/* * tkUtil.c -- * * This file contains miscellaneous utility procedures that * are used by the rest of Tk, such as a procedure for drawing * a focus highlight. * * Copyright (c) 1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tkUtil.c,v 1.12.2.1 2004/10/27 00:37:38 davygrvy Exp $ */ #include "tkInt.h" #include "tkPort.h" /* * The structure below defines the implementation of the "statekey" * Tcl object, used for quickly finding a mapping in a TkStateMap. */ Tcl_ObjType tkStateKeyObjType = { "statekey", /* name */ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */ (Tcl_SetFromAnyProc *) NULL /* setFromAnyProc */ }; /* *-------------------------------------------------------------- * * TkStateParseProc -- * * This procedure is invoked during option processing to handle * the "-state" and "-default" options. * * Results: * A standard Tcl return value. * * Side effects: * The state for a given item gets replaced by the state * indicated in the value argument. * *-------------------------------------------------------------- */ int TkStateParseProc(clientData, interp, tkwin, value, widgRec, offset) ClientData clientData; /* some flags.*/ Tcl_Interp *interp; /* Used for reporting errors. */ Tk_Window tkwin; /* Window containing canvas widget. */ CONST char *value; /* Value of option. */ char *widgRec; /* Pointer to record for item. */ int offset; /* Offset into item. */ { int c; int flags = (int)clientData; size_t length; register Tk_State *statePtr = (Tk_State *) (widgRec + offset); if(value == NULL || *value == 0) { *statePtr = TK_STATE_NULL; return TCL_OK; } c = value[0]; length = strlen(value); if ((c == 'n') && (strncmp(value, "normal", length) == 0)) { *statePtr = TK_STATE_NORMAL; return TCL_OK; } if ((c == 'd') && (strncmp(value, "disabled", length) == 0)) { *statePtr = TK_STATE_DISABLED; return TCL_OK; } if ((c == 'a') && (flags&1) && (strncmp(value, "active", length) == 0)) { *statePtr = TK_STATE_ACTIVE; return TCL_OK; } if ((c == 'h') && (flags&2) && (strncmp(value, "hidden", length) == 0)) { *statePtr = TK_STATE_HIDDEN; return TCL_OK; } Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state", " value \"", value, "\": must be normal", (char *) NULL); if (flags&1) { Tcl_AppendResult(interp, ", active",(char *) NULL); } if (flags&2) { Tcl_AppendResult(interp, ", hidden",(char *) NULL); } if (flags&3) { Tcl_AppendResult(interp, ",",(char *) NULL); } Tcl_AppendResult(interp, " or disabled",(char *) NULL); *statePtr = TK_STATE_NORMAL; return TCL_ERROR; } /* *-------------------------------------------------------------- * * TkStatePrintProc -- * * This procedure is invoked by the Tk configuration code * to produce a printable string for the "-state" * configuration option. * * Results: * The return value is a string describing the state for * the item referred to by "widgRec". In addition, *freeProcPtr * is filled in with the address of a procedure to call to free * the result string when it's no longer needed (or NULL to * indicate that the string doesn't need to be freed). * * Side effects: * None. * *-------------------------------------------------------------- */ char * TkStatePrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) ClientData clientData; /* Ignored. */ Tk_Window tkwin; /* Window containing canvas widget. */ char *widgRec; /* Pointer to record for item. */ int offset; /* Offset into item. */ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with * information about how to reclaim * storage for return string. */ { register Tk_State *statePtr = (Tk_State *) (widgRec + offset); if (*statePtr==TK_STATE_NORMAL) { return "normal"; } else if (*statePtr==TK_STATE_DISABLED) { return "disabled"; } else if (*statePtr==TK_STATE_HIDDEN) { return "hidden"; } else if (*statePtr==TK_STATE_ACTIVE) { return "active"; } else { return ""; } } /* *-------------------------------------------------------------- * * TkOrientParseProc -- * * This procedure is invoked during option processing to handle * the "-orient" option. * * Results: * A standard Tcl return value. * * Side effects: * The orientation for a given item gets replaced by the orientation * indicated in the value argument. * *-------------------------------------------------------------- */ int TkOrientParseProc(clientData, interp, tkwin, value, widgRec, offset) ClientData clientData; /* some flags.*/ Tcl_Interp *interp; /* Used for reporting errors. */ Tk_Window tkwin; /* Window containing canvas widget. */ CONST char *value; /* Value of option. */ char *widgRec; /* Pointer to record for item. */ int offset; /* Offset into item. */ { int c; size_t length; register int *orientPtr = (int *) (widgRec + offset); if(value == NULL || *value == 0) { *orientPtr = 0; return TCL_OK; } c = value[0]; length = strlen(value); if ((c == 'h') && (strncmp(value, "horizontal", length) == 0)) { *orientPtr = 0; return TCL_OK; } if ((c == 'v') && (strncmp(value, "vertical", length) == 0)) { *orientPtr = 1; return TCL_OK; } Tcl_AppendResult(interp, "bad orientation \"", value, "\": must be vertical or horizontal", (char *) NULL); *orientPtr = 0; return TCL_ERROR; } /* *-------------------------------------------------------------- * * TkOrientPrintProc -- * * This procedure is invoked by the Tk configuration code * to produce a printable string for the "-orient" * configuration option. * * Results: * The return value is a string describing the orientation for * the item referred to by "widgRec". In addition, *freeProcPtr * is filled in with the address of a procedure to call to free * the result string when it's no longer needed (or NULL to * indicate that the string doesn't need to be freed). * * Side effects: * None. * *-------------------------------------------------------------- */ char * TkOrientPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) ClientData clientData; /* Ignored. */ Tk_Window tkwin; /* Window containing canvas widget. */ char *widgRec; /* Pointer to record for item. */ int offset; /* Offset into item. */ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with * information about how to reclaim * storage for return string. */ { register int *statePtr = (int *) (widgRec + offset); if (*statePtr) { return "vertical"; } else { return "horizontal"; } } /* *---------------------------------------------------------------------- * * TkOffsetParseProc -- * * Converts the offset of a stipple or tile into the Tk_TSOffset structure. * *---------------------------------------------------------------------- */ int TkOffsetParseProc(clientData, interp, tkwin, value, widgRec, offset) ClientData clientData; /* not used */ Tcl_Interp *interp; /* Interpreter to send results back to */ Tk_Window tkwin; /* Window on same display as tile */ CONST char *value; /* Name of image */ char *widgRec; /* Widget structure record */ int offset; /* Offset of tile in record */ { Tk_TSOffset *offsetPtr = (Tk_TSOffset *)(widgRec + offset); Tk_TSOffset tsoffset; CONST char *q, *p; int result; if ((value == NULL) || (*value == 0)) { tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; goto goodTSOffset; } tsoffset.flags = 0; p = value; switch(value[0]) { case '#': if (((int)clientData) & TK_OFFSET_RELATIVE) { tsoffset.flags = TK_OFFSET_RELATIVE; p++; break; } goto badTSOffset; case 'e': switch(value[1]) { case '\0': tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_MIDDLE; goto goodTSOffset; case 'n': if (value[2]!='d' || value[3]!='\0') {goto badTSOffset;} tsoffset.flags = INT_MAX; goto goodTSOffset; } case 'w': if (value[1] != '\0') {goto badTSOffset;} tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_MIDDLE; goto goodTSOffset; case 'n': if ((value[1] != '\0') && (value[2] != '\0')) { goto badTSOffset; } switch(value[1]) { case '\0': tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_TOP; goto goodTSOffset; case 'w': tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_TOP; goto goodTSOffset; case 'e': tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_TOP; goto goodTSOffset; } goto badTSOffset; case 's': if ((value[1] != '\0') && (value[2] != '\0')) { goto badTSOffset; } switch(value[1]) { case '\0': tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_BOTTOM; goto goodTSOffset; case 'w': tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_BOTTOM; goto goodTSOffset; case 'e': tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_BOTTOM; goto goodTSOffset; } goto badTSOffset; case 'c': if (strncmp(value, "center", strlen(value)) != 0) { goto badTSOffset; } tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; goto goodTSOffset; } if ((q = strchr(p,',')) == NULL) { if (((int)clientData) & TK_OFFSET_INDEX) { if (Tcl_GetInt(interp, (char *) p, &tsoffset.flags) != TCL_OK) { Tcl_ResetResult(interp); goto badTSOffset; } tsoffset.flags |= TK_OFFSET_INDEX; goto goodTSOffset; } goto badTSOffset; } *((char *) q) = 0; result = Tk_GetPixels(interp, tkwin, (char *) p, &tsoffset.xoffset); *((char *) q) = ','; if (result != TCL_OK) { return TCL_ERROR; } if (Tk_GetPixels(interp, tkwin, (char *) q+1, &tsoffset.yoffset) != TCL_OK) { return TCL_ERROR; } goodTSOffset: /* below is a hack to allow the stipple/tile offset to be stored * in the internal tile structure. Most of the times, offsetPtr * is a pointer to an already existing tile structure. However * if this structure is not already created, we must do it * with Tk_GetTile()!!!!; */ memcpy(offsetPtr,&tsoffset, sizeof(Tk_TSOffset)); return TCL_OK; badTSOffset: Tcl_AppendResult(interp, "bad offset \"", value, "\": expected \"x,y\"", (char *) NULL); if (((int) clientData) & TK_OFFSET_RELATIVE) { Tcl_AppendResult(interp, ", \"#x,y\"", (char *) NULL); } if (((int) clientData) & TK_OFFSET_INDEX) { Tcl_AppendResult(interp, ", ", (char *) NULL); } Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center", (char *) NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TkOffsetPrintProc -- * * Returns the offset of the tile. * * Results: * The offset of the tile is returned. * *---------------------------------------------------------------------- */ char * TkOffsetPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) ClientData clientData; /* not used */ Tk_Window tkwin; /* not used */ char *widgRec; /* Widget structure record */ int offset; /* Offset of tile in record */ Tcl_FreeProc **freeProcPtr; /* not used */ { Tk_TSOffset *offsetPtr = (Tk_TSOffset *)(widgRec + offset); char *p, *q; if ((offsetPtr->flags) & TK_OFFSET_INDEX) { if ((offsetPtr->flags) >= INT_MAX) { return "end"; } p = (char *) ckalloc(32); sprintf(p, "%d",(offsetPtr->flags & (~TK_OFFSET_INDEX))); *freeProcPtr = TCL_DYNAMIC; return p; } if ((offsetPtr->flags) & TK_OFFSET_TOP) { if ((offsetPtr->flags) & TK_OFFSET_LEFT) { return "nw"; } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) { return "n"; } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) { return "ne"; } } else if ((offsetPtr->flags) & TK_OFFSET_MIDDLE) { if ((offsetPtr->flags) & TK_OFFSET_LEFT) { return "w"; } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) { return "center"; } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) { return "e"; } } else if ((offsetPtr->flags) & TK_OFFSET_BOTTOM) { if ((offsetPtr->flags) & TK_OFFSET_LEFT) { return "sw"; } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) { return "s"; } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) { return "se"; } } q = p = (char *) ckalloc(32); if ((offsetPtr->flags) & TK_OFFSET_RELATIVE) { *q++ = '#'; } sprintf(q, "%d,%d",offsetPtr->xoffset, offsetPtr->yoffset); *freeProcPtr = TCL_DYNAMIC; return p; } /* *---------------------------------------------------------------------- * * TkPixelParseProc -- * * Converts the name of an image into a tile. * *---------------------------------------------------------------------- */ int TkPixelParseProc(clientData, interp, tkwin, value, widgRec, offset) ClientData clientData; /* if non-NULL, negative values are * allowed as well */ Tcl_Interp *interp; /* Interpreter to send results back to */ Tk_Window tkwin; /* Window on same display as tile */ CONST char *value; /* Name of image */ char *widgRec; /* Widget structure record */ int offset; /* Offset of tile in record */ { double *doublePtr = (double *)(widgRec + offset); int result; result = TkGetDoublePixels(interp, tkwin, value, doublePtr); if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) { Tcl_AppendResult(interp, "bad screen distance \"", value, "\"", (char *) NULL); return TCL_ERROR; } return result; } /* *---------------------------------------------------------------------- * * TkPixelPrintProc -- * * Returns the name of the tile. * * Results: * The name of the tile is returned. * *---------------------------------------------------------------------- */ char * TkPixelPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr) ClientData clientData; /* not used */ Tk_Window tkwin; /* not used */ char *widgRec; /* Widget structure record */ int offset; /* Offset of tile in record */ Tcl_FreeProc **freeProcPtr; /* not used */ { double *doublePtr = (double *)(widgRec + offset); char *p; p = (char *) ckalloc(24); Tcl_PrintDouble((Tcl_Interp *) NULL, *doublePtr, p); *freeProcPtr = TCL_DYNAMIC; return p; } /* *---------------------------------------------------------------------- * * TkDrawInsetFocusHighlight -- * * This procedure draws a rectangular ring around the outside of * a widget to indicate that it has received the input focus. It * takes an additional padding argument that specifies how much * padding is present outside th widget. * * Results: * None. * * Side effects: * A rectangle "width" pixels wide is drawn in "drawable", * corresponding to the outer area of "tkwin". * *---------------------------------------------------------------------- */ void TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, padding) Tk_Window tkwin; /* Window whose focus highlight ring is * to be drawn. */ GC gc; /* Graphics context to use for drawing * the highlight ring. */ int width; /* Width of the highlight ring, in pixels. */ Drawable drawable; /* Where to draw the ring (typically a * pixmap for double buffering). */ int padding; /* Width of padding outside of widget. */ { XRectangle rects[4]; rects[0].x = padding; rects[0].y = padding; rects[0].width = Tk_Width(tkwin) - (2 * padding); rects[0].height = width; rects[1].x = padding; rects[1].y = Tk_Height(tkwin) - width - padding; rects[1].width = Tk_Width(tkwin) - (2 * padding); rects[1].height = width; rects[2].x = padding; rects[2].y = width + padding; rects[2].width = width; rects[2].height = Tk_Height(tkwin) - 2*width - 2*padding; rects[3].x = Tk_Width(tkwin) - width - padding; rects[3].y = rects[2].y; rects[3].width = width; rects[3].height = rects[2].height; XFillRectangles(Tk_Display(tkwin), drawable, gc, rects, 4); } /* *---------------------------------------------------------------------- * * Tk_DrawFocusHighlight -- * * This procedure draws a rectangular ring around the outside of * a widget to indicate that it has received the input focus. * * This function is now deprecated. Use TkpDrawHighlightBorder instead, * since this function does not handle drawing the Focus ring properly * on the Macintosh - you need to know the background GC as well * as the foreground since the Mac focus ring separated from the widget * by a 1 pixel border. * * Results: * None. * * Side effects: * A rectangle "width" pixels wide is drawn in "drawable", * corresponding to the outer area of "tkwin". * *---------------------------------------------------------------------- */ void Tk_DrawFocusHighlight(tkwin, gc, width, drawable) Tk_Window tkwin; /* Window whose focus highlight ring is * to be drawn. */ GC gc; /* Graphics context to use for drawing * the highlight ring. */ int width; /* Width of the highlight ring, in pixels. */ Drawable drawable; /* Where to draw the ring (typically a * pixmap for double buffering). */ { TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, 0); } /* *---------------------------------------------------------------------- * * Tk_GetScrollInfo -- * * This procedure is invoked to parse "xview" and "yview" * scrolling commands for widgets using the new scrolling * command syntax ("moveto" or "scroll" options). * * Results: * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES, * TK_SCROLL_UNITS, or TK_SCROLL_ERROR. This indicates whether * the command was successfully parsed and what form the command * took. If TK_SCROLL_MOVETO, *dblPtr is filled in with the * desired position; if TK_SCROLL_PAGES or TK_SCROLL_UNITS, * *intPtr is filled in with the number of lines to move (may be * negative); if TK_SCROLL_ERROR, the interp's result contains an * error message. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr) Tcl_Interp *interp; /* Used for error reporting. */ int argc; /* # arguments for command. */ CONST char **argv; /* Arguments for command. */ double *dblPtr; /* Filled in with argument "moveto" * option, if any. */ int *intPtr; /* Filled in with number of pages * or lines to scroll, if any. */ { int c; size_t length; length = strlen(argv[2]); c = argv[2][0]; if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) { if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " moveto fraction\"", (char *) NULL); return TK_SCROLL_ERROR; } if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) { return TK_SCROLL_ERROR; } return TK_SCROLL_MOVETO; } else if ((c == 's') && (strncmp(argv[2], "scroll", length) == 0)) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " scroll number units|pages\"", (char *) NULL); return TK_SCROLL_ERROR; } if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) { return TK_SCROLL_ERROR; } length = strlen(argv[4]); c = argv[4][0]; if ((c == 'p') && (strncmp(argv[4], "pages", length) == 0)) { return TK_SCROLL_PAGES; } else if ((c == 'u') && (strncmp(argv[4], "units", length) == 0)) { return TK_SCROLL_UNITS; } else { Tcl_AppendResult(interp, "bad argument \"", argv[4], "\": must be units or pages", (char *) NULL); return TK_SCROLL_ERROR; } } Tcl_AppendResult(interp, "unknown option \"", argv[2], "\": must be moveto or scroll", (char *) NULL); return TK_SCROLL_ERROR; } /* *---------------------------------------------------------------------- * * Tk_GetScrollInfoObj -- * * This procedure is invoked to parse "xview" and "yview" * scrolling commands for widgets using the new scrolling * command syntax ("moveto" or "scroll" options). * * Results: * The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES, * TK_SCROLL_UNITS, or TK_SCROLL_ERROR. This indicates whether * the command was successfully parsed and what form the command * took. If TK_SCROLL_MOVETO, *dblPtr is filled in with the * desired position; if TK_SCROLL_PAGES or TK_SCROLL_UNITS, * *intPtr is filled in with the number of lines to move (may be * negative); if TK_SCROLL_ERROR, the interp's result contains an * error message. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tk_GetScrollInfoObj(interp, objc, objv, dblPtr, intPtr) Tcl_Interp *interp; /* Used for error reporting. */ int objc; /* # arguments for command. */ Tcl_Obj *CONST objv[]; /* Arguments for command. */ double *dblPtr; /* Filled in with argument "moveto" * option, if any. */ int *intPtr; /* Filled in with number of pages * or lines to scroll, if any. */ { int c; size_t length; char *arg2, *arg4; arg2 = Tcl_GetString(objv[2]); length = strlen(arg2); c = arg2[0]; if ((c == 'm') && (strncmp(arg2, "moveto", length) == 0)) { if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "moveto fraction"); return TK_SCROLL_ERROR; } if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) { return TK_SCROLL_ERROR; } return TK_SCROLL_MOVETO; } else if ((c == 's') && (strncmp(arg2, "scroll", length) == 0)) { if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "scroll number units|pages"); return TK_SCROLL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) { return TK_SCROLL_ERROR; } arg4 = Tcl_GetString(objv[4]); length = (strlen(arg4)); c = arg4[0]; if ((c == 'p') && (strncmp(arg4, "pages", length) == 0)) { return TK_SCROLL_PAGES; } else if ((c == 'u') && (strncmp(arg4, "units", length) == 0)) { return TK_SCROLL_UNITS; } else { Tcl_AppendResult(interp, "bad argument \"", arg4, "\": must be units or pages", (char *) NULL); return TK_SCROLL_ERROR; } } Tcl_AppendResult(interp, "unknown option \"", arg2, "\": must be moveto or scroll", (char *) NULL); return TK_SCROLL_ERROR; } /* *--------------------------------------------------------------------------- * * TkComputeAnchor -- * * Determine where to place a rectangle so that it will be properly * anchored with respect to the given window. Used by widgets * to align a box of text inside a window. When anchoring with * respect to one of the sides, the rectangle be placed inside of * the internal border of the window. * * Results: * *xPtr and *yPtr set to the upper-left corner of the rectangle * anchored in the window. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TkComputeAnchor(anchor, tkwin, padX, padY, innerWidth, innerHeight, xPtr, yPtr) Tk_Anchor anchor; /* Desired anchor. */ Tk_Window tkwin; /* Anchored with respect to this window. */ int padX, padY; /* Use this extra padding inside window, in * addition to the internal border. */ int innerWidth, innerHeight;/* Size of rectangle to anchor in window. */ int *xPtr, *yPtr; /* Returns upper-left corner of anchored * rectangle. */ { switch (anchor) { case TK_ANCHOR_NW: case TK_ANCHOR_W: case TK_ANCHOR_SW: *xPtr = Tk_InternalBorderLeft(tkwin) + padX; break; case TK_ANCHOR_N: case TK_ANCHOR_CENTER: case TK_ANCHOR_S: *xPtr = (Tk_Width(tkwin) - innerWidth) / 2; break; default: *xPtr = Tk_Width(tkwin) - (Tk_InternalBorderRight(tkwin) + padX) - innerWidth; break; } switch (anchor) { case TK_ANCHOR_NW: case TK_ANCHOR_N: case TK_ANCHOR_NE: *yPtr = Tk_InternalBorderTop(tkwin) + padY; break; case TK_ANCHOR_W: case TK_ANCHOR_CENTER: case TK_ANCHOR_E: *yPtr = (Tk_Height(tkwin) - innerHeight) / 2; break; default: *yPtr = Tk_Height(tkwin) - Tk_InternalBorderBottom(tkwin) - padY - innerHeight; break; } } /* *--------------------------------------------------------------------------- * * TkFindStateString -- * * Given a lookup table, map a number to a string in the table. * * Results: * If numKey was equal to the numeric key of one of the elements * in the table, returns the string key of that element. * Returns NULL if numKey was not equal to any of the numeric keys * in the table. * * Side effects. * None. * *--------------------------------------------------------------------------- */ char * TkFindStateString(mapPtr, numKey) CONST TkStateMap *mapPtr; /* The state table. */ int numKey; /* The key to try to find in the table. */ { for ( ; mapPtr->strKey != NULL; mapPtr++) { if (numKey == mapPtr->numKey) { return mapPtr->strKey; } } return NULL; } /* *--------------------------------------------------------------------------- * * TkFindStateNum -- * * Given a lookup table, map a string to a number in the table. * * Results: * If strKey was equal to the string keys of one of the elements * in the table, returns the numeric key of that element. * Returns the numKey associated with the last element (the NULL * string one) in the table if strKey was not equal to any of the * string keys in the table. In that case, an error message is * also left in the interp's result (if interp is not NULL). * * Side effects. * None. * *--------------------------------------------------------------------------- */ int TkFindStateNum(interp, option, mapPtr, strKey) Tcl_Interp *interp; /* Interp for error reporting. */ CONST char *option; /* String to use when constructing error. */ CONST TkStateMap *mapPtr; /* Lookup table. */ CONST char *strKey; /* String to try to find in lookup table. */ { CONST TkStateMap *mPtr; for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) { if (strcmp(strKey, mPtr->strKey) == 0) { return mPtr->numKey; } } if (interp != NULL) { mPtr = mapPtr; Tcl_AppendResult(interp, "bad ", option, " value \"", strKey, "\": must be ", mPtr->strKey, (char *) NULL); for (mPtr++; mPtr->strKey != NULL; mPtr++) { Tcl_AppendResult(interp, ((mPtr[1].strKey != NULL) ? ", " : ", or "), mPtr->strKey, (char *) NULL); } } return mPtr->numKey; } int TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr) Tcl_Interp *interp; /* Interp for error reporting. */ Tcl_Obj *optionPtr; /* String to use when constructing error. */ CONST TkStateMap *mapPtr; /* Lookup table. */ Tcl_Obj *keyPtr; /* String key to find in lookup table. */ { CONST TkStateMap *mPtr; CONST char *key; CONST Tcl_ObjType *typePtr; if ((keyPtr->typePtr == &tkStateKeyObjType) && (keyPtr->internalRep.twoPtrValue.ptr1 == (VOID *) mapPtr)) { return (int) keyPtr->internalRep.twoPtrValue.ptr2; } key = Tcl_GetStringFromObj(keyPtr, NULL); for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) { if (strcmp(key, mPtr->strKey) == 0) { typePtr = keyPtr->typePtr; if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(keyPtr); } keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr; keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey; keyPtr->typePtr = &tkStateKeyObjType; return mPtr->numKey; } } if (interp != NULL) { mPtr = mapPtr; Tcl_AppendResult(interp, "bad ", Tcl_GetStringFromObj(optionPtr, NULL), " value \"", key, "\": must be ", mPtr->strKey, (char *) NULL); for (mPtr++; mPtr->strKey != NULL; mPtr++) { Tcl_AppendResult(interp, ((mPtr[1].strKey != NULL) ? ", " : ", or "), mPtr->strKey, (char *) NULL); } } return mPtr->numKey; } /* * For each exit handler created with a call to TkCreateExitHandler * there is a structure of the following type: */ typedef struct ExitHandler { Tcl_ExitProc *proc; /* Procedure to call when process exits. */ ClientData clientData; /* One word of information to pass to proc. */ struct ExitHandler *nextPtr;/* Next in list of all exit handlers for * this application, or NULL for end of list. */ } ExitHandler; /* * There is both per-process and per-thread exit handlers. * The first list is controlled by a mutex. The other is in * thread local storage. */ static ExitHandler *firstExitPtr = NULL; /* First in list of all exit handlers for * application. */ TCL_DECLARE_MUTEX(exitMutex) /* *--------------------------------------------------------------------------- * * TkCreateExitHandler -- * * Same as Tcl_CreateExitHandler, but private to Tk. * * Results: * None. * * Side effects. * Sets a handler with Tcl_CreateExitHandler if this is the first call. * *--------------------------------------------------------------------------- */ void TkCreateExitHandler (proc, clientData) Tcl_ExitProc *proc; /* Procedure to invoke. */ ClientData clientData; /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr; exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler)); exitPtr->proc = proc; exitPtr->clientData = clientData; Tcl_MutexLock(&exitMutex); if (firstExitPtr == NULL) { Tcl_CreateExitHandler(TkFinalize, NULL); } exitPtr->nextPtr = firstExitPtr; firstExitPtr = exitPtr; Tcl_MutexUnlock(&exitMutex); } /* *--------------------------------------------------------------------------- * * TkDeleteExitHandler -- * * Same as Tcl_DeleteExitHandler, but private to Tk. * * Results: * None. * * Side effects. * None. * *--------------------------------------------------------------------------- */ void TkDeleteExitHandler (proc, clientData) Tcl_ExitProc *proc; /* Procedure that was previously registered. */ ClientData clientData; /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr, *prevPtr; Tcl_MutexLock(&exitMutex); for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL; prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) { if ((exitPtr->proc == proc) && (exitPtr->clientData == clientData)) { if (prevPtr == NULL) { firstExitPtr = exitPtr->nextPtr; } else { prevPtr->nextPtr = exitPtr->nextPtr; } ckfree((char *) exitPtr); break; } } Tcl_MutexUnlock(&exitMutex); return; } /* *--------------------------------------------------------------------------- * * TkFinalize -- * * Runs our private exit handlers and removes itself from Tcl. This is * benificial should we want to protect from dangling pointers should * the Tk shared library be unloaded prior to Tcl which can happen on * windows should the process be forcefully exiting from an exception * handler. * * Results: * None. * * Side effects. * None. * *--------------------------------------------------------------------------- */ void TkFinalize (clientData) ClientData clientData; /* Arbitrary value to pass to proc. */ { ExitHandler *exitPtr; Tcl_DeleteExitHandler(TkFinalize, NULL); Tcl_MutexLock(&exitMutex); for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) { /* * Be careful to remove the handler from the list before * invoking its callback. This protects us against * double-freeing if the callback should call * Tcl_DeleteExitHandler on itself. */ firstExitPtr = exitPtr->nextPtr; Tcl_MutexUnlock(&exitMutex); (*exitPtr->proc)(exitPtr->clientData); ckfree((char *) exitPtr); Tcl_MutexLock(&exitMutex); } firstExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); }