/* * ttkTheme.c -- * * This file implements the widget styles and themes support. * * Copyright (c) 2002 Frederic Bonnet * Copyright (c) 2003 Joe English * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * $Id: ttkTheme.c,v 1.5 2007/01/11 15:35:40 dkf Exp $ */ #include #include #include #include "ttkThemeInt.h" #ifdef NO_PRIVATE_HEADERS EXTERN CONST Tk_OptionSpec *TkGetOptionSpec (CONST char *name, Tk_OptionTable optionTable); #else #include #endif /*------------------------------------------------------------------------ * +++ Styles. * * Invariants: * If styleName contains a dot, parentStyle->styleName is everything * after the first dot; otherwise, parentStyle is the theme's root * style ".". The root style's parentStyle is NULL. * */ typedef struct Ttk_Style_ { const char *styleName; /* points to hash table key */ Tcl_HashTable settingsTable; /* KEY: string; VALUE: StateMap */ Tcl_HashTable defaultsTable; /* KEY: string; VALUE: resource */ Ttk_LayoutTemplate layoutTemplate; /* Layout template for style, or NULL */ Ttk_Style parentStyle; /* Previous style in chain */ Ttk_ResourceCache cache; /* Back-pointer to resource cache */ } Style; static Style *NewStyle() { Style *stylePtr = (Style*)ckalloc(sizeof(Style)); stylePtr->styleName = NULL; stylePtr->parentStyle = NULL; stylePtr->layoutTemplate = NULL; stylePtr->cache = NULL; Tcl_InitHashTable(&stylePtr->settingsTable, TCL_STRING_KEYS); Tcl_InitHashTable(&stylePtr->defaultsTable, TCL_STRING_KEYS); return stylePtr; } static void FreeStyle(Style *stylePtr) { Tcl_HashSearch search; Tcl_HashEntry *entryPtr; entryPtr = Tcl_FirstHashEntry(&stylePtr->settingsTable, &search); while (entryPtr != NULL) { Ttk_StateMap stateMap = (Ttk_StateMap)Tcl_GetHashValue(entryPtr); Tcl_DecrRefCount(stateMap); entryPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&stylePtr->settingsTable); entryPtr = Tcl_FirstHashEntry(&stylePtr->defaultsTable, &search); while (entryPtr != NULL) { Tcl_Obj *defaultValue = (Ttk_StateMap)Tcl_GetHashValue(entryPtr); Tcl_DecrRefCount(defaultValue); entryPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&stylePtr->defaultsTable); Ttk_FreeLayoutTemplate(stylePtr->layoutTemplate); ckfree((char*)stylePtr); } /* * LookupStateMap -- * Look up dynamic resource settings in the in the specified style. */ static Ttk_StateMap LookupStateMap(Ttk_Style stylePtr, const char *optionName) { while (stylePtr) { Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&stylePtr->settingsTable, optionName); if (entryPtr) return (Ttk_StateMap)Tcl_GetHashValue(entryPtr); stylePtr = stylePtr->parentStyle; } return 0; } /* * LookupDefault -- * Look up default resource setting the in the specified style. */ static Tcl_Obj *LookupDefault(Ttk_Style stylePtr, const char *optionName) { while (stylePtr) { Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&stylePtr->defaultsTable, optionName); if (entryPtr) return (Tcl_Obj *)Tcl_GetHashValue(entryPtr); stylePtr = stylePtr->parentStyle; } return 0; } /*------------------------------------------------------------------------ * +++ Elements. */ typedef const Tk_OptionSpec **OptionMap; /* array of Tk_OptionSpecs mapping widget options to element options */ typedef struct Ttk_ElementImpl_ /* Element implementation */ { const char *name; /* Points to hash table key */ Ttk_ElementSpec *specPtr; /* Template provided during registration. */ void *clientData; /* Client data passed in at registration time */ void *elementRecord; /* Scratch buffer for element record storage */ int nResources; /* #Element options */ Tcl_Obj **defaultValues; /* Array of option default values */ Tcl_HashTable optMapCache; /* Map: Tk_OptionTable * -> OptionMap */ } ElementImpl; /* TTKGetOptionSpec -- * Look up a Tk_OptionSpec by name from a Tk_OptionTable, * and verify that it's compatible with the specified Tk_OptionType, * along with other constraints (see below). */ static const Tk_OptionSpec *TTKGetOptionSpec( const char *optionName, Tk_OptionTable optionTable, Tk_OptionType optionType) { const Tk_OptionSpec *optionSpec = TkGetOptionSpec(optionName, optionTable); if (!optionSpec) return 0; /* Make sure widget option has a Tcl_Obj* entry: */ if (optionSpec->objOffset < 0) { return 0; } /* Grrr. Ignore accidental mismatches caused by prefix-matching: */ if (strcmp(optionSpec->optionName, optionName)) { return 0; } /* Ensure that the widget option type is compatible with * the element option type. * * TK_OPTION_STRING element options are compatible with anything. * As a workaround for the workaround for Bug #967209, * TK_OPTION_STRING widget options are also compatible with anything * (see <>). */ if ( optionType != TK_OPTION_STRING && optionSpec->type != TK_OPTION_STRING && optionType != optionSpec->type) { return 0; } return optionSpec; } /* BuildOptionMap -- * Construct the mapping from element options to widget options. */ static OptionMap BuildOptionMap(ElementImpl *elementImpl, Tk_OptionTable optionTable) { OptionMap optionMap = (OptionMap)ckalloc( sizeof(const Tk_OptionSpec) * elementImpl->nResources); int i; for (i = 0; i < elementImpl->nResources; ++i) { Ttk_ElementOptionSpec *e = elementImpl->specPtr->options+i; optionMap[i] = TTKGetOptionSpec(e->optionName, optionTable, e->type); } return optionMap; } /* GetOptionMap -- * Return a cached OptionMap matching the specified optionTable * for the specified element, creating it if necessary. */ static OptionMap GetOptionMap(ElementImpl *elementImpl, Tk_OptionTable optionTable) { OptionMap optionMap; int isNew; Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry( &elementImpl->optMapCache, (ClientData)optionTable, &isNew); if (isNew) { optionMap = BuildOptionMap(elementImpl, optionTable); Tcl_SetHashValue(entryPtr, optionMap); } else { optionMap = (OptionMap)(Tcl_GetHashValue(entryPtr)); } return optionMap; } /* * NewElementImpl -- * Allocate and initialize an element implementation record * from the specified element specification. */ static ElementImpl * NewElementImpl(const char *name, Ttk_ElementSpec *specPtr,void *clientData) { ElementImpl *elementImpl = (ElementImpl*)ckalloc(sizeof(ElementImpl)); int i; elementImpl->name = name; elementImpl->specPtr = specPtr; elementImpl->clientData = clientData; elementImpl->elementRecord = ckalloc(specPtr->elementSize); /* Count #element resources: */ for (i = 0; specPtr->options[i].optionName != 0; ++i) continue; elementImpl->nResources = i; /* Initialize default values: */ elementImpl->defaultValues = (Tcl_Obj**) ckalloc(elementImpl->nResources * sizeof(Tcl_Obj *)); for (i=0; i < elementImpl->nResources; ++i) { const char *defaultValue = specPtr->options[i].defaultValue; if (defaultValue) { elementImpl->defaultValues[i] = Tcl_NewStringObj(defaultValue,-1); Tcl_IncrRefCount(elementImpl->defaultValues[i]); } else { elementImpl->defaultValues[i] = 0; } } /* Initialize option map cache: */ Tcl_InitHashTable(&elementImpl->optMapCache, TCL_ONE_WORD_KEYS); return elementImpl; } /* * FreeElementImpl -- * Release resources associated with an element implementation record. */ static void FreeElementImpl(ElementImpl *elementImpl) { Tcl_HashSearch search; Tcl_HashEntry *entryPtr; int i; /* * Free default values: */ for (i = 0; i < elementImpl->nResources; ++i) { if (elementImpl->defaultValues[i]) { Tcl_DecrRefCount(elementImpl->defaultValues[i]); } } ckfree((ClientData)elementImpl->defaultValues); /* * Free option map cache: */ entryPtr = Tcl_FirstHashEntry(&elementImpl->optMapCache, &search); while (entryPtr != NULL) { ckfree(Tcl_GetHashValue(entryPtr)); entryPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&elementImpl->optMapCache); ckfree(elementImpl->elementRecord); ckfree((ClientData)elementImpl); } /*------------------------------------------------------------------------ * +++ Themes. */ static int ThemeEnabled(Ttk_Theme theme, void *clientData) { return 1; } /* Default ThemeEnabledProc -- always return true */ typedef struct Ttk_Theme_ { Ttk_Theme parentPtr; /* Parent theme. */ Tcl_HashTable elementTable; /* Map element names to ElementImpls */ Tcl_HashTable styleTable; /* Map style names to Styles */ Ttk_Style rootStyle; /* "." style, root of chain */ Ttk_ThemeEnabledProc *enabledProc; /* Function called by SetTheme */ void *enabledData; /* ClientData for enabledProc */ Ttk_ResourceCache cache; /* Back-pointer to resource cache */ } Theme; static Theme *NewTheme(Ttk_ResourceCache cache, Ttk_Theme parent) { Theme *themePtr = (Theme*)ckalloc(sizeof(Theme)); Tcl_HashEntry *entryPtr; int unused; themePtr->parentPtr = parent; themePtr->enabledProc = ThemeEnabled; themePtr->enabledData = NULL; themePtr->cache = cache; Tcl_InitHashTable(&themePtr->elementTable, TCL_STRING_KEYS); Tcl_InitHashTable(&themePtr->styleTable, TCL_STRING_KEYS); /* * Create root style "." */ entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, ".", &unused); themePtr->rootStyle = NewStyle(); themePtr->rootStyle->styleName = Tcl_GetHashKey(&themePtr->styleTable, entryPtr); themePtr->rootStyle->cache = themePtr->cache; Tcl_SetHashValue(entryPtr, (ClientData)themePtr->rootStyle); return themePtr; } static void FreeTheme(Theme *themePtr) { Tcl_HashSearch search; Tcl_HashEntry *entryPtr; /* * Free associated ElementImpl's */ entryPtr = Tcl_FirstHashEntry(&themePtr->elementTable, &search); while (entryPtr != NULL) { ElementImpl *elementImpl = (ElementImpl *)Tcl_GetHashValue(entryPtr); FreeElementImpl(elementImpl); entryPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&themePtr->elementTable); /* * Free style table: */ entryPtr = Tcl_FirstHashEntry(&themePtr->styleTable, &search); while (entryPtr != NULL) { Style *stylePtr = (Style*)Tcl_GetHashValue(entryPtr); FreeStyle(stylePtr); entryPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&themePtr->styleTable); /* * Free theme record: */ ckfree((char *)themePtr); return; } /* * Element constructors. */ typedef struct { Ttk_ElementFactory factory; void *clientData; } FactoryRec; /* * Cleanup records: */ typedef struct CleanupStruct { void *clientData; Ttk_CleanupProc *cleanupProc; struct CleanupStruct *next; } Cleanup; /*------------------------------------------------------------------------ * +++ Master style package data structure. */ typedef struct { Tcl_Interp *interp; /* Owner interp */ Tcl_HashTable themeTable; /* KEY: name; VALUE: Theme pointer */ Tcl_HashTable factoryTable; /* KEY: name; VALUE: FactoryRec ptr */ Theme *defaultTheme; /* Default theme; global fallback*/ Theme *currentTheme; /* Currently-selected theme */ Cleanup *cleanupList; /* Cleanup records */ Ttk_ResourceCache cache; /* Resource cache */ int themeChangePending; /* scheduled ThemeChangedProc call? */ } StylePackageData; static void ThemeChangedProc(ClientData); /* Forward */ /* Ttk_StylePkgFree -- * Cleanup procedure for StylePackageData. */ static void Ttk_StylePkgFree(ClientData clientData, Tcl_Interp *interp) { StylePackageData *pkgPtr = (StylePackageData *)clientData; Tcl_HashSearch search; Tcl_HashEntry *entryPtr; Theme *themePtr; Cleanup *cleanup; /* * Cancel any pending ThemeChanged calls: */ if (pkgPtr->themeChangePending) { Tcl_CancelIdleCall(ThemeChangedProc, pkgPtr); } /* * Free themes. */ entryPtr = Tcl_FirstHashEntry(&pkgPtr->themeTable, &search); while (entryPtr != NULL) { themePtr = (Theme *) Tcl_GetHashValue(entryPtr); FreeTheme(themePtr); entryPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&pkgPtr->themeTable); /* * Free element constructor table: */ entryPtr = Tcl_FirstHashEntry(&pkgPtr->factoryTable, &search); while (entryPtr != NULL) { ckfree(Tcl_GetHashValue(entryPtr)); entryPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&pkgPtr->factoryTable); /* * Release cache: */ Ttk_FreeResourceCache(pkgPtr->cache); /* * Call all registered cleanup procedures: */ cleanup = pkgPtr->cleanupList; while (cleanup) { Cleanup *next = cleanup->next; cleanup->cleanupProc(cleanup->clientData); ckfree((ClientData)cleanup); cleanup = next; } ckfree((char*)pkgPtr); } /* * GetStylePackageData -- * Look up the package data registered with the interp. */ static StylePackageData *GetStylePackageData(Tcl_Interp *interp) { return (StylePackageData*)Tcl_GetAssocData(interp, "StylePackage", NULL); } /* * Ttk_RegisterCleanup -- * * Register a function to be called when a theme engine is deleted. * (This only happens when the main interp is destroyed). The cleanup * function is called with the current Tcl interpreter and the client * data provided here. * */ void Ttk_RegisterCleanup( Tcl_Interp *interp, ClientData clientData, Ttk_CleanupProc *cleanupProc) { StylePackageData *pkgPtr = GetStylePackageData(interp); Cleanup *cleanup = (Cleanup*)ckalloc(sizeof(*cleanup)); cleanup->clientData = clientData; cleanup->cleanupProc = cleanupProc; cleanup->next = pkgPtr->cleanupList; pkgPtr->cleanupList = cleanup; } /* ThemeChangedProc -- * Notify all widgets that the theme has been changed. * Scheduled as an idle callback; clientData is a StylePackageData *. * * Sends a <> event to every widget in the hierarchy. * Widgets respond to this by calling the WorldChanged class proc, * which in turn recreates the layout. * * The Tk C API doesn't doesn't provide an easy way to traverse * the widget hierarchy, so this is done by evaluating a Tcl script. */ static void ThemeChangedProc(ClientData clientData) { static char ThemeChangedScript[] = "ttk::ThemeChanged"; StylePackageData *pkgPtr = (StylePackageData *)clientData; if (Tcl_GlobalEval(pkgPtr->interp, ThemeChangedScript) != TCL_OK) { Tcl_BackgroundError(pkgPtr->interp); } pkgPtr->themeChangePending = 0; } /* * ThemeChanged -- * Schedule a call to ThemeChanged if one is not already pending. */ static void ThemeChanged(StylePackageData *pkgPtr) { if (!pkgPtr->themeChangePending) { Tcl_DoWhenIdle(ThemeChangedProc, pkgPtr); pkgPtr->themeChangePending = 1; } } /* * Ttk_CreateTheme -- * Create a new theme and register it in the global theme table. * * Returns: * Pointer to new Theme structure; NULL if named theme already exists. * Leaves an error message in interp's result on error. */ Ttk_Theme Ttk_CreateTheme( Tcl_Interp *interp, /* Interpreter in which to create theme */ const char *name, /* Name of the theme to create. */ Ttk_Theme parent) /* Parent/fallback theme, NULL for default */ { StylePackageData *pkgPtr = GetStylePackageData(interp); Tcl_HashEntry *entryPtr; int newEntry; Theme *themePtr; entryPtr = Tcl_CreateHashEntry(&pkgPtr->themeTable, name, &newEntry); if (!newEntry) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Theme ", name, " already exists", NULL); return NULL; } /* * Initialize new theme: */ if (!parent) parent = pkgPtr->defaultTheme; themePtr = NewTheme(pkgPtr->cache, parent); Tcl_SetHashValue(entryPtr, (ClientData) themePtr); return themePtr; } /* * Ttk_SetThemeEnabledProc -- * Sets a procedure that is used to check that this theme is available. */ void Ttk_SetThemeEnabledProc( Ttk_Theme theme, Ttk_ThemeEnabledProc enabledProc, void *enabledData) { theme->enabledProc = enabledProc; theme->enabledData = enabledData; } /* * LookupTheme -- * Retrieve a registered theme by name. If not found, * returns NULL and leaves an error message in interp's result. */ static Ttk_Theme LookupTheme( Tcl_Interp *interp, /* where to leave error messages */ StylePackageData *pkgPtr, /* style package master record */ const char *name) /* theme name */ { Tcl_HashEntry *entryPtr; entryPtr = Tcl_FindHashEntry(&pkgPtr->themeTable, name); if (!entryPtr) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "theme \"", name, "\" doesn't exist", NULL); return NULL; } return (Ttk_Theme)Tcl_GetHashValue(entryPtr); } /* * Ttk_GetTheme -- * Public interface to LookupTheme. */ Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *themeName) { StylePackageData *pkgPtr = GetStylePackageData(interp); return LookupTheme(interp, pkgPtr, themeName); } Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp) { StylePackageData *pkgPtr = GetStylePackageData(interp); return pkgPtr->currentTheme; } Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp) { StylePackageData *pkgPtr = GetStylePackageData(interp); return pkgPtr->defaultTheme; } /* * Ttk_UseTheme -- * Set the current theme, notify all widgets that the theme has changed. */ int Ttk_UseTheme(Tcl_Interp *interp, Ttk_Theme theme) { StylePackageData *pkgPtr = GetStylePackageData(interp); /* * Check if selected theme is enabled: */ while (theme && !theme->enabledProc(theme, theme->enabledData)) { theme = theme->parentPtr; } if (!theme) { /* This shouldn't happen -- default theme should always work */ Tcl_Panic("No themes available?"); return TCL_ERROR; } pkgPtr->currentTheme = theme; ThemeChanged(pkgPtr); return TCL_OK; } /* * Ttk_GetResourceCache -- * Return the resource cache associated with 'interp' */ Ttk_ResourceCache Ttk_GetResourceCache(Tcl_Interp *interp) { StylePackageData *pkgPtr = GetStylePackageData(interp); return pkgPtr->cache; } /* * Register a new layout specification with a style. * @@@ TODO: Make sure layoutName is not ".", root style must not have a layout */ static void Ttk_RegisterLayoutTemplate( Ttk_Theme theme, /* Target theme */ const char *layoutName, /* Name of new layout */ Ttk_LayoutTemplate layoutTemplate) /* Template */ { Ttk_Style style = Ttk_GetStyle(theme, layoutName); if (style->layoutTemplate) { Ttk_FreeLayoutTemplate(style->layoutTemplate); } style->layoutTemplate = layoutTemplate; } void Ttk_RegisterLayout( Ttk_Theme themePtr, /* Target theme */ const char *layoutName, /* Name of new layout */ Ttk_LayoutSpec specPtr) /* Static layout information */ { Ttk_LayoutTemplate layoutTemplate = Ttk_BuildLayoutTemplate(specPtr); Ttk_RegisterLayoutTemplate(themePtr, layoutName, layoutTemplate); } /* * Ttk_GetStyle -- * Look up a Style from a Theme, create new style if not found. */ Ttk_Style Ttk_GetStyle(Ttk_Theme themePtr, const char *styleName) { Tcl_HashEntry *entryPtr; int newStyle; entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, styleName, &newStyle); if (newStyle) { Ttk_Style stylePtr = NewStyle(); const char *dot = strchr(styleName, '.'); if (dot) { stylePtr->parentStyle = Ttk_GetStyle(themePtr, dot + 1); } else { stylePtr->parentStyle = themePtr->rootStyle; } stylePtr->styleName = Tcl_GetHashKey(&themePtr->styleTable, entryPtr); stylePtr->cache = stylePtr->parentStyle->cache; Tcl_SetHashValue(entryPtr, (ClientData)stylePtr); return stylePtr; } return (Style*)Tcl_GetHashValue(entryPtr); } /* FindLayoutTemplate -- * Locate a layout template in the layout table, checking * generic names to specific names first, then looking for * the full name in the parent theme. */ Ttk_LayoutTemplate Ttk_FindLayoutTemplate(Ttk_Theme themePtr, const char *layoutName) { while (themePtr) { Ttk_Style stylePtr = Ttk_GetStyle(themePtr, layoutName); while (stylePtr) { if (stylePtr->layoutTemplate) { return stylePtr->layoutTemplate; } stylePtr = stylePtr->parentStyle; } themePtr = themePtr->parentPtr; } return NULL; } const char *Ttk_StyleName(Ttk_Style stylePtr) { return stylePtr->styleName; } /* * Ttk_GetElement -- * Look up an element implementation by name in a given theme. * If not found, try generic element names in this theme, then * repeat the lookups in the parent theme. * If not found, return the null element. */ Ttk_ElementImpl Ttk_GetElement(Ttk_Theme themePtr, const char *elementName) { Tcl_HashEntry *entryPtr; const char *dot = elementName; /* * Check if element has already been registered: */ entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, elementName); if (entryPtr) { return (Ttk_ElementImpl)Tcl_GetHashValue(entryPtr); } /* * Check generic names: */ while (!entryPtr && ((dot = strchr(dot, '.')) != NULL)) { dot++; entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, dot); } if (entryPtr) { return (ElementImpl *)Tcl_GetHashValue(entryPtr); } /* * Check parent theme: */ if (themePtr->parentPtr) { return Ttk_GetElement(themePtr->parentPtr, elementName); } /* * Not found, and this is the root theme; return null element, "". * (@@@ SHOULD: signal a background error) */ entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, ""); /* ASSERT: entryPtr != 0 */ return (Ttk_ElementImpl)Tcl_GetHashValue(entryPtr); } const char *Ttk_ElementName(ElementImpl *elementImpl) { return elementImpl->name; } /* * Ttk_RegisterElementFactory -- * Register a new element factory. */ int Ttk_RegisterElementFactory( Tcl_Interp *interp, const char *name, Ttk_ElementFactory factory, void *clientData) { StylePackageData *pkgPtr = GetStylePackageData(interp); FactoryRec *recPtr = (FactoryRec*)ckalloc(sizeof(*recPtr)); Tcl_HashEntry *entryPtr; int newEntry; recPtr->factory = factory; recPtr->clientData = clientData; entryPtr = Tcl_CreateHashEntry(&pkgPtr->factoryTable, name, &newEntry); if (!newEntry) { /* Free old factory: */ ckfree(Tcl_GetHashValue(entryPtr)); } Tcl_SetHashValue(entryPtr, recPtr); return TCL_OK; } /* Ttk_CloneElement -- element factory procedure. * (style element create $name) "from" $theme ?$element? */ static int Ttk_CloneElement( Tcl_Interp *interp, void *clientData, Ttk_Theme theme, const char *elementName, int objc, Tcl_Obj *CONST objv[]) { Ttk_Theme fromTheme; ElementImpl *fromElement; if (objc <= 0 || objc > 2) { Tcl_WrongNumArgs(interp, 0, objv, "theme ?element?"); return TCL_ERROR; } fromTheme = Ttk_GetTheme(interp, Tcl_GetString(objv[0])); if (!fromTheme) { return TCL_ERROR; } if (objc == 2) { fromElement = Ttk_GetElement(fromTheme, Tcl_GetString(objv[1])); } else { fromElement = Ttk_GetElement(fromTheme, elementName); } if (!fromElement) { return TCL_ERROR; } if (Ttk_RegisterElement(interp, theme, elementName, fromElement->specPtr, fromElement->clientData) == NULL) { return TCL_ERROR; } return TCL_OK; } /* Ttk_RegisterElement-- * Register an element in the given theme. * Returns: Element handle if successful, NULL otherwise. * On failure, leaves an error message in interp's result * if interp is non-NULL. */ Ttk_ElementImpl Ttk_RegisterElement( Tcl_Interp *interp, /* Where to leave error messages */ Ttk_Theme theme, /* Style engine providing the implementation. */ const char *name, /* Name of new element */ Ttk_ElementSpec *specPtr, /* Static template information */ void *clientData) /* application-specific data */ { ElementImpl *elementImpl; Tcl_HashEntry *entryPtr; int newEntry; if (specPtr->version != TK_STYLE_VERSION_2) { /* Version mismatch */ if (interp) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Internal error: Ttk_RegisterElement (", name, "): invalid version", NULL); } return 0; } entryPtr = Tcl_CreateHashEntry(&theme->elementTable, name, &newEntry); if (!newEntry) { if (interp) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "Duplicate element ", name, NULL); } return 0; } name = Tcl_GetHashKey(&theme->elementTable, entryPtr); elementImpl = NewElementImpl(name, specPtr, clientData); Tcl_SetHashValue(entryPtr, elementImpl); return elementImpl; } /* Ttk_RegisterElementSpec (deprecated) -- * Register a new element. */ int Ttk_RegisterElementSpec(Ttk_Theme theme, const char *name, Ttk_ElementSpec *specPtr, void *clientData) { return Ttk_RegisterElement(NULL, theme, name, specPtr, clientData) ? TCL_OK : TCL_ERROR; } /*------------------------------------------------------------------------ * +++ Element record initialization. */ /* * AllocateResource -- * Extra initialization for element options like TK_OPTION_COLOR, etc. * * Returns: 1 if OK, 0 on failure. * * Note: if resource allocation fails at this point (just prior * to drawing an element), there's really no good place to * report the error. Instead we just silently fail. */ static int AllocateResource( Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj **destPtr, int optionType) { Tcl_Obj *resource = *destPtr; switch (optionType) { case TK_OPTION_FONT: return (*destPtr = Ttk_UseFont(cache, tkwin, resource)) != NULL; case TK_OPTION_COLOR: return (*destPtr = Ttk_UseColor(cache, tkwin, resource)) != NULL; case TK_OPTION_BORDER: return (*destPtr = Ttk_UseBorder(cache, tkwin, resource)) != NULL; default: /* no-op; always succeeds */ return 1; } } /* * InitializeElementRecord -- * * Fill in the element record based on the element's option table. * Resources are initialized from: * the corresponding widget option if present and non-NULL, * otherwise the dynamic state map if specified, * otherwise from the corresponding widget resource if present, * otherwise the default value specified at registration time. * * Returns: * 1 if OK, 0 if an error is detected. * * NOTES: * Tcl_Obj * reference counts are _NOT_ adjusted. */ static int InitializeElementRecord( ElementImpl *element, /* Element instance to initialize */ Ttk_Style style, /* Style table */ char *widgetRecord, /* Source of widget option values */ Tk_OptionTable optionTable, /* Option table describing widget record */ Tk_Window tkwin, /* Corresponding window */ Ttk_State state) /* Widget or element state */ { char *elementRecord = element->elementRecord; OptionMap optionMap = GetOptionMap(element,optionTable); int nResources = element->nResources; Ttk_ResourceCache cache = style->cache; Ttk_ElementOptionSpec *elementOption = element->specPtr->options; int i; for (i=0; ioffset); const char *optionName = elementOption->optionName; Tcl_Obj *stateMap = LookupStateMap(style, optionName); Tcl_Obj *dynamicSetting = 0; Tcl_Obj *widgetValue = 0; Tcl_Obj *elementDefault = element->defaultValues[i]; if (stateMap) { dynamicSetting = Ttk_StateMapLookup(NULL, stateMap, state); } if (optionMap[i]) { widgetValue = *(Tcl_Obj **) (widgetRecord + optionMap[i]->objOffset); } if (widgetValue) { *dest = widgetValue; } else if (dynamicSetting) { *dest = dynamicSetting; } else { Tcl_Obj *styleDefault = LookupDefault(style, optionName); *dest = styleDefault ? styleDefault : elementDefault; } if (!AllocateResource(cache, tkwin, dest, (int) elementOption->type)) { return 0; } } return 1; } /*------------------------------------------------------------------------ * +++ Public API. */ /* * Ttk_QueryStyle -- * Look up a style option based on the current state. */ Tcl_Obj *Ttk_QueryStyle( Ttk_Style style, /* Style to query */ void *recordPtr, /* Widget record */ Tk_OptionTable optionTable, /* Option table describing widget record */ const char *optionName, /* Option name */ Ttk_State state) /* Current state */ { Tcl_Obj *stateMap; const Tk_OptionSpec *optionSpec; Tcl_Obj *result; /* * Check widget record: */ optionSpec = TTKGetOptionSpec(optionName, optionTable, TK_OPTION_ANY); if (optionSpec) { result = *(Tcl_Obj**)(((char*)recordPtr) + optionSpec->objOffset); if (result) { return result; } } /* * Check dynamic settings: */ stateMap = LookupStateMap(style, optionName); if (stateMap) { result = Ttk_StateMapLookup(NULL, stateMap, state); if (result) { return result; } } /* * Use style default: */ return LookupDefault(style, optionName); } /* * Ttk_ElementSize -- * Compute the requested size of the given element. */ void Ttk_ElementSize( ElementImpl *element, /* Element to query */ Ttk_Style style, /* Style settings */ char *recordPtr, /* The widget record. */ Tk_OptionTable optionTable, /* Description of widget record */ Tk_Window tkwin, /* The widget window. */ Ttk_State state, /* Current widget state */ int *widthPtr, /* Requested width */ int *heightPtr, /* Reqested height */ Ttk_Padding *paddingPtr) /* Requested inner border */ { paddingPtr->left = paddingPtr->right = paddingPtr->top = paddingPtr->bottom = *widthPtr = *heightPtr = 0; if (!InitializeElementRecord(element, style, recordPtr, optionTable, tkwin, state)) return; element->specPtr->size( element->clientData, element->elementRecord, tkwin, widthPtr, heightPtr, paddingPtr); *widthPtr += paddingPtr->left + paddingPtr->right; *heightPtr += paddingPtr->top + paddingPtr->bottom; } /* * Ttk_DrawElement -- * Draw the given widget element in a given drawable area. */ void Ttk_DrawElement( ElementImpl *element, /* Element instance */ Ttk_Style style, /* Style settings */ char *recordPtr, /* The widget record. */ Tk_OptionTable optionTable, /* Description of option table */ Tk_Window tkwin, /* The widget window. */ Drawable d, /* Where to draw element. */ Ttk_Box b, /* Element area */ Ttk_State state) /* Widget or element state flags. */ { if (b.width <= 0 || b.height <= 0) return; if (!InitializeElementRecord(element, style, recordPtr, optionTable, tkwin, state)) return; element->specPtr->draw( element->clientData, element->elementRecord, tkwin, d, b, state); } /*------------------------------------------------------------------------ * +++ 'style' command ensemble procedures. */ /* * EnumerateHashTable -- * Helper routine. Sets interp's result to the list of all keys * in the hash table. * * Returns: TCL_OK. * Side effects: Sets interp's result. */ static int EnumerateHashTable(Tcl_Interp *interp, Tcl_HashTable *ht) { Tcl_HashSearch search; Tcl_Obj *result = Tcl_NewListObj(0, NULL); Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search); while (entryPtr != NULL) { Tcl_Obj *nameObj = Tcl_NewStringObj(Tcl_GetHashKey(ht, entryPtr),-1); Tcl_ListObjAppendElement(interp, result, nameObj); entryPtr = Tcl_NextHashEntry(&search); } Tcl_SetObjResult(interp, result); return TCL_OK; } /* HashTableToDict -- * Helper routine. Converts a TCL_STRING_KEYS Tcl_HashTable * with Tcl_Obj * entries into a dictionary. */ static Tcl_Obj* HashTableToDict(Tcl_HashTable *ht) { Tcl_HashSearch search; Tcl_Obj *result = Tcl_NewListObj(0, NULL); Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search); while (entryPtr != NULL) { Tcl_Obj *nameObj = Tcl_NewStringObj(Tcl_GetHashKey(ht, entryPtr),-1); Tcl_Obj *valueObj = (Tcl_Obj*)Tcl_GetHashValue(entryPtr); Tcl_ListObjAppendElement(NULL, result, nameObj); Tcl_ListObjAppendElement(NULL, result, valueObj); entryPtr = Tcl_NextHashEntry(&search); } return result; } /* + style map $style ? -resource statemap ... ? * * Note that resource names are unconstrained; the Style * doesn't know what resources individual elements may use. */ static int StyleMapCmd( ClientData clientData, /* Master StylePackageData pointer */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj * CONST objv[]) /* Argument objects */ { StylePackageData *pkgPtr = (StylePackageData *)clientData; Ttk_Theme theme = pkgPtr->currentTheme; const char *styleName; Style *stylePtr; int i; if (objc < 3) { usage: Tcl_WrongNumArgs(interp,2,objv,"style ?-option ?value...??"); return TCL_ERROR; } styleName = Tcl_GetString(objv[2]); stylePtr = Ttk_GetStyle(theme, styleName); /* NOTE: StateMaps are actually Tcl_Obj *s, so HashTableToDict works * for settingsTable. */ if (objc == 3) { /* style map $styleName */ Tcl_SetObjResult(interp, HashTableToDict(&stylePtr->settingsTable)); return TCL_OK; } else if (objc == 4) { /* style map $styleName -option */ const char *optionName = Tcl_GetString(objv[3]); Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&stylePtr->settingsTable, optionName); if (entryPtr) { Tcl_SetObjResult(interp, (Tcl_Obj*)Tcl_GetHashValue(entryPtr)); } return TCL_OK; } else if (objc % 2 != 1) { goto usage; } for (i = 3; i < objc; i += 2) { const char *optionName = Tcl_GetString(objv[i]); Tcl_Obj *stateMap = objv[i+1]; Tcl_HashEntry *entryPtr; int newEntry; /* Make sure 'stateMap' is legal: * (@@@ SHOULD: check for valid resource values as well, * but we don't know what types they should be at this level.) */ if (!Ttk_GetStateMapFromObj(interp, stateMap)) return TCL_ERROR; entryPtr = Tcl_CreateHashEntry( &stylePtr->settingsTable,optionName,&newEntry); Tcl_IncrRefCount(stateMap); if (!newEntry) { Tcl_DecrRefCount((Tcl_Obj*)Tcl_GetHashValue(entryPtr)); } Tcl_SetHashValue(entryPtr, stateMap); } ThemeChanged(pkgPtr); return TCL_OK; } /* + style configure $style -option ?value... */ static int StyleConfigureCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { StylePackageData *pkgPtr = (StylePackageData *)clientData; Ttk_Theme theme = pkgPtr->currentTheme; const char *styleName; Style *stylePtr; int i; if (objc < 3) { usage: Tcl_WrongNumArgs(interp,2,objv,"style ?-option ?value...??"); return TCL_ERROR; } styleName = Tcl_GetString(objv[2]); stylePtr = Ttk_GetStyle(theme, styleName); if (objc == 3) { /* style default $styleName */ Tcl_SetObjResult(interp, HashTableToDict(&stylePtr->defaultsTable)); return TCL_OK; } else if (objc == 4) { /* style default $styleName -option */ const char *optionName = Tcl_GetString(objv[3]); Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&stylePtr->defaultsTable, optionName); if (entryPtr) { Tcl_SetObjResult(interp, (Tcl_Obj*)Tcl_GetHashValue(entryPtr)); } return TCL_OK; } else if (objc % 2 != 1) { goto usage; } for (i = 3; i < objc; i += 2) { const char *optionName = Tcl_GetString(objv[i]); Tcl_Obj *value = objv[i+1]; Tcl_HashEntry *entryPtr; int newEntry; entryPtr = Tcl_CreateHashEntry( &stylePtr->defaultsTable,optionName,&newEntry); Tcl_IncrRefCount(value); if (!newEntry) { Tcl_DecrRefCount((Tcl_Obj*)Tcl_GetHashValue(entryPtr)); } Tcl_SetHashValue(entryPtr, value); } ThemeChanged(pkgPtr); return TCL_OK; } /* + style lookup $style -option ?statespec? ?defaultValue? */ static int StyleLookupCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { StylePackageData *pkgPtr = clientData; Ttk_Theme theme = pkgPtr->currentTheme; Ttk_Style style = NULL; const char *optionName; Ttk_State state = 0ul; Tcl_Obj *result; if (objc < 4 || objc > 6) { Tcl_WrongNumArgs(interp, 2, objv, "style -option ?state? ?default?"); return TCL_ERROR; } style = Ttk_GetStyle(theme, Tcl_GetString(objv[2])); if (!style) { return TCL_ERROR; } optionName = Tcl_GetString(objv[3]); if (objc >= 5) { Ttk_StateSpec stateSpec; /* @@@ SB: Ttk_GetStateFromObj(); 'offbits' spec is ignored */ if (Ttk_GetStateSpecFromObj(interp, objv[4], &stateSpec) != TCL_OK) { return TCL_ERROR; } state = stateSpec.onbits; } result = Ttk_QueryStyle(style, NULL,NULL, optionName, state); if (result == NULL && objc >= 6) { /* Use caller-supplied fallback */ result = objv[5]; } if (result) { Tcl_SetObjResult(interp, result); } return TCL_OK; } /* + style theme create name ?-parent $theme? ?-settings { script }? */ static int StyleThemeCreateCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { StylePackageData *pkgPtr = (StylePackageData *)clientData; static const char *optStrings[] = { "-parent", "-settings", NULL }; enum { OP_PARENT, OP_SETTINGS }; Ttk_Theme parentTheme = pkgPtr->defaultTheme, newTheme; Tcl_Obj *settingsScript = NULL; const char *themeName; int i; if (objc < 4 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 3, objv, "name ?options?"); return TCL_ERROR; } themeName = Tcl_GetString(objv[3]); for (i=4; i < objc; i +=2) { int option; if (Tcl_GetIndexFromObj( interp, objv[i], optStrings, "option", 0, &option) != TCL_OK) { return TCL_ERROR; } switch (option) { case OP_PARENT: parentTheme = LookupTheme( interp, pkgPtr, Tcl_GetString(objv[i+1])); if (!parentTheme) return TCL_ERROR; break; case OP_SETTINGS: settingsScript = objv[i+1]; break; } } newTheme = Ttk_CreateTheme(interp, themeName, parentTheme); if (!newTheme) { return TCL_ERROR; } /* * Evaluate the -settings script, if supplied: */ if (settingsScript) { Ttk_Theme oldTheme = pkgPtr->currentTheme; int status; pkgPtr->currentTheme = newTheme; status = Tcl_EvalObjEx(interp, settingsScript, 0); pkgPtr->currentTheme = oldTheme; return status; } else { return TCL_OK; } } /* + style theme names -- * Return list of registered themes. */ static int StyleThemeNamesCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { StylePackageData *pkgPtr = clientData; return EnumerateHashTable(interp, &pkgPtr->themeTable); } /* + style theme settings $theme $script * * Temporarily sets the current theme to $themeName, * evaluates $script, then restores the old theme. */ static int StyleThemeSettingsCmd( ClientData clientData, /* Master StylePackageData pointer */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj * CONST objv[]) /* Argument objects */ { StylePackageData *pkgPtr = (StylePackageData *)clientData; Ttk_Theme oldTheme = pkgPtr->currentTheme; Ttk_Theme newTheme; int status; if (objc != 5) { Tcl_WrongNumArgs(interp, 3, objv, "theme script"); return TCL_ERROR; } newTheme = LookupTheme(interp, pkgPtr, Tcl_GetString(objv[3])); if (!newTheme) return TCL_ERROR; pkgPtr->currentTheme = newTheme; status = Tcl_EvalObjEx(interp, objv[4], 0); pkgPtr->currentTheme = oldTheme; return status; } /* + style element create name type ? ...args ? */ static int StyleElementCreateCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { StylePackageData *pkgPtr = (StylePackageData *)clientData; Ttk_Theme theme = pkgPtr->currentTheme; const char *elementName, *factoryName; Tcl_HashEntry *entryPtr; FactoryRec *recPtr; if (objc < 5) { Tcl_WrongNumArgs(interp, 5, objv, "name type ?options...?"); return TCL_ERROR; } elementName = Tcl_GetString(objv[3]); factoryName = Tcl_GetString(objv[4]); entryPtr = Tcl_FindHashEntry(&pkgPtr->factoryTable, factoryName); if (!entryPtr) { Tcl_AppendResult(interp, "No such element type ", factoryName, NULL); return TCL_ERROR; } recPtr = (FactoryRec *)Tcl_GetHashValue(entryPtr); return recPtr->factory(interp, recPtr->clientData, theme, elementName, objc - 5, objv + 5); } /* + style element names -- * Return a list of elements defined in the current theme. */ static int StyleElementNamesCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { StylePackageData *pkgPtr = (StylePackageData *)clientData; Ttk_Theme theme = pkgPtr->currentTheme; if (objc != 3) { Tcl_WrongNumArgs(interp, 3, objv, NULL); return TCL_ERROR; } return EnumerateHashTable(interp, &theme->elementTable); } /* + style element options $element -- */ static int StyleElementOptionsCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { StylePackageData *pkgPtr = (StylePackageData *)clientData; Ttk_Theme theme = pkgPtr->currentTheme; Tcl_HashEntry *entryPtr; if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "element"); return TCL_ERROR; } entryPtr = Tcl_FindHashEntry(&theme->elementTable, Tcl_GetString(objv[3])); if (entryPtr) { ElementImpl *elementImpl = (ElementImpl *)Tcl_GetHashValue(entryPtr); Ttk_ElementSpec *specPtr = elementImpl->specPtr; Ttk_ElementOptionSpec *option = specPtr->options; Tcl_Obj *result = Tcl_NewListObj(0,0); while (option->optionName) { Tcl_ListObjAppendElement( interp, result, Tcl_NewStringObj(option->optionName,-1)); ++option; } Tcl_SetObjResult(interp, result); return TCL_OK; } Tcl_AppendResult(interp, "element ", Tcl_GetString(objv[3]), " not found", NULL); return TCL_ERROR; } /* + style layout name ?spec? */ static int StyleLayoutCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) { StylePackageData *pkgPtr = (StylePackageData *)clientData; Ttk_Theme theme = pkgPtr->currentTheme; const char *layoutName; Ttk_LayoutTemplate layoutTemplate; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "name ?spec?"); return TCL_ERROR; } layoutName = Tcl_GetString(objv[2]); if (objc == 3) { layoutTemplate = Ttk_FindLayoutTemplate(theme, layoutName); if (!layoutTemplate) { Tcl_AppendResult(interp, "Layout ", layoutName, " not found", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Ttk_UnparseLayoutTemplate(layoutTemplate)); } else { layoutTemplate = Ttk_ParseLayoutTemplate(interp, objv[3]); if (!layoutTemplate) { return TCL_ERROR; } Ttk_RegisterLayoutTemplate(theme, layoutName, layoutTemplate); ThemeChanged(pkgPtr); } return TCL_OK; } /* + style theme use $theme -- * Sets the current theme to $theme */ static int StyleThemeUseCmd( ClientData clientData, /* Master StylePackageData pointer */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj * CONST objv[]) /* Argument objects */ { StylePackageData *pkgPtr = clientData; Ttk_Theme theme; if (objc != 4) { Tcl_WrongNumArgs(interp, 3, objv, "theme"); return TCL_ERROR; } theme = LookupTheme(interp, pkgPtr, Tcl_GetString(objv[3])); if (!theme) { return TCL_ERROR; } return Ttk_UseTheme(interp, theme); } /* * StyleObjCmd -- * Implementation of the [style] command. */ struct Ensemble { const char *name; /* subcommand name */ Tcl_ObjCmdProc *command; /* subcommand implementation, OR: */ struct Ensemble *ensemble; /* subcommand ensemble */ }; static struct Ensemble StyleThemeEnsemble[] = { { "create", StyleThemeCreateCmd, 0 }, { "names", StyleThemeNamesCmd, 0 }, { "settings", StyleThemeSettingsCmd, 0 }, { "use", StyleThemeUseCmd, 0 }, { NULL, 0, 0 } }; static struct Ensemble StyleElementEnsemble[] = { { "create", StyleElementCreateCmd, 0 }, { "names", StyleElementNamesCmd, 0 }, { "options", StyleElementOptionsCmd, 0 }, { NULL, 0, 0 } }; static struct Ensemble StyleEnsemble[] = { { "configure", StyleConfigureCmd, 0 }, { "map", StyleMapCmd, 0 }, { "lookup", StyleLookupCmd, 0 }, { "layout", StyleLayoutCmd, 0 }, { "theme", 0, StyleThemeEnsemble }, { "element", 0, StyleElementEnsemble }, { NULL, 0, 0 } }; static int StyleObjCmd( ClientData clientData, /* Master StylePackageData pointer */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj * CONST objv[]) /* Argument objects */ { struct Ensemble *ensemble = StyleEnsemble; int optPtr = 1; int index; while (optPtr < objc) { if (Tcl_GetIndexFromObjStruct(interp, objv[optPtr], ensemble, sizeof(ensemble[0]), "command", 0, &index) != TCL_OK) { return TCL_ERROR; } if (ensemble[index].command) { return ensemble[index].command(clientData, interp, objc, objv); } ensemble = ensemble[index].ensemble; ++optPtr; } Tcl_WrongNumArgs(interp, optPtr, objv, "option ?arg arg...?"); return TCL_ERROR; } /* * Ttk_StylePkgInit -- * Initializes all the structures that are used by the style * package on a per-interp basis. */ void Ttk_StylePkgInit(Tcl_Interp *interp) { Tcl_Namespace *nsPtr; StylePackageData *pkgPtr = (StylePackageData *) ckalloc(sizeof(StylePackageData)); pkgPtr->interp = interp; Tcl_InitHashTable(&pkgPtr->themeTable, TCL_STRING_KEYS); Tcl_InitHashTable(&pkgPtr->factoryTable, TCL_STRING_KEYS); pkgPtr->cleanupList = NULL; pkgPtr->cache = Ttk_CreateResourceCache(interp); pkgPtr->themeChangePending = 0; Tcl_SetAssocData(interp, "StylePackage", Ttk_StylePkgFree, (ClientData)pkgPtr); /* * Create the default system theme: * * pkgPtr->defaultTheme must be initialized to 0 before * calling Ttk_CreateTheme for the first time, since it's used * as the parent theme. */ pkgPtr->defaultTheme = 0; pkgPtr->defaultTheme = pkgPtr->currentTheme = Ttk_CreateTheme(interp, "default", NULL); /* * Register null element, used as a last-resort fallback: */ Ttk_RegisterElement(interp, pkgPtr->defaultTheme, "", &ttkNullElementSpec, 0); /* * Register commands: */ Tcl_CreateObjCommand(interp, "::ttk::style", StyleObjCmd, (ClientData)pkgPtr, 0); nsPtr = Tcl_FindNamespace(interp, "::ttk", (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG); Tcl_Export(interp, nsPtr, "style", 0 /* dontResetList */); Ttk_RegisterElementFactory(interp, "from", Ttk_CloneElement, 0); } /*EOF*/