diff options
Diffstat (limited to 'generic/tkObj.c')
| -rw-r--r-- | generic/tkObj.c | 685 |
1 files changed, 417 insertions, 268 deletions
diff --git a/generic/tkObj.c b/generic/tkObj.c index 291c70d..7672240 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -1,13 +1,12 @@ -/* +/* * tkObj.c -- * - * This file contains procedures that implement the common Tk object - * types + * This file contains functions that implement the common Tk object types * * Copyright (c) 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. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tkInt.h" @@ -15,7 +14,7 @@ /* * The following structure is the internal representation for pixel objects. */ - + typedef struct PixelRep { double value; int units; @@ -27,11 +26,11 @@ typedef struct PixelRep { ((objPtr)->internalRep.twoPtrValue.ptr2 == 0) #define SET_SIMPLEPIXEL(objPtr, intval) \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (intval); \ + (objPtr)->internalRep.twoPtrValue.ptr1 = INT2PTR(intval); \ (objPtr)->internalRep.twoPtrValue.ptr2 = 0 #define GET_SIMPLEPIXEL(objPtr) \ - ((int) (objPtr)->internalRep.twoPtrValue.ptr1) + (PTR2INT((objPtr)->internalRep.twoPtrValue.ptr1)) #define SET_COMPLEXPIXEL(objPtr, repPtr) \ (objPtr)->internalRep.twoPtrValue.ptr1 = 0; \ @@ -40,11 +39,24 @@ typedef struct PixelRep { #define GET_COMPLEXPIXEL(objPtr) \ ((PixelRep *) (objPtr)->internalRep.twoPtrValue.ptr2) +/* + * One of these structures is created per thread to store thread-specific + * data. In this case, it is used to contain references to selected + * Tcl_ObjTypes that we can use as screen distances without conversion. The + * "dataKey" below is used to locate the ThreadSpecificData for the current + * thread. + */ + +typedef struct ThreadSpecificData { + const Tcl_ObjType *doubleTypePtr; + const Tcl_ObjType *intTypePtr; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; /* * The following structure is the internal representation for mm objects. */ - + typedef struct MMRep { double value; int units; @@ -54,41 +66,37 @@ typedef struct MMRep { /* * The following structure is the internal representation for window objects. - * A WindowRep caches name-to-window lookups. The cache is invalid - * if tkwin is NULL or if mainPtr->deletionEpoch does not match epoch. + * A WindowRep caches name-to-window lookups. The cache is invalid if tkwin is + * NULL or if mainPtr->deletionEpoch does not match epoch. */ + typedef struct WindowRep { - Tk_Window tkwin; /* Cached window; NULL if not found */ - TkMainInfo *mainPtr; /* MainWindow associated with tkwin */ + Tk_Window tkwin; /* Cached window; NULL if not found. */ + TkMainInfo *mainPtr; /* MainWindow associated with tkwin. */ long epoch; /* Value of mainPtr->deletionEpoch at last - * successful lookup. */ + * successful lookup. */ } WindowRep; /* - * Prototypes for procedures defined later in this file: + * Prototypes for functions defined later in this file: */ -static void DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, - Tcl_Obj *copyPtr)); -static void DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, - Tcl_Obj *copyPtr)); -static void DupWindowInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, - Tcl_Obj *copyPtr)); -static void FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); -static void FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); -static void FreeWindowInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); -static void UpdateStringOfMM _ANSI_ARGS_((Tcl_Obj *objPtr)); -static int SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr)); -static int SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr)); -static int SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr)); +static void DupMMInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void DupPixelInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void DupWindowInternalRep(Tcl_Obj *srcPtr,Tcl_Obj *copyPtr); +static void FreeMMInternalRep(Tcl_Obj *objPtr); +static void FreePixelInternalRep(Tcl_Obj *objPtr); +static void FreeWindowInternalRep(Tcl_Obj *objPtr); +static ThreadSpecificData *GetTypeCache(void); +static void UpdateStringOfMM(Tcl_Obj *objPtr); +static int SetMMFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static int SetPixelFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static int SetWindowFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); /* - * The following structure defines the implementation of the "pixel" - * Tcl object, used for measuring distances. The pixel object remembers - * its initial display-independant settings. + * The following structure defines the implementation of the "pixel" Tcl + * object, used for measuring distances. The pixel object remembers its + * initial display-independant settings. */ static Tcl_ObjType pixelObjType = { @@ -100,9 +108,9 @@ static Tcl_ObjType pixelObjType = { }; /* - * The following structure defines the implementation of the "pixel" - * Tcl object, used for measuring distances. The pixel object remembers - * its initial display-independant settings. + * The following structure defines the implementation of the "pixel" Tcl + * object, used for measuring distances. The pixel object remembers its + * initial display-independant settings. */ static Tcl_ObjType mmObjType = { @@ -119,23 +127,46 @@ static Tcl_ObjType mmObjType = { */ static Tcl_ObjType windowObjType = { - "window", /* name */ - FreeWindowInternalRep, /* freeIntRepProc */ - DupWindowInternalRep, /* dupIntRepProc */ - NULL, /* updateStringProc */ - SetWindowFromAny /* setFromAnyProc */ + "window", /* name */ + FreeWindowInternalRep, /* freeIntRepProc */ + DupWindowInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + SetWindowFromAny /* setFromAnyProc */ }; + +/* + *---------------------------------------------------------------------- + * + * GetTypeCache -- + * + * Get (and build if necessary) the cache of useful Tcl object types for + * comparisons in the conversion functions. This allows optimized checks + * for standard cases. + * + *---------------------------------------------------------------------- + */ +static ThreadSpecificData * +GetTypeCache() +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + if (tsdPtr->doubleTypePtr == NULL) { + tsdPtr->doubleTypePtr = Tcl_GetObjType("double"); + tsdPtr->intTypePtr = Tcl_GetObjType("int"); + } + return tsdPtr; +} /* *---------------------------------------------------------------------- * - * Tk_GetPixelsFromObj -- + * GetPixelsFromObjEx -- * * Attempt to return a pixel value from the Tcl object "objPtr". If the - * object is not already a pixel value, an attempt will be made to convert - * it to one. + * object is not already a pixel value, an attempt will be made to + * convert it to one. * * Results: * The return value is a standard Tcl object result. If an error occurs @@ -143,51 +174,94 @@ static Tcl_ObjType windowObjType = { * result unless "interp" is NULL. * * Side effects: - * If the object is not already a pixel, the conversion will free - * any old internal representation. + * If the object is not already a pixel, the conversion will free any old + * internal representation. * *---------------------------------------------------------------------- */ +static int -Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tk_Window tkwin; - Tcl_Obj *objPtr; /* The object from which to get pixels. */ - int *intPtr; /* Place to store resulting pixels. */ +GetPixelsFromObjEx( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tk_Window tkwin, + Tcl_Obj *objPtr, /* The object from which to get pixels. */ + int *intPtr, + double *dblPtr) /* Places to store resulting pixels. */ { - int result; + int result,fresh; double d; PixelRep *pixelPtr; static double bias[] = { - 1.0, 10.0, 25.4, 25.4 / 72.0 + 1.0, 10.0, 25.4, 0.35278 /*25.4 / 72.0*/ }; + /* + * Special hacks where the type of the object is known to be something + * that is just numeric and cannot require distance conversion. This pokes + * holes in Tcl's abstractions, but they are just for optimization, not + * semantics. + */ + + if (objPtr->typePtr != &pixelObjType) { + ThreadSpecificData *tsdPtr = GetTypeCache(); + + if (objPtr->typePtr == tsdPtr->doubleTypePtr) { + (void) Tcl_GetDoubleFromObj(interp, objPtr, &d); + if (dblPtr != NULL) { + *dblPtr = d; + } + *intPtr = (int) (d<0 ? d-0.5 : d+0.5); + return TCL_OK; + } else if (objPtr->typePtr == tsdPtr->intTypePtr) { + (void) Tcl_GetIntFromObj(interp, objPtr, intPtr); + if (dblPtr) { + *dblPtr = (double) (*intPtr); + } + return TCL_OK; + } + } + + retry: if (objPtr->typePtr != &pixelObjType) { result = SetPixelFromAny(interp, objPtr); if (result != TCL_OK) { return result; } + fresh = 1; + } else { + fresh = 0; } if (SIMPLE_PIXELREP(objPtr)) { *intPtr = GET_SIMPLEPIXEL(objPtr); + if (dblPtr) { + *dblPtr = (double) (*intPtr); + } } else { pixelPtr = GET_COMPLEXPIXEL(objPtr); - if (pixelPtr->tkwin != tkwin) { + if ((!fresh) && (pixelPtr->tkwin != tkwin)) { + /* + * In case of exo-screen conversions of non-pixels we force a + * recomputation from the string. + */ + + FreePixelInternalRep(objPtr); + goto retry; + } + if ((pixelPtr->tkwin != tkwin)||dblPtr) { d = pixelPtr->value; if (pixelPtr->units >= 0) { d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin)); d /= WidthMMOfScreen(Tk_Screen(tkwin)); } - if (d < 0) { - pixelPtr->returnValue = (int) (d - 0.5); - } else { - pixelPtr->returnValue = (int) (d + 0.5); - } + pixelPtr->returnValue = (int) (d<0 ? d-0.5 : d+0.5); pixelPtr->tkwin = tkwin; + if (dblPtr) { + *dblPtr = d; + } } - *intPtr = pixelPtr->returnValue; + *intPtr = pixelPtr->returnValue; } return TCL_OK; } @@ -195,6 +269,88 @@ Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr) /* *---------------------------------------------------------------------- * + * Tk_GetPixelsFromObj -- + * + * Attempt to return a pixel value from the Tcl object "objPtr". If the + * object is not already a pixel value, an attempt will be made to + * convert it to one. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If the object is not already a pixel, the conversion will free any old + * internal representation. + * + *---------------------------------------------------------------------- + */ + +int +Tk_GetPixelsFromObj( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tk_Window tkwin, + Tcl_Obj *objPtr, /* The object from which to get pixels. */ + int *intPtr) /* Place to store resulting pixels. */ +{ + return GetPixelsFromObjEx(interp,tkwin,objPtr,intPtr,NULL); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_GetDoublePixelsFromObj -- + * + * Attempt to return a double pixel value from the Tcl object + * "objPtr". If the object is not already a pixel value, an attempt will + * be made to convert it to one, the internal unit being pixels. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If the object is not already a pixel, the conversion will free any old + * internal representation. + * + *---------------------------------------------------------------------- + */ + +int +Tk_GetDoublePixelsFromObj( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tk_Window tkwin, + Tcl_Obj *objPtr, /* The object from which to get pixels. */ + double *doublePtr) /* Place to store resulting pixels. */ +{ + double d; + int result,val; + + result = GetPixelsFromObjEx(interp, tkwin, objPtr, &val, &d); + if (result != TCL_OK) { + return result; + } + if (objPtr->typePtr == &pixelObjType && !SIMPLE_PIXELREP(objPtr)) { + PixelRep *pixelPtr = GET_COMPLEXPIXEL(objPtr); + + if (pixelPtr->units >= 0) { + /* + * Internally "shimmer" to pixel units. + */ + + pixelPtr->units = -1; + pixelPtr->value = d; + } + } + *doublePtr = d; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * FreePixelInternalRep -- * * Deallocate the storage associated with a pixel object's internal @@ -204,20 +360,19 @@ Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr) * None. * * Side effects: - * Frees objPtr's internal representation and sets objPtr's - * internalRep to NULL. + * Frees objPtr's internal representation and sets objPtr's internalRep + * to NULL. * *---------------------------------------------------------------------- */ static void -FreePixelInternalRep(objPtr) - Tcl_Obj *objPtr; /* Pixel object with internal rep to free. */ +FreePixelInternalRep( + Tcl_Obj *objPtr) /* Pixel object with internal rep to free. */ { - PixelRep *pixelPtr; - if (!SIMPLE_PIXELREP(objPtr)) { - pixelPtr = GET_COMPLEXPIXEL(objPtr); + PixelRep *pixelPtr = GET_COMPLEXPIXEL(objPtr); + ckfree((char *) pixelPtr); } SET_SIMPLEPIXEL(objPtr, 0); @@ -229,31 +384,31 @@ FreePixelInternalRep(objPtr) * * DupPixelInternalRep -- * - * Initialize the internal representation of a pixel Tcl_Obj to a - * copy of the internal representation of an existing pixel object. + * Initialize the internal representation of a pixel Tcl_Obj to a copy of + * the internal representation of an existing pixel object. * * Results: * None. * * Side effects: - * copyPtr's internal rep is set to the pixel corresponding to - * srcPtr's internal rep. + * copyPtr's internal rep is set to the pixel corresponding to srcPtr's + * internal rep. * *---------------------------------------------------------------------- */ static void -DupPixelInternalRep(srcPtr, copyPtr) - register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ - register Tcl_Obj *copyPtr; /* Object with internal rep to set. */ +DupPixelInternalRep( + register Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ + register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - PixelRep *oldPtr, *newPtr; - copyPtr->typePtr = srcPtr->typePtr; if (SIMPLE_PIXELREP(srcPtr)) { SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr)); } else { + PixelRep *oldPtr, *newPtr; + oldPtr = GET_COMPLEXPIXEL(srcPtr); newPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); newPtr->value = oldPtr->value; @@ -269,8 +424,7 @@ DupPixelInternalRep(srcPtr, copyPtr) * * SetPixelFromAny -- * - * Attempt to generate a pixel internal form for the Tcl object - * "objPtr". + * Attempt to generate a pixel internal form for the Tcl object "objPtr". * * Results: * The return value is a standard Tcl result. If an error occurs during @@ -278,70 +432,54 @@ DupPixelInternalRep(srcPtr, copyPtr) * unless "interp" is NULL. * * Side effects: - * If no error occurs, a pixel representation of the object is - * stored internally and the type of "objPtr" is set to pixel. + * If no error occurs, a pixel representation of the object is stored + * internally and the type of "objPtr" is set to pixel. * *---------------------------------------------------------------------- */ static int -SetPixelFromAny(interp, objPtr) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr; /* The object to convert. */ +SetPixelFromAny( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_ObjType *typePtr; + const Tcl_ObjType *typePtr; char *string, *rest; double d; int i, units; - PixelRep *pixelPtr; string = Tcl_GetStringFromObj(objPtr, NULL); d = strtod(string, &rest); if (rest == string) { - /* - * Must copy string before resetting the result in case a caller - * is trying to convert the interpreter's result to pixels. - */ - - char buf[100]; - - error: - sprintf(buf, "bad screen distance \"%.50s\"", string); - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, buf, NULL); - return TCL_ERROR; + goto error; } while ((*rest != '\0') && isspace(UCHAR(*rest))) { rest++; } - switch (*rest) { - case '\0': - units = -1; - break; - case 'm': - units = 0; - break; - - case 'c': - units = 1; - break; - - case 'i': - units = 2; - break; - - case 'p': - units = 3; - break; - - default: - goto error; + switch (*rest) { + case '\0': + units = -1; + break; + case 'm': + units = 0; + break; + case 'c': + units = 1; + break; + case 'i': + units = 2; + break; + case 'p': + units = 3; + break; + default: + goto error; } /* - * Free the old internalRep before setting the new one. + * Free the old internalRep before setting the new one. */ typePtr = objPtr->typePtr; @@ -355,7 +493,8 @@ SetPixelFromAny(interp, objPtr) if ((units < 0) && (i == d)) { SET_SIMPLEPIXEL(objPtr, i); } else { - pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); + PixelRep *pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep)); + pixelPtr->value = d; pixelPtr->units = units; pixelPtr->tkwin = NULL; @@ -363,6 +502,21 @@ SetPixelFromAny(interp, objPtr) SET_COMPLEXPIXEL(objPtr, pixelPtr); } return TCL_OK; + + error: + if (interp != NULL) { + /* + * Must copy string before resetting the result in case a caller is + * trying to convert the interpreter's result to pixels. + */ + + char buf[100]; + + sprintf(buf, "bad screen distance \"%.50s\"", string); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, buf, NULL); + } + return TCL_ERROR; } /* @@ -380,24 +534,24 @@ SetPixelFromAny(interp, objPtr) * result unless "interp" is NULL. * * Side effects: - * If the object is not already a pixel, the conversion will free - * any old internal representation. + * If the object is not already a pixel, the conversion will free any old + * internal representation. * *---------------------------------------------------------------------- */ int -Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tk_Window tkwin; - Tcl_Obj *objPtr; /* The object from which to get mms. */ - double *doublePtr; /* Place to store resulting millimeters. */ +Tk_GetMMFromObj( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tk_Window tkwin, + Tcl_Obj *objPtr, /* The object from which to get mms. */ + double *doublePtr) /* Place to store resulting millimeters. */ { int result; double d; MMRep *mmPtr; static double bias[] = { - 10.0, 25.4, 1.0, 25.4 / 72.0 + 10.0, 25.4, 1.0, 0.35278 /*25.4 / 72.0*/ }; if (objPtr->typePtr != &mmObjType) { @@ -436,15 +590,15 @@ Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr) * None. * * Side effects: - * Frees objPtr's internal representation and sets objPtr's - * internalRep to NULL. + * Frees objPtr's internal representation and sets objPtr's internalRep + * to NULL. * *---------------------------------------------------------------------- */ static void -FreeMMInternalRep(objPtr) - Tcl_Obj *objPtr; /* MM object with internal rep to free. */ +FreeMMInternalRep( + Tcl_Obj *objPtr) /* MM object with internal rep to free. */ { ckfree((char *) objPtr->internalRep.otherValuePtr); objPtr->internalRep.otherValuePtr = NULL; @@ -456,26 +610,26 @@ FreeMMInternalRep(objPtr) * * DupMMInternalRep -- * - * Initialize the internal representation of a pixel Tcl_Obj to a - * copy of the internal representation of an existing pixel object. + * Initialize the internal representation of a pixel Tcl_Obj to a copy of + * the internal representation of an existing pixel object. * * Results: * None. * * Side effects: - * copyPtr's internal rep is set to the pixel corresponding to - * srcPtr's internal rep. + * copyPtr's internal rep is set to the pixel corresponding to srcPtr's + * internal rep. * *---------------------------------------------------------------------- */ static void -DupMMInternalRep(srcPtr, copyPtr) - register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */ - register Tcl_Obj *copyPtr; /* Object with internal rep to set. */ +DupMMInternalRep( + register Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ + register Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { MMRep *oldPtr, *newPtr; - + copyPtr->typePtr = srcPtr->typePtr; oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr; newPtr = (MMRep *) ckalloc(sizeof(MMRep)); @@ -491,24 +645,23 @@ DupMMInternalRep(srcPtr, copyPtr) * * UpdateStringOfMM -- * - * Update the string representation for a pixel Tcl_Obj - * this function is only called, if the pixel Tcl_Obj has no unit, - * because with units the string representation is created by - * SetMMFromAny + * Update the string representation for a pixel Tcl_Obj this function is + * only called, if the pixel Tcl_Obj has no unit, because with units the + * string representation is created by SetMMFromAny * * Results: - * None. + * None. * * Side effects: - * The object's string is set to a valid string that results from - * the double-to-string conversion. + * The object's string is set to a valid string that results from the + * double-to-string conversion. * *---------------------------------------------------------------------- */ static void -UpdateStringOfMM(objPtr) - register Tcl_Obj *objPtr; /* pixel obj with string rep to update. */ +UpdateStringOfMM( + register Tcl_Obj *objPtr) /* pixel obj with string rep to update. */ { MMRep *mmPtr; char buffer[TCL_DOUBLE_SPACE]; @@ -517,11 +670,11 @@ UpdateStringOfMM(objPtr) mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr; /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */ if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) { - panic("UpdateStringOfMM: false precondition"); + Tcl_Panic("UpdateStringOfMM: false precondition"); } - Tcl_PrintDouble((Tcl_Interp *) NULL, mmPtr->value, buffer); - len = strlen(buffer); + Tcl_PrintDouble(NULL, mmPtr->value, buffer); + len = (int)strlen(buffer); objPtr->bytes = (char *) ckalloc((unsigned) len + 1); strcpy(objPtr->bytes, buffer); @@ -533,8 +686,7 @@ UpdateStringOfMM(objPtr) * * SetMMFromAny -- * - * Attempt to generate a mm internal form for the Tcl object - * "objPtr". + * Attempt to generate a mm internal form for the Tcl object "objPtr". * * Results: * The return value is a standard Tcl result. If an error occurs during @@ -542,49 +694,38 @@ UpdateStringOfMM(objPtr) * unless "interp" is NULL. * * Side effects: - * If no error occurs, a mm representation of the object is - * stored internally and the type of "objPtr" is set to mm. + * If no error occurs, a mm representation of the object is stored + * internally and the type of "objPtr" is set to mm. * *---------------------------------------------------------------------- */ static int -SetMMFromAny(interp, objPtr) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr; /* The object to convert. */ +SetMMFromAny( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_ObjType *typePtr; + ThreadSpecificData *tsdPtr = GetTypeCache(); + const Tcl_ObjType *typePtr; char *string, *rest; double d; int units; MMRep *mmPtr; - static Tcl_ObjType *tclDoubleObjType = NULL; - static Tcl_ObjType *tclIntObjType = NULL; - - if (tclDoubleObjType == NULL) { - /* - * Cache the object types for comaprison below. - * This allows optimized checks for standard cases. - */ - - tclDoubleObjType = Tcl_GetObjType("double"); - tclIntObjType = Tcl_GetObjType("int"); - } - - if (objPtr->typePtr == tclDoubleObjType) { + if (objPtr->typePtr == tsdPtr->doubleTypePtr) { Tcl_GetDoubleFromObj(interp, objPtr, &d); units = -1; - } else if (objPtr->typePtr == tclIntObjType) { + } else if (objPtr->typePtr == tsdPtr->intTypePtr) { Tcl_GetIntFromObj(interp, objPtr, &units); d = (double) units; units = -1; /* - * In the case of ints, we need to ensure that a valid - * string exists in order for int-but-not-string objects - * to be converted back to ints again from mm obj types. + * In the case of ints, we need to ensure that a valid string exists + * in order for int-but-not-string objects to be converted back to + * ints again from mm obj types. */ + (void) Tcl_GetStringFromObj(objPtr, NULL); } else { /* @@ -600,42 +741,38 @@ SetMMFromAny(interp, objPtr) * is trying to convert the interpreter's result to mms. */ - error: - Tcl_AppendResult(interp, "bad screen distance \"", string, - "\"", (char *) NULL); - return TCL_ERROR; - } - while ((*rest != '\0') && isspace(UCHAR(*rest))) { - rest++; - } - switch (*rest) { - case '\0': - units = -1; - break; - - case 'c': - units = 0; - break; - - case 'i': - units = 1; - break; - - case 'm': - units = 2; - break; - - case 'p': - units = 3; - break; - - default: - goto error; + error: + Tcl_AppendResult(interp, "bad screen distance \"", string, + "\"", NULL); + return TCL_ERROR; + } + while ((*rest != '\0') && isspace(UCHAR(*rest))) { + rest++; + } + + switch (*rest) { + case '\0': + units = -1; + break; + case 'c': + units = 0; + break; + case 'i': + units = 1; + break; + case 'm': + units = 2; + break; + case 'p': + units = 3; + break; + default: + goto error; } } /* - * Free the old internalRep before setting the new one. + * Free the old internalRep before setting the new one. */ typePtr = objPtr->typePtr; @@ -671,18 +808,18 @@ SetMMFromAny(interp, objPtr) * result unless "interp" is NULL. * * Side effects: - * If the object is not already a Tk_Window, the conversion will free - * any old internal representation. + * If the object is not already a Tk_Window, the conversion will free any + * old internal representation. * *---------------------------------------------------------------------- */ int -TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - Tk_Window tkwin; /* A token to get the main window from. */ - Tcl_Obj *objPtr; /* The object from which to get window. */ - Tk_Window *windowPtr; /* Place to store resulting window. */ +TkGetWindowFromObj( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tk_Window tkwin, /* A token to get the main window from. */ + Tcl_Obj *objPtr, /* The object from which to get window. */ + Tk_Window *windowPtr) /* Place to store resulting window. */ { TkMainInfo *mainPtr = ((TkWindow *)tkwin)->mainPtr; register WindowRep *winPtr; @@ -696,11 +833,13 @@ TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr) winPtr = (WindowRep *) objPtr->internalRep.otherValuePtr; if ( winPtr->tkwin == NULL || winPtr->mainPtr == NULL - || winPtr->mainPtr != mainPtr - || winPtr->epoch != mainPtr->deletionEpoch) + || winPtr->mainPtr != mainPtr + || winPtr->epoch != mainPtr->deletionEpoch) { - /* Cache is invalid. + /* + * Cache is invalid. */ + winPtr->tkwin = Tk_NameToWindow(interp, Tcl_GetStringFromObj(objPtr, NULL), tkwin); winPtr->mainPtr = mainPtr; @@ -720,14 +859,15 @@ TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr) *---------------------------------------------------------------------- * * SetWindowFromAny -- + * * Generate a windowObj internal form for the Tcl object "objPtr". * * Results: - * Always returns TCL_OK. + * Always returns TCL_OK. * * Side effects: - * Sets objPtr's internal representation to an uninitialized - * windowObj. Frees the old internal representation, if any. + * Sets objPtr's internal representation to an uninitialized windowObj. + * Frees the old internal representation, if any. * * See also: * TkGetWindowFromObj, which initializes the WindowRep cache. @@ -736,15 +876,15 @@ TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr) */ static int -SetWindowFromAny(interp, objPtr) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr; /* The object to convert. */ +SetWindowFromAny( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + register Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_ObjType *typePtr; + const Tcl_ObjType *typePtr; WindowRep *winPtr; /* - * Free the old internalRep before setting the new one. + * Free the old internalRep before setting the new one. */ Tcl_GetStringFromObj(objPtr, NULL); @@ -769,23 +909,23 @@ SetWindowFromAny(interp, objPtr) * * DupWindowInternalRep -- * - * Initialize the internal representation of a window Tcl_Obj to a - * copy of the internal representation of an existing window object. + * Initialize the internal representation of a window Tcl_Obj to a copy + * of the internal representation of an existing window object. * * Results: * None. * * Side effects: - * copyPtr's internal rep is set to refer to the same window as - * srcPtr's internal rep. + * copyPtr's internal rep is set to refer to the same window as srcPtr's + * internal rep. * *---------------------------------------------------------------------- */ static void -DupWindowInternalRep(srcPtr, copyPtr) - register Tcl_Obj *srcPtr; - register Tcl_Obj *copyPtr; +DupWindowInternalRep( + register Tcl_Obj *srcPtr, + register Tcl_Obj *copyPtr) { register WindowRep *oldPtr, *newPtr; @@ -810,15 +950,15 @@ DupWindowInternalRep(srcPtr, copyPtr) * None. * * Side effects: - * Frees objPtr's internal representation and sets objPtr's - * internalRep to NULL. + * Frees objPtr's internal representation and sets objPtr's internalRep + * to NULL. * *---------------------------------------------------------------------- */ static void -FreeWindowInternalRep(objPtr) - Tcl_Obj *objPtr; /* Window object with internal rep to free. */ +FreeWindowInternalRep( + Tcl_Obj *objPtr) /* Window object with internal rep to free. */ { ckfree((char *) objPtr->internalRep.otherValuePtr); objPtr->internalRep.otherValuePtr = NULL; @@ -830,39 +970,39 @@ FreeWindowInternalRep(objPtr) * * TkParsePadAmount -- * - * This procedure parses a padding specification and returns - * the appropriate padding values. A padding specification can - * be either a single pixel width, or a list of two pixel widths. - * If a single pixel width, the amount specified is used for - * padding on both sides. If two amounts are specified, then - * they specify the left/right or top/bottom padding. + * This function parses a padding specification and returns the + * appropriate padding values. A padding specification can be either a + * single pixel width, or a list of two pixel widths. If a single pixel + * width, the amount specified is used for padding on both sides. If two + * amounts are specified, then they specify the left/right or top/bottom + * padding. * * Results: * A standard Tcl return value. * * Side effects: - * An error message is written to the interpreter is something - * is not right. + * An error message is written to the interpreter if something is not + * right. * *-------------------------------------------------------------- */ int -TkParsePadAmount(interp, tkwin, specObj, halfPtr, allPtr) - Tcl_Interp *interp; /* Interpreter for error reporting. */ - Tk_Window tkwin; /* A window. Needed by Tk_GetPixels() */ - Tcl_Obj *specObj; /* The argument to "-padx", "-pady", "-ipadx", - * or "-ipady". The thing to be parsed. */ - int *halfPtr; /* Write the left/top part of padding here */ - int *allPtr; /* Write the total padding here */ +TkParsePadAmount( + Tcl_Interp *interp, /* Interpreter for error reporting. */ + Tk_Window tkwin, /* A window. Needed by Tk_GetPixels() */ + Tcl_Obj *specObj, /* The argument to "-padx", "-pady", "-ipadx", + * or "-ipady". The thing to be parsed. */ + int *halfPtr, /* Write the left/top part of padding here */ + int *allPtr) /* Write the total padding here */ { int firstInt, secondInt; /* The two components of the padding */ int objc; /* The length of the list (should be 1 or 2) */ Tcl_Obj **objv; /* The objects in the list */ /* - * Check for a common case where a single object would otherwise - * be shimmered between a list and a pixel spec. + * Check for a common case where a single object would otherwise be + * shimmered between a list and a pixel spec. */ if (specObj->typePtr == &pixelObjType) { @@ -870,7 +1010,7 @@ TkParsePadAmount(interp, tkwin, specObj, halfPtr, allPtr) Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(specObj), - "\": must be positive screen distance", (char *) NULL); + "\": must be positive screen distance", NULL); return TCL_ERROR; } secondInt = firstInt; @@ -878,8 +1018,8 @@ TkParsePadAmount(interp, tkwin, specObj, halfPtr, allPtr) } /* - * Pad specifications are a list of one or two elements, each of - * which is a pixel specification. + * Pad specifications are a list of one or two elements, each of which is + * a pixel specification. */ if (Tcl_ListObjGetElements(interp, specObj, &objc, &objv) != TCL_OK) { @@ -899,13 +1039,13 @@ TkParsePadAmount(interp, tkwin, specObj, halfPtr, allPtr) (firstInt < 0)) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad pad value \"", Tcl_GetString(objv[0]), - "\": must be positive screen distance", (char *) NULL); + "\": must be positive screen distance", NULL); return TCL_ERROR; } /* - * Parse the second part if it exists, otherwise it is as if it - * was the same as the first part. + * Parse the second part if it exists, otherwise it is as if it was the + * same as the first part. */ if (objc == 1) { @@ -915,7 +1055,7 @@ TkParsePadAmount(interp, tkwin, specObj, halfPtr, allPtr) Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad 2nd pad value \"", Tcl_GetString(objv[1]), - "\": must be positive screen distance", (char *) NULL); + "\": must be positive screen distance", NULL); return TCL_ERROR; } @@ -942,14 +1082,14 @@ TkParsePadAmount(interp, tkwin, specObj, halfPtr, allPtr) * None * * Side effects: - * All instances of Tcl_ObjType structues used in Tk are registered - * with Tcl. + * All instances of Tcl_ObjType structues used in Tk are registered with + * Tcl. * *---------------------------------------------------------------------- */ void -TkRegisterObjTypes() +TkRegisterObjTypes(void) { Tcl_RegisterObjType(&tkBorderObjType); Tcl_RegisterObjType(&tkBitmapObjType); @@ -961,4 +1101,13 @@ TkRegisterObjTypes() Tcl_RegisterObjType(&pixelObjType); Tcl_RegisterObjType(&tkStateKeyObjType); Tcl_RegisterObjType(&windowObjType); + Tcl_RegisterObjType(&tkTextIndexType); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |