Register Tk's object types with Tcl (Tcl Bug 450545)

10 files changed, 89 insertions, 37 deletions

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));