From 0494d6ea369901955402d84ce76a13ddc200957f Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 15 Aug 2001 15:44:35 +0000 Subject: Register Tk's object types with Tcl (Tcl Bug 450545) --- ChangeLog | 10 ++++++++++ generic/tk3d.c | 10 +++++----- generic/tkBitmap.c | 10 +++++----- generic/tkColor.c | 10 +++++----- generic/tkConfig.c | 8 ++++---- generic/tkCursor.c | 10 +++++----- generic/tkFont.c | 12 ++++++------ generic/tkInt.h | 17 ++++++++++++++++- generic/tkObj.c | 34 +++++++++++++++++++++++++++++++++- generic/tkUtil.c | 8 ++++---- generic/tkWindow.c | 7 ++++++- 11 files changed, 99 insertions(+), 37 deletions(-) diff --git a/ChangeLog b/ChangeLog index 30484de..e608e1b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2001-08-14 Donal K. Fellows + + * generic/tk{Util,Font,Cursor,Color,Bitmap,3d}.c: Modified + objtype declarations so that they can be picked up in tkObj.c and + the names are now prefixed with "tk" too. + * generic/tkObj.c (TkRegisterObjTypes): + * generic/tkWindow.c (Initialize): + * generic/tkInt.h: Added code to register Tk's object types with + the Tcl runtime. [Tcl Bug 450545] + 2001-08-12 Mo DeJong * unix/configure: Regen. diff --git a/generic/tk3d.c b/generic/tk3d.c index e6ba11a..4106745 100644 --- a/generic/tk3d.c +++ b/generic/tk3d.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tk3d.c,v 1.10 2000/05/17 21:17:20 ericm Exp $ + * RCS: @(#) $Id: tk3d.c,v 1.11 2001/08/15 15:44:35 dkf Exp $ */ #include "tk3d.h" @@ -46,7 +46,7 @@ static void ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr, * is set. */ -static Tcl_ObjType borderObjType = { +Tcl_ObjType tkBorderObjType = { "border", /* name */ FreeBorderObjProc, /* freeIntRepProc */ DupBorderObjProc, /* dupIntRepProc */ @@ -87,7 +87,7 @@ Tk_Alloc3DBorderFromObj(interp, tkwin, objPtr) { TkBorder *borderPtr; - if (objPtr->typePtr != &borderObjType) { + if (objPtr->typePtr != &tkBorderObjType) { InitBorderObj(objPtr); } borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1; @@ -1263,7 +1263,7 @@ Tk_Get3DBorderFromObj(tkwin, objPtr) Tcl_HashEntry *hashPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (objPtr->typePtr != &borderObjType) { + if (objPtr->typePtr != &tkBorderObjType) { InitBorderObj(objPtr); } @@ -1356,7 +1356,7 @@ InitBorderObj(objPtr) if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(objPtr); } - objPtr->typePtr = &borderObjType; + objPtr->typePtr = &tkBorderObjType; objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; } diff --git a/generic/tkBitmap.c b/generic/tkBitmap.c index a47d10d..fc445f6 100644 --- a/generic/tkBitmap.c +++ b/generic/tkBitmap.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkBitmap.c,v 1.8 2000/09/30 18:46:03 drh Exp $ + * RCS: @(#) $Id: tkBitmap.c,v 1.9 2001/08/15 15:44:36 dkf Exp $ */ #include "tkPort.h" @@ -125,7 +125,7 @@ static void InitBitmapObj _ANSI_ARGS_((Tcl_Obj *objPtr)); * ptr1 field of the Tcl_Obj points to a TkBitmap object. */ -static Tcl_ObjType bitmapObjType = { +Tcl_ObjType tkBitmapObjType = { "bitmap", /* name */ FreeBitmapObjProc, /* freeIntRepProc */ DupBitmapObjProc, /* dupIntRepProc */ @@ -168,7 +168,7 @@ Tk_AllocBitmapFromObj(interp, tkwin, objPtr) { TkBitmap *bitmapPtr; - if (objPtr->typePtr != &bitmapObjType) { + if (objPtr->typePtr != &tkBitmapObjType) { InitBitmapObj(objPtr); } bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1; @@ -900,7 +900,7 @@ GetBitmapFromObj(tkwin, objPtr) Tcl_HashEntry *hashPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (objPtr->typePtr != &bitmapObjType) { + if (objPtr->typePtr != &tkBitmapObjType) { InitBitmapObj(objPtr); } @@ -975,7 +975,7 @@ InitBitmapObj(objPtr) if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(objPtr); } - objPtr->typePtr = &bitmapObjType; + objPtr->typePtr = &tkBitmapObjType; objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; } diff --git a/generic/tkColor.c b/generic/tkColor.c index 6c4d4e5..7a9ced2 100644 --- a/generic/tkColor.c +++ b/generic/tkColor.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkColor.c,v 1.7 2000/05/11 22:37:06 hobbs Exp $ + * RCS: @(#) $Id: tkColor.c,v 1.8 2001/08/15 15:44:36 dkf Exp $ */ #include "tkColor.h" @@ -54,7 +54,7 @@ static void InitColorObj _ANSI_ARGS_((Tcl_Obj *objPtr)); * ptr1 field of the Tcl_Obj points to a TkColor object. */ -static Tcl_ObjType colorObjType = { +Tcl_ObjType tkColorObjType = { "color", /* name */ FreeColorObjProc, /* freeIntRepProc */ DupColorObjProc, /* dupIntRepProc */ @@ -98,7 +98,7 @@ Tk_AllocColorFromObj(interp, tkwin, objPtr) { TkColor *tkColPtr; - if (objPtr->typePtr != &colorObjType) { + if (objPtr->typePtr != &tkColorObjType) { InitColorObj(objPtr); } tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1; @@ -643,7 +643,7 @@ Tk_GetColorFromObj(tkwin, objPtr) Tcl_HashEntry *hashPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (objPtr->typePtr != &colorObjType) { + if (objPtr->typePtr != &tkColorObjType) { InitColorObj(objPtr); } @@ -731,7 +731,7 @@ InitColorObj(objPtr) if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(objPtr); } - objPtr->typePtr = &colorObjType; + objPtr->typePtr = &tkColorObjType; objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; } diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 338edb9..ab8b55f 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkConfig.c,v 1.14 2000/10/12 21:14:33 ericm Exp $ + * RCS: @(#) $Id: tkConfig.c,v 1.15 2001/08/15 15:44:36 dkf Exp $ */ /* @@ -140,7 +140,7 @@ static int SetOptionFromAny _ANSI_ARGS_((Tcl_Interp *interp, * and the internalPtr2 field points to the entry that matched. */ -Tcl_ObjType optionType = { +Tcl_ObjType tkOptionObjType = { "option", /* name */ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ @@ -1042,7 +1042,7 @@ GetOptionFromObj(interp, objPtr, tablePtr) * First, check to see if the object already has the answer cached. */ - if (objPtr->typePtr == &optionType) { + if (objPtr->typePtr == &tkOptionObjType) { if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) { return (Option *) objPtr->internalRep.twoPtrValue.ptr2; } @@ -1108,7 +1108,7 @@ GetOptionFromObj(interp, objPtr, tablePtr) } objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr; objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) bestPtr; - objPtr->typePtr = &optionType; + objPtr->typePtr = &tkOptionObjType; return bestPtr; error: diff --git a/generic/tkCursor.c b/generic/tkCursor.c index 6bbbbf6..ee2663e 100644 --- a/generic/tkCursor.c +++ b/generic/tkCursor.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCursor.c,v 1.6 2000/07/06 06:38:09 ericm Exp $ + * RCS: @(#) $Id: tkCursor.c,v 1.7 2001/08/15 15:44:36 dkf Exp $ */ #include "tkPort.h" @@ -58,7 +58,7 @@ static void InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr)); * option is set. */ -static Tcl_ObjType cursorObjType = { +Tcl_ObjType tkCursorObjType = { "cursor", /* name */ FreeCursorObjProc, /* freeIntRepProc */ DupCursorObjProc, /* dupIntRepProc */ @@ -101,7 +101,7 @@ Tk_AllocCursorFromObj(interp, tkwin, objPtr) { TkCursor *cursorPtr; - if (objPtr->typePtr != &cursorObjType) { + if (objPtr->typePtr != &tkCursorObjType) { InitCursorObj(objPtr); } cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; @@ -694,7 +694,7 @@ GetCursorFromObj(tkwin, objPtr) Tcl_HashEntry *hashPtr; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (objPtr->typePtr != &cursorObjType) { + if (objPtr->typePtr != &tkCursorObjType) { InitCursorObj(objPtr); } @@ -770,7 +770,7 @@ InitCursorObj(objPtr) if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(objPtr); } - objPtr->typePtr = &cursorObjType; + objPtr->typePtr = &tkCursorObjType; objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; } diff --git a/generic/tkFont.c b/generic/tkFont.c index b5a4c2c..ded3745 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkFont.c,v 1.11 2000/11/22 01:49:38 ericm Exp $ + * RCS: @(#) $Id: tkFont.c,v 1.12 2001/08/15 15:44:36 dkf Exp $ */ #include "tkPort.h" @@ -355,7 +355,7 @@ static void UpdateDependentFonts _ANSI_ARGS_((TkFontInfo *fiPtr, * NULL. */ -static Tcl_ObjType fontObjType = { +Tcl_ObjType tkFontObjType = { "font", /* name */ FreeFontObjProc, /* freeIntRepProc */ DupFontObjProc, /* dupIntRepProc */ @@ -1005,7 +1005,7 @@ Tk_AllocFontFromObj(interp, tkwin, objPtr) NamedFont *nfPtr; fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; - if (objPtr->typePtr != &fontObjType) { + if (objPtr->typePtr != &tkFontObjType) { SetFontFromAny(interp, objPtr); } @@ -1172,7 +1172,7 @@ Tk_GetFontFromObj(tkwin, objPtr) TkFont *fontPtr; Tcl_HashEntry *hashPtr; - if (objPtr->typePtr != &fontObjType) { + if (objPtr->typePtr != &tkFontObjType) { SetFontFromAny((Tcl_Interp *) NULL, objPtr); } @@ -1230,7 +1230,7 @@ Tk_GetFontFromObj(tkwin, objPtr) * Always returns TCL_OK. * * Side effects: - * The object is left with its typePtr pointing to fontObjType. + * The object is left with its typePtr pointing to tkFontObjType. * The TkFont pointer is NULL. * *---------------------------------------------------------------------- @@ -1252,7 +1252,7 @@ SetFontFromAny(interp, objPtr) if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { (*typePtr->freeIntRepProc)(objPtr); } - objPtr->typePtr = &fontObjType; + objPtr->typePtr = &tkFontObjType; objPtr->internalRep.twoPtrValue.ptr1 = NULL; return TCL_OK; diff --git a/generic/tkInt.h b/generic/tkInt.h index 8bf0617..a39fa91 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: $Id: tkInt.h,v 1.35 2001/07/03 01:03:16 hobbs Exp $ + * RCS: $Id: tkInt.h,v 1.36 2001/08/15 15:44:36 dkf Exp $ */ #ifndef _TKINT @@ -835,6 +835,19 @@ extern TkDisplay *tkDisplayList; #define ALT_MASK (AnyModifier<<2) /* + * Object types not declared in tkObj.c need to be mentioned here so + * they can be properly registered with Tcl: + */ + +extern Tcl_ObjType tkBorderObjType; +extern Tcl_ObjType tkBitmapObjType; +extern Tcl_ObjType tkColorObjType; +extern Tcl_ObjType tkCursorObjType; +extern Tcl_ObjType tkFontObjType; +extern Tcl_ObjType tkOptionObjType; +extern Tcl_ObjType tkStateKeyObjType; + +/* * Miscellaneous variables shared among Tk modules but not exported * to the outside world: */ @@ -1003,6 +1016,8 @@ void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp, EXTERN void TkEventInit _ANSI_ARGS_((void)); +EXTERN void TkRegisterObjTypes _ANSI_ARGS_((void)); + EXTERN int TkCreateMenuCmd _ANSI_ARGS_((Tcl_Interp *interp)); EXTERN int TkDeadAppCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); diff --git a/generic/tkObj.c b/generic/tkObj.c index b26da1c..1a4372b 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -9,7 +9,7 @@ * 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.4 2001/03/30 07:11:44 hobbs Exp $ + * RCS: @(#) $Id: tkObj.c,v 1.5 2001/08/15 15:44:36 dkf Exp $ */ #include "tkInt.h" @@ -735,3 +735,35 @@ SetWindowFromAny(interp, objPtr) return TCL_OK; } + +/* + *---------------------------------------------------------------------- + * + * TkRegisterObjTypes -- + * + * Registers Tk's Tcl_ObjType structures with the Tcl run-time. + * + * Results: + * None + * + * Side effects: + * All instances of Tcl_ObjType structues used in Tk are registered + * with Tcl. + * + *---------------------------------------------------------------------- + */ + +void +TkRegisterObjTypes() +{ + Tcl_RegisterObjType(&tkBorderObjType); + Tcl_RegisterObjType(&tkBitmapObjType); + Tcl_RegisterObjType(&tkColorObjType); + Tcl_RegisterObjType(&tkCursorObjType); + Tcl_RegisterObjType(&tkFontObjType); + Tcl_RegisterObjType(&mmObjType); + Tcl_RegisterObjType(&tkOptionObjType); + Tcl_RegisterObjType(&pixelObjType); + Tcl_RegisterObjType(&tkStateKeyObjType); + Tcl_RegisterObjType(&windowObjType); +} diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 99d1235..80f9919 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -11,7 +11,7 @@ * 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.9 2000/04/19 23:11:24 ericm Exp $ + * RCS: @(#) $Id: tkUtil.c,v 1.10 2001/08/15 15:44:36 dkf Exp $ */ #include "tkInt.h" @@ -22,7 +22,7 @@ * Tcl object, used for quickly finding a mapping in a TkStateMap. */ -static Tcl_ObjType stateKeyType = { +Tcl_ObjType tkStateKeyObjType = { "statekey", /* name */ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */ @@ -920,7 +920,7 @@ TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr) CONST char *key; CONST Tcl_ObjType *typePtr; - if ((keyPtr->typePtr == &stateKeyType) + if ((keyPtr->typePtr == &tkStateKeyObjType) && (keyPtr->internalRep.twoPtrValue.ptr1 == (VOID *) mapPtr)) { return (int) keyPtr->internalRep.twoPtrValue.ptr2; } @@ -934,7 +934,7 @@ TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr) } keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr; keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey; - keyPtr->typePtr = &stateKeyType; + keyPtr->typePtr = &tkStateKeyObjType; return mPtr->numKey; } } diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 3c83daa..ca1c9f7 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWindow.c,v 1.32 2001/08/06 18:29:41 dgp Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.33 2001/08/15 15:44:36 dkf Exp $ */ #include "tkPort.h" @@ -2829,6 +2829,11 @@ Initialize(interp) return TCL_ERROR; } + /* + * Ensure that our obj-types are registered with the Tcl runtime. + */ + TkRegisterObjTypes(); + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); -- cgit v0.12