diff options
Diffstat (limited to 'generic/tkConfig.c')
| -rw-r--r-- | generic/tkConfig.c | 176 |
1 files changed, 148 insertions, 28 deletions
diff --git a/generic/tkConfig.c b/generic/tkConfig.c index e82b2ed..6572e23 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.16 2002/01/17 05:13:11 dgp Exp $ + * RCS: @(#) $Id: tkConfig.c,v 1.17 2002/06/18 23:51:46 dkf Exp $ */ /* @@ -127,6 +127,8 @@ static Tcl_Obj * GetConfigList _ANSI_ARGS_((char *recordPtr, Option *optionPtr, Tk_Window tkwin)); static Tcl_Obj * GetObjectForOption _ANSI_ARGS_((char *recordPtr, Option *optionPtr, Tk_Window tkwin)); +static Option * GetOption _ANSI_ARGS_((CONST char *name, + OptionTable *tablePtr)); static Option * GetOptionFromObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, OptionTable *tablePtr)); static int ObjectIsEmpty _ANSI_ARGS_((Tcl_Obj *objPtr)); @@ -789,6 +791,24 @@ DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin, savedOptionPtr) } break; } + case TK_OPTION_STYLE: { + Tk_Style new; + + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + new = NULL; + } else { + new = Tk_AllocStyleFromObj(interp, valuePtr); + if (new == NULL) { + return TCL_ERROR; + } + } + if (internalPtr != NULL) { + *((Tk_Style *) oldInternalPtr) = *((Tk_Style *) internalPtr); + *((Tk_Style *) internalPtr) = new; + } + break; + } case TK_OPTION_BITMAP: { Pixmap new; @@ -1004,53 +1024,38 @@ ObjectIsEmpty(objPtr) /* *---------------------------------------------------------------------- * - * GetOptionFromObj -- + * GetOption -- * * This procedure searches through a chained option table to find * the entry for a particular option name. * * Results: * The return value is a pointer to the matching entry, or NULL - * if no matching entry could be found. If NULL is returned and - * interp is not NULL than an error message is left in its result. + * if no matching entry could be found. * Note: if the matching entry is a synonym then this procedure * returns a pointer to the synonym entry, *not* the "real" entry * that the synonym refers to. * * Side effects: - * Information about the matching entry is cached in the object - * containing the name, so that future lookups can proceed more - * quickly. + * None. * *---------------------------------------------------------------------- */ static Option * -GetOptionFromObj(interp, objPtr, tablePtr) - Tcl_Interp *interp; /* Used only for error reporting; if NULL - * no message is left after an error. */ - Tcl_Obj *objPtr; /* Object whose string value is to be - * looked up in the option table. */ - OptionTable *tablePtr; /* Table in which to look up objPtr. */ +GetOption(name, tablePtr) + CONST char *name; /* String balue to be looked up in the + * option table. */ + OptionTable *tablePtr; /* Table in which to look up name. */ { Option *bestPtr, *optionPtr; OptionTable *tablePtr2; - char *p1, *p2, *name; + CONST char *p1, *p2; int count; /* - * First, check to see if the object already has the answer cached. - */ - - if (objPtr->typePtr == &tkOptionObjType) { - if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) { - return (Option *) objPtr->internalRep.twoPtrValue.ptr2; - } - } - - /* - * The answer isn't cached. Search through all of the option tables - * in the chain to find the best match. Some tricky aspects: + * Search through all of the option tables in the chain to find the + * best match. Some tricky aspects: * * 1. We have to accept unique abbreviations. * 2. The same name could appear in different tables in the chain. @@ -1060,7 +1065,6 @@ GetOptionFromObj(interp, objPtr, tablePtr) */ bestPtr = NULL; - name = Tcl_GetStringFromObj(objPtr, (int *) NULL); for (tablePtr2 = tablePtr; tablePtr2 != NULL; tablePtr2 = tablePtr2->nextPtr) { for (optionPtr = tablePtr2->options, count = tablePtr2->numOptions; @@ -1097,11 +1101,69 @@ GetOptionFromObj(interp, objPtr, tablePtr) } } } + + done: + return bestPtr; + + error: + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * GetOptionFromObj -- + * + * This procedure searches through a chained option table to find + * the entry for a particular option name. + * + * Results: + * The return value is a pointer to the matching entry, or NULL + * if no matching entry could be found. If NULL is returned and + * interp is not NULL than an error message is left in its result. + * Note: if the matching entry is a synonym then this procedure + * returns a pointer to the synonym entry, *not* the "real" entry + * that the synonym refers to. + * + * Side effects: + * Information about the matching entry is cached in the object + * containing the name, so that future lookups can proceed more + * quickly. + * + *---------------------------------------------------------------------- + */ + +static Option * +GetOptionFromObj(interp, objPtr, tablePtr) + Tcl_Interp *interp; /* Used only for error reporting; if NULL + * no message is left after an error. */ + Tcl_Obj *objPtr; /* Object whose string value is to be + * looked up in the option table. */ + OptionTable *tablePtr; /* Table in which to look up objPtr. */ +{ + Option *bestPtr; + char *name; + + /* + * First, check to see if the object already has the answer cached. + */ + + if (objPtr->typePtr == &tkOptionObjType) { + if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) { + return (Option *) objPtr->internalRep.twoPtrValue.ptr2; + } + } + + /* + * The answer isn't cached. + */ + + name = Tcl_GetStringFromObj(objPtr, (int *) NULL); + bestPtr = GetOption(name, tablePtr); if (bestPtr == NULL) { goto error; } - done: if ((objPtr->typePtr != NULL) && (objPtr->typePtr->freeIntRepProc != NULL)) { objPtr->typePtr->freeIntRepProc(objPtr); @@ -1122,6 +1184,44 @@ GetOptionFromObj(interp, objPtr, tablePtr) /* *---------------------------------------------------------------------- * + * TkGetOptionSpec -- + * + * This procedure searches through a chained option table to find + * the option spec for a particular option name. + * + * Results: + * The return value is a pointer to the option spec of the matching + * entry, or NULL if no matching entry could be found. + * Note: if the matching entry is a synonym then this procedure + * returns a pointer to the option spec of the synonym entry, *not* + * the "real" entry that the synonym refers to. + * Note: this call is primarily used by the style management code + * (tkStyle.c) to look up an element's option spec into a widget's + * option table. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +CONST Tk_OptionSpec * +TkGetOptionSpec(name, optionTable) + CONST char *name; /* String value to be looked up. */ + Tk_OptionTable optionTable; /* Table in which to look up name. */ +{ + Option *optionPtr; + + optionPtr = GetOption(name, (OptionTable *) optionTable); + if (optionPtr == NULL) { + return NULL; + } + return optionPtr->specPtr; +} + +/* + *---------------------------------------------------------------------- + * * SetOptionFromAny -- * * This procedure is called to convert a Tcl object to option @@ -1397,6 +1497,11 @@ Tk_RestoreSavedOptions(savePtr) = *((Tk_Font *) &savePtr->items[i].internalForm); break; } + case TK_OPTION_STYLE: { + *((Tk_Style *) internalPtr) + = *((Tk_Style *) &savePtr->items[i].internalForm); + break; + } case TK_OPTION_BITMAP: { *((Pixmap *) internalPtr) = *((Pixmap *) &savePtr->items[i].internalForm); @@ -1627,6 +1732,14 @@ FreeResources(optionPtr, objPtr, internalPtr, tkwin) Tk_FreeFontFromObj(tkwin, objPtr); } break; + case TK_OPTION_STYLE: + if (internalFormExists) { + Tk_FreeStyle(*((Tk_Style *) internalPtr)); + *((Tk_Style *) internalPtr) = NULL; + } else if (objPtr != NULL) { + Tk_FreeStyleFromObj(objPtr); + } + break; case TK_OPTION_BITMAP: if (internalFormExists) { if (*((Pixmap *) internalPtr) != None) { @@ -1900,6 +2013,13 @@ GetObjectForOption(recordPtr, optionPtr, tkwin) } break; } + case TK_OPTION_STYLE: { + Tk_Style style = *((Tk_Style *) internalPtr); + if (style != NULL) { + objPtr = Tcl_NewStringObj(Tk_NameOfStyle(style), -1); + } + break; + } case TK_OPTION_BITMAP: { Pixmap pixmap = *((Pixmap *) internalPtr); if (pixmap != None) { |