开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tkUtil.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：32k
源码类别：

通讯编程

开发平台：

Visual C++

tkUtil.c：源码内容
  1. /* 
  2.  * tkUtil.c --
  3.  *
  4.  * This file contains miscellaneous utility procedures that
  5.  * are used by the rest of Tk, such as a procedure for drawing
  6.  * a focus highlight.
  7.  *
  8.  * Copyright (c) 1994 The Regents of the University of California.
  9.  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  *
  14.  * RCS: @(#) $Id: tkUtil.c,v 1.12.2.1 2004/10/27 00:37:38 davygrvy Exp $
  15.  */
  17. #include "tkInt.h"
  18. #include "tkPort.h"
  20. /*
  21.  * The structure below defines the implementation of the "statekey"
  22.  * Tcl object, used for quickly finding a mapping in a TkStateMap.
  23.  */
  25. Tcl_ObjType tkStateKeyObjType = {
  26.     "statekey", /* name */
  27.     (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
  28.     (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
  29.     (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
  30.     (Tcl_SetFromAnyProc *) NULL /* setFromAnyProc */
  31. };
  34. /*
  35.  *--------------------------------------------------------------
  36.  *
  37.  * TkStateParseProc --
  38.  *
  39.  * This procedure is invoked during option processing to handle
  40.  * the "-state" and "-default" options.
  41.  *
  42.  * Results:
  43.  * A standard Tcl return value.
  44.  *
  45.  * Side effects:
  46.  * The state for a given item gets replaced by the state
  47.  * indicated in the value argument.
  48.  *
  49.  *--------------------------------------------------------------
  50.  */
  52. int
  53. TkStateParseProc(clientData, interp, tkwin, value, widgRec, offset)
  54.     ClientData clientData; /* some flags.*/
  55.     Tcl_Interp *interp; /* Used for reporting errors. */
  56.     Tk_Window tkwin; /* Window containing canvas widget. */
  57.     CONST char *value; /* Value of option. */
  58.     char *widgRec; /* Pointer to record for item. */
  59.     int offset; /* Offset into item. */
  60. {
  61.     int c;
  62.     int flags = (int)clientData;
  63.     size_t length;
  65.     register Tk_State *statePtr = (Tk_State *) (widgRec + offset);
  67.     if(value == NULL || *value == 0) {
  68. *statePtr = TK_STATE_NULL;
  69. return TCL_OK;
  70.     }
  72.     c = value[0];
  73.     length = strlen(value);
  75.     if ((c == 'n') && (strncmp(value, "normal", length) == 0)) {
  76. *statePtr = TK_STATE_NORMAL;
  77. return TCL_OK;
  78.     }
  79.     if ((c == 'd') && (strncmp(value, "disabled", length) == 0)) {
  80. *statePtr = TK_STATE_DISABLED;
  81. return TCL_OK;
  82.     }
  83.     if ((c == 'a') && (flags&1) && (strncmp(value, "active", length) == 0)) {
  84. *statePtr = TK_STATE_ACTIVE;
  85. return TCL_OK;
  86.     }
  87.     if ((c == 'h') && (flags&2) && (strncmp(value, "hidden", length) == 0)) {
  88. *statePtr = TK_STATE_HIDDEN;
  89. return TCL_OK;
  90.     }
  92.     Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state",
  93.     " value "", value, "": must be normal",
  94.     (char *) NULL);
  95.     if (flags&1) {
  96. Tcl_AppendResult(interp, ", active",(char *) NULL);
  97.     }
  98.     if (flags&2) {
  99. Tcl_AppendResult(interp, ", hidden",(char *) NULL);
  100.     }
  101.     if (flags&3) {
  102. Tcl_AppendResult(interp, ",",(char *) NULL);
  103.     }
  104.     Tcl_AppendResult(interp, " or disabled",(char *) NULL);
  105.     *statePtr = TK_STATE_NORMAL;
  106.     return TCL_ERROR;
  107. }
  109. /*
  110.  *--------------------------------------------------------------
  111.  *
  112.  * TkStatePrintProc --
  113.  *
  114.  * This procedure is invoked by the Tk configuration code
  115.  * to produce a printable string for the "-state"
  116.  * configuration option.
  117.  *
  118.  * Results:
  119.  * The return value is a string describing the state for
  120.  * the item referred to by "widgRec".  In addition, *freeProcPtr
  121.  * is filled in with the address of a procedure to call to free
  122.  * the result string when it's no longer needed (or NULL to
  123.  * indicate that the string doesn't need to be freed).
  124.  *
  125.  * Side effects:
  126.  * None.
  127.  *
  128.  *--------------------------------------------------------------
  129.  */
  131. char *
  132. TkStatePrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
  133.     ClientData clientData; /* Ignored. */
  134.     Tk_Window tkwin; /* Window containing canvas widget. */
  135.     char *widgRec; /* Pointer to record for item. */
  136.     int offset; /* Offset into item. */
  137.     Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
  138.  * information about how to reclaim
  139.  * storage for return string. */
  140. {
  141.     register Tk_State *statePtr = (Tk_State *) (widgRec + offset);
  143.     if (*statePtr==TK_STATE_NORMAL) {
  144. return "normal";
  145.     } else if (*statePtr==TK_STATE_DISABLED) {
  146. return "disabled";
  147.     } else if (*statePtr==TK_STATE_HIDDEN) {
  148. return "hidden";
  149.     } else if (*statePtr==TK_STATE_ACTIVE) {
  150. return "active";
  151.     } else {
  152. return "";
  153.     }
  154. }
  156. /*
  157.  *--------------------------------------------------------------
  158.  *
  159.  * TkOrientParseProc --
  160.  *
  161.  * This procedure is invoked during option processing to handle
  162.  * the "-orient" option.
  163.  *
  164.  * Results:
  165.  * A standard Tcl return value.
  166.  *
  167.  * Side effects:
  168.  * The orientation for a given item gets replaced by the orientation
  169.  * indicated in the value argument.
  170.  *
  171.  *--------------------------------------------------------------
  172.  */
  174. int
  175. TkOrientParseProc(clientData, interp, tkwin, value, widgRec, offset)
  176.     ClientData clientData; /* some flags.*/
  177.     Tcl_Interp *interp; /* Used for reporting errors. */
  178.     Tk_Window tkwin; /* Window containing canvas widget. */
  179.     CONST char *value; /* Value of option. */
  180.     char *widgRec; /* Pointer to record for item. */
  181.     int offset; /* Offset into item. */
  182. {
  183.     int c;
  184.     size_t length;
  186.     register int *orientPtr = (int *) (widgRec + offset);
  188.     if(value == NULL || *value == 0) {
  189. *orientPtr = 0;
  190. return TCL_OK;
  191.     }
  193.     c = value[0];
  194.     length = strlen(value);
  196.     if ((c == 'h') && (strncmp(value, "horizontal", length) == 0)) {
  197. *orientPtr = 0;
  198. return TCL_OK;
  199.     }
  200.     if ((c == 'v') && (strncmp(value, "vertical", length) == 0)) {
  201. *orientPtr = 1;
  202. return TCL_OK;
  203.     }
  204.     Tcl_AppendResult(interp, "bad orientation "", value,
  205.     "": must be vertical or horizontal",
  206.     (char *) NULL);
  207.     *orientPtr = 0;
  208.     return TCL_ERROR;
  209. }
  211. /*
  212.  *--------------------------------------------------------------
  213.  *
  214.  * TkOrientPrintProc --
  215.  *
  216.  * This procedure is invoked by the Tk configuration code
  217.  * to produce a printable string for the "-orient"
  218.  * configuration option.
  219.  *
  220.  * Results:
  221.  * The return value is a string describing the orientation for
  222.  * the item referred to by "widgRec".  In addition, *freeProcPtr
  223.  * is filled in with the address of a procedure to call to free
  224.  * the result string when it's no longer needed (or NULL to
  225.  * indicate that the string doesn't need to be freed).
  226.  *
  227.  * Side effects:
  228.  * None.
  229.  *
  230.  *--------------------------------------------------------------
  231.  */
  233. char *
  234. TkOrientPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
  235.     ClientData clientData; /* Ignored. */
  236.     Tk_Window tkwin; /* Window containing canvas widget. */
  237.     char *widgRec; /* Pointer to record for item. */
  238.     int offset; /* Offset into item. */
  239.     Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
  240.  * information about how to reclaim
  241.  * storage for return string. */
  242. {
  243.     register int *statePtr = (int *) (widgRec + offset);
  245.     if (*statePtr) {
  246. return "vertical";
  247.     } else {
  248. return "horizontal";
  249.     }
  250. }
  252. /*
  253.  *----------------------------------------------------------------------
  254.  *
  255.  * TkOffsetParseProc --
  256.  *
  257.  * Converts the offset of a stipple or tile into the Tk_TSOffset structure.
  258.  *
  259.  *----------------------------------------------------------------------
  260.  */
  262. int
  263. TkOffsetParseProc(clientData, interp, tkwin, value, widgRec, offset)
  264.     ClientData clientData; /* not used */
  265.     Tcl_Interp *interp; /* Interpreter to send results back to */
  266.     Tk_Window tkwin; /* Window on same display as tile */
  267.     CONST char *value; /* Name of image */
  268.     char *widgRec; /* Widget structure record */
  269.     int offset; /* Offset of tile in record */
  270. {
  271.     Tk_TSOffset *offsetPtr = (Tk_TSOffset *)(widgRec + offset);
  272.     Tk_TSOffset tsoffset;
  273.     CONST char *q, *p;
  274.     int result;
  276.     if ((value == NULL) || (*value == 0)) {
  277. tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE;
  278. goto goodTSOffset;
  279.     }
  280.     tsoffset.flags = 0;
  281.     p = value;
  283.     switch(value[0]) {
  284. case '#':
  285.     if (((int)clientData) & TK_OFFSET_RELATIVE) {
  286. tsoffset.flags = TK_OFFSET_RELATIVE;
  287. p++; break;
  288.     }
  289.     goto badTSOffset;
  290. case 'e':
  291.     switch(value[1]) {
  292. case '':
  293.     tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_MIDDLE;
  294.     goto goodTSOffset;
  295. case 'n':
  296.     if (value[2]!='d' || value[3]!='') {goto badTSOffset;}
  297.     tsoffset.flags = INT_MAX;
  298.     goto goodTSOffset;
  299.     }
  300. case 'w':
  301.     if (value[1] != '') {goto badTSOffset;}
  302.     tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_MIDDLE;
  303.     goto goodTSOffset;
  304. case 'n':
  305.     if ((value[1] != '') && (value[2] != '')) {
  306. goto badTSOffset;
  307.     }
  308.     switch(value[1]) {
  309. case '': tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_TOP;
  310.    goto goodTSOffset;
  311. case 'w': tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_TOP;
  312.    goto goodTSOffset;
  313. case 'e': tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_TOP;
  314.    goto goodTSOffset;
  315.     }
  316.     goto badTSOffset;
  317. case 's':
  318.     if ((value[1] != '') && (value[2] != '')) {
  319. goto badTSOffset;
  320.     }
  321.     switch(value[1]) {
  322. case '': tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_BOTTOM;
  323.    goto goodTSOffset;
  324. case 'w': tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_BOTTOM;
  325.    goto goodTSOffset;
  326. case 'e': tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_BOTTOM;
  327.    goto goodTSOffset;
  328.     }
  329.     goto badTSOffset;
  330. case 'c':
  331.     if (strncmp(value, "center", strlen(value)) != 0) {
  332. goto badTSOffset;
  333.     }
  334.     tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE;
  335.     goto goodTSOffset;
  336.     }
  337.     if ((q = strchr(p,',')) == NULL) {
  338. if (((int)clientData) & TK_OFFSET_INDEX) {
  339.     if (Tcl_GetInt(interp, (char *) p, &tsoffset.flags) != TCL_OK) {
  340. Tcl_ResetResult(interp);
  341. goto badTSOffset;
  342.     }
  343.     tsoffset.flags |= TK_OFFSET_INDEX;
  344.     goto goodTSOffset;
  345. }
  346. goto badTSOffset;
  347.     }
  348.     *((char *) q) = 0;
  349.     result = Tk_GetPixels(interp, tkwin, (char *) p, &tsoffset.xoffset);
  350.     *((char *) q) = ',';
  351.     if (result != TCL_OK) {
  352. return TCL_ERROR;
  353.     }
  354.     if (Tk_GetPixels(interp, tkwin, (char *) q+1, &tsoffset.yoffset) != TCL_OK) {
  355. return TCL_ERROR;
  356.     }
  359. goodTSOffset:
  360.     /* below is a hack to allow the stipple/tile offset to be stored
  361.      * in the internal tile structure. Most of the times, offsetPtr
  362.      * is a pointer to an already existing tile structure. However
  363.      * if this structure is not already created, we must do it
  364.      * with Tk_GetTile()!!!!;
  365.      */
  367.     memcpy(offsetPtr,&tsoffset, sizeof(Tk_TSOffset));
  368.     return TCL_OK;
  370. badTSOffset:
  371.     Tcl_AppendResult(interp, "bad offset "", value,
  372.     "": expected "x,y"", (char *) NULL);
  373.     if (((int) clientData) & TK_OFFSET_RELATIVE) {
  374. Tcl_AppendResult(interp, ", "#x,y"", (char *) NULL);
  375.     }
  376.     if (((int) clientData) & TK_OFFSET_INDEX) {
  377. Tcl_AppendResult(interp, ", <index>", (char *) NULL);
  378.     }
  379.     Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center",
  380.     (char *) NULL);
  381.     return TCL_ERROR;
  382. }
  384. /*
  385.  *----------------------------------------------------------------------
  386.  *
  387.  * TkOffsetPrintProc --
  388.  *
  389.  * Returns the offset of the tile.
  390.  *
  391.  * Results:
  392.  * The offset of the tile is returned.
  393.  *
  394.  *----------------------------------------------------------------------
  395.  */
  397. char *
  398. TkOffsetPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
  399.     ClientData clientData; /* not used */
  400.     Tk_Window tkwin; /* not used */
  401.     char *widgRec; /* Widget structure record */
  402.     int offset; /* Offset of tile in record */
  403.     Tcl_FreeProc **freeProcPtr; /* not used */
  404. {
  405.     Tk_TSOffset *offsetPtr = (Tk_TSOffset *)(widgRec + offset);
  406.     char *p, *q;
  408.     if ((offsetPtr->flags) & TK_OFFSET_INDEX) {
  409. if ((offsetPtr->flags) >= INT_MAX) {
  410.     return "end";
  411. }
  412. p = (char *) ckalloc(32);
  413. sprintf(p, "%d",(offsetPtr->flags & (~TK_OFFSET_INDEX)));
  414. *freeProcPtr = TCL_DYNAMIC;
  415. return p;
  416.     }
  417.     if ((offsetPtr->flags) & TK_OFFSET_TOP) {
  418. if ((offsetPtr->flags) & TK_OFFSET_LEFT) {
  419.     return "nw";
  420. } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) {
  421.     return "n";
  422. } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) {
  423.     return "ne";
  424. }
  425.     } else if ((offsetPtr->flags) & TK_OFFSET_MIDDLE) {
  426. if ((offsetPtr->flags) & TK_OFFSET_LEFT) {
  427.     return "w";
  428. } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) {
  429.     return "center";
  430. } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) {
  431.     return "e";
  432. }
  433.     } else if ((offsetPtr->flags) & TK_OFFSET_BOTTOM) {
  434. if ((offsetPtr->flags) & TK_OFFSET_LEFT) {
  435.     return "sw";
  436. } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) {
  437.     return "s";
  438. } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) {
  439.     return "se";
  440. }
  441.     } 
  442.     q = p = (char *) ckalloc(32);
  443.     if ((offsetPtr->flags) & TK_OFFSET_RELATIVE) {
  444. *q++ = '#';
  445.     }
  446.     sprintf(q, "%d,%d",offsetPtr->xoffset, offsetPtr->yoffset);
  447.     *freeProcPtr = TCL_DYNAMIC;
  448.     return p;
  449. }
  452. /*
  453.  *----------------------------------------------------------------------
  454.  *
  455.  * TkPixelParseProc --
  456.  *
  457.  * Converts the name of an image into a tile.
  458.  *
  459.  *----------------------------------------------------------------------
  460.  */
  462. int
  463. TkPixelParseProc(clientData, interp, tkwin, value, widgRec, offset)
  464.     ClientData clientData; /* if non-NULL, negative values are
  465.  * allowed as well */
  466.     Tcl_Interp *interp; /* Interpreter to send results back to */
  467.     Tk_Window tkwin; /* Window on same display as tile */
  468.     CONST char *value; /* Name of image */
  469.     char *widgRec; /* Widget structure record */
  470.     int offset; /* Offset of tile in record */
  471. {
  472.     double *doublePtr = (double *)(widgRec + offset);
  473.     int result;
  475.     result = TkGetDoublePixels(interp, tkwin, value, doublePtr);
  477.     if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) {
  478. Tcl_AppendResult(interp, "bad screen distance "", value,
  479. """, (char *) NULL);
  480. return TCL_ERROR;
  481.     }
  482.     return result;
  483. }
  485. /*
  486.  *----------------------------------------------------------------------
  487.  *
  488.  * TkPixelPrintProc --
  489.  *
  490.  * Returns the name of the tile.
  491.  *
  492.  * Results:
  493.  * The name of the tile is returned.
  494.  *
  495.  *----------------------------------------------------------------------
  496.  */
  498. char *
  499. TkPixelPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
  500.     ClientData clientData; /* not used */
  501.     Tk_Window tkwin; /* not used */
  502.     char *widgRec; /* Widget structure record */
  503.     int offset; /* Offset of tile in record */
  504.     Tcl_FreeProc **freeProcPtr; /* not used */
  505. {
  506.     double *doublePtr = (double *)(widgRec + offset);
  507.     char *p;
  509.     p = (char *) ckalloc(24);
  510.     Tcl_PrintDouble((Tcl_Interp *) NULL, *doublePtr, p);
  511.     *freeProcPtr = TCL_DYNAMIC;
  512.     return p;
  513. }
  515. /*
  516.  *----------------------------------------------------------------------
  517.  *
  518.  * TkDrawInsetFocusHighlight --
  519.  *
  520.  * This procedure draws a rectangular ring around the outside of
  521.  * a widget to indicate that it has received the input focus.  It
  522.  * takes an additional padding argument that specifies how much
  523.  * padding is present outside th widget.
  524.  *
  525.  * Results:
  526.  * None.
  527.  *
  528.  * Side effects:
  529.  * A rectangle "width" pixels wide is drawn in "drawable",
  530.  * corresponding to the outer area of "tkwin".
  531.  *
  532.  *----------------------------------------------------------------------
  533.  */
  535. void
  536. TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, padding)
  537.     Tk_Window tkwin; /* Window whose focus highlight ring is
  538.  * to be drawn. */
  539.     GC gc; /* Graphics context to use for drawing
  540.  * the highlight ring. */
  541.     int width; /* Width of the highlight ring, in pixels. */
  542.     Drawable drawable; /* Where to draw the ring (typically a
  543.  * pixmap for double buffering). */
  544.     int padding; /* Width of padding outside of widget. */
  545. {
  546.     XRectangle rects[4];
  548.     rects[0].x = padding;
  549.     rects[0].y = padding;
  550.     rects[0].width = Tk_Width(tkwin) - (2 * padding);
  551.     rects[0].height = width;
  552.     rects[1].x = padding;
  553.     rects[1].y = Tk_Height(tkwin) - width - padding;
  554.     rects[1].width = Tk_Width(tkwin) - (2 * padding);
  555.     rects[1].height = width;
  556.     rects[2].x = padding;
  557.     rects[2].y = width + padding;
  558.     rects[2].width = width;
  559.     rects[2].height = Tk_Height(tkwin) - 2*width - 2*padding;
  560.     rects[3].x = Tk_Width(tkwin) - width - padding;
  561.     rects[3].y = rects[2].y;
  562.     rects[3].width = width;
  563.     rects[3].height = rects[2].height;
  564.     XFillRectangles(Tk_Display(tkwin), drawable, gc, rects, 4);
  565. }
  567. /*
  568.  *----------------------------------------------------------------------
  569.  *
  570.  * Tk_DrawFocusHighlight --
  571.  *
  572.  * This procedure draws a rectangular ring around the outside of
  573.  * a widget to indicate that it has received the input focus.
  574.  *
  575.  *      This function is now deprecated.  Use TkpDrawHighlightBorder instead,
  576.  *      since this function does not handle drawing the Focus ring properly
  577.  *      on the Macintosh - you need to know the background GC as well 
  578.  *      as the foreground since the Mac focus ring separated from the widget
  579.  *      by a 1 pixel border.
  580.  *
  581.  * Results:
  582.  * None.
  583.  *
  584.  * Side effects:
  585.  * A rectangle "width" pixels wide is drawn in "drawable",
  586.  * corresponding to the outer area of "tkwin".
  587.  *
  588.  *----------------------------------------------------------------------
  589.  */
  591. void
  592. Tk_DrawFocusHighlight(tkwin, gc, width, drawable)
  593.     Tk_Window tkwin; /* Window whose focus highlight ring is
  594.  * to be drawn. */
  595.     GC gc; /* Graphics context to use for drawing
  596.  * the highlight ring. */
  597.     int width; /* Width of the highlight ring, in pixels. */
  598.     Drawable drawable; /* Where to draw the ring (typically a
  599.  * pixmap for double buffering). */
  600. {
  601.     TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, 0);
  602. }
  604. /*
  605.  *----------------------------------------------------------------------
  606.  *
  607.  * Tk_GetScrollInfo --
  608.  *
  609.  * This procedure is invoked to parse "xview" and "yview"
  610.  * scrolling commands for widgets using the new scrolling
  611.  * command syntax ("moveto" or "scroll" options).
  612.  *
  613.  * Results:
  614.  * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
  615.  * TK_SCROLL_UNITS, or TK_SCROLL_ERROR.  This indicates whether
  616.  * the command was successfully parsed and what form the command
  617.  * took.  If TK_SCROLL_MOVETO, *dblPtr is filled in with the
  618.  * desired position;  if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
  619.  * *intPtr is filled in with the number of lines to move (may be
  620.  * negative);  if TK_SCROLL_ERROR, the interp's result contains an
  621.  * error message.
  622.  *
  623.  * Side effects:
  624.  * None.
  625.  *
  626.  *----------------------------------------------------------------------
  627.  */
  629. int
  630. Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr)
  631.     Tcl_Interp *interp; /* Used for error reporting. */
  632.     int argc; /* # arguments for command. */
  633.     CONST char **argv; /* Arguments for command. */
  634.     double *dblPtr; /* Filled in with argument "moveto"
  635.  * option, if any. */
  636.     int *intPtr; /* Filled in with number of pages
  637.  * or lines to scroll, if any. */
  638. {
  639.     int c;
  640.     size_t length;
  642.     length = strlen(argv[2]);
  643.     c = argv[2][0];
  644.     if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) {
  645. if (argc != 4) {
  646.     Tcl_AppendResult(interp, "wrong # args: should be "",
  647.     argv[0], " ", argv[1], " moveto fraction"",
  648.     (char *) NULL);
  649.     return TK_SCROLL_ERROR;
  650. }
  651. if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) {
  652.     return TK_SCROLL_ERROR;
  653. }
  654. return TK_SCROLL_MOVETO;
  655.     } else if ((c == 's')
  656.     && (strncmp(argv[2], "scroll", length) == 0)) {
  657. if (argc != 5) {
  658.     Tcl_AppendResult(interp, "wrong # args: should be "",
  659.     argv[0], " ", argv[1], " scroll number units|pages"",
  660.     (char *) NULL);
  661.     return TK_SCROLL_ERROR;
  662. }
  663. if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) {
  664.     return TK_SCROLL_ERROR;
  665. }
  666. length = strlen(argv[4]);
  667. c = argv[4][0];
  668. if ((c == 'p') && (strncmp(argv[4], "pages", length) == 0)) {
  669.     return TK_SCROLL_PAGES;
  670. } else if ((c == 'u')
  671. && (strncmp(argv[4], "units", length) == 0)) {
  672.     return TK_SCROLL_UNITS;
  673. } else {
  674.     Tcl_AppendResult(interp, "bad argument "", argv[4],
  675.     "": must be units or pages", (char *) NULL);
  676.     return TK_SCROLL_ERROR;
  677. }
  678.     }
  679.     Tcl_AppendResult(interp, "unknown option "", argv[2],
  680.     "": must be moveto or scroll", (char *) NULL);
  681.     return TK_SCROLL_ERROR;
  682. }
  684. /*
  685.  *----------------------------------------------------------------------
  686.  *
  687.  * Tk_GetScrollInfoObj --
  688.  *
  689.  * This procedure is invoked to parse "xview" and "yview"
  690.  * scrolling commands for widgets using the new scrolling
  691.  * command syntax ("moveto" or "scroll" options).
  692.  *
  693.  * Results:
  694.  * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
  695.  * TK_SCROLL_UNITS, or TK_SCROLL_ERROR.  This indicates whether
  696.  * the command was successfully parsed and what form the command
  697.  * took.  If TK_SCROLL_MOVETO, *dblPtr is filled in with the
  698.  * desired position;  if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
  699.  * *intPtr is filled in with the number of lines to move (may be
  700.  * negative);  if TK_SCROLL_ERROR, the interp's result contains an
  701.  * error message.
  702.  *
  703.  * Side effects:
  704.  * None.
  705.  *
  706.  *----------------------------------------------------------------------
  707.  */
  709. int
  710. Tk_GetScrollInfoObj(interp, objc, objv, dblPtr, intPtr)
  711.     Tcl_Interp *interp; /* Used for error reporting. */
  712.     int objc; /* # arguments for command. */
  713.     Tcl_Obj *CONST objv[]; /* Arguments for command. */
  714.     double *dblPtr; /* Filled in with argument "moveto"
  715.  * option, if any. */
  716.     int *intPtr; /* Filled in with number of pages
  717.  * or lines to scroll, if any. */
  718. {
  719.     int c;
  720.     size_t length;
  721.     char *arg2, *arg4;
  723.     arg2 = Tcl_GetString(objv[2]);
  724.     length = strlen(arg2);
  725.     c = arg2[0];
  726.     if ((c == 'm') && (strncmp(arg2, "moveto", length) == 0)) {
  727. if (objc != 4) {
  728.     Tcl_WrongNumArgs(interp, 2, objv, "moveto fraction");
  729.     return TK_SCROLL_ERROR;
  730. }
  731. if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) {
  732.     return TK_SCROLL_ERROR;
  733. }
  734. return TK_SCROLL_MOVETO;
  735.     } else if ((c == 's')
  736.     && (strncmp(arg2, "scroll", length) == 0)) {
  737. if (objc != 5) {
  738.     Tcl_WrongNumArgs(interp, 2, objv, "scroll number units|pages");
  739.     return TK_SCROLL_ERROR;
  740. }
  741. if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) {
  742.     return TK_SCROLL_ERROR;
  743. }
  744. arg4 = Tcl_GetString(objv[4]);
  745. length = (strlen(arg4));
  746. c = arg4[0];
  747. if ((c == 'p') && (strncmp(arg4, "pages", length) == 0)) {
  748.     return TK_SCROLL_PAGES;
  749. } else if ((c == 'u')
  750. && (strncmp(arg4, "units", length) == 0)) {
  751.     return TK_SCROLL_UNITS;
  752. } else {
  753.     Tcl_AppendResult(interp, "bad argument "", arg4,
  754.     "": must be units or pages", (char *) NULL);
  755.     return TK_SCROLL_ERROR;
  756. }
  757.     }
  758.     Tcl_AppendResult(interp, "unknown option "", arg2,
  759.     "": must be moveto or scroll", (char *) NULL);
  760.     return TK_SCROLL_ERROR;
  761. }
  763. /*
  764.  *---------------------------------------------------------------------------
  765.  *
  766.  * TkComputeAnchor --
  767.  *
  768.  * Determine where to place a rectangle so that it will be properly
  769.  * anchored with respect to the given window.  Used by widgets
  770.  * to align a box of text inside a window.  When anchoring with
  771.  * respect to one of the sides, the rectangle be placed inside of
  772.  * the internal border of the window.
  773.  *
  774.  * Results:
  775.  * *xPtr and *yPtr set to the upper-left corner of the rectangle
  776.  * anchored in the window.
  777.  *
  778.  * Side effects:
  779.  * None.
  780.  *
  781.  *---------------------------------------------------------------------------
  782.  */
  783. void
  784. TkComputeAnchor(anchor, tkwin, padX, padY, innerWidth, innerHeight, xPtr, yPtr)
  785.     Tk_Anchor anchor; /* Desired anchor. */
  786.     Tk_Window tkwin; /* Anchored with respect to this window. */
  787.     int padX, padY; /* Use this extra padding inside window, in
  788.  * addition to the internal border. */
  789.     int innerWidth, innerHeight;/* Size of rectangle to anchor in window. */
  790.     int *xPtr, *yPtr; /* Returns upper-left corner of anchored
  791.  * rectangle. */
  792. {
  793.     switch (anchor) {
  794. case TK_ANCHOR_NW:
  795. case TK_ANCHOR_W:
  796. case TK_ANCHOR_SW:
  797.     *xPtr = Tk_InternalBorderLeft(tkwin) + padX;
  798.     break;
  800. case TK_ANCHOR_N:
  801. case TK_ANCHOR_CENTER:
  802. case TK_ANCHOR_S:
  803.     *xPtr = (Tk_Width(tkwin) - innerWidth) / 2;
  804.     break;
  806. default:
  807.     *xPtr = Tk_Width(tkwin) - (Tk_InternalBorderRight(tkwin) + padX)
  808.     - innerWidth;
  809.     break;
  810.     }
  812.     switch (anchor) {
  813. case TK_ANCHOR_NW:
  814. case TK_ANCHOR_N:
  815. case TK_ANCHOR_NE:
  816.     *yPtr = Tk_InternalBorderTop(tkwin) + padY;
  817.     break;
  819. case TK_ANCHOR_W:
  820. case TK_ANCHOR_CENTER:
  821. case TK_ANCHOR_E:
  822.     *yPtr = (Tk_Height(tkwin) - innerHeight) / 2;
  823.     break;
  825. default:
  826.     *yPtr = Tk_Height(tkwin) - Tk_InternalBorderBottom(tkwin) - padY
  827.     - innerHeight;
  828.     break;
  829.     }
  830. }
  832. /*
  833.  *---------------------------------------------------------------------------
  834.  *
  835.  * TkFindStateString --
  836.  *
  837.  * Given a lookup table, map a number to a string in the table.
  838.  *
  839.  * Results:
  840.  * If numKey was equal to the numeric key of one of the elements
  841.  * in the table, returns the string key of that element.
  842.  * Returns NULL if numKey was not equal to any of the numeric keys
  843.  * in the table.
  844.  *
  845.  * Side effects.
  846.  * None.
  847.  *
  848.  *---------------------------------------------------------------------------
  849.  */
  851. char *
  852. TkFindStateString(mapPtr, numKey)
  853.     CONST TkStateMap *mapPtr; /* The state table. */
  854.     int numKey; /* The key to try to find in the table. */
  855. {
  856.     for ( ; mapPtr->strKey != NULL; mapPtr++) {
  857. if (numKey == mapPtr->numKey) {
  858.     return mapPtr->strKey;
  859. }
  860.     }
  861.     return NULL;
  862. }
  864. /*
  865.  *---------------------------------------------------------------------------
  866.  *
  867.  * TkFindStateNum --
  868.  *
  869.  * Given a lookup table, map a string to a number in the table.
  870.  *
  871.  * Results:
  872.  * If strKey was equal to the string keys of one of the elements
  873.  * in the table, returns the numeric key of that element.
  874.  * Returns the numKey associated with the last element (the NULL
  875.  * string one) in the table if strKey was not equal to any of the
  876.  * string keys in the table.  In that case, an error message is
  877.  * also left in the interp's result (if interp is not NULL).
  878.  *
  879.  * Side effects.
  880.  * None.
  881.  *
  882.  *---------------------------------------------------------------------------
  883.  */
  885. int
  886. TkFindStateNum(interp, option, mapPtr, strKey)
  887.     Tcl_Interp *interp; /* Interp for error reporting. */
  888.     CONST char *option; /* String to use when constructing error. */
  889.     CONST TkStateMap *mapPtr; /* Lookup table. */
  890.     CONST char *strKey; /* String to try to find in lookup table. */
  891. {
  892.     CONST TkStateMap *mPtr;
  894.     for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
  895. if (strcmp(strKey, mPtr->strKey) == 0) {
  896.     return mPtr->numKey;
  897. }
  898.     }
  899.     if (interp != NULL) {
  900. mPtr = mapPtr;
  901. Tcl_AppendResult(interp, "bad ", option, " value "", strKey,
  902. "": must be ", mPtr->strKey, (char *) NULL);
  903. for (mPtr++; mPtr->strKey != NULL; mPtr++) {
  904.     Tcl_AppendResult(interp, 
  905.     ((mPtr[1].strKey != NULL) ? ", " : ", or "), 
  906.     mPtr->strKey, (char *) NULL);
  907. }
  908.     }
  909.     return mPtr->numKey;
  910. }
  912. int
  913. TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr)
  914.     Tcl_Interp *interp; /* Interp for error reporting. */
  915.     Tcl_Obj *optionPtr; /* String to use when constructing error. */
  916.     CONST TkStateMap *mapPtr; /* Lookup table. */
  917.     Tcl_Obj *keyPtr; /* String key to find in lookup table. */
  918. {
  919.     CONST TkStateMap *mPtr;
  920.     CONST char *key;
  921.     CONST Tcl_ObjType *typePtr;
  923.     if ((keyPtr->typePtr == &tkStateKeyObjType)
  924.     && (keyPtr->internalRep.twoPtrValue.ptr1 == (VOID *) mapPtr)) {
  925. return (int) keyPtr->internalRep.twoPtrValue.ptr2;
  926.     }
  928.     key = Tcl_GetStringFromObj(keyPtr, NULL);
  929.     for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
  930. if (strcmp(key, mPtr->strKey) == 0) {
  931.     typePtr = keyPtr->typePtr;
  932.     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
  933. (*typePtr->freeIntRepProc)(keyPtr);
  934.     }
  935.     keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr;
  936.     keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey;
  937.     keyPtr->typePtr = &tkStateKeyObjType;     
  938.     return mPtr->numKey;
  939. }
  940.     }
  941.     if (interp != NULL) {
  942. mPtr = mapPtr;
  943. Tcl_AppendResult(interp, "bad ",
  944. Tcl_GetStringFromObj(optionPtr, NULL), " value "", key,
  945. "": must be ", mPtr->strKey, (char *) NULL);
  946. for (mPtr++; mPtr->strKey != NULL; mPtr++) {
  947.     Tcl_AppendResult(interp, 
  948. ((mPtr[1].strKey != NULL) ? ", " : ", or "), 
  949. mPtr->strKey, (char *) NULL);
  950. }
  951.     }
  952.     return mPtr->numKey;
  953. }
  955. /*
  956.  * For each exit handler created with a call to TkCreateExitHandler
  957.  * there is a structure of the following type:
  958.  */
  960. typedef struct ExitHandler {
  961.     Tcl_ExitProc *proc; /* Procedure to call when process exits. */
  962.     ClientData clientData; /* One word of information to pass to proc. */
  963.     struct ExitHandler *nextPtr;/* Next in list of all exit handlers for
  964.  * this application, or NULL for end of list. */
  965. } ExitHandler;
  967. /*
  968.  * There is both per-process and per-thread exit handlers.
  969.  * The first list is controlled by a mutex.  The other is in
  970.  * thread local storage.
  971.  */
  973. static ExitHandler *firstExitPtr = NULL;
  974. /* First in list of all exit handlers for
  975.  * application. */
  976. TCL_DECLARE_MUTEX(exitMutex)
  978. /*
  979.  *---------------------------------------------------------------------------
  980.  *
  981.  * TkCreateExitHandler --
  982.  *
  983.  * Same as Tcl_CreateExitHandler, but private to Tk.
  984.  *
  985.  * Results:
  986.  * None.
  987.  *
  988.  * Side effects.
  989.  * Sets a handler with Tcl_CreateExitHandler if this is the first call.
  990.  *
  991.  *---------------------------------------------------------------------------
  992.  */
  994. void
  995. TkCreateExitHandler (proc, clientData)
  996.     Tcl_ExitProc *proc; /* Procedure to invoke. */
  997.     ClientData clientData; /* Arbitrary value to pass to proc. */
  998. {
  999.     ExitHandler *exitPtr;
  1001.     exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
  1002.     exitPtr->proc = proc;
  1003.     exitPtr->clientData = clientData;
  1004.     Tcl_MutexLock(&exitMutex);
  1005.     if (firstExitPtr == NULL) {
  1006. Tcl_CreateExitHandler(TkFinalize, NULL);
  1007.     }
  1008.     exitPtr->nextPtr = firstExitPtr;
  1009.     firstExitPtr = exitPtr;
  1010.     Tcl_MutexUnlock(&exitMutex);
  1011. }
  1013. /*
  1014.  *---------------------------------------------------------------------------
  1015.  *
  1016.  * TkDeleteExitHandler --
  1017.  *
  1018.  * Same as Tcl_DeleteExitHandler, but private to Tk.
  1019.  *
  1020.  * Results:
  1021.  * None.
  1022.  *
  1023.  * Side effects.
  1024.  * None.
  1025.  *
  1026.  *---------------------------------------------------------------------------
  1027.  */
  1029. void
  1030. TkDeleteExitHandler (proc, clientData)
  1031.     Tcl_ExitProc *proc; /* Procedure that was previously registered. */
  1032.     ClientData clientData; /* Arbitrary value to pass to proc. */
  1033. {
  1034.     ExitHandler *exitPtr, *prevPtr;
  1036.     Tcl_MutexLock(&exitMutex);
  1037.     for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
  1038.     prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
  1039. if ((exitPtr->proc == proc)
  1040. && (exitPtr->clientData == clientData)) {
  1041.     if (prevPtr == NULL) {
  1042. firstExitPtr = exitPtr->nextPtr;
  1043.     } else {
  1044. prevPtr->nextPtr = exitPtr->nextPtr;
  1045.     }
  1046.     ckfree((char *) exitPtr);
  1047.     break;
  1048. }
  1049.     }
  1050.     Tcl_MutexUnlock(&exitMutex);
  1051.     return;
  1052. }
  1054. /*
  1055.  *---------------------------------------------------------------------------
  1056.  *
  1057.  * TkFinalize --
  1058.  *
  1059.  * Runs our private exit handlers and removes itself from Tcl. This is
  1060.  * benificial should we want to protect from dangling pointers should
  1061.  * the Tk shared library be unloaded prior to Tcl which can happen on
  1062.  * windows should the process be forcefully exiting from an exception
  1063.  * handler.
  1064.  *
  1065.  * Results:
  1066.  * None.
  1067.  *
  1068.  * Side effects.
  1069.  * None.
  1070.  *
  1071.  *---------------------------------------------------------------------------
  1072.  */
  1074. void
  1075. TkFinalize (clientData)
  1076.     ClientData clientData; /* Arbitrary value to pass to proc. */
  1077. {
  1078.     ExitHandler *exitPtr;
  1080.     Tcl_DeleteExitHandler(TkFinalize, NULL);
  1082.     Tcl_MutexLock(&exitMutex);
  1083.     for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
  1084. /*
  1085.  * Be careful to remove the handler from the list before
  1086.  * invoking its callback.  This protects us against
  1087.  * double-freeing if the callback should call
  1088.  * Tcl_DeleteExitHandler on itself.
  1089.  */
  1091. firstExitPtr = exitPtr->nextPtr;
  1092. Tcl_MutexUnlock(&exitMutex);
  1093. (*exitPtr->proc)(exitPtr->clientData);
  1094. ckfree((char *) exitPtr);
  1095. Tcl_MutexLock(&exitMutex);
  1096.     }    
  1097.     firstExitPtr = NULL;
  1098.     Tcl_MutexUnlock(&exitMutex);
  1099. }