/*
* tkTheme.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: tkTheme.c,v 1.56 2004/03/14 16:28:45 jenglish Exp $
*/
#include <stdlib.h>
#include <string.h>
#include <tk.h>
#include "tkTheme.h"
#ifdef NO_PRIVATE_HEADERS
EXTERN CONST Tk_OptionSpec *TkGetOptionSpec (CONST char *name,
Tk_OptionTable optionTable);
#else
#include <tkInt.h>
#endif
/*
* Styles --
*/
typedef struct TTK_Style_
{
Tcl_HashTable settingsTable; /* KEY: string; VALUE: StateMap */
Tcl_HashTable defaultsTable; /* KEY: string; VALUE: resource */
TTK_Style parentStyle; /* Previous style in chain */
TTK_ResourceCache cache; /* Back-pointer to resource cache */
} Style;
static Style *NewStyle(void)
{
Style *stylePtr = (Style*)ckalloc(sizeof(Style));
stylePtr->parentStyle = 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);
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;
}
/*
* An array of the following structures are used to map Widget resources
* to Element resources.
*/
typedef struct
{
TTK_ElementOptionSpec *elementOption;
CONST Tk_OptionSpec *widgetOption;
Tcl_Obj *defaultValue;
} ResourceMap;
/*
* TTK_Element data structure: holds an instance of an Element.
*
* There is one element instance for every combination of ElementImpl,
* Tk_OptionTable, and Style passed to TTK_GetElement().
*/
typedef struct TTK_Element_
{
struct ElementImpl_ *elementImpl; /* Element implementation */
Style *style; /* Style associated w/element */
Tk_OptionTable optionTable; /* Widget's option table */
ResourceMap *resourceMap; /* Resource mapping table; malloced */
struct TTK_Element_ *next; /* Next in linked list */
} ElementInstance;
/*
* Elements are declared using static templates. But static
* information must be completed by dynamic information only
* accessible at runtime. For each registered element, an instance of
* the following structure is stored in each style engine and used to
* cache information about the widget types (identified by their
* optionTable) that use the given element.
*/
typedef struct ElementImpl_
{
TTK_ElementSpec *specPtr; /* Template provided during registration. */
void *clientData; /* Client data passed in at registration time */
int nResources; /* #Element resources */
void *elementRecord; /* Scratch buffer for element record storage */
ElementInstance *elements; /* Linked list of element instances */
} ElementImpl;
/*
*---------------------------------------------------------------------------
* NewElementInstance --
* Create a new Element instance record, initialize the resource map.
*/
static ElementInstance *
NewElementInstance(
ElementImpl *elementImpl, /* Element descriptor. */
TTK_Style stylePtr, /* Source style */
Tk_OptionTable optionTable) /* The widget's option table. */
{
ElementInstance *element = (ElementInstance *)
ckalloc(sizeof(ElementInstance));
int i;
element->elementImpl = elementImpl;
element->optionTable = optionTable;
element->style = stylePtr;
element->next = 0;
/*
* Build the resource map.
*/
element->resourceMap = (ResourceMap *)ckalloc(
sizeof(ResourceMap) * elementImpl->nResources);
for (i = 0; i < elementImpl->nResources; ++i) {
TTK_ElementOptionSpec *elementOptionPtr
= elementImpl->specPtr->options+i;
const Tk_OptionSpec *widgetOptionPtr
= TkGetOptionSpec(elementOptionPtr->optionName, optionTable);
Tcl_Obj *defaultValue
= Tcl_NewStringObj(elementOptionPtr->defaultValue,-1);
/* Ignore compatibility options:
*/
if (widgetOptionPtr && widgetOptionPtr->flags & TK_OPTION_COMPAT) {
widgetOptionPtr = 0;
}
/* Ensure that the widget option type is compatible with
* the element option type:
*/
if ( elementOptionPtr->type != TK_OPTION_STRING
&& widgetOptionPtr != NULL
&& elementOptionPtr->type != widgetOptionPtr->type)
{
widgetOptionPtr = 0;
}
/* Make sure widget option has a Tcl_Obj* entry:
*/
if (widgetOptionPtr && widgetOptionPtr->objOffset < 0) {
widgetOptionPtr = 0;
}
Tcl_IncrRefCount(defaultValue);
element->resourceMap[i].elementOption = elementOptionPtr;
element->resourceMap[i].widgetOption = widgetOptionPtr;
element->resourceMap[i].defaultValue = defaultValue;
}
return element;
}
/*
* FreeElementInstance --
* Delete an element instance.
*/
static void
FreeElementInstance(ElementInstance *element)
{
int i;
for (i = 0; i< element->elementImpl->nResources; ++i) {
if (element->resourceMap[i].defaultValue)
Tcl_DecrRefCount(element->resourceMap[i].defaultValue);
}
ckfree((char*)element->resourceMap);
ckfree((char*)element);
}
/*
* NewElementImpl --
* Allocate and initialize an element implementation record
* from the specified element specification.
*/
static
ElementImpl * NewElementImpl(struct TTK_ElementSpec *specPtr, void *clientData)
{
ElementImpl *elementImpl = (ElementImpl*)ckalloc(sizeof(ElementImpl));
int i;
elementImpl->specPtr = specPtr;
elementImpl->clientData = clientData;
elementImpl->elementRecord = ckalloc(specPtr->elementSize);
elementImpl->elements = 0;
/* Count #element resources:
*/
for (i = 0; specPtr->options[i].optionName != 0; ++i)
continue;
elementImpl->nResources = i;
return elementImpl;
}
/*
* FreeElementImpl --
* Release resources associated with an element implementation record.
*/
static void FreeElementImpl(ElementImpl *elementImpl)
{
ElementInstance *element = elementImpl->elements;
while (element) {
ElementInstance *next = element->next;
FreeElementInstance(element);
element = next;
}
ckfree(elementImpl->elementRecord);
ckfree((char*)elementImpl);
}
/*
* Default ThemeEnabledProc -- always return true
*/
static int ThemeEnabled(TTK_Theme theme, void *clientData) { return 1; }
/*
* Theme data structure:
*/
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 */
Tcl_HashTable layoutTable; /* Map layout names to LayoutSpecs */
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);
Tcl_InitHashTable(&themePtr->layoutTable, TCL_STRING_KEYS);
/*
* Create root style "."
*/
entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, ".", &unused);
themePtr->rootStyle = NewStyle();
themePtr->rootStyle->cache = themePtr->cache;
Tcl_SetHashValue(entryPtr, (ClientData)themePtr->rootStyle);
return themePtr;
}
static void FreeTheme(Tcl_Interp *interp, 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);
/*
* Layout specs are statically allocated:
*/
Tcl_DeleteHashTable(&themePtr->layoutTable);
/*
* 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 data structure.
*/
typedef struct
{
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 */
} StylePackageData;
/*
*---------------------------------------------------------------------------
*
* TTK_StylePkgFree --
*
* This procedure is called when the interp is deleted. It
* deletes all the structures that were used by the style package
* for this application.
*/
static void
TTK_StylePkgFree(ClientData clientData, Tcl_Interp *interp)
{
StylePackageData *pkgPtr = (StylePackageData *)clientData;
Tcl_HashSearch search;
Tcl_HashEntry *entryPtr;
Theme *themePtr;
Cleanup *cleanup;
/*
* Free themes.
*/
entryPtr = Tcl_FirstHashEntry(&pkgPtr->themeTable, &search);
while (entryPtr != NULL) {
themePtr = (Theme *) Tcl_GetHashValue(entryPtr);
FreeTheme(interp, 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);
}
/*
*---------------------------------------------------------------------------
*
* 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.
*
* Side effects:
* 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 = (StylePackageData *)
Tcl_GetAssocData(interp, "StylePackage", NULL);
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_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 = (StylePackageData *)
Tcl_GetAssocData(interp, "StylePackage", NULL);
Cleanup *cleanup = (Cleanup*)ckalloc(sizeof(*cleanup));
cleanup->clientData = clientData;
cleanup->cleanupProc = cleanupProc;
cleanup->next = pkgPtr->cleanupList;
pkgPtr->cleanupList = cleanup;
}
/*
*---------------------------------------------------------------------------
*
* TTK_SetThemeEnabledProc --
*
* Sets a procedure that is used to check that this theme is available
* for use.
*/
void TTK_SetThemeEnabledProc(
TTK_Theme theme, TTK_ThemeEnabledProc enabledProc, void *enabledData)
{
theme->enabledProc = enabledProc;
theme->enabledData = enabledData;
}
/*
*---------------------------------------------------------------------------
*
* TTK_GetTheme --
* Retrieve a registered theme by name
*
* Results:
* A pointer to the theme, or NULL if none found.
* If not found, leaves an error message in interp's result.
*/
static TTK_Theme
LookupTheme(
Tcl_Interp *interp, /* where to leave error messages (optional) */
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 --
* Look up a TTK_Theme by name.
*
* Results:
* The return value is a token for the named theme,
* NULL if not found. If NULL is returned, an error
* message will be left in interp's result.
*/
TTK_Theme
TTK_GetTheme(
Tcl_Interp *interp, /* Tcl interpreter to query */
const char *name) /* Name of the theme to retrieve; NULL for default */
{
StylePackageData *pkgPtr = (StylePackageData *)
Tcl_GetAssocData(interp, "StylePackage", NULL);
if (name == NULL || *name == '\0') {
return pkgPtr->defaultTheme;
} else {
return LookupTheme(interp, pkgPtr, name);
}
}
TTK_Theme
TTK_GetCurrentTheme(Tcl_Interp *interp)
{
StylePackageData *pkgPtr = (StylePackageData *)
Tcl_GetAssocData(interp, "StylePackage", NULL);
return pkgPtr->currentTheme;
}
TTK_Theme
TTK_GetDefaultTheme(Tcl_Interp *interp)
{
StylePackageData *pkgPtr = (StylePackageData *)
Tcl_GetAssocData(interp, "StylePackage", NULL);
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)
{
static char ThemeChangedScript[] = "tile::ThemeChanged";
StylePackageData *pkgPtr = (StylePackageData *)
Tcl_GetAssocData(interp, "StylePackage", NULL);
/*
* 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;
/*
* Notify all widgets that the current theme has changed:
*/
return Tcl_GlobalEval(interp, ThemeChangedScript);
}
/*
* TTK_GetResourceCache --
* Return the resource cache associated with 'interp'
*/
TTK_ResourceCache
TTK_GetResourceCache(Tcl_Interp *interp)
{
StylePackageData *pkgPtr = (StylePackageData *)
Tcl_GetAssocData(interp, "StylePackage", NULL);
return pkgPtr->cache;
}
/*
* RegisterLayout --
* Register a new layout specification
*/
TTK_LayoutSpec
TTK_RegisterLayout(
TTK_Theme themePtr, /* Target theme */
const char *layoutName, /* Name of new layout */
TTK_LayoutSpec specPtr) /* Static layout information */
{
Tcl_HashEntry *entryPtr;
int newEntry;
entryPtr=Tcl_CreateHashEntry(&themePtr->layoutTable,layoutName,&newEntry);
if (!newEntry)
return 0;
Tcl_SetHashValue(entryPtr, (ClientData)specPtr);
return specPtr;
}
/*
* TTK_GetStyle --
* Look up a Style from a Theme, create new style if not found.
*/
static 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->cache = stylePtr->parentStyle->cache;
Tcl_SetHashValue(entryPtr, (ClientData)stylePtr);
return stylePtr;
}
return (Style*)Tcl_GetHashValue(entryPtr);
}
static TTK_LayoutSpec
TTK_FindLayout(TTK_Theme themePtr, const char *layoutName)
{
Tcl_HashEntry *entryPtr =
Tcl_FindHashEntry(&themePtr->layoutTable, layoutName);
if (entryPtr) {
return (TTK_LayoutSpec)Tcl_GetHashValue(entryPtr);
}
if (themePtr->parentPtr) {
return TTK_FindLayout(themePtr->parentPtr, layoutName);
}
return NULL;
}
/*
* TTK_CreateLayout --
* Create a layout from the specified theme and style name.
* Returns: New layout, 0 on error.
* Leaves an error message in interp's result if there is an error.
*/
TTK_Layout
TTK_CreateLayout(
Tcl_Interp *interp, /* where to leave error messages */
TTK_Theme themePtr,
const char *styleName,
Tk_OptionTable optionTable)
{
TTK_Style style = TTK_GetStyle(themePtr, styleName);
TTK_LayoutSpec layoutSpec = TTK_FindLayout(themePtr, styleName);
if (!style) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "Style ", styleName, " not found", NULL);
return 0;
}
if (!layoutSpec) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL);
return 0;
}
return TTK_BuildLayout(themePtr, layoutSpec, style, optionTable);
}
/*
*---------------------------------------------------------------------------
*
* LookupElementImpl --
*
* 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 engine.
*
*/
static
ElementImpl *LookupElementImpl(
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 (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 LookupElementImpl(themePtr->parentPtr, elementName);
}
/*
* Not found.
*/
return NULL;
}
/*
*---------------------------------------------------------------------------
*
* TTK_RegisterElementFactory --
* Register a new element factory.
*/
int TTK_RegisterElementFactory(
Tcl_Interp *interp, const char *name,
TTK_ElementFactory factory, void *clientData)
{
StylePackageData *pkgPtr = (StylePackageData *)
Tcl_GetAssocData(interp, "StylePackage", NULL);
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_RegisterElementSpec --
*
* Register an implementation of a new element for the given theme.
*
* @@@TODO: report errors
*
*/
int
TTK_RegisterElementSpec(
TTK_Theme theme, /* Style engine providing the implementation. */
const char *name, /* Name of new element */
TTK_ElementSpec *templatePtr, /* Static template information */
void *clientData) /* application-specific data */
{
ElementImpl *elementImpl;
Tcl_HashEntry *entryPtr;
int newEntry;
if (templatePtr->version != TK_STYLE_VERSION_2) {
/*
* Version mismatch. Do nothing.
*/
return TCL_ERROR;
}
entryPtr = Tcl_CreateHashEntry(&theme->elementTable, name, &newEntry);
if (!newEntry) {
/*
* Duplicate entry
*/
return TCL_ERROR;
}
elementImpl = NewElementImpl(templatePtr, clientData);
Tcl_SetHashValue(entryPtr, elementImpl);
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* GetElementInstance --
*
* Return a new or existing element instance for the given
* element implementation and widget type (identified by its
* option table).
*
* Results:
* A pointer to the matching element.
*
* Side effects:
* May create a new ElementInstance.
*
*/
static ElementInstance *
GetElementInstance(
ElementImpl *elementImpl, /* Styled element descriptor. */
TTK_Style stylePtr, /* Base style */
Tk_OptionTable optionTable) /* The widget's option table. */
{
ElementInstance *element = elementImpl->elements;
/*
* Try to find an existing instance:
*/
while (element) {
if (element->optionTable == optionTable && element->style == stylePtr)
return element;
element = element->next;
}
/*
* None found -- create a new one and add to linked list.
*/
element = NewElementInstance(elementImpl, stylePtr, optionTable);
element->next = elementImpl->elements;
elementImpl->elements = element;
return element;
}
/*
*---------------------------------------------------------------------------
* TTK_GetElement --
* Look up and/or create an Element instance from the given style.
*
* Returns the an instance of the first matching element implementation,
* from specific to generic names, then from earlier themes in the chain
*
*---------------------------------------------------------------------------
*/
TTK_Element TTK_GetElement(
TTK_Theme theme,
TTK_Style style,
const char *elementName,
Tk_OptionTable optionTable)
{
ElementImpl *elementImpl = LookupElementImpl(theme, elementName);
if (elementImpl)
return GetElementInstance(elementImpl, style, optionTable);
return 0;
}
/*
* 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 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(
char *widgetRecord, /* Source of resource values */
Tk_Window tkwin, /* Corresponding window */
TTK_Element element, /* Element instance to initialize */
unsigned long state) /* Widget or element state */
{
char *elementRecord = element->elementImpl->elementRecord;
ResourceMap *resourceMap = element->resourceMap;
int nResources = element->elementImpl->nResources;
TTK_ResourceCache cache = element->style->cache;
int i;
for (i=0; i<nResources; ++i, ++resourceMap) {
Tcl_Obj **dest = (Tcl_Obj **)
(elementRecord + resourceMap->elementOption->offset);
const char *optionName = resourceMap->elementOption->optionName;
Tcl_Obj *stateMap = LookupStateMap(element->style, optionName);
Tcl_Obj *dynamicSetting = 0;
Tcl_Obj *widgetValue = 0;
if (stateMap) {
dynamicSetting = TTK_StateMapLookup(NULL, stateMap, state);
}
if (resourceMap->widgetOption) {
widgetValue = *(Tcl_Obj **)
(widgetRecord + resourceMap->widgetOption->objOffset);
}
if (dynamicSetting) {
*dest = dynamicSetting;
} else if (widgetValue) {
*dest = widgetValue;
} else {
Tcl_Obj *styleDefault = LookupDefault(element->style, optionName);
*dest = styleDefault ? styleDefault : resourceMap->defaultValue;
}
if (!AllocateResource(cache, tkwin, dest,
resourceMap->elementOption->type))
{
return 0;
}
}
return 1;
}
/*
*---------------------------------------------------------------------------
*
* TTK_ElementGeometry --
*
* Compute the size of the given widget element.
*
*/
void
TTK_ElementGeometry(
TTK_Element element, /* An element instance, previously
* returned by TTK_GetElement. */
char *recordPtr, /* The widget record. */
Tk_Window tkwin, /* The widget window. */
unsigned int 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(recordPtr, tkwin, element, state))
return;
element->elementImpl->specPtr->geometry(
element->elementImpl->clientData, element->elementImpl->elementRecord,
tkwin, widthPtr, heightPtr, paddingPtr);
*widthPtr += paddingPtr->left + paddingPtr->right;
*heightPtr += paddingPtr->top + paddingPtr->bottom;
}
/*
*---------------------------------------------------------------------------
*
* TTK_DrawElement --
*
* This procedure draw the given widget element in a given drawable area.
*
* Results:
* Element is drawn.
*
*/
void
TTK_DrawElement(
TTK_Element element, /* Element instance */
char *recordPtr, /* The widget record. */
Tk_Window tkwin, /* The widget window. */
Drawable d, /* Where to draw element. */
TTK_Box b, /* Element area */
unsigned int state) /* Widget or element state flags. */
{
if (b.width <= 0 || b.height <= 0)
return;
if (!InitializeElementRecord(recordPtr, tkwin, element, state))
return;
element->elementImpl->specPtr->draw(
element->elementImpl->clientData, element->elementImpl->elementRecord,
tkwin, d, b, state);
}
/*========================================================================
* Style ensemble implementation:
*/
/*
* 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;
}
/*
* 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 || objc % 2 != 1) {
Tcl_WrongNumArgs(interp,2,objv,"style ?-option statemap...?");
return TCL_ERROR;
}
styleName = Tcl_GetString(objv[2]);
stylePtr = TTK_GetStyle(theme, styleName);
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);
}
return TCL_OK;
}
/*
* style default $style -resource value...
*/
static int
StyleDefaultCmd(
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 || objc % 2 != 1) {
Tcl_WrongNumArgs(interp,2,objv,"style ?-option statemap...?");
return TCL_ERROR;
}
styleName = Tcl_GetString(objv[2]);
stylePtr = TTK_GetStyle(theme, styleName);
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);
}
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
*/
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, "");
return TCL_ERROR;
}
return EnumerateHashTable(interp, &theme->elementTable);
}
/*
* 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_LayoutSpec spec;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "name spec");
return TCL_ERROR;
}
layoutName = Tcl_GetString(objv[2]);
spec = TTK_ParseLayoutSpec(interp, objv[3]);
if (!spec) {
return TCL_ERROR;
}
if (!TTK_RegisterLayout(theme, layoutName, spec)) {
Tcl_AppendResult(interp,"Layout ",layoutName," already defined",NULL);
return TCL_ERROR;
}
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 */
};
struct Ensemble StyleThemeEnsemble[] = {
{ "create", StyleThemeCreateCmd, 0 },
{ "names", StyleThemeNamesCmd, 0 },
{ "settings", StyleThemeSettingsCmd, 0 },
{ "use", StyleThemeUseCmd, 0 },
{ NULL, 0, 0 }
};
struct Ensemble StyleElementEnsemble[] = {
{ "create", StyleElementCreateCmd, 0 },
{ "names", StyleElementNamesCmd, 0 },
{ NULL, 0, 0 }
};
struct Ensemble StyleEnsemble[] = {
{ "default", StyleDefaultCmd, 0 },
{ "map", StyleMapCmd, 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)
{
StylePackageData *pkgPtr = (StylePackageData *)
ckalloc(sizeof(StylePackageData));
Tcl_InitHashTable(&pkgPtr->themeTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&pkgPtr->factoryTable, TCL_STRING_KEYS);
pkgPtr->cleanupList = NULL;
pkgPtr->cache = TTK_CreateResourceCache(interp);
Tcl_SetAssocData(interp, "StylePackage", TTK_StylePkgFree,
(ClientData)pkgPtr);
/*
* Create the default system theme "."
*/
pkgPtr->defaultTheme = 0;
pkgPtr->defaultTheme = pkgPtr->currentTheme =
TTK_CreateTheme(interp, "default", NULL);
/*
* Register commands:
*/
Tcl_CreateObjCommand(interp, "style", StyleObjCmd, (ClientData)pkgPtr, 0);
}
/*EOF*/