diff options
Diffstat (limited to 'generic/tkConfig.c')
| -rw-r--r-- | generic/tkConfig.c | 249 |
1 files changed, 108 insertions, 141 deletions
diff --git a/generic/tkConfig.c b/generic/tkConfig.c index f2eaa33..9c159e6 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -27,11 +27,16 @@ #include "tkFont.h" /* - * The following definition is an AssocData key used to keep track of all of - * the option tables that have been created for an interpreter. + * The following definition keeps track of all of + * the option tables that have been created for a thread. */ -#define OPTION_HASH_KEY "TkOptionTable" +typedef struct ThreadSpecificData { + int initialized; /* 0 means table below needs initializing. */ + Tcl_HashTable hashTable; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + /* * The following two structures are used along with Tk_OptionSpec structures @@ -63,7 +68,7 @@ typedef struct TkOption { struct TkOption *synonymPtr; /* For synonym options, this points to the * master entry. */ - struct Tk_ObjCustomOption *custom; + const struct Tk_ObjCustomOption *custom; /* For TK_OPTION_CUSTOM. */ } extra; int flags; /* Miscellaneous flag values; see below for @@ -113,8 +118,6 @@ typedef struct OptionTable { static int DoObjConfig(Tcl_Interp *interp, char *recordPtr, Option *optionPtr, Tcl_Obj *valuePtr, Tk_Window tkwin, Tk_SavedOption *savePtr); -static void DestroyOptionHashTable(ClientData clientData, - Tcl_Interp *interp); static void FreeResources(Option *optionPtr, Tcl_Obj *objPtr, char *internalPtr, Tk_Window tkwin); static Tcl_Obj * GetConfigList(char *recordPtr, @@ -125,7 +128,8 @@ static Option * GetOption(const char *name, OptionTable *tablePtr); static Option * GetOptionFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, OptionTable *tablePtr); static int ObjectIsEmpty(Tcl_Obj *objPtr); -static int SetOptionFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void FreeOptionInternalRep(Tcl_Obj *objPtr); +static void DupOptionInternalRep(Tcl_Obj *, Tcl_Obj *); /* * The structure below defines an object type that is used to cache the result @@ -134,12 +138,12 @@ static int SetOptionFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); * the internalPtr2 field points to the entry that matched. */ -Tcl_ObjType tkOptionObjType = { +static const Tcl_ObjType optionObjType = { "option", /* name */ - NULL, /* freeIntRepProc */ - NULL, /* dupIntRepProc */ + FreeOptionInternalRep, /* freeIntRepProc */ + DupOptionInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ - SetOptionFromAny /* setFromAnyProc */ + NULL /* setFromAnyProc */ }; /* @@ -168,31 +172,26 @@ Tk_CreateOptionTable( /* Static information about the configuration * options. */ { - Tcl_HashTable *hashTablePtr; Tcl_HashEntry *hashEntryPtr; int newEntry; OptionTable *tablePtr; const Tk_OptionSpec *specPtr, *specPtr2; Option *optionPtr; int numOptions, i; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); /* - * We use an AssocData value in the interpreter to keep a hash table of - * all the option tables we've created for this application. This is used - * for two purposes. First, it allows us to share the tables (e.g. in - * several chains) and second, we use the deletion callback for the - * AssocData to delete all the option tables when the interpreter is - * deleted. The code below finds the hash table or creates a new one if it + * We use an TSD in the thread to keep a hash table of + * all the option tables we've created for this application. This is + * used for allowing us to share the tables (e.g. in several chains). + * The code below finds the hash table or creates a new one if it * doesn't already exist. */ - hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY, - NULL); - if (hashTablePtr == NULL) { - hashTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); - Tcl_InitHashTable(hashTablePtr, TCL_ONE_WORD_KEYS); - Tcl_SetAssocData(interp, OPTION_HASH_KEY, DestroyOptionHashTable, - (ClientData) hashTablePtr); + if (!tsdPtr->initialized) { + Tcl_InitHashTable(&tsdPtr->hashTable, TCL_ONE_WORD_KEYS); + tsdPtr->initialized = 1; } /* @@ -200,10 +199,10 @@ Tk_CreateOptionTable( * reuse the existing table. */ - hashEntryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) templatePtr, + hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->hashTable, (char *) templatePtr, &newEntry); if (!newEntry) { - tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr); + tablePtr = Tcl_GetHashValue(hashEntryPtr); tablePtr->refCount++; return (Tk_OptionTable) tablePtr; } @@ -217,8 +216,7 @@ Tk_CreateOptionTable( for (specPtr = templatePtr; specPtr->type != TK_OPTION_END; specPtr++) { numOptions++; } - tablePtr = (OptionTable *) (ckalloc(sizeof(OptionTable) - + (numOptions * sizeof(Option)))); + tablePtr = ckalloc(sizeof(OptionTable) + (numOptions * sizeof(Option))); tablePtr->refCount = 1; tablePtr->hashEntryPtr = hashEntryPtr; tablePtr->nextPtr = NULL; @@ -268,7 +266,7 @@ Tk_CreateOptionTable( || (specPtr->type == TK_OPTION_BORDER)) && (specPtr->clientData != NULL)) { optionPtr->extra.monoColorPtr = - Tcl_NewStringObj((char *) specPtr->clientData, -1); + Tcl_NewStringObj(specPtr->clientData, -1); Tcl_IncrRefCount(optionPtr->extra.monoColorPtr); } @@ -276,8 +274,8 @@ Tk_CreateOptionTable( /* * Get the custom parsing, etc., functions. */ - optionPtr->extra.custom = - (Tk_ObjCustomOption *) specPtr->clientData; + + optionPtr->extra.custom = specPtr->clientData; } } if (((specPtr->type == TK_OPTION_STRING) @@ -301,8 +299,8 @@ Tk_CreateOptionTable( */ if (specPtr->clientData != NULL) { - tablePtr->nextPtr = (OptionTable *) Tk_CreateOptionTable(interp, - (Tk_OptionSpec *) specPtr->clientData); + tablePtr->nextPtr = (OptionTable *) + Tk_CreateOptionTable(interp, specPtr->clientData); } return (Tk_OptionTable) tablePtr; @@ -355,60 +353,7 @@ Tk_DeleteOptionTable( } } Tcl_DeleteHashEntry(tablePtr->hashEntryPtr); - ckfree((char *) tablePtr); -} - -/* - *---------------------------------------------------------------------- - * - * DestroyOptionHashTable -- - * - * This function is the deletion callback associated with the AssocData - * entry created by Tk_CreateOptionTable. It is invoked when an - * interpreter is deleted, and deletes all of the option tables - * associated with that interpreter. - * - * Results: - * None. - * - * Side effects: - * The option hash table is destroyed along with all of the OptionTable - * structures that it refers to. - * - *---------------------------------------------------------------------- - */ - -static void -DestroyOptionHashTable( - ClientData clientData, /* The hash table we are destroying */ - Tcl_Interp *interp) /* The interpreter we are destroying */ -{ - Tcl_HashTable *hashTablePtr = (Tcl_HashTable *) clientData; - Tcl_HashSearch search; - Tcl_HashEntry *hashEntryPtr; - OptionTable *tablePtr; - - for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search); - hashEntryPtr != NULL; - hashEntryPtr = Tcl_NextHashEntry(&search)) { - tablePtr = (OptionTable *) Tcl_GetHashValue(hashEntryPtr); - - /* - * The following statements do two tricky things: - * 1. They ensure that the option table is deleted, even if there are - * outstanding references to it. - * 2. They ensure that Tk_DeleteOptionTable doesn't delete other - * tables chained from this one; we'll do it when we come across - * the hash table entry for the chained table (in fact, the chained - * table may already have been deleted). - */ - - tablePtr->refCount = 1; - tablePtr->nextPtr = NULL; - Tk_DeleteOptionTable((Tk_OptionTable) tablePtr); - } - Tcl_DeleteHashTable(hashTablePtr); - ckfree((char *) hashTablePtr); + ckfree(tablePtr); } /* @@ -710,7 +655,8 @@ DoObjConfig( break; } case TK_OPTION_STRING: { - char *newStr, *value; + char *newStr; + const char *value; int length; if (nullOK && ObjectIsEmpty(valuePtr)) { @@ -719,7 +665,7 @@ DoObjConfig( if (internalPtr != NULL) { if (valuePtr != NULL) { value = Tcl_GetStringFromObj(valuePtr, &length); - newStr = ckalloc((unsigned) (length + 1)); + newStr = ckalloc(length + 1); strcpy(newStr, value); } else { newStr = NULL; @@ -732,8 +678,8 @@ DoObjConfig( case TK_OPTION_STRING_TABLE: { int newValue; - if (Tcl_GetIndexFromObj(interp, valuePtr, - (const char **) optionPtr->specPtr->clientData, + if (Tcl_GetIndexFromObjStruct(interp, valuePtr, + optionPtr->specPtr->clientData, sizeof(char *), optionPtr->specPtr->optionName+1, 0, &newValue) != TCL_OK) { return TCL_ERROR; } @@ -930,7 +876,7 @@ DoObjConfig( break; } case TK_OPTION_CUSTOM: { - Tk_ObjCustomOption *custom = optionPtr->extra.custom; + const Tk_ObjCustomOption *custom = optionPtr->extra.custom; if (custom->setProc(custom->clientData, interp, tkwin, &valuePtr, recordPtr, optionPtr->specPtr->internalOffset, @@ -940,16 +886,13 @@ DoObjConfig( break; } - { - char buf[40+TCL_INTEGER_SPACE]; - default: - sprintf(buf, "bad config table: unknown type %d", - optionPtr->specPtr->type); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad config table: unknown type %d", + optionPtr->specPtr->type)); + Tcl_SetErrorCode(interp, "TK", "BAD_CONFIG", NULL); return TCL_ERROR; } - } /* * Release resources associated with the old value, if we're not returning @@ -1002,7 +945,7 @@ ObjectIsEmpty( if (objPtr->bytes != NULL) { return (objPtr->length == 0); } - Tcl_GetStringFromObj(objPtr, &length); + (void)Tcl_GetStringFromObj(objPtr, &length); return (length == 0); } @@ -1121,13 +1064,13 @@ GetOptionFromObj( OptionTable *tablePtr) /* Table in which to look up objPtr. */ { Option *bestPtr; - char *name; + const char *name; /* * First, check to see if the object already has the answer cached. */ - if (objPtr->typePtr == &tkOptionObjType) { + if (objPtr->typePtr == &optionObjType) { if (objPtr->internalRep.twoPtrValue.ptr1 == (void *) tablePtr) { return (Option *) objPtr->internalRep.twoPtrValue.ptr2; } @@ -1149,12 +1092,15 @@ GetOptionFromObj( } objPtr->internalRep.twoPtrValue.ptr1 = (void *) tablePtr; objPtr->internalRep.twoPtrValue.ptr2 = (void *) bestPtr; - objPtr->typePtr = &tkOptionObjType; + objPtr->typePtr = &optionObjType; + tablePtr->refCount++; return bestPtr; error: if (interp != NULL) { - Tcl_AppendResult(interp, "unknown option \"", name, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\"", name)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "OPTION", name, NULL); } return NULL; } @@ -1199,32 +1145,55 @@ TkGetOptionSpec( /* *---------------------------------------------------------------------- * - * SetOptionFromAny -- + * FreeOptionInternalRep -- * - * This function is called to convert a Tcl object to option internal - * form. However, this doesn't make sense (need to have a table of - * options in order to do the conversion) so the function always - * generates an error. + * Part of the option Tcl object type implementation. Frees the storage + * associated with a option object's internal representation unless it + * is still in use. * * Results: - * The return value is always TCL_ERROR, and an error message is left in - * interp's result if interp isn't NULL. + * None. * * Side effects: - * None. + * The option object's internal rep is marked invalid and its memory + * gets freed unless it is still in use somewhere. In that case the + * cleanup is delayed until the last reference goes away. * *---------------------------------------------------------------------- */ -static int -SetOptionFromAny( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr) /* The object to convert. */ +static void +FreeOptionInternalRep( + register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "can't convert value to option except via GetOptionFromObj API", - -1); - return TCL_ERROR; + register Tk_OptionTable tablePtr = (Tk_OptionTable) objPtr->internalRep.twoPtrValue.ptr1; + + Tk_DeleteOptionTable(tablePtr); + objPtr->typePtr = NULL; + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; +} + +/* + *--------------------------------------------------------------------------- + * + * DupOptionInternalRep -- + * + * When a cached option object is duplicated, this is called to update the + * internal reps. + * + *--------------------------------------------------------------------------- + */ + +static void +DupOptionInternalRep( + Tcl_Obj *srcObjPtr, /* The object we are copying from. */ + Tcl_Obj *dupObjPtr) /* The object we are copying to. */ +{ + register OptionTable *tablePtr = (OptionTable *) srcObjPtr->internalRep.twoPtrValue.ptr1; + tablePtr->refCount++; + dupObjPtr->typePtr = srcObjPtr->typePtr; + dupObjPtr->internalRep = srcObjPtr->internalRep; } /* @@ -1304,9 +1273,10 @@ Tk_SetOptions( if (objc < 2) { if (interp != NULL) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "value for \"", Tcl_GetStringFromObj(*objv, NULL), - "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", + Tcl_GetString(*objv))); + Tcl_SetErrorCode(interp, "TK", "VALUE_MISSING", NULL); goto error; } } @@ -1317,7 +1287,7 @@ Tk_SetOptions( * more space. */ - newSavePtr = (Tk_SavedOptions *) ckalloc(sizeof(Tk_SavedOptions)); + newSavePtr = ckalloc(sizeof(Tk_SavedOptions)); newSavePtr->recordPtr = recordPtr; newSavePtr->tkwin = tkwin; newSavePtr->numItems = 0; @@ -1328,11 +1298,9 @@ Tk_SetOptions( if (DoObjConfig(interp, recordPtr, optionPtr, objv[1], tkwin, (savePtr != NULL) ? &lastSavePtr->items[lastSavePtr->numItems] : NULL) != TCL_OK) { - char msg[100]; - - sprintf(msg, "\n (processing \"%.40s\" option)", - Tcl_GetStringFromObj(*objv, NULL)); - Tcl_AddErrorInfo(interp, msg); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (processing \"%.40s\" option)", + Tcl_GetString(*objv))); goto error; } if (savePtr != NULL) { @@ -1393,7 +1361,7 @@ Tk_RestoreSavedOptions( if (savePtr->nextPtr != NULL) { Tk_RestoreSavedOptions(savePtr->nextPtr); - ckfree((char *) savePtr->nextPtr); + ckfree(savePtr->nextPtr); savePtr->nextPtr = NULL; } for (i = savePtr->numItems - 1; i >= 0; i--) { @@ -1433,6 +1401,7 @@ Tk_RestoreSavedOptions( if (specPtr->internalOffset >= 0) { register char *ptr = (char *) &savePtr->items[i].internalForm; + CLANG_ASSERT(internalPtr); switch (specPtr->type) { case TK_OPTION_BOOLEAN: *((int *) internalPtr) = *((int *) ptr); @@ -1484,7 +1453,7 @@ Tk_RestoreSavedOptions( *((Tk_Window *) internalPtr) = *((Tk_Window *) ptr); break; case TK_OPTION_CUSTOM: { - Tk_ObjCustomOption *custom = optionPtr->extra.custom; + const Tk_ObjCustomOption *custom = optionPtr->extra.custom; if (custom->restoreProc != NULL) { custom->restoreProc(custom->clientData, savePtr->tkwin, @@ -1527,7 +1496,7 @@ Tk_FreeSavedOptions( if (savePtr->nextPtr != NULL) { Tk_FreeSavedOptions(savePtr->nextPtr); - ckfree((char *) savePtr->nextPtr); + ckfree(savePtr->nextPtr); } for (count = savePtr->numItems, savedOptionPtr = &savePtr->items[savePtr->numItems-1]; @@ -1709,7 +1678,7 @@ FreeResources( } break; case TK_OPTION_CUSTOM: { - Tk_ObjCustomOption *custom = optionPtr->extra.custom; + const Tk_ObjCustomOption *custom = optionPtr->extra.custom; if (internalFormExists && custom->freeProc != NULL) { custom->freeProc(custom->clientData, tkwin, internalPtr); } @@ -1729,7 +1698,6 @@ FreeResources( * single option or all the configuration options in a table. * * Results: - * This function normally returns a pointer to an object. If namePtr * isn't NULL, then the result object is a list with five elements: the * option's name, its database name, database class, default value, and @@ -2000,7 +1968,7 @@ GetObjectForOption( break; } case TK_OPTION_CUSTOM: { - Tk_ObjCustomOption *custom = optionPtr->extra.custom; + const Tk_ObjCustomOption *custom = optionPtr->extra.custom; objPtr = custom->getProc(custom->clientData, tkwin, recordPtr, optionPtr->specPtr->internalOffset); @@ -2106,15 +2074,14 @@ TkDebugConfig( * interpreter anymore. */ { OptionTable *tablePtr = (OptionTable *) table; - Tcl_HashTable *hashTablePtr; Tcl_HashEntry *hashEntryPtr; Tcl_HashSearch search; Tcl_Obj *objPtr; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); objPtr = Tcl_NewObj(); - hashTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, OPTION_HASH_KEY, - NULL); - if (hashTablePtr == NULL) { + if (!tablePtr || !tsdPtr->initialized) { return objPtr; } @@ -2123,7 +2090,7 @@ TkDebugConfig( * want still is valid. */ - for (hashEntryPtr = Tcl_FirstHashEntry(hashTablePtr, &search); + for (hashEntryPtr = Tcl_FirstHashEntry(&tsdPtr->hashTable, &search); hashEntryPtr != NULL; hashEntryPtr = Tcl_NextHashEntry(&search)) { if (tablePtr == (OptionTable *) Tcl_GetHashValue(hashEntryPtr)) { |