summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2001-08-15 15:44:35 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2001-08-15 15:44:35 (GMT)
commit0494d6ea369901955402d84ce76a13ddc200957f (patch)
treee817d32e68064c76449930b08bb891ff654501b8
parentfb862db0788d85c6d070781c2cad608e0a470a96 (diff)
downloadtk-0494d6ea369901955402d84ce76a13ddc200957f.zip
tk-0494d6ea369901955402d84ce76a13ddc200957f.tar.gz
tk-0494d6ea369901955402d84ce76a13ddc200957f.tar.bz2
Register Tk's object types with Tcl (Tcl Bug 450545)
-rw-r--r--ChangeLog10
-rw-r--r--generic/tk3d.c10
-rw-r--r--generic/tkBitmap.c10
-rw-r--r--generic/tkColor.c10
-rw-r--r--generic/tkConfig.c8
-rw-r--r--generic/tkCursor.c10
-rw-r--r--generic/tkFont.c12
-rw-r--r--generic/tkInt.h17
-rw-r--r--generic/tkObj.c34
-rw-r--r--generic/tkUtil.c8
-rw-r--r--generic/tkWindow.c7
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 <fellowsd@cs.man.ac.uk>
+
+ * 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 <mdejong@redhat.com>
* 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));