diff options
Diffstat (limited to 'generic/tkObj.c')
| -rw-r--r-- | generic/tkObj.c | 594 |
1 files changed, 345 insertions, 249 deletions
diff --git a/generic/tkObj.c b/generic/tkObj.c index 83faa27..c425864 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -1,15 +1,14 @@ -/* +/* * 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. * - * RCS: @(#) $Id: tkObj.c,v 1.8.2.2 2005/01/11 16:05:16 dkf Exp $ + * RCS: @(#) $Id: tkObj.c,v 1.19.2.1 2008/12/21 23:52:45 ferrieux Exp $ */ #include "tkInt.h" @@ -17,7 +16,7 @@ /* * The following structure is the internal representation for pixel objects. */ - + typedef struct PixelRep { double value; int units; @@ -29,11 +28,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; \ @@ -46,7 +45,7 @@ typedef struct PixelRep { /* * The following structure is the internal representation for mm objects. */ - + typedef struct MMRep { double value; int units; @@ -56,41 +55,36 @@ 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 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 = { @@ -102,9 +96,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 = { @@ -121,23 +115,21 @@ 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 */ }; - - /* *---------------------------------------------------------------------- * - * 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 @@ -145,38 +137,56 @@ 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*/ }; + 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)); @@ -188,9 +198,91 @@ Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr) pixelPtr->returnValue = (int) (d + 0.5); } pixelPtr->tkwin = tkwin; + if (dblPtr) { + *dblPtr=(double)d; + } + } + *intPtr = pixelPtr->returnValue; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * 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 (!SIMPLE_PIXELREP(objPtr)) { + PixelRep *pixelPtr; + pixelPtr = GET_COMPLEXPIXEL(objPtr); + if (pixelPtr->units >= 0) { + /* internally "shimmer" to pixel units */ + pixelPtr->units=-1; + pixelPtr->value=d; } - *intPtr = pixelPtr->returnValue; } + *doublePtr = d; return TCL_OK; } @@ -206,18 +298,18 @@ 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); ckfree((char *) pixelPtr); @@ -231,26 +323,26 @@ 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)) { @@ -271,8 +363,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 @@ -280,70 +371,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; @@ -357,7 +432,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; @@ -365,6 +441,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; } /* @@ -382,24 +473,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) { @@ -438,15 +529,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; @@ -458,26 +549,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)); @@ -493,24 +584,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]; @@ -519,11 +609,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); @@ -535,8 +625,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 @@ -544,30 +633,30 @@ 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; + const Tcl_ObjType *typePtr; char *string, *rest; double d; int units; MMRep *mmPtr; - static Tcl_ObjType *tclDoubleObjType = NULL; - static Tcl_ObjType *tclIntObjType = NULL; + static const Tcl_ObjType *tclDoubleObjType = NULL; + static const Tcl_ObjType *tclIntObjType = NULL; if (tclDoubleObjType == NULL) { /* - * Cache the object types for comaprison below. - * This allows optimized checks for standard cases. + * Cache the object types for comaprison below. This allows optimized + * checks for standard cases. */ tclDoubleObjType = Tcl_GetObjType("double"); @@ -583,10 +672,11 @@ SetMMFromAny(interp, objPtr) 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 { /* @@ -602,42 +692,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; @@ -673,18 +759,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; @@ -698,8 +784,8 @@ 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. */ @@ -722,14 +808,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. @@ -738,15 +825,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); @@ -771,23 +858,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; @@ -812,15 +899,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; @@ -832,31 +919,31 @@ 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) */ @@ -872,7 +959,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; @@ -880,8 +967,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) { @@ -901,13 +988,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) { @@ -917,7 +1004,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; } @@ -944,14 +1031,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); @@ -963,4 +1050,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: + */ |