Attachment "tkobj.patch" to
ticket [450545ffff]
added by
dkf
2001-08-15 16:24:45.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tktoolkit/tk/ChangeLog,v
retrieving revision 1.316
diff -u -r1.316 ChangeLog
--- ChangeLog 2001/08/13 21:07:24 1.316
+++ ChangeLog 2001/08/15 09:23:26
@@ -1,3 +1,13 @@
+2001-08-14 Donal K. Fellows <[email protected]>
+
+ * 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 <[email protected]>
* unix/configure: Regen.
Index: generic/tk3d.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tk3d.c,v
retrieving revision 1.10
diff -u -r1.10 tk3d.c
--- generic/tk3d.c 2000/05/17 21:17:20 1.10
+++ generic/tk3d.c 2001/08/15 09:23:27
@@ -46,7 +46,7 @@
* is set.
*/
-static Tcl_ObjType borderObjType = {
+Tcl_ObjType tkBorderObjType = {
"border", /* name */
FreeBorderObjProc, /* freeIntRepProc */
DupBorderObjProc, /* dupIntRepProc */
@@ -87,7 +87,7 @@
{
TkBorder *borderPtr;
- if (objPtr->typePtr != &borderObjType) {
+ if (objPtr->typePtr != &tkBorderObjType) {
InitBorderObj(objPtr);
}
borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
@@ -1263,7 +1263,7 @@
Tcl_HashEntry *hashPtr;
TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (objPtr->typePtr != &borderObjType) {
+ if (objPtr->typePtr != &tkBorderObjType) {
InitBorderObj(objPtr);
}
@@ -1356,7 +1356,7 @@
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
(*typePtr->freeIntRepProc)(objPtr);
}
- objPtr->typePtr = &borderObjType;
+ objPtr->typePtr = &tkBorderObjType;
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
}
Index: generic/tkBitmap.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkBitmap.c,v
retrieving revision 1.8
diff -u -r1.8 tkBitmap.c
--- generic/tkBitmap.c 2000/09/30 18:46:03 1.8
+++ generic/tkBitmap.c 2001/08/15 09:23:27
@@ -125,7 +125,7 @@
* 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 @@
{
TkBitmap *bitmapPtr;
- if (objPtr->typePtr != &bitmapObjType) {
+ if (objPtr->typePtr != &tkBitmapObjType) {
InitBitmapObj(objPtr);
}
bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
@@ -900,7 +900,7 @@
Tcl_HashEntry *hashPtr;
TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (objPtr->typePtr != &bitmapObjType) {
+ if (objPtr->typePtr != &tkBitmapObjType) {
InitBitmapObj(objPtr);
}
@@ -975,7 +975,7 @@
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
(*typePtr->freeIntRepProc)(objPtr);
}
- objPtr->typePtr = &bitmapObjType;
+ objPtr->typePtr = &tkBitmapObjType;
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
}
Index: generic/tkColor.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkColor.c,v
retrieving revision 1.7
diff -u -r1.7 tkColor.c
--- generic/tkColor.c 2000/05/11 22:37:06 1.7
+++ generic/tkColor.c 2001/08/15 09:23:27
@@ -54,7 +54,7 @@
* 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 @@
{
TkColor *tkColPtr;
- if (objPtr->typePtr != &colorObjType) {
+ if (objPtr->typePtr != &tkColorObjType) {
InitColorObj(objPtr);
}
tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
@@ -643,7 +643,7 @@
Tcl_HashEntry *hashPtr;
TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (objPtr->typePtr != &colorObjType) {
+ if (objPtr->typePtr != &tkColorObjType) {
InitColorObj(objPtr);
}
@@ -731,7 +731,7 @@
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
(*typePtr->freeIntRepProc)(objPtr);
}
- objPtr->typePtr = &colorObjType;
+ objPtr->typePtr = &tkColorObjType;
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
}
Index: generic/tkConfig.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkConfig.c,v
retrieving revision 1.14
diff -u -r1.14 tkConfig.c
--- generic/tkConfig.c 2000/10/12 21:14:33 1.14
+++ generic/tkConfig.c 2001/08/15 09:23:27
@@ -140,7 +140,7 @@
* 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 @@
* 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 @@
}
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) bestPtr;
- objPtr->typePtr = &optionType;
+ objPtr->typePtr = &tkOptionObjType;
return bestPtr;
error:
Index: generic/tkCursor.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkCursor.c,v
retrieving revision 1.6
diff -u -r1.6 tkCursor.c
--- generic/tkCursor.c 2000/07/06 06:38:09 1.6
+++ generic/tkCursor.c 2001/08/15 09:23:27
@@ -58,7 +58,7 @@
* option is set.
*/
-static Tcl_ObjType cursorObjType = {
+Tcl_ObjType tkCursorObjType = {
"cursor", /* name */
FreeCursorObjProc, /* freeIntRepProc */
DupCursorObjProc, /* dupIntRepProc */
@@ -101,7 +101,7 @@
{
TkCursor *cursorPtr;
- if (objPtr->typePtr != &cursorObjType) {
+ if (objPtr->typePtr != &tkCursorObjType) {
InitCursorObj(objPtr);
}
cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
@@ -694,7 +694,7 @@
Tcl_HashEntry *hashPtr;
TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (objPtr->typePtr != &cursorObjType) {
+ if (objPtr->typePtr != &tkCursorObjType) {
InitCursorObj(objPtr);
}
@@ -770,7 +770,7 @@
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
(*typePtr->freeIntRepProc)(objPtr);
}
- objPtr->typePtr = &cursorObjType;
+ objPtr->typePtr = &tkCursorObjType;
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
}
Index: generic/tkFont.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkFont.c,v
retrieving revision 1.11
diff -u -r1.11 tkFont.c
--- generic/tkFont.c 2000/11/22 01:49:38 1.11
+++ generic/tkFont.c 2001/08/15 09:23:28
@@ -355,7 +355,7 @@
* NULL.
*/
-static Tcl_ObjType fontObjType = {
+Tcl_ObjType tkFontObjType = {
"font", /* name */
FreeFontObjProc, /* freeIntRepProc */
DupFontObjProc, /* dupIntRepProc */
@@ -1005,7 +1005,7 @@
NamedFont *nfPtr;
fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
- if (objPtr->typePtr != &fontObjType) {
+ if (objPtr->typePtr != &tkFontObjType) {
SetFontFromAny(interp, objPtr);
}
@@ -1172,7 +1172,7 @@
TkFont *fontPtr;
Tcl_HashEntry *hashPtr;
- if (objPtr->typePtr != &fontObjType) {
+ if (objPtr->typePtr != &tkFontObjType) {
SetFontFromAny((Tcl_Interp *) NULL, objPtr);
}
@@ -1230,7 +1230,7 @@
* 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 @@
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
(*typePtr->freeIntRepProc)(objPtr);
}
- objPtr->typePtr = &fontObjType;
+ objPtr->typePtr = &tkFontObjType;
objPtr->internalRep.twoPtrValue.ptr1 = NULL;
return TCL_OK;
Index: generic/tkInt.h
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkInt.h,v
retrieving revision 1.35
diff -u -r1.35 tkInt.h
--- generic/tkInt.h 2001/07/03 01:03:16 1.35
+++ generic/tkInt.h 2001/08/15 09:23:28
@@ -835,6 +835,19 @@
#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:
*/
@@ -1002,6 +1015,8 @@
int devId, char *buffer, long size));
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,
Index: generic/tkObj.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkObj.c,v
retrieving revision 1.4
diff -u -r1.4 tkObj.c
--- generic/tkObj.c 2001/03/30 07:11:44 1.4
+++ generic/tkObj.c 2001/08/15 09:23:28
@@ -735,3 +735,35 @@
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);
+}
Index: generic/tkUtil.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkUtil.c,v
retrieving revision 1.9
diff -u -r1.9 tkUtil.c
--- generic/tkUtil.c 2000/04/19 23:11:24 1.9
+++ generic/tkUtil.c 2001/08/15 09:23:28
@@ -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 @@
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 @@
}
keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr;
keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey;
- keyPtr->typePtr = &stateKeyType;
+ keyPtr->typePtr = &tkStateKeyObjType;
return mPtr->numKey;
}
}
Index: generic/tkWindow.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkWindow.c,v
retrieving revision 1.32
diff -u -r1.32 tkWindow.c
--- generic/tkWindow.c 2001/08/06 18:29:41 1.32
+++ generic/tkWindow.c 2001/08/15 09:23:29
@@ -2829,6 +2829,11 @@
return TCL_ERROR;
}
+ /*
+ * Ensure that our obj-types are registered with the Tcl runtime.
+ */
+ TkRegisterObjTypes();
+
tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
