Pratt 1.5.6

data/pkgs/tile-0.8.2/generic/tkTheme.c

@@ -0,0 +1,1708 @@
+/*
+ * 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.
+ *
+ * tkTheme.c,v 1.101 2007/12/12 01:19:00 jenglish Exp
+ */
+
+#include <stdlib.h>
+#include <string.h>
+#include <tk.h>
+#include "tkThemeInt.h"
+
+#ifdef NO_PRIVATE_HEADERS
+EXTERN CONST Tk_OptionSpec *TkGetOptionSpec (CONST char *name,
+                            Tk_OptionTable optionTable);
+#else
+#include <tkInt.h>
+#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 <<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(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 <<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 = (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
+ */
+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, (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; i<nResources; ++i, ++elementOption) {
+	Tcl_Obj **dest = (Tcl_Obj **)
+	    (elementRecord + elementOption->offset);
+	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, 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);
+}
+
+/*
+ * 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, 3, 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 --
+ * 	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;
+    ElementImpl *elementImpl;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 3, objv, "element");
+	return TCL_ERROR;
+    }
+
+    elementName = Tcl_GetString(objv[3]);
+    elementImpl = Ttk_GetElement(theme, elementName);
+    if (elementImpl) {
+	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 ", 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 = (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)
+{
+    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);
+    Ttk_RegisterElementFactory(interp, "from", Ttk_CloneElement, 0);
+}
+
+/*EOF*/