Import Tk 8.6.6 (as of svn r86089)

generic/ttk/ttk.decls

@@ -0,0 +1,150 @@
+library 	ttk
+interface 	ttk
+epoch  		0
+scspec		TTKAPI
+
+declare 0 {
+    Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name)
+}
+declare 1 {
+    Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp)
+}
+declare 2 {
+    Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp)
+}
+declare 3 {
+    Ttk_Theme Ttk_CreateTheme(
+	Tcl_Interp *interp, const char *name, Ttk_Theme parent)
+}
+declare 4 {
+    void Ttk_RegisterCleanup(
+	Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc)
+}
+
+declare 5 {
+    int Ttk_RegisterElementSpec(
+	Ttk_Theme theme,
+	const char *elementName,
+	Ttk_ElementSpec *elementSpec,
+	void *clientData)
+}
+
+declare 6 {
+    Ttk_ElementClass *Ttk_RegisterElement(
+	Tcl_Interp *interp,
+	Ttk_Theme theme,
+	const char *elementName,
+	Ttk_ElementSpec *elementSpec,
+	void *clientData)
+}
+
+declare 7 {
+    int Ttk_RegisterElementFactory(
+	Tcl_Interp *interp,
+	const char *name,
+	Ttk_ElementFactory factoryProc,
+	void *clientData)
+}
+
+declare 8 {
+    void Ttk_RegisterLayout(
+	Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec)
+}
+
+#
+# State maps.
+#
+declare 10 {
+    int Ttk_GetStateSpecFromObj(
+    	Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn)
+}
+declare 11 {
+    Tcl_Obj *Ttk_NewStateSpecObj(
+    	unsigned int onbits, unsigned int offbits)
+}
+declare 12 {
+    Ttk_StateMap Ttk_GetStateMapFromObj(
+    	Tcl_Interp *interp, Tcl_Obj *objPtr)
+}
+declare 13 {
+    Tcl_Obj *Ttk_StateMapLookup(
+	Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state)
+}
+declare 14 {
+    int Ttk_StateTableLookup(
+    	Ttk_StateTable map[], Ttk_State state)
+}
+
+
+#
+# Low-level geometry utilities.
+#
+declare 20 {
+    int Ttk_GetPaddingFromObj(
+    	Tcl_Interp *interp,
+	Tk_Window tkwin,
+	Tcl_Obj *objPtr,
+	Ttk_Padding *pad_rtn)
+}
+declare 21 {
+    int Ttk_GetBorderFromObj(
+    	Tcl_Interp *interp,
+	Tcl_Obj *objPtr,
+	Ttk_Padding *pad_rtn)
+}
+declare 22 {
+    int Ttk_GetStickyFromObj(
+    	Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn)
+}
+declare 23 {
+    Ttk_Padding Ttk_MakePadding(
+    	short l, short t, short r, short b)
+}
+declare 24 {
+    Ttk_Padding Ttk_UniformPadding(
+    	short borderWidth)
+}
+declare 25 {
+    Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2)
+}
+declare 26 {
+    Ttk_Padding Ttk_RelievePadding(
+    	Ttk_Padding padding, int relief, int n)
+}
+declare 27 {
+    Ttk_Box Ttk_MakeBox(int x, int y, int width, int height)
+}
+declare 28 {
+    int Ttk_BoxContains(Ttk_Box box, int x, int y)
+}
+declare 29 {
+    Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side)
+}
+declare 30 {
+    Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky)
+}
+declare 31 {
+    Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor)
+}
+declare 32 {
+    Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p)
+}
+declare 33 {
+    Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p)
+}
+declare 34 {
+    Ttk_Box Ttk_PlaceBox(
+	Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky)
+}
+declare 35 {
+    Tcl_Obj *Ttk_NewBoxObj(Ttk_Box box)
+}
+
+#
+# Utilities.
+#
+declare 40 {
+    int Ttk_GetOrientFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient)
+}
+
+

generic/ttk/ttkBlink.c

@@ -0,0 +1,166 @@
+/*
+ * Copyright 2004, Joe English.
+ *
+ * Usage:
+ * 	TtkBlinkCursor(corePtr), usually called in a widget's Init hook,
+ * 	arranges to periodically toggle the corePtr->flags CURSOR_ON bit
+ * 	on and off (and schedule a redisplay) whenever the widget has focus.
+ *
+ * 	Note: Widgets may have additional logic to decide whether
+ * 	to display the cursor or not (e.g., readonly or disabled states);
+ * 	TtkBlinkCursor() does not account for this.
+ *
+ * TODO:
+ * 	Add script-level access to configure application-wide blink rate.
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#define DEF_CURSOR_ON_TIME	600		/* milliseconds */
+#define DEF_CURSOR_OFF_TIME	300		/* milliseconds */
+
+/* Interp-specific data for tracking cursors:
+ */
+typedef struct
+{
+    WidgetCore		*owner; 	/* Widget that currently has cursor */
+    Tcl_TimerToken	timer;		/* Blink timer */
+    int 		onTime;		/* #milliseconds to blink cursor on */
+    int 		offTime;	/* #milliseconds to blink cursor off */
+} CursorManager;
+
+/* CursorManagerDeleteProc --
+ * 	InterpDeleteProc for cursor manager.
+ */
+static void CursorManagerDeleteProc(ClientData clientData, Tcl_Interp *interp)
+{
+    CursorManager *cm = (CursorManager*)clientData;
+    if (cm->timer) {
+	Tcl_DeleteTimerHandler(cm->timer);
+    }
+    ckfree(clientData);
+}
+
+/* GetCursorManager --
+ * 	Look up and create if necessary the interp's cursor manager.
+ */
+static CursorManager *GetCursorManager(Tcl_Interp *interp)
+{
+    static const char *cm_key = "ttk::CursorManager";
+    CursorManager *cm = Tcl_GetAssocData(interp, cm_key,0);
+
+    if (!cm) {
+	cm = ckalloc(sizeof(*cm));
+	cm->timer = 0;
+	cm->owner = 0;
+	cm->onTime = DEF_CURSOR_ON_TIME;
+	cm->offTime = DEF_CURSOR_OFF_TIME;
+	Tcl_SetAssocData(interp,cm_key,CursorManagerDeleteProc,(ClientData)cm);
+    }
+    return cm;
+}
+
+/* CursorBlinkProc --
+ *	Timer handler to blink the insert cursor on and off.
+ */
+static void
+CursorBlinkProc(ClientData clientData)
+{
+    CursorManager *cm = (CursorManager*)clientData;
+    int blinkTime;
+
+    if (cm->owner->flags & CURSOR_ON) {
+	cm->owner->flags &= ~CURSOR_ON;
+	blinkTime = cm->offTime;
+    } else {
+	cm->owner->flags |= CURSOR_ON;
+	blinkTime = cm->onTime;
+    }
+    cm->timer = Tcl_CreateTimerHandler(blinkTime, CursorBlinkProc, clientData);
+    TtkRedisplayWidget(cm->owner);
+}
+
+/* LoseCursor --
+ * 	Turn cursor off, disable blink timer.
+ */
+static void LoseCursor(CursorManager *cm, WidgetCore *corePtr)
+{
+    if (corePtr->flags & CURSOR_ON) {
+	corePtr->flags &= ~CURSOR_ON;
+	TtkRedisplayWidget(corePtr);
+    }
+    if (cm->owner == corePtr) {
+	cm->owner = NULL;
+    }
+    if (cm->timer) {
+	Tcl_DeleteTimerHandler(cm->timer);
+	cm->timer = 0;
+    }
+}
+
+/* ClaimCursor --
+ * 	Claim ownership of the insert cursor and blink on.
+ */
+static void ClaimCursor(CursorManager *cm, WidgetCore *corePtr)
+{
+    if (cm->owner == corePtr)
+	return;
+    if (cm->owner)
+	LoseCursor(cm, cm->owner);
+
+    corePtr->flags |= CURSOR_ON;
+    TtkRedisplayWidget(corePtr);
+
+    cm->owner = corePtr;
+    cm->timer = Tcl_CreateTimerHandler(cm->onTime, CursorBlinkProc, cm);
+}
+
+/*
+ * CursorEventProc --
+ * 	Event handler for FocusIn and FocusOut events;
+ * 	claim/lose ownership of the insert cursor when the widget
+ * 	acquires/loses keyboard focus.
+ */
+
+#define CursorEventMask (FocusChangeMask|StructureNotifyMask)
+#define RealFocusEvent(d) \
+    (d == NotifyInferior || d == NotifyAncestor || d == NotifyNonlinear)
+
+static void
+CursorEventProc(ClientData clientData, XEvent *eventPtr)
+{
+    WidgetCore *corePtr = (WidgetCore *)clientData;
+    CursorManager *cm = GetCursorManager(corePtr->interp);
+
+    switch (eventPtr->type) {
+	case DestroyNotify:
+	    if (cm->owner == corePtr)
+		LoseCursor(cm, corePtr);
+	    Tk_DeleteEventHandler(
+		corePtr->tkwin, CursorEventMask, CursorEventProc, clientData);
+	    break;
+	case FocusIn:
+	    if (RealFocusEvent(eventPtr->xfocus.detail))
+		ClaimCursor(cm, corePtr);
+	    break;
+	case FocusOut:
+	    if (RealFocusEvent(eventPtr->xfocus.detail))
+		LoseCursor(cm, corePtr);
+	    break;
+    }
+}
+
+/*
+ * TtkBlinkCursor (main routine) --
+ * 	Arrange to blink the cursor on and off whenever the
+ * 	widget has focus.
+ */
+void TtkBlinkCursor(WidgetCore *corePtr)
+{
+    Tk_CreateEventHandler(
+	corePtr->tkwin, CursorEventMask, CursorEventProc, corePtr);
+}
+
+/*EOF*/

generic/ttk/ttkButton.c

@@ -0,0 +1,853 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * label, button, checkbutton, radiobutton, and menubutton widgets.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/* Bit fields for OptionSpec mask field:
+ */
+#define STATE_CHANGED	 	(0x100)		/* -state option changed */
+#define DEFAULTSTATE_CHANGED	(0x200)		/* -default option changed */
+
+/*------------------------------------------------------------------------
+ * +++ Base resources for labels, buttons, checkbuttons, etc:
+ */
+typedef struct
+{
+    /*
+     * Text element resources:
+     */
+    Tcl_Obj *textObj;
+    Tcl_Obj *textVariableObj;
+    Tcl_Obj *underlineObj;
+    Tcl_Obj *widthObj;
+
+    Ttk_TraceHandle	*textVariableTrace;
+    Ttk_ImageSpec	*imageSpec;
+
+    /*
+     * Image element resources:
+     */
+    Tcl_Obj *imageObj;
+
+    /*
+     * Compound label/image resources:
+     */
+    Tcl_Obj *compoundObj;
+    Tcl_Obj *paddingObj;
+
+    /*
+     * Compatibility/legacy options:
+     */
+    Tcl_Obj *stateObj;
+
+} BasePart;
+
+typedef struct
+{
+    WidgetCore	core;
+    BasePart	base;
+} Base;
+
+static Tk_OptionSpec BaseOptionSpecs[] =
+{
+    {TK_OPTION_STRING, "-text", "text", "Text", "",
+	Tk_Offset(Base,base.textObj), -1,
+	0,0,GEOMETRY_CHANGED },
+    {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", "",
+	Tk_Offset(Base,base.textVariableObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+    {TK_OPTION_INT, "-underline", "underline", "Underline",
+	"-1", Tk_Offset(Base,base.underlineObj), -1,
+	0,0,0 },
+    /* SB: OPTION_INT, see <<NOTE-NULLOPTIONS>> */
+    {TK_OPTION_STRING, "-width", "width", "Width",
+	NULL, Tk_Offset(Base,base.widthObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+    /*
+     * Image options
+     */
+    {TK_OPTION_STRING, "-image", "image", "Image", NULL/*default*/,
+	Tk_Offset(Base,base.imageObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+    /*
+     * Compound base/image options
+     */
+    {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+	 "none", Tk_Offset(Base,base.compoundObj), -1,
+	 0,(ClientData)ttkCompoundStrings,GEOMETRY_CHANGED },
+    {TK_OPTION_STRING, "-padding", "padding", "Pad",
+	NULL, Tk_Offset(Base,base.paddingObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED},
+
+    /*
+     * Compatibility/legacy options
+     */
+    {TK_OPTION_STRING, "-state", "state", "State",
+	 "normal", Tk_Offset(Base,base.stateObj), -1,
+	 0,0,STATE_CHANGED },
+
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*
+ * Variable trace procedure for -textvariable option:
+ */
+static void TextVariableChanged(void *clientData, const char *value)
+{
+    Base *basePtr = clientData;
+    Tcl_Obj *newText;
+
+    if (WidgetDestroyed(&basePtr->core)) {
+	return;
+    }
+
+    newText = value ? Tcl_NewStringObj(value, -1) : Tcl_NewStringObj("", 0);
+
+    Tcl_IncrRefCount(newText);
+    Tcl_DecrRefCount(basePtr->base.textObj);
+    basePtr->base.textObj = newText;
+
+    TtkResizeWidget(&basePtr->core);
+}
+
+static void
+BaseInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+    Base *basePtr = recordPtr;
+    basePtr->base.textVariableTrace = 0;
+    basePtr->base.imageSpec = NULL;
+}
+
+static void
+BaseCleanup(void *recordPtr)
+{
+    Base *basePtr = recordPtr;
+    if (basePtr->base.textVariableTrace)
+	Ttk_UntraceVariable(basePtr->base.textVariableTrace);
+    if (basePtr->base.imageSpec)
+    	TtkFreeImageSpec(basePtr->base.imageSpec);
+}
+
+static int BaseConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Base *basePtr = recordPtr;
+    Tcl_Obj *textVarName = basePtr->base.textVariableObj;
+    Ttk_TraceHandle *vt = 0;
+    Ttk_ImageSpec *imageSpec = NULL;
+
+    if (textVarName != NULL && *Tcl_GetString(textVarName) != '\0') {
+	vt = Ttk_TraceVariable(interp,textVarName,TextVariableChanged,basePtr);
+	if (!vt) return TCL_ERROR;
+    }
+
+    if (basePtr->base.imageObj) {
+	imageSpec = TtkGetImageSpec(
+	    interp, basePtr->core.tkwin, basePtr->base.imageObj);
+	if (!imageSpec) {
+	    goto error;
+	}
+    }
+
+    if (TtkCoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+error:
+	if (imageSpec) TtkFreeImageSpec(imageSpec);
+	if (vt) Ttk_UntraceVariable(vt);
+	return TCL_ERROR;
+    }
+
+    if (basePtr->base.textVariableTrace) {
+	Ttk_UntraceVariable(basePtr->base.textVariableTrace);
+    }
+    basePtr->base.textVariableTrace = vt;
+
+    if (basePtr->base.imageSpec) {
+	TtkFreeImageSpec(basePtr->base.imageSpec);
+    }
+    basePtr->base.imageSpec = imageSpec;
+
+    if (mask & STATE_CHANGED) {
+	TtkCheckStateOption(&basePtr->core, basePtr->base.stateObj);
+    }
+
+    return TCL_OK;
+}
+
+static int
+BasePostConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Base *basePtr = recordPtr;
+    int status = TCL_OK;
+
+    if (basePtr->base.textVariableTrace) {
+	status = Ttk_FireTrace(basePtr->base.textVariableTrace);
+    }
+
+    return status;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Label widget.
+ * Just a base widget that adds a few appearance-related options
+ */
+
+typedef struct
+{
+    Tcl_Obj *backgroundObj;
+    Tcl_Obj *foregroundObj;
+    Tcl_Obj *fontObj;
+    Tcl_Obj *borderWidthObj;
+    Tcl_Obj *reliefObj;
+    Tcl_Obj *anchorObj;
+    Tcl_Obj *justifyObj;
+    Tcl_Obj *wrapLengthObj;
+} LabelPart;
+
+typedef struct
+{
+    WidgetCore	core;
+    BasePart	base;
+    LabelPart	label;
+} Label;
+
+static Tk_OptionSpec LabelOptionSpecs[] =
+{
+    {TK_OPTION_BORDER, "-background", "frameColor", "FrameColor",
+	NULL, Tk_Offset(Label,label.backgroundObj), -1,
+	TK_OPTION_NULL_OK,0,0 },
+    {TK_OPTION_COLOR, "-foreground", "textColor", "TextColor",
+	NULL, Tk_Offset(Label,label.foregroundObj), -1,
+	TK_OPTION_NULL_OK,0,0 },
+    {TK_OPTION_FONT, "-font", "font", "Font",
+	NULL, Tk_Offset(Label,label.fontObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+	NULL, Tk_Offset(Label,label.borderWidthObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+	NULL, Tk_Offset(Label,label.reliefObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+    {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+	NULL, Tk_Offset(Label,label.anchorObj), -1,
+	TK_OPTION_NULL_OK, 0, GEOMETRY_CHANGED},
+    {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+	NULL, Tk_Offset(Label, label.justifyObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+    {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+	NULL, Tk_Offset(Label, label.wrapLengthObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED /*SB: SIZE_CHANGED*/ },
+
+    WIDGET_TAKEFOCUS_FALSE,
+    WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+static const Ttk_Ensemble LabelCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    { 0,0,0 }
+};
+
+static WidgetSpec LabelWidgetSpec =
+{
+    "TLabel",			/* className */
+    sizeof(Label),		/* recordSize */
+    LabelOptionSpecs,		/* optionSpecs */
+    LabelCommands,		/* subcommands */
+    BaseInitialize,		/* initializeProc */
+    BaseCleanup,		/* cleanupProc */
+    BaseConfigure,		/* configureProc */
+    BasePostConfigure,		/* postConfigureProc */
+    TtkWidgetGetLayout, 	/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    TtkWidgetDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(LabelLayout)
+    TTK_GROUP("Label.border", TTK_FILL_BOTH|TTK_BORDER,
+	TTK_GROUP("Label.padding", TTK_FILL_BOTH|TTK_BORDER,
+	    TTK_NODE("Label.label", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Button widget.
+ * Adds a new subcommand "invoke", and options "-command" and "-default"
+ */
+
+typedef struct
+{
+    Tcl_Obj *commandObj;
+    Tcl_Obj *defaultStateObj;
+} ButtonPart;
+
+typedef struct
+{
+    WidgetCore	core;
+    BasePart	base;
+    ButtonPart	button;
+} Button;
+
+/*
+ * Option specifications:
+ */
+static Tk_OptionSpec ButtonOptionSpecs[] =
+{
+    {TK_OPTION_STRING, "-command", "command", "Command",
+	"", Tk_Offset(Button, button.commandObj), -1, 0,0,0},
+    {TK_OPTION_STRING_TABLE, "-default", "default", "Default",
+	"normal", Tk_Offset(Button, button.defaultStateObj), -1,
+	0, (ClientData) ttkDefaultStrings, DEFAULTSTATE_CHANGED},
+
+    WIDGET_TAKEFOCUS_TRUE,
+    WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+static int ButtonConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Button *buttonPtr = recordPtr;
+
+    if (BaseConfigure(interp, recordPtr, mask) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* Handle "-default" option:
+     */
+    if (mask & DEFAULTSTATE_CHANGED) {
+	int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+	Ttk_GetButtonDefaultStateFromObj(
+	    NULL, buttonPtr->button.defaultStateObj, &defaultState);
+	if (defaultState == TTK_BUTTON_DEFAULT_ACTIVE) {
+	    TtkWidgetChangeState(&buttonPtr->core, TTK_STATE_ALTERNATE, 0);
+	} else {
+	    TtkWidgetChangeState(&buttonPtr->core, 0, TTK_STATE_ALTERNATE);
+	}
+    }
+    return TCL_OK;
+}
+
+/* $button invoke --
+ * 	Evaluate the button's -command.
+ */
+static int
+ButtonInvokeCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Button *buttonPtr = recordPtr;
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+	return TCL_ERROR;
+    }
+    if (buttonPtr->core.state & TTK_STATE_DISABLED) {
+	return TCL_OK;
+    }
+    return Tcl_EvalObjEx(interp, buttonPtr->button.commandObj, TCL_EVAL_GLOBAL);
+}
+
+static const Ttk_Ensemble ButtonCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "invoke",		ButtonInvokeCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    { 0,0,0 }
+};
+
+static WidgetSpec ButtonWidgetSpec =
+{
+    "TButton",			/* className */
+    sizeof(Button),		/* recordSize */
+    ButtonOptionSpecs,		/* optionSpecs */
+    ButtonCommands,		/* subcommands */
+    BaseInitialize,		/* initializeProc */
+    BaseCleanup,		/* cleanupProc */
+    ButtonConfigure,		/* configureProc */
+    BasePostConfigure,		/* postConfigureProc */
+    TtkWidgetGetLayout,		/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    TtkWidgetDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(ButtonLayout)
+    TTK_GROUP("Button.border", TTK_FILL_BOTH|TTK_BORDER,
+	TTK_GROUP("Button.focus", TTK_FILL_BOTH,
+	    TTK_GROUP("Button.padding", TTK_FILL_BOTH,
+	        TTK_NODE("Button.label", TTK_FILL_BOTH))))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Checkbutton widget.
+ */
+typedef struct
+{
+    Tcl_Obj *variableObj;
+    Tcl_Obj *onValueObj;
+    Tcl_Obj *offValueObj;
+    Tcl_Obj *commandObj;
+
+    Ttk_TraceHandle *variableTrace;
+
+} CheckbuttonPart;
+
+typedef struct
+{
+    WidgetCore core;
+    BasePart base;
+    CheckbuttonPart checkbutton;
+} Checkbutton;
+
+/*
+ * Option specifications:
+ */
+static Tk_OptionSpec CheckbuttonOptionSpecs[] =
+{
+    {TK_OPTION_STRING, "-variable", "variable", "Variable",
+	NULL, Tk_Offset(Checkbutton, checkbutton.variableObj), -1,
+	TK_OPTION_NULL_OK,0,0},
+    {TK_OPTION_STRING, "-onvalue", "onValue", "OnValue",
+	"1", Tk_Offset(Checkbutton, checkbutton.onValueObj), -1,
+	0,0,0},
+    {TK_OPTION_STRING, "-offvalue", "offValue", "OffValue",
+	"0", Tk_Offset(Checkbutton, checkbutton.offValueObj), -1,
+	0,0,0},
+    {TK_OPTION_STRING, "-command", "command", "Command",
+	"", Tk_Offset(Checkbutton, checkbutton.commandObj), -1,
+	0,0,0},
+
+    WIDGET_TAKEFOCUS_TRUE,
+    WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+/*
+ * Variable trace procedure for checkbutton -variable option
+ */
+static void CheckbuttonVariableChanged(void *clientData, const char *value)
+{
+    Checkbutton *checkPtr = clientData;
+
+    if (WidgetDestroyed(&checkPtr->core)) {
+	return;
+    }
+
+    if (!value) {
+	TtkWidgetChangeState(&checkPtr->core, TTK_STATE_ALTERNATE, 0);
+	return;
+    }
+    /* else */
+    TtkWidgetChangeState(&checkPtr->core, 0, TTK_STATE_ALTERNATE);
+    if (!strcmp(value, Tcl_GetString(checkPtr->checkbutton.onValueObj))) {
+	TtkWidgetChangeState(&checkPtr->core, TTK_STATE_SELECTED, 0);
+    } else {
+	TtkWidgetChangeState(&checkPtr->core, 0, TTK_STATE_SELECTED);
+    }
+}
+
+static void
+CheckbuttonInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+    Checkbutton *checkPtr = recordPtr;
+    Tcl_Obj *variableObj;
+
+    /* default -variable is the widget name:
+     */
+    variableObj = Tcl_NewStringObj(Tk_PathName(checkPtr->core.tkwin), -1);
+    Tcl_IncrRefCount(variableObj);
+    checkPtr->checkbutton.variableObj = variableObj;
+    BaseInitialize(interp, recordPtr);
+}
+
+static void
+CheckbuttonCleanup(void *recordPtr)
+{
+    Checkbutton *checkPtr = recordPtr;
+    Ttk_UntraceVariable(checkPtr->checkbutton.variableTrace);
+    checkPtr->checkbutton.variableTrace = 0;
+    BaseCleanup(recordPtr);
+}
+
+static int
+CheckbuttonConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Checkbutton *checkPtr = recordPtr;
+    Ttk_TraceHandle *vt = Ttk_TraceVariable(
+	interp, checkPtr->checkbutton.variableObj,
+	CheckbuttonVariableChanged, checkPtr);
+
+    if (!vt) {
+	return TCL_ERROR;
+    }
+
+    if (BaseConfigure(interp, recordPtr, mask) != TCL_OK){
+	Ttk_UntraceVariable(vt);
+	return TCL_ERROR;
+    }
+
+    Ttk_UntraceVariable(checkPtr->checkbutton.variableTrace);
+    checkPtr->checkbutton.variableTrace = vt;
+
+    return TCL_OK;
+}
+
+static int
+CheckbuttonPostConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Checkbutton *checkPtr = recordPtr;
+    int status = TCL_OK;
+
+    if (checkPtr->checkbutton.variableTrace)
+	status = Ttk_FireTrace(checkPtr->checkbutton.variableTrace);
+    if (status == TCL_OK && !WidgetDestroyed(&checkPtr->core))
+	status = BasePostConfigure(interp, recordPtr, mask);
+    return status;
+}
+
+/*
+ * Checkbutton 'invoke' subcommand:
+ * 	Toggles the checkbutton state.
+ */
+static int
+CheckbuttonInvokeCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Checkbutton *checkPtr = recordPtr;
+    WidgetCore *corePtr = &checkPtr->core;
+    Tcl_Obj *newValue;
+
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+	return TCL_ERROR;
+    }
+    if (corePtr->state & TTK_STATE_DISABLED)
+	return TCL_OK;
+
+    /*
+     * Toggle the selected state.
+     */
+    if (corePtr->state & TTK_STATE_SELECTED)
+	newValue = checkPtr->checkbutton.offValueObj;
+    else
+	newValue = checkPtr->checkbutton.onValueObj;
+
+    if (Tcl_ObjSetVar2(interp,
+	    checkPtr->checkbutton.variableObj, NULL, newValue,
+	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+	== NULL)
+	return TCL_ERROR;
+
+    if (WidgetDestroyed(corePtr))
+	return TCL_ERROR;
+
+    return Tcl_EvalObjEx(interp,
+	checkPtr->checkbutton.commandObj, TCL_EVAL_GLOBAL);
+}
+
+static const Ttk_Ensemble CheckbuttonCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "invoke",		CheckbuttonInvokeCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    /* MISSING: select, deselect, toggle */
+    { 0,0,0 }
+};
+
+static WidgetSpec CheckbuttonWidgetSpec =
+{
+    "TCheckbutton",		/* className */
+    sizeof(Checkbutton),	/* recordSize */
+    CheckbuttonOptionSpecs,	/* optionSpecs */
+    CheckbuttonCommands,	/* subcommands */
+    CheckbuttonInitialize,	/* initializeProc */
+    CheckbuttonCleanup,		/* cleanupProc */
+    CheckbuttonConfigure,	/* configureProc */
+    CheckbuttonPostConfigure,	/* postConfigureProc */
+    TtkWidgetGetLayout, 	/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    TtkWidgetDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(CheckbuttonLayout)
+     TTK_GROUP("Checkbutton.padding", TTK_FILL_BOTH,
+	 TTK_NODE("Checkbutton.indicator", TTK_PACK_LEFT)
+	 TTK_GROUP("Checkbutton.focus", TTK_PACK_LEFT | TTK_STICK_W,
+	     TTK_NODE("Checkbutton.label", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Radiobutton widget.
+ */
+
+typedef struct
+{
+    Tcl_Obj *variableObj;
+    Tcl_Obj *valueObj;
+    Tcl_Obj *commandObj;
+
+    Ttk_TraceHandle	*variableTrace;
+
+} RadiobuttonPart;
+
+typedef struct
+{
+    WidgetCore core;
+    BasePart base;
+    RadiobuttonPart radiobutton;
+} Radiobutton;
+
+/*
+ * Option specifications:
+ */
+static Tk_OptionSpec RadiobuttonOptionSpecs[] =
+{
+    {TK_OPTION_STRING, "-variable", "variable", "Variable",
+	"::selectedButton", Tk_Offset(Radiobutton, radiobutton.variableObj),-1,
+	0,0,0},
+    {TK_OPTION_STRING, "-value", "Value", "Value",
+	"1", Tk_Offset(Radiobutton, radiobutton.valueObj), -1,
+	0,0,0},
+    {TK_OPTION_STRING, "-command", "command", "Command",
+	"", Tk_Offset(Radiobutton, radiobutton.commandObj), -1,
+	0,0,0},
+
+    WIDGET_TAKEFOCUS_TRUE,
+    WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+/*
+ * Variable trace procedure for radiobuttons.
+ */
+static void
+RadiobuttonVariableChanged(void *clientData, const char *value)
+{
+    Radiobutton *radioPtr = clientData;
+
+    if (WidgetDestroyed(&radioPtr->core)) {
+	return;
+    }
+
+    if (!value) {
+	TtkWidgetChangeState(&radioPtr->core, TTK_STATE_ALTERNATE, 0);
+	return;
+    }
+    /* else */
+    TtkWidgetChangeState(&radioPtr->core, 0, TTK_STATE_ALTERNATE);
+    if (!strcmp(value, Tcl_GetString(radioPtr->radiobutton.valueObj))) {
+	TtkWidgetChangeState(&radioPtr->core, TTK_STATE_SELECTED, 0);
+    } else {
+	TtkWidgetChangeState(&radioPtr->core, 0, TTK_STATE_SELECTED);
+    }
+}
+
+static void
+RadiobuttonCleanup(void *recordPtr)
+{
+    Radiobutton *radioPtr = recordPtr;
+    Ttk_UntraceVariable(radioPtr->radiobutton.variableTrace);
+    radioPtr->radiobutton.variableTrace = 0;
+    BaseCleanup(recordPtr);
+}
+
+static int
+RadiobuttonConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Radiobutton *radioPtr = recordPtr;
+    Ttk_TraceHandle *vt = Ttk_TraceVariable(
+	interp, radioPtr->radiobutton.variableObj,
+	RadiobuttonVariableChanged, radioPtr);
+
+    if (!vt) {
+	return TCL_ERROR;
+    }
+
+    if (BaseConfigure(interp, recordPtr, mask) != TCL_OK) {
+	Ttk_UntraceVariable(vt);
+	return TCL_ERROR;
+    }
+
+    Ttk_UntraceVariable(radioPtr->radiobutton.variableTrace);
+    radioPtr->radiobutton.variableTrace = vt;
+
+    return TCL_OK;
+}
+
+static int
+RadiobuttonPostConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Radiobutton *radioPtr = recordPtr;
+    int status = TCL_OK;
+
+    if (radioPtr->radiobutton.variableTrace)
+	status = Ttk_FireTrace(radioPtr->radiobutton.variableTrace);
+    if (status == TCL_OK && !WidgetDestroyed(&radioPtr->core))
+	status = BasePostConfigure(interp, recordPtr, mask);
+    return status;
+}
+
+/*
+ * Radiobutton 'invoke' subcommand:
+ * 	Sets the radiobutton -variable to the -value, evaluates the -command.
+ */
+static int
+RadiobuttonInvokeCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Radiobutton *radioPtr = recordPtr;
+    WidgetCore *corePtr = &radioPtr->core;
+
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+	return TCL_ERROR;
+    }
+    if (corePtr->state & TTK_STATE_DISABLED)
+	return TCL_OK;
+
+    if (Tcl_ObjSetVar2(interp,
+	    radioPtr->radiobutton.variableObj, NULL,
+	    radioPtr->radiobutton.valueObj,
+	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+	== NULL)
+	return TCL_ERROR;
+
+    if (WidgetDestroyed(corePtr))
+	return TCL_ERROR;
+
+    return Tcl_EvalObjEx(interp,
+	radioPtr->radiobutton.commandObj, TCL_EVAL_GLOBAL);
+}
+
+static const Ttk_Ensemble RadiobuttonCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "invoke",		RadiobuttonInvokeCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    /* MISSING: select, deselect */
+    { 0,0,0 }
+};
+
+static WidgetSpec RadiobuttonWidgetSpec =
+{
+    "TRadiobutton",		/* className */
+    sizeof(Radiobutton),	/* recordSize */
+    RadiobuttonOptionSpecs,	/* optionSpecs */
+    RadiobuttonCommands,	/* subcommands */
+    BaseInitialize,		/* initializeProc */
+    RadiobuttonCleanup,		/* cleanupProc */
+    RadiobuttonConfigure,	/* configureProc */
+    RadiobuttonPostConfigure,	/* postConfigureProc */
+    TtkWidgetGetLayout, 	/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    TtkWidgetDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(RadiobuttonLayout)
+     TTK_GROUP("Radiobutton.padding", TTK_FILL_BOTH,
+	 TTK_NODE("Radiobutton.indicator", TTK_PACK_LEFT)
+	 TTK_GROUP("Radiobutton.focus", TTK_PACK_LEFT,
+	     TTK_NODE("Radiobutton.label", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Menubutton widget.
+ */
+
+typedef struct
+{
+    Tcl_Obj *menuObj;
+    Tcl_Obj *directionObj;
+} MenubuttonPart;
+
+typedef struct
+{
+    WidgetCore core;
+    BasePart base;
+    MenubuttonPart menubutton;
+} Menubutton;
+
+/*
+ * Option specifications:
+ */
+static const char *const directionStrings[] = {
+    "above", "below", "left", "right", "flush", NULL
+};
+static Tk_OptionSpec MenubuttonOptionSpecs[] =
+{
+    {TK_OPTION_STRING, "-menu", "menu", "Menu",
+	"", Tk_Offset(Menubutton, menubutton.menuObj), -1, 0,0,0},
+    {TK_OPTION_STRING_TABLE, "-direction", "direction", "Direction",
+	"below", Tk_Offset(Menubutton, menubutton.directionObj), -1,
+	0,(ClientData)directionStrings,GEOMETRY_CHANGED},
+
+    WIDGET_TAKEFOCUS_TRUE,
+    WIDGET_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+static const Ttk_Ensemble MenubuttonCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    { 0,0,0 }
+};
+
+static WidgetSpec MenubuttonWidgetSpec =
+{
+    "TMenubutton",		/* className */
+    sizeof(Menubutton), 	/* recordSize */
+    MenubuttonOptionSpecs, 	/* optionSpecs */
+    MenubuttonCommands,  	/* subcommands */
+    BaseInitialize,     	/* initializeProc */
+    BaseCleanup,		/* cleanupProc */
+    BaseConfigure,		/* configureProc */
+    BasePostConfigure,  	/* postConfigureProc */
+    TtkWidgetGetLayout, 	/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    TtkWidgetDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(MenubuttonLayout)
+    TTK_GROUP("Menubutton.border", TTK_FILL_BOTH,
+	TTK_GROUP("Menubutton.focus", TTK_FILL_BOTH,
+	    TTK_NODE("Menubutton.indicator", TTK_PACK_RIGHT)
+	    TTK_GROUP("Menubutton.padding", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_X,
+	        TTK_NODE("Menubutton.label", TTK_PACK_LEFT))))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE
+void TtkButton_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+    Ttk_RegisterLayout(theme, "TLabel", LabelLayout);
+    Ttk_RegisterLayout(theme, "TButton", ButtonLayout);
+    Ttk_RegisterLayout(theme, "TCheckbutton", CheckbuttonLayout);
+    Ttk_RegisterLayout(theme, "TRadiobutton", RadiobuttonLayout);
+    Ttk_RegisterLayout(theme, "TMenubutton", MenubuttonLayout);
+
+    RegisterWidget(interp, "ttk::label", &LabelWidgetSpec);
+    RegisterWidget(interp, "ttk::button", &ButtonWidgetSpec);
+    RegisterWidget(interp, "ttk::checkbutton", &CheckbuttonWidgetSpec);
+    RegisterWidget(interp, "ttk::radiobutton", &RadiobuttonWidgetSpec);
+    RegisterWidget(interp, "ttk::menubutton", &MenubuttonWidgetSpec);
+}

generic/ttk/ttkCache.c

@@ -0,0 +1,350 @@
+/*
+ *      Theme engine resource cache.
+ *
+ * Copyright (c) 2004, Joe English
+ *
+ * The problem:
+ *
+ * Tk maintains reference counts for fonts, colors, and images,
+ * and deallocates them when the reference count goes to zero.
+ * With the theme engine, resources are allocated right before
+ * drawing an element and released immediately after.
+ * This causes a severe performance penalty, and on PseudoColor
+ * visuals it causes colormap cycling as colormap entries are
+ * released and reused.
+ *
+ * Solution: Acquire fonts, colors, and objects from a
+ * resource cache instead of directly from Tk; the cache
+ * holds a semipermanent reference to the resource to keep
+ * it from being deallocated.
+ *
+ * The plumbing and control flow here is quite contorted;
+ * it would be better to address this problem in the core instead.
+ *
+ * @@@ BUGS/TODO: Need distinct caches for each combination
+ * of display, visual, and colormap.
+ *
+ * @@@ Colormap flashing on PseudoColor visuals is still possible,
+ * but this will be a transient effect.
+ */
+
+#include <stdio.h>	/* for sprintf */
+#include <tk.h>
+#include "ttkTheme.h"
+
+struct Ttk_ResourceCache_ {
+    Tcl_Interp	  *interp;	/* Interpreter for error reporting */
+    Tk_Window	  tkwin;	/* Cache window. */
+    Tcl_HashTable fontTable;	/* Entries: Tcl_Obj* holding FontObjs */
+    Tcl_HashTable colorTable;	/* Entries: Tcl_Obj* holding ColorObjs */
+    Tcl_HashTable borderTable;	/* Entries: Tcl_Obj* holding BorderObjs */
+    Tcl_HashTable imageTable;	/* Entries: Tk_Images */
+
+    Tcl_HashTable namedColors;	/* Entries: RGB values as Tcl_StringObjs */
+};
+
+/*
+ * Ttk_CreateResourceCache --
+ * 	Initialize a new resource cache.
+ */
+Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *interp)
+{
+    Ttk_ResourceCache cache = ckalloc(sizeof(*cache));
+
+    cache->tkwin = NULL;	/* initialized later */
+    cache->interp = interp;
+    Tcl_InitHashTable(&cache->fontTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&cache->colorTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&cache->borderTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&cache->imageTable, TCL_STRING_KEYS);
+    Tcl_InitHashTable(&cache->namedColors, TCL_STRING_KEYS);
+
+    return cache;
+}
+
+/*
+ * Ttk_ClearCache --
+ * 	Release references to all cached resources.
+ */
+static void Ttk_ClearCache(Ttk_ResourceCache cache)
+{
+    Tcl_HashSearch search;
+    Tcl_HashEntry *entryPtr;
+
+    /*
+     * Free fonts:
+     */
+    entryPtr = Tcl_FirstHashEntry(&cache->fontTable, &search);
+    while (entryPtr != NULL) {
+	Tcl_Obj *fontObj = Tcl_GetHashValue(entryPtr);
+	if (fontObj) {
+	    Tk_FreeFontFromObj(cache->tkwin, fontObj);
+	    Tcl_DecrRefCount(fontObj);
+	}
+	entryPtr = Tcl_NextHashEntry(&search);
+    }
+    Tcl_DeleteHashTable(&cache->fontTable);
+    Tcl_InitHashTable(&cache->fontTable, TCL_STRING_KEYS);
+
+    /*
+     * Free colors:
+     */
+    entryPtr = Tcl_FirstHashEntry(&cache->colorTable, &search);
+    while (entryPtr != NULL) {
+	Tcl_Obj *colorObj = Tcl_GetHashValue(entryPtr);
+	if (colorObj) {
+	    Tk_FreeColorFromObj(cache->tkwin, colorObj);
+	    Tcl_DecrRefCount(colorObj);
+	}
+	entryPtr = Tcl_NextHashEntry(&search);
+    }
+    Tcl_DeleteHashTable(&cache->colorTable);
+    Tcl_InitHashTable(&cache->colorTable, TCL_STRING_KEYS);
+
+    /*
+     * Free borders:
+     */
+    entryPtr = Tcl_FirstHashEntry(&cache->borderTable, &search);
+    while (entryPtr != NULL) {
+	Tcl_Obj *borderObj = Tcl_GetHashValue(entryPtr);
+	if (borderObj) {
+	    Tk_Free3DBorderFromObj(cache->tkwin, borderObj);
+	    Tcl_DecrRefCount(borderObj);
+	}
+	entryPtr = Tcl_NextHashEntry(&search);
+    }
+    Tcl_DeleteHashTable(&cache->borderTable);
+    Tcl_InitHashTable(&cache->borderTable, TCL_STRING_KEYS);
+
+    /*
+     * Free images:
+     */
+    entryPtr = Tcl_FirstHashEntry(&cache->imageTable, &search);
+    while (entryPtr != NULL) {
+	Tk_Image image = Tcl_GetHashValue(entryPtr);
+	if (image) {
+	    Tk_FreeImage(image);
+	}
+	entryPtr = Tcl_NextHashEntry(&search);
+    }
+    Tcl_DeleteHashTable(&cache->imageTable);
+    Tcl_InitHashTable(&cache->imageTable, TCL_STRING_KEYS);
+
+    return;
+}
+
+/*
+ * Ttk_FreeResourceCache --
+ * 	Release references to all cached resources, delete the cache.
+ */
+
+void Ttk_FreeResourceCache(Ttk_ResourceCache cache)
+{
+    Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+
+    Ttk_ClearCache(cache);
+
+    Tcl_DeleteHashTable(&cache->colorTable);
+    Tcl_DeleteHashTable(&cache->fontTable);
+    Tcl_DeleteHashTable(&cache->imageTable);
+
+    /*
+     * Free named colors:
+     */
+    entryPtr = Tcl_FirstHashEntry(&cache->namedColors, &search);
+    while (entryPtr != NULL) {
+	Tcl_Obj *colorNameObj = Tcl_GetHashValue(entryPtr);
+	Tcl_DecrRefCount(colorNameObj);
+	entryPtr = Tcl_NextHashEntry(&search);
+    }
+    Tcl_DeleteHashTable(&cache->namedColors);
+
+    ckfree(cache);
+}
+
+/*
+ * CacheWinEventHandler --
+ * 	Detect when the cache window is destroyed, clear cache.
+ */
+static void CacheWinEventHandler(ClientData clientData, XEvent *eventPtr)
+{
+    Ttk_ResourceCache cache = clientData;
+
+    if (eventPtr->type != DestroyNotify) {
+	return;
+    }
+    Tk_DeleteEventHandler(cache->tkwin, StructureNotifyMask,
+	    CacheWinEventHandler, clientData);
+    Ttk_ClearCache(cache);
+    cache->tkwin = NULL;
+}
+
+/*
+ * InitCacheWindow --
+ * 	Specify the cache window if not already set.
+ * 	@@@ SHOULD: use separate caches for each combination
+ * 	@@@ of display, visual, and colormap.
+ */
+static void InitCacheWindow(Ttk_ResourceCache cache, Tk_Window tkwin)
+{
+    if (cache->tkwin == NULL) {
+	cache->tkwin = tkwin;
+	Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+		CacheWinEventHandler, cache);
+    }
+}
+
+/*
+ * Ttk_RegisterNamedColor --
+ *	Specify an RGB triplet as a named color.
+ *	Overrides any previous named color specification.
+ */
+void Ttk_RegisterNamedColor(
+    Ttk_ResourceCache cache,
+    const char *colorName,
+    XColor *colorPtr)
+{
+    int newEntry;
+    Tcl_HashEntry *entryPtr;
+    char nameBuf[14];
+    Tcl_Obj *colorNameObj;
+
+    sprintf(nameBuf, "#%04X%04X%04X",
+    	colorPtr->red, colorPtr->green, colorPtr->blue);
+    colorNameObj = Tcl_NewStringObj(nameBuf, -1);
+    Tcl_IncrRefCount(colorNameObj);
+
+    entryPtr = Tcl_CreateHashEntry(&cache->namedColors, colorName, &newEntry);
+    if (!newEntry) {
+    	Tcl_Obj *oldColor = Tcl_GetHashValue(entryPtr);
+	Tcl_DecrRefCount(oldColor);
+    }
+
+    Tcl_SetHashValue(entryPtr, colorNameObj);
+}
+
+/*
+ * CheckNamedColor(objPtr) --
+ *	If objPtr is a registered color name, return a Tcl_Obj *
+ *	containing the registered color value specification.
+ *	Otherwise, return the input argument.
+ */
+static Tcl_Obj *CheckNamedColor(Ttk_ResourceCache cache, Tcl_Obj *objPtr)
+{
+    Tcl_HashEntry *entryPtr =
+    	Tcl_FindHashEntry(&cache->namedColors, Tcl_GetString(objPtr));
+    if (entryPtr) {	/* Use named color instead */
+    	objPtr = Tcl_GetHashValue(entryPtr);
+    }
+    return objPtr;
+}
+
+/*
+ * Template for allocation routines:
+ */
+typedef void *(*Allocator)(Tcl_Interp *, Tk_Window, Tcl_Obj *);
+
+static Tcl_Obj *Ttk_Use(
+    Tcl_Interp *interp,
+    Tcl_HashTable *table,
+    Allocator allocate,
+    Tk_Window tkwin,
+    Tcl_Obj *objPtr)
+{
+    int newEntry;
+    Tcl_HashEntry *entryPtr =
+	Tcl_CreateHashEntry(table,Tcl_GetString(objPtr),&newEntry);
+    Tcl_Obj *cacheObj;
+
+    if (!newEntry) {
+	return Tcl_GetHashValue(entryPtr);
+    }
+
+    cacheObj = Tcl_DuplicateObj(objPtr);
+    Tcl_IncrRefCount(cacheObj);
+
+    if (allocate(interp, tkwin, cacheObj)) {
+	Tcl_SetHashValue(entryPtr, cacheObj);
+	return cacheObj;
+    } else {
+	Tcl_DecrRefCount(cacheObj);
+	Tcl_SetHashValue(entryPtr, NULL);
+	Tcl_BackgroundException(interp, TCL_ERROR);
+	return NULL;
+    }
+}
+
+/*
+ * Ttk_UseFont --
+ * 	Acquire a font from the cache.
+ */
+Tcl_Obj *Ttk_UseFont(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+    InitCacheWindow(cache, tkwin);
+    return Ttk_Use(cache->interp,
+	&cache->fontTable,(Allocator)Tk_AllocFontFromObj, tkwin, objPtr);
+}
+
+/*
+ * Ttk_UseColor --
+ * 	Acquire a color from the cache.
+ */
+Tcl_Obj *Ttk_UseColor(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+    objPtr = CheckNamedColor(cache, objPtr);
+    InitCacheWindow(cache, tkwin);
+    return Ttk_Use(cache->interp,
+	&cache->colorTable,(Allocator)Tk_AllocColorFromObj, tkwin, objPtr);
+}
+
+/*
+ * Ttk_UseBorder --
+ * 	Acquire a Tk_3DBorder from the cache.
+ */
+Tcl_Obj *Ttk_UseBorder(
+    Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+    objPtr = CheckNamedColor(cache, objPtr);
+    InitCacheWindow(cache, tkwin);
+    return Ttk_Use(cache->interp,
+	&cache->borderTable,(Allocator)Tk_Alloc3DBorderFromObj, tkwin, objPtr);
+}
+
+/* NullImageChanged --
+ * 	Tk_ImageChangedProc for Ttk_UseImage
+ */
+
+static void NullImageChanged(ClientData clientData,
+    int x, int y, int width, int height, int imageWidth, int imageHeight)
+{ /* No-op */ }
+
+/*
+ * Ttk_UseImage --
+ * 	Acquire a Tk_Image from the cache.
+ */
+Tk_Image Ttk_UseImage(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+    const char *imageName = Tcl_GetString(objPtr);
+    int newEntry;
+    Tcl_HashEntry *entryPtr =
+	Tcl_CreateHashEntry(&cache->imageTable,imageName,&newEntry);
+    Tk_Image image;
+
+    InitCacheWindow(cache, tkwin);
+
+    if (!newEntry) {
+	return Tcl_GetHashValue(entryPtr);
+    }
+
+    image = Tk_GetImage(cache->interp, tkwin, imageName, NullImageChanged,0);
+    Tcl_SetHashValue(entryPtr, image);
+
+    if (!image) {
+	Tcl_BackgroundException(cache->interp, TCL_ERROR);
+    }
+
+    return image;
+}
+
+/*EOF*/

generic/ttk/ttkClamTheme.c

@@ -0,0 +1,971 @@
+/*
+ * Copyright (C) 2004 Joe English
+ *
+ * "clam" theme; inspired by the XFCE family of Gnome themes.
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+
+/* 
+ * Under windows, the Tk-provided XDrawLine and XDrawArc have an 
+ * off-by-one error in the end point. This is especially apparent with this
+ * theme. Defining this macro as true handles this case.
+ */
+#if defined(_WIN32) && !defined(WIN32_XDRAWLINE_HACK)
+#	define WIN32_XDRAWLINE_HACK 1
+#else
+#	define WIN32_XDRAWLINE_HACK 0
+#endif
+
+#define STR(x) StR(x)
+#define StR(x) #x
+
+#define SCROLLBAR_THICKNESS 14
+
+#define FRAME_COLOR	"#dcdad5"
+#define LIGHT_COLOR  	"#ffffff"
+#define DARK_COLOR  	"#cfcdc8"
+#define DARKER_COLOR 	"#bab5ab"
+#define DARKEST_COLOR	"#9e9a91"
+
+/*------------------------------------------------------------------------
+ * +++ Utilities.
+ */
+
+static GC Ttk_GCForColor(Tk_Window tkwin, Tcl_Obj* colorObj, Drawable d)
+{
+    GC gc = Tk_GCForColor(Tk_GetColorFromObj(tkwin, colorObj), d);
+
+#ifdef MAC_OSX_TK
+    /*
+     * Workaround for Tk bug under Aqua where the default line width is 0.
+     */
+    Display *display = Tk_Display(tkwin);
+    unsigned long mask = 0ul;
+    XGCValues gcValues;
+
+    gcValues.line_width = 1;
+    mask = GCLineWidth;
+
+    XChangeGC(display, gc, mask, &gcValues);
+#endif
+
+    return gc;
+}
+
+static void DrawSmoothBorder(
+    Tk_Window tkwin, Drawable d, Ttk_Box b,
+    Tcl_Obj *outerColorObj, Tcl_Obj *upperColorObj, Tcl_Obj *lowerColorObj)
+{
+    Display *display = Tk_Display(tkwin);
+    int x1 = b.x, x2 = b.x + b.width - 1;
+    int y1 = b.y, y2 = b.y + b.height - 1;
+    const int w = WIN32_XDRAWLINE_HACK;
+    GC gc;
+
+    if (   outerColorObj
+	&& (gc=Ttk_GCForColor(tkwin,outerColorObj,d)))
+    {
+	XDrawLine(display,d,gc, x1+1,y1, x2-1+w,y1); /* N */
+	XDrawLine(display,d,gc, x1+1,y2, x2-1+w,y2); /* S */
+	XDrawLine(display,d,gc, x1,y1+1, x1,y2-1+w); /* E */
+	XDrawLine(display,d,gc, x2,y1+1, x2,y2-1+w); /* W */
+    }
+
+    if (   upperColorObj
+	&& (gc=Ttk_GCForColor(tkwin,upperColorObj,d)))
+    {
+	XDrawLine(display,d,gc, x1+1,y1+1, x2-1+w,y1+1); /* N */
+	XDrawLine(display,d,gc, x1+1,y1+1, x1+1,y2-1);   /* E */
+    }
+
+    if (   lowerColorObj
+	&& (gc=Ttk_GCForColor(tkwin,lowerColorObj,d)))
+    {
+	XDrawLine(display,d,gc, x2-1,y2-1, x1+1-w,y2-1); /* S */
+	XDrawLine(display,d,gc, x2-1,y2-1, x2-1,y1+1-w); /* W */
+    }
+}
+
+static GC BackgroundGC(Tk_Window tkwin, Tcl_Obj *backgroundObj)
+{
+    Tk_3DBorder bd = Tk_Get3DBorderFromObj(tkwin, backgroundObj);
+    return Tk_3DBorderGC(tkwin, bd, TK_3D_FLAT_GC);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Border element.
+ */
+
+typedef struct {
+    Tcl_Obj 	*borderColorObj;
+    Tcl_Obj 	*lightColorObj;
+    Tcl_Obj 	*darkColorObj;
+    Tcl_Obj 	*reliefObj;
+    Tcl_Obj 	*borderWidthObj;	/* See <<NOTE-BORDERWIDTH>> */
+} BorderElement;
+
+static Ttk_ElementOptionSpec BorderElementOptions[] = {
+    { "-bordercolor", TK_OPTION_COLOR,
+	Tk_Offset(BorderElement,borderColorObj), DARKEST_COLOR },
+    { "-lightcolor", TK_OPTION_COLOR,
+	Tk_Offset(BorderElement,lightColorObj), LIGHT_COLOR },
+    { "-darkcolor", TK_OPTION_COLOR,
+	Tk_Offset(BorderElement,darkColorObj), DARK_COLOR },
+    { "-relief", TK_OPTION_RELIEF,
+	Tk_Offset(BorderElement,reliefObj), "flat" },
+    { "-borderwidth", TK_OPTION_PIXELS,
+	Tk_Offset(BorderElement,borderWidthObj), "2" },
+    { NULL, 0, 0, NULL }
+};
+
+/*
+ * <<NOTE-BORDERWIDTH>>: -borderwidth is only partially supported:
+ * in this theme, borders are always exactly 2 pixels thick.
+ * With -borderwidth 0, border is not drawn at all; 
+ * otherwise a 2-pixel border is used.  For -borderwidth > 2, 
+ * the excess is used as padding.
+ */
+
+static void BorderElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    BorderElement *border = (BorderElement*)elementRecord;
+    int borderWidth = 2;
+    Tk_GetPixelsFromObj(NULL, tkwin, border->borderWidthObj, &borderWidth);
+    if (borderWidth == 1) ++borderWidth;
+    *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void BorderElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    BorderElement *border = elementRecord;
+    int relief = TK_RELIEF_FLAT;
+    int borderWidth = 2;
+    Tcl_Obj *outer = 0, *upper = 0, *lower = 0;
+
+    Tk_GetReliefFromObj(NULL, border->reliefObj, &relief);
+    Tk_GetPixelsFromObj(NULL, tkwin, border->borderWidthObj, &borderWidth);
+
+    if (borderWidth == 0) return;
+
+    switch (relief) {
+	case TK_RELIEF_GROOVE :
+	case TK_RELIEF_RIDGE :
+	case TK_RELIEF_RAISED :
+	    outer = border->borderColorObj;
+	    upper = border->lightColorObj;
+	    lower = border->darkColorObj;
+	    break;
+	case TK_RELIEF_SUNKEN :
+	    outer = border->borderColorObj;
+	    upper = border->darkColorObj;
+	    lower = border->lightColorObj;
+	    break;
+	case TK_RELIEF_FLAT :
+	    outer = upper = lower = 0;
+	    break;
+	case TK_RELIEF_SOLID :
+	    outer = upper = lower = border->borderColorObj;
+	    break;
+    }
+
+    DrawSmoothBorder(tkwin, d, b, outer, upper, lower);
+}
+
+static Ttk_ElementSpec BorderElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(BorderElement),
+    BorderElementOptions,
+    BorderElementSize,
+    BorderElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Field element.
+ */
+
+typedef struct {
+    Tcl_Obj 	*borderColorObj;
+    Tcl_Obj 	*lightColorObj;
+    Tcl_Obj 	*darkColorObj;
+    Tcl_Obj 	*backgroundObj;
+} FieldElement;
+
+static Ttk_ElementOptionSpec FieldElementOptions[] = {
+    { "-bordercolor", TK_OPTION_COLOR,
+	Tk_Offset(FieldElement,borderColorObj), DARKEST_COLOR },
+    { "-lightcolor", TK_OPTION_COLOR,
+	Tk_Offset(FieldElement,lightColorObj), LIGHT_COLOR },
+    { "-darkcolor", TK_OPTION_COLOR,
+	Tk_Offset(FieldElement,darkColorObj), DARK_COLOR },
+    { "-fieldbackground", TK_OPTION_BORDER,
+	Tk_Offset(FieldElement,backgroundObj), "white" },
+    { NULL, 0, 0, NULL }
+};
+
+static void FieldElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    *paddingPtr = Ttk_UniformPadding(2);
+}
+
+static void FieldElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    FieldElement *field = elementRecord;
+    Tk_3DBorder bg = Tk_Get3DBorderFromObj(tkwin, field->backgroundObj);
+    Ttk_Box f = Ttk_PadBox(b, Ttk_UniformPadding(2));
+    Tcl_Obj *outer = field->borderColorObj,
+	    *inner = field->lightColorObj;
+
+    DrawSmoothBorder(tkwin, d, b, outer, inner, inner);
+    Tk_Fill3DRectangle(
+	tkwin, d, bg, f.x, f.y, f.width, f.height, 0, TK_RELIEF_SUNKEN);
+}
+
+static Ttk_ElementSpec FieldElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(FieldElement),
+    FieldElementOptions,
+    FieldElementSize,
+    FieldElementDraw
+};
+
+/*
+ * Modified field element for comboboxes:
+ * 	Right edge is expanded to overlap the dropdown button.
+ */
+static void ComboboxFieldElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    FieldElement *field = elementRecord;
+    GC gc = Ttk_GCForColor(tkwin,field->borderColorObj,d);
+
+    ++b.width;
+    FieldElementDraw(clientData, elementRecord, tkwin, d, b, state);
+
+    XDrawLine(Tk_Display(tkwin), d, gc,
+	    b.x + b.width - 1, b.y,
+	    b.x + b.width - 1, b.y + b.height - 1 + WIN32_XDRAWLINE_HACK);
+}
+
+static Ttk_ElementSpec ComboboxFieldElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(FieldElement),
+    FieldElementOptions,
+    FieldElementSize,
+    ComboboxFieldElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Indicator elements for check and radio buttons.
+ */
+
+typedef struct {
+    Tcl_Obj *sizeObj;
+    Tcl_Obj *marginObj;
+    Tcl_Obj *backgroundObj;
+    Tcl_Obj *foregroundObj;
+    Tcl_Obj *upperColorObj;
+    Tcl_Obj *lowerColorObj;
+} IndicatorElement;
+
+static Ttk_ElementOptionSpec IndicatorElementOptions[] = {
+    { "-indicatorsize", TK_OPTION_PIXELS,
+	Tk_Offset(IndicatorElement,sizeObj), "10" },
+    { "-indicatormargin", TK_OPTION_STRING,
+	Tk_Offset(IndicatorElement,marginObj), "1" },
+    { "-indicatorbackground", TK_OPTION_COLOR,
+	Tk_Offset(IndicatorElement,backgroundObj), "white" },
+    { "-indicatorforeground", TK_OPTION_COLOR,
+	Tk_Offset(IndicatorElement,foregroundObj), "black" },
+    { "-upperbordercolor", TK_OPTION_COLOR,
+	Tk_Offset(IndicatorElement,upperColorObj), DARKEST_COLOR },
+    { "-lowerbordercolor", TK_OPTION_COLOR,
+	Tk_Offset(IndicatorElement,lowerColorObj), DARK_COLOR },
+    { NULL, 0, 0, NULL }
+};
+
+static void IndicatorElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    IndicatorElement *indicator = elementRecord;
+    Ttk_Padding margins;
+    int size = 10;
+    Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &margins);
+    Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+    *widthPtr = size + Ttk_PaddingWidth(margins);
+    *heightPtr = size + Ttk_PaddingHeight(margins);
+}
+
+static void RadioIndicatorElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    IndicatorElement *indicator = elementRecord;
+    GC gcb=Ttk_GCForColor(tkwin,indicator->backgroundObj,d);
+    GC gcf=Ttk_GCForColor(tkwin,indicator->foregroundObj,d);
+    GC gcu=Ttk_GCForColor(tkwin,indicator->upperColorObj,d);
+    GC gcl=Ttk_GCForColor(tkwin,indicator->lowerColorObj,d);
+    Ttk_Padding padding;
+
+    Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &padding);
+    b = Ttk_PadBox(b, padding);
+
+    XFillArc(Tk_Display(tkwin),d,gcb, b.x,b.y,b.width,b.height, 0,360*64);
+    XDrawArc(Tk_Display(tkwin),d,gcl, b.x,b.y,b.width,b.height, 225*64,180*64);
+    XDrawArc(Tk_Display(tkwin),d,gcu, b.x,b.y,b.width,b.height, 45*64,180*64);
+
+    if (state & TTK_STATE_SELECTED) {
+	b = Ttk_PadBox(b,Ttk_UniformPadding(3));
+	XFillArc(Tk_Display(tkwin),d,gcf, b.x,b.y,b.width,b.height, 0,360*64);
+	XDrawArc(Tk_Display(tkwin),d,gcf, b.x,b.y,b.width,b.height, 0,360*64);
+#if WIN32_XDRAWLINE_HACK
+	XDrawArc(Tk_Display(tkwin),d,gcf, b.x,b.y,b.width,b.height, 300*64,360*64);
+#endif
+    }
+}
+
+static void CheckIndicatorElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    Display *display = Tk_Display(tkwin);
+    IndicatorElement *indicator = elementRecord;
+    GC gcb=Ttk_GCForColor(tkwin,indicator->backgroundObj,d);
+    GC gcf=Ttk_GCForColor(tkwin,indicator->foregroundObj,d);
+    GC gcu=Ttk_GCForColor(tkwin,indicator->upperColorObj,d);
+    GC gcl=Ttk_GCForColor(tkwin,indicator->lowerColorObj,d);
+    Ttk_Padding padding;
+    const int w = WIN32_XDRAWLINE_HACK;
+
+    Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &padding);
+    b = Ttk_PadBox(b, padding);
+
+    XFillRectangle(display,d,gcb, b.x,b.y,b.width,b.height);
+    XDrawLine(display,d,gcl,b.x,b.y+b.height,b.x+b.width+w,b.y+b.height);/*S*/
+    XDrawLine(display,d,gcl,b.x+b.width,b.y,b.x+b.width,b.y+b.height+w); /*E*/
+    XDrawLine(display,d,gcu,b.x,b.y, b.x,b.y+b.height+w); /*W*/
+    XDrawLine(display,d,gcu,b.x,b.y, b.x+b.width+w,b.y);  /*N*/
+
+    if (state & TTK_STATE_SELECTED) {
+	int p,q,r,s;
+
+	b = Ttk_PadBox(b,Ttk_UniformPadding(2));
+	p = b.x, q = b.y, r = b.x+b.width, s = b.y+b.height;
+
+	r+=w, s+=w;
+	XDrawLine(display, d, gcf, p,   q,   r,   s);
+	XDrawLine(display, d, gcf, p+1, q,   r,   s-1);
+	XDrawLine(display, d, gcf, p,   q+1, r-1, s);
+
+	s-=w, q-=w;
+	XDrawLine(display, d, gcf, p,   s,   r,   q);
+	XDrawLine(display, d, gcf, p+1, s,   r,   q+1);
+	XDrawLine(display, d, gcf, p,   s-1, r-1, q);
+    }
+}
+
+static Ttk_ElementSpec RadioIndicatorElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(IndicatorElement),
+    IndicatorElementOptions,
+    IndicatorElementSize,
+    RadioIndicatorElementDraw
+};
+
+static Ttk_ElementSpec CheckIndicatorElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(IndicatorElement),
+    IndicatorElementOptions,
+    IndicatorElementSize,
+    CheckIndicatorElementDraw
+};
+
+#define MENUBUTTON_ARROW_SIZE 5
+
+typedef struct {
+    Tcl_Obj *sizeObj;
+    Tcl_Obj *colorObj;
+    Tcl_Obj *paddingObj;
+} MenuIndicatorElement;
+
+static Ttk_ElementOptionSpec MenuIndicatorElementOptions[] =
+{
+    { "-arrowsize", TK_OPTION_PIXELS,
+	Tk_Offset(MenuIndicatorElement,sizeObj), 
+	STR(MENUBUTTON_ARROW_SIZE)},
+    { "-arrowcolor",TK_OPTION_COLOR,
+	Tk_Offset(MenuIndicatorElement,colorObj),
+	"black" },
+    { "-arrowpadding",TK_OPTION_STRING,
+	Tk_Offset(MenuIndicatorElement,paddingObj),
+	"3" },
+    { NULL, 0, 0, NULL }
+};
+
+static void MenuIndicatorElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    MenuIndicatorElement *indicator = elementRecord;
+    Ttk_Padding margins;
+    int size = MENUBUTTON_ARROW_SIZE;
+    Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+    Ttk_GetPaddingFromObj(NULL, tkwin, indicator->paddingObj, &margins);
+    TtkArrowSize(size, ARROW_DOWN, widthPtr, heightPtr);
+    *widthPtr += Ttk_PaddingWidth(margins);
+    *heightPtr += Ttk_PaddingHeight(margins);
+}
+
+static void MenuIndicatorElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned int state)
+{
+    MenuIndicatorElement *indicator = elementRecord;
+    XColor *arrowColor = Tk_GetColorFromObj(tkwin, indicator->colorObj);
+    GC gc = Tk_GCForColor(arrowColor, d);
+    int size = MENUBUTTON_ARROW_SIZE;
+    int width, height;
+
+    Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+
+    TtkArrowSize(size, ARROW_DOWN, &width, &height);
+    b = Ttk_StickBox(b, width, height, 0);
+    TtkFillArrow(Tk_Display(tkwin), d, gc, b, ARROW_DOWN);
+}
+
+static Ttk_ElementSpec MenuIndicatorElementSpec =
+{
+    TK_STYLE_VERSION_2,
+    sizeof(MenuIndicatorElement),
+    MenuIndicatorElementOptions,
+    MenuIndicatorElementSize,
+    MenuIndicatorElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Grips.
+ *
+ * TODO: factor this with ThumbElementDraw
+ */
+
+static Ttk_Orient GripClientData[] = {
+    TTK_ORIENT_HORIZONTAL, TTK_ORIENT_VERTICAL
+};
+
+typedef struct {
+    Tcl_Obj 	*lightColorObj;
+    Tcl_Obj 	*borderColorObj;
+    Tcl_Obj 	*gripCountObj;
+} GripElement;
+
+static Ttk_ElementOptionSpec GripElementOptions[] = {
+    { "-lightcolor", TK_OPTION_COLOR,
+	Tk_Offset(GripElement,lightColorObj), LIGHT_COLOR },
+    { "-bordercolor", TK_OPTION_COLOR,
+	Tk_Offset(GripElement,borderColorObj), DARKEST_COLOR },
+    { "-gripcount", TK_OPTION_INT,
+	Tk_Offset(GripElement,gripCountObj), "5" },
+    { NULL, 0, 0, NULL }
+};
+
+static void GripElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    int horizontal = *((Ttk_Orient*)clientData) == TTK_ORIENT_HORIZONTAL;
+    GripElement *grip = elementRecord;
+    int gripCount = 0;
+
+    Tcl_GetIntFromObj(NULL, grip->gripCountObj, &gripCount);
+    if (horizontal) {
+	*widthPtr = 2*gripCount;
+    } else {
+	*heightPtr = 2*gripCount;
+    }
+}
+
+static void GripElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    const int w = WIN32_XDRAWLINE_HACK;
+    int horizontal = *((Ttk_Orient*)clientData) == TTK_ORIENT_HORIZONTAL;
+    GripElement *grip = elementRecord;
+    GC lightGC = Ttk_GCForColor(tkwin,grip->lightColorObj,d);
+    GC darkGC = Ttk_GCForColor(tkwin,grip->borderColorObj,d);
+    int gripPad = 1, gripCount = 0;
+    int i;
+
+    Tcl_GetIntFromObj(NULL, grip->gripCountObj, &gripCount);
+
+    if (horizontal) {
+	int x = b.x + b.width / 2 - gripCount;
+	int y1 = b.y + gripPad, y2 = b.y + b.height - gripPad - 1 + w;
+	for (i=0; i<gripCount; ++i) {
+	    XDrawLine(Tk_Display(tkwin), d, darkGC,  x,y1, x,y2); ++x;
+	    XDrawLine(Tk_Display(tkwin), d, lightGC, x,y1, x,y2); ++x;
+	}
+    } else {
+	int y = b.y + b.height / 2 - gripCount;
+	int x1 = b.x + gripPad, x2 = b.x + b.width - gripPad - 1 + w;
+	for (i=0; i<gripCount; ++i) {
+	    XDrawLine(Tk_Display(tkwin), d, darkGC,  x1,y, x2,y); ++y;
+	    XDrawLine(Tk_Display(tkwin), d, lightGC, x1,y, x2,y); ++y;
+	}
+    }
+}
+
+static Ttk_ElementSpec GripElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(GripElement),
+    GripElementOptions,
+    GripElementSize,
+    GripElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Scrollbar elements: trough, arrows, thumb.
+ *
+ * Notice that the trough element has 0 internal padding;
+ * that way the thumb and arrow borders overlap the trough.
+ */
+
+typedef struct { /* Common element record for scrollbar elements */
+    Tcl_Obj 	*orientObj;
+    Tcl_Obj 	*backgroundObj;
+    Tcl_Obj 	*borderColorObj;
+    Tcl_Obj 	*troughColorObj;
+    Tcl_Obj 	*lightColorObj;
+    Tcl_Obj 	*darkColorObj;
+    Tcl_Obj 	*arrowColorObj;
+    Tcl_Obj 	*arrowSizeObj;
+    Tcl_Obj 	*gripCountObj;
+    Tcl_Obj 	*sliderlengthObj;
+} ScrollbarElement;
+
+static Ttk_ElementOptionSpec ScrollbarElementOptions[] = {
+    { "-orient", TK_OPTION_ANY,
+	Tk_Offset(ScrollbarElement, orientObj), "horizontal" },
+    { "-background", TK_OPTION_BORDER,
+	Tk_Offset(ScrollbarElement,backgroundObj), FRAME_COLOR },
+    { "-bordercolor", TK_OPTION_COLOR,
+	Tk_Offset(ScrollbarElement,borderColorObj), DARKEST_COLOR },
+    { "-troughcolor", TK_OPTION_COLOR,
+	Tk_Offset(ScrollbarElement,troughColorObj), DARKER_COLOR },
+    { "-lightcolor", TK_OPTION_COLOR,
+	Tk_Offset(ScrollbarElement,lightColorObj), LIGHT_COLOR },
+    { "-darkcolor", TK_OPTION_COLOR,
+	Tk_Offset(ScrollbarElement,darkColorObj), DARK_COLOR },
+    { "-arrowcolor", TK_OPTION_COLOR,
+	Tk_Offset(ScrollbarElement,arrowColorObj), "#000000" },
+    { "-arrowsize", TK_OPTION_PIXELS,
+	Tk_Offset(ScrollbarElement,arrowSizeObj), STR(SCROLLBAR_THICKNESS) },
+    { "-gripcount", TK_OPTION_INT,
+	Tk_Offset(ScrollbarElement,gripCountObj), "5" },
+    { "-sliderlength", TK_OPTION_INT,
+	Tk_Offset(ScrollbarElement,sliderlengthObj), "30" },
+    { NULL, 0, 0, NULL }
+};
+
+static void TroughElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    ScrollbarElement *sb = elementRecord;
+    GC gcb = Ttk_GCForColor(tkwin,sb->borderColorObj,d);
+    GC gct = Ttk_GCForColor(tkwin,sb->troughColorObj,d);
+    XFillRectangle(Tk_Display(tkwin), d, gct, b.x, b.y, b.width-1, b.height-1);
+    XDrawRectangle(Tk_Display(tkwin), d, gcb, b.x, b.y, b.width-1, b.height-1);
+}
+
+static Ttk_ElementSpec TroughElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(ScrollbarElement),
+    ScrollbarElementOptions,
+    TtkNullElementSize,
+    TroughElementDraw
+};
+
+static void ThumbElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    ScrollbarElement *sb = elementRecord;
+    int size = SCROLLBAR_THICKNESS;
+    Tcl_GetIntFromObj(NULL, sb->arrowSizeObj, &size);
+    *widthPtr = *heightPtr = size;
+}
+
+static void ThumbElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    ScrollbarElement *sb = elementRecord;
+    int gripCount = 0, orient = TTK_ORIENT_HORIZONTAL;
+    GC lightGC, darkGC;
+    int x1, y1, x2, y2, dx, dy, i;
+    const int w = WIN32_XDRAWLINE_HACK;
+
+    DrawSmoothBorder(tkwin, d, b,
+	sb->borderColorObj, sb->lightColorObj, sb->darkColorObj);
+    XFillRectangle(
+	Tk_Display(tkwin), d, BackgroundGC(tkwin, sb->backgroundObj),
+	b.x+2, b.y+2, b.width-4, b.height-4);
+
+    /*
+     * Draw grip:
+     */
+    Ttk_GetOrientFromObj(NULL, sb->orientObj, &orient);
+    Tcl_GetIntFromObj(NULL, sb->gripCountObj, &gripCount);
+    lightGC = Ttk_GCForColor(tkwin,sb->lightColorObj,d);
+    darkGC = Ttk_GCForColor(tkwin,sb->borderColorObj,d);
+    
+    if (orient == TTK_ORIENT_HORIZONTAL) {
+	dx = 1; dy = 0;
+	x1 = x2 = b.x + b.width / 2 - gripCount;
+	y1 = b.y + 2;
+	y2 = b.y + b.height - 3 + w;
+    } else {
+	dx = 0; dy = 1;
+	y1 = y2 = b.y + b.height / 2 - gripCount;
+	x1 = b.x + 2;
+	x2 = b.x + b.width - 3 + w;
+    }
+
+    for (i=0; i<gripCount; ++i) {
+	XDrawLine(Tk_Display(tkwin), d, darkGC, x1,y1, x2,y2);
+	x1 += dx; x2 += dx; y1 += dy; y2 += dy;
+	XDrawLine(Tk_Display(tkwin), d, lightGC, x1,y1, x2,y2);
+	x1 += dx; x2 += dx; y1 += dy; y2 += dy;
+    }
+}
+
+static Ttk_ElementSpec ThumbElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(ScrollbarElement),
+    ScrollbarElementOptions,
+    ThumbElementSize,
+    ThumbElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Slider element.
+ */
+static void SliderElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    ScrollbarElement *sb = elementRecord;
+    int length, thickness, orient;
+
+    length = thickness = SCROLLBAR_THICKNESS;
+    Ttk_GetOrientFromObj(NULL, sb->orientObj, &orient);
+    Tcl_GetIntFromObj(NULL, sb->arrowSizeObj, &thickness);
+    Tk_GetPixelsFromObj(NULL, tkwin, sb->sliderlengthObj, &length);
+    if (orient == TTK_ORIENT_VERTICAL) {
+	*heightPtr = length;
+	*widthPtr = thickness;
+    } else {
+	*heightPtr = thickness;
+	*widthPtr = length;
+    }
+
+}
+
+static Ttk_ElementSpec SliderElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(ScrollbarElement),
+    ScrollbarElementOptions,
+    SliderElementSize,
+    ThumbElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Progress bar element
+ */
+static void PbarElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    SliderElementSize(clientData, elementRecord, tkwin,
+	    widthPtr, heightPtr, paddingPtr);
+    *paddingPtr = Ttk_UniformPadding(2);
+    *widthPtr += 4;
+    *heightPtr += 4;
+}
+
+static void PbarElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    ScrollbarElement *sb = elementRecord;
+    
+    b = Ttk_PadBox(b, Ttk_UniformPadding(2));
+    if (b.width > 4 && b.height > 4) {
+	DrawSmoothBorder(tkwin, d, b,
+	    sb->borderColorObj, sb->lightColorObj, sb->darkColorObj);
+	XFillRectangle(Tk_Display(tkwin), d, 
+	    BackgroundGC(tkwin, sb->backgroundObj),
+	    b.x+2, b.y+2, b.width-4, b.height-4);
+    }
+}
+
+static Ttk_ElementSpec PbarElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(ScrollbarElement),
+    ScrollbarElementOptions,
+    PbarElementSize,
+    PbarElementDraw
+};
+
+
+/*------------------------------------------------------------------------
+ * +++ Scrollbar arrows.
+ */
+static int ArrowElements[] = { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT };
+
+static void ArrowElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    ScrollbarElement *sb = elementRecord;
+    int size = SCROLLBAR_THICKNESS;
+    Tcl_GetIntFromObj(NULL, sb->arrowSizeObj, &size);
+    *widthPtr = *heightPtr = size;
+}
+
+static void ArrowElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned state)
+{
+    ArrowDirection dir = *(ArrowDirection*)clientData;
+    ScrollbarElement *sb = elementRecord;
+    GC gc = Ttk_GCForColor(tkwin,sb->arrowColorObj, d);
+    int h, cx, cy;
+
+    DrawSmoothBorder(tkwin, d, b,
+	sb->borderColorObj, sb->lightColorObj, sb->darkColorObj);
+
+    XFillRectangle(
+	Tk_Display(tkwin), d, BackgroundGC(tkwin, sb->backgroundObj),
+	b.x+2, b.y+2, b.width-4, b.height-4);
+
+    b = Ttk_PadBox(b, Ttk_UniformPadding(3));
+    h = b.width < b.height ? b.width : b.height;
+    TtkArrowSize(h/2, dir, &cx, &cy);
+    b = Ttk_AnchorBox(b, cx, cy, TK_ANCHOR_CENTER);
+
+    TtkFillArrow(Tk_Display(tkwin), d, gc, b, dir);
+}
+
+static Ttk_ElementSpec ArrowElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(ScrollbarElement),
+    ScrollbarElementOptions,
+    ArrowElementSize,
+    ArrowElementDraw
+};
+
+
+/*------------------------------------------------------------------------
+ * +++ Notebook elements.
+ * 	
+ * Note: Tabs, except for the rightmost, overlap the neighbor to 
+ * their right by one pixel.
+ */
+
+typedef struct {
+    Tcl_Obj *backgroundObj;
+    Tcl_Obj *borderColorObj;
+    Tcl_Obj *lightColorObj;
+    Tcl_Obj *darkColorObj;
+} NotebookElement;
+
+static Ttk_ElementOptionSpec NotebookElementOptions[] = {
+    { "-background", TK_OPTION_BORDER,
+	Tk_Offset(NotebookElement,backgroundObj), FRAME_COLOR },
+    { "-bordercolor", TK_OPTION_COLOR,
+	Tk_Offset(NotebookElement,borderColorObj), DARKEST_COLOR },
+    { "-lightcolor", TK_OPTION_COLOR,
+	Tk_Offset(NotebookElement,lightColorObj), LIGHT_COLOR },
+    { "-darkcolor", TK_OPTION_COLOR,
+	Tk_Offset(NotebookElement,darkColorObj), DARK_COLOR },
+    { NULL, 0, 0, NULL }
+};
+
+static void TabElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    int borderWidth = 2;
+    paddingPtr->top = paddingPtr->left = paddingPtr->right = borderWidth;
+    paddingPtr->bottom = 0;
+}
+
+static void TabElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned int state)
+{
+    NotebookElement *tab = elementRecord;
+    Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, tab->backgroundObj);
+    Display *display = Tk_Display(tkwin);
+    int borderWidth = 2, dh = 0;
+    int x1,y1,x2,y2;
+    GC gc;
+    const int w = WIN32_XDRAWLINE_HACK;
+
+    if (state & TTK_STATE_SELECTED) {
+	dh = borderWidth;
+    }
+
+    if (state & TTK_STATE_USER2) {	/* Rightmost tab */
+	--b.width;
+    }
+
+    Tk_Fill3DRectangle(tkwin, d, border,
+	b.x+2, b.y+2, b.width-1, b.height-2+dh, borderWidth, TK_RELIEF_FLAT);
+
+    x1 = b.x, x2 = b.x + b.width;
+    y1 = b.y, y2 = b.y + b.height;
+
+
+    gc=Ttk_GCForColor(tkwin,tab->borderColorObj,d);
+    XDrawLine(display,d,gc, x1,y1+1, x1,y2+w);
+    XDrawLine(display,d,gc, x2,y1+1, x2,y2+w);
+    XDrawLine(display,d,gc, x1+1,y1, x2-1+w,y1);
+
+    gc=Ttk_GCForColor(tkwin,tab->lightColorObj,d);
+    XDrawLine(display,d,gc, x1+1,y1+1, x1+1,y2-1+dh+w);
+    XDrawLine(display,d,gc, x1+1,y1+1, x2-1+w,y1+1);
+}
+
+static Ttk_ElementSpec TabElementSpec =
+{
+    TK_STYLE_VERSION_2,
+    sizeof(NotebookElement),
+    NotebookElementOptions,
+    TabElementSize,
+    TabElementDraw
+};
+
+static void ClientElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    int borderWidth = 2;
+    *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void ClientElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned int state)
+{
+    NotebookElement *ce = elementRecord;
+    Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, ce->backgroundObj);
+    int borderWidth = 2;
+
+    Tk_Fill3DRectangle(tkwin, d, border,
+	b.x, b.y, b.width, b.height, borderWidth,TK_RELIEF_FLAT);
+    DrawSmoothBorder(tkwin, d, b,
+    	ce->borderColorObj, ce->lightColorObj, ce->darkColorObj);
+}
+
+static Ttk_ElementSpec ClientElementSpec =
+{
+    TK_STYLE_VERSION_2,
+    sizeof(NotebookElement),
+    NotebookElementOptions,
+    ClientElementSize,
+    ClientElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Modified widget layouts.
+ */
+
+TTK_BEGIN_LAYOUT_TABLE(LayoutTable)
+
+TTK_LAYOUT("TCombobox",
+    TTK_NODE("Combobox.downarrow", TTK_PACK_RIGHT|TTK_FILL_Y)
+    TTK_GROUP("Combobox.field", TTK_PACK_LEFT|TTK_FILL_BOTH|TTK_EXPAND,
+	TTK_GROUP("Combobox.padding", TTK_FILL_BOTH,
+	    TTK_NODE("Combobox.textarea", TTK_FILL_BOTH))))
+
+TTK_LAYOUT("Horizontal.Sash",
+    TTK_GROUP("Sash.hsash", TTK_FILL_BOTH,
+	TTK_NODE("Sash.hgrip", TTK_FILL_BOTH)))
+
+TTK_LAYOUT("Vertical.Sash",
+    TTK_GROUP("Sash.vsash", TTK_FILL_BOTH,
+	TTK_NODE("Sash.vgrip", TTK_FILL_BOTH)))
+
+TTK_END_LAYOUT_TABLE
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE int
+TtkClamTheme_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme = Ttk_CreateTheme(interp, "clam", 0);
+
+    if (!theme) {
+        return TCL_ERROR;
+    }
+
+    Ttk_RegisterElement(interp,
+	theme, "border", &BorderElementSpec, NULL);
+    Ttk_RegisterElement(interp,
+	theme, "field", &FieldElementSpec, NULL);
+    Ttk_RegisterElement(interp,
+	theme, "Combobox.field", &ComboboxFieldElementSpec, NULL);
+    Ttk_RegisterElement(interp,
+	theme, "trough", &TroughElementSpec, NULL);
+    Ttk_RegisterElement(interp,
+	theme, "thumb", &ThumbElementSpec, NULL);
+    Ttk_RegisterElement(interp,
+	theme, "uparrow", &ArrowElementSpec, &ArrowElements[0]);
+    Ttk_RegisterElement(interp,
+	theme, "downarrow", &ArrowElementSpec, &ArrowElements[1]);
+    Ttk_RegisterElement(interp,
+	theme, "leftarrow", &ArrowElementSpec, &ArrowElements[2]);
+    Ttk_RegisterElement(interp,
+	theme, "rightarrow", &ArrowElementSpec, &ArrowElements[3]);
+
+    Ttk_RegisterElement(interp,
+	theme, "Radiobutton.indicator", &RadioIndicatorElementSpec, NULL);
+    Ttk_RegisterElement(interp,
+	theme, "Checkbutton.indicator", &CheckIndicatorElementSpec, NULL);
+    Ttk_RegisterElement(interp,
+	theme, "Menubutton.indicator", &MenuIndicatorElementSpec, NULL);
+
+    Ttk_RegisterElement(interp, theme, "tab", &TabElementSpec, NULL);
+    Ttk_RegisterElement(interp, theme, "client", &ClientElementSpec, NULL);
+
+    Ttk_RegisterElement(interp, theme, "slider", &SliderElementSpec, NULL);
+    Ttk_RegisterElement(interp, theme, "bar", &PbarElementSpec, NULL);
+    Ttk_RegisterElement(interp, theme, "pbar", &PbarElementSpec, NULL);
+
+    Ttk_RegisterElement(interp, theme, "hgrip",
+	    &GripElementSpec,  &GripClientData[0]);
+    Ttk_RegisterElement(interp, theme, "vgrip",
+	    &GripElementSpec,  &GripClientData[1]);
+
+    Ttk_RegisterLayouts(theme, LayoutTable);
+
+    Tcl_PkgProvide(interp, "ttk::theme::clam", TTK_VERSION);
+
+    return TCL_OK;
+}

generic/ttk/ttkClassicTheme.c

@@ -0,0 +1,513 @@
+/*
+ * Copyright (c) 2004, Joe English
+ *
+ * "classic" theme; implements the classic Motif-like Tk look.
+ *
+ */
+
+#include <tk.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include "ttkTheme.h"
+
+#define DEFAULT_BORDERWIDTH "2"
+#define DEFAULT_ARROW_SIZE "15"
+
+/*----------------------------------------------------------------------
+ * +++ Highlight element implementation.
+ * 	Draw a solid highlight border to indicate focus.
+ */
+
+typedef struct {
+    Tcl_Obj	*highlightColorObj;
+    Tcl_Obj	*highlightThicknessObj;
+} HighlightElement;
+
+static Ttk_ElementOptionSpec HighlightElementOptions[] = {
+    { "-highlightcolor",TK_OPTION_COLOR,
+	Tk_Offset(HighlightElement,highlightColorObj), DEFAULT_BACKGROUND },
+    { "-highlightthickness",TK_OPTION_PIXELS,
+	Tk_Offset(HighlightElement,highlightThicknessObj), "0" },
+    { NULL, 0, 0, NULL }
+};
+
+static void HighlightElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    HighlightElement *hl = elementRecord;
+    int highlightThickness = 0;
+
+    Tcl_GetIntFromObj(NULL,hl->highlightThicknessObj,&highlightThickness);
+    *paddingPtr = Ttk_UniformPadding((short)highlightThickness);
+}
+
+static void HighlightElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned int state)
+{
+    HighlightElement *hl = elementRecord;
+    int highlightThickness = 0;
+    XColor *highlightColor = Tk_GetColorFromObj(tkwin, hl->highlightColorObj);
+
+    Tcl_GetIntFromObj(NULL,hl->highlightThicknessObj,&highlightThickness);
+    if (highlightColor && highlightThickness > 0) {
+	GC gc = Tk_GCForColor(highlightColor, d);
+	Tk_DrawFocusHighlight(tkwin, gc, highlightThickness, d);
+    }
+}
+
+static Ttk_ElementSpec HighlightElementSpec =
+{
+    TK_STYLE_VERSION_2,
+    sizeof(HighlightElement),
+    HighlightElementOptions,
+    HighlightElementSize,
+    HighlightElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Button Border element:
+ * 
+ * The Motif-style button border on X11 consists of (from outside-in):
+ *
+ * + focus indicator (controlled by -highlightcolor and -highlightthickness),
+ * + default ring (if -default active; blank if -default normal)
+ * + shaded border (controlled by -background, -borderwidth, and -relief)
+ */
+
+typedef struct {
+    Tcl_Obj	*borderObj;
+    Tcl_Obj	*borderWidthObj;
+    Tcl_Obj	*reliefObj;
+    Tcl_Obj	*defaultStateObj;
+} ButtonBorderElement;
+
+static Ttk_ElementOptionSpec ButtonBorderElementOptions[] =
+{
+    { "-background", TK_OPTION_BORDER, 
+	Tk_Offset(ButtonBorderElement,borderObj), DEFAULT_BACKGROUND },
+    { "-borderwidth", TK_OPTION_PIXELS, 
+	Tk_Offset(ButtonBorderElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+    { "-relief", TK_OPTION_RELIEF, 
+	Tk_Offset(ButtonBorderElement,reliefObj), "flat" },
+    { "-default", TK_OPTION_ANY, 
+	Tk_Offset(ButtonBorderElement,defaultStateObj), "disabled" },
+    { NULL, 0, 0, NULL }
+};
+
+static void ButtonBorderElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    ButtonBorderElement *bd = elementRecord;
+    int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+    int borderWidth = 0;
+
+    Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+    Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+
+    if (defaultState != TTK_BUTTON_DEFAULT_DISABLED) {
+	borderWidth += 5;
+    }
+    *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+/*
+ * (@@@ Note: ButtonBorderElement still still still buggy:
+ * padding for default ring is drawn in the wrong color 
+ * when the button is active.)
+ */
+static void ButtonBorderElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned int state)
+{
+    ButtonBorderElement *bd = elementRecord;
+    Tk_3DBorder border = NULL;
+    int borderWidth = 1, relief = TK_RELIEF_FLAT;
+    int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+    int inset = 0;
+
+    /*
+     * Get option values.
+     */
+    border = Tk_Get3DBorderFromObj(tkwin, bd->borderObj);
+    Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+    Tk_GetReliefFromObj(NULL, bd->reliefObj, &relief);
+    Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+
+    /*
+     * Default ring:
+     */
+    switch (defaultState)
+    {
+	case TTK_BUTTON_DEFAULT_DISABLED :
+	    break;
+	case TTK_BUTTON_DEFAULT_NORMAL :
+	    inset += 5;
+	    break;
+	case TTK_BUTTON_DEFAULT_ACTIVE :
+            Tk_Draw3DRectangle(tkwin, d, border,
+		b.x+inset, b.y+inset, b.width - 2*inset, b.height - 2*inset,
+		2, TK_RELIEF_FLAT);
+            inset += 2;
+            Tk_Draw3DRectangle(tkwin, d, border,
+		b.x+inset, b.y+inset, b.width - 2*inset, b.height - 2*inset,
+		1, TK_RELIEF_SUNKEN);
+	    ++inset;
+            Tk_Draw3DRectangle(tkwin, d, border,
+		b.x+inset, b.y+inset, b.width - 2*inset, b.height - 2*inset,
+		2, TK_RELIEF_FLAT);
+	    inset += 2;
+	    break;
+    }
+
+    /*
+     * 3-D border:
+     */
+    if (border && borderWidth > 0) {
+	Tk_Draw3DRectangle(tkwin, d, border,
+	    b.x+inset, b.y+inset, b.width - 2*inset, b.height - 2*inset,
+	    borderWidth,relief);
+    }
+}
+
+static Ttk_ElementSpec ButtonBorderElementSpec =
+{
+    TK_STYLE_VERSION_2,
+    sizeof(ButtonBorderElement),
+    ButtonBorderElementOptions,
+    ButtonBorderElementSize,
+    ButtonBorderElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Arrow element(s).
+ *
+ * Draws a 3-D shaded triangle.
+ * clientData is an enum ArrowDirection pointer.
+ */
+
+static int ArrowElements[] = { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT };
+typedef struct
+{
+    Tcl_Obj *sizeObj;
+    Tcl_Obj *borderObj;
+    Tcl_Obj *borderWidthObj;
+    Tcl_Obj *reliefObj;
+} ArrowElement;
+
+static Ttk_ElementOptionSpec ArrowElementOptions[] =
+{
+    { "-arrowsize", TK_OPTION_PIXELS, Tk_Offset(ArrowElement,sizeObj),
+	DEFAULT_ARROW_SIZE },
+    { "-background", TK_OPTION_BORDER, Tk_Offset(ArrowElement,borderObj),
+    	DEFAULT_BACKGROUND },
+    { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(ArrowElement,borderWidthObj),
+    	DEFAULT_BORDERWIDTH },
+    { "-relief", TK_OPTION_RELIEF, Tk_Offset(ArrowElement,reliefObj),"raised" },
+    { NULL, 0, 0, NULL }
+};
+
+static void ArrowElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    ArrowElement *arrow = elementRecord;
+    int size = 12;
+
+    Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &size);
+    *widthPtr = *heightPtr = size;
+}
+
+static void ArrowElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned int state)
+{
+    int direction = *(int *)clientData;
+    ArrowElement *arrow = elementRecord;
+    Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, arrow->borderObj);
+    int borderWidth = 2;
+    int relief = TK_RELIEF_RAISED;
+    int size = b.width < b.height ? b.width : b.height;
+    XPoint points[3];
+
+    Tk_GetPixelsFromObj(NULL, tkwin, arrow->borderWidthObj, &borderWidth);
+    Tk_GetReliefFromObj(NULL, arrow->reliefObj, &relief);
+
+
+    /*
+     * @@@ There are off-by-one pixel errors in the way these are drawn;
+     * @@@ need to take a look at Tk_Fill3DPolygon and X11 to find the
+     * @@@ exact rules.
+     */
+    switch (direction)
+    {
+	case ARROW_UP:
+	    points[2].x = b.x; 		points[2].y = b.y + size;
+	    points[1].x = b.x + size/2;	points[1].y = b.y;
+	    points[0].x = b.x + size;	points[0].y = b.y + size;
+	    break;
+	case ARROW_DOWN:
+	    points[0].x = b.x; 		points[0].y = b.y;
+	    points[1].x = b.x + size/2;	points[1].y = b.y + size;
+	    points[2].x = b.x + size;	points[2].y = b.y;
+	    break;
+	case ARROW_LEFT:
+	    points[0].x = b.x; 		points[0].y = b.y + size / 2;
+	    points[1].x = b.x + size;	points[1].y = b.y + size;
+	    points[2].x = b.x + size;	points[2].y = b.y;
+	    break;
+	case ARROW_RIGHT:
+	    points[0].x = b.x + size;	points[0].y = b.y + size / 2;
+	    points[1].x = b.x;		points[1].y = b.y;
+	    points[2].x = b.x;		points[2].y = b.y + size;
+	    break;
+    }
+
+    Tk_Fill3DPolygon(tkwin, d, border, points, 3, borderWidth, relief);
+}
+
+static Ttk_ElementSpec ArrowElementSpec =
+{
+    TK_STYLE_VERSION_2,
+    sizeof(ArrowElement),
+    ArrowElementOptions,
+    ArrowElementSize,
+    ArrowElementDraw
+};
+
+
+/*------------------------------------------------------------------------
+ * +++ Sash element (for ttk::panedwindow)
+ *
+ * NOTES: 
+ *
+ * panedwindows with -orient horizontal use vertical sashes, and vice versa.
+ *
+ * Interpretation of -sashrelief 'groove' and 'ridge' are
+ * swapped wrt. the core panedwindow, which (I think) has them backwards.
+ *
+ * Default -sashrelief is sunken; the core panedwindow has default 
+ * -sashrelief raised, but that looks wrong to me.
+ */
+
+static Ttk_Orient SashClientData[] = {
+    TTK_ORIENT_HORIZONTAL, TTK_ORIENT_VERTICAL 
+};
+
+typedef struct {
+    Tcl_Obj *borderObj; 	/* background color */
+    Tcl_Obj *sashReliefObj;	/* sash relief */
+    Tcl_Obj *sashThicknessObj;	/* overall thickness of sash */
+    Tcl_Obj *sashPadObj;	/* padding on either side of handle */
+    Tcl_Obj *handleSizeObj;	/* handle width and height */
+    Tcl_Obj *handlePadObj;	/* handle's distance from edge */
+} SashElement;
+
+static Ttk_ElementOptionSpec SashOptions[] = {
+    { "-background", TK_OPTION_BORDER, 
+	Tk_Offset(SashElement,borderObj), DEFAULT_BACKGROUND },
+    { "-sashrelief", TK_OPTION_RELIEF, 
+	Tk_Offset(SashElement,sashReliefObj), "sunken" },
+    { "-sashthickness", TK_OPTION_PIXELS,
+	Tk_Offset(SashElement,sashThicknessObj), "6" },
+    { "-sashpad", TK_OPTION_PIXELS, 
+	Tk_Offset(SashElement,sashPadObj), "2" },
+    { "-handlesize", TK_OPTION_PIXELS,
+	Tk_Offset(SashElement,handleSizeObj), "8" },
+    { "-handlepad", TK_OPTION_PIXELS,
+	Tk_Offset(SashElement,handlePadObj), "8" },
+    { NULL, 0, 0, NULL }
+};
+
+static void SashElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    SashElement *sash = elementRecord;
+    int sashPad = 2, sashThickness = 6, handleSize = 8;
+    int horizontal = *((Ttk_Orient*)clientData) == TTK_ORIENT_HORIZONTAL;
+
+    Tk_GetPixelsFromObj(NULL, tkwin, sash->sashThicknessObj, &sashThickness);
+    Tk_GetPixelsFromObj(NULL, tkwin, sash->handleSizeObj, &handleSize);
+    Tk_GetPixelsFromObj(NULL, tkwin, sash->sashPadObj, &sashPad);
+
+    if (sashThickness < handleSize + 2*sashPad)
+	sashThickness = handleSize + 2*sashPad;
+
+    if (horizontal)
+	*heightPtr = sashThickness;
+    else
+	*widthPtr = sashThickness;
+}
+
+static void SashElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, Ttk_State state)
+{
+    SashElement *sash = elementRecord;
+    Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, sash->borderObj);
+    GC gc1,gc2;
+    int relief = TK_RELIEF_RAISED;
+    int handleSize = 8, handlePad = 8;
+    int horizontal = *((Ttk_Orient*)clientData) == TTK_ORIENT_HORIZONTAL;
+    Ttk_Box hb;
+
+    Tk_GetPixelsFromObj(NULL, tkwin, sash->handleSizeObj, &handleSize);
+    Tk_GetPixelsFromObj(NULL, tkwin, sash->handlePadObj, &handlePad);
+    Tk_GetReliefFromObj(NULL, sash->sashReliefObj, &relief);
+
+    switch (relief) {
+	case TK_RELIEF_RAISED: case TK_RELIEF_RIDGE:
+	    gc1 = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+	    gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+	    break;
+	case TK_RELIEF_SUNKEN: case TK_RELIEF_GROOVE:
+	    gc1 = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+	    gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+	    break;
+	case TK_RELIEF_SOLID: 
+	    gc1 = gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+	    break;
+	case TK_RELIEF_FLAT: 
+	default:
+	    gc1 = gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_FLAT_GC);
+	    break;
+    }
+
+    /* Draw sash line:
+     */
+    if (horizontal) {
+	int y = b.y + b.height/2 - 1;
+	XDrawLine(Tk_Display(tkwin), d, gc1, b.x, y, b.x+b.width, y); ++y;
+	XDrawLine(Tk_Display(tkwin), d, gc2, b.x, y, b.x+b.width, y);
+    } else {
+	int x = b.x + b.width/2 - 1;
+	XDrawLine(Tk_Display(tkwin), d, gc1, x, b.y, x, b.y+b.height); ++x;
+	XDrawLine(Tk_Display(tkwin), d, gc2, x, b.y, x, b.y+b.height);
+    }
+
+    /* Draw handle:
+     */
+    if (handleSize >= 0) {
+	if (horizontal) {
+	    hb = Ttk_StickBox(b, handleSize, handleSize, TTK_STICK_W);
+	    hb.x += handlePad;
+	} else {
+	    hb = Ttk_StickBox(b, handleSize, handleSize, TTK_STICK_N);
+	    hb.y += handlePad;
+	}
+	Tk_Fill3DRectangle(tkwin, d, border, 
+	    hb.x, hb.y, hb.width, hb.height, 1, TK_RELIEF_RAISED);
+    }
+}
+
+static Ttk_ElementSpec SashElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(SashElement),
+    SashOptions,
+    SashElementSize,
+    SashElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget layouts.
+ */
+
+TTK_BEGIN_LAYOUT_TABLE(LayoutTable)
+
+TTK_LAYOUT("TButton",
+    TTK_GROUP("Button.highlight", TTK_FILL_BOTH,
+        TTK_GROUP("Button.border", TTK_FILL_BOTH|TTK_BORDER,
+	    TTK_GROUP("Button.padding", TTK_FILL_BOTH,
+	        TTK_NODE("Button.label", TTK_FILL_BOTH)))))
+
+TTK_LAYOUT("TCheckbutton",
+    TTK_GROUP("Checkbutton.highlight", TTK_FILL_BOTH,
+        TTK_GROUP("Checkbutton.border", TTK_FILL_BOTH,
+	    TTK_GROUP("Checkbutton.padding", TTK_FILL_BOTH,
+	        TTK_NODE("Checkbutton.indicator", TTK_PACK_LEFT)
+	        TTK_NODE("Checkbutton.label", TTK_PACK_LEFT|TTK_FILL_BOTH)))))
+
+TTK_LAYOUT("TRadiobutton",
+    TTK_GROUP("Radiobutton.highlight", TTK_FILL_BOTH,
+        TTK_GROUP("Radiobutton.border", TTK_FILL_BOTH,
+	    TTK_GROUP("Radiobutton.padding", TTK_FILL_BOTH,
+	        TTK_NODE("Radiobutton.indicator", TTK_PACK_LEFT)
+	        TTK_NODE("Radiobutton.label", TTK_PACK_LEFT|TTK_FILL_BOTH)))))
+
+TTK_LAYOUT("TMenubutton",
+    TTK_GROUP("Menubutton.highlight", TTK_FILL_BOTH,
+        TTK_GROUP("Menubutton.border", TTK_FILL_BOTH,
+	    TTK_NODE("Menubutton.indicator", TTK_PACK_RIGHT)
+	    TTK_GROUP("Menubutton.padding", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_X,
+	        TTK_NODE("Menubutton.label", 0)))))
+
+/* "classic" entry, includes highlight border */
+TTK_LAYOUT("TEntry",
+    TTK_GROUP("Entry.highlight", TTK_FILL_BOTH,
+        TTK_GROUP("Entry.field", TTK_FILL_BOTH|TTK_BORDER,
+	    TTK_GROUP("Entry.padding", TTK_FILL_BOTH,
+	        TTK_NODE("Entry.textarea", TTK_FILL_BOTH)))))
+
+/* Notebook tabs -- omit focus ring */
+TTK_LAYOUT("Tab",
+    TTK_GROUP("Notebook.tab", TTK_FILL_BOTH,
+	TTK_GROUP("Notebook.padding", TTK_FILL_BOTH,
+	    TTK_NODE("Notebook.label", TTK_FILL_BOTH))))
+
+TTK_END_LAYOUT_TABLE
+
+/* POSSIBLY: include Scale layouts w/focus border
+ */
+
+/*------------------------------------------------------------------------
+ * TtkClassicTheme_Init --
+ * 	Install classic theme.
+ */
+
+MODULE_SCOPE int TtkClassicTheme_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme =  Ttk_CreateTheme(interp, "classic", NULL);
+
+    if (!theme) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Register elements:
+     */
+    Ttk_RegisterElement(interp, theme, "highlight",
+	    &HighlightElementSpec, NULL);
+
+    Ttk_RegisterElement(interp, theme, "Button.border",
+	    &ButtonBorderElementSpec, NULL);
+
+    Ttk_RegisterElement(interp, theme, "uparrow",
+	    &ArrowElementSpec, &ArrowElements[0]);
+    Ttk_RegisterElement(interp, theme, "downarrow",
+	    &ArrowElementSpec, &ArrowElements[1]);
+    Ttk_RegisterElement(interp, theme, "leftarrow",
+	    &ArrowElementSpec, &ArrowElements[2]);
+    Ttk_RegisterElement(interp, theme, "rightarrow",
+	    &ArrowElementSpec, &ArrowElements[3]);
+    Ttk_RegisterElement(interp, theme, "arrow",
+	    &ArrowElementSpec, &ArrowElements[0]);
+
+    Ttk_RegisterElement(interp, theme, "hsash", 
+	    &SashElementSpec, &SashClientData[0]);
+    Ttk_RegisterElement(interp, theme, "vsash",
+	    &SashElementSpec, &SashClientData[1]);
+
+    /*
+     * Register layouts:
+     */
+    Ttk_RegisterLayouts(theme, LayoutTable);
+
+    Tcl_PkgProvide(interp, "ttk::theme::classic", TTK_VERSION);
+
+    return TCL_OK;
+}
+
+/*EOF*/

generic/ttk/ttkDecls.h

@@ -0,0 +1,274 @@
+/*
+ * This file is (mostly) automatically generated from ttk.decls.
+ */
+
+#ifndef _TTKDECLS
+#define _TTKDECLS
+
+#if defined(USE_TTK_STUBS)
+
+extern const char *TtkInitializeStubs(
+	Tcl_Interp *, const char *version, int epoch, int revision);
+#define Ttk_InitStubs(interp) TtkInitializeStubs( \
+	interp, TTK_VERSION, TTK_STUBS_EPOCH, TTK_STUBS_REVISION)
+#else
+
+#define Ttk_InitStubs(interp) Tcl_PkgRequireEx(interp, "Ttk", TTK_VERSION, 0, NULL)
+
+#endif
+
+
+/* !BEGIN!: Do not edit below this line. */
+
+#define TTK_STUBS_EPOCH 0
+#define TTK_STUBS_REVISION 31
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* 0 */
+TTKAPI Ttk_Theme	Ttk_GetTheme(Tcl_Interp *interp, const char *name);
+/* 1 */
+TTKAPI Ttk_Theme	Ttk_GetDefaultTheme(Tcl_Interp *interp);
+/* 2 */
+TTKAPI Ttk_Theme	Ttk_GetCurrentTheme(Tcl_Interp *interp);
+/* 3 */
+TTKAPI Ttk_Theme	Ttk_CreateTheme(Tcl_Interp *interp, const char *name,
+				Ttk_Theme parent);
+/* 4 */
+TTKAPI void		Ttk_RegisterCleanup(Tcl_Interp *interp,
+				void *deleteData,
+				Ttk_CleanupProc *cleanupProc);
+/* 5 */
+TTKAPI int		Ttk_RegisterElementSpec(Ttk_Theme theme,
+				const char *elementName,
+				Ttk_ElementSpec *elementSpec,
+				void *clientData);
+/* 6 */
+TTKAPI Ttk_ElementClass * Ttk_RegisterElement(Tcl_Interp *interp,
+				Ttk_Theme theme, const char *elementName,
+				Ttk_ElementSpec *elementSpec,
+				void *clientData);
+/* 7 */
+TTKAPI int		Ttk_RegisterElementFactory(Tcl_Interp *interp,
+				const char *name,
+				Ttk_ElementFactory factoryProc,
+				void *clientData);
+/* 8 */
+TTKAPI void		Ttk_RegisterLayout(Ttk_Theme theme,
+				const char *className,
+				Ttk_LayoutSpec layoutSpec);
+/* Slot 9 is reserved */
+/* 10 */
+TTKAPI int		Ttk_GetStateSpecFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn);
+/* 11 */
+TTKAPI Tcl_Obj *	Ttk_NewStateSpecObj(unsigned int onbits,
+				unsigned int offbits);
+/* 12 */
+TTKAPI Ttk_StateMap	Ttk_GetStateMapFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr);
+/* 13 */
+TTKAPI Tcl_Obj *	Ttk_StateMapLookup(Tcl_Interp *interp,
+				Ttk_StateMap map, Ttk_State state);
+/* 14 */
+TTKAPI int		Ttk_StateTableLookup(Ttk_StateTable map[],
+				Ttk_State state);
+/* Slot 15 is reserved */
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
+/* Slot 18 is reserved */
+/* Slot 19 is reserved */
+/* 20 */
+TTKAPI int		Ttk_GetPaddingFromObj(Tcl_Interp *interp,
+				Tk_Window tkwin, Tcl_Obj *objPtr,
+				Ttk_Padding *pad_rtn);
+/* 21 */
+TTKAPI int		Ttk_GetBorderFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, Ttk_Padding *pad_rtn);
+/* 22 */
+TTKAPI int		Ttk_GetStickyFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn);
+/* 23 */
+TTKAPI Ttk_Padding	Ttk_MakePadding(short l, short t, short r, short b);
+/* 24 */
+TTKAPI Ttk_Padding	Ttk_UniformPadding(short borderWidth);
+/* 25 */
+TTKAPI Ttk_Padding	Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2);
+/* 26 */
+TTKAPI Ttk_Padding	Ttk_RelievePadding(Ttk_Padding padding, int relief,
+				int n);
+/* 27 */
+TTKAPI Ttk_Box		Ttk_MakeBox(int x, int y, int width, int height);
+/* 28 */
+TTKAPI int		Ttk_BoxContains(Ttk_Box box, int x, int y);
+/* 29 */
+TTKAPI Ttk_Box		Ttk_PackBox(Ttk_Box *cavity, int w, int h,
+				Ttk_Side side);
+/* 30 */
+TTKAPI Ttk_Box		Ttk_StickBox(Ttk_Box parcel, int w, int h,
+				Ttk_Sticky sticky);
+/* 31 */
+TTKAPI Ttk_Box		Ttk_AnchorBox(Ttk_Box parcel, int w, int h,
+				Tk_Anchor anchor);
+/* 32 */
+TTKAPI Ttk_Box		Ttk_PadBox(Ttk_Box b, Ttk_Padding p);
+/* 33 */
+TTKAPI Ttk_Box		Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p);
+/* 34 */
+TTKAPI Ttk_Box		Ttk_PlaceBox(Ttk_Box *cavity, int w, int h,
+				Ttk_Side side, Ttk_Sticky sticky);
+/* 35 */
+TTKAPI Tcl_Obj *	Ttk_NewBoxObj(Ttk_Box box);
+/* Slot 36 is reserved */
+/* Slot 37 is reserved */
+/* Slot 38 is reserved */
+/* Slot 39 is reserved */
+/* 40 */
+TTKAPI int		Ttk_GetOrientFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int *orient);
+
+typedef struct TtkStubs {
+    int magic;
+    int epoch;
+    int revision;
+    void *hooks;
+
+    Ttk_Theme (*ttk_GetTheme) (Tcl_Interp *interp, const char *name); /* 0 */
+    Ttk_Theme (*ttk_GetDefaultTheme) (Tcl_Interp *interp); /* 1 */
+    Ttk_Theme (*ttk_GetCurrentTheme) (Tcl_Interp *interp); /* 2 */
+    Ttk_Theme (*ttk_CreateTheme) (Tcl_Interp *interp, const char *name, Ttk_Theme parent); /* 3 */
+    void (*ttk_RegisterCleanup) (Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc); /* 4 */
+    int (*ttk_RegisterElementSpec) (Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, void *clientData); /* 5 */
+    Ttk_ElementClass * (*ttk_RegisterElement) (Tcl_Interp *interp, Ttk_Theme theme, const char *elementName, Ttk_ElementSpec *elementSpec, void *clientData); /* 6 */
+    int (*ttk_RegisterElementFactory) (Tcl_Interp *interp, const char *name, Ttk_ElementFactory factoryProc, void *clientData); /* 7 */
+    void (*ttk_RegisterLayout) (Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec); /* 8 */
+    void (*reserved9)(void);
+    int (*ttk_GetStateSpecFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn); /* 10 */
+    Tcl_Obj * (*ttk_NewStateSpecObj) (unsigned int onbits, unsigned int offbits); /* 11 */
+    Ttk_StateMap (*ttk_GetStateMapFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 12 */
+    Tcl_Obj * (*ttk_StateMapLookup) (Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state); /* 13 */
+    int (*ttk_StateTableLookup) (Ttk_StateTable map[], Ttk_State state); /* 14 */
+    void (*reserved15)(void);
+    void (*reserved16)(void);
+    void (*reserved17)(void);
+    void (*reserved18)(void);
+    void (*reserved19)(void);
+    int (*ttk_GetPaddingFromObj) (Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr, Ttk_Padding *pad_rtn); /* 20 */
+    int (*ttk_GetBorderFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Padding *pad_rtn); /* 21 */
+    int (*ttk_GetStickyFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn); /* 22 */
+    Ttk_Padding (*ttk_MakePadding) (short l, short t, short r, short b); /* 23 */
+    Ttk_Padding (*ttk_UniformPadding) (short borderWidth); /* 24 */
+    Ttk_Padding (*ttk_AddPadding) (Ttk_Padding pad1, Ttk_Padding pad2); /* 25 */
+    Ttk_Padding (*ttk_RelievePadding) (Ttk_Padding padding, int relief, int n); /* 26 */
+    Ttk_Box (*ttk_MakeBox) (int x, int y, int width, int height); /* 27 */
+    int (*ttk_BoxContains) (Ttk_Box box, int x, int y); /* 28 */
+    Ttk_Box (*ttk_PackBox) (Ttk_Box *cavity, int w, int h, Ttk_Side side); /* 29 */
+    Ttk_Box (*ttk_StickBox) (Ttk_Box parcel, int w, int h, Ttk_Sticky sticky); /* 30 */
+    Ttk_Box (*ttk_AnchorBox) (Ttk_Box parcel, int w, int h, Tk_Anchor anchor); /* 31 */
+    Ttk_Box (*ttk_PadBox) (Ttk_Box b, Ttk_Padding p); /* 32 */
+    Ttk_Box (*ttk_ExpandBox) (Ttk_Box b, Ttk_Padding p); /* 33 */
+    Ttk_Box (*ttk_PlaceBox) (Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky); /* 34 */
+    Tcl_Obj * (*ttk_NewBoxObj) (Ttk_Box box); /* 35 */
+    void (*reserved36)(void);
+    void (*reserved37)(void);
+    void (*reserved38)(void);
+    void (*reserved39)(void);
+    int (*ttk_GetOrientFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient); /* 40 */
+} TtkStubs;
+
+extern const TtkStubs *ttkStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TTK_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#define Ttk_GetTheme \
+	(ttkStubsPtr->ttk_GetTheme) /* 0 */
+#define Ttk_GetDefaultTheme \
+	(ttkStubsPtr->ttk_GetDefaultTheme) /* 1 */
+#define Ttk_GetCurrentTheme \
+	(ttkStubsPtr->ttk_GetCurrentTheme) /* 2 */
+#define Ttk_CreateTheme \
+	(ttkStubsPtr->ttk_CreateTheme) /* 3 */
+#define Ttk_RegisterCleanup \
+	(ttkStubsPtr->ttk_RegisterCleanup) /* 4 */
+#define Ttk_RegisterElementSpec \
+	(ttkStubsPtr->ttk_RegisterElementSpec) /* 5 */
+#define Ttk_RegisterElement \
+	(ttkStubsPtr->ttk_RegisterElement) /* 6 */
+#define Ttk_RegisterElementFactory \
+	(ttkStubsPtr->ttk_RegisterElementFactory) /* 7 */
+#define Ttk_RegisterLayout \
+	(ttkStubsPtr->ttk_RegisterLayout) /* 8 */
+/* Slot 9 is reserved */
+#define Ttk_GetStateSpecFromObj \
+	(ttkStubsPtr->ttk_GetStateSpecFromObj) /* 10 */
+#define Ttk_NewStateSpecObj \
+	(ttkStubsPtr->ttk_NewStateSpecObj) /* 11 */
+#define Ttk_GetStateMapFromObj \
+	(ttkStubsPtr->ttk_GetStateMapFromObj) /* 12 */
+#define Ttk_StateMapLookup \
+	(ttkStubsPtr->ttk_StateMapLookup) /* 13 */
+#define Ttk_StateTableLookup \
+	(ttkStubsPtr->ttk_StateTableLookup) /* 14 */
+/* Slot 15 is reserved */
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
+/* Slot 18 is reserved */
+/* Slot 19 is reserved */
+#define Ttk_GetPaddingFromObj \
+	(ttkStubsPtr->ttk_GetPaddingFromObj) /* 20 */
+#define Ttk_GetBorderFromObj \
+	(ttkStubsPtr->ttk_GetBorderFromObj) /* 21 */
+#define Ttk_GetStickyFromObj \
+	(ttkStubsPtr->ttk_GetStickyFromObj) /* 22 */
+#define Ttk_MakePadding \
+	(ttkStubsPtr->ttk_MakePadding) /* 23 */
+#define Ttk_UniformPadding \
+	(ttkStubsPtr->ttk_UniformPadding) /* 24 */
+#define Ttk_AddPadding \
+	(ttkStubsPtr->ttk_AddPadding) /* 25 */
+#define Ttk_RelievePadding \
+	(ttkStubsPtr->ttk_RelievePadding) /* 26 */
+#define Ttk_MakeBox \
+	(ttkStubsPtr->ttk_MakeBox) /* 27 */
+#define Ttk_BoxContains \
+	(ttkStubsPtr->ttk_BoxContains) /* 28 */
+#define Ttk_PackBox \
+	(ttkStubsPtr->ttk_PackBox) /* 29 */
+#define Ttk_StickBox \
+	(ttkStubsPtr->ttk_StickBox) /* 30 */
+#define Ttk_AnchorBox \
+	(ttkStubsPtr->ttk_AnchorBox) /* 31 */
+#define Ttk_PadBox \
+	(ttkStubsPtr->ttk_PadBox) /* 32 */
+#define Ttk_ExpandBox \
+	(ttkStubsPtr->ttk_ExpandBox) /* 33 */
+#define Ttk_PlaceBox \
+	(ttkStubsPtr->ttk_PlaceBox) /* 34 */
+#define Ttk_NewBoxObj \
+	(ttkStubsPtr->ttk_NewBoxObj) /* 35 */
+/* Slot 36 is reserved */
+/* Slot 37 is reserved */
+/* Slot 38 is reserved */
+/* Slot 39 is reserved */
+#define Ttk_GetOrientFromObj \
+	(ttkStubsPtr->ttk_GetOrientFromObj) /* 40 */
+
+#endif /* defined(USE_TTK_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+#endif /* _TTKDECLS */

generic/ttk/ttkFrame.c

@@ -0,0 +1,653 @@
+/*
+ * Copyright (c) 2004, Joe English
+ *
+ * ttk::frame and ttk::labelframe widgets.
+ */
+
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+#include "ttkManager.h"
+
+/* ======================================================================
+ * +++ Frame widget:
+ */
+
+typedef struct {
+    Tcl_Obj	*borderWidthObj;
+    Tcl_Obj	*paddingObj;
+    Tcl_Obj	*reliefObj;
+    Tcl_Obj 	*widthObj;
+    Tcl_Obj 	*heightObj;
+} FramePart;
+
+typedef struct {
+    WidgetCore	core;
+    FramePart	frame;
+} Frame;
+
+static Tk_OptionSpec FrameOptionSpecs[] = {
+    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", NULL,
+	Tk_Offset(Frame,frame.borderWidthObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+    {TK_OPTION_STRING, "-padding", "padding", "Pad", NULL,
+	Tk_Offset(Frame,frame.paddingObj), -1,
+	TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+    {TK_OPTION_RELIEF, "-relief", "relief", "Relief", NULL,
+	Tk_Offset(Frame,frame.reliefObj), -1,
+	TK_OPTION_NULL_OK,0,0 },
+    {TK_OPTION_PIXELS, "-width", "width", "Width", "0",
+	Tk_Offset(Frame,frame.widthObj), -1,
+	0,0,GEOMETRY_CHANGED },
+    {TK_OPTION_PIXELS, "-height", "height", "Height", "0",
+	Tk_Offset(Frame,frame.heightObj), -1,
+	0,0,GEOMETRY_CHANGED },
+
+    WIDGET_TAKEFOCUS_FALSE,
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+static const Ttk_Ensemble FrameCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",   	TtkWidgetCgetCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    { 0,0,0 }
+};
+
+/*
+ * FrameMargins --
+ * 	Compute internal margins for a frame widget.
+ * 	This includes the -borderWidth, plus any additional -padding.
+ */
+static Ttk_Padding FrameMargins(Frame *framePtr)
+{
+    Ttk_Padding margins = Ttk_UniformPadding(0);
+
+    /* Check -padding:
+     */
+    if (framePtr->frame.paddingObj) {
+	Ttk_GetPaddingFromObj(NULL,
+	    framePtr->core.tkwin, framePtr->frame.paddingObj, &margins);
+    }
+
+    /* Add padding for border:
+     */
+    if (framePtr->frame.borderWidthObj) {
+	int border = 0;
+	Tk_GetPixelsFromObj(NULL,
+	    framePtr->core.tkwin, framePtr->frame.borderWidthObj, &border);
+	margins = Ttk_AddPadding(margins, Ttk_UniformPadding((short)border));
+    }
+
+    return margins;
+}
+
+/* FrameSize procedure --
+ * 	The frame doesn't request a size of its own by default,
+ * 	but it does have an internal border.  See also <<NOTE-SIZE>>
+ */
+static int FrameSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+    Frame *framePtr = recordPtr;
+    Ttk_SetMargins(framePtr->core.tkwin, FrameMargins(framePtr));
+    return 0;
+}
+
+/*
+ * FrameConfigure -- configure hook.
+ *	<<NOTE-SIZE>> Usually the size of a frame is controlled by
+ *	a geometry manager (pack, grid); the -width and -height
+ *	options are only effective if geometry propagation is turned
+ *	off or if the [place] GM is used for child widgets.
+ *
+ *	To avoid geometry blinking, we issue a geometry request
+ *	in the Configure hook instead of the Size hook, and only
+ *	if -width and/or -height is nonzero and one of them
+ *	or the other size-related options (-borderwidth, -padding)
+ *	has been changed.
+ */
+
+static int FrameConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Frame *framePtr = recordPtr;
+    int width, height;
+
+    /*
+     * Make sure -padding resource, if present, is correct:
+     */
+    if (framePtr->frame.paddingObj) {
+	Ttk_Padding unused;
+	if (Ttk_GetPaddingFromObj(interp,
+		    	framePtr->core.tkwin,
+			framePtr->frame.paddingObj,
+			&unused) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+
+    /* See <<NOTE-SIZE>>
+     */
+    if (  TCL_OK != Tk_GetPixelsFromObj(
+	    interp,framePtr->core.tkwin,framePtr->frame.widthObj,&width)
+       || TCL_OK != Tk_GetPixelsFromObj(
+	    interp,framePtr->core.tkwin,framePtr->frame.heightObj,&height)
+       )
+    {
+	return TCL_ERROR;
+    }
+
+    if ((width > 0 || height > 0) && (mask & GEOMETRY_CHANGED)) {
+	Tk_GeometryRequest(framePtr->core.tkwin, width, height);
+    }
+
+    return TtkCoreConfigure(interp, recordPtr, mask);
+}
+
+static WidgetSpec FrameWidgetSpec = {
+    "TFrame",			/* className */
+    sizeof(Frame),		/* recordSize */
+    FrameOptionSpecs,		/* optionSpecs */
+    FrameCommands,		/* subcommands */
+    TtkNullInitialize,		/* initializeProc */
+    TtkNullCleanup,		/* cleanupProc */
+    FrameConfigure,		/* configureProc */
+    TtkNullPostConfigure,	/* postConfigureProc */
+    TtkWidgetGetLayout, 	/* getLayoutProc */
+    FrameSize,			/* sizeProc */
+    TtkWidgetDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(FrameLayout)
+    TTK_NODE("Frame.border", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+/* ======================================================================
+ * +++ Labelframe widget:
+ */
+
+#define DEFAULT_LABELINSET	8
+#define DEFAULT_BORDERWIDTH	2
+
+int TtkGetLabelAnchorFromObj(
+    Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_PositionSpec *anchorPtr)
+{
+    const char *string = Tcl_GetString(objPtr);
+    char c = *string++;
+    Ttk_PositionSpec flags = 0;
+
+    /* First character determines side:
+     */
+    switch (c) {
+	case 'w' : flags = TTK_PACK_LEFT; 	break;
+	case 'e' : flags = TTK_PACK_RIGHT; 	break;
+	case 'n' : flags = TTK_PACK_TOP; 	break;
+	case 's' : flags = TTK_PACK_BOTTOM; 	break;
+	default  : goto error;
+    }
+
+    /* Remaining characters are as per -sticky:
+     */
+    while ((c = *string++) != '\0') {
+	switch (c) {
+	    case 'w' : flags |= TTK_STICK_W; break;
+	    case 'e' : flags |= TTK_STICK_E; break;
+	    case 'n' : flags |= TTK_STICK_N; break;
+	    case 's' : flags |= TTK_STICK_S; break;
+	    default  : goto error;
+	}
+    }
+
+    *anchorPtr = flags;
+    return TCL_OK;
+
+error:
+    if (interp) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"Bad label anchor specification %s", Tcl_GetString(objPtr)));
+	Tcl_SetErrorCode(interp, "TTK", "LABEL", "ANCHOR", NULL);
+    }
+    return TCL_ERROR;
+}
+
+/* LabelAnchorSide --
+ * 	Returns the side corresponding to a LabelAnchor value.
+ */
+static Ttk_Side LabelAnchorSide(Ttk_PositionSpec flags)
+{
+    if (flags & TTK_PACK_LEFT) 		return TTK_SIDE_LEFT;
+    else if (flags & TTK_PACK_RIGHT)	return TTK_SIDE_RIGHT;
+    else if (flags & TTK_PACK_TOP)	return TTK_SIDE_TOP;
+    else if (flags & TTK_PACK_BOTTOM)	return TTK_SIDE_BOTTOM;
+    /*NOTREACHED*/
+    return TTK_SIDE_TOP;
+}
+
+/*
+ * Labelframe widget record:
+ */
+typedef struct {
+    Tcl_Obj 	*labelAnchorObj;
+    Tcl_Obj	*textObj;
+    Tcl_Obj 	*underlineObj;
+    Tk_Window	labelWidget;
+
+    Ttk_Manager	*mgr;
+    Ttk_Layout	labelLayout;	/* Sublayout for label */
+    Ttk_Box	labelParcel;	/* Set in layoutProc */
+} LabelframePart;
+
+typedef struct {
+    WidgetCore  	core;
+    FramePart   	frame;
+    LabelframePart	label;
+} Labelframe;
+
+#define LABELWIDGET_CHANGED 0x100
+
+static Tk_OptionSpec LabelframeOptionSpecs[] = {
+    {TK_OPTION_STRING, "-labelanchor", "labelAnchor", "LabelAnchor",
+	"nw", Tk_Offset(Labelframe, label.labelAnchorObj),-1,
+        0,0,GEOMETRY_CHANGED},
+    {TK_OPTION_STRING, "-text", "text", "Text", "",
+	Tk_Offset(Labelframe,label.textObj), -1,
+	0,0,GEOMETRY_CHANGED },
+    {TK_OPTION_INT, "-underline", "underline", "Underline",
+	"-1", Tk_Offset(Labelframe,label.underlineObj), -1,
+	0,0,0 },
+    {TK_OPTION_WINDOW, "-labelwidget", "labelWidget", "LabelWidget", NULL,
+	-1, Tk_Offset(Labelframe,label.labelWidget),
+	TK_OPTION_NULL_OK,0,LABELWIDGET_CHANGED|GEOMETRY_CHANGED },
+
+    WIDGET_INHERIT_OPTIONS(FrameOptionSpecs)
+};
+
+/*
+ * Labelframe style parameters:
+ */
+typedef struct {
+    int 		borderWidth;	/* border width */
+    Ttk_Padding 	padding;	/* internal padding */
+    Ttk_PositionSpec	labelAnchor;	/* corner/side to place label */
+    Ttk_Padding		labelMargins;	/* extra space around label */
+    int 		labelOutside;	/* true=>place label outside border */
+} LabelframeStyle;
+
+static void LabelframeStyleOptions(Labelframe *lf, LabelframeStyle *style)
+{
+    Ttk_Layout layout = lf->core.layout;
+    Tcl_Obj *objPtr;
+
+    style->borderWidth = DEFAULT_BORDERWIDTH;
+    style->padding = Ttk_UniformPadding(0);
+    style->labelAnchor = TTK_PACK_TOP | TTK_STICK_W;
+    style->labelOutside = 0;
+
+    if ((objPtr = Ttk_QueryOption(layout, "-borderwidth", 0)) != NULL) {
+	Tk_GetPixelsFromObj(NULL, lf->core.tkwin, objPtr, &style->borderWidth);
+    }
+    if ((objPtr = Ttk_QueryOption(layout, "-padding", 0)) != NULL) {
+	Ttk_GetPaddingFromObj(NULL, lf->core.tkwin, objPtr, &style->padding);
+    }
+    if ((objPtr = Ttk_QueryOption(layout,"-labelanchor", 0)) != NULL) {
+	TtkGetLabelAnchorFromObj(NULL, objPtr, &style->labelAnchor);
+    }
+    if ((objPtr = Ttk_QueryOption(layout,"-labelmargins", 0)) != NULL) {
+	Ttk_GetBorderFromObj(NULL, objPtr, &style->labelMargins);
+    } else {
+	if (style->labelAnchor & (TTK_PACK_TOP|TTK_PACK_BOTTOM)) {
+	    style->labelMargins =
+		Ttk_MakePadding(DEFAULT_LABELINSET,0,DEFAULT_LABELINSET,0);
+	} else {
+	    style->labelMargins =
+		Ttk_MakePadding(0,DEFAULT_LABELINSET,0,DEFAULT_LABELINSET);
+	}
+    }
+    if ((objPtr = Ttk_QueryOption(layout,"-labeloutside", 0)) != NULL) {
+	Tcl_GetBooleanFromObj(NULL, objPtr, &style->labelOutside);
+    }
+
+    return;
+}
+
+/* LabelframeLabelSize --
+ * 	Extract the requested width and height of the labelframe's label:
+ * 	taken from the label widget if specified, otherwise the text label.
+ */
+static void
+LabelframeLabelSize(Labelframe *lframePtr, int *widthPtr, int *heightPtr)
+{
+    Tk_Window labelWidget = lframePtr->label.labelWidget;
+    Ttk_Layout labelLayout = lframePtr->label.labelLayout;
+
+    if (labelWidget) {
+	*widthPtr = Tk_ReqWidth(labelWidget);
+	*heightPtr = Tk_ReqHeight(labelWidget);
+    } else if (labelLayout) {
+	Ttk_LayoutSize(labelLayout, 0, widthPtr, heightPtr);
+    } else {
+	*widthPtr = *heightPtr = 0;
+    }
+}
+
+/*
+ * LabelframeSize --
+ * 	Like the frame, this doesn't request a size of its own
+ * 	but it does have internal padding and a minimum size.
+ */
+static int LabelframeSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+    Labelframe *lframePtr = recordPtr;
+    WidgetCore *corePtr = &lframePtr->core;
+    Ttk_Padding margins;
+    LabelframeStyle style;
+    int labelWidth, labelHeight;
+
+    LabelframeStyleOptions(lframePtr, &style);
+
+    /* Compute base margins (See also: FrameMargins)
+     */
+    margins = Ttk_AddPadding(
+		style.padding, Ttk_UniformPadding((short)style.borderWidth));
+
+    /* Adjust margins based on label size and position:
+     */
+    LabelframeLabelSize(lframePtr, &labelWidth, &labelHeight);
+    labelWidth += Ttk_PaddingWidth(style.labelMargins);
+    labelHeight += Ttk_PaddingHeight(style.labelMargins);
+
+    switch (LabelAnchorSide(style.labelAnchor)) {
+	case TTK_SIDE_LEFT:	margins.left   += labelWidth;	break;
+	case TTK_SIDE_RIGHT:	margins.right  += labelWidth;	break;
+	case TTK_SIDE_TOP:	margins.top    += labelHeight;	break;
+	case TTK_SIDE_BOTTOM:	margins.bottom += labelHeight;	break;
+    }
+
+    Ttk_SetMargins(corePtr->tkwin,margins);
+
+    /* Request minimum size based on border width and label size:
+     */
+    Tk_SetMinimumRequestSize(corePtr->tkwin,
+	    labelWidth + 2*style.borderWidth,
+	    labelHeight + 2*style.borderWidth);
+
+    return 0;
+}
+
+/*
+ * LabelframeGetLayout --
+ * 	Getlayout widget hook.
+ */
+
+static Ttk_Layout LabelframeGetLayout(
+    Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+    Labelframe *lf = recordPtr;
+    Ttk_Layout frameLayout = TtkWidgetGetLayout(interp, theme, recordPtr);
+    Ttk_Layout labelLayout;
+
+    if (!frameLayout) {
+	return NULL;
+    }
+
+    labelLayout = Ttk_CreateSublayout(
+	interp, theme, frameLayout, ".Label", lf->core.optionTable);
+
+    if (labelLayout) {
+	if (lf->label.labelLayout) {
+	    Ttk_FreeLayout(lf->label.labelLayout);
+	}
+	Ttk_RebindSublayout(labelLayout, recordPtr);
+	lf->label.labelLayout = labelLayout;
+    }
+
+    return frameLayout;
+}
+
+/*
+ * LabelframeDoLayout --
+ * 	Labelframe layout hook.
+ *
+ * Side effects: Computes labelParcel.
+ */
+
+static void LabelframeDoLayout(void *recordPtr)
+{
+    Labelframe *lframePtr = recordPtr;
+    WidgetCore *corePtr = &lframePtr->core;
+    int lw, lh;			/* Label width and height */
+    LabelframeStyle style;
+    Ttk_Box borderParcel = Ttk_WinBox(lframePtr->core.tkwin);
+    Ttk_Box labelParcel;
+
+    /*
+     * Compute label parcel:
+     */
+    LabelframeStyleOptions(lframePtr, &style);
+    LabelframeLabelSize(lframePtr, &lw, &lh);
+    lw += Ttk_PaddingWidth(style.labelMargins);
+    lh += Ttk_PaddingHeight(style.labelMargins);
+
+    labelParcel = Ttk_PadBox(
+	Ttk_PositionBox(&borderParcel, lw, lh, style.labelAnchor),
+	style.labelMargins);
+
+    if (!style.labelOutside) {
+	/* Move border edge so it's over label:
+	*/
+	switch (LabelAnchorSide(style.labelAnchor)) {
+	    case TTK_SIDE_LEFT: 	borderParcel.x -= lw / 2;
+	    case TTK_SIDE_RIGHT:	borderParcel.width += lw/2; 	break;
+	    case TTK_SIDE_TOP:  	borderParcel.y -= lh / 2;
+	    case TTK_SIDE_BOTTOM:	borderParcel.height += lh / 2;	break;
+	}
+    }
+
+    /*
+     * Place border and label:
+     */
+    Ttk_PlaceLayout(corePtr->layout, corePtr->state, borderParcel);
+    if (lframePtr->label.labelLayout) {
+	Ttk_PlaceLayout(
+	    lframePtr->label.labelLayout, corePtr->state, labelParcel);
+    }
+    /* labelWidget placed in LabelframePlaceSlaves GM hook */
+    lframePtr->label.labelParcel = labelParcel;
+}
+
+static void LabelframeDisplay(void *recordPtr, Drawable d)
+{
+    Labelframe *lframePtr = recordPtr;
+    Ttk_DrawLayout(lframePtr->core.layout, lframePtr->core.state, d);
+    if (lframePtr->label.labelLayout) {
+	Ttk_DrawLayout(lframePtr->label.labelLayout, lframePtr->core.state, d);
+    }
+}
+
+/* +++ Labelframe geometry manager hooks.
+ */
+
+/* LabelframePlaceSlaves --
+ * 	Sets the position and size of the labelwidget.
+ */
+static void LabelframePlaceSlaves(void *recordPtr)
+{
+    Labelframe *lframe = recordPtr;
+
+    if (Ttk_NumberSlaves(lframe->label.mgr) == 1) {
+	Ttk_Box b;
+	LabelframeDoLayout(recordPtr);
+	b = lframe->label.labelParcel;
+	/* ASSERT: slave #0 is lframe->label.labelWidget */
+	Ttk_PlaceSlave(lframe->label.mgr, 0, b.x,b.y,b.width,b.height);
+    }
+}
+
+static int LabelRequest(void *managerData, int index, int width, int height)
+{
+    return 1;
+}
+
+/* LabelRemoved --
+ * 	Unset the -labelwidget option.
+ *
+ * <<NOTE-LABELREMOVED>>:
+ * 	This routine is also called when the widget voluntarily forgets
+ * 	the slave in LabelframeConfigure.
+ */
+static void LabelRemoved(void *managerData, int slaveIndex)
+{
+    Labelframe *lframe = managerData;
+    lframe->label.labelWidget = 0;
+}
+
+static Ttk_ManagerSpec LabelframeManagerSpec = {
+    { "labelframe", Ttk_GeometryRequestProc, Ttk_LostSlaveProc },
+    LabelframeSize,
+    LabelframePlaceSlaves,
+    LabelRequest,
+    LabelRemoved
+};
+
+/* LabelframeInitialize --
+ * 	Initialization hook.
+ */
+static void LabelframeInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+    Labelframe *lframe = recordPtr;
+
+    lframe->label.mgr = Ttk_CreateManager(
+	&LabelframeManagerSpec, lframe, lframe->core.tkwin);
+    lframe->label.labelWidget = 0;
+    lframe->label.labelLayout = 0;
+    lframe->label.labelParcel = Ttk_MakeBox(-1,-1,-1,-1);
+}
+
+/* LabelframeCleanup --
+ * 	Cleanup hook.
+ */
+static void LabelframeCleanup(void *recordPtr)
+{
+    Labelframe *lframe = recordPtr;
+    Ttk_DeleteManager(lframe->label.mgr);
+    if (lframe->label.labelLayout) {
+	Ttk_FreeLayout(lframe->label.labelLayout);
+    }
+}
+
+/* RaiseLabelWidget --
+ * 	Raise the -labelwidget to ensure that the labelframe doesn't
+ * 	obscure it (if it's not a direct child), or bring it to
+ * 	the top of the stacking order (if it is).
+ */
+static void RaiseLabelWidget(Labelframe *lframe)
+{
+    Tk_Window parent = Tk_Parent(lframe->label.labelWidget);
+    Tk_Window sibling = NULL;
+    Tk_Window w = lframe->core.tkwin;
+
+    while (w && w != parent) {
+	sibling = w;
+	w = Tk_Parent(w);
+    }
+
+    Tk_RestackWindow(lframe->label.labelWidget, Above, sibling);
+}
+
+/* LabelframeConfigure --
+ * 	Configuration hook.
+ */
+static int LabelframeConfigure(Tcl_Interp *interp,void *recordPtr,int mask)
+{
+    Labelframe *lframePtr = recordPtr;
+    Tk_Window labelWidget = lframePtr->label.labelWidget;
+    Ttk_PositionSpec unused;
+
+    /* Validate options:
+     */
+    if (mask & LABELWIDGET_CHANGED && labelWidget != NULL) {
+	if (!Ttk_Maintainable(interp, labelWidget, lframePtr->core.tkwin)) {
+	    return TCL_ERROR;
+	}
+    }
+
+    if (TtkGetLabelAnchorFromObj(
+    	interp, lframePtr->label.labelAnchorObj, &unused) != TCL_OK)
+    {
+	return TCL_ERROR;
+    }
+
+    /* Base class configuration:
+     */
+    if (FrameConfigure(interp, recordPtr, mask) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* Update -labelwidget changes, if any:
+     */
+    if (mask & LABELWIDGET_CHANGED) {
+	if (Ttk_NumberSlaves(lframePtr->label.mgr) == 1) {
+	    Ttk_ForgetSlave(lframePtr->label.mgr, 0);
+	    /* Restore labelWidget field (see <<NOTE-LABELREMOVED>>)
+	     */
+	    lframePtr->label.labelWidget = labelWidget;
+	}
+
+	if (labelWidget) {
+	    Ttk_InsertSlave(lframePtr->label.mgr, 0, labelWidget, NULL);
+	    RaiseLabelWidget(lframePtr);
+	}
+    }
+
+    if (mask & GEOMETRY_CHANGED) {
+	Ttk_ManagerSizeChanged(lframePtr->label.mgr);
+	Ttk_ManagerLayoutChanged(lframePtr->label.mgr);
+    }
+
+    return TCL_OK;
+}
+
+static WidgetSpec LabelframeWidgetSpec = {
+    "TLabelframe",		/* className */
+    sizeof(Labelframe),		/* recordSize */
+    LabelframeOptionSpecs, 	/* optionSpecs */
+    FrameCommands,		/* subcommands */
+    LabelframeInitialize,	/* initializeProc */
+    LabelframeCleanup,		/* cleanupProc */
+    LabelframeConfigure,	/* configureProc */
+    TtkNullPostConfigure,  	/* postConfigureProc */
+    LabelframeGetLayout, 	/* getLayoutProc */
+    LabelframeSize,		/* sizeProc */
+    LabelframeDoLayout,		/* layoutProc */
+    LabelframeDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(LabelframeLayout)
+    TTK_NODE("Labelframe.border", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(LabelSublayout)
+    TTK_GROUP("Label.fill", TTK_FILL_BOTH,
+	TTK_NODE("Label.text", TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+/* ======================================================================
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE
+void TtkFrame_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme =  Ttk_GetDefaultTheme(interp);
+
+    Ttk_RegisterLayout(theme, "TFrame", FrameLayout);
+    Ttk_RegisterLayout(theme, "TLabelframe", LabelframeLayout);
+    Ttk_RegisterLayout(theme, "Label", LabelSublayout);
+
+    RegisterWidget(interp, "ttk::frame", &FrameWidgetSpec);
+    RegisterWidget(interp, "ttk::labelframe", &LabelframeWidgetSpec);
+}
+

generic/ttk/ttkGenStubs.tcl

@@ -0,0 +1,963 @@
+# ttkGenStubs.tcl --
+#
+#	This script generates a set of stub files for a given
+#	interface.
+#
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SOURCE: tcl/tools/genStubs.tcl, revision 1.44
+#
+# CHANGES:
+#	+ Second argument to "declare" is used as a status guard
+#	  instead of a platform guard.
+#	+ Allow trailing semicolon in function declarations
+#
+
+namespace eval genStubs {
+    # libraryName --
+    #
+    #	The name of the entire library.  This value is used to compute
+    #	the USE_*_STUBS macro and the name of the init file.
+
+    variable libraryName "UNKNOWN"
+
+    # interfaces --
+    #
+    #	An array indexed by interface name that is used to maintain
+    #   the set of valid interfaces.  The value is empty.
+
+    array set interfaces {}
+
+    # curName --
+    #
+    #	The name of the interface currently being defined.
+
+    variable curName "UNKNOWN"
+
+    # scspec --
+    #
+    #	Storage class specifier for external function declarations.
+    #	Normally "EXTERN", may be set to something like XYZAPI
+    #
+    variable scspec "EXTERN"
+
+    # epoch, revision --
+    #
+    #	The epoch and revision numbers of the interface currently being defined.
+    #   (@@@TODO: should be an array mapping interface names -> numbers)
+    #
+
+    variable epoch {}
+    variable revision 0
+
+    # hooks --
+    #
+    #	An array indexed by interface name that contains the set of
+    #	subinterfaces that should be defined for a given interface.
+
+    array set hooks {}
+
+    # stubs --
+    #
+    #	This three dimensional array is indexed first by interface name,
+    #	second by field name, and third by a numeric offset or the
+    #	constant "lastNum".  The lastNum entry contains the largest
+    #	numeric offset used for a given interface.
+    #
+    #	Field "decl,$i" contains the C function specification that
+    #	should be used for the given entry in the stub table.  The spec
+    #	consists of a list in the form returned by parseDecl.
+    #   Other fields TBD later.
+
+    array set stubs {}
+
+    # outDir --
+    #
+    #	The directory where the generated files should be placed.
+
+    variable outDir .
+}
+
+# genStubs::library --
+#
+#	This function is used in the declarations file to set the name
+#	of the library that the interfaces are associated with (e.g. "tcl").
+#	This value will be used to define the inline conditional macro.
+#
+# Arguments:
+#	name	The library name.
+#
+# Results:
+#	None.
+
+proc genStubs::library {name} {
+    variable libraryName $name
+}
+
+# genStubs::interface --
+#
+#	This function is used in the declarations file to set the name
+#	of the interface currently being defined.
+#
+# Arguments:
+#	name	The name of the interface.
+#
+# Results:
+#	None.
+
+proc genStubs::interface {name} {
+    variable curName $name
+    variable interfaces
+    variable stubs
+
+    set interfaces($name) {}
+    set stubs($name,lastNum) 0
+    return
+}
+
+# genStubs::scspec --
+#
+#	Define the storage class macro used for external function declarations.
+#	Typically, this will be a macro like XYZAPI or EXTERN that
+#	expands to either DLLIMPORT or DLLEXPORT, depending on whether
+#	-DBUILD_XYZ has been set.
+#
+proc genStubs::scspec {value} {
+    variable scspec $value
+}
+
+# genStubs::epoch --
+#
+#	Define the epoch number for this library.  The epoch
+#	should be incrememented when a release is made that
+#	contains incompatible changes to the public API.
+#
+proc genStubs::epoch {value} {
+    variable epoch $value
+}
+
+# genStubs::hooks --
+#
+#	This function defines the subinterface hooks for the current
+#	interface.
+#
+# Arguments:
+#	names	The ordered list of interfaces that are reachable through the
+#		hook vector.
+#
+# Results:
+#	None.
+
+proc genStubs::hooks {names} {
+    variable curName
+    variable hooks
+
+    set hooks($curName) $names
+    return
+}
+
+# genStubs::declare --
+#
+#	This function is used in the declarations file to declare a new
+#	interface entry.
+#
+# Arguments:
+#	index		The index number of the interface.
+#	status  	Status of the interface: one of "current",
+#		  	"deprecated", or "obsolete".
+#	decl		The C function declaration, or {} for an undefined
+#			entry.
+#
+# Results:
+#	None.
+
+proc genStubs::declare {args} {
+    variable stubs
+    variable curName
+    variable revision
+
+    incr revision
+    if {[llength $args] == 2} {
+	lassign $args index decl
+	set status current
+    } elseif {[llength $args] == 3} {
+	lassign $args index status decl
+    } else {
+	puts stderr "wrong # args: declare $args"
+	return
+    }
+
+    # Check for duplicate declarations, then add the declaration and
+    # bump the lastNum counter if necessary.
+
+    if {[info exists stubs($curName,decl,$index)]} {
+	puts stderr "Duplicate entry: $index"
+    }
+    regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
+    set decl [parseDecl $decl]
+
+    set stubs($curName,status,$index) $status
+    set stubs($curName,decl,$index) $decl
+
+    if {$index > $stubs($curName,lastNum)} {
+	set stubs($curName,lastNum) $index
+    }
+    return
+}
+
+# genStubs::export --
+#
+#	This function is used in the declarations file to declare a symbol
+#	that is exported from the library but is not in the stubs table.
+#
+# Arguments:
+#	decl		The C function declaration, or {} for an undefined
+#			entry.
+#
+# Results:
+#	None.
+
+proc genStubs::export {args} {
+    if {[llength $args] != 1} {
+	puts stderr "wrong # args: export $args"
+    }
+    return
+}
+
+# genStubs::rewriteFile --
+#
+#	This function replaces the machine generated portion of the
+#	specified file with new contents.  It looks for the !BEGIN! and
+#	!END! comments to determine where to place the new text.
+#
+# Arguments:
+#	file	The name of the file to modify.
+#	text	The new text to place in the file.
+#
+# Results:
+#	None.
+
+proc genStubs::rewriteFile {file text} {
+    if {![file exists $file]} {
+	puts stderr "Cannot find file: $file"
+	return
+    }
+    set in [open ${file} r]
+    set out [open ${file}.new w]
+    fconfigure $out -translation lf
+
+    while {![eof $in]} {
+	set line [gets $in]
+	if {[string match "*!BEGIN!*" $line]} {
+	    break
+	}
+	puts $out $line
+    }
+    puts $out "/* !BEGIN!: Do not edit below this line. */"
+    puts $out $text
+    while {![eof $in]} {
+	set line [gets $in]
+	if {[string match "*!END!*" $line]} {
+	    break
+	}
+    }
+    puts $out "/* !END!: Do not edit above this line. */"
+    puts -nonewline $out [read $in]
+    close $in
+    close $out
+    file rename -force ${file}.new ${file}
+    return
+}
+
+# genStubs::addPlatformGuard --
+#
+#	Wrap a string inside a platform #ifdef.
+#
+# Arguments:
+#	plat	Platform to test.
+#
+# Results:
+#	Returns the original text inside an appropriate #ifdef.
+
+proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} {
+    set text ""
+    switch $plat {
+	win {
+	    append text "#ifdef _WIN32 /* WIN */\n${iftxt}"
+	    if {$eltxt ne ""} {
+		append text "#else /* WIN */\n${eltxt}"
+	    }
+	    append text "#endif /* WIN */\n"
+	}
+	unix {
+	    append text "#if !defined(_WIN32) && !defined(MAC_OSX_TCL)\
+		    /* UNIX */\n${iftxt}"
+	    if {$eltxt ne ""} {
+		append text "#else /* UNIX */\n${eltxt}"
+	    }
+	    append text "#endif /* UNIX */\n"
+	}
+	macosx {
+	    append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}"
+	    if {$eltxt ne ""} {
+		append text "#else /* MACOSX */\n${eltxt}"
+	    }
+	    append text "#endif /* MACOSX */\n"
+	}
+	aqua {
+	    append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}"
+	    if {$eltxt ne ""} {
+		append text "#else /* AQUA */\n${eltxt}"
+	    }
+	    append text "#endif /* AQUA */\n"
+	}
+	x11 {
+	    append text "#if !(defined(_WIN32) || defined(MAC_OSX_TK))\
+		    /* X11 */\n${iftxt}"
+	    if {$eltxt ne ""} {
+		append text "#else /* X11 */\n${eltxt}"
+	    }
+	    append text "#endif /* X11 */\n"
+	}
+	default {
+	    append text "${iftxt}${eltxt}"
+	}
+    }
+    return $text
+}
+
+# genStubs::emitSlots --
+#
+#	Generate the stub table slots for the given interface.  If there
+#	are no generic slots, then one table is generated for each
+#	platform, otherwise one table is generated for all platforms.
+#
+# Arguments:
+#	name	The name of the interface being emitted.
+#	textVar	The variable to use for output.
+#
+# Results:
+#	None.
+
+proc genStubs::emitSlots {name textVar} {
+    upvar $textVar text
+
+    forAllStubs $name makeSlot noGuard text {"    void (*reserved$i)(void);\n"}
+    return
+}
+
+# genStubs::parseDecl --
+#
+#	Parse a C function declaration into its component parts.
+#
+# Arguments:
+#	decl	The function declaration.
+#
+# Results:
+#	Returns a list of the form {returnType name args}.  The args
+#	element consists of a list of type/name pairs, or a single
+#	element "void".  If the function declaration is malformed
+#	then an error is displayed and the return value is {}.
+
+proc genStubs::parseDecl {decl} {
+    if {![regexp {^(.*)\((.*)\);?$} $decl all prefix args]} {
+	set prefix $decl
+	set args {}
+    }
+    set prefix [string trim $prefix]
+    if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} {
+	puts stderr "Bad return type: $decl"
+	return
+    }
+    set rtype [string trim $rtype]
+    if {$args eq ""} {
+	return [list $rtype $fname {}]
+    }
+    foreach arg [split $args ,] {
+	lappend argList [string trim $arg]
+    }
+    if {![string compare [lindex $argList end] "..."]} {
+	set args TCL_VARARGS
+	foreach arg [lrange $argList 0 end-1] {
+	    set argInfo [parseArg $arg]
+	    if {[llength $argInfo] == 2 || [llength $argInfo] == 3} {
+		lappend args $argInfo
+	    } else {
+		puts stderr "Bad argument: '$arg' in '$decl'"
+		return
+	    }
+	}
+    } else {
+	set args {}
+	foreach arg $argList {
+	    set argInfo [parseArg $arg]
+	    if {![string compare $argInfo "void"]} {
+		lappend args "void"
+		break
+	    } elseif {[llength $argInfo] == 2 || [llength $argInfo] == 3} {
+		lappend args $argInfo
+	    } else {
+		puts stderr "Bad argument: '$arg' in '$decl'"
+		return
+	    }
+	}
+    }
+    return [list $rtype $fname $args]
+}
+
+# genStubs::parseArg --
+#
+#	This function parses a function argument into a type and name.
+#
+# Arguments:
+#	arg	The argument to parse.
+#
+# Results:
+#	Returns a list of type and name with an optional third array
+#	indicator.  If the argument is malformed, returns "".
+
+proc genStubs::parseArg {arg} {
+    if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} {
+	if {$arg eq "void"} {
+	    return $arg
+	} else {
+	    return
+	}
+    }
+    set result [list [string trim $type] $name]
+    if {$array ne ""} {
+	lappend result $array
+    }
+    return $result
+}
+
+# genStubs::makeDecl --
+#
+#	Generate the prototype for a function.
+#
+# Arguments:
+#	name	The interface name.
+#	decl	The function declaration.
+#	index	The slot index for this function.
+#
+# Results:
+#	Returns the formatted declaration string.
+
+proc genStubs::makeDecl {name decl index} {
+    variable scspec
+    lassign $decl rtype fname args
+
+    append text "/* $index */\n"
+    set line "$scspec $rtype"
+    set count [expr {2 - ([string length $line] / 8)}]
+    append line [string range "\t\t\t" 0 $count]
+    set pad [expr {24 - [string length $line]}]
+    if {$pad <= 0} {
+	append line " "
+	set pad 0
+    }
+    if {$args eq ""} {
+	append line $fname
+	append text $line
+	append text ";\n"
+	return $text
+    }
+    append line $fname
+
+    set arg1 [lindex $args 0]
+    switch -exact $arg1 {
+	void {
+	    append line "(void)"
+	}
+	TCL_VARARGS {
+	    set sep "("
+	    foreach arg [lrange $args 1 end] {
+		append line $sep
+		set next {}
+		append next [lindex $arg 0]
+		if {[string index $next end] ne "*"} {
+		    append next " "
+		}
+		append next [lindex $arg 1] [lindex $arg 2]
+		if {[string length $line] + [string length $next] \
+			+ $pad > 76} {
+		    append text [string trimright $line] \n
+		    set line "\t\t\t\t"
+		    set pad 28
+		}
+		append line $next
+		set sep ", "
+	    }
+	    append line ", ...)"
+	}
+	default {
+	    set sep "("
+	    foreach arg $args {
+		append line $sep
+		set next {}
+		append next [lindex $arg 0]
+		if {[string index $next end] ne "*"} {
+		    append next " "
+		}
+		append next [lindex $arg 1] [lindex $arg 2]
+		if {[string length $line] + [string length $next] \
+			+ $pad > 76} {
+		    append text [string trimright $line] \n
+		    set line "\t\t\t\t"
+		    set pad 28
+		}
+		append line $next
+		set sep ", "
+	    }
+	    append line ")"
+	}
+    }
+    return "$text$line;\n"
+}
+
+# genStubs::makeMacro --
+#
+#	Generate the inline macro for a function.
+#
+# Arguments:
+#	name	The interface name.
+#	decl	The function declaration.
+#	index	The slot index for this function.
+#
+# Results:
+#	Returns the formatted macro definition.
+
+proc genStubs::makeMacro {name decl index} {
+    lassign $decl rtype fname args
+
+    set lfname [string tolower [string index $fname 0]]
+    append lfname [string range $fname 1 end]
+
+    set text "#define $fname \\\n\t("
+    if {$args eq ""} {
+	append text "*"
+    }
+    append text "${name}StubsPtr->$lfname)"
+    append text " /* $index */\n"
+    return $text
+}
+
+# genStubs::makeSlot --
+#
+#	Generate the stub table entry for a function.
+#
+# Arguments:
+#	name	The interface name.
+#	decl	The function declaration.
+#	index	The slot index for this function.
+#
+# Results:
+#	Returns the formatted table entry.
+
+proc genStubs::makeSlot {name decl index} {
+    lassign $decl rtype fname args
+
+    set lfname [string tolower [string index $fname 0]]
+    append lfname [string range $fname 1 end]
+
+    set text "    "
+    if {$args eq ""} {
+	append text $rtype " *" $lfname "; /* $index */\n"
+	return $text
+    }
+    if {[string range $rtype end-8 end] eq "__stdcall"} {
+	append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
+    } else {
+	append text $rtype " (*" $lfname ") "
+    }
+    set arg1 [lindex $args 0]
+    switch -exact $arg1 {
+	void {
+	    append text "(void)"
+	}
+	TCL_VARARGS {
+	    set sep "("
+	    foreach arg [lrange $args 1 end] {
+		append text $sep [lindex $arg 0]
+		if {[string index $text end] ne "*"} {
+		    append text " "
+		}
+		append text [lindex $arg 1] [lindex $arg 2]
+		set sep ", "
+	    }
+	    append text ", ...)"
+	}
+	default {
+	    set sep "("
+	    foreach arg $args {
+		append text $sep [lindex $arg 0]
+		if {[string index $text end] ne "*"} {
+		    append text " "
+		}
+		append text [lindex $arg 1] [lindex $arg 2]
+		set sep ", "
+	    }
+	    append text ")"
+	}
+    }
+
+    append text "; /* $index */\n"
+    return $text
+}
+
+# genStubs::makeInit --
+#
+#	Generate the prototype for a function.
+#
+# Arguments:
+#	name	The interface name.
+#	decl	The function declaration.
+#	index	The slot index for this function.
+#
+# Results:
+#	Returns the formatted declaration string.
+
+proc genStubs::makeInit {name decl index} {
+    if {[lindex $decl 2] eq ""} {
+	append text "    &" [lindex $decl 1] ", /* " $index " */\n"
+    } else {
+	append text "    " [lindex $decl 1] ", /* " $index " */\n"
+    }
+    return $text
+}
+
+# genStubs::forAllStubs --
+#
+#	This function iterates over all of the slots and invokes
+#	a callback for each slot.  The result of the callback is then
+#	placed inside appropriate guards.
+#
+# Arguments:
+#	name		The interface name.
+#	slotProc	The proc to invoke to handle the slot.  It will
+#			have the interface name, the declaration,  and
+#			the index appended.
+#	guardProc	The proc to invoke to add guards.  It will have
+#		        the slot status and text appended.
+#	textVar		The variable to use for output.
+#	skipString	The string to emit if a slot is skipped.  This
+#			string will be subst'ed in the loop so "$i" can
+#			be used to substitute the index value.
+#
+# Results:
+#	None.
+
+proc genStubs::forAllStubs {name slotProc guardProc textVar
+	{skipString {"/* Slot $i is reserved */\n"}}} {
+    variable stubs
+    upvar $textVar text
+
+    set lastNum $stubs($name,lastNum)
+
+    for {set i 0} {$i <= $lastNum} {incr i} {
+	if {[info exists stubs($name,decl,$i)]} {
+	    append text [$guardProc $stubs($name,status,$i) \
+	    			[$slotProc $name $stubs($name,decl,$i) $i]]
+	} else {
+	    eval {append text} $skipString
+	}
+    }
+}
+
+proc genStubs::noGuard  {status text} { return $text }
+
+proc genStubs::addGuard {status text} {
+    variable libraryName
+    set upName [string toupper $libraryName]
+
+    switch -- $status {
+	current	{
+	    # No change
+	}
+	deprecated {
+	    set text [ifdeffed "${upName}_DEPRECATED" $text]
+	}
+	obsolete {
+	    set text ""
+	}
+	default {
+	    puts stderr "Unrecognized status code $status"
+	}
+    }
+    return $text
+}
+
+proc genStubs::ifdeffed {macro text} {
+    join [list "#ifdef $macro" $text "#endif" ""] \n
+}
+
+# genStubs::emitDeclarations --
+#
+#	This function emits the function declarations for this interface.
+#
+# Arguments:
+#	name	The interface name.
+#	textVar	The variable to use for output.
+#
+# Results:
+#	None.
+
+proc genStubs::emitDeclarations {name textVar} {
+    upvar $textVar text
+
+    append text "\n/*\n * Exported function declarations:\n */\n\n"
+    forAllStubs $name makeDecl noGuard text
+    return
+}
+
+# genStubs::emitMacros --
+#
+#	This function emits the inline macros for an interface.
+#
+# Arguments:
+#	name	The name of the interface being emitted.
+#	textVar	The variable to use for output.
+#
+# Results:
+#	None.
+
+proc genStubs::emitMacros {name textVar} {
+    variable libraryName
+    upvar $textVar text
+
+    set upName [string toupper $libraryName]
+    append text "\n#if defined(USE_${upName}_STUBS)\n"
+    append text "\n/*\n * Inline function declarations:\n */\n\n"
+
+    forAllStubs $name makeMacro addGuard text
+
+    append text "\n#endif /* defined(USE_${upName}_STUBS) */\n"
+    return
+}
+
+# genStubs::emitHeader --
+#
+#	This function emits the body of the <name>Decls.h file for
+#	the specified interface.
+#
+# Arguments:
+#	name	The name of the interface being emitted.
+#
+# Results:
+#	None.
+
+proc genStubs::emitHeader {name} {
+    variable outDir
+    variable hooks
+    variable epoch
+    variable revision
+
+    set capName [string toupper [string index $name 0]]
+    append capName [string range $name 1 end]
+
+    if {$epoch ne ""} {
+	set CAPName [string toupper $name]
+	append text "\n"
+	append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
+	append text "#define ${CAPName}_STUBS_REVISION $revision\n"
+    }
+
+    append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
+
+    emitDeclarations $name text
+
+    if {[info exists hooks($name)]} {
+	append text "\ntypedef struct {\n"
+	foreach hook $hooks($name) {
+	    set capHook [string toupper [string index $hook 0]]
+	    append capHook [string range $hook 1 end]
+	    append text "    const struct ${capHook}Stubs *${hook}Stubs;\n"
+	}
+	append text "} ${capName}StubHooks;\n"
+    }
+    append text "\ntypedef struct ${capName}Stubs {\n"
+    append text "    int magic;\n"
+    if {$epoch ne ""} {
+	append text "    int epoch;\n"
+	append text "    int revision;\n"
+    }
+    if {[info exists hooks($name)]} {
+	append text "    const ${capName}StubHooks *hooks;\n\n"
+    } else {
+	append text "    void *hooks;\n\n"
+    }
+
+    emitSlots $name text
+
+    append text "} ${capName}Stubs;\n\n"
+
+    append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n"
+    append text "#ifdef __cplusplus\n}\n#endif\n"
+
+    emitMacros $name text
+
+    rewriteFile [file join $outDir ${name}Decls.h] $text
+    return
+}
+
+# genStubs::emitInit --
+#
+#	Generate the table initializers for an interface.
+#
+# Arguments:
+#	name		The name of the interface to initialize.
+#	textVar		The variable to use for output.
+#
+# Results:
+#	Returns the formatted output.
+
+proc genStubs::emitInit {name textVar} {
+    variable hooks
+    variable interfaces
+    variable epoch
+    upvar $textVar text
+    set root 1
+
+    set capName [string toupper [string index $name 0]]
+    append capName [string range $name 1 end]
+
+    if {[info exists hooks($name)]} {
+	append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n"
+	set sep "    "
+	foreach sub $hooks($name) {
+	    append text $sep "&${sub}Stubs"
+	    set sep ",\n    "
+	}
+	append text "\n\};\n"
+    }
+    foreach intf [array names interfaces] {
+	if {[info exists hooks($intf)]} {
+	    if {[lsearch -exact $hooks($intf) $name] >= 0} {
+		set root 0
+		break
+	    }
+	}
+    }
+
+    append text "\n"
+    if {!$root} {
+	append text "static "
+    }
+    append text "const ${capName}Stubs ${name}Stubs = \{\n    TCL_STUB_MAGIC,\n"
+    if {$epoch ne ""} {
+	set CAPName [string toupper $name]
+	append text "    ${CAPName}_STUBS_EPOCH,\n"
+	append text "    ${CAPName}_STUBS_REVISION,\n"
+    }
+    if {[info exists hooks($name)]} {
+	append text "    &${name}StubHooks,\n"
+    } else {
+	append text "    0,\n"
+    }
+
+    forAllStubs $name makeInit noGuard text {"    0, /* $i */\n"}
+
+    append text "\};\n"
+    return
+}
+
+# genStubs::emitInits --
+#
+#	This function emits the body of the <name>StubInit.c file for
+#	the specified interface.
+#
+# Arguments:
+#	name	The name of the interface being emitted.
+#
+# Results:
+#	None.
+
+proc genStubs::emitInits {} {
+    variable hooks
+    variable outDir
+    variable libraryName
+    variable interfaces
+
+    # Assuming that dependencies only go one level deep, we need to emit
+    # all of the leaves first to avoid needing forward declarations.
+
+    set leaves {}
+    set roots {}
+    foreach name [lsort [array names interfaces]] {
+	if {[info exists hooks($name)]} {
+	    lappend roots $name
+	} else {
+	    lappend leaves $name
+	}
+    }
+    foreach name $leaves {
+	emitInit $name text
+    }
+    foreach name $roots {
+	emitInit $name text
+    }
+
+    rewriteFile [file join $outDir ${libraryName}StubInit.c] $text
+}
+
+# genStubs::init --
+#
+#	This is the main entry point.
+#
+# Arguments:
+#	None.
+#
+# Results:
+#	None.
+
+proc genStubs::init {} {
+    global argv argv0
+    variable outDir
+    variable interfaces
+
+    if {[llength $argv] < 2} {
+	puts stderr "usage: $argv0 outDir declFile ?declFile...?"
+	exit 1
+    }
+
+    set outDir [lindex $argv 0]
+
+    foreach file [lrange $argv 1 end] {
+	source $file
+    }
+
+    foreach name [lsort [array names interfaces]] {
+	puts "Emitting $name"
+	emitHeader $name
+    }
+
+    emitInits
+}
+
+# lassign --
+#
+#	This function emulates the TclX lassign command.
+#
+# Arguments:
+#	valueList	A list containing the values to be assigned.
+#	args		The list of variables to be assigned.
+#
+# Results:
+#	Returns any values that were not assigned to variables.
+
+if {[string length [namespace which lassign]] == 0} {
+    proc lassign {valueList args} {
+	if {[llength $args] == 0} {
+	    error "wrong # args: should be \"lassign list varName ?varName ...?\""
+	}
+	uplevel [list foreach $args $valueList {break}]
+	return [lrange $valueList [llength $args] end]
+    }
+}
+
+genStubs::init

generic/ttk/ttkImage.c

@@ -0,0 +1,422 @@
+/*
+ *	Image specifications and image element factory.
+ *
+ * Copyright (C) 2004 Pat Thoyts <patthoyts@users.sf.net>
+ * Copyright (C) 2004 Joe English
+ *
+ * An imageSpec is a multi-element list; the first element
+ * is the name of the default image to use, the remainder of the
+ * list is a sequence of statespec/imagename options as per
+ * [style map].
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+
+/*------------------------------------------------------------------------
+ * +++ ImageSpec management.
+ */
+
+struct TtkImageSpec {
+    Tk_Image 		baseImage;	/* Base image to use */
+    int 		mapCount;	/* #state-specific overrides */
+    Ttk_StateSpec	*states;	/* array[mapCount] of states ... */
+    Tk_Image		*images;	/* ... per-state images to use */
+};
+
+/* NullImageChanged --
+ * 	Do-nothing Tk_ImageChangedProc.
+ */
+static void NullImageChanged(ClientData clientData,
+    int x, int y, int width, int height, int imageWidth, int imageHeight)
+{ /* No-op */ }
+
+/* TtkGetImageSpec --
+ * 	Constructs a Ttk_ImageSpec * from a Tcl_Obj *.
+ * 	Result must be released using TtkFreeImageSpec.
+ *
+ * TODO: Need a variant of this that takes a user-specified ImageChanged proc
+ */
+Ttk_ImageSpec *
+TtkGetImageSpec(Tcl_Interp *interp, Tk_Window tkwin, Tcl_Obj *objPtr)
+{
+    Ttk_ImageSpec *imageSpec = 0;
+    int i = 0, n = 0, objc;
+    Tcl_Obj **objv;
+
+    imageSpec = ckalloc(sizeof(*imageSpec));
+    imageSpec->baseImage = 0;
+    imageSpec->mapCount = 0;
+    imageSpec->states = 0;
+    imageSpec->images = 0;
+
+    if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+	goto error;
+    }
+
+    if ((objc % 2) != 1) {
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"image specification must contain an odd number of elements",
+		-1));
+	    Tcl_SetErrorCode(interp, "TTK", "IMAGE", "SPEC", NULL);
+	}
+	goto error;
+    }
+
+    n = (objc - 1) / 2;
+    imageSpec->states = ckalloc(n * sizeof(Ttk_StateSpec));
+    imageSpec->images = ckalloc(n * sizeof(Tk_Image *));
+
+    /* Get base image:
+    */
+    imageSpec->baseImage = Tk_GetImage(
+	    interp, tkwin, Tcl_GetString(objv[0]), NullImageChanged, NULL);
+    if (!imageSpec->baseImage) {
+    	goto error;
+    }
+
+    /* Extract state and image specifications:
+     */
+    for (i = 0; i < n; ++i) {
+	Tcl_Obj *stateSpec = objv[2*i + 1];
+	const char *imageName = Tcl_GetString(objv[2*i + 2]);
+	Ttk_StateSpec state;
+
+	if (Ttk_GetStateSpecFromObj(interp, stateSpec, &state) != TCL_OK) {
+	    goto error;
+	}
+	imageSpec->states[i] = state;
+
+	imageSpec->images[i] = Tk_GetImage(
+	    interp, tkwin, imageName, NullImageChanged, NULL);
+	if (imageSpec->images[i] == NULL) {
+	    goto error;
+	}
+	imageSpec->mapCount = i+1;
+    }
+
+    return imageSpec;
+
+error:
+    TtkFreeImageSpec(imageSpec);
+    return NULL;
+}
+
+/* TtkFreeImageSpec --
+ * 	Dispose of an image specification.
+ */
+void TtkFreeImageSpec(Ttk_ImageSpec *imageSpec)
+{
+    int i;
+
+    for (i=0; i < imageSpec->mapCount; ++i) {
+	Tk_FreeImage(imageSpec->images[i]);
+    }
+
+    if (imageSpec->baseImage) { Tk_FreeImage(imageSpec->baseImage); }
+    if (imageSpec->states) { ckfree(imageSpec->states); }
+    if (imageSpec->images) { ckfree(imageSpec->images); }
+
+    ckfree(imageSpec);
+}
+
+/* TtkSelectImage --
+ * 	Return a state-specific image from an ImageSpec
+ */
+Tk_Image TtkSelectImage(Ttk_ImageSpec *imageSpec, Ttk_State state)
+{
+    int i;
+    for (i = 0; i < imageSpec->mapCount; ++i) {
+	if (Ttk_StateMatches(state, imageSpec->states+i)) {
+	    return imageSpec->images[i];
+	}
+    }
+    return imageSpec->baseImage;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Drawing utilities.
+ */
+
+/* LPadding, CPadding, RPadding --
+ * 	Split a box+padding pair into left, center, and right boxes.
+ */
+static Ttk_Box LPadding(Ttk_Box b, Ttk_Padding p)
+    { return Ttk_MakeBox(b.x, b.y, p.left, b.height); }
+
+static Ttk_Box CPadding(Ttk_Box b, Ttk_Padding p)
+    { return Ttk_MakeBox(b.x+p.left, b.y, b.width-p.left-p.right, b.height); }
+
+static Ttk_Box RPadding(Ttk_Box b, Ttk_Padding p)
+    { return  Ttk_MakeBox(b.x+b.width-p.right, b.y, p.right, b.height); }
+
+/* TPadding, MPadding, BPadding --
+ * 	Split a box+padding pair into top, middle, and bottom parts.
+ */
+static Ttk_Box TPadding(Ttk_Box b, Ttk_Padding p)
+    { return Ttk_MakeBox(b.x, b.y, b.width, p.top); }
+
+static Ttk_Box MPadding(Ttk_Box b, Ttk_Padding p)
+    { return Ttk_MakeBox(b.x, b.y+p.top, b.width, b.height-p.top-p.bottom); }
+
+static Ttk_Box BPadding(Ttk_Box b, Ttk_Padding p)
+    { return Ttk_MakeBox(b.x, b.y+b.height-p.bottom, b.width, p.bottom); }
+
+/* Ttk_Fill --
+ *	Fill the destination area of the drawable by replicating
+ *	the source area of the image.
+ */
+static void Ttk_Fill(
+    Tk_Window tkwin, Drawable d, Tk_Image image, Ttk_Box src, Ttk_Box dst)
+{
+    int dr = dst.x + dst.width;
+    int db = dst.y + dst.height;
+    int x,y;
+
+    if (!(src.width && src.height && dst.width && dst.height))
+	return;
+
+    for (x = dst.x; x < dr; x += src.width) {
+	int cw = MIN(src.width, dr - x);
+	for (y = dst.y; y <= db; y += src.height) {
+	    int ch = MIN(src.height, db - y);
+	    Tk_RedrawImage(image, src.x, src.y, cw, ch, d, x, y);
+	}
+    }
+}
+
+/* Ttk_Stripe --
+ * 	Fill a horizontal stripe of the destination drawable.
+ */
+static void Ttk_Stripe(
+    Tk_Window tkwin, Drawable d, Tk_Image image,
+    Ttk_Box src, Ttk_Box dst, Ttk_Padding p)
+{
+    Ttk_Fill(tkwin, d, image, LPadding(src,p), LPadding(dst,p));
+    Ttk_Fill(tkwin, d, image, CPadding(src,p), CPadding(dst,p));
+    Ttk_Fill(tkwin, d, image, RPadding(src,p), RPadding(dst,p));
+}
+
+/* Ttk_Tile --
+ * 	Fill successive horizontal stripes of the destination drawable.
+ */
+static void Ttk_Tile(
+    Tk_Window tkwin, Drawable d, Tk_Image image,
+    Ttk_Box src, Ttk_Box dst, Ttk_Padding p)
+{
+    Ttk_Stripe(tkwin, d, image, TPadding(src,p), TPadding(dst,p), p);
+    Ttk_Stripe(tkwin, d, image, MPadding(src,p), MPadding(dst,p), p);
+    Ttk_Stripe(tkwin, d, image, BPadding(src,p), BPadding(dst,p), p);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Image element definition.
+ */
+
+typedef struct {		/* ClientData for image elements */
+    Ttk_ImageSpec *imageSpec;	/* Image(s) to use */
+    int minWidth;		/* Minimum width; overrides image width */
+    int minHeight;		/* Minimum width; overrides image width */
+    Ttk_Sticky sticky;		/* -stickiness specification */
+    Ttk_Padding border;		/* Fixed border region */
+    Ttk_Padding padding;	/* Internal padding */
+
+#if TILE_07_COMPAT
+    Ttk_ResourceCache cache;	/* Resource cache for images */
+    Ttk_StateMap imageMap;	/* State-based lookup table for images */
+#endif
+} ImageData;
+
+static void FreeImageData(void *clientData)
+{
+    ImageData *imageData = clientData;
+    if (imageData->imageSpec)	{ TtkFreeImageSpec(imageData->imageSpec); }
+#if TILE_07_COMPAT
+    if (imageData->imageMap)	{ Tcl_DecrRefCount(imageData->imageMap); }
+#endif
+    ckfree(clientData);
+}
+
+static void ImageElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    ImageData *imageData = clientData;
+    Tk_Image image = imageData->imageSpec->baseImage;
+
+    if (image) {
+	Tk_SizeOfImage(image, widthPtr, heightPtr);
+    }
+    if (imageData->minWidth >= 0) {
+	*widthPtr = imageData->minWidth;
+    }
+    if (imageData->minHeight >= 0) {
+	*heightPtr = imageData->minHeight;
+    }
+
+    *paddingPtr = imageData->padding;
+}
+
+static void ImageElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned int state)
+{
+    ImageData *imageData = clientData;
+    Tk_Image image = 0;
+    int imgWidth, imgHeight;
+    Ttk_Box src, dst;
+
+#if TILE_07_COMPAT
+    if (imageData->imageMap) {
+	Tcl_Obj *imageObj = Ttk_StateMapLookup(NULL,imageData->imageMap,state);
+	if (imageObj) {
+	    image = Ttk_UseImage(imageData->cache, tkwin, imageObj);
+	}
+    }
+    if (!image) {
+	image = TtkSelectImage(imageData->imageSpec, state);
+    }
+#else
+    image = TtkSelectImage(imageData->imageSpec, state);
+#endif
+
+    if (!image) {
+	return;
+    }
+
+    Tk_SizeOfImage(image, &imgWidth, &imgHeight);
+    src = Ttk_MakeBox(0, 0, imgWidth, imgHeight);
+    dst = Ttk_StickBox(b, imgWidth, imgHeight, imageData->sticky);
+
+    Ttk_Tile(tkwin, d, image, src, dst, imageData->border);
+}
+
+static Ttk_ElementSpec ImageElementSpec =
+{
+    TK_STYLE_VERSION_2,
+    sizeof(NullElement),
+    TtkNullElementOptions,
+    ImageElementSize,
+    ImageElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Image element factory.
+ */
+static int
+Ttk_CreateImageElement(
+    Tcl_Interp *interp,
+    void *clientData,
+    Ttk_Theme theme,
+    const char *elementName,
+    int objc, Tcl_Obj *const objv[])
+{
+    static const char *optionStrings[] =
+	 { "-border","-height","-padding","-sticky","-width",NULL };
+    enum { O_BORDER, O_HEIGHT, O_PADDING, O_STICKY, O_WIDTH };
+
+    Ttk_ImageSpec *imageSpec = 0;
+    ImageData *imageData = 0;
+    int padding_specified = 0;
+    int i;
+
+    if (objc <= 0) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"Must supply a base image", -1));
+	Tcl_SetErrorCode(interp, "TTK", "IMAGE", "BASE", NULL);
+	return TCL_ERROR;
+    }
+
+    imageSpec = TtkGetImageSpec(interp, Tk_MainWindow(interp), objv[0]);
+    if (!imageSpec) {
+	return TCL_ERROR;
+    }
+
+    imageData = ckalloc(sizeof(*imageData));
+    imageData->imageSpec = imageSpec;
+    imageData->minWidth = imageData->minHeight = -1;
+    imageData->sticky = TTK_FILL_BOTH;
+    imageData->border = imageData->padding = Ttk_UniformPadding(0);
+#if TILE_07_COMPAT
+    imageData->cache = Ttk_GetResourceCache(interp);
+    imageData->imageMap = 0;
+#endif
+
+    for (i = 1; i < objc; i += 2) {
+	int option;
+
+	if (i == objc - 1) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "Value for %s missing", Tcl_GetString(objv[i])));
+	    Tcl_SetErrorCode(interp, "TTK", "IMAGE", "VALUE", NULL);
+	    goto error;
+	}
+
+#if TILE_07_COMPAT
+	if (!strcmp("-map", Tcl_GetString(objv[i]))) {
+	    imageData->imageMap = objv[i+1];
+	    Tcl_IncrRefCount(imageData->imageMap);
+	    continue;
+	}
+#endif
+
+	if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
+		sizeof(char *), "option", 0, &option) != TCL_OK) {
+	    goto error;
+	}
+
+	switch (option) {
+	    case O_BORDER:
+		if (Ttk_GetBorderFromObj(interp, objv[i+1], &imageData->border)
+			!= TCL_OK) {
+		    goto error;
+		}
+		if (!padding_specified) {
+		    imageData->padding = imageData->border;
+		}
+		break;
+	    case O_PADDING:
+		if (Ttk_GetBorderFromObj(interp, objv[i+1], &imageData->padding)
+			!= TCL_OK) { goto error; }
+		padding_specified = 1;
+		break;
+	    case O_WIDTH:
+		if (Tcl_GetIntFromObj(interp, objv[i+1], &imageData->minWidth)
+			!= TCL_OK) { goto error; }
+		break;
+	    case O_HEIGHT:
+		if (Tcl_GetIntFromObj(interp, objv[i+1], &imageData->minHeight)
+			!= TCL_OK) { goto error; }
+		break;
+	    case O_STICKY:
+		if (Ttk_GetStickyFromObj(interp, objv[i+1], &imageData->sticky)
+			!= TCL_OK) { goto error; }
+	}
+    }
+
+    if (!Ttk_RegisterElement(interp, theme, elementName, &ImageElementSpec,
+		imageData))
+    {
+	goto error;
+    }
+
+    Ttk_RegisterCleanup(interp, imageData, FreeImageData);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1));
+    return TCL_OK;
+
+error:
+    FreeImageData(imageData);
+    return TCL_ERROR;
+}
+
+MODULE_SCOPE
+void TtkImage_Init(Tcl_Interp *interp)
+{
+    Ttk_RegisterElementFactory(interp, "image", Ttk_CreateImageElement, NULL);
+}
+
+/*EOF*/

generic/ttk/ttkInit.c

@@ -0,0 +1,283 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * Ttk package: initialization routine and miscellaneous utilities.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*
+ * Legal values for the button -default option.
+ * See also: enum Ttk_ButtonDefaultState.
+ */
+const char *ttkDefaultStrings[] = {
+    "normal", "active", "disabled", NULL
+};
+
+int Ttk_GetButtonDefaultStateFromObj(
+    Tcl_Interp *interp, Tcl_Obj *objPtr, int *statePtr)
+{
+    *statePtr = TTK_BUTTON_DEFAULT_DISABLED;
+    return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkDefaultStrings,
+	    sizeof(char *), "default state", 0, statePtr);
+}
+
+/*
+ * Legal values for the -compound option.
+ * See also: enum Ttk_Compound.
+ */
+const char *ttkCompoundStrings[] = {
+    "none", "text", "image", "center",
+    "top", "bottom", "left", "right", NULL
+};
+
+int Ttk_GetCompoundFromObj(
+    Tcl_Interp *interp, Tcl_Obj *objPtr, int *statePtr)
+{
+    *statePtr = TTK_COMPOUND_NONE;
+    return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkCompoundStrings,
+	    sizeof(char *), "compound layout", 0, statePtr);
+}
+
+/*
+ * Legal values for the -orient option.
+ * See also: enum Ttk_Orient.
+ */
+const char *ttkOrientStrings[] = {
+    "horizontal", "vertical", NULL
+};
+
+int Ttk_GetOrientFromObj(
+    Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr)
+{
+    *resultPtr = TTK_ORIENT_HORIZONTAL;
+    return Tcl_GetIndexFromObjStruct(interp, objPtr, ttkOrientStrings,
+	    sizeof(char *), "orientation", 0, resultPtr);
+}
+
+/*
+ * Recognized values for the -state compatibility option.
+ * Other options are accepted and interpreted as synonyms for "normal".
+ */
+static const char *ttkStateStrings[] = {
+    "normal", "readonly", "disabled", "active", NULL
+};
+enum {
+    TTK_COMPAT_STATE_NORMAL,
+    TTK_COMPAT_STATE_READONLY,
+    TTK_COMPAT_STATE_DISABLED,
+    TTK_COMPAT_STATE_ACTIVE
+};
+
+/* TtkCheckStateOption --
+ * 	Handle -state compatibility option.
+ *
+ *	NOTE: setting -state disabled / -state enabled affects the
+ *	widget state, but the internal widget state does *not* affect
+ *	the value of the -state option.
+ *	This option is present for compatibility only.
+ */
+void TtkCheckStateOption(WidgetCore *corePtr, Tcl_Obj *objPtr)
+{
+    int stateOption = TTK_COMPAT_STATE_NORMAL;
+    unsigned all = TTK_STATE_DISABLED|TTK_STATE_READONLY|TTK_STATE_ACTIVE;
+#   define SETFLAGS(f) TtkWidgetChangeState(corePtr, f, all^f)
+
+    (void)Tcl_GetIndexFromObjStruct(NULL, objPtr, ttkStateStrings,
+	    sizeof(char *), "", 0, &stateOption);
+    switch (stateOption) {
+	case TTK_COMPAT_STATE_NORMAL:
+	default:
+	    SETFLAGS(0);
+	    break;
+	case TTK_COMPAT_STATE_READONLY:
+	    SETFLAGS(TTK_STATE_READONLY);
+	    break;
+	case TTK_COMPAT_STATE_DISABLED:
+	    SETFLAGS(TTK_STATE_DISABLED);
+	    break;
+	case TTK_COMPAT_STATE_ACTIVE:
+	    SETFLAGS(TTK_STATE_ACTIVE);
+	    break;
+    }
+#   undef SETFLAGS
+}
+
+/* TtkSendVirtualEvent --
+ * 	Send a virtual event notification to the specified target window.
+ * 	Equivalent to "event generate $tgtWindow <<$eventName>>"
+ *
+ * 	Note that we use Tk_QueueWindowEvent, not Tk_HandleEvent,
+ * 	so this routine does not reenter the interpreter.
+ */
+void TtkSendVirtualEvent(Tk_Window tgtWin, const char *eventName)
+{
+    union {XEvent general; XVirtualEvent virtual;} event;
+
+    memset(&event, 0, sizeof(event));
+    event.general.xany.type = VirtualEvent;
+    event.general.xany.serial = NextRequest(Tk_Display(tgtWin));
+    event.general.xany.send_event = False;
+    event.general.xany.window = Tk_WindowId(tgtWin);
+    event.general.xany.display = Tk_Display(tgtWin);
+    event.virtual.name = Tk_GetUid(eventName);
+
+    Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL);
+}
+
+/* TtkEnumerateOptions, TtkGetOptionValue --
+ *	Common factors for data accessor commands.
+ */
+int TtkEnumerateOptions(
+    Tcl_Interp *interp, void *recordPtr, const Tk_OptionSpec *specPtr,
+    Tk_OptionTable optionTable, Tk_Window tkwin)
+{
+    Tcl_Obj *result = Tcl_NewListObj(0,0);
+    while (specPtr->type != TK_OPTION_END)
+    {
+	Tcl_Obj *optionName = Tcl_NewStringObj(specPtr->optionName, -1);
+	Tcl_Obj *optionValue =
+	    Tk_GetOptionValue(interp,recordPtr,optionTable,optionName,tkwin);
+	if (optionValue) {
+	    Tcl_ListObjAppendElement(interp, result, optionName);
+	    Tcl_ListObjAppendElement(interp, result, optionValue);
+	}
+	++specPtr;
+
+	if (specPtr->type == TK_OPTION_END && specPtr->clientData != NULL) {
+	    /* Chain to next option spec array: */
+	    specPtr = specPtr->clientData;
+	}
+    }
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+int TtkGetOptionValue(
+    Tcl_Interp *interp, void *recordPtr, Tcl_Obj *optionName,
+    Tk_OptionTable optionTable, Tk_Window tkwin)
+{
+    Tcl_Obj *result =
+	Tk_GetOptionValue(interp,recordPtr,optionTable,optionName,tkwin);
+    if (result) {
+	Tcl_SetObjResult(interp, result);
+	return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+
+/*------------------------------------------------------------------------
+ * Core Option specifications:
+ * type name dbName dbClass default objOffset intOffset flags clientData mask
+ */
+
+/* public */
+Tk_OptionSpec ttkCoreOptionSpecs[] =
+{
+    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", NULL,
+	Tk_Offset(WidgetCore, cursorObj), -1, TK_OPTION_NULL_OK,0,0 },
+    {TK_OPTION_STRING, "-style", "style", "Style", "",
+	Tk_Offset(WidgetCore,styleObj), -1, 0,0,STYLE_CHANGED},
+    {TK_OPTION_STRING, "-class", "", "", NULL,
+	Tk_Offset(WidgetCore,classObj), -1, 0,0,READONLY_OPTION},
+    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0}
+};
+
+/*------------------------------------------------------------------------
+ * +++ Initialization: elements and element factories.
+ */
+
+extern void TtkElements_Init(Tcl_Interp *);
+extern void TtkLabel_Init(Tcl_Interp *);
+extern void TtkImage_Init(Tcl_Interp *);
+
+static void RegisterElements(Tcl_Interp *interp)
+{
+    TtkElements_Init(interp);
+    TtkLabel_Init(interp);
+    TtkImage_Init(interp);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization: Widget definitions.
+ */
+
+extern void TtkButton_Init(Tcl_Interp *);
+extern void TtkEntry_Init(Tcl_Interp *);
+extern void TtkFrame_Init(Tcl_Interp *);
+extern void TtkNotebook_Init(Tcl_Interp *);
+extern void TtkPanedwindow_Init(Tcl_Interp *);
+extern void TtkProgressbar_Init(Tcl_Interp *);
+extern void TtkScale_Init(Tcl_Interp *);
+extern void TtkScrollbar_Init(Tcl_Interp *);
+extern void TtkSeparator_Init(Tcl_Interp *);
+extern void TtkTreeview_Init(Tcl_Interp *);
+
+#ifdef TTK_SQUARE_WIDGET
+extern int TtkSquareWidget_Init(Tcl_Interp *);
+#endif
+
+static void RegisterWidgets(Tcl_Interp *interp)
+{
+    TtkButton_Init(interp);
+    TtkEntry_Init(interp);
+    TtkFrame_Init(interp);
+    TtkNotebook_Init(interp);
+    TtkPanedwindow_Init(interp);
+    TtkProgressbar_Init(interp);
+    TtkScale_Init(interp);
+    TtkScrollbar_Init(interp);
+    TtkSeparator_Init(interp);
+    TtkTreeview_Init(interp);
+#ifdef TTK_SQUARE_WIDGET
+    TtkSquareWidget_Init(interp);
+#endif
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization: Built-in themes.
+ */
+
+extern int TtkAltTheme_Init(Tcl_Interp *);
+extern int TtkClassicTheme_Init(Tcl_Interp *);
+extern int TtkClamTheme_Init(Tcl_Interp *);
+
+static void RegisterThemes(Tcl_Interp *interp)
+{
+
+    TtkAltTheme_Init(interp);
+    TtkClassicTheme_Init(interp);
+    TtkClamTheme_Init(interp);
+}
+
+/*
+ * Ttk initialization.
+ */
+
+extern const TtkStubs ttkStubs;
+
+MODULE_SCOPE int
+Ttk_Init(Tcl_Interp *interp)
+{
+    /*
+     * This will be run for both safe and regular interp init.
+     * Use Tcl_IsSafe if necessary to not initialize unsafe bits.
+     */
+    Ttk_StylePkgInit(interp);
+
+    RegisterElements(interp);
+    RegisterWidgets(interp);
+    RegisterThemes(interp);
+
+    Ttk_PlatformInit(interp);
+
+    Tcl_PkgProvideEx(interp, "Ttk", TTK_PATCH_LEVEL, (ClientData)&ttkStubs);
+
+    return TCL_OK;
+}
+
+/*EOF*/

generic/ttk/ttkLabel.c

@@ -0,0 +1,698 @@
+/*
+ * text, image, and label elements.
+ *
+ * The label element combines text and image elements,
+ * with layout determined by the "-compound" option.
+ *
+ */
+
+#include <tcl.h>
+#include <tkInt.h>
+#include "ttkTheme.h"
+
+/*----------------------------------------------------------------------
+ * +++ Text element.
+ *
+ * This element displays a textual label in the foreground color.
+ *
+ * Optionally underlines the mnemonic character if the -underline resource
+ * is present and >= 0.
+ */
+
+typedef struct {
+    /*
+     * Element options:
+     */
+    Tcl_Obj	*textObj;
+    Tcl_Obj	*fontObj;
+    Tcl_Obj	*foregroundObj;
+    Tcl_Obj	*underlineObj;
+    Tcl_Obj	*widthObj;
+    Tcl_Obj	*anchorObj;
+    Tcl_Obj	*justifyObj;
+    Tcl_Obj	*wrapLengthObj;
+    Tcl_Obj     *embossedObj;
+
+    /*
+     * Computed resources:
+     */
+    Tk_Font		tkfont;
+    Tk_TextLayout	textLayout;
+    int 		width;
+    int 		height;
+    int			embossed;
+
+} TextElement;
+
+/* Text element options table.
+ * NB: Keep in sync with label element option table.
+ */
+static Ttk_ElementOptionSpec TextElementOptions[] = {
+    { "-text", TK_OPTION_STRING,
+	Tk_Offset(TextElement,textObj), "" },
+    { "-font", TK_OPTION_FONT,
+	Tk_Offset(TextElement,fontObj), DEFAULT_FONT },
+    { "-foreground", TK_OPTION_COLOR,
+	Tk_Offset(TextElement,foregroundObj), "black" },
+    { "-underline", TK_OPTION_INT,
+	Tk_Offset(TextElement,underlineObj), "-1"},
+    { "-width", TK_OPTION_INT,
+	Tk_Offset(TextElement,widthObj), "-1"},
+    { "-anchor", TK_OPTION_ANCHOR,
+	Tk_Offset(TextElement,anchorObj), "w"},
+    { "-justify", TK_OPTION_JUSTIFY,
+	Tk_Offset(TextElement,justifyObj), "left" },
+    { "-wraplength", TK_OPTION_PIXELS,
+	Tk_Offset(TextElement,wrapLengthObj), "0" },
+    { "-embossed", TK_OPTION_INT,
+	Tk_Offset(TextElement,embossedObj), "0"},
+    { NULL, 0, 0, NULL }
+};
+
+static int TextSetup(TextElement *text, Tk_Window tkwin)
+{
+    const char *string = Tcl_GetString(text->textObj);
+    Tk_Justify justify = TK_JUSTIFY_LEFT;
+    int wrapLength = 0;
+
+    text->tkfont = Tk_GetFontFromObj(tkwin, text->fontObj);
+    Tk_GetJustifyFromObj(NULL, text->justifyObj, &justify);
+    Tk_GetPixelsFromObj(NULL, tkwin, text->wrapLengthObj, &wrapLength);
+    Tcl_GetBooleanFromObj(NULL, text->embossedObj, &text->embossed);
+
+    text->textLayout = Tk_ComputeTextLayout(
+	    text->tkfont, string, -1/*numChars*/, wrapLength, justify,
+	    0/*flags*/, &text->width, &text->height);
+
+    return 1;
+}
+
+/*
+ * TextReqWidth -- compute the requested width of a text element.
+ *
+ * If -width is positive, use that as the width
+ * If -width is negative, use that as the minimum width
+ * If not specified or empty, use the natural size of the text
+ */
+
+static int TextReqWidth(TextElement *text)
+{
+    int reqWidth;
+
+    if (   text->widthObj
+	&& Tcl_GetIntFromObj(NULL, text->widthObj, &reqWidth) == TCL_OK)
+    {
+	int avgWidth = Tk_TextWidth(text->tkfont, "0", 1);
+	if (reqWidth <= 0) {
+	    int specWidth = avgWidth * -reqWidth;
+	    if (specWidth > text->width)
+		return specWidth;
+	} else {
+	    return avgWidth * reqWidth;
+	}
+    }
+    return text->width;
+}
+
+static void TextCleanup(TextElement *text)
+{
+    Tk_FreeTextLayout(text->textLayout);
+}
+
+/*
+ * TextDraw --
+ * 	Draw a text element.
+ * 	Called by TextElementDraw() and LabelElementDraw().
+ */
+static void TextDraw(TextElement *text, Tk_Window tkwin, Drawable d, Ttk_Box b)
+{
+    XColor *color = Tk_GetColorFromObj(tkwin, text->foregroundObj);
+    int underline = -1;
+    XGCValues gcValues;
+    GC gc1, gc2;
+    Tk_Anchor anchor = TK_ANCHOR_CENTER;
+    TkRegion clipRegion = NULL;
+
+    gcValues.font = Tk_FontId(text->tkfont);
+    gcValues.foreground = color->pixel;
+    gc1 = Tk_GetGC(tkwin, GCFont | GCForeground, &gcValues);
+    gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin));
+    gc2 = Tk_GetGC(tkwin, GCFont | GCForeground, &gcValues);
+
+    /* 
+     * Place text according to -anchor:
+     */
+    Tk_GetAnchorFromObj(NULL, text->anchorObj, &anchor);
+    b = Ttk_AnchorBox(b, text->width, text->height, anchor);
+
+    /*
+     * Clip text if it's too wide:
+     */
+    if (b.width < text->width) {
+	XRectangle rect;
+
+	clipRegion = TkCreateRegion();
+	rect.x = b.x;
+	rect.y = b.y;
+	rect.width = b.width + (text->embossed ? 1 : 0);
+	rect.height = b.height + (text->embossed ? 1 : 0);
+	TkUnionRectWithRegion(&rect, clipRegion, clipRegion);
+	TkSetRegion(Tk_Display(tkwin), gc1, clipRegion);
+	TkSetRegion(Tk_Display(tkwin), gc2, clipRegion);
+#ifdef HAVE_XFT
+	TkUnixSetXftClipRegion(clipRegion);
+#endif
+    }
+
+    if (text->embossed) {
+	Tk_DrawTextLayout(Tk_Display(tkwin), d, gc2,
+	    text->textLayout, b.x+1, b.y+1, 0/*firstChar*/, -1/*lastChar*/);
+    }
+    Tk_DrawTextLayout(Tk_Display(tkwin), d, gc1,
+	    text->textLayout, b.x, b.y, 0/*firstChar*/, -1/*lastChar*/);
+
+    Tcl_GetIntFromObj(NULL, text->underlineObj, &underline);
+    if (underline >= 0) {
+	if (text->embossed) {
+	    Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc2,
+		text->textLayout, b.x+1, b.y+1, underline);
+	}
+	Tk_UnderlineTextLayout(Tk_Display(tkwin), d, gc1,
+	    text->textLayout, b.x, b.y, underline);
+    }
+
+    if (clipRegion != NULL) {
+#ifdef HAVE_XFT
+	TkUnixSetXftClipRegion(None);
+#endif
+	XSetClipMask(Tk_Display(tkwin), gc1, None);
+	XSetClipMask(Tk_Display(tkwin), gc2, None);
+	TkDestroyRegion(clipRegion);
+    }
+    Tk_FreeGC(Tk_Display(tkwin), gc1);
+    Tk_FreeGC(Tk_Display(tkwin), gc2);
+}
+
+static void TextElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    TextElement *text = elementRecord;
+
+    if (!TextSetup(text, tkwin))
+	return;
+
+    *heightPtr = text->height;
+    *widthPtr = TextReqWidth(text);
+
+    TextCleanup(text);
+
+    return;
+}
+
+static void TextElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, Ttk_State state)
+{
+    TextElement *text = elementRecord;
+    if (TextSetup(text, tkwin)) {
+	TextDraw(text, tkwin, d, b);
+	TextCleanup(text);
+    }
+}
+
+static Ttk_ElementSpec TextElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(TextElement),
+    TextElementOptions,
+    TextElementSize,
+    TextElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Image element.
+ * Draws an image.
+ */
+
+typedef struct {
+    Tcl_Obj	*imageObj;
+    Tcl_Obj 	*stippleObj;	/* For TTK_STATE_DISABLED */
+    Tcl_Obj 	*backgroundObj;	/* " " */
+
+    Ttk_ImageSpec *imageSpec;
+    Tk_Image	tkimg;
+    int 	width;
+    int		height;
+} ImageElement;
+
+/* ===> NB: Keep in sync with label element option table.  <===
+ */
+static Ttk_ElementOptionSpec ImageElementOptions[] = {
+    { "-image", TK_OPTION_STRING,
+	Tk_Offset(ImageElement,imageObj), "" },
+    { "-stipple", TK_OPTION_STRING, 	/* Really: TK_OPTION_BITMAP */
+	Tk_Offset(ImageElement,stippleObj), "gray50" },
+    { "-background", TK_OPTION_COLOR,
+	Tk_Offset(ImageElement,backgroundObj), DEFAULT_BACKGROUND },
+    { NULL, 0, 0, NULL }
+};
+
+/*
+ * ImageSetup() --
+ * 	Look up the Tk_Image from the image element's imageObj resource.
+ * 	Caller must release the image with ImageCleanup().
+ *
+ * Returns:
+ * 	1 if successful, 0 if there was an error (unreported)
+ * 	or the image resource was not specified.
+ */
+
+static int ImageSetup(
+    ImageElement *image, Tk_Window tkwin, Ttk_State state)
+{
+
+    if (!image->imageObj) {
+	return 0;
+    }
+    image->imageSpec = TtkGetImageSpec(NULL, tkwin, image->imageObj);
+    if (!image->imageSpec) {
+	return 0;
+    }
+    image->tkimg = TtkSelectImage(image->imageSpec, state);
+    if (!image->tkimg) {
+	TtkFreeImageSpec(image->imageSpec);
+	return 0;
+    }
+    Tk_SizeOfImage(image->tkimg, &image->width, &image->height);
+
+    return 1;
+}
+
+static void ImageCleanup(ImageElement *image)
+{
+    TtkFreeImageSpec(image->imageSpec);
+}
+
+#ifndef MAC_OSX_TK
+/*
+ * StippleOver --
+ * 	Draw a stipple over the image area, to make it look "grayed-out"
+ * 	when TTK_STATE_DISABLED is set.
+ */
+static void StippleOver(
+    ImageElement *image, Tk_Window tkwin, Drawable d, int x, int y)
+{
+    Pixmap stipple = Tk_AllocBitmapFromObj(NULL, tkwin, image->stippleObj);
+    XColor *color = Tk_GetColorFromObj(tkwin, image->backgroundObj);
+
+    if (stipple != None) {
+	unsigned long mask = GCFillStyle | GCStipple | GCForeground;
+	XGCValues gcvalues;
+	GC gc;
+	gcvalues.foreground = color->pixel;
+	gcvalues.fill_style = FillStippled;
+	gcvalues.stipple = stipple;
+	gc = Tk_GetGC(tkwin, mask, &gcvalues);
+	XFillRectangle(Tk_Display(tkwin),d,gc,x,y,image->width,image->height);
+	Tk_FreeGC(Tk_Display(tkwin), gc);
+	Tk_FreeBitmapFromObj(tkwin, image->stippleObj);
+    }
+}
+#endif
+
+static void ImageDraw(
+    ImageElement *image, Tk_Window tkwin,Drawable d,Ttk_Box b,Ttk_State state)
+{
+    int width = image->width, height = image->height;
+
+    /* Clip width and height to remain within window bounds:
+     */
+    if (b.x + width > Tk_Width(tkwin)) {
+	width = Tk_Width(tkwin) - b.x;
+    }
+    if (b.y + height > Tk_Height(tkwin)) {
+	height = Tk_Height(tkwin) - b.y;
+    }
+
+    if (height <= 0 || width <= 0) {
+	/* Completely clipped - bail out.
+	 */
+	return;
+    }
+
+    Tk_RedrawImage(image->tkimg, 0,0, width, height, d, b.x, b.y);
+
+    /* If we're disabled there's no state-specific 'disabled' image, 
+     * stipple the image.
+     * @@@ Possibly: Don't do disabled-stippling at all;
+     * @@@ it's ugly and out of fashion.
+     * Do not stipple at all under Aqua, just draw the image: it shows up 
+     * as a white rectangle otherwise.
+     */
+
+    
+    if (state & TTK_STATE_DISABLED) {
+	if (TtkSelectImage(image->imageSpec, 0ul) == image->tkimg) {
+#ifndef MAC_OSX_TK
+	    StippleOver(image, tkwin, d, b.x,b.y);
+#endif
+	}
+    }
+}
+
+static void ImageElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    ImageElement *image = elementRecord;
+
+    if (ImageSetup(image, tkwin, 0)) {
+	*widthPtr = image->width;
+	*heightPtr = image->height;
+	ImageCleanup(image);
+    }
+}
+
+static void ImageElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, Ttk_State state)
+{
+    ImageElement *image = elementRecord;
+
+    if (ImageSetup(image, tkwin, state)) {
+	ImageDraw(image, tkwin, d, b, state);
+	ImageCleanup(image);
+    }
+}
+
+static Ttk_ElementSpec ImageElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(ImageElement),
+    ImageElementOptions,
+    ImageElementSize,
+    ImageElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Label element.
+ *
+ * Displays an image and/or text, as determined by the -compound option.
+ *
+ * Differences from Tk 8.4 compound elements:
+ *
+ * This adds two new values for the -compound option, "text"
+ * and "image".  (This is useful for configuring toolbars to
+ * display icons, text and icons, or text only, as found in
+ * many browsers.)
+ *
+ * "-compound none" is supported, but I'd like to get rid of it;
+ * it makes the logic more complex, and the only benefit is
+ * backwards compatibility with Tk < 8.3.0 scripts.
+ *
+ * This adds a new resource, -space, for determining how much
+ * space to leave between the text and image; Tk 8.4 reuses the
+ * -padx or -pady option for this purpose.
+ *
+ * -width always specifies the length in characters of the text part;
+ *  in Tk 8.4 it's either characters or pixels, depending on the
+ *  value of -compound.
+ *
+ * Negative values of -width are interpreted as a minimum width
+ * on all platforms, not just on Windows.
+ *
+ * Tk 8.4 ignores -padx and -pady if -compound is set to "none".
+ * Here, padding is handled by a different element.
+ */
+
+typedef struct {
+    /*
+     * Element options:
+     */
+    Tcl_Obj		*compoundObj;
+    Tcl_Obj		*spaceObj;
+    TextElement 	text;
+    ImageElement	image;
+
+    /*
+     * Computed values (see LabelSetup)
+     */
+    Ttk_Compound	compound;
+    int  		space;
+    int 		totalWidth, totalHeight;
+} LabelElement;
+
+static Ttk_ElementOptionSpec LabelElementOptions[] = {
+    { "-compound", TK_OPTION_ANY,
+	Tk_Offset(LabelElement,compoundObj), "none" },
+    { "-space", TK_OPTION_PIXELS,
+	Tk_Offset(LabelElement,spaceObj), "4" },
+
+    /* Text element part:
+     * NB: Keep in sync with TextElementOptions.
+     */
+    { "-text", TK_OPTION_STRING,
+	Tk_Offset(LabelElement,text.textObj), "" },
+    { "-font", TK_OPTION_FONT,
+	Tk_Offset(LabelElement,text.fontObj), DEFAULT_FONT },
+    { "-foreground", TK_OPTION_COLOR,
+	Tk_Offset(LabelElement,text.foregroundObj), "black" },
+    { "-underline", TK_OPTION_INT,
+	Tk_Offset(LabelElement,text.underlineObj), "-1"},
+    { "-width", TK_OPTION_INT,
+	Tk_Offset(LabelElement,text.widthObj), ""},
+    { "-anchor", TK_OPTION_ANCHOR,
+	Tk_Offset(LabelElement,text.anchorObj), "w"},
+    { "-justify", TK_OPTION_JUSTIFY,
+	Tk_Offset(LabelElement,text.justifyObj), "left" },
+    { "-wraplength", TK_OPTION_PIXELS,
+	Tk_Offset(LabelElement,text.wrapLengthObj), "0" },
+    { "-embossed", TK_OPTION_INT,
+	Tk_Offset(LabelElement,text.embossedObj), "0"},
+
+    /* Image element part:
+     * NB: Keep in sync with ImageElementOptions.
+     */
+    { "-image", TK_OPTION_STRING,
+	Tk_Offset(LabelElement,image.imageObj), "" },
+    { "-stipple", TK_OPTION_STRING, 	/* Really: TK_OPTION_BITMAP */
+	Tk_Offset(LabelElement,image.stippleObj), "gray50" },
+    { "-background", TK_OPTION_COLOR,
+	Tk_Offset(LabelElement,image.backgroundObj), DEFAULT_BACKGROUND },
+    { NULL, 0, 0, NULL }
+};
+
+/*
+ * LabelSetup --
+ * 	Fills in computed fields of the label element.
+ *
+ * 	Calculate the text, image, and total width and height.
+ */
+
+#undef  MAX
+#define MAX(a,b) ((a) > (b) ? a : b);
+static void LabelSetup(
+    LabelElement *c, Tk_Window tkwin, Ttk_State state)
+{
+    Ttk_Compound *compoundPtr = &c->compound;
+
+    Tk_GetPixelsFromObj(NULL,tkwin,c->spaceObj,&c->space);
+    Ttk_GetCompoundFromObj(NULL,c->compoundObj,(int*)compoundPtr);
+
+    /*
+     * Deal with TTK_COMPOUND_NONE.
+     */
+    if (c->compound == TTK_COMPOUND_NONE) {
+	if (ImageSetup(&c->image, tkwin, state)) {
+	    c->compound = TTK_COMPOUND_IMAGE;
+	} else {
+	    c->compound = TTK_COMPOUND_TEXT;
+	}
+    } else if (c->compound != TTK_COMPOUND_TEXT) {
+    	if (!ImageSetup(&c->image, tkwin, state)) {
+	    c->compound = TTK_COMPOUND_TEXT;
+	}
+    }
+    if (c->compound != TTK_COMPOUND_IMAGE)
+	TextSetup(&c->text, tkwin);
+
+    /*
+     * ASSERT:
+     * if c->compound != IMAGE, then TextSetup() has been called
+     * if c->compound != TEXT, then ImageSetup() has returned successfully
+     * c->compound != COMPOUND_NONE.
+     */
+
+    switch (c->compound)
+    {
+	case TTK_COMPOUND_NONE:
+	    /* Can't happen */
+	    break;
+	case TTK_COMPOUND_TEXT:
+	    c->totalWidth  = c->text.width;
+	    c->totalHeight = c->text.height;
+	    break;
+	case TTK_COMPOUND_IMAGE:
+	    c->totalWidth  = c->image.width;
+	    c->totalHeight = c->image.height;
+	    break;
+	case TTK_COMPOUND_CENTER:
+	    c->totalWidth  = MAX(c->image.width, c->text.width);
+	    c->totalHeight = MAX(c->image.height, c->text.height);
+	    break;
+	case TTK_COMPOUND_TOP:
+	case TTK_COMPOUND_BOTTOM:
+	    c->totalWidth  = MAX(c->image.width, c->text.width);
+	    c->totalHeight = c->image.height + c->text.height + c->space;
+	    break;
+
+	case TTK_COMPOUND_LEFT:
+	case TTK_COMPOUND_RIGHT:
+	    c->totalWidth  = c->image.width + c->text.width + c->space;
+	    c->totalHeight = MAX(c->image.height, c->text.height);
+	    break;
+    }
+}
+
+static void LabelCleanup(LabelElement *c)
+{
+    if (c->compound != TTK_COMPOUND_TEXT)
+	ImageCleanup(&c->image);
+    if (c->compound != TTK_COMPOUND_IMAGE)
+	TextCleanup(&c->text);
+}
+
+static void LabelElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    LabelElement *label = elementRecord;
+    int textReqWidth = 0;
+
+    LabelSetup(label, tkwin, 0);
+
+    *heightPtr = label->totalHeight;
+
+    /* Requested width based on -width option, not actual text width:
+     */
+    if (label->compound != TTK_COMPOUND_IMAGE)
+	textReqWidth = TextReqWidth(&label->text);
+
+    switch (label->compound) 
+    {
+	case TTK_COMPOUND_TEXT:
+	    *widthPtr = textReqWidth;
+	    break;
+	case TTK_COMPOUND_IMAGE:
+	    *widthPtr = label->image.width;
+	    break;
+	case TTK_COMPOUND_TOP:
+	case TTK_COMPOUND_BOTTOM:
+	case TTK_COMPOUND_CENTER:
+	    *widthPtr = MAX(label->image.width, textReqWidth); 
+	    break;
+	case TTK_COMPOUND_LEFT:
+	case TTK_COMPOUND_RIGHT:
+	    *widthPtr = label->image.width + textReqWidth + label->space; 
+	    break;
+	case TTK_COMPOUND_NONE:
+	    break; /* Can't happen */
+    }
+
+    LabelCleanup(label);
+}
+
+/*
+ * DrawCompound --
+ * 	Helper routine for LabelElementDraw;
+ * 	Handles layout for -compound {left,right,top,bottom}
+ */
+static void DrawCompound(
+    LabelElement *l, Ttk_Box b, Tk_Window tkwin, Drawable d, Ttk_State state,
+    int imageSide, int textSide)
+{
+    Ttk_Box imageBox =
+	Ttk_PlaceBox(&b, l->image.width, l->image.height, imageSide, 0);
+    Ttk_Box textBox =
+	Ttk_PlaceBox(&b, l->text.width, l->text.height, textSide, 0);
+    ImageDraw(&l->image,tkwin,d,imageBox,state);
+    TextDraw(&l->text,tkwin,d,textBox);
+}
+
+static void LabelElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, Ttk_State state)
+{
+    LabelElement *l = elementRecord;
+    Tk_Anchor anchor = TK_ANCHOR_CENTER;
+
+    LabelSetup(l, tkwin, state);
+
+    /*
+     * Adjust overall parcel based on -anchor:
+     */
+    Tk_GetAnchorFromObj(NULL, l->text.anchorObj, &anchor);
+    b = Ttk_AnchorBox(b, l->totalWidth, l->totalHeight, anchor);
+
+    /*
+     * Draw text and/or image parts based on -compound:
+     */
+    switch (l->compound)
+    {
+	case TTK_COMPOUND_NONE:
+	    /* Can't happen */
+	    break;
+	case TTK_COMPOUND_TEXT:
+	    TextDraw(&l->text,tkwin,d,b);
+	    break;
+	case TTK_COMPOUND_IMAGE:
+	    ImageDraw(&l->image,tkwin,d,b,state);
+	    break;
+	case TTK_COMPOUND_CENTER:
+	{
+	    Ttk_Box pb = Ttk_AnchorBox(
+		b, l->image.width, l->image.height, TK_ANCHOR_CENTER);
+	    ImageDraw(&l->image, tkwin, d, pb, state);
+	    pb = Ttk_AnchorBox(
+		b, l->text.width, l->text.height, TK_ANCHOR_CENTER);
+	    TextDraw(&l->text, tkwin, d, pb);
+	    break;
+	}
+	case TTK_COMPOUND_TOP:
+	    DrawCompound(l, b, tkwin, d, state, TTK_SIDE_TOP, TTK_SIDE_BOTTOM);
+	    break;
+	case TTK_COMPOUND_BOTTOM:
+	    DrawCompound(l, b, tkwin, d, state, TTK_SIDE_BOTTOM, TTK_SIDE_TOP);
+	    break;
+	case TTK_COMPOUND_LEFT:
+	    DrawCompound(l, b, tkwin, d, state, TTK_SIDE_LEFT, TTK_SIDE_RIGHT);
+	    break;
+	case TTK_COMPOUND_RIGHT:
+	    DrawCompound(l, b, tkwin, d, state, TTK_SIDE_RIGHT, TTK_SIDE_LEFT);
+	    break;
+    }
+
+    LabelCleanup(l);
+}
+
+static Ttk_ElementSpec LabelElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(LabelElement),
+    LabelElementOptions,
+    LabelElementSize,
+    LabelElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE
+void TtkLabel_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme =  Ttk_GetDefaultTheme(interp);
+
+    Ttk_RegisterElement(interp, theme, "text", &TextElementSpec, NULL);
+    Ttk_RegisterElement(interp, theme, "image", &ImageElementSpec, NULL);
+    Ttk_RegisterElement(interp, theme, "label", &LabelElementSpec, NULL);
+}
+

generic/ttk/ttkManager.c

@@ -0,0 +1,549 @@
+/*
+ * Copyright 2005, Joe English.  Freely redistributable.
+ *
+ * Support routines for geometry managers.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkManager.h"
+
+/*------------------------------------------------------------------------
+ * +++ The Geometry Propagation Dance.
+ *
+ * When a slave window requests a new size or some other parameter changes,
+ * the manager recomputes the required size for the master window and calls
+ * Tk_GeometryRequest().  This is scheduled as an idle handler so multiple
+ * updates can be processed as a single batch.
+ *
+ * If all goes well, the master's manager will process the request
+ * (and so on up the chain to the toplevel window), and the master
+ * window will eventually receive a <Configure> event.  At this point
+ * it recomputes the size and position of all slaves and places them.
+ *
+ * If all does not go well, however, the master's request may be ignored
+ * (typically because the top-level window has a fixed, user-specified size).
+ * Tk doesn't provide any notification when this happens; to account for this,
+ * we also schedule an idle handler to call the layout procedure
+ * after making a geometry request.
+ *
+ * +++ Slave removal <<NOTE-LOSTSLAVE>>.
+ *
+ * There are three conditions under which a slave is removed:
+ *
+ * (1) Another GM claims control
+ * (2) Manager voluntarily relinquishes control
+ * (3) Slave is destroyed
+ *
+ * In case (1), Tk calls the manager's lostSlaveProc.
+ * Case (2) is performed by calling Tk_ManageGeometry(slave,NULL,0);
+ * in this case Tk does _not_ call the LostSlaveProc (documented behavior).
+ * Tk doesn't handle case (3) either; to account for that we
+ * register an event handler on the slave widget to track <Destroy> events.
+ */
+
+/* ++ Data structures.
+ */
+typedef struct
+{
+    Tk_Window 		slaveWindow;
+    Ttk_Manager 	*manager;
+    void 		*slaveData;
+    unsigned		flags;
+} Ttk_Slave;
+
+/* slave->flags bits:
+ */
+#define SLAVE_MAPPED 		0x1	/* slave to be mapped when master is */
+
+struct TtkManager_
+{
+    Ttk_ManagerSpec	*managerSpec;
+    void 		*managerData;
+    Tk_Window   	masterWindow;
+    unsigned		flags;
+    int 	 	nSlaves;
+    Ttk_Slave 		**slaves;
+};
+
+/* manager->flags bits:
+ */
+#define MGR_UPDATE_PENDING	0x1
+#define MGR_RESIZE_REQUIRED	0x2
+#define MGR_RELAYOUT_REQUIRED	0x4
+
+static void ManagerIdleProc(void *);	/* forward */
+
+/* ++ ScheduleUpdate --
+ * 	Schedule a call to recompute the size and/or layout,
+ *	depending on flags.
+ */
+static void ScheduleUpdate(Ttk_Manager *mgr, unsigned flags)
+{
+    if (!(mgr->flags & MGR_UPDATE_PENDING)) {
+	Tcl_DoWhenIdle(ManagerIdleProc, mgr);
+	mgr->flags |= MGR_UPDATE_PENDING;
+    }
+    mgr->flags |= flags;
+}
+
+/* ++ RecomputeSize --
+ * 	Recomputes the required size of the master window,
+ * 	makes geometry request.
+ */
+static void RecomputeSize(Ttk_Manager *mgr)
+{
+    int width = 1, height = 1;
+
+    if (mgr->managerSpec->RequestedSize(mgr->managerData, &width, &height)) {
+	Tk_GeometryRequest(mgr->masterWindow, width, height);
+	ScheduleUpdate(mgr, MGR_RELAYOUT_REQUIRED);
+    }
+    mgr->flags &= ~MGR_RESIZE_REQUIRED;
+}
+
+/* ++ RecomputeLayout --
+ * 	Recompute geometry of all slaves.
+ */
+static void RecomputeLayout(Ttk_Manager *mgr)
+{
+    mgr->managerSpec->PlaceSlaves(mgr->managerData);
+    mgr->flags &= ~MGR_RELAYOUT_REQUIRED;
+}
+
+/* ++ ManagerIdleProc --
+ * 	DoWhenIdle procedure for deferred updates.
+ */
+static void ManagerIdleProc(ClientData clientData)
+{
+    Ttk_Manager *mgr = clientData;
+    mgr->flags &= ~MGR_UPDATE_PENDING;
+
+    if (mgr->flags & MGR_RESIZE_REQUIRED) {
+	RecomputeSize(mgr);
+    }
+    if (mgr->flags & MGR_RELAYOUT_REQUIRED) {
+	if (mgr->flags & MGR_UPDATE_PENDING) {
+	    /* RecomputeSize has scheduled another update; relayout later */
+	    return;
+	}
+	RecomputeLayout(mgr);
+    }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Event handlers.
+ */
+
+/* ++ ManagerEventHandler --
+ * 	Recompute slave layout when master widget is resized.
+ * 	Keep the slave's map state in sync with the master's.
+ */
+static const int ManagerEventMask = StructureNotifyMask;
+static void ManagerEventHandler(ClientData clientData, XEvent *eventPtr)
+{
+    Ttk_Manager *mgr = clientData;
+    int i;
+
+    switch (eventPtr->type)
+    {
+	case ConfigureNotify:
+	    RecomputeLayout(mgr);
+	    break;
+	case MapNotify:
+	    for (i = 0; i < mgr->nSlaves; ++i) {
+		Ttk_Slave *slave = mgr->slaves[i];
+		if (slave->flags & SLAVE_MAPPED) {
+		    Tk_MapWindow(slave->slaveWindow);
+		}
+	    }
+	    break;
+	case UnmapNotify:
+	    for (i = 0; i < mgr->nSlaves; ++i) {
+		Ttk_Slave *slave = mgr->slaves[i];
+		Tk_UnmapWindow(slave->slaveWindow);
+	    }
+	    break;
+    }
+}
+
+/* ++ SlaveEventHandler --
+ * 	Notifies manager when a slave is destroyed
+ * 	(see <<NOTE-LOSTSLAVE>>).
+ */
+static const unsigned SlaveEventMask = StructureNotifyMask;
+static void SlaveEventHandler(ClientData clientData, XEvent *eventPtr)
+{
+    Ttk_Slave *slave = clientData;
+    if (eventPtr->type == DestroyNotify) {
+	slave->manager->managerSpec->tkGeomMgr.lostSlaveProc(
+	    slave->manager, slave->slaveWindow);
+    }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Slave initialization and cleanup.
+ */
+
+static Ttk_Slave *NewSlave(
+    Ttk_Manager *mgr, Tk_Window slaveWindow, void *slaveData)
+{
+    Ttk_Slave *slave = ckalloc(sizeof(*slave));
+
+    slave->slaveWindow = slaveWindow;
+    slave->manager = mgr;
+    slave->flags = 0;
+    slave->slaveData = slaveData;
+
+    return slave;
+}
+
+static void DeleteSlave(Ttk_Slave *slave)
+{
+    ckfree(slave);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Manager initialization and cleanup.
+ */
+
+Ttk_Manager *Ttk_CreateManager(
+    Ttk_ManagerSpec *managerSpec, void *managerData, Tk_Window masterWindow)
+{
+    Ttk_Manager *mgr = ckalloc(sizeof(*mgr));
+
+    mgr->managerSpec 	= managerSpec;
+    mgr->managerData	= managerData;
+    mgr->masterWindow	= masterWindow;
+    mgr->nSlaves 	= 0;
+    mgr->slaves 	= NULL;
+    mgr->flags  	= 0;
+
+    Tk_CreateEventHandler(
+	mgr->masterWindow, ManagerEventMask, ManagerEventHandler, mgr);
+
+    return mgr;
+}
+
+void Ttk_DeleteManager(Ttk_Manager *mgr)
+{
+    Tk_DeleteEventHandler(
+	mgr->masterWindow, ManagerEventMask, ManagerEventHandler, mgr);
+
+    while (mgr->nSlaves > 0) {
+	Ttk_ForgetSlave(mgr, mgr->nSlaves - 1);
+    }
+    if (mgr->slaves) {
+	ckfree(mgr->slaves);
+    }
+
+    Tcl_CancelIdleCall(ManagerIdleProc, mgr);
+
+    ckfree(mgr);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Slave management.
+ */
+
+/* ++ InsertSlave --
+ * 	Adds slave to the list of managed windows.
+ */
+static void InsertSlave(Ttk_Manager *mgr, Ttk_Slave *slave, int index)
+{
+    int endIndex = mgr->nSlaves++;
+    mgr->slaves = ckrealloc(mgr->slaves, mgr->nSlaves * sizeof(Ttk_Slave *));
+
+    while (endIndex > index) {
+	mgr->slaves[endIndex] = mgr->slaves[endIndex - 1];
+	--endIndex;
+    }
+
+    mgr->slaves[index] = slave;
+
+    Tk_ManageGeometry(slave->slaveWindow,
+	&mgr->managerSpec->tkGeomMgr, (ClientData)mgr);
+
+    Tk_CreateEventHandler(slave->slaveWindow,
+	SlaveEventMask, SlaveEventHandler, (ClientData)slave);
+
+    ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+}
+
+/* RemoveSlave --
+ * 	Unmanage and delete the slave.
+ *
+ * NOTES/ASSUMPTIONS:
+ *
+ * [1] It's safe to call Tk_UnmapWindow / Tk_UnmaintainGeometry even if this
+ * routine is called from the slave's DestroyNotify event handler.
+ */
+static void RemoveSlave(Ttk_Manager *mgr, int index)
+{
+    Ttk_Slave *slave = mgr->slaves[index];
+    int i;
+
+    /* Notify manager:
+     */
+    mgr->managerSpec->SlaveRemoved(mgr->managerData, index);
+
+    /* Remove from array:
+     */
+    --mgr->nSlaves;
+    for (i = index ; i < mgr->nSlaves; ++i) {
+	mgr->slaves[i] = mgr->slaves[i+1];
+    }
+
+    /* Clean up:
+     */
+    Tk_DeleteEventHandler(
+	slave->slaveWindow, SlaveEventMask, SlaveEventHandler, slave);
+
+    /* Note [1] */
+    Tk_UnmaintainGeometry(slave->slaveWindow, mgr->masterWindow);
+    Tk_UnmapWindow(slave->slaveWindow);
+
+    DeleteSlave(slave);
+
+    ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tk_GeomMgr hooks.
+ */
+
+void Ttk_GeometryRequestProc(ClientData clientData, Tk_Window slaveWindow)
+{
+    Ttk_Manager *mgr = clientData;
+    int slaveIndex = Ttk_SlaveIndex(mgr, slaveWindow);
+    int reqWidth = Tk_ReqWidth(slaveWindow);
+    int reqHeight= Tk_ReqHeight(slaveWindow);
+
+    if (mgr->managerSpec->SlaveRequest(
+		mgr->managerData, slaveIndex, reqWidth, reqHeight)) 
+    {
+	ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+    }
+}
+
+void Ttk_LostSlaveProc(ClientData clientData, Tk_Window slaveWindow)
+{
+    Ttk_Manager *mgr = clientData;
+    int index = Ttk_SlaveIndex(mgr, slaveWindow);
+
+    /* ASSERT: index >= 0 */
+    RemoveSlave(mgr, index);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Public API.
+ */
+
+/* ++ Ttk_InsertSlave --
+ * 	Add a new slave window at the specified index.
+ */
+void Ttk_InsertSlave(
+    Ttk_Manager *mgr, int index, Tk_Window tkwin, void *slaveData)
+{
+    Ttk_Slave *slave = NewSlave(mgr, tkwin, slaveData);
+    InsertSlave(mgr, slave, index);
+}
+
+/* ++ Ttk_ForgetSlave --
+ * 	Unmanage the specified slave.
+ */
+void Ttk_ForgetSlave(Ttk_Manager *mgr, int slaveIndex)
+{
+    Tk_Window slaveWindow = mgr->slaves[slaveIndex]->slaveWindow;
+    RemoveSlave(mgr, slaveIndex);
+    Tk_ManageGeometry(slaveWindow, NULL, 0);
+}
+
+/* ++ Ttk_PlaceSlave --
+ * 	Set the position and size of the specified slave window.
+ *
+ * NOTES:
+ * 	Contrary to documentation, Tk_MaintainGeometry doesn't always
+ * 	map the slave.
+ */
+void Ttk_PlaceSlave(
+    Ttk_Manager *mgr, int slaveIndex, int x, int y, int width, int height)
+{
+    Ttk_Slave *slave = mgr->slaves[slaveIndex];
+    Tk_MaintainGeometry(slave->slaveWindow,mgr->masterWindow,x,y,width,height);
+    slave->flags |= SLAVE_MAPPED;
+    if (Tk_IsMapped(mgr->masterWindow)) {
+	Tk_MapWindow(slave->slaveWindow);
+    }
+}
+
+/* ++ Ttk_UnmapSlave --
+ * 	Unmap the specified slave, but leave it managed.
+ */
+void Ttk_UnmapSlave(Ttk_Manager *mgr, int slaveIndex)
+{
+    Ttk_Slave *slave = mgr->slaves[slaveIndex];
+    Tk_UnmaintainGeometry(slave->slaveWindow, mgr->masterWindow);
+    slave->flags &= ~SLAVE_MAPPED;
+    /* Contrary to documentation, Tk_UnmaintainGeometry doesn't always
+     * unmap the slave:
+     */
+    Tk_UnmapWindow(slave->slaveWindow);
+}
+
+/* LayoutChanged, SizeChanged --
+ * 	Schedule a relayout, resp. resize request.
+ */
+void Ttk_ManagerLayoutChanged(Ttk_Manager *mgr)
+{
+    ScheduleUpdate(mgr, MGR_RELAYOUT_REQUIRED);
+}
+
+void Ttk_ManagerSizeChanged(Ttk_Manager *mgr)
+{
+    ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+}
+
+/* +++ Accessors.
+ */
+int Ttk_NumberSlaves(Ttk_Manager *mgr)
+{
+    return mgr->nSlaves;
+}
+void *Ttk_SlaveData(Ttk_Manager *mgr, int slaveIndex)
+{
+    return mgr->slaves[slaveIndex]->slaveData;
+}
+Tk_Window Ttk_SlaveWindow(Ttk_Manager *mgr, int slaveIndex)
+{
+    return mgr->slaves[slaveIndex]->slaveWindow;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Utility routines.
+ */
+
+/* ++ Ttk_SlaveIndex --
+ * 	Returns the index of specified slave window, -1 if not found.
+ */
+int Ttk_SlaveIndex(Ttk_Manager *mgr, Tk_Window slaveWindow)
+{
+    int index;
+    for (index = 0; index < mgr->nSlaves; ++index)
+	if (mgr->slaves[index]->slaveWindow == slaveWindow)
+	    return index;
+    return -1;
+}
+
+/* ++ Ttk_GetSlaveIndexFromObj(interp, mgr, objPtr, indexPtr) --
+ * 	Return the index of the slave specified by objPtr.
+ * 	Slaves may be specified as an integer index or
+ * 	as the name of the managed window.
+ *
+ * Returns:
+ * 	Standard Tcl completion code.  Leaves an error message in case of error.
+ */
+
+int Ttk_GetSlaveIndexFromObj(
+    Tcl_Interp *interp, Ttk_Manager *mgr, Tcl_Obj *objPtr, int *indexPtr)
+{
+    const char *string = Tcl_GetString(objPtr);
+    int slaveIndex = 0;
+    Tk_Window tkwin;
+
+    /* Try interpreting as an integer first:
+     */
+    if (Tcl_GetIntFromObj(NULL, objPtr, &slaveIndex) == TCL_OK) {
+	if (slaveIndex < 0 || slaveIndex >= mgr->nSlaves) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"Slave index %d out of bounds", slaveIndex));
+	    Tcl_SetErrorCode(interp, "TTK", "SLAVE", "INDEX", NULL);
+	    return TCL_ERROR;
+	}
+	*indexPtr = slaveIndex;
+	return TCL_OK;
+    }
+
+    /* Try interpreting as a slave window name;
+     */
+    if ((*string == '.') &&
+	    (tkwin = Tk_NameToWindow(interp, string, mgr->masterWindow))) {
+	slaveIndex = Ttk_SlaveIndex(mgr, tkwin);
+	if (slaveIndex < 0) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "%s is not managed by %s", string,
+		    Tk_PathName(mgr->masterWindow)));
+	    Tcl_SetErrorCode(interp, "TTK", "SLAVE", "MANAGER", NULL);
+	    return TCL_ERROR;
+	}
+	*indexPtr = slaveIndex;
+	return TCL_OK;
+    }
+
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "Invalid slave specification %s", string));
+    Tcl_SetErrorCode(interp, "TTK", "SLAVE", "SPEC", NULL);
+    return TCL_ERROR;
+}
+
+/* ++ Ttk_ReorderSlave(mgr, fromIndex, toIndex) --
+ * 	Change slave order.
+ */
+void Ttk_ReorderSlave(Ttk_Manager *mgr, int fromIndex, int toIndex)
+{
+    Ttk_Slave *moved = mgr->slaves[fromIndex];
+
+    /* Shuffle down: */
+    while (fromIndex > toIndex) {
+	mgr->slaves[fromIndex] = mgr->slaves[fromIndex - 1];
+	--fromIndex;
+    }
+    /* Or, shuffle up: */
+    while (fromIndex < toIndex) {
+	mgr->slaves[fromIndex] = mgr->slaves[fromIndex + 1];
+	++fromIndex;
+    }
+    /* ASSERT: fromIndex == toIndex */
+    mgr->slaves[fromIndex] = moved;
+
+    /* Schedule a relayout.  In general, rearranging slaves
+     * may also change the size:
+     */
+    ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED);
+}
+
+/* ++ Ttk_Maintainable(interp, slave, master) --
+ * 	Utility routine.  Verifies that 'master' may be used to maintain
+ *	the geometry of 'slave' via Tk_MaintainGeometry:
+ *
+ * 	+ 'master' is either 'slave's parent -OR-
+ * 	+ 'master is a descendant of 'slave's parent.
+ * 	+ 'slave' is not a toplevel window
+ * 	+ 'slave' belongs to the same toplevel as 'master'
+ *
+ * Returns: 1 if OK; otherwise 0, leaving an error message in 'interp'.
+ */
+int Ttk_Maintainable(Tcl_Interp *interp, Tk_Window slave, Tk_Window master)
+{
+    Tk_Window ancestor = master, parent = Tk_Parent(slave);
+
+    if (Tk_IsTopLevel(slave) || slave == master) {
+	goto badWindow;
+    }
+
+    while (ancestor != parent) {
+	if (Tk_IsTopLevel(ancestor)) {
+	    goto badWindow;
+	}
+	ancestor = Tk_Parent(ancestor);
+    }
+
+    return 1;
+
+badWindow:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't add %s as slave of %s",
+	    Tk_PathName(slave), Tk_PathName(master)));
+    Tcl_SetErrorCode(interp, "TTK", "GEOMETRY", "MAINTAINABLE", NULL);
+    return 0;
+}
+

generic/ttk/ttkManager.h

@@ -0,0 +1,92 @@
+/*
+ * Copyright (c) 2005, Joe English.  Freely redistributable.
+ *
+ * Geometry manager utilities.
+ */
+
+#ifndef _TTKMANAGER
+#define _TTKMANAGER
+
+#include "ttkTheme.h"
+
+typedef struct TtkManager_ Ttk_Manager;
+
+/*
+ * Geometry manager specification record:
+ *
+ * RequestedSize computes the requested size of the master window.
+ *
+ * PlaceSlaves sets the position and size of all managed slaves
+ * by calling Ttk_PlaceSlave().
+ *
+ * SlaveRemoved() is called immediately before a slave is removed.
+ * NB: the associated slave window may have been destroyed when this
+ * routine is called.
+ * 
+ * SlaveRequest() is called when a slave requests a size change.
+ * It should return 1 if the request should propagate, 0 otherwise.
+ */
+typedef struct {			/* Manager hooks */
+    Tk_GeomMgr tkGeomMgr;		/* "real" Tk Geometry Manager */
+
+    int  (*RequestedSize)(void *managerData, int *widthPtr, int *heightPtr);
+    void (*PlaceSlaves)(void *managerData);
+    int  (*SlaveRequest)(void *managerData, int slaveIndex, int w, int h);
+    void (*SlaveRemoved)(void *managerData, int slaveIndex);
+} Ttk_ManagerSpec;
+
+/*
+ * Default implementations for Tk_GeomMgr hooks:
+ */
+MODULE_SCOPE void Ttk_GeometryRequestProc(ClientData, Tk_Window slave);
+MODULE_SCOPE void Ttk_LostSlaveProc(ClientData, Tk_Window slave);
+
+/*
+ * Public API:
+ */
+MODULE_SCOPE Ttk_Manager *Ttk_CreateManager(
+	Ttk_ManagerSpec *, void *managerData, Tk_Window masterWindow);
+MODULE_SCOPE void Ttk_DeleteManager(Ttk_Manager *);
+
+MODULE_SCOPE void Ttk_InsertSlave(
+    Ttk_Manager *, int position, Tk_Window, void *slaveData);
+
+MODULE_SCOPE void Ttk_ForgetSlave(Ttk_Manager *, int slaveIndex);
+
+MODULE_SCOPE void Ttk_ReorderSlave(Ttk_Manager *, int fromIndex, int toIndex);
+    /* Rearrange slave positions */
+
+MODULE_SCOPE void Ttk_PlaceSlave(
+    Ttk_Manager *, int slaveIndex, int x, int y, int width, int height);
+    /* Position and map the slave */
+
+MODULE_SCOPE void Ttk_UnmapSlave(Ttk_Manager *, int slaveIndex);
+    /* Unmap the slave */
+
+MODULE_SCOPE void Ttk_ManagerSizeChanged(Ttk_Manager *);
+MODULE_SCOPE void Ttk_ManagerLayoutChanged(Ttk_Manager *);
+    /* Notify manager that size (resp. layout) needs to be recomputed */
+
+/* Utilities:
+ */
+MODULE_SCOPE int Ttk_SlaveIndex(Ttk_Manager *, Tk_Window);
+    /* Returns: index in slave array of specified window, -1 if not found */
+
+MODULE_SCOPE int Ttk_GetSlaveIndexFromObj(
+    Tcl_Interp *, Ttk_Manager *, Tcl_Obj *, int *indexPtr);
+
+/* Accessor functions:
+ */
+MODULE_SCOPE int Ttk_NumberSlaves(Ttk_Manager *);
+    /* Returns: number of managed slaves */
+
+MODULE_SCOPE void *Ttk_SlaveData(Ttk_Manager *, int slaveIndex);
+    /* Returns: client data associated with slave */
+
+MODULE_SCOPE Tk_Window Ttk_SlaveWindow(Ttk_Manager *, int slaveIndex);
+    /* Returns: slave window */
+
+MODULE_SCOPE int Ttk_Maintainable(Tcl_Interp *, Tk_Window slave, Tk_Window master);
+    /* Returns: 1 if master can manage slave; 0 otherwise leaving error msg */
+
+#endif /* _TTKMANAGER */

generic/ttk/ttkPanedwindow.c

@@ -0,0 +1,976 @@
+/*
+ * Copyright (c) 2005, Joe English.  Freely redistributable.
+ *
+ * ttk::panedwindow widget implementation.
+ *
+ * TODO: track active/pressed sash.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkManager.h"
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*------------------------------------------------------------------------
+ * +++ Layout algorithm.
+ *
+ * (pos=x/y, size=width/height, depending on -orient=horizontal/vertical)
+ *
+ * Each pane carries two pieces of state: the request size and the
+ * position of the following sash.  (The final pane has no sash,
+ * its sash position is used as a sentinel value).
+ *
+ * Pane geometry is determined by the sash positions.
+ * When resizing, sash positions are computed from the request sizes,
+ * the available space, and pane weights (see PlaceSashes()).
+ * This ensures continuous resize behavior (that is: changing
+ * the size by X pixels then changing the size by Y pixels
+ * gives the same result as changing the size by X+Y pixels
+ * in one step).
+ *
+ * The request size is initially set to the slave window's requested size.
+ * When the user drags a sash, each pane's request size is set to its
+ * actual size.  This ensures that panes "stay put" on the next resize.
+ *
+ * If reqSize == 0, use 0 for the weight as well.  This ensures that
+ * "collapsed" panes stay collapsed during a resize, regardless of
+ * their nominal -weight.
+ *
+ * +++ Invariants.
+ *
+ * #sash 		=  #pane - 1
+ * pos(pane[0]) 	=  0
+ * pos(sash[i]) 	=  pos(pane[i]) + size(pane[i]), 0 <= i <= #sash
+ * pos(pane[i+1]) 	=  pos(sash[i]) + size(sash[i]), 0 <= i <  #sash
+ * pos(sash[#sash])	=  size(pw)   // sentinel value, constraint
+ *
+ * size(pw) 		=  sum(size(pane(0..#pane))) + sum(size(sash(0..#sash)))
+ * size(pane[i]) 	>= 0,  for 0 <= i < #pane
+ * size(sash[i]) 	>= 0,  for 0 <= i < #sash
+ * ==> pos(pane[i]) <= pos(sash[i]) <= pos(pane[i+1]), for 0 <= i < #sash
+ *
+ * Assumption: all sashes are the same size.
+ */
+
+/*------------------------------------------------------------------------
+ * +++ Widget record.
+ */
+
+typedef struct {
+    Tcl_Obj	*orientObj;
+    int 	orient;
+    int 	width;
+    int 	height;
+    Ttk_Manager	*mgr;
+    Tk_OptionTable paneOptionTable;
+    Ttk_Layout	sashLayout;
+    int 	sashThickness;
+} PanedPart;
+
+typedef struct {
+    WidgetCore	core;
+    PanedPart	paned;
+} Paned;
+
+/* @@@ NOTE: -orient is readonly 'cause dynamic oriention changes NYI
+ */
+static Tk_OptionSpec PanedOptionSpecs[] = {
+    {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "vertical",
+	Tk_Offset(Paned,paned.orientObj), Tk_Offset(Paned,paned.orient),
+	0,(ClientData)ttkOrientStrings,READONLY_OPTION|STYLE_CHANGED },
+    {TK_OPTION_INT, "-width", "width", "Width", "0",
+	-1,Tk_Offset(Paned,paned.width),
+	0,0,GEOMETRY_CHANGED },
+    {TK_OPTION_INT, "-height", "height", "Height", "0",
+	-1,Tk_Offset(Paned,paned.height),
+	0,0,GEOMETRY_CHANGED },
+
+    WIDGET_TAKEFOCUS_FALSE,
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Slave pane record.
+ */
+typedef struct {
+    int 	reqSize;		/* Pane request size */
+    int 	sashPos;		/* Folowing sash position */
+    int 	weight; 		/* Pane -weight, for resizing */
+} Pane;
+
+static Tk_OptionSpec PaneOptionSpecs[] = {
+    {TK_OPTION_INT, "-weight", "weight", "Weight", "0",
+	-1,Tk_Offset(Pane,weight), 0,0,GEOMETRY_CHANGED },
+    {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+/* CreatePane --
+ * 	Create a new pane record.
+ */
+static Pane *CreatePane(Tcl_Interp *interp, Paned *pw, Tk_Window slaveWindow)
+{
+    Tk_OptionTable optionTable = pw->paned.paneOptionTable;
+    void *record = ckalloc(sizeof(Pane));
+    Pane *pane = record;
+
+    memset(record, 0, sizeof(Pane));
+    if (Tk_InitOptions(interp, record, optionTable, slaveWindow) != TCL_OK) {
+	ckfree(record);
+	return NULL;
+    }
+
+    pane->reqSize
+	= pw->paned.orient == TTK_ORIENT_HORIZONTAL
+	? Tk_ReqWidth(slaveWindow) : Tk_ReqHeight(slaveWindow);
+
+    return pane;
+}
+
+/* DestroyPane --
+ * 	Free pane record.
+ */
+static void DestroyPane(Paned *pw, Pane *pane)
+{
+    void *record = pane;
+    Tk_FreeConfigOptions(record, pw->paned.paneOptionTable, pw->core.tkwin);
+    ckfree(record);
+}
+
+/* ConfigurePane --
+ * 	Set pane options.
+ */
+static int ConfigurePane(
+    Tcl_Interp *interp, Paned *pw, Pane *pane, Tk_Window slaveWindow,
+    int objc, Tcl_Obj *const objv[])
+{
+    Ttk_Manager *mgr = pw->paned.mgr;
+    Tk_SavedOptions savedOptions;
+    int mask = 0;
+
+    if (Tk_SetOptions(interp, (void*)pane, pw->paned.paneOptionTable,
+	    objc, objv, slaveWindow, &savedOptions, &mask) != TCL_OK)
+    {
+	return TCL_ERROR;
+    }
+
+    /* Sanity-check:
+     */
+    if (pane->weight < 0) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"-weight must be nonnegative", -1));
+	Tcl_SetErrorCode(interp, "TTK", "PANE", "WEIGHT", NULL);
+	goto error;
+    }
+
+    /* Done.
+     */
+    Tk_FreeSavedOptions(&savedOptions);
+    Ttk_ManagerSizeChanged(mgr);
+    return TCL_OK;
+
+error:
+    Tk_RestoreSavedOptions(&savedOptions);
+    return TCL_ERROR;
+}
+
+
+/*------------------------------------------------------------------------
+ * +++ Sash adjustment.
+ */
+
+/* ShoveUp --
+ * 	Place sash i at specified position, recursively shoving
+ * 	previous sashes upwards as needed, until hitting the top
+ * 	of the window.  If that happens, shove back down.
+ *
+ * 	Returns: final position of sash i.
+ */
+
+static int ShoveUp(Paned *pw, int i, int pos)
+{
+    Pane *pane = Ttk_SlaveData(pw->paned.mgr, i);
+    int sashThickness = pw->paned.sashThickness;
+
+    if (i == 0) {
+	if (pos < 0)
+	    pos = 0;
+    } else {
+	Pane *prevPane = Ttk_SlaveData(pw->paned.mgr, i-1);
+	if (pos < prevPane->sashPos + sashThickness)
+	    pos = ShoveUp(pw, i-1, pos - sashThickness) + sashThickness;
+    }
+    return pane->sashPos = pos;
+}
+
+/* ShoveDown --
+ * 	Same as ShoveUp, but going in the opposite direction
+ * 	and stopping at the sentinel sash.
+ */
+static int ShoveDown(Paned *pw, int i, int pos)
+{
+    Pane *pane = Ttk_SlaveData(pw->paned.mgr,i);
+    int sashThickness = pw->paned.sashThickness;
+
+    if (i == Ttk_NumberSlaves(pw->paned.mgr) - 1) {
+	pos = pane->sashPos; /* Sentinel value == master window size */
+    } else {
+	Pane *nextPane = Ttk_SlaveData(pw->paned.mgr,i+1);
+	if (pos + sashThickness > nextPane->sashPos)
+	    pos = ShoveDown(pw, i+1, pos + sashThickness) - sashThickness;
+    }
+    return pane->sashPos = pos;
+}
+
+/* PanedSize --
+ * 	Compute the requested size of the paned widget
+ * 	from the individual pane request sizes.
+ *
+ * 	Used as the WidgetSpec sizeProc and the ManagerSpec sizeProc.
+ */
+static int PanedSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+    Paned *pw = recordPtr;
+    int nPanes = Ttk_NumberSlaves(pw->paned.mgr);
+    int nSashes = nPanes - 1;
+    int sashThickness = pw->paned.sashThickness;
+    int width = 0, height = 0;
+    int index;
+
+    if (pw->paned.orient == TTK_ORIENT_HORIZONTAL) {
+	for (index = 0; index < nPanes; ++index) {
+	    Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+	    Tk_Window slaveWindow = Ttk_SlaveWindow(pw->paned.mgr, index);
+
+	    if (height < Tk_ReqHeight(slaveWindow))
+		height = Tk_ReqHeight(slaveWindow);
+	    width += pane->reqSize;
+	}
+	width += nSashes * sashThickness;
+    } else {
+	for (index = 0; index < nPanes; ++index) {
+	    Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+	    Tk_Window slaveWindow = Ttk_SlaveWindow(pw->paned.mgr, index);
+
+	    if (width < Tk_ReqWidth(slaveWindow))
+		width = Tk_ReqWidth(slaveWindow);
+	    height += pane->reqSize;
+	}
+	height += nSashes * sashThickness;
+    }
+
+    *widthPtr = pw->paned.width > 0 ? pw->paned.width : width;
+    *heightPtr = pw->paned.height > 0 ? pw->paned.height : height;
+    return 1;
+}
+
+/* AdjustPanes --
+ * 	Set pane request sizes from sash positions.
+ *
+ * NOTE:
+ * 	AdjustPanes followed by PlaceSashes (called during relayout)
+ * 	will leave the sashes in the same place, as long as available size
+ * 	remains contant.
+ */
+static void AdjustPanes(Paned *pw)
+{
+    int sashThickness = pw->paned.sashThickness;
+    int pos = 0;
+    int index;
+
+    for (index = 0; index < Ttk_NumberSlaves(pw->paned.mgr); ++index) {
+	Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+	int size = pane->sashPos - pos;
+	pane->reqSize = size >= 0 ? size : 0;
+	pos = pane->sashPos + sashThickness;
+    }
+}
+
+/* PlaceSashes --
+ *	Set sash positions from pane request sizes and available space.
+ *	The sentinel sash position is set to the available space.
+ *
+ *	Allocate pane->reqSize pixels to each pane, and distribute
+ *	the difference = available size - requested size according
+ *	to pane->weight.
+ *
+ *	If there's still some left over, squeeze panes from the bottom up
+ *	(This can happen if all weights are zero, or if one or more panes
+ *	are too small to absorb the required shrinkage).
+ *
+ * Notes:
+ * 	This doesn't distribute the remainder pixels as evenly as it could
+ * 	when more than one pane has weight > 1.
+ */
+static void PlaceSashes(Paned *pw, int width, int height)
+{
+    Ttk_Manager *mgr = pw->paned.mgr;
+    int nPanes = Ttk_NumberSlaves(mgr);
+    int sashThickness = pw->paned.sashThickness;
+    int available = pw->paned.orient == TTK_ORIENT_HORIZONTAL ? width : height;
+    int reqSize = 0, totalWeight = 0;
+    int difference, delta, remainder, pos, i;
+
+    if (nPanes == 0)
+	return;
+
+    /* Compute total required size and total available weight:
+     */
+    for (i = 0; i < nPanes; ++i) {
+	Pane *pane = Ttk_SlaveData(mgr, i);
+	reqSize += pane->reqSize;
+	totalWeight += pane->weight * (pane->reqSize != 0);
+    }
+
+    /* Compute difference to be redistributed:
+     */
+    difference = available - reqSize - sashThickness*(nPanes-1);
+    if (totalWeight != 0) {
+	delta = difference / totalWeight;
+	remainder = difference % totalWeight;
+	if (remainder < 0) {
+	    --delta;
+	    remainder += totalWeight;
+	}
+    } else {
+	delta = remainder = 0;
+    }
+    /* ASSERT: 0 <= remainder < totalWeight */
+
+    /* Place sashes:
+     */
+    pos = 0;
+    for (i = 0; i < nPanes; ++i) {
+	Pane *pane = Ttk_SlaveData(mgr, i);
+	int weight = pane->weight * (pane->reqSize != 0);
+	int size = pane->reqSize + delta * weight;
+
+	if (weight > remainder)
+	    weight = remainder;
+	remainder -= weight;
+	size += weight;
+
+	if (size < 0)
+	    size = 0;
+
+	pane->sashPos = (pos += size);
+	pos += sashThickness;
+    }
+
+    /* Handle emergency shrink/emergency stretch:
+     * Set sentinel sash position to end of widget,
+     * shove preceding sashes up.
+     */
+    ShoveUp(pw, nPanes - 1, available);
+}
+
+/* PlacePanes --
+ *	Places slave panes based on sash positions.
+ */
+static void PlacePanes(Paned *pw)
+{
+    int horizontal = pw->paned.orient == TTK_ORIENT_HORIZONTAL;
+    int width = Tk_Width(pw->core.tkwin), height = Tk_Height(pw->core.tkwin);
+    int sashThickness = pw->paned.sashThickness;
+    int pos = 0;
+    int index;
+
+    for (index = 0; index < Ttk_NumberSlaves(pw->paned.mgr); ++index) {
+	Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+	int size = pane->sashPos - pos;
+
+	if (size > 0) {
+	    if (horizontal) {
+		Ttk_PlaceSlave(pw->paned.mgr, index, pos, 0, size, height);
+	    } else {
+		Ttk_PlaceSlave(pw->paned.mgr, index, 0, pos, width, size);
+	    }
+	} else {
+	    Ttk_UnmapSlave(pw->paned.mgr, index);
+	}
+
+	pos = pane->sashPos + sashThickness;
+    }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Manager specification.
+ */
+
+static void PanedPlaceSlaves(void *managerData)
+{
+    Paned *pw = managerData;
+    PlaceSashes(pw, Tk_Width(pw->core.tkwin), Tk_Height(pw->core.tkwin));
+    PlacePanes(pw);
+}
+
+static void PaneRemoved(void *managerData, int index)
+{
+    Paned *pw = managerData;
+    Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+    DestroyPane(pw, pane);
+}
+
+static int AddPane(
+    Tcl_Interp *interp, Paned *pw,
+    int destIndex, Tk_Window slaveWindow,
+    int objc, Tcl_Obj *const objv[])
+{
+    Pane *pane;
+    if (!Ttk_Maintainable(interp, slaveWindow, pw->core.tkwin)) {
+	return TCL_ERROR;
+    }
+    if (Ttk_SlaveIndex(pw->paned.mgr, slaveWindow) >= 0) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"%s already added", Tk_PathName(slaveWindow)));
+	Tcl_SetErrorCode(interp, "TTK", "PANE", "PRESENT", NULL);
+	return TCL_ERROR;
+    }
+
+    pane = CreatePane(interp, pw, slaveWindow);
+    if (!pane) {
+	return TCL_ERROR;
+    }
+    if (ConfigurePane(interp, pw, pane, slaveWindow, objc, objv) != TCL_OK) {
+	DestroyPane(pw, pane);
+	return TCL_ERROR;
+    }
+
+    Ttk_InsertSlave(pw->paned.mgr, destIndex, slaveWindow, pane);
+    return TCL_OK;
+}
+
+/* PaneRequest --
+ * 	Only update pane request size if slave is currently unmapped.
+ * 	Geometry requests from mapped slaves are not directly honored
+ * 	in order to avoid unexpected pane resizes (esp. while the
+ * 	user is dragging a sash [#1325286]).
+ */
+static int PaneRequest(void *managerData, int index, int width, int height)
+{
+    Paned *pw = managerData;
+    Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+    Tk_Window slaveWindow = Ttk_SlaveWindow(pw->paned.mgr, index);
+    int horizontal = pw->paned.orient == TTK_ORIENT_HORIZONTAL;
+
+    if (!Tk_IsMapped(slaveWindow)) {
+	pane->reqSize = horizontal ? width : height;
+    }
+    return 1;
+}
+
+static Ttk_ManagerSpec PanedManagerSpec = {
+    { "panedwindow", Ttk_GeometryRequestProc, Ttk_LostSlaveProc },
+    PanedSize,
+    PanedPlaceSlaves,
+    PaneRequest,
+    PaneRemoved
+};
+
+/*------------------------------------------------------------------------
+ * +++ Event handler.
+ *
+ * <<NOTE-PW-LEAVE-NOTIFYINFERIOR>>
+ * Tk does not execute binding scripts for <Leave> events when
+ * the pointer crosses from a parent to a child.  This widget
+ * needs to know when that happens, though, so it can reset
+ * the cursor.
+ *
+ * This event handler generates an <<EnteredChild>> virtual event
+ * on LeaveNotify/NotifyInferior.
+ */
+
+static const unsigned PanedEventMask = LeaveWindowMask;
+static void PanedEventProc(ClientData clientData, XEvent *eventPtr)
+{
+    WidgetCore *corePtr = clientData;
+    if (   eventPtr->type == LeaveNotify
+	&& eventPtr->xcrossing.detail == NotifyInferior)
+    {
+	TtkSendVirtualEvent(corePtr->tkwin, "EnteredChild");
+    }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization and cleanup hooks.
+ */
+
+static void PanedInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+    Paned *pw = recordPtr;
+
+    Tk_CreateEventHandler(pw->core.tkwin,
+	PanedEventMask, PanedEventProc, recordPtr);
+    pw->paned.mgr = Ttk_CreateManager(&PanedManagerSpec, pw, pw->core.tkwin);
+    pw->paned.paneOptionTable = Tk_CreateOptionTable(interp,PaneOptionSpecs);
+    pw->paned.sashLayout = 0;
+    pw->paned.sashThickness = 1;
+}
+
+static void PanedCleanup(void *recordPtr)
+{
+    Paned *pw = recordPtr;
+
+    if (pw->paned.sashLayout)
+	Ttk_FreeLayout(pw->paned.sashLayout);
+    Tk_DeleteEventHandler(pw->core.tkwin,
+	PanedEventMask, PanedEventProc, recordPtr);
+    Ttk_DeleteManager(pw->paned.mgr);
+}
+
+/* Post-configuration hook.
+ */
+static int PanedPostConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+    Paned *pw = clientData;
+
+    if (mask & GEOMETRY_CHANGED) {
+	/* User has changed -width or -height.
+	 * Recalculate sash positions based on requested size.
+	 */
+	Tk_Window tkwin = pw->core.tkwin;
+	PlaceSashes(pw,
+	    pw->paned.width > 0 ? pw->paned.width : Tk_Width(tkwin),
+	    pw->paned.height > 0 ? pw->paned.height : Tk_Height(tkwin));
+    }
+
+    return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout management hooks.
+ */
+static Ttk_Layout PanedGetLayout(
+    Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr)
+{
+    Paned *pw = recordPtr;
+    Ttk_Layout panedLayout = TtkWidgetGetLayout(interp, themePtr, recordPtr);
+
+    if (panedLayout) {
+	int horizontal = pw->paned.orient == TTK_ORIENT_HORIZONTAL;
+	const char *layoutName =
+	    horizontal ? ".Vertical.Sash" : ".Horizontal.Sash";
+	Ttk_Layout sashLayout = Ttk_CreateSublayout(
+	    interp, themePtr, panedLayout, layoutName, pw->core.optionTable);
+
+	if (sashLayout) {
+	    int sashWidth, sashHeight;
+
+	    Ttk_LayoutSize(sashLayout, 0, &sashWidth, &sashHeight);
+	    pw->paned.sashThickness = horizontal ? sashWidth : sashHeight;
+
+	    if (pw->paned.sashLayout)
+		Ttk_FreeLayout(pw->paned.sashLayout);
+	    pw->paned.sashLayout = sashLayout;
+	} else {
+	    Ttk_FreeLayout(panedLayout);
+	    return 0;
+	}
+    }
+
+    return panedLayout;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Drawing routines.
+ */
+
+/* SashLayout --
+ * 	Place the sash sublayout after the specified pane,
+ * 	in preparation for drawing.
+ */
+static Ttk_Layout SashLayout(Paned *pw, int index)
+{
+    Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+    int thickness = pw->paned.sashThickness,
+	height = Tk_Height(pw->core.tkwin),
+	width = Tk_Width(pw->core.tkwin),
+	sashPos = pane->sashPos;
+
+    Ttk_PlaceLayout(
+	pw->paned.sashLayout, pw->core.state,
+	pw->paned.orient == TTK_ORIENT_HORIZONTAL
+	    ? Ttk_MakeBox(sashPos, 0, thickness, height)
+	    : Ttk_MakeBox(0, sashPos, width, thickness));
+
+    return pw->paned.sashLayout;
+}
+
+static void DrawSash(Paned *pw, int index, Drawable d)
+{
+    Ttk_DrawLayout(SashLayout(pw, index), pw->core.state, d);
+}
+
+static void PanedDisplay(void *recordPtr, Drawable d)
+{
+    Paned *pw = recordPtr;
+    int i, nSashes = Ttk_NumberSlaves(pw->paned.mgr) - 1;
+
+    TtkWidgetDisplay(recordPtr, d);
+    for (i = 0; i < nSashes; ++i) {
+	DrawSash(pw, i, d);
+    }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands.
+ */
+
+/* $pw add window [ options ... ]
+ */
+static int PanedAddCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Paned *pw = recordPtr;
+    Tk_Window slaveWindow;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "window");
+	return TCL_ERROR;
+    }
+
+    slaveWindow = Tk_NameToWindow(
+	interp, Tcl_GetString(objv[2]), pw->core.tkwin);
+
+    if (!slaveWindow) {
+	return TCL_ERROR;
+    }
+
+    return AddPane(interp, pw, Ttk_NumberSlaves(pw->paned.mgr), slaveWindow,
+	    objc - 3, objv + 3);
+}
+
+/* $pw insert $index $slave ?-option value ...?
+ * 	Insert new slave, or move existing one.
+ */
+static int PanedInsertCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Paned *pw = recordPtr;
+    int nSlaves = Ttk_NumberSlaves(pw->paned.mgr);
+    int srcIndex, destIndex;
+    Tk_Window slaveWindow;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 2,objv, "index slave ?-option value ...?");
+	return TCL_ERROR;
+    }
+
+    slaveWindow = Tk_NameToWindow(
+	interp, Tcl_GetString(objv[3]), pw->core.tkwin);
+    if (!slaveWindow) {
+	return TCL_ERROR;
+    }
+
+    if (!strcmp(Tcl_GetString(objv[2]), "end")) {
+	destIndex = Ttk_NumberSlaves(pw->paned.mgr);
+    } else if (TCL_OK != Ttk_GetSlaveIndexFromObj(
+		interp,pw->paned.mgr,objv[2],&destIndex))
+    {
+	return TCL_ERROR;
+    }
+
+    srcIndex = Ttk_SlaveIndex(pw->paned.mgr, slaveWindow);
+    if (srcIndex < 0) { /* New slave: */
+	return AddPane(interp, pw, destIndex, slaveWindow, objc-4, objv+4);
+    } /* else -- move existing slave: */
+
+    if (destIndex >= nSlaves)
+	destIndex  = nSlaves - 1;
+    Ttk_ReorderSlave(pw->paned.mgr, srcIndex, destIndex);
+
+    return objc == 4 ? TCL_OK :
+	ConfigurePane(interp, pw,
+		Ttk_SlaveData(pw->paned.mgr, destIndex),
+		Ttk_SlaveWindow(pw->paned.mgr, destIndex),
+		objc-4,objv+4);
+}
+
+/* $pw forget $pane
+ */
+static int PanedForgetCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Paned *pw = recordPtr;
+    int paneIndex;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 2,objv, "pane");
+	return TCL_ERROR;
+    }
+
+    if (TCL_OK != Ttk_GetSlaveIndexFromObj(
+		    interp, pw->paned.mgr, objv[2], &paneIndex))
+    {
+	return TCL_ERROR;
+    }
+    Ttk_ForgetSlave(pw->paned.mgr, paneIndex);
+
+    return TCL_OK;
+}
+
+/* $pw identify ?what? $x $y --
+ * 	Return index of sash at $x,$y
+ */
+static int PanedIdentifyCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    static const char *whatTable[] = { "element", "sash", NULL };
+    enum { IDENTIFY_ELEMENT, IDENTIFY_SASH };
+    int what = IDENTIFY_SASH;
+    Paned *pw = recordPtr;
+    int sashThickness = pw->paned.sashThickness;
+    int nSashes = Ttk_NumberSlaves(pw->paned.mgr) - 1;
+    int x, y, pos;
+    int index;
+
+    if (objc < 4 || objc > 5) {
+	Tcl_WrongNumArgs(interp, 2,objv, "?what? x y");
+	return TCL_ERROR;
+    }
+
+    if (   Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK
+	|| Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK
+	|| (objc == 5 && Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable,
+	    sizeof(char *), "option", 0, &what) != TCL_OK)
+    ) {
+	return TCL_ERROR;
+    }
+
+    pos = pw->paned.orient == TTK_ORIENT_HORIZONTAL ? x : y;
+    for (index = 0; index < nSashes; ++index) {
+	Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+	if (pane->sashPos <= pos && pos <= pane->sashPos + sashThickness) {
+	    /* Found it. */
+	    switch (what) {
+		case IDENTIFY_SASH:
+		    Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+		    return TCL_OK;
+		case IDENTIFY_ELEMENT:
+		{
+		    Ttk_Element element =
+			Ttk_IdentifyElement(SashLayout(pw, index), x, y);
+		    if (element) {
+			Tcl_SetObjResult(interp,
+			    Tcl_NewStringObj(Ttk_ElementName(element), -1));
+		    }
+		    return TCL_OK;
+		}
+	    }
+	}
+    }
+
+    return TCL_OK; /* nothing found - return empty string */
+}
+
+/* $pw pane $pane ?-option ?value -option value ...??
+ * 	Query/modify pane options.
+ */
+static int PanedPaneCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Paned *pw = recordPtr;
+    int paneIndex;
+    Tk_Window slaveWindow;
+    Pane *pane;
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 2,objv, "pane ?-option value ...?");
+	return TCL_ERROR;
+    }
+
+    if (TCL_OK != Ttk_GetSlaveIndexFromObj(
+		    interp,pw->paned.mgr,objv[2],&paneIndex))
+    {
+	return TCL_ERROR;
+    }
+
+    pane = Ttk_SlaveData(pw->paned.mgr, paneIndex);
+    slaveWindow = Ttk_SlaveWindow(pw->paned.mgr, paneIndex);
+
+    switch (objc) {
+	case 3:
+	    return TtkEnumerateOptions(interp, pane, PaneOptionSpecs,
+			pw->paned.paneOptionTable, slaveWindow);
+	case 4:
+	    return TtkGetOptionValue(interp, pane, objv[3],
+			pw->paned.paneOptionTable, slaveWindow);
+	default:
+	    return ConfigurePane(interp, pw, pane, slaveWindow, objc-3,objv+3);
+    }
+}
+
+/* $pw panes --
+ * 	Return list of managed panes.
+ */
+static int PanedPanesCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Paned *pw = recordPtr;
+    Ttk_Manager *mgr = pw->paned.mgr;
+    Tcl_Obj *panes;
+    int i;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 2, objv, "");
+	return TCL_ERROR;
+    }
+
+    panes = Tcl_NewListObj(0, NULL);
+    for (i = 0; i < Ttk_NumberSlaves(mgr); ++i) {
+	const char *pathName = Tk_PathName(Ttk_SlaveWindow(mgr,i));
+	Tcl_ListObjAppendElement(interp, panes, Tcl_NewStringObj(pathName,-1));
+    }
+    Tcl_SetObjResult(interp, panes);
+
+    return TCL_OK;
+}
+
+
+/* $pw sashpos $index ?$newpos?
+ * 	Query or modify sash position.
+ */
+static int PanedSashposCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Paned *pw = recordPtr;
+    int sashIndex, position = -1;
+    Pane *pane;
+
+    if (objc < 3 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 2,objv, "index ?newpos?");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIntFromObj(interp, objv[2], &sashIndex) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (sashIndex < 0 || sashIndex >= Ttk_NumberSlaves(pw->paned.mgr) - 1) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "sash index %d out of range", sashIndex));
+	Tcl_SetErrorCode(interp, "TTK", "PANE", "SASH_INDEX", NULL);
+	return TCL_ERROR;
+    }
+
+    pane = Ttk_SlaveData(pw->paned.mgr, sashIndex);
+
+    if (objc == 3) {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(pane->sashPos));
+	return TCL_OK;
+    }
+    /* else -- set new sash position */
+
+    if (Tcl_GetIntFromObj(interp, objv[3], &position) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (position < pane->sashPos) {
+	ShoveUp(pw, sashIndex, position);
+    } else {
+	ShoveDown(pw, sashIndex, position);
+    }
+
+    AdjustPanes(pw);
+    Ttk_ManagerLayoutChanged(pw->paned.mgr);
+
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(pane->sashPos));
+    return TCL_OK;
+}
+
+static const Ttk_Ensemble PanedCommands[] = {
+    { "add", 		PanedAddCommand,0 },
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "forget", 	PanedForgetCommand,0 },
+    { "identify", 	PanedIdentifyCommand,0 },
+    { "insert", 	PanedInsertCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "pane",   	PanedPaneCommand,0 },
+    { "panes",   	PanedPanesCommand,0 },
+    { "sashpos",  	PanedSashposCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { 0,0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget specification.
+ */
+
+static WidgetSpec PanedWidgetSpec =
+{
+    "TPanedwindow",		/* className */
+    sizeof(Paned),		/* recordSize */
+    PanedOptionSpecs,		/* optionSpecs */
+    PanedCommands,		/* subcommands */
+    PanedInitialize,		/* initializeProc */
+    PanedCleanup,		/* cleanupProc */
+    TtkCoreConfigure,		/* configureProc */
+    PanedPostConfigure, 	/* postConfigureProc */
+    PanedGetLayout,		/* getLayoutProc */
+    PanedSize, 			/* sizeProc */
+    TtkWidgetDoLayout,		/* layoutProc */
+    PanedDisplay		/* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Elements and layouts.
+ */
+
+static const int DEFAULT_SASH_THICKNESS = 5;
+
+typedef struct {
+    Tcl_Obj *thicknessObj;
+} SashElement;
+
+static Ttk_ElementOptionSpec SashElementOptions[] = {
+    { "-sashthickness", TK_OPTION_INT,
+	    Tk_Offset(SashElement,thicknessObj), "5" },
+    { NULL, 0, 0, NULL }
+};
+
+static void SashElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    SashElement *sash = elementRecord;
+    int thickness = DEFAULT_SASH_THICKNESS;
+    Tcl_GetIntFromObj(NULL, sash->thicknessObj, &thickness);
+    *widthPtr = *heightPtr = thickness;
+}
+
+static Ttk_ElementSpec SashElementSpec = {
+    TK_STYLE_VERSION_2,
+    sizeof(SashElement),
+    SashElementOptions,
+    SashElementSize,
+    TtkNullElementDraw
+};
+
+TTK_BEGIN_LAYOUT(PanedLayout)
+    TTK_NODE("Panedwindow.background", 0)/* @@@ BUG: empty layouts don't work */
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalSashLayout)
+    TTK_NODE("Sash.hsash", TTK_FILL_X)
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(VerticalSashLayout)
+    TTK_NODE("Sash.vsash", TTK_FILL_Y)
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Registration routine.
+ */
+MODULE_SCOPE
+void TtkPanedwindow_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme themePtr = Ttk_GetDefaultTheme(interp);
+    RegisterWidget(interp, "ttk::panedwindow", &PanedWidgetSpec);
+
+    Ttk_RegisterElement(interp, themePtr, "hsash", &SashElementSpec, 0);
+    Ttk_RegisterElement(interp, themePtr, "vsash", &SashElementSpec, 0);
+
+    Ttk_RegisterLayout(themePtr, "TPanedwindow", PanedLayout);
+    Ttk_RegisterLayout(themePtr, "Horizontal.Sash", HorizontalSashLayout);
+    Ttk_RegisterLayout(themePtr, "Vertical.Sash", VerticalSashLayout);
+}
+

generic/ttk/ttkProgress.c

@@ -0,0 +1,545 @@
+/*
+ * Copyright (c) Joe English, Pat Thoyts, Michael Kirkham
+ *
+ * ttk::progressbar widget.
+ */
+
+#include <math.h>
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*------------------------------------------------------------------------
+ * +++ Widget record:
+ */
+
+#define DEF_PROGRESSBAR_LENGTH "100"
+enum {
+    TTK_PROGRESSBAR_DETERMINATE, TTK_PROGRESSBAR_INDETERMINATE
+};
+static const char *const ProgressbarModeStrings[] = {
+    "determinate", "indeterminate", NULL
+};
+
+typedef struct {
+    Tcl_Obj 	*orientObj;
+    Tcl_Obj 	*lengthObj;
+    Tcl_Obj 	*modeObj;
+    Tcl_Obj 	*variableObj;
+    Tcl_Obj 	*maximumObj;
+    Tcl_Obj 	*valueObj;
+    Tcl_Obj 	*phaseObj;
+
+    int 	mode;
+    Ttk_TraceHandle *variableTrace;	/* Trace handle for -variable option */
+    int 	period;			/* Animation period */
+    int 	maxPhase;		/* Max animation phase */
+    Tcl_TimerToken timer;		/* Animation timer */
+
+} ProgressbarPart;
+
+typedef struct {
+    WidgetCore 		core;
+    ProgressbarPart	progress;
+} Progressbar;
+
+static Tk_OptionSpec ProgressbarOptionSpecs[] =
+{
+    {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient",
+	"horizontal", Tk_Offset(Progressbar,progress.orientObj), -1,
+	0, (ClientData)ttkOrientStrings, STYLE_CHANGED },
+    {TK_OPTION_PIXELS, "-length", "length", "Length",
+        DEF_PROGRESSBAR_LENGTH, Tk_Offset(Progressbar,progress.lengthObj), -1,
+	0, 0, GEOMETRY_CHANGED },
+    {TK_OPTION_STRING_TABLE, "-mode", "mode", "ProgressMode", "determinate",
+	Tk_Offset(Progressbar,progress.modeObj),
+	Tk_Offset(Progressbar,progress.mode),
+	0, (ClientData)ProgressbarModeStrings, 0 },
+    {TK_OPTION_DOUBLE, "-maximum", "maximum", "Maximum",
+	"100", Tk_Offset(Progressbar,progress.maximumObj), -1,
+	0, 0, 0 },
+    {TK_OPTION_STRING, "-variable", "variable", "Variable",
+	NULL, Tk_Offset(Progressbar,progress.variableObj), -1,
+	TK_OPTION_NULL_OK, 0, 0 },
+    {TK_OPTION_DOUBLE, "-value", "value", "Value",
+	"0.0", Tk_Offset(Progressbar,progress.valueObj), -1,
+	0, 0, 0 },
+    {TK_OPTION_INT, "-phase", "phase", "Phase",
+	"0", Tk_Offset(Progressbar,progress.phaseObj), -1,
+	0, 0, 0 },
+
+    WIDGET_TAKEFOCUS_FALSE,
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Animation procedures:
+ */
+
+/* AnimationEnabled --
+ * 	Returns 1 if animation should be active, 0 otherwise.
+ */
+static int AnimationEnabled(Progressbar *pb)
+{
+    double maximum = 100, value = 0;
+
+    Tcl_GetDoubleFromObj(NULL, pb->progress.maximumObj, &maximum);
+    Tcl_GetDoubleFromObj(NULL, pb->progress.valueObj, &value);
+
+    return pb->progress.period > 0
+	&& value > 0.0
+	&& (   value < maximum
+	    || pb->progress.mode == TTK_PROGRESSBAR_INDETERMINATE);
+}
+
+/* AnimateProgressProc --
+ * 	Timer callback for progress bar animation.
+ * 	Increments the -phase option, redisplays the widget,
+ * 	and reschedules itself if animation still enabled.
+ */
+static void AnimateProgressProc(ClientData clientData)
+{
+    Progressbar *pb = clientData;
+
+    pb->progress.timer = 0;
+
+    if (AnimationEnabled(pb)) {
+	int phase = 0;
+	Tcl_GetIntFromObj(NULL, pb->progress.phaseObj, &phase);
+
+	/*
+	 * Update -phase:
+	 */
+	++phase;
+	if (pb->progress.maxPhase)
+	    phase %= pb->progress.maxPhase;
+	Tcl_DecrRefCount(pb->progress.phaseObj);
+	pb->progress.phaseObj = Tcl_NewIntObj(phase);
+	Tcl_IncrRefCount(pb->progress.phaseObj);
+
+	/*
+	 * Reschedule:
+	 */
+	pb->progress.timer = Tcl_CreateTimerHandler(
+	    pb->progress.period, AnimateProgressProc, clientData);
+
+	TtkRedisplayWidget(&pb->core);
+    }
+}
+
+/* CheckAnimation --
+ * 	If animation is enabled and not scheduled, schedule it.
+ * 	If animation is disabled but scheduled, cancel it.
+ */
+static void CheckAnimation(Progressbar *pb)
+{
+    if (AnimationEnabled(pb)) {
+	if (pb->progress.timer == 0) {
+	    pb->progress.timer = Tcl_CreateTimerHandler(
+		pb->progress.period, AnimateProgressProc, (ClientData)pb);
+	}
+    } else {
+	if (pb->progress.timer != 0) {
+	    Tcl_DeleteTimerHandler(pb->progress.timer);
+	    pb->progress.timer = 0;
+	}
+    }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Trace hook for progressbar -variable option:
+ */
+
+static void VariableChanged(void *recordPtr, const char *value)
+{
+    Progressbar *pb = recordPtr;
+    Tcl_Obj *newValue;
+    double scratch;
+
+    if (WidgetDestroyed(&pb->core)) {
+	return;
+    }
+
+    if (!value) {
+	/* Linked variable is unset -- disable widget */
+	TtkWidgetChangeState(&pb->core, TTK_STATE_DISABLED, 0);
+	return;
+    }
+    TtkWidgetChangeState(&pb->core, 0, TTK_STATE_DISABLED);
+
+    newValue = Tcl_NewStringObj(value, -1);
+    Tcl_IncrRefCount(newValue);
+    if (Tcl_GetDoubleFromObj(NULL, newValue, &scratch) != TCL_OK) {
+	TtkWidgetChangeState(&pb->core, TTK_STATE_INVALID, 0);
+	return;
+    }
+    TtkWidgetChangeState(&pb->core, 0, TTK_STATE_INVALID);
+    Tcl_DecrRefCount(pb->progress.valueObj);
+    pb->progress.valueObj = newValue;
+
+    CheckAnimation(pb);
+    TtkRedisplayWidget(&pb->core);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget class methods:
+ */
+
+static void ProgressbarInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+    Progressbar *pb = recordPtr;
+    pb->progress.variableTrace = 0;
+    pb->progress.timer = 0;
+}
+
+static void ProgressbarCleanup(void *recordPtr)
+{
+    Progressbar *pb = recordPtr;
+    if (pb->progress.variableTrace)
+	Ttk_UntraceVariable(pb->progress.variableTrace);
+    if (pb->progress.timer)
+	Tcl_DeleteTimerHandler(pb->progress.timer);
+}
+
+/*
+ * Configure hook:
+ *
+ * @@@ TODO: deal with [$pb configure -value ... -variable ...]
+ */
+static int ProgressbarConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Progressbar *pb = recordPtr;
+    Tcl_Obj *varName = pb->progress.variableObj;
+    Ttk_TraceHandle *vt = 0;
+
+    if (varName != NULL && *Tcl_GetString(varName) != '\0') {
+	vt = Ttk_TraceVariable(interp, varName, VariableChanged, recordPtr);
+	if (!vt) return TCL_ERROR;
+    }
+
+    if (TtkCoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+	if (vt) Ttk_UntraceVariable(vt);
+	return TCL_ERROR;
+    }
+
+    if (pb->progress.variableTrace) {
+	Ttk_UntraceVariable(pb->progress.variableTrace);
+    }
+    pb->progress.variableTrace = vt;
+
+    return TCL_OK;
+}
+
+/*
+ * Post-configuration hook:
+ */
+static int ProgressbarPostConfigure(
+    Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Progressbar *pb = recordPtr;
+    int status = TCL_OK;
+
+    if (pb->progress.variableTrace) {
+	status = Ttk_FireTrace(pb->progress.variableTrace);
+	if (WidgetDestroyed(&pb->core)) {
+	    return TCL_ERROR;
+	}
+	if (status != TCL_OK) {
+	    /* Unset -variable: */
+	    Ttk_UntraceVariable(pb->progress.variableTrace);
+	    Tcl_DecrRefCount(pb->progress.variableObj);
+	    pb->progress.variableTrace = 0;
+	    pb->progress.variableObj = NULL;
+	    return TCL_ERROR;
+	}
+    }
+
+    CheckAnimation(pb);
+
+    return status;
+}
+
+/*
+ * Size hook:
+ * 	Compute base layout size, overrid
+ */
+static int ProgressbarSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+    Progressbar *pb = recordPtr;
+    int length = 100, orient = TTK_ORIENT_HORIZONTAL;
+
+    TtkWidgetSize(recordPtr, widthPtr, heightPtr);
+
+    /* Override requested width (height) based on -length and -orient
+     */
+    Tk_GetPixelsFromObj(NULL, pb->core.tkwin, pb->progress.lengthObj, &length);
+    Ttk_GetOrientFromObj(NULL, pb->progress.orientObj, &orient);
+
+    if (orient == TTK_ORIENT_HORIZONTAL) {
+	*widthPtr = length;
+    } else {
+	*heightPtr = length;
+    }
+
+    return 1;
+}
+
+/*
+ * Layout hook:
+ * 	Adjust size and position of pbar element, if present.
+ */
+
+static void ProgressbarDeterminateLayout(
+    Progressbar *pb,
+    Ttk_Element pbar,
+    Ttk_Box parcel,
+    double fraction,
+    Ttk_Orient orient)
+{
+    if (fraction < 0.0) fraction = 0.0;
+    if (fraction > 1.0) fraction = 1.0;
+
+    if (orient == TTK_ORIENT_HORIZONTAL) {
+	parcel.width = (int)(parcel.width * fraction);
+    } else {
+	int newHeight = (int)(parcel.height * fraction);
+	parcel.y += (parcel.height - newHeight);
+	parcel.height = newHeight;
+    }
+    Ttk_PlaceElement(pb->core.layout, pbar, parcel);
+}
+
+static void ProgressbarIndeterminateLayout(
+    Progressbar *pb,
+    Ttk_Element pbar,
+    Ttk_Box parcel,
+    double fraction,
+    Ttk_Orient orient)
+{
+    Ttk_Box pbarBox = Ttk_ElementParcel(pbar);
+
+    fraction = fmod(fabs(fraction), 2.0);
+    if (fraction > 1.0) {
+	fraction = 2.0 - fraction;
+    }
+
+    if (orient == TTK_ORIENT_HORIZONTAL) {
+	pbarBox.x = parcel.x + (int)(fraction * (parcel.width-pbarBox.width));
+    } else {
+	pbarBox.y = parcel.y + (int)(fraction * (parcel.height-pbarBox.height));
+    }
+    Ttk_PlaceElement(pb->core.layout, pbar, pbarBox);
+}
+
+static void ProgressbarDoLayout(void *recordPtr)
+{
+    Progressbar *pb = recordPtr;
+    WidgetCore *corePtr = &pb->core;
+    Ttk_Element pbar = Ttk_FindElement(corePtr->layout, "pbar");
+    double value = 0.0, maximum = 100.0;
+    int orient = TTK_ORIENT_HORIZONTAL;
+
+    Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+
+    /* Adjust the bar size:
+     */
+
+    Tcl_GetDoubleFromObj(NULL, pb->progress.valueObj, &value);
+    Tcl_GetDoubleFromObj(NULL, pb->progress.maximumObj, &maximum);
+    Ttk_GetOrientFromObj(NULL, pb->progress.orientObj, &orient);
+
+    if (pbar) {
+	double fraction = value / maximum;
+	Ttk_Box parcel = Ttk_ClientRegion(corePtr->layout, "trough");
+
+	if (pb->progress.mode == TTK_PROGRESSBAR_DETERMINATE) {
+	    ProgressbarDeterminateLayout(
+		pb, pbar, parcel, fraction, orient);
+	} else {
+	    ProgressbarIndeterminateLayout(
+		pb, pbar, parcel, fraction, orient);
+	}
+    }
+}
+
+static Ttk_Layout ProgressbarGetLayout(
+    Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+    Progressbar *pb = recordPtr;
+    Ttk_Layout layout = TtkWidgetGetOrientedLayout(
+	interp, theme, recordPtr, pb->progress.orientObj);
+
+    /*
+     * Check if the style supports animation:
+     */
+    pb->progress.period = 0;
+    pb->progress.maxPhase = 0;
+    if (layout) {
+	Tcl_Obj *periodObj = Ttk_QueryOption(layout,"-period", 0);
+	Tcl_Obj *maxPhaseObj = Ttk_QueryOption(layout,"-maxphase", 0);
+	if (periodObj)
+	    Tcl_GetIntFromObj(NULL, periodObj, &pb->progress.period);
+	if (maxPhaseObj)
+	    Tcl_GetIntFromObj(NULL, maxPhaseObj, &pb->progress.maxPhase);
+    }
+
+    return layout;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands:
+ */
+
+/* $sb step ?amount?
+ */
+static int ProgressbarStepCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Progressbar *pb = recordPtr;
+    double value = 0.0, stepAmount = 1.0;
+    Tcl_Obj *newValueObj; 
+
+    if (objc == 3) {
+	if (Tcl_GetDoubleFromObj(interp, objv[2], &stepAmount) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 2,objv, "?stepAmount?");
+	return TCL_ERROR;
+    }
+
+    (void)Tcl_GetDoubleFromObj(NULL, pb->progress.valueObj, &value);
+    value += stepAmount;
+
+    /* In determinate mode, wrap around if value exceeds maximum:
+     */
+    if (pb->progress.mode == TTK_PROGRESSBAR_DETERMINATE) {
+	double maximum = 100.0;
+	(void)Tcl_GetDoubleFromObj(NULL, pb->progress.maximumObj, &maximum);
+	value = fmod(value, maximum);
+    }
+
+    newValueObj = Tcl_NewDoubleObj(value);
+
+    TtkRedisplayWidget(&pb->core);
+
+    /* Update value by setting the linked -variable, if there is one: 
+     */
+    if (pb->progress.variableTrace) {
+	return Tcl_ObjSetVar2(
+		    interp, pb->progress.variableObj, 0, newValueObj,
+		    TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)
+	    ? TCL_OK : TCL_ERROR;
+    }
+
+    /* Otherwise, change the -value directly:
+     */
+    Tcl_IncrRefCount(newValueObj);
+    Tcl_DecrRefCount(pb->progress.valueObj);
+    pb->progress.valueObj = newValueObj;
+    CheckAnimation(pb);
+
+    return TCL_OK;
+}
+
+/* $sb start|stop ?args? --
+ * Change [$sb $cmd ...] to [ttk::progressbar::$cmd ...] 
+ * and pass to interpreter.
+ */
+static int ProgressbarStartStopCommand(
+    Tcl_Interp *interp, const char *cmdName, int objc, Tcl_Obj *const objv[])
+{
+    Tcl_Obj *cmd = Tcl_NewListObj(objc, objv);
+    Tcl_Obj *prefix[2];
+    int status;
+
+    /* ASSERT: objc >= 2 */
+
+    prefix[0] = Tcl_NewStringObj(cmdName, -1);
+    prefix[1] = objv[0];
+    Tcl_ListObjReplace(interp, cmd, 0,2, 2,prefix);
+
+    Tcl_IncrRefCount(cmd);
+    status = Tcl_EvalObjEx(interp, cmd, 0);
+    Tcl_DecrRefCount(cmd);
+
+    return status;
+}
+
+static int ProgressbarStartCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    return ProgressbarStartStopCommand(
+	interp, "::ttk::progressbar::start", objc, objv);
+}
+
+static int ProgressbarStopCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    return ProgressbarStartStopCommand(
+	interp, "::ttk::progressbar::stop", objc, objv);
+}
+
+static const Ttk_Ensemble ProgressbarCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "start", 		ProgressbarStartCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { "step", 		ProgressbarStepCommand,0 },
+    { "stop", 		ProgressbarStopCommand,0 },
+    { 0,0,0 }
+};
+
+/*
+ * Widget specification:
+ */
+static WidgetSpec ProgressbarWidgetSpec =
+{
+    "TProgressbar",		/* className */
+    sizeof(Progressbar),	/* recordSize */
+    ProgressbarOptionSpecs,	/* optionSpecs */
+    ProgressbarCommands,	/* subcommands */
+    ProgressbarInitialize,	/* initializeProc */
+    ProgressbarCleanup,		/* cleanupProc */
+    ProgressbarConfigure,	/* configureProc */
+    ProgressbarPostConfigure,	/* postConfigureProc */
+    ProgressbarGetLayout,	/* getLayoutProc */
+    ProgressbarSize, 		/* sizeProc */
+    ProgressbarDoLayout,	/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+/*
+ * Layouts:
+ */
+TTK_BEGIN_LAYOUT(VerticalProgressbarLayout)
+    TTK_GROUP("Vertical.Progressbar.trough", TTK_FILL_BOTH,
+	TTK_NODE("Vertical.Progressbar.pbar", TTK_PACK_BOTTOM|TTK_FILL_X))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalProgressbarLayout)
+    TTK_GROUP("Horizontal.Progressbar.trough", TTK_FILL_BOTH,
+	TTK_NODE("Horizontal.Progressbar.pbar", TTK_PACK_LEFT|TTK_FILL_Y))
+TTK_END_LAYOUT
+
+/*
+ * Initialization:
+ */
+
+MODULE_SCOPE
+void TtkProgressbar_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme themePtr = Ttk_GetDefaultTheme(interp);
+
+    Ttk_RegisterLayout(themePtr,
+	"Vertical.TProgressbar", VerticalProgressbarLayout);
+    Ttk_RegisterLayout(themePtr,
+	"Horizontal.TProgressbar", HorizontalProgressbarLayout);
+
+    RegisterWidget(interp, "ttk::progressbar", &ProgressbarWidgetSpec);
+}
+
+/*EOF*/

generic/ttk/ttkScale.c

@@ -0,0 +1,515 @@
+/*
+ * Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+ *
+ * ttk::scale widget.
+ */
+
+#include <tk.h>
+#include <string.h>
+#include <stdio.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#define DEF_SCALE_LENGTH "100"
+
+#define MAX(a,b) ((a) > (b) ? (a) : (b))
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+
+/*
+ * Scale widget record
+ */
+typedef struct
+{
+    /* slider element options */
+    Tcl_Obj *fromObj;         /* minimum value */
+    Tcl_Obj *toObj;           /* maximum value */
+    Tcl_Obj *valueObj;        /* current value */
+    Tcl_Obj *lengthObj;       /* length of the long axis of the scale */
+    Tcl_Obj *orientObj;       /* widget orientation */
+    int orient;
+
+    /* widget options */
+    Tcl_Obj *commandObj;
+    Tcl_Obj *variableObj;
+
+    /* internal state */
+    Ttk_TraceHandle *variableTrace;
+
+} ScalePart;
+
+typedef struct
+{
+    WidgetCore core;
+    ScalePart  scale;
+} Scale;
+
+static Tk_OptionSpec ScaleOptionSpecs[] =
+{
+    {TK_OPTION_STRING, "-command", "command", "Command", "",
+	Tk_Offset(Scale,scale.commandObj), -1, 
+	TK_OPTION_NULL_OK,0,0},
+    {TK_OPTION_STRING, "-variable", "variable", "Variable", "",
+	Tk_Offset(Scale,scale.variableObj), -1, 
+	0,0,0},
+    {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "horizontal",
+	Tk_Offset(Scale,scale.orientObj),
+	Tk_Offset(Scale,scale.orient), 0, 
+	(ClientData)ttkOrientStrings, STYLE_CHANGED },
+
+    {TK_OPTION_DOUBLE, "-from", "from", "From", "0",
+	Tk_Offset(Scale,scale.fromObj), -1, 0, 0, 0},
+    {TK_OPTION_DOUBLE, "-to", "to", "To", "1.0",
+	Tk_Offset(Scale,scale.toObj), -1, 0, 0, 0},
+    {TK_OPTION_DOUBLE, "-value", "value", "Value", "0",
+	Tk_Offset(Scale,scale.valueObj), -1, 0, 0, 0},
+    {TK_OPTION_PIXELS, "-length", "length", "Length",
+	DEF_SCALE_LENGTH, Tk_Offset(Scale,scale.lengthObj), -1, 0, 0, 
+    	GEOMETRY_CHANGED},
+
+    WIDGET_TAKEFOCUS_TRUE,
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+static XPoint ValueToPoint(Scale *scalePtr, double value);
+static double PointToValue(Scale *scalePtr, int x, int y);
+
+/* ScaleVariableChanged --
+ * 	Variable trace procedure for scale -variable;
+ * 	Updates the scale's value.
+ * 	If the linked variable is not a valid double, 
+ * 	sets the 'invalid' state.
+ */
+static void ScaleVariableChanged(void *recordPtr, const char *value)
+{
+    Scale *scale = recordPtr;
+    double v;
+
+    if (value == NULL || Tcl_GetDouble(0, value, &v) != TCL_OK) {
+	TtkWidgetChangeState(&scale->core, TTK_STATE_INVALID, 0);
+    } else {
+	Tcl_Obj *valueObj = Tcl_NewDoubleObj(v);
+	Tcl_IncrRefCount(valueObj);
+	Tcl_DecrRefCount(scale->scale.valueObj);
+	scale->scale.valueObj = valueObj;
+	TtkWidgetChangeState(&scale->core, 0, TTK_STATE_INVALID);
+    }
+    TtkRedisplayWidget(&scale->core);
+}
+
+/* ScaleInitialize --
+ * 	Scale widget initialization hook.
+ */
+static void ScaleInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+    Scale *scalePtr = recordPtr;
+    TtkTrackElementState(&scalePtr->core);
+}
+
+static void ScaleCleanup(void *recordPtr)
+{
+    Scale *scale = recordPtr;
+
+    if (scale->scale.variableTrace) {
+	Ttk_UntraceVariable(scale->scale.variableTrace);
+	scale->scale.variableTrace = 0;
+    }
+}
+
+/* ScaleConfigure --
+ * 	Configuration hook.
+ */
+static int ScaleConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Scale *scale = recordPtr;
+    Tcl_Obj *varName = scale->scale.variableObj;
+    Ttk_TraceHandle *vt = 0;
+
+    if (varName != NULL && *Tcl_GetString(varName) != '\0') {
+	vt = Ttk_TraceVariable(interp,varName, ScaleVariableChanged,recordPtr);
+	if (!vt) return TCL_ERROR;
+    }
+
+    if (TtkCoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+	if (vt) Ttk_UntraceVariable(vt);
+	return TCL_ERROR;
+    }
+
+    if (scale->scale.variableTrace) {
+	Ttk_UntraceVariable(scale->scale.variableTrace);
+    }
+    scale->scale.variableTrace = vt;
+
+    return TCL_OK;
+}
+
+/* ScalePostConfigure --
+ * 	Post-configuration hook.
+ */
+static int ScalePostConfigure(
+    Tcl_Interp *interp, void *recordPtr, int mask)
+{
+    Scale *scale = recordPtr;
+    int status = TCL_OK;
+
+    if (scale->scale.variableTrace) {
+	status = Ttk_FireTrace(scale->scale.variableTrace);
+	if (WidgetDestroyed(&scale->core)) {
+	    return TCL_ERROR;
+	}
+	if (status != TCL_OK) {
+	    /* Unset -variable: */
+	    Ttk_UntraceVariable(scale->scale.variableTrace);
+	    Tcl_DecrRefCount(scale->scale.variableObj);
+	    scale->scale.variableTrace = 0;
+	    scale->scale.variableObj = NULL;
+	    status = TCL_ERROR;
+	}
+    }
+
+    return status;
+}
+
+/* ScaleGetLayout --
+ *	getLayout hook.
+ */
+static Ttk_Layout 
+ScaleGetLayout(Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+    Scale *scalePtr = recordPtr;
+    return TtkWidgetGetOrientedLayout(
+	interp, theme, recordPtr, scalePtr->scale.orientObj);
+}
+
+/*
+ * TroughBox --
+ * 	Returns the inner area of the trough element.
+ */
+static Ttk_Box TroughBox(Scale *scalePtr)
+{
+    return Ttk_ClientRegion(scalePtr->core.layout, "trough");
+}
+
+/*
+ * TroughRange --
+ * 	Return the value area of the trough element, adjusted
+ * 	for slider size.
+ */
+static Ttk_Box TroughRange(Scale *scalePtr)
+{
+    Ttk_Box troughBox = TroughBox(scalePtr);
+    Ttk_Element slider = Ttk_FindElement(scalePtr->core.layout,"slider");
+
+    /*
+     * If this is a scale widget, adjust range for slider:
+     */
+    if (slider) {
+	Ttk_Box sliderBox = Ttk_ElementParcel(slider);
+	if (scalePtr->scale.orient == TTK_ORIENT_HORIZONTAL) {
+	    troughBox.x += sliderBox.width / 2;
+	    troughBox.width -= sliderBox.width;
+	} else {
+	    troughBox.y += sliderBox.height / 2;
+	    troughBox.height -= sliderBox.height;
+	}
+    }
+
+    return troughBox;
+}
+
+/*
+ * ScaleFraction --
+ */
+static double ScaleFraction(Scale *scalePtr, double value)
+{
+    double from = 0, to = 1, fraction;
+
+    Tcl_GetDoubleFromObj(NULL, scalePtr->scale.fromObj, &from);
+    Tcl_GetDoubleFromObj(NULL, scalePtr->scale.toObj, &to);
+
+    if (from == to) {
+	return 1.0;
+    }
+
+    fraction = (value - from) / (to - from);
+
+    return fraction < 0 ? 0 : fraction > 1 ? 1 : fraction;
+}
+
+/* $scale get ?x y? --
+ * 	Returns the current value of the scale widget, or if $x and 
+ * 	$y are specified, the value represented by point @x,y.
+ */
+static int
+ScaleGetCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Scale *scalePtr = recordPtr;
+    int x, y, r = TCL_OK;
+    double value = 0;
+
+    if ((objc != 2) && (objc != 4)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?");
+	return TCL_ERROR;
+    }
+    if (objc == 2) {
+	Tcl_SetObjResult(interp, scalePtr->scale.valueObj);
+    } else {
+	r = Tcl_GetIntFromObj(interp, objv[2], &x);
+	if (r == TCL_OK)
+	    r = Tcl_GetIntFromObj(interp, objv[3], &y);
+	if (r == TCL_OK) {
+	    value = PointToValue(scalePtr, x, y);
+	    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(value));
+	}
+    }
+    return r;
+}
+
+/* $scale set $newValue
+ */
+static int
+ScaleSetCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Scale *scalePtr = recordPtr;
+    double from = 0.0, to = 1.0, value;
+    int result = TCL_OK;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "set value");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (scalePtr->core.state & TTK_STATE_DISABLED) {
+	return TCL_OK;
+    }
+
+    /* ASSERT: fromObj and toObj are valid doubles.
+     */
+    Tcl_GetDoubleFromObj(interp, scalePtr->scale.fromObj, &from);
+    Tcl_GetDoubleFromObj(interp, scalePtr->scale.toObj, &to);
+
+    /* Limit new value to between 'from' and 'to':
+     */
+    if (from < to) {
+	value = value < from ? from : value > to ? to : value;
+    } else {
+	value = value < to ? to : value > from ? from : value;
+    }
+
+    /*
+     * Set value:
+     */
+    Tcl_DecrRefCount(scalePtr->scale.valueObj);
+    scalePtr->scale.valueObj = Tcl_NewDoubleObj(value);
+    Tcl_IncrRefCount(scalePtr->scale.valueObj);
+    TtkRedisplayWidget(&scalePtr->core);
+
+    /*
+     * Set attached variable, if any:
+     */
+    if (scalePtr->scale.variableObj != NULL) {
+	Tcl_ObjSetVar2(interp, scalePtr->scale.variableObj, NULL,
+	    scalePtr->scale.valueObj, TCL_GLOBAL_ONLY);
+    }
+    if (WidgetDestroyed(&scalePtr->core)) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Invoke -command, if any:
+     */
+    if (scalePtr->scale.commandObj != NULL) {
+	Tcl_Obj *cmdObj = Tcl_DuplicateObj(scalePtr->scale.commandObj);
+	Tcl_IncrRefCount(cmdObj);
+	Tcl_AppendToObj(cmdObj, " ", 1);
+	Tcl_AppendObjToObj(cmdObj, scalePtr->scale.valueObj);
+	result = Tcl_EvalObjEx(interp, cmdObj, TCL_EVAL_GLOBAL);
+	Tcl_DecrRefCount(cmdObj);
+    }
+
+    return result;
+}
+
+static int
+ScaleCoordsCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Scale *scalePtr = recordPtr;
+    double value;
+    int r = TCL_OK;
+
+    if (objc < 2 || objc > 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?");
+	return TCL_ERROR;
+    }
+
+    if (objc == 3) {
+	r = Tcl_GetDoubleFromObj(interp, objv[2], &value);
+    } else {
+	r = Tcl_GetDoubleFromObj(interp, scalePtr->scale.valueObj, &value);
+    }
+
+    if (r == TCL_OK) {
+	Tcl_Obj *point[2];
+	XPoint pt = ValueToPoint(scalePtr, value);
+	point[0] = Tcl_NewIntObj(pt.x);
+	point[1] = Tcl_NewIntObj(pt.y);
+	Tcl_SetObjResult(interp, Tcl_NewListObj(2, point));
+    }
+    return r;
+}
+
+static void ScaleDoLayout(void *clientData)
+{
+    WidgetCore *corePtr = clientData;
+    Ttk_Element slider = Ttk_FindElement(corePtr->layout, "slider");
+
+    Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+
+    /* Adjust the slider position:
+     */
+    if (slider) {
+	Scale *scalePtr = clientData;
+	Ttk_Box troughBox = TroughBox(scalePtr);
+	Ttk_Box sliderBox = Ttk_ElementParcel(slider);
+	double value = 0.0;
+	double fraction;
+	int range;
+
+	Tcl_GetDoubleFromObj(NULL, scalePtr->scale.valueObj, &value);
+	fraction = ScaleFraction(scalePtr, value);
+
+	if (scalePtr->scale.orient == TTK_ORIENT_HORIZONTAL) {
+	    range = troughBox.width - sliderBox.width;
+	    sliderBox.x += (int)(fraction * range);
+	} else {
+	    range = troughBox.height - sliderBox.height;
+	    sliderBox.y += (int)(fraction * range);
+	}
+	Ttk_PlaceElement(corePtr->layout, slider, sliderBox);
+    }
+}
+
+/*
+ * ScaleSize --
+ * 	Compute requested size of scale.
+ */
+static int ScaleSize(void *clientData, int *widthPtr, int *heightPtr)
+{
+    WidgetCore *corePtr = clientData;
+    Scale *scalePtr = clientData;
+    int length;
+
+    Ttk_LayoutSize(corePtr->layout, corePtr->state, widthPtr, heightPtr);
+
+    /* Assert the -length configuration option */
+    Tk_GetPixelsFromObj(NULL, corePtr->tkwin,
+	    scalePtr->scale.lengthObj, &length);
+    if (scalePtr->scale.orient == TTK_ORIENT_VERTICAL) {
+	*heightPtr = MAX(*heightPtr, length);
+    } else {
+	*widthPtr = MAX(*widthPtr, length);
+    }
+
+    return 1;
+}
+
+static double
+PointToValue(Scale *scalePtr, int x, int y)
+{
+    Ttk_Box troughBox = TroughRange(scalePtr);
+    double from = 0, to = 1, fraction;
+
+    Tcl_GetDoubleFromObj(NULL, scalePtr->scale.fromObj, &from);
+    Tcl_GetDoubleFromObj(NULL, scalePtr->scale.toObj, &to);
+
+    if (scalePtr->scale.orient == TTK_ORIENT_HORIZONTAL) {
+	fraction = (double)(x - troughBox.x) / (double)troughBox.width;
+    } else {
+	fraction = (double)(y - troughBox.y) / (double)troughBox.height;
+    }
+
+    fraction = fraction < 0 ? 0 : fraction > 1 ? 1 : fraction;
+
+    return from + fraction * (to-from);
+}
+
+/*
+ * Return the center point in the widget corresponding to the given
+ * value. This point can be used to center the slider.
+ */
+
+static XPoint
+ValueToPoint(Scale *scalePtr, double value)
+{
+    Ttk_Box troughBox = TroughRange(scalePtr);
+    double fraction = ScaleFraction(scalePtr, value);
+    XPoint pt = {0, 0};
+
+    if (scalePtr->scale.orient == TTK_ORIENT_HORIZONTAL) {
+	pt.x = troughBox.x + (int)(fraction * troughBox.width);
+	pt.y = troughBox.y + troughBox.height / 2;
+    } else {
+	pt.x = troughBox.x + troughBox.width / 2;
+	pt.y = troughBox.y + (int)(fraction * troughBox.height);
+    }
+    return pt;
+}
+
+static const Ttk_Ensemble ScaleCommands[] = {
+    { "configure",   TtkWidgetConfigureCommand,0 },
+    { "cget",        TtkWidgetCgetCommand,0 },
+    { "state",       TtkWidgetStateCommand,0 },
+    { "instate",     TtkWidgetInstateCommand,0 },
+    { "identify",    TtkWidgetIdentifyCommand,0 },
+    { "set",         ScaleSetCommand,0 },
+    { "get",         ScaleGetCommand,0 },
+    { "coords",      ScaleCoordsCommand,0 },
+    { 0,0,0 }
+};
+
+static WidgetSpec ScaleWidgetSpec =
+{
+    "TScale",			/* Class name */
+    sizeof(Scale),		/* record size */
+    ScaleOptionSpecs,		/* option specs */
+    ScaleCommands,		/* widget commands */
+    ScaleInitialize,		/* initialization proc */
+    ScaleCleanup,		/* cleanup proc */
+    ScaleConfigure,		/* configure proc */
+    ScalePostConfigure,		/* postConfigure */
+    ScaleGetLayout, 		/* getLayoutProc */
+    ScaleSize,			/* sizeProc */
+    ScaleDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(VerticalScaleLayout)
+    TTK_GROUP("Vertical.Scale.trough", TTK_FILL_BOTH,
+	TTK_NODE("Vertical.Scale.slider", TTK_PACK_TOP) )
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalScaleLayout)
+    TTK_GROUP("Horizontal.Scale.trough", TTK_FILL_BOTH,
+	TTK_NODE("Horizontal.Scale.slider", TTK_PACK_LEFT) )
+TTK_END_LAYOUT
+
+/*
+ * Initialization.
+ */
+MODULE_SCOPE
+void TtkScale_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+    Ttk_RegisterLayout(theme, "Vertical.TScale", VerticalScaleLayout);
+    Ttk_RegisterLayout(theme, "Horizontal.TScale", HorizontalScaleLayout);
+
+    RegisterWidget(interp, "ttk::scale", &ScaleWidgetSpec);
+}
+

generic/ttk/ttkScroll.c

@@ -0,0 +1,258 @@
+/*
+ * Copyright 2004, Joe English
+ *
+ * Support routines for scrollable widgets.
+ *
+ * (This is sort of half-baked; needs some work)
+ *
+ * Scrollable interface:
+ *
+ * 	+ 'first' is controlled by [xy]view widget command
+ * 	  and other scrolling commands like 'see';
+ *      + 'total' depends on widget contents;
+ *      + 'last' depends on first, total, and widget size.
+ *
+ * Choreography (typical usage):
+ *
+ * 	1. User adjusts scrollbar, scrollbar widget calls its -command
+ * 	2. Scrollbar -command invokes the scrollee [xy]view widget method
+ * 	3. TtkScrollviewCommand calls TtkScrollTo(), which updates
+ * 	   'first' and schedules a redisplay.
+ * 	4. Once the scrollee knows 'total' and 'last' (typically in
+ * 	   the LayoutProc), call TtkScrolled(h,first,last,total) to
+ * 	   synchronize the scrollbar.
+ * 	5. The scrollee -[xy]scrollcommand is called (in an idle callback)
+ * 	6. Which calls the scrollbar 'set' method and redisplays the scrollbar.
+ *
+ * If the scrollee has internal scrolling (e.g., a 'see' method),
+ * it should TtkScrollTo() directly (step 2).
+ *
+ * If the widget value changes, it should call TtkScrolled() (step 4).
+ * (This usually happens automatically when the widget is redisplayed).
+ *
+ * If the scrollee's -[xy]scrollcommand changes, it should call
+ * TtkScrollbarUpdateRequired, which will invoke step (5) (@@@ Fix this)
+ */
+
+#include <tkInt.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/* Private data:
+ */
+#define SCROLL_UPDATE_PENDING  (0x1)
+#define SCROLL_UPDATE_REQUIRED (0x2)
+
+struct ScrollHandleRec
+{
+    unsigned 	flags;
+    WidgetCore	*corePtr;
+    Scrollable	*scrollPtr;
+};
+
+/* TtkCreateScrollHandle --
+ * 	Initialize scroll handle.
+ */
+ScrollHandle TtkCreateScrollHandle(WidgetCore *corePtr, Scrollable *scrollPtr)
+{
+    ScrollHandle h = ckalloc(sizeof(*h));
+
+    h->flags = 0;
+    h->corePtr = corePtr;
+    h->scrollPtr = scrollPtr;
+
+    scrollPtr->first = 0;
+    scrollPtr->last = 1;
+    scrollPtr->total = 1;
+    return h;
+}
+
+/* UpdateScrollbar --
+ *	Call the -scrollcommand callback to sync the scrollbar.
+ * 	Returns: Whatever the -scrollcommand does.
+ */
+static int UpdateScrollbar(Tcl_Interp *interp, ScrollHandle h)
+{
+    Scrollable *s = h->scrollPtr;
+    WidgetCore *corePtr = h->corePtr;
+    char arg1[TCL_DOUBLE_SPACE + 2];
+    char arg2[TCL_DOUBLE_SPACE + 2];
+    int code;
+    Tcl_DString buf;
+
+    h->flags &= ~SCROLL_UPDATE_REQUIRED;
+
+    if (s->scrollCmd == NULL) {
+	return TCL_OK;
+    }
+
+    arg1[0] = arg2[0] = ' ';
+    Tcl_PrintDouble(interp, (double)s->first / s->total, arg1+1);
+    Tcl_PrintDouble(interp, (double)s->last / s->total, arg2+1);
+    Tcl_DStringInit(&buf);
+    Tcl_DStringAppend(&buf, s->scrollCmd, -1);
+    Tcl_DStringAppend(&buf, arg1, -1);
+    Tcl_DStringAppend(&buf, arg2, -1);
+
+    Tcl_Preserve(corePtr);
+    code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, TCL_EVAL_GLOBAL);
+    Tcl_DStringFree(&buf);
+    if (WidgetDestroyed(corePtr)) {
+	Tcl_Release(corePtr);
+	return TCL_ERROR;
+    }
+    Tcl_Release(corePtr);
+
+    if (code != TCL_OK && !Tcl_InterpDeleted(interp)) {
+	/* Disable the -scrollcommand, add to stack trace:
+	 */
+	ckfree(s->scrollCmd);
+	s->scrollCmd = 0;
+
+	Tcl_AddErrorInfo(interp, /* @@@ "horizontal" / "vertical" */
+		"\n    (scrolling command executed by ");
+	Tcl_AddErrorInfo(interp, Tk_PathName(h->corePtr->tkwin));
+	Tcl_AddErrorInfo(interp, ")");
+    }
+    return code;
+}
+
+/* UpdateScrollbarBG --
+ * 	Idle handler to update the scrollbar.
+ */
+static void UpdateScrollbarBG(ClientData clientData)
+{
+    ScrollHandle h = (ScrollHandle)clientData;
+    Tcl_Interp *interp = h->corePtr->interp;
+    int code;
+
+    h->flags &= ~SCROLL_UPDATE_PENDING;
+    Tcl_Preserve((ClientData) interp);
+    code = UpdateScrollbar(interp, h);
+    if (code == TCL_ERROR && !Tcl_InterpDeleted(interp)) {
+	Tcl_BackgroundException(interp, code);
+    }
+    Tcl_Release((ClientData) interp);
+}
+
+/* TtkScrolled --
+ * 	Update scroll info, schedule scrollbar update.
+ */
+void TtkScrolled(ScrollHandle h, int first, int last, int total)
+{
+    Scrollable *s = h->scrollPtr;
+
+    /* Sanity-check inputs:
+     */
+    if (total <= 0) {
+	first = 0;
+	last = 1;
+	total = 1;
+    }
+
+    if (last > total) {
+	first -= (last - total);
+	if (first < 0) first = 0;
+	last = total;
+    }
+
+    if (s->first != first || s->last != last || s->total != total
+	    || (h->flags & SCROLL_UPDATE_REQUIRED))
+    {
+	s->first = first;
+	s->last = last;
+	s->total = total;
+
+	if (!(h->flags & SCROLL_UPDATE_PENDING)) {
+	    Tcl_DoWhenIdle(UpdateScrollbarBG, (ClientData)h);
+	    h->flags |= SCROLL_UPDATE_PENDING;
+	}
+    }
+}
+
+/* TtkScrollbarUpdateRequired --
+ * 	Force a scrollbar update at the next call to TtkScrolled(),
+ * 	even if scroll parameters haven't changed (e.g., if
+ * 	-yscrollcommand has changed).
+ */
+
+void TtkScrollbarUpdateRequired(ScrollHandle h)
+{
+    h->flags |= SCROLL_UPDATE_REQUIRED;
+}
+
+/* TtkScrollviewCommand --
+ * 	Widget [xy]view command implementation.
+ *
+ *  $w [xy]view -- return current view region
+ *  $w [xy]view $index -- set topmost item
+ *  $w [xy]view moveto $fraction
+ *  $w [xy]view scroll $number $what -- scrollbar interface
+ */
+int TtkScrollviewCommand(
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], ScrollHandle h)
+{
+    Scrollable *s = h->scrollPtr;
+    int newFirst = s->first;
+
+    if (objc == 2) {
+	Tcl_Obj *result[2];
+	result[0] = Tcl_NewDoubleObj((double)s->first / s->total);
+	result[1] = Tcl_NewDoubleObj((double)s->last / s->total);
+	Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
+	return TCL_OK;
+    } else if (objc == 3) {
+	if (Tcl_GetIntFromObj(interp, objv[2], &newFirst) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else {
+	double fraction;
+	int count;
+
+	switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) {
+	    case TK_SCROLL_ERROR:
+		return TCL_ERROR;
+	    case TK_SCROLL_MOVETO:
+		newFirst = (int) ((fraction * s->total) + 0.5);
+		break;
+	    case TK_SCROLL_UNITS:
+		newFirst = s->first + count;
+		break;
+	    case TK_SCROLL_PAGES: {
+		int perPage = s->last - s->first;	/* @@@ */
+		newFirst = s->first + count * perPage;
+		break;
+	    }
+	}
+    }
+
+    TtkScrollTo(h, newFirst);
+
+    return TCL_OK;
+}
+
+void TtkScrollTo(ScrollHandle h, int newFirst)
+{
+    Scrollable *s = h->scrollPtr;
+
+    if (newFirst >= s->total)
+	newFirst = s->total - 1;
+    if (newFirst > s->first && s->last >= s->total) /* don't scroll past end */
+	newFirst = s->first;
+    if (newFirst < 0)
+	newFirst = 0;
+
+    if (newFirst != s->first) {
+	s->first = newFirst;
+	TtkRedisplayWidget(h->corePtr);
+    }
+}
+
+void TtkFreeScrollHandle(ScrollHandle h)
+{
+    if (h->flags & SCROLL_UPDATE_PENDING) {
+	Tcl_CancelIdleCall(UpdateScrollbarBG, (ClientData)h);
+    }
+    ckfree(h);
+}
+

generic/ttk/ttkScrollbar.c

@@ -0,0 +1,345 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * ttk::scrollbar widget.
+ */
+
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*------------------------------------------------------------------------
+ * +++ Scrollbar widget record.
+ */
+typedef struct
+{
+    Tcl_Obj	*commandObj;
+
+    int 	orient;
+    Tcl_Obj	*orientObj;
+
+    double	first;			/* top fraction */
+    double	last;			/* bottom fraction */
+
+    Ttk_Box	troughBox;		/* trough parcel */ 
+    int 	minSize;		/* minimum size of thumb */
+} ScrollbarPart;
+
+typedef struct
+{
+    WidgetCore core;
+    ScrollbarPart scrollbar;
+} Scrollbar;
+
+static Tk_OptionSpec ScrollbarOptionSpecs[] =
+{
+    {TK_OPTION_STRING, "-command", "command", "Command", "",
+	Tk_Offset(Scrollbar,scrollbar.commandObj), -1, 0,0,0},
+
+    {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "vertical",
+	Tk_Offset(Scrollbar,scrollbar.orientObj),
+	Tk_Offset(Scrollbar,scrollbar.orient),
+	0,(ClientData)ttkOrientStrings,STYLE_CHANGED },
+
+    WIDGET_TAKEFOCUS_FALSE,
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget hooks.
+ */
+
+static void 
+ScrollbarInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+    Scrollbar *sb = recordPtr;
+    sb->scrollbar.first = 0.0;
+    sb->scrollbar.last = 1.0;
+
+    TtkTrackElementState(&sb->core);
+}
+
+static Ttk_Layout ScrollbarGetLayout(
+    Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+    Scrollbar *sb = recordPtr;
+    return TtkWidgetGetOrientedLayout(
+	interp, theme, recordPtr, sb->scrollbar.orientObj);
+}
+
+/*
+ * ScrollbarDoLayout --
+ * 	Layout hook.  Adjusts the position of the scrollbar thumb.
+ *
+ * Side effects:
+ * 	Sets sb->troughBox and sb->minSize.
+ */
+static void ScrollbarDoLayout(void *recordPtr)
+{
+    Scrollbar *sb = recordPtr;
+    WidgetCore *corePtr = &sb->core;
+    Ttk_Element thumb;
+    Ttk_Box thumbBox;
+    int thumbWidth, thumbHeight;
+    double first, last, size;
+    int minSize;
+
+    /*
+     * Use generic layout manager to compute initial layout:
+     */
+    Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+
+    /*
+     * Locate thumb element, extract parcel and requested minimum size:
+     */
+    thumb = Ttk_FindElement(corePtr->layout, "thumb");
+    if (!thumb)	/* Something has gone wrong -- bail */
+	return;
+
+    sb->scrollbar.troughBox = thumbBox = Ttk_ElementParcel(thumb);
+    Ttk_LayoutNodeReqSize(
+	corePtr->layout, thumb, &thumbWidth,&thumbHeight);
+
+    /*
+     * Adjust thumb element parcel:
+     */
+    first = sb->scrollbar.first;
+    last  = sb->scrollbar.last;
+
+    if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) {
+	minSize = thumbHeight;
+	size = thumbBox.height - minSize;
+	thumbBox.y += (int)(size * first);
+	thumbBox.height = (int)(size * last) + minSize - (int)(size * first);
+    } else {
+	minSize = thumbWidth;
+	size = thumbBox.width - minSize;
+	thumbBox.x += (int)(size * first);
+	thumbBox.width = (int)(size * last) + minSize - (int)(size * first);
+    }
+    sb->scrollbar.minSize = minSize;
+    Ttk_PlaceElement(corePtr->layout, thumb, thumbBox);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands.
+ */
+
+/* $sb set $first $last --
+ * 	Set the position of the scrollbar.
+ */
+static int
+ScrollbarSetCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Scrollbar *scrollbar = recordPtr;
+    Tcl_Obj *firstObj, *lastObj;
+    double first, last;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "first last");
+	return TCL_ERROR;
+    }
+
+    firstObj = objv[2];
+    lastObj = objv[3];
+    if (Tcl_GetDoubleFromObj(interp, firstObj, &first) != TCL_OK
+	|| Tcl_GetDoubleFromObj(interp, lastObj, &last) != TCL_OK)
+	return TCL_ERROR;
+
+    /* Range-checks:
+     */
+    if (first < 0.0) {
+	first = 0.0;
+    } else if (first > 1.0) {
+	first = 1.0;
+    }
+
+    if (last < first) {
+	last = first;
+    } else if (last > 1.0) {
+	last = 1.0;
+    }
+
+    /* ASSERT: 0.0 <= first <= last <= 1.0 */
+
+    scrollbar->scrollbar.first = first;
+    scrollbar->scrollbar.last = last;
+    if (first <= 0.0 && last >= 1.0) {
+	scrollbar->core.state |= TTK_STATE_DISABLED;
+    } else {
+	scrollbar->core.state &= ~TTK_STATE_DISABLED;
+    }
+
+    TtkRedisplayWidget(&scrollbar->core);
+
+    return TCL_OK;
+}
+
+/* $sb get --
+ * 	Returns the last thing passed to 'set'.
+ */
+static int
+ScrollbarGetCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Scrollbar *scrollbar = recordPtr;
+    Tcl_Obj *result[2];
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 2, objv, "");
+	return TCL_ERROR;
+    }
+
+    result[0] = Tcl_NewDoubleObj(scrollbar->scrollbar.first);
+    result[1] = Tcl_NewDoubleObj(scrollbar->scrollbar.last);
+    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
+
+    return TCL_OK;
+}
+
+/* $sb delta $dx $dy --
+ * 	Returns the percentage change corresponding to a mouse movement
+ * 	of $dx, $dy.
+ */
+static int
+ScrollbarDeltaCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Scrollbar *sb = recordPtr;
+    double dx, dy;
+    double delta = 0.0;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "dx dy");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetDoubleFromObj(interp, objv[2], &dx) != TCL_OK
+	|| Tcl_GetDoubleFromObj(interp, objv[3], &dy) != TCL_OK)
+    {
+	return TCL_ERROR;
+    }
+
+    delta = 0.0;
+    if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) {
+	int size = sb->scrollbar.troughBox.height - sb->scrollbar.minSize;
+	if (size > 0) {
+	    delta = (double)dy / (double)size;
+	}
+    } else {
+	int size = sb->scrollbar.troughBox.width - sb->scrollbar.minSize;
+	if (size > 0) {
+	    delta = (double)dx / (double)size;
+	}
+    }
+
+    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(delta));
+    return TCL_OK;
+}
+
+/* $sb fraction $x $y --
+ * 	Returns a real number between 0 and 1 indicating  where  the
+ * 	point given by x and y lies in the trough area of the scrollbar. 
+ */
+static int
+ScrollbarFractionCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    Scrollbar *sb = recordPtr;
+    Ttk_Box b = sb->scrollbar.troughBox;
+    int minSize = sb->scrollbar.minSize;
+    double x, y;
+    double fraction = 0.0;
+
+    if (objc != 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "x y");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetDoubleFromObj(interp, objv[2], &x) != TCL_OK
+	|| Tcl_GetDoubleFromObj(interp, objv[3], &y) != TCL_OK)
+    {
+	return TCL_ERROR;
+    }
+
+    fraction = 0.0;
+    if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) {
+	if (b.height > minSize) {
+	    fraction = (double)(y - b.y) / (double)(b.height - minSize);
+	}
+    } else {
+	if (b.width > minSize) {
+	    fraction = (double)(x - b.x) / (double)(b.width - minSize);
+	}
+    }
+
+    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction));
+    return TCL_OK;
+}
+
+static const Ttk_Ensemble ScrollbarCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "delta",    	ScrollbarDeltaCommand,0 },
+    { "fraction",    	ScrollbarFractionCommand,0 },
+    { "get",    	ScrollbarGetCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "set",  		ScrollbarSetCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { 0,0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget specification.
+ */
+static WidgetSpec ScrollbarWidgetSpec =
+{
+    "TScrollbar",		/* className */
+    sizeof(Scrollbar),		/* recordSize */
+    ScrollbarOptionSpecs,	/* optionSpecs */
+    ScrollbarCommands,		/* subcommands */
+    ScrollbarInitialize,	/* initializeProc */
+    TtkNullCleanup,		/* cleanupProc */
+    TtkCoreConfigure,		/* configureProc */
+    TtkNullPostConfigure,	/* postConfigureProc */
+    ScrollbarGetLayout,		/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    ScrollbarDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(VerticalScrollbarLayout)
+    TTK_GROUP("Vertical.Scrollbar.trough", TTK_FILL_Y,
+	TTK_NODE("Vertical.Scrollbar.uparrow", TTK_PACK_TOP)
+	TTK_NODE("Vertical.Scrollbar.downarrow", TTK_PACK_BOTTOM)
+	TTK_NODE(
+	    "Vertical.Scrollbar.thumb", TTK_PACK_TOP|TTK_EXPAND|TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalScrollbarLayout)
+    TTK_GROUP("Horizontal.Scrollbar.trough", TTK_FILL_X,
+	TTK_NODE("Horizontal.Scrollbar.leftarrow", TTK_PACK_LEFT)
+	TTK_NODE("Horizontal.Scrollbar.rightarrow", TTK_PACK_RIGHT)
+	TTK_NODE(
+	"Horizontal.Scrollbar.thumb", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+MODULE_SCOPE
+void TtkScrollbar_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+    Ttk_RegisterLayout(theme,"Vertical.TScrollbar",VerticalScrollbarLayout);
+    Ttk_RegisterLayout(theme,"Horizontal.TScrollbar",HorizontalScrollbarLayout);
+
+    RegisterWidget(interp, "ttk::scrollbar", &ScrollbarWidgetSpec);
+}
+
+/*EOF*/

generic/ttk/ttkSeparator.c

@@ -0,0 +1,136 @@
+/*
+ * Copyright (c) 2004, Joe English
+ *
+ * ttk::separator and ttk::sizegrip widgets.
+ */
+
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/* +++ Separator widget record:
+ */
+typedef struct
+{
+    Tcl_Obj	*orientObj;
+    int 	orient;
+} SeparatorPart;
+
+typedef struct
+{
+    WidgetCore core;
+    SeparatorPart separator;
+} Separator;
+
+static Tk_OptionSpec SeparatorOptionSpecs[] = {
+    {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "horizontal",
+	Tk_Offset(Separator,separator.orientObj),
+	Tk_Offset(Separator,separator.orient),
+	0,(ClientData)ttkOrientStrings,STYLE_CHANGED },
+
+    WIDGET_TAKEFOCUS_FALSE,
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*
+ * GetLayout hook --
+ * 	Choose layout based on -orient option.
+ */
+static Ttk_Layout SeparatorGetLayout(
+    Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+    Separator *sep = recordPtr;
+    return TtkWidgetGetOrientedLayout(
+	interp, theme, recordPtr, sep->separator.orientObj);
+}
+
+/*
+ * Widget commands:
+ */
+static const Ttk_Ensemble SeparatorCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { 0,0,0 }
+};
+
+/*
+ * Widget specification:
+ */
+static WidgetSpec SeparatorWidgetSpec =
+{
+    "TSeparator",		/* className */
+    sizeof(Separator),		/* recordSize */
+    SeparatorOptionSpecs,	/* optionSpecs */
+    SeparatorCommands,		/* subcommands */
+    TtkNullInitialize,		/* initializeProc */
+    TtkNullCleanup,		/* cleanupProc */
+    TtkCoreConfigure,		/* configureProc */
+    TtkNullPostConfigure,	/* postConfigureProc */
+    SeparatorGetLayout,		/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    TtkWidgetDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(SeparatorLayout)
+    TTK_NODE("Separator.separator", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+/* +++ Sizegrip widget:
+ * 	Has no options or methods other than the standard ones.
+ */
+
+static Tk_OptionSpec SizegripOptionSpecs[] = {
+    WIDGET_TAKEFOCUS_FALSE,
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+static const Ttk_Ensemble SizegripCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { 0,0,0 }
+};
+
+static WidgetSpec SizegripWidgetSpec =
+{
+    "TSizegrip",		/* className */
+    sizeof(WidgetCore),		/* recordSize */
+    SizegripOptionSpecs, 	/* optionSpecs */
+    SizegripCommands,		/* subcommands */
+    TtkNullInitialize,		/* initializeProc */
+    TtkNullCleanup,		/* cleanupProc */
+    TtkCoreConfigure,		/* configureProc */
+    TtkNullPostConfigure,	/* postConfigureProc */
+    TtkWidgetGetLayout, 	/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    TtkWidgetDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(SizegripLayout)
+    TTK_NODE("Sizegrip.sizegrip", TTK_PACK_BOTTOM|TTK_STICK_S|TTK_STICK_E)
+TTK_END_LAYOUT
+
+/* +++ Initialization:
+ */
+
+MODULE_SCOPE
+void TtkSeparator_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+    Ttk_RegisterLayout(theme, "TSeparator", SeparatorLayout);
+    Ttk_RegisterLayout(theme, "TSizegrip", SizegripLayout);
+
+    RegisterWidget(interp, "ttk::separator", &SeparatorWidgetSpec);
+    RegisterWidget(interp, "ttk::sizegrip", &SizegripWidgetSpec);
+}
+
+/*EOF*/

generic/ttk/ttkSquare.c

@@ -0,0 +1,301 @@
+/* square.c - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+ *
+ * Minimal sample ttk widget.
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#if defined(TTK_SQUARE_WIDGET) || 1
+
+#ifndef DEFAULT_BORDERWIDTH
+#define DEFAULT_BORDERWIDTH "2"
+#endif
+
+/*
+ * First, we setup the widget record. The Ttk package provides a structure
+ * that contains standard widget data so it is only necessary to define
+ * a structure that holds the data required for our widget. We do this by
+ * defining a widget part and then specifying the widget record as the
+ * concatenation of the two structures.
+ */
+
+typedef struct
+{
+    Tcl_Obj *widthObj;
+    Tcl_Obj *heightObj;
+    Tcl_Obj *reliefObj;
+    Tcl_Obj *borderWidthObj;
+    Tcl_Obj *foregroundObj;
+    Tcl_Obj *paddingObj;
+    Tcl_Obj *anchorObj;
+} SquarePart;
+
+typedef struct
+{
+    WidgetCore core;
+    SquarePart square;
+} Square;
+
+/*
+ * Widget options.
+ *
+ * This structure is the same as the option specification structure used
+ * for Tk widgets. For each option we provide the type, name and options
+ * database name and class name and the position in the structure and
+ * default values. At the bottom we bring in the standard widget option
+ * defined for all widgets.
+ */
+
+static Tk_OptionSpec SquareOptionSpecs[] =
+{
+    {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+     DEFAULT_BORDERWIDTH, Tk_Offset(Square,square.borderWidthObj), -1,
+     0,0,GEOMETRY_CHANGED },
+    {TK_OPTION_BORDER, "-foreground", "foreground", "Foreground",
+     DEFAULT_BACKGROUND, Tk_Offset(Square,square.foregroundObj),
+     -1, 0, 0, 0},
+    
+    {TK_OPTION_PIXELS, "-width", "width", "Width",
+     "50", Tk_Offset(Square,square.widthObj), -1, 0, 0,
+     GEOMETRY_CHANGED},
+    {TK_OPTION_PIXELS, "-height", "height", "Height",
+     "50", Tk_Offset(Square,square.heightObj), -1, 0, 0,
+     GEOMETRY_CHANGED},
+    
+    {TK_OPTION_STRING, "-padding", "padding", "Pad", NULL,
+     Tk_Offset(Square,square.paddingObj), -1, 
+     TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+    
+    {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+     NULL, Tk_Offset(Square,square.reliefObj), -1, TK_OPTION_NULL_OK, 0, 0},
+    
+    {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+     NULL, Tk_Offset(Square,square.anchorObj), -1, TK_OPTION_NULL_OK, 0, 0},
+    
+    WIDGET_TAKEFOCUS_TRUE,
+    WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs)
+};
+
+/*
+ * Almost all of the widget functionality is handled by the default Ttk
+ * widget code and the contained element. The one thing that we must handle
+ * is the -anchor option which positions the square element within the parcel
+ * of space available for the widget.
+ * To do this we must find out the layout preferences for the square
+ * element and adjust its position within our region.
+ *
+ * Note that if we do not have a "square" elememt then just the default
+ * layout will be done. So if someone places a label element into the
+ * widget layout it will still be handled but the -anchor option will be
+ * passed onto the label element instead of handled here.
+ */
+
+static void
+SquareDoLayout(void *clientData)
+{
+    WidgetCore *corePtr = (WidgetCore *)clientData;
+    Ttk_Box winBox;
+    Ttk_Element squareNode;
+
+    squareNode = Ttk_FindElement(corePtr->layout, "square");
+    winBox = Ttk_WinBox(corePtr->tkwin);
+    Ttk_PlaceLayout(corePtr->layout, corePtr->state, winBox);
+
+    /*
+     * Adjust the position of the square element within the widget according
+     * to the -anchor option.
+     */
+
+    if (squareNode) {
+	Square *squarePtr = clientData;
+	Tk_Anchor anchor = TK_ANCHOR_CENTER;
+	Ttk_Box b;
+
+	b = Ttk_ElementParcel(squareNode);
+	if (squarePtr->square.anchorObj != NULL)
+	    Tk_GetAnchorFromObj(NULL, squarePtr->square.anchorObj, &anchor);
+	b = Ttk_AnchorBox(winBox, b.width, b.height, anchor);
+
+	Ttk_PlaceElement(corePtr->layout, squareNode, b);
+    }
+}
+
+/*
+ * Widget commands. A widget is impelemented as an ensemble and the
+ * subcommands are listed here. Ttk provides default implementations
+ * that are sufficient for our needs.
+ */
+
+static const Ttk_Ensemble SquareCommands[] = {
+    { "configure",	TtkWidgetConfigureCommand,0 },
+    { "cget",		TtkWidgetCgetCommand,0 },
+    { "identify",	TtkWidgetIdentifyCommand,0 },
+    { "instate",	TtkWidgetInstateCommand,0 },
+    { "state",  	TtkWidgetStateCommand,0 },
+    { 0,0,0 }
+};
+
+/*
+ * The Widget specification structure holds all the implementation 
+ * information about this widget and this is what must be registered
+ * with Tk in the package initialization code (see bottom).
+ */
+
+static WidgetSpec SquareWidgetSpec =
+{
+    "TSquare",			/* className */
+    sizeof(Square),		/* recordSize */
+    SquareOptionSpecs,		/* optionSpecs */
+    SquareCommands,		/* subcommands */
+    TtkNullInitialize,		/* initializeProc */
+    TtkNullCleanup,		/* cleanupProc */
+    TtkCoreConfigure,		/* configureProc */
+    TtkNullPostConfigure,		/* postConfigureProc */
+    TtkWidgetGetLayout,		/* getLayoutProc */
+    TtkWidgetSize, 		/* sizeProc */
+    SquareDoLayout,		/* layoutProc */
+    TtkWidgetDisplay		/* displayProc */
+};
+
+/* ---------------------------------------------------------------------- 
+ * Square element
+ *
+ * In this section we demonstrate what is required to create a new themed
+ * element.
+ */
+
+typedef struct
+{
+    Tcl_Obj *borderObj;
+    Tcl_Obj *foregroundObj;
+    Tcl_Obj *borderWidthObj;
+    Tcl_Obj *reliefObj;
+    Tcl_Obj *widthObj;
+    Tcl_Obj *heightObj;
+} SquareElement;
+
+static Ttk_ElementOptionSpec SquareElementOptions[] = 
+{
+    { "-background", TK_OPTION_BORDER, Tk_Offset(SquareElement,borderObj),
+    	DEFAULT_BACKGROUND },
+    { "-foreground", TK_OPTION_BORDER, Tk_Offset(SquareElement,foregroundObj),
+    	DEFAULT_BACKGROUND },
+    { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(SquareElement,borderWidthObj),
+    	DEFAULT_BORDERWIDTH },
+    { "-relief", TK_OPTION_RELIEF, Tk_Offset(SquareElement,reliefObj),
+    	"raised" },
+    { "-width",  TK_OPTION_PIXELS, Tk_Offset(SquareElement,widthObj), "20"},
+    { "-height", TK_OPTION_PIXELS, Tk_Offset(SquareElement,heightObj), "20"},
+    { NULL, 0, 0, NULL }
+};
+
+/*
+ * The element geometry function is called when the layout code wishes to
+ * find out how big this element wants to be. We must return our preferred
+ * size and padding information
+ */
+
+static void SquareElementSize(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+    SquareElement *square = elementRecord;
+    int borderWidth = 0;
+
+    Tcl_GetIntFromObj(NULL, square->borderWidthObj, &borderWidth);
+    *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+    Tk_GetPixelsFromObj(NULL, tkwin, square->widthObj, widthPtr);
+    Tk_GetPixelsFromObj(NULL, tkwin, square->heightObj, heightPtr);
+}
+
+/*
+ * Draw the element in the box provided.
+ */
+
+static void SquareElementDraw(
+    void *clientData, void *elementRecord, Tk_Window tkwin,
+    Drawable d, Ttk_Box b, unsigned int state)
+{
+    SquareElement *square = elementRecord;
+    Tk_3DBorder foreground = NULL;
+    int borderWidth = 1, relief = TK_RELIEF_FLAT;
+
+    foreground = Tk_Get3DBorderFromObj(tkwin, square->foregroundObj);
+    Tcl_GetIntFromObj(NULL, square->borderWidthObj, &borderWidth);
+    Tk_GetReliefFromObj(NULL, square->reliefObj, &relief);
+
+    Tk_Fill3DRectangle(tkwin, d, foreground,
+	b.x, b.y, b.width, b.height, borderWidth, relief);
+}
+
+static Ttk_ElementSpec SquareElementSpec =
+{
+    TK_STYLE_VERSION_2,
+    sizeof(SquareElement),
+    SquareElementOptions,
+    SquareElementSize,
+    SquareElementDraw
+};
+
+/* ----------------------------------------------------------------------
+ *
+ * Layout section.
+ *
+ * Every widget class needs a layout style that specifies which elements
+ * are part of the widget and how they should be placed. The element layout
+ * engine is similar to the Tk pack geometry manager. Read the documentation
+ * for the details. In this example we just need to have the square element
+ * that has been defined for this widget placed on a background. We will
+ * also need some padding to keep it away from the edges. 
+ */
+
+TTK_BEGIN_LAYOUT(SquareLayout)
+     TTK_NODE("Square.background", TTK_FILL_BOTH)
+     TTK_GROUP("Square.padding", TTK_FILL_BOTH,
+	 TTK_NODE("Square.square", 0))
+TTK_END_LAYOUT
+
+/* ---------------------------------------------------------------------- 
+ *
+ * Widget initialization.
+ *
+ * This file defines a new element and a new widget. We need to register
+ * the element with the themes that will need it. In this case we will 
+ * register with the default theme that is the root of the theme inheritance
+ * tree. This means all themes will find this element.
+ * We then need to register the widget class style. This is the layout
+ * specification. If a different theme requires an alternative layout, we
+ * could register that here. For instance, in some themes the scrollbars have
+ * one uparrow, in other themes there are two uparrow elements.
+ * Finally we register the widget itself. This step creates a tcl command so
+ * that we can actually create an instance of this class. The widget is
+ * linked to a particular style by the widget class name. This is important
+ * to realise as the programmer may change the classname when creating a
+ * new instance. If this is done, a new layout will need to be created (which
+ * can be done at script level). Some widgets may require particular elements
+ * to be present but we try to avoid this where possible. In this widget's C
+ * code, no reference is made to any particular elements. The programmer is
+ * free to specify a new style using completely different elements.
+ */
+
+/* public */ MODULE_SCOPE int
+TtkSquareWidget_Init(Tcl_Interp *interp)
+{
+    Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+    /* register the new elements for this theme engine */
+    Ttk_RegisterElement(interp, theme, "square", &SquareElementSpec, NULL);
+    
+    /* register the layout for this theme */
+    Ttk_RegisterLayout(theme, "TSquare", SquareLayout);
+    
+    /* register the widget */
+    RegisterWidget(interp, "ttk::square", &SquareWidgetSpec);
+
+    return TCL_OK;
+}
+
+#endif /* TTK_SQUARE_WIDGET */
+

generic/ttk/ttkState.c

@@ -0,0 +1,275 @@
+/*
+ * Tk widget state utilities.
+ *
+ * Copyright (c) 2003 Joe English.  Freely redistributable.
+ *
+ */
+
+#include <string.h>
+
+#include <tk.h>
+#include "ttkTheme.h"
+
+/*
+ * Table of state names.  Must be kept in sync with TTK_STATE_*
+ * #defines in ttkTheme.h.
+ */
+static const char *const stateNames[] =
+{
+    "active",		/* Mouse cursor is over widget or element */
+    "disabled",		/* Widget is disabled */
+    "focus",		/* Widget has keyboard focus */
+    "pressed",		/* Pressed or "armed" */
+    "selected",		/* "on", "true", "current", etc. */
+    "background",	/* Top-level window lost focus (Mac,Win "inactive") */
+    "alternate",	/* Widget-specific alternate display style */
+    "invalid",		/* Bad value */
+    "readonly",		/* Editing/modification disabled */
+    "hover",		/* Mouse cursor is over widget */
+    "reserved1",	/* Reserved for future extension */
+    "reserved2",	/* Reserved for future extension */
+    "reserved3",	/* Reserved for future extension */
+    "user3",		/* User-definable state */
+    "user2",		/* User-definable state */
+    "user1",		/* User-definable state */
+    NULL
+};
+
+/*------------------------------------------------------------------------
+ * +++ StateSpec object type:
+ *
+ * The string representation consists of a list of state names,
+ * each optionally prefixed by an exclamation point (!).
+ *
+ * The internal representation uses the upper half of the longValue
+ * to store the on bits and the lower half to store the off bits.
+ * If we ever get more than 16 states, this will need to be reconsidered...
+ */
+
+static int  StateSpecSetFromAny(Tcl_Interp *interp, Tcl_Obj *obj);
+/* static void StateSpecFreeIntRep(Tcl_Obj *); */
+#define StateSpecFreeIntRep 0		/* not needed */
+static void StateSpecDupIntRep(Tcl_Obj *, Tcl_Obj *);
+static void StateSpecUpdateString(Tcl_Obj *);
+
+static
+struct Tcl_ObjType StateSpecObjType =
+{
+    "StateSpec",
+    StateSpecFreeIntRep,
+    StateSpecDupIntRep,
+    StateSpecUpdateString,
+    StateSpecSetFromAny
+};
+
+static void StateSpecDupIntRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)
+{
+    copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
+    copyPtr->typePtr = &StateSpecObjType;
+}
+
+static int StateSpecSetFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
+{
+    int status;
+    int objc;
+    Tcl_Obj **objv;
+    int i;
+    unsigned int onbits = 0, offbits = 0;
+
+    status = Tcl_ListObjGetElements(interp, objPtr, &objc, &objv);
+    if (status != TCL_OK)
+	return status;
+
+    for (i = 0; i < objc; ++i) {
+	const char *stateName = Tcl_GetString(objv[i]);
+	int on, j;
+
+	if (*stateName == '!') {
+	    ++stateName;
+	    on = 0;
+	} else {
+	    on = 1;
+	}
+
+	for (j = 0; stateNames[j] != 0; ++j) {
+	    if (strcmp(stateName, stateNames[j]) == 0)
+		break;
+	}
+
+    	if (stateNames[j] == 0) {
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"Invalid state name %s", stateName));
+		Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATE", NULL);
+	    }
+	    return TCL_ERROR;
+	}
+
+	if (on) {
+	    onbits |= (1<<j);
+	} else {
+	    offbits |= (1<<j);
+	}
+    }
+
+    /* Invalidate old intrep:
+     */
+    if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->typePtr = &StateSpecObjType;
+    objPtr->internalRep.longValue = (onbits << 16) | offbits;
+
+    return TCL_OK;
+}
+
+static void StateSpecUpdateString(Tcl_Obj *objPtr)
+{
+    unsigned int onbits = (objPtr->internalRep.longValue & 0xFFFF0000) >> 16;
+    unsigned int offbits = objPtr->internalRep.longValue & 0x0000FFFF;
+    unsigned int mask = onbits | offbits;
+    Tcl_DString result;
+    int i, len;
+
+    Tcl_DStringInit(&result);
+
+    for (i=0; stateNames[i] != NULL; ++i) {
+	if (mask & (1<<i)) {
+	    if (offbits & (1<<i))
+		Tcl_DStringAppend(&result, "!", 1);
+	    Tcl_DStringAppend(&result, stateNames[i], -1);
+	    Tcl_DStringAppend(&result, " ", 1);
+	}
+    }
+
+    len = Tcl_DStringLength(&result);
+    if (len) {
+	/* 'len' includes extra trailing ' ' */
+	objPtr->bytes = Tcl_Alloc((unsigned)len);
+	objPtr->length = len-1;
+	strncpy(objPtr->bytes, Tcl_DStringValue(&result), (size_t)len-1);
+	objPtr->bytes[len-1] = '\0';
+    } else {
+	/* empty string */
+	objPtr->length = 0;
+	objPtr->bytes = Tcl_Alloc(1);
+	*objPtr->bytes = '\0';
+    }
+
+    Tcl_DStringFree(&result);
+}
+
+Tcl_Obj *Ttk_NewStateSpecObj(unsigned int onbits, unsigned int offbits)
+{
+    Tcl_Obj *objPtr = Tcl_NewObj();
+
+    Tcl_InvalidateStringRep(objPtr);
+    objPtr->typePtr = &StateSpecObjType;
+    objPtr->internalRep.longValue = (onbits << 16) | offbits;
+
+    return objPtr;
+}
+
+int Ttk_GetStateSpecFromObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    Ttk_StateSpec *spec)
+{
+    if (objPtr->typePtr != &StateSpecObjType) {
+	int status = StateSpecSetFromAny(interp, objPtr);
+	if (status != TCL_OK)
+	    return status;
+    }
+
+    spec->onbits = (objPtr->internalRep.longValue & 0xFFFF0000) >> 16;
+    spec->offbits = objPtr->internalRep.longValue & 0x0000FFFF;
+    return TCL_OK;
+}
+
+
+/*
+ * Tk_StateMapLookup --
+ *
+ * 	A state map is a paired list of StateSpec / value pairs.
+ *	Returns the value corresponding to the first matching state
+ *	specification, or NULL if not found or an error occurs.
+ */
+Tcl_Obj *Ttk_StateMapLookup(
+    Tcl_Interp *interp,		/* Where to leave error messages; may be NULL */
+    Ttk_StateMap map,		/* State map */
+    Ttk_State state)    	/* State to look up */
+{
+    Tcl_Obj **specs;
+    int nSpecs;
+    int j, status;
+
+    status = Tcl_ListObjGetElements(interp, map, &nSpecs, &specs);
+    if (status != TCL_OK)
+	return NULL;
+
+    for (j = 0; j < nSpecs; j += 2) {
+	Ttk_StateSpec spec;
+	status = Ttk_GetStateSpecFromObj(interp, specs[j], &spec);
+	if (status != TCL_OK)
+	    return NULL;
+	if (Ttk_StateMatches(state, &spec))
+	    return specs[j+1];
+    }
+    if (interp) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj("No match in state map", -1));
+	Tcl_SetErrorCode(interp, "TTK", "STATE", "UNMATCHED", NULL);
+    }
+    return NULL;
+}
+
+/* Ttk_GetStateMapFromObj --
+ * 	Returns a Ttk_StateMap from a Tcl_Obj*.
+ * 	Since a Ttk_StateMap is just a specially-formatted Tcl_Obj,
+ * 	this basically just checks for errors.
+ */
+Ttk_StateMap Ttk_GetStateMapFromObj(
+    Tcl_Interp *interp,		/* Where to leave error messages; may be NULL */
+    Tcl_Obj *mapObj)		/* State map */
+{
+    Tcl_Obj **specs;
+    int nSpecs;
+    int j, status;
+
+    status = Tcl_ListObjGetElements(interp, mapObj, &nSpecs, &specs);
+    if (status != TCL_OK)
+	return NULL;
+
+    if (nSpecs % 2 != 0) {
+	if (interp) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "State map must have an even number of elements", -1));
+	    Tcl_SetErrorCode(interp, "TTK", "VALUE", "STATEMAP", NULL);
+	}
+	return 0;
+    }
+
+    for (j = 0; j < nSpecs; j += 2) {
+	Ttk_StateSpec spec;
+	if (Ttk_GetStateSpecFromObj(interp, specs[j], &spec) != TCL_OK)
+	    return NULL;
+    }
+
+    return mapObj;
+}
+
+/*
+ * Ttk_StateTableLooup --
+ * 	Look up an index from a statically allocated state table.
+ */
+int Ttk_StateTableLookup(Ttk_StateTable *map, unsigned int state)
+{
+    while ((state & map->onBits) != map->onBits
+	    || (~state & map->offBits) != map->offBits)
+    {
+	++map;
+    }
+    return map->index;
+}
+
+/*EOF*/

generic/ttk/ttkStubInit.c

@@ -0,0 +1,61 @@
+/*
+ * This file is (mostly) automatically generated from ttk.decls.
+ * It is compiled and linked in with the ttk package proper.
+ */
+
+#include "tk.h"
+#include "ttkTheme.h"
+
+MODULE_SCOPE const TtkStubs ttkStubs;
+
+/* !BEGIN!: Do not edit below this line. */
+
+const TtkStubs ttkStubs = {
+    TCL_STUB_MAGIC,
+    TTK_STUBS_EPOCH,
+    TTK_STUBS_REVISION,
+    0,
+    Ttk_GetTheme, /* 0 */
+    Ttk_GetDefaultTheme, /* 1 */
+    Ttk_GetCurrentTheme, /* 2 */
+    Ttk_CreateTheme, /* 3 */
+    Ttk_RegisterCleanup, /* 4 */
+    Ttk_RegisterElementSpec, /* 5 */
+    Ttk_RegisterElement, /* 6 */
+    Ttk_RegisterElementFactory, /* 7 */
+    Ttk_RegisterLayout, /* 8 */
+    0, /* 9 */
+    Ttk_GetStateSpecFromObj, /* 10 */
+    Ttk_NewStateSpecObj, /* 11 */
+    Ttk_GetStateMapFromObj, /* 12 */
+    Ttk_StateMapLookup, /* 13 */
+    Ttk_StateTableLookup, /* 14 */
+    0, /* 15 */
+    0, /* 16 */
+    0, /* 17 */
+    0, /* 18 */
+    0, /* 19 */
+    Ttk_GetPaddingFromObj, /* 20 */
+    Ttk_GetBorderFromObj, /* 21 */
+    Ttk_GetStickyFromObj, /* 22 */
+    Ttk_MakePadding, /* 23 */
+    Ttk_UniformPadding, /* 24 */
+    Ttk_AddPadding, /* 25 */
+    Ttk_RelievePadding, /* 26 */
+    Ttk_MakeBox, /* 27 */
+    Ttk_BoxContains, /* 28 */
+    Ttk_PackBox, /* 29 */
+    Ttk_StickBox, /* 30 */
+    Ttk_AnchorBox, /* 31 */
+    Ttk_PadBox, /* 32 */
+    Ttk_ExpandBox, /* 33 */
+    Ttk_PlaceBox, /* 34 */
+    Ttk_NewBoxObj, /* 35 */
+    0, /* 36 */
+    0, /* 37 */
+    0, /* 38 */
+    0, /* 39 */
+    Ttk_GetOrientFromObj, /* 40 */
+};
+
+/* !END!: Do not edit above this line. */

generic/ttk/ttkStubLib.c

@@ -0,0 +1,74 @@
+/*
+ * We need to ensure that we use the tcl stub macros so that this file
+ * contains no references to any of the tcl stub functions.
+ */
+
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
+
+#include "tk.h"
+
+#define USE_TTK_STUBS 1
+#include "ttkTheme.h"
+
+MODULE_SCOPE const TtkStubs *ttkStubsPtr;
+const TtkStubs *ttkStubsPtr = NULL;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TtkInitializeStubs --
+ *	Load the Ttk package, initialize stub table pointer.
+ *	Do not call this function directly, use Ttk_InitStubs() macro instead.
+ *
+ * Results:
+ *	The actual version of the package that satisfies the request, or
+ *	NULL to indicate that an error occurred.
+ *
+ * Side effects:
+ *	Sets the stub table pointer.
+ *
+ */
+MODULE_SCOPE const char *
+TtkInitializeStubs(
+    Tcl_Interp *interp, const char *version, int epoch, int revision)
+{
+    int exact = 0;
+    const char *packageName = "Ttk";
+    const char *errMsg = NULL;
+    ClientData pkgClientData = NULL;
+    const char *actualVersion = Tcl_PkgRequireEx(
+	interp, packageName, version, exact, &pkgClientData);
+    const TtkStubs *stubsPtr = pkgClientData;
+
+    if (!actualVersion) {
+	return NULL;
+    }
+
+    if (!stubsPtr) {
+	errMsg = "missing stub table pointer";
+	goto error;
+    }
+    if (stubsPtr->epoch != epoch) {
+	errMsg = "epoch number mismatch";
+	goto error;
+    }
+    if (stubsPtr->revision < revision) {
+	errMsg = "require later revision";
+	goto error;
+    }
+
+    ttkStubsPtr = stubsPtr;
+    return actualVersion;
+
+error:
+    Tcl_ResetResult(interp);
+    Tcl_AppendResult(interp,
+	"Error loading ", packageName, " package",
+	" (requested version '", version,
+	"', loaded version '", actualVersion, "'): ",
+	errMsg, 
+	NULL);
+    return NULL;
+}
+

generic/ttk/ttkTagSet.c

@@ -0,0 +1,306 @@
+/*
+ * Tag tables.  3/4-baked, work in progress.
+ *
+ * Copyright (C) 2005, Joe English.  Freely redistributable.
+ */
+
+#include <string.h>	/* for memset() */
+#include <tcl.h>
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*------------------------------------------------------------------------
+ * +++ Internal data structures.
+ */
+struct TtkTag {
+    int 	priority;		/* 1=>highest */
+    const char	*tagName;		/* Back-pointer to hash table entry */
+    void	*tagRecord;		/* User data */
+};
+
+struct TtkTagTable {
+    Tk_Window		tkwin;		/* owner window */
+    Tk_OptionSpec	*optionSpecs;	/* ... */
+    Tk_OptionTable	optionTable;	/* ... */
+    int         	recordSize;	/* size of tag record */
+    int 		nTags;		/* #tags defined so far */
+    Tcl_HashTable	tags;		/* defined tags */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Tags.
+ */
+static Ttk_Tag NewTag(Ttk_TagTable tagTable, const char *tagName)
+{
+    Ttk_Tag tag = ckalloc(sizeof(*tag));
+    tag->tagRecord = ckalloc(tagTable->recordSize);
+    memset(tag->tagRecord, 0, tagTable->recordSize);
+    /* Don't need Tk_InitOptions() here, all defaults should be NULL. */
+    tag->priority = ++tagTable->nTags;
+    tag->tagName = tagName;
+    return tag;
+}
+
+static void DeleteTag(Ttk_TagTable tagTable, Ttk_Tag tag)
+{
+    Tk_FreeConfigOptions(tag->tagRecord,tagTable->optionTable,tagTable->tkwin);
+    ckfree(tag->tagRecord);
+    ckfree(tag);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tag tables.
+ */
+
+Ttk_TagTable Ttk_CreateTagTable(
+    Tcl_Interp *interp, Tk_Window tkwin,
+    Tk_OptionSpec optionSpecs[], int recordSize)
+{
+    Ttk_TagTable tagTable = ckalloc(sizeof(*tagTable));
+    tagTable->tkwin = tkwin;
+    tagTable->optionSpecs = optionSpecs;
+    tagTable->optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+    tagTable->recordSize = recordSize;
+    tagTable->nTags = 0;
+    Tcl_InitHashTable(&tagTable->tags, TCL_STRING_KEYS);
+    return tagTable;
+}
+
+void Ttk_DeleteTagTable(Ttk_TagTable tagTable)
+{
+    Tcl_HashSearch search;
+    Tcl_HashEntry *entryPtr;
+
+    entryPtr = Tcl_FirstHashEntry(&tagTable->tags, &search);
+    while (entryPtr != NULL) {
+	DeleteTag(tagTable, Tcl_GetHashValue(entryPtr));
+	entryPtr = Tcl_NextHashEntry(&search);
+    }
+
+    Tcl_DeleteHashTable(&tagTable->tags);
+    ckfree(tagTable);
+}
+
+Ttk_Tag Ttk_GetTag(Ttk_TagTable tagTable, const char *tagName)
+{
+    int isNew = 0;
+    Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(
+	&tagTable->tags, tagName, &isNew);
+
+    if (isNew) {
+	tagName = Tcl_GetHashKey(&tagTable->tags, entryPtr);
+	Tcl_SetHashValue(entryPtr, NewTag(tagTable,tagName));
+    }
+    return Tcl_GetHashValue(entryPtr);
+}
+
+Ttk_Tag Ttk_GetTagFromObj(Ttk_TagTable tagTable, Tcl_Obj *objPtr)
+{
+    return Ttk_GetTag(tagTable, Tcl_GetString(objPtr));
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tag sets.
+ */
+
+/* Ttk_GetTagSetFromObj --
+ * 	Extract an array of pointers to Ttk_Tags from a Tcl_Obj.
+ * 	objPtr may be NULL, in which case a new empty tag set is returned.
+ *
+ * Returns NULL and leaves an error message in interp->result on error.
+ *
+ * Non-NULL results must be passed to Ttk_FreeTagSet().
+ */
+Ttk_TagSet Ttk_GetTagSetFromObj(
+    Tcl_Interp *interp, Ttk_TagTable tagTable, Tcl_Obj *objPtr)
+{
+    Ttk_TagSet tagset = ckalloc(sizeof(*tagset));
+    Tcl_Obj **objv;
+    int i, objc;
+
+    if (objPtr == NULL) {
+	tagset->tags = NULL;
+	tagset->nTags = 0;
+	return tagset;
+    }
+
+    if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+	ckfree(tagset);
+    	return NULL;
+    }
+
+    tagset->tags = ckalloc((objc+1) * sizeof(Ttk_Tag));
+    for (i=0; i<objc; ++i) {
+	tagset->tags[i] = Ttk_GetTagFromObj(tagTable, objv[i]);
+    }
+    tagset->tags[i] = NULL;
+    tagset->nTags = objc;
+
+    return tagset;
+}
+
+/* Ttk_NewTagSetObj --
+ * 	Construct a fresh Tcl_Obj * from a tag set.
+ */
+Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet tagset)
+{
+    Tcl_Obj *result = Tcl_NewListObj(0,0);
+    int i;
+
+    for (i = 0; i < tagset->nTags; ++i) {
+	Tcl_ListObjAppendElement(
+	    NULL, result, Tcl_NewStringObj(tagset->tags[i]->tagName, -1));
+    }
+    return result;
+}
+
+void Ttk_FreeTagSet(Ttk_TagSet tagset)
+{
+    ckfree(tagset->tags);
+    ckfree(tagset);
+}
+
+/* Ttk_TagSetContains -- test if tag set contains a tag.
+ */
+int Ttk_TagSetContains(Ttk_TagSet tagset, Ttk_Tag tag)
+{
+    int i;
+    for (i = 0; i < tagset->nTags; ++i) {
+	if (tagset->tags[i] == tag) {
+	    return 1;
+	}
+    }
+    return 0;
+}
+
+/* Ttk_TagSetAdd -- add a tag to a tag set.
+ *
+ * Returns: 0 if tagset already contained tag,
+ * 1 if tagset was modified.
+ */
+int Ttk_TagSetAdd(Ttk_TagSet tagset, Ttk_Tag tag)
+{
+    int i;
+    for (i = 0; i < tagset->nTags; ++i) {
+	if (tagset->tags[i] == tag) {
+	    return 0;
+	}
+    }
+    tagset->tags = ckrealloc(tagset->tags, 
+	    (tagset->nTags+1)*sizeof(tagset->tags[0]));
+    tagset->tags[tagset->nTags++] = tag;
+    return 1;
+}
+
+/* Ttk_TagSetRemove -- remove a tag from a tag set.
+ *
+ * Returns: 0 if tagset did not contain tag,
+ * 1 if tagset was modified.
+ */
+int Ttk_TagSetRemove(Ttk_TagSet tagset, Ttk_Tag tag)
+{
+    int i = 0, j = 0;
+    while (i < tagset->nTags) {
+	if ((tagset->tags[j] = tagset->tags[i]) != tag) {
+	    ++j;
+	}
+	++i;
+    }
+    tagset->nTags = j;
+    return j != i;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Utilities for widget commands.
+ */
+
+/* Ttk_EnumerateTags -- implements [$w tag names]
+ */
+int Ttk_EnumerateTags(
+    Tcl_Interp *interp, Ttk_TagTable tagTable)
+{
+    return TtkEnumerateHashTable(interp, &tagTable->tags);
+}
+
+/* Ttk_EnumerateTagOptions -- implements [$w tag configure $tag]
+ */
+int Ttk_EnumerateTagOptions(
+    Tcl_Interp *interp, Ttk_TagTable tagTable, Ttk_Tag tag)
+{
+    return TtkEnumerateOptions(interp, tag->tagRecord,
+	tagTable->optionSpecs, tagTable->optionTable, tagTable->tkwin);
+}
+
+/* Ttk_TagOptionValue -- implements [$w tag configure $tag -option]
+ */
+Tcl_Obj *Ttk_TagOptionValue(
+    Tcl_Interp *interp,
+    Ttk_TagTable tagTable,
+    Ttk_Tag tag,
+    Tcl_Obj *optionName)
+{
+    return Tk_GetOptionValue(interp,
+	tag->tagRecord, tagTable->optionTable, optionName, tagTable->tkwin);
+}
+
+/* Ttk_ConfigureTag -- implements [$w tag configure $tag -option value...]
+ */
+int Ttk_ConfigureTag(
+    Tcl_Interp *interp,
+    Ttk_TagTable tagTable,
+    Ttk_Tag tag,
+    int objc, Tcl_Obj *const objv[])
+{
+    return Tk_SetOptions(
+	interp, tag->tagRecord, tagTable->optionTable,
+	objc, objv, tagTable->tkwin, NULL/*savedOptions*/, NULL/*mask*/);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tag values.
+ */
+
+#define OBJ_AT(record, offset) (*(Tcl_Obj**)(((char*)record)+offset))
+
+void Ttk_TagSetValues(Ttk_TagTable tagTable, Ttk_TagSet tagSet, void *record)
+{
+    const int LOWEST_PRIORITY = 0x7FFFFFFF;
+    int i, j;
+
+    memset(record, 0, tagTable->recordSize);
+
+    for (i = 0; tagTable->optionSpecs[i].type != TK_OPTION_END; ++i) {
+	Tk_OptionSpec *optionSpec = tagTable->optionSpecs + i;
+	int offset = optionSpec->objOffset;
+	int prio = LOWEST_PRIORITY;
+
+	for (j = 0; j < tagSet->nTags; ++j) {
+	    Ttk_Tag tag = tagSet->tags[j];
+	    if (OBJ_AT(tag->tagRecord, offset) != 0 && tag->priority < prio) {
+		OBJ_AT(record, offset) = OBJ_AT(tag->tagRecord, offset);
+		prio = tag->priority;
+	    }
+	}
+    }
+}
+
+void Ttk_TagSetApplyStyle(
+    Ttk_TagTable tagTable, Ttk_Style style, Ttk_State state, void *record)
+{
+    Tk_OptionSpec *optionSpec = tagTable->optionSpecs;
+
+    while (optionSpec->type != TK_OPTION_END) {
+	int offset = optionSpec->objOffset;
+	const char *optionName = optionSpec->optionName;
+	Tcl_Obj *val = Ttk_StyleMap(style, optionName, state);
+	if (val) {
+	    OBJ_AT(record, offset) = val;
+	} else if (OBJ_AT(record, offset) == 0) {
+	    OBJ_AT(record, offset) = Ttk_StyleDefault(style, optionName);
+	}
+	++optionSpec;
+    }
+}
+

generic/ttk/ttkTheme.h

@@ -0,0 +1,444 @@
+/*
+ * Copyright (c) 2003 Joe English.  Freely redistributable.
+ *
+ * Declarations for Tk theme engine.
+ */
+
+#ifndef _TTKTHEME
+#define _TTKTHEME
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef MODULE_SCOPE
+#   ifdef __cplusplus
+#	define MODULE_SCOPE extern "C"
+#   else
+#	define MODULE_SCOPE extern
+#   endif
+#endif
+
+#define TTKAPI MODULE_SCOPE
+
+/* Ttk syncs to the Tk version & patchlevel */
+#define TTK_VERSION    TK_VERSION
+#define TTK_PATCH_LEVEL TK_PATCH_LEVEL
+
+/*------------------------------------------------------------------------
+ * +++ Defaults for element option specifications.
+ */
+#define DEFAULT_FONT 		"TkDefaultFont"
+#define DEFAULT_BACKGROUND	"#d9d9d9"
+#define DEFAULT_FOREGROUND	"black"
+
+/*------------------------------------------------------------------------
+ * +++ Widget states.
+ * 	Keep in sync with stateNames[] in tkstate.c.
+ */
+
+typedef unsigned int Ttk_State;
+
+#define TTK_STATE_ACTIVE	(1<<0)
+#define TTK_STATE_DISABLED	(1<<1)
+#define TTK_STATE_FOCUS		(1<<2)
+#define TTK_STATE_PRESSED	(1<<3)
+#define TTK_STATE_SELECTED	(1<<4)
+#define TTK_STATE_BACKGROUND	(1<<5)
+#define TTK_STATE_ALTERNATE	(1<<6)
+#define TTK_STATE_INVALID	(1<<7)
+#define TTK_STATE_READONLY 	(1<<8)
+#define TTK_STATE_HOVER		(1<<9)
+#define TTK_STATE_USER6		(1<<10)
+#define TTK_STATE_USER5		(1<<11)
+#define TTK_STATE_USER4		(1<<12)
+#define TTK_STATE_USER3		(1<<13)
+#define TTK_STATE_USER2		(1<<14)
+#define TTK_STATE_USER1		(1<<15)
+
+/* Maintenance note: if you get all the way to "USER1",
+ * see tkstate.c
+ */
+typedef struct
+{
+    unsigned int onbits;	/* bits to turn on */
+    unsigned int offbits;	/* bits to turn off */
+} Ttk_StateSpec;
+
+#define Ttk_StateMatches(state, spec) \
+    (((state) & ((spec)->onbits|(spec)->offbits)) == (spec)->onbits)
+
+#define Ttk_ModifyState(state, spec) \
+    (((state) & ~(spec)->offbits) | (spec)->onbits)
+
+TTKAPI int Ttk_GetStateSpecFromObj(Tcl_Interp *, Tcl_Obj *, Ttk_StateSpec *);
+TTKAPI Tcl_Obj *Ttk_NewStateSpecObj(unsigned int onbits,unsigned int offbits);
+
+/*------------------------------------------------------------------------
+ * +++ State maps and state tables.
+ */
+typedef Tcl_Obj *Ttk_StateMap;
+
+TTKAPI Ttk_StateMap Ttk_GetStateMapFromObj(Tcl_Interp *, Tcl_Obj *);
+TTKAPI Tcl_Obj *Ttk_StateMapLookup(Tcl_Interp*, Ttk_StateMap, Ttk_State);
+
+/*
+ * Table for looking up an integer index based on widget state:
+ */
+typedef struct
+{
+    int index;			/* Value to return if this entry matches */
+    unsigned int onBits;	/* Bits which must be set */
+    unsigned int offBits;	/* Bits which must be cleared */
+} Ttk_StateTable;
+
+TTKAPI int Ttk_StateTableLookup(Ttk_StateTable map[], Ttk_State);
+
+/*------------------------------------------------------------------------
+ * +++ Padding.
+ * 	Used to represent internal padding and borders.
+ */
+typedef struct
+{
+    short left;
+    short top;
+    short right;
+    short bottom;
+} Ttk_Padding;
+
+TTKAPI int Ttk_GetPaddingFromObj(Tcl_Interp*,Tk_Window,Tcl_Obj*,Ttk_Padding*);
+TTKAPI int Ttk_GetBorderFromObj(Tcl_Interp*,Tcl_Obj*,Ttk_Padding*);
+
+TTKAPI Ttk_Padding Ttk_MakePadding(short l, short t, short r, short b);
+TTKAPI Ttk_Padding Ttk_UniformPadding(short borderWidth);
+TTKAPI Ttk_Padding Ttk_AddPadding(Ttk_Padding, Ttk_Padding);
+TTKAPI Ttk_Padding Ttk_RelievePadding(Ttk_Padding, int relief, int n);
+
+#define Ttk_PaddingWidth(p) ((p).left + (p).right)
+#define Ttk_PaddingHeight(p) ((p).top + (p).bottom)
+
+#define Ttk_SetMargins(tkwin, pad) \
+    Tk_SetInternalBorderEx(tkwin, pad.left, pad.right, pad.top, pad.bottom)
+
+/*------------------------------------------------------------------------
+ * +++ Boxes.
+ * 	Used to represent rectangular regions
+ */
+typedef struct 	/* Hey, this is an XRectangle! */
+{
+    int x;
+    int y;
+    int width;
+    int height;
+} Ttk_Box;
+
+TTKAPI Ttk_Box Ttk_MakeBox(int x, int y, int width, int height);
+TTKAPI int Ttk_BoxContains(Ttk_Box, int x, int y);
+
+#define Ttk_WinBox(tkwin) Ttk_MakeBox(0,0,Tk_Width(tkwin),Tk_Height(tkwin))
+
+/*------------------------------------------------------------------------
+ * +++ Layout utilities.
+ */
+typedef enum {
+    TTK_SIDE_LEFT, TTK_SIDE_TOP, TTK_SIDE_RIGHT, TTK_SIDE_BOTTOM
+} Ttk_Side;
+
+typedef unsigned int Ttk_Sticky;
+
+/*
+ * -sticky bits for Ttk_StickBox:
+ */
+#define TTK_STICK_W	(0x1)
+#define TTK_STICK_E	(0x2)
+#define TTK_STICK_N	(0x4)
+#define TTK_STICK_S	(0x8)
+
+/*
+ * Aliases and useful combinations:
+ */
+#define TTK_FILL_X	(0x3)	/* -sticky ew */
+#define TTK_FILL_Y	(0xC)	/* -sticky ns */
+#define TTK_FILL_BOTH	(0xF)	/* -sticky nswe */
+
+TTKAPI int Ttk_GetStickyFromObj(Tcl_Interp *, Tcl_Obj *, Ttk_Sticky *);
+TTKAPI Tcl_Obj *Ttk_NewStickyObj(Ttk_Sticky);
+
+/*
+ * Extra bits for position specifications (combine -side and -sticky)
+ */
+
+typedef unsigned int Ttk_PositionSpec;	/* See below */
+
+#define TTK_PACK_LEFT	(0x10)	/* pack at left of current parcel */
+#define TTK_PACK_RIGHT	(0x20)	/* pack at right of current parcel */
+#define TTK_PACK_TOP	(0x40)	/* pack at top of current parcel */
+#define TTK_PACK_BOTTOM	(0x80)	/* pack at bottom of current parcel */
+#define TTK_EXPAND	(0x100)	/* use entire parcel */
+#define TTK_BORDER	(0x200)	/* draw this element after children */
+#define TTK_UNIT	(0x400)	/* treat descendants as a part of element */
+
+/*
+ * Extra bits for layout specifications
+ */
+#define _TTK_CHILDREN	(0x1000)/* for LayoutSpecs -- children follow */
+#define _TTK_LAYOUT_END	(0x2000)/* for LayoutSpecs -- end of child list */
+#define _TTK_LAYOUT	(0x4000)/* for LayoutSpec tables -- define layout */
+
+#define _TTK_MASK_STICK (0x0F)	/* See Ttk_UnparseLayout() */
+#define _TTK_MASK_PACK	(0xF0)	/* See Ttk_UnparseLayout(), packStrings */
+
+TTKAPI Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side);
+TTKAPI Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky);
+TTKAPI Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor);
+TTKAPI Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p);
+TTKAPI Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p);
+TTKAPI Ttk_Box Ttk_PlaceBox(Ttk_Box *cavity, int w,int h, Ttk_Side,Ttk_Sticky);
+TTKAPI Ttk_Box Ttk_PositionBox(Ttk_Box *cavity, int w, int h, Ttk_PositionSpec);
+
+/*------------------------------------------------------------------------
+ * +++ Themes.
+ */
+MODULE_SCOPE void Ttk_StylePkgInit(Tcl_Interp *);
+
+typedef struct Ttk_Theme_ *Ttk_Theme;
+typedef struct Ttk_ElementClass_ Ttk_ElementClass;
+typedef struct Ttk_Layout_ *Ttk_Layout;
+typedef struct Ttk_LayoutNode_ *Ttk_Element;
+typedef struct Ttk_Style_ *Ttk_Style;
+
+TTKAPI Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name);
+TTKAPI Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp);
+TTKAPI Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp);
+
+TTKAPI Ttk_Theme Ttk_CreateTheme(
+    Tcl_Interp *interp, const char *name, Ttk_Theme parent);
+
+typedef int (Ttk_ThemeEnabledProc)(Ttk_Theme theme, void *clientData);
+MODULE_SCOPE void Ttk_SetThemeEnabledProc(Ttk_Theme, Ttk_ThemeEnabledProc, void *);
+
+MODULE_SCOPE int Ttk_UseTheme(Tcl_Interp *, Ttk_Theme);
+
+typedef void (Ttk_CleanupProc)(void *clientData);
+TTKAPI void Ttk_RegisterCleanup(
+    Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc);
+
+/*------------------------------------------------------------------------
+ * +++ Elements.
+ */
+
+enum TTKStyleVersion2 { TK_STYLE_VERSION_2 = 2 };
+
+typedef void (Ttk_ElementSizeProc)(void *clientData, void *elementRecord,
+        Tk_Window tkwin, int *widthPtr, int *heightPtr, Ttk_Padding*);
+typedef void (Ttk_ElementDrawProc)(void *clientData, void *elementRecord,
+        Tk_Window tkwin, Drawable d, Ttk_Box b, Ttk_State state);
+
+typedef struct Ttk_ElementOptionSpec
+{
+    const char *optionName;		/* Command-line name of the widget option */
+    Tk_OptionType type; 	/* Accepted option types */
+    int offset;			/* Offset of Tcl_Obj* field in element record */
+    const char *defaultValue;		/* Default value to used if resource missing */
+} Ttk_ElementOptionSpec;
+
+#define TK_OPTION_ANY TK_OPTION_STRING
+
+typedef struct Ttk_ElementSpec {
+    enum TTKStyleVersion2 version;	/* Version of the style support. */
+    size_t elementSize;			/* Size of element record */
+    Ttk_ElementOptionSpec *options;	/* List of options, NULL-terminated */
+    Ttk_ElementSizeProc *size;		/* Compute min size and padding */
+    Ttk_ElementDrawProc *draw;  	/* Draw the element */
+} Ttk_ElementSpec;
+
+TTKAPI Ttk_ElementClass *Ttk_RegisterElement(
+	Tcl_Interp *interp, Ttk_Theme theme, const char *elementName,
+	Ttk_ElementSpec *, void *clientData);
+
+typedef int (*Ttk_ElementFactory)
+	(Tcl_Interp *, void *clientData,
+	 Ttk_Theme, const char *elementName, int objc, Tcl_Obj *const objv[]);
+
+TTKAPI int Ttk_RegisterElementFactory(
+	Tcl_Interp *, const char *name, Ttk_ElementFactory, void *clientData);
+
+/*
+ * Null element implementation:
+ * has no geometry or layout; may be used as a stub or placeholder.
+ */
+
+typedef struct {
+    Tcl_Obj	*unused;
+} NullElement;
+
+MODULE_SCOPE void TtkNullElementSize
+	(void *, void *, Tk_Window, int *, int *, Ttk_Padding *);
+MODULE_SCOPE void TtkNullElementDraw
+	(void *, void *, Tk_Window, Drawable, Ttk_Box, Ttk_State);
+MODULE_SCOPE Ttk_ElementOptionSpec TtkNullElementOptions[];
+MODULE_SCOPE Ttk_ElementSpec ttkNullElementSpec;
+
+/*------------------------------------------------------------------------
+ * +++ Layout templates.
+ */
+typedef struct {
+    const char *	elementName;
+    unsigned		opcode;
+} TTKLayoutInstruction, *Ttk_LayoutSpec;
+
+#define TTK_BEGIN_LAYOUT_TABLE(name) \
+				static TTKLayoutInstruction name[] = {
+#define TTK_LAYOUT(name, content) \
+				{ name, _TTK_CHILDREN|_TTK_LAYOUT }, \
+				content \
+				{ 0, _TTK_LAYOUT_END },
+#define TTK_GROUP(name, flags, children) \
+				{ name, flags | _TTK_CHILDREN }, \
+				children \
+				{ 0, _TTK_LAYOUT_END },
+#define TTK_NODE(name, flags)	{ name, flags },
+#define TTK_END_LAYOUT_TABLE	{ 0, _TTK_LAYOUT | _TTK_LAYOUT_END } };
+
+#define TTK_BEGIN_LAYOUT(name)	static TTKLayoutInstruction name[] = {
+#define TTK_END_LAYOUT 		{ 0, _TTK_LAYOUT_END } };
+
+TTKAPI void Ttk_RegisterLayout(
+    Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec);
+
+TTKAPI void Ttk_RegisterLayouts(
+    Ttk_Theme theme, Ttk_LayoutSpec layoutTable);
+
+/*------------------------------------------------------------------------
+ * +++ Layout instances.
+ */
+
+MODULE_SCOPE Ttk_Layout Ttk_CreateLayout(
+    Tcl_Interp *, Ttk_Theme, const char *name,
+    void *recordPtr, Tk_OptionTable, Tk_Window tkwin);
+
+MODULE_SCOPE Ttk_Layout Ttk_CreateSublayout(
+    Tcl_Interp *, Ttk_Theme, Ttk_Layout, const char *name, Tk_OptionTable);
+
+MODULE_SCOPE void Ttk_FreeLayout(Ttk_Layout);
+
+MODULE_SCOPE void Ttk_LayoutSize(Ttk_Layout,Ttk_State,int *widthPtr,int *heightPtr);
+MODULE_SCOPE void Ttk_PlaceLayout(Ttk_Layout, Ttk_State, Ttk_Box);
+MODULE_SCOPE void Ttk_DrawLayout(Ttk_Layout, Ttk_State, Drawable);
+
+MODULE_SCOPE void Ttk_RebindSublayout(Ttk_Layout, void *recordPtr);
+
+MODULE_SCOPE Ttk_Element Ttk_IdentifyElement(Ttk_Layout, int x, int y);
+MODULE_SCOPE Ttk_Element Ttk_FindElement(Ttk_Layout, const char *nodeName);
+
+MODULE_SCOPE const char *Ttk_ElementName(Ttk_Element);
+MODULE_SCOPE Ttk_Box Ttk_ElementParcel(Ttk_Element);
+
+MODULE_SCOPE Ttk_Box Ttk_ClientRegion(Ttk_Layout, const char *elementName);
+
+MODULE_SCOPE Ttk_Box Ttk_LayoutNodeInternalParcel(Ttk_Layout,Ttk_Element);
+MODULE_SCOPE Ttk_Padding Ttk_LayoutNodeInternalPadding(Ttk_Layout,Ttk_Element);
+MODULE_SCOPE void Ttk_LayoutNodeReqSize(Ttk_Layout, Ttk_Element, int *w, int *h);
+
+MODULE_SCOPE void Ttk_PlaceElement(Ttk_Layout, Ttk_Element, Ttk_Box);
+MODULE_SCOPE void Ttk_ChangeElementState(Ttk_Element,unsigned set,unsigned clr);
+
+MODULE_SCOPE Tcl_Obj *Ttk_QueryOption(Ttk_Layout, const char *, Ttk_State);
+
+TTKAPI Ttk_Style Ttk_LayoutStyle(Ttk_Layout);
+TTKAPI Tcl_Obj *Ttk_StyleDefault(Ttk_Style, const char *optionName);
+TTKAPI Tcl_Obj *Ttk_StyleMap(Ttk_Style, const char *optionName, Ttk_State);
+
+/*------------------------------------------------------------------------
+ * +++ Resource cache.
+ * 	See resource.c for explanation.
+ */
+
+typedef struct Ttk_ResourceCache_ *Ttk_ResourceCache;
+MODULE_SCOPE Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *);
+MODULE_SCOPE void Ttk_FreeResourceCache(Ttk_ResourceCache);
+
+MODULE_SCOPE Ttk_ResourceCache Ttk_GetResourceCache(Tcl_Interp*);
+MODULE_SCOPE Tcl_Obj *Ttk_UseFont(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+MODULE_SCOPE Tcl_Obj *Ttk_UseColor(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+MODULE_SCOPE Tcl_Obj *Ttk_UseBorder(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+MODULE_SCOPE Tk_Image Ttk_UseImage(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+
+MODULE_SCOPE void Ttk_RegisterNamedColor(Ttk_ResourceCache, const char *, XColor *);
+
+/*------------------------------------------------------------------------
+ * +++ Image specifications.
+ */
+
+typedef struct TtkImageSpec Ttk_ImageSpec;
+TTKAPI Ttk_ImageSpec *TtkGetImageSpec(Tcl_Interp *, Tk_Window, Tcl_Obj *);
+TTKAPI void TtkFreeImageSpec(Ttk_ImageSpec *);
+TTKAPI Tk_Image TtkSelectImage(Ttk_ImageSpec *, Ttk_State);
+
+/*------------------------------------------------------------------------
+ * +++ Miscellaneous enumerations.
+ * 	Other stuff that element implementations need to know about.
+ */
+typedef enum 			/* -default option values */
+{
+    TTK_BUTTON_DEFAULT_NORMAL,	/* widget defaultable */
+    TTK_BUTTON_DEFAULT_ACTIVE,	/* currently the default widget */
+    TTK_BUTTON_DEFAULT_DISABLED	/* not defaultable */
+} Ttk_ButtonDefaultState;
+
+TTKAPI int Ttk_GetButtonDefaultStateFromObj(Tcl_Interp *, Tcl_Obj *, int *);
+
+typedef enum 			/* -compound option values */
+{
+    TTK_COMPOUND_NONE,  	/* image if specified, otherwise text */
+    TTK_COMPOUND_TEXT,  	/* text only */
+    TTK_COMPOUND_IMAGE,  	/* image only */
+    TTK_COMPOUND_CENTER,	/* text overlays image */
+    TTK_COMPOUND_TOP,   	/* image above text */
+    TTK_COMPOUND_BOTTOM,	/* image below text */
+    TTK_COMPOUND_LEFT,   	/* image to left of text */
+    TTK_COMPOUND_RIGHT  	/* image to right of text */
+} Ttk_Compound;
+
+TTKAPI int Ttk_GetCompoundFromObj(Tcl_Interp *, Tcl_Obj *, int *);
+
+typedef enum { 		/* -orient option values */
+    TTK_ORIENT_HORIZONTAL,
+    TTK_ORIENT_VERTICAL
+} Ttk_Orient;
+
+/*------------------------------------------------------------------------
+ * +++ Utilities.
+ */
+
+typedef struct TtkEnsemble {
+    const char *name;			/* subcommand name */
+    Tcl_ObjCmdProc *command; 		/* subcommand implementation, OR: */
+    const struct TtkEnsemble *ensemble;	/* subcommand ensemble */
+} Ttk_Ensemble;
+
+MODULE_SCOPE int Ttk_InvokeEnsemble(	/* Run an ensemble command */
+    const Ttk_Ensemble *commands, int cmdIndex,
+    void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+
+MODULE_SCOPE int TtkEnumerateHashTable(Tcl_Interp *, Tcl_HashTable *);
+
+/*------------------------------------------------------------------------
+ * +++ Stub table declarations.
+ */
+
+#include "ttkDecls.h"
+
+/*
+ * Drawing utilities for theme code:
+ * (@@@ find a better home for this)
+ */
+typedef enum { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT } ArrowDirection;
+MODULE_SCOPE void TtkArrowSize(int h, ArrowDirection, int *widthPtr, int *heightPtr);
+MODULE_SCOPE void TtkDrawArrow(Display *, Drawable, GC, Ttk_Box, ArrowDirection);
+MODULE_SCOPE void TtkFillArrow(Display *, Drawable, GC, Ttk_Box, ArrowDirection);
+
+#ifdef __cplusplus
+}
+#endif
+#endif /* _TTKTHEME */

generic/ttk/ttkThemeInt.h

@@ -0,0 +1,42 @@
+/*
+ * Theme engine: private definitions.
+ *
+ * Copyright (c) 2004 Joe English.  Freely redistributable.
+ */
+
+#ifndef _TTKTHEMEINT
+#define _TTKTHEMEINT
+
+#include "ttkTheme.h"
+
+typedef struct Ttk_TemplateNode_ Ttk_TemplateNode, *Ttk_LayoutTemplate;
+
+MODULE_SCOPE Ttk_ElementClass *Ttk_GetElement(Ttk_Theme, const char *name);
+MODULE_SCOPE const char *Ttk_ElementClassName(Ttk_ElementClass *);
+
+MODULE_SCOPE void Ttk_ElementSize(
+	Ttk_ElementClass *, Ttk_Style, char *recordPtr, Tk_OptionTable,
+	Tk_Window tkwin, Ttk_State state,
+	int *widthPtr, int *heightPtr, Ttk_Padding*);
+MODULE_SCOPE void Ttk_DrawElement(
+	Ttk_ElementClass *, Ttk_Style, char *recordPtr, Tk_OptionTable,
+	Tk_Window tkwin, Drawable d, Ttk_Box b, Ttk_State state);
+
+MODULE_SCOPE Tcl_Obj *Ttk_QueryStyle(
+    Ttk_Style, void *, Tk_OptionTable, const char *, Ttk_State state);
+
+MODULE_SCOPE Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(
+	Tcl_Interp *, Tcl_Obj *);
+MODULE_SCOPE Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_LayoutTemplate);
+MODULE_SCOPE Ttk_LayoutTemplate Ttk_BuildLayoutTemplate(Ttk_LayoutSpec);
+MODULE_SCOPE void Ttk_FreeLayoutTemplate(Ttk_LayoutTemplate);
+MODULE_SCOPE void Ttk_RegisterLayoutTemplate(
+    Ttk_Theme theme, const char *layoutName, Ttk_LayoutTemplate);
+
+MODULE_SCOPE Ttk_Style Ttk_GetStyle(Ttk_Theme themePtr, const char *styleName);
+MODULE_SCOPE Ttk_LayoutTemplate Ttk_FindLayoutTemplate(
+    Ttk_Theme themePtr, const char *layoutName);
+
+MODULE_SCOPE const char *Ttk_StyleName(Ttk_Style);
+
+#endif /* _TTKTHEMEINT */

generic/ttk/ttkTrace.c

@@ -0,0 +1,190 @@
+/*
+ * Copyright 2003, Joe English
+ *
+ * Simplified interface to Tcl_TraceVariable.
+ *
+ * PROBLEM: Can't distinguish "variable does not exist" (which is OK) 
+ * from other errors (which are not).
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+struct TtkTraceHandle_
+{
+    Tcl_Interp		*interp;	/* Containing interpreter */
+    Tcl_Obj 		*varnameObj;	/* Name of variable being traced */
+    Ttk_TraceProc	callback;	/* Callback procedure */
+    void		*clientData;	/* Data to pass to callback */
+};
+
+/*
+ * Tcl_VarTraceProc for trace handles.
+ */
+static char *
+VarTraceProc(
+    ClientData clientData,	/* Widget record pointer */
+    Tcl_Interp *interp, 	/* Interpreter containing variable. */
+    const char *name1,		/* (unused) */
+    const char *name2,		/* (unused) */
+    int flags)			/* Information about what happened. */
+{
+    Ttk_TraceHandle *tracePtr = clientData;
+    const char *name, *value;
+    Tcl_Obj *valuePtr;
+
+    if (flags & TCL_INTERP_DESTROYED) {
+	return NULL;
+    }
+
+    name = Tcl_GetString(tracePtr->varnameObj);
+
+    /*
+     * If the variable is being unset, then re-establish the trace:
+     */
+    if (flags & TCL_TRACE_DESTROYED) {
+	/*
+	 * If a prior call to Ttk_UntraceVariable() left behind an
+	 * indicator that we wanted this handler to be deleted (see below),
+	 * cleanup the ClientData bits and exit.
+	 */
+	if (tracePtr->interp == NULL) {
+	    Tcl_DecrRefCount(tracePtr->varnameObj);
+	    ckfree((ClientData)tracePtr);
+	    return NULL;
+	}
+	Tcl_TraceVar2(interp, name, NULL,
+		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+		VarTraceProc, clientData);
+	tracePtr->callback(tracePtr->clientData, NULL);
+	return NULL;
+    }
+
+    /*
+     * Call the callback:
+     */
+    valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+    value = valuePtr ?  Tcl_GetString(valuePtr) : NULL;
+    tracePtr->callback(tracePtr->clientData, value);
+
+    return NULL;
+}
+
+/* Ttk_TraceVariable(interp, varNameObj, callback, clientdata) --
+ * 	Attach a write trace to the specified variable,
+ * 	which will pass the variable's value to 'callback'
+ * 	whenever the variable is set.
+ *
+ * 	When the variable is unset, passes NULL to the callback
+ * 	and reattaches the trace.
+ */
+Ttk_TraceHandle *Ttk_TraceVariable(
+    Tcl_Interp *interp,
+    Tcl_Obj *varnameObj,
+    Ttk_TraceProc callback,
+    void *clientData)
+{
+    Ttk_TraceHandle *h = ckalloc(sizeof(*h));
+    int status;
+
+    h->interp = interp;
+    h->varnameObj = Tcl_DuplicateObj(varnameObj);
+    Tcl_IncrRefCount(h->varnameObj);
+    h->clientData = clientData;
+    h->callback = callback;
+
+    status = Tcl_TraceVar2(interp, Tcl_GetString(varnameObj),
+	    NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+	    VarTraceProc, (ClientData)h);
+
+    if (status != TCL_OK) {
+	Tcl_DecrRefCount(h->varnameObj);
+	ckfree(h);
+	return NULL;
+    }
+
+    return h;
+}
+
+/*
+ * Ttk_UntraceVariable --
+ * 	Remove previously-registered trace and free the handle.
+ */
+void Ttk_UntraceVariable(Ttk_TraceHandle *h)
+{
+    if (h) {
+	ClientData cd = NULL;
+
+	/*
+	 * Workaround for Tcl Bug 3062331.  The trace design problem is
+	 * that when variable unset traces fire, Tcl documents that the
+	 * traced variable has already been unset.  It's already gone.
+	 * So from within an unset trace, if you try to call
+	 * Tcl_UntraceVar() on that variable, it will do nothing, because
+	 * the variable by that name can no longer be found.  It's gone.
+	 * This means callers of Tcl_UntraceVar() that might be running
+	 * in response to an unset trace have to handle the possibility
+	 * that their Tcl_UntraceVar() call will do nothing.  In this case,
+	 * we have to support the possibility that Tcl_UntraceVar() will
+	 * leave the trace in place, so we need to leave the ClientData
+	 * untouched so when that trace does fire it will not crash.
+	 */
+
+	/*
+	 * Search the traces on the variable to see if the one we are tasked
+	 * with removing is present.
+	 */
+	while ((cd = Tcl_VarTraceInfo(h->interp, Tcl_GetString(h->varnameObj),
+		TCL_GLOBAL_ONLY, VarTraceProc, cd)) != NULL) {
+	    if (cd == (ClientData) h) {
+		break;
+	    }
+	}
+	/*
+	 * If the trace we wish to delete is not visible, Tcl_UntraceVar
+	 * will do nothing, so don't try to call it.  Instead set an
+	 * indicator in the Ttk_TraceHandle that we need to cleanup later.
+	 */
+	if (cd == NULL) {
+	    h->interp = NULL;
+	    return;
+	}
+	Tcl_UntraceVar2(h->interp, Tcl_GetString(h->varnameObj),
+		NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+		VarTraceProc, (ClientData)h);
+	Tcl_DecrRefCount(h->varnameObj);
+	ckfree(h);
+    }
+}
+
+/*
+ * Ttk_FireTrace --
+ * 	Executes a trace handle as if the variable has been written.
+ *
+ * 	Note: may reenter the interpreter.
+ */
+int Ttk_FireTrace(Ttk_TraceHandle *tracePtr)
+{
+    Tcl_Interp *interp = tracePtr->interp;
+    void *clientData = tracePtr->clientData;
+    const char *name = Tcl_GetString(tracePtr->varnameObj);
+    Ttk_TraceProc callback = tracePtr->callback;
+    Tcl_Obj *valuePtr;
+    const char *value;
+
+    /* Read the variable.
+     * Note that this can reenter the interpreter, and anything can happen --
+     * including the current trace handle being freed!
+     */
+    valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+    value = valuePtr ? Tcl_GetString(valuePtr) : NULL;
+
+    /* Call callback.
+     */
+    callback(clientData, value);
+
+    return TCL_OK;
+}
+
+/*EOF*/

generic/ttk/ttkTrack.c

@@ -0,0 +1,183 @@
+/*
+ * Copyright (c) 2004, Joe English
+ *
+ * TtkTrackElementState() -- helper routine for widgets
+ * like scrollbars in which individual elements may
+ * be active or pressed instead of the widget as a whole.
+ *
+ * Usage:
+ * 	TtkTrackElementState(&recordPtr->core);
+ *
+ * Registers an event handler on the widget that tracks pointer
+ * events and updates the state of the element under the
+ * mouse cursor.
+ *
+ * The "active" element is the one under the mouse cursor,
+ * and is normally set to the ACTIVE state unless another element
+ * is currently being pressed.
+ *
+ * The active element becomes "pressed" on <ButtonPress> events,
+ * and remains "active" and "pressed" until the corresponding
+ * <ButtonRelease> event.
+ *
+ * TODO: Handle "chords" properly (e.g., <B1-ButtonPress-2>)
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+typedef struct {
+    WidgetCore		*corePtr;	/* widget to track */
+    Ttk_Layout		tracking;	/* current layout being tracked */
+    Ttk_Element 	activeElement;	/* element under the mouse cursor */
+    Ttk_Element 	pressedElement; /* currently pressed element */
+} ElementStateTracker;
+
+/*
+ * ActivateElement(es, node) --
+ * 	Make 'node' the active element if non-NULL.
+ * 	Deactivates the currently active element if different.
+ *
+ * 	The active element has TTK_STATE_ACTIVE set _unless_
+ * 	another element is 'pressed'
+ */
+static void ActivateElement(ElementStateTracker *es, Ttk_Element element)
+{
+    if (es->activeElement == element) {
+	/* No change */
+	return;
+    }
+
+    if (!es->pressedElement) {
+	if (es->activeElement) {
+	    /* Deactivate old element */
+	    Ttk_ChangeElementState(es->activeElement, 0,TTK_STATE_ACTIVE);
+	}
+	if (element) {
+	    /* Activate new element */
+	    Ttk_ChangeElementState(element, TTK_STATE_ACTIVE,0);
+	}
+	TtkRedisplayWidget(es->corePtr);
+    }
+
+    es->activeElement = element;
+}
+
+/* ReleaseElement --
+ * 	Releases the currently pressed element, if any.
+ */
+static void ReleaseElement(ElementStateTracker *es)
+{
+    if (!es->pressedElement)
+	return;
+
+    Ttk_ChangeElementState(
+	es->pressedElement, 0,TTK_STATE_PRESSED|TTK_STATE_ACTIVE);
+    es->pressedElement = 0;
+
+    /* Reactivate element under the mouse cursor:
+     */
+    if (es->activeElement)
+	Ttk_ChangeElementState(es->activeElement, TTK_STATE_ACTIVE,0);
+
+    TtkRedisplayWidget(es->corePtr);
+}
+
+/* PressElement --
+ * 	Presses the specified element.
+ */
+static void PressElement(ElementStateTracker *es, Ttk_Element element)
+{
+    if (es->pressedElement) {
+	ReleaseElement(es);
+    }
+
+    if (element) {
+	Ttk_ChangeElementState(
+	    element, TTK_STATE_PRESSED|TTK_STATE_ACTIVE, 0);
+    }
+
+    es->pressedElement = element;
+    TtkRedisplayWidget(es->corePtr);
+}
+
+/* ElementStateEventProc --
+ * 	Event handler for tracking element states.
+ */
+
+static const unsigned ElementStateMask =
+      ButtonPressMask
+    | ButtonReleaseMask
+    | PointerMotionMask
+    | LeaveWindowMask
+    | EnterWindowMask
+    | StructureNotifyMask
+    ;
+
+static void
+ElementStateEventProc(ClientData clientData, XEvent *ev)
+{
+    ElementStateTracker *es = clientData;
+    Ttk_Layout layout = es->corePtr->layout;
+    Ttk_Element element;
+
+    /* Guard against dangling pointers [#2431428]
+     */
+    if (es->tracking != layout) {
+	es->pressedElement = es->activeElement = 0;
+	es->tracking = layout;
+    }
+
+    switch (ev->type)
+    {
+	case MotionNotify :
+	    element = Ttk_IdentifyElement(
+		layout, ev->xmotion.x, ev->xmotion.y);
+	    ActivateElement(es, element);
+	    break;
+	case LeaveNotify:
+	    ActivateElement(es, 0);
+	    if (ev->xcrossing.mode == NotifyGrab)
+		PressElement(es, 0);
+	    break;
+	case EnterNotify:
+	    element = Ttk_IdentifyElement(
+		layout, ev->xcrossing.x, ev->xcrossing.y);
+	    ActivateElement(es, element);
+	    break;
+	case ButtonPress:
+	    element = Ttk_IdentifyElement(
+		layout, ev->xbutton.x, ev->xbutton.y);
+	    if (element)
+		PressElement(es, element);
+	    break;
+	case ButtonRelease:
+	    ReleaseElement(es);
+	    break;
+	case DestroyNotify:
+	    /* Unregister this event handler and free client data.
+	     */
+	    Tk_DeleteEventHandler(es->corePtr->tkwin,
+		    ElementStateMask, ElementStateEventProc, es);
+	    ckfree(clientData);
+	    break;
+    }
+}
+
+/*
+ * TtkTrackElementState --
+ * 	Register an event handler to manage the 'pressed'
+ * 	and 'active' states of individual widget elements.
+ */
+
+void TtkTrackElementState(WidgetCore *corePtr)
+{
+    ElementStateTracker *es = ckalloc(sizeof(*es));
+    es->corePtr = corePtr;
+    es->tracking = 0;
+    es->activeElement = es->pressedElement = 0;
+    Tk_CreateEventHandler(corePtr->tkwin,
+	    ElementStateMask,ElementStateEventProc,es);
+}
+

generic/ttk/ttkWidget.c

@@ -0,0 +1,791 @@
+/*
+ * Copyright (c) 2003, Joe English
+ *
+ * Core widget utilities.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#ifdef MAC_OSX_TK
+#define TK_NO_DOUBLE_BUFFERING 1
+#endif
+
+/*------------------------------------------------------------------------
+ * +++ Internal helper routines.
+ */
+
+/* UpdateLayout --
+ * 	Call the widget's get-layout hook to recompute corePtr->layout.
+ * 	Returns TCL_OK if successful, returns TCL_ERROR and leaves
+ * 	the layout unchanged otherwise.
+ */
+static int UpdateLayout(Tcl_Interp *interp, WidgetCore *corePtr)
+{
+    Ttk_Theme themePtr = Ttk_GetCurrentTheme(interp);
+    Ttk_Layout newLayout =
+    	corePtr->widgetSpec->getLayoutProc(interp, themePtr,corePtr);
+
+    if (newLayout) {
+	if (corePtr->layout) {
+	    Ttk_FreeLayout(corePtr->layout);
+	}
+	corePtr->layout = newLayout;
+	return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+/* SizeChanged --
+ * 	Call the widget's sizeProc to compute new requested size
+ * 	and pass it to the geometry manager.
+ */
+static void SizeChanged(WidgetCore *corePtr)
+{
+    int reqWidth = 1, reqHeight = 1;
+
+    if (corePtr->widgetSpec->sizeProc(corePtr,&reqWidth,&reqHeight)) {
+	Tk_GeometryRequest(corePtr->tkwin, reqWidth, reqHeight);
+    }
+}
+
+#ifndef TK_NO_DOUBLE_BUFFERING
+
+/* BeginDrawing --
+ * 	Returns a Drawable for drawing the widget contents.
+ *	This is normally an off-screen Pixmap, copied to
+ *	the window by EndDrawing().
+ */
+static Drawable BeginDrawing(Tk_Window tkwin)
+{
+    return Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+	    Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+}
+
+/* EndDrawing --
+ *	Copy the drawable contents to the screen and release resources.
+ */
+static void EndDrawing(Tk_Window tkwin, Drawable d)
+{
+    XGCValues gcValues;
+    GC gc;
+
+    gcValues.function = GXcopy;
+    gcValues.graphics_exposures = False;
+    gc = Tk_GetGC(tkwin, GCFunction|GCGraphicsExposures, &gcValues);
+
+    XCopyArea(Tk_Display(tkwin), d, Tk_WindowId(tkwin), gc,
+	    0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+	    0, 0);
+
+    Tk_FreePixmap(Tk_Display(tkwin), d);
+    Tk_FreeGC(Tk_Display(tkwin), gc);
+}
+#else
+/* No double-buffering: draw directly into the window. */
+static Drawable BeginDrawing(Tk_Window tkwin) { return Tk_WindowId(tkwin); }
+static void EndDrawing(Tk_Window tkwin, Drawable d) { }
+#endif
+
+/* DrawWidget --
+ *	Redraw a widget.  Called as an idle handler.
+ */
+static void DrawWidget(ClientData recordPtr)
+{
+    WidgetCore *corePtr = recordPtr;
+
+    corePtr->flags &= ~REDISPLAY_PENDING;
+    if (Tk_IsMapped(corePtr->tkwin)) {
+	Drawable d = BeginDrawing(corePtr->tkwin);
+	corePtr->widgetSpec->layoutProc(recordPtr);
+	corePtr->widgetSpec->displayProc(recordPtr, d);
+	EndDrawing(corePtr->tkwin, d);
+    }
+}
+
+/* TtkRedisplayWidget --
+ * 	Schedule redisplay as an idle handler.
+ */
+void TtkRedisplayWidget(WidgetCore *corePtr)
+{
+    if (corePtr->flags & WIDGET_DESTROYED) {
+	return;
+    }
+
+    if (!(corePtr->flags & REDISPLAY_PENDING)) {
+	Tcl_DoWhenIdle(DrawWidget, corePtr);
+	corePtr->flags |= REDISPLAY_PENDING;
+    }
+}
+
+/* TtkResizeWidget --
+ * 	Recompute widget size, schedule geometry propagation and redisplay.
+ */
+void TtkResizeWidget(WidgetCore *corePtr)
+{
+    if (corePtr->flags & WIDGET_DESTROYED) {
+	return;
+    }
+
+    SizeChanged(corePtr);
+    TtkRedisplayWidget(corePtr);
+}
+
+/* TtkWidgetChangeState --
+ * 	Set / clear the specified bits in the 'state' flag,
+ */
+void TtkWidgetChangeState(WidgetCore *corePtr,
+    unsigned int setBits, unsigned int clearBits)
+{
+    Ttk_State oldState = corePtr->state;
+    corePtr->state = (oldState & ~clearBits) | setBits;
+    if (corePtr->state ^ oldState) {
+	TtkRedisplayWidget(corePtr);
+    }
+}
+
+/* WidgetInstanceObjCmd --
+ *	Widget instance command implementation.
+ */
+static int
+WidgetInstanceObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    WidgetCore *corePtr = clientData;
+    const Ttk_Ensemble *commands = corePtr->widgetSpec->commands;
+    int status;
+
+    Tcl_Preserve(clientData);
+    status = Ttk_InvokeEnsemble(commands,1, clientData,interp,objc,objv);
+    Tcl_Release(clientData);
+
+    return status;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget destruction.
+ *
+ * A widget can be destroyed when the application explicitly
+ * destroys the window or one of its ancestors via [destroy]
+ * or Tk_DestroyWindow(); when the application deletes the widget
+ * instance command; when there is an error in the widget constructor;
+ * or when another application calls XDestroyWindow on the window ID.
+ *
+ * The window receives a <DestroyNotify> event in all cases,
+ * so we do the bulk of the cleanup there.  See [#2207435] for
+ * further notes (esp. re: Tk_FreeConfigOptions).
+ *
+ * Widget code that reenters the interp should only do so
+ * when the widtget is Tcl_Preserve()d, and should check
+ * the WIDGET_DESTROYED flag bit upon return.
+ */
+
+/* WidgetInstanceObjCmdDeleted --
+ * 	Widget instance command	deletion callback.
+ */
+static void
+WidgetInstanceObjCmdDeleted(ClientData clientData)
+{
+    WidgetCore *corePtr = clientData;
+    corePtr->widgetCmd = NULL;
+    if (corePtr->tkwin != NULL)
+	Tk_DestroyWindow(corePtr->tkwin);
+}
+
+/* FreeWidget --
+ *	 Final cleanup for widget; called via Tcl_EventuallyFree().
+ */
+static void
+FreeWidget(void *memPtr)
+{
+    ckfree(memPtr);
+}
+
+/* DestroyWidget --
+ * 	Main widget destructor; called from <DestroyNotify> event handler.
+ */
+static void
+DestroyWidget(WidgetCore *corePtr)
+{
+    corePtr->flags |= WIDGET_DESTROYED;
+
+    corePtr->widgetSpec->cleanupProc(corePtr);
+
+    Tk_FreeConfigOptions(
+	(ClientData)corePtr, corePtr->optionTable, corePtr->tkwin);
+
+    if (corePtr->layout) {
+	Ttk_FreeLayout(corePtr->layout);
+    }
+
+    if (corePtr->flags & REDISPLAY_PENDING) {
+	Tcl_CancelIdleCall(DrawWidget, corePtr);
+    }
+
+    corePtr->tkwin = NULL;
+    if (corePtr->widgetCmd) {
+	Tcl_Command cmd = corePtr->widgetCmd;
+	corePtr->widgetCmd = 0;
+	/* NB: this can reenter the interpreter via a command traces */
+	Tcl_DeleteCommandFromToken(corePtr->interp, cmd);
+    }
+    Tcl_EventuallyFree(corePtr, (Tcl_FreeProc *) FreeWidget);
+}
+
+/*
+ * CoreEventProc --
+ *	Event handler for basic events.
+ *	Processes Expose, Configure, FocusIn/Out, and Destroy events.
+ *	Also handles <<ThemeChanged>> virtual events.
+ *
+ *	For Expose and Configure, simply schedule the widget for redisplay.
+ *	For Destroy events, handle the cleanup process.
+ *
+ *	For Focus events, set/clear the focus bit in the state field.
+ *	It turns out this is impossible to do correctly in a binding script,
+ *	because Tk filters out focus events with detail == NotifyInferior.
+ *
+ *	For Deactivate/Activate pseudo-events, set/clear the background state
+ *	flag.
+ */
+
+static const unsigned CoreEventMask
+    = ExposureMask
+    | StructureNotifyMask
+    | FocusChangeMask
+    | VirtualEventMask
+    | ActivateMask
+    | EnterWindowMask
+    | LeaveWindowMask
+    ;
+
+static void CoreEventProc(ClientData clientData, XEvent *eventPtr)
+{
+    WidgetCore *corePtr = clientData;
+
+    switch (eventPtr->type)
+    {
+	case ConfigureNotify :
+	    TtkRedisplayWidget(corePtr);
+	    break;
+	case Expose :
+	    if (eventPtr->xexpose.count == 0) {
+		TtkRedisplayWidget(corePtr);
+	    }
+	    break;
+	case DestroyNotify :
+	    Tk_DeleteEventHandler(
+		corePtr->tkwin, CoreEventMask,CoreEventProc,clientData);
+	    DestroyWidget(corePtr);
+	    break;
+	case FocusIn:
+	case FocusOut:
+	    /* Don't process "virtual crossing" events */
+	    if (   eventPtr->xfocus.detail == NotifyInferior
+		|| eventPtr->xfocus.detail == NotifyAncestor
+		|| eventPtr->xfocus.detail == NotifyNonlinear)
+	    {
+		if (eventPtr->type == FocusIn)
+		    corePtr->state |= TTK_STATE_FOCUS;
+		else
+		    corePtr->state &= ~TTK_STATE_FOCUS;
+		TtkRedisplayWidget(corePtr);
+	    }
+	    break;
+	case ActivateNotify:
+	    corePtr->state &= ~TTK_STATE_BACKGROUND;
+	    TtkRedisplayWidget(corePtr);
+	    break;
+	case DeactivateNotify:
+	    corePtr->state |= TTK_STATE_BACKGROUND;
+	    TtkRedisplayWidget(corePtr);
+	    break;
+	case LeaveNotify:
+	    corePtr->state &= ~TTK_STATE_HOVER;
+	    TtkRedisplayWidget(corePtr);
+	    break;
+	case EnterNotify:
+	    corePtr->state |= TTK_STATE_HOVER;
+	    TtkRedisplayWidget(corePtr);
+	    break;
+	case VirtualEvent:
+	    if (!strcmp("ThemeChanged", ((XVirtualEvent *)(eventPtr))->name)) {
+		(void)UpdateLayout(corePtr->interp, corePtr);
+		SizeChanged(corePtr);
+		TtkRedisplayWidget(corePtr);
+	    }
+	default:
+	    /* can't happen... */
+	    break;
+    }
+}
+
+/*
+ * WidgetWorldChanged --
+ * 	Default Tk_ClassWorldChangedProc() for widgets.
+ * 	Invoked whenever fonts or other system resources are changed;
+ * 	recomputes geometry.
+ */
+static void WidgetWorldChanged(ClientData clientData)
+{
+    WidgetCore *corePtr = clientData;
+    SizeChanged(corePtr);
+    TtkRedisplayWidget(corePtr);
+}
+
+static Tk_ClassProcs widgetClassProcs = {
+    sizeof(Tk_ClassProcs),	/* size */
+    WidgetWorldChanged,	/* worldChangedProc */
+    NULL,					/* createProc */
+    NULL					/* modalProc */
+};
+
+/*
+ * TtkWidgetConstructorObjCmd --
+ *	General-purpose widget constructor command implementation.
+ *	ClientData is a WidgetSpec *.
+ */
+int TtkWidgetConstructorObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    WidgetSpec *widgetSpec = clientData;
+    const char *className = widgetSpec->className;
+    Tk_OptionTable optionTable =
+	Tk_CreateOptionTable(interp, widgetSpec->optionSpecs);
+    Tk_Window tkwin;
+    void *recordPtr;
+    WidgetCore *corePtr;
+    Tk_SavedOptions savedOptions;
+    int i;
+
+    if (objc < 2 || objc % 2 == 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?");
+	return TCL_ERROR;
+    }
+
+    /* Check if a -class option has been specified.
+     * We have to do this before the InitOptions() call,
+     * since InitOptions() is affected by the widget class.
+     */
+    for (i = 2; i < objc; i += 2) {
+	if (!strcmp(Tcl_GetString(objv[i]), "-class")) {
+	    className = Tcl_GetString(objv[i+1]);
+	    break;
+	}
+    }
+
+    tkwin = Tk_CreateWindowFromPath(
+	interp, Tk_MainWindow(interp), Tcl_GetString(objv[1]), NULL);
+    if (tkwin == NULL)
+	return TCL_ERROR;
+
+    /*
+     * Allocate and initialize the widget record.
+     */
+    recordPtr = ckalloc(widgetSpec->recordSize);
+    memset(recordPtr, 0, widgetSpec->recordSize);
+    corePtr = recordPtr;
+
+    corePtr->tkwin	= tkwin;
+    corePtr->interp 	= interp;
+    corePtr->widgetSpec	= widgetSpec;
+    corePtr->widgetCmd	= Tcl_CreateObjCommand(interp, Tk_PathName(tkwin),
+	WidgetInstanceObjCmd, recordPtr, WidgetInstanceObjCmdDeleted);
+    corePtr->optionTable = optionTable;
+    corePtr->layout	= NULL;
+    corePtr->flags 	= 0;
+    corePtr->state 	= 0;
+
+    Tk_SetClass(tkwin, className);
+    Tk_SetClassProcs(tkwin, &widgetClassProcs, recordPtr);
+    Tk_SetWindowBackgroundPixmap(tkwin, ParentRelative);
+
+    widgetSpec->initializeProc(interp, recordPtr);
+
+    Tk_CreateEventHandler(tkwin, CoreEventMask, CoreEventProc, recordPtr);
+
+    /*
+     * Initial configuration.
+     */
+
+    Tcl_Preserve(corePtr);
+    if (Tk_InitOptions(interp, recordPtr, optionTable, tkwin) != TCL_OK) {
+	goto error;
+    }
+
+    if (Tk_SetOptions(interp, recordPtr, optionTable,
+	    objc - 2, objv + 2, tkwin, &savedOptions, NULL) != TCL_OK) {
+	Tk_RestoreSavedOptions(&savedOptions);
+	goto error;
+    } else {
+	Tk_FreeSavedOptions(&savedOptions);
+    }
+    if (widgetSpec->configureProc(interp, recordPtr, ~0) != TCL_OK)
+	goto error;
+    if (widgetSpec->postConfigureProc(interp, recordPtr, ~0) != TCL_OK)
+	goto error;
+
+    if (WidgetDestroyed(corePtr))
+	goto error;
+
+    Tcl_Release(corePtr);
+
+    SizeChanged(corePtr);
+    Tk_MakeWindowExist(tkwin);
+
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin), -1));
+    return TCL_OK;
+
+error:
+    if (WidgetDestroyed(corePtr)) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"widget has been destroyed", -1));
+    } else {
+	Tk_DestroyWindow(tkwin);
+    }
+    Tcl_Release(corePtr);
+    return TCL_ERROR;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Default implementations for widget hook procedures.
+ */
+
+/* TtkWidgetGetLayout --
+ * 	Default getLayoutProc.
+ *	Looks up the layout based on the -style resource (if specified),
+ *	otherwise use the widget class.
+ */
+Ttk_Layout TtkWidgetGetLayout(
+    Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr)
+{
+    WidgetCore *corePtr = recordPtr;
+    const char *styleName = 0;
+
+    if (corePtr->styleObj)
+    	styleName = Tcl_GetString(corePtr->styleObj);
+
+    if (!styleName || *styleName == '\0')
+    	styleName = corePtr->widgetSpec->className;
+
+    return Ttk_CreateLayout(interp, themePtr, styleName,
+	recordPtr, corePtr->optionTable, corePtr->tkwin);
+}
+
+/*
+ * TtkWidgetGetOrientedLayout --
+ * 	Helper routine.  Same as TtkWidgetGetLayout, but prefixes
+ * 	"Horizontal." or "Vertical." to the style name, depending
+ * 	on the value of the 'orient' option.
+ */
+Ttk_Layout TtkWidgetGetOrientedLayout(
+    Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr, Tcl_Obj *orientObj)
+{
+    WidgetCore *corePtr = recordPtr;
+    const char *baseStyleName = 0;
+    Tcl_DString styleName;
+    int orient = TTK_ORIENT_HORIZONTAL;
+    Ttk_Layout layout;
+
+    Tcl_DStringInit(&styleName);
+
+    /* Prefix:
+     */
+    Ttk_GetOrientFromObj(NULL, orientObj, &orient);
+    if (orient == TTK_ORIENT_HORIZONTAL)
+	Tcl_DStringAppend(&styleName, "Horizontal.", -1);
+    else
+	Tcl_DStringAppend(&styleName, "Vertical.", -1);
+
+    /* Add base style name:
+     */
+    if (corePtr->styleObj)
+    	baseStyleName = Tcl_GetString(corePtr->styleObj);
+    if (!baseStyleName || *baseStyleName == '\0')
+    	baseStyleName = corePtr->widgetSpec->className;
+
+    Tcl_DStringAppend(&styleName, baseStyleName, -1);
+
+    /* Create layout:
+     */
+    layout= Ttk_CreateLayout(interp, themePtr, Tcl_DStringValue(&styleName),
+	recordPtr, corePtr->optionTable, corePtr->tkwin);
+
+    Tcl_DStringFree(&styleName);
+
+    return layout;
+}
+
+/* TtkNullInitialize --
+ * 	Default widget initializeProc (no-op)
+ */
+void TtkNullInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+}
+
+/* TtkNullPostConfigure --
+ * 	Default widget postConfigureProc (no-op)
+ */
+int TtkNullPostConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+    return TCL_OK;
+}
+
+/* TtkCoreConfigure --
+ * 	Default widget configureProc.
+ * 	Handles -style option.
+ */
+int TtkCoreConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+    WidgetCore *corePtr = clientData;
+    int status = TCL_OK;
+
+    if (mask & STYLE_CHANGED) {
+	status = UpdateLayout(interp, corePtr);
+    }
+
+    return status;
+}
+
+/* TtkNullCleanup --
+ * 	Default widget cleanupProc (no-op)
+ */
+void TtkNullCleanup(void *recordPtr)
+{
+    return;
+}
+
+/* TtkWidgetDoLayout --
+ * 	Default widget layoutProc.
+ */
+void TtkWidgetDoLayout(void *clientData)
+{
+    WidgetCore *corePtr = clientData;
+    Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+}
+
+/* TtkWidgetDisplay --
+ * 	Default widget displayProc.
+ */
+void TtkWidgetDisplay(void *recordPtr, Drawable d)
+{
+    WidgetCore *corePtr = recordPtr;
+    Ttk_DrawLayout(corePtr->layout, corePtr->state, d);
+}
+
+/* TtkWidgetSize --
+ * 	Default widget sizeProc()
+ */
+int TtkWidgetSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+    WidgetCore *corePtr = recordPtr;
+    Ttk_LayoutSize(corePtr->layout, corePtr->state, widthPtr, heightPtr);
+    return 1;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Default implementations for widget subcommands.
+ */
+
+/* $w cget -option
+ */
+int TtkWidgetCgetCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    WidgetCore *corePtr = recordPtr;
+    Tcl_Obj *result;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "option");
+	return TCL_ERROR;
+    }
+    result = Tk_GetOptionValue(interp, recordPtr,
+		corePtr->optionTable, objv[2], corePtr->tkwin);
+    if (result == NULL)
+	return TCL_ERROR;
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+/* $w configure ?-option ?value ....??
+ */
+int TtkWidgetConfigureCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    WidgetCore *corePtr = recordPtr;
+    Tcl_Obj *result;
+
+    if (objc == 2) {
+	result = Tk_GetOptionInfo(interp, recordPtr,
+		corePtr->optionTable, NULL, corePtr->tkwin);
+    } else if (objc == 3) {
+	result = Tk_GetOptionInfo(interp, recordPtr,
+		corePtr->optionTable, objv[2], corePtr->tkwin);
+    } else {
+	Tk_SavedOptions savedOptions;
+	int status;
+	int mask = 0;
+
+	status = Tk_SetOptions(interp, recordPtr,
+		corePtr->optionTable, objc - 2, objv + 2,
+		corePtr->tkwin, &savedOptions, &mask);
+	if (status != TCL_OK)
+	    return status;
+
+	if (mask & READONLY_OPTION) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "attempt to change read-only option", -1));
+	    Tk_RestoreSavedOptions(&savedOptions);
+	    return TCL_ERROR;
+	}
+
+	status = corePtr->widgetSpec->configureProc(interp, recordPtr, mask);
+	if (status != TCL_OK) {
+	    Tk_RestoreSavedOptions(&savedOptions);
+	    return status;
+	}
+	Tk_FreeSavedOptions(&savedOptions);
+
+	status = corePtr->widgetSpec->postConfigureProc(interp,recordPtr,mask);
+	if (WidgetDestroyed(corePtr)) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "widget has been destroyed", -1));
+	    status = TCL_ERROR;
+	}
+	if (status != TCL_OK) {
+	    return status;
+	}
+
+	if (mask & (STYLE_CHANGED | GEOMETRY_CHANGED)) {
+	    SizeChanged(corePtr);
+	}
+
+	TtkRedisplayWidget(corePtr);
+	result = Tcl_NewObj();
+    }
+
+    if (result == 0) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+/* $w state ? $stateSpec ?
+ *
+ * 	If $stateSpec is specified, modify the widget state accordingly,
+ * 	return a new stateSpec representing the changed bits.
+ *
+ * 	Otherwise, return a statespec matching all the currently-set bits.
+ */
+
+int TtkWidgetStateCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    WidgetCore *corePtr = recordPtr;
+    Ttk_StateSpec spec;
+    int status;
+    Ttk_State oldState, changed;
+
+    if (objc == 2) {
+	Tcl_SetObjResult(interp,
+	    Ttk_NewStateSpecObj(corePtr->state, 0ul));
+	return TCL_OK;
+    }
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "state-spec");
+	return TCL_ERROR;
+    }
+    status = Ttk_GetStateSpecFromObj(interp, objv[2], &spec);
+    if (status != TCL_OK)
+	return status;
+
+    oldState = corePtr->state;
+    corePtr->state = Ttk_ModifyState(corePtr->state, &spec);
+    changed = corePtr->state ^ oldState;
+
+    TtkRedisplayWidget(corePtr);
+
+    Tcl_SetObjResult(interp,
+	Ttk_NewStateSpecObj(oldState & changed, ~oldState & changed));
+    return status;
+}
+
+/* $w instate $stateSpec ?$script?
+ *
+ * 	Tests if widget state matches $stateSpec.
+ *	If $script is specified, execute script if state matches.
+ *	Otherwise, return true/false
+ */
+
+int TtkWidgetInstateCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    WidgetCore *corePtr = recordPtr;
+    Ttk_State state = corePtr->state;
+    Ttk_StateSpec spec;
+    int status = TCL_OK;
+
+    if (objc < 3 || objc > 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "state-spec ?script?");
+	return TCL_ERROR;
+    }
+    status = Ttk_GetStateSpecFromObj(interp, objv[2], &spec);
+    if (status != TCL_OK)
+	return status;
+
+    if (objc == 3) {
+	Tcl_SetObjResult(interp,
+	    Tcl_NewBooleanObj(Ttk_StateMatches(state,&spec)));
+    } else if (objc == 4) {
+	if (Ttk_StateMatches(state,&spec)) {
+	    status = Tcl_EvalObjEx(interp, objv[3], 0);
+	}
+    }
+    return status;
+}
+
+/* $w identify $x $y
+ * $w identify element $x $y
+ * 	Returns: name of element at $x, $y
+ */
+int TtkWidgetIdentifyCommand(
+    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
+{
+    WidgetCore *corePtr = recordPtr;
+    Ttk_Element element;
+    static const char *whatTable[] = { "element", NULL };
+    int x, y, what;
+
+    if (objc < 4 || objc > 5) {
+	Tcl_WrongNumArgs(interp, 2, objv, "?what? x y");
+	return TCL_ERROR;
+    }
+    if (objc == 5) {
+	/* $w identify element $x $y */
+	if (Tcl_GetIndexFromObjStruct(interp, objv[2], whatTable,
+		sizeof(char *), "option", 0, &what) != TCL_OK)
+	{
+	    return TCL_ERROR;
+	}
+    }
+
+    if (   Tcl_GetIntFromObj(interp, objv[objc-2], &x) != TCL_OK
+	|| Tcl_GetIntFromObj(interp, objv[objc-1], &y) != TCL_OK
+    ) {
+	return TCL_ERROR;
+    }
+
+    element = Ttk_IdentifyElement(corePtr->layout, x, y);
+    if (element) {
+	const char *elementName = Ttk_ElementName(element);
+	Tcl_SetObjResult(interp,Tcl_NewStringObj(elementName,-1));
+    }
+
+    return TCL_OK;
+}
+
+/*EOF*/

generic/ttk/ttkWidget.h

@@ -0,0 +1,273 @@
+/*
+ * Copyright (c) 2003, Joe English
+ * Helper routines for widget implementations.
+ */
+
+#ifndef _TTKWIDGET
+#define _TTKWIDGET
+
+/*
+ * State flags for 'flags' field.
+ */
+#define WIDGET_DESTROYED	0x0001
+#define REDISPLAY_PENDING 	0x0002	/* scheduled call to RedisplayWidget */
+#define CURSOR_ON 		0x0020	/* See TtkBlinkCursor() */
+#define WIDGET_USER_FLAG        0x0100  /* 0x0100 - 0x8000 for user flags */
+
+/*
+ * Bit fields for OptionSpec 'mask' field:
+ */
+#define READONLY_OPTION 	0x1
+#define STYLE_CHANGED   	0x2
+#define GEOMETRY_CHANGED	0x4
+
+/*
+ * Core widget elements
+ */
+typedef struct WidgetSpec_ WidgetSpec;	/* Forward */
+
+typedef struct
+{
+    Tk_Window tkwin;		/* Window associated with widget */
+    Tcl_Interp *interp;		/* Interpreter associated with widget. */
+    WidgetSpec *widgetSpec;	/* Widget class hooks */
+    Tcl_Command widgetCmd;	/* Token for widget command. */
+    Tk_OptionTable optionTable;	/* Option table */
+    Ttk_Layout layout;  	/* Widget layout */
+
+    /*
+     * Storage for resources:
+     */
+    Tcl_Obj *takeFocusPtr;	/* Storage for -takefocus option */
+    Tcl_Obj *cursorObj;		/* Storage for -cursor option */
+    Tcl_Obj *styleObj;		/* Name of currently-applied style */
+    Tcl_Obj *classObj;		/* Class name (readonly option) */
+
+    Ttk_State state;		/* Current widget state */
+    unsigned int flags;		/* internal flags, see above */
+
+} WidgetCore;
+
+/*
+ * Widget specifications:
+ */
+struct WidgetSpec_
+{
+    const char 		*className;	/* Widget class name */
+    size_t 		recordSize;	/* #bytes in widget record */
+    const Tk_OptionSpec	*optionSpecs;	/* Option specifications */
+    const Ttk_Ensemble	*commands;	/* Widget instance subcommands */
+
+    /*
+     * Hooks:
+     */
+    void  	(*initializeProc)(Tcl_Interp *, void *recordPtr);
+    void	(*cleanupProc)(void *recordPtr);
+    int 	(*configureProc)(Tcl_Interp *, void *recordPtr, int flags);
+    int 	(*postConfigureProc)(Tcl_Interp *, void *recordPtr, int flags);
+    Ttk_Layout	(*getLayoutProc)(Tcl_Interp *,Ttk_Theme, void *recordPtr);
+    int 	(*sizeProc)(void *recordPtr, int *widthPtr, int *heightPtr);
+    void	(*layoutProc)(void *recordPtr);
+    void	(*displayProc)(void *recordPtr, Drawable d);
+};
+
+/*
+ * Common factors for widget implementations:
+ */
+MODULE_SCOPE void TtkNullInitialize(Tcl_Interp *, void *);
+MODULE_SCOPE int  TtkNullPostConfigure(Tcl_Interp *, void *, int);
+MODULE_SCOPE void TtkNullCleanup(void *recordPtr);
+MODULE_SCOPE Ttk_Layout TtkWidgetGetLayout(
+	Tcl_Interp *, Ttk_Theme, void *recordPtr);
+MODULE_SCOPE Ttk_Layout TtkWidgetGetOrientedLayout(
+	Tcl_Interp *, Ttk_Theme, void *recordPtr, Tcl_Obj *orientObj);
+MODULE_SCOPE int  TtkWidgetSize(void *recordPtr, int *w, int *h);
+MODULE_SCOPE void TtkWidgetDoLayout(void *recordPtr);
+MODULE_SCOPE void TtkWidgetDisplay(void *recordPtr, Drawable);
+
+MODULE_SCOPE int TtkCoreConfigure(Tcl_Interp*, void *, int mask);
+
+/* Common widget commands:
+ */
+MODULE_SCOPE int TtkWidgetConfigureCommand(
+	void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+MODULE_SCOPE int TtkWidgetCgetCommand(
+	void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+MODULE_SCOPE int TtkWidgetInstateCommand(
+	void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+MODULE_SCOPE int TtkWidgetStateCommand(
+	void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+MODULE_SCOPE int TtkWidgetIdentifyCommand(
+	void *,Tcl_Interp *, int, Tcl_Obj*const[]);
+
+/* Widget constructor:
+ */
+MODULE_SCOPE int TtkWidgetConstructorObjCmd(
+	ClientData, Tcl_Interp*, int, Tcl_Obj*const[]);
+
+#define RegisterWidget(interp, name, specPtr) \
+    Tcl_CreateObjCommand(interp, name, \
+	TtkWidgetConstructorObjCmd, (ClientData)specPtr,NULL)
+
+/* WIDGET_TAKEFOCUS_TRUE --
+ * WIDGET_TAKEFOCUS_FALSE --
+ *	Add one or the other of these to each OptionSpecs table 
+ *	to indicate whether the widget should take focus 
+ *	during keyboard traversal.
+ */
+#define WIDGET_TAKEFOCUS_TRUE \
+    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", \
+	"ttk::takefocus", Tk_Offset(WidgetCore, takeFocusPtr), -1, 0,0,0 }
+#define WIDGET_TAKEFOCUS_FALSE \
+    {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", \
+	"", Tk_Offset(WidgetCore, takeFocusPtr), -1, 0,0,0 }
+
+/* WIDGET_INHERIT_OPTIONS(baseOptionSpecs) --
+ * Add this at the end of an OptionSpecs table to inherit
+ * the options from 'baseOptionSpecs'.
+ */
+#define WIDGET_INHERIT_OPTIONS(baseOptionSpecs) \
+    {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0, (ClientData)baseOptionSpecs, 0}
+
+/* All widgets should inherit from ttkCoreOptionSpecs[].
+ */
+MODULE_SCOPE Tk_OptionSpec ttkCoreOptionSpecs[];
+
+/*
+ * Useful routines for use inside widget implementations:
+ */
+/* extern int WidgetDestroyed(WidgetCore *); */
+#define WidgetDestroyed(corePtr) ((corePtr)->flags & WIDGET_DESTROYED)
+
+MODULE_SCOPE void TtkWidgetChangeState(WidgetCore *,
+	unsigned int setBits, unsigned int clearBits);
+
+MODULE_SCOPE void TtkRedisplayWidget(WidgetCore *);
+MODULE_SCOPE void TtkResizeWidget(WidgetCore *);
+
+MODULE_SCOPE void TtkTrackElementState(WidgetCore *);
+MODULE_SCOPE void TtkBlinkCursor(WidgetCore *);
+
+/*
+ * -state option values (compatibility)
+ */
+MODULE_SCOPE void TtkCheckStateOption(WidgetCore *, Tcl_Obj *);
+
+/*
+ * Variable traces:
+ */
+typedef void (*Ttk_TraceProc)(void *recordPtr, const char *value);
+typedef struct TtkTraceHandle_ Ttk_TraceHandle;
+
+MODULE_SCOPE Ttk_TraceHandle *Ttk_TraceVariable(
+    Tcl_Interp*, Tcl_Obj *varnameObj, Ttk_TraceProc callback, void *clientData);
+MODULE_SCOPE void Ttk_UntraceVariable(Ttk_TraceHandle *);
+MODULE_SCOPE int Ttk_FireTrace(Ttk_TraceHandle *);
+
+/*
+ * Virtual events:
+ */
+MODULE_SCOPE void TtkSendVirtualEvent(Tk_Window tgtWin, const char *eventName);
+
+/*
+ * Helper routines for data accessor commands:
+ */
+MODULE_SCOPE int TtkEnumerateOptions(
+    Tcl_Interp *, void *, const Tk_OptionSpec *, Tk_OptionTable, Tk_Window);
+MODULE_SCOPE int TtkGetOptionValue(
+    Tcl_Interp *, void *, Tcl_Obj *optName, Tk_OptionTable, Tk_Window);
+
+/*
+ * Helper routines for scrolling widgets (see scroll.c).
+ */
+typedef struct {
+    int 	first;		/* First visible item */
+    int 	last;		/* Last visible item */
+    int 	total;		/* Total #items */
+    char 	*scrollCmd;	/* Widget option */
+} Scrollable;
+
+typedef struct ScrollHandleRec *ScrollHandle;
+
+MODULE_SCOPE ScrollHandle TtkCreateScrollHandle(WidgetCore *, Scrollable *);
+MODULE_SCOPE void TtkFreeScrollHandle(ScrollHandle);
+
+MODULE_SCOPE int TtkScrollviewCommand(
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], ScrollHandle);
+
+MODULE_SCOPE void TtkScrollTo(ScrollHandle, int newFirst);
+MODULE_SCOPE void TtkScrolled(ScrollHandle, int first, int last, int total);
+MODULE_SCOPE void TtkScrollbarUpdateRequired(ScrollHandle);
+
+/*
+ * Tag sets (work in progress, half-baked)
+ */
+
+typedef struct TtkTag *Ttk_Tag;
+typedef struct TtkTagTable *Ttk_TagTable;
+typedef struct TtkTagSet {	/* TODO: make opaque */
+    Ttk_Tag	*tags;
+    int 	nTags;
+} *Ttk_TagSet;
+
+MODULE_SCOPE Ttk_TagTable Ttk_CreateTagTable(
+	Tcl_Interp *, Tk_Window tkwin, Tk_OptionSpec[], int recordSize);
+MODULE_SCOPE void Ttk_DeleteTagTable(Ttk_TagTable);
+
+MODULE_SCOPE Ttk_Tag Ttk_GetTag(Ttk_TagTable, const char *tagName);
+MODULE_SCOPE Ttk_Tag Ttk_GetTagFromObj(Ttk_TagTable, Tcl_Obj *);
+
+MODULE_SCOPE Tcl_Obj *Ttk_TagOptionValue(
+    Tcl_Interp *, Ttk_TagTable, Ttk_Tag, Tcl_Obj *optionName);
+
+MODULE_SCOPE int Ttk_EnumerateTagOptions(
+    Tcl_Interp *, Ttk_TagTable, Ttk_Tag);
+
+MODULE_SCOPE int Ttk_EnumerateTags(Tcl_Interp *, Ttk_TagTable);
+
+MODULE_SCOPE int Ttk_ConfigureTag(
+    Tcl_Interp *interp, Ttk_TagTable tagTable, Ttk_Tag tag,
+    int objc, Tcl_Obj *const objv[]);
+
+MODULE_SCOPE Ttk_TagSet Ttk_GetTagSetFromObj(
+    Tcl_Interp *interp, Ttk_TagTable, Tcl_Obj *objPtr);
+MODULE_SCOPE Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet);
+
+MODULE_SCOPE void Ttk_FreeTagSet(Ttk_TagSet);
+
+MODULE_SCOPE int Ttk_TagSetContains(Ttk_TagSet, Ttk_Tag tag);
+MODULE_SCOPE int Ttk_TagSetAdd(Ttk_TagSet, Ttk_Tag tag);
+MODULE_SCOPE int Ttk_TagSetRemove(Ttk_TagSet, Ttk_Tag tag);
+
+MODULE_SCOPE void Ttk_TagSetValues(Ttk_TagTable, Ttk_TagSet, void *record);
+MODULE_SCOPE void Ttk_TagSetApplyStyle(Ttk_TagTable,Ttk_Style,Ttk_State,void*);
+
+/*
+ * String tables for widget resource specifications:
+ */
+
+MODULE_SCOPE const char *ttkOrientStrings[];
+MODULE_SCOPE const char *ttkCompoundStrings[];
+MODULE_SCOPE const char *ttkDefaultStrings[];
+
+/*
+ * ... other option types...
+ */
+MODULE_SCOPE int TtkGetLabelAnchorFromObj(
+	Tcl_Interp*, Tcl_Obj*, Ttk_PositionSpec *);
+
+/*
+ * Platform-specific initialization.
+ */
+
+#ifdef _WIN32
+#define Ttk_PlatformInit Ttk_WinPlatformInit
+MODULE_SCOPE int Ttk_PlatformInit(Tcl_Interp *);
+#elif defined(MAC_OSX_TK)
+#define Ttk_PlatformInit Ttk_MacOSXPlatformInit
+MODULE_SCOPE int Ttk_PlatformInit(Tcl_Interp *);
+#else
+#define Ttk_PlatformInit(interp) /* TTK_X11PlatformInit() */
+#endif
+
+#endif /* _TTKWIDGET */