diff options
Diffstat (limited to 'generic/ttk/ttkTheme.c')
| -rw-r--r-- | generic/ttk/ttkTheme.c | 1737 |
1 files changed, 1737 insertions, 0 deletions
diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c new file mode 100644 index 0000000..a2c51c0 --- /dev/null +++ b/generic/ttk/ttkTheme.c @@ -0,0 +1,1737 @@ +/* + * 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. + */ + +#include <stdlib.h> +#include <string.h> +#include <tk.h> +#include <tkInt.h> +#include "ttkThemeInt.h" + +#define PKG_ASSOC_KEY "Ttk" + +/*------------------------------------------------------------------------ + * +++ 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 = 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 = Tcl_GetHashValue(entryPtr); + Tcl_DecrRefCount(defaultValue); + entryPtr = Tcl_NextHashEntry(&search); + } + Tcl_DeleteHashTable(&stylePtr->defaultsTable); + + Ttk_FreeLayoutTemplate(stylePtr->layoutTemplate); + + ckfree((ClientData)stylePtr); +} + +/* + * Ttk_StyleMap -- + * Look up state-specific option value from specified style. + */ +Tcl_Obj *Ttk_StyleMap(Ttk_Style style, const char *optionName, Ttk_State state) +{ + while (style) { + Tcl_HashEntry *entryPtr = + Tcl_FindHashEntry(&style->settingsTable, optionName); + if (entryPtr) { + Ttk_StateMap stateMap = Tcl_GetHashValue(entryPtr); + return Ttk_StateMapLookup(NULL, stateMap, state); + } + style = style->parentStyle; + } + return 0; +} + +/* + * Ttk_StyleDefault -- + * Look up default resource setting the in the specified style. + */ +Tcl_Obj *Ttk_StyleDefault(Ttk_Style style, const char *optionName) +{ + while (style) { + Tcl_HashEntry *entryPtr = + Tcl_FindHashEntry(&style->defaultsTable, optionName); + if (entryPtr) + return Tcl_GetHashValue(entryPtr); + style= style->parentStyle; + } + return 0; +} + +/*------------------------------------------------------------------------ + * +++ Elements. + */ +typedef const Tk_OptionSpec **OptionMap; + /* array of Tk_OptionSpecs mapping widget options to element options */ + +struct Ttk_ElementClass_ { + 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 */ +}; + +/* 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 <<NOTE-NULLOPTIONS>>). + */ + 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(Ttk_ElementClass *elementClass, Tk_OptionTable optionTable) +{ + OptionMap optionMap = (OptionMap)ckalloc( + sizeof(const Tk_OptionSpec) * elementClass->nResources + 1); + int i; + + for (i = 0; i < elementClass->nResources; ++i) { + Ttk_ElementOptionSpec *e = elementClass->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(Ttk_ElementClass *elementClass, Tk_OptionTable optionTable) +{ + OptionMap optionMap; + int isNew; + Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry( + &elementClass->optMapCache, (void*)optionTable, &isNew); + + if (isNew) { + optionMap = BuildOptionMap(elementClass, optionTable); + Tcl_SetHashValue(entryPtr, optionMap); + } else { + optionMap = Tcl_GetHashValue(entryPtr); + } + + return optionMap; +} + +/* + * NewElementClass -- + * Allocate and initialize an element class record + * from the specified element specification. + */ +static Ttk_ElementClass * +NewElementClass(const char *name, Ttk_ElementSpec *specPtr,void *clientData) +{ + Ttk_ElementClass *elementClass = + (Ttk_ElementClass*)ckalloc(sizeof(Ttk_ElementClass)); + int i; + + elementClass->name = name; + elementClass->specPtr = specPtr; + elementClass->clientData = clientData; + elementClass->elementRecord = ckalloc(specPtr->elementSize); + + /* Count #element resources: + */ + for (i = 0; specPtr->options[i].optionName != 0; ++i) + continue; + elementClass->nResources = i; + + /* Initialize default values: + */ + elementClass->defaultValues = (Tcl_Obj**) + ckalloc(elementClass->nResources * sizeof(Tcl_Obj *) + 1); + for (i=0; i < elementClass->nResources; ++i) { + const char *defaultValue = specPtr->options[i].defaultValue; + if (defaultValue) { + elementClass->defaultValues[i] = Tcl_NewStringObj(defaultValue,-1); + Tcl_IncrRefCount(elementClass->defaultValues[i]); + } else { + elementClass->defaultValues[i] = 0; + } + } + + /* Initialize option map cache: + */ + Tcl_InitHashTable(&elementClass->optMapCache, TCL_ONE_WORD_KEYS); + + return elementClass; +} + +/* + * FreeElementClass -- + * Release resources associated with an element class record. + */ +static void FreeElementClass(Ttk_ElementClass *elementClass) +{ + Tcl_HashSearch search; + Tcl_HashEntry *entryPtr; + int i; + + /* + * Free default values: + */ + for (i = 0; i < elementClass->nResources; ++i) { + if (elementClass->defaultValues[i]) { + Tcl_DecrRefCount(elementClass->defaultValues[i]); + } + } + ckfree((ClientData)elementClass->defaultValues); + + /* + * Free option map cache: + */ + entryPtr = Tcl_FirstHashEntry(&elementClass->optMapCache, &search); + while (entryPtr != NULL) { + ckfree(Tcl_GetHashValue(entryPtr)); + entryPtr = Tcl_NextHashEntry(&search); + } + Tcl_DeleteHashTable(&elementClass->optMapCache); + + ckfree(elementClass->elementRecord); + ckfree((ClientData)elementClass); +} + +/*------------------------------------------------------------------------ + * +++ 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 class records */ + 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, themePtr->rootStyle); + + return themePtr; +} + +static void FreeTheme(Theme *themePtr) +{ + Tcl_HashSearch search; + Tcl_HashEntry *entryPtr; + + /* + * Free element table: + */ + entryPtr = Tcl_FirstHashEntry(&themePtr->elementTable, &search); + while (entryPtr != NULL) { + Ttk_ElementClass *elementClass = Tcl_GetHashValue(entryPtr); + FreeElementClass(elementClass); + entryPtr = Tcl_NextHashEntry(&search); + } + Tcl_DeleteHashTable(&themePtr->elementTable); + + /* + * Free style table: + */ + entryPtr = Tcl_FirstHashEntry(&themePtr->styleTable, &search); + while (entryPtr != NULL) { + Style *stylePtr = Tcl_GetHashValue(entryPtr); + FreeStyle(stylePtr); + entryPtr = Tcl_NextHashEntry(&search); + } + Tcl_DeleteHashTable(&themePtr->styleTable); + + /* + * Free theme record: + */ + ckfree((ClientData)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 = clientData; + Tcl_HashSearch search; + Tcl_HashEntry *entryPtr; + 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) { + Theme *themePtr = 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((ClientData)pkgPtr); +} + +/* + * GetStylePackageData -- + * Look up the package data registered with the interp. + */ + +static StylePackageData *GetStylePackageData(Tcl_Interp *interp) +{ + return Tcl_GetAssocData(interp, PKG_ASSOC_KEY, 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 <<ThemeChanged>> 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 = clientData; + + if (Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL) != 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, 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 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 + */ +MODULE_SCOPE +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, stylePtr); + return stylePtr; + } + return 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 class 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_ElementClass *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 Tcl_GetHashValue(entryPtr); + } + + /* + * Check generic names: + */ + while (!entryPtr && ((dot = strchr(dot, '.')) != NULL)) { + dot++; + entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, dot); + } + if (entryPtr) { + return 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 Tcl_GetHashValue(entryPtr); +} + +const char *Ttk_ElementClassName(Ttk_ElementClass *elementClass) +{ + return elementClass->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; + Ttk_ElementClass *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_ElementClass *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 */ +{ + Ttk_ElementClass *elementClass; + 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); + elementClass = NewElementClass(name, specPtr, clientData); + Tcl_SetHashValue(entryPtr, elementClass); + + return elementClass; +} + +/* 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( + Ttk_ElementClass *eclass, /* 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 = eclass->elementRecord; + OptionMap optionMap = GetOptionMap(eclass,optionTable); + int nResources = eclass->nResources; + Ttk_ResourceCache cache = style->cache; + Ttk_ElementOptionSpec *elementOption = eclass->specPtr->options; + + int i; + for (i=0; i<nResources; ++i, ++elementOption) { + Tcl_Obj **dest = (Tcl_Obj **) + (elementRecord + elementOption->offset); + const char *optionName = elementOption->optionName; + Tcl_Obj *dynamicSetting = Ttk_StyleMap(style, optionName, state); + Tcl_Obj *widgetValue = 0; + Tcl_Obj *elementDefault = eclass->defaultValues[i]; + + if (optionMap[i]) { + widgetValue = *(Tcl_Obj **) + (widgetRecord + optionMap[i]->objOffset); + } + + if (widgetValue) { + *dest = widgetValue; + } else if (dynamicSetting) { + *dest = dynamicSetting; + } else { + Tcl_Obj *styleDefault = Ttk_StyleDefault(style, optionName); + *dest = styleDefault ? styleDefault : elementDefault; + } + + if (!AllocateResource(cache, tkwin, dest, 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 */ +{ + 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: + */ + result = Ttk_StyleMap(style, optionName, state); + if (result) { + return result; + } + + /* + * Use style default: + */ + return Ttk_StyleDefault(style, optionName); +} + +/* + * Ttk_ElementSize -- + * Compute the requested size of the given element. + */ + +void +Ttk_ElementSize( + Ttk_ElementClass *eclass, /* 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( + eclass, style, recordPtr, optionTable, tkwin, state)) + { + return; + } + eclass->specPtr->size( + eclass->clientData, eclass->elementRecord, + tkwin, widthPtr, heightPtr, paddingPtr); +} + +/* + * Ttk_DrawElement -- + * Draw the given widget element in a given drawable area. + */ + +void +Ttk_DrawElement( + Ttk_ElementClass *eclass, /* 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( + eclass, style, recordPtr, optionTable, tkwin, state)) + { + return; + } + eclass->specPtr->draw( + eclass->clientData, eclass->elementRecord, + tkwin, d, b, state); +} + +/*------------------------------------------------------------------------ + * +++ 'style' command ensemble procedures. + */ + +/* + * TtkEnumerateHashTable -- + * 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. + */ + +MODULE_SCOPE +int TtkEnumerateHashTable(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_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 = 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 = 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; +} + +static int StyleThemeCurrentCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]) +{ + StylePackageData *pkgPtr = clientData; + Tcl_HashSearch search; + Tcl_HashEntry *entryPtr = NULL; + const char *name = NULL; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, ""); + return TCL_ERROR; + } + + entryPtr = Tcl_FirstHashEntry(&pkgPtr->themeTable, &search); + while (entryPtr != NULL) { + Theme *ptr = Tcl_GetHashValue(entryPtr); + if (ptr == pkgPtr->currentTheme) { + name = Tcl_GetHashKey(&pkgPtr->themeTable, entryPtr); + break; + } + entryPtr = Tcl_NextHashEntry(&search); + } + + if (name == NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("error: failed to get theme name", -1)); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); + 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 = 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 ?-option value ...?"); + 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 TtkEnumerateHashTable(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 = 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 = clientData; + Ttk_Theme theme = pkgPtr->currentTheme; + const char *elementName, *factoryName; + Tcl_HashEntry *entryPtr; + FactoryRec *recPtr; + + if (objc < 5) { + Tcl_WrongNumArgs(interp, 3, objv, "name type ?-option value ...?"); + 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 = 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 = clientData; + Ttk_Theme theme = pkgPtr->currentTheme; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, NULL); + return TCL_ERROR; + } + return TtkEnumerateHashTable(interp, &theme->elementTable); +} + +/* + style element options $element -- + * Return list of element options for specified element + */ +static int StyleElementOptionsCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) +{ + StylePackageData *pkgPtr = clientData; + Ttk_Theme theme = pkgPtr->currentTheme; + const char *elementName; + Ttk_ElementClass *elementClass; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "element"); + return TCL_ERROR; + } + + elementName = Tcl_GetString(objv[3]); + elementClass = Ttk_GetElement(theme, elementName); + if (elementClass) { + Ttk_ElementSpec *specPtr = elementClass->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 ", elementName, " 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 = 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 < 3 || objc > 4) { + Tcl_WrongNumArgs(interp, 3, objv, "?theme?"); + return TCL_ERROR; + } + + if (objc == 3) { + return StyleThemeCurrentCmd(clientData, interp, objc, objv); + } + + theme = LookupTheme(interp, pkgPtr, Tcl_GetString(objv[3])); + if (!theme) { + return TCL_ERROR; + } + + return Ttk_UseTheme(interp, theme); +} + +/* + * StyleObjCmd -- + * Implementation of the [style] command. + */ + +static const Ttk_Ensemble StyleThemeEnsemble[] = { + { "create", StyleThemeCreateCmd, 0 }, + { "names", StyleThemeNamesCmd, 0 }, + { "settings", StyleThemeSettingsCmd, 0 }, + { "use", StyleThemeUseCmd, 0 }, + { NULL, 0, 0 } +}; + +static const Ttk_Ensemble StyleElementEnsemble[] = { + { "create", StyleElementCreateCmd, 0 }, + { "names", StyleElementNamesCmd, 0 }, + { "options", StyleElementOptionsCmd, 0 }, + { NULL, 0, 0 } +}; + +static const Ttk_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 */ +{ + return Ttk_InvokeEnsemble(StyleEnsemble, 1, clientData,interp,objc,objv); +} + +MODULE_SCOPE +int Ttk_InvokeEnsemble( /* Run an ensemble command */ + const Ttk_Ensemble *ensemble, int cmdIndex, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) +{ + while (cmdIndex < objc) { + int index; + if (Tcl_GetIndexFromObjStruct(interp, + objv[cmdIndex], 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; + ++cmdIndex; + } + Tcl_WrongNumArgs(interp, cmdIndex, objv, "option ?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, PKG_ASSOC_KEY, Ttk_StylePkgFree, 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, pkgPtr, 0); + + nsPtr = Tcl_FindNamespace(interp, "::ttk", NULL, TCL_LEAVE_ERR_MSG); + Tcl_Export(interp, nsPtr, "style", 0 /* dontResetList */); + + Ttk_RegisterElementFactory(interp, "from", Ttk_CloneElement, 0); +} + +/*EOF*/ |