summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2006-10-31 01:42:25 (GMT)
committerhobbs <hobbs>2006-10-31 01:42:25 (GMT)
commit397a2c9832bf618f26be267501cf49ab06a562ec (patch)
tree61d5e957eccfcba57b0dd27ebc73db085385834e
parent18d330543869e240c2bd12fc9fbb8d5027f5cad6 (diff)
downloadtk-397a2c9832bf618f26be267501cf49ab06a562ec.zip
tk-397a2c9832bf618f26be267501cf49ab06a562ec.tar.gz
tk-397a2c9832bf618f26be267501cf49ab06a562ec.tar.bz2
* doc/ttk_Geometry.3, doc/ttk_Theme.3, doc/ttk_button.n:
* doc/ttk_checkbutton.n, doc/ttk_combobox.n, doc/ttk_dialog.n: * doc/ttk_entry.n, doc/ttk_frame.n, doc/ttk_image.n: * doc/ttk_intro.n, doc/ttk_label.n, doc/ttk_labelframe.n: * doc/ttk_menubutton.n, doc/ttk_notebook.n, doc/ttk_panedwindow.n: * doc/ttk_progressbar.n, doc/ttk_radiobutton.n, doc/ttk_scrollbar.n: * doc/ttk_separator.n, doc/ttk_sizegrip.n, doc/ttk_style.n: * doc/ttk_treeview.n, doc/ttk_widget.n,: * generic/ttk/ttk.decls, generic/ttk/ttkBlink.c: * generic/ttk/ttkButton.c, generic/ttk/ttkCache.c: * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c: * generic/ttk/ttkDecls.h, generic/ttk/ttkDefaultTheme.c: * generic/ttk/ttkElements.c, generic/ttk/ttkEntry.c: * generic/ttk/ttkFrame.c, generic/ttk/ttkImage.c: * generic/ttk/ttkInit.c, generic/ttk/ttkLabel.c: * generic/ttk/ttkLayout.c, generic/ttk/ttkManager.c: * generic/ttk/ttkManager.h, generic/ttk/ttkNotebook.c: * generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c: * generic/ttk/ttkScale.c, generic/ttk/ttkScroll.c: * generic/ttk/ttkScrollbar.c, generic/ttk/ttkSeparator.c: * generic/ttk/ttkSquare.c, generic/ttk/ttkState.c: * generic/ttk/ttkStubInit.c, generic/ttk/ttkStubLib.c: * generic/ttk/ttkTagSet.c, generic/ttk/ttkTheme.c: * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h: * generic/ttk/ttkTrace.c, generic/ttk/ttkTrack.c: * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.c: * generic/ttk/ttkWidget.h: * library/demos/ttk_demo.tcl, library/demos/ttk_iconlib.tcl: * library/demos/ttk_repeater.tcl: * library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl: * library/ttk/button.tcl, library/ttk/clamTheme.tcl: * library/ttk/classicTheme.tcl, library/ttk/combobox.tcl: * library/ttk/cursors.tcl, library/ttk/defaults.tcl: * library/ttk/dialog.tcl, library/ttk/entry.tcl: * library/ttk/fonts.tcl, library/ttk/icons.tcl: * library/ttk/keynav.tcl, library/ttk/menubutton.tcl: * library/ttk/notebook.tcl, library/ttk/panedwindow.tcl: * library/ttk/progress.tcl, library/ttk/scale.tcl: * library/ttk/scrollbar.tcl, library/ttk/sizegrip.tcl: * library/ttk/treeview.tcl, library/ttk/ttk.tcl: * library/ttk/utils.tcl, library/ttk/winTheme.tcl: * library/ttk/xpTheme.tcl: * macosx/ttkMacOSXTheme.c: * tests/ttk/all.tcl, tests/ttk/bwidget.test, tests/ttk/combobox.test: * tests/ttk/entry.test, tests/ttk/image.test: * tests/ttk/labelframe.test, tests/ttk/layout.test: * tests/ttk/misc.test, tests/ttk/notebook.test: * tests/ttk/panedwindow.test, tests/ttk/progressbar.test: * tests/ttk/scrollbar.test, tests/ttk/treetags.test: * tests/ttk/treeview.test, tests/ttk/ttk.test, tests/ttk/validate.test: * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: First import of Ttk themed Tk widgets as branched from tile 0.7.8 * generic/tkInt.h, generic/tkWindow.c: add Ttk_Init call, copy tk classic widgets to ::tk namespace. * library/tk.tcl: add source of ttk/ttk.tcl, define $::ttk::library. * unix/Makefile.in, win/Makefile.in: add Ttk build bits * win/configure, win/configure.in: check for uxtheme.h (XP theme).
-rw-r--r--ChangeLog61
-rw-r--r--doc/ttk_Geometry.3226
-rw-r--r--doc/ttk_Theme.334
-rw-r--r--doc/ttk_button.n75
-rw-r--r--doc/ttk_checkbutton.n61
-rw-r--r--doc/ttk_combobox.n96
-rw-r--r--doc/ttk_dialog.n120
-rw-r--r--doc/ttk_entry.n438
-rw-r--r--doc/ttk_frame.n43
-rw-r--r--doc/ttk_image.n73
-rw-r--r--doc/ttk_intro.n160
-rw-r--r--doc/ttk_label.n75
-rw-r--r--doc/ttk_labelframe.n64
-rw-r--r--doc/ttk_menubutton.n41
-rw-r--r--doc/ttk_notebook.n179
-rw-r--r--doc/ttk_panedwindow.n78
-rw-r--r--doc/ttk_progressbar.n79
-rw-r--r--doc/ttk_radiobutton.n57
-rw-r--r--doc/ttk_scrollbar.n160
-rw-r--r--doc/ttk_separator.n30
-rw-r--r--doc/ttk_sizegrip.n53
-rw-r--r--doc/ttk_style.n121
-rw-r--r--doc/ttk_treeview.n401
-rw-r--r--doc/ttk_widget.n224
-rw-r--r--generic/tkInt.h8
-rw-r--r--generic/tkWindow.c35
-rw-r--r--generic/ttk/ttk.decls154
-rw-r--r--generic/ttk/ttkBlink.c168
-rw-r--r--generic/ttk/ttkButton.c897
-rw-r--r--generic/ttk/ttkCache.c352
-rw-r--r--generic/ttk/ttkClamTheme.c969
-rw-r--r--generic/ttk/ttkClassicTheme.c530
-rw-r--r--generic/ttk/ttkDecls.h336
-rw-r--r--generic/ttk/ttkDefaultTheme.c1162
-rw-r--r--generic/ttk/ttkElements.c1447
-rw-r--r--generic/ttk/ttkEntry.c1909
-rw-r--r--generic/ttk/ttkFrame.c620
-rw-r--r--generic/ttk/ttkImage.c291
-rw-r--r--generic/ttk/ttkInit.c289
-rw-r--r--generic/ttk/ttkLabel.c740
-rw-r--r--generic/ttk/ttkLayout.c1200
-rw-r--r--generic/ttk/ttkManager.c605
-rw-r--r--generic/ttk/ttkManager.h122
-rw-r--r--generic/ttk/ttkNotebook.c1264
-rw-r--r--generic/ttk/ttkPanedwindow.c809
-rw-r--r--generic/ttk/ttkProgress.c551
-rw-r--r--generic/ttk/ttkScale.c503
-rw-r--r--generic/ttk/ttkScroll.c248
-rw-r--r--generic/ttk/ttkScrollbar.c316
-rw-r--r--generic/ttk/ttkSeparator.c111
-rw-r--r--generic/ttk/ttkSquare.c303
-rw-r--r--generic/ttk/ttkState.c268
-rw-r--r--generic/ttk/ttkStubInit.c61
-rw-r--r--generic/ttk/ttkStubLib.c69
-rw-r--r--generic/ttk/ttkTagSet.c147
-rw-r--r--generic/ttk/ttkTheme.c1719
-rw-r--r--generic/ttk/ttkTheme.h409
-rw-r--r--generic/ttk/ttkThemeInt.h43
-rw-r--r--generic/ttk/ttkTrace.c145
-rw-r--r--generic/ttk/ttkTrack.c175
-rw-r--r--generic/ttk/ttkTreeview.c2973
-rw-r--r--generic/ttk/ttkWidget.c786
-rw-r--r--generic/ttk/ttkWidget.h269
-rw-r--r--library/demos/ttk_demo.tcl883
-rw-r--r--library/demos/ttk_iconlib.tcl110
-rw-r--r--library/demos/ttk_repeater.tcl117
-rw-r--r--library/tk.tcl26
-rw-r--r--library/ttk/altTheme.tcl85
-rw-r--r--library/ttk/aquaTheme.tcl60
-rw-r--r--library/ttk/button.tcl85
-rw-r--r--library/ttk/clamTheme.tcl119
-rw-r--r--library/ttk/classicTheme.tcl94
-rw-r--r--library/ttk/combobox.tcl360
-rw-r--r--library/ttk/cursors.tcl35
-rw-r--r--library/ttk/defaults.tcl95
-rw-r--r--library/ttk/dialog.tcl272
-rw-r--r--library/ttk/entry.tcl580
-rw-r--r--library/ttk/fonts.tcl132
-rw-r--r--library/ttk/icons.tcl105
-rw-r--r--library/ttk/keynav.tcl163
-rw-r--r--library/ttk/menubutton.tcl171
-rw-r--r--library/ttk/notebook.tcl205
-rw-r--r--library/ttk/panedwindow.tcl87
-rw-r--r--library/ttk/progress.tcl51
-rw-r--r--library/ttk/scale.tcl54
-rw-r--r--library/ttk/scrollbar.tcl107
-rw-r--r--library/ttk/sizegrip.tcl77
-rw-r--r--library/ttk/treeview.tcl423
-rw-r--r--library/ttk/ttk.tcl200
-rw-r--r--library/ttk/utils.tcl234
-rw-r--r--library/ttk/winTheme.tcl61
-rw-r--r--library/ttk/xpTheme.tcl51
-rw-r--r--macosx/ttkMacOSXTheme.c996
-rw-r--r--tests/ttk/all.tcl15
-rw-r--r--tests/ttk/bwidget.test101
-rw-r--r--tests/ttk/combobox.test48
-rw-r--r--tests/ttk/entry.test262
-rw-r--r--tests/ttk/image.test44
-rw-r--r--tests/ttk/labelframe.test134
-rw-r--r--tests/ttk/layout.test29
-rw-r--r--tests/ttk/misc.test33
-rw-r--r--tests/ttk/notebook.test387
-rw-r--r--tests/ttk/panedwindow.test201
-rw-r--r--tests/ttk/progressbar.test89
-rw-r--r--tests/ttk/scrollbar.test42
-rw-r--r--tests/ttk/treetags.test77
-rw-r--r--tests/ttk/treeview.test494
-rw-r--r--tests/ttk/ttk.test594
-rw-r--r--tests/ttk/validate.test277
-rw-r--r--unix/Makefile.in226
-rw-r--r--win/Makefile.in85
-rwxr-xr-xwin/configure64
-rw-r--r--win/configure.in10
-rw-r--r--win/ttkWinMonitor.c164
-rw-r--r--win/ttkWinTheme.c730
-rw-r--r--win/ttkWinXPTheme.c998
116 files changed, 37030 insertions, 64 deletions
diff --git a/ChangeLog b/ChangeLog
index 0a96b53..7965b9a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,64 @@
+2006-10-30 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * doc/ttk_Geometry.3, doc/ttk_Theme.3, doc/ttk_button.n:
+ * doc/ttk_checkbutton.n, doc/ttk_combobox.n, doc/ttk_dialog.n:
+ * doc/ttk_entry.n, doc/ttk_frame.n, doc/ttk_image.n:
+ * doc/ttk_intro.n, doc/ttk_label.n, doc/ttk_labelframe.n:
+ * doc/ttk_menubutton.n, doc/ttk_notebook.n, doc/ttk_panedwindow.n:
+ * doc/ttk_progressbar.n, doc/ttk_radiobutton.n, doc/ttk_scrollbar.n:
+ * doc/ttk_separator.n, doc/ttk_sizegrip.n, doc/ttk_style.n:
+ * doc/ttk_treeview.n, doc/ttk_widget.n,:
+ * generic/ttk/ttk.decls, generic/ttk/ttkBlink.c:
+ * generic/ttk/ttkButton.c, generic/ttk/ttkCache.c:
+ * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c:
+ * generic/ttk/ttkDecls.h, generic/ttk/ttkDefaultTheme.c:
+ * generic/ttk/ttkElements.c, generic/ttk/ttkEntry.c:
+ * generic/ttk/ttkFrame.c, generic/ttk/ttkImage.c:
+ * generic/ttk/ttkInit.c, generic/ttk/ttkLabel.c:
+ * generic/ttk/ttkLayout.c, generic/ttk/ttkManager.c:
+ * generic/ttk/ttkManager.h, generic/ttk/ttkNotebook.c:
+ * generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c:
+ * generic/ttk/ttkScale.c, generic/ttk/ttkScroll.c:
+ * generic/ttk/ttkScrollbar.c, generic/ttk/ttkSeparator.c:
+ * generic/ttk/ttkSquare.c, generic/ttk/ttkState.c:
+ * generic/ttk/ttkStubInit.c, generic/ttk/ttkStubLib.c:
+ * generic/ttk/ttkTagSet.c, generic/ttk/ttkTheme.c:
+ * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h:
+ * generic/ttk/ttkTrace.c, generic/ttk/ttkTrack.c:
+ * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.c:
+ * generic/ttk/ttkWidget.h:
+ * library/demos/ttk_demo.tcl, library/demos/ttk_iconlib.tcl:
+ * library/demos/ttk_repeater.tcl:
+ * library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl:
+ * library/ttk/button.tcl, library/ttk/clamTheme.tcl:
+ * library/ttk/classicTheme.tcl, library/ttk/combobox.tcl:
+ * library/ttk/cursors.tcl, library/ttk/defaults.tcl:
+ * library/ttk/dialog.tcl, library/ttk/entry.tcl:
+ * library/ttk/fonts.tcl, library/ttk/icons.tcl:
+ * library/ttk/keynav.tcl, library/ttk/menubutton.tcl:
+ * library/ttk/notebook.tcl, library/ttk/panedwindow.tcl:
+ * library/ttk/progress.tcl, library/ttk/scale.tcl:
+ * library/ttk/scrollbar.tcl, library/ttk/sizegrip.tcl:
+ * library/ttk/treeview.tcl, library/ttk/ttk.tcl:
+ * library/ttk/utils.tcl, library/ttk/winTheme.tcl:
+ * library/ttk/xpTheme.tcl:
+ * macosx/ttkMacOSXTheme.c:
+ * tests/ttk/all.tcl, tests/ttk/bwidget.test, tests/ttk/combobox.test:
+ * tests/ttk/entry.test, tests/ttk/image.test:
+ * tests/ttk/labelframe.test, tests/ttk/layout.test:
+ * tests/ttk/misc.test, tests/ttk/notebook.test:
+ * tests/ttk/panedwindow.test, tests/ttk/progressbar.test:
+ * tests/ttk/scrollbar.test, tests/ttk/treetags.test:
+ * tests/ttk/treeview.test, tests/ttk/ttk.test, tests/ttk/validate.test:
+ * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c:
+ First import of Ttk themed Tk widgets as branched from tile 0.7.8
+
+ * generic/tkInt.h, generic/tkWindow.c: add Ttk_Init call, copy
+ tk classic widgets to ::tk namespace.
+ * library/tk.tcl: add source of ttk/ttk.tcl, define $::ttk::library.
+ * unix/Makefile.in, win/Makefile.in: add Ttk build bits
+ * win/configure, win/configure.in: check for uxtheme.h (XP theme).
+
2006-10-23 Don Porter <dgp@users.sourceforge.net>
* README: Bump version number to 8.5a6
diff --git a/doc/ttk_Geometry.3 b/doc/ttk_Geometry.3
new file mode 100644
index 0000000..f902122
--- /dev/null
+++ b/doc/ttk_Geometry.3
@@ -0,0 +1,226 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+'\" RCS: @(#) $Id: ttk_Geometry.3,v 1.1 2006/10/31 01:42:25 hobbs Exp $
+'\"
+.so man.macros
+.TH Geometry 3 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+Ttk_MakeBox, Ttk_PadBox, Ttk_ExpandBox, Ttk_PackBox, Ttk_StickBox, Ttk_PlaceBox, Ttk_BoxContains, Ttk_MakePadding, Ttk_UniformPadding, Ttk_AddPadding, Ttk_RelievePadding, Ttk_GetPaddingFromObj, Ttk_GetBorderFromObj, Ttk_GetStickyFromObj \- Tk themed geometry utilities
+.SH SYNOPSIS
+.nf
+\fB#include <tkTheme.h>\fR
+
+Ttk_Box
+\fBTtk_MakeBox\fR(int \fIx\fR, int \fIy\fR, int \fIwidth\fR, int \fIheight\fR);
+
+Ttk_Box
+\fBTtk_PadBox\fR(Ttk_Box \fIparcel\fR, Ttk_Padding \fIpadding\fR);
+
+Ttk_Box
+\fBTtk_ExpandBox\fR(Ttk_Box \fIparcel\fR, Ttk_Padding \fIpadding\fR);
+
+Ttk_Box
+\fBTtk_PackBox\fR(Ttk_Box *\fIcavity\fR, int \fIwidth\fR, int \fIheight\fR, Ttk_Side \fIside\fR);
+
+Ttk_Box
+\fBTtk_StickBox\fR(Ttk_Box \fIparcel\fR, int \fIwidth\fR, int \fIheight\fR, unsigned \fIsticky\fR);
+
+Ttk_Box
+\fBTtk_PlaceBox\fR(Ttk_Box *\fIcavity\fR, int \fIwidth\fR, int \fIheight\fR, Ttk_Side \fIside\fR, unsigned \fIsticky\fR);
+
+Ttk_Box
+\fBTtk_AnchorBox\fR(Ttk_Box \fIparcel\fR, int \fIwidth\fR, int \fIheight\fR, Tk_Anchor \fIanchor\fR);
+
+Ttk_Padding
+\fBTtk_MakePadding\fR(short \fIleft\fR, short \fItop\fR, short \fIright\fR, short \fIbottom\fR);
+
+Ttk_Padding
+\fBTtk_UniformPadding\fR(short \fIborder\fR);
+
+Ttk_Padding
+\fBTtk_AddPadding\fR(Ttk_Padding \fIpadding1\fR, Ttk_Padding \fIpadding2\fR;
+
+Ttk_Padding
+\fBTtk_RelievePadding\fR(Ttk_Padding \fIpadding\fR, int \fIrelief\fR);
+
+int
+\fBTtk_BoxContains\fR(Ttk_Box \fIbox\fR, int \fIx\fR, int \fIy\fR);
+
+int
+\fBTtk_GetPaddingFromObj\fR(Tcl_Interp *\fIinterp\fR, Tk_Window \fItkwin\fR, Tcl_Obj *\fIobjPtr\fR, Ttk_Padding *\fIpadding_rtn\fR);
+
+int
+\fBTtk_GetBorderFromObj\fR(Tcl_Interp *\fIinterp\fR, Tcl_Obj *\fIobjPtr\fR, Ttk_Padding *\fIpadding_rtn\fR);
+
+int
+\fBTtk_GetStickyFromObj\fR(Tcl_Interp *\fIinterp\fR, Tcl_Obj *\fIobjPtr\fR, int *\fIsticky_rtn\fR);
+.fi
+
+.SH ARGUMENTS
+.AP Tk_Anchor anchor in
+One of the symbolic constants \fBTK_ANCHOR_N\fR, \fBTK_ANCHOR_NE\fR,
+etc. See \fITk_GetAnchorFromObj(3)\fR.
+.AP "Ttk_Box *" cavity in/out
+A rectangular region from which a parcel is allocated.
+.AP short border in
+Extra padding (in pixels) to add uniformly to each side of a region.
+.AP short bottom in
+Extra padding (in pixels) to add to the bottom of a region.
+.AP Ttk_Box box in
+.AP "Ttk_Box *" box_rtn out
+Specifies a rectangular region.
+.AP int height in
+The height in pixels of a region.
+.AP "Tcl_Interp *" interp in
+Used to store error messages.
+.AP int left in
+Extra padding (in pixels) to add to the left side of a region.
+.AP "Tcl_Obj *" objPtr in
+String value contains a symbolic name
+to be converted to an enumerated value or bitmask.
+Internal rep may be be modified to cache corresponding value.
+.AP Ttk_Padding padding in
+.AP "Ttk_Padding *" padding_rtn out
+Extra padding to add on the inside of a region.
+.AP Ttk_Box parcel in
+A rectangular region, allocated from a cavity.
+.AP int relief in
+One of the standard Tk relief options
+(TK_RELIEF_RAISED, TK_RELIEF_SUNKEN, etc.).
+See \fBTk_GetReliefFromObj\fR.
+.AP short right in
+Extra padding (in pixles) to add to the right side of a region.
+.AP Ttk_Side side in
+One of \fBTTK_SIDE_LEFT\fR, \fBTTK_SIDE_TOP\fR,
+\fBTTK_SIDE_RIGHT\fR, or \fBTTK_SIDE_BOTTOM\fR.
+.AP unsigned sticky in
+A bitmask containing one or more of the bits
+\fBTTK_STICK_W\fR (west, or left),
+\fBTTK_STICK_E\fR (east, or right,
+\fBTTK_STICK_N\fR (north, or top), and
+\fBTTK_STICK_S\fR (south, or bottom).
+\fBTTK_FILL_X\fR is defined as a synonym for (TTK_STICK_W|TTK_STICK_E),
+\fBTTK_FILL_Y\fR is a synonym for (TTK_STICK_N|TTK_STICK_S),
+and \fBTTK_FILL_BOTH\fR and \fBTTK_STICK_ALL\fR
+are synonyms for (TTK_FILL_X|TTK_FILL_Y).
+See also: \fIgrid(n)\fR.
+.AP Tk_Window tkwin in
+Window whose screen geometry determines
+the conversion between absolute units and pixels.
+.AP short top in
+Extra padding at the top of a region.
+.AP int width in
+The width in pixels of a region.
+.AP int x in
+X coordinate of upper-left corner of region.
+.AP int y in
+Y coordinate of upper-left corner of region.
+.BE
+
+.SH "BOXES"
+The \fBTtk_Box\fR structure represents a rectangular region of a window:
+.CS
+typedef struct {
+ int x;
+ int y;
+ int width;
+ int height;
+} Ttk_Box;
+.CE
+All coordinates are relative to the window.
+.PP
+\fBTtk_MakeBox\fR is a convenience routine that contsructs
+a \fBTtk_Box\fR structure representing a region \fIwidth\fR pixels
+wide, \fIheight\fR pixels tall, at the specified \fIx, y\fR coordinates.
+.PP
+\fBTtk_PadBox\fR returns a new box located inside the specified \fIparcel\fR,
+shrunken according to the left, top, right, and bottom margins
+specified by \fIpadding\fR.
+.PP
+\fBTtk_ExpandBox\fR is the inverse of \fBTtk_PadBox\fP:
+it returns a new box surrounding the specified \fIparcel\fR,
+expanded according to the left, top, right, and bottom margins
+specified by \fIpadding\fR.
+.PP
+\fBTtk_PackBox\fR allocates a parcel \fIwidth\fR by \fIheight\fR
+pixels wide on the specified \fIside\fR of the \fIcavity\fR,
+and shrinks the \fIcavity\fR accordingly.
+.PP
+\fBTtk_StickBox\fR places a box with the requested \fIwidth\fR
+and \fIheight\fR inside the \fIparcel\fR according to the
+\fIsticky\fR bits.
+.PP
+\fBTtk_PlaceBox\fP combines \fBTtk_PackBox\fP and \fBTtk_StickBox\fP:
+it allocates a parcel on the specified \fIside\fP of the \fIcavity\fP,
+places a box of the requested size inside the parcel according to \fIsticky\fP,
+and shrinks the \fIcavity\fP.
+.PP
+\fBTtk_AnchorBox\fR places a box with the requested \fIwidth\fR
+and \fIheight\fR inside the \fIparcel\fR according to the
+specified \fIanchor\fR option.
+.PP
+\fBTtk_BoxContains\fR tests if the specified \fIx, y\fR coordinate
+lies within the rectangular region \fIbox\fR.
+.SH "PADDDING"
+The \fBTtk_Padding\fR structure is used to represent
+borders, internal padding, and external margins:
+.CS
+typedef struct {
+ short left;
+ short top;
+ short right;
+ short bottom;
+} Ttk_Padding;
+.CE
+.PP
+\fBTtk_MakePadding\fR is a convenience routine that contsructs
+a \fBTtk_Padding\fR structure with the specified left, top, right, and bottom
+components.
+.PP
+\fBTtk_UniformPadding\fR constructs a \fBTtk_Padding\fR structure
+with all components equal to the specified \fIborder\fR.
+.PP
+\fBTtk_AddPadding\fR adds two \fBTtk_Padding\fRs together
+and returns a combined padding containing the sum of the
+individual padding components.
+.PP
+\fBTtk_RelievePadding\fR
+adds an extra 2 pixels of padding to \fIpadding\fR
+according to the specified \fIrelief\fR.
+If \fIrelief\fR is \fBTK_RELIEF_SUNKEN\fR,
+adds two pixels at the top and left
+so the inner region is shifted down and to the left.
+If it is \fBTK_RELIEF_RAISED\fR, adds two pixels
+at the bottom and right so
+the inner region is shifted up and to the right.
+Otherwise, adds 1 pixel on all sides.
+This is typically used in element geometry procedures to simulate
+a "pressed-in" look for pushbuttons.
+
+.SH "CONVERSION ROUTINES"
+\fBTtk_GetPaddingFromObj\fR converts the string in \fIobjPtr\fR
+to a \fBTtk_Padding\fR structure.
+The string representation is a list of
+up to four length specifications
+\fI"left top right bottom"\fR.
+If fewer than four elements are specified,
+\fIbottom\fR defaults to \fItop\fR,
+\fIright\fR defaults to \fIleft\fR, and
+\fItop\fR defaults to \fIleft\fR.
+See \fBTk_GetPixelsFromObj(3)\fR for the syntax of length specifications.
+.PP
+\fBTtk_GetBorderFromObj\fR is the same as \fBTtk_GetPaddingFromObj\fP
+except that the lengths are specified as integers
+(i.e., resolution-dependant values like \fI3m\fP are not allowed).
+.PP
+\fBTtk_GetStickyFromObj\fR converts the string in \fIobjPtr\fR
+to a \fIsticky\fR bitmask. The string contains zero or more
+of the characters \fBn\fR, \fBs\fR, \fBe\fR, or \fBw\fR.
+
+.SH "SEE ALSO"
+Tk_GetReliefFromObj(3), Tk_GetPixelsFromObj(3), Tk_GetAnchorFromObj(3)
+
+.SH "KEYWORDS"
+geometry, padding, margins, box, region, sticky, relief
diff --git a/doc/ttk_Theme.3 b/doc/ttk_Theme.3
new file mode 100644
index 0000000..fb16978
--- /dev/null
+++ b/doc/ttk_Theme.3
@@ -0,0 +1,34 @@
+'\"
+'\" Copyright (c) 2003 Joe English
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id: ttk_Theme.3,v 1.1 2006/10/31 01:42:25 hobbs Exp $
+'\"
+.so man.macros
+.TH Ttk_CreateTheme 3 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+Ttk_CreateTheme, Ttk_GetTheme, Ttk_GetDefaultTheme, Ttk_GetCurrentTheme \- create and use Tk themes.
+.SH SYNOPSIS
+.nf
+Ttk_Theme Ttk_CreateTheme(\fIinterp\fR, \fIname\fR, \fIparentTheme\fR);
+Ttk_Theme Ttk_GetTheme(\fIinterp\fR, \fIname\fR);
+Ttk_Theme Ttk_GetDefaultTheme(\fIinterp\fR);
+Ttk_Theme Ttk_GetCurrentTheme(\fIinterp\fR);
+.fi
+.SH ARGUMENTS
+.AP "Tcl_Interp *" interp in
+The Tcl interpreter in which to register/query available themes.
+.AP "Ttk_Theme" parentTheme in
+Fallback or parent theme from which the new theme will
+inherit elements and layouts.
+.AP "const char *" name in
+The name of the theme.
+.BE
+.SH DESCRIPTION
+
+.SH "SEE ALSO"
+Ttk_RegisterLayout, Ttk_BuildLayout
+.\" .SH KEYWORDS
diff --git a/doc/ttk_button.n b/doc/ttk_button.n
new file mode 100644
index 0000000..b085d8b
--- /dev/null
+++ b/doc/ttk_button.n
@@ -0,0 +1,75 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_button n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::button \- Widget that issues a command when pressed
+.SH SYNOPSIS
+\fBttk::button\fR \fIpathName \fR?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+A \fBbutton\fP widget displays a textual label and/or image,
+and evaluates a command when pressed.
+.SO
+\-class \-compound \-cursor \-image
+\-state \-style \-takefocus \-text
+\-textvariable \-underline \-width
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-command command Command
+A script to evaluate when the widget is invoked.
+.OP \-default default Default
+May be set to one of \fBnormal\fP, \fBactive\fP, or \fBdisabled\fP.
+In a dialog box, one button may be designated the "default" button
+(meaning, roughly, "the one that gets invoked when the user presses <Enter>").
+\fBactive\fP indicates that this is currently the default button;
+\fBnormal\fP means that it may become the default button, and
+\fBdisabled\fP means that it is not defaultable.
+The default is \fBnormal\fP.
+.br
+Depending on the theme, the default button may be displayed
+with an extra highlight ring, or with a different border color.
+See also: \fIkeynav(n)\fP.
+.OP \-width width Width
+If greater than zero, specifies how much space, in character widths,
+to allocate for the text label.
+If less than zero, specifies a minimum width.
+If zero or unspecified, the natural width of the text label is used.
+Note that some themes may specify a non-zero \fB-width\fP
+in the style.
+'\" Not documented -- may go away
+'\" .OP \-padding padding Padding
+'\" .OP \-foreground foreground Foreground
+'\" .OP \-font font Font
+'\" .OP \-anchor anchor Anchor
+'\" .OP \-padding padding Padding
+'\" .OP \-relief relief Relief
+
+.SH "WIDGET COMMAND"
+.TP
+\fIpathName \fBinvoke\fR
+Invokes the command associated with the button.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+.TP
+\fIpathName \fBinstate \fIstatespec\fR ?\fIscript\fR?
+.TP
+\fIpathName \fBstate\fR ?\fIstateSpec\fR?
+See \fIwidget(n)\fP
+
+.SH "COMPATIBILITY OPTIONS"
+.OP \-state state State
+May be set to \fBnormal\fP or \fBdisabled\fP
+to control the \fBdisabled\fP state bit.
+This is a ``write-only'' option: setting it changes the
+widget state, but the \fBstate\fP widget command does
+not affect the state option.
+
+.SH "SEE ALSO"
+widget(n), keynav(n)
+.SH "KEYWORDS"
+widget, button, default, command
diff --git a/doc/ttk_checkbutton.n b/doc/ttk_checkbutton.n
new file mode 100644
index 0000000..cd5ee64
--- /dev/null
+++ b/doc/ttk_checkbutton.n
@@ -0,0 +1,61 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_checkbutton n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::checkbutton \- On/off widget
+.SH SYNOPSIS
+\fBttk::checkbutton\fR \fIpathName \fR?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+A \fBcheckbutton\fR widget is used to show or change a setting.
+It has two states, selected and deselected.
+The state of the checkbuton may be linked to a Tcl variable.
+.SO
+\-class \-compound \-cursor \-image
+\-state \-style \-takefocus \-text
+\-textvariable \-underline \-width
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-command command Command
+A Tcl script to execute whenever the widget is invoked.
+.OP \-offvalue offValue OffValue
+The value to store in the associated \fI-variable\fR
+when the widget is deselected. Defaults to \fB0\fR.
+.OP \-onvalue onValue OnValue
+The value to store in the associated \fI-variable\fR
+when the widget is selected. Defaults to \fB1\fR.
+.OP \-variable variable Variable
+The name of a global variable whose value is linked to the widget.
+Defaults to the widget pathname if not specified.
+.SH "WIDGET COMMAND"
+In addition to the standard
+\fBcget\fR, \fBconfigure\fR, \fBinstate\fR, and \fBstate\fR
+commands, checkbuttons support the following additional
+widget commands:
+.TP
+\fIpathname\fR invoke
+Toggles between the selected and deselected states
+and evaluates the associated \fI-command\fR.
+If the widget is currently selected, sets the \fI-variable\fR
+to the \fI-offvalue\fR and deselects the widget;
+otherwise, sets the \fI-variable\fR to the \fI-onvalue\fR
+Returns the result of the \fI-command\fR.
+.\" Missing: select, deselect, toggle
+.\" Are these useful? They don't invoke the -command
+.\" Missing: flash. This is definitely not useful.
+.SH "WIDGET STATES"
+The widget does not respond to user input if the \fBdisabled\fP state is set.
+The widget sets the \fBselected\fP state whenever
+the linked \fB-variable\fP is set to the widget's \fB-onvalue\fP,
+and clears it otherwise.
+The widget sets the \fBalternate\fP state whenever the
+linked \fB-variable\fP is unset.
+(The \fBalternate\fP state may be used to indicate a ``tri-state''
+or ``indeterminate'' selection.)
+.SH "SEE ALSO"
+widget(n), keynav(n), radiobutton(n)
+.SH "KEYWORDS"
+widget, button, toggle, check, option
diff --git a/doc/ttk_combobox.n b/doc/ttk_combobox.n
new file mode 100644
index 0000000..1e0664a
--- /dev/null
+++ b/doc/ttk_combobox.n
@@ -0,0 +1,96 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_combobox n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::combobox \- text field with popdown selection list
+.SH SYNOPSIS
+\fBttk::combobox\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-class \-cursor \-takefocus \-style
+.SE
+.\" ALSO: Other entry widget options
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-exportselection exportSelection ExportSelection
+Boolean value.
+If set, the widget selection is linked to the X selection.
+.OP \-justify justify Justify
+Specifies how the text is aligned within the widget.
+One of \fBleft\fP, \fBcenter\fP, or \fBright\fP.
+.OP \-postcommand postCommand PostCommand
+A Tcl script to evaluate immediately before displaying the listbox.
+The \fB-postcommand\fP script may specify the \fB-values\fP to display.
+.OP \-state state State
+One of \fBnormal\fR, \fBreadonly\fR, or \fBdisabled\fP.
+In the \fBreadonly\fP state,
+the value may not be edited directly, and
+the user can only select one of the \fB-values\fP from the
+dropdown list.
+In the \fBnormal\fP state,
+the text field is directly editable.
+In the \fBdisabled\fP state, no interaction is possible.
+.OP \-textvariable textVariable TextVariable
+Specifies the name of a variable whose value is linked
+to the widget value.
+Whenever the variable changes value the widget value is updated,
+and vice versa.
+.OP \-values values Values
+Specifies the list of values to display in the drop-down listbox.
+.OP \-width width Width
+Specifies an integer value indicating the desired width of the entry window,
+in average-size characters of the widget's font.
+.BE
+.SH DESCRIPTION
+A combobox combines a text field with a pop-down list of values;
+the user may select the value of the text field from among the
+values in the list.
+.SH "WIDGET COMMAND"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the specified \fIoption\fP.
+See \fIwidget(n)\fP.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Modify or query widget options.
+See \fIwidget(n)\fP.
+.TP
+\fIpathName \fBcurrent\fR ?\fInewIndex\fR?
+If \fInewIndex\fP is supplied, sets the combobox value
+to the element at position \fInewIndex\fR in the list of \fB-values\fR.
+Otherwise, returns the index of the current value in the list of \fB-values\fR
+or \fB-1\fR if the current value does not appear in the list.
+.TP
+\fIpathName \fBget\fR
+Returns the current value of the combobox.
+.TP
+\fIpathName \fBidentify \fIx y\fR
+Returns the name of the element at position \fIx\fP, \fIy\fP,
+or the empty string if the coordinates are outside the window.
+.TP
+\fIpathName \fBinstate \fIstatespec\fR ?\fIscript\fR?
+Test the widget state.
+See \fIwidget(n)\fP.
+.TP
+\fIpathName \fBset\fR \fIvalue\fR
+Sets the value of the combobox to \fIvalue\fP.
+.TP
+\fIpathName \fBstate\fR ?\fIstateSpec\fR?
+Modify or query the widget state.
+See \fIwidget(n)\fP.
+.PP
+The combobox widget also supports the following \fIentry\fP
+widget commands (see \fIentry(n)\fP for details):
+.DS
+.ta 5.5c 11c
+bbox delete icursor
+index insert selection
+xview
+.DE
+.SH "VIRTUAL EVENTS"
+The combobox widget generates a \fB<<ComboboxSelected>>\fP virtual event
+when the user selects an element from the list of values.
+This event is generated after the listbox is unposted.
+.SH "SEE ALSO"
+widget(n), entry(n)
diff --git a/doc/ttk_dialog.n b/doc/ttk_dialog.n
new file mode 100644
index 0000000..3fdeb24
--- /dev/null
+++ b/doc/ttk_dialog.n
@@ -0,0 +1,120 @@
+'\"
+'\" Copyright (c) 2005 Joe English
+'\"
+.so man.macros
+.TH ttk_dialog n 8.5 Tk "Tk Themed Widget"
+.SH "NAME"
+ttk::dialog \- create a dialog box
+.SH "SYNOPSIS"
+\fBttk::dialog\fR \fIpathname\fR ?\fIoptions...\fR?
+\fBttk::dialog::define\fR \fIdialogType\fR ?\fIoptions...\fR?
+.SH "DESCRIPTION"
+A dialog box is a transient top-level window
+containing an icon, a short message, an optional, longer, detail message,
+and a row of command buttons.
+When the user presses any of the buttons,
+a callback function is invoked
+and then the dialog is destroyed.
+.PP
+Additional widgets may be added in the dialog \fIclient frame\fR.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-title undefined undefined
+Specifies a string to use as the window manager title.
+.OP \-message undefined undefined
+Specifies the message to display in this dialog.
+.OP \-detail undefined undefined
+Specifies a longer auxilliary message.
+.OP \-command undefined undefined
+Specifies a command prefix to be invoked when the user presses
+one of the command buttons.
+The symbolic name of the button is passed as an additional argument
+to the command.
+The dialog is dismissed after invoking the command.
+.OP \-parent undefined undefined
+Specifies a toplevel window for which the dialog is transient.
+If omitted, the default is the nearest ancestor toplevel.
+If set to the empty string, the dialog will not be a transient window.
+.OP \-type undefined undefined
+Specifies a built-in or user-defined dialog type.
+See \fBPREDEFINED DIALOG TYPES\fP, below.
+.OP \-icon undefined undefined
+Specifies one of the stock dialog icons,
+\fBinfo\fP, \fBquestion\fP, \fBwarning\fP, \fBerror\fP,
+\fBauth\fP, or \fBbusy\fP.
+If set to the empty string (the defalt), no icon is displayed.
+.OP \-buttons undefined undefined
+A list of symbolic button names.
+.OP \-labels undefined undefined
+A dictionary mapping symbolic button names to textual labels.
+May be omitted if all the buttons are predefined.
+.OP \-default undefined undefined
+The symbolic name of the default button.
+.OP \-cancel undefined undefined
+The symbolic name of the "cancel" button.
+The cancel button is invoked if the user presses the Escape key
+and when the dialog is closed from the window manager.
+If \fB-cancel\fP is not specified,
+the dialog ignores window manager close commands (WM_DELETE_WINDOW).
+.SH "WIDGET COMMANDS"
+.TP
+\fBttk::dialog::clientframe \fIdlg\fR
+Returns the widget path of the client frame.
+Other widgets may be added to the client frame.
+The client frame appears between the detail message and the command buttons.
+.SH "PREDEFINED DIALOG TYPES"
+The \fB-type\fP option, if present, specifies default values
+for other options. \fBttk::dialog::define \fItype options...\fR
+specifies a new stock dialog \fItype\fP.
+The following stock dialog types are predefined:
+.CS
+ttk::dialog::define ok \e
+ -icon info -buttons {ok} -default ok
+ttk::dialog::define okcancel \e
+ -icon info -buttons {ok cancel} -default ok -cancel cancel
+ttk::dialog::define yesno \e
+ -icon question -buttons {yes no}
+ttk::dialog::define yesnocancel \e
+ -icon question -buttons {yes no cancel} -cancel cancel
+ttk::dialog::define retrycancel \e
+ -icon question -buttons {retry cancel} -cancel cancel
+.CE
+.SH "STOCK BUTTONS"
+The following ``stock'' symbolic button names have predefined labels:
+\fByes\fP, \fBno\fP, \fBok\fP, \fBcancel\fP, and \fBretry\fP.
+.PP
+It is not necessary to list these in the \fB-labels\fP dictionary.
+.\" .SH "DIFFERENCES FROM MESSAGE BOXES"
+.\" The \fBttk::dialog\fR constructor is similar to
+.\" the Tk library procedure \fBtk_messageBox\fP,
+.\" but with the following notable differences:
+.\" .IP \(bu
+.\" The first argument to \fBttk::dialog\fP is the name of
+.\" the widget to create; \fBtk_messageBox\fP has
+.\" .IP \(bu
+.\" Ttk dialog boxes are non-modal by default.
+.\" .IP \(bu
+.\" The \fBtk_messageBox\fP command is blocking:
+.\" it does not return until the user presses one of the command buttons.
+.\" \fBttk::dialog\fP returns immediately after creating the dialog box.
+.SH EXAMPLE
+.CS
+proc saveFileComplete {button} {
+ switch -- $button {
+ yes { # save file ... }
+ no { exit }
+ cancel { # no-op }
+ }
+}
+
+ttk::dialog .saveFileDialog \e
+ -title "Save file?" \e
+ -icon question \e
+ -message "Save file before closing?" \e
+ -detail "If you do not save the file, your work will be lost" \e
+ -buttons [list yes no cancel] \e
+ -labels [list yes "Save file" no "Don't save"] \e
+ -command saveFileComplete \e
+ ;
+.CE
+.SH "SEE ALSO"
+\fBtk_messageBox(n)\fR, \fBwm(n)\fR, \fBtoplevel(n)\fP
diff --git a/doc/ttk_entry.n b/doc/ttk_entry.n
new file mode 100644
index 0000000..7b665eb
--- /dev/null
+++ b/doc/ttk_entry.n
@@ -0,0 +1,438 @@
+'\"
+'\" SOURCE: entry.n, r1.12
+'\"
+'\" Copyright (c) 1990-1994 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 1998-2000 Scriptics Corporation.
+'\" Copyright (c) 2004 Joe English
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.so man.macros
+.TH ttk_entry n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::entry \- Editable text field widget
+.SH SYNOPSIS
+\fBttk::entry\fR \fIpathName \fR?\fIoptions\fR?
+.SH DESCRIPTION
+.PP
+An \fBentry\fP widget displays a one-line text string and
+allows that string to be edited by the user.
+The value of the string may be linked to a Tcl variable
+with the \fB-textvariable\fP option.
+Entry widgets support horizontal scrolling with the
+standard \fB-xscrollcommand\fP option and \fBxview\fP widget command.
+.SO
+\-class \-cursor \-style \-takefocus
+\-xscrollcommand
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-exportselection exportSelection ExportSelection
+A boolean value specifying whether or not
+a selection in the widget should be linked to the X selection.
+If the selection is exported, then selecting in the widget deselects
+the current X selection, selecting outside the widget deselects any
+widget selection, and the widget will respond to selection retrieval
+requests when it has a selection.
+.\" MAYBE: .OP \-font font Font
+.\" MAYBE: .OP \-foreground foreground Foreground
+.\" MAYBE: .OP \-insertbackground insertBackground Foreground
+.\" MAYBE: .OP \-insertwidth insertWidth InsertWidth
+.OP \-invalidcommand invalidCommand InvalidCommand
+A script template to evaluate whenever the \fBvalidateCommand\fR returns 0.
+See \fBVALIDATION\fR below for more information.
+.OP \-justify justify Justify
+Specifies how the text is aligned within the entry widget.
+One of \fBleft\fP, \fBcenter\fP, or \fBright\fP.
+.\" MAYBE: .OP \-selectbackground selectBackground Foreground
+.\" MAYBE: .OP \-selectborderwidth selectBorderWidth BorderWidth
+.\" MAYBE: .OP \-selectforeground selectForeground Background
+.OP \-show show Show
+If this option is specified, then the true contents of the entry
+are not displayed in the window.
+Instead, each character in the entry's value will be displayed as
+the first character in the value of this option, such as ``*''.
+This is useful, for example, if the entry is to be used to enter
+a password.
+If characters in the entry are selected and copied elsewhere, the
+information copied will be what is displayed, not the true contents
+of the entry.
+.OP \-state state State
+Compatibility option; see \fBwidget(n)\fP for details.
+Specifies one of three states for the entry,
+\fBnormal\fR, \fBdisabled\fR, or \fBreadonly\fR.
+See \fBWIDGET STATES\fP, below.
+.OP \-textvariable textVariable Variable
+Specifies the name of a variable whose value is linked
+to the entry widget's contents.
+Whenever the variable changes value, the widget's contents are updated,
+and vice versa.
+.OP \-validate validate Validate
+Specifies the mode in which validation should operate:
+\fBnone\fR, \fBfocus\fR, \fBfocusin\fR, \fBfocusout\fR, \fBkey\fR, or \fBall\fR.
+Default is \fBnone\fR, meaning that validation is disabled.
+See \fBVALIDATION\fR below.
+.OP \-validatecommand validateCommand ValidateCommand
+A script template to evaluate whenever validation is triggered.
+If set to the empty string (the default), validation is disabled.
+The script must return a boolean value.
+See \fBVALIDATION\fR below.
+.OP \-width width Width
+Specifies an integer value indicating the desired width of the entry window,
+in average-size characters of the widget's font.
+.\" Not in ttk: If the value is less than or equal to zero, the widget picks a
+.\" Not in ttk: size just large enough to hold its current text.
+.BE
+.SH NOTES
+A portion of the entry may be selected as described below.
+If an entry is exporting its selection (see the \fBexportSelection\fR
+option), then it will observe the standard X11 protocols for handling the
+selection; entry selections are available as type \fBSTRING\fR.
+Entries also observe the standard Tk rules for dealing with the
+input focus. When an entry has the input focus it displays an
+\fIinsert cursor\fR to indicate where new characters will be
+inserted.
+.PP
+Entries are capable of displaying strings that are too long to
+fit entirely within the widget's window. In this case, only a
+portion of the string will be displayed; commands described below
+may be used to change the view in the window. Entries use
+the standard \fBxScrollCommand\fR mechanism for interacting with
+scrollbars (see the description of the \fBxScrollCommand\fR option
+for details).
+.SH "INDICES"
+Many of the \fBentry\fP widget commands take one or more indices as
+arguments. An index specifies a particular character in the entry's
+string, in any of the following ways:
+.IP \fInumber\fR
+Specifies the character as a numerical index, where 0 corresponds
+to the first character in the string.
+.IP \fB@\fInumber\fR
+In this form, \fInumber\fR is treated as an x-coordinate in the
+entry's window; the character spanning that x-coordinate is used.
+For example, ``\fB@0\fR'' indicates the left-most character in the
+window.
+.IP \fBend\fR
+Indicates the character just after the last one in the entry's string.
+This is equivalent to specifying a numerical index equal to the length
+of the entry's string.
+.IP \fBinsert\fR
+Indicates the character adjacent to and immediately following the
+insert cursor.
+.IP \fBsel.first\fR
+Indicates the first character in the selection. It is an error to
+use this form if the selection isn't in the entry window.
+.IP \fBsel.last\fR
+Indicates the character just after the last one in the selection.
+It is an error to use this form if the selection isn't in the
+entry window.
+.LP
+Abbreviations may be used for any of the forms above, e.g. ``\fBe\fR''
+or ``\fBsel.f\fR''. In general, out-of-range indices are automatically
+rounded to the nearest legal value.
+.SH "WIDGET COMMAND"
+.PP
+The following commands are possible for entry widgets:
+.TP
+\fIpathName \fBbbox \fIindex\fR
+Returns a list of four numbers describing the bounding box of the
+character given by \fIindex\fR.
+The first two elements of the list give the x and y coordinates of
+the upper-left corner of the screen area covered by the character
+(in pixels relative to the widget) and the last two elements give
+the width and height of the character, in pixels.
+The bounding box may refer to a region outside the visible area
+of the window.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the specified \fIoption\fP.
+See \fIwidget(n)\fP.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Modify or query widget options.
+See \fIwidget(n)\fP.
+.TP
+\fIpathName \fBdelete \fIfirst \fR?\fIlast\fR?
+Delete one or more elements of the entry.
+\fIFirst\fR is the index of the first character to delete, and
+\fIlast\fR is the index of the character just after the last
+one to delete.
+If \fIlast\fR isn't specified it defaults to \fIfirst\fR+1,
+i.e. a single character is deleted.
+This command returns the empty string.
+.TP
+\fIpathName \fBget\fR
+Returns the entry's string.
+.TP
+\fIpathName \fBicursor \fIindex\fR
+Arrange for the insert cursor to be displayed just before the character
+given by \fIindex\fR. Returns the empty string.
+.TP
+\fIpathName \fBidentify \fIx y\fR
+Returns the name of the element at position \fIx\fP, \fIy\fP,
+or the empty string if the coordinates are outside the window.
+.TP
+\fIpathName \fBindex\fI index\fR
+Returns the numerical index corresponding to \fIindex\fR.
+.TP
+\fIpathName \fBinsert \fIindex string\fR
+Insert \fIstring\fR just before the character
+indicated by \fIindex\fR. Returns the empty string.
+.TP
+\fIpathName \fBinstate \fIstatespec\fR ?\fIscript\fR?
+Test the widget state.
+See \fIwidget(n)\fP.
+.TP
+\fIpathName \fBselection \fIoption arg\fR
+This command is used to adjust the selection within an entry. It
+has several forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBselection clear\fR
+Clear the selection if it is currently in this widget.
+If the selection isn't in this widget then the command has no effect.
+Returns the empty string.
+.TP
+\fIpathName \fBselection present\fR
+Returns 1 if there is are characters selected in the entry,
+0 if nothing is selected.
+.TP
+\fIpathName \fBselection range \fIstart\fR \fIend\fR
+Sets the selection to include the characters starting with
+the one indexed by \fIstart\fR and ending with the one just
+before \fIend\fR.
+If \fIend\fR refers to the same character as \fIstart\fR or an
+earlier one, then the entry's selection is cleared.
+.RE
+.TP
+\fIpathName \fBstate\fR ?\fIstateSpec\fR?
+Modify or query the widget state.
+See \fIwidget(n)\fP.
+.TP
+\fIpathName \fBvalidate\fR
+Force revalidation, independent of the conditions specified
+by the \fB-validate\fR option.
+Returns 0 if validation fails, 1 if it succeeds.
+Sets or clears the \fBinvalid\fP state accordingly.
+.TP
+\fIpathName \fBxview \fIargs\fR
+This command is used to query and change the horizontal position of the
+text in the widget's window. It can take any of the following
+forms:
+.RS
+.TP
+\fIpathName \fBxview\fR
+Returns a list containing two elements.
+Each element is a real fraction between 0 and 1; together they describe
+the horizontal span that is visible in the window.
+For example, if the first element is .2 and the second element is .6,
+20% of the entry's text is off-screen to the left, the middle 40% is visible
+in the window, and 40% of the text is off-screen to the right.
+These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR
+option.
+.TP
+\fIpathName \fBxview\fR \fIindex\fR
+Adjusts the view in the window so that the character given by \fIindex\fR
+is displayed at the left edge of the window.
+.TP
+\fIpathName \fBxview moveto\fI fraction\fR
+Adjusts the view in the window so that the character \fIfraction\fR of the
+way through the text appears at the left edge of the window.
+\fIFraction\fR must be a fraction between 0 and 1.
+.TP
+\fIpathName \fBxview scroll \fInumber what\fR
+This command shifts the view in the window left or right according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR.
+'\" or an abbreviation of one of these, but we don't document that.
+If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by
+\fInumber\fR average-width characters on the display; if it is
+\fBpages\fR then the view adjusts by \fInumber\fR screenfuls.
+If \fInumber\fR is negative then characters farther to the left
+become visible; if it is positive then characters farther to the right
+become visible.
+.RE
+.SH VALIDATION
+The \fB-validate\fP, \fB-validatecommand\fP, and \fB-invalidcommand\fP
+options are used to enable entry widget validation.
+.SS "VALIDATION MODES"
+There are two main validation modes: \fIprevalidation\fP,
+in which the \fB-validatecommand\fP is evaluated prior to each edit
+and the return value is used to determine whether to accept
+or reject the change;
+and \fIrevalidation\fP, in which the \fB-validatecommand\fP is
+evaluated to determine whether the current value is valid.
+.PP
+The \fB-validate\fP option determines when validation occurs;
+it may be set to any of the following values:
+.IP \fBnone\fR
+Default. This means validation will only occur when
+specifically requested by the \fBvalidate\fP widget command.
+.IP \fBkey\fR
+The entry will be prevalidated prior to each edit
+(specifically, whenever the \fBinsert\fP or \fBdelete\fP
+widget commands are called).
+If prevalidation fails, the edit is rejected.
+.IP \fBfocus\fR
+The entry is revalidated when the entry receives or loses focus.
+.IP \fBfocusin\fR
+The entry is revalidated when the entry receives focus.
+.IP \fBfocusout\fR
+The entry is revalidated when the entry loses focus.
+.IP \fBall\fR
+Validation is performed for all above conditions.
+.PP
+The \fB-invalidcommand\fP is evaluated whenever
+the \fB-validatecommand\fP returns a false value.
+.PP
+The \fB-validatecommand\fP and \fB-invalidcommand\fP
+may modify the entry widget's value
+via the widget \fBinsert\fP or \fBdelete\fP commands,
+or by setting the linked \fB-textvariable\fP.
+If either does so during prevalidation,
+then the edit is rejected
+regardless of the value returned by the \fB-validatecommand\fP.
+.PP
+If \fB-validatecommand\fP is empty (the default),
+validation always succeeds.
+.SS "VALIDATION SCRIPT SUBSTITUTIONS"
+It is possible to perform percent substitutions on the
+\fB-validatecommand\fR and \fBinvalidCommand\fR,
+just as in a \fBbind\fR script.
+The following substitutions are recognized:
+.IP \fB%d\fR
+Type of action: 1 for \fBinsert\fR prevalidation,
+0 for \fBdelete\fR prevalidation,
+or -1 for revalidation.
+.IP \fB%i\fR
+Index of character string to be inserted/deleted, if any, otherwise -1.
+.IP \fB%P\fR
+In prevalidation, the new value of the entry if the edit is accepted.
+In revalidation, the current value of the entry.
+.IP \fB%s\fR
+The current value of entry prior to editing.
+.IP \fB%S\fR
+The text string being inserted/deleted, if any, {} otherwise.
+.IP \fB%v\fR
+The current value of the \fB-validate\fP option.
+.IP \fB%V\fR
+The validation condition that triggered the callback
+(\fBkey\fP, \fBfocusin\fP, \fBfocusout\fP, or \fBforced\fP).
+.IP \fB%W\fR
+The name of the entry widget.
+.SS "DIFFERENCES FROM TK ENTRY WIDGET VALIDATION"
+.IP \(bu
+The standard Tk entry widget automatically disables validation
+(by setting \fB-validate\fP to \fBnone\fP)
+if the \fB-validatecommand\fP or \fB-invalidcommand\fP modifies
+the entry's value.
+The Tk themed entry widget only disables validation if one
+of the validation scripts raises an error, or if \fB-validatecommand\fP
+does not return a valid boolean value.
+(Thus, it is not necessary to reenable validation after
+modifying the entry value in a validation script).
+.IP \(bu
+The standard entry widget invokes validation whenever the linked
+\fB-textvariable\fP is modified; the Tk themed entry widget does not.
+.SH "DEFAULT BINDINGS"
+The entry widget's default bindings enable the following behavior.
+In the descriptions below, ``word'' refers to a contiguous group
+of letters, digits, or ``_'' characters, or any single character
+other than these.
+.IP \(bu
+Clicking mouse button 1 positions the insert cursor
+just before the character underneath the mouse cursor, sets the
+input focus to this widget, and clears any selection in the widget.
+Dragging with mouse button 1 down strokes out a selection between
+the insert cursor and the character under the mouse.
+.IP \(bu
+Double-clicking with mouse button 1 selects the word under the mouse
+and positions the insert cursor at the end of the word.
+Dragging after a double click strokes out a selection consisting
+of whole words.
+.IP \(bu
+Triple-clicking with mouse button 1 selects all of the text in the
+entry and positions the insert cursor at the end of the line.
+.IP \(bu
+The ends of the selection can be adjusted by dragging with mouse
+button 1 while the Shift key is down.
+If the button is double-clicked before dragging then the selection
+will be adjusted in units of whole words.
+.IP \(bu
+Clicking mouse button 1 with the Control key down will position the
+insert cursor in the entry without affecting the selection.
+.IP \(bu
+If any normal printing characters are typed in an entry, they are
+inserted at the point of the insert cursor.
+.IP \(bu
+The view in the entry can be adjusted by dragging with mouse button 2.
+If mouse button 2 is clicked without moving the mouse, the selection
+is copied into the entry at the position of the mouse cursor.
+.IP \(bu
+If the mouse is dragged out of the entry on the left or right sides
+while button 1 is pressed, the entry will automatically scroll to
+make more text visible (if there is more text off-screen on the side
+where the mouse left the window).
+.IP \(bu
+The Left and Right keys move the insert cursor one character to the
+left or right; they also clear any selection in the entry.
+If Left or Right is typed with the Shift key down, then the insertion
+cursor moves and the selection is extended to include the new character.
+Control-Left and Control-Right move the insert cursor by words, and
+Control-Shift-Left and Control-Shift-Right move the insert cursor
+by words and also extend the selection.
+Control-b and Control-f behave the same as Left and Right, respectively.
+.IP \(bu
+The Home key and Control-a move the insert cursor to the
+beginning of the entry and clear any selection in the entry.
+Shift-Home moves the insert cursor to the beginning of the entry
+and extends the selection to that point.
+.IP \(bu
+The End key and Control-e move the insert cursor to the
+end of the entry and clear any selection in the entry.
+Shift-End moves the cursor to the end and extends the selection
+to that point.
+.IP \(bu
+Control-/ selects all the text in the entry.
+.IP \(bu
+Control-\e clears any selection in the entry.
+.IP \(bu
+The standard Tk <<Cut>>, <<Copy>>, <<Paste>>, and <<Clear>>
+virtual events operate on the selection in the expected manner.
+.IP \(bu
+The Delete key deletes the selection, if there is one in the entry.
+If there is no selection, it deletes the character to the right of
+the insert cursor.
+.IP \(bu
+The BackSpace key and Control-h delete the selection, if there is one
+in the entry.
+If there is no selection, it deletes the character to the left of
+the insert cursor.
+.IP \(bu
+Control-d deletes the character to the right of the insert cursor.
+.IP \(bu
+Control-k deletes all the characters to the right of the insertion
+cursor.
+.SH "WIDGET STATES"
+In the \fBdisabled\fP state,
+the entry cannot be edited and the text cannot be selected.
+In the \fBreadonly\fP state,
+no insert cursor is displayed and
+the entry cannot be edited
+(specifically: the \fBinsert\fP and \fBdelete\fP commands have no effect).
+The \fBdisabled\fP state is the same as \fBreadonly\fP,
+and in addition text cannot be selected.
+.PP
+Note that changes to the linked \fB-textvariable\fP will
+still be reflected in the entry, even if it is disabled or readonly.
+.PP
+Typically, the text is "grayed-out" in the \fBdisabled\fP state,
+and a different background is used in the \fBreadonly\fP state.
+.PP
+The entry widget sets the \fBinvalid\fP state if revalidation fails,
+and clears it whenever validation succeeds.
+.SH KEYWORDS
+entry, widget, text field
diff --git a/doc/ttk_frame.n b/doc/ttk_frame.n
new file mode 100644
index 0000000..da7a00a
--- /dev/null
+++ b/doc/ttk_frame.n
@@ -0,0 +1,43 @@
+'\" Copyright (c) 2005 Joe English
+.so man.macros
+.TH ttk_frame n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::frame \- Simple container widget
+.SH SYNOPSIS
+\fBttk::frame\fR \fIpathName \fR?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+A \fBframe\fP widget is a container, used to group other widgets together.
+.SO
+\-class \-cursor \-takefocus \-style
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP -borderwidth borderWidth BorderWidth
+The desired width of the widget border. Defaults to 0.
+.OP -relief relief Relief
+One of the standard Tk border styles:
+\fBflat\fR, \fBgroove\fR, \fBraised\fR, \fBridge\fR,
+\fBsolid\fR, or \fBsunken\fP.
+Defaults to \fBflat\fP.
+.OP -padding padding Padding
+Additional padding to include inside the border.
+.OP -width width Width
+If specified, the widget's requested width in pixels.
+.OP -height height Height
+If specified, the widget's requested height in pixels.
+.SH "WIDGET COMMAND"
+Supports the standard widget commands
+\fBconfigure\fP, \fBcget\fP, \fBinstate\fP, and \fBstate\fP;
+see \fIwidget(n)\fP.
+.SH "NOTES"
+Note that if the \fBpack\fP, \fBgrid\fP, or other geometry managers
+are used to manage the children of the \fBframe\fP,
+by the GM's requested size will normally take precedence
+over the \fBframe\fP widget's \fB-width\fP and \fB-height\fP options.
+[\fBpack propagate\fP] and [\fBgrid propagate\fP] can be used
+to change this.
+.SH "SEE ALSO"
+widget(n), labelframe(n)
+.SH "KEYWORDS"
+widget, frame, container
diff --git a/doc/ttk_image.n b/doc/ttk_image.n
new file mode 100644
index 0000000..87e2deb
--- /dev/null
+++ b/doc/ttk_image.n
@@ -0,0 +1,73 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\" $Id: ttk_image.n,v 1.1 2006/10/31 01:42:25 hobbs Exp $
+'\"
+.so man.macros
+.TH ttk_image n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk_image \- Define an element based on an image
+.SH SYNOPSIS
+\fBttk::style create element \fIname\fR \fBimage\fR \fIimageName\fR ?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+The \fIimage\fP element factory creates a new element
+in the current theme whose visual appearance is determined
+by a Tk image.
+.SH OPTIONS
+Valid \fIoptions\fR are:
+.TP
+\fB-border\fP \fIpadding\fP
+\fIpadding\fP is a list of up to four integers, specifying
+the left, top, right, and bottom borders, respectively.
+See \fBIMAGE STRETCHING\fP, below.
+.TP
+\fB-height \fIheight\fP
+Specifies a minimum height for the element.
+If less than zero, the base image's height is used as a default.
+.TP
+\fB-map { \fIstatespec\fP \fIimage\fP.. }
+Specifies auxilliary images to use in different states.
+Each \fIstatespec\fP is a list of state names optionally
+prefixed by an exclamation point, as in \fBttk::style map\fP.
+Each \fIimageName\fP is the name of a Tk image
+defined with \fBimage create ...\fP.
+When the element is displayed, each \fIstatespec\fP is
+tested in order, and the \fIimage\fP corresponding to
+the first matching \fIstatespec\fP is used.
+If none match, the base \fIimageName\fP is used.
+.TP
+\fB-padding\fP \fIpadding\fP
+Specifies the element's interior padding. Defaults to
+\fI-border\fP if not specified.
+.TP
+\fB-sticky\fP \fIspec\fP
+Specifies how the image is placed within the final parcel.
+\fIspec\fP contains zero or more characters "n", "s", "w", or "e".
+.TP
+\fB-width \fIwidth\fP
+Specifies a minimum width for the element.
+If less than zero, the base image's width is used as a default.
+
+.SH "IMAGE STRETCHING"
+If the element's allocated parcel is larger than the image,
+the image will be placed in the parcel based on the \fB-sticky\fP option.
+If the image needs to stretch horizontally (i.e., \fB-sticky ew\fP)
+or vertically (\fB-sticky ns\fP),
+subregions of the image are replicated to fill the parcel
+based on the \fB-border\fP option.
+The \fB-border\fP divides the image into 9 regions:
+four fixed corners, top and left edges (which may be tiled horizontally),
+left and right edges (which may be tiled vertically),
+and the central area (which may be tiled in both directions).
+.SH "EXAMPLE"
+.CS
+set button(normal) [image create photo -file button.png]
+set button(pressed) [image create photo -file button-pressed.png]
+ttk::style element create Button.button image $button(normal) \e
+ -border {2 4} -map [list pressed $button(pressed)] -sticky nswe
+.CE
+.SH "SEE ALSO"
+image(n), photo(n)
+.SH KEYWORDS
+pixmap theme, image
diff --git a/doc/ttk_intro.n b/doc/ttk_intro.n
new file mode 100644
index 0000000..cbe49b4
--- /dev/null
+++ b/doc/ttk_intro.n
@@ -0,0 +1,160 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_intro n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk_intro \- Introduction to the Tk theme engine
+.BE
+.SH "OVERVIEW"
+The Tk themed widget set is based on a revised and enhanced version
+of TIP #48 (http://tip.tcl.tk/48) specified style engine.
+The main concepts are described below.
+The basic idea is to separate, to the extent possible,
+the code implementing a widget's behavior from
+the code implementing its appearance.
+Widget class bindings are primarily responsible for
+maintaining the widget state and invoking callbacks;
+all aspects of the widgets appearance is
+.SH "THEMES"
+A \fItheme\fR is a collection of elements and styles
+that determine the look and feel of the widget set.
+Themes can be used to:
+.IP \(bu
+Isolate platform differences (X11 vs. classic Windows vs. XP vs. Aqua ...)
+.IP \(bu
+Adapt to display limitations (low-color, grayscale, monochrome, tiny screens)
+.IP \(bu
+Accessibility (high contrast, large type)
+.IP \(bu
+Application suite "branding"
+.IP \(bu
+Blend in with the rest of the desktop (Gnome, KDE, Java)
+.IP \(bu
+And, of course: eye candy.
+
+.SH "ELEMENTS"
+An \fIelement\fR displays an individual part of a widget.
+For example, a vertical scrollbar widget contains \fBuparrow\fR,
+\fBdownarrow\fR, \fBtrough\fR and \fBslider\fR elements.
+.PP
+Element names use a recursive dotted notation.
+For example, \fBuparrow\fR identifies a generic arrow element,
+and \fBScrollbar.arrow\fR and \fBCombobox.uparrow\fR identify
+widget-specific elements.
+When looking for an element, the style engine looks for
+the specific name first, and if an element of that name is
+not found it looks for generic elements by stripping off
+successive leading components of the element name.
+.PP
+Like widgets, elements have \fIoptions\fR which
+specify what to display and how to display it.
+For example, the \fBtext\fR element
+(which displays a text string) has
+\fB-text\fR, \fB-font\fR, \fB-foreground\fR, \fB-background\fR,
+\fB-underline\fR, and \fB-width\fR options.
+The value of an element resource is taken from:
+.IP \(bu
+A dynamic setting specified by \fBstyle map\fR and the current state;
+.IP \(bu
+An option of the same name and type in the widget containing the element;
+.IP \(bu
+The default setting specified by \fBstyle default\fR; or
+.IP \(bu
+The element's built-in default value for the resource.
+.SH "LAYOUTS"
+A \fIlayout\fR specifies which elements make up a widget
+and how they are arranged.
+The layout engine uses a simplified version of the \fBpack\fR
+algorithm: starting with an initial cavity equal to the size
+of the widget, elements are allocated a parcel within the cavity along
+the side specified by the \fB-side\fR option,
+and placed within the parcel according to the \fB-sticky\fR
+option.
+For example, the layout for a horizontal scrollbar
+.CS
+style layout Horizontal.TScrollbar {
+ Scrollbar.trough -children {
+ Scrollbar.leftarrow -side left -sticky w
+ Scrollbar.rightarrow -side right -sticky e
+ Scrollbar.thumb -side left -expand true -sticky ew
+ }
+}
+.CE
+By default, the layout for a widget is the same as its class name.
+Some widgets may override this (for example, the \fBscrollbar\fR
+widget chooses different layouts based on the \fB-orient\fR option).
+
+.SH "STATES"
+In standard Tk, many widgets have a \fB-state\fR option
+which (in most cases) is either \fBnormal\fR or \fBdisabled\fR.
+Some widgets support additional states, such
+as the \fBentry\fR widget which has a \fBreadonly\fR state
+and the various flavors of buttons which have \fBactive\fR state.
+.PP
+The themed Tk widgets generalizes this idea:
+every widget has a bitmap of independent state flags.
+Widget state flags include \fBactive\fR, \fBdisabled\fR,
+\fBpressed\fR, \fBfocus\fR, etc.,
+(see \fIwidget(n)\fR for the full list of state flags).
+.PP
+Instead of a \fB-state\fR option, every widget now has
+a \fBstate\fR widget command which is used to set or query
+the state.
+A \fIstate specification\fR is a list of symbolic state names
+indicating which bits are set, each optionally prefixed with an
+exclamation point indicating that the bit is cleared instead.
+.PP
+For example, the class bindings for the \fBtbutton\fR
+widget are:
+.CS
+bind TButton <Enter> { %W state active }
+bind TButton <Leave> { %W state !active }
+bind TButton <ButtonPress-1> { %W state pressed }
+bind TButton <Button1-Leave> { %W state !pressed }
+bind TButton <Button1-Enter> { %W state pressed }
+bind TButton <ButtonRelease-1> \e
+ { %W instate {pressed} { %W state !pressed ; %W invoke } }
+.CE
+This specifies that the widget becomes \fBactive\fR when
+the pointer enters the widget, and inactive when it leaves.
+Similarly it becomes \fBpressed\fR when the mouse button is pressed,
+and \fB!pressed\fR on the ButtonRelease event.
+In addition, the button unpresses if
+pointer is dragged outside the widget while Button-1 is held down,
+and represses if it's dragged back in.
+Finally, when the mouse button is released, the widget's
+\fB-command\fR is invoked, but only if the button is currently
+in the \fBpressed\fR state.
+(The actual bindings are a little more complicated than the above,
+but not by much).
+.PP
+\fINote to self: rewrite that paragraph. It's horrible.\fR
+.SH "STYLES"
+Each widget is associated with a \fIstyle\fR,
+which specifies values for element resources.
+Style names use a recursive dotted notation like layouts and elements;
+by default, widgets use the class name to look up a style in the current theme.
+For example:
+.CS
+style default TButton \e
+ -background #d9d9d9 \e
+ -foreground black \e
+ -relief raised \e
+ ;
+.CE
+Many elements are displayed differently depending on the widget state.
+For example, buttons have a different background when they are active,
+a different foreground when disabled, and a different relief when pressed.
+The \fBstyle map\fP command specifies dynamic resources
+for a particular style:
+.CS
+style map TButton \e
+ -background [list disabled #d9d9d9 active #ececec] \e
+ -foreground [list disabled #a3a3a3] \e
+ -relief [list {pressed !disabled} sunken] \e
+ ;
+.CE
+.SH "SEE ALSO"
+widget(n), style(n)
diff --git a/doc/ttk_label.n b/doc/ttk_label.n
new file mode 100644
index 0000000..77ac736
--- /dev/null
+++ b/doc/ttk_label.n
@@ -0,0 +1,75 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_label n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::label \- Display a text string and/or image
+.SH SYNOPSIS
+\fBttk::label\fR \fIpathName \fR?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+A \fBlabel\fP widget displays a textual label and/or image.
+The label may be linked to a Tcl variable
+to automatically change the displayed text.
+.SO
+\-class \-compound \-cursor \-image
+\-style \-takefocus \-text \-textvariable
+\-underline \-width
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-anchor anchor Anchor
+Specifies how the information in the widget is positioned
+relative to the inner margins. Legal values are
+\fBn\fR, \fBne\fR, \fBe\fR, \fBse\fR,
+\fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, and \fBcenter\fR.
+See also \fB-justify\fP.
+.OP \-background frameColor FrameColor
+The widget's background color.
+If unspecified, the theme default is used.
+.OP \-font font Font
+Font to use for label text.
+.OP \-foreground textColor TextColor
+The widget's foreground color.
+If unspecified, the theme default is used.
+.OP \-justify justify Justify
+If there are multiple lines of text, specifies how
+the lines are laid out relative to one another.
+One of \fBleft\fP, \fBcenter\fP, or \fBright\fP.
+See also \fB-anchor\fP.
+.OP \-padding padding Padding
+Specifies the amount of extra space to allocate for the widget.
+The padding is a list of up to four length specifications
+\fIleft top right bottom\fR.
+If fewer than four elements are specified,
+\fIbottom\fR defaults to \fItop\fR,
+\fIright\fR defaults to \fIleft\fR, and
+\fItop\fR defaults to \fIleft\fR.
+.OP \-relief relief Relief
+.\" Rewrite this:
+Specifies the 3-D effect desired for the widget border.
+Valid values are
+\fBflat\fR, \fBgroove\fR, \fBraised\fR, \fBridge\fR, \fBsolid\fR,
+and \fBsunken\fR.
+.OP \-text text Text
+Specifies a text string to be displayed inside the widget
+(unless overridden by \fB-textvariable\fR).
+.OP \-wraplength wrapLength WrapLength
+Specifies the maximum line length (in pixels).
+If this option is less than or equal to zero,
+then automatic wrapping is not performed; otherwise
+the text is split into lines such that no line is longer
+than the specified value.
+.SH "WIDGET COMMAND"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+.TP
+\fIpathName \fBinstate \fIstatespec\fR ?\fIscript\fR?
+.TP
+\fIpathName \fBstate\fR ?\fIstateSpec\fR?
+See \fIwidget(n)\fP
+.SH "SEE ALSO"
+widget(n)
diff --git a/doc/ttk_labelframe.n b/doc/ttk_labelframe.n
new file mode 100644
index 0000000..1eabcf2
--- /dev/null
+++ b/doc/ttk_labelframe.n
@@ -0,0 +1,64 @@
+'\" Copyright (c) 2005 Joe English
+.so man.macros
+.TH ttk_labelframe n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::labelframe \- Container widget with optional label
+.SH SYNOPSIS
+\fBttk::labelframe\fR \fIpathName \fR?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+A \fBlabelframe\fP widget is a container used to group other widgets together.
+It has an optional label, which may be a plain text string or another widget.
+.SO
+\-class \-cursor \-takefocus \-style
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+'\" XXX: Currently included, but may go away:
+'\" XXX: .OP -borderwidth borderWidth BorderWidth
+'\" XXX: The desired width of the widget border. Default is theme-dependent.
+'\" XXX: .OP -relief relief Relief
+'\" XXX: One of the standard Tk border styles:
+'\" XXX: \fBflat\fR, \fBgroove\fR, \fBraised\fR, \fBridge\fR,
+'\" XXX: \fBsolid\fR, or \fBsunken\fP.
+'\" XXX: Default is theme-dependent.
+.OP -labelanchor labelAnchor LabelAnchor
+Specifies where to place the label.
+Allowed values are (clockwise from the top upper left corner):
+\fBnw\fR, \fBn\fR, \fBne\fR, \fBen\fR, \fBe\fR, \fBes\fR,
+\fBse\fR, \fBs\fR,\fBsw\fR, \fBws\fR, \fBw\fR and \fBwn\fR.
+The default value is theme-dependent.
+'\" Alternate explanation: The first character must be one of n, s, e, or w
+'\" and specifies which side the label should be placed on;
+'\" the remaining characters specify how the label is aligned on that side.
+'\" NOTE: Now allows other values as well; leave this undocumented for now
+.OP -text text Text
+Specifies the text of the label.
+.OP -underline underline Underline
+If set, specifies the integer index (0-based) of a character to
+underline in the text string.
+The underlined character is used for mnemonic activation
+(see \fIkeynav(n)\fR).
+Mnemonic activation for a \fBttk::labelframe\fP
+sets the keyboard focus to the first child of the \fBttk::labelframe\fP widget.
+.OP -padding padding Padding
+Additional padding to include inside the border.
+.OP -labelwidget labelWidget LabelWidget
+The name of a widget to use for the label.
+If set, overrides the \fB-text\fP option.
+The \fB-labelwidget\fP must be a child of the \fBlabelframe\fP widget
+or one of the \fBlabelframe\fP's ancestors, and must belong to the
+same top-level widget as the \fBlabelframe\fP.
+.OP -width width Width
+If specified, the widget's requested width in pixels.
+.OP -height height Height
+If specified, the widget's requested height in pixels.
+(See \fIttk::frame\fP for further notes on \fB-width\fP and \fB-height\fP).
+.SH "WIDGET COMMAND"
+Supports the standard widget commands
+\fBconfigure\fP, \fBcget\fP, \fBinstate\fP, and \fBstate\fP;
+see \fIwidget(n)\fP.
+.SH "SEE ALSO"
+widget(n), frame(n)
+.SH "KEYWORDS"
+widget, frame, container, label, groupbox
diff --git a/doc/ttk_menubutton.n b/doc/ttk_menubutton.n
new file mode 100644
index 0000000..cf3c576
--- /dev/null
+++ b/doc/ttk_menubutton.n
@@ -0,0 +1,41 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_menubutton n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::menubutton \- Widget that pops down a menu when pressed
+.SH SYNOPSIS
+\fBttk::menubutton\fR \fIpathName \fR?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+A \fBmenubutton\fP widget displays a textual label and/or image,
+and displays a menu when pressed.
+.SO
+\-class \-compound \-cursor \-image
+\-state \-style \-takefocus \-text
+\-textvariable \-underline \-width
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-direction direction Direction
+Specifies where the menu is to be popped up relative
+to the menubutton.
+One of: \fIabove\fR, \fIbelow\fR, \fIleft\fR, \fIright\fR,
+or \fIflush\fR. The default is \fIbelow\fR.
+\fIflush\fR pops the menu up directly over the menubutton.
+.OP \-menu menu Menu
+Specifies the path name of the menu associated with the menubutton.
+To be on the safe side, the menu ought to be a direct child of the
+menubutton.
+.\" not documented: may go away:
+.\" .OP \-anchor anchor Anchor
+.\" .OP \-padding padding Pad
+.SH "WIDGET COMMAND"
+Menubutton widgets support the standard
+\fBcget\fR, \fBconfigure\fR, \fBinstate\fR, and \fBstate\fR
+methods. No other widget methods are used.
+.SH "SEE ALSO"
+widget(n), keynav(n), menu(n)
+.SH "KEYWORDS"
+widget, button, menu
diff --git a/doc/ttk_notebook.n b/doc/ttk_notebook.n
new file mode 100644
index 0000000..e123077
--- /dev/null
+++ b/doc/ttk_notebook.n
@@ -0,0 +1,179 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_notebook n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::notebook \- Multi-paned container widget
+.SH SYNOPSIS
+\fBttk::notebook\fR \fIpathName \fR?\fIoptions\fR?
+.br
+\fIpathName \fBadd\fR \fIpathName\fR.\fIsubwindow\fR ?\fIoptions...\fR?
+\fIpathName \fBinsert\fR \fIindex\fR \fIpathName\fR.\fIsubwindow\fR ?\fIoptions...\fR?
+.BE
+.SH DESCRIPTION
+A \fBnotebook\fP widget manages a collection of subpanes
+and displays a single one at a time.
+Each pane is associated with a tab, which the user
+may select to change the currently-displayed pane.
+.SO
+\-class \-cursor \-takefocus \-style
+.SE
+.SH "WIDGET OPTIONS"
+.OP \-height height Height
+If present and greater than zero,
+specifies the desired height of the pane area
+(not including internal padding or tabs).
+Otherwise, the maximum height of all panes is used.
+.OP \-padding padding Padding
+Specifies the amount of extra space to add around the outside
+of the notebook.
+The padding is a list of up to four length specifications
+\fIleft top right bottom\fR.
+If fewer than four elements are specified,
+\fIbottom\fR defaults to \fItop\fR,
+\fIright\fR defaults to \fIleft\fR, and
+\fItop\fR defaults to \fIleft\fR.
+.OP \-width width Width
+If present and greater than zero,
+specifies the desired width of the pane area
+(not including internal padding).
+Otherwise, the maximum width of all panes is used.
+.SH "TAB OPTIONS"
+The following options may be specified for individual notebook panes:
+.OP \-state state State
+Either \fBnormal\fP, \fBdisabled\fP or \fBhidden\fP.
+If \fBdisabled\fP, then the tab is not selectable. If \fBhidden\fP,
+then the tab is not shown.
+.OP \-sticky sticky Sticky
+Specifies how the child pane is positioned within the pane area.
+Value is a string containing zero or more of the characters
+\fBn, s, e,\fR or \fBw\fR.
+Each letter refers to a side (north, south, east, or west)
+that the child window will "stick" to,
+as per the \fBgrid\fR geometry manager.
+.OP \-padding padding Padding
+Specifies the amount of extra space to add between the notebook and this pane.
+Syntax is the same as for the widget \fB-padding\fP option.
+.OP \-text text Text
+Specifies a string to be displayed in the tab.
+.OP \-image image Image
+Specifies an image to display in the tab,
+which must have been created with the \fBimage create\fR command.
+.OP \-compound compound Compound
+Specifies how to display the image relative to the text,
+in the case both \fB-text\fR and \fB-image\fR are present.
+See \fIlabel(n)\fR for legal values.
+.OP \-underline underline Underline
+Specifies the integer index (0-based) of a character to underline
+in the text string.
+The underlined character is used for mnemonic activation
+if \fBttk::notebook::enableTraversal\fR is called.
+.SH "WIDGET COMMAND"
+.TP
+\fIpathname \fBadd \fIchild\fR ?\fIoptions...\fR?
+Adds a new tab to the notebook.
+When the tab is selected, the \fIchild\fR window
+will be displayed.
+\fIchild\fR must be a direct child of the notebook window.
+See \fBTAB OPTIONS\fR for the list of available \fIoptions\fR.
+.TP
+\fIpathname \fBconfigure\fR ?\fIoptions\fR?
+See \fIwidget(n)\fR.
+.TP
+\fIpathname \fBcget\fR \fIoption\fR
+See \fIwidget(n)\fR.
+.TP
+\fIpathname \fBforget\fR \fItabid\fR
+Removes the tab specified by \fItabid\fR,
+unmaps and unmanages the associated child window.
+.TP
+\fIpathname \fBindex\fR \fItabid\fR
+Returns the numeric index of the tab specified by \fItabid\fR,
+or the total number of tabs if \fItabid\fR is the string "\fBend\fR".
+.TP
+\fIpathname \fBinsert\fR \fIpos\fR \fIsubwindow\fR \fIoptions...\fR
+Inserts a pane at the specified position.
+\fIpos\fR is either the string \fBend\fR, an integer index,
+or the name of a managed subwindow.
+If \fIsubwindow\fR is already managed by the notebook,
+moves it to the specified position.
+See \fBTAB OPTIONS\fR for the list of available options.
+.TP
+\fIpathname \fBinstate\fR \fIstatespec \fR?\fIscript...\fR?
+See \fIwidget(n)\fR.
+.TP
+\fIpathname \fBselect\fR ?\fItabid\fR?
+Selects the specified tab. The associated child pane will be displayed,
+and the previously-selected pane (if different) is unmapped.
+If \fItabid\fR is omitted, returns the widget name of the
+currently selected pane.
+.TP
+\fIpathname \fBstate\fR ?\fIstatespec\fR?
+See \fIwidget(n)\fR.
+.TP
+\fIpathname \fBtab\fR \fItabid\fR ?\fI-options \fR?\fIvalue ...\fR
+Query or modify the options of the specific tab.
+If no \fI-option\fR is specified, returns a dictionary of the tab option values.
+If one \fI-option\fP is specified, returns the value of that \fIoption\fR.
+Otherwise, sets the \fI-option\fRs to the corresponding \fIvalue\fRs.
+See \fBTAB OPTIONS\fR for the available options.
+.TP
+\fIpathname \fBtabs\fR
+Returns a list of all windows managed by the widget.
+.\" Perhaps "panes" is a better name for this command?
+.SH "KEYBOARD TRAVERSAL"
+To enable keyboard traversal for a toplevel window
+containing a notebook widget \fI$nb\fR, call:
+.CS
+ttk::notebook::enableTraversal $nb
+.CE
+.PP
+This will extend the bindings for the toplevel widget
+containing the notebook as follows:
+.IP \(bu
+\fBControl-Tab\fR selects the tab following the currently selected one.
+.IP \(bu
+\fBShift-Control-Tab\fR selects the tab preceding the currently selected one.
+.IP \(bu
+\fBAlt-K\fP, where \fBK\fP is the mnemonic (underlined) character
+of any tab, will select that tab.
+.PP
+Multiple notebooks in a single toplevel may be enabled for traversal,
+including nested notebooks.
+However, notebook traversal only works properly if all panes
+are direct children of the notebook.
+.SH "TAB IDENTIFIERS"
+The \fItabid\fR argument to the above commands may take
+any of the following forms:
+.IP \(bu
+An integer between zero and the number of tabs;
+.IP \(bu
+The name of a child pane window;
+.IP \(bu
+A positional specification of the form "@\fIx\fR,\fIy\fR",
+which identifies the tab
+.IP \(bu
+The literal string "\fBcurrent\fR",
+which identifies the currently-selected tab; or:
+.IP \(bu
+The literal string "\fBend\fR",
+which returns the number of tabs
+(only valid for "\fIpathname \fBindex\fR").
+
+.SH "VIRTUAL EVENTS"
+The notebook widget generates a \fB<<NotebookTabChanged>>\fP
+virtual event after a new tab is selected.
+.SH "EXAMPLE"
+.CS
+notebook .nb
+\.nb add [frame .nb.f1] -text "First tab"
+\.nb add [frame .nb.f2] -text "Second tab"
+\.nb select .nb.f2
+ttk::notebook::enableTraversal .nb
+.CE
+.SH "SEE ALSO"
+widget(n), grid(n)
+.SH "KEYWORDS"
+pane, tab
diff --git a/doc/ttk_panedwindow.n b/doc/ttk_panedwindow.n
new file mode 100644
index 0000000..d38a007
--- /dev/null
+++ b/doc/ttk_panedwindow.n
@@ -0,0 +1,78 @@
+'\" $Id: ttk_panedwindow.n,v 1.1 2006/10/31 01:42:25 hobbs Exp $
+'\" Copyright (c) 2005 Joe English
+.so man.macros
+.TH ttk_panedwindow n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH "NAME"
+ttk::panedwindow \- Multi-pane container window
+.SH SYNOPSIS
+.nf
+\fBttk::panedwindow\fR \fIpathName \fR?\fIoptions\fR?
+.br
+\fIpathName \fBadd\fR \fIpathName.subwindow\fR ?\fIoptions...\fR?
+\fIpathName \fBinsert\fR \fIindex\fR \fIpathName.subwindow\fR ?\fIoptions...\fR?
+.fi
+.BE
+.SH "DESCRIPTION"
+A paned widget displays a number of subwindows,
+stacked either vertically or horizontally.
+The user may adjust the relative sizes of the subwindows
+by dragging the sash between panes.
+.SO
+\-class \-cursor \-takefocus \-style
+.SE
+.SH "WIDGET OPTIONS"
+.OP \-orient orient Orient
+Specifies the orientation of the window.
+If \fBvertical\fP, subpanes are stacked top-to-bottom;
+if \fBhorizontal\fP, subpanes are stacked left-to-right.
+.SH "PANE OPTIONS"
+The following options may be specified for each pane:
+.OP \-weight weight Weight
+An integer specifying the relative stretchability of the pane.
+When the paned window is resized, the extra space is added
+or subracted to each pane proportionally to its \fB-weight\fP.
+.SH "WIDGET COMMAND"
+Supports the standard \fBconfigure\fR, \fBcget\fR, \fBstate\fP,
+and \fBinstate\fR commands; see \fIwidget(n)\fR for details.
+Additional commands:
+.TP
+\fIpathname \fBadd\fR \fIsubwindow\fR \fIoptions...\fR
+Adds a new pane to the window.
+\fIsubwindow\fR must be a direct child of the paned window \fIpathname\fR.
+See \fBPANE OPTIONS\fR for the list of available options.
+.TP
+\fIpathname \fBforget\fR \fIpane\fR
+Removes the specified subpane from the widget.
+\fIpane\fR is either an integer index or the name of a managed subwindow.
+.TP
+\fIpathname \fBinsert\fR \fIpos\fR \fIsubwindow\fR \fIoptions...\fR
+Inserts a pane at the specified position.
+\fIpos\fR is either the string \fBend\fR, an integer index,
+or the name of a managed subwindow.
+If \fIsubwindow\fR is already managed by the paned window,
+moves it to the specified position.
+See \fBPANE OPTIONS\fR for the list of available options.
+.TP
+\fIpathname \fBpane\fR \fIpane -option \fR?\fIvalue \fR?\fI-option value...\fR
+Query or modify the options of the specified \fIpane\fR,
+where \fIpane\fR is either an integer index or the name of a managed subwindow.
+If no \fI-option\fR is specified, returns a dictionary of the pane
+option values.
+If one \fI-option\fP is specified, returns the value of that \fIoption\fR.
+Otherwise, sets the \fI-option\fRs to the corresponding \fIvalue\fRs.
+.SH "INTERNAL ROUTINES"
+The following routines are used internally by the \fBpaned\fR widget
+binding code.
+.TP
+\fIpathname\fR \fBsashpos\fR \fIindex\fR ?\fInewpos\fR?
+If \fInewpos\fR is specified, sets the sash position
+(subject to constraints).
+Returns the position of sash number \fIindex\fR.
+.TP
+\fIpathname\fR \fBidentify\fR \fIx y\fR
+Returns a list consisting of the sash index at point \fIx,y\fR
+and the name of the sash subelement at that point.
+Returns the empty list if \fIx,y\fR is not over a sash.
+.SH "SEE ALSO"
+\fIwidget(n)\fR, \fInotebook(n)\fR.
diff --git a/doc/ttk_progressbar.n b/doc/ttk_progressbar.n
new file mode 100644
index 0000000..15ac048
--- /dev/null
+++ b/doc/ttk_progressbar.n
@@ -0,0 +1,79 @@
+'\"
+'\" Copyright (c) 2005 Joe English
+'\"
+.so man.macros
+.TH ttk_progressbar n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::progressbar \- Provide progress feedback
+.SH SYNOPSIS
+\fBttk::progressbar\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-class \-cursor \-takefocus \-style
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-orient orient Orient
+One of \fBhorizontal\fP or \fBvertical\fP.
+Specifies the orientation of the progress bar.
+.OP \-length length Length
+Specifies the length of the long axis of the progress bar
+(width if horizontal, height if vertical).
+.OP \-mode mode Mode
+One of \fBdeterminate\fP or \fBindeterminate\fP.
+.OP \-maximum maximum Maximum
+A floating point number specifying the maximum \fB-value\fR.
+Defaults to 100.
+.OP \-value value Value
+The current value of the progress bar.
+In \fIdeterminate\fR mode, this represents the amount of work completed.
+In \fIindeterminate\fR mode, it is interpreted modulo \fB-maximum\fP;
+that is, the progress bar completes one "cycle" when
+the \fB-value\fP increases by \fB-maximum\fP.
+.OP \-variable variable Variable
+The name of a Tcl variable which is linked to the \fB-value\fP.
+If specified, the \fB-value\fP of the progress bar is
+automatically set to the value of the variable whenever
+the latter is modified.
+.OP \-phase phase Phase
+Read-only option.
+The widget periodically increments the value of this option
+whenever the \fB-value\fP is greater than 0 and,
+in \fIdeterminate\fR mode, less than \fB-maximum\fR.
+This option may be used by the current theme
+to provide additional animation effects.
+.BE
+.SH "DESCRIPTION"
+A progress bar widget shows the status of a long-running operation.
+They can operate in two modes: \fIdeterminate\fP mode shows the
+amount completed relative to the total amount of work to be done,
+and \fIindeterminate\fR mode provides an animated display to
+let the user know that something is happening.
+.SH "WIDGET COMMAND"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the specified \fIoption\fP; see \fIwidget(n)\fP.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Modify or query widget options; see \fIwidget(n)\fP.
+.TP
+\fIpathName \fBinstate \fIstatespec\fR ?\fIscript\fR?
+Test the widget state; see \fIwidget(n)\fP.
+.TP
+\fIpathName \fBstart\fR ?\fIinterval\fR?
+Begin autoincrement mode:
+schedules a recurring timer event that calls \fBstep\fP
+every \fIinterval\fP milliseconds.
+If omitted, \fIinterval\fP defaults to 50 milliseconds (20 steps/second).
+.TP
+\fIpathName \fBstate\fR ?\fIstateSpec\fR?
+Modify or query the widget state; see \fIwidget(n)\fP.
+.TP
+\fIpathName \fBstep\fR ?\fIamount\fR?
+Increments the \fB-value\fR by \fIamount\fR.
+\fIamount\fR defaults to 1.0 if omitted.
+.TP
+\fIpathName \fBstop\fR
+Stop autoincrement mode:
+cancels any recurring timer event initiated by \fIpathName \fBstart\fR.
+.SH "SEE ALSO"
+widget(n)
diff --git a/doc/ttk_radiobutton.n b/doc/ttk_radiobutton.n
new file mode 100644
index 0000000..134b4c6
--- /dev/null
+++ b/doc/ttk_radiobutton.n
@@ -0,0 +1,57 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_radiobutton n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::radiobutton \- Mutually exclusive option widget
+.SH SYNOPSIS
+\fBttk::radiobutton\fR \fIpathName \fR?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+\fBradiobutton\fR widgets are used in groups to show or change
+a set of mutually-exclusive options.
+Radiobuttons are linked to a Tcl variable,
+and have an associated value; when a radiobutton is clicked,
+it sets the variable to its associated value.
+.SO
+\-class \-compound \-cursor \-image
+\-state \-style \-takefocus \-text
+\-textvariable \-underline \-width
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-command command Command
+A Tcl script to evaluate whenever the widget is invoked.
+.OP \-value Value Value
+The value to store in the associated \fI-variable\fR
+when the widget is selected.
+.OP \-variable variable Variable
+The name of a global variable whose value is linked to the widget.
+Default value is \fB::selectedButton\fP.
+.SH "WIDGET COMMAND"
+In addition to the standard
+\fBcget\fR, \fBconfigure\fR, \fBinstate\fR, and \fBstate\fR
+commands, radiobuttons support the following additional
+widget commands:
+.TP
+\fIpathname\fR invoke
+Sets the \fI-variable\fR to the \fI-value\fR, selects the widget,
+and evaluates the associated \fI-command\fR.
+Returns the result of the \fI-command\fR, or the empty
+string if no \fI-command\fR is specified.
+.\" Missing: select, deselect. Useful?
+.\" Missing: flash. This is definitely not useful.
+.SH "WIDGET STATES"
+The widget does not respond to user input if the \fBdisabled\fP state is set.
+The widget sets the \fBselected\fP state whenever
+the linked \fB-variable\fP is set to the widget's \fB-value\fP,
+and clears it otherwise.
+The widget sets the \fBalternate\fP state whenever the
+linked \fB-variable\fP is unset.
+(The \fBalternate\fP state may be used to indicate a ``tri-state''
+or ``indeterminate'' selection.)
+.SH "SEE ALSO"
+widget(n), keynav(n), checkbutton(n)
+.SH "KEYWORDS"
+widget, button, option
diff --git a/doc/ttk_scrollbar.n b/doc/ttk_scrollbar.n
new file mode 100644
index 0000000..4593140
--- /dev/null
+++ b/doc/ttk_scrollbar.n
@@ -0,0 +1,160 @@
+'\"
+'\" SOURCE: tk/doc/scrollbar.n, r1.4
+'\"
+'\" Copyright (c) 1990-1994 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2004 Joe English
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" $Id: ttk_scrollbar.n,v 1.1 2006/10/31 01:42:25 hobbs Exp $
+'\"
+.so man.macros
+.TH ttk_scrollbar n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::scrollbar \- Control the viewport of a scrollable widget
+.SH SYNOPSIS
+\fBttk::scrollbar\fR \fIpathName \fR?\fIoptions...\fR?
+.SO
+\-class \-cursor \-style \-takefocus
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-command command Command
+A Tcl script prefix to evaluate
+to change the view in the widget associated with the scrollbar.
+Additional arguments are appended to the value of this option,
+as described in \fBSCROLLING COMMANDS\fP below,
+whenever the user requests a view change by manipulating the scrollbar.
+.br
+This option typically consists of a two-element list,
+containing the name of a scrollable widget followed by
+either \fBxview\fP (for horizontal scrollbars)
+or \fByview\fP (for vertical scrollbars).
+.OP \-orient orient Orient
+One of \fBhorizontal\fP or \fBvertical\fP.
+Specifies the orientation of the scrollbar.
+.BE
+
+.SH DESCRIPTION
+Scrollbar widgets are typically linked to an associated window
+that displays a document of some sort,
+such as a file being edited or a drawing.
+A scrollbar displays a \fIthumb\fR in the
+middle portion of the scrollbar,
+whose position and size provides information
+about the portion of the document visible in
+the associated window.
+The thumb may be dragged by the user to control the
+visible region.
+Depending on the theme, two or more arrow buttons may also be present;
+these are used to scroll the visible region in discrete units.
+.SH "WIDGET COMMAND"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the specified \fIoption\fP; see \fIwidget(n)\fP.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Modify or query widget options; see \fIwidget(n)\fP.
+.TP
+\fIpathName \fBget\fR
+Returns the scrollbar settings in the form of a list whose
+elements are the arguments to the most recent \fBset\fR widget command.
+.TP
+\fIpathName \fBinstate \fIstatespec\fR ?\fIscript\fR?
+Test the widget state; see \fIwidget(n)\fP.
+.TP
+\fIpathName \fBset\fR \fIfirst last\fR
+This command is normally invoked by the scrollbar's associated widget
+from an \fB-xscrollcommand\fP or \fB-yscrollcommand\fP callback.
+Specifies the visible range to be displayed.
+\fIfirst\fR and \fIlast\fR are real fractions between 0 and 1.
+.TP
+\fIpathName \fBstate\fR ?\fIstateSpec\fR?
+Modify or query the widget state; see \fIwidget(n)\fP.
+.SH "INTERNAL COMMANDS"
+The following widget commands are used internally
+by the TScrollbar widget class bindings.
+.TP
+\fIpathName \fBdelta \fIdeltaX deltaY\fR
+Returns a real number indicating the fractional change in
+the scrollbar setting that corresponds to a given change
+in thumb position. For example, if the scrollbar is horizontal,
+the result indicates how much the scrollbar setting must change
+to move the thumb \fIdeltaX\fR pixels to the right (\fIdeltaY\fR is
+ignored in this case).
+If the scrollbar is vertical, the result indicates how much the
+scrollbar setting must change to move the thumb \fIdeltaY\fR pixels
+down. The arguments and the result may be zero or negative.
+.TP
+\fIpathName \fBfraction \fIx y\fR
+Returns a real number between 0 and 1 indicating where the point
+given by \fIx\fR and \fIy\fR lies in the trough area of the scrollbar,
+where 0.0 corresponds to the top or left of the trough
+and 1.0 corresponds to the bottom or right.
+\fIX\fR and \fIy\fR are pixel coordinates relative to the scrollbar
+widget.
+If \fIx\fR and \fIy\fR refer to a point outside the trough, the closest
+point in the trough is used.
+.TP
+\fIpathName \fBidentify\fR \fIx y\fR
+Returns the name of the element under the point given
+by \fIx\fR and \fIy\fR, or an empty string if the point does
+not lie in any element of the scrollbar.
+\fIX\fR and \fIy\fR are pixel coordinates relative to the scrollbar widget.
+.SH "SCROLLING COMMANDS"
+When the user interacts with the scrollbar, for example by dragging
+the thumb, the scrollbar notifies the associated widget that it
+must change its view.
+The scrollbar makes the notification by evaluating a Tcl command
+generated from the scrollbar's \fB\-command\fR option.
+The command may take any of the following forms.
+In each case, \fIprefix\fR is the contents of the
+\fB\-command\fR option, which usually has a form like \fB.t yview\fR
+.TP
+\fIprefix \fBmoveto \fIfraction\fR
+\fIFraction\fR is a real number between 0 and 1.
+The widget should adjust its view so that the point given
+by \fIfraction\fR appears at the beginning of the widget.
+If \fIfraction\fR is 0 it refers to the beginning of the
+document. 1.0 refers to the end of the document, 0.333
+refers to a point one-third of the way through the document,
+and so on.
+.TP
+\fIprefix \fBscroll \fInumber \fBunits\fR
+The widget should adjust its view by \fInumber\fR units.
+The units are defined in whatever way makes sense for the widget,
+such as characters or lines in a text widget.
+\fINumber\fR is either 1, which means one unit should scroll off
+the top or left of the window, or \-1, which means that one unit
+should scroll off the bottom or right of the window.
+.TP
+\fIprefix \fBscroll \fInumber \fBpages\fR
+The widget should adjust its view by \fInumber\fR pages.
+It is up to the widget to define the meaning of a page; typically
+it is slightly less than what fits in the window, so that there
+is a slight overlap between the old and new views.
+\fINumber\fR is either 1, which means the next page should
+become visible, or \-1, which means that the previous page should
+become visible.
+.SH "WIDGET STATES"
+The scrollbar automatically sets the \fBdisabled\fP state bit.
+when the entire range is visible (range is 0.0 to 1.0),
+and clears it otherwise.
+It also sets the \fBactive\fP and \fBpressed\fP state flags
+of individual elements, based on the position and state of the mouse pointer.
+.SH EXAMPLE
+.CS
+set f [frame .f]
+ttk::scrollbar $f.hsb -orient horizontal -command [list $f.t xview]
+ttk::scrollbar $f.vsb -orient vertical -command [list $f.t yview]
+text $f.t -xscrollcommand [list $f.hsb set] -yscrollcommand [list $f.vsb set]
+grid $f.t -row 0 -column 0 -sticky nsew
+grid $f.vsb -row 0 -column 1 -sticky nsew
+grid $f.hsb -row 1 -column 0 -sticky nsew
+grid columnconfigure $f 0 -weight 1
+grid rowconfigure $f 0 -weight 1
+.CE
+.SH KEYWORDS
+scrollbar, widget
diff --git a/doc/ttk_separator.n b/doc/ttk_separator.n
new file mode 100644
index 0000000..4a6a3b4
--- /dev/null
+++ b/doc/ttk_separator.n
@@ -0,0 +1,30 @@
+'\" $Id: ttk_separator.n,v 1.1 2006/10/31 01:42:25 hobbs Exp $
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_separator n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::separator \- Separator bar
+.SH SYNOPSIS
+\fBttk::separator\fR \fIpathName \fR?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+A \fBseparator\fP widget displays a horizontal or vertical separator bar.
+.SO
+\-class \-cursor \-state \-style
+\-takefocus
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-orient orient Orient
+One of \fBhorizontal\fP or \fBvertical\fP.
+Specifies the orientation of the separator.
+.SH "WIDGET COMMAND"
+Separator widgets support the standard
+\fBcget\fR, \fBconfigure\fR, \fBinstate\fR, and \fBstate\fR
+methods. No other widget methods are used.
+.SH "SEE ALSO"
+widget(n)
+.SH "KEYWORDS"
+widget, separator
diff --git a/doc/ttk_sizegrip.n b/doc/ttk_sizegrip.n
new file mode 100644
index 0000000..3735f11
--- /dev/null
+++ b/doc/ttk_sizegrip.n
@@ -0,0 +1,53 @@
+'\" $Id: ttk_sizegrip.n,v 1.1 2006/10/31 01:42:25 hobbs Exp $
+'\"
+'\" Copyright (c) 2006 Joe English
+'\"
+.so man.macros
+.TH ttk_sizegrip n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::sizegrip \- A silly widget
+.SH SYNOPSIS
+\fBttk::sizegrip\fR \fIpathName \fR?\fIoptions\fR?
+.BE
+.SH DESCRIPTION
+A \fBsizegrip\fP widget (also known as a \fIgrow box\fR)
+allows the user to resize the containing toplevel window
+by pressing and dragging the grip.
+.SO
+\-class \-cursor \-state \-style
+\-takefocus
+.SE
+.SH "WIDGET COMMAND"
+Sizegrip widgets support the standard
+\fBcget\fR, \fBconfigure\fR, \fBinstate\fR, and \fBstate\fR
+methods. No other widget methods are used.
+.SH "PLATFORM-SPECIFIC NOTES"
+On Mac OSX, toplevel windows automatically include a built-in
+size grip by default.
+Adding an \fBttk::sizegrip\fP there is harmless, since
+the built-in grip will just mask the widget.
+.SH EXAMPLES
+.CS
+# Using pack:
+pack [ttk::frame $top.statusbar] -side bottom -fill x
+pack [ttk::sizegrip $top.statusbar.grip -side right -anchor se]
+
+# Using grid:
+grid [ttk::sizegrip $top.statusbar.grip] \
+ -row $lastRow -column $lastColumn -sticky se
+# ... optional: add vertical scrollbar in $lastColumn,
+# ... optional: add horizontal scrollbar in $lastRow
+.CE
+.SH "BUGS"
+If the containing toplevel's position was specified
+relative to the right or bottom of the sceen
+(e.g., \fB[wm geometry ... \fIw\fBx\fIh\fB-\fIx\fB-\fIy\fB]\fR
+instead of \fB[wm geometry ... \fIw\fBx\fIh\fB+\fIx\fB+\fIy\fB]\fR),
+the sizegrip widget will not resize the window.
+.PP
+ttk::sizegrip widgets only support "southeast" resizing.
+.SH "SEE ALSO"
+widget(n)
+.SH "KEYWORDS"
+widget, sizegrip, grow box
diff --git a/doc/ttk_style.n b/doc/ttk_style.n
new file mode 100644
index 0000000..9b57bf8
--- /dev/null
+++ b/doc/ttk_style.n
@@ -0,0 +1,121 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\" $Id: ttk_style.n,v 1.1 2006/10/31 01:42:25 hobbs Exp $
+'\"
+.so man.macros
+.TH ttk_style n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+ttk::style \- Control overall look and feel of widgets
+.SH SYNOPSIS
+\fBttk::style\fR \fIoption\fR ?\fIargs\fR?
+.BE
+.SH NOTES
+.PP
+This manpage has not been written yet.
+Please see the Tcl'2004 conference presentation,
+available at http://tktable.sourceforge.net/tile/tile-tcl2004.pdf
+
+.SH DEFINITIONS
+.PP
+Each widget is assigned a \fIstyle\fR,
+which specifies the set of elements making up the widget
+and how they are arranged, along with dynamic and default
+settings for element resources.
+By default, the style name is the same as the widget's class;
+this may be overridden by the \fB-style\fP option.
+.PP
+A \fItheme\fR is a collection of elements and styles
+which controls the overall look and feel of an application.
+.SH DESCRIPTION
+The \fBttk::style\fR command takes the following arguments:
+.TP
+\fBttk::style configure \fIstyle\fR ?\fI-option \fR?\fIvalue option value...\fR? ?
+Sets the default value of the specified option(s) in \fIstyle\fR.
+.TP
+\fBttk::style map \fIstyle\fR ?\fI-option\fR { \fIstatespec value\fR } ... ?
+Sets dynamic values of the specified option(s) in \fIstyle\fR.
+Each \fIstatespec / value\fR pair is examined in order;
+the value corresponding to the first matching \fIstatespec\fP
+is used.
+.TP
+\fBttk::style lookup \fIstyle\fR \fI-option \fR?\fIstate \fR?\fIdefault\fR??
+Returns the value specified for \fI-option\fP in style \fIstyle\fP
+in state \fIstate\fP, using the standard lookup rules for element options.
+\fIstate\fR is a list of state names; if omitted,
+it defaults to all bits off (the ``normal'' state).
+If the \fIdefault\fP argument is present, it is used as a fallback
+value in case no specification for \fI-option\fP is found.
+.\" Otherwise -- signal error? return empty string? Leave unspecified for now.
+.TP
+\fBttk::style layout \fIstyle\fR ?\fIlayoutSpec\fR?
+Define the widget layout for style \fIstyle\fR.
+See "\fBLAYOUTS\fR" below for the format of \fIlayoutSpec\fR.
+If \fIlayoutSpec\fR is omitted, return the layout specification
+for style \fIstyle\fR.
+.TP
+\fBttk::style element create\fR \fIelementName\fR \fItype\fR ?\fIargs...\fR?
+Creates a new element in the current theme of type \fItype\fR.
+The only built-in element type is \fIimage\fR (see \fIimage(n)\fR),
+although themes may define other element types
+(see \fBTtk_RegisterElementFactory\fR).
+.TP
+\fBttk::style element names\fR
+Returns the list of elements defined in the current theme.
+.TP
+\fBttk::style element options \fIelement\fR
+Returns the list of \fIelement\fR's options.
+.TP
+\fBttk::style theme create\fR \fIthemeName\fR ?\fB-parent \fIbasedon\fR? ?\fB-settings \fIscript...\fR ?
+Creates a new theme. It is an error if \fIthemeName\fR already exists.
+If \fI-parent\fR is specified, the new theme will inherit
+styles, elements, and layouts from the parent theme \fIbasedon\fB.
+If \fI-settings\fR is present, \fIscript\fP is evaluated in the
+context of the new theme as per \fBttk::style theme settings\fP.
+.TP
+\fBttk::style theme settings \fIthemeName\fP \fIscript\fP
+Temporarily sets the current theme to \fIthemeName\fR,
+evaluate \fIscript\fR, then restore the previous theme.
+Typically \fIscript\fP simply defines styles and elements,
+though arbitrary Tcl code may appear.
+.TP
+\fBttk::style theme names\fR
+Returns a list of the available themes.
+.TP
+\fBttk::style theme use\fR \fIthemeName\fR
+Sets the current theme to \fIthemeName\fR, and refreshes all widgets.
+
+.SH LAYOUTS
+A \fIlayout\fP specifies a list of elements, each followed
+by one or more options specifying how to arrange the element.
+The layout mechanism uses a simplified version of the \fBpack\fP
+geometry manager: given an initial cavity,
+each element is allocated a parcel.
+Valid options are:
+.TP
+\fB-side \fIside\fR
+Specifies which side of the cavity to place the element;
+one of \fBleft\fP, \fBright\fP, \fBtop\fP, or \fBbottom\fP.
+If omitted, the element occupies the entire cavity.
+.TP
+\fB-sticky \fI[nswe]\fR
+Specifies where the element is placed inside its allocated parcel.
+.TP
+\fB-children \fI{ sublayout... }\fR
+Specifies a list of elements to place inside the element.
+.\" Also: -border, -unit, -expand: may go away.
+.PP
+For example:
+.CS
+ttk::style layout Horizontal.TScrollbar {
+ Scrollbar.trough -children {
+ Scrollbar.leftarrow -side left
+ Scrollbar.rightarrow -side right
+ Horizontal.Scrollbar.thumb -side left -sticky ew
+ }
+}
+.CE
+.SH "SEE ALSO"
+ttk_intro(n), ttk_widget(n), pixmap
+.SH KEYWORDS
+style, theme, appearance
diff --git a/doc/ttk_treeview.n b/doc/ttk_treeview.n
new file mode 100644
index 0000000..c24b7f8
--- /dev/null
+++ b/doc/ttk_treeview.n
@@ -0,0 +1,401 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\"
+.so man.macros
+.TH ttk_treeview n 8.5 Tk "Tk Themed Widget"
+.SH NAME
+ttk::treeview \- hierarchical multicolumn data display widget
+.SH SYNOPSIS
+\fBttk::treeview\fR \fIpathname \fR?\fIoptions\fR?
+.SH "DESCRIPTION"
+The treeview widget displays a hierarchical collection of items.
+Each item has a textual label, an optional image,
+and an optional list of data values.
+The data values are displayed in successive columns after
+the tree label.
+.PP
+The order in which data values are displayed may be controlled
+by setting the \fB-displaycolumns\fR widget option.
+The tree widget can also display column headings.
+Columns may be accessed by number or by symbolic names
+listed in the \fB-columns\fR widget option;
+see \fBCOLUMN IDENTIFIERS\fR.
+.PP
+Each item is identified by a unique name.
+The widget will generate item IDs if they are not supplied by the caller.
+There is a distinguished root item, named \fB{}\fR.
+The root item itself is not displayed;
+its children appear at the top level of the hierarchy.
+.PP
+Each item also has a list of \fItags\fR,
+which can be used to associate event bindings with individual items
+and control the appearance of the item.
+.\" .PP
+.\" @@@HERE: describe selection, focus item
+.PP
+Treeview widgets support vertical scrolling with the
+standard \fB-yscrollcommand\fR option and \fByview\fR widget command.
+They probably ought to support horizontal scrolling as well.
+.SO
+\-class \-cursor \-takefocus \-style
+\-yscrollcommand
+.SE
+.SH "WIDGET OPTIONS"
+.OP \-columns columns Columns
+A list of column identifiers,
+specifying the number of columns and their names.
+.\"X: This is a read-only option; it may only be set when the widget is created.
+.OP \-displaycolumns displayColumns DisplayColumns
+A list of column identifiers
+(either symbolic names or integer indices)
+specifying which data columns are displayed
+and the order in which they appear.
+.br
+If empty (the default), all columns are shown in the order given.
+.OP \-height height Height
+Specifies the number of rows which should be visible.
+Note:
+the requested width is determined from the sum of the column widths.
+.OP \-padding padding Padding
+Specifies the internal padding for the widget.
+The padding is a list of up to four length specifications;
+see \fBTtk_GetPaddingFromObj()\fR for details.
+.OP \-selectmode selectMode SelectMode
+Controls how the built-in class bindings manage the selection.
+One of \fBextended\fR, \fBbrowse\fR, or \fBnone\fR.
+.br
+If set to \fBextended\fR (the default), multiple items may be selected.
+If \fBbrowse\fR, only a single item will be selected at a time.
+If \fBnone\fR, the selection will not be changed.
+.br
+Note that application code and tag bindings can set the selection
+however they wish, regardless of the value of \fB-selectmode\fR.
+.OP \-show show Show
+A list containing zero or more of the following values, specifying
+which elements of the tree to display.
+.RS
+.IP \fBtree\fR
+Display tree labels in column #0.
+.IP \fBheadings\fR
+Display the heading row.
+.PP
+The default is \fBtree headings\fR, i.e., show all elements.
+.PP
+\fBNOTE:\fR Column #0 always refers to the tree column,
+even if \fB-show tree\fR is not specified.
+.RE
+.SH "WIDGET COMMAND"
+.TP
+\fIpathname \fBbbox\fR \fIitem\fR ?\fIcolumn\fR?
+Returns the bounding box (relative to the treeview widget's window)
+of the specified \fIitem\fR
+in the form \fIx y width height\fR.
+If \fIcolumn\fR is specified, returns the bounding box of that cell.
+If the \fIitem\fR is not visible
+(i.e., if it is a descendant of a closed item or is scrolled offscreen),
+returns the empty list.
+.TP
+\fIpathname \fBcget\fR \fIoption\fR
+Returns the current value of the specified \fIoption\fR; see \fIwidget(n)\fR.
+.TP
+\fIpathname \fBchildren\fR \fIitem\fR ?\fInewchildren\fR?
+If \fInewchildren\fR is not specified,
+returns the list of children belonging to \fIitem\fR.
+.br
+If \fInewchildren\fR is specified, replaces \fIitem\fR's child list
+with \fInewchildren\fR.
+Items in the old child list not present in the new child list
+are detached from the tree.
+None of the items in \fInewchildren\fR may be an ancestor
+of \fIitem\fR.
+.TP
+\fIpathname \fBcolumn\fR \fIcolumn\fR ?\fI-option \fR?\fIvalue -option value...\fR?
+Query or modify the options for the specified \fIcolumn\fR.
+If no \fI-option\fR is specified,
+returns a dictionary of option/value pairs.
+If a single \fI-option\fR is specified,
+returns the value of that option.
+Otherwise, the options are updated with the specified values.
+The following options may be set on each column:
+.RS
+.TP
+\fB-id \fIname\fR
+The column name. This is a read-only option.
+For example, [\fI$pathname \fBcolumn #\fIn \fB-id\fR]
+returns the data column associated with data column #\fIn\fR.
+.TP
+\fB-anchor\fR
+Specifies how the text in this column should be aligned
+with respect to the cell. One of
+\fBn\fR, \fBne\fR, \fBe\fR, \fBse\fR,
+\fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR.
+.TP
+\fB-width \fIw\fR
+The width of the column in pixels. Default is something reasonable,
+probably 200 or so.
+.PP
+Use \fIpathname column #0\fR to configure the tree column.
+.RE
+.TP
+\fIpathname \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Modify or query widget options; see \fIwidget(n)\fR.
+.TP
+\fIpathname \fBdelete\fR \fIitemList\fR
+Deletes each of the items in \fIitemList\fR and all of their descendants.
+The root item may not be deleted.
+See also: \fBdetach\fR.
+.TP
+\fIpathname \fBdetach\fR \fIitemList\fR
+Unlinks all of the specified items in \fIitemList\fR from the tree.
+The items and all of their descendants are still present
+and may be reinserted at another point in the tree
+but will not be displayed.
+The root item may not be detached.
+See also: \fBdelete\fR.
+.TP
+\fIpathname \fBexists \fIitem\fR
+Returns 1 if the specified \fIitem\fR is present in the tree,
+0 otherwise.
+.TP
+\fIpathname \fBfocus \fR?\fIitem\fR?
+If \fIitem\fR is specified, sets the focus item to \fIitem\fR.
+Otherwise, returns the current focus item, or \fB{}\fR if there is none.
+.\" Need: way to clear the focus item. {} works for this...
+.TP
+\fIpathname \fBheading\fR \fIcolumn\fR ?\fI-option \fR?\fIvalue -option value...\fR?
+Query or modify the heading options for the specified \fIcolumn\fR.
+Valid options are:
+.RS
+.TP
+\fB-text \fItext\fR
+The text to display in the column heading.
+.TP
+\fB-image \fIimageName\fR
+Specifies an image to display to the right of the column heading.
+.TP
+\fB-anchor \fIanchor\fR
+Specifies how the heading text should be aligned.
+One of the standard Tk anchor values.
+.TP
+\fB-command \fIscript\fR
+A script to evaluate when the heading label is pressed.
+.PP
+Use \fIpathname heading #0\fR to configure the tree column heading.
+.RE
+.TP
+\fIpathname \fBidentify \fIcomponent x y\fR
+Returns a description of the specified \fIcomponent\fR
+under the point given by \fIx\fR and \fIy\fR,
+or the empty string if no such \fIcomponent\fR is present at that position.
+The following subcommands are supported:
+.RS
+.TP
+\fIpathname \fBidentify row\fR \fIx y\fR
+Returns the item ID of the item at position \fIy\fR.
+.TP
+\fIpathname \fBidentify column\fR \fIx y\fR
+Returns the data column identifier of the cell at position \fIx\fR.
+The tree column has ID \fB#0\fR.
+.PP
+See \fBCOLUMN IDENTIFIERS\fR for a discussion of display columns
+and data columns.
+.RE
+.TP
+\fIpathname \fBindex \fIitem\fR
+Returns the integer index of \fIitem\fR within its parent's list of children.
+.TP
+\fIpathname \fBinsert\fR \fIparent\fR \fIindex\fR ?\fB-id \fIid\fR? \fIoptions...\fR
+Creates a new item.
+\fIparent\fR is the item ID of the parent item,
+or the empty string \fB{}\fR
+to create a new top-level item.
+\fIindex\fR is an integer, or the value \fBend\fR, specifying where in the
+list of \fIparent\fR's children to insert the new item.
+If \fIindex\fR is less than or equal to zero,
+the new node is inserted at the beginning;
+if \fIindex\fR is greater than or equal to the current number of children,
+it is inserted at the end.
+If \fB-id\fR is specified, it is used as the item identifier;
+\fIid\fR must not already exist in the tree.
+Otherwise, a new unique identifier is generated.
+.br
+\fIpathname \fBinsert\fR returns the item identifier of the
+newly created item.
+See \fBITEM OPTIONS\fR for the list of available options.
+.TP
+\fIpathname \fBinstate \fIstatespec\fR ?\fIscript\fR?
+Test the widget state; see \fIwidget(n)\fR.
+.TP
+\fIpathname \fBitem\fR \fIitem\fR ?\fI-option \fR?\fIvalue -option value...\fR?
+Query or modify the options for the specified \fIitem\fR.
+If no \fI-option\fR is specified,
+returns a dictionary of option/value pairs.
+If a single \fI-option\fR is specified,
+returns the value of that option.
+Otherwise, the item's options are updated with the specified values.
+See \fBITEM OPTIONS\fR for the list of available options.
+.TP
+\fIpathname \fBmove \fIitem parent index\fR
+Moves \fIitem\fR to position \fIindex\fR in \fIparent\fR's list of children.
+It is illegal to move an item under one of its descendants.
+.br
+If \fIindex\fR is less than or equal to zero, \fIitem\fR is moved
+to the beginning; if greater than or equal to the number of children,
+it's moved to the end.
+.TP
+\fIpathname \fBnext \fIitem\fR
+Returns the identifier of \fIitem\fR's next sibling,
+or \fB{}\fR if \fIitem\fR is the last child of its parent.
+.TP
+\fIpathname \fBparent \fIitem\fR
+Returns the ID of the parent of \fIitem\fR,
+or \fB{}\fR if \fIitem\fR is at the top level of the hierarchy.
+.TP
+\fIpathname \fBprev \fIitem\fR
+Returns the identifier of \fIitem\fR's previous sibling,
+or \fB{}\fR if \fIitem\fR is the first child of its parent.
+.TP
+\fIpathname \fBsee\fR \fIitem\fR
+Ensure that \fIitem\fR is visible:
+sets all of \fIitem\fR's ancestors to \fB-open true\fR,
+and scrolls the widget if necessary so that \fIitem\fR is
+within the visible portion of the tree.
+.TP
+\fIpathname \fBselection\fR ?\fIselop\fR \fIitemList\fR?
+If \fIselop\fR is not specified, returns the list of selected items.
+Otherwise, \fIselop\fR is one of the following:
+.RS
+.TP
+\fIpathname \fBselection set \fIitemList\fR
+\fIitemList\fR becomes the new selection.
+.TP
+\fIpathname \fBselection add \fIitemList\fR
+Add \fIitemList\fR to the selection
+.TP
+\fIpathname \fBselection remove \fIitemList\fR
+Remove \fIitemList\fR from the selection
+.TP
+\fIpathname \fBselection toggle \fIitemList\fR
+Toggle the selection state of each item in \fIitemList\fR.
+.RE
+.TP
+\fIpathname \fBset\fR \fIitem\fR ?\fIcolumn\fR ?\fIvalue\fR??
+With one argument, returns a dictionary of column/value pairs
+for the specified \fIitem\fR.
+With two arguments, returns the current value of the specified \fIcolumn\fR.
+With three arguments, sets the value of column \fIcolumn\fR
+in item \fIitem\fR to the specified \fIvalue\fR.
+See also \fBCOLUMN IDENTIFIERS\fR.
+.TP
+\fIpathname \fBstate\fR ?\fIstateSpec\fR?
+Modify or query the widget state; see \fIwidget(n)\fR.
+.TP
+\fIpathName \fBtag \fIargs...\fR
+.RS
+.TP
+\fIpathName \fBtag bind \fItagName \fR?\fIsequence \fR?\fIscript\fR??
+Add a Tk binding script for the event sequence \fIsequence\fR
+to the tag \fItagName\fR. When an X event is delivered to an item,
+binding scripts for each of the item's \fB-tags\fR are evaluated
+in order as per \fIbindtags(n)\fR.
+.br
+\fB<KeyPress>\fR, \fB<KeyRelease>\fR, and virtual events
+are sent to the focus item.
+\fB<ButtonPress>\fR, \fB<ButtonRelease>\fR, and \fB<Motion>\fR events
+are sent to the item under the mouse pointer.
+No other event types are supported.
+.br
+The binding \fIscript\fR undergoes \fB%\fR-substitutions before
+evaluation; see \fBbind(n)\fR for details.
+.TP
+\fIpathName \fBtag configure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the options for the specified \fItagName\fR.
+If one or more \fIoption/value\fR pairs are specified,
+sets the value of those options for the specified tag.
+If a single \fIoption\fR is specified,
+returns the value of that option
+(or the empty string if the option has not been specified for \fItagName\fR).
+With no additional arguments,
+returns a dictionary of the option settings for \fItagName\fR.
+See \fBTAG OPTIONS\fR for the list of available options.
+.RE
+.TP
+\fIpathName \fByview \fIargs\fR
+Standard command for vertical scrolling; see \fIwidget(n)\fR.
+
+.PP
+.SH "ITEM OPTIONS"
+The following item options may be specified for items
+in the \fBinsert\fR and \fBitem\fR widget commands.
+.OP \-text text Text
+The textual label to display for the item.
+.OP \-image image Image
+A Tk image, displayed to the left of the label.
+.OP \-values values Values
+The list of values associated with the item.
+.br
+Each item should have the same number of values as
+the \fB-columns\fR widget option.
+If there are fewer values than columns,
+the remaining values are assumed empty.
+If there are more values than columns,
+the extra values are ignored.
+.OP \-open open Open
+A boolean value indicating whether the items's children
+should be displayed (\fB-open true\fR) or hidden (\fB-open false\fR).
+.OP \-tags tags Tags
+A list of tags associated with this item.
+.SH "TAG OPTIONS"
+The following options may be specified on tags:
+.IP \-foreground
+Specifies the text foreground color.
+.IP \-background
+Specifies the cell or item background color.
+.IP \-font
+Specifies the font to use when drawing text.
+.\" ??? Maybe: .IP \-anchor
+.\" ??? Maybe: .IP \-padding
+.\" ??? Maybe: .IP \-text
+.IP \-image
+Specifies the item image, in case the item's \fB-image\fR option is empty.
+.PP
+\fI(@@@ TODO: sort out order of precedence for options)\fR
+.SH "COLUMN IDENTIFIERS"
+Column identifiers take any of the following forms:
+.IP \(bu
+A symbolic name from the list of \fB-columns\fR.
+.IP \(bu
+An integer \fIn\fR, specifying the \fIn\fRth data column.
+.IP \(bu
+A string of the form \fB#\fIn\fR, where \fIn\fR is an integer,
+specifying the \fIn\fRth display column.
+.PP
+\fBNOTE:\fR
+Item \fB-values\fR may be displayed in a different order than
+the order in which they are stored.
+.PP
+\fBNOTE:\fR Column #0 always refers to the tree column,
+even if \fB-show tree\fR is not specified.
+.PP
+A \fIdata column number\fR is an index into an item's \fB-values\fR list;
+a \fIdisplay column number\fR is the column number in the tree
+where the values are displayed.
+Tree labels are displayed in column #0.
+If \fB-displaycolumns\fR is not set,
+then data column \fIn\fR is displayed in display column \fB#\fIn+1\fR.
+Again, \fBcolumn #0 always refers to the tree column\fR.
+.SH "VIRTUAL EVENTS"
+The treeview widget generates the following virtual events.
+.IP <<TreeviewSelect>>
+Generated whenever the selection changes.
+.IP <<TreeviewOpen>>
+Generated just before setting the focus item to \fB-open true\fR.
+.IP <<TreeviewClose>>
+Generated just after setting the focus item to \fB-open false\fR.
+.PP
+The \fBfocus\fR and \fBselection\fR widget commands can be used
+to determine the affected item or items.
+In Tk 8.5, the affected item is also passed as the \fB-detail\fR field
+of the virtual event.
+.SH "SEE ALSO"
+widget(n), listbox(n), image(n), bind(n)
diff --git a/doc/ttk_widget.n b/doc/ttk_widget.n
new file mode 100644
index 0000000..1d7de13
--- /dev/null
+++ b/doc/ttk_widget.n
@@ -0,0 +1,224 @@
+'\"
+'\" Copyright (c) 2004 Joe English
+'\" $Id: ttk_widget.n,v 1.1 2006/10/31 01:42:25 hobbs Exp $
+'\"
+.so man.macros
+.TH ttk_widget n 8.5 Tk "Tk Themed Widget"
+.BS
+.SH NAME
+widget \- Standard options and commands supported by Tk themed widgets
+.BE
+.SH DESCRIPTION
+This manual describes common widget options and commands.
+.SH "STANDARD OPTIONS"
+The following options are supported by all Tk themed widgets:
+.OP \-class undefined undefined
+Specifies the window class.
+The class is used when querying the option database
+for the window's other options, to determine the default
+bindtags for the window, and to select the widget's default
+layout and style.
+This is a read-only option:
+it may only be specified when the window is created,
+and may not be changed with the \fBconfigure\fR widget command.
+.OP \-cursor cursor Cursor
+Specifies the mouse cursor to be used for the widget.
+See \fBTk_GetCursor\fR and \fIcursors(n)\fR in the Tk reference manual
+for the legal values.
+If set to the empty string (the default),
+the cursor is inherited from the parent widget.
+.OP \-takefocus takeFocus TakeFocus
+Determines whether the window accepts the focus during keyboard traversal.
+Either \fB0\fR, \fB1\fR, a command prefix (to which the widget path
+is appended, and which should return \fB0\fR or \fB1\fR),
+or the empty string.
+See \fIoptions(n)\fR in the Tk reference manual for the full description.
+.OP \-style style Style
+May be used to specify a custom widget style.
+.SH "SCROLLABLE WIDGET OPTIONS"
+.PP
+The following options are supported by widgets that
+are controllable by a scrollbar.
+See \fIscrollbar(n)\fP for more information
+.OP \-xscrollcommand xScrollCommand ScrollCommand
+A command prefix, used to communicate with horizontal scrollbars.
+.br
+When the view in the widget's window changes, the widget will
+generate a Tcl command by concatenating the scroll command and
+two numbers.
+Each of the numbers is a fraction between 0 and 1 indicating
+a position in the document; 0 indicates the beginning,
+and 1 indicates the end.
+The first fraction indicates the first information in the widget
+that is visible in the window, and the second fraction indicates
+the information just after the last portion that is visible.
+.br
+Typically the \fBxScrollCommand\fR option consists of the path name
+of a \fBscrollbar\fP widget followed by ``set'', e.g. ``.x.scrollbar set''.
+This will cause the scrollbar to be updated whenever the view in the
+window changes.
+.br
+If this option is set to the empty string (the default),
+then no command is be executed.
+.OP \-yscrollcommand yScrollCommand ScrollCommand
+A command prefix, used to communicate with vertical scrollbars.
+See the description of \fB-xscrollcommand\fP above for details.
+.SH "LABEL OPTIONS"
+The following options are supported by labels, buttons,
+and other button-like widgets:
+.OP \-text text Text
+Specifies a text string to be displayed inside the widget
+(unless overridden by \fB-textvariable\fR).
+.OP \-textvariable textVariable Variable
+Specifies the name of variable whose value will be used
+in place of the \fB-text\fP resource.
+.OP \-underline underline Underline
+If set, specifies the integer index (0-based) of a character to underline
+in the text string.
+The underlined character is used for mnemonic activation
+(see \fIkeynav(n)\fR).
+.OP \-image image Image
+Specifies an image to display.
+This is a list of 1 or more elements.
+The first element is the default image name.
+The rest of the list is a sequence of \fIstatespec / value\fR pairs
+as per \fBstyle map\fR, specifying different images to use when
+the widget is in a particular state or combination of states.
+All images in the list should have the same size.
+.OP \-compound compound Compound
+Specifies how to display the image relative to the text,
+in the case both \fB-text\fR and \fB-image\fR are present.
+Valid values are:
+.RS
+.IP text
+Display text only.
+.IP image
+Display image only.
+.IP center
+Display text centered on top of image.
+.IP top
+.IP bottom
+.IP left
+.IP right
+Display image above, below, left of, or right of the text, respectively.
+.IP none
+The default; display the image if present, otherwise the text.
+.RE
+.OP \-width width Width
+If greater than zero, specifies how much space, in character widths,
+to allocate for the text label.
+If less than zero, specifies a minimum width.
+If zero or unspecified, the natural width of the text label is used.
+
+.SH "COMPATIBILITY OPTIONS"
+.OP \-state state State
+May be set to \fBnormal\fP or \fBdisabled\fP
+to control the \fBdisabled\fP state bit.
+This is a ``write-only'' option: setting it changes the
+widget state, but the \fBstate\fP widget command does
+not affect the state option.
+
+.SH COMMANDS
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If one or more \fIoption\-value\fR pairs are specified,
+then the command modifies the given widget option(s)
+to have the given value(s);
+in this case the command returns an empty string.
+If \fIoption\fR is specified with no \fIvalue\fR,
+then the command returns a list describing the named option:
+the elements of the list are the
+option name, database name, database class, default value,
+and current value.
+.\" Note: Ttk widgets don't use TK_OPTION_SYNONYM.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR.
+.TP
+\fIpathName \fBinstate\fR \fIstatespec\fR ?\fIscript\fR?
+Test the widget's state.
+If \fIscript\fR is not specified, returns 1 if
+the widget state matches \fIstatespec\fR and 0 otherwise.
+If \fIscript\fR is specified, equivalent to
+.CS
+if {[\fIpathName\fR instate \fIstateSpec\fR]} \fIscript\fR
+.CE
+.TP
+\fIpathName \fBstate\fR ?\fIstateSpec\fR
+Modify or inquire widget state.
+If \fIstateSpec\fR is present, sets the widget state:
+for each flag in \fIstateSpec\fR, sets the corresponding flag
+or clears it if prefixed by an exclamation point.
+Returns a new state spec indicating which flags were changed:
+.CS
+set changes [\fIpathName \fRstate \fIspec\fR]
+\fIpathName \fRstate $changes
+.CE
+will restore \fIpathName\fR to the original state.
+If \fIstateSpec\fR is not specified,
+returns a list of the currently-enabled state flags.
+.SH "WIDGET STATES"
+The widget state is a bitmap of independent state flags.
+Widget state flags include:
+.TP
+\fBactive\fR
+The mouse cursor is over the widget
+and pressing a mouse button will cause some action to occur.
+(aka "prelight" (Gnome), "hot" (Windows), "hover").
+.TP
+\fBdisabled\fR
+Widget is disabled under program control
+(aka "unavailable", "inactive")
+.TP
+\fBfocus\fR
+Widget has keyboard focus
+.TP
+\fBpressed\fR
+Widget is being pressed (aka "armed" in Motif).
+.TP
+\fBselected\fR
+"On", "true", or "current" for things like checkbuttons and radiobuttons.
+.TP
+\fBbackground\fR
+Windows and the Mac have a notion of an "active" or foreground window.
+The \fBbackground\fP state is set for widgets in a background window,
+and cleared for those in the foreground window.
+.TP
+\fBreadonly\fR
+Widget should not allow user modification.
+.TP
+\fBalternate\fR
+A widget-specific alternate display format.
+For example, used for checkbuttons and radiobuttons
+in the "tristate" or "mixed" state,
+and for buttons with \fB-default active\fP.
+.TP
+\fBinvalid\fP
+The widget's value is invalid.
+(Potential uses: scale widget value out of bounds,
+entry widget value failed validation.)
+.PP
+A \fIstate specification\fP or \fIstateSpec\fP is a list
+of state names, optionally prefixed with an exclamation point (!)
+indicating that the bit is off.
+.SH EXAMPLES
+.CS
+set b [ttk::button .b]
+
+# Disable the widget:
+$b state disabled
+
+# Invoke the widget only if it is currently pressed and enabled:
+$b instate {pressed !disabled} { .b invoke }
+
+# Reenable widget:
+$b state !disabled
+.CE
+.SH "SEE ALSO"
+ttk_intro(n), style(n)
+.SH KEYWORDS
+state, configure, option
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 3ad218e..7a5335f 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: $Id: tkInt.h,v 1.73 2006/09/06 22:39:28 hobbs Exp $
+ * RCS: $Id: tkInt.h,v 1.74 2006/10/31 01:42:25 hobbs Exp $
*/
#ifndef _TKINT
@@ -947,6 +947,12 @@ MODULE_SCOPE Tcl_HashTable tkPredefBitmapTable;
#endif
/*
+ * Themed widget set init function:
+ */
+
+MODULE_SCOPE int Ttk_Init(Tcl_Interp *interp);
+
+/*
* Internal functions shared among Tk modules but not exported to the outside
* world:
*/
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 25624f9..9558f4c 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkWindow.c,v 1.78 2006/10/08 21:47:12 patthoyts Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.79 2006/10/31 01:42:26 hobbs Exp $
*/
#include "tkPort.h"
@@ -137,7 +137,7 @@ static TkCmd commands[] = {
{"wm", NULL, Tk_WmObjCmd, 0, 1},
/*
- * Widget class commands.
+ * Default widget class commands.
*/
{"button", NULL, Tk_ButtonObjCmd, 1, 0},
@@ -159,6 +159,28 @@ static TkCmd commands[] = {
{"toplevel", NULL, Tk_ToplevelObjCmd, 0, 0},
/*
+ * Classic widget class commands.
+ */
+
+ {"::tk::button", NULL, Tk_ButtonObjCmd, 1, 0},
+ {"::tk::canvas", NULL, Tk_CanvasObjCmd, 1, 1},
+ {"::tk::checkbutton",NULL, Tk_CheckbuttonObjCmd, 1, 0},
+ {"::tk::entry", NULL, Tk_EntryObjCmd, 1, 0},
+ {"::tk::frame", NULL, Tk_FrameObjCmd, 1, 0},
+ {"::tk::label", NULL, Tk_LabelObjCmd, 1, 0},
+ {"::tk::labelframe",NULL, Tk_LabelframeObjCmd, 1, 0},
+ {"::tk::listbox", NULL, Tk_ListboxObjCmd, 1, 0},
+ {"::tk::menubutton",NULL, Tk_MenubuttonObjCmd, 1, 0},
+ {"::tk::message", NULL, Tk_MessageObjCmd, 1, 0},
+ {"::tk::panedwindow",NULL, Tk_PanedWindowObjCmd, 1, 0},
+ {"::tk::radiobutton",NULL, Tk_RadiobuttonObjCmd, 1, 0},
+ {"::tk::scale", NULL, Tk_ScaleObjCmd, 1, 0},
+ {"::tk::scrollbar", Tk_ScrollbarCmd, NULL, 1, 1},
+ {"::tk::spinbox", NULL, Tk_SpinboxObjCmd, 1, 0},
+ {"::tk::text", NULL, Tk_TextObjCmd, 1, 1},
+ {"::tk::toplevel", NULL, Tk_ToplevelObjCmd, 0, 0},
+
+ /*
* Standard dialog support. Note that the Unix/X11 platform implements
* these commands differently (via the script library).
*/
@@ -3191,6 +3213,15 @@ Initialize(interp)
Tk_InitStubs(interp, TK_VERSION, 1);
/*
+ * Initialized the themed widget set
+ */
+
+ code = Ttk_Init(interp);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ /*
* Invoke platform-specific initialization.
* Unlock mutex before entering TkpInit, as that may run through the
* Tk_Init routine again for the console window interpreter.
diff --git a/generic/ttk/ttk.decls b/generic/ttk/ttk.decls
new file mode 100644
index 0000000..64820cd
--- /dev/null
+++ b/generic/ttk/ttk.decls
@@ -0,0 +1,154 @@
+#
+# $Id: ttk.decls,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+#
+
+library ttk
+interface ttk
+epoch 0
+scspec TTKAPI
+
+declare 0 current {
+ Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *name);
+}
+declare 1 current {
+ Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp);
+}
+declare 2 current {
+ Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp);
+}
+declare 3 current {
+ Ttk_Theme Ttk_CreateTheme(
+ Tcl_Interp *interp, const char *name, Ttk_Theme parent);
+}
+declare 4 current {
+ void Ttk_RegisterCleanup(
+ Tcl_Interp *interp, void *deleteData, Ttk_CleanupProc *cleanupProc);
+}
+
+declare 5 current {
+ int Ttk_RegisterElementSpec(
+ Ttk_Theme theme,
+ const char *elementName,
+ Ttk_ElementSpec *elementSpec,
+ void *clientData);
+}
+
+declare 6 current {
+ Ttk_Element Ttk_RegisterElement(
+ Tcl_Interp *interp,
+ Ttk_Theme theme,
+ const char *elementName,
+ Ttk_ElementSpec *elementSpec,
+ void *clientData);
+}
+
+declare 7 current {
+ int Ttk_RegisterElementFactory(
+ Tcl_Interp *interp,
+ const char *name,
+ Ttk_ElementFactory factoryProc,
+ void *clientData);
+}
+
+declare 8 current {
+ void Ttk_RegisterLayout(
+ Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec);
+}
+
+#
+# State maps.
+#
+declare 10 current {
+ int Ttk_GetStateSpecFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_StateSpec *spec_rtn);
+}
+declare 11 current {
+ Tcl_Obj *Ttk_NewStateSpecObj(
+ unsigned int onbits,unsigned int offbits);
+}
+declare 12 current {
+ Ttk_StateMap Ttk_GetStateMapFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr);
+}
+declare 13 current {
+ Tcl_Obj *Ttk_StateMapLookup(
+ Tcl_Interp *interp, Ttk_StateMap map, Ttk_State state);
+}
+declare 14 current {
+ int Ttk_StateTableLookup(
+ Ttk_StateTable map[], Ttk_State state);
+}
+
+
+#
+# Low-level geometry utilities.
+#
+declare 20 current {
+ int Ttk_GetPaddingFromObj(
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tcl_Obj *objPtr,
+ Ttk_Padding *pad_rtn);
+}
+declare 21 current {
+ int Ttk_GetBorderFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Ttk_Padding *pad_rtn);
+}
+declare 22 current {
+ int Ttk_GetStickyFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *sticky_rtn);
+}
+declare 23 current {
+ Ttk_Padding Ttk_MakePadding(
+ short l, short t, short r, short b);
+}
+declare 24 current {
+ Ttk_Padding Ttk_UniformPadding(
+ short borderWidth);
+}
+declare 25 current {
+ Ttk_Padding Ttk_AddPadding(Ttk_Padding pad1, Ttk_Padding pad2);
+}
+declare 26 current {
+ Ttk_Padding Ttk_RelievePadding(
+ Ttk_Padding padding, int relief, int n);
+}
+declare 27 current {
+ Ttk_Box Ttk_MakeBox(int x, int y, int width, int height);
+}
+declare 28 current {
+ int Ttk_BoxContains(Ttk_Box box, int x, int y);
+}
+declare 29 current {
+ Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int w, int h, Ttk_Side side);
+}
+declare 30 current {
+ Ttk_Box Ttk_StickBox(Ttk_Box parcel, int w, int h, Ttk_Sticky sticky);
+}
+declare 31 current {
+ Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int w, int h, Tk_Anchor anchor);
+}
+declare 32 current {
+ Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p);
+}
+declare 33 current {
+ Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p);
+}
+declare 34 current {
+ Ttk_Box Ttk_PlaceBox(
+ Ttk_Box *cavity, int w, int h, Ttk_Side side, Ttk_Sticky sticky);
+}
+declare 35 current {
+ Tcl_Obj *Ttk_NewBoxObj(Ttk_Box box);
+}
+
+#
+# Utilities.
+#
+declare 40 current {
+ int Ttk_GetOrientFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *orient);
+}
+
+
diff --git a/generic/ttk/ttkBlink.c b/generic/ttk/ttkBlink.c
new file mode 100644
index 0000000..cc87397
--- /dev/null
+++ b/generic/ttk/ttkBlink.c
@@ -0,0 +1,168 @@
+/*
+ * $Id: ttkBlink.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright 2004, Joe English.
+ *
+ * Usage:
+ * BlinkCursor(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);
+ * BlinkCursor() 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 = (CursorManager *) Tcl_GetAssocData(interp, cm_key,0);
+
+ if (!cm) {
+ cm = (CursorManager*)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;
+ }
+}
+
+/*
+ * BlinkCursor (main routine) --
+ * Arrange to blink the cursor on and off whenever the
+ * widget has focus.
+ */
+void BlinkCursor(WidgetCore *corePtr)
+{
+ Tk_CreateEventHandler(
+ corePtr->tkwin, CursorEventMask, CursorEventProc, corePtr);
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkButton.c b/generic/ttk/ttkButton.c
new file mode 100644
index 0000000..eb6417a
--- /dev/null
+++ b/generic/ttk/ttkButton.c
@@ -0,0 +1,897 @@
+/* $Id: ttkButton.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Copyright (c) 2003, Joe English
+ *
+ * Ttk widget set: 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;
+ Tk_Image *images;
+
+ /*
+ * 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(CoreOptionSpecs)
+};
+
+/*
+ * 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);
+}
+
+/*
+ * Tk_ImageChangedProc for -image option:
+ */
+static void CoreImageChangedProc(ClientData clientData,
+ int x, int y, int width, int height, int imageWidth, int imageHeight)
+{
+ WidgetCore *corePtr = (WidgetCore *)clientData;
+ TtkRedisplayWidget(corePtr);
+}
+
+/* GetImageList --
+ * ConfigureProc utility routine for handling -image option.
+ * Verifies that -image is a valid image specification,
+ * registers image-changed callbacks for each image (via Tk_GetImage).
+ *
+ * The -image option 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].
+ *
+ * Returns: TCL_OK if image specification is valid and sets *imageListPtr
+ * to a NULL-terminated list of Tk_Images; otherwise TCL_ERROR
+ * and leaves an error message in the interpreter result.
+ */
+int GetImageList(
+ Tcl_Interp *interp,
+ WidgetCore *corePtr,
+ Tcl_Obj *imageOption,
+ Tk_Image **imageListPtr)
+{
+ int i, mapCount, imageCount;
+ Tcl_Obj **mapList;
+ Tk_Image *images;
+
+ if (Tcl_ListObjGetElements(interp,
+ imageOption, &mapCount, &mapList) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ if (mapCount == 0) {
+ *imageListPtr = 0;
+ return TCL_OK;
+ }
+
+ if ((mapCount % 2) != 1) {
+ Tcl_SetResult(interp,
+ "-image value must contain an odd number of elements", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ /* Verify state specifications:
+ */
+ for (i = 1; i < mapCount -1; i += 2) {
+ Ttk_StateSpec spec;
+ if (Ttk_GetStateSpecFromObj(interp, mapList[i], &spec) != TCL_OK)
+ return TCL_ERROR;
+ }
+
+ /* Get images:
+ */
+ imageCount = (mapCount + 1) / 2;
+ images = (Tk_Image*)ckalloc((imageCount+1) * sizeof(Tk_Image));
+
+ for (i = 0; i < imageCount; ++i) {
+ const char *imageName = Tcl_GetString(mapList[i * 2]);
+ images[i] = Tk_GetImage(interp, corePtr->tkwin,
+ imageName, CoreImageChangedProc, corePtr);
+
+ if (!images[i]) {
+ while (i--)
+ Tk_FreeImage(images[i]);
+ ckfree((ClientData)images);
+ return TCL_ERROR;
+ }
+ }
+ images[i] = NULL; /* Add null terminator */
+
+ *imageListPtr = images;
+ return TCL_OK;
+}
+
+/*
+ * FreeImageList --
+ * Release an image list obtained by GetImageList.
+ */
+void FreeImageList(Tk_Image *imageList)
+{
+ Tk_Image *p;
+ for (p = imageList; *p; ++p)
+ Tk_FreeImage(*p);
+ ckfree((ClientData)imageList);
+}
+
+static int
+BaseInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Base *basePtr = recordPtr;
+ basePtr->base.textVariableTrace = 0;
+ basePtr->base.images = NULL;
+ return TCL_OK;
+}
+
+static void
+BaseCleanup(void *recordPtr)
+{
+ Base *basePtr = recordPtr;
+ if (basePtr->base.textVariableTrace)
+ Ttk_UntraceVariable(basePtr->base.textVariableTrace);
+ if (basePtr->base.images)
+ FreeImageList(basePtr->base.images);
+}
+
+static int BaseConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Base *basePtr = recordPtr;
+ Tcl_Obj *textVarName = basePtr->base.textVariableObj;
+ Ttk_TraceHandle *vt = 0;
+ Tk_Image *images = NULL;
+
+ if (textVarName != NULL && *Tcl_GetString(textVarName) != '\0') {
+ vt = Ttk_TraceVariable(interp,textVarName,TextVariableChanged,basePtr);
+ if (!vt) return TCL_ERROR;
+ }
+
+ if (basePtr->base.imageObj && GetImageList(interp,
+ &basePtr->core, basePtr->base.imageObj, &images) != TCL_OK)
+ {
+ goto error;
+ }
+
+ if (CoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+error:
+ if (images) FreeImageList(images);
+ if (vt) Ttk_UntraceVariable(vt);
+ return TCL_ERROR;
+ }
+
+ if (basePtr->base.textVariableTrace) {
+ Ttk_UntraceVariable(basePtr->base.textVariableTrace);
+ }
+ basePtr->base.textVariableTrace = vt;
+
+ if (basePtr->base.images) {
+ FreeImageList(basePtr->base.images);
+ }
+ basePtr->base.images = images;
+
+ if (mask & STATE_CHANGED) {
+ CheckStateOption(&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_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+static WidgetCommandSpec LabelCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "instate", WidgetInstateCommand },
+ { "state", WidgetStateCommand },
+ { "identify", WidgetIdentifyCommand },
+ { NULL, NULL }
+};
+
+WidgetSpec LabelWidgetSpec =
+{
+ "TLabel", /* className */
+ sizeof(Label), /* recordSize */
+ LabelOptionSpecs, /* optionSpecs */
+ LabelCommands, /* subcommands */
+ BaseInitialize, /* initializeProc */
+ BaseCleanup, /* cleanupProc */
+ BaseConfigure, /* configureProc */
+ BasePostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ WidgetDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ 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[] =
+{
+ WIDGET_TAKES_FOCUS,
+
+ {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_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) {
+ WidgetChangeState(&buttonPtr->core, TTK_STATE_ALTERNATE, 0);
+ } else {
+ WidgetChangeState(&buttonPtr->core, 0, TTK_STATE_ALTERNATE);
+ }
+ }
+ return TCL_OK;
+}
+
+/* $button invoke --
+ * Evaluate the button's -command.
+ */
+static int
+ButtonInvokeCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ 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 WidgetCommandSpec ButtonCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "invoke", ButtonInvokeCommand },
+ { "instate", WidgetInstateCommand },
+ { "state", WidgetStateCommand },
+ { "identify", WidgetIdentifyCommand },
+ { NULL, NULL }
+};
+
+WidgetSpec ButtonWidgetSpec =
+{
+ "TButton", /* className */
+ sizeof(Button), /* recordSize */
+ ButtonOptionSpecs, /* optionSpecs */
+ ButtonCommands, /* subcommands */
+ BaseInitialize, /* initializeProc */
+ BaseCleanup, /* cleanupProc */
+ ButtonConfigure, /* configureProc */
+ BasePostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ WidgetDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ 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[] =
+{
+ WIDGET_TAKES_FOCUS,
+
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ "", Tk_Offset(Checkbutton, checkbutton.variableObj), -1, 0,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_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) {
+ WidgetChangeState(&checkPtr->core, TTK_STATE_ALTERNATE, 0);
+ return;
+ }
+ /* else */
+ WidgetChangeState(&checkPtr->core, 0, TTK_STATE_ALTERNATE);
+ if (!strcmp(value, Tcl_GetString(checkPtr->checkbutton.onValueObj))) {
+ WidgetChangeState(&checkPtr->core, TTK_STATE_SELECTED, 0);
+ } else {
+ WidgetChangeState(&checkPtr->core, 0, TTK_STATE_SELECTED);
+ }
+}
+
+static int CheckbuttonInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Checkbutton *checkPtr = recordPtr;
+ Tcl_Obj *objPtr;
+
+ /* default -variable is the widget name:
+ */
+ objPtr = Tcl_NewStringObj(Tk_PathName(checkPtr->core.tkwin), -1);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_DecrRefCount(checkPtr->checkbutton.variableObj);
+ checkPtr->checkbutton.variableObj = objPtr;
+
+ return 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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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 WidgetCommandSpec CheckbuttonCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "invoke", CheckbuttonInvokeCommand },
+ { "instate", WidgetInstateCommand },
+ { "state", WidgetStateCommand },
+ { "identify", WidgetIdentifyCommand },
+ /* MISSING: select, deselect, toggle */
+ { NULL, NULL }
+};
+
+WidgetSpec CheckbuttonWidgetSpec =
+{
+ "TCheckbutton", /* className */
+ sizeof(Checkbutton), /* recordSize */
+ CheckbuttonOptionSpecs, /* optionSpecs */
+ CheckbuttonCommands, /* subcommands */
+ CheckbuttonInitialize, /* initializeProc */
+ CheckbuttonCleanup, /* cleanupProc */
+ CheckbuttonConfigure, /* configureProc */
+ CheckbuttonPostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ WidgetDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ 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[] =
+{
+ WIDGET_TAKES_FOCUS,
+
+ {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_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) {
+ WidgetChangeState(&radioPtr->core, TTK_STATE_ALTERNATE, 0);
+ return;
+ }
+ /* else */
+ WidgetChangeState(&radioPtr->core, 0, TTK_STATE_ALTERNATE);
+ if (!strcmp(value, Tcl_GetString(radioPtr->radiobutton.valueObj))) {
+ WidgetChangeState(&radioPtr->core, TTK_STATE_SELECTED, 0);
+ } else {
+ WidgetChangeState(&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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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 WidgetCommandSpec RadiobuttonCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "invoke", RadiobuttonInvokeCommand },
+ { "instate", WidgetInstateCommand },
+ { "state", WidgetStateCommand },
+ { "identify", WidgetIdentifyCommand },
+ /* MISSING: select, deselect */
+ { NULL, NULL }
+};
+
+WidgetSpec RadiobuttonWidgetSpec =
+{
+ "TRadiobutton", /* className */
+ sizeof(Radiobutton), /* recordSize */
+ RadiobuttonOptionSpecs, /* optionSpecs */
+ RadiobuttonCommands, /* subcommands */
+ BaseInitialize, /* initializeProc */
+ RadiobuttonCleanup, /* cleanupProc */
+ RadiobuttonConfigure, /* configureProc */
+ RadiobuttonPostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ WidgetDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ 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 *directionStrings[] = {
+ "above", "below", "left", "right", "flush", NULL
+};
+static Tk_OptionSpec MenubuttonOptionSpecs[] =
+{
+ WIDGET_TAKES_FOCUS,
+
+ {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_INHERIT_OPTIONS(BaseOptionSpecs)
+};
+
+static WidgetCommandSpec MenubuttonCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "instate", WidgetInstateCommand },
+ { "state", WidgetStateCommand },
+ { "identify", WidgetIdentifyCommand },
+ { NULL, NULL }
+};
+
+WidgetSpec MenubuttonWidgetSpec =
+{
+ "TMenubutton", /* className */
+ sizeof(Menubutton), /* recordSize */
+ MenubuttonOptionSpecs, /* optionSpecs */
+ MenubuttonCommands, /* subcommands */
+ BaseInitialize, /* initializeProc */
+ BaseCleanup, /* cleanupProc */
+ BaseConfigure, /* configureProc */
+ BasePostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ WidgetDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
diff --git a/generic/ttk/ttkCache.c b/generic/ttk/ttkCache.c
new file mode 100644
index 0000000..a12bf30
--- /dev/null
+++ b/generic/ttk/ttkCache.c
@@ -0,0 +1,352 @@
+/*
+ * $Id: ttkCache.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Ttk 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 = (Ttk_ResourceCache)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_Obj*)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_Obj*)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_Obj*)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 = (Tk_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_Obj*)Tcl_GetHashValue(entryPtr);
+ Tcl_DecrRefCount(colorNameObj);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&cache->namedColors);
+
+ ckfree((ClientData)cache);
+}
+
+/*
+ * CacheWinEventHandler --
+ * Detect when the cache window is destroyed, clear cache.
+ */
+static void CacheWinEventHandler(ClientData clientData, XEvent *eventPtr)
+{
+ Ttk_ResourceCache cache = (Ttk_ResourceCache)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, (ClientData)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_Obj*)Tcl_GetHashValue(entryPtr);
+ Tcl_DecrRefCount(oldColor);
+ }
+
+ Tcl_SetHashValue(entryPtr, (ClientData)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_Obj *)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_Obj*)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_BackgroundError(interp);
+ 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 (Tk_Image)Tcl_GetHashValue(entryPtr);
+ }
+
+ image = Tk_GetImage(cache->interp, tkwin, imageName, NullImageChanged,0);
+ Tcl_SetHashValue(entryPtr, image);
+
+ if (!image) {
+ Tcl_BackgroundError(cache->interp);
+ }
+
+ return image;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkClamTheme.c b/generic/ttk/ttkClamTheme.c
new file mode 100644
index 0000000..0165a9f
--- /dev/null
+++ b/generic/ttk/ttkClamTheme.c
@@ -0,0 +1,969 @@
+/*
+ * $Id: ttkClamTheme.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright (C) 2004 Joe English
+ *
+ * Ttk widget set: another theme engine.
+ * 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" },
+ {0,0,0}
+};
+
+/*
+ * <<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 BorderElementGeometry(
+ 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,
+ BorderElementGeometry,
+ 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" },
+ {0,0,0}
+};
+
+static void FieldElementGeometry(
+ 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,
+ FieldElementGeometry,
+ 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,
+ FieldElementGeometry,
+ 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 },
+ {0,0,0}
+};
+
+static void
+IndicatorElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ IndicatorElement *indicator = elementRecord;
+ int size = 10;
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, paddingPtr);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+ *widthPtr = *heightPtr = size;
+}
+
+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,
+ IndicatorElementGeometry,
+ RadioIndicatorElementDraw
+};
+
+static Ttk_ElementSpec CheckIndicatorElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(IndicatorElement),
+ IndicatorElementOptions,
+ IndicatorElementGeometry,
+ 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 }
+};
+
+static void MenuIndicatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ MenuIndicatorElement *indicator = elementRecord;
+ int size = MENUBUTTON_ARROW_SIZE;
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+ ArrowSize(size, ARROW_DOWN, widthPtr, heightPtr);
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->paddingObj, paddingPtr);
+}
+
+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);
+
+ ArrowSize(size, ARROW_DOWN, &width, &height);
+ b = Ttk_StickBox(b, width, height, 0);
+ FillArrow(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" },
+ {0,0,0}
+};
+
+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;
+
+ 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;
+ int i, gripCount;
+
+ 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" },
+ {0,0,0}
+};
+
+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,
+ NullElementGeometry,
+ TroughElementDraw
+};
+
+static void ThumbElementGeometry(
+ 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 = 3, 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,
+ ThumbElementGeometry,
+ ThumbElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Slider element.
+ */
+static void SliderElementGeometry(
+ 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,
+ SliderElementGeometry,
+ ThumbElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Progress bar element
+ */
+static void PbarElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SliderElementGeometry(clientData, elementRecord, tkwin,
+ widthPtr, heightPtr, paddingPtr);
+ *paddingPtr = Ttk_UniformPadding(2);
+}
+
+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,
+ PbarElementGeometry,
+ PbarElementDraw
+};
+
+
+/*------------------------------------------------------------------------
+ * +++ Scrollbar arrows.
+ */
+static int ArrowElements[] = { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT };
+
+static void ArrowElementGeometry(
+ 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;
+ ArrowSize(h/2, dir, &cx, &cy);
+ b = Ttk_AnchorBox(b, cx, cy, TK_ANCHOR_CENTER);
+
+ FillArrow(Tk_Display(tkwin), d, gc, b, dir);
+}
+
+static Ttk_ElementSpec ArrowElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(ScrollbarElement),
+ ScrollbarElementOptions,
+ ArrowElementGeometry,
+ 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 },
+ {0,0,0}
+};
+
+static void TabElementGeometry(
+ 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,
+ TabElementGeometry,
+ TabElementDraw
+};
+
+static void ClientElementGeometry(
+ 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,
+ ClientElementGeometry,
+ ClientElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Modified widget layouts.
+ */
+
+TTK_BEGIN_LAYOUT(ComboboxLayout)
+ 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_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalSashLayout)
+ TTK_GROUP("Sash.hsash", TTK_FILL_BOTH,
+ TTK_NODE("Sash.hgrip", TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(VerticalSashLayout)
+ TTK_GROUP("Sash.vsash", TTK_FILL_BOTH,
+ TTK_NODE("Sash.vgrip", TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+int DLLEXPORT
+ClamTheme_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_RegisterLayout(theme, "TCombobox", ComboboxLayout);
+ Ttk_RegisterLayout(theme, "Horizontal.Sash", HorizontalSashLayout);
+ Ttk_RegisterLayout(theme, "Vertical.Sash", VerticalSashLayout);
+
+ return TCL_OK;
+}
diff --git a/generic/ttk/ttkClassicTheme.c b/generic/ttk/ttkClassicTheme.c
new file mode 100644
index 0000000..9ddaee4
--- /dev/null
+++ b/generic/ttk/ttkClassicTheme.c
@@ -0,0 +1,530 @@
+/*
+ * $Id: ttkClassicTheme.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright (c) 2004, Joe English
+ *
+ * Ttk widget set: 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}
+};
+
+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}
+};
+
+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 }
+};
+
+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;
+ int borderWidth;
+ int relief = TK_RELIEF_RAISED;
+ int size;
+ XPoint points[3];
+
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->borderWidthObj, &borderWidth);
+ border = Tk_Get3DBorderFromObj(tkwin, arrow->borderObj);
+ Tk_GetReliefFromObj(NULL, arrow->reliefObj, &relief);
+
+ size = b.width < b.height ? b.width : b.height;
+
+ /*
+ * @@@ 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::paned window)
+ *
+ * NOTES:
+ *
+ * Paned windows 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" },
+ {0,0,0}
+};
+
+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(ButtonLayout)
+ 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_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(CheckbuttonLayout)
+ 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_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(RadiobuttonLayout)
+ 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_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(MenubuttonLayout)
+ 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))))
+TTK_END_LAYOUT
+
+/* "classic" entry, includes highlight border */
+TTK_BEGIN_LAYOUT(EntryLayout)
+ 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))))
+TTK_END_LAYOUT
+
+/* Notebook tabs -- omit focus ring */
+TTK_BEGIN_LAYOUT(TabLayout)
+ TTK_GROUP("Notebook.tab", TTK_FILL_BOTH,
+ TTK_GROUP("Notebook.padding", TTK_FILL_BOTH,
+ TTK_NODE("Notebook.label", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/* POSSIBLY: include Scale layouts w/focus border
+ */
+
+/*------------------------------------------------------------------------
+ * ClassicTheme_Init --
+ * Install classic theme.
+ */
+
+int ClassicTheme_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_RegisterLayout(theme, "TButton", ButtonLayout);
+ Ttk_RegisterLayout(theme, "TCheckbutton", CheckbuttonLayout);
+ Ttk_RegisterLayout(theme, "TRadiobutton", RadiobuttonLayout);
+ Ttk_RegisterLayout(theme, "TMenubutton", MenubuttonLayout);
+ Ttk_RegisterLayout(theme, "TEntry", EntryLayout);
+ Ttk_RegisterLayout(theme, "TNotebook.Tab", TabLayout);
+
+ Tcl_PkgProvide(interp, "ttk::theme::classic", TTK_VERSION);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkDecls.h b/generic/ttk/ttkDecls.h
new file mode 100644
index 0000000..20fcd85
--- /dev/null
+++ b/generic/ttk/ttkDecls.h
@@ -0,0 +1,336 @@
+/*
+ * $Id: ttkDecls.h,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * This file is (mostly) automatically generated from ttk.decls.
+ */
+
+
+#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_PkgRequire(interp,"ttk",TTK_VERSION)
+
+#endif
+
+
+/* !BEGIN!: Do not edit below this line. */
+
+#define TTK_STUBS_EPOCH 0
+#define TTK_STUBS_REVISION 31
+
+#if !defined(USE_TTK_STUBS)
+
+/*
+ * 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_Element 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);
+
+#endif /* !defined(USE_TTK_STUBS) */
+
+typedef struct TtkStubs {
+ int magic;
+ int epoch;
+ int revision;
+ struct TtkStubHooks *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_Element (*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;
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern const TtkStubs *ttkStubsPtr;
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_TTK_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+#ifndef Ttk_GetTheme
+#define Ttk_GetTheme \
+ (ttkStubsPtr->ttk_GetTheme) /* 0 */
+#endif
+#ifndef Ttk_GetDefaultTheme
+#define Ttk_GetDefaultTheme \
+ (ttkStubsPtr->ttk_GetDefaultTheme) /* 1 */
+#endif
+#ifndef Ttk_GetCurrentTheme
+#define Ttk_GetCurrentTheme \
+ (ttkStubsPtr->ttk_GetCurrentTheme) /* 2 */
+#endif
+#ifndef Ttk_CreateTheme
+#define Ttk_CreateTheme \
+ (ttkStubsPtr->ttk_CreateTheme) /* 3 */
+#endif
+#ifndef Ttk_RegisterCleanup
+#define Ttk_RegisterCleanup \
+ (ttkStubsPtr->ttk_RegisterCleanup) /* 4 */
+#endif
+#ifndef Ttk_RegisterElementSpec
+#define Ttk_RegisterElementSpec \
+ (ttkStubsPtr->ttk_RegisterElementSpec) /* 5 */
+#endif
+#ifndef Ttk_RegisterElement
+#define Ttk_RegisterElement \
+ (ttkStubsPtr->ttk_RegisterElement) /* 6 */
+#endif
+#ifndef Ttk_RegisterElementFactory
+#define Ttk_RegisterElementFactory \
+ (ttkStubsPtr->ttk_RegisterElementFactory) /* 7 */
+#endif
+#ifndef Ttk_RegisterLayout
+#define Ttk_RegisterLayout \
+ (ttkStubsPtr->ttk_RegisterLayout) /* 8 */
+#endif
+/* Slot 9 is reserved */
+#ifndef Ttk_GetStateSpecFromObj
+#define Ttk_GetStateSpecFromObj \
+ (ttkStubsPtr->ttk_GetStateSpecFromObj) /* 10 */
+#endif
+#ifndef Ttk_NewStateSpecObj
+#define Ttk_NewStateSpecObj \
+ (ttkStubsPtr->ttk_NewStateSpecObj) /* 11 */
+#endif
+#ifndef Ttk_GetStateMapFromObj
+#define Ttk_GetStateMapFromObj \
+ (ttkStubsPtr->ttk_GetStateMapFromObj) /* 12 */
+#endif
+#ifndef Ttk_StateMapLookup
+#define Ttk_StateMapLookup \
+ (ttkStubsPtr->ttk_StateMapLookup) /* 13 */
+#endif
+#ifndef Ttk_StateTableLookup
+#define Ttk_StateTableLookup \
+ (ttkStubsPtr->ttk_StateTableLookup) /* 14 */
+#endif
+/* Slot 15 is reserved */
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
+/* Slot 18 is reserved */
+/* Slot 19 is reserved */
+#ifndef Ttk_GetPaddingFromObj
+#define Ttk_GetPaddingFromObj \
+ (ttkStubsPtr->ttk_GetPaddingFromObj) /* 20 */
+#endif
+#ifndef Ttk_GetBorderFromObj
+#define Ttk_GetBorderFromObj \
+ (ttkStubsPtr->ttk_GetBorderFromObj) /* 21 */
+#endif
+#ifndef Ttk_GetStickyFromObj
+#define Ttk_GetStickyFromObj \
+ (ttkStubsPtr->ttk_GetStickyFromObj) /* 22 */
+#endif
+#ifndef Ttk_MakePadding
+#define Ttk_MakePadding \
+ (ttkStubsPtr->ttk_MakePadding) /* 23 */
+#endif
+#ifndef Ttk_UniformPadding
+#define Ttk_UniformPadding \
+ (ttkStubsPtr->ttk_UniformPadding) /* 24 */
+#endif
+#ifndef Ttk_AddPadding
+#define Ttk_AddPadding \
+ (ttkStubsPtr->ttk_AddPadding) /* 25 */
+#endif
+#ifndef Ttk_RelievePadding
+#define Ttk_RelievePadding \
+ (ttkStubsPtr->ttk_RelievePadding) /* 26 */
+#endif
+#ifndef Ttk_MakeBox
+#define Ttk_MakeBox \
+ (ttkStubsPtr->ttk_MakeBox) /* 27 */
+#endif
+#ifndef Ttk_BoxContains
+#define Ttk_BoxContains \
+ (ttkStubsPtr->ttk_BoxContains) /* 28 */
+#endif
+#ifndef Ttk_PackBox
+#define Ttk_PackBox \
+ (ttkStubsPtr->ttk_PackBox) /* 29 */
+#endif
+#ifndef Ttk_StickBox
+#define Ttk_StickBox \
+ (ttkStubsPtr->ttk_StickBox) /* 30 */
+#endif
+#ifndef Ttk_AnchorBox
+#define Ttk_AnchorBox \
+ (ttkStubsPtr->ttk_AnchorBox) /* 31 */
+#endif
+#ifndef Ttk_PadBox
+#define Ttk_PadBox \
+ (ttkStubsPtr->ttk_PadBox) /* 32 */
+#endif
+#ifndef Ttk_ExpandBox
+#define Ttk_ExpandBox \
+ (ttkStubsPtr->ttk_ExpandBox) /* 33 */
+#endif
+#ifndef Ttk_PlaceBox
+#define Ttk_PlaceBox \
+ (ttkStubsPtr->ttk_PlaceBox) /* 34 */
+#endif
+#ifndef Ttk_NewBoxObj
+#define Ttk_NewBoxObj \
+ (ttkStubsPtr->ttk_NewBoxObj) /* 35 */
+#endif
+/* Slot 36 is reserved */
+/* Slot 37 is reserved */
+/* Slot 38 is reserved */
+/* Slot 39 is reserved */
+#ifndef Ttk_GetOrientFromObj
+#define Ttk_GetOrientFromObj \
+ (ttkStubsPtr->ttk_GetOrientFromObj) /* 40 */
+#endif
+
+#endif /* defined(USE_TTK_STUBS) */
+
+/* !END!: Do not edit above this line. */
diff --git a/generic/ttk/ttkDefaultTheme.c b/generic/ttk/ttkDefaultTheme.c
new file mode 100644
index 0000000..86f169a
--- /dev/null
+++ b/generic/ttk/ttkDefaultTheme.c
@@ -0,0 +1,1162 @@
+/* $Id: ttkDefaultTheme.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright (c) 2003, Joe English
+ *
+ * Tk alternate theme, intended to match the MSUE and Gtk's (old) default theme
+ */
+
+#include <math.h>
+#include <string.h>
+
+#include <tkInt.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+#include "ttkTheme.h"
+
+#if defined(WIN32)
+static const int WIN32_XDRAWLINE_HACK = 1;
+#else
+static const int WIN32_XDRAWLINE_HACK = 0;
+#endif
+
+#define MIN(a,b) (a < b ? a : b)
+
+#define BORDERWIDTH 2
+#define SCROLLBAR_WIDTH 14
+#define MIN_THUMB_SIZE 8
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Helper routines for border drawing:
+ *
+ * NOTE: MSUE specifies a slightly different arrangement
+ * for button borders than for other elements; "shadowColors"
+ * is for button borders.
+ *
+ * Please excuse the gross misspelling "LITE" for "LIGHT",
+ * but it makes things line up nicer.
+ */
+
+enum BorderColor { FLAT = 1, LITE = 2, DARK = 3, BRDR = 4 };
+
+/* top-left outer, top-left inner, bottom-right inner, bottom-right outer */
+static int shadowColors[6][4] =
+{
+ { FLAT, FLAT, FLAT, FLAT }, /* TK_RELIEF_FLAT = 0*/
+ { DARK, LITE, DARK, LITE }, /* TK_RELIEF_GROOVE = 1*/
+ { LITE, FLAT, DARK, BRDR }, /* TK_RELIEF_RAISED = 2*/
+ { LITE, DARK, LITE, DARK }, /* TK_RELIEF_RIDGE = 3*/
+ { BRDR, BRDR, BRDR, BRDR }, /* TK_RELIEF_SOLID = 4*/
+ { BRDR, DARK, FLAT, LITE } /* TK_RELIEF_SUNKEN = 5*/
+};
+
+/* top-left, bottom-right */
+int thinShadowColors[6][4] =
+{
+ { FLAT, FLAT }, /* TK_RELIEF_FLAT = 0*/
+ { DARK, LITE }, /* TK_RELIEF_GROOVE = 1*/
+ { LITE, DARK }, /* TK_RELIEF_RAISED = 2*/
+ { LITE, DARK }, /* TK_RELIEF_RIDGE = 3*/
+ { BRDR, BRDR }, /* TK_RELIEF_SOLID = 4*/
+ { DARK, LITE } /* TK_RELIEF_SUNKEN = 5*/
+};
+
+static void DrawCorner(
+ Tk_Window tkwin,
+ Drawable d,
+ Tk_3DBorder border, /* get most GCs from here... */
+ GC borderGC, /* "window border" color GC */
+ int x,int y, int width,int height, /* where to draw */
+ int corner, /* 0 => top left; 1 => bottom right */
+ enum BorderColor color)
+{
+ XPoint points[3];
+ GC gc;
+
+ --width; --height;
+ points[0].x = x; points[0].y = y+height;
+ points[1].x = x+width*corner; points[1].y = y+height*corner;
+ points[2].x = x+width; points[2].y = y;
+
+ if (color == BRDR)
+ gc = borderGC;
+ else
+ gc = Tk_3DBorderGC(tkwin, border, (int)color);
+
+ XDrawLines(Tk_Display(tkwin), d, gc, points, 3, CoordModeOrigin);
+}
+
+static void DrawBorder(
+ Tk_Window tkwin, Drawable d, Tk_3DBorder border, XColor *borderColor,
+ Ttk_Box b, int borderWidth, int relief)
+{
+ GC borderGC = Tk_GCForColor(borderColor, d);
+
+ switch (borderWidth) {
+ case 2: /* "thick" border */
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 0,shadowColors[relief][0]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x+1, b.y+1, b.width-2, b.height-2, 0,shadowColors[relief][1]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x+1, b.y+1, b.width-2, b.height-2, 1,shadowColors[relief][2]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 1,shadowColors[relief][3]);
+ break;
+ case 1: /* "thin" border */
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 0, thinShadowColors[relief][0]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 1, thinShadowColors[relief][1]);
+ break;
+ case 0: /* no border -- do nothing */
+ break;
+ default: /* Fall back to Motif-style borders: */
+ Tk_Draw3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height, borderWidth,relief);
+ break;
+ }
+}
+
+/* Alternate shadow colors for entry fields:
+ * NOTE: FLAT color is normally white, and the LITE color is a darker shade.
+ */
+static int fieldShadowColors[4] = { DARK, BRDR, LITE, FLAT };
+
+static void DrawFieldBorder(
+ Tk_Window tkwin, Drawable d, Tk_3DBorder border, XColor *borderColor,
+ Ttk_Box b)
+{
+ GC borderGC = Tk_GCForColor(borderColor, d);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 0,fieldShadowColors[0]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x+1, b.y+1, b.width-2, b.height-2, 0,fieldShadowColors[1]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x+1, b.y+1, b.width-2, b.height-2, 1,fieldShadowColors[2]);
+ DrawCorner(tkwin, d, border, borderGC,
+ b.x, b.y, b.width, b.height, 1,fieldShadowColors[3]);
+ return;
+}
+
+/*
+ * ArrowPoints --
+ * Compute points of arrow polygon.
+ */
+static void ArrowPoints(Ttk_Box b, ArrowDirection dir, XPoint points[4])
+{
+ int cx, cy, h;
+
+ switch (dir) {
+ case ARROW_UP:
+ h = (b.width - 1)/2;
+ cx = b.x + h;
+ cy = b.y;
+ if (b.height <= h) h = b.height - 1;
+ points[0].x = cx; points[0].y = cy;
+ points[1].x = cx - h; points[1].y = cy + h;
+ points[2].x = cx + h; points[2].y = cy + h;
+ break;
+ case ARROW_DOWN:
+ h = (b.width - 1)/2;
+ cx = b.x + h;
+ cy = b.y + b.height - 1;
+ if (b.height <= h) h = b.height - 1;
+ points[0].x = cx; points[0].y = cy;
+ points[1].x = cx - h; points[1].y = cy - h;
+ points[2].x = cx + h; points[2].y = cy - h;
+ break;
+ case ARROW_LEFT:
+ h = (b.height - 1)/2;
+ cx = b.x;
+ cy = b.y + h;
+ if (b.width <= h) h = b.width - 1;
+ points[0].x = cx; points[0].y = cy;
+ points[1].x = cx + h; points[1].y = cy - h;
+ points[2].x = cx + h; points[2].y = cy + h;
+ break;
+ case ARROW_RIGHT:
+ h = (b.height - 1)/2;
+ cx = b.x + b.width - 1;
+ cy = b.y + h;
+ if (b.width <= h) h = b.width - 1;
+ points[0].x = cx; points[0].y = cy;
+ points[1].x = cx - h; points[1].y = cy - h;
+ points[2].x = cx - h; points[2].y = cy + h;
+ break;
+ }
+
+ points[3].x = points[0].x;
+ points[3].y = points[0].y;
+}
+
+/*public*/
+void ArrowSize(int h, ArrowDirection dir, int *widthPtr, int *heightPtr)
+{
+ switch (dir) {
+ case ARROW_UP:
+ case ARROW_DOWN: *widthPtr = 2*h+1; *heightPtr = h+1; break;
+ case ARROW_LEFT:
+ case ARROW_RIGHT: *widthPtr = h+1; *heightPtr = 2*h+1;
+ }
+}
+
+/*
+ * DrawArrow, FillArrow --
+ * Draw an arrow in the indicated direction inside the specified box.
+ */
+/*public*/
+void FillArrow(
+ Display *display, Drawable d, GC gc, Ttk_Box b, ArrowDirection dir)
+{
+ XPoint points[4];
+ ArrowPoints(b, dir, points);
+ XFillPolygon(display, d, gc, points, 3, Convex, CoordModeOrigin);
+ XDrawLines(display, d, gc, points, 4, CoordModeOrigin);
+}
+
+/*public*/
+void DrawArrow(
+ Display *display, Drawable d, GC gc, Ttk_Box b, ArrowDirection dir)
+{
+ XPoint points[4];
+ ArrowPoints(b, dir, points);
+ XDrawLines(display, d, gc, points, 4, CoordModeOrigin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Border element implementation.
+ *
+ * This border consists of (from outside-in):
+ *
+ * + a 1-pixel thick default indicator (defaultable widgets only)
+ * + 1- or 2- pixel shaded border (controlled by -background and -relief)
+ * + 1 pixel padding (???)
+ */
+
+typedef struct
+{
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderColorObj; /* Extra border color */
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *defaultStateObj; /* for buttons */
+} BorderElement;
+
+static Ttk_ElementOptionSpec BorderElementOptions[] =
+{
+ { "-background", TK_OPTION_BORDER, Tk_Offset(BorderElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-bordercolor",TK_OPTION_COLOR,
+ Tk_Offset(BorderElement,borderColorObj), "black" },
+ { "-default", TK_OPTION_ANY, Tk_Offset(BorderElement,defaultStateObj),
+ "disabled" },
+ { "-borderwidth",TK_OPTION_PIXELS,Tk_Offset(BorderElement,borderWidthObj),
+ STRINGIFY(BORDERWIDTH) },
+ { "-relief", TK_OPTION_RELIEF, Tk_Offset(BorderElement,reliefObj),
+ "flat" },
+ {NULL}
+};
+
+static void BorderElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ BorderElement *bd = elementRecord;
+ int borderWidth = 0;
+ int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+
+ if (defaultState != TTK_BUTTON_DEFAULT_DISABLED) {
+ ++borderWidth;
+ }
+
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void
+BorderElementDraw(
+ void *clientData, void *elementRecord,
+ Tk_Window tkwin, Drawable d, Ttk_Box b, unsigned int state)
+{
+ BorderElement *bd = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, bd->borderObj);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, bd->borderColorObj);
+ int borderWidth = 2;
+ int relief = TK_RELIEF_FLAT;
+ int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+
+ /*
+ * Get option values.
+ */
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, bd->reliefObj, &relief);
+ Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+
+ if (defaultState == TTK_BUTTON_DEFAULT_ACTIVE) {
+ GC gc = Tk_GCForColor(borderColor, d);
+ XDrawRectangle(Tk_Display(tkwin), d, gc,
+ b.x, b.y, b.width-1, b.height-1);
+ }
+ if (defaultState != TTK_BUTTON_DEFAULT_DISABLED) {
+ /* Space for default ring: */
+ b = Ttk_PadBox(b, Ttk_UniformPadding(1));
+ }
+
+ DrawBorder(tkwin, d, border, borderColor, b, borderWidth, relief);
+}
+
+static Ttk_ElementSpec BorderElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(BorderElement),
+ BorderElementOptions,
+ BorderElementSize,
+ BorderElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Field element:
+ * Used for editable fields.
+ */
+typedef struct
+{
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderColorObj; /* Extra border color */
+} FieldElement;
+
+static Ttk_ElementOptionSpec FieldElementOptions[] =
+{
+ { "-fieldbackground", TK_OPTION_BORDER, Tk_Offset(FieldElement,borderObj),
+ "white" },
+ { "-bordercolor",TK_OPTION_COLOR, Tk_Offset(FieldElement,borderColorObj),
+ "black" },
+ {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 int state)
+{
+ FieldElement *field = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, field->borderObj);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, field->borderColorObj);
+
+ Tk_Fill3DRectangle(
+ tkwin, d, border, b.x, b.y, b.width, b.height, 0, TK_RELIEF_SUNKEN);
+ DrawFieldBorder(tkwin, d, border, borderColor, b);
+}
+
+static Ttk_ElementSpec FieldElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(FieldElement),
+ FieldElementOptions,
+ FieldElementSize,
+ FieldElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * Indicators --
+ *
+ * Code derived (probably incorrectly) from TIP 109 implementation,
+ * unix/tkUnixButton.c r 1.15.
+ */
+
+/*
+ * Indicator bitmap descriptor:
+ */
+typedef struct
+{
+ int width; /* Width of each image */
+ int height; /* Height of each image */
+ int nimages; /* #images / row */
+ char **pixels; /* array[height] of char[width*nimage] */
+ Ttk_StateTable *map;/* used to look up image index by state */
+} IndicatorSpec;
+
+#if 0
+/*XPM*/
+static char *button_images[] = {
+ /* width height ncolors chars_per_pixel */
+ "52 26 7 1",
+ /* colors */
+ "A c #808000000000 s background",
+ "B c #000080800000 s background",
+ "C c #808080800000 s highlight",
+ "D c #000000008080 s select",
+ "E c #808000008080 s shadow",
+ "F c #000080808080 s background",
+ "G c #000000000000 s indicator",
+ "H c #000080800000 s disabled",
+};
+#endif
+
+Ttk_StateTable checkbutton_states[] =
+{
+ { 0, 0, TTK_STATE_SELECTED|TTK_STATE_DISABLED },
+ { 1, TTK_STATE_SELECTED, TTK_STATE_DISABLED },
+ { 2, TTK_STATE_DISABLED, TTK_STATE_SELECTED },
+ { 3, TTK_STATE_SELECTED|TTK_STATE_DISABLED, 0 },
+ { 0, 0, 0 }
+};
+static char *checkbutton_pixels[] = {
+ "AAAAAAAAAAAABAAAAAAAAAAAABAAAAAAAAAAAABAAAAAAAAAAAAB",
+ "AEEEEEEEEEECBAEEEEEEEEEECBAEEEEEEEEEECBAEEEEEEEEEECB",
+ "AEDDDDDDDDDCBAEDDDDDDDDDCBAEFFFFFFFFFCBAEFFFFFFFFFCB",
+ "AEDDDDDDDDDCBAEDDDDDDDGDCBAEFFFFFFFFFCBAEFFFFFFFHFCB",
+ "AEDDDDDDDDDCBAEDDDDDDGGDCBAEFFFFFFFFFCBAEFFFFFFHHFCB",
+ "AEDDDDDDDDDCBAEDGDDDGGGDCBAEFFFFFFFFFCBAEFHFFFHHHFCB",
+ "AEDDDDDDDDDCBAEDGGDGGGDDCBAEFFFFFFFFFCBAEFHHFHHHFFCB",
+ "AEDDDDDDDDDCBAEDGGGGGDDDCBAEFFFFFFFFFCBAEFHHHHHFFFCB",
+ "AEDDDDDDDDDCBAEDDGGGDDDDCBAEFFFFFFFFFCBAEFFHHHFFFFCB",
+ "AEDDDDDDDDDCBAEDDDGDDDDDCBAEFFFFFFFFFCBAEFFFHFFFFFCB",
+ "AEDDDDDDDDDCBAEDDDDDDDDDCBAEFFFFFFFFFCBAEFFFFFFFFFCB",
+ "ACCCCCCCCCCCBACCCCCCCCCCCBACCCCCCCCCCCBACCCCCCCCCCCB",
+ "BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
+};
+
+IndicatorSpec checkbutton_spec =
+{
+ 13, 13, 4, /* width, height, nimages */
+ checkbutton_pixels,
+ checkbutton_states
+};
+
+Ttk_StateTable radiobutton_states[] =
+{
+ { 0, 0, TTK_STATE_SELECTED|TTK_STATE_DISABLED },
+ { 1, TTK_STATE_SELECTED, TTK_STATE_DISABLED },
+ { 2, TTK_STATE_DISABLED, TTK_STATE_SELECTED },
+ { 3, TTK_STATE_SELECTED|TTK_STATE_DISABLED, 0 },
+ { 0, 0, 0 }
+};
+
+static char *radiobutton_pixels[] = {
+ "FFFFAAAAFFFFFFFFFAAAAFFFFFFFFFAAAAFFFFFFFFFAAAAFFFFF",
+ "FFAAEEEEAAFFFFFAAEEEEAAFFFFFAAEEEEAAFFFFFAAEEEEAAFFF",
+ "FAEEDDDDECBFFFAEEDDDDECBFFFAEEFFFFECBFFFAEEFFFFECBFF",
+ "FAEDDDDDDCBFFFAEDDDDDDCBFFFAEFFFFFFCBFFFAEFFFFFFCBFF",
+ "AEDDDDDDDDCBFAEDDDGGDDDCBFAEFFFFFFFFCBFAEFFFHHFFFCBF",
+ "AEDDDDDDDDCBFAEDDGGGGDDCBFAEFFFFFFFFCBFAEFFHHHHFFCBF",
+ "AEDDDDDDDDCBFAEDDGGGGDDCBFAEFFFFFFFFCBFAEFFHHHHFFCBF",
+ "AEDDDDDDDDCBFAEDDDGGDDDCBFAEFFFFFFFFCBFAEFFFHHFFFCBF",
+ "FAEDDDDDDCBFFFAEDDDDDDCBFFFAEFFFFFFCBFFFAEFFFFFFCBFF",
+ "FACCDDDDCCBFFFACCDDDDCCBFFFACCFFFFCCBFFFACCFFFFCCBFF",
+ "FFBBCCCCBBFFFFFBBCCCCBBFFFFFBBCCCCBBFFFFFBBCCCCBBFFF",
+ "FFFFBBBBFFFFFFFFFBBBBFFFFFFFFFBBBBFFFFFFFFFBBBBFFFFF",
+ "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF",
+};
+
+IndicatorSpec radiobutton_spec =
+{
+ 13, 13, 4, /* width, height, nimages */
+ radiobutton_pixels,
+ radiobutton_states
+};
+
+typedef struct
+{
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *foregroundObj;
+ Tcl_Obj *colorObj;
+ Tcl_Obj *lightColorObj;
+ Tcl_Obj *shadeColorObj;
+ Tcl_Obj *marginObj;
+} IndicatorElement;
+
+static Ttk_ElementOptionSpec IndicatorElementOptions[] =
+{
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(IndicatorElement,backgroundObj), DEFAULT_BACKGROUND },
+ { "-foreground", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,foregroundObj), DEFAULT_FOREGROUND },
+ { "-indicatorcolor", TK_OPTION_BORDER,
+ Tk_Offset(IndicatorElement,colorObj), "#FFFFFF" },
+ { "-lightcolor", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,lightColorObj), "#DDDDDD" },
+ { "-shadecolor", TK_OPTION_COLOR,
+ Tk_Offset(IndicatorElement,shadeColorObj), "#888888" },
+ { "-indicatormargin", TK_OPTION_STRING,
+ Tk_Offset(IndicatorElement,marginObj), "0 2 4 2" },
+ {NULL}
+};
+
+static void IndicatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ IndicatorSpec *spec = clientData;
+ IndicatorElement *indicator = elementRecord;
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, paddingPtr);
+ *widthPtr = spec->width;
+ *heightPtr = spec->height;
+}
+
+static void IndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ IndicatorSpec *spec = clientData;
+ IndicatorElement *indicator = elementRecord;
+ Display *display = Tk_Display(tkwin);
+ Tk_3DBorder bgBorder;
+ Ttk_Padding padding;
+ XColor *fgColor, *bgColor, *lightColor, *shadeColor, *selectColor;
+
+ int index, ix, iy;
+ XGCValues gcValues;
+ GC copyGC;
+ unsigned long imgColors[8];
+ XImage *img;
+
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, &padding);
+ b = Ttk_PadBox(b, padding);
+
+ if ( b.x < 0
+ || b.y < 0
+ || Tk_Width(tkwin) < b.x + spec->width
+ || Tk_Height(tkwin) < b.y + spec->height)
+ {
+ /* Oops! not enough room to display the image.
+ * Don't draw anything.
+ */
+ return;
+ }
+
+ /*
+ * Fill in imgColors palette:
+ *
+ * (SHOULD: take light and shade colors from the border object,
+ * but Tk doesn't provide easy access to these in the public API.)
+ */
+ fgColor = Tk_GetColorFromObj(tkwin, indicator->foregroundObj);
+ bgBorder = Tk_Get3DBorderFromObj(tkwin, indicator->backgroundObj);
+ bgColor = Tk_3DBorderColor(bgBorder);
+ lightColor = Tk_GetColorFromObj(tkwin, indicator->lightColorObj);
+ shadeColor = Tk_GetColorFromObj(tkwin, indicator->shadeColorObj);
+ selectColor = Tk_GetColorFromObj(tkwin, indicator->colorObj);
+
+ imgColors[0 /*A*/] = bgColor->pixel;
+ imgColors[1 /*B*/] = bgColor->pixel;
+ imgColors[2 /*C*/] = lightColor->pixel;
+ imgColors[3 /*D*/] = selectColor->pixel;
+ imgColors[4 /*E*/] = shadeColor->pixel;
+ imgColors[5 /*F*/] = bgColor->pixel;
+ imgColors[6 /*G*/] = fgColor->pixel;
+ imgColors[7 /*H*/] = selectColor->pixel;
+
+ /*
+ * Create a scratch buffer to store the image:
+ */
+ img = XGetImage(display,d, 0, 0,
+ (unsigned int)spec->width, (unsigned int)spec->height,
+ AllPlanes, ZPixmap);
+ if (img == NULL)
+ return;
+
+ /*
+ * Create the image, painting it into an XImage one pixel at a time.
+ */
+ index = Ttk_StateTableLookup(spec->map, state);
+ for (iy=0 ; iy<spec->height ; iy++) {
+ for (ix=0 ; ix<spec->width ; ix++) {
+ XPutPixel(img, ix, iy,
+ imgColors[spec->pixels[iy][index*spec->width+ix] - 'A'] );
+ }
+ }
+
+ /*
+ * Copy onto our target drawable surface.
+ */
+ memset(&gcValues, 0, sizeof(gcValues));
+ copyGC = Tk_GetGC(tkwin, 0, &gcValues);
+
+ TkPutImage(NULL, 0, display, d, copyGC, img, 0, 0, b.x, b.y,
+ spec->width, spec->height);
+
+ /*
+ * Tidy up.
+ */
+ Tk_FreeGC(display, copyGC);
+ XDestroyImage(img);
+}
+
+static Ttk_ElementSpec IndicatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(IndicatorElement),
+ IndicatorElementOptions,
+ IndicatorElementSize,
+ IndicatorElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Arrow element(s).
+ *
+ * Draws a solid triangle, inside a box.
+ * 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 *borderColorObj; /* Extra color for borders */
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *colorObj; /* Arrow color */
+} ArrowElement;
+
+static Ttk_ElementOptionSpec ArrowElementOptions[] =
+{
+ { "-arrowsize", TK_OPTION_PIXELS,
+ Tk_Offset(ArrowElement,sizeObj), STRINGIFY(SCROLLBAR_WIDTH) },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(ArrowElement,borderObj), DEFAULT_BACKGROUND },
+ { "-bordercolor", TK_OPTION_COLOR,
+ Tk_Offset(ArrowElement,borderColorObj), "black" },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(ArrowElement,reliefObj),"raised"},
+ { "-arrowcolor", TK_OPTION_COLOR,
+ Tk_Offset(ArrowElement,colorObj),"black"},
+ { NULL }
+};
+
+/*
+ * Note asymmetric padding:
+ * top/left padding is 1 less than bottom/right,
+ * since in this theme 2-pixel borders are asymmetric.
+ */
+static Ttk_Padding ArrowPadding = { 3,3,4,4 };
+
+static void ArrowElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ArrowElement *arrow = elementRecord;
+ int direction = *(int *)clientData;
+ int width = SCROLLBAR_WIDTH;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &width);
+ width -= Ttk_PaddingWidth(ArrowPadding);
+ ArrowSize(width/2, direction, widthPtr, heightPtr);
+ *paddingPtr = ArrowPadding;
+}
+
+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);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, arrow->borderColorObj);
+ XColor *arrowColor = Tk_GetColorFromObj(tkwin, arrow->colorObj);
+ int relief = TK_RELIEF_RAISED;
+ int borderWidth = 2;
+
+ Tk_GetReliefFromObj(NULL, arrow->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(
+ tkwin, d, border, b.x, b.y, b.width, b.height, 0, TK_RELIEF_FLAT);
+ DrawBorder(tkwin,d,border,borderColor,b,borderWidth,relief);
+
+ FillArrow(Tk_Display(tkwin), d, Tk_GCForColor(arrowColor, d),
+ Ttk_PadBox(b, ArrowPadding), direction);
+}
+
+static Ttk_ElementSpec ArrowElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(ArrowElement),
+ ArrowElementOptions,
+ ArrowElementSize,
+ ArrowElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Menubutton indicator:
+ * Draw an arrow in the direction where the menu will be posted.
+ */
+
+#define MENUBUTTON_ARROW_SIZE 5
+
+typedef struct {
+ Tcl_Obj *directionObj;
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *colorObj;
+} MenubuttonArrowElement;
+
+static const char *directionStrings[] = { /* See also: button.c */
+ "above", "below", "left", "right", "flush", NULL
+};
+enum { POST_ABOVE, POST_BELOW, POST_LEFT, POST_RIGHT, POST_FLUSH };
+
+static Ttk_ElementOptionSpec MenubuttonArrowElementOptions[] =
+{
+ { "-direction", TK_OPTION_STRING,
+ Tk_Offset(MenubuttonArrowElement,directionObj), "below" },
+ { "-arrowsize", TK_OPTION_PIXELS,
+ Tk_Offset(MenubuttonArrowElement,sizeObj), STRINGIFY(MENUBUTTON_ARROW_SIZE)},
+ { "-arrowcolor",TK_OPTION_COLOR,
+ Tk_Offset(MenubuttonArrowElement,colorObj), "black"},
+ { NULL }
+};
+
+static Ttk_Padding MenubuttonArrowPadding = { 3, 0, 3, 0 };
+
+static void MenubuttonArrowElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ MenubuttonArrowElement *arrow = elementRecord;
+ int size = MENUBUTTON_ARROW_SIZE;
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &size);
+ *widthPtr = *heightPtr = 2 * size + 1;
+ *paddingPtr = MenubuttonArrowPadding;
+}
+
+static void MenubuttonArrowElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ MenubuttonArrowElement *arrow = elementRecord;
+ XColor *arrowColor = Tk_GetColorFromObj(tkwin, arrow->colorObj);
+ GC gc = Tk_GCForColor(arrowColor, d);
+ int size = MENUBUTTON_ARROW_SIZE;
+ int postDirection = POST_BELOW;
+ ArrowDirection arrowDirection = ARROW_DOWN;
+ int width, height;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &size);
+ Tcl_GetIndexFromObj(NULL, arrow->directionObj, directionStrings,
+ ""/*message*/, 0/*flags*/, &postDirection);
+
+ /* ... this might not be such a great idea ... */
+ switch (postDirection) {
+ case POST_ABOVE: arrowDirection = ARROW_UP; break;
+ case POST_BELOW: arrowDirection = ARROW_DOWN; break;
+ case POST_LEFT: arrowDirection = ARROW_LEFT; break;
+ case POST_RIGHT: arrowDirection = ARROW_RIGHT; break;
+ case POST_FLUSH: arrowDirection = ARROW_DOWN; break;
+ }
+
+ ArrowSize(size, arrowDirection, &width, &height);
+ b = Ttk_PadBox(b, MenubuttonArrowPadding);
+ b = Ttk_AnchorBox(b, width, height, TK_ANCHOR_CENTER);
+ FillArrow(Tk_Display(tkwin), d, gc, b, arrowDirection);
+}
+
+static Ttk_ElementSpec MenubuttonArrowElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(MenubuttonArrowElement),
+ MenubuttonArrowElementOptions,
+ MenubuttonArrowElementSize,
+ MenubuttonArrowElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Trough element
+ *
+ * Used in scrollbars and the scale.
+ *
+ * The -groovewidth option can be used to set the size of the short axis
+ * for the drawn area. This will not affect the geometry, but can be used
+ * to draw a thin centered trough inside the packet alloted. This is used
+ * to show a win32-style scale widget. Use -1 or a large number to use the
+ * full area (default).
+ *
+ */
+
+typedef struct
+{
+ Tcl_Obj *colorObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *grooveWidthObj;
+ Tcl_Obj *orientObj;
+} TroughElement;
+
+static Ttk_ElementOptionSpec TroughElementOptions[] =
+{
+ { "-orient", TK_OPTION_ANY,
+ Tk_Offset(TroughElement, orientObj), "horizontal" },
+ { "-troughborderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(TroughElement,borderWidthObj), "1" },
+ { "-troughcolor", TK_OPTION_BORDER,
+ Tk_Offset(TroughElement,colorObj), DEFAULT_BACKGROUND },
+ { "-troughrelief",TK_OPTION_RELIEF,
+ Tk_Offset(TroughElement,reliefObj), "sunken" },
+ { "-groovewidth", TK_OPTION_PIXELS,
+ Tk_Offset(TroughElement,grooveWidthObj), "-1" },
+ { NULL }
+};
+
+static void TroughElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TroughElement *troughPtr = elementRecord;
+ int borderWidth = 2, grooveWidth = 0;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->borderWidthObj, &borderWidth);
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->grooveWidthObj, &grooveWidth);
+
+ if (grooveWidth <= 0) {
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+ }
+}
+
+static void TroughElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ TroughElement *troughPtr = elementRecord;
+ Tk_3DBorder border = NULL;
+ int borderWidth = 2, relief, groove, orient;
+
+ border = Tk_Get3DBorderFromObj(tkwin, troughPtr->colorObj);
+ Ttk_GetOrientFromObj(NULL, troughPtr->orientObj, &orient);
+ Tk_GetReliefFromObj(NULL, troughPtr->reliefObj, &relief);
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->borderWidthObj, &borderWidth);
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->grooveWidthObj, &groove);
+
+ if (groove != -1 && groove < b.height && groove < b.width) {
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ b.y = b.y + b.height/2 - groove/2;
+ b.height = groove;
+ } else {
+ b.x = b.x + b.width/2 - groove/2;
+ b.width = groove;
+ }
+ }
+
+ Tk_Fill3DRectangle(tkwin, d, border, b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+}
+
+static Ttk_ElementSpec TroughElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(TroughElement),
+ TroughElementOptions,
+ TroughElementSize,
+ TroughElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Thumb element.
+ */
+
+typedef struct
+{
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *firstObj;
+ Tcl_Obj *lastObj;
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderColorObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *orientObj;
+} ThumbElement;
+
+static Ttk_ElementOptionSpec ThumbElementOptions[] =
+{
+ { "-width", TK_OPTION_PIXELS, Tk_Offset(ThumbElement,sizeObj),
+ STRINGIFY(SCROLLBAR_WIDTH) },
+ { "-background", TK_OPTION_BORDER, Tk_Offset(ThumbElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-bordercolor", TK_OPTION_COLOR, Tk_Offset(ThumbElement,borderColorObj),
+ "black" },
+ { "-relief", TK_OPTION_RELIEF,Tk_Offset(ThumbElement,reliefObj),"raised" },
+ { "-orient", TK_OPTION_ANY,Tk_Offset(ThumbElement,orientObj),"horizontal"},
+ { NULL }
+};
+
+static void ThumbElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ThumbElement *thumb = elementRecord;
+ int orient, size;
+ Tk_GetPixelsFromObj(NULL, tkwin, thumb->sizeObj, &size);
+ Ttk_GetOrientFromObj(NULL, thumb->orientObj, &orient);
+
+ if (orient == TTK_ORIENT_VERTICAL) {
+ *widthPtr = size;
+ *heightPtr = MIN_THUMB_SIZE;
+ } else {
+ *widthPtr = MIN_THUMB_SIZE;
+ *heightPtr = size;
+ }
+}
+
+static void ThumbElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ThumbElement *thumb = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, thumb->borderObj);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, thumb->borderColorObj);
+ int relief = TK_RELIEF_RAISED;
+ int borderWidth = 2;
+
+ /*
+ * Don't draw the thumb if we are disabled.
+ * This makes it behave like Windows ... if that's what we want.
+ if (state & TTK_STATE_DISABLED)
+ return;
+ */
+
+ Tk_GetReliefFromObj(NULL, thumb->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(
+ tkwin, d, border, b.x,b.y,b.width,b.height, 0, TK_RELIEF_FLAT);
+ DrawBorder(tkwin, d, border, borderColor, b, borderWidth, relief);
+}
+
+static Ttk_ElementSpec ThumbElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(ThumbElement),
+ ThumbElementOptions,
+ ThumbElementSize,
+ ThumbElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Slider element.
+ *
+ * This is the moving part of the scale widget.
+ *
+ * The slider element is the thumb in the scale widget. This is drawn
+ * as an arrow-type element that can point up, down, left or right.
+ *
+ */
+
+typedef struct
+{
+ Tcl_Obj *lengthObj; /* Long axis dimension */
+ Tcl_Obj *thicknessObj; /* Short axis dimension */
+ Tcl_Obj *reliefObj; /* Relief for this object */
+ Tcl_Obj *borderObj; /* Border / background color */
+ Tcl_Obj *borderColorObj; /* Additional border color */
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *orientObj; /* Orientation of overall slider */
+} SliderElement;
+
+static Ttk_ElementOptionSpec SliderElementOptions[] =
+{
+ { "-sliderlength", TK_OPTION_PIXELS, Tk_Offset(SliderElement,lengthObj),
+ "15" },
+ { "-sliderthickness",TK_OPTION_PIXELS,Tk_Offset(SliderElement,thicknessObj),
+ "15" },
+ { "-sliderrelief", TK_OPTION_RELIEF, Tk_Offset(SliderElement,reliefObj),
+ "raised" },
+ { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(SliderElement,borderWidthObj),
+ STRINGIFY(BORDERWIDTH) },
+ { "-background", TK_OPTION_BORDER, Tk_Offset(SliderElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-bordercolor", TK_OPTION_COLOR, Tk_Offset(ThumbElement,borderColorObj),
+ "black" },
+ { "-orient", TK_OPTION_ANY, Tk_Offset(SliderElement,orientObj),
+ "horizontal" },
+ { NULL }
+};
+
+static void SliderElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SliderElement *slider = elementRecord;
+ int orient, length, thickness, borderWidth;
+
+ Ttk_GetOrientFromObj(NULL, slider->orientObj, &orient);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->borderWidthObj, &borderWidth);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->lengthObj, &length);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->thicknessObj, &thickness);
+
+ switch (orient) {
+ case TTK_ORIENT_VERTICAL:
+ *widthPtr = thickness + (borderWidth *2);
+ *heightPtr = *widthPtr/2;
+ break;
+
+ case TTK_ORIENT_HORIZONTAL:
+ *heightPtr = thickness + (borderWidth *2);
+ *widthPtr = *heightPtr/2;
+ break;
+ }
+}
+
+static void SliderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SliderElement *slider = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, slider->borderObj);
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, slider->borderColorObj);
+ int relief = TK_RELIEF_RAISED, borderWidth = 2;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, slider->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height,
+ borderWidth, TK_RELIEF_FLAT);
+ DrawBorder(tkwin, d, border, borderColor, b, borderWidth, relief);
+}
+
+static Ttk_ElementSpec SliderElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(SliderElement),
+ SliderElementOptions,
+ SliderElementSize,
+ SliderElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Tree indicator element.
+ */
+
+#define TTK_STATE_OPEN TTK_STATE_USER1 /* XREF: treeview.c */
+#define TTK_STATE_LEAF TTK_STATE_USER2
+
+typedef struct
+{
+ Tcl_Obj *colorObj;
+ Tcl_Obj *marginObj;
+ Tcl_Obj *diameterObj;
+} TreeitemIndicator;
+
+static Ttk_ElementOptionSpec TreeitemIndicatorOptions[] =
+{
+ { "-foreground", TK_OPTION_COLOR,
+ Tk_Offset(TreeitemIndicator,colorObj), DEFAULT_FOREGROUND },
+ { "-diameter", TK_OPTION_PIXELS,
+ Tk_Offset(TreeitemIndicator,diameterObj), "6" },
+ { "-indicatormargins", TK_OPTION_STRING,
+ Tk_Offset(TreeitemIndicator,marginObj), "0 2 4 2" },
+ {NULL}
+};
+
+static void TreeitemIndicatorSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TreeitemIndicator *indicator = elementRecord;
+ int diameter = 0;
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, paddingPtr);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->diameterObj, &diameter);
+ *widthPtr = *heightPtr = diameter;
+}
+
+static void TreeitemIndicatorDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ TreeitemIndicator *indicator = elementRecord;
+ XColor *color = Tk_GetColorFromObj(tkwin, indicator->colorObj);
+ GC gc = Tk_GCForColor(color, d);
+ Ttk_Padding padding = Ttk_UniformPadding(0);
+ int w = WIN32_XDRAWLINE_HACK;
+ int cx, cy;
+
+ if (state & TTK_STATE_LEAF) {
+ /* don't draw anything ... */
+ return;
+ }
+
+ Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginObj,&padding);
+ b = Ttk_PadBox(b, padding);
+
+ XDrawRectangle(Tk_Display(tkwin), d, gc,
+ b.x, b.y, b.width, b.height);
+
+ cx = b.x + b.width / 2;
+ cy = b.y + b.height / 2;
+ XDrawLine(Tk_Display(tkwin), d, gc, b.x+2, cy, b.x+b.width-2+w, cy);
+
+ if (!(state & TTK_STATE_OPEN)) {
+ /* turn '-' into a '+' */
+ XDrawLine(Tk_Display(tkwin), d, gc, cx, b.y+2, cx, b.y+b.height-2+w);
+ }
+}
+
+static Ttk_ElementSpec TreeitemIndicatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(TreeitemIndicator),
+ TreeitemIndicatorOptions,
+ TreeitemIndicatorSize,
+ TreeitemIndicatorDraw
+};
+
+
+
+
+/*------------------------------------------------------------------------
+ * AltTheme_Init --
+ * Install alternate theme.
+ */
+int AltTheme_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_CreateTheme(interp, "alt", NULL);
+
+ if (!theme) {
+ return TCL_ERROR;
+ }
+
+ Ttk_RegisterElement(interp, theme, "border", &BorderElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "Checkbutton.indicator",
+ &IndicatorElementSpec, &checkbutton_spec);
+ Ttk_RegisterElement(interp, theme, "Radiobutton.indicator",
+ &IndicatorElementSpec, &radiobutton_spec);
+ Ttk_RegisterElement(interp, theme, "Menubutton.indicator",
+ &MenubuttonArrowElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "field", &FieldElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "trough", &TroughElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "thumb", &ThumbElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "slider", &SliderElementSpec, 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, "arrow",
+ &ArrowElementSpec, &ArrowElements[0]);
+
+ Ttk_RegisterElement(interp, theme, "Treeitem.indicator",
+ &TreeitemIndicatorElementSpec, 0);
+
+ Tcl_PkgProvide(interp, "ttk::theme::alt", TTK_VERSION);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkElements.c b/generic/ttk/ttkElements.c
new file mode 100644
index 0000000..8cd5c6b
--- /dev/null
+++ b/generic/ttk/ttkElements.c
@@ -0,0 +1,1447 @@
+/* $Id: ttkElements.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright (c) 2003, Joe English
+ *
+ * Default implementation for themed elements.
+ *
+ */
+
+#include <tcl.h>
+#include <tk.h>
+#include <string.h>
+#include "ttkTheme.h"
+
+#define DEFAULT_BORDERWIDTH "2"
+#define DEFAULT_ARROW_SIZE "15"
+#define MIN_THUMB_SIZE 10
+
+/*----------------------------------------------------------------------
+ * +++ Null element. Does nothing; used as a stub.
+ * Null element methods, option table and element spec are public,
+ * and may be used in other engines.
+ */
+
+/* public */ Ttk_ElementOptionSpec NullElementOptions[] = { {NULL} };
+
+/* public */ void
+NullElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+}
+
+/* public */ void
+NullElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+}
+
+/* public */ Ttk_ElementSpec NullElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ NullElementGeometry,
+ NullElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Background element.
+ *
+ * This element simply clears the entire widget area
+ * with the background color. (NB: ignores parcel).
+ *
+ * Ttk_GetLayout() automatically includes a background element.
+ */
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+} BackgroundElement;
+
+static Ttk_ElementOptionSpec BackgroundElementOptions[] =
+{
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(BackgroundElement,backgroundObj), DEFAULT_BACKGROUND },
+ {NULL}
+};
+
+static void
+BackgroundElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+}
+
+static void
+BackgroundElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ BackgroundElement *bg = elementRecord;
+ Tk_3DBorder backgroundPtr = Tk_Get3DBorderFromObj(tkwin,bg->backgroundObj);
+
+ XFillRectangle(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, backgroundPtr, TK_3D_FLAT_GC),
+ 0,0, Tk_Width(tkwin), Tk_Height(tkwin));
+}
+
+static Ttk_ElementSpec BackgroundElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(BackgroundElement),
+ BackgroundElementOptions,
+ BackgroundElementGeometry,
+ BackgroundElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Border element.
+ */
+
+typedef struct {
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+} BorderElement;
+
+static Ttk_ElementOptionSpec BorderElementOptions[] =
+{
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(BorderElement,borderObj), DEFAULT_BACKGROUND },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(BorderElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(BorderElement,reliefObj), "flat" },
+ {NULL}
+};
+
+static void
+BorderElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ BorderElement *bd = elementRecord;
+ int borderWidth = 0;
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void
+BorderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ BorderElement *bd = elementRecord;
+ Tk_3DBorder border = NULL;
+ int borderWidth = 1, relief = TK_RELIEF_FLAT;
+
+ border = Tk_Get3DBorderFromObj(tkwin, bd->borderObj);
+ Tcl_GetIntFromObj(NULL, bd->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, bd->reliefObj, &relief);
+
+ if (border && borderWidth > 0 && relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height, borderWidth,relief);
+ }
+}
+
+static Ttk_ElementSpec BorderElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(BorderElement),
+ BorderElementOptions,
+ BorderElementGeometry,
+ BorderElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Field element.
+ * Used for editable fields.
+ */
+typedef struct {
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+} FieldElement;
+
+static Ttk_ElementOptionSpec FieldElementOptions[] = {
+ { "-fieldbackground", TK_OPTION_BORDER,
+ Tk_Offset(FieldElement,borderObj), "white" },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(FieldElement,borderWidthObj), "2" },
+ {NULL}
+};
+
+static void
+FieldElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ FieldElement *field = elementRecord;
+ int borderWidth = 2;
+ Tk_GetPixelsFromObj(NULL, tkwin, field->borderWidthObj, &borderWidth);
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void
+FieldElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ FieldElement *field = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, field->borderObj);
+ int borderWidth = 2;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, field->borderWidthObj, &borderWidth);
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height, borderWidth, TK_RELIEF_SUNKEN);
+}
+
+static Ttk_ElementSpec FieldElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(FieldElement),
+ FieldElementOptions,
+ FieldElementGeometry,
+ FieldElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Padding element.
+ *
+ * This element has no visual representation, only geometry.
+ * It adds a (possibly non-uniform) internal border.
+ * In addition, if "-shiftrelief" is specified,
+ * adds additional pixels to shift child elements "in" or "out"
+ * depending on the -relief.
+ */
+
+typedef struct {
+ Tcl_Obj *paddingObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *shiftreliefObj;
+} PaddingElement;
+
+static Ttk_ElementOptionSpec PaddingElementOptions[] =
+{
+ { "-padding", TK_OPTION_STRING,
+ Tk_Offset(PaddingElement,paddingObj), "0" },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(PaddingElement,reliefObj), "flat" },
+ { "-shiftrelief", TK_OPTION_INT,
+ Tk_Offset(PaddingElement,shiftreliefObj), "0" },
+ {NULL}
+};
+
+static void
+PaddingElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ PaddingElement *padding = elementRecord;
+ int shiftRelief = 0;
+ int relief = TK_RELIEF_FLAT;
+ Ttk_Padding pad;
+
+ Tk_GetReliefFromObj(NULL, padding->reliefObj, &relief);
+ Tcl_GetIntFromObj(NULL, padding->shiftreliefObj, &shiftRelief);
+ Ttk_GetPaddingFromObj(NULL,tkwin,padding->paddingObj,&pad);
+ *paddingPtr = Ttk_RelievePadding(pad, relief, shiftRelief);
+}
+
+static void
+PaddingElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ /* No-op */
+}
+
+static Ttk_ElementSpec PaddingElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(PaddingElement),
+ PaddingElementOptions,
+ PaddingElementGeometry,
+ PaddingElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Focus ring element.
+ * Draws a dashed focus ring, if the widget has keyboard focus.
+ */
+typedef struct {
+ Tcl_Obj *focusColorObj;
+ Tcl_Obj *focusThicknessObj;
+} FocusElement;
+
+/*
+ * DrawFocusRing --
+ * Draw a dotted rectangle to indicate focus.
+ */
+static void DrawFocusRing(
+ Tk_Window tkwin, Drawable d, Tcl_Obj *colorObj, Ttk_Box b)
+{
+ XColor *color = Tk_GetColorFromObj(tkwin, colorObj);
+ unsigned long mask = 0UL;
+ XGCValues gcvalues;
+ GC gc;
+
+ gcvalues.foreground = color->pixel;
+ gcvalues.line_style = LineOnOffDash;
+ gcvalues.line_width = 1;
+ gcvalues.dashes = 1;
+ gcvalues.dash_offset = 1;
+ mask = GCForeground | GCLineStyle | GCDashList | GCDashOffset | GCLineWidth;
+
+ gc = Tk_GetGC(tkwin, mask, &gcvalues);
+ XDrawRectangle(Tk_Display(tkwin), d, gc, b.x, b.y, b.width-1, b.height-1);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+}
+
+static Ttk_ElementOptionSpec FocusElementOptions[] = {
+ { "-focuscolor",TK_OPTION_COLOR,
+ Tk_Offset(FocusElement,focusColorObj), "black" },
+ { "-focusthickness",TK_OPTION_PIXELS,
+ Tk_Offset(FocusElement,focusThicknessObj), "1" },
+ {NULL}
+};
+
+static void
+FocusElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ FocusElement *focus = elementRecord;
+ int focusThickness = 0;
+
+ Tcl_GetIntFromObj(NULL, focus->focusThicknessObj, &focusThickness);
+ *paddingPtr = Ttk_UniformPadding((short)focusThickness);
+}
+
+static void
+FocusElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ FocusElement *focus = elementRecord;
+ int focusThickness = 0;
+
+ if (state & TTK_STATE_FOCUS) {
+ Tcl_GetIntFromObj(NULL,focus->focusThicknessObj,&focusThickness);
+ DrawFocusRing(tkwin, d, focus->focusColorObj, b);
+ }
+}
+
+static Ttk_ElementSpec FocusElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(FocusElement),
+ FocusElementOptions,
+ FocusElementGeometry,
+ FocusElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Separator element.
+ * Just draws a horizontal or vertical bar.
+ * Three elements are defined: horizontal, vertical, and general;
+ * the general separator checks the "-orient" option.
+ */
+
+typedef struct
+{
+ Tcl_Obj *orientObj;
+ Tcl_Obj *borderObj;
+} SeparatorElement;
+
+static Ttk_ElementOptionSpec SeparatorElementOptions[] =
+{
+ { "-orient", TK_OPTION_ANY,
+ Tk_Offset(SeparatorElement, orientObj), "horizontal" },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(SeparatorElement,borderObj), DEFAULT_BACKGROUND },
+ {NULL}
+};
+
+static void
+SeparatorElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *widthPtr = *heightPtr = 2;
+}
+
+static void
+HorizontalSeparatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SeparatorElement *separator = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, separator->borderObj);
+ GC lightGC = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+ GC darkGC = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+
+ XDrawLine(Tk_Display(tkwin), d, darkGC, b.x, b.y, b.x + b.width, b.y);
+ XDrawLine(Tk_Display(tkwin), d, lightGC, b.x, b.y+1, b.x + b.width, b.y+1);
+}
+
+static void
+VerticalSeparatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SeparatorElement *separator = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, separator->borderObj);
+ GC lightGC = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+ GC darkGC = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+
+ XDrawLine(Tk_Display(tkwin), d, darkGC, b.x, b.y, b.x, b.y + b.height);
+ XDrawLine(Tk_Display(tkwin), d, lightGC, b.x+1, b.y, b.x+1, b.y+b.height);
+}
+
+static void
+GeneralSeparatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SeparatorElement *separator = elementRecord;
+ int orient;
+ Ttk_GetOrientFromObj(NULL, separator->orientObj, &orient);
+ switch (orient) {
+ case TTK_ORIENT_HORIZONTAL:
+ HorizontalSeparatorElementDraw(
+ clientData, elementRecord, tkwin, d, b, state);
+ break;
+ case TTK_ORIENT_VERTICAL:
+ VerticalSeparatorElementDraw(
+ clientData, elementRecord, tkwin, d, b, state);
+ break;
+ }
+}
+
+static Ttk_ElementSpec HorizontalSeparatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(SeparatorElement),
+ SeparatorElementOptions,
+ SeparatorElementGeometry,
+ HorizontalSeparatorElementDraw
+};
+
+static Ttk_ElementSpec VerticalSeparatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(SeparatorElement),
+ SeparatorElementOptions,
+ SeparatorElementGeometry,
+ HorizontalSeparatorElementDraw
+};
+
+static Ttk_ElementSpec SeparatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(SeparatorElement),
+ SeparatorElementOptions,
+ SeparatorElementGeometry,
+ GeneralSeparatorElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Sizegrip: lower-right corner grip handle for resizing window.
+ */
+
+typedef struct
+{
+ Tcl_Obj *backgroundObj;
+} SizegripElement;
+
+static Ttk_ElementOptionSpec SizegripOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(SizegripElement,backgroundObj), DEFAULT_BACKGROUND },
+ {0,0,0,0}
+};
+
+static void SizegripSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ int gripCount = 3, gripSpace = 2, gripThickness = 3;
+ *widthPtr = *heightPtr = gripCount * (gripSpace + gripThickness);
+}
+
+static void SizegripDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ SizegripElement *grip = elementRecord;
+ int gripCount = 3, gripSpace = 2;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, grip->backgroundObj);
+ GC lightGC = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC);
+ GC darkGC = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC);
+ int x1 = b.x + b.width-1, y1 = b.y + b.height-1, x2 = x1, y2 = y1;
+
+ while (gripCount--) {
+ x1 -= gripSpace; y2 -= gripSpace;
+ XDrawLine(Tk_Display(tkwin), d, darkGC, x1,y1, x2,y2); --x1; --y2;
+ XDrawLine(Tk_Display(tkwin), d, darkGC, x1,y1, x2,y2); --x1; --y2;
+ XDrawLine(Tk_Display(tkwin), d, lightGC, x1,y1, x2,y2); --x1; --y2;
+ }
+}
+
+static Ttk_ElementSpec SizegripElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SizegripElement),
+ SizegripOptions,
+ SizegripSize,
+ SizegripDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Indicator element.
+ *
+ * Draws the on/off indicator for checkbuttons and radiobuttons.
+ *
+ * Draws a 3-D square (or diamond), raised if off, sunken if on.
+ *
+ * This is actually a regression from Tk 8.5 back to the ugly old Motif
+ * style; use "altTheme" for the newer, nicer version.
+ */
+
+typedef struct
+{
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *colorObj;
+ Tcl_Obj *diameterObj;
+ Tcl_Obj *marginObj;
+ Tcl_Obj *borderWidthObj;
+} IndicatorElement;
+
+static Ttk_ElementOptionSpec IndicatorElementOptions[] =
+{
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(IndicatorElement,backgroundObj), DEFAULT_BACKGROUND },
+ { "-indicatorcolor", TK_OPTION_BORDER,
+ Tk_Offset(IndicatorElement,colorObj), DEFAULT_BACKGROUND },
+ { "-indicatorrelief", TK_OPTION_RELIEF,
+ Tk_Offset(IndicatorElement,reliefObj), "raised" },
+ { "-indicatordiameter", TK_OPTION_PIXELS,
+ Tk_Offset(IndicatorElement,diameterObj), "12" },
+ { "-indicatormargin", TK_OPTION_STRING,
+ Tk_Offset(IndicatorElement,marginObj), "0 2 4 2" },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(IndicatorElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ {NULL}
+};
+
+/*
+ * Checkbutton indicators (default): 3-D square.
+ */
+static void
+SquareIndicatorElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ IndicatorElement *indicator = elementRecord;
+ int diameter = 0;
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, paddingPtr);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->diameterObj, &diameter);
+ *widthPtr = *heightPtr = diameter;
+}
+
+static void
+SquareIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ IndicatorElement *indicator = elementRecord;
+ Tk_3DBorder border = 0, interior = 0;
+ int relief = TK_RELIEF_RAISED;
+ Ttk_Padding padding;
+ int borderWidth = 2;
+ int diameter;
+
+ interior = Tk_Get3DBorderFromObj(tkwin, indicator->colorObj);
+ border = Tk_Get3DBorderFromObj(tkwin, indicator->backgroundObj);
+ Tcl_GetIntFromObj(NULL,indicator->borderWidthObj,&borderWidth);
+ Tk_GetReliefFromObj(NULL,indicator->reliefObj,&relief);
+ Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginObj,&padding);
+
+ b = Ttk_PadBox(b, padding);
+
+ diameter = b.width < b.height ? b.width : b.height;
+ Tk_Fill3DRectangle(tkwin, d, interior, b.x, b.y,
+ diameter, diameter,borderWidth, TK_RELIEF_FLAT);
+ Tk_Draw3DRectangle(tkwin, d, border, b.x, b.y,
+ diameter, diameter, borderWidth, relief);
+}
+
+/*
+ * Radiobutton indicators: 3-D diamond.
+ */
+static void
+DiamondIndicatorElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ IndicatorElement *indicator = elementRecord;
+ int diameter = 0;
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginObj, paddingPtr);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->diameterObj, &diameter);
+ *widthPtr = *heightPtr = diameter + 3;
+}
+
+static void
+DiamondIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ IndicatorElement *indicator = elementRecord;
+ Tk_3DBorder border = 0, interior = 0;
+ int borderWidth = 2;
+ int relief = TK_RELIEF_RAISED;
+ int diameter, radius;
+ XPoint points[4];
+ Ttk_Padding padding;
+
+ interior = Tk_Get3DBorderFromObj(tkwin, indicator->colorObj);
+ border = Tk_Get3DBorderFromObj(tkwin, indicator->backgroundObj);
+ Tcl_GetIntFromObj(NULL,indicator->borderWidthObj,&borderWidth);
+ Tk_GetReliefFromObj(NULL,indicator->reliefObj,&relief);
+ Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginObj,&padding);
+
+ b = Ttk_PadBox(b, padding);
+
+ diameter = b.width < b.height ? b.width : b.height;
+ radius = diameter / 2;
+
+ points[0].x = b.x;
+ points[0].y = b.y + radius;
+ points[1].x = b.x + radius;
+ points[1].y = b.y + 2*radius;
+ points[2].x = b.x + 2*radius;
+ points[2].y = b.y + radius;
+ points[3].x = b.x + radius;
+ points[3].y = b.y;
+
+ Tk_Fill3DPolygon(tkwin,d,interior,points,4,borderWidth,TK_RELIEF_FLAT);
+ Tk_Draw3DPolygon(tkwin,d,border,points,4,borderWidth,relief);
+}
+
+static Ttk_ElementSpec CheckbuttonIndicatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(IndicatorElement),
+ IndicatorElementOptions,
+ SquareIndicatorElementGeometry,
+ SquareIndicatorElementDraw
+};
+
+static Ttk_ElementSpec RadiobuttonIndicatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(IndicatorElement),
+ IndicatorElementOptions,
+ DiamondIndicatorElementGeometry,
+ DiamondIndicatorElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Menubutton indicators.
+ *
+ * These aren't functional like radio/check indicators,
+ * they're just affordability indicators.
+ *
+ * Standard Tk sets the indicator size to 4.0 mm by 1.7 mm.
+ * I have no idea where these numbers came from.
+ */
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *widthObj;
+ Tcl_Obj *heightObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *marginObj;
+} MenuIndicatorElement;
+
+static Ttk_ElementOptionSpec MenuIndicatorElementOptions[] =
+{
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(MenuIndicatorElement,backgroundObj), DEFAULT_BACKGROUND },
+ { "-indicatorwidth", TK_OPTION_PIXELS,
+ Tk_Offset(MenuIndicatorElement,widthObj), "4.0m" },
+ { "-indicatorheight", TK_OPTION_PIXELS,
+ Tk_Offset(MenuIndicatorElement,heightObj), "1.7m" },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(MenuIndicatorElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { "-indicatorrelief", TK_OPTION_RELIEF,
+ Tk_Offset(MenuIndicatorElement,reliefObj),"raised" },
+ { "-indicatormargin", TK_OPTION_STRING,
+ Tk_Offset(MenuIndicatorElement,marginObj), "5 0" },
+ { NULL }
+};
+
+static void
+MenuIndicatorElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ MenuIndicatorElement *mi = elementRecord;
+ Tk_GetPixelsFromObj(NULL, tkwin, mi->widthObj, widthPtr);
+ Tk_GetPixelsFromObj(NULL, tkwin, mi->heightObj, heightPtr);
+ Ttk_GetPaddingFromObj(NULL,tkwin,mi->marginObj,paddingPtr);
+}
+
+static void
+MenuIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ MenuIndicatorElement *mi = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, mi->backgroundObj);
+ Ttk_Padding margins;
+ int borderWidth = 2;
+
+ Ttk_GetPaddingFromObj(NULL,tkwin,mi->marginObj,&margins);
+ b = Ttk_PadBox(b, margins);
+ Tk_GetPixelsFromObj(NULL, tkwin, mi->borderWidthObj, &borderWidth);
+ Tk_Fill3DRectangle(tkwin, d, border, b.x, b.y, b.width, b.height,
+ borderWidth, TK_RELIEF_RAISED);
+}
+
+static Ttk_ElementSpec MenuIndicatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(MenuIndicatorElement),
+ MenuIndicatorElementOptions,
+ MenuIndicatorElementGeometry,
+ MenuIndicatorElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Arrow elements.
+ *
+ * Draws a solid triangle inside a box.
+ * clientData is an enum ArrowDirection pointer.
+ */
+
+static int ArrowElements[] = { ARROW_UP, ARROW_DOWN, ARROW_LEFT, ARROW_RIGHT };
+typedef struct
+{
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *colorObj;
+} ArrowElement;
+
+static Ttk_ElementOptionSpec ArrowElementOptions[] =
+{
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(ArrowElement,borderObj), DEFAULT_BACKGROUND },
+ { "-relief",TK_OPTION_RELIEF,
+ Tk_Offset(ArrowElement,reliefObj),"raised"},
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(ArrowElement,borderWidthObj), "1" },
+ { "-arrowcolor",TK_OPTION_COLOR,
+ Tk_Offset(ArrowElement,colorObj),"black"},
+ { "-arrowsize", TK_OPTION_PIXELS,
+ Tk_Offset(ArrowElement,sizeObj), "14" },
+ { NULL }
+};
+
+static Ttk_Padding ArrowPadding = { 3,3,3,3 };
+
+static void
+ArrowElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ArrowElement *arrow = elementRecord;
+ int direction = *(int *)clientData;
+ int width = 14;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, arrow->sizeObj, &width);
+ width -= Ttk_PaddingWidth(ArrowPadding);
+ ArrowSize(width/2, direction, widthPtr, heightPtr);
+ *paddingPtr = ArrowPadding;
+}
+
+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);
+ XColor *arrowColor = Tk_GetColorFromObj(tkwin, arrow->colorObj);
+ int relief = TK_RELIEF_RAISED;
+ int borderWidth = 1;
+
+ Tk_GetReliefFromObj(NULL, arrow->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(
+ tkwin, d, border, b.x, b.y, b.width, b.height, borderWidth, relief);
+
+ FillArrow(Tk_Display(tkwin), d, Tk_GCForColor(arrowColor, d),
+ Ttk_PadBox(b, ArrowPadding), direction);
+}
+
+static Ttk_ElementSpec ArrowElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(ArrowElement),
+ ArrowElementOptions,
+ ArrowElementGeometry,
+ ArrowElementDraw
+};
+
+
+/*----------------------------------------------------------------------
+ * +++ Trough element.
+ *
+ * Used in scrollbars and scales in place of "border".
+ */
+
+typedef struct
+{
+ Tcl_Obj *colorObj;
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *reliefObj;
+} TroughElement;
+
+static Ttk_ElementOptionSpec TroughElementOptions[] =
+{
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(TroughElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { "-troughcolor", TK_OPTION_BORDER,
+ Tk_Offset(TroughElement,colorObj), DEFAULT_BACKGROUND },
+ { "-troughrelief",TK_OPTION_RELIEF,
+ Tk_Offset(TroughElement,reliefObj), "sunken" },
+ { NULL }
+};
+
+static void
+TroughElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TroughElement *troughPtr = elementRecord;
+ int borderWidth = 2;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->borderWidthObj, &borderWidth);
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void
+TroughElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ TroughElement *troughPtr = elementRecord;
+ Tk_3DBorder border = NULL;
+ int borderWidth = 2, relief = TK_RELIEF_SUNKEN;
+
+ border = Tk_Get3DBorderFromObj(tkwin, troughPtr->colorObj);
+ Tk_GetReliefFromObj(NULL, troughPtr->reliefObj, &relief);
+ Tk_GetPixelsFromObj(NULL, tkwin, troughPtr->borderWidthObj, &borderWidth);
+
+ Tk_Fill3DRectangle(tkwin, d, border, b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+}
+
+static Ttk_ElementSpec TroughElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(TroughElement),
+ TroughElementOptions,
+ TroughElementGeometry,
+ TroughElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Thumb element.
+ *
+ * Used in scrollbars.
+ */
+
+typedef struct
+{
+ Tcl_Obj *orientObj;
+ Tcl_Obj *thicknessObj;
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *borderObj;
+ Tcl_Obj *borderWidthObj;
+} ThumbElement;
+
+static Ttk_ElementOptionSpec ThumbElementOptions[] =
+{
+ { "-orient", TK_OPTION_ANY,
+ Tk_Offset(ThumbElement, orientObj), "horizontal" },
+ { "-width", TK_OPTION_PIXELS,
+ Tk_Offset(ThumbElement,thicknessObj), DEFAULT_ARROW_SIZE },
+ { "-relief", TK_OPTION_RELIEF,
+ Tk_Offset(ThumbElement,reliefObj), "raised" },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(ThumbElement,borderObj), DEFAULT_BACKGROUND },
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(ThumbElement,borderWidthObj), DEFAULT_BORDERWIDTH },
+ { NULL }
+};
+
+static void
+ThumbElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ThumbElement *thumb = elementRecord;
+ int orient, thickness;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, thumb->thicknessObj, &thickness);
+ Ttk_GetOrientFromObj(NULL, thumb->orientObj, &orient);
+
+ if (orient == TTK_ORIENT_VERTICAL) {
+ *widthPtr = thickness;
+ *heightPtr = MIN_THUMB_SIZE;
+ } else {
+ *widthPtr = MIN_THUMB_SIZE;
+ *heightPtr = thickness;
+ }
+}
+
+static void
+ThumbElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ThumbElement *thumb = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, thumb->borderObj);
+ int borderWidth = 2, relief = TK_RELIEF_RAISED;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, thumb->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, thumb->reliefObj, &relief);
+ Tk_Fill3DRectangle(tkwin, d, border, b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+}
+
+static Ttk_ElementSpec ThumbElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(ThumbElement),
+ ThumbElementOptions,
+ ThumbElementGeometry,
+ ThumbElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Slider element.
+ *
+ * This is the moving part of the scale widget. Drawn as a raised box.
+ */
+
+typedef struct
+{
+ Tcl_Obj *orientObj; /* orientation of overall slider */
+ Tcl_Obj *lengthObj; /* slider length */
+ Tcl_Obj *thicknessObj; /* slider thickness */
+ Tcl_Obj *reliefObj; /* the relief for this object */
+ Tcl_Obj *borderObj; /* the background color */
+ Tcl_Obj *borderWidthObj; /* the size of the border */
+} SliderElement;
+
+static Ttk_ElementOptionSpec SliderElementOptions[] =
+{
+ { "-sliderlength", TK_OPTION_PIXELS, Tk_Offset(SliderElement,lengthObj),
+ "30" },
+ { "-sliderthickness",TK_OPTION_PIXELS,Tk_Offset(SliderElement,thicknessObj),
+ "15" },
+ { "-sliderrelief", TK_OPTION_RELIEF, Tk_Offset(SliderElement,reliefObj),
+ "raised" },
+ { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(SliderElement,borderWidthObj),
+ DEFAULT_BORDERWIDTH },
+ { "-background", TK_OPTION_BORDER, Tk_Offset(SliderElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { "-orient", TK_OPTION_ANY, Tk_Offset(SliderElement,orientObj),
+ "horizontal" },
+ { NULL }
+};
+
+static void
+SliderElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SliderElement *slider = elementRecord;
+ int orient, length, thickness;
+
+ Ttk_GetOrientFromObj(NULL, slider->orientObj, &orient);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->lengthObj, &length);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->thicknessObj, &thickness);
+
+ switch (orient) {
+ case TTK_ORIENT_VERTICAL:
+ *widthPtr = thickness;
+ *heightPtr = length;
+ break;
+
+ case TTK_ORIENT_HORIZONTAL:
+ *widthPtr = length;
+ *heightPtr = thickness;
+ break;
+ }
+}
+
+static void
+SliderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ SliderElement *slider = elementRecord;
+ Tk_3DBorder border = NULL;
+ int relief, borderWidth, orient;
+
+ border = Tk_Get3DBorderFromObj(tkwin, slider->borderObj);
+ Ttk_GetOrientFromObj(NULL, slider->orientObj, &orient);
+ Tk_GetPixelsFromObj(NULL, tkwin, slider->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, slider->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+
+ if (relief != TK_RELIEF_FLAT) {
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ if (b.width > 4) {
+ b.x += b.width/2;
+ XDrawLine(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC),
+ b.x-1, b.y+borderWidth, b.x-1, b.y+b.height-borderWidth);
+ XDrawLine(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC),
+ b.x, b.y+borderWidth, b.x, b.y+b.height-borderWidth);
+ }
+ } else {
+ if (b.height > 4) {
+ b.y += b.height/2;
+ XDrawLine(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC),
+ b.x+borderWidth, b.y-1, b.x+b.width-borderWidth, b.y-1);
+ XDrawLine(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC),
+ b.x+borderWidth, b.y, b.x+b.width-borderWidth, b.y);
+ }
+ }
+ }
+}
+
+static Ttk_ElementSpec SliderElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(SliderElement),
+ SliderElementOptions,
+ SliderElementGeometry,
+ SliderElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Progress bar element:
+ * Draws the moving part of the progress bar.
+ *
+ * -thickness specifies the size along the short axis of the bar.
+ * -length specifies the default size along the long axis;
+ * the bar will be this long in indeterminate mode.
+ */
+
+#define DEFAULT_PBAR_THICKNESS "15"
+#define DEFAULT_PBAR_LENGTH "30"
+
+typedef struct
+{
+ Tcl_Obj *orientObj; /* widget orientation */
+ Tcl_Obj *thicknessObj; /* the height/width of the bar */
+ Tcl_Obj *lengthObj; /* default width/height of the bar */
+ Tcl_Obj *reliefObj; /* border relief for this object */
+ Tcl_Obj *borderObj; /* background color */
+ Tcl_Obj *borderWidthObj; /* thickness of the border */
+} PbarElement;
+
+static Ttk_ElementOptionSpec PbarElementOptions[] =
+{
+ { "-orient", TK_OPTION_ANY, Tk_Offset(PbarElement,orientObj),
+ "horizontal" },
+ { "-thickness", TK_OPTION_PIXELS, Tk_Offset(PbarElement,thicknessObj),
+ DEFAULT_PBAR_THICKNESS },
+ { "-barsize", TK_OPTION_PIXELS, Tk_Offset(PbarElement,lengthObj),
+ DEFAULT_PBAR_LENGTH },
+ { "-pbarrelief", TK_OPTION_RELIEF, Tk_Offset(PbarElement,reliefObj),
+ "raised" },
+ { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(PbarElement,borderWidthObj),
+ DEFAULT_BORDERWIDTH },
+ { "-background", TK_OPTION_BORDER, Tk_Offset(PbarElement,borderObj),
+ DEFAULT_BACKGROUND },
+ { NULL }
+};
+
+static void PbarElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ PbarElement *pbar = elementRecord;
+ int orient, thickness, length, borderWidth;
+
+ Ttk_GetOrientFromObj(NULL, pbar->orientObj, &orient);
+ Tk_GetPixelsFromObj(NULL, tkwin, pbar->thicknessObj, &thickness);
+ Tk_GetPixelsFromObj(NULL, tkwin, pbar->lengthObj, &length);
+ Tk_GetPixelsFromObj(NULL, tkwin, pbar->borderWidthObj, &borderWidth);
+
+ switch (orient) {
+ case TTK_ORIENT_HORIZONTAL:
+ *widthPtr = length;
+ *heightPtr = thickness;
+ break;
+ case TTK_ORIENT_VERTICAL:
+ *widthPtr = thickness;
+ *heightPtr = length;
+ break;
+ }
+
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static void PbarElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ PbarElement *pbar = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, pbar->borderObj);
+ int relief, borderWidth;
+
+ Tk_GetPixelsFromObj(NULL, tkwin, pbar->borderWidthObj, &borderWidth);
+ Tk_GetReliefFromObj(NULL, pbar->reliefObj, &relief);
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height,
+ borderWidth, relief);
+}
+
+static Ttk_ElementSpec PbarElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(PbarElement),
+ PbarElementOptions,
+ PbarElementGeometry,
+ PbarElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Notebook tabs and client area.
+ */
+
+typedef struct {
+ Tcl_Obj *borderWidthObj;
+ Tcl_Obj *backgroundObj;
+} TabElement;
+
+static Ttk_ElementOptionSpec TabElementOptions[] = {
+ { "-borderwidth", TK_OPTION_PIXELS,
+ Tk_Offset(TabElement,borderWidthObj),"1" },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(TabElement,backgroundObj), DEFAULT_BACKGROUND },
+ {0,0,0,0}
+};
+
+static void
+TabElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TabElement *tab = elementRecord;
+ int borderWidth = 1;
+ Tk_GetPixelsFromObj(0, tkwin, tab->borderWidthObj, &borderWidth);
+ 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)
+{
+ TabElement *tab = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, tab->backgroundObj);
+ int borderWidth = 1;
+ int cut = 2;
+ XPoint pts[6];
+ int n = 0;
+
+ Tcl_GetIntFromObj(NULL, tab->borderWidthObj, &borderWidth);
+
+ if (state & TTK_STATE_SELECTED) {
+ /*
+ * Draw slightly outside of the allocated parcel,
+ * to overwrite the client area border.
+ */
+ b.height += borderWidth;
+ }
+
+ pts[n].x = b.x; pts[n].y = b.y + b.height - 1; ++n;
+ pts[n].x = b.x; pts[n].y = b.y + cut; ++n;
+ pts[n].x = b.x + cut; pts[n].y = b.y; ++n;
+ pts[n].x = b.x + b.width-1-cut; pts[n].y = b.y; ++n;
+ pts[n].x = b.x + b.width-1; pts[n].y = b.y + cut; ++n;
+ pts[n].x = b.x + b.width-1; pts[n].y = b.y + b.height; ++n;
+
+ XFillPolygon(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_FLAT_GC),
+ pts, 6, Convex, CoordModeOrigin);
+
+#ifndef WIN32
+ /*
+ * Account for whether XDrawLines draws endpoints by platform
+ */
+ --pts[5].y;
+#endif
+
+ while (borderWidth--) {
+ XDrawLines(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC),
+ pts, 4, CoordModeOrigin);
+ XDrawLines(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC),
+ pts+3, 3, CoordModeOrigin);
+ ++pts[0].x; ++pts[1].x; ++pts[2].x; --pts[4].x; --pts[5].x;
+ ++pts[2].y; ++pts[3].y;
+ }
+
+}
+
+static Ttk_ElementSpec TabElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(TabElement),
+ TabElementOptions,
+ TabElementGeometry,
+ TabElementDraw
+};
+
+/*
+ * Client area element:
+ * Uses same resources as tab element.
+ */
+typedef TabElement ClientElement;
+#define ClientElementOptions TabElementOptions
+
+static void
+ClientElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ClientElement *ce = elementRecord;
+ Tk_3DBorder border = Tk_Get3DBorderFromObj(tkwin, ce->backgroundObj);
+ int borderWidth = 1;
+
+ Tcl_GetIntFromObj(NULL, ce->borderWidthObj, &borderWidth);
+
+ Tk_Fill3DRectangle(tkwin, d, border,
+ b.x, b.y, b.width, b.height, borderWidth,TK_RELIEF_RAISED);
+}
+
+static void
+ClientElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ClientElement *ce = elementRecord;
+ int borderWidth = 1;
+ Tk_GetPixelsFromObj(0, tkwin, ce->borderWidthObj, &borderWidth);
+ *paddingPtr = Ttk_UniformPadding((short)borderWidth);
+}
+
+static Ttk_ElementSpec ClientElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(ClientElement),
+ ClientElementOptions,
+ ClientElementGeometry,
+ ClientElementDraw
+};
+
+
+/*------------------------------------------------------------------------
+ * +++ Widget layouts.
+ */
+
+TTK_BEGIN_LAYOUT(FrameLayout)
+ TTK_NODE("Frame.border", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(LabelframeLayout)
+ /* Note: labelframe widget does its own layout */
+ TTK_NODE("Labelframe.border", TTK_FILL_BOTH)
+ TTK_NODE("Labelframe.text", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+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
+
+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
+
+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
+
+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
+
+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
+
+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
+
+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
+
+TTK_BEGIN_LAYOUT(SeparatorLayout)
+ TTK_NODE("Separator.separator", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(SizegripLayout)
+ TTK_NODE("Sizegrip.sizegrip", TTK_PACK_BOTTOM|TTK_STICK_S|TTK_STICK_E)
+TTK_END_LAYOUT
+
+/*----------------------------------------------------------------------
+ * RegisterElements --
+ *
+ * Register all elements and layouts defined in this package.
+ */
+
+extern Ttk_ElementSpec TextElementSpec;
+extern Ttk_ElementSpec ImageElementSpec;
+extern Ttk_ElementSpec ImageTextElementSpec;
+extern Ttk_ElementSpec LabelElementSpec;
+
+void RegisterElements(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ /*
+ * Elements:
+ */
+ Ttk_RegisterElement(interp, theme, "background",
+ &BackgroundElementSpec,NULL);
+
+ Ttk_RegisterElement(interp, theme, "border", &BorderElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "field", &FieldElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "focus", &FocusElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "padding", &PaddingElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "text", &TextElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme,
+ "Labelframe.text",&ImageTextElementSpec,NULL);
+ Ttk_RegisterElement(interp, theme, "image", &ImageElementSpec, interp);
+ Ttk_RegisterElement(interp, theme, "label", &LabelElementSpec, interp);
+ Ttk_RegisterElement(interp, theme, "Checkbutton.indicator",
+ &CheckbuttonIndicatorElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "Radiobutton.indicator",
+ &RadiobuttonIndicatorElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "Menubutton.indicator",
+ &MenuIndicatorElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "indicator", &NullElementSpec,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, "trough", &TroughElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "thumb", &ThumbElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "slider", &SliderElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "pbar", &PbarElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "separator",
+ &SeparatorElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "hseparator",
+ &HorizontalSeparatorElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "vseparator",
+ &VerticalSeparatorElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "sizegrip", &SizegripElementSpec, NULL);
+
+ Ttk_RegisterElement(interp, theme, "tab", &TabElementSpec, NULL);
+ Ttk_RegisterElement(interp, theme, "client", &ClientElementSpec, NULL);
+
+ /*
+ * Layouts:
+ */
+ Ttk_RegisterLayout(theme, "TFrame", FrameLayout);
+ Ttk_RegisterLayout(theme, "TLabelframe", LabelframeLayout);
+ 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);
+ Ttk_RegisterLayout(theme,
+ "Vertical.TScrollbar", VerticalScrollbarLayout);
+ Ttk_RegisterLayout(theme,
+ "Horizontal.TScrollbar", HorizontalScrollbarLayout);
+ Ttk_RegisterLayout(theme, "Vertical.TScale", VerticalScaleLayout);
+ Ttk_RegisterLayout(theme, "Horizontal.TScale", HorizontalScaleLayout);
+ Ttk_RegisterLayout(theme, "TSeparator", SeparatorLayout);
+ Ttk_RegisterLayout(theme, "TSizegrip", SizegripLayout);
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c
new file mode 100644
index 0000000..d6e3616
--- /dev/null
+++ b/generic/ttk/ttkEntry.c
@@ -0,0 +1,1909 @@
+/*
+ * $Id: ttkEntry.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * DERIVED FROM: tk/generic/tkEntry.c r1.35.
+ *
+ * Copyright (c) 1990-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2000 Ajuba Solutions.
+ * Copyright (c) 2002 ActiveState Corporation.
+ * Copyright (c) 2004 Joe English
+ */
+
+#include <string.h>
+#include <tk.h>
+#include <X11/Xatom.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*
+ * Extra bits for core.flags:
+ */
+#define GOT_SELECTION (WIDGET_USER_FLAG<<1)
+#define SYNCING_VARIABLE (WIDGET_USER_FLAG<<2)
+#define VALIDATING (WIDGET_USER_FLAG<<3)
+#define VALIDATION_SET_VALUE (WIDGET_USER_FLAG<<4)
+
+/*
+ * Definitions for -validate option values:
+ */
+typedef enum validateMode {
+ VMODE_ALL, VMODE_KEY, VMODE_FOCUS, VMODE_FOCUSIN, VMODE_FOCUSOUT, VMODE_NONE
+} VMODE;
+
+static const char *validateStrings[] = {
+ "all", "key", "focus", "focusin", "focusout", "none", NULL
+};
+
+/*
+ * Validation reasons:
+ */
+typedef enum validateReason {
+ VALIDATE_INSERT, VALIDATE_DELETE,
+ VALIDATE_FOCUSIN, VALIDATE_FOCUSOUT,
+ VALIDATE_FORCED
+} VREASON;
+
+static const char *validateReasonStrings[] = {
+ "key", "key", "focusin", "focusout", "forced", NULL
+};
+
+/*------------------------------------------------------------------------
+ * +++ Entry widget record.
+ *
+ * Dependencies:
+ *
+ * textVariableTrace : textVariableObj
+ *
+ * numBytes,numChars : string
+ * displayString : numChars, showChar
+ * layoutHeight,
+ * layoutWidth,
+ * textLayout : fontObj, displayString
+ * layoutX, layoutY : textLayout, justify, xscroll.first
+ *
+ * Invariants:
+ *
+ * 0 <= insertPos <= numChars
+ * 0 <= selectFirst < selectLast <= numChars || selectFirst == selectLast == -1
+ * displayString points to string if showChar == NULL,
+ * or to malloc'ed storage if showChar != NULL.
+ */
+
+/* Style parameters:
+ */
+typedef struct
+{
+ Tcl_Obj *foregroundObj; /* Foreground color for normal text */
+ Tcl_Obj *backgroundObj; /* Entry widget background color */
+ Tcl_Obj *selBorderObj; /* Border and background for selection */
+ Tcl_Obj *selBorderWidthObj; /* Width of selection border */
+ Tcl_Obj *selForegroundObj; /* Foreground color for selected text */
+ Tcl_Obj *insertColorObj; /* Color of insertion cursor */
+ Tcl_Obj *insertWidthObj; /* Insert cursor width */
+} EntryStyleData;
+
+typedef struct
+{
+ /*
+ * Internal state:
+ */
+ char *string; /* Storage for string (malloced) */
+ int numBytes; /* Length of string in bytes. */
+ int numChars; /* Length of string in characters. */
+
+ int insertPos; /* Insert index */
+ int selectFirst; /* Index of start of selection, or -1 */
+ int selectLast; /* Index of end of selection, or -1 */
+
+ Scrollable xscroll; /* Current scroll position */
+ ScrollHandle xscrollHandle;
+
+ /*
+ * Options managed by Tk_SetOptions:
+ */
+ Tcl_Obj *textVariableObj; /* Name of linked variable */
+ int exportSelection; /* Tie internal selection to X selection? */
+
+ VMODE validate; /* Validation mode */
+ char *validateCmd; /* Validation script template */
+ char *invalidCmd; /* Invalid callback script template */
+
+ char *showChar; /* Used to derive displayString */
+
+ Tcl_Obj *fontObj; /* Text font to use */
+ Tcl_Obj *widthObj; /* Desired width of window (in avgchars) */
+ Tk_Justify justify; /* Text justification */
+
+ EntryStyleData styleData; /* Display style data (widget options) */
+ EntryStyleData styleDefaults;/* Style defaults (fallback values) */
+
+ Tcl_Obj *stateObj; /* Compatibility option -- see CheckStateObj */
+
+ /*
+ * Derived resources:
+ */
+ Ttk_TraceHandle *textVariableTrace;
+
+ char *displayString; /* String to use when displaying */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ int layoutWidth; /* textLayout width */
+ int layoutHeight; /* textLayout height */
+
+ int layoutX, layoutY; /* Origin for text layout. */
+
+} EntryPart;
+
+typedef struct
+{
+ WidgetCore core;
+ EntryPart entry;
+} Entry;
+
+/*
+ * Extra mask bits for Tk_SetOptions()
+ */
+#define STATE_CHANGED (0x100) /* -state option changed */
+#define TEXTVAR_CHANGED (0x200) /* -textvariable option changed */
+#define SCROLLCMD_CHANGED (0x400) /* -xscrollcommand option changed */
+
+/*
+ * Default option values:
+ */
+#define DEF_SELECT_BG "#000000"
+#define DEF_SELECT_FG "#ffffff"
+#define DEF_INSERT_BG "black"
+#define DEF_ENTRY_WIDTH "20"
+#define DEF_ENTRY_FONT "TkTextFont"
+
+static Tk_OptionSpec EntryOptionSpecs[] =
+{
+ WIDGET_TAKES_FOCUS,
+
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", "1", -1, Tk_Offset(Entry, entry.exportSelection),
+ 0,0,0 },
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, Tk_Offset(Entry, entry.fontObj),-1,
+ 0,0,GEOMETRY_CHANGED},
+ {TK_OPTION_STRING, "-invalidcommand", "invalidCommand", "InvalidCommand",
+ NULL, -1, Tk_Offset(Entry, entry.invalidCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ "left", -1, Tk_Offset(Entry, entry.justify),
+ 0, 0, GEOMETRY_CHANGED},
+ {TK_OPTION_STRING, "-show", "show", "Show",
+ NULL, -1, Tk_Offset(Entry, entry.showChar),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-state", "state", "State",
+ "normal", Tk_Offset(Entry, entry.stateObj), -1,
+ 0,0,STATE_CHANGED},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ NULL, Tk_Offset(Entry, entry.textVariableObj), -1,
+ TK_OPTION_NULL_OK,0,TEXTVAR_CHANGED},
+ {TK_OPTION_STRING_TABLE, "-validate", "validate", "Validate",
+ "none", -1, Tk_Offset(Entry, entry.validate),
+ 0, (ClientData) validateStrings, 0},
+ {TK_OPTION_STRING, "-validatecommand", "validateCommand", "ValidateCommand",
+ NULL, -1, Tk_Offset(Entry, entry.validateCmd),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_ENTRY_WIDTH, Tk_Offset(Entry, entry.widthObj), -1,
+ 0,0,GEOMETRY_CHANGED},
+ {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ NULL, -1, Tk_Offset(Entry, entry.xscroll.scrollCmd),
+ TK_OPTION_NULL_OK, 0, SCROLLCMD_CHANGED},
+
+ /* EntryStyleData options:
+ */
+ {TK_OPTION_COLOR, "-foreground", "textColor", "TextColor",
+ NULL, Tk_Offset(Entry, entry.styleData.foregroundObj), -1,
+ TK_OPTION_NULL_OK,0,0},
+ {TK_OPTION_COLOR, "-background", "windowColor", "WindowColor",
+ NULL, Tk_Offset(Entry, entry.styleData.backgroundObj), -1,
+ TK_OPTION_NULL_OK,0,0},
+
+ WIDGET_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ EntryStyleData management.
+ * This is still more awkward than it should be;
+ * it should be able to use the Element API instead.
+ */
+
+/* EntryInitStyleDefaults --
+ * Initialize EntryStyleData record to fallback values.
+ */
+static void EntryInitStyleDefaults(EntryStyleData *es)
+{
+#define INIT(member, value) \
+ es->member = Tcl_NewStringObj(value, -1); \
+ Tcl_IncrRefCount(es->member);
+ INIT(foregroundObj, DEFAULT_FOREGROUND)
+ INIT(selBorderObj, DEF_SELECT_BG)
+ INIT(selForegroundObj, DEF_SELECT_FG)
+ INIT(insertColorObj, DEFAULT_FOREGROUND)
+ INIT(selBorderWidthObj, "0")
+ INIT(insertWidthObj, "1")
+#undef INIT
+}
+
+static void EntryFreeStyleDefaults(EntryStyleData *es)
+{
+ Tcl_DecrRefCount(es->foregroundObj);
+ Tcl_DecrRefCount(es->selBorderObj);
+ Tcl_DecrRefCount(es->selForegroundObj);
+ Tcl_DecrRefCount(es->insertColorObj);
+ Tcl_DecrRefCount(es->selBorderWidthObj);
+ Tcl_DecrRefCount(es->insertWidthObj);
+}
+
+/*
+ * EntryInitStyleData --
+ * Look up style-specific data for an entry widget.
+ */
+static void EntryInitStyleData(Entry *entryPtr, EntryStyleData *es)
+{
+ Ttk_State state = entryPtr->core.state;
+ Ttk_ResourceCache cache = Ttk_GetResourceCache(entryPtr->core.interp);
+ Tk_Window tkwin = entryPtr->core.tkwin;
+ Tcl_Obj *tmp;
+
+ /* Initialize to fallback values:
+ */
+ *es = entryPtr->entry.styleDefaults;
+
+# define INIT(member, name) \
+ if ((tmp=Ttk_QueryOption(entryPtr->core.layout,name,state))) \
+ es->member=tmp;
+ INIT(foregroundObj, "-foreground");
+ INIT(selBorderObj, "-selectbackground")
+ INIT(selBorderWidthObj, "-selectborderwidth")
+ INIT(selForegroundObj, "-selectforeground")
+ INIT(insertColorObj, "-insertcolor")
+ INIT(insertWidthObj, "-insertwidth")
+#undef INIT
+
+ /* Reacquire color & border resources from resource cache.
+ */
+ es->foregroundObj = Ttk_UseColor(cache, tkwin, es->foregroundObj);
+ es->selForegroundObj = Ttk_UseColor(cache, tkwin, es->selForegroundObj);
+ es->insertColorObj = Ttk_UseColor(cache, tkwin, es->insertColorObj);
+ es->selBorderObj = Ttk_UseBorder(cache, tkwin, es->selBorderObj);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Resource management.
+ */
+
+/* EntryDisplayString --
+ * Return a malloc'ed string consisting of 'numChars' copies
+ * of (the first character in the string) 'showChar'.
+ * Used to compute the displayString if -show is non-NULL.
+ */
+static char *EntryDisplayString(const char *showChar, int numChars)
+{
+ char *displayString, *p;
+ int size;
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX];
+
+ Tcl_UtfToUniChar(showChar, &ch);
+ size = Tcl_UniCharToUtf(ch, buf);
+ p = displayString = ckalloc(numChars * size + 1);
+
+ while (numChars--) {
+ p += Tcl_UniCharToUtf(ch, p);
+ }
+ *p = '\0';
+
+ return displayString;
+}
+
+/* EntryUpdateTextLayout --
+ * Recompute textLayout, layoutWidth, and layoutHeight
+ * from displayString and fontObj.
+ */
+static void EntryUpdateTextLayout(Entry *entryPtr)
+{
+ Tk_FreeTextLayout(entryPtr->entry.textLayout);
+ entryPtr->entry.textLayout = Tk_ComputeTextLayout(
+ Tk_GetFontFromObj(entryPtr->core.tkwin, entryPtr->entry.fontObj),
+ entryPtr->entry.displayString, entryPtr->entry.numChars,
+ 0/*wraplength*/, entryPtr->entry.justify, TK_IGNORE_NEWLINES,
+ &entryPtr->entry.layoutWidth, &entryPtr->entry.layoutHeight);
+}
+
+/* EntryEditable --
+ * Returns 1 if the entry widget accepts user changes, 0 otherwise
+ */
+static int
+EntryEditable(Entry *entryPtr)
+{
+ return !(entryPtr->core.state & (TTK_STATE_DISABLED|TTK_STATE_READONLY));
+}
+
+/*------------------------------------------------------------------------
+ * +++ Selection management.
+ */
+
+/* EntryFetchSelection --
+ * Selection handler for entry widgets.
+ */
+static int
+EntryFetchSelection(
+ ClientData clientData, int offset, char *buffer, int maxBytes)
+{
+ Entry *entryPtr = (Entry *) clientData;
+ size_t byteCount;
+ const char *string;
+ const char *selStart, *selEnd;
+
+ if (entryPtr->entry.selectFirst < 0 || !entryPtr->entry.exportSelection) {
+ return -1;
+ }
+ string = entryPtr->entry.displayString;
+
+ selStart = Tcl_UtfAtIndex(string, entryPtr->entry.selectFirst);
+ selEnd = Tcl_UtfAtIndex(selStart,
+ entryPtr->entry.selectLast - entryPtr->entry.selectFirst);
+ byteCount = selEnd - selStart - offset;
+ if (byteCount > (size_t)maxBytes) {
+ /* @@@POSSIBLE BUG: Can transfer partial UTF-8 sequences. Is this OK? */
+ byteCount = maxBytes;
+ }
+ if (byteCount <= 0) {
+ return 0;
+ }
+ memcpy(buffer, selStart + offset, byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
+}
+
+/* EntryLostSelection --
+ * Tk_LostSelProc for Entry widgets; called when an entry
+ * loses ownership of the selection.
+ */
+static void EntryLostSelection(ClientData clientData)
+{
+ Entry *entryPtr = (Entry *) clientData;
+ entryPtr->core.flags &= ~GOT_SELECTION;
+ entryPtr->entry.selectFirst = entryPtr->entry.selectLast = -1;
+ TtkRedisplayWidget(&entryPtr->core);
+}
+
+/* EntryOwnSelection --
+ * Assert ownership of the PRIMARY selection,
+ * if -exportselection set and selection is present.
+ */
+static void EntryOwnSelection(Entry *entryPtr)
+{
+ if (entryPtr->entry.exportSelection
+ && !(entryPtr->core.flags & GOT_SELECTION)) {
+ Tk_OwnSelection(entryPtr->core.tkwin, XA_PRIMARY, EntryLostSelection,
+ (ClientData) entryPtr);
+ entryPtr->core.flags |= GOT_SELECTION;
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Validation.
+ */
+
+/* ExpandPercents --
+ * Expand an entry validation script template (-validatecommand
+ * or -invalidcommand).
+ */
+static void
+ExpandPercents(
+ Entry *entryPtr, /* Entry that needs validation. */
+ const char *template, /* Script template */
+ const char *new, /* Potential new value of entry string */
+ int index, /* index of insert/delete */
+ int count, /* #changed characters */
+ VREASON reason, /* Reason for change */
+ Tcl_DString *dsPtr) /* Result of %-substitutions */
+{
+ int spaceNeeded, cvtFlags;
+ int number, length;
+ const char *string;
+ int stringLength;
+ Tcl_UniChar ch;
+ char numStorage[2*TCL_INTEGER_SPACE];
+
+ while (*template) {
+ /* Find everything up to the next % character and append it
+ * to the result string.
+ */
+ string = Tcl_UtfFindFirst(template, '%');
+ if (string == NULL) {
+ /* No more %-sequences to expand.
+ * Copy the rest of the template.
+ */
+ Tcl_DStringAppend(dsPtr, template, -1);
+ return;
+ }
+ if (string != template) {
+ Tcl_DStringAppend(dsPtr, template, string - template);
+ template = string;
+ }
+
+ /* There's a percent sequence here. Process it.
+ */
+ ++template; /* skip over % */
+ if (*template != '\0') {
+ template += Tcl_UtfToUniChar(template, &ch);
+ } else {
+ ch = '%';
+ }
+
+ stringLength = -1;
+ switch (ch) {
+ case 'd': /* Type of call that caused validation */
+ if (reason == VALIDATE_INSERT) {
+ number = 1;
+ } else if (reason == VALIDATE_DELETE) {
+ number = 0;
+ } else {
+ number = -1;
+ }
+ sprintf(numStorage, "%d", number);
+ string = numStorage;
+ break;
+ case 'i': /* index of insert/delete */
+ sprintf(numStorage, "%d", index);
+ string = numStorage;
+ break;
+ case 'P': /* 'Peeked' new value of the string */
+ string = new;
+ break;
+ case 's': /* Current string value */
+ string = entryPtr->entry.string;
+ break;
+ case 'S': /* string to be inserted/deleted, if any */
+ if (reason == VALIDATE_INSERT) {
+ string = Tcl_UtfAtIndex(new, index);
+ stringLength = Tcl_UtfAtIndex(string, count) - string;
+ } else if (reason == VALIDATE_DELETE) {
+ string = Tcl_UtfAtIndex(entryPtr->entry.string, index);
+ stringLength = Tcl_UtfAtIndex(string, count) - string;
+ } else {
+ string = "";
+ stringLength = 0;
+ }
+ break;
+ case 'v': /* type of validation currently set */
+ string = validateStrings[entryPtr->entry.validate];
+ break;
+ case 'V': /* type of validation in effect */
+ string = validateReasonStrings[reason];
+ break;
+ case 'W': /* widget name */
+ string = Tk_PathName(entryPtr->core.tkwin);
+ break;
+ default:
+ length = Tcl_UniCharToUtf(ch, numStorage);
+ numStorage[length] = '\0';
+ string = numStorage;
+ break;
+ }
+
+ spaceNeeded = Tcl_ScanCountedElement(string, stringLength, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ spaceNeeded = Tcl_ConvertCountedElement(string, stringLength,
+ Tcl_DStringValue(dsPtr) + length,
+ cvtFlags | TCL_DONT_USE_BRACES);
+ Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
+ }
+}
+
+/* RunValidationScript --
+ * Build and evaluate an entry validation script.
+ * If the script raises an error, disable validation
+ * by setting '-validate none'
+ */
+static int RunValidationScript(
+ Tcl_Interp *interp, /* Interpreter to use */
+ Entry *entryPtr, /* Entry being validated */
+ const char *template, /* Script template */
+ const char *optionName, /* "-validatecommand", "-invalidcommand" */
+ const char *new, /* Potential new value of entry string */
+ int index, /* index of insert/delete */
+ int count, /* #changed characters */
+ VREASON reason) /* Reason for change */
+{
+ Tcl_DString script;
+ int code;
+
+ Tcl_DStringInit(&script);
+ ExpandPercents(entryPtr, template, new, index, count, reason, &script);
+ code = Tcl_EvalEx(interp,
+ Tcl_DStringValue(&script), Tcl_DStringLength(&script),
+ TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+ Tcl_DStringFree(&script);
+ if (WidgetDestroyed(&entryPtr->core))
+ return TCL_ERROR;
+
+ if (code != TCL_OK && code != TCL_RETURN) {
+ Tcl_AddErrorInfo(interp, "\n\t(in ");
+ Tcl_AddErrorInfo(interp, optionName);
+ Tcl_AddErrorInfo(interp, " validation command executed by ");
+ Tcl_AddErrorInfo(interp, Tk_PathName(entryPtr->core.tkwin));
+ Tcl_AddErrorInfo(interp, ")");
+ entryPtr->entry.validate = VMODE_NONE;
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/* EntryNeedsValidation --
+ * Determine whether the specified VREASON should trigger validation
+ * in the current VMODE.
+ */
+static int EntryNeedsValidation(VMODE vmode, VREASON reason)
+{
+ return (reason == VALIDATE_FORCED)
+ || (vmode == VMODE_ALL)
+ || (reason == VALIDATE_FOCUSIN
+ && (vmode == VMODE_FOCUSIN || vmode == VMODE_FOCUS))
+ || (reason == VALIDATE_FOCUSOUT
+ && (vmode == VMODE_FOCUSOUT || vmode == VMODE_FOCUS))
+ || (reason == VALIDATE_INSERT && vmode == VMODE_KEY)
+ || (reason == VALIDATE_DELETE && vmode == VMODE_KEY)
+ ;
+}
+
+/* EntryValidateChange --
+ * Validate a proposed change to the entry widget's value if required.
+ * Call the -invalidcommand if validation fails.
+ *
+ * Returns:
+ * TCL_OK if the change is accepted
+ * TCL_BREAK if the change is rejected
+ * TCL_ERROR if any errors occured
+ *
+ * The change will be rejected if -validatecommand returns 0,
+ * or if -validatecommand or -invalidcommand modifies the value.
+ */
+static int
+EntryValidateChange(
+ Entry *entryPtr, /* Entry that needs validation. */
+ const char *newValue, /* Potential new value of entry string */
+ int index, /* index of insert/delete, -1 otherwise */
+ int count, /* #changed characters */
+ VREASON reason) /* Reason for change */
+{
+ Tcl_Interp *interp = entryPtr->core.interp;
+ VMODE vmode = entryPtr->entry.validate;
+ int code, change_ok;
+
+ if ( (entryPtr->entry.validateCmd == NULL)
+ || (entryPtr->core.flags & VALIDATING)
+ || !EntryNeedsValidation(vmode, reason) )
+ {
+ return TCL_OK;
+ }
+
+ entryPtr->core.flags |= VALIDATING;
+
+ /* Run -validatecommand and check return value:
+ */
+ code = RunValidationScript(interp, entryPtr,
+ entryPtr->entry.validateCmd, "-validatecommand",
+ newValue, index, count, reason);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ code = Tcl_GetBooleanFromObj(interp,Tcl_GetObjResult(interp), &change_ok);
+ if (code != TCL_OK) {
+ entryPtr->entry.validate = VMODE_NONE; /* Disable validation */
+ Tcl_AddErrorInfo(interp,
+ "\n(validation command did not return valid boolean)");
+ goto done;
+ }
+
+ /* Run the -invalidcommand if validation failed:
+ */
+ if (!change_ok && entryPtr->entry.invalidCmd != NULL) {
+ code = RunValidationScript(interp, entryPtr,
+ entryPtr->entry.invalidCmd, "-invalidcommand",
+ newValue, index, count, reason);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ }
+
+ /* Reject the pending change if validation failed
+ * or if a validation script changed the value.
+ */
+ if (!change_ok || (entryPtr->core.flags & VALIDATION_SET_VALUE)) {
+ code = TCL_BREAK;
+ }
+
+done:
+ entryPtr->core.flags &= ~(VALIDATING|VALIDATION_SET_VALUE);
+ return code;
+}
+
+/* EntryRevalidate --
+ * Revalidate the current value of an entry widget,
+ * update the TTK_STATE_INVALID bit.
+ *
+ * Returns:
+ * TCL_OK if valid, TCL_BREAK if invalid, TCL_ERROR on error.
+ */
+static int EntryRevalidate(Tcl_Interp *interp, Entry *entryPtr, VREASON reason)
+{
+ int code = EntryValidateChange(
+ entryPtr, entryPtr->entry.string, -1,0, reason);
+
+ if (code == TCL_BREAK) {
+ WidgetChangeState(&entryPtr->core, TTK_STATE_INVALID, 0);
+ } else if (code == TCL_OK) {
+ WidgetChangeState(&entryPtr->core, 0, TTK_STATE_INVALID);
+ }
+
+ return code;
+}
+
+/* EntryRevalidateBG --
+ * Revalidate in the background (called from event handler).
+ */
+static void EntryRevalidateBG(Entry *entryPtr, VREASON reason)
+{
+ Tcl_Interp *interp = entryPtr->core.interp;
+ if (EntryRevalidate(interp, entryPtr, reason) == TCL_ERROR) {
+ Tcl_BackgroundError(interp);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Entry widget modification.
+ */
+
+/* AdjustIndex --
+ * Adjust index to account for insertion (nChars > 0)
+ * or deletion (nChars < 0) at specified index.
+ */
+static int AdjustIndex(int i0, int index, int nChars)
+{
+ if (i0 >= index) {
+ i0 += nChars;
+ if (i0 < index) { /* index was inside deleted range */
+ i0 = index;
+ }
+ }
+ return i0;
+}
+
+/* AdjustIndices --
+ * Adjust all internal entry indexes to account for change.
+ * Note that insertPos, and selectFirst have "right gravity",
+ * while leftIndex (=xscroll.first) and selectLast have "left gravity".
+ */
+static void AdjustIndices(Entry *entryPtr, int index, int nChars)
+{
+ EntryPart *e = &entryPtr->entry;
+ int g = nChars > 0; /* left gravity adjustment */
+
+ e->insertPos = AdjustIndex(e->insertPos, index, nChars);
+ e->selectFirst = AdjustIndex(e->selectFirst, index, nChars);
+ e->selectLast = AdjustIndex(e->selectLast, index+g, nChars);
+ e->xscroll.first= AdjustIndex(e->xscroll.first, index+g, nChars);
+
+ if (e->selectLast <= e->selectFirst)
+ e->selectFirst = e->selectLast = -1;
+}
+
+/* EntryStoreValue --
+ * Replace the contents of a text entry with a given value,
+ * recompute dependent resources, and schedule a redisplay.
+ *
+ * See also: EntrySetValue().
+ */
+static void
+EntryStoreValue(Entry *entryPtr, const char *value)
+{
+ size_t numBytes = strlen(value);
+ int numChars = Tcl_NumUtfChars(value, numBytes);
+
+ if (entryPtr->core.flags & VALIDATING)
+ entryPtr->core.flags |= VALIDATION_SET_VALUE;
+
+ /* Make sure all indices remain in bounds:
+ */
+ if (numChars < entryPtr->entry.numChars)
+ AdjustIndices(entryPtr, numChars, numChars - entryPtr->entry.numChars);
+
+ /* Free old value:
+ */
+ if (entryPtr->entry.displayString != entryPtr->entry.string)
+ ckfree(entryPtr->entry.displayString);
+ ckfree(entryPtr->entry.string);
+
+ /* Store new value:
+ */
+ entryPtr->entry.string = ckalloc(numBytes + 1);
+ strcpy(entryPtr->entry.string, value);
+ entryPtr->entry.numBytes = numBytes;
+ entryPtr->entry.numChars = numChars;
+
+ entryPtr->entry.displayString
+ = entryPtr->entry.showChar
+ ? EntryDisplayString(entryPtr->entry.showChar, numChars)
+ : entryPtr->entry.string
+ ;
+
+ /* Update layout, schedule redisplay:
+ */
+ EntryUpdateTextLayout(entryPtr);
+ TtkRedisplayWidget(&entryPtr->core);
+}
+
+/* EntrySetValue --
+ * Stores a new value in the entry widget and updates the
+ * linked -textvariable, if any. The write trace on the
+ * text variable is temporarily disabled; however, other
+ * write traces may change the value of the variable.
+ * If so, the new value is used instead (bypassing validation).
+ *
+ * Returns:
+ * TCL_OK if successful, TCL_ERROR otherwise.
+ */
+static int EntrySetValue(Entry *entryPtr, const char *value)
+{
+ if (entryPtr->entry.textVariableObj) {
+ const char *textVarName =
+ Tcl_GetString(entryPtr->entry.textVariableObj);
+ if (textVarName && *textVarName) {
+ entryPtr->core.flags |= SYNCING_VARIABLE;
+ value = Tcl_SetVar(entryPtr->core.interp, textVarName,
+ value, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ entryPtr->core.flags &= ~SYNCING_VARIABLE;
+ if (!value || WidgetDestroyed(&entryPtr->core))
+ return TCL_ERROR;
+ }
+ }
+
+ EntryStoreValue(entryPtr, value);
+ return TCL_OK;
+}
+
+/* EntryTextVariableTrace --
+ * Variable trace procedure for entry -textvariable
+ */
+static void EntryTextVariableTrace(void *recordPtr, const char *value)
+{
+ Entry *entryPtr = recordPtr;
+
+ if (WidgetDestroyed(&entryPtr->core)) {
+ return;
+ }
+
+ if (entryPtr->core.flags & SYNCING_VARIABLE) {
+ /* Trace was fired due to Tcl_SetVar call in EntrySetValue.
+ * Don't do anything.
+ */
+ return;
+ }
+
+ EntryStoreValue(entryPtr, value ? value : "");
+}
+
+/*------------------------------------------------------------------------
+ * +++ Insertion and deletion.
+ */
+
+/* InsertChars --
+ * Add new characters to an entry widget.
+ */
+static int
+InsertChars(
+ Entry *entryPtr, /* Entry that is to get the new elements. */
+ int index, /* Insert before this index */
+ const char *value) /* New characters to add */
+{
+ char *string = entryPtr->entry.string;
+ size_t byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ size_t byteCount = strlen(value);
+ int charsAdded = Tcl_NumUtfChars(value, byteCount);
+ size_t newByteCount = entryPtr->entry.numBytes + byteCount + 1;
+ char *new;
+ int code;
+
+ if (byteCount == 0) {
+ return TCL_OK;
+ }
+
+ new = ckalloc(newByteCount);
+ memcpy(new, string, byteIndex);
+ strcpy(new + byteIndex, value);
+ strcpy(new + byteIndex + byteCount, string + byteIndex);
+
+ code = EntryValidateChange(
+ entryPtr, new, index, charsAdded, VALIDATE_INSERT);
+
+ if (code == TCL_OK) {
+ AdjustIndices(entryPtr, index, charsAdded);
+ code = EntrySetValue(entryPtr, new);
+ } else if (code == TCL_BREAK) {
+ code = TCL_OK;
+ }
+
+ ckfree(new);
+ return code;
+}
+
+/* DeleteChars --
+ * Remove one or more characters from an entry widget.
+ */
+static int
+DeleteChars(
+ Entry *entryPtr, /* Entry widget to modify. */
+ int index, /* Index of first character to delete. */
+ int count) /* How many characters to delete. */
+{
+ char *string = entryPtr->entry.string;
+ size_t byteIndex, byteCount, newByteCount;
+ char *new;
+ int code;
+
+ if (index < 0) {
+ index = 0;
+ }
+ if (count > entryPtr->entry.numChars - index) {
+ count = entryPtr->entry.numChars - index;
+ }
+ if (count <= 0) {
+ return TCL_OK;
+ }
+
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = Tcl_UtfAtIndex(string+byteIndex, count) - (string+byteIndex);
+
+ newByteCount = entryPtr->entry.numBytes + 1 - byteCount;
+ new = ckalloc(newByteCount);
+ memcpy(new, string, byteIndex);
+ strcpy(new + byteIndex, string + byteIndex + byteCount);
+
+ code = EntryValidateChange(
+ entryPtr, new, index, count, VALIDATE_DELETE);
+
+ if (code == TCL_OK) {
+ AdjustIndices(entryPtr, index, -count);
+ code = EntrySetValue(entryPtr, new);
+ } else if (code == TCL_BREAK) {
+ code = TCL_OK;
+ }
+ ckfree(new);
+
+ return code;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Event handler.
+ */
+
+/* EntryEventProc --
+ * Extra event handling for entry widgets:
+ * Triggers validation on FocusIn and FocusOut events.
+ */
+#define EntryEventMask (FocusChangeMask)
+static void
+EntryEventProc(ClientData clientData, XEvent *eventPtr)
+{
+ Entry *entryPtr = (Entry *) clientData;
+
+ Tcl_Preserve(clientData);
+ switch (eventPtr->type) {
+ case DestroyNotify:
+ Tk_DeleteEventHandler(entryPtr->core.tkwin,
+ EntryEventMask, EntryEventProc, clientData);
+ break;
+ case FocusIn:
+ EntryRevalidateBG(entryPtr, VALIDATE_FOCUSIN);
+ break;
+ case FocusOut:
+ EntryRevalidateBG(entryPtr, VALIDATE_FOCUSOUT);
+ break;
+ }
+ Tcl_Release(clientData);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization and cleanup.
+ */
+
+static int
+EntryInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+
+ Tk_CreateEventHandler(
+ entryPtr->core.tkwin, EntryEventMask, EntryEventProc, entryPtr);
+ Tk_CreateSelHandler(entryPtr->core.tkwin, XA_PRIMARY, XA_STRING,
+ EntryFetchSelection, (ClientData) entryPtr, XA_STRING);
+ BlinkCursor(&entryPtr->core);
+
+ entryPtr->entry.string = ckalloc(1);
+ *entryPtr->entry.string = '\0';
+ entryPtr->entry.displayString = entryPtr->entry.string;
+ entryPtr->entry.textVariableTrace = 0;
+ entryPtr->entry.numBytes = entryPtr->entry.numChars = 0;
+
+ EntryInitStyleDefaults(&entryPtr->entry.styleDefaults);
+
+ entryPtr->entry.xscrollHandle =
+ CreateScrollHandle(&entryPtr->core, &entryPtr->entry.xscroll);
+
+ entryPtr->entry.insertPos = 0;
+ entryPtr->entry.selectFirst = -1;
+ entryPtr->entry.selectLast = -1;
+
+ return TCL_OK;
+}
+
+static void
+EntryCleanup(void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+
+ if (entryPtr->entry.textVariableTrace)
+ Ttk_UntraceVariable(entryPtr->entry.textVariableTrace);
+
+ FreeScrollHandle(entryPtr->entry.xscrollHandle);
+
+ EntryFreeStyleDefaults(&entryPtr->entry.styleDefaults);
+
+ Tk_DeleteSelHandler(entryPtr->core.tkwin, XA_PRIMARY, XA_STRING);
+
+ Tk_FreeTextLayout(entryPtr->entry.textLayout);
+ if (entryPtr->entry.displayString != entryPtr->entry.string)
+ ckfree(entryPtr->entry.displayString);
+ ckfree(entryPtr->entry.string);
+}
+
+/* EntryConfigure --
+ * Configure hook for Entry widgets.
+ */
+static int EntryConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Entry *entryPtr = recordPtr;
+ Tcl_Obj *textVarName = entryPtr->entry.textVariableObj;
+ Ttk_TraceHandle *vt = 0;
+
+ if (mask & TEXTVAR_CHANGED) {
+ if (textVarName && *Tcl_GetString(textVarName)) {
+ vt = Ttk_TraceVariable(interp,
+ textVarName,EntryTextVariableTrace,entryPtr);
+ if (!vt) return TCL_ERROR;
+ }
+ }
+
+ if (CoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+ if (vt) Ttk_UntraceVariable(vt);
+ return TCL_ERROR;
+ }
+
+ /* Update derived resources:
+ */
+ if (mask & TEXTVAR_CHANGED) {
+ if (entryPtr->entry.textVariableTrace)
+ Ttk_UntraceVariable(entryPtr->entry.textVariableTrace);
+ entryPtr->entry.textVariableTrace = vt;
+ }
+
+ /* Claim the selection, in case we've suddenly started exporting it.
+ */
+ if (entryPtr->entry.exportSelection && entryPtr->entry.selectFirst != -1) {
+ EntryOwnSelection(entryPtr);
+ }
+
+ /* Handle -state compatibility option:
+ */
+ if (mask & STATE_CHANGED) {
+ CheckStateOption(&entryPtr->core, entryPtr->entry.stateObj);
+ }
+
+ /* Force scrollbar update if needed:
+ */
+ if (mask & SCROLLCMD_CHANGED) {
+ ScrollbarUpdateRequired(entryPtr->entry.xscrollHandle);
+ }
+
+ /* Recompute the displayString, in case showChar changed:
+ */
+ if (entryPtr->entry.displayString != entryPtr->entry.string)
+ ckfree(entryPtr->entry.displayString);
+
+ entryPtr->entry.displayString
+ = entryPtr->entry.showChar
+ ? EntryDisplayString(entryPtr->entry.showChar, entryPtr->entry.numChars)
+ : entryPtr->entry.string
+ ;
+
+ /* Update textLayout:
+ */
+ EntryUpdateTextLayout(entryPtr);
+ return TCL_OK;
+}
+
+/* EntryPostConfigure --
+ * Post-configuration hook for entry widgets.
+ */
+static int EntryPostConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Entry *entryPtr = recordPtr;
+ int status = TCL_OK;
+
+ if ((mask & TEXTVAR_CHANGED) && entryPtr->entry.textVariableTrace != NULL) {
+ status = Ttk_FireTrace(entryPtr->entry.textVariableTrace);
+ }
+
+ return status;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout and display.
+ */
+
+/* EntryTextArea --
+ * Return bounding box of entry display ("owner-draw") area.
+ */
+static Ttk_Box
+EntryTextArea(Entry *entryPtr)
+{
+ WidgetCore *corePtr = &entryPtr->core;
+ Ttk_LayoutNode *node = Ttk_LayoutFindNode(corePtr->layout, "textarea");
+ return node ? Ttk_LayoutNodeParcel(node) : Ttk_WinBox(corePtr->tkwin);
+}
+
+/* EntryCharPosition --
+ * Return the X coordinate of the specified character index.
+ * Precondition: textLayout and layoutX up-to-date.
+ */
+static int
+EntryCharPosition(Entry *entryPtr, int index)
+{
+ int xPos;
+ Tk_CharBbox(entryPtr->entry.textLayout, index, &xPos, NULL, NULL, NULL);
+ return xPos + entryPtr->entry.layoutX;
+}
+
+/* EntryDoLayout --
+ * Layout hook for entry widgets.
+ *
+ * Determine position of textLayout based on xscroll.first, justify,
+ * and display area.
+ *
+ * Recalculates layoutX, layoutY, and rightIndex,
+ * and updates xscroll accordingly.
+ * May adjust xscroll.first to ensure the maximum #characters are onscreen.
+ */
+static void
+EntryDoLayout(void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ WidgetCore *corePtr = &entryPtr->core;
+ Tk_TextLayout textLayout = entryPtr->entry.textLayout;
+ int leftIndex = entryPtr->entry.xscroll.first;
+ int rightIndex;
+ Ttk_Box textarea;
+
+ Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+ textarea = EntryTextArea(entryPtr);
+
+ /* Center the text vertically within the available parcel:
+ */
+ entryPtr->entry.layoutY = textarea.y +
+ (textarea.height - entryPtr->entry.layoutHeight)/2;
+
+ /* Recompute where the leftmost character on the display will
+ * be drawn (layoutX) and adjust leftIndex if necessary.
+ */
+ if (entryPtr->entry.layoutWidth <= textarea.width) {
+ /* Everything fits. Set leftIndex to zero (no need to scroll),
+ * and compute layoutX based on -justify.
+ */
+ int extraSpace = textarea.width - entryPtr->entry.layoutWidth;
+ leftIndex = 0;
+ rightIndex = entryPtr->entry.numChars;
+ entryPtr->entry.layoutX = textarea.x;
+ if (entryPtr->entry.justify == TK_JUSTIFY_RIGHT) {
+ entryPtr->entry.layoutX += extraSpace;
+ } else if (entryPtr->entry.justify == TK_JUSTIFY_CENTER) {
+ entryPtr->entry.layoutX += extraSpace / 2;
+ }
+ } else {
+ /* The whole string doesn't fit in the window.
+ * Limit leftIndex to leave at most one character's worth
+ * of empty space on the right.
+ */
+ int overflow = entryPtr->entry.layoutWidth - textarea.width;
+ int maxLeftIndex = 1 + Tk_PointToChar(textLayout, overflow, 0);
+ int leftX;
+
+ if (leftIndex > maxLeftIndex) {
+ leftIndex = maxLeftIndex;
+ }
+
+ /* Compute layoutX and rightIndex.
+ * rightIndex is set to one past the last fully-visible character.
+ */
+ Tk_CharBbox(textLayout, leftIndex, &leftX, NULL, NULL, NULL);
+ rightIndex = Tk_PointToChar(textLayout, leftX + textarea.width, 0);
+ entryPtr->entry.layoutX = textarea.x - leftX;
+ }
+
+ Scrolled(entryPtr->entry.xscrollHandle,
+ leftIndex, rightIndex, entryPtr->entry.numChars);
+}
+
+/* EntryGetGC -- Helper routine.
+ * Get a GC using the specified foreground color and the entry's font.
+ * Result must be freed with Tk_FreeGC().
+ */
+static GC EntryGetGC(Entry *entryPtr, Tcl_Obj *colorObj)
+{
+ Tk_Window tkwin = entryPtr->core.tkwin;
+ Tk_Font font = Tk_GetFontFromObj(tkwin, entryPtr->entry.fontObj);
+ XColor *colorPtr;
+ unsigned long mask = 0ul;
+ XGCValues gcValues;
+
+ gcValues.line_width = 1; mask |= GCLineWidth;
+ gcValues.font = Tk_FontId(font); mask |= GCFont;
+ if (colorObj != 0 && (colorPtr=Tk_GetColorFromObj(tkwin,colorObj)) != 0) {
+ gcValues.foreground = colorPtr->pixel;
+ mask |= GCForeground;
+ }
+ return Tk_GetGC(entryPtr->core.tkwin, mask, &gcValues);
+}
+
+
+/* EntryDisplay --
+ * Redraws the contents of an entry window.
+ */
+static void EntryDisplay(void *clientData, Drawable d)
+{
+ Entry *entryPtr = clientData;
+ Tk_Window tkwin = entryPtr->core.tkwin;
+ int leftIndex = entryPtr->entry.xscroll.first,
+ rightIndex = entryPtr->entry.xscroll.last,
+ selFirst = entryPtr->entry.selectFirst,
+ selLast = entryPtr->entry.selectLast;
+ EntryStyleData es;
+ GC gc;
+ int showSelection, showCursor;
+
+ EntryInitStyleData(entryPtr, &es);
+
+ showCursor =
+ (entryPtr->core.flags & CURSOR_ON) != 0
+ && EntryEditable(entryPtr)
+ && entryPtr->entry.insertPos >= leftIndex
+ && entryPtr->entry.insertPos <= rightIndex
+ ;
+ showSelection =
+ (entryPtr->core.state & TTK_STATE_DISABLED) == 0
+ && selFirst > -1
+ && selLast > leftIndex
+ && selFirst <= rightIndex
+ ;
+
+ /* Adjust selection range to keep in display bounds.
+ */
+ if (showSelection) {
+ if (selFirst < leftIndex)
+ selFirst = leftIndex;
+ if (selLast > rightIndex)
+ selLast = rightIndex;
+ }
+
+ /* Draw widget background & border
+ */
+ Ttk_DrawLayout(entryPtr->core.layout, entryPtr->core.state, d);
+
+ /* Draw selection background
+ */
+ if (showSelection && es.selBorderObj) {
+ Tk_3DBorder selBorder = Tk_Get3DBorderFromObj(tkwin, es.selBorderObj);
+ int selStartX = EntryCharPosition(entryPtr, selFirst);
+ int selEndX = EntryCharPosition(entryPtr, selLast);
+ int borderWidth = 1;
+
+ Tcl_GetIntFromObj(NULL, es.selBorderWidthObj, &borderWidth);
+
+ if (selBorder) {
+ Tk_Fill3DRectangle(tkwin, d, selBorder,
+ selStartX - borderWidth, entryPtr->entry.layoutY - borderWidth,
+ selEndX - selStartX + 2*borderWidth,
+ entryPtr->entry.layoutHeight + 2*borderWidth,
+ borderWidth, TK_RELIEF_RAISED);
+ }
+ }
+
+ /* Draw cursor:
+ */
+ if (showCursor) {
+ int cursorX = EntryCharPosition(entryPtr, entryPtr->entry.insertPos),
+ cursorY = entryPtr->entry.layoutY,
+ cursorHeight = entryPtr->entry.layoutHeight,
+ cursorWidth = 1;
+
+ Tcl_GetIntFromObj(NULL,es.insertWidthObj,&cursorWidth);
+ if (cursorWidth <= 0) {
+ cursorWidth = 1;
+ }
+
+ /* @@@ should: maybe: SetCaretPos even when blinked off */
+ Tk_SetCaretPos(tkwin, cursorX, cursorY, cursorHeight);
+
+ gc = EntryGetGC(entryPtr, es.insertColorObj);
+ XFillRectangle(Tk_Display(tkwin), d, gc,
+ cursorX-cursorWidth/2, cursorY, cursorWidth, cursorHeight);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+ }
+
+ /* Draw the text:
+ */
+ gc = EntryGetGC(entryPtr, es.foregroundObj);
+ Tk_DrawTextLayout(
+ Tk_Display(tkwin), d, gc, entryPtr->entry.textLayout,
+ entryPtr->entry.layoutX, entryPtr->entry.layoutY,
+ leftIndex, rightIndex);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+
+ /* Overwrite the selected portion (if any) in the -selectforeground color:
+ */
+ if (showSelection) {
+ gc = EntryGetGC(entryPtr, es.selForegroundObj);
+ Tk_DrawTextLayout(
+ Tk_Display(tkwin), d, gc, entryPtr->entry.textLayout,
+ entryPtr->entry.layoutX, entryPtr->entry.layoutY,
+ selFirst, selLast);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands.
+ */
+
+/* EntryIndex --
+ * Parse an index into an entry and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *indexPtr is
+ * filled in with the character index (into entryPtr) corresponding to
+ * string. The index value is guaranteed to lie between 0 and
+ * the number of characters in the string, inclusive. If an
+ * error occurs then an error message is left in the interp's result.
+ */
+static int
+EntryIndex(
+ Tcl_Interp *interp, /* For error messages. */
+ Entry *entryPtr, /* Entry widget to query */
+ Tcl_Obj *indexObj, /* Symbolic index name */
+ int *indexPtr) /* Return value */
+{
+# define EntryWidth(e) (Tk_Width(entryPtr->core.tkwin)) /* Not Right */
+ int length;
+ const char *string = Tcl_GetStringFromObj(indexObj, &length);
+
+ if (strncmp(string, "end", length) == 0) {
+ *indexPtr = entryPtr->entry.numChars;
+ } else if (strncmp(string, "insert", length) == 0) {
+ *indexPtr = entryPtr->entry.insertPos;
+ } else if (strncmp(string, "left", length) == 0) { /* for debugging */
+ *indexPtr = entryPtr->entry.xscroll.first;
+ } else if (strncmp(string, "right", length) == 0) { /* for debugging */
+ *indexPtr = entryPtr->entry.xscroll.last;
+ } else if (strncmp(string, "sel.", 4) == 0) {
+ if (entryPtr->entry.selectFirst < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "selection isn't in widget ",
+ Tk_PathName(entryPtr->core.tkwin), NULL);
+ return TCL_ERROR;
+ }
+ if (strncmp(string, "sel.first", length) == 0) {
+ *indexPtr = entryPtr->entry.selectFirst;
+ } else if (strncmp(string, "sel.last", length) == 0) {
+ *indexPtr = entryPtr->entry.selectLast;
+ } else {
+ goto badIndex;
+ }
+ } else if (string[0] == '@') {
+ int roundUp = 0;
+ int maxWidth = EntryWidth(entryPtr);
+ int x;
+
+ if (Tcl_GetInt(interp, string + 1, &x) != TCL_OK) {
+ goto badIndex;
+ }
+ if (x > maxWidth) {
+ x = maxWidth;
+ roundUp = 1;
+ }
+ *indexPtr = Tk_PointToChar(entryPtr->entry.textLayout,
+ x - entryPtr->entry.layoutX, 0);
+
+ if (*indexPtr < entryPtr->entry.xscroll.first) {
+ *indexPtr = entryPtr->entry.xscroll.first;
+ }
+
+ /*
+ * Special trick: if the x-position was off-screen to the right,
+ * round the index up to refer to the character just after the
+ * last visible one on the screen. This is needed to enable the
+ * last character to be selected, for example.
+ */
+
+ if (roundUp && (*indexPtr < entryPtr->entry.numChars)) {
+ *indexPtr += 1;
+ }
+ } else {
+ if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
+ goto badIndex;
+ }
+ if (*indexPtr < 0) {
+ *indexPtr = 0;
+ } else if (*indexPtr > entryPtr->entry.numChars) {
+ *indexPtr = entryPtr->entry.numChars;
+ }
+ }
+ return TCL_OK;
+
+badIndex:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad entry index \"", string, "\"", NULL);
+ return TCL_ERROR;
+}
+
+/* $entry bbox $index --
+ * Return the bounding box of the character at the specified index.
+ */
+static int
+EntryBBoxCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ Ttk_Box b;
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((index == entryPtr->entry.numChars) && (index > 0)) {
+ index--;
+ }
+ Tk_CharBbox(entryPtr->entry.textLayout, index,
+ &b.x, &b.y, &b.width, &b.height);
+ b.x += entryPtr->entry.layoutX;
+ b.y += entryPtr->entry.layoutY;
+ Tcl_SetObjResult(interp, Ttk_NewBoxObj(b));
+ return TCL_OK;
+}
+
+/* $entry delete $from ?$to? --
+ * Delete the characters in the range [$from,$to).
+ * $to defaults to $from+1 if not specified.
+ */
+static int
+EntryDeleteCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ int first, last;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2], &first) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ last = first + 1;
+ } else if (EntryIndex(interp, entryPtr, objv[3], &last) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (last >= first && EntryEditable(entryPtr)) {
+ return DeleteChars(entryPtr, first, last - first);
+ }
+ return TCL_OK;
+}
+
+/* $entry get --
+ * Return the current value of the entry widget.
+ */
+static int
+EntryGetCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, entryPtr->entry.string, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/* $entry icursor $index --
+ * Set the insert cursor position.
+ */
+static int
+EntryICursorCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pos");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2],
+ &entryPtr->entry.insertPos) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TtkRedisplayWidget(&entryPtr->core);
+ return TCL_OK;
+}
+
+/* $entry index $index --
+ * Return numeric value (0..numChars) of the specified index.
+ */
+static int
+EntryIndexCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "string");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ return TCL_OK;
+}
+
+/* $entry insert $index $text --
+ * Insert $text after position $index.
+ * Silent no-op if the entry is disabled or read-only.
+ */
+static int
+EntryInsertCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index text");
+ return TCL_ERROR;
+ }
+ if (EntryIndex(interp, entryPtr, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (EntryEditable(entryPtr)) {
+ return InsertChars(entryPtr, index, Tcl_GetString(objv[3]));
+ }
+ return TCL_OK;
+}
+
+/* selection clear --
+ * Clear selection.
+ */
+static int EntrySelectionClearCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ entryPtr->entry.selectFirst = entryPtr->entry.selectLast = -1;
+ TtkRedisplayWidget(&entryPtr->core);
+ return TCL_OK;
+}
+
+/* $entry selection present --
+ * Returns 1 if any characters are selected, 0 otherwise.
+ */
+static int EntrySelectionPresentCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp,
+ Tcl_NewBooleanObj(entryPtr->entry.selectFirst >= 0));
+ return TCL_OK;
+}
+
+/* $entry selection range $start $end --
+ * Explicitly set the selection range.
+ */
+static int EntrySelectionRangeCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ int start, end;
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "start end");
+ return TCL_ERROR;
+ }
+ if ( EntryIndex(interp, entryPtr, objv[3], &start) != TCL_OK
+ || EntryIndex(interp, entryPtr, objv[4], &end) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (entryPtr->core.state & TTK_STATE_DISABLED) {
+ return TCL_OK;
+ }
+
+ if (start >= end) {
+ entryPtr->entry.selectFirst = entryPtr->entry.selectLast = -1;
+ } else {
+ entryPtr->entry.selectFirst = start;
+ entryPtr->entry.selectLast = end;
+ EntryOwnSelection(entryPtr);
+ }
+ TtkRedisplayWidget(&entryPtr->core);
+ return TCL_OK;
+}
+
+/* $entry selection $command ?arg arg...?
+ * Ensemble, see above.
+ */
+static int EntrySelectionCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ static WidgetCommandSpec EntrySelectionCommands[] = {
+ { "clear", EntrySelectionClearCommand },
+ { "present", EntrySelectionPresentCommand },
+ { "range", EntrySelectionRangeCommand },
+ {0,0}
+ };
+ return WidgetEnsembleCommand(
+ EntrySelectionCommands, 2, interp, objc, objv, recordPtr);
+}
+
+/* $entry set $value
+ * Sets the value of an entry widget.
+ */
+static int EntrySetCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "value");
+ return TCL_ERROR;
+ }
+ EntrySetValue(entryPtr, Tcl_GetString(objv[2]));
+ return TCL_OK;
+}
+
+/* $entry validate --
+ * Trigger forced validation. Returns 1/0 if validation succeeds/fails
+ * or error status from -validatecommand / -invalidcommand.
+ */
+static int EntryValidateCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ int code;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ code = EntryRevalidate(interp, entryPtr, VALIDATE_FORCED);
+
+ if (code == TCL_ERROR)
+ return code;
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(code == TCL_OK));
+ return TCL_OK;
+}
+
+/* $entry xview -- horizontal scrolling interface
+ */
+static int EntryXViewCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Entry *entryPtr = recordPtr;
+ return ScrollviewCommand(interp, objc, objv, entryPtr->entry.xscrollHandle);
+}
+
+static WidgetCommandSpec EntryCommands[] =
+{
+ { "bbox", EntryBBoxCommand },
+ { "cget", WidgetCgetCommand },
+ { "configure", WidgetConfigureCommand },
+ { "delete", EntryDeleteCommand },
+ { "get", EntryGetCommand },
+ { "icursor", EntryICursorCommand },
+ { "identify", WidgetIdentifyCommand },
+ { "index", EntryIndexCommand },
+ { "insert", EntryInsertCommand },
+ { "instate", WidgetInstateCommand },
+ { "selection", EntrySelectionCommand },
+ { "state", WidgetStateCommand },
+ { "validate", EntryValidateCommand },
+ { "xview", EntryXViewCommand },
+ {0,0}
+};
+
+/*------------------------------------------------------------------------
+ * +++ Entry widget definition.
+ */
+
+WidgetSpec EntryWidgetSpec =
+{
+ "TEntry", /* className */
+ sizeof(Entry), /* recordSize */
+ EntryOptionSpecs, /* optionSpecs */
+ EntryCommands, /* subcommands */
+ EntryInitialize, /* initializeProc */
+ EntryCleanup, /* cleanupProc */
+ EntryConfigure, /* configureProc */
+ EntryPostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ EntryDoLayout, /* layoutProc */
+ EntryDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Combobox widget record.
+ */
+
+typedef struct {
+ Tcl_Obj *postCommandObj;
+ Tcl_Obj *valuesObj;
+ int currentIndex;
+} ComboboxPart;
+
+typedef struct {
+ WidgetCore core;
+ EntryPart entry;
+ ComboboxPart combobox;
+} Combobox;
+
+static Tk_OptionSpec ComboboxOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-postcommand", "postCommand", "PostCommand",
+ "", Tk_Offset(Combobox, combobox.postCommandObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-values", "values", "Values",
+ "", Tk_Offset(Combobox, combobox.valuesObj), -1,
+ 0,0,0 },
+ WIDGET_INHERIT_OPTIONS(EntryOptionSpecs)
+};
+
+/* ComboboxInitialize --
+ * Initialization hook for combobox widgets.
+ */
+static int
+ComboboxInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Combobox *cb = recordPtr;
+ cb->combobox.currentIndex = -1;
+ TrackElementState(&cb->core);
+ return EntryInitialize(interp, recordPtr);
+}
+
+/* ComboboxConfigure --
+ * Configuration hook for combobox widgets.
+ */
+static int
+ComboboxConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Combobox *cbPtr = recordPtr;
+ int unused;
+
+ /* Make sure -values is a valid list:
+ */
+ if (Tcl_ListObjLength(interp,cbPtr->combobox.valuesObj,&unused) != TCL_OK)
+ return TCL_ERROR;
+
+ return EntryConfigure(interp, recordPtr, mask);
+}
+
+/* $cb current ?newIndex? -- get or set current index.
+ * Setting the current index updates the combobox value,
+ * but the value and -values may be changed independently
+ * of the index. Instead of trying to keep currentIndex
+ * in sync at all times, [$cb current] double-checks
+ */
+static int ComboboxCurrentCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Combobox *cbPtr = recordPtr;
+ int currentIndex = cbPtr->combobox.currentIndex;
+ const char *currentValue = cbPtr->entry.string;
+ int nValues;
+ Tcl_Obj **values;
+
+ Tcl_ListObjGetElements(interp,cbPtr->combobox.valuesObj,&nValues,&values);
+
+ if (objc == 2) {
+ /* Check if currentIndex still valid:
+ */
+ if ( currentIndex < 0
+ || currentIndex >= nValues
+ || strcmp(currentValue,Tcl_GetString(values[currentIndex]))
+ )
+ {
+ /* Not valid. Check current value against each element in -values:
+ */
+ for (currentIndex = 0; currentIndex < nValues; ++currentIndex) {
+ if (!strcmp(currentValue,Tcl_GetString(values[currentIndex]))) {
+ break;
+ }
+ }
+ if (currentIndex >= nValues) {
+ /* Not found */
+ currentIndex = -1;
+ }
+ }
+ cbPtr->combobox.currentIndex = currentIndex;
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(currentIndex));
+ return TCL_OK;
+ } else if (objc == 3) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &currentIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (currentIndex < 0 || currentIndex >= nValues) {
+ Tcl_AppendResult(interp,
+ "Index ", Tcl_GetString(objv[2]), " out of range",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ cbPtr->combobox.currentIndex = currentIndex;
+
+ return EntrySetValue(recordPtr, Tcl_GetString(values[currentIndex]));
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?newIndex?");
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Combobox widget definition.
+ */
+static WidgetCommandSpec ComboboxCommands[] =
+{
+ { "bbox", EntryBBoxCommand },
+ { "cget", WidgetCgetCommand },
+ { "configure", WidgetConfigureCommand },
+ { "current", ComboboxCurrentCommand },
+ { "delete", EntryDeleteCommand },
+ { "get", EntryGetCommand },
+ { "icursor", EntryICursorCommand },
+ { "identify", WidgetIdentifyCommand },
+ { "index", EntryIndexCommand },
+ { "insert", EntryInsertCommand },
+ { "instate", WidgetInstateCommand },
+ { "selection", EntrySelectionCommand },
+ { "state", WidgetStateCommand },
+ { "set", EntrySetCommand },
+ { "xview", EntryXViewCommand },
+ {0,0}
+};
+
+WidgetSpec ComboboxWidgetSpec =
+{
+ "TCombobox", /* className */
+ sizeof(Combobox), /* recordSize */
+ ComboboxOptionSpecs, /* optionSpecs */
+ ComboboxCommands, /* subcommands */
+ ComboboxInitialize, /* initializeProc */
+ EntryCleanup, /* cleanupProc */
+ ComboboxConfigure, /* configureProc */
+ EntryPostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ EntryDoLayout, /* layoutProc */
+ EntryDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Textarea element.
+ *
+ * Text display area for Entry widgets.
+ * Just computes requested size; display is handled by the widget itself.
+ */
+
+typedef struct {
+ Tcl_Obj *fontObj;
+ Tcl_Obj *widthObj;
+} TextareaElement;
+
+static Ttk_ElementOptionSpec TextareaElementOptions[] = {
+ { "-font", TK_OPTION_FONT,
+ Tk_Offset(TextareaElement,fontObj), DEF_ENTRY_FONT },
+ { "-width", TK_OPTION_INT,
+ Tk_Offset(TextareaElement,widthObj), "20" },
+ {0,0,0}
+};
+
+static void TextareaElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TextareaElement *textarea = elementRecord;
+ Tk_Font font = Tk_GetFontFromObj(tkwin, textarea->fontObj);
+ int avgWidth = Tk_TextWidth(font, "0", 1);
+ Tk_FontMetrics fm;
+ int prefWidth = 1;
+
+ Tk_GetFontMetrics(font, &fm);
+ Tcl_GetIntFromObj(NULL, textarea->widthObj, &prefWidth);
+ if (prefWidth <= 0)
+ prefWidth = 1;
+
+ *heightPtr = fm.linespace;
+ *widthPtr = prefWidth * avgWidth;
+}
+
+static Ttk_ElementSpec TextareaElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(TextareaElement),
+ TextareaElementOptions,
+ TextareaElementGeometry,
+ NullElementDraw
+};
+
+TTK_BEGIN_LAYOUT(EntryLayout)
+ TTK_GROUP("Entry.field", TTK_FILL_BOTH|TTK_BORDER,
+ TTK_GROUP("Entry.padding", TTK_FILL_BOTH,
+ TTK_NODE("Entry.textarea", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(ComboboxLayout)
+ TTK_GROUP("Combobox.field", TTK_FILL_BOTH,
+ TTK_NODE("Combobox.downarrow", TTK_PACK_RIGHT|TTK_FILL_Y)
+ TTK_GROUP("Combobox.padding", TTK_FILL_BOTH|TTK_PACK_LEFT|TTK_EXPAND,
+ TTK_NODE("Combobox.textarea", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/* EntryWidget_Init --
+ * Register entry-based widgets and related resources.
+ */
+int EntryWidget_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme themePtr = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterElement(interp, themePtr, "textarea", &TextareaElementSpec, 0);
+
+ Ttk_RegisterLayout(themePtr, "TEntry", EntryLayout);
+ Ttk_RegisterLayout(themePtr, "TCombobox", ComboboxLayout);
+
+ RegisterWidget(interp, "ttk::entry", &EntryWidgetSpec);
+ RegisterWidget(interp, "ttk::combobox", &ComboboxWidgetSpec);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkFrame.c b/generic/ttk/ttkFrame.c
new file mode 100644
index 0000000..c0a9b6e
--- /dev/null
+++ b/generic/ttk/ttkFrame.c
@@ -0,0 +1,620 @@
+/* $Id: ttkFrame.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Copyright (c) 2004, Joe English
+ *
+ * Ttk widget set: frame and 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_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+static WidgetCommandSpec FrameCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "instate", WidgetInstateCommand },
+ { "state", WidgetStateCommand },
+ { "identify", WidgetIdentifyCommand },
+ { NULL, NULL }
+};
+
+/*
+ * 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 CoreConfigure(interp, recordPtr, mask);
+}
+
+/* public */
+WidgetSpec FrameWidgetSpec =
+{
+ "TFrame", /* className */
+ sizeof(Frame), /* recordSize */
+ FrameOptionSpecs, /* optionSpecs */
+ FrameCommands, /* subcommands */
+ NullInitialize, /* initializeProc */
+ NullCleanup, /* cleanupProc */
+ FrameConfigure, /* configureProc */
+ NullPostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ FrameSize, /* sizeProc */
+ WidgetDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
+/* ======================================================================
+ * +++ 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_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "Bad label anchor specification ", Tcl_GetString(objPtr),
+ 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;
+ Tcl_Obj *labelWidgetObj;
+
+ Ttk_Manager *mgr;
+ Tk_Window labelWidget; /* Set in configureProc */
+ 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,
+ Tk_Offset(Labelframe,label.labelWidgetObj), -1,
+ 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->labelMargins =
+ Ttk_MakePadding(DEFAULT_LABELINSET,0,DEFAULT_LABELINSET,0);
+ 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);
+ }
+ 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)
+{
+ WidgetCore *corePtr = &lframePtr->core;
+ Tk_Window labelWidget = lframePtr->label.labelWidget;
+ Ttk_LayoutNode *textNode = Ttk_LayoutFindNode(corePtr->layout, "text");
+
+ if (labelWidget) {
+ *widthPtr = Tk_ReqWidth(labelWidget);
+ *heightPtr = Tk_ReqHeight(labelWidget);
+ } else if (textNode) {
+ Ttk_LayoutNodeReqSize(corePtr->layout, textNode, 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;
+}
+
+/*
+ * LabelframeDoLayout --
+ * Labelframe layout hook.
+ *
+ * Side effects: Computes labelParcel.
+ */
+
+static void LabelframeDoLayout(void *recordPtr)
+{
+ Labelframe *lframePtr = recordPtr;
+ WidgetCore *corePtr = &lframePtr->core;
+ Ttk_Box borderParcel = Ttk_WinBox(corePtr->tkwin);
+ Ttk_LayoutNode
+ *textNode = Ttk_LayoutFindNode(corePtr->layout, "text"),
+ *borderNode = Ttk_LayoutFindNode(corePtr->layout, "border");
+ int lw, lh; /* Label width and height */
+ LabelframeStyle style;
+ Ttk_Box labelParcel;
+
+ /*
+ * Do base layout:
+ */
+ Ttk_PlaceLayout(corePtr->layout,corePtr->state,borderParcel);
+
+ /*
+ * 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:
+ */
+ if (borderNode) {
+ Ttk_PlaceLayoutNode(corePtr->layout, borderNode, borderParcel);
+ }
+ if (textNode) {
+ Ttk_PlaceLayoutNode(corePtr->layout, textNode, labelParcel);
+ }
+ /* labelWidget placed in LabelframePlaceSlaves GM hook */
+ lframePtr->label.labelParcel = labelParcel;
+}
+
+/* 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);
+ }
+}
+
+/* Labelframe geometry manager:
+ */
+static void LabelAdded(Ttk_Manager *mgr, int slaveIndex) { /* no-op */ }
+static void LabelRemoved(Ttk_Manager *mgr, int slaveIndex) { /* no-op */ }
+static int LabelConfigured(
+ Tcl_Interp *interp, Ttk_Manager *mgr, Ttk_Slave *slave, unsigned mask)
+ { return TCL_OK; }
+
+/* LabelframeLostSlave --
+ * Called when the labelWidget slave is involuntarily lost;
+ * unset the -labelwidget option.
+ * Notes:
+ * Do this here instead of in the SlaveRemoved hook,
+ * since the latter is also called when the widget voluntarily
+ * forgets the slave. The latter happens in the ConfigureProc
+ * at a time when the widget is in an inconsistent state.
+ */
+static void LabelframeLostSlave(ClientData clientData, Tk_Window slaveWindow)
+{
+ Ttk_Slave *slave = clientData;
+ Labelframe *lframePtr = slave->manager->managerData;
+
+ Tcl_DecrRefCount(lframePtr->label.labelWidgetObj);
+ lframePtr->label.labelWidgetObj = 0;
+ lframePtr->label.labelWidget = 0;
+ Ttk_LostSlaveProc(clientData, slaveWindow);
+}
+
+static Tk_OptionSpec LabelOptionSpecs[] = {
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0, 0,0}
+};
+
+static Ttk_ManagerSpec LabelframeManagerSpec =
+{
+ { "labelframe", Ttk_GeometryRequestProc, LabelframeLostSlave },
+ LabelOptionSpecs, 0,
+
+ LabelframeSize,
+ LabelframePlaceSlaves,
+
+ LabelAdded,
+ LabelRemoved,
+ LabelConfigured
+};
+
+/* LabelframeInitialize --
+ * Initialization hook.
+ */
+static int 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.labelParcel = Ttk_MakeBox(-1,-1,-1,-1);
+
+ return TCL_OK;
+}
+
+/* LabelframeCleanup --
+ * Cleanup hook.
+ */
+static void LabelframeCleanup(void *recordPtr)
+{
+ Labelframe *lframe = recordPtr;
+ Ttk_DeleteManager(lframe->label.mgr);
+}
+
+/* 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 = NULL;
+ Ttk_PositionSpec unused;
+
+ /* Validate -labelwidget option:
+ */
+ if (lframePtr->label.labelWidgetObj) {
+ const char *pathName = Tcl_GetString(lframePtr->label.labelWidgetObj);
+ if (pathName && *pathName) {
+ labelWidget =
+ Tk_NameToWindow(interp, pathName, lframePtr->core.tkwin);
+ if (!labelWidget) {
+ return TCL_ERROR;
+ }
+ 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);
+ }
+
+ lframePtr->label.labelWidget = labelWidget;
+
+ if (labelWidget) {
+ Ttk_AddSlave(interp, lframePtr->label.mgr, labelWidget, 0, 0,0);
+ RaiseLabelWidget(lframePtr);
+ }
+ }
+
+ if (mask & GEOMETRY_CHANGED) {
+ Ttk_ManagerSizeChanged(lframePtr->label.mgr);
+ Ttk_ManagerLayoutChanged(lframePtr->label.mgr);
+ }
+
+ return TCL_OK;
+}
+
+/* public */
+WidgetSpec LabelframeWidgetSpec =
+{
+ "TLabelframe", /* className */
+ sizeof(Labelframe), /* recordSize */
+ LabelframeOptionSpecs, /* optionSpecs */
+ FrameCommands, /* subcommands */
+ LabelframeInitialize, /* initializeProc */
+ LabelframeCleanup, /* cleanupProc */
+ LabelframeConfigure, /* configureProc */
+ NullPostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ LabelframeSize, /* sizeProc */
+ LabelframeDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
diff --git a/generic/ttk/ttkImage.c b/generic/ttk/ttkImage.c
new file mode 100644
index 0000000..4e93235
--- /dev/null
+++ b/generic/ttk/ttkImage.c
@@ -0,0 +1,291 @@
+/* $Id: ttkImage.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Ttk widget set -- image element factory.
+ *
+ * Copyright (C) 2004 Pat Thoyts <patthoyts@users.sf.net>
+ * Copyright (C) 2004 Joe English
+ *
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+
+/*------------------------------------------------------------------------
+ * +++ 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_ResourceCache cache; /* Resource cache for images */
+ Tcl_Obj *baseImage; /* Name of default image */
+ Ttk_StateMap imageMap; /* State-based lookup table for images */
+ Tcl_Obj *stickyObj; /* Stickiness specification, NWSE */
+ Tcl_Obj *borderObj; /* Border specification */
+ Tcl_Obj *paddingObj; /* Padding specification */
+ int minWidth; /* Minimum width; overrides image width */
+ int minHeight; /* Minimum width; overrides image width */
+ unsigned sticky;
+ Ttk_Padding border; /* Fixed border region */
+ Ttk_Padding padding; /* Internal padding */
+} ImageData;
+
+static void FreeImageData(void *clientData)
+{
+ ImageData *imageData = clientData;
+ Tcl_DecrRefCount(imageData->baseImage);
+ if (imageData->imageMap) {
+ Tcl_DecrRefCount(imageData->imageMap);
+ }
+ if (imageData->stickyObj) {
+ Tcl_DecrRefCount(imageData->stickyObj);
+ }
+ if (imageData->borderObj) {
+ Tcl_DecrRefCount(imageData->borderObj);
+ }
+ if (imageData->paddingObj) {
+ Tcl_DecrRefCount(imageData->paddingObj);
+ }
+ ckfree(clientData);
+}
+
+static Tk_OptionSpec ImageOptionSpecs[] =
+{
+ { TK_OPTION_STRING, "-sticky", "sticky", "Sticky",
+ "nswe", Tk_Offset(ImageData,stickyObj), -1,
+ 0,0,0 },
+ { TK_OPTION_STRING, "-border", "border", "Border",
+ "0", Tk_Offset(ImageData,borderObj), -1,
+ 0,0,0 },
+ { TK_OPTION_STRING, "-padding", "padding", "Padding",
+ NULL, Tk_Offset(ImageData,paddingObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ { TK_OPTION_STRING, "-map", "map", "Map",
+ "", Tk_Offset(ImageData,imageMap), -1,
+ 0,0,0 },
+ { TK_OPTION_INT, "-width", "width", "Width",
+ "-1", -1, Tk_Offset(ImageData, minWidth),
+ 0, 0, 0},
+ { TK_OPTION_INT, "-height", "height", "Height",
+ "-1", -1, Tk_Offset(ImageData, minHeight),
+ 0, 0, 0},
+ { TK_OPTION_END }
+};
+
+static void ImageElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ImageData *imageData = clientData;
+ Tk_Image image = Ttk_UseImage(imageData->cache,tkwin,imageData->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;
+ *widthPtr -= Ttk_PaddingWidth(imageData->padding);
+ *heightPtr -= Ttk_PaddingHeight(imageData->padding);
+}
+
+static void ImageElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ImageData *imageData = clientData;
+ Tcl_Obj *imageObj = 0;
+ Tk_Image image;
+ int imgWidth, imgHeight;
+ Ttk_Box src, dst;
+
+ if (imageData->imageMap) {
+ imageObj = Ttk_StateMapLookup(NULL, imageData->imageMap, state);
+ }
+ if (!imageObj) {
+ imageObj = imageData->baseImage;
+ }
+ image = Ttk_UseImage(imageData->cache, tkwin, imageObj);
+
+ 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),
+ NullElementOptions,
+ ImageElementGeometry,
+ 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[])
+{
+ Tk_OptionTable imageOptionTable =
+ Tk_CreateOptionTable(interp, ImageOptionSpecs);
+ ImageData *imageData;
+
+ imageData = (ImageData*)ckalloc(sizeof(*imageData));
+
+ if (objc <= 0) {
+ Tcl_AppendResult(interp, "Must supply a base image", NULL);
+ return TCL_ERROR;
+ }
+
+ imageData->cache = Ttk_GetResourceCache(interp);
+ imageData->imageMap = imageData->stickyObj
+ = imageData->borderObj = imageData->paddingObj = 0;
+ imageData->minWidth = imageData->minHeight = -1;
+ imageData->sticky = TTK_FILL_BOTH; /* ??? Is this sensible */
+ imageData->border = imageData->padding = Ttk_UniformPadding(0);
+
+ /* Can't use Tk_InitOptions() here, since we don't have a Tk_Window
+ */
+ if (TCL_OK != Tk_SetOptions(interp, (ClientData)imageData,
+ imageOptionTable, objc-1, objv+1,
+ NULL/*tkwin*/, NULL/*savedOptions*/, NULL/*mask*/))
+ {
+ ckfree((ClientData)imageData);
+ return TCL_ERROR;
+ }
+
+ imageData->baseImage = Tcl_DuplicateObj(objv[0]);
+
+ if (imageData->borderObj && Ttk_GetBorderFromObj(
+ interp, imageData->borderObj, &imageData->border) != TCL_OK)
+ {
+ goto error;
+ }
+
+ imageData->padding = imageData->border;
+
+ if (imageData->paddingObj && Ttk_GetBorderFromObj(
+ interp, imageData->paddingObj, &imageData->padding) != TCL_OK)
+ {
+ goto error;
+ }
+
+ if (imageData->stickyObj && Ttk_GetStickyFromObj(
+ interp, imageData->stickyObj, &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;
+}
+
+void Ttk_ImageInit(Tcl_Interp *interp)
+{
+ Ttk_RegisterElementFactory(interp, "image", Ttk_CreateImageElement, NULL);
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkInit.c b/generic/ttk/ttkInit.c
new file mode 100644
index 0000000..723708f
--- /dev/null
+++ b/generic/ttk/ttkInit.c
@@ -0,0 +1,289 @@
+/* $Id: ttkInit.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * 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 in ttkTheme.h.
+ */
+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_GetIndexFromObj(interp, objPtr,
+ TTKDefaultStrings, "default state", 0, statePtr);
+}
+
+/*
+ * Legal values for the -compound option.
+ * See also: enum Ttk_Compound in ttkTheme.h
+ */
+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_GetIndexFromObj(interp, objPtr,
+ TTKCompoundStrings, "compound layout", 0, statePtr);
+}
+
+/*
+ * Legal values for the -orient option.
+ * See also: enum TTK_ORIENT in ttkTheme.h
+ */
+CONST char *TTKOrientStrings[] = {
+ "horizontal", "vertical", NULL
+};
+
+int Ttk_GetOrientFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, int *resultPtr)
+{
+ *resultPtr = TTK_ORIENT_HORIZONTAL;
+ return Tcl_GetIndexFromObj(interp, objPtr,
+ TTKOrientStrings, "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
+};
+
+/* CheckStateOption --
+ * 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 CheckStateOption(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) WidgetChangeState(corePtr, f, all^f)
+
+ (void)Tcl_GetIndexFromObj(NULL,objPtr,TTKStateStrings,"",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
+}
+
+/* SendVirtualEvent --
+ * 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 SendVirtualEvent(Tk_Window tgtWin, const char *eventName)
+{
+ XEvent event;
+
+ memset(&event, 0, sizeof(event));
+ event.xany.type = VirtualEvent;
+ event.xany.serial = NextRequest(Tk_Display(tgtWin));
+ event.xany.send_event = False;
+ event.xany.window = Tk_WindowId(tgtWin);
+ event.xany.display = Tk_Display(tgtWin);
+ ((XVirtualEvent *) &event)->name = Tk_GetUid(eventName);
+
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+}
+
+/* EnumerateOptions, GetOptionValue --
+ * Common factors for data accessor commands.
+ */
+int EnumerateOptions(
+ Tcl_Interp *interp, void *recordPtr, 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 GetOptionValue(
+ 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 CoreOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ "", Tk_Offset(WidgetCore, takeFocusPtr), -1, 0,0,0 },
+ {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}
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget definitions.
+ */
+
+extern WidgetSpec FrameWidgetSpec;
+extern WidgetSpec LabelframeWidgetSpec;
+extern WidgetSpec LabelWidgetSpec;
+extern WidgetSpec ButtonWidgetSpec;
+extern WidgetSpec CheckbuttonWidgetSpec;
+extern WidgetSpec RadiobuttonWidgetSpec;
+extern WidgetSpec MenubuttonWidgetSpec;
+extern WidgetSpec ScrollbarWidgetSpec;
+extern WidgetSpec ScaleWidgetSpec;
+extern WidgetSpec SeparatorWidgetSpec;
+extern WidgetSpec SizegripWidgetSpec;
+
+extern void Progressbar_Init(Tcl_Interp *);
+extern void Notebook_Init(Tcl_Interp *);
+extern void EntryWidget_Init(Tcl_Interp *);
+extern void Treeview_Init(Tcl_Interp *);
+extern void Paned_Init(Tcl_Interp *);
+
+#ifdef TTK_SQUARE_WIDGET
+extern void SquareWidget_Init(Tcl_Interp *);
+#endif
+
+static void RegisterWidgets(Tcl_Interp *interp)
+{
+ RegisterWidget(interp, "::ttk::frame", &FrameWidgetSpec);
+ RegisterWidget(interp, "::ttk::labelframe", &LabelframeWidgetSpec);
+ 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);
+ RegisterWidget(interp, "::ttk::scrollbar", &ScrollbarWidgetSpec);
+ RegisterWidget(interp, "::ttk::scale", &ScaleWidgetSpec);
+ RegisterWidget(interp, "::ttk::separator", &SeparatorWidgetSpec);
+ RegisterWidget(interp, "::ttk::sizegrip", &SizegripWidgetSpec);
+ Notebook_Init(interp);
+ EntryWidget_Init(interp);
+ Progressbar_Init(interp);
+ Paned_Init(interp);
+#ifdef TTK_TREEVIEW_WIDGET
+ Treeview_Init(interp);
+#endif
+
+#ifdef TTK_SQUARE_WIDGET
+ SquareWidget_Init(interp);
+#endif
+}
+
+/*------------------------------------------------------------------------
+ * +++ Built-in themes.
+ */
+
+extern int AltTheme_Init(Tcl_Interp *);
+extern int ClassicTheme_Init(Tcl_Interp *);
+extern int ClamTheme_Init(Tcl_Interp *);
+
+extern int Ttk_ImageInit(Tcl_Interp *);
+
+static void RegisterThemes(Tcl_Interp *interp)
+{
+ Ttk_ImageInit(interp); /* not really a theme... */
+ AltTheme_Init(interp);
+ ClassicTheme_Init(interp);
+ ClamTheme_Init(interp);
+}
+
+/*
+ * Ttk initialization.
+ */
+
+extern TtkStubs ttkStubs;
+
+int DLLEXPORT
+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);
+
+#if 0
+ Tcl_PkgProvideEx(interp, "Ttk", TTK_PATCH_LEVEL, (void*)&ttkStubs);
+#endif
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c
new file mode 100644
index 0000000..e2ccc6f
--- /dev/null
+++ b/generic/ttk/ttkLabel.c
@@ -0,0 +1,740 @@
+/* $Id: ttkLabel.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Ttk widget set: text, image, and label elements.
+ *
+ * The label element combines text and image elements,
+ * with layout determined by the "-compound" option.
+ *
+ */
+
+#include <tcl.h>
+#include <tk.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 *backgroundObj;
+ 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" },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(TextElement,backgroundObj), DEFAULT_BACKGROUND },
+ { "-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), "center"},
+ { "-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}
+};
+
+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;
+ int lastChar = -1;
+ XGCValues gcValues;
+ GC gc1, gc2;
+ Tk_Anchor anchor = TK_ANCHOR_CENTER;
+
+ 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:
+ * @@@ BUG: This will overclip multi-line text.
+ */
+ if (b.width < text->width) {
+ lastChar = Tk_PointToChar(text->textLayout, b.width, 1) + 1;
+ }
+
+ if (text->embossed) {
+ Tk_DrawTextLayout(Tk_Display(tkwin), d, gc2,
+ text->textLayout, b.x+1, b.y+1, 0/*firstChar*/, lastChar);
+ }
+ Tk_DrawTextLayout(Tk_Display(tkwin), d, gc1,
+ text->textLayout, b.x, b.y, 0/*firstChar*/, lastChar);
+
+ Tcl_GetIntFromObj(NULL, text->underlineObj, &underline);
+ if (underline >= 0 && (lastChar == -1 || underline <= lastChar)) {
+ 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);
+ }
+
+ 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);
+ }
+}
+
+/*public*/ Ttk_ElementSpec TextElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(TextElement),
+ TextElementOptions,
+ TextElementSize,
+ TextElementDraw
+};
+
+/*
+ * ImageTextElement --
+ * Same as TextElement, but erases the background area first.
+ */
+static void ImageTextElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ TextElement *text = elementRecord;
+ Tk_3DBorder bd = Tk_Get3DBorderFromObj(tkwin,text->backgroundObj);
+
+ if (!TextSetup(text, tkwin))
+ return;
+
+ XFillRectangle(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, bd, TK_3D_FLAT_GC), b.x, b.y, b.width, b.height);
+
+ TextDraw(text, tkwin, d, b);
+ TextCleanup(text);
+}
+
+/*public*/ Ttk_ElementSpec ImageTextElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(TextElement),
+ TextElementOptions,
+ TextElementSize,
+ ImageTextElementDraw
+};
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Image element.
+ *
+ * Draws an image.
+ *
+ * The clientData parameter is a Tcl_Interp, which is needed for
+ * the call to Tk_GetImage().
+ */
+
+typedef struct
+{
+ Tcl_Obj *imageObj;
+
+ Tcl_Obj *stippleObj; /* For TTK_STATE_DISABLED */
+ Tcl_Obj *backgroundObj; /* " " */
+
+ Tk_Image tkimg;
+ int width;
+ int height;
+ int doStipple;
+} 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}
+};
+
+/* NullImageChanged --
+ * No-op Tk_ImageChangedProc for Tk_GetImage.
+ */
+static void NullImageChanged(ClientData clientData,
+ int x, int y, int width, int height, int imageWidth, int imageHeight)
+{ }
+
+/*
+ * 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, Tcl_Interp *interp, Ttk_State state)
+{
+ const char *imageName;
+ Tcl_Obj *imageObj = image->imageObj;
+ Tcl_Obj **mapList = NULL;
+ int i, mapCnt = 0;
+
+ if (!imageObj) /* No -image option specified */
+ return 0;
+
+ if (Tcl_ListObjGetElements(interp,imageObj,&mapCnt,&mapList) == TCL_ERROR)
+ return 0;
+
+ if (mapCnt == 0) /* -image is an empty list */
+ return 0;
+
+ /* Only enable disabled-stippling if there's no state map:
+ * @@@ Possibly: Don't do disabled-stippling at all;
+ * @@@ it's ugly and out of fashion.
+ */
+ image->doStipple = mapCnt == 1;
+
+ /* Locate which image to use based on current state:
+ */
+ imageObj = mapList[0];
+ for (i = 1; i < mapCnt - 1; i += 2) {
+ Ttk_StateSpec stateSpec;
+
+ if (Ttk_GetStateSpecFromObj(interp,mapList[i],&stateSpec) != TCL_OK) {
+ /* shouldn't happen, but can */
+ break;
+ }
+
+ if (Ttk_StateMatches(state, &stateSpec)) {
+ imageObj = mapList[i+1];
+ break;
+ }
+ }
+
+ imageName = Tcl_GetString(imageObj);
+ if (!imageName || !*imageName) /* Empty string. */
+ return 0;
+
+ image->tkimg = Tk_GetImage(interp, tkwin, imageName, NullImageChanged, 0);
+ if (!image->tkimg) /* No such image */
+ return 0;
+
+ Tk_SizeOfImage(image->tkimg, &image->width, &image->height);
+
+ return 1;
+}
+
+static void ImageCleanup(ImageElement *image)
+{
+ Tk_FreeImage(image->tkimg);
+}
+
+/*
+ * 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);
+ }
+}
+
+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;
+ }
+
+ Tk_RedrawImage(image->tkimg, 0,0, width, height, d, b.x, b.y);
+
+ if (image->doStipple && (state & TTK_STATE_DISABLED)) {
+ StippleOver(image, tkwin, d, b.x,b.y);
+ }
+}
+
+static void ImageElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ImageElement *image = elementRecord;
+ Tcl_Interp *interp = clientData;
+
+ if (ImageSetup(image, tkwin, interp, 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;
+ Tcl_Interp *interp = clientData;
+
+ if (ImageSetup(image, tkwin, interp, state)) {
+ ImageDraw(image, tkwin, d, b, state);
+ ImageCleanup(image);
+ }
+}
+
+/*public*/ 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.
+ *
+ * The clientData parameter is a Tcl_Interp; this is needed for the
+ * image part.
+ *
+ * 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" },
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(LabelElement,text.backgroundObj), DEFAULT_BACKGROUND },
+ { "-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), "center"},
+ { "-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}
+};
+
+/*
+ * LabelSetup --
+ * Fills in computed fields of the label element.
+ *
+ * Calculate the text, image, and total width and height.
+ */
+
+#define MAX(a,b) ((a) > (b) ? a : b);
+static void LabelSetup(
+ LabelElement *c, Tk_Window tkwin, Tcl_Interp *interp, Ttk_State state)
+{
+ Tk_GetPixelsFromObj(NULL,tkwin,c->spaceObj,&c->space);
+ Ttk_GetCompoundFromObj(NULL,c->compoundObj,(int*)&c->compound);
+
+ /*
+ * Deal with TTK_COMPOUND_NONE.
+ */
+ if (c->compound == TTK_COMPOUND_NONE) {
+ if (ImageSetup(&c->image, tkwin, interp, state)) {
+ c->compound = TTK_COMPOUND_IMAGE;
+ } else {
+ c->compound = TTK_COMPOUND_TEXT;
+ }
+ } else if (c->compound != TTK_COMPOUND_TEXT) {
+ if (!ImageSetup(&c->image, tkwin, interp, 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;
+ Tcl_Interp *interp = clientData;
+ int textReqWidth = 0;
+
+ LabelSetup(label, tkwin, interp, 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;
+ Tcl_Interp *interp = clientData;
+ Tk_Anchor anchor = TK_ANCHOR_CENTER;
+
+ LabelSetup(l, tkwin, interp, 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);
+}
+
+/*public*/ Ttk_ElementSpec LabelElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(LabelElement),
+ LabelElementOptions,
+ LabelElementSize,
+ LabelElementDraw
+};
+
diff --git a/generic/ttk/ttkLayout.c b/generic/ttk/ttkLayout.c
new file mode 100644
index 0000000..54ebc34
--- /dev/null
+++ b/generic/ttk/ttkLayout.c
@@ -0,0 +1,1200 @@
+/*
+ * layout.c --
+ *
+ * Generic layout processing.
+ *
+ * Copyright (c) 2003 Joe English. Freely redistributable.
+ *
+ * $Id: ttkLayout.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkThemeInt.h"
+
+#define MAX(a,b) (a > b ? a : b)
+#define MIN(a,b) (a < b ? a : b)
+
+/*------------------------------------------------------------------------
+ * +++ Ttk_Box and Ttk_Padding utilities:
+ */
+
+Ttk_Box
+Ttk_MakeBox(int x, int y, int width, int height)
+{
+ Ttk_Box b;
+ b.x = x; b.y = y; b.width = width; b.height = height;
+ return b;
+}
+
+int
+Ttk_BoxContains(Ttk_Box box, int x, int y)
+{
+ return box.x <= x && x < box.x + box.width
+ && box.y <= y && y < box.y + box.height;
+}
+
+Tcl_Obj *
+Ttk_NewBoxObj(Ttk_Box box)
+{
+ Tcl_Obj *result[4];
+
+ result[0] = Tcl_NewIntObj(box.x);
+ result[1] = Tcl_NewIntObj(box.y);
+ result[2] = Tcl_NewIntObj(box.width);
+ result[3] = Tcl_NewIntObj(box.height);
+
+ return Tcl_NewListObj(4, result);
+}
+
+
+
+/*
+ * packTop, packBottom, packLeft, packRight --
+ * Carve out a parcel of the specified height (resp width)
+ * from the specified cavity.
+ *
+ * Returns:
+ * The new parcel.
+ *
+ * Side effects:
+ * Adjust the cavity.
+ */
+
+static Ttk_Box packTop(Ttk_Box *cavity, int height)
+{
+ Ttk_Box parcel;
+ height = MIN(height, cavity->height);
+ parcel = Ttk_MakeBox(cavity->x, cavity->y, cavity->width, height);
+ cavity->y += height;
+ cavity->height -= height;
+ return parcel;
+}
+
+static Ttk_Box packBottom(Ttk_Box *cavity, int height)
+{
+ height = MIN(height, cavity->height);
+ cavity->height -= height;
+ return Ttk_MakeBox(
+ cavity->x, cavity->y + cavity->height,
+ cavity->width, height);
+}
+
+static Ttk_Box packLeft(Ttk_Box *cavity, int width)
+{
+ Ttk_Box parcel;
+ width = MIN(width, cavity->width);
+ parcel = Ttk_MakeBox(cavity->x, cavity->y, width,cavity->height);
+ cavity->x += width;
+ cavity->width -= width;
+ return parcel;
+}
+
+static Ttk_Box packRight(Ttk_Box *cavity, int width)
+{
+ width = MIN(width, cavity->width);
+ cavity->width -= width;
+ return Ttk_MakeBox(cavity->x + cavity->width,
+ cavity->y, width, cavity->height);
+}
+
+/*
+ * Ttk_PackBox --
+ * Carve out a parcel of the specified size on the specified side
+ * in the specified cavity.
+ *
+ * Returns:
+ * The new parcel.
+ *
+ * Side effects:
+ * Adjust the cavity.
+ */
+
+Ttk_Box Ttk_PackBox(Ttk_Box *cavity, int width, int height, Ttk_Side side)
+{
+ switch (side) {
+ default:
+ case TTK_SIDE_TOP: return packTop(cavity, height);
+ case TTK_SIDE_BOTTOM: return packBottom(cavity, height);
+ case TTK_SIDE_LEFT: return packLeft(cavity, width);
+ case TTK_SIDE_RIGHT: return packRight(cavity, width);
+ }
+}
+
+/*
+ * Ttk_PadBox --
+ * Shrink a box by the specified padding amount.
+ */
+Ttk_Box Ttk_PadBox(Ttk_Box b, Ttk_Padding p)
+{
+ b.x += p.left;
+ b.y += p.top;
+ b.width -= (p.left + p.right);
+ b.height -= (p.top + p.bottom);
+ if (b.width <= 0) b.width = 1;
+ if (b.height <= 0) b.height = 1;
+ return b;
+}
+
+/*
+ * Ttk_ExpandBox --
+ * Grow a box by the specified padding amount.
+ */
+Ttk_Box Ttk_ExpandBox(Ttk_Box b, Ttk_Padding p)
+{
+ b.x -= p.left;
+ b.y -= p.top;
+ b.width += (p.left + p.right);
+ b.height += (p.top + p.bottom);
+ return b;
+}
+
+/*
+ * Ttk_StickBox --
+ * Place a box of size w * h in the specified parcel,
+ * according to the specified sticky bits.
+ */
+Ttk_Box Ttk_StickBox(Ttk_Box parcel, int width, int height, unsigned sticky)
+{
+ int dx, dy;
+
+ if (width > parcel.width) width = parcel.width;
+ if (height > parcel.height) height = parcel.height;
+
+ dx = parcel.width - width;
+ dy = parcel.height - height;
+
+ /*
+ * X coordinate adjustment:
+ */
+ switch (sticky & (TTK_STICK_W | TTK_STICK_E))
+ {
+ case TTK_STICK_W | TTK_STICK_E:
+ /* no-op -- use entire parcel width */
+ break;
+ case TTK_STICK_W:
+ parcel.width = width;
+ break;
+ case TTK_STICK_E:
+ parcel.x += dx;
+ parcel.width = width;
+ break;
+ default :
+ parcel.x += dx / 2;
+ parcel.width = width;
+ break;
+ }
+
+ /*
+ * Y coordinate adjustment:
+ */
+ switch (sticky & (TTK_STICK_N | TTK_STICK_S))
+ {
+ case TTK_STICK_N | TTK_STICK_S:
+ /* use entire parcel height */
+ break;
+ case TTK_STICK_N:
+ parcel.height = height;
+ break;
+ case TTK_STICK_S:
+ parcel.y += dy;
+ parcel.height = height;
+ break;
+ default :
+ parcel.y += dy / 2;
+ parcel.height = height;
+ break;
+ }
+
+ return parcel;
+}
+
+/*
+ * AnchorToSticky --
+ * Convert a Tk_Anchor enum to a TTK_STICKY bitmask.
+ */
+static Ttk_Sticky AnchorToSticky(Tk_Anchor anchor)
+{
+ switch (anchor)
+ {
+ case TK_ANCHOR_N: return TTK_STICK_N;
+ case TK_ANCHOR_NE: return TTK_STICK_N | TTK_STICK_E;
+ case TK_ANCHOR_E: return TTK_STICK_E;
+ case TK_ANCHOR_SE: return TTK_STICK_S | TTK_STICK_E;
+ case TK_ANCHOR_S: return TTK_STICK_S;
+ case TK_ANCHOR_SW: return TTK_STICK_S | TTK_STICK_W;
+ case TK_ANCHOR_W: return TTK_STICK_W;
+ case TK_ANCHOR_NW: return TTK_STICK_N | TTK_STICK_W;
+ default:
+ case TK_ANCHOR_CENTER: return 0;
+ }
+}
+
+/*
+ * Ttk_AnchorBox --
+ * Place a box of size w * h in the specified parcel,
+ * according to the specified anchor.
+ */
+Ttk_Box Ttk_AnchorBox(Ttk_Box parcel, int width, int height, Tk_Anchor anchor)
+{
+ return Ttk_StickBox(parcel, width, height, AnchorToSticky(anchor));
+}
+
+/*
+ * Ttk_PlaceBox --
+ * Combine Ttk_PackBox() and Ttk_StickBox().
+ */
+Ttk_Box Ttk_PlaceBox(
+ Ttk_Box *cavity, int width, int height, Ttk_Side side, unsigned sticky)
+{
+ return Ttk_StickBox(
+ Ttk_PackBox(cavity, width, height, side), width, height, sticky);
+}
+
+/*
+ * Ttk_PositionBox --
+ * Pack and stick a box according to PositionSpec flags.
+ */
+TTKAPI Ttk_Box
+Ttk_PositionBox(Ttk_Box *cavity, int width, int height, Ttk_PositionSpec flags)
+{
+ Ttk_Box parcel;
+
+ if (flags & TTK_EXPAND) parcel = *cavity;
+ else if (flags & TTK_PACK_TOP) parcel = packTop(cavity, height);
+ else if (flags & TTK_PACK_LEFT) parcel = packLeft(cavity, width);
+ else if (flags & TTK_PACK_BOTTOM) parcel = packBottom(cavity, height);
+ else if (flags & TTK_PACK_RIGHT) parcel = packRight(cavity, width);
+ else parcel = *cavity;
+
+ return Ttk_StickBox(parcel, width, height, flags);
+}
+
+/*
+ * TTKInitPadding --
+ * Common factor of Ttk_GetPaddingFromObj and Ttk_GetBorderFromObj.
+ * Initializes Ttk_Padding record, supplying default values
+ * for missing entries.
+ */
+static void TTKInitPadding(int padc, int pixels[4], Ttk_Padding *pad)
+{
+ switch (padc)
+ {
+ case 1: pixels[1] = pixels[0]; /*FALLTHRU*/
+ case 2: pixels[2] = pixels[0]; /*FALLTHRU*/
+ case 3: pixels[3] = pixels[1]; /*FALLTHRU*/
+ }
+
+ pad->left = (short)pixels[0];
+ pad->top = (short)pixels[1];
+ pad->right = (short)pixels[2];
+ pad->bottom = (short)pixels[3];
+}
+
+/*
+ * Ttk_GetPaddingFromObj --
+ *
+ * Extract a padding specification from a Tcl_Obj * scaled
+ * to work with a particular Tk_Window.
+ *
+ * The string representation of a Ttk_Padding is a list
+ * of one to four Tk_Pixel specifications, corresponding
+ * to the left, top, right, and bottom padding.
+ *
+ * If the 'bottom' (fourth) element is missing, it defaults to 'top'.
+ * If the 'right' (third) element is missing, it defaults to 'left'.
+ * If the 'top' (second) element is missing, it defaults to 'left'.
+ *
+ * The internal representation is a Tcl_ListObj containing
+ * one to four Tk_PixelObj objects.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR. In the latter case an error message is
+ * left in 'interp' and '*paddingPtr' is set to all-zeros.
+ * Otherwise, *paddingPtr is filled in with the padding specification.
+ *
+ */
+int Ttk_GetPaddingFromObj(
+ Tcl_Interp *interp,
+ Tk_Window tkwin,
+ Tcl_Obj *objPtr,
+ Ttk_Padding *pad)
+{
+ Tcl_Obj **padv;
+ int i, padc, pixels[4];
+
+ if (TCL_OK != Tcl_ListObjGetElements(interp, objPtr, &padc, &padv)) {
+ goto error;
+ }
+
+ if (padc > 4) {
+ if (interp) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Wrong #elements in padding spec", NULL);
+ }
+ goto error;
+ }
+
+ for (i=0; i < padc; ++i) {
+ if (Tk_GetPixelsFromObj(interp, tkwin, padv[i], &pixels[i]) != TCL_OK) {
+ goto error;
+ }
+ }
+
+ TTKInitPadding(padc, pixels, pad);
+ return TCL_OK;
+
+error:
+ pad->left = pad->top = pad->right = pad->bottom = 0;
+ return TCL_ERROR;
+}
+
+/* Ttk_GetBorderFromObj --
+ * Same as Ttk_GetPaddingFromObj, except padding is a list of integers
+ * instead of Tk_Pixel specifications. Does not require a Tk_Window
+ * parameter.
+ *
+ */
+int Ttk_GetBorderFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Padding *pad)
+{
+ Tcl_Obj **padv;
+ int i, padc, pixels[4];
+
+ if (TCL_OK != Tcl_ListObjGetElements(interp, objPtr, &padc, &padv)) {
+ goto error;
+ }
+
+ if (padc > 4) {
+ if (interp) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Wrong #elements in border spec", NULL);
+ }
+ goto error;
+ }
+
+ for (i=0; i < padc; ++i) {
+ if (Tcl_GetIntFromObj(interp, padv[i], &pixels[i]) != TCL_OK) {
+ goto error;
+ }
+ }
+
+ TTKInitPadding(padc, pixels, pad);
+ return TCL_OK;
+
+error:
+ pad->left = pad->top = pad->right = pad->bottom = 0;
+ return TCL_ERROR;
+}
+
+/*
+ * Ttk_MakePadding --
+ * Return an initialized Ttk_Padding structure.
+ */
+Ttk_Padding Ttk_MakePadding(short left, short top, short right, short bottom)
+{
+ Ttk_Padding pad;
+ pad.left = left;
+ pad.top = top;
+ pad.right = right;
+ pad.bottom = bottom;
+ return pad;
+}
+
+/*
+ * Ttk_UniformPadding --
+ * Returns a uniform Ttk_Padding structure, with the same
+ * border width on all sides.
+ */
+Ttk_Padding Ttk_UniformPadding(short borderWidth)
+{
+ Ttk_Padding pad;
+ pad.left = pad.top = pad.right = pad.bottom = borderWidth;
+ return pad;
+}
+
+/*
+ * Ttk_AddPadding --
+ * Combine two padding records.
+ */
+Ttk_Padding Ttk_AddPadding(Ttk_Padding p1, Ttk_Padding p2)
+{
+ p1.left += p2.left;
+ p1.top += p2.top;
+ p1.right += p2.right;
+ p1.bottom += p2.bottom;
+ return p1;
+}
+
+/* Ttk_RelievePadding --
+ * Add an extra n pixels of padding according to specified relief.
+ * This may be used in element geometry procedures to simulate
+ * a "pressed-in" look for pushbuttons.
+ */
+Ttk_Padding Ttk_RelievePadding(Ttk_Padding padding, int relief, int n)
+{
+ switch (relief)
+ {
+ case TK_RELIEF_RAISED:
+ padding.right += n;
+ padding.bottom += n;
+ break;
+ case TK_RELIEF_SUNKEN: /* shift */
+ padding.left += n;
+ padding.top += n;
+ break;
+ default:
+ {
+ int h1 = n/2, h2 = h1 + n % 2;
+ padding.left += h1;
+ padding.top += h1;
+ padding.right += h2;
+ padding.bottom += h2;
+ break;
+ }
+ }
+ return padding;
+}
+
+/*
+ * Ttk_GetStickyFromObj --
+ * Returns a stickiness specification from the specified Tcl_Obj*,
+ * consisting of any combination of n, s, e, and w.
+ *
+ * Returns: TCL_OK if objPtr holds a valid stickiness specification,
+ * otherwise TCL_ERROR. interp is used for error reporting if non-NULL.
+ *
+ */
+int Ttk_GetStickyFromObj(
+ Tcl_Interp *interp, Tcl_Obj *objPtr, Ttk_Sticky *result)
+{
+ const char *string = Tcl_GetString(objPtr);
+ Ttk_Sticky sticky = 0;
+ char c;
+
+ while ((c = *string++) != '\0') {
+ switch (c) {
+ case 'w': case 'W': sticky |= TTK_STICK_W; break;
+ case 'e': case 'E': sticky |= TTK_STICK_E; break;
+ case 'n': case 'N': sticky |= TTK_STICK_N; break;
+ case 's': case 'S': sticky |= TTK_STICK_S; break;
+ default:
+ if (interp) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "Bad -sticky specification ",
+ Tcl_GetString(objPtr),
+ NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
+
+ *result = sticky;
+ return TCL_OK;
+}
+
+/* Ttk_NewStickyObj --
+ * Construct a new Tcl_Obj * containing a stickiness specification.
+ */
+Tcl_Obj *Ttk_NewStickyObj(Ttk_Sticky sticky)
+{
+ char buf[5];
+ char *p = buf;
+
+ if (sticky & TTK_STICK_N) *p++ = 'n';
+ if (sticky & TTK_STICK_S) *p++ = 's';
+ if (sticky & TTK_STICK_W) *p++ = 'w';
+ if (sticky & TTK_STICK_E) *p++ = 'e';
+
+ *p = '\0';
+ return Tcl_NewStringObj(buf, p - buf);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout nodes.
+ */
+struct Ttk_LayoutNode_
+{
+ unsigned flags; /* Packing and sticky flags */
+ Ttk_Element element; /* Element implementation */
+ Ttk_State state; /* Current state */
+ Ttk_Box parcel; /* allocated parcel */
+ Ttk_LayoutNode *next, *child;
+};
+
+static Ttk_LayoutNode *Ttk_NewLayoutNode(unsigned flags, Ttk_Element element)
+{
+ Ttk_LayoutNode *node = (Ttk_LayoutNode*)ckalloc(sizeof(Ttk_LayoutNode));
+
+ node->flags = flags;
+ node->element = element;
+ node->state = 0u;
+ node->next = node->child = 0;
+ /* parcel uninitialized */
+
+ return node;
+}
+
+static void Ttk_FreeLayoutNode(Ttk_LayoutNode *node)
+{
+ while (node) {
+ Ttk_LayoutNode *next = node->next;
+ Ttk_FreeLayoutNode(node->child);
+ ckfree((ClientData)node);
+ node = next;
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout templates.
+ */
+
+struct Ttk_TemplateNode_ {
+ char *name;
+ unsigned flags;
+ struct Ttk_TemplateNode_ *next, *child;
+};
+
+static Ttk_TemplateNode *Ttk_NewTemplateNode(const char *name, unsigned flags)
+{
+ Ttk_TemplateNode *op = (Ttk_TemplateNode*)ckalloc(sizeof(*op));
+ op->name = ckalloc(strlen(name) + 1); strcpy(op->name, name);
+ op->flags = flags;
+ op->next = op->child = 0;
+ return op;
+}
+
+void Ttk_FreeLayoutTemplate(Ttk_LayoutTemplate op)
+{
+ while (op) {
+ Ttk_LayoutTemplate next = op->next;
+ Ttk_FreeLayoutTemplate(op->child);
+ ckfree(op->name);
+ ckfree((ClientData)op);
+ op = next;
+ }
+}
+
+/* InstantiateLayout --
+ * Create a layout tree from a template.
+ */
+static Ttk_LayoutNode *
+Ttk_InstantiateLayout(Ttk_Theme theme, Ttk_TemplateNode *op)
+{
+ Ttk_Element elementImpl = Ttk_GetElement(theme, op->name);
+ Ttk_LayoutNode *node = Ttk_NewLayoutNode(op->flags, elementImpl);
+
+ if (op->next) {
+ node->next = Ttk_InstantiateLayout(theme,op->next);
+ }
+ if (op->child) {
+ node->child = Ttk_InstantiateLayout(theme,op->child);
+ }
+
+ return node;
+}
+
+/*
+ * Ttk_ParseLayoutTemplate --
+ * Convert a Tcl list into a layout template.
+ *
+ * Syntax:
+ * layoutSpec ::= { elementName ?-option value ...? }+
+ */
+
+/* NB: This must match bit definitions TTK_PACK_LEFT etc. */
+static const char *packSideStrings[] =
+ { "left", "right", "top", "bottom", NULL };
+
+Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(Tcl_Interp *interp, Tcl_Obj *objPtr)
+{
+ enum { OP_SIDE, OP_STICKY, OP_EXPAND, OP_BORDER, OP_UNIT, OP_CHILDREN };
+ static const char *optStrings[] = {
+ "-side", "-sticky", "-expand", "-border", "-unit", "-children", 0 };
+
+ int i = 0, objc;
+ Tcl_Obj **objv;
+ Ttk_TemplateNode *head = 0, *tail = 0;
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK)
+ return 0;
+
+ while (i < objc) {
+ char *elementName = Tcl_GetString(objv[i]);
+ unsigned flags = 0x0, sticky = TTK_FILL_BOTH;
+ Tcl_Obj *childSpec = 0;
+
+ /*
+ * Parse options:
+ */
+ ++i;
+ while (i < objc) {
+ const char *optName = Tcl_GetString(objv[i]);
+ int option, value;
+
+ if (optName[0] != '-')
+ break;
+
+ if (Tcl_GetIndexFromObj(
+ interp, objv[i], optStrings, "option", 0, &option)
+ != TCL_OK)
+ {
+ goto error;
+ }
+
+ if (++i >= objc) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "Missing value for option ",Tcl_GetString(objv[i-1]),
+ NULL);
+ goto error;
+ }
+
+ switch (option) {
+ case OP_SIDE: /* <<NOTE-PACKSIDE>> */
+ if (Tcl_GetIndexFromObj(interp, objv[i], packSideStrings,
+ "side", 0, &value) != TCL_OK)
+ {
+ goto error;
+ }
+ flags |= (TTK_PACK_LEFT << value);
+
+ break;
+ case OP_STICKY:
+ if (Ttk_GetStickyFromObj(interp,objv[i],&sticky) != TCL_OK)
+ goto error;
+ break;
+ case OP_EXPAND:
+ if (Tcl_GetBooleanFromObj(interp,objv[i],&value) != TCL_OK)
+ goto error;
+ if (value)
+ flags |= TTK_EXPAND;
+ break;
+ case OP_BORDER:
+ if (Tcl_GetBooleanFromObj(interp,objv[i],&value) != TCL_OK)
+ goto error;
+ if (value)
+ flags |= TTK_BORDER;
+ break;
+ case OP_UNIT:
+ if (Tcl_GetBooleanFromObj(interp,objv[i],&value) != TCL_OK)
+ goto error;
+ if (value)
+ flags |= TTK_UNIT;
+ break;
+ case OP_CHILDREN:
+ childSpec = objv[i];
+ break;
+ }
+ ++i;
+ }
+
+ /*
+ * Build new node:
+ */
+ if (tail) {
+ tail->next = Ttk_NewTemplateNode(elementName, flags | sticky);
+ tail = tail->next;
+ } else {
+ head = tail = Ttk_NewTemplateNode(elementName, flags | sticky);
+ }
+ if (childSpec) {
+ tail->child = Ttk_ParseLayoutTemplate(interp, childSpec);
+ if (!tail->child) {
+ goto error;
+ }
+ }
+ }
+
+ return head;
+
+error:
+ Ttk_FreeLayoutTemplate(head);
+ return 0;
+}
+
+/* Ttk_BuildLayoutTemplate --
+ * Build a layout template tree from a statically defined
+ * Ttk_LayoutSpec array.
+ */
+Ttk_LayoutTemplate Ttk_BuildLayoutTemplate(Ttk_LayoutSpec spec)
+{
+ Ttk_TemplateNode *first = 0, *last = 0;
+
+ for ( ; !(spec->opcode & TTK_LAYOUT_END) ; ++spec) {
+ if (spec->elementName) {
+ Ttk_TemplateNode *node =
+ Ttk_NewTemplateNode(spec->elementName, spec->opcode);
+
+ if (last) {
+ last->next = node;
+ } else {
+ first = node;
+ }
+ last = node;
+ }
+
+ if (spec->opcode & TTK_CHILDREN) {
+ last->child = Ttk_BuildLayoutTemplate(spec+1);
+ while (!(spec->opcode & TTK_LAYOUT_END)) {
+ ++spec;
+ }
+ }
+ } /* for */
+
+ return first;
+}
+
+Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_TemplateNode *node)
+{
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+
+# define APPENDOBJ(obj) Tcl_ListObjAppendElement(NULL, result, obj)
+# define APPENDSTR(str) APPENDOBJ(Tcl_NewStringObj(str,-1))
+
+ while (node) {
+ unsigned flags = node->flags;
+
+ APPENDSTR(node->name);
+
+ /* Back-compute -side. <<NOTE-PACKSIDE>>
+ * @@@ NOTES: Ick.
+ */
+ if (flags & TTK_EXPAND) {
+ APPENDSTR("-expand");
+ APPENDSTR("1");
+ } else {
+ if (flags & _TTK_MASK_PACK) {
+ int side = 0;
+ unsigned sideFlags = flags & _TTK_MASK_PACK;
+
+ while ((sideFlags & TTK_PACK_LEFT) == 0) {
+ ++side;
+ sideFlags >>= 1;
+ }
+ APPENDSTR("-side");
+ APPENDSTR(packSideStrings[side]);
+ }
+ }
+
+ /* In Ttk_ParseLayoutTemplate, default -sticky is "nsew",
+ * so always include this even if no sticky bits are set.
+ */
+ APPENDSTR("-sticky");
+ APPENDOBJ(Ttk_NewStickyObj(flags & _TTK_MASK_STICK));
+
+ /* @@@ Check again: are these necessary? */
+ if (flags & TTK_BORDER) { APPENDSTR("-border"); APPENDSTR("1"); }
+ if (flags & TTK_UNIT) { APPENDSTR("-unit"); APPENDSTR("1"); }
+
+ if (node->child) {
+ APPENDSTR("-children");
+ APPENDOBJ(Ttk_UnparseLayoutTemplate(node->child));
+ }
+ node = node->next;
+ }
+
+# undef APPENDOBJ
+# undef APPENDSTR
+
+ return result;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layouts.
+ */
+struct Ttk_Layout_
+{
+ Ttk_Style style;
+ void *recordPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ Ttk_LayoutNode *root;
+};
+
+static Ttk_Layout TTKNewLayout(
+ Ttk_Style style,
+ void *recordPtr,Tk_OptionTable optionTable, Tk_Window tkwin,
+ Ttk_LayoutNode *root)
+{
+ Ttk_Layout layout = (Ttk_Layout)ckalloc(sizeof(*layout));
+ layout->style = style;
+ layout->recordPtr = recordPtr;
+ layout->optionTable = optionTable;
+ layout->tkwin = tkwin;
+ layout->root = root;
+ return layout;
+}
+
+void Ttk_FreeLayout(Ttk_Layout layout)
+{
+ Ttk_FreeLayoutNode(layout->root);
+ ckfree((ClientData)layout);
+}
+
+/*
+ * Ttk_CreateLayout --
+ * Create a layout from the specified theme and style name.
+ * Returns: New layout, 0 on error.
+ * Leaves an error message in interp's result if there is an error.
+ */
+Ttk_Layout Ttk_CreateLayout(
+ Tcl_Interp *interp, /* where to leave error messages */
+ Ttk_Theme themePtr,
+ const char *styleName,
+ void *recordPtr,
+ Tk_OptionTable optionTable,
+ Tk_Window tkwin)
+{
+ Ttk_Style style = Ttk_GetStyle(themePtr, styleName);
+ Ttk_LayoutTemplate layoutTemplate =
+ Ttk_FindLayoutTemplate(themePtr,styleName);
+ Ttk_Element bgelement = Ttk_GetElement(themePtr, "background");
+ Ttk_LayoutNode *bgnode;
+
+ if (!layoutTemplate) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL);
+ return 0;
+ }
+
+ bgnode = Ttk_NewLayoutNode(TTK_FILL_BOTH, bgelement);
+ bgnode->next = Ttk_InstantiateLayout(themePtr, layoutTemplate);
+
+ return TTKNewLayout(style, recordPtr, optionTable, tkwin, bgnode);
+}
+
+/* Ttk_CreateSublayout --
+ * Creates a new sublayout.
+ *
+ * Sublayouts are used to draw subparts of a compound widget.
+ * They use the same Tk_Window, but a different option table
+ * and data record.
+ */
+Ttk_Layout
+Ttk_CreateSublayout(
+ Tcl_Interp *interp,
+ Ttk_Theme themePtr,
+ Ttk_Layout parentLayout,
+ const char *baseName,
+ Tk_OptionTable optionTable)
+{
+ Tcl_DString buf;
+ const char *styleName;
+ Ttk_Style style;
+ Ttk_LayoutTemplate layoutTemplate;
+
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, Ttk_StyleName(parentLayout->style), -1);
+ Tcl_DStringAppend(&buf, baseName, -1);
+ styleName = Tcl_DStringValue(&buf);
+
+ style = Ttk_GetStyle(themePtr, styleName);
+ layoutTemplate = Ttk_FindLayoutTemplate(themePtr, styleName);
+
+ if (!layoutTemplate) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Layout ", styleName, " not found", NULL);
+ return 0;
+ }
+
+ Tcl_DStringFree(&buf);
+
+ return TTKNewLayout(
+ style, 0, optionTable, parentLayout->tkwin,
+ Ttk_InstantiateLayout(themePtr, layoutTemplate));
+}
+
+/* Ttk_RebindSublayout --
+ * Bind sublayout to new data source.
+ */
+void Ttk_RebindSublayout(Ttk_Layout layout, void *recordPtr)
+{
+ layout->recordPtr = recordPtr;
+}
+
+/*
+ * Ttk_QueryOption --
+ * Look up an option from a layout's associated option.
+ */
+Tcl_Obj *Ttk_QueryOption(
+ Ttk_Layout layout, const char *optionName, Ttk_State state)
+{
+ return Ttk_QueryStyle(
+ layout->style,layout->recordPtr,layout->optionTable,optionName,state);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Size computation.
+ */
+static void Ttk_NodeListSize(
+ Ttk_Layout layout, Ttk_LayoutNode *node,
+ Ttk_State state, int *widthPtr, int *heightPtr); /* Forward */
+
+static void Ttk_NodeSize(
+ Ttk_Layout layout, Ttk_LayoutNode *node, Ttk_State state,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ int elementWidth, elementHeight, subWidth, subHeight;
+ Ttk_Padding elementPadding;
+
+ Ttk_ElementSize(node->element,
+ layout->style, layout->recordPtr,layout->optionTable, layout->tkwin,
+ state|node->state,
+ &elementWidth, &elementHeight, &elementPadding);
+
+ Ttk_NodeListSize(layout,node->child,state,&subWidth,&subHeight);
+ subWidth += Ttk_PaddingWidth(elementPadding);
+ subHeight += Ttk_PaddingHeight(elementPadding);
+
+ *widthPtr = MAX(elementWidth, subWidth);
+ *heightPtr = MAX(elementHeight, subHeight);
+ *paddingPtr = elementPadding;
+}
+
+static void Ttk_NodeListSize(
+ Ttk_Layout layout, Ttk_LayoutNode *node,
+ Ttk_State state, int *widthPtr, int *heightPtr)
+{
+ if (!node) {
+ *widthPtr = *heightPtr = 0;
+ } else {
+ int width, height, restWidth, restHeight;
+ Ttk_Padding unused;
+
+ Ttk_NodeSize(layout, node, state, &width, &height, &unused);
+ Ttk_NodeListSize(layout, node->next, state, &restWidth, &restHeight);
+
+ if (node->flags & (TTK_PACK_LEFT|TTK_PACK_RIGHT)) {
+ *widthPtr = width + restWidth;
+ } else {
+ *widthPtr = MAX(width, restWidth);
+ }
+
+ if (node->flags & (TTK_PACK_TOP|TTK_PACK_BOTTOM)) {
+ *heightPtr = height + restHeight;
+ } else {
+ *heightPtr = MAX(height, restHeight);
+ }
+ }
+}
+
+/*
+ * Ttk_LayoutNodeInternalPadding --
+ * Returns the internal padding of a layout node.
+ */
+Ttk_Padding Ttk_LayoutNodeInternalPadding(
+ Ttk_Layout layout, Ttk_LayoutNode *node)
+{
+ int unused;
+ Ttk_Padding padding;
+ Ttk_ElementSize(node->element,
+ layout->style, layout->recordPtr, layout->optionTable, layout->tkwin,
+ 0/*state*/, &unused, &unused, &padding);
+ return padding;
+}
+
+/*
+ * Ttk_LayoutNodeInternalParcel --
+ * Returns the inner area of a specified layout node,
+ * based on current parcel and element's internal padding.
+ */
+Ttk_Box Ttk_LayoutNodeInternalParcel(Ttk_Layout layout, Ttk_LayoutNode *node)
+{
+ Ttk_Padding padding = Ttk_LayoutNodeInternalPadding(layout, node);
+ return Ttk_PadBox(node->parcel, padding);
+}
+
+/* Ttk_LayoutSize --
+ * Compute requested size of a layout.
+ */
+void Ttk_LayoutSize(
+ Ttk_Layout layout, Ttk_State state, int *widthPtr, int *heightPtr)
+{
+ Ttk_NodeListSize(layout, layout->root, state, widthPtr, heightPtr);
+}
+
+void Ttk_LayoutNodeReqSize( /* @@@ Rename this */
+ Ttk_Layout layout, Ttk_LayoutNode *node, int *widthPtr, int *heightPtr)
+{
+ Ttk_Padding unused;
+ Ttk_NodeSize(layout, node, 0/*state*/, widthPtr, heightPtr, &unused);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout placement.
+ */
+
+/* Ttk_PlaceNodeList --
+ * Compute parcel for each node in a layout tree
+ * according to position specification and overall size.
+ */
+static void Ttk_PlaceNodeList(
+ Ttk_Layout layout, Ttk_LayoutNode *node, Ttk_State state, Ttk_Box cavity)
+{
+ for (; node; node = node->next)
+ {
+ int width, height;
+ Ttk_Padding padding;
+
+ /* Compute node size: (@@@ cache this instead?)
+ */
+ Ttk_NodeSize(layout, node, state, &width, &height, &padding);
+
+ /* Compute parcel:
+ */
+ node->parcel = Ttk_PositionBox(&cavity, width, height, node->flags);
+
+ /* Place child nodes:
+ */
+ if (node->child) {
+ Ttk_Box childBox = Ttk_PadBox(node->parcel, padding);
+ Ttk_PlaceNodeList(layout,node->child, state, childBox);
+ }
+ }
+}
+
+void Ttk_PlaceLayout(Ttk_Layout layout, Ttk_State state, Ttk_Box b)
+{
+ Ttk_PlaceNodeList(layout, layout->root, state, b);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout drawing.
+ */
+
+/*
+ * Ttk_DrawLayout --
+ * Draw a layout tree.
+ */
+static void Ttk_DrawNodeList(
+ Ttk_Layout layout, Ttk_State state, Ttk_LayoutNode *node, Drawable d)
+{
+ for (; node; node = node->next)
+ {
+ int border = node->flags & TTK_BORDER;
+ int substate = state;
+
+ if (node->flags & TTK_UNIT)
+ substate |= node->state;
+
+ if (node->child && border)
+ Ttk_DrawNodeList(layout, substate, node->child, d);
+
+ Ttk_DrawElement(
+ node->element,
+ layout->style,layout->recordPtr,layout->optionTable,layout->tkwin,
+ d, node->parcel, state | node->state);
+
+ if (node->child && !border)
+ Ttk_DrawNodeList(layout, substate, node->child, d);
+ }
+}
+
+void Ttk_DrawLayout(Ttk_Layout layout, Ttk_State state, Drawable d)
+{
+ Ttk_DrawNodeList(layout, state, layout->root, d);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Inquiry and modification.
+ */
+
+/*
+ * Ttk_LayoutIdentify --
+ * Find the layout node at the specified x,y coordinate.
+ */
+static Ttk_LayoutNode *
+Ttk_LayoutNodeIdentify(Ttk_LayoutNode *node, int x, int y)
+{
+ Ttk_LayoutNode *closest = NULL;
+
+ for (; node; node = node->next) {
+ if (Ttk_BoxContains(node->parcel, x, y)) {
+ closest = node;
+ if (node->child && !(node->flags & TTK_UNIT)) {
+ Ttk_LayoutNode *childNode =
+ Ttk_LayoutNodeIdentify(node->child, x,y);
+ if (childNode) {
+ closest = childNode;
+ }
+ }
+ }
+ }
+ return closest;
+}
+
+Ttk_LayoutNode *Ttk_LayoutIdentify(Ttk_Layout layout, int x, int y)
+{
+ return Ttk_LayoutNodeIdentify(layout->root, x, y);
+}
+
+/*
+ * tail --
+ * Return the last component of an element name, e.g.,
+ * "Scrollbar.thumb" => "thumb"
+ */
+static const char *tail(const char *elementName)
+{
+ const char *dot;
+ while ((dot=strchr(elementName,'.')) != NULL)
+ elementName = dot + 1;
+ return elementName;
+}
+
+/*
+ * Ttk_LayoutFindNode --
+ * Look up a layout node by name.
+ */
+static Ttk_LayoutNode *
+Ttk_LayoutNodeFind(Ttk_LayoutNode *node, const char *nodeName)
+{
+ for (; node ; node = node->next) {
+ if (!strcmp(tail(Ttk_LayoutNodeName(node)), nodeName))
+ return node;
+
+ if (node->child) {
+ Ttk_LayoutNode *childNode =
+ Ttk_LayoutNodeFind(node->child, nodeName);
+ if (childNode)
+ return childNode;
+ }
+ }
+ return 0;
+}
+
+Ttk_LayoutNode *Ttk_LayoutFindNode(Ttk_Layout layout, const char *nodeName)
+{
+ return Ttk_LayoutNodeFind(layout->root, nodeName);
+}
+
+const char *Ttk_LayoutNodeName(Ttk_LayoutNode *node)
+{
+ return Ttk_ElementName(node->element);
+}
+
+Ttk_Box Ttk_LayoutNodeParcel(Ttk_LayoutNode *node)
+{
+ return node->parcel;
+}
+
+void Ttk_LayoutNodeSetParcel(Ttk_LayoutNode *node, Ttk_Box parcel)
+{
+ node->parcel = parcel;
+}
+
+void Ttk_PlaceLayoutNode(Ttk_Layout layout, Ttk_LayoutNode *node, Ttk_Box b)
+{
+ node->parcel = b;
+ if (node->child) {
+ Ttk_PlaceNodeList(layout, node->child, 0,
+ Ttk_PadBox(b, Ttk_LayoutNodeInternalPadding(layout, node)));
+ }
+}
+
+void Ttk_ChangeElementState(Ttk_LayoutNode *node,unsigned set,unsigned clr)
+{
+ node->state = (node->state | set) & ~clr;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkManager.c b/generic/ttk/ttkManager.c
new file mode 100644
index 0000000..e41b36d
--- /dev/null
+++ b/generic/ttk/ttkManager.c
@@ -0,0 +1,605 @@
+/* $Id: ttkManager.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright 2005, Joe English. Freely redistributable.
+ *
+ * Ttk widget set: 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.
+ *
+ */
+
+/* ++ manager->flags bits:
+ */
+#define MGR_UPDATE_PENDING 0x1
+#define MGR_RESIZE_REQUIRED 0x2
+#define MGR_RELAYOUT_REQUIRED 0x4
+
+/* ++ slave->flags bits:
+ */
+#define SLAVE_MAPPED 0x1 /* slave to be mapped when master is */
+
+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(
+ clientData, slave->slaveWindow);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Slave initialization and cleanup.
+ */
+
+static Ttk_Slave *CreateSlave(
+ Tcl_Interp *interp, Ttk_Manager *mgr, Tk_Window slaveWindow)
+{
+ Ttk_Slave *slave = (Ttk_Slave*)ckalloc(sizeof(*slave));
+ int status;
+
+ slave->slaveWindow = slaveWindow;
+ slave->manager = mgr;
+ slave->flags = 0;
+ slave->slaveData = ckalloc(mgr->managerSpec->slaveSize);
+ memset(slave->slaveData, 0, mgr->managerSpec->slaveSize);
+
+ if (!mgr->slaveOptionTable) {
+ mgr->slaveOptionTable =
+ Tk_CreateOptionTable(interp, mgr->managerSpec->slaveOptionSpecs);
+ }
+
+ status = Tk_InitOptions(
+ interp, slave->slaveData, mgr->slaveOptionTable, slaveWindow);
+
+ if (status != TCL_OK) {
+ ckfree((ClientData)slave->slaveData);
+ ckfree((ClientData)slave);
+ return NULL;
+ }
+
+ return slave;
+}
+
+static void DeleteSlave(Ttk_Slave *slave)
+{
+ Tk_FreeConfigOptions(
+ slave->slaveData, slave->manager->slaveOptionTable, slave->slaveWindow);
+ ckfree((ClientData)slave->slaveData);
+ ckfree((ClientData)slave);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Manager initialization and cleanup.
+ */
+
+Ttk_Manager *Ttk_CreateManager(
+ Ttk_ManagerSpec *managerSpec, void *managerData, Tk_Window masterWindow)
+{
+ Ttk_Manager *mgr = (Ttk_Manager*)ckalloc(sizeof(*mgr));
+
+ mgr->managerSpec = managerSpec;
+ mgr->managerData = managerData;
+ mgr->masterWindow = masterWindow;
+ mgr->slaveOptionTable= 0;
+ 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((ClientData)mgr->slaves);
+ }
+ if (mgr->slaveOptionTable) {
+ Tk_DeleteOptionTable(mgr->slaveOptionTable);
+ }
+
+ Tk_CancelIdleCall(ManagerIdleProc, mgr);
+
+ ckfree((ClientData)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 = (Ttk_Slave**)ckrealloc(
+ (ClientData)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)slave);
+
+ 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, 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_Slave *slave = clientData;
+ ScheduleUpdate(slave->manager, MGR_RESIZE_REQUIRED);
+}
+
+void Ttk_LostSlaveProc(ClientData clientData, Tk_Window slaveWindow)
+{
+ Ttk_Slave *slave = clientData;
+ int index = Ttk_SlaveIndex(slave->manager, slave->slaveWindow);
+
+ /* ASSERT: index >= 0 */
+ RemoveSlave(slave->manager, index);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Public API.
+ */
+
+/* ++ Ttk_AddSlave --
+ * Create and configure new slave window, insert at specified index.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR; in the case of TCL_ERROR, the slave
+ * is not added and an error message is left in interp.
+ */
+int Ttk_AddSlave(
+ Tcl_Interp *interp, Ttk_Manager *mgr, Tk_Window slaveWindow,
+ int index, int objc, Tcl_Obj *CONST objv[])
+{
+ Ttk_Slave *slave;
+
+ /* Sanity-checks:
+ */
+ if (!Ttk_Maintainable(interp, slaveWindow, mgr->masterWindow)) {
+ return TCL_ERROR;
+ }
+ if (Ttk_SlaveIndex(mgr, slaveWindow) >= 0) {
+ Tcl_AppendResult(interp,
+ Tk_PathName(slaveWindow), " already added",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /* Create, configure, and insert slave:
+ */
+ slave = CreateSlave(interp, mgr, slaveWindow);
+ if (Ttk_ConfigureSlave(interp, mgr, slave, objc, objv) != TCL_OK) {
+ DeleteSlave(slave);
+ return TCL_ERROR;
+ }
+ InsertSlave(mgr, slave, index);
+ mgr->managerSpec->SlaveAdded(mgr, index);
+ return TCL_OK;
+}
+
+/* ++ Ttk_ConfigureSlave --
+ */
+int Ttk_ConfigureSlave(
+ Tcl_Interp *interp, Ttk_Manager *mgr, Ttk_Slave *slave,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ Tk_SavedOptions savedOptions;
+ int mask = 0;
+
+ /* ASSERT: mgr->slaveOptionTable != NULL */
+
+ if (Tk_SetOptions(interp, slave->slaveData, mgr->slaveOptionTable,
+ objc, objv, slave->slaveWindow, &savedOptions, &mask) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ if (mgr->managerSpec->SlaveConfigured(interp,mgr,slave,mask) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+
+ Tk_FreeSavedOptions(&savedOptions);
+ ScheduleUpdate(mgr, MGR_RELAYOUT_REQUIRED);
+ return TCL_OK;
+}
+
+/* ++ 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_GetSlaveFromObj(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:
+ * Pointer to slave; stores slave index in *indexPtr.
+ * On error, returns NULL and leaves an error message in interp.
+ */
+
+Ttk_Slave *Ttk_GetSlaveFromObj(
+ 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_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "Slave index ", Tcl_GetString(objPtr), " out of bounds",
+ NULL);
+ return NULL;
+ }
+ *indexPtr = slaveIndex;
+ return mgr->slaves[slaveIndex];
+ }
+
+ /* 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_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ string, " is not managed by ", Tk_PathName(mgr->masterWindow),
+ NULL);
+ return NULL;
+ }
+ *indexPtr = slaveIndex;
+ return mgr->slaves[slaveIndex];
+ }
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Invalid slave specification ", string, NULL);
+ return NULL;
+}
+
+/* ++ 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), sibling = NULL;
+
+ if (Tk_IsTopLevel(slave) || slave == master) {
+ goto badWindow;
+ }
+
+ while (ancestor != parent) {
+ if (Tk_IsTopLevel(ancestor)) {
+ goto badWindow;
+ }
+ sibling = ancestor;
+ ancestor = Tk_Parent(ancestor);
+ }
+
+ return 1;
+
+badWindow:
+ Tcl_AppendResult(interp,
+ "can't add ", Tk_PathName(slave),
+ " as slave of ", Tk_PathName(master),
+ NULL);
+ return 0;
+}
+
diff --git a/generic/ttk/ttkManager.h b/generic/ttk/ttkManager.h
new file mode 100644
index 0000000..d046cd7
--- /dev/null
+++ b/generic/ttk/ttkManager.h
@@ -0,0 +1,122 @@
+/* $Id: ttkManager.h,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright (c) 2005, Joe English. Freely redistributable.
+ *
+ * Ttk widget set: Geometry management utilities.
+ *
+ * TODO: opacify data structures.
+ */
+
+#ifndef TTK_MANAGER_H
+#define TTK_MANAGER_H 1
+
+typedef struct TtkManager_ Ttk_Manager; /* forward */
+typedef struct TtkSlave_ Ttk_Slave; /* forward */
+
+/*
+ * 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().
+ *
+ * SlaveAdded() is called after a new slave has been added.
+ *
+ * SlaveRemoved() is called immediately before a slave is removed.
+ * NB: the associated slave window may have been destroyed when this
+ * routine is called.
+ */
+typedef struct { /* Manager hooks */
+ Tk_GeomMgr tkGeomMgr; /* "real" Tk Geometry Manager */
+ Tk_OptionSpec *slaveOptionSpecs; /* slave record options */
+ size_t slaveSize; /* size of slave record */
+
+ int (*RequestedSize)(void *managerData, int *widthPtr, int *heightPtr);
+ void (*PlaceSlaves)(void *managerData);
+
+ void (*SlaveAdded)(Ttk_Manager *, int slaveIndex);
+ void (*SlaveRemoved)(Ttk_Manager *, int slaveIndex);
+ int (*SlaveConfigured)(
+ Tcl_Interp *, Ttk_Manager *, Ttk_Slave *, unsigned mask);
+} Ttk_ManagerSpec;
+
+/*
+ * Default implementations for Tk_GeomMgr hooks:
+ */
+extern void Ttk_GeometryRequestProc(ClientData, Tk_Window slave);
+extern void Ttk_LostSlaveProc(ClientData, Tk_Window slave);
+
+struct TtkSlave_
+{
+ Tk_Window slaveWindow;
+ Ttk_Manager *manager;
+ void *slaveData;
+ unsigned flags; /* private; see manager.c */
+};
+
+struct TtkManager_
+{
+ Ttk_ManagerSpec *managerSpec;
+ void *managerData;
+ Tk_Window masterWindow;
+ Tk_OptionTable slaveOptionTable;
+ unsigned flags; /* private; see manager.c */
+ int nSlaves;
+ Ttk_Slave **slaves;
+};
+
+/*
+ * Public API:
+ */
+extern Ttk_Manager *Ttk_CreateManager(
+ Ttk_ManagerSpec *, void *managerData, Tk_Window masterWindow);
+extern void Ttk_DeleteManager(Ttk_Manager *);
+
+extern int Ttk_AddSlave(
+ Tcl_Interp *, Ttk_Manager *, Tk_Window, int position,
+ int objc, Tcl_Obj *CONST objv[]);
+
+extern void Ttk_ForgetSlave(Ttk_Manager *, int slaveIndex);
+
+extern int Ttk_ConfigureSlave(
+ Tcl_Interp *interp, Ttk_Manager *, Ttk_Slave *,
+ int objc, Tcl_Obj *CONST objv[]);
+
+extern void Ttk_ReorderSlave(Ttk_Manager *, int fromIndex, int toIndex);
+ /* Rearrange slave positions */
+
+extern void Ttk_PlaceSlave(
+ Ttk_Manager *, int slaveIndex, int x, int y, int width, int height);
+ /* Position and map the slave */
+
+extern void Ttk_UnmapSlave(Ttk_Manager *, int slaveIndex);
+ /* Unmap the slave */
+
+extern void Ttk_ManagerSizeChanged(Ttk_Manager *);
+extern void Ttk_ManagerLayoutChanged(Ttk_Manager *);
+ /* Notify manager that size (resp. layout) needs to be recomputed */
+
+/* Utilities:
+ */
+extern int Ttk_SlaveIndex(Ttk_Manager *, Tk_Window);
+ /* Returns: index in slave array of specified window, -1 if not found */
+
+extern Ttk_Slave *Ttk_GetSlaveFromObj(
+ Tcl_Interp *, Ttk_Manager *, Tcl_Obj *, int *indexPtr);
+
+/* Accessor functions:
+ */
+extern int Ttk_NumberSlaves(Ttk_Manager *);
+ /* Returns: number of managed slaves */
+
+extern void *Ttk_SlaveData(Ttk_Manager *, int slaveIndex);
+ /* Returns: private data associated with slave */
+
+extern Tk_Window Ttk_SlaveWindow(Ttk_Manager *, int slaveIndex);
+ /* Returns: slave window */
+
+extern int Ttk_Maintainable(Tcl_Interp *, Tk_Window slave, Tk_Window master);
+ /* Returns: 1 if master can manage slave; 0 otherwise leaving error msg */
+
+#endif
diff --git a/generic/ttk/ttkNotebook.c b/generic/ttk/ttkNotebook.c
new file mode 100644
index 0000000..e8b6640
--- /dev/null
+++ b/generic/ttk/ttkNotebook.c
@@ -0,0 +1,1264 @@
+/* $Id: ttkNotebook.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Copyright (c) 2004, Joe English
+ *
+ * NOTE-ACTIVE: activeTabIndex is not always correct (it's
+ * more trouble than it's worth to track this 100%)
+ */
+
+#include <string.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <tk.h>
+
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+#include "ttkManager.h"
+
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+#define MAX(a,b) ((a) > (b) ? (a) : (b))
+
+/*------------------------------------------------------------------------
+ * +++ Tab resources.
+ */
+
+#define DEFAULT_MIN_TAB_WIDTH 24
+
+static const char *TabStateStrings[] = { "normal", "disabled", "hidden", 0 };
+typedef enum {
+ TAB_STATE_NORMAL, TAB_STATE_DISABLED, TAB_STATE_HIDDEN
+} TAB_STATE;
+
+typedef struct
+{
+ /* Internal data:
+ */
+ int width, height; /* Requested size of tab */
+ Ttk_Box parcel; /* Tab position */
+
+ /* Tab options:
+ */
+ TAB_STATE state;
+
+ /* Child window options:
+ */
+ Tcl_Obj *paddingObj; /* Padding inside pane */
+ Ttk_Padding padding;
+ Tcl_Obj *stickyObj;
+ Ttk_Sticky sticky;
+
+ /* Label options:
+ */
+ Tcl_Obj *textObj;
+ Tcl_Obj *imageObj;
+ Tcl_Obj *compoundObj;
+ Tcl_Obj *underlineObj;
+
+} Tab;
+
+/* Two different option tables are used for tabs:
+ * TabOptionSpecs is used to draw the tab, and only includes resources
+ * relevant to the tab.
+ *
+ * PaneOptionSpecs includes additional options for child window placement
+ * and is used to configure the slave.
+ */
+static Tk_OptionSpec TabOptionSpecs[] =
+{
+ {TK_OPTION_STRING_TABLE, "-state", "", "",
+ "normal", -1,Tk_Offset(Tab,state),
+ 0,(ClientData)TabStateStrings,0 },
+ {TK_OPTION_STRING, "-text", "text", "Text", "",
+ Tk_Offset(Tab,textObj), -1, 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-image", "image", "Image", NULL/*default*/,
+ Tk_Offset(Tab,imageObj), -1, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING_TABLE, "-compound", "compound", "Compound",
+ "none", Tk_Offset(Tab,compoundObj), -1,
+ 0,(ClientData)TTKCompoundStrings,GEOMETRY_CHANGED },
+ {TK_OPTION_INT, "-underline", "underline", "Underline", "-1",
+ Tk_Offset(Tab,underlineObj), -1, 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_END}
+};
+
+static Tk_OptionSpec PaneOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-padding", "padding", "Padding", "0",
+ Tk_Offset(Tab,paddingObj), -1, 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-sticky", "sticky", "Sticky", "nsew",
+ Tk_Offset(Tab,stickyObj), -1, 0,0,GEOMETRY_CHANGED },
+
+ WIDGET_INHERIT_OPTIONS(TabOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Notebook resources.
+ */
+typedef struct
+{
+ Tcl_Obj *widthObj; /* Default width */
+ Tcl_Obj *heightObj; /* Default height */
+ Tcl_Obj *paddingObj; /* Padding around notebook */
+
+ Ttk_Manager *mgr; /* Geometry manager */
+ Tk_OptionTable tabOptionTable; /* Tab options */
+ Tk_OptionTable paneOptionTable; /* Tab+pane options */
+ int currentIndex; /* index of currently selected tab */
+ int activeIndex; /* index of currently active tab */
+ Ttk_Layout tabLayout; /* Sublayout for tabs */
+
+ Ttk_Box clientArea; /* Where to pack slave widgets */
+} NotebookPart;
+
+typedef struct
+{
+ WidgetCore core;
+ NotebookPart notebook;
+} Notebook;
+
+static Tk_OptionSpec NotebookOptionSpecs[] =
+{
+ WIDGET_TAKES_FOCUS,
+
+ {TK_OPTION_INT, "-width", "width", "Width", "0",
+ Tk_Offset(Notebook,notebook.widthObj),-1,
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_INT, "-height", "height", "Height", "0",
+ Tk_Offset(Notebook,notebook.heightObj),-1,
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-padding", "padding", "Padding", NULL,
+ Tk_Offset(Notebook,notebook.paddingObj),-1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+ WIDGET_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+/* Notebook style options:
+ */
+typedef struct
+{
+ Ttk_PositionSpec tabPosition; /* Where to place tabs */
+ Ttk_Padding tabMargins; /* Margins around tab row */
+ Ttk_PositionSpec tabPlacement; /* How to pack tabs within tab row */
+ Ttk_Orient tabOrient; /* ... */
+ int minTabWidth; /* Minimum tab width */
+ Ttk_Padding padding; /* External padding */
+} NotebookStyle;
+
+static void NotebookStyleOptions(Notebook *nb, NotebookStyle *nbstyle)
+{
+ Tcl_Obj *objPtr;
+
+ nbstyle->tabPosition = TTK_PACK_TOP | TTK_STICK_W;
+ if ((objPtr = Ttk_QueryOption(nb->core.layout, "-tabposition", 0)) != 0) {
+ TtkGetLabelAnchorFromObj(NULL, objPtr, &nbstyle->tabPosition);
+ }
+
+ /* compute tabPlacement and tabOrient as function of tabPosition:
+ */
+ if (nbstyle->tabPosition & TTK_PACK_LEFT) {
+ nbstyle->tabPlacement = TTK_PACK_TOP | TTK_STICK_E;
+ nbstyle->tabOrient = TTK_ORIENT_VERTICAL;
+ } else if (nbstyle->tabPosition & TTK_PACK_RIGHT) {
+ nbstyle->tabPlacement = TTK_PACK_TOP | TTK_STICK_W;
+ nbstyle->tabOrient = TTK_ORIENT_VERTICAL;
+ } else if (nbstyle->tabPosition & TTK_PACK_BOTTOM) {
+ nbstyle->tabPlacement = TTK_PACK_LEFT | TTK_STICK_N;
+ nbstyle->tabOrient = TTK_ORIENT_HORIZONTAL;
+ } else { /* Assume TTK_PACK_TOP */
+ nbstyle->tabPlacement = TTK_PACK_LEFT | TTK_STICK_S;
+ nbstyle->tabOrient = TTK_ORIENT_HORIZONTAL;
+ }
+
+ nbstyle->tabMargins = Ttk_UniformPadding(0);
+ if ((objPtr = Ttk_QueryOption(nb->core.layout, "-tabmargins", 0)) != 0) {
+ Ttk_GetBorderFromObj(NULL, objPtr, &nbstyle->tabMargins);
+ }
+
+ nbstyle->padding = Ttk_UniformPadding(0);
+ if ((objPtr = Ttk_QueryOption(nb->core.layout, "-padding", 0)) != 0) {
+ Ttk_GetPaddingFromObj(NULL,nb->core.tkwin,objPtr,&nbstyle->padding);
+ }
+
+ nbstyle->minTabWidth = DEFAULT_MIN_TAB_WIDTH;
+ if ((objPtr = Ttk_QueryOption(nb->core.layout, "-mintabwidth", 0)) != 0) {
+ Tcl_GetIntFromObj(NULL, objPtr, &nbstyle->minTabWidth);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tab management.
+ */
+
+/*
+ * IdentifyTab --
+ * Return the index of the tab at point x,y,
+ * or -1 if no tab at that point.
+ */
+static int IdentifyTab(Notebook *nb, int x, int y)
+{
+ int index;
+ for (index = 0; index < Ttk_NumberSlaves(nb->notebook.mgr); ++index) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr,index);
+ if ( tab->state != TAB_STATE_HIDDEN
+ && Ttk_BoxContains(tab->parcel, x,y))
+ {
+ return index;
+ }
+ }
+ return -1;
+}
+
+/*
+ * ActivateTab --
+ * Set the active tab index, redisplay if necessary.
+ */
+static void ActivateTab(Notebook *nb, int index)
+{
+ if (index != nb->notebook.activeIndex) {
+ nb->notebook.activeIndex = index;
+ TtkRedisplayWidget(&nb->core);
+ }
+}
+
+/*
+ * TabState --
+ * Return the state of the specified tab, based on
+ * notebook state, currentIndex, activeIndex, and user-specified tab state.
+ * The USER1 bit is set for the leftmost tab, and USER2
+ * is set for the rightmost tab.
+ */
+static Ttk_State TabState(Notebook *nb, int index)
+{
+ Ttk_State state = nb->core.state;
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, index);
+
+ if (index == nb->notebook.currentIndex) {
+ state |= TTK_STATE_SELECTED;
+ } else {
+ state &= ~TTK_STATE_FOCUS;
+ }
+
+ if (index == nb->notebook.activeIndex) {
+ state |= TTK_STATE_ACTIVE;
+ }
+ if (index == 0) {
+ state |= TTK_STATE_USER1;
+ }
+ if (index == Ttk_NumberSlaves(nb->notebook.mgr) - 1) {
+ state |= TTK_STATE_USER2;
+ }
+ if (tab->state == TAB_STATE_DISABLED) {
+ state |= TTK_STATE_DISABLED;
+ }
+
+ return state;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Geometry management - size computation.
+ */
+
+/* TabrowSize --
+ * Compute max height and total width of all tabs (horizontal layouts)
+ * or total height and max width (vertical layouts).
+ *
+ * Side effects:
+ * Sets width and height fields for all tabs.
+ *
+ * Notes:
+ * Hidden tabs are included in the perpendicular computation
+ * (max height/width) but not parallel (total width/height).
+ */
+static void TabrowSize(
+ Notebook *nb, Ttk_Orient orient, int *widthPtr, int *heightPtr)
+{
+ Ttk_Layout tabLayout = nb->notebook.tabLayout;
+ int tabrowWidth = 0, tabrowHeight = 0;
+ int i;
+
+ for (i = 0; i < Ttk_NumberSlaves(nb->notebook.mgr); ++i) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, i);
+ Ttk_State tabState = TabState(nb,i);
+
+ Ttk_RebindSublayout(tabLayout, tab);
+ Ttk_LayoutSize(tabLayout,tabState,&tab->width,&tab->height);
+
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ tabrowHeight = MAX(tabrowHeight, tab->height);
+ if (tab->state != TAB_STATE_HIDDEN) { tabrowWidth += tab->width; }
+ } else {
+ tabrowWidth = MAX(tabrowWidth, tab->width);
+ if (tab->state != TAB_STATE_HIDDEN) { tabrowHeight += tab->height; }
+ }
+ }
+
+ *widthPtr = tabrowWidth;
+ *heightPtr = tabrowHeight;
+}
+
+/* NotebookSize -- GM and widget size hook.
+ *
+ * Total height is tab height + client area height + pane internal padding
+ * Total width is max(client width, tab width) + pane internal padding
+ * Client area size determined by max size of slaves,
+ * overridden by -width and/or -height if nonzero.
+ */
+
+static int NotebookSize(void *clientData, int *widthPtr, int *heightPtr)
+{
+ Notebook *nb = clientData;
+ NotebookStyle nbstyle;
+ Ttk_Padding padding;
+ Ttk_LayoutNode *clientNode = Ttk_LayoutFindNode(nb->core.layout, "client");
+ int clientWidth = 0, clientHeight = 0,
+ reqWidth = 0, reqHeight = 0,
+ tabrowWidth = 0, tabrowHeight = 0;
+ int i;
+
+ NotebookStyleOptions(nb, &nbstyle);
+
+ /* Compute max requested size of all slaves:
+ */
+ for (i = 0; i < Ttk_NumberSlaves(nb->notebook.mgr); ++i) {
+ Tk_Window slaveWindow = Ttk_SlaveWindow(nb->notebook.mgr, i);
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, i);
+ int slaveWidth
+ = Tk_ReqWidth(slaveWindow) + Ttk_PaddingWidth(tab->padding);
+ int slaveHeight
+ = Tk_ReqHeight(slaveWindow) + Ttk_PaddingHeight(tab->padding);
+
+ clientWidth = MAX(clientWidth, slaveWidth);
+ clientHeight = MAX(clientHeight, slaveHeight);
+ }
+
+ /* Client width/height overridable by widget options:
+ */
+ Tcl_GetIntFromObj(NULL, nb->notebook.widthObj,&reqWidth);
+ Tcl_GetIntFromObj(NULL, nb->notebook.heightObj,&reqHeight);
+ if (reqWidth > 0)
+ clientWidth = reqWidth;
+ if (reqHeight > 0)
+ clientHeight = reqHeight;
+
+ /* Tab row:
+ */
+ TabrowSize(nb, nbstyle.tabOrient, &tabrowWidth, &tabrowHeight);
+ tabrowHeight += Ttk_PaddingHeight(nbstyle.tabMargins);
+ tabrowWidth += Ttk_PaddingWidth(nbstyle.tabMargins);
+
+ /* Account for exterior and interior padding:
+ */
+ padding = nbstyle.padding;
+ if (clientNode) {
+ Ttk_Padding ipad =
+ Ttk_LayoutNodeInternalPadding(nb->core.layout, clientNode);
+ padding = Ttk_AddPadding(padding, ipad);
+ }
+
+ *widthPtr = MAX(tabrowWidth, clientWidth) + Ttk_PaddingWidth(padding);
+ *heightPtr = tabrowHeight + clientHeight + Ttk_PaddingHeight(padding);
+
+ return 1;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Geometry management - layout.
+ */
+
+/* SqueezeTabs --
+ * If the notebook is not wide enough to display all tabs,
+ * attempt to decrease tab widths to fit.
+ *
+ * All tabs are shrunk by an equal amount, but will not be made
+ * smaller than the minimum width. (If all the tabs still do
+ * not fit in the available space, the rightmost tabs are truncated).
+ *
+ * The algorithm does not always yield an optimal layout, but does
+ * have the important property that decreasing the available width
+ * by one pixel will cause at most one tab to shrink by one pixel;
+ * this means that tabs resize "smoothly" when the window shrinks
+ * and grows.
+ *
+ * @@@ <<NOTE-TABPOSITION>> bug: only works for horizontal orientations
+ */
+
+static void SqueezeTabs(
+ Notebook *nb, int desiredWidth, int availableWidth, int minTabWidth)
+{
+ int nTabs = Ttk_NumberSlaves(nb->notebook.mgr);
+ int shrinkage = desiredWidth - availableWidth;
+ int extra = 0;
+ int i;
+
+ for (i = 0; i < nTabs; ++i) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr,i);
+ int shrink = (shrinkage/nTabs) + (i < (shrinkage%nTabs)) + extra;
+ int shrinkability = MAX(0, tab->width - minTabWidth);
+ int delta = MIN(shrinkability, shrink);
+ tab->width -= delta;
+ extra = shrink - delta;
+ }
+}
+
+/* PlaceTabs --
+ * Compute all tab parcels.
+ */
+static void PlaceTabs(
+ Notebook *nb, Ttk_Box tabrowBox, Ttk_PositionSpec tabPlacement)
+{
+ Ttk_Layout tabLayout = nb->notebook.tabLayout;
+ int nTabs = Ttk_NumberSlaves(nb->notebook.mgr);
+ int i;
+
+ for (i = 0; i < nTabs; ++i) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, i);
+ Ttk_State tabState = TabState(nb, i);
+
+ if (tab->state != TAB_STATE_HIDDEN) {
+ Ttk_Padding expand = Ttk_UniformPadding(0);
+ Tcl_Obj *expandObj = Ttk_QueryOption(tabLayout,"-expand",tabState);
+
+ if (expandObj) {
+ Ttk_GetBorderFromObj(NULL, expandObj, &expand);
+ }
+
+ tab->parcel =
+ Ttk_ExpandBox(
+ Ttk_PositionBox(&tabrowBox,
+ tab->width, tab->height, tabPlacement),
+ expand);
+ }
+ }
+}
+
+/* NotebookDoLayout --
+ * Computes notebook layout and places tabs.
+ *
+ * Side effects:
+ * Sets clientArea, used to place slave panes.
+ */
+static void NotebookDoLayout(void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ Tk_Window nbwin = nb->core.tkwin;
+ Ttk_Box cavity = Ttk_WinBox(nbwin);
+ int tabrowWidth = 0, tabrowHeight = 0;
+ Ttk_LayoutNode *clientNode = Ttk_LayoutFindNode(nb->core.layout, "client");
+ Ttk_Box tabrowBox;
+ NotebookStyle nbstyle;
+
+ NotebookStyleOptions(nb, &nbstyle);
+
+ /* Notebook internal padding:
+ */
+ cavity = Ttk_PadBox(cavity, nbstyle.padding);
+
+ /* Layout for notebook background (base layout):
+ */
+ Ttk_PlaceLayout(nb->core.layout, nb->core.state, Ttk_WinBox(nbwin));
+
+ /* Place tabs:
+ */
+ TabrowSize(nb, nbstyle.tabOrient, &tabrowWidth, &tabrowHeight);
+ tabrowBox = Ttk_PadBox(
+ Ttk_PositionBox(&cavity,
+ tabrowWidth + Ttk_PaddingWidth(nbstyle.tabMargins),
+ tabrowHeight + Ttk_PaddingHeight(nbstyle.tabMargins),
+ nbstyle.tabPosition),
+ nbstyle.tabMargins);
+
+ if (tabrowWidth > tabrowBox.width) {
+ SqueezeTabs(nb, tabrowWidth, tabrowBox.width, nbstyle.minTabWidth);
+ }
+ PlaceTabs(nb, tabrowBox, nbstyle.tabPlacement);
+
+ /* Layout for client area frame:
+ */
+ if (clientNode) {
+ Ttk_PlaceLayoutNode(nb->core.layout, clientNode, cavity);
+ cavity = Ttk_LayoutNodeInternalParcel(nb->core.layout, clientNode);
+ }
+
+ if (cavity.height <= 0) cavity.height = 1;
+ if (cavity.width <= 0) cavity.width = 1;
+
+ nb->notebook.clientArea = cavity;
+}
+
+/*
+ * NotebookPlaceSlave --
+ * Set the position and size of a child widget
+ * based on the current client area and slave options:
+ */
+static void NotebookPlaceSlave(Notebook *nb, int slaveIndex)
+{
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, slaveIndex);
+ Tk_Window slaveWindow = Ttk_SlaveWindow(nb->notebook.mgr, slaveIndex);
+ Ttk_Box slaveBox =
+ Ttk_StickBox(Ttk_PadBox(nb->notebook.clientArea, tab->padding),
+ Tk_ReqWidth(slaveWindow), Tk_ReqHeight(slaveWindow),tab->sticky);
+
+ Ttk_PlaceSlave(nb->notebook.mgr, slaveIndex,
+ slaveBox.x, slaveBox.y, slaveBox.width, slaveBox.height);
+}
+
+/* NotebookPlaceSlaves --
+ * Geometry manager hook.
+ */
+static void NotebookPlaceSlaves(void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ int currentIndex = nb->notebook.currentIndex;
+ if (currentIndex >= 0) {
+ NotebookDoLayout(nb);
+ NotebookPlaceSlave(nb, currentIndex);
+ }
+}
+
+/*
+ * SelectTab(nb, index) --
+ * Change the currently-selected tab.
+ */
+static void SelectTab(Notebook *nb, int index)
+{
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr,index);
+ int currentIndex = nb->notebook.currentIndex;
+
+ if (index == currentIndex) {
+ return;
+ }
+
+ if (TabState(nb, index) & TTK_STATE_DISABLED) {
+ return;
+ }
+
+ /* Unhide the tab if it is currently hidden and being selected.
+ */
+ if (tab->state == TAB_STATE_HIDDEN) {
+ tab->state = TAB_STATE_NORMAL;
+ }
+
+ if (currentIndex >= 0) {
+ Ttk_UnmapSlave(nb->notebook.mgr, currentIndex);
+ }
+
+ NotebookPlaceSlave(nb, index);
+
+ nb->notebook.currentIndex = index;
+ TtkRedisplayWidget(&nb->core);
+
+ SendVirtualEvent(nb->core.tkwin, "NotebookTabChanged");
+}
+
+/* NextTab --
+ * Returns the index of the next tab after the specified tab
+ * in the normal state (e.g., not hidden or disabled),
+ * or -1 if all tabs are disabled or hidden.
+ */
+static int NextTab(Notebook *nb, int index)
+{
+ int nTabs = Ttk_NumberSlaves(nb->notebook.mgr);
+ int nextIndex;
+
+ /* Scan forward for following usable tab:
+ */
+ for (nextIndex = index + 1; nextIndex < nTabs; ++nextIndex) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, nextIndex);
+ if (tab->state == TAB_STATE_NORMAL) {
+ return nextIndex;
+ }
+ }
+
+ /* Not found -- scan backwards.
+ */
+ for (nextIndex = index - 1; nextIndex >= 0; --nextIndex) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, nextIndex);
+ if (tab->state == TAB_STATE_NORMAL) {
+ return nextIndex;
+ }
+ }
+
+ /* Still nothing. Give up.
+ */
+ return -1;
+}
+
+/* SelectNearestTab --
+ * Handles the case where the current tab is forgotten, hidden,
+ * or destroyed. Select the next available tab; or, if there is none,
+ * leaves all tabs unselected.
+ */
+static void SelectNearestTab(Notebook *nb)
+{
+ int nextIndex = NextTab(nb, nb->notebook.currentIndex);
+
+ if (nextIndex >= 0) {
+ SelectTab(nb, nextIndex);
+ } else {
+ /* No available tabs -- unmap current one.
+ * ASSERT: this is safe to do even when the slave is being destroyed.
+ */
+ if (nb->notebook.currentIndex >= 0) {
+ Ttk_UnmapSlave(nb->notebook.mgr, nb->notebook.currentIndex);
+ SendVirtualEvent(nb->core.tkwin, "NotebookTabChanged");
+ }
+ nb->notebook.currentIndex = -1;
+ }
+}
+
+/* TabAdded -- GM SlaveAdded hook.
+ */
+static void TabAdded(Ttk_Manager *mgr, int slaveIndex) { /* No-op */ }
+
+/* TabRemoved -- GM SlaveRemoved hook.
+ * Select the next tab if the current one is being removed.
+ * Adjust currentIndex to account for removed slave if needed.
+ */
+static void TabRemoved(Ttk_Manager *mgr, int index)
+{
+ Notebook *nb = mgr->managerData;
+
+ if (index == nb->notebook.currentIndex) {
+ SelectNearestTab(nb);
+ }
+
+ if (index < nb->notebook.currentIndex) {
+ --nb->notebook.currentIndex;
+ }
+
+ TtkRedisplayWidget(&nb->core);
+}
+
+/* TabConfigured -- GM slaveConfigured hook.
+ */
+static int TabConfigured(
+ Tcl_Interp *interp, Ttk_Manager *mgr, Ttk_Slave *slave, unsigned mask)
+{
+ Tab *tab = slave->slaveData;
+ Ttk_Sticky sticky = tab->sticky;
+ Tk_Window tkwin = mgr->masterWindow;
+
+ /* Check options:
+ * @@@ TODO: validate -image option with GetImageList()
+ */
+ if (Ttk_GetStickyFromObj(interp, tab->stickyObj, &sticky) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Ttk_GetPaddingFromObj(interp,tkwin,tab->paddingObj,&tab->padding)
+ != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ tab->sticky = sticky;
+ return TCL_OK;
+}
+
+static Ttk_ManagerSpec NotebookManagerSpec =
+{
+ { "notebook", Ttk_GeometryRequestProc, Ttk_LostSlaveProc },
+ PaneOptionSpecs, sizeof(Tab),
+
+ NotebookSize,
+ NotebookPlaceSlaves,
+ TabAdded,
+ TabRemoved,
+ TabConfigured
+};
+
+/*------------------------------------------------------------------------
+ * +++ Event handlers.
+ */
+
+/* NotebookEventHandler --
+ * Tracks the active tab.
+ */
+static const int NotebookEventMask
+ = StructureNotifyMask
+ | PointerMotionMask
+ | LeaveWindowMask
+ ;
+static void NotebookEventHandler(ClientData clientData, XEvent *eventPtr)
+{
+ Notebook *nb = clientData;
+
+ if (eventPtr->type == DestroyNotify) { /* Remove self */
+ Tk_DeleteEventHandler(nb->core.tkwin,
+ NotebookEventMask, NotebookEventHandler, clientData);
+ } else if (eventPtr->type == MotionNotify) {
+ int index = IdentifyTab(nb, eventPtr->xmotion.x, eventPtr->xmotion.y);
+ ActivateTab(nb, index);
+ } else if (eventPtr->type == LeaveNotify) {
+ ActivateTab(nb, -1);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Utilities.
+ */
+
+/* FindTabIndex --
+ * Find the index of the specified tab.
+ * Tab identifiers are one of:
+ *
+ * + positional specifications @x,y,
+ * + "current",
+ * + numeric indices [0..nTabs],
+ * + slave window names
+ *
+ * Stores index of specified tab in *index_rtn, -1 if not found.
+ *
+ * Returns TCL_ERROR and leaves an error message in interp->result
+ * if the tab identifier was incorrect.
+ *
+ * See also: GetTabIndex.
+ */
+static int FindTabIndex(
+ Tcl_Interp *interp, Notebook *nb, Tcl_Obj *objPtr, int *index_rtn)
+{
+ const char *string = Tcl_GetString(objPtr);
+ int x, y;
+
+ *index_rtn = -1;
+
+ /* Check for @x,y ...
+ */
+ if (string[0] == '@' && sscanf(string, "@%d,%d",&x,&y) == 2) {
+ *index_rtn = IdentifyTab(nb, x, y);
+ return TCL_OK;
+ }
+
+ /* ... or "current" ...
+ */
+ if (!strcmp(string, "current")) {
+ *index_rtn = nb->notebook.currentIndex;
+ return TCL_OK;
+ }
+
+ /* ... or integer index or slave window name:
+ */
+ if (Ttk_GetSlaveFromObj(
+ interp, nb->notebook.mgr, objPtr, index_rtn) != NULL)
+ {
+ return TCL_OK;
+ }
+
+ /* Nothing matched; Ttk_GetSlaveFromObj will have left error message.
+ */
+ return TCL_ERROR;
+}
+
+/* GetTabIndex --
+ * Get the index of an existing tab.
+ * Tab identifiers are as per FindTabIndex.
+ * Returns TCL_ERROR if the tab does not exist.
+ */
+static int GetTabIndex(
+ Tcl_Interp *interp, Notebook *nb, Tcl_Obj *objPtr, int *index_rtn)
+{
+ int status = FindTabIndex(interp, nb, objPtr, index_rtn);
+
+ if (status == TCL_OK && *index_rtn < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "tab '", Tcl_GetString(objPtr), "' not found",
+ NULL);
+ status = TCL_ERROR;
+ }
+ return status;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget command routines.
+ */
+
+/* $nb add window ?options ... ?
+ */
+static int NotebookAddCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ int index = nb->notebook.mgr->nSlaves;
+ Tk_Window slaveWindow;
+
+ if (objc <= 2 || objc % 2 != 1) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?options...?");
+ return TCL_ERROR;
+ }
+
+ slaveWindow = Tk_NameToWindow(interp,Tcl_GetString(objv[2]),nb->core.tkwin);
+ if (!slaveWindow) {
+ return TCL_ERROR;
+ }
+
+ /* Create and initialize new tab:
+ */
+ if (TCL_OK != Ttk_AddSlave(
+ interp, nb->notebook.mgr, slaveWindow, index, objc-3,objv+3) )
+ {
+ return TCL_ERROR;
+ }
+
+ /* If no tab is currently selected (or if this is the first tab),
+ * select this one:
+ */
+ if (nb->notebook.currentIndex < 0) {
+ SelectTab(nb, index);
+ }
+
+ TtkResizeWidget(&nb->core);
+
+ return TCL_OK;
+}
+
+/* $nb insert $index $tab ?options...?
+ * Insert new tab, or move existing one.
+ */
+static int NotebookInsertCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ int current = nb->notebook.currentIndex;
+ int srcIndex, destIndex;
+ int status = TCL_OK;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2,objv, "index slave ?options...?");
+ return TCL_ERROR;
+ }
+
+ if (!strcmp(Tcl_GetString(objv[2]), "end")) {
+ destIndex = Ttk_NumberSlaves(nb->notebook.mgr);
+ } else if (!Ttk_GetSlaveFromObj(
+ interp, nb->notebook.mgr, objv[2], &destIndex)) {
+ return TCL_ERROR;
+ }
+
+ if (!Ttk_GetSlaveFromObj(interp, nb->notebook.mgr, objv[3], &srcIndex)) {
+ /* Try adding new slave:
+ */
+ Tk_Window slaveWindow =
+ Tk_NameToWindow(interp,Tcl_GetString(objv[3]),nb->core.tkwin);
+ if (!slaveWindow) {
+ return TCL_ERROR;
+ }
+
+ if (Ttk_AddSlave(interp, nb->notebook.mgr, slaveWindow,
+ destIndex, objc - 4, objv + 4) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+ if (nb->notebook.currentIndex <= destIndex) {
+ ++nb->notebook.currentIndex;
+ }
+ return TCL_OK;
+ }
+
+ /* else - move existing slave: */
+
+ if (destIndex >= nb->notebook.mgr->nSlaves) {
+ destIndex = nb->notebook.mgr->nSlaves - 1;
+ }
+ Ttk_ReorderSlave(nb->notebook.mgr, srcIndex, destIndex);
+
+ /* Adjust internal indexes:
+ */
+ nb->notebook.activeIndex = -1;
+ if (current == srcIndex) {
+ nb->notebook.currentIndex = destIndex;
+ } else if (destIndex <= current && current < srcIndex) {
+ ++nb->notebook.currentIndex;
+ } else if (srcIndex < current && current <= destIndex) {
+ --nb->notebook.currentIndex;
+ }
+
+ if (objc > 4) {
+ status = Ttk_ConfigureSlave(interp, nb->notebook.mgr,
+ nb->notebook.mgr->slaves[destIndex], objc-4,objv+4);
+ }
+
+ TtkRedisplayWidget(&nb->core);
+
+ return status;
+}
+
+/* $nb forget $item --
+ * Removes the selected tab.
+ */
+static int NotebookForgetCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tab");
+ return TCL_ERROR;
+ }
+
+ if (GetTabIndex(interp, nb, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Ttk_ForgetSlave(nb->notebook.mgr, index);
+
+ return TCL_OK;
+}
+
+/* $nb identify $x $y --
+ * Returns name of tab element at $x,$y; empty string if none.
+ */
+static int NotebookIdentifyCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ Ttk_LayoutNode *node = NULL;
+ int x, y, tabIndex;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ return TCL_ERROR;
+ }
+
+ if ( Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ tabIndex = IdentifyTab(nb, x, y);
+ if (tabIndex >= 0) {
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, tabIndex);
+ Ttk_State state = TabState(nb, tabIndex);
+ Ttk_Layout tabLayout = nb->notebook.tabLayout;
+
+ Ttk_RebindSublayout(tabLayout, tab);
+ Ttk_PlaceLayout(tabLayout, state, tab->parcel);
+
+ node = Ttk_LayoutIdentify(tabLayout, x, y);
+ }
+
+ if (node) {
+ const char *elementName = Ttk_LayoutNodeName(node);
+ Tcl_SetObjResult(interp,Tcl_NewStringObj(elementName,-1));
+ }
+
+ return TCL_OK;
+}
+
+/* $nb index $item --
+ * Returns the integer index of the tab specified by $item,
+ * the empty string if $item does not identify a tab.
+ * See above for valid item formats.
+ */
+static int NotebookIndexCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ int index, status;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tab");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Special-case for "end":
+ */
+ if (!strcmp("end", Tcl_GetString(objv[2]))) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(nb->notebook.mgr->nSlaves));
+ return TCL_OK;
+ }
+
+ status = FindTabIndex(interp, nb, objv[2], &index);
+ if (status == TCL_OK && index >= 0) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ }
+
+ return status;
+}
+
+/* $nb select ?$item? --
+ * Select the specified tab, or return the widget path of
+ * the currently-selected pane.
+ */
+static int NotebookSelectCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+
+ if (objc == 2) {
+ if (nb->notebook.currentIndex >= 0) {
+ Tk_Window pane = Ttk_SlaveWindow(
+ nb->notebook.mgr, nb->notebook.currentIndex);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(pane), -1));
+ }
+ return TCL_OK;
+ } else if (objc == 3) {
+ int index, status = GetTabIndex(interp, nb, objv[2], &index);
+ if (status == TCL_OK) {
+ SelectTab(nb, index);
+ }
+ return status;
+ } /*else*/
+ Tcl_WrongNumArgs(interp, 2, objv, "?tab?");
+ return TCL_ERROR;
+}
+
+/* $nb tabs --
+ * Return list of tabs.
+ */
+static int NotebookTabsCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ Ttk_Manager *mgr = nb->notebook.mgr;
+ Tcl_Obj *result;
+ int i;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+
+ result = Tcl_NewListObj(0, NULL);
+ for (i = 0; i < mgr->nSlaves; ++i) {
+ const char *pathName = Tk_PathName(Ttk_SlaveWindow(mgr,i));
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(pathName,-1));
+ }
+ Tcl_SetObjResult(interp, result);
+
+ return TCL_OK;
+}
+
+/* $nb tab $tab ?-option ?value -option value...??
+ */
+static int NotebookTabCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[], void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ Ttk_Manager *mgr = nb->notebook.mgr;
+ int index;
+ Ttk_Slave *slave;
+ Tab *tab;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tab ?-option ?value??...");
+ return TCL_ERROR;
+ }
+
+ if (GetTabIndex(interp, nb, objv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ slave = mgr->slaves[index];
+ tab = Ttk_SlaveData(mgr, index);
+
+ if (objc == 3) {
+ return EnumerateOptions(interp, tab,
+ PaneOptionSpecs, nb->notebook.paneOptionTable, nb->core.tkwin);
+ } else if (objc == 4) {
+ return GetOptionValue(interp, tab, objv[3],
+ nb->notebook.paneOptionTable, nb->core.tkwin);
+ } /* else */
+
+ if (Ttk_ConfigureSlave(interp, mgr, slave, objc - 3,objv + 3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* If the current tab has become disabled or hidden,
+ * select the next nondisabled, unhidden one:
+ */
+ if (index == nb->notebook.currentIndex && tab->state != TAB_STATE_NORMAL) {
+ SelectNearestTab(nb);
+ }
+
+ TtkResizeWidget(&nb->core);
+ return TCL_OK;
+}
+
+/* Subcommand table:
+ */
+static WidgetCommandSpec NotebookCommands[] =
+{
+ { "add", NotebookAddCommand },
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "forget", NotebookForgetCommand },
+ { "identify", NotebookIdentifyCommand },
+ { "index", NotebookIndexCommand },
+ { "insert", NotebookInsertCommand },
+ { "instate", WidgetInstateCommand },
+ { "select", NotebookSelectCommand },
+ { "state", WidgetStateCommand },
+ { "tab", NotebookTabCommand },
+ { "tabs", NotebookTabsCommand },
+ { 0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget class hooks.
+ */
+
+static int NotebookInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+
+ nb->notebook.mgr = Ttk_CreateManager(
+ &NotebookManagerSpec, recordPtr, nb->core.tkwin);
+
+ nb->notebook.tabOptionTable = Tk_CreateOptionTable(interp,TabOptionSpecs);
+ nb->notebook.paneOptionTable = Tk_CreateOptionTable(interp,PaneOptionSpecs);
+
+ nb->notebook.currentIndex = -1;
+ nb->notebook.activeIndex = -1;
+ nb->notebook.tabLayout = 0;
+
+ nb->notebook.clientArea = Ttk_MakeBox(0,0,1,1);
+
+ Tk_CreateEventHandler(
+ nb->core.tkwin, NotebookEventMask, NotebookEventHandler, recordPtr);
+
+ return TCL_OK;
+}
+
+static void NotebookCleanup(void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+
+ Ttk_DeleteManager(nb->notebook.mgr);
+ Tk_DeleteOptionTable(nb->notebook.tabOptionTable);
+ Tk_DeleteOptionTable(nb->notebook.paneOptionTable);
+
+ if (nb->notebook.tabLayout)
+ Ttk_FreeLayout(nb->notebook.tabLayout);
+}
+
+static int NotebookConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+ Notebook *nb = clientData;
+
+ /*
+ * Error-checks:
+ */
+ if (nb->notebook.paddingObj) {
+ /* Check for valid -padding: */
+ Ttk_Padding unused;
+ if (Ttk_GetPaddingFromObj(
+ interp, nb->core.tkwin, nb->notebook.paddingObj, &unused)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ return CoreConfigure(interp, clientData, mask);
+}
+
+/* NotebookGetLayout --
+ * GetLayout widget hook.
+ */
+static Ttk_Layout NotebookGetLayout(
+ Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Notebook *nb = recordPtr;
+ Ttk_Layout notebookLayout = WidgetGetLayout(interp, theme, recordPtr);
+ Ttk_Layout tabLayout;
+
+ if (!notebookLayout) {
+ return NULL;
+ }
+
+ tabLayout = Ttk_CreateSublayout(
+ interp, theme, notebookLayout, ".Tab", nb->notebook.tabOptionTable);
+
+ if (tabLayout) {
+ if (nb->notebook.tabLayout) {
+ Ttk_FreeLayout(nb->notebook.tabLayout);
+ }
+ nb->notebook.tabLayout = tabLayout;
+ }
+
+ return notebookLayout;
+}
+
+/* +++ Display routines.
+ */
+
+static void DisplayTab(Notebook *nb, int index, Drawable d)
+{
+ Ttk_Layout tabLayout = nb->notebook.tabLayout;
+ Tab *tab = Ttk_SlaveData(nb->notebook.mgr, index);
+ Ttk_State state = TabState(nb, index);
+
+ if (tab->state != TAB_STATE_HIDDEN) {
+ Ttk_RebindSublayout(tabLayout, tab);
+ Ttk_PlaceLayout(tabLayout, state, tab->parcel);
+ Ttk_DrawLayout(tabLayout, state, d);
+ }
+}
+
+static void NotebookDisplay(void *clientData, Drawable d)
+{
+ Notebook *nb = clientData;
+ int index;
+
+ /* Draw notebook background (base layout):
+ */
+ Ttk_DrawLayout(nb->core.layout, nb->core.state, d);
+
+ /* Draw tabs from left to right, but draw the current tab last
+ * so it will overwrite its neighbors.
+ */
+ for (index = 0; index < nb->notebook.mgr->nSlaves; ++index) {
+ if (index != nb->notebook.currentIndex) {
+ DisplayTab(nb, index, d);
+ }
+ }
+ if (nb->notebook.currentIndex >= 0) {
+ DisplayTab(nb, nb->notebook.currentIndex, d);
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget specification and layout definitions.
+ */
+
+static WidgetSpec NotebookWidgetSpec =
+{
+ "TNotebook", /* className */
+ sizeof(Notebook), /* recordSize */
+ NotebookOptionSpecs, /* optionSpecs */
+ NotebookCommands, /* subcommands */
+ NotebookInitialize, /* initializeProc */
+ NotebookCleanup, /* cleanupProc */
+ NotebookConfigure, /* configureProc */
+ NullPostConfigure, /* postConfigureProc */
+ NotebookGetLayout, /* getLayoutProc */
+ NotebookSize, /* geometryProc */
+ NotebookDoLayout, /* layoutProc */
+ NotebookDisplay /* displayProc */
+};
+
+TTK_BEGIN_LAYOUT(NotebookLayout)
+ TTK_NODE("Notebook.client", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(TabLayout)
+ TTK_GROUP("Notebook.tab", TTK_FILL_BOTH,
+ TTK_GROUP("Notebook.padding", TTK_PACK_TOP|TTK_FILL_BOTH,
+ TTK_GROUP("Notebook.focus", TTK_PACK_TOP|TTK_FILL_BOTH,
+ TTK_NODE("Notebook.label", TTK_PACK_TOP))))
+TTK_END_LAYOUT
+
+int Notebook_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme themePtr = Ttk_GetDefaultTheme(interp);
+
+ Ttk_RegisterLayout(themePtr, "Tab", TabLayout);
+ Ttk_RegisterLayout(themePtr, "TNotebook", NotebookLayout);
+
+ RegisterWidget(interp, "ttk::notebook", &NotebookWidgetSpec);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkPanedwindow.c b/generic/ttk/ttkPanedwindow.c
new file mode 100644
index 0000000..8b55e50
--- /dev/null
+++ b/generic/ttk/ttkPanedwindow.c
@@ -0,0 +1,809 @@
+/* $Id: ttkPanedwindow.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright (c) 2005, Joe English. Freely redistributable.
+ *
+ * Ttk widget set: ttk::panedwindow widget.
+ *
+ * TODO: track active/pressed sash.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkManager.h"
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#define MIN_SASH_THICKNESS 5
+
+/*------------------------------------------------------------------------
+ * +++ 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 ComputePositions()).
+ * 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;
+ Ttk_Manager *mgr;
+ 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 },
+
+ WIDGET_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ 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}
+};
+
+/*------------------------------------------------------------------------
+ * +++ Layout algorithm.
+ */
+
+/* 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 == pw->paned.mgr->nSlaves - 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.
+ * Used as both 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 = width;
+ *heightPtr = height;
+ return 1;
+}
+
+/* AdjustPanes --
+ * Set pane request sizes from sash positions.
+ *
+ * NOTE:
+ * AdjustPanes followed by ComputePositions (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;
+ }
+}
+
+/* ComputePositions --
+ * Set sash positions from pane request sizes and 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 ComputePositions(Paned *pw)
+{
+ Ttk_Manager *mgr = pw->paned.mgr;
+ int nPanes = Ttk_NumberSlaves(mgr);
+ int sashThickness = pw->paned.sashThickness;
+ int available
+ = pw->paned.orient == TTK_ORIENT_HORIZONTAL
+ ? Tk_Width(pw->core.tkwin) : Tk_Height(pw->core.tkwin);
+ 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;
+ ComputePositions(pw);
+ PlacePanes(pw);
+}
+
+static void PaneAdded(Ttk_Manager *mgr, int index)
+{
+ Pane *pane = Ttk_SlaveData(mgr, index);
+ Tk_Window slaveWindow = Ttk_SlaveWindow(mgr, index);
+ Paned *pw = mgr->managerData;
+
+ /* See also: PanedGeometryRequestProc */
+ pane->reqSize
+ = pw->paned.orient == TTK_ORIENT_HORIZONTAL
+ ? Tk_ReqWidth(slaveWindow) : Tk_ReqHeight(slaveWindow);
+}
+
+static void PaneRemoved(Ttk_Manager *mgr, int i) { /*no-op*/ }
+
+static int PaneConfigured(
+ Tcl_Interp *interp, Ttk_Manager *mgr, Ttk_Slave *slave, unsigned mask)
+{
+ Pane *pane = slave->slaveData;
+ if (pane->weight < 0) {
+ Tcl_AppendResult(interp, "-weight must be nonnegative", NULL);
+ pane->weight = 0;
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/* PanedGeometryRequestProc --
+ * Update pane request size, but only 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 void PanedGeometryRequestProc(
+ ClientData clientData, Tk_Window slaveWindow)
+{
+ Ttk_Slave *slave = clientData;
+ Pane *pane = slave->slaveData;
+ Paned *pw = slave->manager->managerData;
+
+ if (!Tk_IsMapped(slaveWindow)) {
+ pane->reqSize
+ = pw->paned.orient == TTK_ORIENT_HORIZONTAL
+ ? Tk_ReqWidth(slaveWindow) : Tk_ReqHeight(slaveWindow);
+ }
+
+ /* Continue with default GeometryRequestProc:
+ */
+ Ttk_GeometryRequestProc(clientData, slaveWindow);
+}
+
+static Ttk_ManagerSpec PanedManagerSpec = {
+ { "paned", PanedGeometryRequestProc, Ttk_LostSlaveProc },
+ PaneOptionSpecs, sizeof(Pane),
+ PanedSize,
+ PanedPlaceSlaves,
+ PaneAdded,
+ PaneRemoved,
+ PaneConfigured,
+};
+
+/*------------------------------------------------------------------------
+ * +++ Event handler.
+ *
+ * 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)
+ {
+ SendVirtualEvent(corePtr->tkwin, "EnteredChild");
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization and cleanup hooks.
+ */
+
+static int 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.sashLayout = 0;
+ pw->paned.sashThickness = 1;
+
+ return TCL_OK;
+}
+
+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);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Layout management hooks.
+ */
+static Ttk_Layout PanedGetLayout(
+ Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr)
+{
+ Paned *pw = recordPtr;
+ Ttk_Layout panedLayout = WidgetGetLayout(interp, themePtr, recordPtr);
+ 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;
+
+ if (pw->paned.sashLayout)
+ Ttk_FreeLayout(pw->paned.sashLayout);
+ pw->paned.sashLayout = sashLayout;
+
+ Ttk_LayoutSize(sashLayout, 0, &sashWidth, &sashHeight);
+
+ pw->paned.sashThickness = horizontal ? sashWidth : sashHeight;
+
+ /* Sanity-check:
+ */
+ if (pw->paned.sashThickness < MIN_SASH_THICKNESS)
+ pw->paned.sashThickness = MIN_SASH_THICKNESS;
+
+ Ttk_ManagerSizeChanged(pw->paned.mgr);
+ }
+
+ return panedLayout;
+}
+
+static void PanedDisplay(void *recordPtr, Drawable d)
+{
+ Paned *pw = recordPtr;
+ int horizontal = pw->paned.orient == TTK_ORIENT_HORIZONTAL;
+ Ttk_Layout sashLayout = pw->paned.sashLayout;
+ int sashThickness = pw->paned.sashThickness;
+ Ttk_State state = pw->core.state;
+ int nPanes = Ttk_NumberSlaves(pw->paned.mgr);
+ int i;
+
+ WidgetDisplay(recordPtr, d);
+
+ /* Draw sashes:
+ */
+ if (horizontal) {
+ int height = Tk_Height(pw->core.tkwin);
+ for (i = 0; i < nPanes; ++i) {
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, i);
+ Ttk_PlaceLayout(sashLayout, state,
+ Ttk_MakeBox(pane->sashPos, 0, sashThickness, height));
+ Ttk_DrawLayout(sashLayout, state, d);
+ }
+ } else {
+ int width = Tk_Width(pw->core.tkwin);
+ for (i = 0; i < nPanes; ++i) {
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, i);
+ Ttk_PlaceLayout(sashLayout, state,
+ Ttk_MakeBox(0, pane->sashPos, width, sashThickness));
+ Ttk_DrawLayout(sashLayout, state, d);
+ }
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands.
+ */
+
+/* $pw add window [ options ... ]
+ */
+static int PanedAddCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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 Ttk_AddSlave(interp, pw->paned.mgr, slaveWindow,
+ Ttk_NumberSlaves(pw->paned.mgr), objc - 3, objv + 3);
+}
+
+/* $pw insert $index $slave ?options...?
+ * Insert new slave, or move existing one.
+ */
+static int PanedInsertCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Paned *pw = recordPtr;
+ int srcIndex, destIndex;
+ Tk_Window slaveWindow;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2,objv, "index slave ?options...?");
+ 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 (!Ttk_GetSlaveFromObj(interp,pw->paned.mgr,objv[2],&destIndex)) {
+ return TCL_ERROR;
+ }
+
+ srcIndex = Ttk_SlaveIndex(pw->paned.mgr, slaveWindow);
+ if (srcIndex < 0) { /* New slave: */
+ return Ttk_AddSlave(interp, pw->paned.mgr, slaveWindow,
+ destIndex, objc - 4, objv + 4);
+ } /* else -- move existing slave: */
+
+ if (destIndex >= pw->paned.mgr->nSlaves)
+ destIndex = pw->paned.mgr->nSlaves - 1;
+ Ttk_ReorderSlave(pw->paned.mgr, srcIndex, destIndex);
+
+ return objc == 4 ? TCL_OK :
+ Ttk_ConfigureSlave(interp, pw->paned.mgr,
+ pw->paned.mgr->slaves[destIndex], objc-4,objv+4);
+}
+
+/* $pw forget $pane
+ */
+static int PanedForgetCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Paned *pw = recordPtr;
+ int paneIndex;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2,objv, "pane");
+ return TCL_ERROR;
+ }
+
+ if (!Ttk_GetSlaveFromObj(interp, pw->paned.mgr, objv[2], &paneIndex)) {
+ return TCL_ERROR;
+ }
+ Ttk_ForgetSlave(pw->paned.mgr, paneIndex);
+
+ return TCL_OK;
+}
+
+/* $pw identify $x $y
+ * @@@ TODO: implement as documented, or change documentation.
+ */
+static int PanedIdentifyCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Paned *pw = recordPtr;
+ int sashThickness = pw->paned.sashThickness;
+ int x, y, pos;
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2,objv, "x y");
+ return TCL_ERROR;
+ }
+ if ( Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ pos = pw->paned.orient == TTK_ORIENT_HORIZONTAL ? x : y;
+ for (index = 0; index < pw->paned.mgr->nSlaves - 1; ++index) {
+ Pane *pane = Ttk_SlaveData(pw->paned.mgr, index);
+ if (pane->sashPos <= pos && pos <= pane->sashPos + sashThickness) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ return TCL_OK;
+ }
+ }
+
+ return TCL_OK; /* empty list */
+}
+
+/* $pw pane $pane ?-option ?value -option value ...??
+ * Query/modify pane options.
+ */
+static int PanedPaneCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ Paned *pw = recordPtr;
+ int paneIndex;
+ Ttk_Slave *slave;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2,objv, "pane ?-option value...?");
+ return TCL_ERROR;
+ }
+
+ slave = Ttk_GetSlaveFromObj(interp,pw->paned.mgr,objv[2],&paneIndex);
+ if (!slave) {
+ return TCL_ERROR;
+ }
+
+ switch (objc) {
+ case 3:
+ return EnumerateOptions(interp, slave->slaveData, PaneOptionSpecs,
+ pw->paned.mgr->slaveOptionTable, slave->slaveWindow);
+ case 4:
+ return GetOptionValue(interp, slave->slaveData,objv[3],
+ pw->paned.mgr->slaveOptionTable, slave->slaveWindow);
+ default:
+ return Ttk_ConfigureSlave(
+ interp, pw->paned.mgr, slave, objc-3,objv+3);
+ }
+}
+
+/* $pw sashpos $index ?$newpos?
+ * Query or modify sash position.
+ */
+static int PanedSashposCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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_AppendResult(interp,
+ "sash index ", Tcl_GetString(objv[2]), " out of range",
+ 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 WidgetCommandSpec PanedCommands[] =
+{
+ { "add", PanedAddCommand },
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "forget", PanedForgetCommand },
+ { "identify", PanedIdentifyCommand },
+ { "insert", PanedInsertCommand },
+ { "instate", WidgetInstateCommand },
+ { "pane", PanedPaneCommand },
+ { "sashpos", PanedSashposCommand },
+ { "state", WidgetStateCommand },
+ { 0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget specification.
+ */
+
+static WidgetSpec PanedWidgetSpec =
+{
+ "TPanedwindow", /* className */
+ sizeof(Paned), /* recordSize */
+ PanedOptionSpecs, /* optionSpecs */
+ PanedCommands, /* subcommands */
+ PanedInitialize, /* initializeProc */
+ PanedCleanup, /* cleanupProc */
+ CoreConfigure, /* configureProc */
+ NullPostConfigure, /* postConfigureProc */
+ PanedGetLayout, /* getLayoutProc */
+ PanedSize, /* sizeProc */
+ WidgetDoLayout, /* layoutProc */
+ PanedDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Elements and layouts.
+ */
+
+typedef struct {
+ Tcl_Obj *thicknessObj;
+} SashElement;
+
+static Ttk_ElementOptionSpec SashElementOptions[] = {
+ { "-sashthickness", TK_OPTION_INT,
+ Tk_Offset(SashElement,thicknessObj), "5" },
+ {NULL}
+};
+
+static void SashElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SashElement *sash = elementRecord;
+ int thickness = MIN_SASH_THICKNESS;
+ Tcl_GetIntFromObj(NULL, sash->thicknessObj, &thickness);
+ *widthPtr = *heightPtr = thickness;
+}
+
+static Ttk_ElementSpec SashElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(SashElement),
+ SashElementOptions,
+ SashElementSize,
+ NullElementDraw
+};
+
+TTK_BEGIN_LAYOUT(PanedLayout)
+ TTK_NODE("Paned.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.
+ */
+void Paned_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);
+}
+
diff --git a/generic/ttk/ttkProgress.c b/generic/ttk/ttkProgress.c
new file mode 100644
index 0000000..bb1bc0c
--- /dev/null
+++ b/generic/ttk/ttkProgress.c
@@ -0,0 +1,551 @@
+/* $Id: ttkProgress.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright (c) Joe English, Pat Thoyts, Michael Kirkham
+ *
+ * Ttk widget set: progress bar 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 *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_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ 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 */
+ WidgetChangeState(&pb->core, TTK_STATE_DISABLED, 0);
+ return;
+ }
+ WidgetChangeState(&pb->core, 0, TTK_STATE_DISABLED);
+
+ newValue = Tcl_NewStringObj(value, -1);
+ Tcl_IncrRefCount(newValue);
+ if (Tcl_GetDoubleFromObj(NULL, newValue, &scratch) != TCL_OK) {
+ WidgetChangeState(&pb->core, TTK_STATE_INVALID, 0);
+ return;
+ }
+ WidgetChangeState(&pb->core, 0, TTK_STATE_INVALID);
+ Tcl_DecrRefCount(pb->progress.valueObj);
+ pb->progress.valueObj = newValue;
+
+ CheckAnimation(pb);
+ TtkRedisplayWidget(&pb->core);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget class methods:
+ */
+
+static int ProgressbarInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Progressbar *pb = recordPtr;
+ pb->progress.variableTrace = 0;
+ pb->progress.timer = 0;
+ return TCL_OK;
+}
+
+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 (CoreConfigure(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;
+
+ WidgetSize(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_LayoutNode *pbarNode,
+ 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_PlaceLayoutNode(pb->core.layout, pbarNode, parcel);
+}
+
+static void ProgressbarIndeterminateLayout(
+ Progressbar *pb,
+ Ttk_LayoutNode *pbarNode,
+ Ttk_Box parcel,
+ double fraction,
+ Ttk_Orient orient)
+{
+ Ttk_Box pbarBox = Ttk_LayoutNodeParcel(pbarNode);
+
+ 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_PlaceLayoutNode(pb->core.layout, pbarNode, pbarBox);
+}
+
+static void ProgressbarDoLayout(void *recordPtr)
+{
+ Progressbar *pb = recordPtr;
+ WidgetCore *corePtr = &pb->core;
+ Ttk_LayoutNode *pbarNode = Ttk_LayoutFindNode(corePtr->layout, "pbar");
+ Ttk_LayoutNode *troughNode = Ttk_LayoutFindNode(corePtr->layout, "trough");
+ double value = 0.0, maximum = 100.0;
+ int orient = TTK_ORIENT_HORIZONTAL;
+ Ttk_Box parcel = Ttk_WinBox(corePtr->tkwin);
+
+ 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 (pbarNode) {
+ double fraction = value / maximum;
+
+ if (troughNode) {
+ parcel = Ttk_LayoutNodeInternalParcel(corePtr->layout, troughNode);
+ }
+
+ if (pb->progress.mode == TTK_PROGRESSBAR_DETERMINATE) {
+ ProgressbarDeterminateLayout(
+ pb, pbarNode, parcel, fraction, orient);
+ } else {
+ ProgressbarIndeterminateLayout(
+ pb, pbarNode, parcel, fraction, orient);
+ }
+ }
+}
+
+static Ttk_Layout ProgressbarGetLayout(
+ Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Progressbar *pb = recordPtr;
+ Ttk_Layout layout = WidgetGetOrientedLayout(
+ 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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ return ProgressbarStartStopCommand(
+ interp, "::ttk::progressbar::start", objc, objv);
+}
+
+static int ProgressbarStopCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ return ProgressbarStartStopCommand(
+ interp, "::ttk::progressbar::stop", objc, objv);
+}
+
+static WidgetCommandSpec ProgressbarCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "identify", WidgetIdentifyCommand },
+ { "instate", WidgetInstateCommand },
+ { "start", ProgressbarStartCommand },
+ { "state", WidgetStateCommand },
+ { "step", ProgressbarStepCommand },
+ { "stop", ProgressbarStopCommand },
+ { NULL, NULL }
+};
+
+/*
+ * 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 */
+ WidgetDisplay /* 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:
+ */
+int Progressbar_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);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkScale.c b/generic/ttk/ttkScale.c
new file mode 100644
index 0000000..346183a
--- /dev/null
+++ b/generic/ttk/ttkScale.c
@@ -0,0 +1,503 @@
+/* $Id: ttkScale.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+ *
+ * Ttk widget set: 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[] =
+{
+ WIDGET_TAKES_FOCUS,
+
+ {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_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+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) {
+ WidgetChangeState(&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;
+ WidgetChangeState(&scale->core, 0, TTK_STATE_INVALID);
+ }
+ TtkRedisplayWidget(&scale->core);
+}
+
+/* ScaleInitialize --
+ * Scale widget initialization hook.
+ */
+static int ScaleInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Scale *scalePtr = recordPtr;
+
+ TrackElementState(&scalePtr->core);
+ return TCL_OK;
+}
+
+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 (CoreConfigure(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 WidgetGetOrientedLayout(
+ interp, theme, recordPtr, scalePtr->scale.orientObj);
+}
+
+/*
+ * TroughBox --
+ * Returns the inner area of the trough element.
+ */
+static Ttk_Box TroughBox(Scale *scalePtr)
+{
+ WidgetCore *corePtr = &scalePtr->core;
+ Ttk_LayoutNode *node = Ttk_LayoutFindNode(corePtr->layout, "trough");
+
+ if (node) {
+ return Ttk_LayoutNodeInternalParcel(corePtr->layout, node);
+ } else {
+ return Ttk_MakeBox(
+ 0,0, Tk_Width(corePtr->tkwin), Tk_Height(corePtr->tkwin));
+ }
+}
+
+/*
+ * 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_LayoutNode *slider=Ttk_LayoutFindNode(scalePtr->core.layout,"slider");
+
+ /*
+ * If this is a scale widget, adjust range for slider:
+ */
+ if (slider) {
+ Ttk_Box sliderBox = Ttk_LayoutNodeParcel(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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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_LayoutNode *sliderNode = Ttk_LayoutFindNode(corePtr->layout, "slider");
+
+ Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+
+ /* Adjust the slider position:
+ */
+ if (sliderNode) {
+ Scale *scalePtr = clientData;
+ Ttk_Box troughBox = TroughBox(scalePtr);
+ Ttk_Box sliderBox = Ttk_LayoutNodeParcel(sliderNode);
+ 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_PlaceLayoutNode(corePtr->layout, sliderNode, 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 WidgetCommandSpec ScaleCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "state", WidgetStateCommand },
+ { "instate", WidgetInstateCommand },
+ { "identify", WidgetIdentifyCommand },
+ { "set", ScaleSetCommand },
+ { "get", ScaleGetCommand },
+ { "coords", ScaleCoordsCommand },
+ { 0, 0 }
+};
+
+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 */
+ WidgetDisplay /* displayProc */
+};
+
diff --git a/generic/ttk/ttkScroll.c b/generic/ttk/ttkScroll.c
new file mode 100644
index 0000000..32c9477
--- /dev/null
+++ b/generic/ttk/ttkScroll.c
@@ -0,0 +1,248 @@
+/* $Id: ttkScroll.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * 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. ScrollviewCommand calls ScrollTo(), which updates
+ * 'first' and schedules a redisplay.
+ * 4. Once the scrollee knows 'total' and 'last' (typically in
+ * the LayoutProc), call Scrolled(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 ScrollTo() directly (step 2).
+ *
+ * If the widget value changes, it should call Scrolled() (step 4).
+ * (This usually happens automatically when the widget is redisplayed).
+ *
+ * If the scrollee's -[xy]scrollcommand changes, it should call
+ * ScrollbarUpdateRequired, which will invoke step (5) (@@@ Fix this)
+ */
+
+#include <tk.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;
+};
+
+/* CreateScrollHandle --
+ * Initialize scroll handle.
+ */
+ScrollHandle CreateScrollHandle(WidgetCore *corePtr, Scrollable *scrollPtr)
+{
+ ScrollHandle h = (ScrollHandle)ckalloc(sizeof(*h));
+
+ h->flags = 0;
+ h->corePtr = corePtr;
+ h->scrollPtr = scrollPtr;
+
+ scrollPtr->first = 0;
+ scrollPtr->last = 1;
+ scrollPtr->total = 1;
+ return h;
+}
+
+void FreeScrollHandle(ScrollHandle h)
+{
+ Tcl_EventuallyFree((ClientData)h, TCL_DYNAMIC);
+}
+
+/* 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;
+ char args[TCL_DOUBLE_SPACE * 2];
+ int code;
+
+ h->flags &= ~(SCROLL_UPDATE_PENDING | SCROLL_UPDATE_REQUIRED);
+
+ if (s->scrollCmd == NULL)
+ return TCL_OK;
+
+ sprintf(args, " %g %g",
+ (double)s->first / s->total,
+ (double)s->last / s->total);
+
+ Tcl_Preserve(h->corePtr);
+ code = Tcl_VarEval(interp, s->scrollCmd, args, NULL);
+ if (WidgetDestroyed(h->corePtr)) {
+ Tcl_Release(h->corePtr);
+ return TCL_ERROR;
+ }
+ Tcl_Release(h->corePtr);
+
+ if (code != TCL_OK) {
+ /* 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;
+
+ if (WidgetDestroyed(h->corePtr)) {
+ Tcl_Release(clientData);
+ return;
+ }
+
+ Tcl_Preserve((ClientData) interp);
+ code = UpdateScrollbar(interp, h);
+ if (code == TCL_ERROR && !Tcl_InterpDeleted(interp)) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+ Tcl_Release(clientData);
+}
+
+/* Scrolled --
+ * Update scroll info, schedule scrollbar update.
+ */
+void Scrolled(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 (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_Preserve((ClientData)h);
+ Tcl_DoWhenIdle(UpdateScrollbarBG, (ClientData)h);
+ h->flags |= SCROLL_UPDATE_PENDING;
+ }
+ }
+}
+
+/* ScrollbarUpdateRequired --
+ * Force a scrollbar update at the next call to Scrolled(),
+ * even if scroll parameters haven't changed (e.g., if
+ * -yscrollcommand has changed).
+ */
+
+void ScrollbarUpdateRequired(ScrollHandle h)
+{
+ h->flags |= SCROLL_UPDATE_REQUIRED;
+}
+
+/* ScrollviewCommand --
+ * 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 ScrollviewCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], ScrollHandle h)
+{
+ Scrollable *s = h->scrollPtr;
+ int newFirst = s->first;
+
+ if (objc == 2) {
+ char buf[TCL_DOUBLE_SPACE * 2];
+ sprintf(buf, "%g %g",
+ (double)s->first / s->total,
+ (double)s->last / s->total);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ 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;
+ }
+ }
+ }
+
+ ScrollTo(h, newFirst);
+
+ return TCL_OK;
+}
+
+void ScrollTo(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);
+ }
+}
+
diff --git a/generic/ttk/ttkScrollbar.c b/generic/ttk/ttkScrollbar.c
new file mode 100644
index 0000000..1431c46
--- /dev/null
+++ b/generic/ttk/ttkScrollbar.c
@@ -0,0 +1,316 @@
+/* $Id: ttkScrollbar.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Copyright (c) 2003, Joe English
+ * Ttk widget set: scrollbar widget implementation.
+ */
+
+#include <string.h>
+#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_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget hooks.
+ */
+
+static int
+ScrollbarInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Scrollbar *sb = recordPtr;
+ sb->scrollbar.first = 0.0;
+ sb->scrollbar.last = 1.0;
+
+ TrackElementState(&sb->core);
+
+ return TCL_OK;
+}
+
+static Ttk_Layout ScrollbarGetLayout(
+ Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Scrollbar *sb = recordPtr;
+ return WidgetGetOrientedLayout(
+ 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_LayoutNode *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_LayoutFindNode(corePtr->layout, "thumb");
+ if (!thumb) /* Something has gone wrong -- bail */
+ return;
+
+ sb->scrollbar.troughBox = thumbBox = Ttk_LayoutNodeParcel(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_PlaceLayoutNode(corePtr->layout, thumb, thumbBox);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands.
+ */
+
+/* $sb set $first $last --
+ * Set the position of the scrollbar.
+ */
+static int
+ScrollbarSetCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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 WidgetCommandSpec ScrollbarCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "delta", ScrollbarDeltaCommand },
+ { "fraction", ScrollbarFractionCommand },
+ { "get", ScrollbarGetCommand },
+ { "identify", WidgetIdentifyCommand },
+ { "instate", WidgetInstateCommand },
+ { "set", ScrollbarSetCommand },
+ { "state", WidgetStateCommand },
+ { 0,0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget specification.
+ */
+WidgetSpec ScrollbarWidgetSpec =
+{
+ "TScrollbar", /* className */
+ sizeof(Scrollbar), /* recordSize */
+ ScrollbarOptionSpecs, /* optionSpecs */
+ ScrollbarCommands, /* subcommands */
+ ScrollbarInitialize, /* initializeProc */
+ NullCleanup, /* cleanupProc */
+ CoreConfigure, /* configureProc */
+ NullPostConfigure, /* postConfigureProc */
+ ScrollbarGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ ScrollbarDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
+/*EOF*/
diff --git a/generic/ttk/ttkSeparator.c b/generic/ttk/ttkSeparator.c
new file mode 100644
index 0000000..7914928
--- /dev/null
+++ b/generic/ttk/ttkSeparator.c
@@ -0,0 +1,111 @@
+/* $Id: ttkSeparator.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Copyright (c) 2004, Joe English
+ *
+ * Ttk widget set: separator and 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_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+/*
+ * GetLayout hook --
+ * Choose layout based on -orient option.
+ */
+static Ttk_Layout SeparatorGetLayout(
+ Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr)
+{
+ Separator *sep = recordPtr;
+ return WidgetGetOrientedLayout(
+ interp, theme, recordPtr, sep->separator.orientObj);
+}
+
+/*
+ * Widget commands:
+ */
+static WidgetCommandSpec SeparatorCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "identify", WidgetIdentifyCommand },
+ { "instate", WidgetInstateCommand },
+ { "state", WidgetStateCommand },
+ { NULL, NULL }
+};
+
+/*
+ * Widget specification:
+ */
+WidgetSpec SeparatorWidgetSpec =
+{
+ "TSeparator", /* className */
+ sizeof(Separator), /* recordSize */
+ SeparatorOptionSpecs, /* optionSpecs */
+ SeparatorCommands, /* subcommands */
+ NullInitialize, /* initializeProc */
+ NullCleanup, /* cleanupProc */
+ CoreConfigure, /* configureProc */
+ NullPostConfigure, /* postConfigureProc */
+ SeparatorGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ WidgetDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
+/* +++ Sizegrip widget:
+ * Has no options or methods other than the standard ones.
+ */
+
+static WidgetCommandSpec SizegripCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "identify", WidgetIdentifyCommand },
+ { "instate", WidgetInstateCommand },
+ { "state", WidgetStateCommand },
+ { NULL, NULL }
+};
+
+WidgetSpec SizegripWidgetSpec =
+{
+ "TSizegrip", /* className */
+ sizeof(WidgetCore), /* recordSize */
+ CoreOptionSpecs, /* optionSpecs */
+ SizegripCommands, /* subcommands */
+ NullInitialize, /* initializeProc */
+ NullCleanup, /* cleanupProc */
+ CoreConfigure, /* configureProc */
+ NullPostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ WidgetDoLayout, /* layoutProc */
+ WidgetDisplay /* displayProc */
+};
+
+/*EOF*/
diff --git a/generic/ttk/ttkSquare.c b/generic/ttk/ttkSquare.c
new file mode 100644
index 0000000..eec4776
--- /dev/null
+++ b/generic/ttk/ttkSquare.c
@@ -0,0 +1,303 @@
+/* square.c - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+ *
+ * Minimal sample ttk widget.
+ *
+ * $Id: ttkSquare.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#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[] =
+{
+ WIDGET_TAKES_FOCUS,
+
+ {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_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+/*
+ * 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_LayoutNode *squareNode;
+
+ squareNode = Ttk_LayoutFindNode(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_LayoutNodeParcel(squareNode);
+ if (squarePtr->square.anchorObj != NULL)
+ Tk_GetAnchorFromObj(NULL, squarePtr->square.anchorObj, &anchor);
+ b = Ttk_AnchorBox(winBox, b.width, b.height, anchor);
+
+ Ttk_PlaceLayoutNode(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 WidgetCommandSpec SquareCommands[] =
+{
+ { "configure", WidgetConfigureCommand },
+ { "cget", WidgetCgetCommand },
+ { "identify", WidgetIdentifyCommand },
+ { "instate", WidgetInstateCommand },
+ { "state", WidgetStateCommand },
+ { NULL, NULL }
+};
+
+/*
+ * 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).
+ */
+
+WidgetSpec SquareWidgetSpec =
+{
+ "TSquare", /* className */
+ sizeof(Square), /* recordSize */
+ SquareOptionSpecs, /* optionSpecs */
+ SquareCommands, /* subcommands */
+ NullInitialize, /* initializeProc */
+ NullCleanup, /* cleanupProc */
+ CoreConfigure, /* configureProc */
+ NullPostConfigure, /* postConfigureProc */
+ WidgetGetLayout, /* getLayoutProc */
+ WidgetSize, /* sizeProc */
+ SquareDoLayout, /* layoutProc */
+ WidgetDisplay /* 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 }
+};
+
+/*
+ * 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
+SquareElementGeometry(
+ 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 border = NULL, foreground = NULL;
+ int borderWidth = 1, relief = TK_RELIEF_FLAT;
+
+ border = Tk_Get3DBorderFromObj(tkwin, square->borderObj);
+ 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,
+ SquareElementGeometry,
+ 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 */ int
+SquareWidget_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;
+}
+
diff --git a/generic/ttk/ttkState.c b/generic/ttk/ttkState.c
new file mode 100644
index 0000000..8923fa6
--- /dev/null
+++ b/generic/ttk/ttkState.c
@@ -0,0 +1,268 @@
+/*
+ * $Id: ttkState.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * 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 *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 */
+ 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) {
+ 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_ResetResult(interp);
+ Tcl_AppendResult(interp, "Invalid state name ", stateName,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_ResetResult(interp);
+ Tcl_AppendResult(interp, "No match in state map", 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_SetResult(interp,
+ "State map must have an even number of elements",
+ TCL_STATIC);
+ 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*/
diff --git a/generic/ttk/ttkStubInit.c b/generic/ttk/ttkStubInit.c
new file mode 100644
index 0000000..c1223d3
--- /dev/null
+++ b/generic/ttk/ttkStubInit.c
@@ -0,0 +1,61 @@
+/*
+ * $Id: ttkStubInit.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * 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"
+
+/* !BEGIN!: Do not edit below this line. */
+
+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. */
diff --git a/generic/ttk/ttkStubLib.c b/generic/ttk/ttkStubLib.c
new file mode 100644
index 0000000..e13abde
--- /dev/null
+++ b/generic/ttk/ttkStubLib.c
@@ -0,0 +1,69 @@
+/*
+ * $Id: ttkStubLib.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
+ */
+
+#include "tk.h"
+
+#define USE_TTK_STUBS 1
+#include "ttkTheme.h"
+
+const TtkStubs *ttkStubsPtr;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ */
+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);
+ 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;
+}
+
diff --git a/generic/ttk/ttkTagSet.c b/generic/ttk/ttkTagSet.c
new file mode 100644
index 0000000..dd4d3a4
--- /dev/null
+++ b/generic/ttk/ttkTagSet.c
@@ -0,0 +1,147 @@
+/* $Id: ttkTagSet.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Ttk widget set: tag tables. Half-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 {
+ Tcl_Obj **tagRecord; /* ... hrmph. */
+};
+
+struct TtkTagTable {
+ Tk_OptionTable tagOptionTable; /* ... */
+ int tagRecordSize; /* size of tag record */
+ Tcl_HashTable tags; /* defined tags */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Tags.
+ */
+static Ttk_Tag NewTag(Ttk_TagTable tagTable)
+{
+ Ttk_Tag tag = (Ttk_Tag)ckalloc(sizeof(*tag));
+ tag->tagRecord = (Tcl_Obj **)ckalloc(tagTable->tagRecordSize);
+ memset(tag->tagRecord, 0, tagTable->tagRecordSize);
+ return tag;
+}
+
+static void DeleteTag(Ttk_Tag tag, int nOptions)
+{
+ int i;
+ for (i = 0; i < nOptions; ++i) {
+ if (tag->tagRecord[i]) {
+ Tcl_DecrRefCount(tag->tagRecord[i]);
+ }
+ }
+ ckfree((void*)tag->tagRecord);
+ ckfree((void*)tag);
+}
+
+Tcl_Obj **Ttk_TagRecord(Ttk_Tag tag)
+{
+ return tag->tagRecord;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Tag tables.
+ */
+
+Ttk_TagTable Ttk_CreateTagTable(
+ Tk_OptionTable tagOptionTable, int tagRecordSize)
+{
+ Ttk_TagTable tagTable = (Ttk_TagTable)ckalloc(sizeof(*tagTable));
+ tagTable->tagOptionTable = tagOptionTable;
+ tagTable->tagRecordSize = tagRecordSize;
+ Tcl_InitHashTable(&tagTable->tags, TCL_STRING_KEYS);
+ return tagTable;
+}
+
+void Ttk_DeleteTagTable(Ttk_TagTable tagTable)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+ int nOptions = tagTable->tagRecordSize / sizeof(Tcl_Obj *);
+
+ entryPtr = Tcl_FirstHashEntry(&tagTable->tags, &search);
+ while (entryPtr != NULL) {
+ DeleteTag(Tcl_GetHashValue(entryPtr), nOptions);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ Tcl_DeleteHashTable(&tagTable->tags);
+ ckfree((void*)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) {
+ Tcl_SetHashValue(entryPtr, NewTag(tagTable));
+ }
+ return Tcl_GetHashValue(entryPtr);
+}
+
+Ttk_Tag Ttk_GetTagFromObj(Ttk_TagTable tagTable, Tcl_Obj *objPtr)
+{
+ return Ttk_GetTag(tagTable, Tcl_GetString(objPtr));
+}
+
+/* Ttk_GetTagListFromObj --
+ * Extract an array of pointers to Ttk_Tags from a Tcl_Obj.
+ * (suitable for passing to Tk_BindEvent).
+ *
+ * Result must be passed to Ttk_FreeTagList().
+ */
+extern int Ttk_GetTagListFromObj(
+ Tcl_Interp *interp,
+ Ttk_TagTable tagTable,
+ Tcl_Obj *objPtr,
+ int *nTags_rtn,
+ void **taglist_rtn)
+{
+ Tcl_Obj **objv;
+ int i, objc;
+ void **tags;
+
+ *taglist_rtn = NULL; *nTags_rtn = 0;
+
+ if (objPtr == NULL) {
+ return TCL_OK;
+ }
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ tags = (void**)ckalloc((objc+1) * sizeof(void*));
+ for (i=0; i<objc; ++i) {
+ tags[i] = Ttk_GetTagFromObj(tagTable, objv[i]);
+ }
+ tags[i] = NULL;
+
+ *taglist_rtn = tags;
+ *nTags_rtn = objc;
+
+ return TCL_OK;
+}
+
+void Ttk_FreeTagList(void **taglist)
+{
+ if (taglist)
+ ckfree((ClientData)taglist);
+}
+
diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c
new file mode 100644
index 0000000..c8b8010
--- /dev/null
+++ b/generic/ttk/ttkTheme.c
@@ -0,0 +1,1719 @@
+/*
+ * tkTheme.c --
+ *
+ * This file implements the widget styles and themes support.
+ *
+ * Copyright (c) 2002 Frederic Bonnet
+ * Copyright (c) 2003 Joe English
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * $Id: ttkTheme.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ */
+
+#include <stdlib.h>
+#include <string.h>
+#include <tk.h>
+#include "ttkThemeInt.h"
+
+#ifdef NO_PRIVATE_HEADERS
+EXTERN CONST Tk_OptionSpec *TkGetOptionSpec (CONST char *name,
+ Tk_OptionTable optionTable);
+#else
+#include <tkInt.h>
+#endif
+
+/*------------------------------------------------------------------------
+ * +++ Styles.
+ *
+ * Invariants:
+ * If styleName contains a dot, parentStyle->styleName is everything
+ * after the first dot; otherwise, parentStyle is the theme's root
+ * style ".". The root style's parentStyle is NULL.
+ *
+ */
+
+typedef struct Ttk_Style_
+{
+ const char *styleName; /* points to hash table key */
+ Tcl_HashTable settingsTable; /* KEY: string; VALUE: StateMap */
+ Tcl_HashTable defaultsTable; /* KEY: string; VALUE: resource */
+ Ttk_LayoutTemplate layoutTemplate; /* Layout template for style, or NULL */
+ Ttk_Style parentStyle; /* Previous style in chain */
+ Ttk_ResourceCache cache; /* Back-pointer to resource cache */
+} Style;
+
+static Style *NewStyle()
+{
+ Style *stylePtr = (Style*)ckalloc(sizeof(Style));
+
+ stylePtr->styleName = NULL;
+ stylePtr->parentStyle = NULL;
+ stylePtr->layoutTemplate = NULL;
+ stylePtr->cache = NULL;
+ Tcl_InitHashTable(&stylePtr->settingsTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&stylePtr->defaultsTable, TCL_STRING_KEYS);
+
+ return stylePtr;
+}
+
+static void FreeStyle(Style *stylePtr)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+
+ entryPtr = Tcl_FirstHashEntry(&stylePtr->settingsTable, &search);
+ while (entryPtr != NULL) {
+ Ttk_StateMap stateMap = (Ttk_StateMap)Tcl_GetHashValue(entryPtr);
+ Tcl_DecrRefCount(stateMap);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&stylePtr->settingsTable);
+
+ entryPtr = Tcl_FirstHashEntry(&stylePtr->defaultsTable, &search);
+ while (entryPtr != NULL) {
+ Tcl_Obj *defaultValue = (Ttk_StateMap)Tcl_GetHashValue(entryPtr);
+ Tcl_DecrRefCount(defaultValue);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&stylePtr->defaultsTable);
+
+ Ttk_FreeLayoutTemplate(stylePtr->layoutTemplate);
+
+ ckfree((char*)stylePtr);
+}
+
+/*
+ * LookupStateMap --
+ * Look up dynamic resource settings in the in the specified style.
+ */
+
+static Ttk_StateMap LookupStateMap(Ttk_Style stylePtr, const char *optionName)
+{
+ while (stylePtr) {
+ Tcl_HashEntry *entryPtr =
+ Tcl_FindHashEntry(&stylePtr->settingsTable, optionName);
+ if (entryPtr)
+ return (Ttk_StateMap)Tcl_GetHashValue(entryPtr);
+ stylePtr = stylePtr->parentStyle;
+ }
+ return 0;
+}
+
+/*
+ * LookupDefault --
+ * Look up default resource setting the in the specified style.
+ */
+static Tcl_Obj *LookupDefault(Ttk_Style stylePtr, const char *optionName)
+{
+ while (stylePtr) {
+ Tcl_HashEntry *entryPtr =
+ Tcl_FindHashEntry(&stylePtr->defaultsTable, optionName);
+ if (entryPtr)
+ return (Tcl_Obj *)Tcl_GetHashValue(entryPtr);
+ stylePtr = stylePtr->parentStyle;
+ }
+ return 0;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Elements.
+ */
+typedef const Tk_OptionSpec **OptionMap;
+ /* array of Tk_OptionSpecs mapping widget options to element options */
+
+typedef struct Ttk_ElementImpl_ /* Element implementation */
+{
+ const char *name; /* Points to hash table key */
+ Ttk_ElementSpec *specPtr; /* Template provided during registration. */
+ void *clientData; /* Client data passed in at registration time */
+ void *elementRecord; /* Scratch buffer for element record storage */
+ int nResources; /* #Element options */
+ Tcl_Obj **defaultValues; /* Array of option default values */
+ Tcl_HashTable optMapCache; /* Map: Tk_OptionTable * -> OptionMap */
+} ElementImpl;
+
+/* TTKGetOptionSpec --
+ * Look up a Tk_OptionSpec by name from a Tk_OptionTable,
+ * and verify that it's compatible with the specified Tk_OptionType,
+ * along with other constraints (see below).
+ */
+static const Tk_OptionSpec *TTKGetOptionSpec(
+ const char *optionName,
+ Tk_OptionTable optionTable,
+ Tk_OptionType optionType)
+{
+ const Tk_OptionSpec *optionSpec = TkGetOptionSpec(optionName, optionTable);
+
+ if (!optionSpec)
+ return 0;
+
+ /* Make sure widget option has a Tcl_Obj* entry:
+ */
+ if (optionSpec->objOffset < 0) {
+ return 0;
+ }
+
+ /* Grrr. Ignore accidental mismatches caused by prefix-matching:
+ */
+ if (strcmp(optionSpec->optionName, optionName)) {
+ return 0;
+ }
+
+ /* Ensure that the widget option type is compatible with
+ * the element option type.
+ *
+ * TK_OPTION_STRING element options are compatible with anything.
+ * As a workaround for the workaround for Bug #967209,
+ * TK_OPTION_STRING widget options are also compatible with anything
+ * (see <<NOTE-NULLOPTIONS>>).
+ */
+ if ( optionType != TK_OPTION_STRING
+ && optionSpec->type != TK_OPTION_STRING
+ && optionType != optionSpec->type)
+ {
+ return 0;
+ }
+
+ return optionSpec;
+}
+
+/* BuildOptionMap --
+ * Construct the mapping from element options to widget options.
+ */
+static OptionMap
+BuildOptionMap(ElementImpl *elementImpl, Tk_OptionTable optionTable)
+{
+ OptionMap optionMap = (OptionMap)ckalloc(
+ sizeof(const Tk_OptionSpec) * elementImpl->nResources);
+ int i;
+
+ for (i = 0; i < elementImpl->nResources; ++i) {
+ Ttk_ElementOptionSpec *e = elementImpl->specPtr->options+i;
+ optionMap[i] = TTKGetOptionSpec(e->optionName, optionTable, e->type);
+ }
+
+ return optionMap;
+}
+
+/* GetOptionMap --
+ * Return a cached OptionMap matching the specified optionTable
+ * for the specified element, creating it if necessary.
+ */
+static OptionMap
+GetOptionMap(ElementImpl *elementImpl, Tk_OptionTable optionTable)
+{
+ OptionMap optionMap;
+ int isNew;
+ Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(
+ &elementImpl->optMapCache, (ClientData)optionTable, &isNew);
+
+ if (isNew) {
+ optionMap = BuildOptionMap(elementImpl, optionTable);
+ Tcl_SetHashValue(entryPtr, optionMap);
+ } else {
+ optionMap = (OptionMap)(Tcl_GetHashValue(entryPtr));
+ }
+
+ return optionMap;
+}
+
+/*
+ * NewElementImpl --
+ * Allocate and initialize an element implementation record
+ * from the specified element specification.
+ */
+static ElementImpl *
+NewElementImpl(const char *name, Ttk_ElementSpec *specPtr,void *clientData)
+{
+ ElementImpl *elementImpl = (ElementImpl*)ckalloc(sizeof(ElementImpl));
+ int i;
+
+ elementImpl->name = name;
+ elementImpl->specPtr = specPtr;
+ elementImpl->clientData = clientData;
+ elementImpl->elementRecord = ckalloc(specPtr->elementSize);
+
+ /* Count #element resources:
+ */
+ for (i = 0; specPtr->options[i].optionName != 0; ++i)
+ continue;
+ elementImpl->nResources = i;
+
+ /* Initialize default values:
+ */
+ elementImpl->defaultValues = (Tcl_Obj**)
+ ckalloc(elementImpl->nResources * sizeof(Tcl_Obj *));
+ for (i=0; i < elementImpl->nResources; ++i) {
+ const char *defaultValue = specPtr->options[i].defaultValue;
+ if (defaultValue) {
+ elementImpl->defaultValues[i] = Tcl_NewStringObj(defaultValue,-1);
+ Tcl_IncrRefCount(elementImpl->defaultValues[i]);
+ } else {
+ elementImpl->defaultValues[i] = 0;
+ }
+ }
+
+ /* Initialize option map cache:
+ */
+ Tcl_InitHashTable(&elementImpl->optMapCache, TCL_ONE_WORD_KEYS);
+
+ return elementImpl;
+}
+
+/*
+ * FreeElementImpl --
+ * Release resources associated with an element implementation record.
+ */
+static void FreeElementImpl(ElementImpl *elementImpl)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+ int i;
+
+ /*
+ * Free default values:
+ */
+ for (i = 0; i < elementImpl->nResources; ++i) {
+ if (elementImpl->defaultValues[i]) {
+ Tcl_DecrRefCount(elementImpl->defaultValues[i]);
+ }
+ }
+ ckfree((ClientData)elementImpl->defaultValues);
+
+ /*
+ * Free option map cache:
+ */
+ entryPtr = Tcl_FirstHashEntry(&elementImpl->optMapCache, &search);
+ while (entryPtr != NULL) {
+ ckfree(Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&elementImpl->optMapCache);
+
+ ckfree(elementImpl->elementRecord);
+ ckfree((ClientData)elementImpl);
+}
+
+
+/*------------------------------------------------------------------------
+ * +++ Themes.
+ */
+
+static int ThemeEnabled(Ttk_Theme theme, void *clientData) { return 1; }
+ /* Default ThemeEnabledProc -- always return true */
+
+typedef struct Ttk_Theme_
+{
+ Ttk_Theme parentPtr; /* Parent theme. */
+ Tcl_HashTable elementTable; /* Map element names to ElementImpls */
+ Tcl_HashTable styleTable; /* Map style names to Styles */
+ Ttk_Style rootStyle; /* "." style, root of chain */
+ Ttk_ThemeEnabledProc *enabledProc; /* Function called by SetTheme */
+ void *enabledData; /* ClientData for enabledProc */
+ Ttk_ResourceCache cache; /* Back-pointer to resource cache */
+} Theme;
+
+static Theme *NewTheme(Ttk_ResourceCache cache, Ttk_Theme parent)
+{
+ Theme *themePtr = (Theme*)ckalloc(sizeof(Theme));
+ Tcl_HashEntry *entryPtr;
+ int unused;
+
+ themePtr->parentPtr = parent;
+ themePtr->enabledProc = ThemeEnabled;
+ themePtr->enabledData = NULL;
+ themePtr->cache = cache;
+ Tcl_InitHashTable(&themePtr->elementTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&themePtr->styleTable, TCL_STRING_KEYS);
+
+ /*
+ * Create root style "."
+ */
+ entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, ".", &unused);
+ themePtr->rootStyle = NewStyle();
+ themePtr->rootStyle->styleName =
+ Tcl_GetHashKey(&themePtr->styleTable, entryPtr);
+ themePtr->rootStyle->cache = themePtr->cache;
+ Tcl_SetHashValue(entryPtr, (ClientData)themePtr->rootStyle);
+
+ return themePtr;
+}
+
+static void FreeTheme(Theme *themePtr)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+
+ /*
+ * Free associated ElementImpl's
+ */
+ entryPtr = Tcl_FirstHashEntry(&themePtr->elementTable, &search);
+ while (entryPtr != NULL) {
+ ElementImpl *elementImpl = (ElementImpl *)Tcl_GetHashValue(entryPtr);
+ FreeElementImpl(elementImpl);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&themePtr->elementTable);
+
+ /*
+ * Free style table:
+ */
+ entryPtr = Tcl_FirstHashEntry(&themePtr->styleTable, &search);
+ while (entryPtr != NULL) {
+ Style *stylePtr = (Style*)Tcl_GetHashValue(entryPtr);
+ FreeStyle(stylePtr);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&themePtr->styleTable);
+
+ /*
+ * Free theme record:
+ */
+ ckfree((char *)themePtr);
+
+ return;
+}
+
+/*
+ * Element constructors.
+ */
+typedef struct {
+ Ttk_ElementFactory factory;
+ void *clientData;
+} FactoryRec;
+
+/*
+ * Cleanup records:
+ */
+typedef struct CleanupStruct {
+ void *clientData;
+ Ttk_CleanupProc *cleanupProc;
+ struct CleanupStruct *next;
+} Cleanup;
+
+/*------------------------------------------------------------------------
+ * +++ Master style package data structure.
+ */
+typedef struct
+{
+ Tcl_Interp *interp; /* Owner interp */
+ Tcl_HashTable themeTable; /* KEY: name; VALUE: Theme pointer */
+ Tcl_HashTable factoryTable; /* KEY: name; VALUE: FactoryRec ptr */
+ Theme *defaultTheme; /* Default theme; global fallback*/
+ Theme *currentTheme; /* Currently-selected theme */
+ Cleanup *cleanupList; /* Cleanup records */
+ Ttk_ResourceCache cache; /* Resource cache */
+ int themeChangePending; /* scheduled ThemeChangedProc call? */
+} StylePackageData;
+
+static void ThemeChangedProc(ClientData); /* Forward */
+
+/* Ttk_StylePkgFree --
+ * Cleanup procedure for StylePackageData.
+ */
+static void Ttk_StylePkgFree(ClientData clientData, Tcl_Interp *interp)
+{
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr;
+ Theme *themePtr;
+ Cleanup *cleanup;
+
+ /*
+ * Cancel any pending ThemeChanged calls:
+ */
+ if (pkgPtr->themeChangePending) {
+ Tcl_CancelIdleCall(ThemeChangedProc, pkgPtr);
+ }
+
+ /*
+ * Free themes.
+ */
+ entryPtr = Tcl_FirstHashEntry(&pkgPtr->themeTable, &search);
+ while (entryPtr != NULL) {
+ themePtr = (Theme *) Tcl_GetHashValue(entryPtr);
+ FreeTheme(themePtr);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&pkgPtr->themeTable);
+
+ /*
+ * Free element constructor table:
+ */
+ entryPtr = Tcl_FirstHashEntry(&pkgPtr->factoryTable, &search);
+ while (entryPtr != NULL) {
+ ckfree(Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&pkgPtr->factoryTable);
+
+ /*
+ * Release cache:
+ */
+ Ttk_FreeResourceCache(pkgPtr->cache);
+
+ /*
+ * Call all registered cleanup procedures:
+ */
+ cleanup = pkgPtr->cleanupList;
+ while (cleanup) {
+ Cleanup *next = cleanup->next;
+ cleanup->cleanupProc(cleanup->clientData);
+ ckfree((ClientData)cleanup);
+ cleanup = next;
+ }
+
+ ckfree((char*)pkgPtr);
+}
+
+/*
+ * GetStylePackageData --
+ * Look up the package data registered with the interp.
+ */
+
+static StylePackageData *GetStylePackageData(Tcl_Interp *interp)
+{
+ return (StylePackageData*)Tcl_GetAssocData(interp, "StylePackage", NULL);
+}
+
+/*
+ * Ttk_RegisterCleanup --
+ *
+ * Register a function to be called when a theme engine is deleted.
+ * (This only happens when the main interp is destroyed). The cleanup
+ * function is called with the current Tcl interpreter and the client
+ * data provided here.
+ *
+ */
+void Ttk_RegisterCleanup(
+ Tcl_Interp *interp, ClientData clientData, Ttk_CleanupProc *cleanupProc)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ Cleanup *cleanup = (Cleanup*)ckalloc(sizeof(*cleanup));
+
+ cleanup->clientData = clientData;
+ cleanup->cleanupProc = cleanupProc;
+ cleanup->next = pkgPtr->cleanupList;
+ pkgPtr->cleanupList = cleanup;
+}
+
+/* ThemeChangedProc --
+ * Notify all widgets that the theme has been changed.
+ * Scheduled as an idle callback; clientData is a StylePackageData *.
+ *
+ * Sends a <<ThemeChanged>> event to every widget in the hierarchy.
+ * Ttk widgets respond to this by calling the WorldChanged class proc,
+ * which in turn recreates the layout.
+ *
+ * The Tk C API doesn't doesn't provide an easy way to traverse
+ * the widget hierarchy, so this is done by evaluating a Tcl script.
+ */
+
+static void ThemeChangedProc(ClientData clientData)
+{
+ static char ThemeChangedScript[] = "ttk::ThemeChanged";
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+
+ if (Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL)
+ != TCL_OK) {
+ Tcl_BackgroundError(pkgPtr->interp);
+ }
+ pkgPtr->themeChangePending = 0;
+}
+
+/*
+ * ThemeChanged --
+ * Schedule a call to ThemeChanged if one is not already pending.
+ */
+static void ThemeChanged(StylePackageData *pkgPtr)
+{
+ if (!pkgPtr->themeChangePending) {
+ Tcl_DoWhenIdle(ThemeChangedProc, pkgPtr);
+ pkgPtr->themeChangePending = 1;
+ }
+}
+
+/*
+ * Ttk_CreateTheme --
+ * Create a new theme and register it in the global theme table.
+ *
+ * Returns:
+ * Pointer to new Theme structure; NULL if named theme already exists.
+ * Leaves an error message in interp's result on error.
+ */
+
+Ttk_Theme
+Ttk_CreateTheme(
+ Tcl_Interp *interp, /* Interpreter in which to create theme */
+ const char *name, /* Name of the theme to create. */
+ Ttk_Theme parent) /* Parent/fallback theme, NULL for default */
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+ Theme *themePtr;
+
+ entryPtr = Tcl_CreateHashEntry(&pkgPtr->themeTable, name, &newEntry);
+ if (!newEntry) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Theme ", name, " already exists", NULL);
+ return NULL;
+ }
+
+ /*
+ * Initialize new theme:
+ */
+ if (!parent) parent = pkgPtr->defaultTheme;
+
+ themePtr = NewTheme(pkgPtr->cache, parent);
+ Tcl_SetHashValue(entryPtr, (ClientData) themePtr);
+
+ return themePtr;
+}
+
+
+/*
+ * Ttk_SetThemeEnabledProc --
+ * Sets a procedure that is used to check that this theme is available.
+ */
+
+void Ttk_SetThemeEnabledProc(
+ Ttk_Theme theme, Ttk_ThemeEnabledProc enabledProc, void *enabledData)
+{
+ theme->enabledProc = enabledProc;
+ theme->enabledData = enabledData;
+}
+
+/*
+ * LookupTheme --
+ * Retrieve a registered theme by name. If not found,
+ * returns NULL and leaves an error message in interp's result.
+ */
+
+static Ttk_Theme LookupTheme(
+ Tcl_Interp *interp, /* where to leave error messages */
+ StylePackageData *pkgPtr, /* style package master record */
+ const char *name) /* theme name */
+{
+ Tcl_HashEntry *entryPtr;
+
+ entryPtr = Tcl_FindHashEntry(&pkgPtr->themeTable, name);
+ if (!entryPtr) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "theme \"", name, "\" doesn't exist", NULL);
+ return NULL;
+ }
+
+ return (Ttk_Theme)Tcl_GetHashValue(entryPtr);
+}
+
+/*
+ * Ttk_GetTheme --
+ * Public interface to LookupTheme.
+ */
+Ttk_Theme Ttk_GetTheme(Tcl_Interp *interp, const char *themeName)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+
+ return LookupTheme(interp, pkgPtr, themeName);
+}
+
+Ttk_Theme Ttk_GetCurrentTheme(Tcl_Interp *interp)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ return pkgPtr->currentTheme;
+}
+
+Ttk_Theme Ttk_GetDefaultTheme(Tcl_Interp *interp)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ return pkgPtr->defaultTheme;
+}
+
+/*
+ * Ttk_UseTheme --
+ * Set the current theme, notify all widgets that the theme has changed.
+ */
+int Ttk_UseTheme(Tcl_Interp *interp, Ttk_Theme theme)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+
+ /*
+ * Check if selected theme is enabled:
+ */
+ while (theme && !theme->enabledProc(theme, theme->enabledData)) {
+ theme = theme->parentPtr;
+ }
+ if (!theme) {
+ /* This shouldn't happen -- default theme should always work */
+ Tcl_Panic("No themes available?");
+ return TCL_ERROR;
+ }
+
+ pkgPtr->currentTheme = theme;
+ ThemeChanged(pkgPtr);
+ return TCL_OK;
+}
+
+/*
+ * Ttk_GetResourceCache --
+ * Return the resource cache associated with 'interp'
+ */
+Ttk_ResourceCache
+Ttk_GetResourceCache(Tcl_Interp *interp)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ return pkgPtr->cache;
+}
+
+/*
+ * Register a new layout specification with a style.
+ * @@@ TODO: Make sure layoutName is not ".", root style must not have a layout
+ */
+static void Ttk_RegisterLayoutTemplate(
+ Ttk_Theme theme, /* Target theme */
+ const char *layoutName, /* Name of new layout */
+ Ttk_LayoutTemplate layoutTemplate) /* Template */
+{
+ Ttk_Style style = Ttk_GetStyle(theme, layoutName);
+ if (style->layoutTemplate) {
+ Ttk_FreeLayoutTemplate(style->layoutTemplate);
+ }
+ style->layoutTemplate = layoutTemplate;
+}
+
+void Ttk_RegisterLayout(
+ Ttk_Theme themePtr, /* Target theme */
+ const char *layoutName, /* Name of new layout */
+ Ttk_LayoutSpec specPtr) /* Static layout information */
+{
+ Ttk_LayoutTemplate layoutTemplate = Ttk_BuildLayoutTemplate(specPtr);
+ Ttk_RegisterLayoutTemplate(themePtr, layoutName, layoutTemplate);
+}
+
+/*
+ * Ttk_GetStyle --
+ * Look up a Style from a Theme, create new style if not found.
+ */
+Ttk_Style Ttk_GetStyle(Ttk_Theme themePtr, const char *styleName)
+{
+ Tcl_HashEntry *entryPtr;
+ int newStyle;
+
+ entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, styleName, &newStyle);
+ if (newStyle) {
+ Ttk_Style stylePtr = NewStyle();
+ const char *dot = strchr(styleName, '.');
+
+ if (dot) {
+ stylePtr->parentStyle = Ttk_GetStyle(themePtr, dot + 1);
+ } else {
+ stylePtr->parentStyle = themePtr->rootStyle;
+ }
+
+ stylePtr->styleName = Tcl_GetHashKey(&themePtr->styleTable, entryPtr);
+ stylePtr->cache = stylePtr->parentStyle->cache;
+ Tcl_SetHashValue(entryPtr, (ClientData)stylePtr);
+ return stylePtr;
+ }
+ return (Style*)Tcl_GetHashValue(entryPtr);
+}
+
+/* FindLayoutTemplate --
+ * Locate a layout template in the layout table, checking
+ * generic names to specific names first, then looking for
+ * the full name in the parent theme.
+ */
+Ttk_LayoutTemplate
+Ttk_FindLayoutTemplate(Ttk_Theme themePtr, const char *layoutName)
+{
+ while (themePtr) {
+ Ttk_Style stylePtr = Ttk_GetStyle(themePtr, layoutName);
+ while (stylePtr) {
+ if (stylePtr->layoutTemplate) {
+ return stylePtr->layoutTemplate;
+ }
+ stylePtr = stylePtr->parentStyle;
+ }
+ themePtr = themePtr->parentPtr;
+ }
+ return NULL;
+}
+
+const char *Ttk_StyleName(Ttk_Style stylePtr)
+{
+ return stylePtr->styleName;
+}
+
+/*
+ * Ttk_GetElement --
+ * Look up an element implementation by name in a given theme.
+ * If not found, try generic element names in this theme, then
+ * repeat the lookups in the parent theme.
+ * If not found, return the null element.
+ */
+Ttk_Element Ttk_GetElement(Ttk_Theme themePtr, const char *elementName)
+{
+ Tcl_HashEntry *entryPtr;
+ const char *dot = elementName;
+
+ /*
+ * Check if element has already been registered:
+ */
+ entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, elementName);
+ if (entryPtr) {
+ return (Ttk_Element)Tcl_GetHashValue(entryPtr);
+ }
+
+ /*
+ * Check generic names:
+ */
+ while (!entryPtr && ((dot = strchr(dot, '.')) != NULL)) {
+ dot++;
+ entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, dot);
+ }
+ if (entryPtr) {
+ return (ElementImpl *)Tcl_GetHashValue(entryPtr);
+ }
+
+ /*
+ * Check parent theme:
+ */
+ if (themePtr->parentPtr) {
+ return Ttk_GetElement(themePtr->parentPtr, elementName);
+ }
+
+ /*
+ * Not found, and this is the root theme; return null element, "".
+ * (@@@ SHOULD: signal a background error)
+ */
+ entryPtr = Tcl_FindHashEntry(&themePtr->elementTable, "");
+ /* ASSERT: entryPtr != 0 */
+ return (Ttk_Element)Tcl_GetHashValue(entryPtr);
+}
+
+const char *Ttk_ElementName(ElementImpl *elementImpl)
+{
+ return elementImpl->name;
+}
+
+/*
+ * Ttk_RegisterElementFactory --
+ * Register a new element factory.
+ */
+int Ttk_RegisterElementFactory(
+ Tcl_Interp *interp, const char *name,
+ Ttk_ElementFactory factory, void *clientData)
+{
+ StylePackageData *pkgPtr = GetStylePackageData(interp);
+ FactoryRec *recPtr = (FactoryRec*)ckalloc(sizeof(*recPtr));
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+
+ recPtr->factory = factory;
+ recPtr->clientData = clientData;
+
+ entryPtr = Tcl_CreateHashEntry(&pkgPtr->factoryTable, name, &newEntry);
+ if (!newEntry) {
+ /* Free old factory: */
+ ckfree(Tcl_GetHashValue(entryPtr));
+ }
+ Tcl_SetHashValue(entryPtr, recPtr);
+
+ return TCL_OK;
+}
+
+
+/* Ttk_CloneElement -- element factory procedure.
+ * (style element create $name) "from" $theme ?$element?
+ */
+static int Ttk_CloneElement(
+ Tcl_Interp *interp, void *clientData,
+ Ttk_Theme theme, const char *elementName,
+ int objc, Tcl_Obj *CONST objv[])
+{
+ Ttk_Theme fromTheme;
+ ElementImpl *fromElement;
+
+ if (objc <= 0 || objc > 2) {
+ Tcl_WrongNumArgs(interp, 0, objv, "theme ?element?");
+ return TCL_ERROR;
+ }
+
+ fromTheme = Ttk_GetTheme(interp, Tcl_GetString(objv[0]));
+ if (!fromTheme) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 2) {
+ fromElement = Ttk_GetElement(fromTheme, Tcl_GetString(objv[1]));
+ } else {
+ fromElement = Ttk_GetElement(fromTheme, elementName);
+ }
+ if (!fromElement) {
+ return TCL_ERROR;
+ }
+
+ if (Ttk_RegisterElement(interp, theme, elementName,
+ fromElement->specPtr, fromElement->clientData) == NULL)
+ {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/* Ttk_RegisterElement--
+ * Register an element in the given theme.
+ * Returns: Element handle if successful, NULL otherwise.
+ * On failure, leaves an error message in interp's result
+ * if interp is non-NULL.
+ */
+
+Ttk_Element Ttk_RegisterElement(
+ Tcl_Interp *interp, /* Where to leave error messages */
+ Ttk_Theme theme, /* Style engine providing the implementation. */
+ const char *name, /* Name of new element */
+ Ttk_ElementSpec *specPtr, /* Static template information */
+ void *clientData) /* application-specific data */
+{
+ ElementImpl *elementImpl;
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+
+ if (specPtr->version != TK_STYLE_VERSION_2) {
+ /* Version mismatch */
+ if (interp) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Internal error: Ttk_RegisterElement (",
+ name, "): invalid version",
+ NULL);
+ }
+ return 0;
+ }
+
+ entryPtr = Tcl_CreateHashEntry(&theme->elementTable, name, &newEntry);
+ if (!newEntry) {
+ if (interp) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Duplicate element ", name, NULL);
+ }
+ return 0;
+ }
+
+ name = Tcl_GetHashKey(&theme->elementTable, entryPtr);
+ elementImpl = NewElementImpl(name, specPtr, clientData);
+ Tcl_SetHashValue(entryPtr, elementImpl);
+
+ return elementImpl;
+}
+
+/* Ttk_RegisterElementSpec (deprecated) --
+ * Register a new element.
+ */
+int Ttk_RegisterElementSpec(Ttk_Theme theme,
+ const char *name, Ttk_ElementSpec *specPtr, void *clientData)
+{
+ return Ttk_RegisterElement(NULL, theme, name, specPtr, clientData)
+ ? TCL_OK : TCL_ERROR;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Element record initialization.
+ */
+
+/*
+ * AllocateResource --
+ * Extra initialization for element options like TK_OPTION_COLOR, etc.
+ *
+ * Returns: 1 if OK, 0 on failure.
+ *
+ * Note: if resource allocation fails at this point (just prior
+ * to drawing an element), there's really no good place to
+ * report the error. Instead we just silently fail.
+ */
+
+static int AllocateResource(
+ Ttk_ResourceCache cache,
+ Tk_Window tkwin,
+ Tcl_Obj **destPtr,
+ int optionType)
+{
+ Tcl_Obj *resource = *destPtr;
+
+ switch (optionType)
+ {
+ case TK_OPTION_FONT:
+ return (*destPtr = Ttk_UseFont(cache, tkwin, resource)) != NULL;
+ case TK_OPTION_COLOR:
+ return (*destPtr = Ttk_UseColor(cache, tkwin, resource)) != NULL;
+ case TK_OPTION_BORDER:
+ return (*destPtr = Ttk_UseBorder(cache, tkwin, resource)) != NULL;
+ default:
+ /* no-op; always succeeds */
+ return 1;
+ }
+}
+
+/*
+ * InitializeElementRecord --
+ *
+ * Fill in the element record based on the element's option table.
+ * Resources are initialized from:
+ * the corresponding widget option if present and non-NULL,
+ * otherwise the dynamic state map if specified,
+ * otherwise from the corresponding widget resource if present,
+ * otherwise the default value specified at registration time.
+ *
+ * Returns:
+ * 1 if OK, 0 if an error is detected.
+ *
+ * NOTES:
+ * Tcl_Obj * reference counts are _NOT_ adjusted.
+ */
+
+static
+int InitializeElementRecord(
+ ElementImpl *element, /* Element instance to initialize */
+ Ttk_Style style, /* Style table */
+ char *widgetRecord, /* Source of widget option values */
+ Tk_OptionTable optionTable, /* Option table describing widget record */
+ Tk_Window tkwin, /* Corresponding window */
+ Ttk_State state) /* Widget or element state */
+{
+ char *elementRecord = element->elementRecord;
+ OptionMap optionMap = GetOptionMap(element,optionTable);
+ int nResources = element->nResources;
+ Ttk_ResourceCache cache = style->cache;
+ Ttk_ElementOptionSpec *elementOption = element->specPtr->options;
+
+ int i;
+ for (i=0; i<nResources; ++i, ++elementOption) {
+ Tcl_Obj **dest = (Tcl_Obj **)
+ (elementRecord + elementOption->offset);
+ const char *optionName = elementOption->optionName;
+ Tcl_Obj *stateMap = LookupStateMap(style, optionName);
+ Tcl_Obj *dynamicSetting = 0;
+ Tcl_Obj *widgetValue = 0;
+ Tcl_Obj *elementDefault = element->defaultValues[i];
+
+ if (stateMap) {
+ dynamicSetting = Ttk_StateMapLookup(NULL, stateMap, state);
+ }
+
+ if (optionMap[i]) {
+ widgetValue = *(Tcl_Obj **)
+ (widgetRecord + optionMap[i]->objOffset);
+ }
+
+ if (widgetValue) {
+ *dest = widgetValue;
+ } else if (dynamicSetting) {
+ *dest = dynamicSetting;
+ } else {
+ Tcl_Obj *styleDefault = LookupDefault(style, optionName);
+ *dest = styleDefault ? styleDefault : elementDefault;
+ }
+
+ if (!AllocateResource(cache, tkwin, dest, elementOption->type)) {
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Public API.
+ */
+
+/*
+ * Ttk_QueryStyle --
+ * Look up a style option based on the current state.
+ */
+Tcl_Obj *Ttk_QueryStyle(
+ Ttk_Style style, /* Style to query */
+ void *recordPtr, /* Widget record */
+ Tk_OptionTable optionTable, /* Option table describing widget record */
+ const char *optionName, /* Option name */
+ Ttk_State state) /* Current state */
+{
+ Tcl_Obj *stateMap;
+ const Tk_OptionSpec *optionSpec;
+ Tcl_Obj *result;
+
+ /*
+ * Check widget record:
+ */
+ optionSpec = TTKGetOptionSpec(optionName, optionTable, TK_OPTION_ANY);
+ if (optionSpec) {
+ result = *(Tcl_Obj**)(((char*)recordPtr) + optionSpec->objOffset);
+ if (result) {
+ return result;
+ }
+ }
+
+ /*
+ * Check dynamic settings:
+ */
+ stateMap = LookupStateMap(style, optionName);
+ if (stateMap) {
+ result = Ttk_StateMapLookup(NULL, stateMap, state);
+ if (result) {
+ return result;
+ }
+ }
+
+ /*
+ * Use style default:
+ */
+ return LookupDefault(style, optionName);
+}
+
+/*
+ * Ttk_ElementSize --
+ * Compute the requested size of the given element.
+ */
+
+void
+Ttk_ElementSize(
+ ElementImpl *element, /* Element to query */
+ Ttk_Style style, /* Style settings */
+ char *recordPtr, /* The widget record. */
+ Tk_OptionTable optionTable, /* Description of widget record */
+ Tk_Window tkwin, /* The widget window. */
+ Ttk_State state, /* Current widget state */
+ int *widthPtr, /* Requested width */
+ int *heightPtr, /* Reqested height */
+ Ttk_Padding *paddingPtr) /* Requested inner border */
+{
+ paddingPtr->left = paddingPtr->right = paddingPtr->top = paddingPtr->bottom
+ = *widthPtr = *heightPtr = 0;
+
+ if (!InitializeElementRecord(element, style, recordPtr, optionTable, tkwin, state))
+ return;
+ element->specPtr->size(
+ element->clientData, element->elementRecord,
+ tkwin, widthPtr, heightPtr, paddingPtr);
+ *widthPtr += paddingPtr->left + paddingPtr->right;
+ *heightPtr += paddingPtr->top + paddingPtr->bottom;
+}
+
+/*
+ * Ttk_DrawElement --
+ * Draw the given widget element in a given drawable area.
+ */
+
+void
+Ttk_DrawElement(
+ ElementImpl *element, /* Element instance */
+ Ttk_Style style, /* Style settings */
+ char *recordPtr, /* The widget record. */
+ Tk_OptionTable optionTable, /* Description of option table */
+ Tk_Window tkwin, /* The widget window. */
+ Drawable d, /* Where to draw element. */
+ Ttk_Box b, /* Element area */
+ Ttk_State state) /* Widget or element state flags. */
+{
+ if (b.width <= 0 || b.height <= 0)
+ return;
+ if (!InitializeElementRecord(element, style, recordPtr, optionTable, tkwin, state))
+ return;
+ element->specPtr->draw(
+ element->clientData, element->elementRecord,
+ tkwin, d, b, state);
+}
+
+/*------------------------------------------------------------------------
+ * +++ 'style' command ensemble procedures.
+ */
+
+/*
+ * EnumerateHashTable --
+ * Helper routine. Sets interp's result to the list of all keys
+ * in the hash table.
+ *
+ * Returns: TCL_OK.
+ * Side effects: Sets interp's result.
+ */
+
+static int EnumerateHashTable(Tcl_Interp *interp, Tcl_HashTable *ht)
+{
+ Tcl_HashSearch search;
+ Tcl_Obj *result = Tcl_NewListObj(0, NULL);
+ Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search);
+
+ while (entryPtr != NULL) {
+ Tcl_Obj *nameObj = Tcl_NewStringObj(Tcl_GetHashKey(ht, entryPtr),-1);
+ Tcl_ListObjAppendElement(interp, result, nameObj);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/* HashTableToDict --
+ * Helper routine. Converts a TCL_STRING_KEYS Tcl_HashTable
+ * with Tcl_Obj * entries into a dictionary.
+ */
+static Tcl_Obj* HashTableToDict(Tcl_HashTable *ht)
+{
+ Tcl_HashSearch search;
+ Tcl_Obj *result = Tcl_NewListObj(0, NULL);
+ Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search);
+
+ while (entryPtr != NULL) {
+ Tcl_Obj *nameObj = Tcl_NewStringObj(Tcl_GetHashKey(ht, entryPtr),-1);
+ Tcl_Obj *valueObj = (Tcl_Obj*)Tcl_GetHashValue(entryPtr);
+ Tcl_ListObjAppendElement(NULL, result, nameObj);
+ Tcl_ListObjAppendElement(NULL, result, valueObj);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+
+ return result;
+}
+
+/* + style map $style ? -resource statemap ... ?
+ *
+ * Note that resource names are unconstrained; the Style
+ * doesn't know what resources individual elements may use.
+ */
+static int
+StyleMapCmd(
+ ClientData clientData, /* Master StylePackageData pointer */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj * CONST objv[]) /* Argument objects */
+{
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ const char *styleName;
+ Style *stylePtr;
+ int i;
+
+ if (objc < 3) {
+usage:
+ Tcl_WrongNumArgs(interp,2,objv,"style ?-option ?value...??");
+ return TCL_ERROR;
+ }
+
+ styleName = Tcl_GetString(objv[2]);
+ stylePtr = Ttk_GetStyle(theme, styleName);
+
+ /* NOTE: StateMaps are actually Tcl_Obj *s, so HashTableToDict works
+ * for settingsTable.
+ */
+ if (objc == 3) { /* style map $styleName */
+ Tcl_SetObjResult(interp, HashTableToDict(&stylePtr->settingsTable));
+ return TCL_OK;
+ } else if (objc == 4) { /* style map $styleName -option */
+ const char *optionName = Tcl_GetString(objv[3]);
+ Tcl_HashEntry *entryPtr =
+ Tcl_FindHashEntry(&stylePtr->settingsTable, optionName);
+ if (entryPtr) {
+ Tcl_SetObjResult(interp, (Tcl_Obj*)Tcl_GetHashValue(entryPtr));
+ }
+ return TCL_OK;
+ } else if (objc % 2 != 1) {
+ goto usage;
+ }
+
+ for (i = 3; i < objc; i += 2) {
+ const char *optionName = Tcl_GetString(objv[i]);
+ Tcl_Obj *stateMap = objv[i+1];
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+
+ /* Make sure 'stateMap' is legal:
+ * (@@@ SHOULD: check for valid resource values as well,
+ * but we don't know what types they should be at this level.)
+ */
+ if (!Ttk_GetStateMapFromObj(interp, stateMap))
+ return TCL_ERROR;
+
+ entryPtr = Tcl_CreateHashEntry(
+ &stylePtr->settingsTable,optionName,&newEntry);
+
+ Tcl_IncrRefCount(stateMap);
+ if (!newEntry) {
+ Tcl_DecrRefCount((Tcl_Obj*)Tcl_GetHashValue(entryPtr));
+ }
+ Tcl_SetHashValue(entryPtr, stateMap);
+ }
+ ThemeChanged(pkgPtr);
+ return TCL_OK;
+}
+
+/* + style configure $style -option ?value...
+ */
+static int StyleConfigureCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])
+{
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ const char *styleName;
+ Style *stylePtr;
+ int i;
+
+ if (objc < 3) {
+usage:
+ Tcl_WrongNumArgs(interp,2,objv,"style ?-option ?value...??");
+ return TCL_ERROR;
+ }
+
+ styleName = Tcl_GetString(objv[2]);
+ stylePtr = Ttk_GetStyle(theme, styleName);
+
+ if (objc == 3) { /* style default $styleName */
+ Tcl_SetObjResult(interp, HashTableToDict(&stylePtr->defaultsTable));
+ return TCL_OK;
+ } else if (objc == 4) { /* style default $styleName -option */
+ const char *optionName = Tcl_GetString(objv[3]);
+ Tcl_HashEntry *entryPtr =
+ Tcl_FindHashEntry(&stylePtr->defaultsTable, optionName);
+ if (entryPtr) {
+ Tcl_SetObjResult(interp, (Tcl_Obj*)Tcl_GetHashValue(entryPtr));
+ }
+ return TCL_OK;
+ } else if (objc % 2 != 1) {
+ goto usage;
+ }
+
+ for (i = 3; i < objc; i += 2) {
+ const char *optionName = Tcl_GetString(objv[i]);
+ Tcl_Obj *value = objv[i+1];
+ Tcl_HashEntry *entryPtr;
+ int newEntry;
+
+ entryPtr = Tcl_CreateHashEntry(
+ &stylePtr->defaultsTable,optionName,&newEntry);
+
+ Tcl_IncrRefCount(value);
+ if (!newEntry) {
+ Tcl_DecrRefCount((Tcl_Obj*)Tcl_GetHashValue(entryPtr));
+ }
+ Tcl_SetHashValue(entryPtr, value);
+ }
+
+ ThemeChanged(pkgPtr);
+ return TCL_OK;
+}
+
+/* + style lookup $style -option ?statespec? ?defaultValue?
+ */
+static int StyleLookupCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ Ttk_Style style = NULL;
+ const char *optionName;
+ Ttk_State state = 0ul;
+ Tcl_Obj *result;
+
+ if (objc < 4 || objc > 6) {
+ Tcl_WrongNumArgs(interp, 2, objv, "style -option ?state? ?default?");
+ return TCL_ERROR;
+ }
+
+ style = Ttk_GetStyle(theme, Tcl_GetString(objv[2]));
+ if (!style) {
+ return TCL_ERROR;
+ }
+ optionName = Tcl_GetString(objv[3]);
+
+ if (objc >= 5) {
+ Ttk_StateSpec stateSpec;
+ /* @@@ SB: Ttk_GetStateFromObj(); 'offbits' spec is ignored */
+ if (Ttk_GetStateSpecFromObj(interp, objv[4], &stateSpec) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ state = stateSpec.onbits;
+ }
+
+ result = Ttk_QueryStyle(style, NULL,NULL, optionName, state);
+ if (result == NULL && objc >= 6) { /* Use caller-supplied fallback */
+ result = objv[5];
+ }
+
+ if (result) {
+ Tcl_SetObjResult(interp, result);
+ }
+
+ return TCL_OK;
+}
+
+/* + style theme create name ?-parent $theme? ?-settings { script }?
+ */
+static int StyleThemeCreateCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])
+{
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+ static const char *optStrings[] =
+ { "-parent", "-settings", NULL };
+ enum { OP_PARENT, OP_SETTINGS };
+ Ttk_Theme parentTheme = pkgPtr->defaultTheme, newTheme;
+ Tcl_Obj *settingsScript = NULL;
+ const char *themeName;
+ int i;
+
+ if (objc < 4 || objc % 2 != 0) {
+ Tcl_WrongNumArgs(interp, 3, objv, "name ?options?");
+ return TCL_ERROR;
+ }
+
+ themeName = Tcl_GetString(objv[3]);
+
+ for (i=4; i < objc; i +=2) {
+ int option;
+ if (Tcl_GetIndexFromObj(
+ interp, objv[i], optStrings, "option", 0, &option) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ switch (option) {
+ case OP_PARENT:
+ parentTheme = LookupTheme(
+ interp, pkgPtr, Tcl_GetString(objv[i+1]));
+ if (!parentTheme)
+ return TCL_ERROR;
+ break;
+ case OP_SETTINGS:
+ settingsScript = objv[i+1];
+ break;
+ }
+ }
+
+ newTheme = Ttk_CreateTheme(interp, themeName, parentTheme);
+ if (!newTheme) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Evaluate the -settings script, if supplied:
+ */
+ if (settingsScript) {
+ Ttk_Theme oldTheme = pkgPtr->currentTheme;
+ int status;
+
+ pkgPtr->currentTheme = newTheme;
+ status = Tcl_EvalObjEx(interp, settingsScript, 0);
+ pkgPtr->currentTheme = oldTheme;
+ return status;
+ } else {
+ return TCL_OK;
+ }
+}
+
+/* + style theme names --
+ * Return list of registered themes.
+ */
+static int StyleThemeNamesCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])
+{
+ StylePackageData *pkgPtr = clientData;
+ return EnumerateHashTable(interp, &pkgPtr->themeTable);
+}
+
+/* + style theme settings $theme $script
+ *
+ * Temporarily sets the current theme to $themeName,
+ * evaluates $script, then restores the old theme.
+ */
+static int
+StyleThemeSettingsCmd(
+ ClientData clientData, /* Master StylePackageData pointer */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj * CONST objv[]) /* Argument objects */
+{
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+ Ttk_Theme oldTheme = pkgPtr->currentTheme;
+ Ttk_Theme newTheme;
+ int status;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 3, objv, "theme script");
+ return TCL_ERROR;
+ }
+
+ newTheme = LookupTheme(interp, pkgPtr, Tcl_GetString(objv[3]));
+ if (!newTheme)
+ return TCL_ERROR;
+
+ pkgPtr->currentTheme = newTheme;
+ status = Tcl_EvalObjEx(interp, objv[4], 0);
+ pkgPtr->currentTheme = oldTheme;
+
+ return status;
+}
+
+/* + style element create name type ? ...args ?
+ */
+static int StyleElementCreateCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])
+{
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ const char *elementName, *factoryName;
+ Tcl_HashEntry *entryPtr;
+ FactoryRec *recPtr;
+
+ if (objc < 5) {
+ Tcl_WrongNumArgs(interp, 5, objv, "name type ?options...?");
+ return TCL_ERROR;
+ }
+
+ elementName = Tcl_GetString(objv[3]);
+ factoryName = Tcl_GetString(objv[4]);
+
+ entryPtr = Tcl_FindHashEntry(&pkgPtr->factoryTable, factoryName);
+ if (!entryPtr) {
+ Tcl_AppendResult(interp, "No such element type ", factoryName, NULL);
+ return TCL_ERROR;
+ }
+
+ recPtr = (FactoryRec *)Tcl_GetHashValue(entryPtr);
+
+ return recPtr->factory(interp, recPtr->clientData,
+ theme, elementName, objc - 5, objv + 5);
+}
+
+/* + style element names --
+ * Return a list of elements defined in the current theme.
+ */
+static int StyleElementNamesCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])
+{
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, NULL);
+ return TCL_ERROR;
+ }
+ return EnumerateHashTable(interp, &theme->elementTable);
+}
+
+/* + style element options $element --
+ */
+static int StyleElementOptionsCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])
+{
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ Tcl_HashEntry *entryPtr;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "element");
+ return TCL_ERROR;
+ }
+
+ entryPtr = Tcl_FindHashEntry(&theme->elementTable, Tcl_GetString(objv[3]));
+ if (entryPtr) {
+ ElementImpl *elementImpl = (ElementImpl *)Tcl_GetHashValue(entryPtr);
+ Ttk_ElementSpec *specPtr = elementImpl->specPtr;
+ Ttk_ElementOptionSpec *option = specPtr->options;
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+
+ while (option->optionName) {
+ Tcl_ListObjAppendElement(
+ interp, result, Tcl_NewStringObj(option->optionName,-1));
+ ++option;
+ }
+
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp,
+ "element ", Tcl_GetString(objv[3]), " not found",
+ NULL);
+ return TCL_ERROR;
+}
+
+/* + style layout name ?spec?
+ */
+static int StyleLayoutCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])
+{
+ StylePackageData *pkgPtr = (StylePackageData *)clientData;
+ Ttk_Theme theme = pkgPtr->currentTheme;
+ const char *layoutName;
+ Ttk_LayoutTemplate layoutTemplate;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ?spec?");
+ return TCL_ERROR;
+ }
+
+ layoutName = Tcl_GetString(objv[2]);
+
+ if (objc == 3) {
+ layoutTemplate = Ttk_FindLayoutTemplate(theme, layoutName);
+ if (!layoutTemplate) {
+ Tcl_AppendResult(interp, "Layout ", layoutName, " not found", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Ttk_UnparseLayoutTemplate(layoutTemplate));
+ } else {
+ layoutTemplate = Ttk_ParseLayoutTemplate(interp, objv[3]);
+ if (!layoutTemplate) {
+ return TCL_ERROR;
+ }
+ Ttk_RegisterLayoutTemplate(theme, layoutName, layoutTemplate);
+ ThemeChanged(pkgPtr);
+ }
+ return TCL_OK;
+}
+
+/* + style theme use $theme --
+ * Sets the current theme to $theme
+ */
+static int
+StyleThemeUseCmd(
+ ClientData clientData, /* Master StylePackageData pointer */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj * CONST objv[]) /* Argument objects */
+{
+ StylePackageData *pkgPtr = clientData;
+ Ttk_Theme theme;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "theme");
+ return TCL_ERROR;
+ }
+
+ theme = LookupTheme(interp, pkgPtr, Tcl_GetString(objv[3]));
+ if (!theme) {
+ return TCL_ERROR;
+ }
+
+ return Ttk_UseTheme(interp, theme);
+}
+
+/*
+ * StyleObjCmd --
+ * Implementation of the [style] command.
+ */
+
+struct Ensemble {
+ const char *name; /* subcommand name */
+ Tcl_ObjCmdProc *command; /* subcommand implementation, OR: */
+ struct Ensemble *ensemble; /* subcommand ensemble */
+};
+
+struct Ensemble StyleThemeEnsemble[] = {
+ { "create", StyleThemeCreateCmd, 0 },
+ { "names", StyleThemeNamesCmd, 0 },
+ { "settings", StyleThemeSettingsCmd, 0 },
+ { "use", StyleThemeUseCmd, 0 },
+ { NULL, 0, 0 }
+};
+
+struct Ensemble StyleElementEnsemble[] = {
+ { "create", StyleElementCreateCmd, 0 },
+ { "names", StyleElementNamesCmd, 0 },
+ { "options", StyleElementOptionsCmd, 0 },
+ { NULL, 0, 0 }
+};
+
+struct Ensemble StyleEnsemble[] = {
+ { "configure", StyleConfigureCmd, 0 },
+ { "map", StyleMapCmd, 0 },
+ { "lookup", StyleLookupCmd, 0 },
+ { "layout", StyleLayoutCmd, 0 },
+ { "theme", 0, StyleThemeEnsemble },
+ { "element", 0, StyleElementEnsemble },
+
+ { "default", StyleConfigureCmd, 0 }, /* TEMP: for pre-0.7 compatibility */
+ { NULL, 0, 0 }
+};
+
+static int
+StyleObjCmd(
+ ClientData clientData, /* Master StylePackageData pointer */
+ Tcl_Interp *interp, /* Current interpreter */
+ int objc, /* Number of arguments */
+ Tcl_Obj * CONST objv[]) /* Argument objects */
+{
+ struct Ensemble *ensemble = StyleEnsemble;
+ int optPtr = 1;
+ int index;
+
+ while (optPtr < objc) {
+ if (Tcl_GetIndexFromObjStruct(interp,
+ objv[optPtr], ensemble, sizeof(ensemble[0]),
+ "command", 0, &index)
+ != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ if (ensemble[index].command) {
+ return ensemble[index].command(clientData, interp, objc, objv);
+ }
+ ensemble = ensemble[index].ensemble;
+ ++optPtr;
+ }
+ Tcl_WrongNumArgs(interp, optPtr, objv, "option ?arg arg...?");
+ return TCL_ERROR;
+}
+
+/*
+ * Ttk_StylePkgInit --
+ * Initializes all the structures that are used by the style
+ * package on a per-interp basis.
+ */
+
+void Ttk_StylePkgInit(Tcl_Interp *interp)
+{
+ Tcl_Namespace *nsPtr;
+
+ StylePackageData *pkgPtr = (StylePackageData *)
+ ckalloc(sizeof(StylePackageData));
+
+ pkgPtr->interp = interp;
+ Tcl_InitHashTable(&pkgPtr->themeTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&pkgPtr->factoryTable, TCL_STRING_KEYS);
+ pkgPtr->cleanupList = NULL;
+ pkgPtr->cache = Ttk_CreateResourceCache(interp);
+ pkgPtr->themeChangePending = 0;
+
+ Tcl_SetAssocData(interp, "StylePackage", Ttk_StylePkgFree,
+ (ClientData)pkgPtr);
+
+ /*
+ * Create the default system theme:
+ *
+ * pkgPtr->defaultTheme must be initialized to 0 before
+ * calling Ttk_CreateTheme for the first time, since it's used
+ * as the parent theme.
+ */
+ pkgPtr->defaultTheme = 0;
+ pkgPtr->defaultTheme = pkgPtr->currentTheme =
+ Ttk_CreateTheme(interp, "default", NULL);
+
+ /*
+ * Register null element, used as a last-resort fallback:
+ */
+ Ttk_RegisterElement(interp, pkgPtr->defaultTheme, "", &NullElementSpec, 0);
+
+ /*
+ * Register commands:
+ */
+ Tcl_CreateObjCommand(interp, "::ttk::style", StyleObjCmd,
+ (ClientData)pkgPtr, 0);
+
+ nsPtr = Tcl_FindNamespace(interp, "::ttk", (Tcl_Namespace *) NULL,
+ TCL_LEAVE_ERR_MSG);
+ Tcl_Export(interp, nsPtr, "style", 0 /* dontResetList */);
+
+ Ttk_RegisterElementFactory(interp, "from", Ttk_CloneElement, 0);
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkTheme.h b/generic/ttk/ttkTheme.h
new file mode 100644
index 0000000..2bdba70
--- /dev/null
+++ b/generic/ttk/ttkTheme.h
@@ -0,0 +1,409 @@
+/*
+ * ttkTheme.h --
+ * Declarations for Tk style engine.
+ *
+ * Copyright (c) 2003 Joe English. Freely redistributable.
+ *
+ * $Id: ttkTheme.h,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ */
+
+#ifndef TKTHEME_H
+#define TKTHEME_H 1
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if defined(BUILD_ttk)
+# define TTKAPI DLLEXPORT
+# undef USE_TTK_STUBS
+#else
+# define TTKAPI DLLIMPORT
+#endif
+
+/* Ttk syncs to the Tk version & patchlevel */
+#define TTK_VERSION TK_VERSION
+#define TTK_PATCH_LEVEL TK_PATCH_LEVEL
+
+/*
+ * Statically branched from tile 0.7.8.
+ */
+#ifdef TTK_DEFINE_TILE
+#define TILE_VERSION "0.7.8"
+#define TILE_PATCH_LEVEL TILE_VERSION
+#endif
+
+/*------------------------------------------------------------------------
+ * +++ 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_USER7 (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_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.
+ */
+extern void Ttk_StylePkgInit(Tcl_Interp *);
+
+typedef struct Ttk_Theme_ *Ttk_Theme;
+typedef struct Ttk_ElementImpl_ *Ttk_Element;
+typedef struct Ttk_Layout_ *Ttk_Layout;
+typedef struct Ttk_LayoutNode_ Ttk_LayoutNode;
+
+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);
+extern void Ttk_SetThemeEnabledProc(Ttk_Theme, Ttk_ThemeEnabledProc, void *);
+
+extern 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
+{
+ 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 */
+ 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_Element 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;
+
+extern void NullElementGeometry
+ (void *, void *, Tk_Window, int *, int *, Ttk_Padding *);
+extern void NullElementDraw
+ (void *, void *, Tk_Window, Drawable, Ttk_Box, Ttk_State);
+extern Ttk_ElementOptionSpec NullElementOptions[];
+extern Ttk_ElementSpec NullElementSpec;
+
+/*------------------------------------------------------------------------
+ * +++ Layout templates.
+ */
+typedef struct {
+ const char * elementName;
+ unsigned opcode;
+} TTKLayoutInstruction, *Ttk_LayoutSpec;
+
+#define TTK_BEGIN_LAYOUT(name) static TTKLayoutInstruction name[] = {
+#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 { 0, TTK_LAYOUT_END } };
+
+TTKAPI void Ttk_RegisterLayout(
+ Ttk_Theme theme, const char *className, Ttk_LayoutSpec layoutSpec);
+
+/*------------------------------------------------------------------------
+ * +++ Layout instances.
+ */
+
+extern Ttk_Layout Ttk_CreateLayout(
+ Tcl_Interp *, Ttk_Theme, const char *name,
+ void *recordPtr, Tk_OptionTable, Tk_Window tkwin);
+
+extern Ttk_Layout Ttk_CreateSublayout(
+ Tcl_Interp *, Ttk_Theme, Ttk_Layout, const char *name, Tk_OptionTable);
+
+extern void Ttk_FreeLayout(Ttk_Layout);
+
+extern void Ttk_LayoutSize(Ttk_Layout,Ttk_State,int *widthPtr,int *heightPtr);
+extern void Ttk_PlaceLayout(Ttk_Layout, Ttk_State, Ttk_Box);
+extern void Ttk_DrawLayout(Ttk_Layout, Ttk_State, Drawable);
+
+extern void Ttk_RebindSublayout(Ttk_Layout, void *recordPtr);
+
+extern Ttk_LayoutNode *Ttk_LayoutIdentify(Ttk_Layout, int x, int y);
+extern Ttk_LayoutNode *Ttk_LayoutFindNode(Ttk_Layout, const char *nodeName);
+
+extern const char *Ttk_LayoutNodeName(Ttk_LayoutNode *);
+extern Ttk_Box Ttk_LayoutNodeParcel(Ttk_LayoutNode *);
+extern Ttk_Box Ttk_LayoutNodeInternalParcel(Ttk_Layout,Ttk_LayoutNode *);
+extern Ttk_Padding Ttk_LayoutNodeInternalPadding(Ttk_Layout,Ttk_LayoutNode *);
+extern void Ttk_LayoutNodeReqSize(Ttk_Layout, Ttk_LayoutNode *, int *w, int *h);
+
+extern void Ttk_LayoutNodeSetParcel(Ttk_LayoutNode *node, Ttk_Box parcel);
+extern void Ttk_PlaceLayoutNode(Ttk_Layout,Ttk_LayoutNode *, Ttk_Box);
+extern void Ttk_ChangeElementState(Ttk_LayoutNode *,unsigned set,unsigned clr);
+
+extern Tcl_Obj *Ttk_QueryOption(Ttk_Layout, const char *, Ttk_State);
+
+/*------------------------------------------------------------------------
+ * +++ Resource cache.
+ * See resource.c for explanation.
+ */
+
+typedef struct Ttk_ResourceCache_ *Ttk_ResourceCache;
+extern Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *);
+extern void Ttk_FreeResourceCache(Ttk_ResourceCache);
+
+extern Ttk_ResourceCache Ttk_GetResourceCache(Tcl_Interp*);
+extern Tcl_Obj *Ttk_UseFont(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+extern Tcl_Obj *Ttk_UseColor(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+extern Tcl_Obj *Ttk_UseBorder(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+extern Tk_Image Ttk_UseImage(Ttk_ResourceCache, Tk_Window, Tcl_Obj *);
+
+extern void Ttk_RegisterNamedColor(Ttk_ResourceCache, const char *, XColor *);
+
+/*------------------------------------------------------------------------
+ * +++ 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;
+
+extern 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;
+
+extern int Ttk_GetCompoundFromObj(Tcl_Interp *, Tcl_Obj *, int *);
+
+typedef enum { /* -orient option values */
+ TTK_ORIENT_HORIZONTAL,
+ TTK_ORIENT_VERTICAL
+} Ttk_Orient;
+
+/*------------------------------------------------------------------------
+ * +++ 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;
+extern void ArrowSize(int h, ArrowDirection, int *widthPtr, int *heightPtr);
+extern void DrawArrow(Display *, Drawable, GC, Ttk_Box, ArrowDirection);
+extern void FillArrow(Display *, Drawable, GC, Ttk_Box, ArrowDirection);
+
+#ifdef __cplusplus
+}
+#endif
+#endif /* TKTHEME_H */
diff --git a/generic/ttk/ttkThemeInt.h b/generic/ttk/ttkThemeInt.h
new file mode 100644
index 0000000..065dd44
--- /dev/null
+++ b/generic/ttk/ttkThemeInt.h
@@ -0,0 +1,43 @@
+/*
+ * $Id: ttkThemeInt.h,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * Theme engine: private definitions.
+ *
+ * Copyright (c) 2004 Joe English. Freely redistributable.
+ */
+
+#ifndef TKTHEMEINT_INCLUDED
+#define TKTHEMEINT_INCLUDED 1
+
+#include "ttkTheme.h"
+
+typedef struct Ttk_Style_ *Ttk_Style;
+typedef struct Ttk_TemplateNode_ Ttk_TemplateNode, *Ttk_LayoutTemplate;
+
+extern Ttk_Element Ttk_GetElement(Ttk_Theme theme, const char *name);
+extern const char *Ttk_ElementName(Ttk_Element);
+
+extern void Ttk_ElementSize(
+ Ttk_Element element, Ttk_Style, char *recordPtr, Tk_OptionTable,
+ Tk_Window tkwin, Ttk_State state,
+ int *widthPtr, int *heightPtr, Ttk_Padding*);
+extern void Ttk_DrawElement(
+ Ttk_Element element, Ttk_Style, char *recordPtr, Tk_OptionTable,
+ Tk_Window tkwin, Drawable d, Ttk_Box b, Ttk_State state);
+
+extern Tcl_Obj *Ttk_QueryStyle(
+ Ttk_Style, void *, Tk_OptionTable, const char *, Ttk_State state);
+
+extern Ttk_LayoutTemplate Ttk_ParseLayoutTemplate(Tcl_Interp *, Tcl_Obj *);
+extern Tcl_Obj *Ttk_UnparseLayoutTemplate(Ttk_LayoutTemplate);
+extern Ttk_LayoutTemplate Ttk_BuildLayoutTemplate(Ttk_LayoutSpec);
+extern void Ttk_FreeLayoutTemplate(Ttk_LayoutTemplate);
+
+extern Ttk_Style Ttk_GetStyle(Ttk_Theme themePtr, const char *styleName);
+extern Ttk_LayoutTemplate Ttk_FindLayoutTemplate(
+ Ttk_Theme themePtr, const char *layoutName);
+
+extern const char *Ttk_StyleName(Ttk_Style);
+
+
+#endif /* TKTHEMEINT_INCLUDED */
diff --git a/generic/ttk/ttkTrace.c b/generic/ttk/ttkTrace.c
new file mode 100644
index 0000000..37a319b
--- /dev/null
+++ b/generic/ttk/ttkTrace.c
@@ -0,0 +1,145 @@
+/* $Id: ttkTrace.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ *
+ * 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) {
+ Tcl_TraceVar(interp, name,
+ 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 = (Ttk_TraceHandle*)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_TraceVar(interp, Tcl_GetString(varnameObj),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ VarTraceProc, (ClientData)h);
+
+ if (status != TCL_OK) {
+ Tcl_DecrRefCount(h->varnameObj);
+ ckfree((ClientData)h);
+ return NULL;
+ }
+
+ return h;
+}
+
+/*
+ * Ttk_UntraceVariable --
+ * Remove previously-registered trace and free the handle.
+ */
+void Ttk_UntraceVariable(Ttk_TraceHandle *h)
+{
+ if (h) {
+ Tcl_UntraceVar(h->interp, Tcl_GetString(h->varnameObj),
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ VarTraceProc, (ClientData)h);
+ Tcl_DecrRefCount(h->varnameObj);
+ ckfree((ClientData)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*/
diff --git a/generic/ttk/ttkTrack.c b/generic/ttk/ttkTrack.c
new file mode 100644
index 0000000..4a6337e
--- /dev/null
+++ b/generic/ttk/ttkTrack.c
@@ -0,0 +1,175 @@
+/* $Id: ttkTrack.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Copyright (c) 2004, Joe English
+ *
+ * TrackElementState() -- helper routine for widgets
+ * like scrollbars in which individual elements may
+ * be active or pressed instead of the widget as a whole.
+ *
+ * Usage:
+ * TrackElementState(&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>)
+ * TODO: Deal with grabs -- possible to get a Press event w/no corresponding Release.
+ *
+ */
+
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+typedef struct
+{
+ WidgetCore *corePtr; /* Widget to track */
+ Ttk_LayoutNode *activeElement; /* element under the mouse cursor */
+ Ttk_LayoutNode *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_LayoutNode *node)
+{
+ if (es->activeElement == node) {
+ /* No change */
+ return;
+ }
+
+ if (!es->pressedElement) {
+ if (es->activeElement) {
+ /* Deactivate old element */
+ Ttk_ChangeElementState(es->activeElement, 0,TTK_STATE_ACTIVE);
+ }
+ if (node) {
+ /* Activate new element */
+ Ttk_ChangeElementState(node, TTK_STATE_ACTIVE,0);
+ }
+ TtkRedisplayWidget(es->corePtr);
+ }
+
+ es->activeElement = node;
+}
+
+/* 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_LayoutNode *node)
+{
+ if (es->pressedElement) {
+ ReleaseElement(es);
+ }
+
+ if (node) {
+ Ttk_ChangeElementState(
+ node, TTK_STATE_PRESSED|TTK_STATE_ACTIVE, 0);
+ }
+
+ es->pressedElement = node;
+ 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 = (ElementStateTracker *)clientData;
+ Ttk_LayoutNode *node;
+
+ switch (ev->type)
+ {
+ case MotionNotify :
+ node = Ttk_LayoutIdentify(
+ es->corePtr->layout,ev->xmotion.x,ev->xmotion.y);
+ ActivateElement(es, node);
+ break;
+ case LeaveNotify:
+ ActivateElement(es, 0);
+ break;
+ case EnterNotify:
+ node = Ttk_LayoutIdentify(
+ es->corePtr->layout,ev->xcrossing.x,ev->xcrossing.y);
+ ActivateElement(es, node);
+ break;
+ case ButtonPress:
+ node = Ttk_LayoutIdentify(
+ es->corePtr->layout, ev->xbutton.x, ev->xbutton.y);
+ if (node)
+ PressElement(es, node);
+ 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)es);
+ break;
+ }
+}
+
+/*
+ * TrackElementState --
+ * Register an event handler to manage the 'pressed'
+ * and 'active' states of individual widget elements.
+ */
+
+void TrackElementState(WidgetCore *corePtr)
+{
+ ElementStateTracker *es = (ElementStateTracker*)ckalloc(sizeof(*es));
+ es->corePtr = corePtr;
+ es->activeElement = es->pressedElement = 0;
+ Tk_CreateEventHandler(corePtr->tkwin,
+ ElementStateMask,ElementStateEventProc,es);
+}
+
+
diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c
new file mode 100644
index 0000000..4038a5d
--- /dev/null
+++ b/generic/ttk/ttkTreeview.c
@@ -0,0 +1,2973 @@
+/*
+ * $Id: ttkTreeview.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Copyright (c) 2004, Joe English
+ *
+ * Ttk widget set: treeview widget.
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+#define DEF_TREE_ROWS "10"
+#define DEF_TREE_PADDING "4"
+#define DEF_COLWIDTH "200"
+
+static const int ROWHEIGHT = 24;
+static const int HEADINGHEIGHT = 24;
+static const int INDENT = 24;
+static const int HALO = 4; /* separator */
+
+#define TTK_STATE_OPEN TTK_STATE_USER1
+#define TTK_STATE_LEAF TTK_STATE_USER2
+
+#define STATE_CHANGED (0x100) /* item state option changed */
+
+/*------------------------------------------------------------------------
+ * +++ Tree items.
+ *
+ * INVARIANTS:
+ * item->children ==> item->children->parent == item
+ * item->next ==> item->next->parent == item->parent
+ * item->next ==> item->next->prev == item
+ * item->prev ==> item->prev->next == item
+ */
+
+typedef struct TreeItemRec TreeItem;
+struct TreeItemRec
+{
+ Tcl_HashEntry *entryPtr; /* Back-pointer to hash table entry */
+ TreeItem *parent; /* Parent item */
+ TreeItem *children; /* Linked list of child items */
+ TreeItem *next; /* Next sibling */
+ TreeItem *prev; /* Previous sibling */
+
+ /*
+ * Options and instance data:
+ */
+ Ttk_State state;
+ Tcl_Obj *textObj;
+ Tcl_Obj *imageObj;
+ Tcl_Obj *valuesObj;
+ Tcl_Obj *openObj;
+ Tcl_Obj *tagsObj;
+};
+
+static Tk_OptionSpec ItemOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ "", Tk_Offset(TreeItem,textObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ NULL, Tk_Offset(TreeItem,imageObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_STRING, "-values", "values", "Values",
+ NULL, Tk_Offset(TreeItem,valuesObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_BOOLEAN, "-open", "open", "Open",
+ "0", Tk_Offset(TreeItem,openObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-tags", "tags", "Tags",
+ NULL, Tk_Offset(TreeItem,tagsObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+/* + NewItem --
+ * Allocate a new, uninitialized, unlinked item
+ */
+static TreeItem *NewItem(void)
+{
+ TreeItem *item = (TreeItem*)ckalloc(sizeof(*item));
+
+ item->entryPtr = 0;
+ item->parent = item->children = item->next = item->prev = NULL;
+
+ item->state = 0ul;
+ item->textObj = NULL;
+ item->imageObj = NULL;
+ item->valuesObj = NULL;
+ item->openObj = NULL;
+ item->tagsObj = NULL;
+
+ return item;
+}
+
+/* + FreeItem --
+ * Destroy an item
+ */
+static void FreeItem(TreeItem *item)
+{
+ if (item->textObj) { Tcl_DecrRefCount(item->textObj); }
+ if (item->imageObj) { Tcl_DecrRefCount(item->imageObj); }
+ if (item->valuesObj) { Tcl_DecrRefCount(item->valuesObj); }
+ if (item->openObj) { Tcl_DecrRefCount(item->openObj); }
+ if (item->tagsObj) { Tcl_DecrRefCount(item->tagsObj); }
+ ckfree((ClientData)item);
+}
+
+static void FreeItemCB(void *clientData) { FreeItem(clientData); }
+
+/* + DetachItem --
+ * Unlink an item from the tree.
+ */
+static void DetachItem(TreeItem *item)
+{
+ if (item->parent && item->parent->children == item)
+ item->parent->children = item->next;
+ if (item->prev)
+ item->prev->next = item->next;
+ if (item->next)
+ item->next->prev = item->prev;
+ item->next = item->prev = item->parent = NULL;
+}
+
+/* + InsertItem --
+ * Insert an item into the tree after the specified item.
+ *
+ * Preconditions:
+ * + item is currently detached
+ * + prev != NULL ==> prev->parent == parent.
+ */
+static void InsertItem(TreeItem *parent, TreeItem *prev, TreeItem *item)
+{
+ item->parent = parent;
+ item->prev = prev;
+ if (prev) {
+ item->next = prev->next;
+ prev->next = item;
+ } else {
+ item->next = parent->children;
+ parent->children = item;
+ }
+ if (item->next) {
+ item->next->prev = item;
+ }
+}
+
+/* + NextPreorder --
+ * Return the next item in preorder traversal order.
+ */
+
+static TreeItem *NextPreorder(TreeItem *item)
+{
+ if (item->children)
+ return item->children;
+ while (!item->next) {
+ item = item->parent;
+ if (!item)
+ return 0;
+ }
+ return item->next;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Display items and tag options.
+ */
+
+typedef struct {
+ Tcl_Obj *textObj; /* taken from item / data cell */
+ Tcl_Obj *imageObj; /* taken from item */
+ Tcl_Obj *anchorObj; /* from column */
+ Tcl_Obj *backgroundObj; /* remainder from tag */
+ Tcl_Obj *foregroundObj;
+ Tcl_Obj *fontObj;
+} DisplayItem;
+
+static Tk_OptionSpec TagOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ NULL, Tk_Offset(DisplayItem,textObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ NULL, Tk_Offset(DisplayItem,imageObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ NULL, Tk_Offset(DisplayItem,anchorObj), -1,
+ TK_OPTION_NULL_OK, 0, GEOMETRY_CHANGED},
+ {TK_OPTION_COLOR, "-background", "windowColor", "WindowColor",
+ NULL, Tk_Offset(DisplayItem,backgroundObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_COLOR, "-foreground", "textColor", "TextColor",
+ NULL, Tk_Offset(DisplayItem,foregroundObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ NULL, Tk_Offset(DisplayItem,fontObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+
+
+/*------------------------------------------------------------------------
+ * +++ Columns.
+ *
+ * There are separate option tables associated with the column record:
+ * ColumnOptionSpecs is for configuring the column,
+ * and HeadingOptionSpecs is for drawing headings.
+ */
+typedef struct {
+ int width; /* Column width, in pixels */
+ Tcl_Obj *idObj; /* Column identifier, from -columns option */
+
+ Tcl_Obj *anchorObj; /* -anchor for cell data */
+
+ /* Column heading data:
+ */
+ Tcl_Obj *headingObj; /* Heading label */
+ Tcl_Obj *headingImageObj; /* Heading image */
+ Tcl_Obj *headingAnchorObj; /* -anchor for heading label */
+ Tcl_Obj *headingCommandObj; /* Command to execute */
+ Tcl_Obj *headingStateObj; /* @@@ testing ... */
+ Ttk_State headingState; /* ... */
+
+ /* Temporary storage for cell data
+ */
+ Tcl_Obj *data;
+} TreeColumn;
+
+static void InitColumn(TreeColumn *column)
+{
+ column->width = 200;
+ column->idObj = 0;
+ column->anchorObj = 0;
+
+ column->headingState = 0;
+ column->headingObj = 0;
+ column->headingImageObj = 0;
+ column->headingAnchorObj = 0;
+ column->headingStateObj = 0;
+ column->headingCommandObj = 0;
+
+ column->data = 0;
+}
+
+static void FreeColumn(TreeColumn *column) /* @@@ rename */
+{
+ if (column->idObj) { Tcl_DecrRefCount(column->idObj); }
+ if (column->anchorObj) { Tcl_DecrRefCount(column->anchorObj); }
+
+ if (column->headingObj) { Tcl_DecrRefCount(column->headingObj); }
+ if (column->headingImageObj) { Tcl_DecrRefCount(column->headingImageObj); }
+ if (column->headingAnchorObj) { Tcl_DecrRefCount(column->headingAnchorObj); }
+ if (column->headingStateObj) { Tcl_DecrRefCount(column->headingStateObj); }
+ if (column->headingCommandObj) { Tcl_DecrRefCount(column->headingCommandObj); }
+
+ /* Don't touch column->data, it's scratch storage */
+}
+
+static Tk_OptionSpec ColumnOptionSpecs[] =
+{
+ {TK_OPTION_INT, "-width", "width", "Width",
+ DEF_COLWIDTH, -1, Tk_Offset(TreeColumn,width),
+ 0,0,GEOMETRY_CHANGED },
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ "w", Tk_Offset(TreeColumn,anchorObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-id", "id", "ID",
+ NULL, Tk_Offset(TreeColumn,idObj), -1,
+ TK_OPTION_NULL_OK,0,READONLY_OPTION },
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+static Tk_OptionSpec HeadingOptionSpecs[] =
+{
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ "", Tk_Offset(TreeColumn,headingObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ "", Tk_Offset(TreeColumn,headingImageObj), -1,
+ 0,0,0 },
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ "center", Tk_Offset(TreeColumn,headingAnchorObj), -1,
+ 0,0,0 },
+ {TK_OPTION_STRING, "-command", "", "",
+ "", Tk_Offset(TreeColumn,headingCommandObj), -1,
+ TK_OPTION_NULL_OK,0,0 },
+ {TK_OPTION_STRING, "state", "", "",
+ "", Tk_Offset(TreeColumn,headingStateObj), -1,
+ 0,0,STATE_CHANGED },
+ {TK_OPTION_END, 0,0,0, NULL, -1,-1, 0,0,0}
+};
+
+/*------------------------------------------------------------------------
+ * +++ -show option:
+ * TODO: Implement SHOW_BRANCHES.
+ */
+
+#define SHOW_TREE (0x1) /* Show tree column? */
+#define SHOW_HEADINGS (0x2) /* Show heading row? */
+
+#define DEFAULT_SHOW "tree headings"
+
+static const char *showStrings[] = {
+ "tree", "headings", NULL
+};
+
+static int GetEnumSetFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ const char *table[],
+ unsigned *resultPtr)
+{
+ unsigned result = 0;
+ int i, objc;
+ Tcl_Obj **objv;
+
+ if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK)
+ return TCL_ERROR;
+
+ for (i = 0; i < objc; ++i) {
+ int index;
+ if (TCL_OK != Tcl_GetIndexFromObj(
+ interp, objv[i], table, "value", TCL_EXACT, &index))
+ {
+ return TCL_ERROR;
+ }
+ result |= (1 << index);
+ }
+
+ *resultPtr = result;
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Treeview widget record.
+ *
+ * Dependencies:
+ * columns, columnNames: -columns
+ * displayColumns: -columns, -displaycolumns
+ */
+typedef struct
+{
+ /* Resources acquired at initialization-time:
+ */
+ Tk_OptionTable itemOptionTable;
+ Tk_OptionTable columnOptionTable;
+ Tk_OptionTable headingOptionTable;
+ Tk_OptionTable tagOptionTable;
+ Tk_BindingTable bindingTable;
+ Ttk_TagTable tagTable;
+
+ /* Acquired in GetLayout hook:
+ */
+ Ttk_Layout itemLayout;
+ Ttk_Layout cellLayout;
+ Ttk_Layout headingLayout;
+ Ttk_Layout rowLayout;
+
+ /* Tree data:
+ */
+ Tcl_HashTable items; /* Map: item name -> item */
+ int serial; /* Next item # for autogenerated names */
+ TreeItem *root; /* Root item */
+
+ TreeColumn column0; /* Column options for display column #0 */
+ TreeColumn *columns; /* Array of column options for data columns */
+
+ TreeItem *focus; /* Current focus item */
+
+ /* Widget options:
+ */
+ Tcl_Obj *columnsObj; /* List of symbolic column names */
+ Tcl_Obj *displayColumnsObj; /* List of columns to display */
+
+ Tcl_Obj *heightObj; /* height (rows) */
+ Tcl_Obj *paddingObj; /* internal padding */
+
+ Tcl_Obj *showObj; /* -show list */
+ Tcl_Obj *selectModeObj; /* -selectmode option */
+
+ Scrollable yscroll;
+ ScrollHandle yscrollHandle;
+
+ /* Derived resources:
+ */
+ Tcl_HashTable columnNames; /* Map: column name -> column index */
+ int nColumns; /* #columns */
+ unsigned showFlags; /* bitmask of subparts to display */
+
+ TreeColumn **displayColumns; /* List of columns for display (incl tree) */
+ int nDisplayColumns; /* #display columns */
+ Ttk_Box headingArea; /* Display area for column headings */
+ Ttk_Box treeArea; /* Display area for tree */
+
+} TreePart;
+
+typedef struct {
+ WidgetCore core;
+ TreePart tree;
+} Treeview;
+
+#define USER_MASK 0x0100
+#define COLUMNS_CHANGED (USER_MASK)
+#define DCOLUMNS_CHANGED (USER_MASK<<1)
+#define SCROLLCMD_CHANGED (USER_MASK<<2)
+#define SHOW_CHANGED (USER_MASK<<3)
+
+static const char *SelectModeStrings[] = { "none", "browse", "extended", NULL };
+
+static Tk_OptionSpec TreeviewOptionSpecs[] =
+{
+ WIDGET_TAKES_FOCUS,
+
+ {TK_OPTION_STRING, "-columns", "columns", "Columns",
+ "", Tk_Offset(Treeview,tree.columnsObj), -1,
+ 0,0,COLUMNS_CHANGED | GEOMETRY_CHANGED /*| READONLY_OPTION*/ },
+ {TK_OPTION_STRING, "-displaycolumns","displayColumns","DisplayColumns",
+ "", Tk_Offset(Treeview,tree.displayColumnsObj), -1,
+ 0,0,DCOLUMNS_CHANGED | GEOMETRY_CHANGED },
+ {TK_OPTION_STRING, "-show", "show", "Show",
+ DEFAULT_SHOW, Tk_Offset(Treeview,tree.showObj), -1,
+ 0,0,SHOW_CHANGED | GEOMETRY_CHANGED },
+
+ {TK_OPTION_STRING_TABLE, "-selectmode", "selectMode", "SelectMode",
+ "extended", Tk_Offset(Treeview,tree.selectModeObj), -1,
+ 0,(ClientData)SelectModeStrings,0 },
+
+ {TK_OPTION_PIXELS, "-height", "height", "Height",
+ DEF_TREE_ROWS, Tk_Offset(Treeview,tree.heightObj), -1,
+ 0,0,GEOMETRY_CHANGED},
+ {TK_OPTION_STRING, "-padding", "padding", "Pad",
+ DEF_TREE_PADDING, Tk_Offset(Treeview,tree.paddingObj), -1,
+ TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED },
+
+ {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ NULL, -1, Tk_Offset(Treeview, tree.yscroll.scrollCmd),
+ TK_OPTION_NULL_OK, 0, SCROLLCMD_CHANGED},
+
+ WIDGET_INHERIT_OPTIONS(CoreOptionSpecs)
+};
+
+/*------------------------------------------------------------------------
+ * +++ Utilities.
+ */
+typedef void (*HashEntryIterator)(void *hashValue);
+
+static void foreachHashEntry(Tcl_HashTable *ht, HashEntryIterator func)
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(ht, &search);
+ while (entryPtr != NULL) {
+ func(Tcl_GetHashValue(entryPtr));
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+}
+
+/* + unshare(objPtr) --
+ * Ensure that a Tcl_Obj * has refcount 1 -- either return objPtr
+ * itself, or a duplicated copy.
+ */
+static Tcl_Obj *unshare(Tcl_Obj *objPtr)
+{
+ if (Tcl_IsShared(objPtr)) {
+ Tcl_Obj *newObj = Tcl_DuplicateObj(objPtr);
+ Tcl_DecrRefCount(objPtr);
+ Tcl_IncrRefCount(newObj);
+ return newObj;
+ }
+ return objPtr;
+}
+
+/* DisplayLayout --
+ * Rebind, place, and draw a layout + object combination.
+ */
+static void DisplayLayout(
+ Ttk_Layout layout, void *recordPtr, Ttk_State state, Ttk_Box b, Drawable d)
+{
+ Ttk_RebindSublayout(layout, recordPtr);
+ Ttk_PlaceLayout(layout, state, b);
+ Ttk_DrawLayout(layout, state, d);
+}
+
+/* + ColumnIndex --
+ * Maps column identifier to column index.
+ * Returns: -1 if not found, column index otherwise.
+ * Leaves an error message in interp->result on error.
+ *
+ * Column IDs may be specified by name or as a number.
+ */
+static int ColumnIndex(Tcl_Interp *interp, Treeview *tv, Tcl_Obj *columnIDObj)
+{
+ Tcl_HashEntry *entryPtr;
+ int columnIndex;
+
+ /* Check for named column:
+ */
+ entryPtr = Tcl_FindHashEntry(
+ &tv->tree.columnNames, Tcl_GetString(columnIDObj));
+ if (entryPtr) {
+ return (int)Tcl_GetHashValue(entryPtr);
+ }
+
+ /* Check for number:
+ */
+ if (Tcl_GetIntFromObj(NULL, columnIDObj, &columnIndex) == TCL_OK) {
+ if (columnIndex < 0 || columnIndex >= tv->tree.nColumns) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "Column index ",
+ Tcl_GetString(columnIDObj),
+ " out of bounds",
+ NULL);
+ return -1;
+ }
+
+ return columnIndex;
+ }
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "Invalid column index ", Tcl_GetString(columnIDObj),
+ NULL);
+ return -1;
+}
+
+/* + FindItem --
+ * Locates the item with the specified identifier in the tree.
+ * If there is no such item, leaves an error message in interp.
+ */
+static TreeItem *FindItem(
+ Tcl_Interp *interp, Treeview *tv, Tcl_Obj *itemNameObj)
+{
+ const char *itemName = Tcl_GetString(itemNameObj);
+ Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tv->tree.items, itemName);
+
+ if (!entryPtr) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Item ", itemName, " not found", NULL);
+ return 0;
+ }
+ return (TreeItem*)Tcl_GetHashValue(entryPtr);
+}
+
+/* + GetItemListFromObj --
+ * Parse a Tcl_Obj * as a list of items.
+ * Returns a NULL-terminated array of items; result must
+ * be ckfree()d. On error, returns NULL and leaves an error
+ * message in interp.
+ */
+
+static TreeItem **GetItemListFromObj(
+ Tcl_Interp *interp, Treeview *tv, Tcl_Obj *objPtr)
+{
+ TreeItem **items;
+ Tcl_Obj **elements;
+ int i, nElements;
+
+ if (Tcl_ListObjGetElements(interp,objPtr,&nElements,&elements) != TCL_OK) {
+ return NULL;
+ }
+
+ items = (TreeItem**)ckalloc((nElements + 1)*sizeof(TreeItem*));
+ for (i = 0; i < nElements; ++i) {
+ items[i] = FindItem(interp, tv, elements[i]);
+ if (!items[i]) {
+ ckfree((ClientData)items);
+ return NULL;
+ }
+ }
+ items[i] = NULL;
+ return items;
+}
+
+/* + ItemName --
+ * Returns the item's ID.
+ */
+static const char *ItemName(Treeview *tv, TreeItem *item)
+{
+ return Tcl_GetHashKey(&tv->tree.items, item->entryPtr);
+}
+
+/* + ItemID --
+ * Returns a fresh Tcl_Obj * (refcount 0) holding the
+ * item identifier of the specified item.
+ */
+static Tcl_Obj *ItemID(Treeview *tv, TreeItem *item)
+{
+ return Tcl_NewStringObj(ItemName(tv, item), -1);
+}
+
+/* + FindColumn --
+ */
+static TreeColumn *FindColumn(
+ Tcl_Interp *interp, Treeview *tv, Tcl_Obj *columnIDObj)
+{
+ int column;
+
+ if (sscanf(Tcl_GetString(columnIDObj), "#%d", &column) == 1)
+ { /* Display column specification, #n */
+ if (column >= 0 && column < tv->tree.nDisplayColumns) {
+ return tv->tree.displayColumns[column];
+ }
+ /* else */
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "Column ", Tcl_GetString(columnIDObj), " out of range",
+ NULL);
+ return NULL;
+ }
+
+ column = ColumnIndex(interp, tv, columnIDObj);
+ if (column >= 0)
+ return tv->tree.columns + column;
+ return 0;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Column configuration.
+ */
+
+/* + TreeviewFreeColumns --
+ * Free column data.
+ */
+static void TreeviewFreeColumns(Treeview *tv)
+{
+ int i;
+
+ Tcl_DeleteHashTable(&tv->tree.columnNames);
+ Tcl_InitHashTable(&tv->tree.columnNames, TCL_STRING_KEYS);
+
+ if (tv->tree.columns) {
+ for (i = 0; i < tv->tree.nColumns; ++i)
+ FreeColumn(tv->tree.columns + i);
+ ckfree((ClientData)tv->tree.columns);
+ tv->tree.columns = 0;
+ }
+}
+
+/* + TreeviewInitColumns --
+ * Initialize column data when -columns changes.
+ * Returns: TCL_OK or TCL_ERROR;
+ */
+static int TreeviewInitColumns(Tcl_Interp *interp, Treeview *tv)
+{
+ Tcl_Obj **columns;
+ int i, ncols;
+
+ if (Tcl_ListObjGetElements(
+ interp, tv->tree.columnsObj, &ncols, &columns) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Free old values:
+ */
+ TreeviewFreeColumns(tv);
+
+ /*
+ * Initialize columns array and columnNames hash table:
+ */
+ tv->tree.nColumns = ncols;
+ tv->tree.columns =
+ (TreeColumn*)ckalloc(tv->tree.nColumns * sizeof(TreeColumn));
+
+ for (i = 0; i < ncols; ++i) {
+ int isNew;
+ Tcl_Obj *columnName = Tcl_DuplicateObj(columns[i]);
+
+ Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry(
+ &tv->tree.columnNames, Tcl_GetString(columnName), &isNew);
+ Tcl_SetHashValue(entryPtr, i);
+
+ InitColumn(tv->tree.columns + i);
+ Tk_InitOptions(
+ interp, (ClientData)(tv->tree.columns + i),
+ tv->tree.columnOptionTable, tv->core.tkwin);
+ Tk_InitOptions(
+ interp, (ClientData)(tv->tree.columns + i),
+ tv->tree.headingOptionTable, tv->core.tkwin);
+ Tcl_IncrRefCount(columnName);
+ tv->tree.columns[i].idObj = columnName;
+ }
+
+ return TCL_OK;
+}
+
+/* + TreeviewInitDisplayColumns --
+ * Initializes the 'displayColumns' array.
+ *
+ * Note that displayColumns[0] is always the tree column,
+ * even when SHOW_TREE is not set.
+ *
+ * @@@ TODO: disallow duplicated columns
+ */
+static int TreeviewInitDisplayColumns(Tcl_Interp *interp, Treeview *tv)
+{
+ Tcl_Obj **dcolumns;
+ int index, ndcols;
+ TreeColumn **displayColumns = 0;
+
+ if (Tcl_ListObjGetElements(interp,
+ tv->tree.displayColumnsObj, &ndcols, &dcolumns) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (ndcols == 0) {
+ ndcols = tv->tree.nColumns;
+ displayColumns = (TreeColumn**)ckalloc((ndcols+1)*sizeof(TreeColumn*));
+ for (index = 0; index < ndcols; ++index) {
+ displayColumns[index+1] = tv->tree.columns + index;
+ }
+ } else {
+ displayColumns = (TreeColumn**)ckalloc((ndcols+1)*sizeof(TreeColumn*));
+ for (index = 0; index < ndcols; ++index) {
+ int columnIndex = ColumnIndex(interp, tv, dcolumns[index]);
+ if (columnIndex == -1) {
+ ckfree((ClientData)displayColumns);
+ return TCL_ERROR;
+ }
+ displayColumns[index+1] = tv->tree.columns + columnIndex;
+ }
+ }
+ displayColumns[0] = &tv->tree.column0;
+
+ if (tv->tree.displayColumns)
+ ckfree((ClientData)tv->tree.displayColumns);
+ tv->tree.displayColumns = displayColumns;
+ tv->tree.nDisplayColumns = ndcols + 1;
+
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Event handlers.
+ */
+
+static TreeItem *IdentifyItem(Treeview *tv,int y,Ttk_Box *itemPos); /*forward*/
+
+const unsigned int TreeviewBindEventMask =
+ KeyPressMask|KeyReleaseMask
+ | ButtonPressMask|ButtonReleaseMask
+ | PointerMotionMask|ButtonMotionMask
+ | VirtualEventMask
+ ;
+
+static void TreeviewBindEventProc(void *clientData, XEvent *event)
+{
+ Treeview *tv = clientData;
+ TreeItem *item = NULL;
+ Ttk_Box unused;
+ void *taglist;
+ int nTags;
+
+ /*
+ * Figure out where to deliver the event.
+ */
+
+ switch (event->type)
+ {
+ case KeyPress:
+ case KeyRelease:
+ case VirtualEvent:
+ item = tv->tree.focus;
+ break;
+ case ButtonPress:
+ case ButtonRelease:
+ item = IdentifyItem(tv, event->xbutton.y, &unused);
+ break;
+ case MotionNotify:
+ item = IdentifyItem(tv, event->xmotion.y, &unused);
+ break;
+ default:
+ break;
+ }
+
+ if (!item) {
+ return;
+ }
+
+ /* ASSERT: Ttk_GetTagListFromObj returns TCL_OK. */
+ Ttk_GetTagListFromObj(NULL, tv->tree.tagTable, item->tagsObj,
+ &nTags, &taglist);
+
+ /*
+ * Fire binding:
+ */
+ Tcl_Preserve(clientData);
+ Tk_BindEvent(tv->tree.bindingTable, event, tv->core.tkwin, nTags, taglist);
+ Tcl_Release(clientData);
+
+ Ttk_FreeTagList(taglist);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Initialization and cleanup.
+ */
+
+static int TreeviewInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ int unused;
+
+ tv->tree.itemOptionTable =
+ Tk_CreateOptionTable(interp, ItemOptionSpecs);
+ tv->tree.columnOptionTable =
+ Tk_CreateOptionTable(interp, ColumnOptionSpecs);
+ tv->tree.headingOptionTable =
+ Tk_CreateOptionTable(interp, HeadingOptionSpecs);
+ tv->tree.tagOptionTable =
+ Tk_CreateOptionTable(interp, TagOptionSpecs);
+
+ tv->tree.tagTable = Ttk_CreateTagTable(
+ tv->tree.tagOptionTable, sizeof(DisplayItem));
+ tv->tree.bindingTable = Tk_CreateBindingTable(interp);
+ Tk_CreateEventHandler(tv->core.tkwin,
+ TreeviewBindEventMask, TreeviewBindEventProc, tv);
+
+ tv->tree.itemLayout
+ = tv->tree.cellLayout
+ = tv->tree.headingLayout
+ = tv->tree.rowLayout
+ = 0;
+
+ Tcl_InitHashTable(&tv->tree.columnNames, TCL_STRING_KEYS);
+ tv->tree.nColumns = tv->tree.nDisplayColumns = 0;
+ tv->tree.columns = NULL;
+ tv->tree.displayColumns = NULL;
+ tv->tree.showFlags = ~0;
+
+ InitColumn(&tv->tree.column0);
+ Tk_InitOptions(
+ interp, (ClientData)(&tv->tree.column0),
+ tv->tree.columnOptionTable, tv->core.tkwin);
+ Tk_InitOptions(
+ interp, (ClientData)(&tv->tree.column0),
+ tv->tree.headingOptionTable, tv->core.tkwin);
+
+ Tcl_InitHashTable(&tv->tree.items, TCL_STRING_KEYS);
+ tv->tree.serial = 0;
+
+ tv->tree.focus = 0;
+
+ /* Create root item "":
+ */
+ tv->tree.root = NewItem();
+ Tk_InitOptions(interp, (ClientData)tv->tree.root,
+ tv->tree.itemOptionTable, tv->core.tkwin);
+ tv->tree.root->entryPtr = Tcl_CreateHashEntry(&tv->tree.items, "", &unused);
+ Tcl_SetHashValue(tv->tree.root->entryPtr, tv->tree.root);
+
+ /* Scroll handles:
+ */
+ tv->tree.yscrollHandle = CreateScrollHandle(&tv->core, &tv->tree.yscroll);
+
+ return TCL_OK;
+}
+
+static void TreeviewCleanup(void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+
+ Tk_DeleteEventHandler(tv->core.tkwin,
+ TreeviewBindEventMask, TreeviewBindEventProc, tv);
+ Tk_DeleteBindingTable(tv->tree.bindingTable);
+ Ttk_DeleteTagTable(tv->tree.tagTable);
+
+ if (tv->tree.itemLayout) Ttk_FreeLayout(tv->tree.itemLayout);
+ if (tv->tree.cellLayout) Ttk_FreeLayout(tv->tree.cellLayout);
+ if (tv->tree.headingLayout) Ttk_FreeLayout(tv->tree.headingLayout);
+ if (tv->tree.rowLayout) Ttk_FreeLayout(tv->tree.rowLayout);
+
+ TreeviewFreeColumns(tv);
+
+ if (tv->tree.displayColumns)
+ Tcl_Free((ClientData)tv->tree.displayColumns);
+
+ foreachHashEntry(&tv->tree.items, FreeItemCB);
+ Tcl_DeleteHashTable(&tv->tree.items);
+
+ FreeScrollHandle(tv->tree.yscrollHandle);
+}
+
+/* + TreeviewConfigure --
+ * Configuration widget hook.
+ *
+ * BUG: If user sets -columns and -displaycolumns, but -displaycolumns
+ * has an error, the widget is left in an inconsistent state.
+ */
+static int
+TreeviewConfigure(Tcl_Interp *interp, void *recordPtr, int mask)
+{
+ Treeview *tv = recordPtr;
+ unsigned showFlags = tv->tree.showFlags;
+
+ if (mask & COLUMNS_CHANGED) {
+ if (TreeviewInitColumns(interp, tv) != TCL_OK)
+ return TCL_ERROR;
+ mask |= DCOLUMNS_CHANGED;
+ }
+ if (mask & DCOLUMNS_CHANGED) {
+ if (TreeviewInitDisplayColumns(interp, tv) != TCL_OK)
+ return TCL_ERROR;
+ }
+ if (mask & SCROLLCMD_CHANGED) {
+ ScrollbarUpdateRequired(tv->tree.yscrollHandle);
+ }
+
+ if ( (mask & SHOW_CHANGED)
+ && GetEnumSetFromObj(
+ interp,tv->tree.showObj,showStrings,&showFlags) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ if (CoreConfigure(interp, recordPtr, mask) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ tv->tree.showFlags = showFlags;
+ return TCL_OK;
+}
+
+/* + ConfigureItem --
+ * Set item options.
+ */
+static int ConfigureItem(
+ Tcl_Interp *interp, Treeview *tv, TreeItem *item,
+ int objc, Tcl_Obj *const objv[])
+{
+ Tk_SavedOptions savedOptions;
+
+ if (Tk_SetOptions(interp, (ClientData)item, tv->tree.itemOptionTable,
+ objc, objv, tv->core.tkwin,&savedOptions,0) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /* Make sure that -values is a valid list:
+ */
+ if (item->valuesObj) {
+ int unused;
+ if (Tcl_ListObjLength(interp, item->valuesObj, &unused) != TCL_OK)
+ goto error;
+ }
+
+ /* Validate -image option.
+ * @@@ TODO: keep images array around
+ */
+ if (item->imageObj) {
+ Tk_Image *images = NULL;
+ if (GetImageList(interp, &tv->core, item->imageObj, &images) != TCL_OK)
+ goto error;
+ if (images)
+ FreeImageList(images);
+ }
+
+ /* Keep TTK_STATE_OPEN flag in sync with item->openObj.
+ * We use both a state flag and a Tcl_Obj* resource so elements
+ * can access the value in either way.
+ */
+ if (item->openObj) {
+ int isOpen;
+ if (Tcl_GetBooleanFromObj(interp, item->openObj, &isOpen) != TCL_OK)
+ goto error;
+ if (isOpen)
+ item->state |= TTK_STATE_OPEN;
+ else
+ item->state &= ~TTK_STATE_OPEN;
+ }
+
+ /* Make sure -tags is a valid list
+ * (side effect: may create new tags)
+ */
+ if (item->tagsObj) {
+ void *taglist;
+ int nTags;
+ if (Ttk_GetTagListFromObj(interp, tv->tree.tagTable, item->tagsObj,
+ &nTags, &taglist) != TCL_OK)
+ {
+ goto error;
+ }
+ Ttk_FreeTagList(taglist);
+ }
+
+ /* All OK.
+ */
+ Tk_FreeSavedOptions(&savedOptions);
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+
+error:
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+}
+
+/* + ConfigureColumn --
+ * Set column options.
+ */
+static int ConfigureColumn(
+ Tcl_Interp *interp, Treeview *tv, TreeColumn *column,
+ int objc, Tcl_Obj *const objv[])
+{
+ Tk_SavedOptions savedOptions;
+ int mask;
+
+ if (Tk_SetOptions(interp, (ClientData)column,
+ tv->tree.columnOptionTable, objc, objv, tv->core.tkwin,
+ &savedOptions,&mask) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ if (mask & READONLY_OPTION) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Attempt to change read-only option", NULL);
+ goto error;
+ }
+
+ /* Propagate column width changes to overall widget request width,
+ * but only if the widget is currently unmapped, in order to prevent
+ * geometry jumping during interactive column resize.
+ */
+ if (mask & GEOMETRY_CHANGED && !Tk_IsMapped(tv->core.tkwin)) {
+ TtkResizeWidget(&tv->core);
+ }
+ TtkRedisplayWidget(&tv->core);
+
+ Tk_FreeSavedOptions(&savedOptions);
+ return TCL_OK;
+
+error:
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+}
+
+/* + ConfigureHeading --
+ * Set heading options.
+ */
+static int ConfigureHeading(
+ Tcl_Interp *interp, Treeview *tv, TreeColumn *column,
+ int objc, Tcl_Obj *const objv[])
+{
+ Tk_SavedOptions savedOptions;
+ int mask;
+
+ if (Tk_SetOptions(interp, (ClientData)column,
+ tv->tree.headingOptionTable, objc, objv, tv->core.tkwin,
+ &savedOptions,&mask) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /* @@@ testing ... */
+ if ((mask & STATE_CHANGED) && column->headingStateObj) {
+ Ttk_StateSpec stateSpec;
+ if (Ttk_GetStateSpecFromObj(
+ interp, column->headingStateObj, &stateSpec) != TCL_OK)
+ {
+ goto error;
+ }
+ column->headingState = Ttk_ModifyState(column->headingState,&stateSpec);
+ Tcl_DecrRefCount(column->headingStateObj);
+ column->headingStateObj = Ttk_NewStateSpecObj(column->headingState,0);
+ Tcl_IncrRefCount(column->headingStateObj);
+ }
+
+ TtkRedisplayWidget(&tv->core);
+ Tk_FreeSavedOptions(&savedOptions);
+ return TCL_OK;
+
+error:
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Geometry routines.
+ */
+
+/* + CountRows --
+ * Count the number of viewable items.
+ */
+static int CountRows(TreeItem *item)
+{
+ int height = 1;
+
+ if (item->state & TTK_STATE_OPEN) {
+ TreeItem *child = item->children;
+ while (child) {
+ height += CountRows(child);
+ child = child->next;
+ }
+ }
+ return height;
+}
+
+/* + TreeWidth --
+ * Compute the requested tree width from the sum of visible column widths.
+ */
+static int TreeWidth(Treeview *tv)
+{
+ int i = (tv->tree.showFlags&SHOW_TREE) ? 0 : 1;
+ int width = 0;
+
+ while (i < tv->tree.nDisplayColumns) {
+ width += tv->tree.displayColumns[i++]->width;
+ }
+ return width;
+}
+
+/* + PlaceColumns -
+ * Adjust final column width to fill available space.
+ * @@@ NB: still not right -- see paned.c for correct algorithm
+ */
+static void PlaceColumns(Treeview *tv, int availableWidth)
+{
+# define MIN_WIDTH 24
+ int colno = (tv->tree.showFlags & SHOW_TREE) ? 0 : 1;
+ TreeColumn *column = tv->tree.displayColumns[colno];
+
+ while (++colno < tv->tree.nDisplayColumns) {
+ availableWidth -= column->width;
+ column = tv->tree.displayColumns[colno];
+ }
+ column->width = availableWidth;
+ if (column->width < MIN_WIDTH) {
+ column->width = MIN_WIDTH;
+ }
+}
+
+/* + IdentifyRow --
+ * Recursive search for item at specified y position.
+ * Main work routine for IdentifyItem(()
+ */
+static TreeItem *IdentifyRow(
+ TreeItem *item, /* where to start search */
+ Ttk_Box *bp, /* Scan position */
+ int y) /* target y coordinate */
+{
+ while (item) {
+ int next_ypos = bp->y + ROWHEIGHT;
+ if (bp->y <= y && y <= next_ypos) {
+ bp->height = ROWHEIGHT;
+ return item;
+ }
+ bp->y = next_ypos;
+ if (item->state & TTK_STATE_OPEN) {
+ TreeItem *subitem = IdentifyRow(item->children, bp, y);
+ if (subitem) {
+ bp->x += INDENT;
+ bp->width -= INDENT;
+ return subitem;
+ }
+ }
+ item = item->next;
+ }
+ return 0;
+}
+
+/* + IdentifyItem --
+ * Locate the item at the specified y position, if any.
+ * On return, *itemPos holds the parcel of the tree item.
+ */
+static TreeItem *IdentifyItem(Treeview *tv, int y, Ttk_Box *itemPos)
+{
+ *itemPos = Ttk_MakeBox(
+ tv->tree.treeArea.x,
+ tv->tree.treeArea.y - tv->tree.yscroll.first * ROWHEIGHT,
+ tv->tree.column0.width,
+ ROWHEIGHT);
+ return IdentifyRow(tv->tree.root->children, itemPos, y);
+}
+
+/* + IdentifyDisplayColumn --
+ * Returns the display column number at the specified x position,
+ * or -1 if x is outside any columns.
+ */
+static int IdentifyDisplayColumn(Treeview *tv, int x, int *x1)
+{
+ int colno = (tv->tree.showFlags & SHOW_TREE) ? 0 : 1;
+ int xpos = tv->tree.treeArea.x;
+
+ while (colno < tv->tree.nDisplayColumns) {
+ TreeColumn *column = tv->tree.displayColumns[colno];
+ int next_xpos = xpos + column->width;
+ if (xpos <= x && x <= next_xpos + HALO) {
+ *x1 = next_xpos;
+ return colno;
+ }
+ ++colno;
+ xpos = next_xpos;
+ }
+
+ return -1;
+}
+
+/* + SubtreeHeight --
+ * Returns the height of the visible subtree rooted at item.
+ */
+#define ItemHeight(item) (ROWHEIGHT) /* TBFIXED */
+static int SubtreeHeight(TreeItem *item)
+{
+ int height = ItemHeight(item);
+ if (item->state & TTK_STATE_OPEN) {
+ TreeItem *child = item->children;
+ while (child) {
+ height += SubtreeHeight(child);
+ child = child->next;
+ }
+ }
+ return height;
+}
+
+/* + ItemYPosition --
+ * Returns Y position of specified item relative to root of tree,
+ * -1 if item is not viewable.
+ */
+static int ItemYPosition(Treeview *tv, TreeItem *p)
+{
+ TreeItem *root = tv->tree.root;
+ int ypos = 0;
+
+ for (;;) {
+ if (p->prev) {
+ p = p->prev;
+ ypos += SubtreeHeight(p);
+ } else {
+ p = p->parent;
+ if (!(p && (p->state & TTK_STATE_OPEN))) {
+ /* detached or closed ancestor */
+ return -1;
+ }
+ if (p == root) {
+ return ypos;
+ }
+ ypos += ItemHeight(p);
+ }
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Display routines.
+ */
+
+/* + GetSublayout --
+ * Utility routine; acquires a sublayout for items, cells, etc.
+ */
+static Ttk_Layout GetSublayout(
+ Tcl_Interp *interp,
+ Ttk_Theme themePtr,
+ Ttk_Layout parentLayout,
+ const char *layoutName,
+ Tk_OptionTable optionTable,
+ Ttk_Layout *layoutPtr)
+{
+ Ttk_Layout newLayout = Ttk_CreateSublayout(
+ interp, themePtr, parentLayout, layoutName, optionTable);
+
+ if (newLayout) {
+ if (*layoutPtr)
+ Ttk_FreeLayout(*layoutPtr);
+ *layoutPtr = newLayout;
+ }
+ return newLayout;
+}
+
+/* + TreeviewGetLayout --
+ * GetLayout() widget hook.
+ */
+static Ttk_Layout TreeviewGetLayout(
+ Tcl_Interp *interp, Ttk_Theme themePtr, void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ Ttk_Layout treeLayout = WidgetGetLayout(interp, themePtr, recordPtr);
+
+ if (!(
+ GetSublayout(interp, themePtr, treeLayout, ".Item",
+ tv->tree.itemOptionTable, &tv->tree.itemLayout)
+ && GetSublayout(interp, themePtr, treeLayout, ".Cell",
+ tv->tree.tagOptionTable, &tv->tree.cellLayout) /*@@@HERE*/
+ && GetSublayout(interp, themePtr, treeLayout, ".Heading",
+ tv->tree.headingOptionTable, &tv->tree.headingLayout)
+ && GetSublayout(interp, themePtr, treeLayout, ".Row",
+ tv->tree.tagOptionTable, &tv->tree.rowLayout) /*@@@HERE*/
+ )) {
+ return 0;
+ }
+
+ return treeLayout;
+}
+
+/* + TreeviewDoLayout --
+ * DoLayout() widget hook. Computes widget layout.
+ *
+ * Side effects:
+ * Computes headingArea and treeArea.
+ * Computes subtree height.
+ * Invokes scroll callbacks.
+ */
+static void TreeviewDoLayout(void *clientData)
+{
+ Treeview *tv = clientData;
+ unsigned showFlags = tv->tree.showFlags;
+ Ttk_LayoutNode *clientNode = Ttk_LayoutFindNode(tv->core.layout, "client");
+
+ Ttk_PlaceLayout(tv->core.layout,tv->core.state,Ttk_WinBox(tv->core.tkwin));
+ tv->tree.treeArea = clientNode
+ ? Ttk_LayoutNodeInternalParcel(tv->core.layout,clientNode)
+ : Ttk_WinBox(tv->core.tkwin) ;
+
+ PlaceColumns(tv, tv->tree.treeArea.width);
+
+ if (showFlags & SHOW_HEADINGS) {
+ tv->tree.headingArea = Ttk_PackBox(
+ &tv->tree.treeArea, 1, HEADINGHEIGHT, TTK_SIDE_TOP);
+ } else {
+ tv->tree.headingArea = Ttk_MakeBox(0,0,0,0);
+ }
+
+ tv->tree.root->state |= TTK_STATE_OPEN;
+ Scrolled(tv->tree.yscrollHandle,
+ tv->tree.yscroll.first,
+ tv->tree.yscroll.first + (tv->tree.treeArea.height / ROWHEIGHT),
+ CountRows(tv->tree.root) - 1);
+}
+
+/* + TreeviewSize --
+ * SizeProc() widget hook. Size is determined by
+ * -height option and column widths.
+ *
+ * <<NOTE-SLOP>>: Ought to compute extra width and height
+ * by checking the padding of TTK_OPTION_BORDER elements
+ * in the layout. In the meantime, just add some extra for slop.
+ */
+static int TreeviewSize(void *clientData, int *widthPtr, int *heightPtr)
+{
+ Treeview *tv = clientData;
+ int nRows;
+ int slop = 12; /* NOTE-SLOP */
+
+ Tk_GetPixelsFromObj(NULL,tv->core.tkwin, tv->tree.heightObj, &nRows);
+
+ *widthPtr = TreeWidth(tv) + slop;
+ *heightPtr = slop + ROWHEIGHT * nRows;
+
+ if (tv->tree.showFlags & SHOW_HEADINGS)
+ *heightPtr += HEADINGHEIGHT;
+
+ return 1;
+}
+
+/* + ItemState --
+ * Returns the state of the specified item, based
+ * on widget state, item state, and other information.
+ */
+static Ttk_State ItemState(Treeview *tv, TreeItem *item)
+{
+ Ttk_State state = tv->core.state | item->state;
+ if (!item->children)
+ state |= TTK_STATE_LEAF;
+ if (item != tv->tree.focus)
+ state &= ~TTK_STATE_FOCUS;
+ return state;
+}
+
+/* + DrawHeadings --
+ * Draw tree headings.
+ */
+static void DrawHeadings(Treeview *tv, Drawable d, Ttk_Box b)
+{
+ int i = (tv->tree.showFlags & SHOW_TREE) ? 0 : 1;
+ int x = 0;
+
+ while (i < tv->tree.nDisplayColumns) {
+ TreeColumn *column = tv->tree.displayColumns[i];
+ Ttk_Box parcel = Ttk_MakeBox(b.x+x, b.y, column->width, b.height);
+ DisplayLayout(tv->tree.headingLayout,
+ column, column->headingState, parcel, d);
+ x += column->width;
+ ++i;
+ }
+}
+
+/* + PrepareItem --
+ * Fill in a displayItem record from tag settings.
+ */
+static void PrepareItem(Treeview *tv, TreeItem *item, DisplayItem *displayItem)
+{
+ const int nOptions = sizeof(*displayItem)/sizeof(Tcl_Obj*);
+ Tcl_Obj **dest = (Tcl_Obj**)displayItem;
+ Tcl_Obj **objv = NULL;
+ int objc = 0;
+
+ memset(displayItem, 0, sizeof(*displayItem));
+
+ if ( item->tagsObj
+ && Tcl_ListObjGetElements(NULL, item->tagsObj, &objc, &objv) == TCL_OK)
+ {
+ int i, j;
+ for (i=0; i<objc; ++i) {
+ Ttk_Tag tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[i]);
+ Tcl_Obj **tagRecord = Ttk_TagRecord(tag);
+
+ if (tagRecord) {
+ for (j=0; j<nOptions; ++j) {
+ if (tagRecord[j] != 0) {
+ dest[j] = tagRecord[j];
+ }
+ }
+ }
+ }
+ }
+}
+
+/* + DrawCells --
+ * Draw data cells for specified item.
+ */
+static void DrawCells(
+ Treeview *tv, TreeItem *item, DisplayItem *displayItem,
+ Drawable d, Ttk_Box b, int x, int y)
+{
+ Ttk_Layout layout = tv->tree.cellLayout;
+ Ttk_State state = ItemState(tv, item);
+ Ttk_Padding cellPadding = {4, 0, 4, 0};
+ int height = ROWHEIGHT;
+ int nValues = 0;
+ Tcl_Obj **values = 0;
+ int i;
+
+ if (!item->valuesObj) {
+ return;
+ }
+
+ Tcl_ListObjGetElements(NULL, item->valuesObj, &nValues, &values);
+ for (i = 0; i < tv->tree.nColumns; ++i) {
+ tv->tree.columns[i].data = (i < nValues) ? values[i] : 0;
+ }
+
+ for (i = 1; i < tv->tree.nDisplayColumns; ++i) {
+ TreeColumn *column = tv->tree.displayColumns[i];
+ Ttk_Box parcel = Ttk_PadBox(
+ Ttk_MakeBox(b.x+x, b.y+y, column->width, height), cellPadding);
+
+ displayItem->textObj = column->data;
+ displayItem->anchorObj = column->anchorObj;
+
+ DisplayLayout(layout, displayItem, state, parcel, d);
+ x += column->width;
+ }
+}
+
+/* + DrawItem --
+ * Draw an item (row background, tree label, and cells).
+ * at the specified x, y position.
+ */
+static void DrawItem(
+ Treeview *tv, TreeItem *item, Drawable d, Ttk_Box b, int depth, int row)
+{
+ Ttk_Layout layout = tv->tree.itemLayout;
+ Ttk_State state = ItemState(tv, item);
+ DisplayItem displayItem;
+ int height = ROWHEIGHT;
+ int x = depth * INDENT;
+ int y = (row - tv->tree.yscroll.first) * ROWHEIGHT;
+
+ if (row % 2) state |= TTK_STATE_ALTERNATE;
+
+ PrepareItem(tv, item, &displayItem);
+
+ /* Draw row background:
+ */
+ {
+ Ttk_Box rowBox = Ttk_MakeBox(b.x, b.y+y, TreeWidth(tv), height);
+ DisplayLayout(tv->tree.rowLayout, &displayItem, state, rowBox, d);
+ }
+
+ /* Draw tree label:
+ */
+ if (tv->tree.showFlags & SHOW_TREE) {
+ int colwidth = tv->tree.column0.width;
+ Ttk_Box parcel = Ttk_MakeBox(b.x + x, b.y + y, colwidth - x, height);
+ DisplayLayout(layout, item, state, parcel, d);
+ x = colwidth;
+ } else {
+ x = 0;
+ }
+
+ /* Draw data cells:
+ */
+ DrawCells(tv, item, &displayItem, d, b, x, y);
+}
+
+/* + DrawSubtree --
+ * Draw an item and all of its (viewable) descendants.
+ *
+ * Returns:
+ * Row number of the last item drawn.
+ */
+
+static int DrawForest( /* forward */
+ Treeview *tv, TreeItem *item, Drawable d, Ttk_Box b, int depth, int row);
+
+static int DrawSubtree(
+ Treeview *tv, TreeItem *item, Drawable d, Ttk_Box b, int depth, int row)
+{
+ if (row >= tv->tree.yscroll.first) {
+ DrawItem(tv, item, d, b, depth, row);
+ }
+
+ if (item->state & TTK_STATE_OPEN) {
+ return DrawForest(tv, item->children, d, b, depth + 1, row + 1);
+ } else {
+ return row + 1;
+ }
+}
+
+/* + DrawForest --
+ * Draw a sequence of items and their visible descendants.
+ *
+ * Returns:
+ * Row number of the last item drawn.
+ */
+static int DrawForest(
+ Treeview *tv, TreeItem *item, Drawable d, Ttk_Box b, int depth, int row)
+{
+ while (item && row <= tv->tree.yscroll.last) {
+ row = DrawSubtree(tv, item, d, b, depth, row);
+ item = item->next;
+ }
+ return row;
+}
+
+/* + TreeviewDisplay --
+ * Display() widget hook. Draw the widget contents.
+ */
+static void TreeviewDisplay(void *clientData, Drawable d)
+{
+ Treeview *tv = clientData;
+
+ Ttk_DrawLayout(tv->core.layout, tv->core.state, d);
+ if (tv->tree.showFlags & SHOW_HEADINGS) {
+ DrawHeadings(tv, d, tv->tree.headingArea);
+ }
+ DrawForest(tv, tv->tree.root->children, d, tv->tree.treeArea, 0,0);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Utilities for widget commands
+ */
+
+/* + InsertPosition --
+ * Locate the previous sibling for [$tree insert] and [$tree move].
+ *
+ * Returns a pointer to the item just before the specified index,
+ * or 0 if the item is to be inserted at the beginning.
+ */
+static TreeItem *InsertPosition(TreeItem *parent, int index)
+{
+ TreeItem *sibling = parent->children;
+ if (sibling) {
+ while (index > 0 && sibling->next) {
+ sibling = sibling->next;
+ --index;
+ }
+ if (index <= 0) {
+ sibling = sibling->prev;
+ } /* else -- $index > #children, insert at end. */
+ }
+ return sibling;
+}
+
+/* + EndPosition --
+ * Locate the last child of the specified node.
+ */
+static TreeItem *EndPosition(TreeItem *parent)
+{
+ TreeItem *sibling = parent->children;
+ if (sibling) {
+ while (sibling->next) {
+ sibling = sibling->next;
+ }
+ }
+ return sibling;
+}
+
+/* + AncestryCheck --
+ * Verify that specified item is not an ancestor of the specified parent;
+ * returns 1 if OK, 0 and leaves an error message in interp otherwise.
+ */
+static int AncestryCheck(
+ Tcl_Interp *interp, Treeview *tv, TreeItem *item, TreeItem *parent)
+{
+ TreeItem *p = parent;
+ while (p) {
+ if (p == item) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "Cannot insert ", ItemName(tv, item),
+ " as a descendant of ", ItemName(tv, parent),
+ NULL);
+ return 0;
+ }
+ p = p->parent;
+ }
+ return 1;
+}
+
+/* + DeleteItems --
+ * Remove an item and all of its descendants from the hash table
+ * and detach them from the tree; returns a linked list (chained
+ * along the ->next pointer) of deleted items.
+ */
+static TreeItem *DeleteItems(TreeItem *item, TreeItem *delq)
+{
+ if (item->entryPtr) {
+ DetachItem(item);
+ while (item->children) {
+ delq = DeleteItems(item->children, delq);
+ }
+ Tcl_DeleteHashEntry(item->entryPtr);
+ item->entryPtr = 0;
+ item->next = delq;
+ delq = item;
+ } /* else -- item has already been unlinked */
+ return delq;
+}
+
+/* + RowNumber --
+ * Calculate which row the specified item appears on;
+ * returns -1 if the item is not viewable.
+ * Xref: DrawForest, IdentifyItem.
+ */
+static int RowNumber(Treeview *tv, TreeItem *item)
+{
+ TreeItem *p = tv->tree.root->children;
+ int n = 0;
+
+ while (p) {
+ if (p == item)
+ return n;
+
+ ++n;
+
+ /* Find next viewable item in preorder traversal order
+ */
+ if (p->children && (p->state & TTK_STATE_OPEN)) {
+ p = p->children;
+ } else {
+ while (!p->next && p && p->parent)
+ p = p->parent;
+ if (p)
+ p = p->next;
+ }
+ }
+
+ return -1;
+}
+
+/* + ItemDepth -- return the depth of a tree item.
+ * The depth of an item is equal to the number of proper ancestors,
+ * not counting the root node.
+ */
+static int ItemDepth(TreeItem *item)
+{
+ int depth = 0;
+ while (item->parent) {
+ ++depth;
+ item = item->parent;
+ }
+ return depth-1;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- item inquiry.
+ */
+
+/* + $tv children $item ?newchildren? --
+ * Return the list of children associated with $item
+ */
+static int TreeviewChildrenCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+ Tcl_Obj *result;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item ?newchildren?");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ result = Tcl_NewListObj(0,0);
+ for (item = item->children; item; item = item->next) {
+ Tcl_ListObjAppendElement(interp, result, ItemID(tv, item));
+ }
+ Tcl_SetObjResult(interp, result);
+ } else {
+ TreeItem **newChildren = GetItemListFromObj(interp, tv, objv[3]);
+ TreeItem *child;
+ int i;
+
+ if (!newChildren)
+ return TCL_ERROR;
+
+ /* Sanity-check:
+ */
+ for (i=0; newChildren[i]; ++i) {
+ if (!AncestryCheck(interp, tv, newChildren[i], item)) {
+ ckfree((ClientData)newChildren);
+ return TCL_ERROR;
+ }
+ }
+
+ /* Detach old children:
+ */
+ child = item->children;
+ while (child) {
+ TreeItem *next = child->next;
+ DetachItem(child);
+ child = next;
+ }
+
+ /* Detach new children from their current locations:
+ */
+ for (i=0; newChildren[i]; ++i) {
+ DetachItem(newChildren[i]);
+ }
+
+ /* Reinsert new children:
+ * Note: it is not an error for an item to be listed more than once,
+ * though it probably should be...
+ */
+ child = 0;
+ for (i=0; newChildren[i]; ++i) {
+ if (newChildren[i]->parent) {
+ /* This is a duplicate element which has already been
+ * inserted. Ignore it.
+ */
+ continue;
+ }
+ InsertItem(item, child, newChildren[i]);
+ child = newChildren[i];
+ }
+
+ ckfree((ClientData)newChildren);
+ TtkRedisplayWidget(&tv->core);
+ }
+
+ return TCL_OK;
+}
+
+/* + $tv parent $item --
+ * Return the item ID of $item's parent.
+ */
+static int TreeviewParentCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ if (item->parent) {
+ Tcl_SetObjResult(interp, ItemID(tv, item->parent));
+ } else {
+ /* This is the root item. @@@ Return an error? */
+ Tcl_ResetResult(interp);
+ }
+
+ return TCL_OK;
+}
+
+/* + $tv next $item
+ * Return the ID of $item's next sibling.
+ */
+static int TreeviewNextCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ if (item->next) {
+ Tcl_SetObjResult(interp, ItemID(tv, item->next));
+ } /* else -- leave interp-result empty */
+
+ return TCL_OK;
+}
+
+/* + $tv prev $item
+ * Return the ID of $item's previous sibling.
+ */
+static int TreeviewPrevCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ if (item->prev) {
+ Tcl_SetObjResult(interp, ItemID(tv, item->prev));
+ } /* else -- leave interp-result empty */
+
+ return TCL_OK;
+}
+
+/* + $tv index $item --
+ * Return the index of $item within its parent.
+ */
+static int TreeviewIndexCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+ int index = 0;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+
+ while (item->prev) {
+ ++index;
+ item = item->prev;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ return TCL_OK;
+}
+
+/* + $tv exists $itemid --
+ * Test if the specified item id is present in the tree.
+ */
+static int TreeviewExistsCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ Tcl_HashEntry *entryPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "itemid");
+ return TCL_ERROR;
+ }
+
+ entryPtr = Tcl_FindHashEntry(&tv->tree.items, Tcl_GetString(objv[2]));
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(entryPtr != 0));
+ return TCL_OK;
+}
+
+/* + $tv bbox $itemid ?$column? --
+ * Return bounding box [x y width height] of specified item.
+ */
+static int TreeviewBBoxCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item = 0;
+ TreeColumn *column = 0;
+ int ypos;
+ Ttk_Box bbox;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "itemid ?column");
+ return TCL_ERROR;
+ }
+
+ item = FindItem(interp, tv, objv[2]);
+ if (!item) {
+ return TCL_ERROR;
+ }
+ if (objc >=4 && (column = FindColumn(interp,tv,objv[3])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Compute bounding box of item:
+ * ALTERNATE: (RowNumber(tv, item) - tv->tree.yscroll.first) * ROWHEIGHT;
+ */
+ ypos = ItemYPosition(tv, item) - (ROWHEIGHT * tv->tree.yscroll.first);
+ if (ypos < 0 || ypos > tv->tree.treeArea.height) {
+ /* not viewable, or off-screen */
+ return TCL_OK;
+ }
+
+ bbox = tv->tree.treeArea;
+ bbox.y += ypos;
+ bbox.height = ROWHEIGHT;
+
+ /* If column has been specified, compute bounding box of cell
+ */
+ if (column) {
+ int xpos = 0, i = (tv->tree.showFlags & SHOW_TREE) ? 0 : 1;
+ while (i < tv->tree.nDisplayColumns) {
+ if (tv->tree.displayColumns[i] == column) {
+ break;
+ }
+ xpos += tv->tree.displayColumns[i]->width;
+ ++i;
+ }
+ if (i == tv->tree.nDisplayColumns) { /* specified column unviewable */
+ return TCL_OK;
+ }
+ bbox.x += xpos;
+ bbox.width = column->width;
+
+ /* Special case for tree column -- account for indentation:
+ * (@@@ NOTE: doesn't account for tree indicator or image;
+ * @@@ this may or may not be the right thing.)
+ */
+ if (column == &tv->tree.column0) {
+ int indent = INDENT * ItemDepth(item);
+ bbox.x += indent;
+ bbox.width -= indent;
+ }
+ }
+
+ Tcl_SetObjResult(interp, Ttk_NewBoxObj(bbox));
+ return TCL_OK;
+}
+
+/* + $tv identify $x $y -- (obsolescent)
+ * Implements the old, horrible, 2-argument form of [$tv identify].
+ *
+ * Returns: one of
+ * heading #n
+ * cell itemid #n
+ * item itemid element
+ * row itemid
+ */
+static int TreeviewHorribleIdentify(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Treeview *tv)
+{
+ const char *what = "nothing", *detail = NULL;
+ TreeItem *item = 0;
+ Tcl_Obj *result;
+ int dColumnNumber;
+ char dcolbuf[16];
+ int x, y, x1;
+
+ /* ASSERT: objc == 4 */
+
+ if ( Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ dColumnNumber = IdentifyDisplayColumn(tv, x, &x1);
+ if (dColumnNumber < 0) {
+ goto done;
+ }
+ sprintf(dcolbuf, "#%d", dColumnNumber);
+
+ if (Ttk_BoxContains(tv->tree.headingArea,x,y)) {
+ if (-HALO <= x1 - x && x1 - x <= HALO) {
+ what = "separator";
+ } else {
+ what = "heading";
+ }
+ detail = dcolbuf;
+ } else if (Ttk_BoxContains(tv->tree.treeArea,x,y)) {
+ Ttk_Box itemBox;
+ item = IdentifyItem(tv, y, &itemBox);
+ if (item && dColumnNumber > 0) {
+ what = "cell";
+ detail = dcolbuf;
+ } else if (item) {
+ Ttk_Layout layout = tv->tree.itemLayout;
+ Ttk_LayoutNode *element;
+ Ttk_RebindSublayout(layout, item);
+ Ttk_PlaceLayout(layout, ItemState(tv,item), itemBox);
+ element = Ttk_LayoutIdentify(layout, x, y);
+
+ if (element) {
+ what = "item";
+ detail = Ttk_LayoutNodeName(element);
+ } else {
+ what = "row";
+ }
+ }
+ }
+
+done:
+ result = Tcl_NewListObj(0,0);
+ Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(what, -1));
+ if (item)
+ Tcl_ListObjAppendElement(NULL, result, ItemID(tv, item));
+ if (detail)
+ Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(detail, -1));
+
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/* + $tv identify $component $x $y --
+ * Identify the component at position x,y.
+ */
+
+static int TreeviewIdentifyCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ static const char *componentStrings[] =
+ { "row", "column", NULL };
+ enum { I_ROW, I_COLUMN };
+
+ Treeview *tv = recordPtr;
+ int component, x, y;
+
+ if (objc == 4) { /* Old form */
+ return TreeviewHorribleIdentify(interp, objc, objv, tv);
+ } else if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "component x y");
+ return TCL_ERROR;
+ }
+
+ if ( Tcl_GetIndexFromObj(interp, objv[2],
+ componentStrings, "component", TCL_EXACT, &component) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ switch (component)
+ {
+ case I_ROW :
+ {
+ Ttk_Box itemBox;
+ TreeItem *item = IdentifyItem(tv, y, &itemBox);
+ if (item) {
+ Tcl_SetObjResult(interp, ItemID(tv, item));
+ }
+ break;
+ }
+
+ case I_COLUMN :
+ {
+ int x1;
+ int column = IdentifyDisplayColumn(tv, x, &x1);
+
+ if (column >= 0) {
+ char dcolbuf[16];
+ sprintf(dcolbuf, "#%d", column);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(dcolbuf, -1));
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- item and column configuration.
+ */
+
+/* + $tv item $item ?options ....?
+ * Query or configure item options.
+ */
+static int TreeviewItemCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item ?option ?value??...");
+ return TCL_ERROR;
+ }
+ if (!(item = FindItem(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ return EnumerateOptions(interp, item, ItemOptionSpecs,
+ tv->tree.itemOptionTable, tv->core.tkwin);
+ } else if (objc == 4) {
+ return GetOptionValue(interp, item, objv[3],
+ tv->tree.itemOptionTable, tv->core.tkwin);
+ } else {
+ return ConfigureItem(interp, tv, item, objc-3, objv+3);
+ }
+}
+
+/* + $tv column column ?options ....?
+ * Column data accessor
+ */
+static int TreeviewColumnCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeColumn *column;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "column -option value...");
+ return TCL_ERROR;
+ }
+ if (!(column = FindColumn(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ return EnumerateOptions(interp, column, ColumnOptionSpecs,
+ tv->tree.columnOptionTable, tv->core.tkwin);
+ } else if (objc == 4) {
+ return GetOptionValue(interp, column, objv[3],
+ tv->tree.columnOptionTable, tv->core.tkwin);
+ } else {
+ return ConfigureColumn(interp, tv, column, objc-3, objv+3);
+ }
+}
+
+/* + $tv heading column ?options ....?
+ * Heading data accessor
+ */
+static int TreeviewHeadingCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ Tk_OptionTable optionTable = tv->tree.headingOptionTable;
+ Tk_Window tkwin = tv->core.tkwin;
+ TreeColumn *column;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "column -option value...");
+ return TCL_ERROR;
+ }
+ if (!(column = FindColumn(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ return EnumerateOptions(
+ interp, column, HeadingOptionSpecs, optionTable, tkwin);
+ } else if (objc == 4) {
+ return GetOptionValue(
+ interp, column, objv[3], optionTable, tkwin);
+ } else {
+ return ConfigureHeading(interp, tv, column, objc-3,objv+3);
+ }
+}
+
+/* + $tv set $item ?$column ?value??
+ * Query or configure cell values
+ */
+static int TreeviewSetCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item;
+ TreeColumn *column;
+ int columnNumber;
+
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item ?column ?value??");
+ return TCL_ERROR;
+ }
+ if (!(item = FindItem(interp, tv, objv[2])))
+ return TCL_ERROR;
+
+ /* Make sure -values exists:
+ */
+ if (!item->valuesObj) {
+ item->valuesObj = Tcl_NewListObj(0,0);
+ Tcl_IncrRefCount(item->valuesObj);
+ }
+
+ if (objc == 3) {
+ /* Return dictionary:
+ */
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+ Tcl_Obj *value;
+ for (columnNumber=0; columnNumber<tv->tree.nColumns; ++columnNumber) {
+ Tcl_ListObjIndex(interp, item->valuesObj, columnNumber, &value);
+ if (value) {
+ Tcl_ListObjAppendElement(interp, result,
+ tv->tree.columns[columnNumber].idObj);
+ Tcl_ListObjAppendElement(interp, result, value);
+ }
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ }
+
+ /* else -- get or set column
+ */
+ if (!(column = FindColumn(interp, tv, objv[3])))
+ return TCL_ERROR;
+
+ if (column == &tv->tree.column0) {
+ /* @@@ Maybe set -text here instead? */
+ Tcl_AppendResult(interp, "Display column #0 cannot be set", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Note: we don't do any error checking in the list operations,
+ * since item->valuesObj is guaranteed to be a list.
+ */
+ columnNumber = column - tv->tree.columns;
+
+ if (objc == 4) { /* get column */
+ Tcl_Obj *result = 0;
+ Tcl_ListObjIndex(interp, item->valuesObj, columnNumber, &result);
+ if (!result) {
+ result = Tcl_NewStringObj("",0);
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ } else { /* set column */
+ int length;
+
+ item->valuesObj = unshare(item->valuesObj);
+
+ /* Make sure -values is fully populated:
+ */
+ Tcl_ListObjLength(interp, item->valuesObj, &length);
+ while (length < tv->tree.nColumns) {
+ Tcl_Obj *empty = Tcl_NewStringObj("",0);
+ Tcl_ListObjAppendElement(interp, item->valuesObj, empty);
+ ++length;
+ }
+
+ /* Set value:
+ */
+ Tcl_ListObjReplace(interp,item->valuesObj,columnNumber,1,1,objv+4);
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+ }
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- tree modification.
+ */
+
+/* + $tv insert $parent $index ?-id id? ?-option value...?
+ * Insert a new item.
+ */
+static int TreeviewInsertCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *parent, *sibling, *newItem;
+ Tcl_HashEntry *entryPtr;
+ int isNew;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "parent index ?-id id? -options...");
+ return TCL_ERROR;
+ }
+
+ /* Get parent node:
+ */
+ if ((parent = FindItem(interp, tv, objv[2])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Locate previous sibling based on $index:
+ */
+ if (!strcmp(Tcl_GetString(objv[3]), "end")) {
+ sibling = EndPosition(parent);
+ } else {
+ int index;
+ if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK)
+ return TCL_ERROR;
+ sibling = InsertPosition(parent, index);
+ }
+
+ /* Get node name:
+ * If -id supplied and does not already exist, use that;
+ * Otherwise autogenerate new one.
+ */
+ objc -= 4; objv += 4;
+ if (objc >= 2 && !strcmp("-id", Tcl_GetString(objv[0]))) {
+ const char *itemName = Tcl_GetString(objv[1]);
+ entryPtr = Tcl_CreateHashEntry(&tv->tree.items, itemName, &isNew);
+ if (!isNew) {
+ Tcl_AppendResult(interp, "Item ",itemName," already exists",NULL);
+ return TCL_ERROR;
+ }
+ objc -= 2; objv += 2;
+ } else {
+ char idbuf[16];
+ do {
+ ++tv->tree.serial;
+ sprintf(idbuf, "I%03X", tv->tree.serial);
+ entryPtr = Tcl_CreateHashEntry(&tv->tree.items, idbuf, &isNew);
+ } while (!isNew);
+ }
+
+ /* Create and configure new item:
+ */
+ newItem = NewItem();
+ Tk_InitOptions(
+ interp, (ClientData)newItem, tv->tree.itemOptionTable, tv->core.tkwin);
+ if (ConfigureItem(interp, tv, newItem, objc, objv) != TCL_OK) {
+ Tcl_DeleteHashEntry(entryPtr);
+ FreeItem(newItem);
+ return TCL_ERROR;
+ }
+
+ /* Store in hash table, link into tree:
+ */
+ Tcl_SetHashValue(entryPtr, newItem);
+ newItem->entryPtr = entryPtr;
+ InsertItem(parent, sibling, newItem);
+ TtkRedisplayWidget(&tv->core);
+
+ Tcl_SetObjResult(interp, ItemID(tv, newItem));
+ return TCL_OK;
+}
+
+/* + $tv detach $item --
+ * Unlink $item from the tree.
+ */
+static int TreeviewDetachCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem **items;
+ int i;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ if (!(items = GetItemListFromObj(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ /* Sanity-check */
+ for (i = 0; items[i]; ++i) {
+ if (items[i] == tv->tree.root) {
+ Tcl_AppendResult(interp, "Cannot detach root item", NULL);
+ ckfree((ClientData)items);
+ return TCL_ERROR;
+ }
+ }
+
+ for (i = 0; items[i]; ++i) {
+ DetachItem(items[i]);
+ }
+
+ TtkRedisplayWidget(&tv->core);
+ ckfree((ClientData)items);
+ return TCL_OK;
+}
+
+/* + $tv delete $items --
+ * Delete each item in $items.
+ *
+ * Do this in two passes:
+ * First detach the item and all its descendants and remove them
+ * from the hash table. Free the items themselves in a second pass.
+ *
+ * It's done this way because an item may appear more than once
+ * in the list of items to delete (either directly or as a descendant
+ * of a previously deleted item.)
+ */
+
+static int TreeviewDeleteCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem **items, *delq;
+ int i;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "items");
+ return TCL_ERROR;
+ }
+
+ if (!(items = GetItemListFromObj(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ /* Sanity-check:
+ */
+ for (i=0; items[i]; ++i) {
+ if (items[i] == tv->tree.root) {
+ ckfree((ClientData)items);
+ Tcl_AppendResult(interp, "Cannot delete root item", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /* Remove items from hash table.
+ */
+ delq = 0;
+ for (i=0; items[i]; ++i) {
+ delq = DeleteItems(items[i], delq);
+ }
+
+ /* Free items:
+ */
+ while (delq) {
+ TreeItem *next = delq->next;
+ if (tv->tree.focus == delq)
+ tv->tree.focus = 0;
+ FreeItem(delq);
+ delq = next;
+ }
+
+ ckfree((ClientData)items);
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+}
+
+/* + $tv move $item $parent $index
+ * Move $item to the specified $index in $parent's child list.
+ */
+static int TreeviewMoveCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item, *parent;
+ TreeItem *sibling;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item parent index");
+ return TCL_ERROR;
+ }
+ if ( (item = FindItem(interp, tv, objv[2])) == 0
+ || (parent = FindItem(interp, tv, objv[3])) == 0)
+ {
+ return TCL_ERROR;
+ }
+
+ /* Locate previous sibling based on $index:
+ */
+ if (!strcmp(Tcl_GetString(objv[4]), "end")) {
+ sibling = EndPosition(parent);
+ } else {
+ int index;
+ if (Tcl_GetIntFromObj(interp, objv[4], &index) != TCL_OK)
+ return TCL_ERROR;
+ sibling = InsertPosition(parent, index);
+ }
+
+ /* Check ancestry:
+ */
+ if (!AncestryCheck(interp, tv, item, parent))
+ return TCL_ERROR;
+
+ /* Moving an item after itself is a no-op:
+ */
+ if (item == sibling) {
+ return TCL_OK;
+ }
+
+ /* Move item:
+ */
+ DetachItem(item);
+ InsertItem(parent, sibling, item);
+
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- scrolling
+ */
+
+static int TreeviewYViewCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ return ScrollviewCommand(interp, objc, objv, tv->tree.yscrollHandle);
+}
+
+/* $tree see $item --
+ * Ensure that $item is visible.
+ */
+static int TreeviewSeeCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ TreeItem *item, *parent;
+ int rowNumber;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "item");
+ return TCL_ERROR;
+ }
+ if (!(item = FindItem(interp, tv, objv[2]))) {
+ return TCL_ERROR;
+ }
+
+ /* Make sure all ancestors are open:
+ */
+ for (parent = item->parent; parent; parent = parent->parent) {
+ if (!(parent->state & TTK_STATE_OPEN)) {
+ parent->openObj = unshare(parent->openObj);
+ Tcl_SetBooleanObj(parent->openObj, 1);
+ parent->state |= TTK_STATE_OPEN;
+ }
+ }
+
+ /* Make sure item is visible:
+ * @@@ DOUBLE-CHECK THIS:
+ */
+ rowNumber = RowNumber(tv, item);
+ if (rowNumber < tv->tree.yscroll.first) {
+ ScrollTo(tv->tree.yscrollHandle, rowNumber);
+ } else if (rowNumber >= tv->tree.yscroll.last) {
+ ScrollTo(tv->tree.yscrollHandle,
+ tv->tree.yscroll.first + (1+rowNumber - tv->tree.yscroll.last));
+ }
+
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- focus and selection
+ */
+
+/* + $tree focus ?item?
+ */
+static int TreeviewFocusCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+
+ if (objc == 2) {
+ if (tv->tree.focus) {
+ Tcl_SetObjResult(interp, ItemID(tv, tv->tree.focus));
+ }
+ return TCL_OK;
+ } else if (objc == 3) {
+ TreeItem *newFocus = FindItem(interp, tv, objv[2]);
+ if (!newFocus)
+ return TCL_ERROR;
+ tv->tree.focus = newFocus;
+ TtkRedisplayWidget(&tv->core);
+ return TCL_OK;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "?newFocus?");
+ return TCL_ERROR;
+ }
+}
+
+/* + $tree selection ?add|remove|set|toggle $items?
+ */
+static int TreeviewSelectionCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ enum {
+ SELECTION_SET, SELECTION_ADD, SELECTION_REMOVE, SELECTION_TOGGLE
+ };
+ static const char *selopStrings[] = {
+ "set", "add", "remove", "toggle", NULL
+ };
+
+ Treeview *tv = recordPtr;
+ int selop, i;
+ TreeItem *item, **items;
+
+ if (objc == 2) {
+ Tcl_Obj *result = Tcl_NewListObj(0,0);
+ for (item = tv->tree.root->children; item; item=NextPreorder(item)) {
+ if (item->state & TTK_STATE_SELECTED)
+ Tcl_ListObjAppendElement(NULL, result, ItemID(tv, item));
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+ }
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?add|remove|set|toggle items?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], selopStrings,
+ "selection operation", 0, &selop) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ items = GetItemListFromObj(interp, tv, objv[3]);
+ if (!items) {
+ return TCL_ERROR;
+ }
+
+ switch (selop)
+ {
+ case SELECTION_SET:
+ for (item=tv->tree.root; item; item=NextPreorder(item)) {
+ item->state &= ~TTK_STATE_SELECTED;
+ }
+ /*FALLTHRU*/
+ case SELECTION_ADD:
+ for (i=0; items[i]; ++i) {
+ items[i]->state |= TTK_STATE_SELECTED;
+ }
+ break;
+ case SELECTION_REMOVE:
+ for (i=0; items[i]; ++i) {
+ items[i]->state &= ~TTK_STATE_SELECTED;
+ }
+ break;
+ case SELECTION_TOGGLE:
+ for (i=0; items[i]; ++i) {
+ items[i]->state ^= TTK_STATE_SELECTED;
+ }
+ break;
+ }
+
+ ckfree((ClientData)items);
+ SendVirtualEvent(tv->core.tkwin, "TreeviewSelect");
+ TtkRedisplayWidget(&tv->core);
+
+ return TCL_OK;
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands -- tags and bindings.
+ */
+
+/* + $tv tag bind $tag ?$sequence ?$script??
+ */
+static int TreeviewTagBindCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ Ttk_Tag tag;
+
+ if (objc < 4 || objc > 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?sequence? ?script?");
+ return TCL_ERROR;
+ }
+
+ tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[3]);
+ if (!tag) { return TCL_ERROR; }
+
+ if (objc == 4) { /* $tv tag bind $tag */
+ Tk_GetAllBindings(interp, tv->tree.bindingTable, tag);
+ } else if (objc == 5) { /* $tv tag bind $tag $sequence */
+ /* TODO: distinguish "no such binding" (OK) from "bad pattern" (ERROR)
+ */
+ const char *script = Tk_GetBinding(interp,
+ tv->tree.bindingTable, tag, Tcl_GetString(objv[4]));
+ if (script != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(script,-1));
+ }
+ } else if (objc == 6) { /* $tv tag bind $tag $sequence $script */
+ CONST char *sequence = Tcl_GetString(objv[4]);
+ CONST char *script = Tcl_GetString(objv[5]);
+ unsigned long mask = Tk_CreateBinding(interp,
+ tv->tree.bindingTable, tag, sequence, script, 0);
+
+ /* Test mask to make sure event is supported:
+ */
+ if (mask & (~TreeviewBindEventMask)) {
+ Tk_DeleteBinding(interp, tv->tree.bindingTable, tag, sequence);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "unsupported event ", sequence,
+ "\nonly key, button, motion, and virtual events supported",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ return mask ? TCL_OK : TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/* + $tv tag configure $tag ?-option ?value -option value...??
+ */
+static int TreeviewTagConfigureCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ Treeview *tv = recordPtr;
+ void *tagRecord;
+ Ttk_Tag tag;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "tagName ?-option ?value ...??");
+ return TCL_ERROR;
+ }
+
+ tag = Ttk_GetTagFromObj(tv->tree.tagTable, objv[3]);
+ tagRecord = Ttk_TagRecord(tag);
+
+ if (objc == 4) {
+ return EnumerateOptions(interp, tagRecord, TagOptionSpecs,
+ tv->tree.tagOptionTable, tv->core.tkwin);
+ } else if (objc == 5) {
+ return GetOptionValue(interp, tagRecord, objv[4],
+ tv->tree.tagOptionTable, tv->core.tkwin);
+ }
+ /* else */
+ TtkRedisplayWidget(&tv->core);
+ return Tk_SetOptions(
+ interp, tagRecord, tv->tree.tagOptionTable,
+ objc - 4, objv + 4, tv->core.tkwin,
+ NULL/*savedOptions*/, NULL/*mask*/);
+}
+
+/* + $tv tag option args...
+ */
+static int TreeviewTagCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr)
+{
+ static WidgetCommandSpec TreeviewTagCommands[] = {
+ { "bind", TreeviewTagBindCommand },
+ { "configure", TreeviewTagConfigureCommand },
+ {0,0}
+ };
+ return WidgetEnsembleCommand(
+ TreeviewTagCommands, 2, interp, objc, objv, recordPtr);
+}
+
+/*------------------------------------------------------------------------
+ * +++ Widget commands record.
+ */
+static WidgetCommandSpec TreeviewCommands[] =
+{
+ { "bbox", TreeviewBBoxCommand },
+ { "children", TreeviewChildrenCommand },
+ { "cget", WidgetCgetCommand },
+ { "column", TreeviewColumnCommand },
+ { "configure", WidgetConfigureCommand },
+ { "delete", TreeviewDeleteCommand },
+ { "detach", TreeviewDetachCommand },
+ { "exists", TreeviewExistsCommand },
+ { "focus", TreeviewFocusCommand },
+ { "heading", TreeviewHeadingCommand },
+ { "identify", TreeviewIdentifyCommand },
+ { "index", TreeviewIndexCommand },
+ { "instate", WidgetInstateCommand },
+ { "insert", TreeviewInsertCommand },
+ { "item", TreeviewItemCommand },
+ { "move", TreeviewMoveCommand },
+ { "next", TreeviewNextCommand },
+ { "parent", TreeviewParentCommand },
+ { "prev", TreeviewPrevCommand },
+ { "see", TreeviewSeeCommand },
+ { "selection" , TreeviewSelectionCommand },
+ { "set", TreeviewSetCommand },
+ { "state", WidgetStateCommand },
+ { "tag", TreeviewTagCommand },
+ { "yview", TreeviewYViewCommand },
+ { NULL, NULL }
+};
+
+/*------------------------------------------------------------------------
+ * +++ Widget definition.
+ */
+
+WidgetSpec TreeviewWidgetSpec =
+{
+ "Treeview", /* className */
+ sizeof(Treeview), /* recordSize */
+ TreeviewOptionSpecs, /* optionSpecs */
+ TreeviewCommands, /* subcommands */
+ TreeviewInitialize, /* initializeProc */
+ TreeviewCleanup, /* cleanupProc */
+ TreeviewConfigure, /* configureProc */
+ NullPostConfigure, /* postConfigureProc */
+ TreeviewGetLayout, /* getLayoutProc */
+ TreeviewSize, /* sizeProc */
+ TreeviewDoLayout, /* layoutProc */
+ TreeviewDisplay /* displayProc */
+};
+
+/*------------------------------------------------------------------------
+ * +++ Layout specifications.
+ */
+
+TTK_BEGIN_LAYOUT(TreeviewLayout)
+ TTK_GROUP("Treeview.field", TTK_FILL_BOTH|TTK_BORDER,
+ TTK_GROUP("Treeview.padding", TTK_FILL_BOTH,
+ TTK_NODE("Treeview.client", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(ItemLayout)
+ TTK_GROUP("Treeitem.padding", TTK_FILL_BOTH,
+ TTK_NODE("Treeitem.indicator", TTK_PACK_LEFT)
+ TTK_NODE("Treeitem.image", TTK_PACK_LEFT)
+ TTK_GROUP("Treeitem.focus", TTK_PACK_LEFT,
+ TTK_NODE("Treeitem.text", TTK_PACK_LEFT)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(CellLayout)
+ TTK_GROUP("Treedata.padding", TTK_FILL_BOTH,
+ TTK_NODE("Treeitem.label", TTK_FILL_BOTH))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HeadingLayout)
+ TTK_NODE("Treeheading.cell", TTK_FILL_BOTH)
+ TTK_GROUP("Treeheading.border", TTK_FILL_BOTH,
+ TTK_NODE("Treeheading.image", TTK_PACK_RIGHT)
+ TTK_NODE("Treeheading.text", TTK_FILL_X))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(RowLayout)
+ TTK_NODE("Treeitem.row", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+/*------------------------------------------------------------------------
+ * +++ Tree indicator element.
+ */
+
+#if defined(WIN32)
+static const int WIN32_XDRAWLINE_HACK = 1;
+#else
+static const int WIN32_XDRAWLINE_HACK = 0;
+#endif
+
+typedef struct
+{
+ Tcl_Obj *colorObj;
+ Tcl_Obj *sizeObj;
+ Tcl_Obj *marginsObj;
+} TreeitemIndicator;
+
+static Ttk_ElementOptionSpec TreeitemIndicatorOptions[] =
+{
+ { "-foreground", TK_OPTION_COLOR,
+ Tk_Offset(TreeitemIndicator,colorObj), DEFAULT_FOREGROUND },
+ { "-indicatorsize", TK_OPTION_PIXELS,
+ Tk_Offset(TreeitemIndicator,sizeObj), "12" },
+ { "-indicatormargins", TK_OPTION_STRING,
+ Tk_Offset(TreeitemIndicator,marginsObj), "2 2 4 2" },
+ {NULL}
+};
+
+static void TreeitemIndicatorSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TreeitemIndicator *indicator = elementRecord;
+ int size = 0;
+
+ Ttk_GetPaddingFromObj(NULL, tkwin, indicator->marginsObj, paddingPtr);
+ Tk_GetPixelsFromObj(NULL, tkwin, indicator->sizeObj, &size);
+
+ *widthPtr = *heightPtr = size;
+}
+
+static void TreeitemIndicatorDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ TreeitemIndicator *indicator = elementRecord;
+ ArrowDirection direction =
+ (state & TTK_STATE_OPEN) ? ARROW_DOWN : ARROW_RIGHT;
+ Ttk_Padding margins;
+ XColor *borderColor = Tk_GetColorFromObj(tkwin, indicator->colorObj);
+ XGCValues gcvalues; GC gc; unsigned mask;
+
+ if (state & TTK_STATE_LEAF) /* don't draw anything */
+ return;
+
+ Ttk_GetPaddingFromObj(NULL,tkwin,indicator->marginsObj,&margins);
+ b = Ttk_PadBox(b, margins);
+
+ gcvalues.foreground = borderColor->pixel;
+ gcvalues.line_width = 1;
+ mask = GCForeground | GCLineWidth;
+ gc = Tk_GetGC(tkwin, mask, &gcvalues);
+
+ DrawArrow(Tk_Display(tkwin), d, gc, b, direction);
+
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+}
+
+static Ttk_ElementSpec TreeitemIndicatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(TreeitemIndicator),
+ TreeitemIndicatorOptions,
+ TreeitemIndicatorSize,
+ TreeitemIndicatorDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Row element.
+ */
+
+typedef struct
+{
+ Tcl_Obj *backgroundObj;
+ Tcl_Obj *rowNumberObj;
+} RowElement;
+
+static Ttk_ElementOptionSpec RowElementOptions[] =
+{
+ { "-background", TK_OPTION_COLOR,
+ Tk_Offset(RowElement,backgroundObj), DEFAULT_BACKGROUND },
+ { "-rownumber", TK_OPTION_INT,
+ Tk_Offset(RowElement,rowNumberObj), "0" },
+ {NULL}
+};
+
+static void RowElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ RowElement *row = elementRecord;
+ XColor *color = Tk_GetColorFromObj(tkwin, row->backgroundObj);
+ GC gc = Tk_GCForColor(color, d);
+ XFillRectangle(Tk_Display(tkwin), d, gc,
+ b.x, b.y, b.width, b.height);
+}
+
+static Ttk_ElementSpec RowElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(RowElement),
+ RowElementOptions,
+ NullElementGeometry,
+ RowElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Initialisation.
+ */
+DLLEXPORT int Treeview_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme theme = Ttk_GetDefaultTheme(interp);
+
+ RegisterWidget(interp, "ttk::treeview", &TreeviewWidgetSpec);
+
+ Ttk_RegisterElement(interp, theme,
+ "Treeitem.indicator", &TreeitemIndicatorElementSpec, 0);
+ Ttk_RegisterElement(interp, theme, "Treeitem.row", &RowElementSpec, 0);
+ Ttk_RegisterElement(interp, theme, "Treeheading.cell", &RowElementSpec, 0);
+
+ Ttk_RegisterLayout(theme, TreeviewWidgetSpec.className, TreeviewLayout);
+ Ttk_RegisterLayout(theme, "Item", ItemLayout);
+ Ttk_RegisterLayout(theme, "Cell", CellLayout);
+ Ttk_RegisterLayout(theme, "Heading", HeadingLayout);
+ Ttk_RegisterLayout(theme, "Row", RowLayout);
+
+ Tcl_PkgProvide(interp, "ttk::treeview", TTK_VERSION);
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkWidget.c b/generic/ttk/ttkWidget.c
new file mode 100644
index 0000000..6f4e56f
--- /dev/null
+++ b/generic/ttk/ttkWidget.c
@@ -0,0 +1,786 @@
+/* $Id: ttkWidget.c,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Copyright (c) 2003, Joe English
+ *
+ * Ttk widget implementation, core widget utilities.
+ *
+ */
+
+#include <string.h>
+#include <tk.h>
+#include "ttkTheme.h"
+#include "ttkWidget.h"
+
+/*------------------------------------------------------------------------
+ * Helper routines.
+ */
+
+static void UpdateLayout(Tcl_Interp *interp, WidgetCore *corePtr)
+{
+ Ttk_Theme themePtr = Ttk_GetCurrentTheme(interp);
+ Ttk_Layout newLayout =
+ corePtr->widgetSpec->getLayoutProc(interp, themePtr,corePtr);
+
+ /* TODO: @@@ Check for errors */
+ if (newLayout) {
+ if (corePtr->layout) {
+ Ttk_FreeLayout(corePtr->layout);
+ }
+ corePtr->layout = newLayout;
+ }
+}
+
+static void UpdateGeometry(WidgetCore *corePtr)
+{
+ int reqWidth = 1, reqHeight = 1;
+
+ if (corePtr->widgetSpec->sizeProc(corePtr,&reqWidth,&reqHeight)) {
+ Tk_GeometryRequest(corePtr->tkwin, reqWidth, reqHeight);
+ }
+}
+
+/*
+ * RedisplayWidget --
+ * Redraw a widget. Called as an idle handler.
+ */
+
+static void RedisplayWidget(ClientData recordPtr)
+{
+ WidgetCore *corePtr = (WidgetCore *)recordPtr;
+ Tk_Window tkwin = corePtr->tkwin;
+ Drawable d;
+ XGCValues gcValues;
+ GC gc;
+
+ corePtr->flags &= ~REDISPLAY_PENDING;
+ if (!Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * Get a Pixmap for drawing in the background:
+ */
+ d = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin),
+ DefaultDepthOfScreen(Tk_Screen(tkwin)));
+
+ /*
+ * Get a GC for blitting the pixmap to the display:
+ */
+ gcValues.function = GXcopy;
+ gcValues.graphics_exposures = False;
+ gc = Tk_GetGC(corePtr->tkwin, GCFunction|GCGraphicsExposures, &gcValues);
+
+ /*
+ * Recompute layout and draw widget contents:
+ */
+ corePtr->widgetSpec->layoutProc(recordPtr);
+ corePtr->widgetSpec->displayProc(recordPtr, d);
+
+ /*
+ * Copy to the screen.
+ */
+ XCopyArea(Tk_Display(tkwin), d, Tk_WindowId(tkwin), gc,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+
+ /*
+ * Release resources
+ */
+ Tk_FreePixmap(Tk_Display(tkwin), d);
+ Tk_FreeGC(Tk_Display(tkwin), gc);
+}
+
+/* TtkRedisplayWidget --
+ * Schedule redisplay as an idle handler.
+ */
+
+void TtkRedisplayWidget(WidgetCore *corePtr)
+{
+ if (corePtr->flags & WIDGET_DESTROYED) {
+ return;
+ }
+
+ if (!(corePtr->flags & REDISPLAY_PENDING)) {
+ Tcl_DoWhenIdle(RedisplayWidget, (ClientData) corePtr);
+ corePtr->flags |= REDISPLAY_PENDING;
+ }
+}
+
+/* TtkResizeWidget --
+ * Recompute widget size, schedule geometry propagation and redisplay.
+ */
+
+void TtkResizeWidget(WidgetCore *corePtr)
+{
+ if (corePtr->flags & WIDGET_DESTROYED) {
+ return;
+ }
+
+ UpdateGeometry(corePtr);
+ TtkRedisplayWidget(corePtr);
+}
+
+/* WidgetEnsembleCommand --
+ * Invoke an ensemble defined by a WidgetCommandSpec.
+ */
+int WidgetEnsembleCommand(
+ WidgetCommandSpec *commands, /* Ensemble definition */
+ int cmdIndex, /* Index of command word */
+ Tcl_Interp *interp, /* Interpreter to use */
+ int objc, Tcl_Obj *const objv[], /* Argument vector */
+ void *clientData) /* User data (widget record pointer) */
+{
+ int index;
+
+ if (objc <= cmdIndex) {
+ Tcl_WrongNumArgs(interp, cmdIndex, objv, "option ?arg arg...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObjStruct(interp, objv[cmdIndex], commands,
+ sizeof(commands[0]), "command", 0, &index) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+ return commands[index].command(interp, objc, objv, clientData);
+}
+
+/*
+ * WidgetInstanceObjCmd --
+ * Widget instance command implementation.
+ */
+static int
+WidgetInstanceObjCmd(
+ ClientData clientData, /* Widget record pointer */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj * CONST objv[]) /* Argument objects. */
+{
+ WidgetCore *corePtr = (WidgetCore *)clientData;
+ WidgetCommandSpec *commands = corePtr->widgetSpec->commands;
+ int status = TCL_OK;
+
+ Tcl_Preserve(clientData);
+ status = WidgetEnsembleCommand(commands, 1, interp, objc, objv, clientData);
+ Tcl_Release(clientData);
+
+ return status;
+}
+
+/*
+ * Command deletion callback for widget instance commands.
+ */
+static void
+WidgetInstanceObjCmdDeleted(ClientData clientData)
+{
+ WidgetCore *corePtr = (WidgetCore *) clientData;
+ corePtr->widgetCmd = NULL;
+ if (corePtr->tkwin != NULL)
+ Tk_DestroyWindow(corePtr->tkwin);
+}
+
+/*
+ * WidgetCleanup --
+ * Final cleanup for widget.
+ *
+ * @@@ TODO: check all code paths leading to widget destruction,
+ * @@@ describe here.
+ * @@@ Call widget-specific cleanup routine at an appropriate point.
+ */
+static void
+WidgetCleanup(char *memPtr)
+{
+ ckfree(memPtr);
+}
+
+/*
+ * 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, clear/set the background state flag.
+ *
+ * <<NOTE-REALIZED>> On the first ConfigureNotify event
+ * (which indicates that the window has just been created),
+ * update the layout. This is to work around two problems:
+ * (1) Virtual events aren't delivered to unrealized widgets
+ * (see bug #835997), so any intervening <<ThemeChanged>> events
+ * will not have been processed.
+ *
+ * (2) Geometry calculations in the XP theme don't work
+ * until the widget is realized.
+ */
+
+static const unsigned CoreEventMask
+ = ExposureMask
+ | StructureNotifyMask
+ | FocusChangeMask
+ | VirtualEventMask
+ | ActivateMask
+ ;
+
+static void CoreEventProc(ClientData clientData, XEvent *eventPtr)
+{
+ WidgetCore *corePtr = (WidgetCore *) clientData;
+
+ switch (eventPtr->type)
+ {
+ case ConfigureNotify :
+ if (!(corePtr->flags & WIDGET_REALIZED)) {
+ /* See <<NOTE-REALIZED>> */
+ UpdateLayout(corePtr->interp, corePtr);
+ UpdateGeometry(corePtr);
+ corePtr->flags |= WIDGET_REALIZED;
+ }
+ TtkRedisplayWidget(corePtr);
+ break;
+ case Expose :
+ if (eventPtr->xexpose.count == 0) {
+ TtkRedisplayWidget(corePtr);
+ }
+ break;
+ case DestroyNotify :
+ corePtr->flags |= WIDGET_DESTROYED;
+
+ Tk_DeleteEventHandler(corePtr->tkwin,
+ CoreEventMask,CoreEventProc,clientData);
+
+ if (corePtr->flags & REDISPLAY_PENDING) {
+ Tcl_CancelIdleCall(RedisplayWidget, clientData);
+ }
+
+ corePtr->widgetSpec->cleanupProc(corePtr);
+
+ Tk_FreeConfigOptions(
+ clientData, corePtr->optionTable, corePtr->tkwin);
+ corePtr->tkwin = NULL;
+
+ if (corePtr->layout) {
+ Ttk_FreeLayout(corePtr->layout);
+ }
+
+ /* NB: this can reenter the interpreter via a command traces */
+ if (corePtr->widgetCmd) {
+ Tcl_Command cmd = corePtr->widgetCmd;
+ corePtr->widgetCmd = 0;
+ Tcl_DeleteCommandFromToken(corePtr->interp, cmd);
+ }
+ Tcl_EventuallyFree(clientData, WidgetCleanup);
+ 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 VirtualEvent:
+ if (!strcmp("ThemeChanged", ((XVirtualEvent *)(eventPtr))->name)) {
+ UpdateLayout(corePtr->interp, corePtr);
+ UpdateGeometry(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 = (WidgetCore*)clientData;
+ UpdateGeometry(corePtr);
+ TtkRedisplayWidget(corePtr);
+}
+
+static struct Tk_ClassProcs widgetClassProcs = {
+ sizeof(Tk_ClassProcs),
+ WidgetWorldChanged
+};
+
+/*
+ * WidgetConstructorObjCmd --
+ * General-purpose widget constructor command implementation.
+ * ClientData is a WidgetSpec *.
+ */
+int WidgetConstructorObjCmd(
+ ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
+{
+ WidgetSpec *widgetSpec = (WidgetSpec *)clientData;
+ const char *className = widgetSpec->className;
+ WidgetCore *corePtr;
+ ClientData recordPtr;
+ Tk_Window tkwin;
+ Tk_OptionTable optionTable;
+ int i;
+
+ if (objc < 2 || objc % 1 == 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetStringFromObj(objv[1], NULL), (char *) NULL);
+ if (tkwin == NULL)
+ return TCL_ERROR;
+
+ /*
+ * Check if a -class resource 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) {
+ const char *resourceName = Tcl_GetString(objv[i]);
+ if (!strcmp(resourceName, "-class")) {
+ className = Tcl_GetString(objv[i+1]);
+ break;
+ }
+ }
+
+ Tk_SetClass(tkwin, className);
+
+ /*
+ * Set the BackgroundPixmap to ParentRelative here, so
+ * subclasses don't need to worry about setting the background.
+ */
+ Tk_SetWindowBackgroundPixmap(tkwin, ParentRelative);
+
+ optionTable = Tk_CreateOptionTable(interp, widgetSpec->optionSpecs);
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+ recordPtr = ckalloc(widgetSpec->recordSize);
+ memset(recordPtr, 0, widgetSpec->recordSize);
+ corePtr = (WidgetCore *)recordPtr;
+
+ corePtr->tkwin = tkwin;
+ corePtr->interp = interp;
+ corePtr->widgetSpec = widgetSpec;
+ corePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin),
+ WidgetInstanceObjCmd, recordPtr, WidgetInstanceObjCmdDeleted);
+ corePtr->optionTable = optionTable;
+
+ Tk_SetClassProcs(tkwin, &widgetClassProcs, recordPtr);
+
+ if (Tk_InitOptions(interp, recordPtr, optionTable, tkwin) != TCL_OK)
+ goto error;
+
+ if (widgetSpec->initializeProc(interp, recordPtr) != TCL_OK)
+ goto error;
+
+ if (Tk_SetOptions(interp, recordPtr, optionTable, objc - 2,
+ objv + 2, tkwin, NULL/*savePtr*/, (int *)NULL/*maskPtr*/) != TCL_OK)
+ goto error;
+
+ 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;
+
+ UpdateLayout(interp, corePtr);
+ UpdateGeometry(corePtr);
+
+ Tk_CreateEventHandler(tkwin, CoreEventMask, CoreEventProc, recordPtr);
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin), -1));
+
+ return TCL_OK;
+
+error:
+ if (corePtr->layout) {
+ Ttk_FreeLayout(corePtr->layout);
+ corePtr->layout = 0;
+ }
+ Tk_FreeConfigOptions(recordPtr, optionTable, tkwin);
+ Tk_DestroyWindow(tkwin);
+ corePtr->tkwin = 0;
+ Tcl_DeleteCommandFromToken(interp, corePtr->widgetCmd);
+ ckfree(recordPtr);
+ return TCL_ERROR;
+}
+
+/*
+ * WidgetChangeState --
+ * Set / clear the specified bits in the 'state' flag,
+ */
+void WidgetChangeState(WidgetCore *corePtr,
+ unsigned int setBits, unsigned int clearBits)
+{
+ Ttk_State oldState = corePtr->state;
+ corePtr->state = (oldState & ~clearBits) | setBits;
+ if (corePtr->state ^ oldState) {
+ TtkRedisplayWidget(corePtr);
+ }
+}
+
+/*
+ * WidgetGetLayout --
+ * Default getLayoutProc.
+ * Looks up the layout based on the -style resource (if specified),
+ * otherwise use the widget class.
+ */
+Ttk_Layout WidgetGetLayout(
+ 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);
+}
+
+/*
+ * WidgetGetOrientedLayout --
+ * Helper routine. Same as WidgetGetLayout, but prefixes
+ * "Horizontal." or "Vertical." to the style name, depending
+ * on the value of the 'orient' option.
+ */
+Ttk_Layout WidgetGetOrientedLayout(
+ 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;
+}
+
+/*
+ * NullInitialize --
+ * Default widget initializeProc (no-op)
+ */
+int NullInitialize(Tcl_Interp *interp, void *recordPtr)
+{
+ return TCL_OK;
+}
+
+/*
+ * NullPostConfigure --
+ * Default widget postConfigureProc (no-op)
+ */
+int NullPostConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+ return TCL_OK;
+}
+
+/* CoreConfigure --
+ * Default widget configureProc.
+ */
+int CoreConfigure(Tcl_Interp *interp, void *clientData, int mask)
+{
+ WidgetCore *corePtr = clientData;
+
+ if (mask & STYLE_CHANGED) {
+ Ttk_Theme theme = Ttk_GetCurrentTheme(interp);
+ Ttk_Layout newLayout =
+ corePtr->widgetSpec->getLayoutProc(interp,theme,corePtr);
+
+ if (!newLayout) {
+ return TCL_ERROR;
+ }
+ if (corePtr->layout) {
+ Ttk_FreeLayout(corePtr->layout);
+ }
+ corePtr->layout = newLayout;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ * NullCleanup --
+ * Default widget cleanupProc (no-op)
+ */
+void NullCleanup(void *recordPtr)
+{
+ return;
+}
+
+/*
+ * WidgetDoLayout --
+ * Default widget layoutProc.
+ */
+void WidgetDoLayout(void *clientData)
+{
+ WidgetCore *corePtr = clientData;
+ Ttk_PlaceLayout(corePtr->layout,corePtr->state,Ttk_WinBox(corePtr->tkwin));
+}
+
+/*
+ * WidgetDisplay --
+ * Default widget displayProc.
+ */
+void WidgetDisplay(void *recordPtr, Drawable d)
+{
+ WidgetCore *corePtr = recordPtr;
+ Ttk_DrawLayout(corePtr->layout, corePtr->state, d);
+}
+
+/*
+ * WidgetSize --
+ * Default widget sizeProc()
+ */
+int WidgetSize(void *recordPtr, int *widthPtr, int *heightPtr)
+{
+ WidgetCore *corePtr = recordPtr;
+ Ttk_LayoutSize(corePtr->layout, corePtr->state, widthPtr, heightPtr);
+ return 1;
+
+/* OR: (@@@)
+ return *widthPtr > Tk_Width(corePtr->tkwin)
+ || *heightPtr > Tk_Height(corePtr->tkwin);
+*/
+}
+
+
+/* Default implementations for widget subcommands:
+*/
+int WidgetCgetCommand(
+Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[], void *recordPtr)
+{
+ 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;
+}
+
+int WidgetConfigureCommand(
+Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ WidgetCore *corePtr = recordPtr;
+ Tcl_Obj *result;
+
+ if (objc == 2) {
+ result = Tk_GetOptionInfo(interp, recordPtr,
+ corePtr->optionTable, (Tcl_Obj *) 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_SetResult(interp,
+ "Attempt to change read-only option", TCL_STATIC);
+ 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 (status != TCL_OK) {
+ return status;
+ }
+
+ if (mask & (STYLE_CHANGED | GEOMETRY_CHANGED)) {
+ UpdateGeometry(corePtr);
+ }
+
+ TtkRedisplayWidget(corePtr);
+ result = Tcl_NewObj();
+ }
+
+ if (result == 0) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, result);
+ return TCL_OK;
+}
+
+/* $w state $stateSpec
+ * $w state
+ *
+ * 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 WidgetStateCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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 WidgetInstateCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ 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
+ * Returns: name of element at $x, $y
+ */
+int WidgetIdentifyCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], void *recordPtr)
+{
+ WidgetCore *corePtr = recordPtr;
+ Ttk_LayoutNode *node;
+ int x, y;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)
+ return TCL_ERROR;
+
+ node = Ttk_LayoutIdentify(corePtr->layout, x, y);
+ if (node) {
+ const char *elementName = Ttk_LayoutNodeName(node);
+ Tcl_SetObjResult(interp,Tcl_NewStringObj(elementName,-1));
+ }
+
+ return TCL_OK;
+}
+
+/*EOF*/
diff --git a/generic/ttk/ttkWidget.h b/generic/ttk/ttkWidget.h
new file mode 100644
index 0000000..aa749ee
--- /dev/null
+++ b/generic/ttk/ttkWidget.h
@@ -0,0 +1,269 @@
+/* $Id: ttkWidget.h,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+ * Copyright (c) 2003, Joe English
+ *
+ * Helper routines for widget implementations.
+ *
+ * Require: ttkTheme.h.
+ */
+
+#ifndef WIDGET_H
+#define WIDGET_H 1
+
+/* State flags for 'flags' field.
+ * @@@ todo: distinguish:
+ * need reconfigure, need redisplay, redisplay pending
+ */
+#define WIDGET_DESTROYED 0x0001
+#define REDISPLAY_PENDING 0x0002 /* scheduled call to RedisplayWidget */
+#define WIDGET_REALIZED 0x0010 /* set at first ConfigureNotify */
+#define CURSOR_ON 0x0020 /* See BlinkCursor() */
+#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;
+
+/*
+ * Subcommand specifications:
+ */
+typedef int (*WidgetSubcommandProc)(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr);
+typedef struct {
+ const char *name;
+ WidgetSubcommandProc command;
+} WidgetCommandSpec;
+
+extern int WidgetEnsembleCommand( /* Run an ensemble command */
+ WidgetCommandSpec *commands, int cmdIndex,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr);
+
+/*
+ * Widget specifications:
+ */
+struct WidgetSpec_
+{
+ const char *className; /* Widget class name */
+ size_t recordSize; /* #bytes in widget record */
+ Tk_OptionSpec *optionSpecs; /* Option specifications */
+ WidgetCommandSpec *commands; /* Widget instance subcommands */
+
+ /*
+ * Hooks:
+ */
+ int (*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:
+ */
+extern int NullInitialize(Tcl_Interp *, void *);
+extern int NullPostConfigure(Tcl_Interp *, void *, int);
+extern void NullCleanup(void *recordPtr);
+extern Ttk_Layout WidgetGetLayout(Tcl_Interp *, Ttk_Theme, void *recordPtr);
+extern Ttk_Layout WidgetGetOrientedLayout(
+ Tcl_Interp *, Ttk_Theme, void *recordPtr, Tcl_Obj *orientObj);
+extern int WidgetSize(void *recordPtr, int *w, int *h);
+extern void WidgetDoLayout(void *recordPtr);
+extern void WidgetDisplay(void *recordPtr, Drawable);
+
+extern int CoreConfigure(Tcl_Interp*, void *, int mask);
+
+/* Commands present in all widgets:
+ */
+extern int WidgetConfigureCommand(Tcl_Interp *, int, Tcl_Obj*const[], void *);
+extern int WidgetCgetCommand(Tcl_Interp *, int, Tcl_Obj*const[], void *);
+extern int WidgetInstateCommand(Tcl_Interp *, int, Tcl_Obj*const[], void *);
+extern int WidgetStateCommand(Tcl_Interp *, int, Tcl_Obj*const[], void *);
+
+/* Common widget commands:
+ */
+extern int WidgetIdentifyCommand(Tcl_Interp *, int, Tcl_Obj*const[], void *);
+
+extern int WidgetConstructorObjCmd(ClientData,Tcl_Interp*,int,Tcl_Obj*CONST[]);
+
+#define RegisterWidget(interp, name, specPtr) \
+ Tcl_CreateObjCommand(interp, name, \
+ WidgetConstructorObjCmd, (ClientData)specPtr,NULL)
+
+/* WIDGET_TAKES_FOCUS --
+ * Add this to the OptionSpecs table of widgets that
+ * take keyboard focus during traversal to override
+ * CoreOptionSpec's -takefocus default value:
+ */
+#define WIDGET_TAKES_FOCUS \
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", \
+ "ttk::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}
+
+/*
+ * Useful routines for use inside widget implementations:
+ */
+extern int WidgetDestroyed(WidgetCore *);
+#define WidgetDestroyed(corePtr) ((corePtr)->flags & WIDGET_DESTROYED)
+
+extern void WidgetChangeState(WidgetCore *,
+ unsigned int setBits, unsigned int clearBits);
+
+extern void TtkRedisplayWidget(WidgetCore *);
+extern void TtkResizeWidget(WidgetCore *);
+
+extern void TrackElementState(WidgetCore *);
+extern void BlinkCursor(WidgetCore *);
+
+/*
+ * -state option values (compatibility)
+ */
+extern void CheckStateOption(WidgetCore *, Tcl_Obj *);
+
+/*
+ * Variable traces:
+ */
+typedef void (*Ttk_TraceProc)(void *recordPtr, const char *value);
+typedef struct TtkTraceHandle_ Ttk_TraceHandle;
+
+extern Ttk_TraceHandle *Ttk_TraceVariable(
+ Tcl_Interp*, Tcl_Obj *varnameObj, Ttk_TraceProc callback, void *clientData);
+extern void Ttk_UntraceVariable(Ttk_TraceHandle *);
+extern int Ttk_FireTrace(Ttk_TraceHandle *);
+
+/*
+ * Utility routines for managing -image option:
+ */
+extern int GetImageList(
+ Tcl_Interp *, WidgetCore *, Tcl_Obj *imageOption, Tk_Image **imageListPtr);
+extern void FreeImageList(Tk_Image *);
+
+/*
+ * Virtual events:
+ */
+extern void SendVirtualEvent(Tk_Window tgtWin, const char *eventName);
+
+/*
+ * Helper routines for data accessor commands:
+ */
+extern int EnumerateOptions(
+ Tcl_Interp *, void *recordPtr, Tk_OptionSpec *, Tk_OptionTable, Tk_Window);
+extern int GetOptionValue(
+ Tcl_Interp *, void *recordPtr, 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;
+
+extern ScrollHandle CreateScrollHandle(WidgetCore *, Scrollable *);
+extern void FreeScrollHandle(ScrollHandle);
+
+extern int ScrollviewCommand(
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], ScrollHandle);
+
+extern void ScrollTo(ScrollHandle, int newFirst);
+extern void Scrolled(ScrollHandle, int first, int last, int total);
+extern void ScrollbarUpdateRequired(ScrollHandle);
+
+/*
+ * Tag sets (work in progress, half-baked)
+ */
+
+typedef struct TtkTag *Ttk_Tag;
+typedef struct TtkTagTable *Ttk_TagTable;
+
+extern Ttk_TagTable Ttk_CreateTagTable(Tk_OptionTable, int tagRecSize);
+extern void Ttk_DeleteTagTable(Ttk_TagTable);
+
+extern Ttk_Tag Ttk_GetTag(Ttk_TagTable, const char *tagName);
+extern Ttk_Tag Ttk_GetTagFromObj(Ttk_TagTable, Tcl_Obj *);
+
+extern Tcl_Obj **Ttk_TagRecord(Ttk_Tag);
+
+extern int Ttk_GetTagListFromObj(
+ Tcl_Interp *interp, Ttk_TagTable, Tcl_Obj *objPtr,
+ int *nTags_rtn, void **taglist_rtn);
+
+extern void Ttk_FreeTagList(void **taglist);
+
+
+/*
+ * Useful widget base classes:
+ */
+extern Tk_OptionSpec CoreOptionSpecs[];
+
+/*
+ * String tables for widget resource specifications:
+ */
+
+extern const char *TTKOrientStrings[];
+extern const char *TTKCompoundStrings[];
+extern const char *TTKDefaultStrings[];
+
+/*
+ * ... other option types...
+ */
+extern int TtkGetLabelAnchorFromObj(Tcl_Interp*,Tcl_Obj*,Ttk_PositionSpec *);
+
+/*
+ * Package initialiation routines:
+ */
+extern void RegisterElements(Tcl_Interp *);
+
+#if defined(__WIN32__)
+#define Ttk_PlatformInit Ttk_WinPlatformInit
+extern int Ttk_WinPlatformInit(Tcl_Interp *);
+#elif defined(MAC_OSX_TK)
+#define Ttk_PlatformInit Ttk_MacPlatformInit
+extern int Ttk_MacPlatformInit(Tcl_Interp *);
+#else
+#define Ttk_PlatformInit(interp) /* TTK_X11PlatformInit() */
+#endif
+
+#endif /* WIDGET_H */
diff --git a/library/demos/ttk_demo.tcl b/library/demos/ttk_demo.tcl
new file mode 100644
index 0000000..0686b62
--- /dev/null
+++ b/library/demos/ttk_demo.tcl
@@ -0,0 +1,883 @@
+#
+# $Id: ttk_demo.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+#
+# Tile widget set -- widget demo
+#
+package require Tk 8.5
+
+eval destroy [winfo children .] ;# in case script is re-sourced
+
+### Load auxilliary scripts.
+#
+variable demodir [file dirname [info script]]
+lappend auto_path . $demodir
+
+source [file join $demodir ttk_iconlib.tcl]
+source [file join $demodir ttk_repeater.tcl]
+
+# This forces an update of the available packages list.
+# It's required for package names to find the themes in demos/themes/*.tcl
+eval [package unknown] Tcl [package provide Tcl]
+
+### Global options and bindings.
+#
+option add *Button.default normal
+option add *Text.background white
+option add *Entry.background white
+option add *tearOff false
+
+# See toolbutton.tcl.
+#
+option add *Toolbar.relief groove
+option add *Toolbar.borderWidth 2
+option add *Toolbar.Button.Pad 2
+option add *Toolbar.Button.default disabled
+option add *Toolbar*takeFocus 0
+
+# ... for debugging:
+bind all <ButtonPress-3> { set ::W %W }
+bind all <Control-ButtonPress-3> { focus %W }
+
+# Stealth feature:
+#
+if {![catch {package require Img 1.3}]} {
+ bind all <Control-Shift-Alt-KeyPress-S> screenshot
+ proc screenshot {} {
+ image create photo ScreenShot -format window -data .
+ bell
+ # Gamma looks off if we use PNG ...
+ # Looks even worse if we use GIF ...
+ ScreenShot write screenshot.png -format png
+ image delete ScreenShot
+ bell
+ }
+}
+
+### Global data.
+#
+
+# The descriptive names of the builtin themes:
+#
+set ::THEMELIST {
+ default "Default"
+ classic "Classic"
+ alt "Revitalized"
+ winnative "Windows native"
+ xpnative "XP Native"
+ aqua "Aqua"
+}
+array set ::THEMES $THEMELIST;
+
+# Add in any available loadable themes:
+#
+foreach name [ttk::themes] {
+ if {![info exists ::THEMES($name)]} {
+ lappend THEMELIST $name [set ::THEMES($name) [string totitle $name]]
+ }
+}
+
+# Generate icons (see also: iconlib.tcl):
+#
+foreach {icon data} [array get ::ImgData] {
+ set ::ICON($icon) [image create photo -data $data]
+}
+
+variable ROOT "."
+variable BASE [ttk::frame .base]
+pack $BASE -side top -expand true -fill both
+
+array set ::V {
+ COMPOUND top
+ CONSOLE 0
+ MENURADIO1 One
+ PBMODE determinate
+ SELECTED 1
+ CHOICE 2
+ SCALE 50
+ VSCALE 0
+}
+
+### Utilities.
+#
+
+## foreachWidget varname widget script --
+# Execute $script with $varname set to each widget in the hierarchy.
+#
+proc foreachWidget {varname Q script} {
+ upvar 1 $varname w
+ while {[llength $Q]} {
+ set QN [list]
+ foreach w $Q {
+ uplevel 1 $script
+ foreach child [winfo children $w] {
+ lappend QN $child
+ }
+ }
+ set Q $QN
+ }
+}
+
+## sbstub $sb -- stub -command option for a scrollbar.
+# Updates the scrollbar's position.
+#
+proc sbstub {sb cmd number {units units}} { sbstub.$cmd $sb $number $units }
+proc sbstub.moveto {sb number _} { $sb set $number [expr {$number + 0.5}] }
+proc sbstub.scroll {sb number units} {
+ if {$units eq "pages"} {
+ set delta 0.2
+ } else {
+ set delta 0.05
+ }
+ set current [$sb get]
+ set new0 [expr {[lindex $current 0] + $delta*$number}]
+ set new1 [expr {[lindex $current 1] + $delta*$number}]
+ $sb set $new0 $new1
+}
+
+## sbset $sb -- auto-hide scrollbar
+# Scrollable widget -[xy]scrollcommand prefix.
+# Sets the scrollbar, auto-hides/shows.
+# Scrollbar must be controlled by the grid geometry manager.
+#
+proc sbset {sb first last} {
+ if {$first <= 0 && $last >= 1} {
+ grid remove $sb
+ } else {
+ grid $sb
+ }
+ $sb set $first $last
+}
+
+## scrolled -- create a widget with attached scrollbars.
+#
+proc scrolled {class w args} {
+ set sf "${w}_sf"
+
+ frame $sf
+ eval [linsert $args 0 $class $w]
+ scrollbar $sf.hsb -orient horizontal -command [list $w xview]
+ scrollbar $sf.vsb -orient vertical -command [list $w yview]
+
+ configure.scrolled $sf $w
+ return $sf
+}
+
+## ttk::scrolled -- create a widget with attached Ttk scrollbars.
+#
+proc ttk::scrolled {class w args} {
+ set sf "${w}_sf"
+
+ ttk::frame $sf
+ eval [linsert $args 0 $class $w]
+ ttk::scrollbar $sf.hsb -orient horizontal -command [list $w xview]
+ ttk::scrollbar $sf.vsb -orient vertical -command [list $w yview]
+
+ configure.scrolled $sf $w
+ return $sf
+}
+
+## configure.scrolled -- common factor of [scrolled] and [ttk::scrolled]
+#
+proc configure.scrolled {sf w} {
+ $w configure -xscrollcommand [list $sf.hsb set]
+ $w configure -yscrollcommand [list $sf.vsb set]
+
+ grid $w -in $sf -row 0 -column 0 -sticky nwse
+ grid $sf.hsb -row 1 -column 0 -sticky we
+ grid $sf.vsb -row 0 -column 1 -sticky ns
+
+ grid columnconfigure $sf 0 -weight 1
+ grid rowconfigure $sf 0 -weight 1
+}
+
+### Toolbars.
+#
+proc makeToolbars {} {
+ set buttons [list open new save]
+ set checkboxes [list bold italic]
+
+ #
+ # Ttk toolbar:
+ #
+ set tb [ttk::frame $::BASE.tbar_styled -class Toolbar]
+ set i 0
+ foreach icon $buttons {
+ set b [ttk::button $tb.tb[incr i] \
+ -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \
+ -style Toolbutton]
+ grid $b -row 0 -column $i -sticky news
+ }
+ ttk::separator $tb.sep -orient vertical
+ grid $tb.sep -row 0 -column [incr i] -sticky news -padx 2 -pady 2
+ foreach icon $checkboxes {
+ set b [ttk::checkbutton $tb.cb[incr i] \
+ -variable ::V($icon) \
+ -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \
+ -style Toolbutton]
+ grid $b -row 0 -column $i -sticky news
+ }
+
+ ttk::menubutton $tb.compound \
+ -text "toolbar" -image $::ICON(file) -compound $::V(COMPOUND)
+ $tb.compound configure -menu [makeCompoundMenu $tb.compound.menu]
+ grid $tb.compound -row 0 -column [incr i] -sticky news
+
+ grid columnconfigure $tb [incr i] -weight 1
+
+ #
+ # Standard toolbar:
+ #
+ set tb [frame $::BASE.tbar_orig -class Toolbar]
+ set i 0
+ foreach icon $buttons {
+ set b [button $tb.tb[incr i] \
+ -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \
+ -relief flat -overrelief raised]
+ grid $b -row 0 -column $i -sticky news
+ }
+ frame $tb.sep -borderwidth 1 -width 2 -relief sunken
+ grid $tb.sep -row 0 -column [incr i] -sticky news -padx 2 -pady 2
+ foreach icon $checkboxes {
+ set b [checkbutton $tb.cb[incr i] -variable ::V($icon) \
+ -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \
+ -indicatoron false \
+ -selectcolor {} \
+ -relief flat \
+ -overrelief raised \
+ -offrelief flat]
+ grid $b -row 0 -column $i -sticky news
+ }
+
+ menubutton $tb.compound \
+ -text "toolbar" -image $::ICON(file) -compound $::V(COMPOUND) \
+ -indicatoron true
+ $tb.compound configure -menu [makeCompoundMenu $tb.compound.menu]
+ grid $tb.compound -row 0 -column [incr i] -sticky news
+
+ grid columnconfigure $tb [incr i] -weight 1
+}
+
+#
+# Toolbar -compound control:
+#
+proc makeCompoundMenu {menu} {
+ variable compoundStrings {text image none top bottom left right center}
+ menu $menu
+ foreach string $compoundStrings {
+ $menu add radiobutton \
+ -label [string totitle $string] \
+ -variable ::V(COMPOUND) -value $string \
+ -command changeToolbars ;
+ }
+ return $menu
+}
+
+proc changeToolbars {} {
+ foreachWidget w [list $::BASE.tbar_styled $::BASE.tbar_orig] {
+ catch { $w configure -compound $::V(COMPOUND) }
+ }
+}
+
+makeToolbars
+
+### Theme control panel.
+#
+proc makeThemeControl {c} {
+ ttk::labelframe $c -text "Theme"
+ foreach {theme name} $::THEMELIST {
+ set b [ttk::radiobutton $c.s$theme -text $name \
+ -variable ::ttk::currentTheme -value $theme \
+ -command [list ttk::setTheme $theme]]
+ pack $b -side top -expand false -fill x
+ if {[lsearch -exact [package names] ttk::theme::$theme] == -1} {
+ $c.s$theme state disabled
+ }
+ }
+ return $c
+}
+makeThemeControl $::BASE.control
+
+### Notebook widget.
+#
+set nb [ttk::notebook $::BASE.nb]
+ttk::notebook::enableTraversal $nb
+
+### Main demo pane.
+#
+# Side-by comparison of Ttk vs. core widgets.
+#
+
+
+set pw [ttk::panedwindow $nb.client -orient horizontal]
+$nb add $pw -text "Demo" -underline 0 -padding 6
+set l [ttk::labelframe $pw.l -text "Themed" -padding 6 -underline 1]
+set r [labelframe $pw.r -text "Standard" -padx 6 -pady 6]
+$pw add $l -weight 1; $pw add $r -weight 1
+
+## menubuttonMenu -- demo menu for menubutton widgets.
+#
+proc menubuttonMenu {menu} {
+ menu $menu
+ foreach dir {above below left right flush} {
+ $menu add command -label [string totitle $dir] \
+ -command [list [winfo parent $menu] configure -direction $dir]
+ }
+ $menu add cascade -label "Submenu" -menu [set submenu [menu $menu.submenu]]
+ $submenu add command -label "Subcommand 1"
+ $submenu add command -label "Subcommand 2"
+ $submenu add command -label "Subcommand 3"
+ $menu add separator
+ $menu add command -label "Quit" -command [list destroy .]
+
+ return $menu
+}
+
+## Main demo pane - themed widgets.
+#
+ttk::checkbutton $l.cb -text "Checkbutton" -variable ::V(SELECTED) -underline 2
+ttk::radiobutton $l.rb1 -text "One" -variable ::V(CHOICE) -value 1 -underline 0
+ttk::radiobutton $l.rb2 -text "Two" -variable ::V(CHOICE) -value 2
+ttk::radiobutton $l.rb3 -text "Three" -variable ::V(CHOICE) -value 3 -under 0
+ttk::button $l.button -text "Button" -underline 0
+
+ttk::menubutton $l.mb -text "Menubutton" -underline 2
+$l.mb configure -menu [menubuttonMenu $l.mb.menu]
+
+set ::entryText "Entry widget"
+ttk::entry $l.e -textvariable ::entryText
+$l.e selection range 6 end
+
+set ltext [ttk::scrolled text $l.t -width 12 -height 5 -wrap none]
+
+grid $l.cb -sticky ew
+grid $l.rb1 -sticky ew
+grid $l.rb2 -sticky ew
+grid $l.rb3 -sticky ew
+grid $l.button -sticky ew -padx 2 -pady 2
+grid $l.mb -sticky ew -padx 2 -pady 2
+grid $l.e -sticky ew -padx 2 -pady 2
+grid $ltext -sticky news
+
+grid columnconfigure $l 0 -weight 1
+grid rowconfigure $l 7 -weight 1 ; # text widget (grid is a PITA)
+
+## Main demo pane - core widgets.
+#
+checkbutton $r.cb -text "Checkbutton" -variable ::V(SELECTED)
+radiobutton $r.rb1 -text "One" -variable ::V(CHOICE) -value 1
+radiobutton $r.rb2 -text "Two" -variable ::V(CHOICE) -value 2 -underline 1
+radiobutton $r.rb3 -text "Three" -variable ::V(CHOICE) -value 3
+button $r.button -text "Button"
+menubutton $r.mb -text "Menubutton" -underline 3 -takefocus 1
+$r.mb configure -menu [menubuttonMenu $r.mb.menu]
+# Add -indicatoron control:
+set ::V(rmbIndicatoron) [$r.mb cget -indicatoron]
+$r.mb.menu insert 0 checkbutton -label "Indicator?" \
+ -variable ::V(rmbIndicatoron) \
+ -command "$r.mb configure -indicatoron \$::V(rmbIndicatoron)" ;
+$r.mb.menu insert 1 separator
+
+entry $r.e -textvariable ::entryText
+
+set rtext [scrolled text $r.t -width 12 -height 5 -wrap none]
+
+grid $r.cb -sticky ew
+grid $r.rb1 -sticky ew
+grid $r.rb2 -sticky ew
+grid $r.rb3 -sticky ew
+grid $r.button -sticky ew -padx 2 -pady 2
+grid $r.mb -sticky ew -padx 2 -pady 2
+grid $r.e -sticky ew -padx 2 -pady 2
+grid $rtext -sticky news
+
+grid columnconfigure $r 0 -weight 1
+grid rowconfigure $r 7 -weight 1 ; # text widget
+
+#
+# Add some text to the text boxes:
+#
+
+set cb $::BASE.tbar_orig.cb5
+set txt "checkbutton $cb \\\n"
+foreach copt [$cb configure] {
+ if {[llength $copt] == 5} {
+ append txt " [lindex $copt 0] [lindex $copt 4] \\\n"
+ }
+}
+append txt " ;\n"
+
+$l.t insert end $txt
+$r.t insert end $txt
+
+### Scales and sliders pane.
+#
+proc scales.pane {scales} {
+ ttk::frame $scales
+
+ ttk::panedwindow $scales.pw -orient horizontal
+ set l [ttk::labelframe $scales.styled -text "Themed" -padding 6]
+ set r [labelframe $scales.orig -text "Standard" -padx 6 -pady 6]
+
+ ttk::scale $l.scale -orient horizontal -from 0 -to 100 -variable ::V(SCALE)
+ ttk::scale $l.vscale -orient vertical -from 100 -to 0 -variable ::V(VSCALE)
+ ttk::progressbar $l.progress -orient horizontal -maximum 100
+ ttk::progressbar $l.vprogress -orient vertical -maximum 100
+ if {1} {
+ $l.scale configure -command [list $l.progress configure -value]
+ $l.vscale configure -command [list $l.vprogress configure -value]
+ } else {
+ # This would also work, but the Tk scale widgets
+ # in the right hand pane cause some interference when
+ # in autoincrement/indeterminate mode.
+ #
+ $l.progress configure -variable ::V(SCALE)
+ $l.vprogress configure -variable ::V(VSCALE)
+ }
+
+ $l.scale set 50
+ $l.vscale set 50
+
+ ttk::label $l.lmode -text "Progress bar mode:"
+ ttk::radiobutton $l.pbmode0 -variable ::V(PBMODE) \
+ -text determinate -value determinate -command [list pbMode $l]
+ ttk::radiobutton $l.pbmode1 -variable ::V(PBMODE) \
+ -text indeterminate -value indeterminate -command [list pbMode $l]
+ proc pbMode {l} {
+ variable V
+ $l.progress configure -mode $V(PBMODE)
+ $l.vprogress configure -mode $V(PBMODE)
+ }
+
+ ttk::button $l.start -text "Start" -command [list pbStart $l]
+ proc pbStart {l} {
+ set ::V(PBMODE) indeterminate; pbMode $l
+ $l.progress start 10
+ $l.vprogress start
+ }
+
+ ttk::button $l.stop -text "Stop" -command [list pbStop $l]
+ proc pbStop {l} {
+ $l.progress stop
+ $l.vprogress stop
+ }
+
+ grid $l.scale -columnspan 2 -sticky ew
+ grid $l.progress -columnspan 2 -sticky ew
+ grid $l.vscale $l.vprogress -sticky nws
+
+ grid $l.lmode -sticky we -columnspan 2
+ grid $l.pbmode0 -sticky we -columnspan 2
+ grid $l.pbmode1 -sticky we -columnspan 2
+ grid $l.start -sticky we -columnspan 2
+ grid $l.stop -sticky we -columnspan 2
+
+ grid columnconfigure $l 0 -weight 1
+ grid columnconfigure $l 1 -weight 1
+
+ grid rowconfigure $l 99 -weight 1
+
+ scale $r.scale -orient horizontal -from 0 -to 100 -variable ::V(SCALE)
+ scale $r.vscale -orient vertical -from 100 -to 0 -variable ::V(VSCALE)
+ grid $r.scale -sticky news
+ grid $r.vscale -sticky nws
+
+ grid rowconfigure $r 99 -weight 1
+ grid columnconfigure $r 0 -weight 1
+
+ ##
+ $scales.pw add $l -weight 1
+ $scales.pw add $r -weight 1
+ pack $scales.pw -expand true -fill both
+
+ return $scales
+}
+$nb add [scales.pane $nb.scales] -text Scales -sticky nwes -padding 6
+
+### Combobox demo pane.
+#
+proc combobox.pane {cbf} {
+ ttk::frame $cbf
+ set values [list abc def ghi jkl mno pqr stu vwx yz]
+ pack \
+ [ttk::combobox $cbf.cb1 -values $values -textvariable ::COMBO] \
+ [ttk::combobox $cbf.cb2 -values $values -textvariable ::COMBO ] \
+ -side top -padx 2 -pady 2 -expand false -fill x;
+ $cbf.cb2 configure -state readonly
+ $cbf.cb1 current 3
+ return $cbf
+}
+$nb add [combobox.pane $nb.combos] -text "Combobox" -underline 7
+
+### Treeview widget demo pane.
+#
+proc tree.pane {w} {
+ ttk::frame $w
+ ttk::scrollbar $w.vsb -command [list $w.t yview]
+ ttk::treeview $w.t -columns [list Class] \
+ -padding 4 \
+ -yscrollcommand [list sbset $w.vsb]
+
+ grid $w.t $w.vsb -sticky nwse
+ grid columnconfigure $w 0 -weight 1
+ grid rowconfigure $w 0 -weight 1
+ grid propagate $w 0
+
+ #
+ # Add initial tree node:
+ # Later nodes will be added in <<TreeviewOpen>> binding.
+ #
+ $w.t insert {} 0 -id . -text "Main Window" -open 0 \
+ -values [list [winfo class .]]
+ $w.t heading \#0 -text "Widget"
+ $w.t heading Class -text "Class"
+ bind $w.t <<TreeviewOpen>> [list fillTree $w.t]
+
+ return $w
+}
+
+# fillTree -- <<TreeviewOpen>> binding for tree widget.
+#
+proc fillTree {tv} {
+ set id [$tv focus]
+ if {![winfo exists $id]} {
+ $tv delete $id
+ return
+ }
+
+ #
+ # Replace tree item children with current list of child windows.
+ #
+ $tv delete [$tv children $id]
+ set children [winfo children $id]
+ foreach child $children {
+ $tv insert $id end -id $child -text [winfo name $child] -open 0 \
+ -values [list [winfo class $child]]
+ if {[llength [winfo children $child]]} {
+ # insert dummy child to show [+] indicator
+ $tv insert $child end
+ }
+ }
+}
+
+if {[llength [info commands ttk::treeview]]} {
+ $nb add [tree.pane $nb.tree] -text "Tree" -sticky news
+}
+
+### Other demos.
+#
+$nb add [ttk::frame $nb.others] -text "Others" -underline 4
+
+set Timers(StateMonitor) {}
+set Timers(FocusMonitor) {}
+
+set others $::BASE.nb.others
+
+ttk::label $others.m -justify left -wraplength 300
+bind ShowDescription <Enter> { $BASE.nb.others.m configure -text $Desc(%W) }
+bind ShowDescription <Leave> { $BASE.nb.others.m configure -text "" }
+
+foreach {command label description} {
+ trackStates "Widget states..."
+ "Display/modify widget state bits"
+
+ scrollbarResizeDemo "Scrollbar resize behavior..."
+ "Shows how Ttk and standard scrollbars differ when they're sized too large"
+
+ trackFocus "Track keyboard focus..."
+ "Display the name of the widget that currently has focus"
+
+ repeatDemo "Repeating buttons"
+ "Demonstrates custom classes (see demos/repeater.tcl)"
+
+} {
+ set b [ttk::button $others.$command -text $label -command $command]
+ set Desc($b) $description
+ bindtags $b [lreplace [bindtags $b] end 0 ShowDescription]
+
+ pack $b -side top -expand false -fill x -padx 6 -pady 6
+}
+
+pack $others.m -side bottom -expand true -fill both
+
+
+### Scrollbar resize demo.
+#
+proc scrollbarResizeDemo {} {
+ set t .scrollbars
+ destroy $t
+ toplevel $t ; wm geometry $t 200x200
+ frame $t.f -height 200
+ grid \
+ [ttk::scrollbar $t.f.tsb -command [list sbstub $t.f.tsb]] \
+ [scrollbar $t.f.sb -command [list sbstub $t.f.sb]] \
+ -sticky news
+
+ $t.f.sb set 0 0.5 ;# prevent backwards-compatibility mode for old SB
+
+ grid columnconfigure $t.f 0 -weight 1
+ grid columnconfigure $t.f 1 -weight 1
+ grid rowconfigure $t.f 0 -weight 1
+ pack $t.f -expand true -fill both
+}
+
+### Track focus demo.
+#
+proc trackFocus {} {
+ global Focus
+ set t .focus
+ destroy $t
+ toplevel $t
+ wm title $t "Keyboard focus"
+ set i 0
+ foreach {label variable} {
+ "Focus widget:" Focus(Widget)
+ "Class:" Focus(WidgetClass)
+ "Next:" Focus(WidgetNext)
+ "Grab:" Focus(Grab)
+ "Status:" Focus(GrabStatus)
+ } {
+ grid [ttk::label $t.l$i -text $label -anchor e] \
+ [ttk::label $t.v$i -textvariable $variable \
+ -width 40 -anchor w -relief groove] \
+ -sticky ew;
+ incr i
+ }
+ grid columnconfigure $t 1 -weight 1
+ grid rowconfigure $t $i -weight 1
+
+ bind $t <Destroy> {after cancel $Timers(FocusMonitor)}
+ FocusMonitor
+}
+
+proc FocusMonitor {} {
+ global Focus
+
+ set Focus(Widget) [focus]
+ if {$::Focus(Widget) ne ""} {
+ set Focus(WidgetClass) [winfo class $Focus(Widget)]
+ set Focus(WidgetNext) [tk_focusNext $Focus(Widget)]
+ } else {
+ set Focus(WidgetClass) [set Focus(WidgetNext) ""]
+ }
+
+ set Focus(Grab) [grab current]
+ if {$Focus(Grab) ne ""} {
+ set Focus(GrabStatus) [grab status $Focus(Grab)]
+ } else {
+ set Focus(GrabStatus) ""
+ }
+
+ set ::Timers(FocusMonitor) [after 200 FocusMonitor]
+}
+
+### Widget states demo.
+#
+variable Widget .tbar_styled.tb1
+
+bind all <Control-Shift-ButtonPress-1> { TrackWidget %W ; break }
+
+proc TrackWidget {w} {
+ set ::Widget $w ;
+ if {[winfo exists .states]} {
+ UpdateStates
+ } else {
+ trackStates
+ }
+}
+
+variable states [list \
+ active disabled focus pressed selected readonly \
+ background alternate invalid]
+
+proc trackStates {} {
+ variable states
+ set t .states
+ destroy $t; toplevel $t ; wm title $t "Widget states"
+
+ set tf [ttk::frame $t.f] ; pack $tf -expand true -fill both
+
+ ttk::label $tf.info -text "Press Control-Shift-Button-1 on any widget"
+
+ ttk::label $tf.lw -text "Widget:" -anchor e -relief groove
+ ttk::label $tf.w -textvariable ::Widget -anchor w -relief groove
+
+ grid $tf.info - -sticky ew -padx 6 -pady 6
+ grid $tf.lw $tf.w -sticky ew
+
+ foreach state $states {
+ ttk::checkbutton $tf.s$state \
+ -text $state \
+ -variable ::State($state) \
+ -command [list ChangeState $state] ;
+ grid x $tf.s$state -sticky nsew
+ }
+
+ grid columnconfigure $tf 1 -weight 1
+
+ grid x [ttk::frame $tf.cmd] -sticky nse
+ grid x \
+ [ttk::button $tf.cmd.close -text Close -command [list destroy $t]] \
+ -padx 4 -pady {6 4};
+ grid columnconfigure $tf.cmd 0 -weight 1
+
+ bind $t <KeyPress-Escape> [list event generate $tf.cmd.close <<Invoke>>]
+ bind $t <Destroy> { after cancel $::Timers(StateMonitor) }
+ StateMonitor
+}
+
+proc StateMonitor {} {
+ if {$::Widget ne ""} { UpdateStates }
+ set ::Timers(StateMonitor) [after 200 StateMonitor]
+}
+
+proc UpdateStates {} {
+ variable states
+ variable State
+ variable Widget
+
+ foreach state $states {
+ if {[catch {set State($state) [$Widget instate $state]}]} {
+ # Not a Ttk widget:
+ .states.f.s$state state disabled
+ } else {
+ .states.f.s$state state !disabled
+ }
+ }
+}
+
+proc ChangeState {state} {
+ variable State
+ variable Widget
+ if {$Widget ne ""} {
+ if {$State($state)} {
+ $Widget state $state
+ } else {
+ $Widget state !$state
+ }
+ }
+}
+
+### Repeating button demo.
+#
+
+proc repeatDemo {} {
+ set top .repeatDemo
+ if {![catch { wm deiconify $top ; raise $top }]} { return }
+ toplevel $top
+ wm title $top "Repeating button"
+ keynav::enableMnemonics $top
+
+ set f [ttk::frame .repeatDemo.f]
+ ttk::button $f.b -class Repeater -text "Press and hold" \
+ -command [list $f.p step]
+ ttk::progressbar $f.p -orient horizontal -maximum 10
+
+ ttk::separator $f.sep -orient horizontal
+ set cmd [ttk::frame $f.cmd]
+ pack \
+ [ttk::button $cmd.close -text Close -command [list destroy $top]] \
+ -side right -padx 6;
+
+ pack $f.cmd -side bottom -expand false -fill x -padx 6 -pady 6
+ pack $f.sep -side bottom -expand false -fill x -padx 6 -pady 6
+ pack $f.b -side left -expand false -fill none -padx 6 -pady 6
+ pack $f.p -side right -expand true -fill x -padx 6 -pady 6
+
+ $f.b configure -underline 0
+ $cmd.close configure -underline 0
+ bind $top <KeyPress-Escape> [list event generate $cmd.close <<Invoke>>]
+
+ pack $f -expand true -fill both
+}
+
+
+### Command box.
+#
+set cmd [ttk::frame $::BASE.command]
+ttk::button $cmd.close -text Close -underline 0 -command [list destroy .]
+ttk::button $cmd.help -text Help -command showHelp
+
+proc showHelp {} {
+ if {![winfo exists .helpDialog]} {
+ lappend detail "Tk version $::tk_version"
+ lappend detail "Ttk library: $::ttk::library"
+ ttk::dialog .helpDialog -type ok -icon info \
+ -message "Ttk demo" -detail [join $detail \n]
+ }
+}
+
+grid x $cmd.close $cmd.help -pady 6 -padx 6
+grid columnconfigure $cmd 0 -weight 1
+
+## Status bar (to demonstrate size grip)
+#
+set statusbar [ttk::frame $BASE.statusbar]
+pack [ttk::sizegrip $statusbar.grip] -side right -anchor se
+
+## Accelerators:
+#
+bind $::ROOT <KeyPress-Escape> [list event generate $cmd.close <<Invoke>>]
+bind $::ROOT <<Help>> [list event generate $cmd.help <<Invoke>>]
+keynav::enableMnemonics $::ROOT
+keynav::defaultButton $cmd.help
+
+### Menubar.
+#
+set menu [menu $::BASE.menu]
+$::ROOT configure -menu $menu
+$menu add cascade -label "File" -underline 0 -menu [menu $menu.file]
+$menu.file add command -label "Open" -underline 0 \
+ -compound left -image $::ICON(open)
+$menu.file add command -label "Save" -underline 0 \
+ -compound left -image $::ICON(save)
+$menu.file add separator
+$menu.file add checkbutton -label "Checkbox" -underline 0 \
+ -variable ::V(SELECTED)
+$menu.file add cascade -label "Choices" -underline 1 \
+ -menu [menu $menu.file.choices]
+foreach {label value} {One 1 Two 2 Three 3} {
+ $menu.file.choices add radiobutton \
+ -label $label -variable ::V(CHOICE) -value $value
+}
+
+$menu.file insert end separator
+if {[tk windowingsystem] ne "x11"} {
+ $menu.file insert end checkbutton -label Console -underline 5 \
+ -variable ::V(CONSOLE) -command toggleconsole
+ proc toggleconsole {} {
+ if {$::V(CONSOLE)} {console show} else {console hide}
+ }
+}
+$menu.file add command -label "Exit" -underline 1 \
+ -command [list event generate $cmd.close <<Invoke>>]
+
+# Add Theme menu.
+#
+proc makeThemeMenu {menu} {
+ menu $menu
+ foreach {theme name} $::THEMELIST {
+ $menu add radiobutton -label $name \
+ -variable ::ttk::currentTheme -value $theme \
+ -command [list ttk::setTheme $theme]
+ if {[lsearch -exact [package names] ttk::theme::$theme] == -1} {
+ $menu entryconfigure end -state disabled
+ }
+ }
+ return $menu
+}
+
+$menu add cascade -label "Theme" -underline 3 -menu [makeThemeMenu $menu.theme]
+
+### Main window layout.
+#
+
+pack $BASE.statusbar -side bottom -expand false -fill x
+pack $BASE.command -side bottom -expand false -fill x
+pack $BASE.tbar_styled -side top -expand false -fill x
+pack $BASE.tbar_orig -side top -expand false -fill x
+pack $BASE.control -side left -expand false -fill y -padx 6 -pady 6
+pack $BASE.nb -side left -expand true -fill both -padx 6 -pady 6
+
+wm title $ROOT "Ttk demo"
+wm iconname $ROOT "Ttk demo"
+update; wm deiconify $ROOT
diff --git a/library/demos/ttk_iconlib.tcl b/library/demos/ttk_iconlib.tcl
new file mode 100644
index 0000000..9a93ece
--- /dev/null
+++ b/library/demos/ttk_iconlib.tcl
@@ -0,0 +1,110 @@
+array set ImgData {
+bold {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAI6hI+py60U3wj+
+RYQFJYRvEWFBCeFbRFhQQvhG8YPgX0RYUEL4FhEWlBC+RYQFJYQPFN8IPqYut/8hBQA7}
+copy {R0lGODlhEAAQAJEAANnZ2QAAAP///wAAhCH5BAEAAAAALAAAAAAQABAAAAJUhI8JFJ/gY4iI
+UEL4FyIiFIXgW0iEUDgfACBI9pzMAAGRiIghWSMDECR7JEKGtkFIRFBG+TIQKDQxtgzcDcmX
+IfgwQrFlCD4MyZch+EDzj+Bj6mYBADs=}
+cut {R0lGODlhEAAQAJEAANnZ2QAAAAAAhP///yH5BAEAAAAALAAAAAAQABAAAAJFhI+pcUHwEeIi
+E0gACIKPEAFBIXy0gMg8EhM+YmQiKSL4eAIiJMI/EQEhQGYGYiQIQAg+iAkIATIzECMBIgT/
+RBARERlSADs=}
+dragfile {R0lGODlhGAAYAKIAANnZ2TMzM////wAAAJmZmf///////////yH5BAEAAAAALAAAAAAYABgA
+AAPACBi63IqgC4GiyxwogaAbKLrMgSKBoBoousyBogEACIGiyxwoKgGAECI4uiyCExMTOACB
+osuNpDoAGCI4uiyCIkREOACBosutSDoAgSI4usyCIjQAGCi63Iw0ACEoOLrMgiI0ABgoutyM
+NAAhKDi6zIIiNAAYKLrcjDQAISg4usyCIjQAGCi63Iw0AIGiiqPLIyhCA4CBosvNSAMQKKo4
+ujyCIjQAGCi63Iw0AIGiy81IAxCBpMu9GAMAgKPL3QgJADs=}
+dragicon {R0lGODlhGAAYALMAANnZ2TMzM/////8zM8zMzGYAAAAAAJmZmQCZMwAzZgCZzGZmZv//////
+/////////yH5BAEAAAAALAAAAAAYABgAAAT/EMAgJ60SAjlBgEJOSoMIEMgZoJCT0iADBFIG
+KOSkNMwAAABhwiHnIEKIIIQQAQIZhBBwyDmKEMIEE0yABoAghIBDzlGEENDIaQAIQgg45BwF
+CinPOccAECYcUiKEEBFCiHPgMQAEIcQYYyABBUGIQCHlMQCEScZAAhKEEApCECGOARAEIQQp
+BRGIpAyCJCGOASBAISdEcqJAVBLiGABggELOAJGUKyiVhDgGABigkJMEhNAKSqkEhTgGgCCl
+FCQEGIJSSiUhjgEgQCEnJVBJmYQ4BoAAhZyTQCVnEuIYAAIUckoCk5xSiGMACFDISSs9BoBg
+rRXQMQAEKOSklR4DEUAI8MhJ6wwGAACgkZNWCkAEADs=}
+error {R0lGODlhIAAgAKIAANnZ2YQAAP8AAISEhP///////////////yH5BAEAAAAALAAAAAAgACAA
+AAP/CLoMGLqKoMvtGIqiqxEYCLrcioGiyxwIusyBgaLLLRiBoMsQKLrcjYGgu4Giy+2CAkFX
+A0WX2wXFIOgGii7trkCEohsDCACBoktEKLpKhISiGwAIECiqSKooukiqKKoxgACBooukKiIo
+SKooujGDECi6iqQqsopEV2MQAkV3kXQZRXdjEAJFl5F0FUWXY3ACRZcFSRdFlyVwJlB0WZB0
+UXRZAmcCRZeRdBVFl2NwAkV3kXQZRXdjcAJFV5FURVaR6GoMDgSKLpKqiKAgqaLoxgwOBIoq
+kiqKLpIqimrM4ECg6BIRiq4SIaHoxgyCBoou7a5AhKIbMzgAAIGiy+2CTWJmBhAAAkWX2wXF
+zCDoBooud2PMDIKuRqDocgtGzMwg6O4Eii5z4Kgi6DIMhqLoagQGjiqCLvPgYOgqji6CLrfi
+6DIj6HI7jq4i6DIkADs=}
+file {R0lGODlhCwANAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAALAA0AAAIyhI9G8Q0AguSH
+AMQdxQgxEyEFQfItICQokYgEBMm3gBCKLRIQJN8CQii2SECQfAug+FgAOw==}
+folder {R0lGODlhEAANAKIAANnZ2YSEhMbGxv//AP///wAAAP///////yH5BAEAAAAALAAAAAAQAA0A
+AANjCIqhiqDLITgyEgi6GoIjIyMYugCBpMsaWBA0giMjIzgyUYBBMjIoIyODEgVBODIygiMj
+E1gQJIMyMjIoI1GAQSMjODIyghMFQSgjI4MyMhJYEDSCIyMjODJRgKHLXAiApcucADs=}
+hourglass {R0lGODlhIAAgAKIAANnZ2YAAAAAAAP8AAP///8DAwICAgP///yH5BAEAAAAALAAAAAAgACAA
+AAPZCLrc/jDKSau9OGcUuqyCoMvNGENVhaMrCLrcjaLLgqDL7WhFVIVVZoKgy+1oRUSFVWaC
+oMvtaEVEhVVmgqDL7WhFRIVVZoKgy+1oVVaCJWaCoMvtgKxISrBMEHS5fZEVSRkKgi63NzIq
+EwRdbndkVCYIutzeyIqqDAVBl9sXWRFJYZkg6HI7ICsiKqwyEwRdbkcrIhKsMhMEXW5HKyIp
+lDITBF1uRysyEiwxEwRdbkcrIyuUEhMEXW5H0WVB0OVujKGqwtEVBF1uRtHlRdDl9odRTlrt
+xRmjBAA7}
+info {R0lGODlhIAAgAKIAANnZ2YSEhMbGxv///wAA/wAAAP///////yH5BAEAAAAALAAAAAAgACAA
+AAP/CLoMGLqKoMvtGCo4uhKBgaDLDRghOLqsghEIuryBgqPLPSiBoMsQOLojhEQkOLpTCLob
+OLqKpIujq4WgC4Gju0i6OLpbCKohOLorhEQkOLorhaAQOLrc3qgCIARHl9sbSQUEji4j6RKO
+Lk9hQODosiKp4ujyFIbi6LIiqeLo8hSG4uiyIqni6PIUhuLosiKp4ujyFIYKji4PkiqOLkth
+BASOLg+SKo4uV2AEhODoMpIqju5KYShA4Ogqku7i6E4FRgAAYOHocvugiohAUC0cXe7GiohA
+0IUSHF3uQamICATdrULB0WUVrIqIQNBlCCwVHF2pwsJQRdDlDYyoKsHRPMLQDQRdbsDQqBmc
+wlBF0OV2jJqZwggEXW5vVDMVgaDL7Y5qKgJBl9sfVUUg6HL7AxSKoMvtr1AEgi5DAgA7}
+italic {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAIrhI+py+1A4hN8
+hIjINBITPlpEZBqJCR8tIjKNxISPFhGZQOITfExdbv9FCgA7}
+new {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAJFhI95FN8IvgXJ
+jyD4ECQ/JAh+kPyICIIdJP+CYAfJvyDYQfIvCHaQ/AuCHST/gmAHyb8g2EHyLwh2kPwLgk3x
+MQg+pu4WADs=}
+open {R0lGODlhEAAQAKIAANnZ2QAAAP//AP///4SEAP///////////yH5BAEAAAAALAAAAAAQABAA
+AANZCLrczigUQZc1EDQgEHSZAwMgIhB0NQIDQkYwdANBNUZwZGQEJxBUQwZlZGRQAkE1RnAE
+Q5dVcCSQdDcAYySQdDcAISSQdDcAASKQdDcAAQBDlwNBl9sfApQAOw==}
+openfold {R0lGODlhEAANAKIAANnZ2YSEhP///8bGxv//AAAAAP///////yH5BAEAAAAALAAAAAAQAA0A
+AANgCIqhiqDLgaIaCLoagkNDIxi6AIFCQ0M4KKpRgCFDQzg0NIQThaHLSxgVKLochRMVMkhD
+Q4M0VBFYEDKEQ0NDOFFRgCE0NEhDQ4MVBRAoNDSEQ0NRWAAYuqyFBQBYurwJADs=}
+overstrike {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAI3hI+py80Uh+Aj
+RFhQCP8iMILgWwRGEHyLwAiCbxEYQfCB4iPBhwiMIPgXYREEHyEiguBj6nI7FQA7}
+palette {R0lGODlhEAAQAKIAANnZ2QAAAP//AP////8A/4QAhP8AAAD//yH5BAEAAAAALAAAAAAQABAA
+AANtCLrcjqGBoMsRKCMTgaALMSgDAYMSCKoxgAFBITgSAIAQEhUIARCAEgAQOBAwghMQEwga
+MoIjIxAIEgCAEBEyKBAgg4GgGxAIYTGCgaALcRgQIIGgCwEYICODgaALITgyEoGguxiqCLrc
+/lChBAA7}
+passwd {R0lGODlhIAAgAMQAANnZ2QAAAICAgICAAP///7CwsMDAwMjIAPjIAOjo6Pj4AODg4HBwcMj4
+ANjY2JiYANDQ0MjIyPj4yKCgoMiYAMjImDAwAMjIMJiYmJCQkP//////////////////////
+/yH5BAEAAAAALAAAAAAgACAAAAX/ICCOIhiIIgiII1maZSCMQnCeJyAIQiAIAiAMwxCcJwkk
+EAQRCIUwGMSBDEEAAuJIlgKRJEEgGAMRBIGiDENQlqNAJAsYCEwgEEEgBAHSIEMAAuJIAgKR
+LEsgGEMgCEJgBMqhHENQlgJILMsSCMRABEFgGAESHMcRgIA4kgKxOIsTBAOhKAITKEGDHMhD
+kqIAEqAjisJAgIooBkpwNMcTgIA4jgLhOBAkEAOhKIoSKEGDIMcTkKQICgQEQQIxEIqiBEpw
+IMdxPAEIiCMJCEQUMUQ0EIqiHIfSIM3xBGUpCiABCUQyEMqhHMiBHMjxBCAgjuQoEAKxRANB
+HMqhHM1x/zxDUJajQIACsUTDQBAEIR3IcQRDAALiSIoCYQiEE03gII7HQR3BEICAOJICYRSC
+QDjRNE1CAAzVQR3WE5AkAAqEUQiFQEARBAUAAAzHQR3BEICAOI4CUQhFIBAREwXjUFUHdQRD
+QJJAABbCFAhEJBgBAADAMAwXdQRDAALiCAhEIRQCYRiCEZDjUFFHMAQkIBAFOAmTQBiFUAQg
+II7AUFXUEQwBCQjEJExBkBRCEZCjMIBD9RxDAALiGEzCFBBYIRTBOI7AQB1DMIoCMQkYGAjL
+JEwBCIgjOVDDEJCAQGACJiTTJEwBSY5BEJAiSCCwTAiCZBKmAATEkSzNQBCCYCDBJgELTNMk
+g0AMEgwTAhAQR7I0zYARgvM8TyAIznMMAQA7}
+paste {R0lGODlhEAAQAKIAANnZ2QAAAP//AISEAISEhP///wAAhP///yH5BAEAAAAALAAAAAAQABAA
+AANwCLrcjqGBoKsYqiKrCDSGBkMiJJCGAgCDKBB0gwYDIKYwdJUIAyBokIaGBmloAhBiaAgH
+TdcCEIKGBsmwVM0AIYaGcAxL1coQgoYGySoisMzMAoeGxrB01QJpaMiwMHTLAEPVsHTVEHTR
+dBlBlxswAQA7}
+print {R0lGODlhEAAQAKIAANnZ2QAAAP///4SEhP//AP///////////yH5BAEAAAAALAAAAAAQABAA
+AANZCLrcjqG7CLqBoquBoBuCoSqBoBsouhoIuiEYqrKBoIGiqwEYEIChyxAIEYGgywEYgKHL
+DAgRCLozgwABARgIukSEABEBGLq8gAEQCLobgAEAgKHLgaDLzZgAOw==}
+question {R0lGODlhIAAgAKIAANnZ2YSEhMbGxv///wAAAAAA/////////yH5BAEAAAAALAAAAAAgACAA
+AAP/CLoMGLqKoMvtGCo4uhKBgaDLDRghOLqsghEIuryBgqPLPSiBoMsQOLrcjYSgu4GjO4Kl
+Kzi6Qwi6EDi6I4UyU1VYgqM7hKAagqM7VTg6VYWFoztCCAqBo6tVWDVThVU4ukqBACE4ulqF
+VSNVWIWjq0IYEDi6K4UlU1VYOLpMgRA4uryCpTi6PIShOLq8hVU4uqyEoTi6vIUlOLqshKE4
+uryFhaPLSxgqOLrc3kgoAgJHl0ewSnB0eQhDIQRHl6uwCkeXhTAUIHB0uQqrcHSZAiMAAJBw
+dFcKS3B0lwIjAkGVcHS5GykiAkEXSHB0uQeFIiIQdJcIBUeXVZAoIgJBT5chkFRwdIUICUMV
+QZc3MIKIBEcJQzcQdLkBQ4NmcAhDFUGX2zFoZggjEHS5vRHNUASCLrc7oqEIBF1uf0QUgaDL
+7Q9QKIIut79CEQi6DAkAOw==}
+redo {R0lGODlhEAAQAJEAANnZ2QAAhP///////yH5BAEAAAAALAAAAAAQABAAAAIvhI+py+1vSByC
+jxAYQXDMwsyAggQAQBB8iwgMgg8REQgUwqbYBDsIPqYutz+MgBQAOw==}
+save {R0lGODlhEAAQAJEAANnZ2QAAAISEAP///yH5BAEAAAAALAAAAAAQABAAAAJWhI9pFB8RIIRC
++BYQFqQQvkWEBSmEbyFhQQrhW0hYkEL4FhIWpBC+hYQFSYxvIgFAoXy0AAiSGP8kAIIkxgcI
+CSBEQvEBQgIIkVB8gJAAAhgfj+BjWgEAOw==}
+underline {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAI3hI+py60UBy4I
+vkVcBMG/iIsg+BdxEQT/Ii6C4F/ERRD8i7gIgn8RF0HwkWITfExFin8EH1OXCwA7}
+undo {R0lGODlhEAAQAJEAANnZ2QAAhP///////yH5BAEAAAAALAAAAAAQABAAAAIuhI+py+2vSByC
+HxdxQCHsCIg7oAAAEUHwLTAiKIQPgRSbYMfd3VEIH1OX2x8mUgA7}
+warning {R0lGODlhIAAgAKIAANnZ2YSEAP//AMbGxgAAAISEhP///////yH5BAEAAAAALAAAAAAgACAA
+AAP/CLq8gREIutz+KESGEHS5vVGIiAxSIehy+6JAUaUqBF1uBxQoukOFhaDL7RgoukKFhaDL
+3RgoujqEVQi63IyBortUWAi63IuBostDWIWgy60YIjKERCMiSFUIutyAISKCpCoiOFSFoMsd
+KCpIqiKCQlUIusyBooqkKiIoQ1UIuryBooqkiqJKVQi6rIGii6SKojpUWAi6DIGiG0RIgaJL
+VQi6HCi6MoREg6I7VFgIuhsoukqEhKKrVFgIuhoouhuEgaKrQ1iFoAuBortDOCi6S4WFoBso
+uiyEostDWIWgGii63K6IqgAAIVB0WQaJBkV3h7AKAAJFl4WQiFB0mQoLRyBQdFkJiQhFl4ew
+CgJFl3WQaFB0WQirIFB0ud0RVVWg6HJ7o6GqAgwUXW5fNFRVhQCBpMvti0oVABCwdLndEehi
+6XI7I4AEADs=}
+}
diff --git a/library/demos/ttk_repeater.tcl b/library/demos/ttk_repeater.tcl
new file mode 100644
index 0000000..b515ed4
--- /dev/null
+++ b/library/demos/ttk_repeater.tcl
@@ -0,0 +1,117 @@
+#
+# $Id: ttk_repeater.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+#
+# Demonstration of custom classes.
+#
+# The Ttk button doesn't have built-in support for autorepeat.
+# Instead of adding -repeatdelay and -repeatinterval options,
+# and all the extra binding scripts required to deal with them,
+# we create a custom widget class for autorepeating buttons.
+#
+# Usage:
+# ttk::button .b -class Repeater [... other options ...]
+#
+# TODO:
+# Use system settings for repeat interval and initial delay.
+#
+# Notes:
+# Repeater buttons work more like scrollbar arrows than
+# Tk repeating buttons: they fire once immediately when
+# first pressed, and $State(delay) specifies the initial
+# interval before the button starts autorepeating.
+#
+
+namespace eval ttk::Repeater {
+ variable State
+ set State(timer) {} ;# [after] id of repeat script
+ set State(interval) 100 ;# interval between repetitions
+ set State(delay) 300 ;# delay after initial invocation
+}
+
+### Class bindings.
+#
+
+bind Repeater <Enter> { %W state active }
+bind Repeater <Leave> { %W state !active }
+
+bind Repeater <Key-space> { ttk::Repeater::Activate %W }
+bind Repeater <<Invoke>> { ttk::Repeater::Activate %W }
+
+bind Repeater <ButtonPress-1> { ttk::Repeater::Press %W }
+bind Repeater <ButtonRelease-1> { ttk::Repeater::Release %W }
+bind Repeater <B1-Leave> { ttk::Repeater::Pause %W }
+bind Repeater <B1-Enter> { ttk::Repeater::Resume %W } ;# @@@ see below
+
+# @@@ Workaround for metacity-induced bug:
+bind Repeater <B1-Enter> \
+ { if {"%d" ne "NotifyUngrab"} { ttk::Repeater::Resume %W } }
+
+### Binding procedures.
+#
+
+## Activate -- Keyboard activation binding.
+# Simulate clicking the button, and invoke the command once.
+#
+proc ttk::Repeater::Activate {w} {
+ $w instate disabled { return }
+ set oldState [$w state pressed]
+ update idletasks; after 100
+ $w state $oldState
+ after idle [list $w invoke]
+}
+
+## Press -- ButtonPress-1 binding.
+# Invoke the command once and start autorepeating after
+# $State(delay) milliseconds.
+#
+proc ttk::Repeater::Press {w} {
+ variable State
+ $w instate disabled { return }
+ $w state pressed
+ $w invoke
+ after cancel $State(timer)
+ set State(timer) [after $State(delay) [list ttk::Repeater::Repeat $w]]
+}
+
+## Release -- ButtonRelease binding.
+# Stop repeating.
+#
+proc ttk::Repeater::Release {w} {
+ variable State
+ $w state !pressed
+ after cancel $State(timer)
+}
+
+## Pause -- B1-Leave binding
+# Temporarily suspend autorepeat.
+#
+proc ttk::Repeater::Pause {w} {
+ variable State
+ $w state !pressed
+ after cancel $State(timer)
+}
+
+## Resume -- B1-Enter binding
+# Resume autorepeat.
+#
+proc ttk::Repeater::Resume {w} {
+ variable State
+ $w instate disabled { return }
+ $w state pressed
+ $w invoke
+ after cancel $State(timer)
+ set State(timer) [after $State(interval) [list ttk::Repeater::Repeat $w]]
+}
+
+## Repeat -- Timer script
+# Invoke the command and reschedule another repetition
+# after $State(interval) milliseconds.
+#
+proc ttk::Repeater::Repeat {w} {
+ variable State
+ $w instate disabled { return }
+ $w invoke
+ set State(timer) [after $State(interval) [list ttk::Repeater::Repeat $w]]
+}
+
+#*EOF*
diff --git a/library/tk.tcl b/library/tk.tcl
index c4e2b3d..09ac18a 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
# Initialization script normally executed in the interpreter for each
# Tk-based application. Arranges class bindings for widgets.
#
-# RCS: @(#) $Id: tk.tcl,v 1.59 2006/10/23 20:31:48 dgp Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.60 2006/10/31 01:42:26 hobbs Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -46,13 +46,20 @@ namespace eval ::tk {
}
namespace import ::tk::msgcat::*
}
+# and a ::ttk namespace
+namespace eval ::ttk {
+ if {$::tk_library ne ""} {
+ # avoid file join to work in safe interps, but this is also x-plat ok
+ variable library $::tk_library/ttk
+ }
+}
-# Add Tk's directory to the end of the auto-load search path, if it
+# Add Ttk & Tk's directory to the end of the auto-load search path, if it
# isn't already on the path:
-if {[info exists ::auto_path] && $::tk_library ne "" && \
- [lsearch -exact $::auto_path $::tk_library] < 0} {
- lappend ::auto_path $::tk_library
+if {[info exists ::auto_path] && ($::tk_library ne "")
+ && ($::tk_library ni $::auto_path)} {
+ lappend ::auto_path $::tk_library $::ttk::library
}
# Turn off strict Motif look and feel as a default.
@@ -394,7 +401,7 @@ switch -- [tk windowingsystem] {
if {$::tk_library ne ""} {
proc ::tk::SourceLibFile {file} {
namespace eval :: [list source [file join $::tk_library $file.tcl]]
- }
+ }
namespace eval ::tk {
SourceLibFile button
SourceLibFile entry
@@ -472,7 +479,7 @@ proc ::tk::UnderlineAmpersand {text} {
}
if {$idx >= 0} {
regsub -all -- {&([^&])} $text {\1} text
- }
+ }
return [list $text $idx]
}
@@ -584,3 +591,8 @@ if {[tk windowingsystem] eq "aqua"} {
set useCustomMDEF 0
}
}
+
+# Run the Ttk themed widget set initialization
+if {$::ttk::library ne ""} {
+ uplevel \#0 [list source $::ttk::library/ttk.tcl]
+}
diff --git a/library/ttk/altTheme.tcl b/library/ttk/altTheme.tcl
new file mode 100644
index 0000000..71fe23b
--- /dev/null
+++ b/library/ttk/altTheme.tcl
@@ -0,0 +1,85 @@
+#
+# $Id: altTheme.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+#
+# Ttk widget set: Alternate theme
+#
+
+namespace eval ttk::theme::alt {
+
+ variable colors
+ array set colors {
+ -frame "#d9d9d9"
+ -darker "#c3c3c3"
+ -activebg "#ececec"
+ -disabledfg "#a3a3a3"
+ -selectbg "#4a6984"
+ -selectfg "#ffffff"
+ }
+
+ namespace import -force ::ttk::style
+ style theme settings alt {
+
+ style configure "." \
+ -background $colors(-frame) \
+ -foreground black \
+ -troughcolor $colors(-darker) \
+ -selectbackground $colors(-selectbg) \
+ -selectforeground $colors(-selectfg) \
+ -font TkDefaultFont \
+ ;
+
+ style map "." -background \
+ [list disabled $colors(-frame) active $colors(-activebg)] ;
+ style map "." -foreground [list disabled $colors(-disabledfg)] ;
+ style map "." -embossed [list disabled 1] ;
+
+ style configure TButton \
+ -width -11 -padding "1 1" -relief raised -shiftrelief 1 \
+ -highlightthickness 1 -highlightcolor $colors(-frame)
+
+ style map TButton -relief {
+ {pressed !disabled} sunken
+ {active !disabled} raised
+ } -highlightcolor {alternate black}
+
+ style configure TCheckbutton -indicatorcolor "#ffffff" -padding 2
+ style configure TRadiobutton -indicatorcolor "#ffffff" -padding 2
+ style map TCheckbutton -indicatorcolor \
+ [list disabled $colors(-frame) pressed $colors(-frame)]
+ style map TRadiobutton -indicatorcolor \
+ [list disabled $colors(-frame) pressed $colors(-frame)]
+
+ style configure TMenubutton -width -11 -padding "3 3" -relief raised
+
+ style configure TEntry -padding 1
+ style map TEntry -fieldbackground \
+ [list readonly $colors(-frame) disabled $colors(-frame)]
+ style configure TCombobox -padding 1
+ style map TCombobox -fieldbackground \
+ [list readonly $colors(-frame) disabled $colors(-frame)]
+
+ style configure Toolbutton -relief flat -padding 2
+ style map Toolbutton -relief \
+ {disabled flat selected sunken pressed sunken active raised}
+ style map Toolbutton -background \
+ [list pressed $colors(-darker) active $colors(-activebg)]
+
+ style configure TScrollbar -relief raised
+
+ style configure TLabelframe -relief groove -borderwidth 2
+
+ style configure TNotebook -tabmargins {2 2 1 0}
+ style configure TNotebook.Tab \
+ -padding {4 2} -background $colors(-darker)
+ style map TNotebook.Tab \
+ -background [list selected $colors(-frame)] \
+ -expand [list selected {2 2 1 0}] \
+ ;
+
+ style configure TScale \
+ -groovewidth 4 -troughrelief sunken \
+ -sliderwidth raised -borderwidth 2
+ style configure TProgressbar \
+ -background $colors(-selectbg) -borderwidth 0
+ }
+}
diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl
new file mode 100644
index 0000000..4b4ad5e
--- /dev/null
+++ b/library/ttk/aquaTheme.tcl
@@ -0,0 +1,60 @@
+#
+# $Id: aquaTheme.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+#
+# Ttk widget set: Aqua theme (OSX native look and feel)
+#
+#
+# TODO: panedwindow sashes should be 9 pixels (HIG:Controls:Split Views)
+#
+
+namespace eval ttk {
+
+ style theme settings aqua {
+
+ style configure . \
+ -font System \
+ -background White \
+ -foreground Black \
+ -selectbackground SystemHighlight \
+ -selectforeground SystemHighlightText \
+ -selectborderwidth 0 \
+ -insertwidth 1 \
+ ;
+ style map . \
+ -foreground [list disabled "#a3a3a3" background "#a3a3a3"] \
+ -selectbackground [list background "#c3c3c3" !focus "#c3c3c3"] \
+ -selectforeground [list background "#a3a3a3" !focus "#000000"] \
+ ;
+
+ # Workaround for #1100117:
+ # Actually, on Aqua we probably shouldn't stipple images in
+ # disabled buttons even if it did work...
+ #
+ style configure . -stipple {}
+
+ style configure TButton -padding {0 2} -width -6
+ style configure Toolbutton -padding 4
+ # See Apple HIG figs 14-63, 14-65
+ style configure TNotebook -tabposition n -padding {20 12}
+ style configure TNotebook.Tab -padding {10 2 10 2}
+
+ # Enable animation for ttk::progressbar widget:
+ style configure TProgressbar -period 100 -maxphase 255
+
+ # Modify the the default Labelframe layout to use generic text element
+ # instead of Labelframe.text; the latter erases the window background
+ # (@@@ this still isn't right... want to fill with background pattern)
+
+ style layout TLabelframe {
+ Labelframe.border
+ text
+ }
+ #
+ # For Aqua, labelframe labels should appear outside the border,
+ # with a 14 pixel inset and 4 pixels spacing between border and label
+ # (ref: Apple Human Interface Guidelines / Controls / Grouping Controls)
+ #
+ style configure TLabelframe \
+ -labeloutside true -labelmargins {14 0 14 4}
+ }
+}
diff --git a/library/ttk/button.tcl b/library/ttk/button.tcl
new file mode 100644
index 0000000..ccc1fb4
--- /dev/null
+++ b/library/ttk/button.tcl
@@ -0,0 +1,85 @@
+#
+# $Id: button.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+#
+# Bindings for Buttons, Checkbuttons, and Radiobuttons.
+#
+# Notes: <Button1-Leave>, <Button1-Enter> only control the "pressed"
+# state; widgets remain "active" if the pointer is dragged out.
+# This doesn't seem to be conventional, but it's a nice way
+# to provide extra feedback while the grab is active.
+# (If the button is released off the widget, the grab deactivates and
+# we get a <Leave> event then, which turns off the "active" state)
+#
+# Normally, <ButtonRelease> and <ButtonN-Enter/Leave> events are
+# delivered to the widget which received the initial <ButtonPress>
+# event. However, Tk [grab]s (#1223103) and menu interactions
+# (#1222605) can interfere with this. To guard against spurious
+# <Button1-Enter> events, the <Button1-Enter> binding only sets
+# the pressed state if the button is currently active.
+#
+
+namespace eval ttk::button {}
+
+bind TButton <Enter> { %W instate !disabled {%W state active} }
+bind TButton <Leave> { %W state !active }
+bind TButton <Key-space> { ttk::button::activate %W }
+bind TButton <<Invoke>> { ttk::button::activate %W }
+
+bind TButton <ButtonPress-1> \
+ { %W instate !disabled { ttk::clickToFocus %W; %W state pressed } }
+bind TButton <ButtonRelease-1> \
+ { %W instate {pressed !disabled} { %W state !pressed; %W invoke } }
+bind TButton <Button1-Leave> \
+ { %W state !pressed }
+bind TButton <Button1-Enter> \
+ { %W instate {active !disabled} { %W state pressed } }
+
+# Checkbuttons and Radiobuttons have the same bindings as Buttons:
+#
+ttk::CopyBindings TButton TCheckbutton
+ttk::CopyBindings TButton TRadiobutton
+
+# ...plus a few more:
+
+bind TRadiobutton <KeyPress-Up> { ttk::button::RadioTraverse %W -1 }
+bind TRadiobutton <KeyPress-Down> { ttk::button::RadioTraverse %W +1 }
+
+# bind TCheckbutton <KeyPress-plus> { %W select }
+# bind TCheckbutton <KeyPress-minus> { %W deselect }
+
+# activate --
+# Simulate a button press: temporarily set the state to 'pressed',
+# then invoke the button.
+#
+proc ttk::button::activate {w} {
+ $w instate disabled { return }
+ set oldState [$w state pressed]
+ update idletasks; after 100
+ $w state $oldState
+ $w invoke
+}
+
+# RadioTraverse -- up/down keyboard traversal for radiobutton groups.
+# Set focus to previous/next radiobutton in a group.
+# A radiobutton group consists of all the radiobuttons with
+# the same parent and -variable; this is a pretty good heuristic
+# that works most of the time.
+#
+proc ttk::button::RadioTraverse {w dir} {
+ set group [list]
+ foreach sibling [winfo children [winfo parent $w]] {
+ if { [winfo class $sibling] eq "TRadiobutton"
+ && [$sibling cget -variable] eq [$w cget -variable]
+ && ![$sibling instate disabled]
+ } {
+ lappend group $sibling
+ }
+ }
+
+ if {![llength $group]} { # Shouldn't happen, but can.
+ return
+ }
+
+ set pos [expr {([lsearch -exact $group $w] + $dir) % [llength $group]}]
+ tk::TabToWindow [lindex $group $pos]
+}
diff --git a/library/ttk/clamTheme.tcl b/library/ttk/clamTheme.tcl
new file mode 100644
index 0000000..76e24fe
--- /dev/null
+++ b/library/ttk/clamTheme.tcl
@@ -0,0 +1,119 @@
+#
+# $Id: clamTheme.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+#
+# Ttk widget set: "Clam" theme
+#
+# Inspired by the XFCE family of Gnome themes.
+#
+
+namespace eval ttk::theme::clam {
+
+ package provide ttk::theme::clam 0.0.1
+
+ variable colors ; array set colors {
+ -disabledfg "#999999"
+
+ -frame "#dcdad5"
+ -dark "#cfcdc8"
+ -darker "#bab5ab"
+ -darkest "#9e9a91"
+ -lighter "#eeebe7"
+ -lightest "#ffffff"
+ -selectbg "#4a6984"
+ -selectfg "#ffffff"
+ }
+
+ namespace import -force ::ttk::style
+ style theme settings clam {
+
+ style configure "." \
+ -background $colors(-frame) \
+ -foreground black \
+ -bordercolor $colors(-darkest) \
+ -darkcolor $colors(-dark) \
+ -lightcolor $colors(-lighter) \
+ -troughcolor $colors(-darker) \
+ -selectbackground $colors(-selectbg) \
+ -selectforeground $colors(-selectfg) \
+ -selectborderwidth 0 \
+ -font TkDefaultFont \
+ ;
+
+ style map "." \
+ -background [list disabled $colors(-frame) \
+ active $colors(-lighter)] \
+ -foreground [list disabled $colors(-disabledfg)] \
+ -selectbackground [list !focus $colors(-darkest)] \
+ -selectforeground [list !focus white] \
+ ;
+ # -selectbackground [list !focus "#847d73"]
+
+ style configure TButton -width -11 -padding 5 -relief raised
+ style map TButton \
+ -background [list \
+ disabled $colors(-frame) \
+ pressed $colors(-darker) \
+ active $colors(-lighter)] \
+ -lightcolor [list pressed $colors(-darker)] \
+ -darkcolor [list pressed $colors(-darker)] \
+ -bordercolor [list alternate "#000000"] \
+ ;
+
+ style configure Toolbutton -padding 2 -relief flat
+ style map Toolbutton \
+ -relief {disabled flat selected sunken pressed sunken active raised} \
+ -background [list disabled $colors(-frame) \
+ pressed $colors(-darker) \
+ active $colors(-lighter)] \
+ -lightcolor [list pressed $colors(-darker)] \
+ -darkcolor [list pressed $colors(-darker)] \
+ ;
+
+ style configure TCheckbutton \
+ -indicatorbackground "#ffffff" \
+ -indicatormargin {1 1 4 1} \
+ -padding 2 ;
+ style configure TRadiobutton \
+ -indicatorbackground "#ffffff" \
+ -indicatormargin {1 1 4 1} \
+ -padding 2 ;
+ style map TCheckbutton -indicatorbackground \
+ [list disabled $colors(-frame) pressed $colors(-frame)]
+ style map TRadiobutton -indicatorbackground \
+ [list disabled $colors(-frame) pressed $colors(-frame)]
+
+ style configure TMenubutton -width -11 -padding 5 -relief raised
+
+ style configure TEntry -padding 1 -insertwidth 1
+ style map TEntry \
+ -background [list readonly $colors(-frame)] \
+ -bordercolor [list focus $colors(-selectbg)] \
+ -lightcolor [list focus "#6f9dc6"] \
+ -darkcolor [list focus "#6f9dc6"] \
+ ;
+
+ style configure TCombobox -padding 1 -insertwidth 1
+ style map TCombobox \
+ -background [list active $colors(-lighter) \
+ pressed $colors(-lighter)] \
+ -fieldbackground [list {readonly focus} $colors(-selectbg) \
+ readonly $colors(-frame)] \
+ -foreground [list {readonly focus} $colors(-selectfg)] \
+ ;
+
+ style configure TNotebook.Tab -padding {6 2 6 2}
+ style map TNotebook.Tab \
+ -padding [list selected {6 4 6 2}] \
+ -background [list selected $colors(-frame) {} $colors(-darker)] \
+ -lightcolor [list selected $colors(-lighter) {} $colors(-dark)] \
+ ;
+
+ style configure TLabelframe \
+ -labeloutside true -labelmargins {0 0 0 4} \
+ -borderwidth 2 -relief raised
+
+ style configure TProgressbar -background $colors(-frame)
+
+ style configure Sash -sashthickness 6 -gripcount 10
+ }
+}
diff --git a/library/ttk/classicTheme.tcl b/library/ttk/classicTheme.tcl
new file mode 100644
index 0000000..6376268
--- /dev/null
+++ b/library/ttk/classicTheme.tcl
@@ -0,0 +1,94 @@
+#
+# $Id: classicTheme.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $
+#
+# Ttk widget set: Classic theme.
+# Implements the classic Tk Motif-like look and feel.
+#
+
+namespace eval ttk::theme::classic {
+
+ font create TkClassicDefaultFont -family Helvetica -weight bold -size -12
+
+ variable colors; array set colors {
+ -frame "#d9d9d9"
+ -activebg "#ececec"
+ -troughbg "#c3c3c3"
+ -selectbg "#c3c3c3"
+ -selectfg "#000000"
+ -disabledfg "#a3a3a3"
+ -indicator "#b03060"
+ }
+
+ namespace import -force ::ttk::style
+ style theme settings classic {
+ style configure "." \
+ -font TkClassicDefaultFont \
+ -background $colors(-frame) \
+ -foreground black \
+ -selectbackground $colors(-selectbg) \
+ -selectforeground $colors(-selectfg) \
+ -troughcolor $colors(-troughbg) \
+ -indicatorcolor $colors(-frame) \
+ -highlightcolor $colors(-frame) \
+ -highlightthickness 1 \
+ -selectborderwidth 1 \
+ -insertwidth 2 \
+ ;
+
+ style map "." -background \
+ [list disabled $colors(-frame) active $colors(-activebg)]
+ style map "." -foreground \
+ [list disabled $colors(-disabledfg)]
+
+ style map "." -highlightcolor [list focus black]
+
+ style configure TButton -padding "3m 1m" -relief raised -shiftrelief 1
+ style map TButton -relief [list {!disabled pressed} sunken]
+
+ style configure TCheckbutton -indicatorrelief raised
+ style map TCheckbutton \
+ -indicatorcolor [list \
+ pressed $colors(-frame) selected $colors(-indicator)] \
+ -indicatorrelief {selected sunken pressed sunken} \
+ ;
+
+ style configure TRadiobutton -indicatorrelief raised
+ style map TRadiobutton \
+ -indicatorcolor [list \
+ pressed $colors(-frame) selected $colors(-indicator)] \
+ -indicatorrelief {selected sunken pressed sunken} \
+ ;
+
+ style configure TMenubutton -relief raised -padding "3m 1m"
+
+ style configure TEntry -relief sunken -padding 1 -font TkTextFont
+ style map TEntry -fieldbackground \
+ [list readonly $colors(-frame) disabled $colors(-frame)]
+ style configure TCombobox -padding 1
+ style map TCombobox -fieldbackground \
+ [list readonly $colors(-frame) disabled $colors(-frame)]
+
+ style configure TLabelframe -borderwidth 2 -relief groove
+
+ style configure TScrollbar -relief raised
+ style map TScrollbar -relief {{pressed !disabled} sunken}
+
+ style configure TScale -sliderrelief raised
+ style map TScale -sliderrelief {{pressed !disabled} sunken}
+
+ style configure TProgressbar -background SteelBlue
+ style configure TNotebook.Tab \
+ -padding {3m 1m} \
+ -background $colors(-troughbg)
+ style map TNotebook.Tab -background [list selected $colors(-frame)]
+
+ #
+ # Toolbar buttons:
+ #
+ style configure Toolbutton -padding 2 -relief flat -shiftrelief 2
+ style map Toolbutton -relief \
+ {disabled flat selected sunken pressed sunken active raised}
+ style map Toolbutton -background \
+ [list pressed $colors(-troughbg) active $colors(-activebg)]
+ }
+}
diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl
new file mode 100644
index 0000000..7df9f61
--- /dev/null
+++ b/library/ttk/combobox.tcl
@@ -0,0 +1,360 @@
+#
+# $Id: combobox.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set: combobox bindings.
+#
+# Each combobox $cb has a child $cb.popdown, which contains
+# a listbox $cb.popdown.l and a scrollbar. The listbox -listvariable
+# is set to a namespace variable, which is used to synchronize the
+# combobox values with the listbox values.
+#
+
+namespace eval ttk::combobox {
+ variable Values ;# Values($cb) is -listvariable of listbox widget
+
+ variable State
+ set State(entryPress) 0
+}
+
+### Combobox bindings.
+#
+# Duplicate the Entry bindings, override if needed:
+#
+
+ttk::CopyBindings TEntry TCombobox
+
+bind TCombobox <KeyPress-Down> { ttk::combobox::Post %W }
+bind TCombobox <KeyPress-Escape> { ttk::combobox::Unpost %W }
+
+bind TCombobox <ButtonPress-1> { ttk::combobox::Press "" %W %x %y }
+bind TCombobox <Shift-ButtonPress-1> { ttk::combobox::Press "s" %W %x %y }
+bind TCombobox <Double-ButtonPress-1> { ttk::combobox::Press "2" %W %x %y }
+bind TCombobox <Triple-ButtonPress-1> { ttk::combobox::Press "3" %W %x %y }
+bind TCombobox <B1-Motion> { ttk::combobox::Drag %W %x }
+
+bind TCombobox <MouseWheel> { ttk::combobox::Scroll %W [expr {%D/-120}] }
+if {[tk windowingsystem] eq "x11"} {
+ bind TCombobox <ButtonPress-4> { ttk::combobox::Scroll %W -1 }
+ bind TCombobox <ButtonPress-5> { ttk::combobox::Scroll %W 1 }
+}
+
+bind TCombobox <<TraverseIn>> { ttk::combobox::TraverseIn %W }
+
+### Combobox listbox bindings.
+#
+bind ComboboxListbox <ButtonPress-1> { focus %W ; continue }
+bind ComboboxListbox <ButtonRelease-1> { ttk::combobox::LBSelected %W }
+bind ComboboxListbox <KeyPress-Return> { ttk::combobox::LBSelected %W }
+bind ComboboxListbox <KeyPress-Escape> { ttk::combobox::LBCancel %W }
+bind ComboboxListbox <KeyPress-Tab> { ttk::combobox::LBTab %W next }
+bind ComboboxListbox <<PrevWindow>> { ttk::combobox::LBTab %W prev }
+bind ComboboxListbox <Destroy> { ttk::combobox::LBCleanup %W }
+# Default behavior is to follow selection on mouseover
+bind ComboboxListbox <Motion> {
+ %W selection clear 0 end
+ %W activate @%x,%y
+ %W selection set @%x,%y
+}
+
+# The combobox has a global grab active when the listbox is posted,
+# but on Windows and OSX that doesn't prevent the user from interacting
+# with other applications. We need to popdown the listbox when this happens.
+#
+# On OSX, the listbox gets a <Deactivate> event. This doesn't happen
+# on Windows or X11, but it does get a <FocusOut> event. However on OSX
+# in Tk 8.5, the listbox gets spurious <FocusOut> events when the listbox
+# is posted (see #1349811).
+#
+# The following seems to work:
+#
+
+switch -- [tk windowingsystem] {
+ win32 {
+ bind ComboboxListbox <FocusOut> { ttk::combobox::LBCancel %W }
+ }
+ aqua {
+ bind ComboboxListbox <Deactivate> { ttk::combobox::LBCancel %W }
+ }
+}
+
+### Option database settings.
+#
+
+if {[tk windowingsystem] eq "x11"} {
+ option add *TCombobox*Listbox.background white
+}
+
+# The following ensures that the popdown listbox uses the same font
+# as the combobox entry field (at least for the standard Ttk themes).
+#
+option add *TCombobox*Listbox.font TkTextFont
+
+### Binding procedures.
+#
+
+## combobox::Press $mode $x $y --
+# ButtonPress binding for comboboxes.
+# Either post/unpost the listbox, or perform Entry widget binding,
+# depending on widget state and location of button press.
+#
+proc ttk::combobox::Press {mode w x y} {
+ variable State
+ set State(entryPress) [expr {
+ [$w instate {!readonly !disabled}]
+ && [string match *textarea [$w identify $x $y]]
+ }]
+
+ if {$State(entryPress)} {
+ focus $w
+ switch -- $mode {
+ s { ttk::entry::Shift-Press $w $x ; # Shift }
+ 2 { ttk::entry::Select $w $x word ; # Double click}
+ 3 { ttk::entry::Select $w $x line ; # Triple click }
+ "" -
+ default { ttk::entry::Press $w $x }
+ }
+ } else {
+ TogglePost $w
+ }
+}
+
+## combobox::Drag --
+# B1-Motion binding for comboboxes.
+# If the initial ButtonPress event was handled by Entry binding,
+# perform Entry widget drag binding; otherwise nothing.
+#
+proc ttk::combobox::Drag {w x} {
+ variable State
+ if {$State(entryPress)} {
+ ttk::entry::Drag $w $x
+ }
+}
+
+## TraverseIn -- receive focus due to keyboard navigation
+# For editable comboboxes, set the selection and insert cursor.
+#
+proc ttk::combobox::TraverseIn {w} {
+ $w instate {!readonly !disabled} {
+ $w selection range 0 end
+ $w icursor end
+ }
+}
+
+## SelectEntry $cb $index --
+# Set the combobox selection in response to a user action.
+#
+proc ttk::combobox::SelectEntry {cb index} {
+ $cb current $index
+ $cb selection range 0 end
+ $cb icursor end
+ event generate $cb <<ComboboxSelected>>
+}
+
+## Scroll -- Mousewheel binding
+#
+proc ttk::combobox::Scroll {cb dir} {
+ $cb instate disabled { return }
+ set max [llength [$cb cget -values]]
+ set current [$cb current]
+ incr current $dir
+ if {$max != 0 && $current == $current % $max} {
+ SelectEntry $cb $current
+ }
+}
+
+## LBSelected $lb -- Activation binding for listbox
+# Set the combobox value to the currently-selected listbox value
+# and unpost the listbox.
+#
+proc ttk::combobox::LBSelected {lb} {
+ set cb [LBMaster $lb]
+ set selection [$lb curselection]
+ Unpost $cb
+ focus $cb
+ if {[llength $selection] == 1} {
+ SelectEntry $cb [lindex $selection 0]
+ }
+}
+
+## LBCancel --
+# Unpost the listbox.
+#
+proc ttk::combobox::LBCancel {lb} {
+ Unpost [LBMaster $lb]
+}
+
+## LBTab --
+# Tab key binding for combobox listbox:
+# Set the selection, and navigate to next/prev widget.
+#
+proc ttk::combobox::LBTab {lb dir} {
+ set cb [LBMaster $lb]
+ switch -- $dir {
+ next { set newFocus [tk_focusNext $cb] }
+ prev { set newFocus [tk_focusPrev $cb] }
+ }
+
+ if {$newFocus ne ""} {
+ LBSelected $lb
+ # The [grab release] call in [Unpost] queues events that later
+ # re-set the focus. [update] to make sure these get processed first:
+ update
+ tk::TabToWindow $newFocus
+ }
+}
+
+## PopdownShell --
+# Returns the popdown shell widget associated with a combobox,
+# creating it if necessary.
+#
+proc ttk::combobox::PopdownShell {cb} {
+ if {![winfo exists $cb.popdown]} {
+ set popdown [toplevel $cb.popdown -relief solid -bd 1]
+ wm withdraw $popdown
+ wm overrideredirect $popdown 1
+ wm transient $popdown [winfo toplevel $cb]
+
+ # XXX Until we have a proper native scrollbar on Aqua, use
+ # XXX the regular Tk one
+ if {[tk windowingsystem] eq "aqua"} {
+ scrollbar $popdown.sb -orient vertical \
+ -command [list $popdown.l yview]
+ } else {
+ ttk::scrollbar $popdown.sb -orient vertical \
+ -command [list $popdown.l yview]
+ }
+ listbox $popdown.l \
+ -listvariable ttk::combobox::Values($cb) \
+ -yscrollcommand [list $popdown.sb set] \
+ -exportselection false \
+ -selectmode browse \
+ -borderwidth 2 -relief flat \
+ -highlightthickness 0 \
+ -activestyle none \
+ ;
+
+ bindtags $popdown.l \
+ [list $popdown.l ComboboxListbox Listbox $popdown all]
+
+ grid $popdown.l $popdown.sb -sticky news
+ grid columnconfigure $popdown 0 -weight 1
+ grid rowconfigure $popdown 0 -weight 1
+ }
+ return $cb.popdown
+}
+
+## combobox::Post $cb --
+# Pop down the associated listbox.
+#
+proc ttk::combobox::Post {cb} {
+ variable State
+ variable Values
+
+ # Don't do anything if disabled:
+ #
+ $cb instate disabled { return }
+
+ # Run -postcommand callback:
+ #
+ uplevel #0 [$cb cget -postcommand]
+
+ # Combobox is in 'pressed' state while listbox posted:
+ #
+ $cb state pressed
+
+ set popdown [PopdownShell $cb]
+ set values [$cb cget -values]
+ set current [$cb current]
+ if {$current < 0} {
+ set current 0 ;# no current entry, highlight first one
+ }
+ set Values($cb) $values
+ $popdown.l selection clear 0 end
+ $popdown.l selection set $current
+ $popdown.l activate $current
+ $popdown.l see $current
+ # Should allow user to control listbox height
+ set height [llength $values]
+ if {$height > 10} {
+ set height 10
+ }
+ $popdown.l configure -height $height
+ update idletasks
+
+ # Position listbox (@@@ factor with menubutton::PostPosition
+ #
+ set x [winfo rootx $cb]
+ set y [winfo rooty $cb]
+ set w [winfo width $cb]
+ set h [winfo height $cb]
+ if {[tk windowingsystem] eq "aqua"} {
+ # Adjust for platform-specific bordering to ensure the box is
+ # directly under actual 'entry square'
+ set xoff 3
+ set yoff 2
+ incr x $xoff
+ set w [expr {$w - $xoff*2}]
+ } else {
+ set yoff 0
+ }
+
+ set H [winfo reqheight $popdown]
+ if {$y + $h + $H > [winfo screenheight $popdown]} {
+ set Y [expr {$y - $H - $yoff}]
+ } else {
+ set Y [expr {$y + $h - $yoff}]
+ }
+ wm geometry $popdown ${w}x${H}+${x}+${Y}
+
+ # Post the listbox:
+ #
+ wm deiconify $popdown
+ raise $popdown
+ # @@@ Workaround for TrackElementState bug:
+ event generate $cb <ButtonRelease-1>
+ # /@@@
+ ttk::globalGrab $cb
+ focus $popdown.l
+}
+
+## combobox::Unpost $cb --
+# Unpost the listbox, restore focus to combobox widget.
+#
+proc ttk::combobox::Unpost {cb} {
+ $cb state !pressed
+ ttk::releaseGrab $cb
+ if {[winfo exists $cb.popdown]} {
+ wm withdraw $cb.popdown
+ }
+ focus $cb
+}
+
+## combobox::TogglePost $cb --
+# Post the listbox if unposted, unpost otherwise.
+#
+proc ttk::combobox::TogglePost {cb} {
+ if {[$cb instate pressed]} { Unpost $cb } { Post $cb }
+}
+
+## LBMaster $lb --
+# Return the combobox main widget that owns the listbox.
+#
+proc ttk::combobox::LBMaster {lb} {
+ winfo parent [winfo parent $lb]
+}
+
+## LBCleanup $lb --
+# <Destroy> binding for combobox listboxes.
+# Cleans up by unsetting the linked textvariable.
+#
+# Note: we can't just use { unset [%W cget -listvariable] }
+# because the widget command is already gone when this binding fires).
+# [winfo parent] still works, fortunately.
+#
+
+proc ttk::combobox::LBCleanup {lb} {
+ variable Values
+ unset Values([LBMaster $lb])
+}
+
+#*EOF*
diff --git a/library/ttk/cursors.tcl b/library/ttk/cursors.tcl
new file mode 100644
index 0000000..a151194
--- /dev/null
+++ b/library/ttk/cursors.tcl
@@ -0,0 +1,35 @@
+#
+# $Id: cursors.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk package: Symbolic cursor names.
+#
+# @@@ TODO: Figure out appropriate platform-specific cursors
+# for the various functions.
+#
+
+namespace eval ttk {
+
+ variable Cursors
+
+ switch -glob $::tcl_platform(platform) {
+ "windows" {
+ array set Cursors {
+ hresize sb_h_double_arrow
+ vresize sb_v_double_arrow
+ seresize size_nw_se
+ }
+ }
+
+ "unix" -
+ * {
+ array set Cursors {
+ hresize sb_h_double_arrow
+ vresize sb_v_double_arrow
+ seresize bottom_right_corner
+ }
+ }
+
+ }
+}
+
+#*EOF*
diff --git a/library/ttk/defaults.tcl b/library/ttk/defaults.tcl
new file mode 100644
index 0000000..a370e65
--- /dev/null
+++ b/library/ttk/defaults.tcl
@@ -0,0 +1,95 @@
+#
+# $Id: defaults.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set: Default theme
+#
+
+namespace eval ttk {
+ # XXX do we want to separate Tk version from theme version?
+ package provide ttk::theme::default $::tk_version
+
+ variable colors
+ array set colors {
+ -frame "#d9d9d9"
+ -activebg "#ececec"
+ -selectbg "#4a6984"
+ -selectfg "#ffffff"
+ -darker "#c3c3c3"
+ -disabledfg "#a3a3a3"
+ -indicator "#4a6984"
+ }
+
+ style theme settings default {
+
+ style configure "." \
+ -borderwidth 1 \
+ -background $colors(-frame) \
+ -foreground black \
+ -troughcolor $colors(-darker) \
+ -font TkDefaultFont \
+ -selectborderwidth 1 \
+ -selectbackground $colors(-selectbg) \
+ -selectforeground $colors(-selectfg) \
+ -insertwidth 1 \
+ -indicatordiameter 10 \
+ ;
+
+ style map "." -background \
+ [list disabled $colors(-frame) active $colors(-activebg)]
+ style map "." -foreground \
+ [list disabled $colors(-disabledfg)]
+
+ style configure TButton \
+ -padding "3 3" -width -9 -relief raised -shiftrelief 1
+ style map TButton -relief [list {!disabled pressed} sunken]
+
+ style configure TCheckbutton \
+ -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
+ style map TCheckbutton -indicatorcolor \
+ [list pressed $colors(-activebg) selected $colors(-indicator)]
+
+ style configure TRadiobutton \
+ -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
+ style map TRadiobutton -indicatorcolor \
+ [list pressed $colors(-activebg) selected $colors(-indicator)]
+
+ style configure TMenubutton -relief raised -padding "10 3"
+
+ style configure TEntry -relief sunken -fieldbackground white -padding 1
+ style map TEntry -fieldbackground \
+ [list readonly $colors(-frame) disabled $colors(-frame)]
+
+ style configure TCombobox -arrowsize 12 -padding 1
+ style map TCombobox -fieldbackground \
+ [list readonly $colors(-frame) disabled $colors(-frame)]
+
+ style configure TLabelframe -relief groove -borderwidth 2
+
+ style configure TScrollbar -width 12 -arrowsize 12
+ style map TScrollbar -arrowcolor [list disabled $colors(-disabledfg)]
+
+ style configure TScale -sliderrelief raised
+ style configure TProgressbar -background $colors(-selectbg)
+
+ style configure TNotebook.Tab \
+ -padding {4 2} -background $colors(-darker)
+ style map TNotebook.Tab -background [list selected $colors(-frame)]
+
+ #
+ # Toolbar buttons:
+ #
+ style layout Toolbutton {
+ Toolbutton.border -children {
+ Toolbutton.padding -children {
+ Toolbutton.label
+ }
+ }
+ }
+
+ style configure Toolbutton -padding 2 -relief flat
+ style map Toolbutton -relief \
+ {disabled flat selected sunken pressed sunken active raised}
+ style map Toolbutton -background \
+ [list pressed $colors(-darker) active $colors(-activebg)]
+ }
+}
diff --git a/library/ttk/dialog.tcl b/library/ttk/dialog.tcl
new file mode 100644
index 0000000..cb3db47
--- /dev/null
+++ b/library/ttk/dialog.tcl
@@ -0,0 +1,272 @@
+#
+# $Id: dialog.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Copyright (c) 2005, Joe English. Freely redistributable.
+#
+# Ttk widget set: dialog boxes.
+#
+# TODO: option to keep dialog onscreen ("persistent" / "transient")
+# TODO: accelerator keys.
+# TODO: use message catalogs for button labels
+# TODO: routines to selectively enable/disable individual command buttons
+# TODO: use megawidgetoid API [$dlg dismiss] vs. [ttk::dialog::dismiss $dlg]
+# TODO: MAYBE: option for app-modal dialogs
+# TODO: MAYBE: [wm withdraw] dialog on dismiss instead of self-destructing
+#
+
+namespace eval ttk::dialog {
+
+ variable Config
+ #
+ # Spacing parameters:
+ # (taken from GNOME HIG 2.0, may need adjustment for other platforms)
+ # (textwidth just a guess)
+ #
+ set Config(margin) 12 ;# space between icon and text
+ set Config(interspace) 6 ;# horizontal space between buttons
+ set Config(sepspace) 24 ;# vertical space above buttons
+ set Config(textwidth) 400 ;# width of dialog box text (pixels)
+
+ variable DialogTypes ;# map -type => list of dialog options
+ variable ButtonOptions ;# map button name => list of button options
+
+ # stockButton -- define new built-in button
+ #
+ proc stockButton {button args} {
+ variable ButtonOptions
+ set ButtonOptions($button) $args
+ }
+
+ # Built-in button types:
+ #
+ stockButton ok -text OK
+ stockButton cancel -text Cancel
+ stockButton yes -text Yes
+ stockButton no -text No
+ stockButton retry -text Retry
+
+ # stockDialog -- define new dialog type.
+ #
+ proc stockDialog {type args} {
+ variable DialogTypes
+ set DialogTypes($type) $args
+ }
+
+ # Built-in dialog types:
+ #
+ stockDialog ok \
+ -icon info -buttons {ok} -default ok
+ stockDialog okcancel \
+ -icon info -buttons {ok cancel} -default ok -cancel cancel
+ stockDialog retrycancel \
+ -icon question -buttons {retry cancel} -cancel cancel
+ stockDialog yesno \
+ -icon question -buttons {yes no}
+ stockDialog yesnocancel \
+ -icon question -buttons {yes no cancel} -cancel cancel
+}
+
+## ttk::dialog::nop --
+# Do nothing (used as a default callback command).
+#
+proc ttk::dialog::nop {args} { }
+
+## ttk::dialog -- dialog box constructor.
+#
+interp alias {} ttk::dialog {} ttk::dialog::Constructor
+
+proc ttk::dialog::Constructor {dlg args} {
+ upvar #0 $dlg D
+ variable Config
+ variable ButtonOptions
+ variable DialogTypes
+
+ #
+ # Option processing:
+ #
+ array set defaults {
+ -title ""
+ -message ""
+ -detail ""
+ -command ttk::dialog::nop
+ -icon ""
+ -buttons {}
+ -labels {}
+ -default {}
+ -cancel {}
+ -parent #AUTO
+ }
+
+ array set options [array get defaults]
+
+ foreach {option value} $args {
+ if {$option eq "-type"} {
+ array set options $DialogTypes($value)
+ } elseif {![info exists options($option)]} {
+ set validOptions [join [lsort [array names options]] ", "]
+ return -code error \
+ "Illegal option $option: must be one of $validOptions"
+ }
+ }
+ array set options $args
+
+ # ...
+ #
+ array set buttonOptions [array get ::ttk::dialog::ButtonOptions]
+ foreach {button label} $options(-labels) {
+ lappend buttonOptions($button) -text $label
+ }
+
+ #
+ # Initialize dialog private data:
+ #
+ foreach option {-command -message -detail} {
+ set D($option) $options($option)
+ }
+
+ toplevel $dlg -class Dialog; wm withdraw $dlg
+
+ #
+ # Determine default transient parent.
+ #
+ # NB: menus (including menubars) are considered toplevels,
+ # so skip over those.
+ #
+ if {$options(-parent) eq "#AUTO"} {
+ set parent [winfo toplevel [winfo parent $dlg]]
+ while {[winfo class $parent] eq "Menu" && $parent ne "."} {
+ set parent [winfo toplevel [winfo parent $parent]]
+ }
+ set options(-parent) $parent
+ }
+
+ #
+ # Build dialog:
+ #
+ if {$options(-parent) ne ""} {
+ wm transient $dlg $options(-parent)
+ }
+ wm title $dlg $options(-title)
+ wm protocol $dlg WM_DELETE_WINDOW { }
+
+ set f [ttk::frame $dlg.f]
+
+ ttk::label $f.icon
+ if {$options(-icon) ne ""} {
+ $f.icon configure -image [ttk::stockIcon dialog/$options(-icon)]
+ }
+ ttk::label $f.message -textvariable ${dlg}(-message) \
+ -font TkCaptionFont -wraplength $Config(textwidth)\
+ -anchor w -justify left
+ ttk::label $f.detail -textvariable ${dlg}(-detail) \
+ -font TkTextFont -wraplength $Config(textwidth) \
+ -anchor w -justify left
+
+ #
+ # Command buttons:
+ #
+ set cmd [ttk::frame $f.cmd]
+ set column 0
+ grid columnconfigure $f.cmd 0 -weight 1
+
+ foreach button $options(-buttons) {
+ incr column
+ eval [linsert $buttonOptions($button) 0 ttk::button $cmd.$button]
+ $cmd.$button configure -command [list ttk::dialog::Done $dlg $button]
+ grid $cmd.$button -row 0 -column $column \
+ -padx [list $Config(interspace) 0] -sticky ew
+ grid columnconfigure $cmd $column -uniform buttons
+ }
+
+ if {$options(-default) ne ""} {
+ keynav::defaultButton $cmd.$options(-default)
+ focus $cmd.$options(-default)
+ }
+ if {$options(-cancel) ne ""} {
+ bind $dlg <KeyPress-Escape> \
+ [list event generate $cmd.$options(-cancel) <<Invoke>>]
+ wm protocol $dlg WM_DELETE_WINDOW \
+ [list event generate $cmd.$options(-cancel) <<Invoke>>]
+ }
+
+ #
+ # Assemble dialog.
+ #
+ pack $f.cmd -side bottom -expand false -fill x \
+ -pady [list $Config(sepspace) $Config(margin)] -padx $Config(margin)
+
+ if {0} {
+ # GNOME and Apple HIGs say not to use separators.
+ # But in case we want them anyway:
+ #
+ pack [ttk::separator $f.sep -orient horizontal] \
+ -side bottom -expand false -fill x \
+ -pady [list $Config(sepspace) 0] \
+ -padx $Config(margin)
+ }
+
+ if {$options(-icon) ne ""} {
+ pack $f.icon -side left -anchor n -expand false \
+ -pady $Config(margin) -padx $Config(margin)
+ }
+
+ pack $f.message -side top -expand false -fill x \
+ -padx $Config(margin) -pady $Config(margin)
+ if {$options(-detail) != ""} {
+ pack $f.detail -side top -expand false -fill x \
+ -padx $Config(margin)
+ }
+
+ # Client area goes here.
+
+ pack $f -expand true -fill both
+ keynav::enableMnemonics $dlg
+ wm deiconify $dlg
+}
+
+## ttk::dialog::clientframe --
+# Returns the widget path of the dialog client frame,
+# creating and managing it if necessary.
+#
+proc ttk::dialog::clientframe {dlg} {
+ variable Config
+ set client $dlg.f.client
+ if {![winfo exists $client]} {
+ pack [ttk::frame $client] -side top -expand true -fill both \
+ -pady $Config(margin) -padx $Config(margin)
+ lower $client ;# so it's first in keyboard traversal order
+ }
+ return $client
+}
+
+## ttk::dialog::Done --
+# -command callback for dialog command buttons (internal)
+#
+proc ttk::dialog::Done {dlg button} {
+ upvar #0 $dlg D
+ set rc [catch [linsert $D(-command) end $button] result]
+ if {$rc == 1} {
+ return -code $rc -errorinfo $::errorInfo -errorcode $::errorCode $result
+ } elseif {$rc == 3 || $rc == 4} {
+ # break or continue -- don't dismiss dialog
+ return
+ }
+ dismiss $dlg
+}
+
+## ttk::dialog::activate $dlg $button --
+# Simulate a button press.
+#
+proc ttk::dialog::activate {dlg button} {
+ event generate $dlg.f.cmd.$button <<Invoke>>
+}
+
+## dismiss --
+# Dismiss the dialog (without invoking any actions).
+#
+proc ttk::dialog::dismiss {dlg} {
+ uplevel #0 [list unset $dlg]
+ destroy $dlg
+}
+
+#*EOF*
diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl
new file mode 100644
index 0000000..65fdf90
--- /dev/null
+++ b/library/ttk/entry.tcl
@@ -0,0 +1,580 @@
+#
+# $Id: entry.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# DERIVED FROM: tk/library/entry.tcl r1.22
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 2004, Joe English
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+namespace eval ttk {
+ namespace eval entry {
+ variable State
+
+ set State(x) 0
+ set State(selectMode) char
+ set State(anchor) 0
+ set State(scanX) 0
+ set State(scanIndex) 0
+ set State(scanMoved) 0
+
+ # Button-2 scan speed is (scanNum/scanDen) characters
+ # per pixel of mouse movement.
+ # The standard Tk entry widget uses the equivalent of
+ # scanNum = 10, scanDen = average character width.
+ # I don't know why that was chosen.
+ #
+ set State(scanNum) 1
+ set State(scanDen) 1
+ set State(deadband) 3 ;# #pixels for mouse-moved deadband.
+ }
+}
+
+### Bindings.
+#
+# Removed the following standard Tk bindings:
+#
+# <Control-Key-space>, <Control-Shift-Key-space>,
+# <Key-Select>, <Shift-Key-Select>:
+# Ttk entry widget doesn't use selection anchor.
+# <Key-Insert>:
+# Inserts PRIMARY selection (on non-Windows platforms).
+# This is inconsistent with typical platform bindings.
+# <Double-Shift-ButtonPress-1>, <Triple-Shift-ButtonPress-1>:
+# These don't do the right thing to start with.
+# <Meta-Key-b>, <Meta-Key-d>, <Meta-Key-f>,
+# <Meta-Key-BackSpace>, <Meta-Key-Delete>:
+# Judgment call. If <Meta> happens to be assigned to the Alt key,
+# these could conflict with application accelerators.
+# (Plus, who has a Meta key these days?)
+# <Control-Key-t>:
+# Another judgment call. If anyone misses this, let me know
+# and I'll put it back.
+#
+
+## Clipboard events:
+#
+bind TEntry <<Cut>> { ttk::entry::Cut %W }
+bind TEntry <<Copy>> { ttk::entry::Copy %W }
+bind TEntry <<Paste>> { ttk::entry::Paste %W }
+bind TEntry <<Clear>> { ttk::entry::Clear %W }
+
+## Button1 bindings:
+# Used for selection and navigation.
+#
+bind TEntry <ButtonPress-1> { ttk::entry::Press %W %x }
+bind TEntry <Shift-ButtonPress-1> { ttk::entry::Shift-Press %W %x }
+bind TEntry <Double-ButtonPress-1> { ttk::entry::Select %W %x word }
+bind TEntry <Triple-ButtonPress-1> { ttk::entry::Select %W %x line }
+bind TEntry <B1-Motion> { ttk::entry::Drag %W %x }
+
+bind TEntry <B1-Leave> { ttk::Repeatedly ttk::entry::AutoScroll %W }
+bind TEntry <B1-Enter> { ttk::CancelRepeat }
+bind TEntry <ButtonRelease-1> { ttk::CancelRepeat }
+
+bind TEntry <Control-ButtonPress-1> {
+ %W instate {!readonly !disabled} { %W icursor @%x ; focus %W }
+}
+
+## Button2 bindings:
+# Used for scanning and primary transfer.
+# Note: ButtonRelease-2 is mapped to <<PasteSelection>> in tk.tcl.
+#
+bind TEntry <ButtonPress-2> { ttk::entry::ScanMark %W %x }
+bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x }
+bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x }
+bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x }
+
+## Keyboard navigation bindings:
+#
+bind TEntry <Key-Left> { ttk::entry::Move %W prevchar }
+bind TEntry <Key-Right> { ttk::entry::Move %W nextchar }
+bind TEntry <Control-Key-Left> { ttk::entry::Move %W prevword }
+bind TEntry <Control-Key-Right> { ttk::entry::Move %W nextword }
+bind TEntry <Key-Home> { ttk::entry::Move %W home }
+bind TEntry <Key-End> { ttk::entry::Move %W end }
+
+bind TEntry <Shift-Key-Left> { ttk::entry::Extend %W prevchar }
+bind TEntry <Shift-Key-Right> { ttk::entry::Extend %W nextchar }
+bind TEntry <Shift-Control-Key-Left> { ttk::entry::Extend %W prevword }
+bind TEntry <Shift-Control-Key-Right> { ttk::entry::Extend %W nextword }
+bind TEntry <Shift-Key-Home> { ttk::entry::Extend %W home }
+bind TEntry <Shift-Key-End> { ttk::entry::Extend %W end }
+
+bind TEntry <Control-Key-slash> { %W selection range 0 end }
+bind TEntry <Control-Key-backslash> { %W selection clear }
+
+bind TEntry <<TraverseIn>> { %W selection range 0 end; %W icursor end }
+
+## Edit bindings:
+#
+bind TEntry <KeyPress> { ttk::entry::Insert %W %A }
+bind TEntry <Key-Delete> { ttk::entry::Delete %W }
+bind TEntry <Key-BackSpace> { ttk::entry::Backspace %W }
+
+# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
+# Otherwise, the <KeyPress> class binding will fire and insert the character.
+# Ditto for Escape, Return, and Tab.
+#
+bind TEntry <Alt-KeyPress> {# nothing}
+bind TEntry <Meta-KeyPress> {# nothing}
+bind TEntry <Control-KeyPress> {# nothing}
+bind TEntry <Key-Escape> {# nothing}
+bind TEntry <Key-Return> {# nothing}
+bind TEntry <Key-KP_Enter> {# nothing}
+bind TEntry <Key-Tab> {# nothing}
+
+# Argh. Apparently on Windows, the NumLock modifier is interpreted
+# as a Command modifier.
+if {[tk windowingsystem] eq "aqua"} {
+ bind TEntry <Command-KeyPress> {# nothing}
+}
+
+## Additional emacs-like bindings:
+#
+bind TEntry <Control-Key-a> { ttk::entry::Move %W home }
+bind TEntry <Control-Key-b> { ttk::entry::Move %W prevchar }
+bind TEntry <Control-Key-d> { ttk::entry::Delete %W }
+bind TEntry <Control-Key-e> { ttk::entry::Move %W end }
+bind TEntry <Control-Key-f> { ttk::entry::Move %W nextchar }
+bind TEntry <Control-Key-h> { ttk::entry::Backspace %W }
+bind TEntry <Control-Key-k> { %W delete insert end }
+
+### Clipboard procedures.
+#
+
+## EntrySelection -- Return the selected text of the entry.
+# Raises an error if there is no selection.
+#
+proc ttk::entry::EntrySelection {w} {
+ set entryString [string range [$w get] [$w index sel.first] \
+ [expr {[$w index sel.last] - 1}]]
+ if {[$w cget -show] ne ""} {
+ return [string repeat [string index [$w cget -show] 0] \
+ [string length $entryString]]
+ }
+ return $entryString
+}
+
+## Paste -- Insert clipboard contents at current insert point.
+#
+proc ttk::entry::Paste {w} {
+ catch {
+ set clipboard [::tk::GetSelection $w CLIPBOARD]
+ PendingDelete $w
+ $w insert insert $clipboard
+ See $w insert
+ }
+}
+
+## Copy -- Copy selection to clipboard.
+#
+proc ttk::entry::Copy {w} {
+ if {![catch {EntrySelection $w} selection]} {
+ clipboard clear -displayof $w
+ clipboard append -displayof $w $selection
+ }
+}
+
+## Clear -- Delete the selection.
+#
+proc ttk::entry::Clear {w} {
+ catch { $w delete sel.first sel.last }
+}
+
+## Cut -- Copy selection to clipboard then delete it.
+#
+proc ttk::entry::Cut {w} {
+ Copy $w; Clear $w
+}
+
+### Navigation procedures.
+#
+
+## ClosestGap -- Find closest boundary between characters.
+# Returns the index of the character just after the boundary.
+#
+proc ttk::entry::ClosestGap {w x} {
+ set pos [$w index @$x]
+ set bbox [$w bbox $pos]
+ if {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} {
+ incr pos
+ }
+ return $pos
+}
+
+## See $index -- Make sure that the character at $index is visible.
+#
+proc ttk::entry::See {w {index insert}} {
+ update idletasks ;# ensure scroll data up-to-date
+ set c [$w index $index]
+ # @@@ OR: check [$w index left] / [$w index right]
+ if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} {
+ $w xview $c
+ }
+}
+
+## NextWord -- Find the next word position.
+# Note: The "next word position" follows platform conventions:
+# either the next end-of-word position, or the start-of-word
+# position following the next end-of-word position.
+#
+set ::ttk::entry::State(startNext) \
+ [string equal $tcl_platform(platform) "windows"]
+
+proc ttk::entry::NextWord {w start} {
+ variable State
+ set pos [tcl_endOfWord [$w get] [$w index $start]]
+ if {$pos >= 0 && $State(startNext)} {
+ set pos [tcl_startOfNextWord [$w get] $pos]
+ }
+ if {$pos < 0} {
+ return end
+ }
+ return $pos
+}
+
+## PrevWord -- Find the previous word position.
+#
+proc ttk::entry::PrevWord {w start} {
+ set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
+ if {$pos < 0} {
+ return 0
+ }
+ return $pos
+}
+
+## RelIndex -- Compute character/word/line-relative index.
+#
+proc ttk::entry::RelIndex {w where {index insert}} {
+ switch -- $where {
+ prevchar { expr {[$w index $index] - 1} }
+ nextchar { expr {[$w index $index] + 1} }
+ prevword { PrevWord $w $index }
+ nextword { NextWord $w $index }
+ home { return 0 }
+ end { $w index end }
+ default { error "Bad relative index $index" }
+ }
+}
+
+## Move -- Move insert cursor to relative location.
+# Also clears the selection, if any, and makes sure
+# that the insert cursor is visible.
+#
+proc ttk::entry::Move {w where} {
+ $w icursor [RelIndex $w $where]
+ $w selection clear
+ See $w insert
+}
+
+### Selection procedures.
+#
+
+## ExtendTo -- Extend the selection to the specified index.
+#
+# The other end of the selection (the anchor) is determined as follows:
+#
+# (1) if there is no selection, the anchor is the insert cursor;
+# (2) if the index is outside the selection, grow the selection;
+# (3) if the insert cursor is at one end of the selection, anchor the other end
+# (4) otherwise anchor the start of the selection
+#
+# The insert cursor is placed at the new end of the selection.
+#
+# Returns: selection anchor.
+#
+proc ttk::entry::ExtendTo {w index} {
+ set index [$w index $index]
+ set insert [$w index insert]
+
+ # Figure out selection anchor:
+ if {![$w selection present]} {
+ set anchor $insert
+ } else {
+ set selfirst [$w index sel.first]
+ set sellast [$w index sel.last]
+
+ if { ($index < $selfirst)
+ || ($insert == $selfirst && $index <= $sellast)
+ } {
+ set anchor $sellast
+ } else {
+ set anchor $selfirst
+ }
+ }
+
+ # Extend selection:
+ if {$anchor < $index} {
+ $w selection range $anchor $index
+ } else {
+ $w selection range $index $anchor
+ }
+
+ $w icursor $index
+ return $anchor
+}
+
+## Extend -- Extend the selection to a relative position, show insert cursor
+#
+proc ttk::entry::Extend {w where} {
+ ExtendTo $w [RelIndex $w $where]
+ See $w
+}
+
+### Button 1 binding procedures.
+#
+# Double-clicking followed by a drag enters "word-select" mode.
+# Triple-clicking enters "line-select" mode.
+#
+
+## Press -- ButtonPress-1 binding.
+# Set the insertion cursor, claim the input focus, set up for
+# future drag operations.
+#
+proc ttk::entry::Press {w x} {
+ variable State
+
+ $w icursor [ClosestGap $w $x]
+ $w selection clear
+ $w instate !disabled { focus $w }
+
+ # Set up for future drag, double-click, or triple-click.
+ set State(x) $x
+ set State(selectMode) char
+ set State(anchor) [$w index insert]
+}
+
+## Shift-Press -- Shift-ButtonPress-1 binding.
+# Extends the selection, sets anchor for future drag operations.
+#
+proc ttk::entry::Shift-Press {w x} {
+ variable State
+
+ focus $w
+ set anchor [ExtendTo $w @$x]
+
+ set State(x) $x
+ set State(selectMode) char
+ set State(anchor) $anchor
+}
+
+## Select $w $x $mode -- Binding for double- and triple- clicks.
+# Selects a word or line (according to mode),
+# and sets the selection mode for subsequent drag operations.
+#
+proc ttk::entry::Select {w x mode} {
+ variable State
+ set cur [ClosestGap $w $x]
+
+ switch -- $mode {
+ word { WordSelect $w $cur $cur }
+ line { LineSelect $w $cur $cur }
+ char { # no-op }
+ }
+
+ set State(anchor) $cur
+ set State(selectMode) $mode
+}
+
+## Drag -- Button1 motion binding.
+#
+proc ttk::entry::Drag {w x} {
+ variable State
+ set State(x) $x
+ DragTo $w $x
+}
+
+## DragTo $w $x -- Extend selection to $x based on current selection mode.
+#
+proc ttk::entry::DragTo {w x} {
+ variable State
+
+ set cur [ClosestGap $w $x]
+ switch $State(selectMode) {
+ char { CharSelect $w $State(anchor) $cur }
+ word { WordSelect $w $State(anchor) $cur }
+ line { LineSelect $w $State(anchor) $cur }
+ }
+}
+
+## AutoScroll
+# Called repeatedly when the mouse is outside an entry window
+# with Button 1 down. Scroll the window left or right,
+# depending on where the mouse is, and extend the selection
+# according to the current selection mode.
+#
+# TODO: AutoScroll should repeat faster (50ms) than normal autorepeat.
+# TODO: Need a way for ttk::Repeat scripts to cancel themselves.
+#
+proc ttk::entry::AutoScroll {w} {
+ variable State
+ if {![winfo exists $w]} return
+ set x $State(x)
+ if {$x > [winfo width $w]} {
+ $w xview scroll 2 units
+ DragTo $w $x
+ } elseif {$x < 0} {
+ $w xview scroll -2 units
+ DragTo $w $x
+ }
+}
+
+## CharSelect -- select characters between index $from and $to
+#
+proc ttk::entry::CharSelect {w from to} {
+ if {$to <= $from} {
+ $w selection range $to $from
+ } else {
+ $w selection range $from $to
+ }
+ $w icursor $to
+}
+
+## WordSelect -- Select whole words between index $from and $to
+#
+proc ttk::entry::WordSelect {w from to} {
+ if {$to < $from} {
+ set first [WordBack [$w get] $to]
+ set last [WordForward [$w get] $from]
+ $w icursor $first
+ } else {
+ set first [WordBack [$w get] $from]
+ set last [WordForward [$w get] $to]
+ $w icursor $last
+ }
+ $w selection range $first $last
+}
+
+## WordBack, WordForward -- helper routines for WordSelect.
+#
+proc WordBack {text index} {
+ if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 }
+ return $pos
+}
+proc WordForward {text index} {
+ if {[set pos [tcl_wordBreakAfter $text $index]] < 0} { return end }
+ return $pos
+}
+
+## LineSelect -- Select the entire line.
+#
+proc ttk::entry::LineSelect {w _ _} {
+ variable State
+ $w selection range 0 end
+ $w icursor end
+}
+
+### Button 2 binding procedures.
+#
+
+## ScanMark -- ButtonPress-2 binding.
+# Marks the start of a scan or primary transfer operation.
+#
+proc ttk::entry::ScanMark {w x} {
+ variable State
+ set State(scanX) $x
+ set State(scanIndex) [$w index @0]
+ set State(scanMoved) 0
+}
+
+## ScanDrag -- Button2 motion binding.
+#
+proc ttk::entry::ScanDrag {w x} {
+ variable State
+
+ set dx [expr {$State(scanX) - $x}]
+ if {abs($dx) > $State(deadband)} {
+ set State(scanMoved) 1
+ }
+ set left [expr {$State(scanIndex) + ($dx*$State(scanNum))/$State(scanDen)}]
+ $w xview $left
+
+ if {$left != [set newLeft [$w index @0]]} {
+ # We've scanned past one end of the entry;
+ # reset the mark so that the text will start dragging again
+ # as soon as the mouse reverses direction.
+ #
+ set State(scanX) $x
+ set State(scanIndex) $newLeft
+ }
+}
+
+## ScanRelease -- Button2 release binding.
+# Do a primary transfer if the mouse has not moved since the button press.
+#
+proc ttk::entry::ScanRelease {w x} {
+ variable State
+ if {!$State(scanMoved)} {
+ $w instate {!disabled !readonly} {
+ $w icursor [ClosestGap $w $x]
+ catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
+ }
+ }
+}
+
+### Insertion and deletion procedures.
+#
+
+## PendingDelete -- Delete selection prior to insert.
+# If the entry currently has a selection, delete it and
+# set the insert position to where the selection was.
+# Returns: 1 if pending delete occurred, 0 if nothing was selected.
+#
+proc ttk::entry::PendingDelete {w} {
+ if {[$w selection present]} {
+ $w icursor sel.first
+ $w delete sel.first sel.last
+ return 1
+ }
+ return 0
+}
+
+## Insert -- Insert text into the entry widget.
+# If a selection is present, the new text replaces it.
+# Otherwise, the new text is inserted at the insert cursor.
+#
+proc ttk::entry::Insert {w s} {
+ if {$s eq ""} { return }
+ PendingDelete $w
+ $w insert insert $s
+ See $w insert
+}
+
+## Backspace -- Backspace over the character just before the insert cursor.
+# If there is a selection, delete that instead.
+# If the new insert position is offscreen to the left,
+# scroll to place the cursor at about the middle of the window.
+#
+proc ttk::entry::Backspace {w} {
+ if {[PendingDelete $w]} {
+ See $w
+ return
+ }
+ set x [expr {[$w index insert] - 1}]
+ if {$x < 0} { return }
+
+ $w delete $x
+
+ if {[$w index @0] >= [$w index insert]} {
+ set range [$w xview]
+ set left [lindex $range 0]
+ set right [lindex $range 1]
+ $w xview moveto [expr {$left - ($right - $left)/2.0}]
+ }
+}
+
+## Delete -- Delete the character after the insert cursor.
+# If there is a selection, delete that instead.
+#
+proc ttk::entry::Delete {w} {
+ if {![PendingDelete $w]} {
+ $w delete insert
+ }
+}
+
+#*EOF*
diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl
new file mode 100644
index 0000000..c3d4d50
--- /dev/null
+++ b/library/ttk/fonts.tcl
@@ -0,0 +1,132 @@
+#
+# $Id: fonts.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk package: Font specifications.
+#
+# This file, [source]d from ttk.tcl when the package is loaded,
+# sets up the following symbolic fonts based on the current platform:
+#
+# TkDefaultFont -- default for GUI items not otherwise specified
+# TkTextFont -- font for user text (entry, listbox, others). [not in #145]
+# TkHeadingFont -- headings (column headings, etc) [not in #145]
+# TkCaptionFont -- dialog captions (primary text in alert dialogs, etc.)
+# TkTooltipFont -- font to use for tooltip windows
+#
+# This is a temporary solution until TIP #145 is implemented.
+#
+# Symbolic fonts listed in TIP #145:
+#
+# TkDefaultFont -- the default for all GUI items not otherwise specified.
+# TkFixedFont -- standard fixed width font [not used in Ttk]
+# TkMenuFont -- used for menu items [not used in Ttk]
+# TkCaptionFont -- used for window and dialog caption bars [different in Ttk]
+# TkSmallCaptionFont -- captions on contained windows or tool dialogs [not used]
+# TkIconFont -- font in use for icon captions [not used in Ttk]
+# TkTooltipFont -- font to use for tooltip windows
+#
+#
+# +++ Platform notes:
+#
+# Windows:
+# The default system font changed from "MS Sans Serif" to "Tahoma"
+# in Windows XP/Windows 2000.
+#
+# MS documentation says to use "Tahoma 8" in Windows 2000/XP,
+# although many MS programs still use "MS Sans Serif 8"
+#
+# Should use SystemParametersInfo() instead.
+#
+# Mac OSX / Aqua:
+# Quoth the Apple HIG:
+# The _system font_ (Lucida Grande Regular 13 pt) is used for text
+# in menus, dialogs, and full-size controls.
+# [...] Use the _view font_ (Lucida Grande Regular 12pt) as the default
+# font of text in lists and tables.
+# [...] Use the _emphasized system font_ (Lucida Grande Bold 13 pt)
+# sparingly. It is used for the message text in alerts.
+# [...] The _small system font_ (Lucida Grande Regular 11 pt) [...]
+# is also the default font for column headings in lists, for help tags,
+# and for small controls.
+#
+# Note that the font for column headings (TkHeadingFont) is
+# _smaller_ than the
+#
+# There's also a GetThemeFont() Appearance Manager API call
+# for looking up kThemeSystemFont dynamically.
+#
+# Mac classic:
+# Don't know, can't find *anything* on the Web about Mac pre-OSX.
+# Might have used Geneva. Doesn't matter, this platform
+# isn't supported anymore anyway.
+#
+# X11:
+# Need a way to tell if Xft is enabled or not.
+# For now, assume patch #971980 applied.
+#
+# "Classic" look used Helvetica bold for everything except
+# for entry widgets, which use Helvetica medium.
+# Most other toolkits use medium weight for all UI elements,
+# which is what we do now.
+#
+# Font size specified in pixels on X11, not points.
+# This is Theoretically Wrong, but in practice works better; using
+# points leads to huge inconsistencies across different servers.
+#
+
+namespace eval ttk {
+
+catch {font create TkDefaultFont}
+catch {font create TkTextFont}
+catch {font create TkHeadingFont}
+catch {font create TkCaptionFont}
+catch {font create TkTooltipFont}
+
+switch -- [tk windowingsystem] {
+ win32 {
+ if {$tcl_platform(osVersion) >= 5.0} {
+ variable family "Tahoma"
+ } else {
+ variable family "MS Sans Serif"
+ }
+ variable size 8
+
+ font configure TkDefaultFont -family $family -size $size
+ font configure TkTextFont -family $family -size $size
+ font configure TkHeadingFont -family $family -size $size
+ font configure TkCaptionFont -family $family -size $size -weight bold
+ font configure TkTooltipFont -family $family -size $size
+ }
+ classic -
+ aqua {
+ variable family "Lucida Grande"
+ variable size 13
+ variable viewsize 12
+ variable smallsize 11
+
+ font configure TkDefaultFont -family $family -size $size
+ font configure TkTextFont -family $family -size $size
+ font configure TkHeadingFont -family $family -size $smallsize
+ font configure TkCaptionFont -family $family -size $size -weight bold
+ font configure TkTooltipFont -family $family -size $viewsize
+ }
+ x11 {
+ if {![catch {tk::pkgconfig get fontsystem} fs] && $fs eq "xft"} {
+ variable family "sans-serif"
+ } else {
+ variable family "Helvetica"
+ }
+ variable size -12
+ variable ttsize -10
+ variable capsize -14
+
+ font configure TkDefaultFont -family $family -size $size
+ font configure TkTextFont -family $family -size $size
+ font configure TkHeadingFont -family $family -size $size -weight bold
+ font configure TkCaptionFont -family $family -size $capsize -weight bold
+ font configure TkTooltipFont -family $family -size $ttsize
+ }
+}
+
+}
+
+#*EOF*
diff --git a/library/ttk/icons.tcl b/library/ttk/icons.tcl
new file mode 100644
index 0000000..493bb0a
--- /dev/null
+++ b/library/ttk/icons.tcl
@@ -0,0 +1,105 @@
+#
+# $Id: icons.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk package -- stock icons.
+#
+# Usage:
+# $w configure -image [ttk::stockIcon $context/$icon]
+#
+# At present, only includes icons for dialog boxes,
+# dialog/info, dialog/warning, dialog/error, etc.
+#
+# This list should be expanded.
+#
+# See the Icon Naming Specification from the Tango project:
+# http://standards.freedesktop.org/icon-naming-spec/
+# They've finally gotten around to publishing something.
+#
+
+namespace eval ttk {
+ variable Icons ;# Map: icon name -> image
+ namespace eval icons {} ;# container namespace for images
+}
+
+# stockIcon $name --
+# Returns a Tk image for built-in icon $name.
+#
+proc ttk::stockIcon {name} {
+ variable Icons
+ return $Icons($name)
+}
+
+# defineImage --
+# Define a new stock icon.
+#
+proc ttk::defineImage {name args} {
+ variable Icons
+ set iconName ::ttk::icons::$name
+ eval [linsert $args 0 image create photo $iconName]
+ set Icons($name) $iconName
+}
+
+#
+# Stock icons for dialogs
+#
+# SOURCE: dialog icons taken from BWidget toolkit.
+#
+ttk::defineImage dialog/error -data {
+ R0lGODlhIAAgALMAAIQAAISEhPf/Mf8AAP//////////////////////////
+ /////////////////////yH5BAEAAAIALAAAAAAgACAAAASwUMhJBbj41s0n
+ HmAIYl0JiCgKlNWVvqHGnnA9mnY+rBytw4DAxhci2IwqoSdFaMKaSBFPQhxA
+ nahrdKS0MK8ibSoorBbBVvS4XNOKgey2e7sOmLPvGvkezsPtR3M2e3JzdFIB
+ gC9vfohxfVCQWI6PII1pkZReeIeWkzGJS1lHdV2bPy9koaKopUOtSatDfECq
+ phWKOra3G3YuqReJwiwUiRkZwsPEuMnNycslzrIdEQAAOw==
+}
+
+ttk::defineImage dialog/info -data {
+ R0lGODlhIAAgALMAAAAAAAAA/4SEhMbGxvf/Mf//////////////////////
+ /////////////////////yH5BAEAAAQALAAAAAAgACAAAAStkMhJibj41s0n
+ HkUoDljXXaCoqqRgUkK6zqP7CvQQ7IGsAiYcjcejFYAb4ZAYMB4rMaeO51sN
+ kBKlc/uzRbng0NWlnTF3XAAZzExj2ET3BV7cqufctv2Tj0vvFn11RndkVSt6
+ OYVZRmeDXRoTAGFOhTaSlDOWHACHW2MlHQCdYFebN6OkVqkZlzcXqTKWoS8w
+ GJMhs7WoIoC7v7i+v7uTwsO1o5HHu7TLtcodEQAAOw==
+}
+
+ttk::defineImage dialog/question -data {
+ R0lGODlhIAAgALMAAAAAAAAA/4SEhMbGxvf/Mf//////////////////////
+ /////////////////////yH5BAEAAAQALAAAAAAgACAAAAS2kMhJibj41s0n
+ HkUoDljXXaCoqqRgUkK6zqP7CnS+AiY+D4GgUKbibXwrYEoYIIqMHmcoqGLS
+ BlBLzlrgzgC22FZYAJKvYG3ODPLS0khd+awDX+Qieh2Dnzb7dnE6VIAffYdl
+ dmo6bHiBFlJVej+PizRuXyUTAIxBkSGBNpuImZoVAJ9roSYAqH1Yqzetrkmz
+ GaI3F7MyoaYvHhicoLe/sk8axcnCisnKBczNxa3I0cW+1bm/EQAAOw==
+}
+
+ttk::defineImage dialog/warning -data {
+ R0lGODlhIAAgALMAAAAAAISEAISEhMbGxv//AP//////////////////////
+ /////////////////////yH5BAEAAAUALAAAAAAgACAAAASrsMhJZ7g16y0D
+ IQPAjZr3gYBAroV5piq7uWcoxHJFv3eun0BUz9cJAmHElhFow8lcIQBgwHOu
+ aNJsDfk8ZgHH4TX4BW/Fo12ZjJ4Z10wuZ0cIZOny0jI6NTbnSwRaS3kUdCd2
+ h0JWRYEhVIGFSoEfZo6FipRvaJkfUZB7cp2Cg5FDo6RSmn+on5qCPaivYTey
+ s4sqtqswp2W+v743whTCxcbHyG0FyczJEhEAADs=
+}
+
+ttk::defineImage dialog/auth -data {
+ R0lGODlhIAAgAIQAAAAA/wAAAICAgICAAP///7CwsMDAwMjIAPjIAOjo6Pj4
+ AODg4HBwcMj4ANjY2JiYANDQ0MjIyPj4yKCgoMiYAMjImDAwAMjIMJiYmJCQ
+ kAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAgACAAAAX+ICCOYmCa
+ ZKquZCCMQsDOqWC7NiAMvEyvAoLQVdgZCAfEAPWDERIJk8AwIJwUil5T91y4
+ GC6ry4RoKH2zYGLhnS5tMUNAcaAvaUF2m1A9GeQIAQeDaEAECw6IJlVYAmAK
+ AWZJD3gEDpeXOwRYnHOCCgcPhTWWDhAQQYydkGYIoaOkp6h8m1ieSYOvP0ER
+ EQwEEap0dWagok1BswmMdbiursfIBHnBQs10oKF30tQ8QkISuAcB25UGQQ4R
+ EzzsA4MU4+WGBkXo6hMTMQADFQfwFtHmFSlCAEKEU2jc+YsHy8nAML4iJKzQ
+ Dx65hiWKTIA4pRC7CxblORRA8E/HFfxfQo4KUiBfPgL0SDbkV0ElKZcmEjwE
+ wqPCgwMiAQTASQDDzhkD4IkMkg+DiwU4aSTVQiIIBgFXE+ATsPHHCRVWM8QI
+ oJUrxi04TCzA0PQsWh9kMVx1u6UFA3116zLJGwIAOw==
+}
+
+ttk::defineImage dialog/busy -data {
+ R0lGODlhIAAgALMAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwICAgP8AAAD/
+ AP//AAAA//8A/wD//////yH5BAEAAAsALAAAAAAgACAAAASAcMlJq7046827
+ /2AYBmRpkoC4BMlzvEkspypg3zitIsfjvgcEQifi+X7BoUpi9AGFxFATCV0u
+ eMEDQFu1GrdbpZXZC0e9LvF4gkifl8aX2tt7bIPvz/Q5l9btcn0gTWBJeR1G
+ bWBdO0EPPIuHHDmUSyxIMjM1lJVrnp+goaIfEQAAOw==
+}
+
+#*EOF*
diff --git a/library/ttk/keynav.tcl b/library/ttk/keynav.tcl
new file mode 100644
index 0000000..090c8f5
--- /dev/null
+++ b/library/ttk/keynav.tcl
@@ -0,0 +1,163 @@
+########################################################################
+# keynav package - Enhanced keyboard navigation
+# Copyright (C) 2003 Joe English
+# Freely redistributable; see the file license.terms for details.
+#
+# $Id: keynav.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+########################################################################
+#
+# Usage:
+#
+# package require keynav
+#
+# keynav::enableMnemonics $toplevel --
+# Enable mnemonic accelerators for toplevel widget. Pressing Alt-K,
+# where K is any alphanumeric key, will send an <<Invoke>> event to the
+# widget with mnemonic K (as determined by the -underline and -text
+# options).
+#
+# Side effects: adds a binding for <Alt-KeyPress> to $toplevel
+#
+# keynav::defaultButton $button --
+# Enables default activation for the toplevel window in which $button
+# appears. Pressing <Key-Return> invokes the default widget. The
+# default widget is set to the widget with keyboard focus if it is
+# defaultable, otherwise $button. A widget is _defaultable_ if it has
+# a -default option which is not set to "disabled".
+#
+# Side effects: adds <FocusIn> and <KeyPress-Return> bindings
+# to the toplevel containing $button, and a <Destroy> binding
+# to $button.
+#
+# $button must be a defaultable widget.
+#
+
+namespace eval keynav {}
+
+package require Tcl 8.4
+package require Tk 8.4
+package provide keynav 1.0
+
+event add <<Help>> <KeyPress-F1>
+
+#
+# Bindings for stock Tk widgets:
+# (NB: for 8.3 use tkButtonInvoke, tkMbPost instead)
+#
+bind Button <<Invoke>> { tk::ButtonInvoke %W }
+bind Checkbutton <<Invoke>> { tk::ButtonInvoke %W }
+bind Radiobutton <<Invoke>> { tk::ButtonInvoke %W }
+bind Menubutton <<Invoke>> { tk::MbPost %W }
+
+proc keynav::enableMnemonics {w} {
+ bind [winfo toplevel $w] <Alt-KeyPress> {+ keynav::Alt-KeyPress %W %K }
+}
+
+# mnemonic $w --
+# Return the mnemonic character for widget $w,
+# as determined by the -text and -underline resources.
+#
+proc keynav::mnemonic {w} {
+ if {[catch {
+ set label [$w cget -text]
+ set underline [$w cget -underline]
+ }]} { return "" }
+ return [string index $label $underline]
+}
+
+# FindMnemonic $w $key --
+# Locate the descendant of $w with mnemonic $key.
+#
+proc keynav::FindMnemonic {w key} {
+ if {[string length $key] != 1} { return }
+ set Q [list [set top [winfo toplevel $w]]]
+ while {[llength $Q]} {
+ set QN [list]
+ foreach w $Q {
+ if {[string equal -nocase $key [mnemonic $w]]} {
+ return $w
+ }
+ foreach c [winfo children $w] {
+ if {[winfo ismapped $c] && [winfo toplevel $c] eq $top} {
+ lappend QN $c
+ }
+ }
+ }
+ set Q $QN
+ }
+ return {}
+}
+
+# Alt-KeyPress --
+# Alt-KeyPress binding for toplevels with mnemonic accelerators enabled.
+#
+proc keynav::Alt-KeyPress {w k} {
+ set w [FindMnemonic $w $k]
+ if {$w ne ""} {
+ event generate $w <<Invoke>>
+ return -code break
+ }
+}
+
+# defaultButton $w --
+# Enable default activation for the toplevel containing $w,
+# and make $w the default default widget.
+#
+proc keynav::defaultButton {w} {
+ variable DefaultButton
+
+ $w configure -default active
+ set top [winfo toplevel $w]
+ set DefaultButton(current.$top) $w
+ set DefaultButton(default.$top) $w
+
+ bind $w <Destroy> [list keynav::CleanupDefault $top]
+ bind $top <FocusIn> [list keynav::ClaimDefault $top %W]
+ bind $top <KeyPress-Return> [list keynav::ActivateDefault $top]
+}
+
+proc keynav::CleanupDefault {top} {
+ variable DefaultButton
+ unset DefaultButton(current.$top)
+ unset DefaultButton(default.$top)
+}
+
+# ClaimDefault $top $w --
+# <FocusIn> binding for default activation.
+# Sets the default widget to $w if it is defaultable,
+# otherwise set it to the default default.
+#
+proc keynav::ClaimDefault {top w} {
+ variable DefaultButton
+ if {![info exists DefaultButton(current.$top)]} {
+ # Someone destroyed the default default, but not
+ # the rest of the toplevel.
+ return;
+ }
+
+ set default $DefaultButton(default.$top)
+ if {![catch {$w cget -default} dstate] && $dstate ne "disabled"} {
+ set default $w
+ }
+
+ if {$default ne $DefaultButton(current.$top)} {
+ # Ignore errors -- someone may have destroyed the current default
+ catch { $DefaultButton(current.$top) configure -default normal }
+ $default configure -default active
+ set DefaultButton(current.$top) $default
+ }
+}
+
+# ActivateDefault --
+# Invoke the default widget for toplevel window, if any.
+#
+proc keynav::ActivateDefault {top} {
+ variable DefaultButton
+ if {[info exists DefaultButton(current.$top)]
+ && [winfo exists $DefaultButton(current.$top)]} {
+ event generate $DefaultButton(current.$top) <<Invoke>>
+ }
+}
+
+#*EOF*
diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl
new file mode 100644
index 0000000..fec276e
--- /dev/null
+++ b/library/ttk/menubutton.tcl
@@ -0,0 +1,171 @@
+#
+# $Id: menubutton.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Bindings for Menubuttons.
+#
+# Menubuttons have three interaction modes:
+#
+# Pulldown: Press menubutton, drag over menu, release to activate menu entry
+# Popdown: Click menubutton to post menu
+# Keyboard: <Key-space> or accelerator key to post menu
+#
+# (In addition, when menu system is active, "dropdown" -- menu posts
+# on mouse-over. Ttk menubuttons don't implement this).
+#
+# For keyboard and popdown mode, we hand off to tk_popup and let
+# the built-in Tk bindings handle the rest of the interaction.
+#
+# ON X11:
+#
+# Standard Tk menubuttons use a global grab on the menubutton.
+# This won't work for Ttk menubuttons in pulldown mode,
+# since we need to process the final <ButtonRelease> event,
+# and this might be delivered to the menu. So instead we
+# rely on the passive grab that occurs on <ButtonPress> events,
+# and transition to popdown mode when the mouse is released
+# or dragged outside the menubutton.
+#
+# ON WINDOWS:
+#
+# I'm not sure what the hell is going on here. [$menu post] apparently
+# sets up some kind of internal grab for native menus.
+# On this platform, just use [tk_popup] for all menu actions.
+#
+# ON MACOS:
+#
+# Same probably applies here.
+#
+
+namespace eval ttk {
+ namespace eval menubutton {
+ variable State
+ array set State {
+ pulldown 0
+ oldcursor {}
+ }
+ }
+}
+
+bind TMenubutton <Enter> { %W instate !disabled {%W state active } }
+bind TMenubutton <Leave> { %W state !active }
+bind TMenubutton <Key-space> { ttk::menubutton::Popdown %W }
+bind TMenubutton <<Invoke>> { ttk::menubutton::Popdown %W }
+
+if {[tk windowingsystem] eq "x11"} {
+ bind TMenubutton <ButtonPress-1> { ttk::menubutton::Pulldown %W }
+ bind TMenubutton <ButtonRelease-1> { ttk::menubutton::TransferGrab %W }
+ bind TMenubutton <B1-Leave> { ttk::menubutton::TransferGrab %W }
+} else {
+ bind TMenubutton <ButtonPress-1> \
+ { %W state pressed ; ttk::menubutton::Popdown %W }
+ bind TMenubutton <ButtonRelease-1> \
+ { %W state !pressed }
+}
+
+# PostPosition --
+# Returns the x and y coordinates where the menu
+# should be posted, based on the menubutton and menu size
+# and -direction option.
+#
+# TODO: adjust menu width to be at least as wide as the button
+# for -direction above, below.
+#
+proc ttk::menubutton::PostPosition {mb menu} {
+ set x [winfo rootx $mb]
+ set y [winfo rooty $mb]
+ set dir [$mb cget -direction]
+
+ set bw [winfo width $mb]
+ set bh [winfo height $mb]
+ set mw [winfo reqwidth $menu]
+ set mh [winfo reqheight $menu]
+ set sw [expr {[winfo screenwidth $menu] - $bw - $mw}]
+ set sh [expr {[winfo screenheight $menu] - $bh - $mh}]
+
+ switch -- $dir {
+ above { if {$y >= $mh} { incr y -$mh } { incr y $bh } }
+ below { if {$y <= $sh} { incr y $bh } { incr y -$mh } }
+ left { if {$x >= $mw} { incr x -$mw } { incr x $bw } }
+ right { if {$x <= $sw} { incr x $bw } { incr x -$mw } }
+ flush {
+ # post menu atop menubutton.
+ # If there's a menu entry whose label matches the
+ # menubutton -text, assume this is an optionmenu
+ # and place that entry over the menubutton.
+ set index [FindMenuEntry $menu [$mb cget -text]]
+ if {$index ne ""} {
+ incr y -[$menu yposition $index]
+ }
+ }
+ }
+
+ return [list $x $y]
+}
+
+# Popdown --
+# Post the menu and set a grab on the menu.
+#
+proc ttk::menubutton::Popdown {mb} {
+ if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
+ return
+ }
+ foreach {x y} [PostPosition $mb $menu] { break }
+ tk_popup $menu $x $y
+}
+
+# Pulldown (X11 only) --
+# Called when Button1 is pressed on a menubutton.
+# Posts the menu; a subsequent ButtonRelease
+# or Leave event will set a grab on the menu.
+#
+proc ttk::menubutton::Pulldown {mb} {
+ variable State
+ if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} {
+ return
+ }
+ foreach {x y} [PostPosition $mb $menu] { break }
+ set State(pulldown) 1
+ set State(oldcursor) [$mb cget -cursor]
+
+ $mb state pressed
+ $mb configure -cursor [$menu cget -cursor]
+ $menu post $x $y
+ tk_menuSetFocus $menu
+}
+
+# TransferGrab (X11 only) --
+# Switch from pulldown mode (menubutton has an implicit grab)
+# to popdown mode (menu has an explicit grab).
+#
+proc ttk::menubutton::TransferGrab {mb} {
+ variable State
+ if {$State(pulldown)} {
+ $mb configure -cursor $State(oldcursor)
+ $mb state {!pressed !active}
+ set State(pulldown) 0
+
+ set menu [$mb cget -menu]
+ tk_popup $menu [winfo rootx $menu] [winfo rooty $menu]
+ }
+}
+
+# FindMenuEntry --
+# Hack to support tk_optionMenus.
+# Returns the index of the menu entry with a matching -label,
+# -1 if not found.
+#
+proc ttk::menubutton::FindMenuEntry {menu s} {
+ set last [$menu index last]
+ if {$last eq "none"} {
+ return ""
+ }
+ for {set i 0} {$i <= $last} {incr i} {
+ if {![catch {$menu entrycget $i -label} label]
+ && ($label eq $s)} {
+ return $i
+ }
+ }
+ return ""
+}
+
+#*EOF*
diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl
new file mode 100644
index 0000000..d2edddc
--- /dev/null
+++ b/library/ttk/notebook.tcl
@@ -0,0 +1,205 @@
+#
+# $Id: notebook.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Bindings for TNotebook widget
+#
+
+namespace eval ttk::notebook {
+ variable TLNotebooks ;# See enableTraversal
+}
+
+bind TNotebook <ButtonPress-1> { ttk::notebook::Press %W %x %y }
+bind TNotebook <Key-Right> { ttk::notebook::CycleTab %W 1; break }
+bind TNotebook <Key-Left> { ttk::notebook::CycleTab %W -1; break }
+bind TNotebook <Control-Key-Tab> { ttk::notebook::CycleTab %W 1; break }
+bind TNotebook <Control-Shift-Key-Tab> { ttk::notebook::CycleTab %W -1; break }
+catch {
+bind TNotebook <Control-ISO_Left_Tab> { ttk::notebook::CycleTab %W -1; break }
+}
+bind TNotebook <Destroy> { ttk::notebook::Cleanup %W }
+
+# ActivateTab $nb $tab --
+# Select the specified tab and set focus.
+#
+# If $tab was already the current tab, set the focus to the
+# notebook widget. Otherwise, set the focus to the first
+# traversable widget in the pane. The behavior is that the
+# notebook takes focus when the user selects the same tab
+# a second time. This mirrors Windows tab behavior.
+#
+proc ttk::notebook::ActivateTab {w tab} {
+ if {[$w index $tab] eq [$w index current]} {
+ focus $w
+ } else {
+ $w select $tab
+ update ;# needed so focus logic sees correct mapped/unmapped states
+ if {[set f [ttk::focusFirst [$w select]]] ne ""} {
+ tk::TabToWindow $f
+ }
+ }
+}
+
+# ttk::focusFirst $w --
+# Return the first descendant of $w, in preorder traversal order,
+# that can take keyboard focus, "" if none do.
+#
+# See also: tk_focusNext
+#
+proc ttk::focusFirst {w} {
+ if {[ttk::takesFocus $w]} {
+ return $w
+ }
+ foreach child [winfo children $w] {
+ if {[set c [ttk::focusFirst $child]] ne ""} {
+ return $c
+ }
+ }
+ return ""
+}
+
+# Press $nb $x $y --
+# ButtonPress-1 binding for notebook widgets.
+# Activate the tab under the mouse cursor, if any.
+#
+proc ttk::notebook::Press {w x y} {
+ set index [$w index @$x,$y]
+ if {$index ne ""} {
+ ActivateTab $w $index
+ }
+}
+
+# CycleTab --
+# Select the next/previous tab in the list.
+#
+proc ttk::notebook::CycleTab {w dir} {
+ if {[$w index end] != 0} {
+ set current [$w index current]
+ set select [expr {($current + $dir) % [$w index end]}]
+ while {[$w tab $select -state] != "normal" && ($select != $current)} {
+ set select [expr {($select + $dir) % [$w index end]}]
+ }
+ if {$select != $current} {
+ ActivateTab $w $select
+ }
+ }
+}
+
+# MnemonicTab $nb $key --
+# Scan all tabs in the specified notebook for one with the
+# specified mnemonic. If found, returns path name of tab;
+# otherwise returns ""
+#
+proc ttk::notebook::MnemonicTab {nb key} {
+ set key [string toupper $key]
+ foreach tab [$nb tabs] {
+ set label [$nb tab $tab -text]
+ set underline [$nb tab $tab -underline]
+ set mnemonic [string toupper [string index $label $underline]]
+ if {$mnemonic ne "" && $mnemonic eq $key} {
+ return $tab
+ }
+ }
+ return ""
+}
+
+# +++ Toplevel keyboard traversal.
+#
+
+# enableTraversal --
+# Enable keyboard traversal for a notebook widget
+# by adding bindings to the containing toplevel window.
+#
+# TLNotebooks($top) keeps track of the list of all traversal-enabled
+# notebooks contained in the toplevel
+#
+proc ttk::notebook::enableTraversal {nb} {
+ variable TLNotebooks
+
+ set top [winfo toplevel $nb]
+
+ if {![info exists TLNotebooks($top)]} {
+ # Augment $top bindings:
+ #
+ bind $top <Control-Key-Tab> {+ttk::notebook::TLCycleTab %W 1}
+ bind $top <Shift-Control-Key-Tab> {+ttk::notebook::TLCycleTab %W -1}
+ catch {
+ bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1}
+ }
+ bind $top <Alt-KeyPress> \
+ +[list ttk::notebook::MnemonicActivation $top %K]
+ bind $top <Destroy> {+ttk::notebook::TLCleanup %W}
+ }
+
+ lappend TLNotebooks($top) $nb
+}
+
+# TLCleanup -- <Destroy> binding for traversal-enabled toplevels
+#
+proc ttk::notebook::TLCleanup {w} {
+ variable TLNotebooks
+ if {$w eq [winfo toplevel $w]} {
+ unset -nocomplain -please TLNotebooks($w)
+ }
+}
+
+# Cleanup -- <Destroy> binding for notebooks
+#
+proc ttk::notebook::Cleanup {nb} {
+ variable TLNotebooks
+ set top [winfo toplevel $nb]
+ if {[info exists TLNotebooks($top)]} {
+ set index [lsearch -exact $TLNotebooks($top) $nb]
+ set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index]
+ }
+}
+
+# EnclosingNotebook $w --
+# Return the nearest traversal-enabled notebook widget
+# that contains $w.
+#
+# BUGS: this only works properly for tabs that are direct children
+# of the notebook widget. This routine should follow the
+# geometry manager hierarchy, not window ancestry, but that
+# information is not available in Tk.
+#
+proc ttk::notebook::EnclosingNotebook {w} {
+ variable TLNotebooks
+
+ set top [winfo toplevel $w]
+ if {![info exists TLNotebooks($top)]} { return }
+
+ while {$w ne $top && $w ne ""} {
+ if {[lsearch -exact $TLNotebooks($top) $w] >= 0} {
+ return $w
+ }
+ set w [winfo parent $w]
+ }
+ return ""
+}
+
+# TLCycleTab --
+# toplevel binding procedure for Control-Tab / Shift-Control-Tab
+# Select the next/previous tab in the nearest ancestor notebook.
+#
+proc ttk::notebook::TLCycleTab {w dir} {
+ set nb [EnclosingNotebook $w]
+ if {$nb ne ""} {
+ CycleTab $nb $dir
+ return -code break
+ }
+}
+
+# MnemonicActivation $nb $key --
+# Alt-KeyPress binding procedure for mnemonic activation.
+# Scan all notebooks in specified toplevel for a tab with the
+# the specified mnemonic. If found, activate it and return TCL_BREAK.
+#
+proc ttk::notebook::MnemonicActivation {top key} {
+ variable TLNotebooks
+ foreach nb $TLNotebooks($top) {
+ if {[set tab [MnemonicTab $nb $key]] ne ""} {
+ ActivateTab $nb [$nb index $tab]
+ return -code break
+ }
+ }
+}
diff --git a/library/ttk/panedwindow.tcl b/library/ttk/panedwindow.tcl
new file mode 100644
index 0000000..451e5c4
--- /dev/null
+++ b/library/ttk/panedwindow.tcl
@@ -0,0 +1,87 @@
+#
+# $Id: panedwindow.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set: bindings for TPanedwindow widget.
+#
+
+namespace eval ttk::panedwindow {
+ variable State
+ array set State {
+ pressed 0
+ pressX -
+ pressY -
+ sash -
+ sashPos -
+ }
+}
+
+## Bindings:
+#
+bind TPanedwindow <ButtonPress-1> { ttk::panedwindow::Press %W %x %y }
+bind TPanedwindow <B1-Motion> { ttk::panedwindow::Drag %W %x %y }
+bind TPanedwindow <ButtonRelease-1> { ttk::panedwindow::Release %W %x %y }
+
+bind TPanedwindow <Motion> { ttk::panedwindow::SetCursor %W %x %y }
+bind TPanedwindow <Enter> { ttk::panedwindow::SetCursor %W %x %y }
+bind TPanedwindow <Leave> { ttk::panedwindow::ResetCursor %W }
+# See PanedEventProc in ttkPanedwindow.c:
+bind TPanedwindow <<EnteredChild>> { ttk::panedwindow::ResetCursor %W }
+
+
+## Sash movement:
+#
+proc ttk::panedwindow::Press {w x y} {
+ variable State
+
+ lassign [$w identify $x $y] sash element
+ if {![info exists sash]} {
+ set State(pressed) 0
+ return
+ }
+ set State(pressed) 1
+ set State(pressX) $x
+ set State(pressY) $y
+ set State(sash) $sash
+ set State(sashPos) [$w sashpos $sash]
+}
+
+proc ttk::panedwindow::Drag {w x y} {
+ variable State
+ if {!$State(pressed)} { return }
+ switch -- [$w cget -orient] {
+ horizontal { set delta [expr {$x - $State(pressX)}] }
+ vertical { set delta [expr {$y - $State(pressY)}] }
+ }
+ $w sashpos $State(sash) [expr {$State(sashPos) + $delta}]
+}
+
+proc ttk::panedwindow::Release {w x y} {
+ variable State
+ set State(pressed) 0
+ SetCursor $w $x $y
+}
+
+## Cursor management:
+#
+proc ttk::panedwindow::ResetCursor {w} {
+ variable State
+ if {!$State(pressed)} {
+ $w configure -cursor {}
+ }
+}
+
+proc ttk::panedwindow::SetCursor {w x y} {
+ variable ::ttk::Cursors
+
+ if {![llength [$w identify $x $y]]} {
+ ResetCursor $w
+ } else {
+ # Assume we're over a sash.
+ switch -- [$w cget -orient] {
+ horizontal { $w configure -cursor $Cursors(hresize) }
+ vertical { $w configure -cursor $Cursors(vresize) }
+ }
+ }
+}
+
+#*EOF*
diff --git a/library/ttk/progress.tcl b/library/ttk/progress.tcl
new file mode 100644
index 0000000..f457bbe
--- /dev/null
+++ b/library/ttk/progress.tcl
@@ -0,0 +1,51 @@
+#
+# $Id: progress.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set: progress bar utilities.
+#
+
+namespace eval ttk::progressbar {
+ variable Timers ;# Map: widget name -> after ID
+}
+
+# Autoincrement --
+# Periodic callback procedure for autoincrement mode
+#
+proc ttk::progressbar::Autoincrement {pb steptime stepsize} {
+ variable Timers
+
+ if {![winfo exists $pb]} {
+ # widget has been destroyed -- cancel timer
+ unset -nocomplain Timers($pb)
+ return
+ }
+
+ $pb step $stepsize
+
+ set Timers($pb) [after $steptime \
+ [list ttk::progressbar::Autoincrement $pb $steptime $stepsize] ]
+}
+
+# ttk::progressbar::start --
+# Start autoincrement mode. Invoked by [$pb start] widget code.
+#
+proc ttk::progressbar::start {pb {steptime 50} {stepsize 1}} {
+ variable Timers
+ if {![info exists Timers($pb)]} {
+ Autoincrement $pb $steptime $stepsize
+ }
+}
+
+# ttk::progressbar::stop --
+# Cancel autoincrement mode. Invoked by [$pb stop] widget code.
+#
+proc ttk::progressbar::stop {pb} {
+ variable Timers
+ if {[info exists Timers($pb)]} {
+ after cancel $Timers($pb)
+ unset Timers($pb)
+ }
+ $pb configure -value 0
+}
+
+
diff --git a/library/ttk/scale.tcl b/library/ttk/scale.tcl
new file mode 100644
index 0000000..2a5cf2e
--- /dev/null
+++ b/library/ttk/scale.tcl
@@ -0,0 +1,54 @@
+# scale.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# Bindings for the TScale widget
+#
+# $Id: scale.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+
+namespace eval ttk::scale {
+ variable State
+ array set State {
+ dragging 0
+ }
+}
+
+bind TScale <ButtonPress-1> { ttk::scale::Press %W %x %y }
+bind TScale <B1-Motion> { ttk::scale::Drag %W %x %y }
+bind TScale <ButtonRelease-1> { ttk::scale::Release %W %x %y }
+
+proc ttk::scale::Press {w x y} {
+ variable State
+ set State(dragging) 0
+
+ switch -glob -- [$w identify $x $y] {
+ *track -
+ *trough {
+ if {[$w get $x $y] <= [$w get]} {
+ ttk::Repeatedly Increment $w -1
+ } else {
+ ttk::Repeatedly Increment $w 1
+ }
+ }
+ *slider {
+ set State(dragging) 1
+ set State(initial) [$w get]
+ }
+ }
+}
+
+proc ttk::scale::Drag {w x y} {
+ variable State
+ if {$State(dragging)} {
+ $w set [$w get $x $y]
+ }
+}
+
+proc ttk::scale::Release {w x y} {
+ variable State
+ set State(dragging) 0
+ ttk::CancelRepeat
+}
+
+proc ttk::scale::Increment {w delta} {
+ if {![winfo exists $w]} return
+ $w set [expr {[$w get] + $delta}]
+}
diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl
new file mode 100644
index 0000000..6b37b24
--- /dev/null
+++ b/library/ttk/scrollbar.tcl
@@ -0,0 +1,107 @@
+#
+# $Id: scrollbar.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Bindings for TScrollbar widget
+#
+
+namespace eval ttk::scrollbar {
+ variable State
+ # State(xPress) --
+ # State(yPress) -- initial position of mouse at start of drag.
+ # State(first) -- value of -first at start of drag.
+}
+
+bind TScrollbar <ButtonPress-1> { ttk::scrollbar::Press %W %x %y }
+bind TScrollbar <B1-Motion> { ttk::scrollbar::Drag %W %x %y }
+bind TScrollbar <ButtonRelease-1> { ttk::scrollbar::Release %W %x %y }
+
+bind TScrollbar <ButtonPress-2> { ttk::scrollbar::Jump %W %x %y }
+bind TScrollbar <B2-Motion> { ttk::scrollbar::Drag %W %x %y }
+bind TScrollbar <ButtonRelease-2> { ttk::scrollbar::Release %W %x %y }
+
+proc ttk::scrollbar::Scroll {w n units} {
+ set cmd [$w cget -command]
+ if {$cmd ne ""} {
+ uplevel #0 $cmd scroll $n $units
+ }
+}
+
+proc ttk::scrollbar::Moveto {w fraction} {
+ set cmd [$w cget -command]
+ if {$cmd ne ""} {
+ uplevel #0 $cmd moveto $fraction
+ }
+}
+
+proc ttk::scrollbar::Press {w x y} {
+ variable State
+
+ set State(xPress) $x
+ set State(yPress) $y
+
+ switch -glob -- [$w identify $x $y] {
+ *uparrow -
+ *leftarrow {
+ ttk::Repeatedly Scroll $w -1 units
+ }
+ *downarrow -
+ *rightarrow {
+ ttk::Repeatedly Scroll $w 1 units
+ }
+ *thumb {
+ set State(first) [lindex [$w get] 0]
+ }
+ *trough {
+ set f [$w fraction $x $y]
+ if {$f < [lindex [$w get] 0]} {
+ # Clicked in upper/left trough
+ ttk::Repeatedly Scroll $w -1 pages
+ } elseif {$f > [lindex [$w get] 1]} {
+ # Clicked in lower/right trough
+ ttk::Repeatedly Scroll $w 1 pages
+ } else {
+ # Clicked on thumb (???)
+ set State(first) [lindex [$w get] 0]
+ }
+ }
+ }
+}
+
+proc ttk::scrollbar::Drag {w x y} {
+ variable State
+ if {![info exists State(first)]} {
+ # Initial buttonpress was not on the thumb,
+ # or something screwy has happened. In either case, ignore:
+ return;
+ }
+ set xDelta [expr {$x - $State(xPress)}]
+ set yDelta [expr {$y - $State(yPress)}]
+ Moveto $w [expr {$State(first) + [$w delta $xDelta $yDelta]}]
+}
+
+proc ttk::scrollbar::Release {w x y} {
+ variable State
+ unset -nocomplain State(xPress) State(yPress) State(first)
+ ttk::CancelRepeat
+}
+
+# scrollbar::Jump -- ButtonPress-2 binding for scrollbars.
+# Behaves exactly like scrollbar::Press, except that
+# clicking in the trough jumps to the the selected position.
+#
+proc ttk::scrollbar::Jump {w x y} {
+ variable State
+
+ switch -glob -- [$w identify $x $y] {
+ *thumb -
+ *trough {
+ set State(first) [$w fraction $x $y]
+ Moveto $w $State(first)
+ set State(xPress) $x
+ set State(yPress) $y
+ }
+ default {
+ Press $w $x $y
+ }
+ }
+}
diff --git a/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl
new file mode 100644
index 0000000..f1b87b1
--- /dev/null
+++ b/library/ttk/sizegrip.tcl
@@ -0,0 +1,77 @@
+#
+# $Id: sizegrip.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set -- sizegrip widget bindings.
+#
+# Dragging a sizegrip widget resizes the containing toplevel.
+#
+# NOTE: the sizegrip widget must be in the lower right hand corner.
+#
+
+option add *TSizegrip.cursor $::ttk::Cursors(seresize)
+
+namespace eval ttk::sizegrip {
+ variable State
+ array set State {
+ pressed 0
+ pressX 0
+ pressY 0
+ width 0
+ height 0
+ widthInc 1
+ heightInc 1
+ toplevel {}
+ }
+}
+
+bind TSizegrip <ButtonPress-1> { ttk::sizegrip::Press %W %X %Y }
+bind TSizegrip <B1-Motion> { ttk::sizegrip::Drag %W %X %Y }
+bind TSizegrip <ButtonRelease-1> { ttk::sizegrip::Release %W %X %Y }
+
+proc ttk::sizegrip::Press {W X Y} {
+ variable State
+
+ set top [winfo toplevel $W]
+
+ # Sanity-checks:
+ # If a negative X or Y position was specified for [wm geometry],
+ # just bail out -- there's no way to handle this cleanly.
+ #
+ if {[scan [wm geometry $top] "%dx%d+%d+%d" width height _x _y] != 4} {
+ return;
+ }
+
+ # Account for gridded geometry:
+ #
+ set grid [wm grid $top]
+ if {[llength $grid]} {
+ set State(widthInc) [lindex $grid 2]
+ set State(heightInc) [lindex $grid 3]
+ } else {
+ set State(widthInc) [set State(heightInc) 1]
+ }
+
+ set State(toplevel) $top
+ set State(pressX) $X
+ set State(pressY) $Y
+ set State(width) $width
+ set State(height) $height
+ set State(pressed) 1
+}
+
+proc ttk::sizegrip::Drag {W X Y} {
+ variable State
+ if {!$State(pressed)} { return }
+ set w [expr {$State(width) + ($X - $State(pressX))/$State(widthInc)}]
+ set h [expr {$State(height) + ($Y - $State(pressY))/$State(heightInc)}]
+ if {$w <= 0} { set w 1 }
+ if {$h <= 0} { set h 1 }
+ wm geometry $State(toplevel) ${w}x${h}
+}
+
+proc ttk::sizegrip::Release {W X Y} {
+ variable State
+ set State(pressed) 0
+}
+
+#*EOF*
diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl
new file mode 100644
index 0000000..265f34c
--- /dev/null
+++ b/library/ttk/treeview.tcl
@@ -0,0 +1,423 @@
+#
+# $Id: treeview.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set -- bindings for Treeview widget.
+#
+
+namespace eval ttk::treeview {
+ variable State
+
+ # Enter/Leave/Motion
+ #
+ set State(activeWidget) {}
+ set State(activeHeading) {}
+
+ # Press/drag/release:
+ #
+ set State(pressMode) none
+ set State(pressX) 0
+
+ # For pressMode == "resize"
+ set State(minWidth) 24
+ set State(resizeColumn) #0
+ set State(resizeWidth) 0
+
+ # For pressmode == "heading"
+ set State(heading) {}
+
+ # Provide [lassign] if not already present
+ # (@@@ TODO: check if this is still needed after horrible-identify purge)
+ #
+ if {![llength [info commands lassign]]} {
+ proc lassign {vals args} {
+ uplevel 1 [list foreach $args $vals break]
+ }
+ }
+}
+
+### Widget bindings.
+#
+
+bind Treeview <Motion> { ttk::treeview::Motion %W %x %y }
+bind Treeview <B1-Leave> { #nothing }
+bind Treeview <Leave> { ttk::treeview::ActivateHeading {} {}}
+bind Treeview <ButtonPress-1> { ttk::treeview::Press %W %x %y }
+bind Treeview <Double-ButtonPress-1> { ttk::treeview::DoubleClick %W %x %y }
+bind Treeview <ButtonRelease-1> { ttk::treeview::Release %W %x %y }
+bind Treeview <B1-Motion> { ttk::treeview::Drag %W %x %y }
+bind Treeview <KeyPress-Up> { ttk::treeview::Keynav %W up }
+bind Treeview <KeyPress-Down> { ttk::treeview::Keynav %W down }
+bind Treeview <KeyPress-Right> { ttk::treeview::Keynav %W right }
+bind Treeview <KeyPress-Left> { ttk::treeview::Keynav %W left }
+bind Treeview <KeyPress-Prior> { %W yview scroll -1 pages }
+bind Treeview <KeyPress-Next> { %W yview scroll 1 pages }
+bind Treeview <KeyPress-Return> { ttk::treeview::ToggleFocus %W }
+bind Treeview <KeyPress-space> { ttk::treeview::ToggleFocus %W }
+
+bind Treeview <Shift-ButtonPress-1> \
+ { ttk::treeview::Select %W %x %y extend }
+bind Treeview <Control-ButtonPress-1> \
+ { ttk::treeview::Select %W %x %y toggle }
+
+# Standard mousewheel bindings:
+#
+bind Treeview <MouseWheel> { %W yview scroll [expr {- (%D / 120) * 4}] units }
+if {[string equal "x11" [tk windowingsystem]]} {
+ bind Treeview <ButtonPress-4> { %W yview scroll -5 units }
+ bind Treeview <ButtonPress-5> { %W yview scroll 5 units }
+}
+
+### Binding procedures.
+#
+
+## Keynav -- Keyboard navigation
+#
+# @@@ TODO: verify/rewrite up and down code.
+#
+proc ttk::treeview::Keynav {w dir} {
+ set focus [$w focus]
+ if {$focus eq ""} { return }
+
+ switch -- $dir {
+ up {
+ if {[set up [$w prev $focus]] eq ""} {
+ set focus [$w parent $focus]
+ } else {
+ while {[$w item $up -open] && [llength [$w children $up]]} {
+ set up [lindex [$w children $up] end]
+ }
+ set focus $up
+ }
+ }
+ down {
+ if {[$w item $focus -open] && [llength [$w children $focus]]} {
+ set focus [lindex [$w children $focus] 0]
+ } else {
+ set up $focus
+ while {$up ne "" && [set down [$w next $up]] eq ""} {
+ set up [$w parent $up]
+ }
+ set focus $down
+ }
+ }
+ left {
+ if {[$w item $focus -open] && [llength [$w children $focus]]} {
+ CloseItem $w $focus
+ } else {
+ set focus [$w parent $focus]
+ }
+ }
+ right {
+ OpenItem $w $focus
+ }
+ }
+
+ if {$focus != {}} {
+ SelectOp $w $focus choose
+ }
+}
+
+## Motion -- pointer motion binding.
+# Sets cursor, active element ...
+#
+proc ttk::treeview::Motion {w x y} {
+ variable ::ttk::Cursors
+ variable State
+
+ set cursor {}
+ set activeHeading {}
+
+ lassign [$w identify $x $y] what where detail
+ switch -- $what {
+ separator { set cursor $Cursors(hresize) }
+ heading { set activeHeading $where }
+ }
+
+ if {[$w cget -cursor] ne $cursor} {
+ $w configure -cursor $cursor
+ }
+ ActivateHeading $w $activeHeading
+}
+
+## ActivateHeading -- track active heading element
+#
+proc ttk::treeview::ActivateHeading {w heading} {
+ variable State
+
+ if {$w != $State(activeWidget) || $heading != $State(activeHeading)} {
+ if {$State(activeHeading) != {}} {
+ $State(activeWidget) heading $State(activeHeading) state !active
+ }
+ if {$heading != {}} {
+ $w heading $heading state active
+ }
+ set State(activeHeading) $heading
+ set State(activeWidget) $w
+ }
+}
+
+## Select $w $x $y $selectop
+# Binding procedure for selection operations.
+# See "Selection modes", below.
+#
+proc ttk::treeview::Select {w x y op} {
+ if {[set item [$w identify row $x $y]] ne "" } {
+ SelectOp $w $item $op
+ }
+}
+
+## DoubleClick -- Double-ButtonPress-1 binding.
+#
+proc ttk::treeview::DoubleClick {w x y} {
+ if {[set row [$w identify row $x $y]] ne ""} {
+ Toggle $w $row
+ } else {
+ Press $w $x $y ;# perform single-click action
+ }
+}
+
+## Press -- ButtonPress binding.
+#
+proc ttk::treeview::Press {w x y} {
+ lassign [$w identify $x $y] what where detail
+ focus $w ;# or: ClickToFocus?
+
+ switch -- $what {
+ nothing { }
+ heading { heading.press $w $where }
+ separator { resize.press $w $x $where }
+ cell -
+ row -
+ item { SelectOp $w $where choose }
+ }
+ if {$what eq "item" && [string match *indicator $detail]} {
+ Toggle $w $where
+ }
+}
+
+## Drag -- B1-Motion binding
+#
+proc ttk::treeview::Drag {w x y} {
+ variable State
+ switch $State(pressMode) {
+ resize { resize.drag $w $x }
+ heading { heading.drag $w $x $y }
+ }
+}
+
+proc ttk::treeview::Release {w x y} {
+ variable State
+ switch $State(pressMode) {
+ resize { resize.release $w $x }
+ heading { heading.release $w }
+ }
+ set State(pressMode) none
+ Motion $w $x $y
+}
+
+### Interactive column resizing.
+#
+# @@@ needs work.
+#
+proc ttk::treeview::resize.press {w x column} {
+ variable State
+
+ set State(pressMode) "resize"
+ set State(pressX) $x
+ set State(resizeColumn) $column
+ set State(resizeWidth) [$w column $column -width]
+}
+
+proc ttk::treeview::resize.drag {w x} {
+ variable State
+ set newWidth [expr {$State(resizeWidth) + $x - $State(pressX)}]
+ if {$newWidth < $State(minWidth)} {
+ set newWidth $State(minWidth)
+ }
+ $w column $State(resizeColumn) -width $newWidth
+}
+
+proc ttk::treeview::resize.release {w x} {
+ # no-op
+}
+
+### Heading activation.
+#
+
+proc ttk::treeview::heading.press {w column} {
+ variable State
+ set State(pressMode) "heading"
+ set State(heading) $column
+ $w heading $column state pressed
+}
+
+proc ttk::treeview::heading.drag {w x y} {
+ variable State
+ lassign [$w identify $x $y] what where detail
+ if {$what eq "heading" && $where eq $State(heading)} {
+ $w heading $State(heading) state pressed
+ } else {
+ $w heading $State(heading) state !pressed
+ }
+}
+
+proc ttk::treeview::heading.release {w} {
+ variable State
+ if {[lsearch -exact [$w heading $State(heading) state] pressed] >= 0} {
+ after idle [$w heading $State(heading) -command]
+ }
+ $w heading $State(heading) state !pressed
+}
+
+### Selection modes.
+#
+
+## SelectOp $w $item [ choose | extend | toggle ] --
+# Dispatch to appropriate selection operation
+# depending on current value of -selectmode.
+#
+proc ttk::treeview::SelectOp {w item op} {
+ select.$op.[$w cget -selectmode] $w $item
+}
+
+## -selectmode none:
+#
+proc ttk::treeview::select.choose.none {w item} { $w focus $item }
+proc ttk::treeview::select.toggle.none {w item} { $w focus $item }
+proc ttk::treeview::select.extend.none {w item} { $w focus $item }
+
+## -selectmode browse:
+#
+proc ttk::treeview::select.choose.browse {w item} { BrowseTo $w $item }
+proc ttk::treeview::select.toggle.browse {w item} { BrowseTo $w $item }
+proc ttk::treeview::select.extend.browse {w item} { BrowseTo $w $item }
+
+## -selectmode multiple:
+#
+proc ttk::treeview::select.choose.extended {w item} {
+ BrowseTo $w $item
+}
+proc ttk::treeview::select.toggle.extended {w item} {
+ $w selection toggle $item
+}
+proc ttk::treeview::select.extend.extended {w item} {
+ if {[set anchor [$w focus]] ne ""} {
+ $w selection set [between $w $anchor $item]
+ } else {
+ BrowseTo $item
+ }
+}
+
+### Tree structure utilities.
+#
+
+## between $tv $item1 $item2 --
+# Returns a list of all items between $item1 and $item2,
+# in preorder traversal order. $item1 and $item2 may be
+# in either order.
+#
+# NOTES:
+# This routine is O(N) in the size of the tree.
+# There's probably a way to do this that's O(N) in the number
+# of items returned, but I'm not clever enough to figure it out.
+#
+proc ttk::treeview::between {tv item1 item2} {
+ variable between [list]
+ variable selectingBetween 0
+ ScanBetween $tv $item1 $item2 {}
+ return $between
+}
+
+## ScanBetween --
+# Recursive worker routine for ttk::treeview::between
+#
+proc ttk::treeview::ScanBetween {tv item1 item2 item} {
+ variable between
+ variable selectingBetween
+
+ if {$item eq $item1 || $item eq $item2} {
+ lappend between $item
+ set selectingBetween [expr {!$selectingBetween}]
+ } elseif {$selectingBetween} {
+ lappend between $item
+ }
+ foreach child [$tv children $item] {
+ ScanBetween $tv $item1 $item2 $child
+ }
+}
+
+### User interaction utilities.
+#
+
+## OpenItem, CloseItem -- Set the open state of an item, generate event
+#
+
+proc ttk::treeview::OpenItem {w item} {
+ $w focus $item
+ event generate $w <<TreeviewOpen>>
+ $w item $item -open true
+}
+
+proc ttk::treeview::CloseItem {w item} {
+ $w item $item -open false
+ $w focus $item
+ event generate $w <<TreeviewClose>>
+}
+
+## Toggle -- toggle opened/closed state of item
+#
+proc ttk::treeview::Toggle {w item} {
+ if {[$w item $item -open]} {
+ CloseItem $w $item
+ } else {
+ OpenItem $w $item
+ }
+}
+
+## ToggleFocus -- toggle opened/closed state of focus item
+#
+proc ttk::treeview::ToggleFocus {w} {
+ set item [$w focus]
+ if {$item ne ""} {
+ Toggle $w $item
+ }
+}
+
+## BrowseTo -- navigate to specified item; set focus and selection
+#
+proc ttk::treeview::BrowseTo {w item} {
+ $w see $item
+ $w focus $item
+ $w selection set [list $item]
+}
+
+### Style settings for selected built-in themes.
+#
+# Do this here instead of in the theme definitions since the details are
+# likely to change; it's better to keep this all in one place for now.
+#
+namespace eval ::ttk::treeview {
+ variable theme
+ namespace import -force ::ttk::style
+ foreach theme [style theme names] {
+ style theme settings $theme {
+ style map Item -foreground [list selected "#FFFFFF"]
+ style configure Row -background "#EEEEEE"
+ style configure Heading -relief raised -font TkHeadingFont
+ style configure Item -justify left
+ style map Heading -relief {
+ pressed sunken
+ }
+ style map Row -background {
+ selected #4a6984
+ focus #ccccff
+ alternate #FFFFFF
+ }
+ style map Cell -foreground {
+ selected #FFFFFF
+ }
+ }
+ }
+}
+
+#*EOF*
diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl
new file mode 100644
index 0000000..f573bfc
--- /dev/null
+++ b/library/ttk/ttk.tcl
@@ -0,0 +1,200 @@
+#
+# $Id: ttk.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set initialization script.
+#
+
+### Source library scripts.
+#
+
+namespace eval ::ttk {
+ variable library
+ if {![info exists library]} {
+ set library [file dirname [info script]]
+ }
+}
+
+source [file join $::ttk::library keynav.tcl]
+source [file join $::ttk::library fonts.tcl]
+source [file join $::ttk::library cursors.tcl]
+source [file join $::ttk::library icons.tcl]
+source [file join $::ttk::library utils.tcl]
+
+## ttk::deprecated $old $new --
+# Define $old command as a deprecated alias for $new command
+# $old and $new must be fully namespace-qualified.
+#
+proc ::ttk::deprecated {old new} {
+ interp alias {} $old {} ttk::do'deprecate $old $new
+}
+## do'deprecate --
+# Implementation procedure for deprecated commands --
+# issue a warning (once), then re-alias old to new.
+#
+proc ::ttk::do'deprecate {old new args} {
+ deprecated'warning $old $new
+ interp alias {} $old {} $new
+ eval [linsert $args 0 $new]
+}
+
+## deprecated'warning --
+# Gripe about use of deprecated commands.
+#
+proc ::ttk::deprecated'warning {old new} {
+ puts stderr "$old deprecated -- use $new instead"
+}
+
+### Forward-compatibility.
+#
+# ttk::panedwindow used to be named ttk::paned. Keep the alias for now.
+#
+::ttk::deprecated ::ttk::paned ::ttk::panedwindow
+
+if {[info exists ::ttk::deprecrated] && $::ttk::deprecated} {
+ ### Deprecated bits.
+ #
+
+ namespace eval ::tile {
+ # Deprecated namespace. Define these only when requested
+ variable library
+ if {![info exists library]} {
+ set library [file dirname [info script]]
+ }
+
+ variable version 0.7.8
+ variable patchlevel 0.7.8
+ }
+ package provide tile $::tile::version
+
+ ### Widgets.
+ # Widgets are all defined in the ::ttk namespace.
+ #
+ # For compatibility with earlier Tile releases, we temporarily
+ # create aliases ::tile::widget, and ::t$widget.
+ # Using any of the aliases will issue a warning.
+ #
+
+ namespace eval ttk {
+ variable widgets {
+ button checkbutton radiobutton menubutton label entry
+ frame labelframe scrollbar
+ notebook progressbar combobox separator
+ scale
+ }
+
+ variable wc
+ foreach wc $widgets {
+ namespace export $wc
+
+ deprecated ::t$wc ::ttk::$wc
+ deprecated ::tile::$wc ::ttk::$wc
+ namespace eval ::tile [list namespace export $wc]
+ }
+ }
+}
+
+### ::ttk::ThemeChanged --
+# Called from [::ttk::style theme use].
+# Sends a <<ThemeChanged>> virtual event to all widgets.
+#
+proc ::ttk::ThemeChanged {} {
+ set Q .
+ while {[llength $Q]} {
+ set QN [list]
+ foreach w $Q {
+ event generate $w <<ThemeChanged>>
+ foreach child [winfo children $w] {
+ lappend QN $child
+ }
+ }
+ set Q $QN
+ }
+}
+
+### Public API.
+#
+
+proc ::ttk::themes {{ptn *}} {
+ set themes [list]
+
+ foreach pkg [lsearch -inline -all -glob [package names] ttk::theme::$ptn] {
+ lappend themes [namespace tail $pkg]
+ }
+
+ return $themes
+}
+
+## ttk::setTheme $theme --
+# Set the current theme to $theme, loading it if necessary.
+#
+proc ::ttk::setTheme {theme} {
+ variable currentTheme ;# @@@ Temp -- [::ttk::style theme use] doesn't work
+ if {$theme ni [::ttk::style theme names]} {
+ package require ttk::theme::$theme
+ }
+ ::ttk::style theme use $theme
+ set currentTheme $theme
+}
+
+### Load widget bindings.
+#
+source [file join $::ttk::library button.tcl]
+source [file join $::ttk::library menubutton.tcl]
+source [file join $::ttk::library scrollbar.tcl]
+source [file join $::ttk::library scale.tcl]
+source [file join $::ttk::library progress.tcl]
+source [file join $::ttk::library notebook.tcl]
+source [file join $::ttk::library panedwindow.tcl]
+source [file join $::ttk::library entry.tcl]
+source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl
+source [file join $::ttk::library treeview.tcl]
+source [file join $::ttk::library sizegrip.tcl]
+source [file join $::ttk::library dialog.tcl]
+
+## Label and Labelframe bindings:
+# (not enough to justify their own file...)
+#
+bind TLabelframe <<Invoke>> { tk::TabToWindow [tk_focusNext %W] }
+bind TLabel <<Invoke>> { tk::TabToWindow [tk_focusNext %W] }
+
+### Load themes.
+#
+source [file join $::ttk::library defaults.tcl]
+source [file join $::ttk::library classicTheme.tcl]
+source [file join $::ttk::library altTheme.tcl]
+source [file join $::ttk::library clamTheme.tcl]
+
+### Choose platform-specific default theme.
+#
+# Notes:
+# + xpnative takes precedence over winnative if available.
+# + On X11, users can use the X resource database to
+# specify a preferred theme (*TkTheme: themeName)
+#
+
+set ::ttk::defaultTheme "default"
+
+if {[package provide ttk::theme::winnative] != {}} {
+ source [file join $::ttk::library winTheme.tcl]
+ set ::ttk::defaultTheme "winnative"
+}
+if {[package provide ttk::theme::xpnative] != {}} {
+ source [file join $::ttk::library xpTheme.tcl]
+ set ::ttk::defaultTheme "xpnative"
+}
+if {[package provide ttk::theme::aqua] != {}} {
+ source [file join $::ttk::library aquaTheme.tcl]
+ set ::ttk::defaultTheme "aqua"
+}
+
+set ::ttk::userTheme [option get . tkTheme TkTheme]
+if {$::ttk::userTheme != {}} {
+ if {($::ttk::userTheme in [::ttk::style theme names])
+ || ![catch {package require ttk::theme::$ttk::userTheme}]} {
+ set ::ttk::defaultTheme $::ttk::userTheme
+ }
+}
+
+::ttk::setTheme $::ttk::defaultTheme
+
+#*EOF*
diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl
new file mode 100644
index 0000000..b8059ae
--- /dev/null
+++ b/library/ttk/utils.tcl
@@ -0,0 +1,234 @@
+#
+# $Id: utils.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set: utilities for widget implementations.
+#
+
+### Focus management.
+#
+
+## ttk::takefocus --
+# This is the default value of the "-takefocus" option
+# for widgets that participate in keyboard navigation.
+#
+# See also: tk::FocusOK
+#
+proc ttk::takefocus {w} {
+ expr {[$w instate !disabled] && [winfo viewable $w]}
+}
+
+## ttk::clickToFocus $w --
+# Utility routine, used in <ButtonPress-1> bindings --
+# Assign keyboard focus to the specified widget if -takefocus is enabled.
+#
+proc ttk::clickToFocus {w} {
+ if {[ttk::takesFocus $w]} { focus $w }
+}
+
+## ttk::takesFocus w --
+# Test if the widget can take keyboard focus:
+#
+# + widget is viewable, AND:
+# - if -takefocus is missing or empty, return 0, OR
+# - if -takefocus is 0 or 1, return that value, OR
+# - append the widget name to -takefocus and evaluate it
+# as a script.
+#
+# See also: tk::FocusOK
+#
+# Note: This routine doesn't implement the same fallback heuristics
+# as tk::FocusOK.
+#
+proc ttk::takesFocus {w} {
+
+ if {![winfo viewable $w]} { return 0 }
+
+ if {![catch {$w cget -takefocus} takefocus]} {
+ switch -- $takefocus {
+ 0 -
+ 1 { return $takefocus }
+ "" { return 0 }
+ default {
+ set value [uplevel #0 $takefocus [list $w]]
+ return [expr {$value eq 1}]
+ }
+ }
+ }
+
+ return 0
+}
+
+### Grabs.
+#
+# Rules:
+# Each call to [grabWindow $w] or [globalGrab $w] must be
+# matched with a call to [releaseGrab $w] in LIFO order.
+#
+# Do not call [grabWindow $w] for a window that currently
+# appears on the grab stack.
+#
+# See #1239190 and #1411983 for more discussion.
+#
+namespace eval ttk {
+ variable Grab ;# map: window name -> grab token
+
+ # grab token details:
+ # Two-element list containing:
+ # 1) a script to evaluate to restore the previous grab (if any);
+ # 2) a script to evaluate to restore the focus (if any)
+}
+
+## SaveGrab --
+# Record current grab and focus windows.
+#
+proc ttk::SaveGrab {w} {
+ variable Grab
+
+ set restoreGrab [set restoreFocus ""]
+
+ set grabbed [grab current $w]
+ if {[winfo exists $grabbed]} {
+ switch [grab status $grabbed] {
+ global { set restoreGrab [list grab -global $grabbed] }
+ local { set restoreGrab [list grab $grabbed] }
+ none { ;# grab window is really in a different interp }
+ }
+ }
+
+ set focus [focus]
+ if {$focus ne ""} {
+ set restoreFocus [list focus -force $focus]
+ }
+
+ set Grab($w) [list $restoreGrab $restoreFocus]
+}
+
+## RestoreGrab --
+# Restore previous grab and focus windows.
+# If called more than once without an intervening [SaveGrab $w],
+# does nothing.
+#
+proc ttk::RestoreGrab {w} {
+ variable Grab
+
+ if {![info exists Grab($w)]} { # Ignore
+ return;
+ }
+
+ # The previous grab/focus window may have been destroyed,
+ # unmapped, or some other abnormal condition; ignore any errors.
+ #
+ foreach script $Grab($w) {
+ catch $script
+ }
+
+ unset Grab($w)
+}
+
+## ttk::grabWindow $w --
+# Records the current focus and grab windows, sets an application-modal
+# grab on window $w.
+#
+proc ttk::grabWindow {w} {
+ SaveGrab $w
+ grab $w
+}
+
+## ttk::globalGrab $w --
+# Same as grabWindow, but sets a global grab on $w.
+#
+proc ttk::globalGrab {w} {
+ SaveGrab $w
+ grab -global $w
+}
+
+## ttk::releaseGrab --
+# Release the grab previously set by [ttk::grabWindow]
+# or [ttk::globalGrab].
+#
+proc ttk::releaseGrab {w} {
+ grab release $w
+ RestoreGrab $w
+}
+
+### Auto-repeat.
+#
+# NOTE: repeating widgets do not have -repeatdelay
+# or -repeatinterval resources as in standard Tk;
+# instead a single set of settings is applied application-wide.
+# (TODO: make this user-configurable)
+#
+# (@@@ Windows seems to use something like 500/50 milliseconds
+# @@@ for -repeatdelay/-repeatinterval)
+#
+
+namespace eval ttk {
+ variable Repeat
+ array set Repeat {
+ delay 300
+ interval 100
+ timer {}
+ script {}
+ }
+}
+
+## ttk::Repeatedly --
+# Begin auto-repeat.
+#
+proc ttk::Repeatedly {args} {
+ variable Repeat
+ after cancel $Repeat(timer)
+ set script [uplevel 1 [list namespace code $args]]
+ set Repeat(script) $script
+ uplevel #0 $script
+ set Repeat(timer) [after $Repeat(delay) ttk::Repeat]
+}
+
+## Repeat --
+# Continue auto-repeat
+#
+proc ttk::Repeat {} {
+ variable Repeat
+ uplevel #0 $Repeat(script)
+ set Repeat(timer) [after $Repeat(interval) ttk::Repeat]
+}
+
+## ttk::CancelRepeat --
+# Halt auto-repeat.
+#
+proc ttk::CancelRepeat {} {
+ variable Repeat
+ after cancel $Repeat(timer)
+}
+
+### Miscellaneous.
+#
+
+## ttk::CopyBindings $from $to --
+# Utility routine; copies bindings from one bindtag onto another.
+#
+proc ttk::CopyBindings {from to} {
+ foreach event [bind $from] {
+ bind $to $event [bind $from $event]
+ }
+}
+
+## ttk::LoadImages $imgdir ?$patternList? --
+# Utility routine for pixmap themes
+#
+# Loads all image files in $imgdir matching $patternList.
+# Returns: a paired list of filename/imagename pairs.
+#
+proc ttk::LoadImages {imgdir {patterns {*.gif}}} {
+ foreach pattern $patterns {
+ foreach file [glob -directory $imgdir $pattern] {
+ set img [file tail [file rootname $file]]
+ if {![info exists images($img)]} {
+ set images($img) [image create photo -file $file]
+ }
+ }
+ }
+ return [array get images]
+}
+
+#*EOF*
diff --git a/library/ttk/winTheme.tcl b/library/ttk/winTheme.tcl
new file mode 100644
index 0000000..ac4cba9
--- /dev/null
+++ b/library/ttk/winTheme.tcl
@@ -0,0 +1,61 @@
+#
+# $Id: winTheme.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set: Windows Native theme
+#
+
+namespace eval ttk {
+
+ style theme settings winnative {
+
+ style configure "." \
+ -background SystemButtonFace \
+ -foreground SystemWindowText \
+ -selectforeground SystemHighlightText \
+ -selectbackground SystemHighlight \
+ -troughcolor SystemScrollbar \
+ -font TkDefaultFont \
+ ;
+
+ style map "." -foreground [list disabled SystemGrayText] ;
+ style map "." -embossed [list disabled 1] ;
+
+ style configure TButton -width -11 -relief raised -shiftrelief 1
+ style configure TCheckbutton -padding "2 4"
+ style configure TRadiobutton -padding "2 4"
+ style configure TMenubutton -padding "8 4" -arrowsize 3 -relief raised
+
+ style map TButton -relief {{!disabled pressed} sunken}
+
+ style configure TEntry \
+ -padding 2 -selectborderwidth 0 -insertwidth 1
+ style map TEntry \
+ -fieldbackground \
+ [list readonly SystemButtonFace disabled SystemButtonFace] \
+ -selectbackground [list !focus SystemWindow] \
+ -selectforeground [list !focus SystemWindowText] \
+ ;
+
+ style configure TCombobox -padding 2
+ style map TCombobox \
+ -selectbackground [list !focus SystemWindow] \
+ -selectforeground [list !focus SystemWindowText] \
+ -foreground [list {readonly focus} SystemHighlightText] \
+ -focusfill [list {readonly focus} SystemHighlight] \
+ ;
+
+ style configure TLabelframe -borderwidth 2 -relief groove
+
+ style configure Toolbutton -relief flat -padding {8 4}
+ style map Toolbutton -relief \
+ {disabled flat selected sunken pressed sunken active raised}
+
+ style configure TScale -groovewidth 4
+
+ style configure TNotebook -tabmargins {2 2 2 0}
+ style configure TNotebook.Tab -padding {3 1} -borderwidth 1
+ style map TNotebook.Tab -expand [list selected {2 2 2 0}]
+
+ style configure TProgressbar -borderwidth 0 -background SystemHighlight
+ }
+}
diff --git a/library/ttk/xpTheme.tcl b/library/ttk/xpTheme.tcl
new file mode 100644
index 0000000..7749e56
--- /dev/null
+++ b/library/ttk/xpTheme.tcl
@@ -0,0 +1,51 @@
+#
+# $Id: xpTheme.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# Ttk widget set: XP Native theme
+#
+# @@@ todo: spacing and padding needs tweaking
+
+namespace eval ttk {
+
+ style theme settings xpnative {
+
+ style configure . \
+ -background SystemButtonFace \
+ -foreground SystemWindowText \
+ -selectforeground SystemHighlightText \
+ -selectbackground SystemHighlight \
+ -font TkDefaultFont \
+ ;
+
+ style map "." \
+ -foreground [list disabled SystemGrayText] \
+ ;
+
+ style configure TButton -padding {1 1} -width -11
+ style configure TRadiobutton -padding 2
+ style configure TCheckbutton -padding 2
+ style configure TMenubutton -padding {8 4}
+
+ style configure TNotebook -tabmargins {2 2 2 0}
+ style map TNotebook.Tab \
+ -expand [list selected {2 2 2 2}]
+
+ style configure TLabelframe -foreground "#0046d5"
+
+ # OR: -padding {3 3 3 6}, which some apps seem to use.
+ style configure TEntry -padding {2 2 2 4}
+ style map TEntry \
+ -selectbackground [list !focus SystemWindow] \
+ -selectforeground [list !focus SystemWindowText] \
+ ;
+ style configure TCombobox -padding 2
+ style map TCombobox \
+ -selectbackground [list !focus SystemWindow] \
+ -selectforeground [list !focus SystemWindowText] \
+ -foreground [list {readonly focus} SystemHighlightText] \
+ -focusfill [list {readonly focus} SystemHighlight] \
+ ;
+
+ style configure Toolbutton -padding {4 4}
+ }
+}
diff --git a/macosx/ttkMacOSXTheme.c b/macosx/ttkMacOSXTheme.c
new file mode 100644
index 0000000..ca10aa9
--- /dev/null
+++ b/macosx/ttkMacOSXTheme.c
@@ -0,0 +1,996 @@
+/*
+ * $Id: ttkMacOSXTheme.c,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+ *
+ * Tk theme engine for Mac OSX, using the Appearance Manager API.
+ *
+ * Copyright (c) 2004 Joe English
+ * Copyright (c) 2005 Neil Madden
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * See also:
+ *
+ * <URL: http://developer.apple.com/documentation/Carbon/Reference/
+ * Appearance_Manager/appearance_manager/APIIndex.html >
+ *
+ * Notes:
+ * "Active" means different things in Mac and Tk terminology --
+ * On Aqua, widgets are "Active" if they belong to the foreground window,
+ * "Inactive" if they are in a background window.
+ * Tk/ttk uses the term "active" to mean that the mouse cursor
+ * is over a widget; aka "hover", "prelight", or "hot-tracked".
+ * (Aqua doesn't use this kind of feedback).
+ *
+ * The QuickDraw/Carbon coordinate system is relative to the
+ * top-level window, *not* to the Tk_Window. However,
+ * since we're drawing into an off-screen port (Tk "Pixmap),
+ * we don't need to account for this.
+ */
+
+#include <Carbon/Carbon.h>
+#include <tkMacOSXInt.h>
+#include "ttk/ttkTheme.h"
+
+/*----------------------------------------------------------------------
+ * +++ Utilities.
+ */
+
+static
+Rect BoxToRect(Ttk_Box b)
+{
+ Rect rect;
+ rect.top = b.y;
+ rect.left = b.x;
+ rect.bottom = b.y + b.height;
+ rect.right = b.x + b.width;
+ return rect;
+}
+
+#define BEGIN_DRAWING(d) { \
+ CGrafPtr saveWorld; GDHandle saveDevice; \
+ GetGWorld(&saveWorld, &saveDevice); \
+ SetGWorld(TkMacOSXGetDrawablePort(d), 0) ;
+#define END_DRAWING \
+ SetGWorld(saveWorld,saveDevice); }
+
+/* Table mapping Tk states to Appearance manager ThemeStates
+ */
+
+static Ttk_StateTable ThemeStateTable[] = {
+ {kThemeStateUnavailable, TTK_STATE_DISABLED, 0},
+ {kThemeStatePressed, TTK_STATE_PRESSED, 0},
+ {kThemeStateInactive, TTK_STATE_BACKGROUND, 0},
+ {kThemeStateActive, 0, 0}
+/* Others: Not sure what these are supposed to mean.
+ Up/Down have something to do with "little arrow" increment controls...
+ Dunno what a "Rollover" is.
+ NEM: Rollover is TTK_STATE_ACTIVE... but we don't handle that yet, by the
+ looks of things
+ {kThemeStateRollover, 0, 0},
+ {kThemeStateUnavailableInactive, 0, 0}
+ {kThemeStatePressedUp, 0, 0},
+ {kThemeStatePressedDown, 0, 0}
+*/
+};
+
+/*----------------------------------------------------------------------
+ * +++ Button element: Used for elements drawn with DrawThemeButton.
+ */
+
+/* Extra margins to account for drop shadow.
+ */
+static Ttk_Padding ButtonMargins = {2,2,2,2};
+
+#define NoThemeMetric 0xFFFFFFFF
+
+typedef struct {
+ ThemeButtonKind kind;
+ ThemeMetric heightMetric;
+} ThemeButtonParms;
+
+static ThemeButtonParms
+ PushButtonParms = { kThemePushButton, NoThemeMetric },
+ CheckBoxParms = { kThemeCheckBox, kThemeMetricCheckBoxHeight },
+ RadioButtonParms = { kThemeRadioButton, kThemeMetricRadioButtonHeight },
+ BevelButtonParms = { kThemeBevelButton, NoThemeMetric },
+ PopupButtonParms = { kThemePopupButton, NoThemeMetric },
+ ListHeaderParms = { kThemeListHeaderButton, kThemeMetricListHeaderHeight };
+
+static Ttk_StateTable ButtonValueTable[] = {
+ { kThemeButtonMixed, TTK_STATE_ALTERNATE, 0 },
+ { kThemeButtonOn, TTK_STATE_SELECTED, 0 },
+ { kThemeButtonOff, 0, 0 }
+/* Others: kThemeDisclosureRight, kThemeDisclosureDown, kThemeDisclosureLeft */
+};
+
+static Ttk_StateTable ButtonAdornmentTable[] = {
+ { kThemeAdornmentDefault, TTK_STATE_ALTERNATE, 0 },
+ { kThemeAdornmentFocus, TTK_STATE_FOCUS, 0 },
+ { kThemeAdornmentNone, 0, 0 }
+};
+
+/*
+ * computeButtonDrawInfo --
+ * Fill in an appearance manager ThemeButtonDrawInfo record.
+ */
+static ThemeButtonDrawInfo computeButtonDrawInfo(
+ ThemeButtonParms *parms, Ttk_State state)
+{
+ ThemeButtonDrawInfo info;
+ info.state = Ttk_StateTableLookup(ThemeStateTable, state);
+ info.value = Ttk_StateTableLookup(ButtonValueTable, state);
+ info.adornment = Ttk_StateTableLookup(ButtonAdornmentTable, state);
+ return info;
+}
+
+static void ButtonElementGeometryNoPadding(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ThemeButtonParms *parms = clientData;
+
+ if (parms->heightMetric != NoThemeMetric) {
+ SInt32 gratuitouslyOverspecifiedType;
+ GetThemeMetric(parms->heightMetric, &gratuitouslyOverspecifiedType);
+ *heightPtr = gratuitouslyOverspecifiedType;
+ }
+}
+
+static void ButtonElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ThemeButtonParms *parms = clientData;
+ ThemeButtonDrawInfo drawInfo = computeButtonDrawInfo(parms, 0);
+ Rect scratchRect, contentsRect;
+ const int scratchSize = 100;
+
+ ButtonElementGeometryNoPadding(
+ clientData, elementRecord, tkwin,
+ widthPtr, heightPtr, paddingPtr);
+
+ /* To compute internal padding, query the appearance manager
+ * for the content bounds of a dummy rectangle, then use
+ * the difference as the padding.
+ */
+ scratchRect.top = scratchRect.left = 0;
+ scratchRect.bottom = scratchRect.right = scratchSize;
+
+ GetThemeButtonContentBounds(
+ &scratchRect, parms->kind, &drawInfo, &contentsRect);
+
+ paddingPtr->left = contentsRect.left;
+ paddingPtr->top = contentsRect.top;
+ paddingPtr->bottom = scratchSize - contentsRect.bottom;
+ paddingPtr->right = scratchSize - contentsRect.right;
+
+ /* Now add a little extra padding to account for drop shadows.
+ * @@@ SHOULD: call GetThemeButtonBackgroundBounds() instead.
+ */
+
+ *paddingPtr = Ttk_AddPadding(*paddingPtr, ButtonMargins);
+}
+
+static void ButtonElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ Rect bounds = BoxToRect(Ttk_PadBox(b, ButtonMargins));
+ ThemeButtonParms *parms = clientData;
+ ThemeButtonDrawInfo info = computeButtonDrawInfo(parms, state);
+
+ BEGIN_DRAWING(d)
+ DrawThemeButton(&bounds, parms->kind, &info,
+ NULL/*prevInfo*/,NULL/*eraseProc*/,NULL/*labelProc*/,0/*userData*/);
+ END_DRAWING
+}
+
+static Ttk_ElementSpec ButtonElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ ButtonElementGeometry,
+ ButtonElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Notebook elements.
+ */
+
+static Ttk_StateTable TabStyleTable[] = {
+ { kThemeTabFrontInactive, TTK_STATE_SELECTED|TTK_STATE_BACKGROUND, 0 },
+ { kThemeTabNonFrontInactive, TTK_STATE_BACKGROUND, 0 },
+ { kThemeTabFrontUnavailable, TTK_STATE_DISABLED|TTK_STATE_SELECTED, 0 },
+ { kThemeTabNonFrontUnavailable, TTK_STATE_DISABLED, 0 },
+ { kThemeTabFront, TTK_STATE_SELECTED, 0 },
+ { kThemeTabNonFrontPressed, TTK_STATE_PRESSED, 0 },
+ { kThemeTabNonFront, 0,0 }
+};
+
+/* Quoth DrawThemeTab() reference manual:
+ * "Small tabs have a height of 16 pixels large tabs have a height of
+ * 21 pixels. (The widths of tabs are variable.) Additionally, the
+ * distance that the tab overlaps the pane must be included in the tab
+ * rectangle this overlap distance is always 3 pixels, although the
+ * 3-pixel overlap is only drawn for the front tab."
+ */
+static const int TAB_HEIGHT = 21;
+static const int TAB_OVERLAP = 3;
+
+static void TabElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *heightPtr = TAB_HEIGHT + TAB_OVERLAP - 1;
+}
+
+static void TabElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ Rect bounds = BoxToRect(b);
+ bounds.bottom += TAB_OVERLAP;
+ BEGIN_DRAWING(d)
+ DrawThemeTab(
+ &bounds, Ttk_StateTableLookup(TabStyleTable, state), kThemeTabNorth,
+ 0/*labelProc*/,0/*userData*/);
+ END_DRAWING
+}
+
+static Ttk_ElementSpec TabElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ TabElementGeometry,
+ TabElementDraw
+};
+
+/* Notebook panes:
+ */
+static void PaneElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ /* Padding determined by trial-and-error */
+ *paddingPtr = Ttk_MakePadding(2,8,2,2);
+}
+
+static void PaneElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ Rect bounds = BoxToRect(b);
+ BEGIN_DRAWING(d)
+ DrawThemeTabPane(
+ &bounds, Ttk_StateTableLookup(ThemeStateTable, state));
+ END_DRAWING
+}
+
+static Ttk_ElementSpec PaneElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ PaneElementGeometry,
+ PaneElementDraw
+};
+
+/* Labelframe borders:
+ * Use "primary group box ..."
+ * Quoth DrawThemePrimaryGroup reference:
+ * "The primary group box frame is drawn inside the specified
+ * rectangle and is a maximum of 2 pixels thick."
+ *
+ * "Maximum of 2 pixels thick" is apparently a lie;
+ * looks more like 4 to me with shading.
+ */
+static void GroupElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *paddingPtr = Ttk_UniformPadding(4);
+}
+
+static void GroupElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ Rect bounds = BoxToRect(b);
+ BEGIN_DRAWING(d)
+ DrawThemePrimaryGroup(
+ &bounds, Ttk_StateTableLookup(ThemeStateTable, state));
+ END_DRAWING
+}
+
+static Ttk_ElementSpec GroupElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ GroupElementGeometry,
+ GroupElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Entry element --
+ * 3 pixels padding for focus rectangle
+ * 2 pixels padding for EditTextFrame
+ */
+
+typedef struct {
+ Tcl_Obj *backgroundObj;
+} EntryElement;
+
+static Ttk_ElementOptionSpec EntryElementOptions[] = {
+ { "-background", TK_OPTION_BORDER,
+ Tk_Offset(EntryElement,backgroundObj), "white" },
+ {0}
+};
+
+static void EntryElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *paddingPtr = Ttk_UniformPadding(5);
+}
+
+static void EntryElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ EntryElement *e = elementRecord;
+ Tk_3DBorder backgroundPtr = Tk_Get3DBorderFromObj(tkwin,e->backgroundObj);
+ Ttk_Box inner = Ttk_PadBox(b, Ttk_UniformPadding(3));
+ Rect bounds = BoxToRect(inner);
+
+ BEGIN_DRAWING(d)
+
+ /* Erase w/background color:
+ */
+ XFillRectangle(Tk_Display(tkwin), d,
+ Tk_3DBorderGC(tkwin, backgroundPtr, TK_3D_FLAT_GC),
+ inner.x,inner.y, inner.width, inner.height);
+
+ /* Draw border:
+ */
+ DrawThemeEditTextFrame(
+ &bounds, Ttk_StateTableLookup(ThemeStateTable, state));
+
+ /* Draw focus highlight:
+ */
+ if (state & TTK_STATE_FOCUS)
+ DrawThemeFocusRect(&bounds, 1);
+
+ END_DRAWING
+}
+
+static Ttk_ElementSpec EntryElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(EntryElement),
+ EntryElementOptions,
+ EntryElementGeometry,
+ EntryElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Pop-up arrow (for comboboxes)
+ * NOTE: This isn't right at all, but I can't find the correct
+ * function in the Appearance Manager reference.
+ */
+
+static void PopupArrowElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *widthPtr = 12; /* wild-assed guess */
+ *heightPtr = 12; /* wild-assed guess */
+}
+
+static void PopupArrowElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ Rect bounds = BoxToRect(b);
+
+ ThemeButtonParms *parms = clientData;
+ ThemeButtonDrawInfo info = computeButtonDrawInfo(parms, state);
+
+ bounds.left -= 6;
+ bounds.top -= 3;
+ bounds.right -= 6;
+ bounds.bottom -= 2;
+
+ BEGIN_DRAWING(d)
+ DrawThemeButton(&bounds, kThemeArrowButton, &info,
+ NULL/*prevInfo*/,NULL/*eraseProc*/,NULL/*labelProc*/,0/*userData*/);
+
+ bounds = BoxToRect(Ttk_PadBox(b, ButtonMargins));
+ bounds.top += 2;
+ bounds.bottom += 2;
+ bounds.left -= 2;
+ bounds.right -= 2;
+
+ DrawThemePopupArrow(&bounds,
+ kThemeArrowDown,
+ kThemeArrow9pt, /* ??? */
+ Ttk_StateTableLookup(ThemeStateTable, state),
+ NULL /*eraseProc*/,0/*eraseData*/);
+ END_DRAWING
+}
+
+static Ttk_ElementSpec PopupArrowElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ PopupArrowElementGeometry,
+ PopupArrowElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ DrawThemeTrack-based elements --
+ * Progress bars and scales. (See also: <<NOTE-TRACKS>>)
+ */
+
+static Ttk_StateTable ThemeTrackEnableTable[] = {
+ { kThemeTrackDisabled, TTK_STATE_DISABLED, 0 },
+ { kThemeTrackInactive, TTK_STATE_BACKGROUND, 0 },
+ { kThemeTrackActive, 0, 0 }
+ /* { kThemeTrackNothingToScroll, ?, ? }, */
+};
+
+typedef struct { /* TrackElement client data */
+ ThemeTrackKind kind;
+ SInt32 thicknessMetric;
+} TrackElementData;
+
+static TrackElementData ScaleData =
+ { kThemeSlider, kThemeMetricHSliderHeight };
+
+typedef struct {
+ Tcl_Obj *fromObj; /* minimum value */
+ Tcl_Obj *toObj; /* maximum value */
+ Tcl_Obj *valueObj; /* current value */
+ Tcl_Obj *orientObj; /* horizontal / vertical */
+} TrackElement;
+
+static Ttk_ElementOptionSpec TrackElementOptions[] = {
+ { "-from", TK_OPTION_DOUBLE, Tk_Offset(TrackElement,fromObj) },
+ { "-to", TK_OPTION_DOUBLE, Tk_Offset(TrackElement,toObj) },
+ { "-value", TK_OPTION_DOUBLE, Tk_Offset(TrackElement,valueObj) },
+ { "-orient", TK_OPTION_STRING, Tk_Offset(TrackElement,orientObj) },
+ {0,0,0}
+};
+
+static void TrackElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TrackElementData *data = clientData;
+ SInt32 size = 24; /* reasonable default ... */
+ GetThemeMetric(data->thicknessMetric, &size);
+ *widthPtr = *heightPtr = size;
+}
+
+static void TrackElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ TrackElementData *data = clientData;
+ TrackElement *elem = elementRecord;
+ double from = 0, to = 100, value = 0;
+ int orientation = TTK_ORIENT_HORIZONTAL;
+ ThemeTrackDrawInfo drawInfo;
+
+ Tcl_GetDoubleFromObj(NULL, elem->fromObj, &from);
+ Tcl_GetDoubleFromObj(NULL, elem->toObj, &to);
+ Tcl_GetDoubleFromObj(NULL, elem->valueObj, &value);
+ Ttk_GetOrientFromObj(NULL, elem->orientObj, &orientation);
+
+ /* @@@ BUG: min, max, and value should account for resolution:
+ * @@@ if finer than 1.0, conversion to int breaks.
+ */
+ drawInfo.kind = data->kind;
+ drawInfo.bounds = BoxToRect(b);
+ drawInfo.min = (int)from; /* @@@ */
+ drawInfo.max = (int)to; /* @@@ */
+ drawInfo.value = (int)value; /* @@@ */
+
+ drawInfo.attributes = orientation == TTK_ORIENT_HORIZONTAL
+ ? kThemeTrackHorizontal : 0;
+ drawInfo.attributes |= kThemeTrackShowThumb;
+ drawInfo.enableState = Ttk_StateTableLookup(ThemeTrackEnableTable, state);
+
+ switch (data->kind) {
+ case kThemeProgressBar:
+ drawInfo.trackInfo.progress.phase = 0; /* 1-4: animation phase */
+ break;
+ case kThemeSlider:
+ drawInfo.trackInfo.slider.pressState = 0; /* @@@ fill this in */
+ drawInfo.trackInfo.slider.thumbDir = kThemeThumbPlain;
+ /* kThemeThumbUpward, kThemeThumbDownward, kThemeThumbPlain */
+ break;
+ }
+
+ BEGIN_DRAWING(d)
+ DrawThemeTrack(&drawInfo,
+ NULL/*rgnGhost*/,NULL/*eraseProc*/,0/*eraseData*/);
+ END_DRAWING
+}
+
+static Ttk_ElementSpec TrackElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(TrackElement),
+ TrackElementOptions,
+ TrackElementGeometry,
+ TrackElementDraw
+};
+
+
+/* Slider element -- <<NOTE-TRACKS>>
+ * Has geometry only. The Scale widget adjusts the position of this element,
+ * and uses it for hit detection. In the Aqua theme, the slider is actually
+ * drawn as part of the trough element.
+ *
+ * Also buggy: The geometry here is a Wild-Assed-Guess; I can't
+ * figure out how to get the Appearance Manager to tell me the
+ * slider size.
+ */
+static void SliderElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *widthPtr = *heightPtr = 24;
+}
+
+static Ttk_ElementSpec SliderElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ SliderElementGeometry,
+ NullElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Progress bar element (new):
+ *
+ * @@@ NOTE: According to an older revision of the Aqua reference docs,
+ * @@@ the 'phase' field is between 0 and 4. Newer revisions say
+ * @@@ that it can be any UInt8 value.
+ */
+
+typedef struct {
+ Tcl_Obj *orientObj; /* horizontal / vertical */
+ Tcl_Obj *valueObj; /* current value */
+ Tcl_Obj *maximumObj; /* maximum value */
+ Tcl_Obj *phaseObj; /* animation phase */
+ Tcl_Obj *modeObj; /* progress bar mode */
+} PbarElement;
+
+static Ttk_ElementOptionSpec PbarElementOptions[] = {
+ { "-orient", TK_OPTION_STRING,
+ Tk_Offset(PbarElement,orientObj), "horizontal" },
+ { "-value", TK_OPTION_DOUBLE,
+ Tk_Offset(PbarElement,valueObj), "0" },
+ { "-maximum", TK_OPTION_DOUBLE,
+ Tk_Offset(PbarElement,maximumObj), "100" },
+ { "-phase", TK_OPTION_INT,
+ Tk_Offset(PbarElement,phaseObj), "0" },
+ { "-mode", TK_OPTION_STRING,
+ Tk_Offset(PbarElement,modeObj), "determinate" },
+ {0,0,0,0}
+};
+
+static void PbarElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SInt32 size = 24; /* @@@ Check HIG for correct default */
+ GetThemeMetric(kThemeMetricLargeProgressBarThickness, &size);
+ *widthPtr = *heightPtr = size;
+}
+
+static void PbarElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ PbarElement *pbar = elementRecord;
+ int orientation = TTK_ORIENT_HORIZONTAL;
+ double value = 0, maximum = 100;
+ int phase = 0;
+ ThemeTrackDrawInfo drawInfo;
+
+ Ttk_GetOrientFromObj(NULL, pbar->orientObj, &orientation);
+ Tcl_GetDoubleFromObj(NULL, pbar->valueObj, &value);
+ Tcl_GetDoubleFromObj(NULL, pbar->maximumObj, &maximum);
+ Tcl_GetIntFromObj(NULL, pbar->phaseObj, &phase);
+
+ if (!strcmp("indeterminate", Tcl_GetString(pbar->modeObj)) && value) {
+ drawInfo.kind = kThemeIndeterminateBar;
+ } else {
+ drawInfo.kind = kThemeProgressBar;
+ }
+ drawInfo.bounds = BoxToRect(b);
+ drawInfo.min = 0;
+ drawInfo.max = (int)maximum; /* @@@ See note above */
+ drawInfo.value = (int)value;
+ drawInfo.attributes = orientation == TTK_ORIENT_HORIZONTAL
+ ? kThemeTrackHorizontal : 0;
+ drawInfo.attributes |= kThemeTrackShowThumb;
+ drawInfo.enableState = Ttk_StateTableLookup(ThemeTrackEnableTable, state);
+ drawInfo.trackInfo.progress.phase = phase;
+
+ BEGIN_DRAWING(d)
+ DrawThemeTrack(&drawInfo,
+ NULL/*rgnGhost*/,NULL/*eraseProc*/,0/*eraseData*/);
+ END_DRAWING
+}
+
+static Ttk_ElementSpec PbarElementSpec = {
+ TK_STYLE_VERSION_2,
+ sizeof(PbarElement),
+ PbarElementOptions,
+ PbarElementGeometry,
+ PbarElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Separator element.
+ *
+ * DrawThemeSeparator() guesses the orientation of the line from
+ * the width and height of the rectangle, so the same element can
+ * can be used for horizontal, vertical, and general separators.
+ */
+
+static void SeparatorElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *widthPtr = *heightPtr = 2;
+}
+
+static void SeparatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ Rect bounds = BoxToRect(b);
+
+ /* DrawThemeSeparator only supports kThemeStateActive / kThemeStateInactive
+ */
+ state &= TTK_STATE_BACKGROUND;
+ BEGIN_DRAWING(d)
+ DrawThemeSeparator(&bounds, Ttk_StateTableLookup(ThemeStateTable, state));
+ END_DRAWING
+}
+
+static Ttk_ElementSpec SeparatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ SeparatorElementSize,
+ SeparatorElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Size grip element.
+ */
+static const ThemeGrowDirection sizegripGrowDirection
+ = kThemeGrowRight|kThemeGrowDown;
+
+static void SizegripElementSize(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ Point origin;
+ Rect bounds;
+
+ origin.h = origin.v = 0;
+ GetThemeStandaloneGrowBoxBounds(
+ origin, sizegripGrowDirection, false, &bounds);
+ *widthPtr = bounds.right - bounds.left;
+ *heightPtr = bounds.bottom - bounds.top;
+}
+
+static void SizegripElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ Point origin;
+ origin.h = b.x; origin.v = b.y;
+
+ /* Grow box only supports kThemeStateActive, kThemeStateInactive */
+ state &= TTK_STATE_BACKGROUND;
+
+ BEGIN_DRAWING(d)
+ DrawThemeStandaloneGrowBox(
+ origin, sizegripGrowDirection, false,
+ Ttk_StateTableLookup(ThemeStateTable, state));
+ END_DRAWING
+}
+
+static Ttk_ElementSpec SizegripElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ SizegripElementSize,
+ SizegripElementDraw
+};
+
+
+/*----------------------------------------------------------------------
+ * +++ Background element -- an experiment.
+ *
+ * This isn't quite right: In Aqua, the correct background for
+ * a control depends on what kind of container it belongs to,
+ * and the type of the top-level window.
+ *
+ * Also: patterned backgrounds should be aligned with the coordinate
+ * system of the top-level window. Since we're drawing into an
+ * off-screen graphics port with its own coordinate system,
+ * this leads to alignment glitches.
+ *
+ * Available kTheme constants:
+ * kThemeBackgroundTabPane,
+ * kThemeBackgroundPlacard,
+ * kThemeBackgroundWindowHeader,
+ * kThemeBackgroundListViewWindowHeader,
+ * kThemeBackgroundSecondaryGroupBox,
+ *
+ * GetThemeBrush() and SetThemeBackground() offer more choices.
+ *
+ */
+
+static void BackgroundElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ ThemeBackgroundKind kind = kThemeBackgroundWindowHeader;
+ Rect bounds;
+ SInt32 depth = 32; /* ??? */
+ Boolean inColor = true;
+ Point origin;
+
+ /* Avoid kThemeStatePressed, which seems to give bad results
+ * for ApplyThemeBackground:
+ */
+ state &= ~TTK_STATE_PRESSED;
+
+ TkMacOSXWinBounds((TkWindow *) tkwin, &bounds);
+ origin.v = -bounds.top;
+ origin.h = -bounds.left;
+
+ bounds.top = bounds.left = 0;
+ bounds.right = Tk_Width(tkwin);
+ bounds.bottom = Tk_Height(tkwin);
+
+ BEGIN_DRAWING(d)
+ ApplyThemeBackground(kind, &bounds,
+ Ttk_StateTableLookup(ThemeStateTable, state),
+ depth, inColor);
+ QDSetPatternOrigin(origin);
+ EraseRect(&bounds);
+ END_DRAWING
+}
+
+static Ttk_ElementSpec BackgroundElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ NullElementGeometry,
+ BackgroundElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ ToolbarBackground element -- toolbar style for frames.
+ *
+ * This is very similar to the normal background element, but uses a
+ * different ThemeBrush in order to get the lighter pinstripe effect
+ * used in toolbars. We use SetThemeBackground() rather than
+ * ApplyThemeBackground() in order to get the right style.
+ *
+ * <URL: http://developer.apple.com/documentation/Carbon/Reference/
+ * Appearance_Manager/appearance_manager/constant_7.html#/
+ * /apple_ref/doc/uid/TP30000243/C005321>
+ *
+ */
+static void ToolbarBackgroundElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ ThemeBrush brush = kThemeBrushToolbarBackground;
+ Rect bounds;
+ SInt32 depth = 32; /* ??? */
+ Boolean inColor = true;
+
+ bounds.top = bounds.left = 0;
+ bounds.right = Tk_Width(tkwin);
+ bounds.bottom = Tk_Height(tkwin);
+
+ BEGIN_DRAWING(d)
+ SetThemeBackground(brush,
+ depth, inColor);
+ EraseRect(&bounds);
+ END_DRAWING
+}
+
+static Ttk_ElementSpec ToolbarBackgroundElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ NullElementGeometry,
+ ToolbarBackgroundElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Treeview header
+ * Redefine the header to use a kThemeListHeaderButton.
+ */
+
+static Ttk_StateTable TreeHeaderAdornmentTable[] = {
+ { kThemeAdornmentHeaderButtonSortUp, TTK_STATE_ALTERNATE, 0 },
+ { kThemeAdornmentFocus, TTK_STATE_FOCUS, 0 },
+ { kThemeAdornmentNone, 0, 0 }
+};
+
+static void TreeHeaderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, Ttk_State state)
+{
+ Rect bounds = BoxToRect(b);
+ ThemeButtonParms *parms = clientData;
+ ThemeButtonDrawInfo info;
+
+ info.state = Ttk_StateTableLookup(ThemeStateTable, state);
+ info.value = Ttk_StateTableLookup(ButtonValueTable, state);
+ info.adornment = Ttk_StateTableLookup(TreeHeaderAdornmentTable, state);
+
+ BEGIN_DRAWING(d)
+ DrawThemeButton(&bounds, parms->kind, &info,
+ NULL/*prevInfo*/,NULL/*eraseProc*/,NULL/*labelProc*/,0/*userData*/);
+ END_DRAWING
+}
+
+static Ttk_ElementSpec TreeHeaderElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ ButtonElementGeometryNoPadding,
+ TreeHeaderElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Widget layouts.
+ */
+TTK_BEGIN_LAYOUT(ToolbarLayout)
+ TTK_NODE("Toolbar.background", TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(ButtonLayout)
+ TTK_GROUP("Button.button", TTK_FILL_BOTH,
+ TTK_GROUP("Button.padding", TTK_FILL_BOTH,
+ TTK_NODE("Button.label", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(RadiobuttonLayout)
+ TTK_GROUP("Radiobutton.button", TTK_FILL_BOTH,
+ TTK_GROUP("Radiobutton.padding", TTK_FILL_BOTH,
+ TTK_NODE("Radiobutton.label", TTK_PACK_LEFT)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(CheckbuttonLayout)
+ TTK_GROUP("Checkbutton.button", TTK_FILL_BOTH,
+ TTK_GROUP("Checkbutton.padding", TTK_FILL_BOTH,
+ TTK_NODE("Checkbutton.label", TTK_PACK_LEFT)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(MenubuttonLayout)
+ TTK_GROUP("Menubutton.button", TTK_FILL_BOTH,
+ TTK_GROUP("Menubutton.padding", TTK_FILL_BOTH,
+ TTK_NODE("Menubutton.label", TTK_PACK_LEFT)))
+TTK_END_LAYOUT
+
+/* Notebook tabs -- no focus ring */
+TTK_BEGIN_LAYOUT(TabLayout)
+ TTK_GROUP("Notebook.tab", TTK_FILL_BOTH,
+ TTK_GROUP("Notebook.padding", TTK_EXPAND|TTK_FILL_BOTH,
+ TTK_NODE("Notebook.label", TTK_EXPAND|TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+/* Progress bars -- track only */
+TTK_BEGIN_LAYOUT(ProgressbarLayout)
+ TTK_NODE("Progressbar.track", TTK_EXPAND|TTK_FILL_BOTH)
+TTK_END_LAYOUT
+
+/* Tree heading -- no border, fixed height */
+TTK_BEGIN_LAYOUT(TreeHeadingLayout)
+ TTK_NODE("Treeheading.cell", TTK_FILL_X)
+ TTK_NODE("Treeheading.image", TTK_PACK_RIGHT)
+ TTK_NODE("Treeheading.text", 0)
+TTK_END_LAYOUT
+
+/*----------------------------------------------------------------------
+ * +++ Initialization.
+ */
+
+int AquaTheme_Init(Tcl_Interp *interp)
+{
+ Ttk_Theme themePtr = Ttk_CreateTheme(interp, "aqua", NULL);
+
+ if (!themePtr) {
+ return TCL_ERROR;
+ }
+
+ /* Elements:
+ */
+ Ttk_RegisterElementSpec(themePtr,"background",&BackgroundElementSpec,0);
+ Ttk_RegisterElementSpec(themePtr,"Toolbar.background",
+ &ToolbarBackgroundElementSpec, 0);
+
+ Ttk_RegisterElementSpec(themePtr, "Button.button",
+ &ButtonElementSpec, &PushButtonParms);
+ Ttk_RegisterElementSpec(themePtr, "Checkbutton.button",
+ &ButtonElementSpec, &CheckBoxParms);
+ Ttk_RegisterElementSpec(themePtr, "Radiobutton.button",
+ &ButtonElementSpec, &RadioButtonParms);
+ Ttk_RegisterElementSpec(themePtr, "Toolbutton.border",
+ &ButtonElementSpec, &BevelButtonParms);
+ Ttk_RegisterElementSpec(themePtr, "Menubutton.button",
+ &ButtonElementSpec, &PopupButtonParms);
+ Ttk_RegisterElementSpec(themePtr, "Treeheading.cell",
+ &TreeHeaderElementSpec, &ListHeaderParms);
+
+ Ttk_RegisterElementSpec(themePtr, "Notebook.tab", &TabElementSpec, 0);
+ Ttk_RegisterElementSpec(themePtr, "Notebook.client", &PaneElementSpec, 0);
+
+ Ttk_RegisterElementSpec(themePtr, "Labelframe.border",&GroupElementSpec,0);
+ Ttk_RegisterElementSpec(themePtr, "Entry.field",&EntryElementSpec,0);
+
+ Ttk_RegisterElementSpec(themePtr, "Combobox.field",&EntryElementSpec,0);
+ Ttk_RegisterElementSpec(themePtr, "Combobox.downarrow",
+ &PopupArrowElementSpec, 0);
+
+ Ttk_RegisterElementSpec(themePtr, "separator",&SeparatorElementSpec,0);
+ Ttk_RegisterElementSpec(themePtr, "hseparator",&SeparatorElementSpec,0);
+ Ttk_RegisterElementSpec(themePtr, "vseparator",&SeparatorElementSpec,0);
+
+ Ttk_RegisterElementSpec(themePtr, "sizegrip",&SizegripElementSpec,0);
+
+ /* <<NOTE-TRACKS>>
+ * The Progressbar widget adjusts the size of the pbar element.
+ * In the Aqua theme, the appearance manager computes the bar geometry;
+ * we do all the drawing in the ".track" element and leave the .pbar out.
+ */
+ Ttk_RegisterElementSpec(themePtr,"Scale.trough",
+ &TrackElementSpec, &ScaleData);
+ Ttk_RegisterElementSpec(themePtr,"Scale.slider",&SliderElementSpec,0);
+ Ttk_RegisterElementSpec(themePtr,"Progressbar.track", &PbarElementSpec, 0);
+
+ /* Layouts:
+ */
+ Ttk_RegisterLayout(themePtr, "Toolbar", ToolbarLayout);
+ Ttk_RegisterLayout(themePtr, "TButton", ButtonLayout);
+ Ttk_RegisterLayout(themePtr, "TCheckbutton", CheckbuttonLayout);
+ Ttk_RegisterLayout(themePtr, "TRadiobutton", RadiobuttonLayout);
+ Ttk_RegisterLayout(themePtr, "TMenubutton", MenubuttonLayout);
+ Ttk_RegisterLayout(themePtr, "TProgressbar", ProgressbarLayout);
+ Ttk_RegisterLayout(themePtr, "TNotebook.Tab", TabLayout);
+ Ttk_RegisterLayout(themePtr, "Heading", TreeHeadingLayout);
+
+ Tcl_PkgProvide(interp, "ttk::theme::aqua", TTK_VERSION);
+ return TCL_OK;
+}
+
+int Ttk_MacPlatformInit(Tcl_Interp *interp)
+{
+ return AquaTheme_Init(interp);
+}
+
diff --git a/tests/ttk/all.tcl b/tests/ttk/all.tcl
new file mode 100644
index 0000000..75aa035
--- /dev/null
+++ b/tests/ttk/all.tcl
@@ -0,0 +1,15 @@
+#
+# source all tests.
+#
+package require tcltest 2.1
+
+package require Tk 8.5 ;# This is the Tk test suite; fail early if no Tk!
+
+tcltest::configure -testdir [file join [pwd] [file dirname [info script]]]
+
+eval tcltest::configure $::argv
+tcltest::runAllTests
+
+if {![catch { package present Tk }]} {
+ destroy .
+}
diff --git a/tests/ttk/bwidget.test b/tests/ttk/bwidget.test
new file mode 100644
index 0000000..f371daf
--- /dev/null
+++ b/tests/ttk/bwidget.test
@@ -0,0 +1,101 @@
+#
+# Test BWidget / Ttk compatibility.
+#
+# NOTE: This part of the test suite is no longer operative:
+# [namespace import -force ttk::*] is not expected or intended to work.
+#
+# Keeping the file around for now since it contains some historical
+# information about how ttk *tried* to make it work, and what
+# sort of things went wrong.
+#
+
+package require Tk 8.5
+package require tcltest
+tcltest::cleanupTests ; return
+
+loadTestedCommands
+
+set have_compat 0
+if {![catch {ttk::pkgconfig get compat} compat]} {set have_compat $compat}
+testConstraint bwidget [expr {$have_compat && ![catch {package require BWidget}]}]
+
+test bwidget-1.0 "Setup for BWidget test" -constraints bwidget -body {
+ namespace import -force ttk::*
+ puts "Loaded BWidget version [package provide BWidget]"
+}
+
+test bwidget-1.1 "Make Label widget" -constraints bwidget -body {
+ pack [Label .w]
+} -cleanup {destroy .w}
+
+test bwidget-1.2 "Make ScrolledWindow widget" -constraints bwidget -body {
+ pack [ScrolledWindow .w -auto both -scrollbar vertical]
+} -cleanup {destroy .w}
+
+test bwidget-1.3 "Make PagesManager widget" -constraints bwidget -body {
+ pack [PagesManager .w]
+} -cleanup {destroy .w}
+
+#
+# ProgressBar: this one fails with 'unknown color name "xxx"',
+# where "xxx" is the default value of some other option
+# (variously, "4m", "100", something else).
+#
+# Update: fixed now. Source of problem: widgets were using "unused"
+# as the resource database name for compatibility options;
+# BWidgets keys off the db name instead of the option name.
+#
+test bwidget-1.4 "Make ProgressBar widget" -constraints bwidget -body {
+ pack [ProgressBar .w]
+} -cleanup {destroy .w}
+
+# @@@ TODO: full BWidget coverage,
+# @@@ not just the ones people have reported problems with.
+
+
+#
+# <<NOTE-NULLOPTIONS>>:
+#
+# TK_OPTION_NULL_OK doesn't work for TK_OPTION_INT (among others);
+# see Bug #967209.
+#
+# This means that [.l configure -width [.l cget -width]] -- which is
+# essentially what BWidgets does -- will raise an error if -width has
+# a NULL default.
+#
+# Temporary workaround: declare -width, etc. as TK_OPTION_STRING instead.
+# This disables typechecking in the 'configure' method, but it seems
+# to be the best way to avoid the BWidget incompatibility for now.
+#
+test nulloptions-1.1 "Test null options" -body {
+ ttk::label .tl
+ .tl configure -width [.tl cget -width]
+} -cleanup { destroy .tl }
+
+#
+# <<NOTE-NULLOPTIONS-2>> This also means we have to (partially) disable
+# the widget option / element option consistency checks.
+#
+test nulloptions-1.2 "Ensure workaround doesn't break -width" -body {
+ ttk::label .tl -text "x" -width 0
+ set w1 [winfo reqwidth .tl]
+ .tl configure -width 10
+ set w2 [winfo reqwidth .tl]
+ expr {$w2 > $w1}
+} -result 1 -cleanup { destroy .tl }
+
+test nulloptions-1.3 "Exhaustive test" -body {
+ set readonlyOpts [list -class]
+ foreach widget $::ttk::widgets {
+ #puts "$widget"
+ ttk::$widget .w
+ foreach configspec [.w configure] {
+ set option [lindex $configspec 0]
+ if {[lsearch -exact $readonlyOpts $option] >= 0} { continue }
+ .w configure $option [.w cget $option]
+ }
+ destroy .w
+ }
+}
+
+tcltest::cleanupTests
diff --git a/tests/ttk/combobox.test b/tests/ttk/combobox.test
new file mode 100644
index 0000000..3c20bd3
--- /dev/null
+++ b/tests/ttk/combobox.test
@@ -0,0 +1,48 @@
+#
+# Tile package: combobox widget tests
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+test combobox-1.0 "Combobox tests -- setup" -body {
+ ttk::combobox .cb
+} -result .cb
+
+test combobox-1.1 "Bad -values list" -body {
+ .cb configure -values "bad \{list"
+} -result "unmatched open brace in list" -returnCodes 1
+
+test combobox-1.end "Combobox tests -- cleanup" -body {
+ destroy .cb
+}
+
+test combobox-2.0 "current command" -body {
+ ttk::combobox .cb -values [list a b c d e a]
+ .cb current
+} -result -1
+
+test combobox-2.1 "current -- set index" -body {
+ .cb current 5
+ .cb get
+} -result a
+
+test combobox-2.2 "current -- change -values" -body {
+ .cb configure -values [list c b a d e]
+ .cb current
+} -result 2
+
+test combobox-2.3 "current -- change value" -body {
+ .cb set "b"
+ .cb current
+} -result 1
+
+test combobox-2.4 "current -- value not in list" -body {
+ .cb set "z"
+ .cb current
+} -result -1
+
+test combobox-end "Cleanup" -body { destroy .cb }
+
+tcltest::cleanupTests
diff --git a/tests/ttk/entry.test b/tests/ttk/entry.test
new file mode 100644
index 0000000..0e7acd2
--- /dev/null
+++ b/tests/ttk/entry.test
@@ -0,0 +1,262 @@
+#
+# Tile package: entry widget tests
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+variable scrollInfo
+proc scroll args {
+ global scrollInfo
+ set scrollInfo $args
+}
+
+# Some of the tests raise background errors;
+# override default bgerror to catch them.
+#
+variable bgerror ""
+proc bgerror {error} {
+ variable bgerror $error
+ variable bgerrorInfo $::errorInfo
+ variable bgerrorCode $::errorCode
+}
+
+#
+test entry-1.1 "Create entry widget" -body {
+ ttk::entry .e
+} -result .e
+
+test entry-1.2 "Insert" -body {
+ .e insert end abcde
+ .e get
+} -result abcde
+
+test entry-1.3 "Selection" -body {
+ .e selection range 1 3
+ selection get
+} -result bc
+
+test entry-1.4 "Delete" -body {
+ .e delete 1 3
+ .e get
+} -result ade
+
+test entry-1.5 "Deletion - insert cursor" -body {
+ .e insert end abcde
+ .e icursor 0
+ .e delete 0 end
+ .e index insert
+} -result 0
+
+test entry-1.6 "Deletion - insert cursor at end" -body {
+ .e insert end abcde
+ .e icursor end
+ .e delete 0 end
+ .e index insert
+} -result 0
+
+test entry-1.7 "Deletion - insert cursor in the middle " -body {
+ .e insert end abcde
+ .e icursor 3
+ .e delete 0 end
+ .e index insert
+} -result 0
+
+test entry-1.done "Cleanup" -body { destroy .e }
+
+# Scrollbar tests.
+
+test entry-2.1 "Create entry before scrollbar" -body {
+ pack [ttk::entry .te -xscrollcommand [list .tsb set]] \
+ -expand true -fill both
+ pack [ttk::scrollbar .tsb -orient horizontal -command [list .te xview]] \
+ -expand false -fill x
+} -cleanup {destroy .te .tsb}
+
+test entry-2.2 "Initial scroll position" -body {
+ ttk::entry .e -font fixed -width 5 -xscrollcommand scroll
+ .e insert end "0123456789"
+ pack .e; update idletasks
+ set scrollInfo
+} -result {0 0.5} -cleanup { destroy .e }
+# NOTE: result can vary depending on font.
+
+# Bounding box / scrolling tests.
+test entry-3.0 "Series 3 setup" -body {
+ ttk::style theme use default
+ variable fixed fixed
+ variable cw [font measure $fixed a]
+ variable ch [font metrics $fixed -linespace]
+ variable bd 2 ;# border + padding
+ variable ux [font measure $fixed \u4e4e]
+
+ pack [ttk::entry .e -font $fixed -width 20]
+ update
+}
+
+test entry-3.1 "bbox widget command" -body {
+ .e delete 0 end
+ .e bbox 0
+} -result [list $bd $bd 0 $ch]
+
+test entry-3.2 "xview" -body {
+ .e delete 0 end;
+ .e insert end [string repeat "M" 40]
+ update idletasks
+ set result [.e xview]
+} -result {0 0.5}
+
+test entry-3.last "Series 3 cleanup" -body {
+ destroy .e
+}
+
+# Selection tests:
+
+test entry-4.0 "Selection test - setup" -body {
+ ttk::entry .e
+ .e insert end asdfasdf
+ .e selection range 0 end
+}
+
+test entry-4.1 "Selection test" -body {
+ selection get
+} -result asdfasdf
+
+test entry-4.2 "Disable -exportselection" -body {
+ .e configure -exportselection false
+ selection get
+} -returnCodes error -result "PRIMARY selection doesn't exist*" -match glob
+
+test entry-4.3 "Reenable -exportselection" -body {
+ .e configure -exportselection true
+ selection get
+} -result asdfasdf
+
+test entry-4.4 "Force selection loss" -body {
+ selection own .
+ .e index sel.first
+} -returnCodes error -result "selection isn't in widget .e"
+
+test entry-4.5 "Allow selection changes if readonly" -body {
+ .e delete 0 end
+ .e insert end 0123456789
+ .e selection range 0 end
+ .e configure -state readonly
+ .e selection range 2 4
+ .e configure -state normal
+ list [.e index sel.first] [.e index sel.last]
+} -result {2 4}
+
+test entry-4.6 "Disallow selection changes if disabled" -body {
+ .e delete 0 end
+ .e insert end 0123456789
+ .e selection range 0 end
+ .e configure -state disabled
+ .e selection range 2 4
+ .e configure -state normal
+ list [.e index sel.first] [.e index sel.last]
+} -result {0 10}
+
+test entry-4.7 {sel.first and sel.last gravity} -body {
+ set result [list]
+ .e delete 0 end
+ .e insert 0 0123456789
+ .e select range 2 6
+ .e insert 2 XXX
+ lappend result [.e index sel.first] [.e index sel.last]
+ .e insert 6 YYY
+ lappend result [.e index sel.first] [.e index sel.last] [.e get]
+} -result {5 9 5 12 01XXX2YYY3456789}
+
+# Self-destruct tests.
+
+test entry-5.1 {widget deletion while active} -body {
+ destroy .e
+ pack [ttk::entry .e]
+ update
+ .e config -xscrollcommand { destroy .e }
+ update idletasks
+ winfo exists .e
+} -result 0
+
+# TODO: test killing .e in -validatecommand, -invalidcommand, variable trace;
+
+
+# -textvariable tests.
+
+test entry-6.1 {Update linked variable in write trace} -body {
+ proc override args {
+ global x
+ set x "Overridden!"
+ }
+ catch {destroy .e}
+ set x ""
+ trace variable x w override
+ ttk::entry .e -textvariable x
+ .e insert 0 "Some text"
+ set result [list $x [.e get]]
+ set result
+} -result {Overridden! Overridden!} -cleanup {
+ unset x
+ rename override {}
+ destroy .e
+}
+
+test entry-6.2 {-textvariable tests} -body {
+ set result [list]
+ ttk::entry .e -textvariable x
+ set x "text"
+ lappend result [.e get]
+ unset x
+ lappend result [.e get]
+ .e insert end "newtext"
+ lappend result [.e get] [set x]
+} -result [list "text" "" "newtext" "newtext"] -cleanup {
+ destroy .e
+ unset -nocomplain x
+}
+
+test entry-7.1 {Bad style options} -body {
+ ttk::style theme create entry-7.1 -settings {
+ ttk::style configure TEntry -foreground BadColor
+ ttk::style map TEntry -foreground {readonly AnotherBadColor}
+ ttk::style map TEntry -font {readonly ABadFont}
+ ttk::style map TEntry \
+ -selectbackground {{} BadColor} \
+ -selectforeground {{} BadColor} \
+ -insertcolor {{} BadColor}
+ }
+ pack [ttk::entry .e -text "Don't crash"]
+ ttk::style theme use entry-7.1
+ update
+ .e selection range 0 end
+ update
+ .e state readonly;
+ update
+} -cleanup { destroy .e ; ttk::style theme use default }
+
+test entry-8.1 "Unset linked variable" -body {
+ variable foo "bar"
+ pack [ttk::entry .e -textvariable foo]
+ unset foo
+ .e insert end "baz"
+ list [.e cget -textvariable] [.e get] [set foo]
+} -result [list foo "baz" "baz"] -cleanup { destroy .e }
+
+test entry-8.2 "Unset linked variable by deleting namespace" -body {
+ namespace eval ::test { variable foo "bar" }
+ pack [ttk::entry .e -textvariable ::test::foo]
+ namespace delete ::test
+ .e insert end "baz" ;# <== error here
+ list [.e cget -textvariable] [.e get] [set foo]
+} -returnCodes error -result "*parent namespace doesn't exist*" -match glob
+# '-result [list ::test::foo "baz" "baz"]' would also be sensible,
+# but Tcl namespaces don't work that way.
+
+test entry-8.2a "Followup to test 8.2" -body {
+ .e cget -textvariable
+} -result ::test::foo -cleanup { destroy .e }
+# For 8.2a, -result {} would also be sensible.
+
+tcltest::cleanupTests
diff --git a/tests/ttk/image.test b/tests/ttk/image.test
new file mode 100644
index 0000000..b1f66bd
--- /dev/null
+++ b/tests/ttk/image.test
@@ -0,0 +1,44 @@
+#
+# $Id: image.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+# catch background errors:
+#
+if {[info procs bgerror] == "bgerror"} { rename bgerror {} }
+array set BGerror { caught 0 message {} }
+proc bgerror {message} {
+ variable BGerror
+ set BGerror(caught) 1
+ set BGerror(message) $message
+}
+proc caughtbgerror {} {
+ variable BGerror
+ if {!$BGerror(caught)} {
+ error "No bgerror caught"
+ }
+ set BGerror(caught) 0
+ return $BGerror(message)
+}
+
+test image-1.1 "Bad image element" -body {
+ ttk::style element create BadImage image badimage
+ ttk::style layout BadImage { BadImage }
+ ttk::label .l -style BadImage
+ pack .l ; update
+ destroy .l
+ caughtbgerror
+} -result {image "badimage" doesn't exist}
+
+test image-1.2 "Duplicate element" -setup {
+ image create photo test.element -width 10 -height 10
+ ttk::style element create testElement image test.element
+} -body {
+ ttk::style element create testElement image test.element
+} -returnCodes 1 -result "Duplicate element testElement"
+
+#
+tcltest::cleanupTests
diff --git a/tests/ttk/labelframe.test b/tests/ttk/labelframe.test
new file mode 100644
index 0000000..1dd5573
--- /dev/null
+++ b/tests/ttk/labelframe.test
@@ -0,0 +1,134 @@
+#
+# $Id: labelframe.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+test labelframe-1.0 "Setup" -body {
+ pack [ttk::labelframe .lf] -expand true -fill both
+}
+
+test labelframe-2.1 "Can't use indirect descendant as labelwidget" -body {
+ ttk::frame .lf.t
+ ttk::checkbutton .lf.t.cb
+ .lf configure -labelwidget .lf.t.cb
+} -returnCodes 1 -result "can't *" -match glob \
+ -cleanup { destroy .lf.t } ;
+
+test labelframe-2.2 "Can't use toplevel as labelwidget" -body {
+ toplevel .lf.t
+ .lf configure -labelwidget .lf.t
+} -returnCodes 1 -result "can't *" -match glob \
+ -cleanup { destroy .lf.t } ;
+
+test labelframe-2.3 "Can't use non-windows as -labelwidget" -body {
+ .lf configure -labelwidget BogusWindowName
+} -returnCodes 1 -result {bad window path name "BogusWindowName"}
+
+test labelframe-2.4 "Can't use nonexistent-windows as -labelwidget" -body {
+ .lf configure -labelwidget .nosuchwindow
+} -returnCodes 1 -result {bad window path name ".nosuchwindow"}
+
+
+###
+# See also series labelframe-4.x
+#
+test labelframe-3.1 "Add child slave" -body {
+ checkbutton .lf.cb -text "abcde"
+ .lf configure -labelwidget .lf.cb
+ list [update; winfo viewable .lf.cb] [winfo manager .lf.cb]
+} -result [list 1 labelframe]
+
+test labelframe-3.2 "Remove child slave" -body {
+ .lf configure -labelwidget {}
+ list [update; winfo viewable .lf.cb] [winfo manager .lf.cb]
+} -result [list 0 {}]
+
+test labelframe-3.3 "Re-add child slave" -body {
+ .lf configure -labelwidget .lf.cb
+ list [update; winfo viewable .lf.cb] [winfo manager .lf.cb]
+} -result [list 1 labelframe]
+
+test labelframe-3.4 "Re-manage child slave" -body {
+ pack .lf.cb -side right
+ list [update; winfo viewable .lf.cb] [winfo manager .lf.cb] [.lf cget -labelwidget]
+} -result [list 1 pack {}]
+
+test labelframe-3.5 "Re-add child slave" -body {
+ .lf configure -labelwidget .lf.cb
+ list [update; winfo viewable .lf.cb] [winfo manager .lf.cb]
+} -result [list 1 labelframe]
+
+test labelframe-3.6 "Destroy child slave" -body {
+ destroy .lf.cb
+ .lf cget -labelwidget
+} -result {}
+
+###
+# Re-run series labelframe-3.x with nonchild slaves.
+#
+# @@@ ODDITY, 14 Nov 2005:
+# @@@ labelframe-4.1 fails if .cb is a [checkbutton],
+# @@@ but seems to succeed if it's some other widget class.
+# @@@ I suspect a race condition; unable to track it down ATM.
+#
+# @@@ FOLLOWUP: This *may* have been caused by a bug in ManagerIdleProc
+# @@@ (see manager.c r1.11). There's still probably a race condition in here.
+#
+test labelframe-4.1 "Add nonchild slave" -body {
+ checkbutton .cb -text "abcde"
+ .lf configure -labelwidget .cb
+ update
+ list [winfo ismapped .cb] [winfo viewable .cb] [winfo manager .cb]
+
+} -result [list 1 1 labelframe]
+
+test labelframe-4.2 "Remove nonchild slave" -body {
+ .lf configure -labelwidget {}
+ update;
+ list [winfo ismapped .cb] [winfo viewable .cb] [winfo manager .cb]
+} -result [list 0 0 {}]
+
+test labelframe-4.3 "Re-add nonchild slave" -body {
+ .lf configure -labelwidget .cb
+ list [update; winfo viewable .cb] [winfo manager .cb]
+} -result [list 1 labelframe]
+
+test labelframe-4.4 "Re-manage nonchild slave" -body {
+ pack .cb -side right
+ list [update; winfo viewable .cb] \
+ [winfo manager .cb] \
+ [.lf cget -labelwidget]
+} -result [list 1 pack {}]
+
+test labelframe-4.5 "Re-add nonchild slave" -body {
+ .lf configure -labelwidget .cb
+ list [update; winfo viewable .cb] \
+ [winfo manager .cb] \
+ [.lf cget -labelwidget]
+} -result [list 1 labelframe .cb]
+
+test labelframe-4.6 "Destroy nonchild slave" -body {
+ destroy .cb
+ .lf cget -labelwidget
+} -result {}
+
+test labelframe-5.0 "Cleanup" -body {
+ destroy .lf
+}
+
+# 1342876 -- labelframe should raise sibling -labelwidget above self.
+#
+test labelframe-6.1 "Stacking order" -body {
+ toplevel .t
+ pack [ttk::checkbutton .t.x1]
+ pack [ttk::labelframe .t.lf -labelwidget [ttk::label .t.lb]]
+ pack [ttk::checkbutton .t.x2]
+ winfo children .t
+} -cleanup {
+ destroy .t
+} -result [list .t.x1 .t.lf .t.lb .t.x2]
+
+tcltest::cleanupTests
diff --git a/tests/ttk/layout.test b/tests/ttk/layout.test
new file mode 100644
index 0000000..4b69b3c
--- /dev/null
+++ b/tests/ttk/layout.test
@@ -0,0 +1,29 @@
+#
+# $Id: layout.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+test layout-1.1 "Size computations for mixed-orientation layouts" -body {
+ ttk::style theme use default
+
+ set block [image create photo -width 10 -height 10]
+ ttk::style element create block image $block
+ ttk::style layout Blocks {
+ border -children { block } -side left
+ border -children { block } -side top
+ border -children { block } -side bottom
+ }
+ ttk::style configure Blocks -borderwidth 1 -relief raised
+ ttk::button .b -style Blocks
+
+ pack .b -expand true -fill both
+
+ list [winfo reqwidth .b] [winfo reqheight .b]
+
+} -cleanup { destroy .b } -result [list 24 24]
+
+
+tcltest::cleanupTests
diff --git a/tests/ttk/misc.test b/tests/ttk/misc.test
new file mode 100644
index 0000000..27b87d6
--- /dev/null
+++ b/tests/ttk/misc.test
@@ -0,0 +1,33 @@
+#
+# $Id: misc.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+test misc-1.0 "#1551500 -parent option in ttk::dialog doesn't work" -body {
+ ttk::dialog .dialog -parent . -type ok \
+ -message "Something to say" -title "Let's see"
+ wm transient .dialog
+} -result . -cleanup { destroy .dialog }
+
+test misc-1.1 "ttk::dialog w/no -parent option" -body {
+ toplevel .t
+ ttk::dialog .t.dialog -type ok
+ wm transient .t.dialog
+} -result .t -cleanup { destroy .t }
+
+test misc-1.2 "Explicitly specify -parent" -body {
+ toplevel .t
+ ttk::dialog .t.dialog -type ok -parent .
+ wm transient .t.dialog
+} -result . -cleanup { destroy .t }
+
+test misc-1.3 "Nontransient dialog" -body {
+ toplevel .t
+ ttk::dialog .t.dialog -type ok -parent ""
+ wm transient .t.dialog
+} -result "" -cleanup { destroy .t }
+
+tcltest::cleanupTests
diff --git a/tests/ttk/notebook.test b/tests/ttk/notebook.test
new file mode 100644
index 0000000..ecb614a
--- /dev/null
+++ b/tests/ttk/notebook.test
@@ -0,0 +1,387 @@
+#
+# $Id: notebook.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+test notebook-1.0 "Setup" -body {
+ ttk::notebook .nb
+} -result .nb
+
+#
+# Error handling tests:
+#
+test notebook-1.1 "Cannot add ancestor" -body {
+ .nb add .
+} -returnCodes error -result "*" -match glob
+
+proc inoperative {args} {}
+
+inoperative test notebook-1.2 "Cannot add siblings" -body {
+ # This is legal now
+ .nb add [frame .sibling]
+} -returnCodes error -result "*" -match glob
+
+test notebook-1.3 "Cannot add toplevel" -body {
+ .nb add [toplevel .nb.t]
+} -cleanup {
+ destroy .t.nb
+} -returnCodes 1 -match glob -result "can't add .nb.t*"
+
+test notebook-1.4 "Try to select bad tab" -body {
+ .nb select @6000,6000
+} -returnCodes 1 -match glob -result "* not found"
+
+#
+# Now add stuff:
+#
+test notebook-2.0 "Add children" -body {
+ pack .nb -expand true -fill both
+ .nb add [frame .nb.foo] -text "Foo"
+ pack [label .nb.foo.l -text "Foo"]
+
+ .nb add [frame .nb.bar -relief raised -borderwidth 2] -text "Bar"
+ pack [label .nb.bar.l -text "Bar"]
+
+ .nb tabs
+} -result [list .nb.foo .nb.bar]
+
+test notebook-2.1 "select pane" -body {
+ .nb select .nb.foo
+ update
+ list [winfo viewable .nb.foo] [winfo viewable .nb.bar] [.nb index current]
+} -result [list 1 0 0]
+
+test notebook-2.2 "select another pane" -body {
+ .nb select 1
+ update
+ list [winfo viewable .nb.foo] [winfo viewable .nb.bar] [.nb index current]
+} -result [list 0 1 1]
+
+test notebook-2.3 "tab - get value" -body {
+ .nb tab .nb.foo -text
+} -result "Foo"
+
+test notebook-2.4 "tab - set value" -body {
+ .nb tab .nb.foo -text "Changed Foo"
+ .nb tab .nb.foo -text
+} -result "Changed Foo"
+
+test notebook-2.5 "tab - get all options" -body {
+ .nb tab .nb.foo
+} -result [list \
+ -padding 0 -sticky nsew \
+ -state normal -text "Changed Foo" -image "" -compound none -underline -1]
+
+test notebook-4.1 "Test .nb index end" -body {
+ .nb index end
+} -result 2
+
+test notebook-4.2 "'end' is not a selectable index" -body {
+ .nb select end
+} -returnCodes error -result "*" -match glob
+
+test notebook-4.3 "Select index out of range" -body {
+ .nb select 2
+} -returnCodes error -result "*" -match glob
+
+test notebook-4.4 "-padding option" -body {
+ .nb configure -padding "5 5 5 5"
+}
+
+test notebook-4.end "Cleanup test suite 1-4.*" -body { destroy .nb }
+
+test notebook-5.1 "Virtual events" -body {
+ toplevel .t
+ set ::events [list]
+ bind .t <<NotebookTabChanged>> { lappend events changed %W }
+
+ pack [set nb [ttk::notebook .t.nb]] -expand true -fill both; update
+ $nb add [frame $nb.f1]
+ $nb add [frame $nb.f2]
+ $nb add [frame $nb.f3]
+
+ $nb select $nb.f1
+ update; set events
+} -result [list changed .t.nb]
+
+test notebook-5.2 "Virtual events, continued" -body {
+ set events [list]
+ $nb select $nb.f3
+ update ; set events
+} -result [list changed .t.nb]
+# OR: [list deselected .t.nb.f1 selected .t.nb.f3 changed .t.nb]
+
+test notebook-5.3 "Disabled tabs" -body {
+ set events [list]
+ $nb tab $nb.f2 -state disabled
+ $nb select $nb.f2
+ update
+ list $events [$nb index current]
+} -result [list [list] 2]
+
+test notebook-5.4 "Reenable tab" -body {
+ set events [list]
+ $nb tab $nb.f2 -state normal
+ $nb select $nb.f2
+ update
+ list $events [$nb index current]
+} -result [list [list changed .t.nb] 1]
+
+test notebook-5.end "Virtual events, cleanup" -body { destroy .t }
+
+test notebook-6.0 "Select hidden tab" -setup {
+ set nb [ttk::notebook .nb]
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb select $nb.f2
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ $nb tab $nb.f1 -state hidden
+ lappend result [$nb tab $nb.f1 -state]
+ $nb select $nb.f1
+ lappend result [$nb tab $nb.f1 -state]
+} -result [list hidden normal]
+
+test notebook-6.1 "Hide selected tab" -setup {
+ pack [set nb [ttk::notebook .nb]] ; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f2
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+ $nb tab $nb.f2 -state hidden
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+} -result [list 1 1 2 0]
+
+# See 1370833
+test notebook-6.2 "Forget selected tab" -setup {
+ ttk::notebook .n
+ pack .n
+ label .n.l -text abc
+ .n add .n.l
+} -body {
+ update
+ after 100
+ .n forget .n.l
+ update ;# Yowch!
+} -cleanup {
+ destroy .n
+} -result {}
+
+test notebook-6.3 "Hide first tab when it's the current" -setup {
+ pack [set nb [ttk::notebook .nb]] ; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f1
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f1]
+ $nb tab $nb.f1 -state hidden
+ lappend result [$nb index current] [winfo ismapped $nb.f1]
+} -result [list 0 1 1 0]
+
+test notebook-6.4 "Forget first tab when it's the current" -setup {
+ pack [set nb [ttk::notebook .nb]] ; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f1
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f1]
+ $nb forget $nb.f1
+ lappend result [$nb index current] [winfo ismapped $nb.f1]
+} -result [list 0 1 0 0]
+
+test notebook-6.5 "Hide last tab when it's the current" -setup {
+ pack [set nb [ttk::notebook .nb]] ; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f3
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f3]
+ $nb tab $nb.f3 -state hidden
+ lappend result [$nb index current] [winfo ismapped $nb.f3]
+} -result [list 2 1 1 0]
+
+test notebook-6.6 "Forget a middle tab when it's the current" -setup {
+ pack [set nb [ttk::notebook .nb]] ; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f2
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+ $nb forget $nb.f2
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+} -result [list 1 1 1 0]
+
+test notebook-6.7 "Hide a middle tab when it's the current" -setup {
+ pack [set nb [ttk::notebook .nb]]; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f2
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+ $nb tab $nb.f2 -state hidden
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+} -result [list 1 1 2 0]
+
+test notebook-6.8 "Forget a non-current tab < current" -setup {
+ pack [set nb [ttk::notebook .nb]] ; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f2
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+ $nb forget $nb.f1
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+} -result [list 1 1 0 1]
+
+test notebook-6.9 "Hide a non-current tab < current" -setup {
+ pack [set nb [ttk::notebook .nb]] ; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f2
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+ $nb tab $nb.f1 -state hidden
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+} -result [list 1 1 1 1]
+
+test notebook-6.10 "Forget a non-current tab > current" -setup {
+ pack [set nb [ttk::notebook .nb]] ; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f2
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+ $nb forget $nb.f3
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+} -result [list 1 1 1 1]
+
+test notebook-6.11 "Hide a non-current tab > current" -setup {
+ pack [set nb [ttk::notebook .nb]]; update
+ $nb add [ttk::frame $nb.f1]
+ $nb add [ttk::frame $nb.f2]
+ $nb add [ttk::frame $nb.f3]
+ $nb select $nb.f2
+} -cleanup {
+ destroy $nb
+} -body {
+ set result [list]
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+ $nb tab $nb.f3 -state hidden
+ lappend result [$nb index current] [winfo ismapped $nb.f2]
+} -result [list 1 1 1 1]
+
+
+#
+# Insert:
+#
+unset nb
+test notebook-7.0 "insert - setup" -body {
+ pack [ttk::notebook .nb]
+ for {set i 0} {$i < 5} {incr i} {
+ .nb add [ttk::frame .nb.f$i] -text "$i"
+ }
+ .nb select .nb.f1
+ list [.nb index current] [.nb tabs]
+} -result [list 1 [list .nb.f0 .nb.f1 .nb.f2 .nb.f3 .nb.f4]]
+
+test notebook-7.1 "insert - move backwards" -body {
+ .nb insert 1 3
+ list [.nb index current] [.nb tabs]
+} -result [list 2 [list .nb.f0 .nb.f3 .nb.f1 .nb.f2 .nb.f4]]
+
+test notebook-7.2 "insert - move backwards again" -body {
+ .nb insert 1 3
+ list [.nb index current] [.nb tabs]
+} -result [list 3 [list .nb.f0 .nb.f2 .nb.f3 .nb.f1 .nb.f4]]
+
+test notebook-7.3 "insert - move backwards again" -body {
+ .nb insert 1 3
+ list [.nb index current] [.nb tabs]
+} -result [list 1 [list .nb.f0 .nb.f1 .nb.f2 .nb.f3 .nb.f4]]
+
+test notebook-7.4 "insert - move forwards" -body {
+ .nb insert 3 1
+ list [.nb index current] [.nb tabs]
+} -result [list 3 [list .nb.f0 .nb.f2 .nb.f3 .nb.f1 .nb.f4]]
+
+test notebook-7.5 "insert - move forwards again" -body {
+ .nb insert 3 1
+ list [.nb index current] [.nb tabs]
+} -result [list 2 [list .nb.f0 .nb.f3 .nb.f1 .nb.f2 .nb.f4]]
+
+test notebook-7.6 "insert - move forwards again" -body {
+ .nb insert 3 1
+ list [.nb index current] [.nb tabs]
+} -result [list 1 [list .nb.f0 .nb.f1 .nb.f2 .nb.f3 .nb.f4]]
+
+test notebook-7.7a "insert - current tab undisturbed" -body {
+ .nb select 0
+ .nb insert 3 1
+ .nb index current
+} -result 0
+
+test notebook-7.7b "insert - current tab undisturbed" -body {
+ .nb select 0
+ .nb insert 1 3
+ .nb index current
+} -result 0
+
+test notebook-7.7c "insert - current tab undisturbed" -body {
+ .nb select 4
+ .nb insert 3 1
+ .nb index current
+} -result 4
+
+test notebook-7.7d "insert - current tab undisturbed" -body {
+ .nb select 4
+ .nb insert 1 3
+ .nb index current
+} -result 4
+
+test notebook-7.end "insert - cleanup" -body {
+ destroy .nb
+}
+
+tcltest::cleanupTests
diff --git a/tests/ttk/panedwindow.test b/tests/ttk/panedwindow.test
new file mode 100644
index 0000000..13a7e85
--- /dev/null
+++ b/tests/ttk/panedwindow.test
@@ -0,0 +1,201 @@
+#
+# $Id: panedwindow.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+
+# Basic sanity checks:
+#
+test panedwindow-1.0 "Setup" -body {
+ ttk::panedwindow .pw
+} -result .pw
+
+test panedwindow-1.1 "Make sure empty panedwindow doesn't crash" -body {
+ pack .pw -expand true -fill both
+ update
+}
+
+test panedwindow-1.2 "Add a pane" -body {
+ .pw add [ttk::frame .pw.f1]
+ winfo manager .pw.f1
+} -result "paned"
+
+test panedwindow-1.3 "Steal pane" -body {
+ pack .pw.f1 -side bottom
+ winfo manager .pw.f1
+} -result "pack"
+
+test panedwindow-1.4 "Make sure empty panedwindow still doesn't crash" -body {
+ update
+}
+
+test panedwindow-1.5 "Remanage pane" -body {
+ #XXX .pw insert 0 .pw.f1
+ .pw add .pw.f1
+ winfo manager .pw.f1
+} -result "paned"
+
+test panedwindow-1.6 "Forget pane" -body {
+ .pw forget .pw.f1
+ winfo manager .pw.f1
+} -result ""
+
+test panedwindow-1.7 "Make sure empty panedwindow still still doesn't crash" -body {
+ update
+}
+
+test panedwindow-1.8 "Re-forget pane" -body {
+ .pw forget .pw.f1
+} -returnCodes 1 -result ".pw.f1 is not managed by .pw"
+
+test panedwindow-1.end "Cleanup" -body {
+ destroy .pw
+}
+
+# Resize behavior:
+#
+test panedwindow-2.1 "..." -body {
+ ttk::panedwindow .pw -orient horizontal
+
+ .pw add [listbox .pw.l1]
+ .pw add [listbox .pw.l2]
+ .pw add [listbox .pw.l3]
+ .pw add [listbox .pw.l4]
+
+ pack .pw -expand true -fill both
+ update
+ set w1 [winfo width .]
+
+ # This should make the window shrink:
+ destroy .pw.l2
+
+ update
+ set w2 [winfo width .]
+
+ expr {$w2 < $w1}
+} -result 1
+
+test panedwindow-2.2 "..., cont'd" -body {
+
+ # This should keep the window from shrinking:
+ wm geometry . [wm geometry .]
+
+ set rw2 [winfo reqwidth .pw]
+
+ destroy .pw.l1
+ update
+
+ set w3 [winfo width .]
+ set rw3 [winfo reqwidth .pw]
+
+ expr {$w3 == $w2 && $rw3 < $rw2}
+ # problem: [winfo reqwidth] shrinks, but sashes haven't moved
+ # since we haven't gotten a ConfigureNotify.
+ # How to (a) check for this, and (b) fix it?
+} -result 1
+
+test panedwindow-2.3 "..., cont'd" -body {
+
+ .pw add [listbox .pw.l5]
+ update
+ set rw4 [winfo reqwidth .pw]
+
+ expr {$rw4 > $rw3}
+} -result 1
+
+test panedwindow-2.end "Cleanup" -body { destroy .pw }
+
+#
+# ...
+#
+test panedwindow-3.0 "configure pane" -body {
+ ttk::panedwindow .pw
+ .pw add [listbox .pw.lb1]
+ .pw add [listbox .pw.lb2]
+ .pw pane 1 -weight 2
+ .pw pane 1 -weight
+} -result 2
+
+test panedwindow-3.1 "configure pane -- errors" -body {
+ .pw pane 1 -weight -4
+} -returnCodes 1 -match glob -result "-weight must be nonnegative"
+
+test panedwindow-3.2 "add pane -- errors" -body {
+ .pw add [ttk::label .pw.l] -weight -1
+} -returnCodes 1 -match glob -result "-weight must be nonnegative"
+
+
+test panedwindow-3.end "cleanup" -body { destroy .pw }
+
+
+test panedwindow-4.1 "forget" -body {
+ pack [ttk::panedwindow .pw -orient vertical] -expand true -fill both
+ .pw add [label .pw.l1 -text "L1"]
+ .pw add [label .pw.l2 -text "L2"]
+ .pw add [label .pw.l3 -text "L3"]
+ .pw add [label .pw.l4 -text "L4"]
+
+ update
+
+ .pw forget .pw.l1
+ .pw forget .pw.l2
+ .pw forget .pw.l3
+ .pw forget .pw.l4
+ update
+}
+
+test panedwindow-4.2 "forget forgotten" -body {
+ .pw forget .pw.l1
+} -returnCodes 1 -result ".pw.l1 is not managed by .pw"
+
+# checkorder $winlist --
+# Ensure that Y coordinates windows in $winlist are strictly increasing.
+#
+proc checkorder {winlist} {
+ set pos -1
+ foreach win $winlist {
+ set nextpos [winfo y $win]
+ if {$nextpos <= $pos} {
+ error "window $win out of order"
+ }
+ set pos $nextpos
+ }
+}
+
+test panedwindow-4.3 "insert command" -body {
+ .pw insert end .pw.l1
+ .pw insert end .pw.l3
+ .pw insert 1 .pw.l2
+ .pw insert end .pw.l4
+
+ update;
+ checkorder {.pw.l1 .pw.l2 .pw.l3 .pw.l4}
+}
+
+test panedwindow-4.END "cleanup" -body {
+ destroy .pw
+}
+
+# See #1292219
+
+test panedwindow-5.1 "Propage Map/Unmap state to children" -body {
+ set result [list]
+ pack [ttk::panedwindow .pw]
+ .pw add [ttk::button .pw.b]
+ update
+
+ lappend result [winfo ismapped .pw] [winfo ismapped .pw.b]
+
+ pack forget .pw
+ update
+ lappend result [winfo ismapped .pw] [winfo ismapped .pw.b]
+
+ set result
+} -result [list 1 1 0 0] -cleanup {
+ destroy .pw
+}
+
+tcltest::cleanupTests
diff --git a/tests/ttk/progressbar.test b/tests/ttk/progressbar.test
new file mode 100644
index 0000000..ead15f6
--- /dev/null
+++ b/tests/ttk/progressbar.test
@@ -0,0 +1,89 @@
+#
+# $Id: progressbar.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+
+test progressbar-1.1 "Setup" -body {
+ ttk::progressbar .pb
+} -result .pb
+
+test progressbar-1.2 "Linked variable" -body {
+ set PB 50
+ .pb configure -variable PB
+ .pb cget -value
+} -result 50
+
+test progressbar-1.3 "Change linked variable" -body {
+ set PB 80
+ .pb cget -value
+} -result 80
+
+test progressbar-1.4 "Set linked variable to bad value" -body {
+ set PB "bogus"
+ .pb instate invalid
+} -result 1
+
+test progressbar-1.4.1 "Set linked variable back to a good value" -body {
+ set PB 80
+ .pb instate invalid
+} -result 0
+
+test progressbar-1.5 "Set -variable to illegal variable" -body {
+ set BAD "bogus"
+ .pb configure -variable BAD
+ .pb instate invalid
+} -result 1
+
+test progressbar-1.6 "Unset -variable" -body {
+ unset -nocomplain UNSET
+ .pb configure -variable UNSET
+ .pb instate disabled
+} -result 1
+
+test progressbar-2.0 "step command" -body {
+ .pb configure -variable {} ;# @@@
+ .pb configure -value 5 -maximum 10 -mode determinate
+ .pb step
+ .pb cget -value
+} -result 6.0
+
+test progressbar-2.1 "step command, with stepamount" -body {
+ .pb step 3
+ .pb cget -value
+} -result 9.0
+
+test progressbar-2.2 "step wraps at -maximum in determinate mode" -body {
+ .pb step
+ .pb cget -value
+} -result 0.0
+
+test progressbar-2.3 "step doesn't wrap in indeterminate mode" -body {
+ .pb configure -value 8 -maximum 10 -mode indeterminate
+ .pb step
+ .pb step
+ .pb step
+ .pb cget -value
+} -result 11.0
+
+test progressbar-2.4 "step with linked variable" -body {
+ .pb configure -variable PB ;# @@@
+ set PB 5
+ .pb step
+ set PB
+} -result 6.0
+
+test progressbar-2.5 "error in write trace" -body {
+ trace variable PB w { error "YIPES!" ;# }
+ .pb step
+ set PB ;# NOTREACHED
+} -cleanup { unset PB } -returnCodes 1 -match glob -result "*YIPES!"
+
+test progressbar-end "Cleanup" -body {
+ destroy .pb
+}
+
+tcltest::cleanupTests
diff --git a/tests/ttk/scrollbar.test b/tests/ttk/scrollbar.test
new file mode 100644
index 0000000..f91659a
--- /dev/null
+++ b/tests/ttk/scrollbar.test
@@ -0,0 +1,42 @@
+#
+# $Id: scrollbar.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+test scrollbar-1.0 "Setup" -body {
+ ttk::scrollbar .tsb
+} -result .tsb
+
+test scrollbar-1.1 "Set method" -body {
+ .tsb set 0.2 0.4
+ .tsb get
+} -result [list 0.2 0.4]
+
+test scrollbar-1.2 "Set orientation" -body {
+ .tsb configure -orient vertical
+ set w [winfo reqwidth .tsb] ; set h [winfo reqheight .tsb]
+ expr {$h > $w}
+} -result 1
+
+test scrollbar-1.3 "Change orientation" -body {
+ .tsb configure -orient horizontal
+ set w [winfo reqwidth .tsb] ; set h [winfo reqheight .tsb]
+ expr {$h < $w}
+} -result 1
+
+#
+# Scale tests:
+#
+
+test scale-1.0 "Self-destruction" -body {
+ trace variable v w { destroy .s ;# }
+ ttk::scale .s -variable v
+ pack .s ; update
+ .s set 1 ; update
+} -returnCodes 1 -match glob -result "*"
+
+tcltest::cleanupTests
+
diff --git a/tests/ttk/treetags.test b/tests/ttk/treetags.test
new file mode 100644
index 0000000..2161395
--- /dev/null
+++ b/tests/ttk/treetags.test
@@ -0,0 +1,77 @@
+#
+# $Id: treetags.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+testConstraint treeview [llength [info commands ttk::treeview]]
+testConstraint nyi 0
+
+test treetags-1.0 "Setup" -constraints treeview -body {
+ set tv [ttk::treeview .tv]
+ .tv insert {} end -id item1 -text "Item 1"
+ pack .tv
+}
+
+test treetags-1.1 "Bad tag list" -constraints treeview -body {
+ $tv item item1 -tags {bad {list}here bad}
+} -returnCodes error -result "list element in braces *" -match glob
+
+test treetags-1.2 "Good tag list" -constraints treeview -body {
+ $tv item item1 -tags tag1
+ $tv item item1 -tags
+} -result [list tag1]
+
+test treetags-1.3 "Bad events" -constraints treeview -body {
+ $tv tag bind bad <Enter> { puts "Entered!" }
+} -returnCodes 1 -result "unsupported event <Enter>*" -match glob
+
+test treetags-2.0 "tag bind" -constraints treeview -body {
+ $tv tag bind tag1 <KeyPress> {set ::KEY %A}
+ $tv tag bind tag1 <KeyPress>
+} -result {set ::KEY %A}
+
+test treetags-2.1 "Events delivered to tags" -constraints treeview -body {
+ focus -force $tv ; update ;# needed so [event generate] delivers KeyPress
+ $tv focus item1
+ event generate .tv <KeyPress-a>
+ set ::KEY
+} -result a
+
+test treetags-2.2 "Events delivered to correct tags" -constraints treeview -body {
+ $tv insert {} end -id item2 -tags tag2
+ $tv tag bind tag2 <KeyPress> [list set ::KEY2 %A]
+
+ $tv focus item1
+ event generate $tv <KeyPress-b>
+ $tv focus item2
+ event generate $tv <KeyPress-c>
+
+ list $::KEY $::KEY2
+} -result [list b c]
+
+test treetags-2.3 "Virtual events delivered to focus item" -constraints treeview -body {
+ set ::bong 0
+ $tv tag bind tag2 <<Bing>> { incr bong }
+ $tv focus item2
+ event generate $tv <<Bing>>
+ $tv focus item1
+ event generate $tv <<Bing>>
+ set bong
+} -result 1
+
+
+test treetags-3.0 "tag configure" -constraints treeview -body {
+ $tv tag configure tag1 -foreground blue -background red
+} -result {}
+
+test treetags-3.1 "tag configure" -constraints treeview -body {
+ $tv tag configure tag1 -foreground
+} -result [list blue]
+
+
+test treetags-end "Cleanup" -constraints treeview -body { destroy .tv }
+
+tcltest::cleanupTests
diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test
new file mode 100644
index 0000000..ac0778c
--- /dev/null
+++ b/tests/ttk/treeview.test
@@ -0,0 +1,494 @@
+#
+# $Id: treeview.test,v 1.1 2006/10/31 01:42:27 hobbs Exp $
+#
+# [7Jun2005] TO CHECK: [$tv see {}] -- shouldn't work (at least, shouldn't do
+# what it currently does)
+#
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+testConstraint treeview [llength [info commands ttk::treeview]]
+
+# consistencyCheck --
+# Traverse the tree to make sure the item data structures
+# are properly linked.
+#
+# Since [$tv children] follows ->next links and [$tv index]
+# follows ->prev links, this should cover all invariants.
+#
+proc consistencyCheck {tv {item {}}} {
+ if {![llength [info commands ttk::treeview]]} { return }
+ set i 0;
+ foreach child [$tv children $item] {
+ assert {[$tv parent $child] == $item} "parent $child = $item"
+ assert {[$tv index $child] == $i} "index $child [$tv index $child]=$i"
+ incr i
+ consistencyCheck $tv $child
+ }
+}
+
+proc assert {expr {message ""}} {
+ if {![uplevel 1 [list expr $expr]]} {
+ set error "PANIC! PANIC! PANIC: $message ($expr failed)"
+ puts stderr $error
+ error $error
+ }
+}
+
+test treeview-0 "treeview test - setup" -constraints treeview -body {
+ ttk::treeview .tv -columns {a b c}
+ pack .tv -expand true -fill both
+ update
+}
+
+test treeview-1.1 "columns" -constraints treeview -body {
+ .tv configure -columns {a b c}
+}
+
+test treeview-1.2 "Bad columns" -constraints treeview -body {
+ #.tv configure -columns {illegal "list"value}
+ ttk::treeview .badtv -columns {illegal "list"value}
+} -returnCodes 1 -result "list element in quotes followed by*" -match glob
+
+test treeview-1.3 "bad displaycolumns" -constraints treeview -body {
+ .tv configure -displaycolumns {a b d}
+} -returnCodes 1 -result "Invalid column index d"
+
+test treeview-1.4 "more bad displaycolumns" -constraints treeview -body {
+ .tv configure -displaycolumns {1 2 3}
+} -returnCodes 1 -result "Column index 3 out of bounds"
+
+test treeview-1.5 "Don't forget to check negative numbers" -constraints treeview -body {
+ .tv configure -displaycolumns {1 -2 3}
+} -returnCodes 1 -result "Column index -2 out of bounds"
+
+# Item creation.
+#
+test treeview-2.1 "insert -- not enough args" -constraints treeview -body {
+ .tv insert
+} -returnCodes 1 -result "wrong # args: *" -match glob
+
+test treeview-2.3 "insert -- bad integer index" -constraints treeview -body {
+ .tv insert {} badindex
+} -returnCodes 1 -result "expected integer *" -match glob
+
+test treeview-2.4 "insert -- bad parent node" -constraints treeview -body {
+ .tv insert badparent end
+} -returnCodes 1 -result "Item badparent not found" -match glob
+
+test treeview-2.5 "insert -- finaly insert a node" -constraints treeview -body {
+ .tv insert {} end -id newnode -text "New node"
+} -result newnode
+
+test treeview-2.6 "insert -- make sure node was inserted" -constraints treeview -body {
+ .tv children {}
+} -result [list newnode]
+
+test treeview-2.7 "insert -- prevent duplicate node names" -constraints treeview -body {
+ .tv insert {} end -id newnode
+} -returnCodes 1 -result "Item newnode already exists"
+
+test treeview-2.8 "insert -- new node at end" -constraints treeview -body {
+ .tv insert {} end -id lastnode
+ consistencyCheck .tv
+ .tv children {}
+} -result [list newnode lastnode]
+
+consistencyCheck .tv
+
+test treeview-2.9 "insert -- new node at beginning" -constraints treeview -body {
+ .tv insert {} 0 -id firstnode
+ consistencyCheck .tv
+ .tv children {}
+} -result [list firstnode newnode lastnode]
+
+test treeview-2.10 "insert -- one more node" -constraints treeview -body {
+ .tv insert {} 2 -id onemore
+ consistencyCheck .tv
+ .tv children {}
+} -result [list firstnode newnode onemore lastnode]
+
+test treeview-2.11 "insert -- and another one" -constraints treeview -body {
+ .tv insert {} 2 -id anotherone
+ consistencyCheck .tv
+ .tv children {}
+} -result [list firstnode newnode anotherone onemore lastnode]
+
+test treeview-2.12 "insert -- one more at end" -constraints treeview -body {
+ .tv insert {} end -id newlastone
+ consistencyCheck .tv
+ .tv children {}
+} -result [list firstnode newnode anotherone onemore lastnode newlastone]
+
+test treeview-2.13 "insert -- one more at beginning" -constraints treeview -body {
+ .tv insert {} 0 -id newfirstone
+ consistencyCheck .tv
+ .tv children {}
+} -result [list newfirstone firstnode newnode anotherone onemore lastnode newlastone]
+
+test treeview-2.14 "insert -- bad options" -constraints treeview -body {
+ .tv insert {} end -badoption foo
+} -returnCodes 1 -result {unknown option "-badoption"}
+
+test treeview-2.15 "insert -- at position 0 w/no children" -constraints treeview -body {
+ .tv insert newnode 0 -id newnode.n2 -text "Foo"
+ .tv children newnode
+} -result newnode.n2 ;# don't crash
+
+test treeview-2.16 "insert -- insert way past end" -constraints treeview -body {
+ .tv insert newnode 99 -id newnode.n3 -text "Foo"
+ consistencyCheck .tv
+ .tv children newnode
+} -result [list newnode.n2 newnode.n3]
+
+test treeview-2.17 "insert -- insert before beginning" -constraints treeview -body {
+ .tv insert newnode -1 -id newnode.n1 -text "Foo"
+ consistencyCheck .tv
+ .tv children newnode
+} -result [list newnode.n1 newnode.n2 newnode.n3]
+
+###
+#
+test treeview-3.1 "parent" -constraints treeview -body {
+ .tv parent newnode.n1
+} -result newnode
+test treeview-3.2 "parent - top-level node" -constraints treeview -body {
+ .tv parent newnode
+} -result {}
+test treeview-3.3 "parent - root node" -constraints treeview -body {
+ .tv parent {}
+} -result {}
+test treeview-3.4 "index" -constraints treeview -body {
+ list [.tv index newnode.n3] [.tv index newnode.n2] [.tv index newnode.n1]
+} -result [list 2 1 0]
+test treeview-3.5 "index - exhaustive test" -constraints treeview -body {
+ set result [list]
+ foreach item [.tv children {}] {
+ lappend result [.tv index $item]
+ }
+ set result
+} -result [list 0 1 2 3 4 5 6]
+
+test treeview-3.6 "detach" -constraints treeview -body {
+ .tv detach newnode
+ consistencyCheck .tv
+ .tv children {}
+} -result [list newfirstone firstnode anotherone onemore lastnode newlastone]
+# XREF: treeview-2.13
+
+test treeview-3.7 "detach didn't screw up internal links" -constraints treeview -body {
+ consistencyCheck .tv
+ set result [list]
+ foreach item [.tv children {}] {
+ lappend result [.tv index $item]
+ }
+ set result
+} -result [list 0 1 2 3 4 5]
+
+test treeview-3.8 "detached node has no parent, index 0" -constraints treeview -body {
+ list [.tv parent newnode] [.tv index newnode]
+} -result [list {} 0]
+# @@@ Can't distinguish detached nodes from first root node
+
+test treeview-3.9 "detached node's children undisturbed" -constraints treeview -body {
+ .tv children newnode
+} -result [list newnode.n1 newnode.n2 newnode.n3]
+
+test treeview-3.10 "detach is idempotent" -constraints treeview -body {
+ .tv detach newnode
+ consistencyCheck .tv
+ .tv children {}
+} -result [list newfirstone firstnode anotherone onemore lastnode newlastone]
+
+test treeview-3.11 "Can't detach root item" -constraints treeview -body {
+ .tv detach [list {}]
+ update
+ consistencyCheck .tv
+} -returnCodes 1 -result "Cannot detach root item"
+consistencyCheck .tv
+
+test treeview-3.12 "Reattach" -constraints treeview -body {
+ .tv move newnode {} end
+ consistencyCheck .tv
+ .tv children {}
+} -result [list newfirstone firstnode anotherone onemore lastnode newlastone newnode]
+
+# Bug # ?????
+test treeview-3.13 "Re-reattach" -constraints treeview -body {
+ .tv move newnode {} end
+ consistencyCheck .tv
+ .tv children {}
+} -result [list newfirstone firstnode anotherone onemore lastnode newlastone newnode]
+
+catch {
+ .tv insert newfirstone end -id x1
+ .tv insert newfirstone end -id x2
+ .tv insert newfirstone end -id x3
+}
+
+test treeview-3.14 "Duplicated entry in children list" -constraints treeview -body {
+ .tv children newfirstone [list x3 x1 x2 x3]
+ # ??? Maybe this should raise an error?
+ consistencyCheck .tv
+ .tv children newfirstone
+} -result [list x3 x1 x2]
+
+test treeview-3.14.1 "Duplicated entry in children list" -constraints treeview -body {
+ .tv children newfirstone [list x1 x2 x3 x3 x2 x1]
+ consistencyCheck .tv
+ .tv children newfirstone
+} -result [list x1 x2 x3]
+
+test treeview-3.15 "Consecutive duplicate entries in children list" -constraints treeview -body {
+ .tv children newfirstone [list x1 x2 x2 x3]
+ consistencyCheck .tv
+ .tv children newfirstone
+} -result [list x1 x2 x3]
+
+test treeview-3.16 "Insert child after self" -constraints treeview -body {
+ .tv move x2 newfirstone 1
+ consistencyCheck .tv
+ .tv children newfirstone
+} -result [list x1 x2 x3]
+
+test treeview-3.17 "Insert last child after self" -constraints treeview -body {
+ .tv move x3 newfirstone 2
+ consistencyCheck .tv
+ .tv children newfirstone
+} -result [list x1 x2 x3]
+
+test treeview-3.18 "Insert last child after end" -constraints treeview -body {
+ .tv move x3 newfirstone 3
+ consistencyCheck .tv
+ .tv children newfirstone
+} -result [list x1 x2 x3]
+
+
+test treeview-4.1 "opened - initial state" -constraints treeview -body {
+ .tv item newnode -open
+} -result 0
+test treeview-4.2 "opened - open node" -constraints treeview -body {
+ .tv item newnode -open 1
+ .tv item newnode -open
+} -result 1
+test treeview-4.3 "opened - closed node" -constraints treeview -body {
+ .tv item newnode -open 0
+ .tv item newnode -open
+} -result 0
+
+test treeview-5.1 "item -- error checks" -constraints treeview -body {
+ .tv item newnode -text "Bad values" -values "{bad}list"
+} -returnCodes 1 -result "list element in braces followed by*" -match glob
+
+test treeview-5.2 "item -- error leaves options unchanged " -constraints treeview -body {
+ .tv item newnode -text
+} -result "New node"
+
+test treeview-5.3 "Heading" -constraints treeview -body {
+ .tv heading #0 -text "Heading"
+}
+
+test treeview-5.4 "get cell" -constraints treeview -body {
+ set l [list a b c]
+ .tv item newnode -values $l
+ .tv set newnode 1
+} -result b
+
+test treeview-5.5 "set cell" -constraints treeview -body {
+ .tv set newnode 1 XXX
+ .tv item newnode -values
+} -result [list a XXX c]
+
+test treeview-5.6 "set illegal cell" -constraints treeview -body {
+ .tv set newnode #0 YYY
+} -returnCodes 1 -result "Display column #0 cannot be set"
+
+test treeview-5.7 "set illegal cell" -constraints treeview -body {
+ .tv set newnode 3 YY ;# 3 == current #columns
+} -returnCodes 1 -result "Column index 3 out of bounds"
+
+test treeview-5.8 "set display columns" -constraints treeview -body {
+ .tv configure -displaycolumns [list 2 1 0]
+ .tv set newnode #1 X
+ .tv set newnode #2 Y
+ .tv set newnode #3 Z
+ .tv item newnode -values
+} -result [list Z Y X]
+
+test treeview-5.9 "display columns part 2" -constraints treeview -body {
+ list [.tv column #1 -id] [.tv column #2 -id] [.tv column #3 -id]
+} -result [list c b a]
+
+test treeview-5.10 "cannot set column -id" -constraints treeview -body {
+ .tv column #1 -id X
+} -returnCodes 1 -result "Attempt to change read-only option"
+
+test treeview-5.11 "get" -constraints treeview -body {
+ .tv set newnode #1
+} -result X
+
+test treeview-5.12 "get dictionary" -constraints treeview -body {
+ .tv set newnode
+} -result [list a Z b Y c X]
+
+test treeview-5.13 "get, no value" -constraints treeview -body {
+ set newitem [.tv insert {} end]
+ set result [.tv set $newitem #1]
+ .tv delete $newitem
+ set result
+} -result {}
+
+
+test treeview-6.1 "deletion - setup" -constraints treeview -body {
+ .tv insert {} end -id dtest
+ foreach id [list a b c d e] {
+ .tv insert dtest end -id $id
+ }
+ .tv children dtest
+} -result [list a b c d e]
+
+test treeview-6.1 "delete" -constraints treeview -body {
+ .tv delete b
+ consistencyCheck .tv
+ list [.tv exists b] [.tv children dtest]
+} -result [list 0 [list a c d e]]
+
+consistencyCheck .tv
+
+test treeview-6.2 "delete - duplicate items in list" -constraints treeview -body {
+ .tv delete [list a e a e]
+ consistencyCheck .tv
+ .tv children dtest
+} -result [list c d]
+
+test treeview-6.3 "delete - descendants removed" -constraints treeview -body {
+ .tv insert c end -id c1
+ .tv insert c end -id c2
+ .tv insert c1 end -id c11
+ consistencyCheck .tv
+ .tv delete c
+ consistencyCheck .tv
+ list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11]
+} -result [list 0 0 0 0]
+
+test treeview-6.4 "delete - delete parent and descendants" -constraints treeview -body {
+ .tv insert dtest end -id c
+ .tv insert c end -id c1
+ .tv insert c end -id c2
+ .tv insert c1 end -id c11
+ consistencyCheck .tv
+ .tv delete [list c c1 c2 c11]
+ consistencyCheck .tv
+ list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11]
+} -result [list 0 0 0 0]
+
+test treeview-6.5 "delete - delete descendants and parent" -constraints treeview -body {
+ .tv insert dtest end -id c
+ .tv insert c end -id c1
+ .tv insert c end -id c2
+ .tv insert c1 end -id c11
+ consistencyCheck .tv
+ .tv delete [list c11 c1 c2 c]
+ consistencyCheck .tv
+ list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11]
+} -result [list 0 0 0 0]
+
+test treeview-6.6 "delete - end" -constraints treeview -body {
+ consistencyCheck .tv
+ .tv children dtest
+} -result [list d]
+
+test treeview-7.1 "move" -constraints treeview -body {
+ .tv insert d end -id d1
+ .tv insert d end -id d2
+ .tv insert d end -id d3
+ .tv move d3 d 0
+ consistencyCheck .tv
+ .tv children d
+} -result [list d3 d1 d2]
+
+test treeview-7.2 "illegal move" -constraints treeview -body {
+ .tv move d d2 end
+} -returnCodes 1 -result "Cannot insert d as a descendant of d2"
+
+test treeview-7.3 "illegal move has no effect" -constraints treeview -body {
+ consistencyCheck .tv
+ .tv children d
+} -result [list d3 d1 d2]
+
+test treeview-7.4 "Replace children" -constraints treeview -body {
+ .tv children d [list d3 d2 d1]
+ consistencyCheck .tv
+ .tv children d
+} -result [list d3 d2 d1]
+
+test treeview-7.5 "replace children - precondition" -constraints treeview -body {
+ # Just check to make sure the test suite so far has left
+ # us in the state we expect to be in:
+ list [.tv parent newnode] [.tv children newnode]
+} -result [list {} [list newnode.n1 newnode.n2 newnode.n3]]
+
+test treeview-7.6 "Replace children - illegal move" -constraints treeview -body {
+ .tv children newnode.n1 [list newnode.n1 newnode.n2 newnode.n3]
+} -returnCodes 1 -result "Cannot insert newnode.n1 as a descendant of newnode.n1"
+
+consistencyCheck .tv
+
+test treeview-8.0 "Selection set" -constraints treeview -body {
+ .tv selection set [list newnode.n1 newnode.n3 newnode.n2]
+ .tv selection
+} -result [list newnode.n1 newnode.n2 newnode.n3]
+
+test treeview-8.1 "Selection add" -constraints treeview -body {
+ .tv selection add [list newnode]
+ .tv selection
+} -result [list newnode newnode.n1 newnode.n2 newnode.n3]
+
+test treeview-8.2 "Selection toggle" -constraints treeview -body {
+ .tv selection toggle [list newnode.n2 d3]
+ .tv selection
+} -result [list newnode newnode.n1 newnode.n3 d3]
+
+test treeview-8.3 "Selection remove" -constraints treeview -body {
+ .tv selection remove [list newnode.n2 d3]
+ .tv selection
+} -result [list newnode newnode.n1 newnode.n3]
+
+test treeview-8.4 "Selection - clear" -constraints treeview -body {
+ .tv selection set {}
+ .tv selection
+} -result {}
+
+test treeview-8.5 "Selection - bad operation" -constraints treeview -body {
+ .tv selection badop foo
+} -returnCodes 1 -match glob -result {bad selection operation "badop": must be *}
+
+### NEED: more tests for see/yview/scrolling
+
+proc scrollcallback {args} {
+ set ::scrolldata $args
+}
+test treeview-9.0 "scroll callback - empty tree" -constraints treeview -body {
+ .tv configure -yscrollcommand scrollcallback
+ .tv delete [.tv children {}]
+ update
+ set ::scrolldata
+} -result [list 0 1]
+
+### NEED: tests for focus item, selection
+
+
+### Misc. tests:
+
+destroy .tv
+test treeview-10.1 "Root node properly initialized (#1541739)" -setup {
+ ttk::treeview .tv
+ .tv insert {} end -id a
+ .tv see a
+} -cleanup {
+ destroy .tv
+} -constraints treeview
+
+tcltest::cleanupTests
diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test
new file mode 100644
index 0000000..1532a24
--- /dev/null
+++ b/tests/ttk/ttk.test
@@ -0,0 +1,594 @@
+
+package require Tk 8.5
+package require tcltest ; namespace import -force tcltest::*
+loadTestedCommands
+
+proc skip args {}
+proc ok {} { return }
+
+proc bgerror {error} {
+ variable bgerror $error
+ variable bgerrorInfo $::errorInfo
+ variable bgerrorCode $::errorCode
+}
+
+# Self-destruct tests.
+# Do these early, so any memory corruption has a longer time to cause a crash.
+#
+proc selfdestruct {w args} {
+ destroy $w
+}
+test ttk-6.1 "Self-destructing checkbutton" -body {
+ pack [ttk::checkbutton .sd -text "Self-destruction" -variable ::sd]
+ trace variable sd w [list selfdestruct .sd]
+ update
+ .sd invoke
+} -returnCodes 1
+test ttk-6.2 "Checkbutton self-destructed" -body {
+ winfo exists .sd
+} -result 0
+
+test ttk-6.3 "Test package cleanup" -body {
+ interp create foo
+ foo eval { if {[catch {package require Tk}]} { load {} Tk } }
+ foo eval { destroy . }
+ interp delete foo
+}
+
+test ttk-6.4 "Defeat evil intentions" -body {
+ trace variable OUCH r { kill.b }
+ proc kill.b {args} { destroy .b }
+ pack [ttk::checkbutton .b]
+ .b configure -variable OUCH
+ # At this point, .b should be gone.
+ .b invoke
+ list [set OUCH] [winfo exists .b]
+ # Mostly we just care that we haven't crashed the interpreter.
+ #
+} -returnCodes error -match glob -result "*"
+
+test ttk-6.5 "Clean up -textvariable traces" -body {
+ foreach class {ttk::button ttk::checkbutton ttk::radiobutton} {
+ $class .b1 -textvariable V
+ set V "asdf"
+ destroy .b1
+ set V ""
+ }
+}
+
+test ttk-6.6 "Bad color spec in styles" -body {
+ pack [ttk::button .b1 -text Hi!]
+ ttk::style configure TButton -foreground badColor
+ event generate .b1 <Expose>
+ update
+ ttk::style configure TButton -foreground black
+ destroy .b1
+ set ::bgerror
+} -result {unknown color name "badColor"}
+
+# This should move to be a standard test per widget test file
+test ttk-6.7 "Basic destruction test" -body {
+ foreach widget {
+ button checkbutton radiobutton sizegrip separator notebook
+ progressbar panedwindow scrollbar
+ } {
+ ttk::$widget .w
+ pack .w
+ destroy .w
+ }
+}
+
+test ttk-6.8 "Button command removes itself" -body {
+ ttk::button .b -command ".b configure -command {}; set ::A {it worked}"
+ .b invoke
+ destroy .b
+ set ::A
+} -result {it worked}
+
+#
+#
+
+test ttk-6.9 "Bad font spec in styles" -setup {
+ ttk::style theme create badfont -settings {
+ ttk::style configure . -font {Helvetica 12 Bogus}
+ }
+ ttk::style theme use badfont
+} -cleanup {
+ ttk::style theme use default
+} -body {
+ pack [ttk::label .l -text Hi!]
+ event generate .l <Expose>
+ update
+ destroy .l
+ set ::bgerror
+} -result {unknown font style "Bogus"}
+
+#
+# Basic tests.
+#
+
+test ttk-1.1 "Create button" -body {
+ pack [ttk::button .t] -expand true -fill both
+ update
+}
+
+test ttk-1.2 "Check style" -body {
+ .t cget -style
+} -result {}
+
+
+test ttk-1.4 "Restore default style" -body {
+ .t cget -style
+} -result ""
+
+proc checkstate {w} {
+ foreach statespec {
+ {!active !disabled}
+ {!active disabled}
+ {active !disabled}
+ {active disabled}
+ active
+ disabled
+ } {
+ lappend result [$w instate $statespec]
+ }
+ set result
+}
+
+# NB: this will fail if the top-level window pops up underneath the cursor
+test ttk-2.0 "Check state" -body {
+ checkstate .t
+} -result [list 1 0 0 0 0 0]
+
+test ttk-2.1 "Change state" -body {
+ .t state active
+} -result !active
+
+test ttk-2.2 "Check state again" -body {
+ checkstate .t
+} -result [list 0 0 1 0 1 0]
+
+test ttk-2.3 "Change state again" -body {
+ .t state {!active disabled}
+} -result {active !disabled}
+
+test ttk-2.4 "Check state again" -body {
+ checkstate .t
+} -result [list 0 1 0 0 0 1]
+
+test ttk-2.5 "Change state again" -body {
+ .t state !disabled
+} -result {disabled}
+
+test ttk-2.6 "instate scripts, false" -body {
+ set x 0
+ .t instate disabled { set x 1 }
+ set x
+} -result 0
+
+test ttk-2.7 "instate scripts, true" -body {
+ set x 0
+ .t instate !disabled { set x 1 }
+ set x
+} -result 1
+
+
+# misc. error detection
+test ttk-3.0 "Bad option" -body {
+ ttk::button .bad -badoption foo
+} -returnCodes 1 -result {unknown option "-badoption"} -match glob
+
+test ttk-3.1 "Make sure widget command not created" -body {
+ .bad state disabled
+} -returnCodes 1 -result {invalid command name ".bad"} -match glob
+
+test ttk-3.2 "Propagate errors from variable traces" -body {
+ set A 0
+ trace add variable A write {error "failure" ;# }
+ ttk::checkbutton .cb -variable A
+ .cb invoke
+} -cleanup {
+ unset ::A ; destroy .cb
+} -returnCodes error -result {can't set "A": failure}
+
+# Test resource allocation
+# (@@@ "-font" is a compatibility option now, so tests 4.1-4.3
+# don't really test anything useful at the moment.)
+#
+
+test ttk-4.0 "Setup" -body {
+ catch { destroy .t }
+ pack [ttk::label .t -text "Button 1"]
+ testConstraint fontOption [expr ![catch { set prevFont [.t cget -font] }]]
+ ok
+}
+
+test ttk-4.1 "Change font" -constraints fontOption -body {
+ .t configure -font "Helvetica 18 bold"
+}
+test ttk-4.2 "Check font" -constraints fontOption -body {
+ .t cget -font
+} -result "Helvetica 18 bold"
+
+test ttk-4.3 "Restore font" -constraints fontOption -body {
+ .t configure -font $prevFont
+}
+
+test ttk-4.4 "Bad resource specifications" -body {
+ ttk::style theme settings alt {
+ ttk::style configure TButton -font {Bad font}
+ # @@@ it would be best to raise an error at this point,
+ # @@@ but that's not really feasible in the current framework.
+ }
+ pack [ttk::button .tb1 -text "Ouch"]
+ ttk::style theme use alt
+ update;
+ # As long as we haven't crashed, everything's OK
+ ttk::style theme settings alt {
+ ttk::style configure TButton -font TkDefaultFont
+ }
+ ttk::style theme use default
+ destroy .tb1
+}
+
+#
+# checkbutton tests
+#
+test ttk-5.1 "Checkbutton check" -body {
+ pack [ttk::checkbutton .cb -text "TCheckbutton" -variable cb]
+}
+test ttk-5.2 "Checkbutton invoke" -body {
+ .cb invoke
+ list [set ::cb] [.cb instate selected]
+} -result [list 1 1]
+test ttk-5.3 "Checkbutton reinvoke" -body {
+ .cb invoke
+ list [set ::cb] [.cb instate selected]
+} -result [list 0 0]
+
+test ttk-5.4 "Checkbutton variable" -body {
+ set result []
+ set ::cb 1
+ lappend result [.cb instate selected]
+ set ::cb 0
+ lappend result [.cb instate selected]
+} -result {1 0}
+
+test ttk-5.5 "Unset checkbutton variable" -body {
+ set result []
+ unset ::cb
+ lappend result [.cb instate alternate] [info exists ::cb]
+ set ::cb 1
+ lappend result [.cb instate alternate] [info exists ::cb]
+} -result {1 0 0 1}
+
+# See #1257319
+test ttk-5.6 "Checkbutton default variable" -body {
+ destroy .cb ; unset -nocomplain {} ; set result [list]
+ ttk::checkbutton .cb -onvalue on -offvalue off
+ lappend result [.cb cget -variable] [info exists .cb] [.cb state]
+ .cb invoke
+ lappend result [info exists .cb] [set .cb] [.cb state]
+ .cb invoke
+ lappend result [info exists .cb] [set .cb] [.cb state]
+} -result [list .cb 0 alternate 1 on selected 1 off {}]
+
+#
+# radiobutton tests
+#
+test ttk-7.1 "Radiobutton check" -body {
+ pack \
+ [ttk::radiobutton .rb1 -text "One" -variable choice -value 1] \
+ [ttk::radiobutton .rb2 -text "Two" -variable choice -value 2] \
+ [ttk::radiobutton .rb3 -text "Three" -variable choice -value 3] \
+ ;
+}
+test ttk-7.2 "Radiobutton invoke" -body {
+ .rb1 invoke
+ set ::choice
+} -result 1
+
+test ttk-7.3 "Radiobutton state" -body {
+ .rb1 instate selected
+} -result 1
+
+test ttk-7.4 "Other radiobutton invoke" -body {
+ .rb2 invoke
+ set ::choice
+} -result 2
+
+test ttk-7.5 "Other radiobutton state" -body {
+ .rb2 instate selected
+} -result 1
+
+test ttk-7.6 "First radiobutton state" -body {
+ .rb1 instate selected
+} -result 0
+
+test ttk-7.6 "Unset radiobutton variable" -body {
+ unset ::choice
+ list [info exists ::choice] [.rb1 instate alternate] [.rb2 instate alternate]
+} -result {0 1 1}
+
+test ttk-7.6 "Reset radiobutton variable" -body {
+ set ::choice 2
+ list [info exists ::choice] [.rb1 instate alternate] [.rb2 instate alternate]
+} -result {1 0 0}
+
+#
+# -compound tests:
+#
+variable iconData \
+{R0lGODlhIAAgAKIAANnZ2YQAAP8AAISEhP///////////////yH5BAEAAAAALAAAAAAgACAA
+AAP/CLoMGLqKoMvtGIqiqxEYCLrcioGiyxwIusyBgaLLLRiBoMsQKLrcjYGgu4Giy+2CAkFX
+A0WX2wXFIOgGii7trkCEohsDCACBoktEKLpKhISiGwAIECiqSKooukiqKKoxgACBooukKiIo
+SKooujGDECi6iqQqsopEV2MQAkV3kXQZRXdjEAJFl5F0FUWXY3ACRZcFSRdFlyVwJlB0WZB0
+UXRZAmcCRZeRdBVFl2NwAkV3kXQZRXdjcAJFV5FURVaR6GoMDgSKLpKqiKAgqaLoxgwOBIoq
+kiqKLpIqimrM4ECg6BIRiq4SIaHoxgyCBoou7a5AhKIbMzgAAIGiy+2CTWJmBhAAAkWX2wXF
+zCDoBooud2PMDIKuRqDocgtGzMwg6O4Eii5z4Kgi6DIMhqLoagQGjiqCLvPgYOgqji6CLrfi
+6DIj6HI7jq4i6DIkADs=}
+
+variable compoundStrings {text image center top bottom left right none}
+
+if {0} {
+ proc now {} { set ::now [clock clicks -milliseconds] }
+ proc tick {} { puts -nonewline stderr "+" ; flush stderr }
+ proc tock {} {
+ set then $::now; set ::now [clock clicks -milliseconds]
+ puts stderr " [expr {$::now - $then}] ms"
+ }
+} else {
+ proc now {} {} ; proc tick {} {} ; proc tock {} {}
+}
+
+now ; tick
+test ttk-8.0 "Setup for 8.X" -body {
+ ttk::button .ctb
+ image create photo icon -data $::iconData;
+ pack .ctb
+}
+tock
+
+now
+test ttk-8.1 "Test -compound options" -body {
+ # Exhaustively test each combination.
+ # Main goal is to make sure no code paths crash.
+ foreach image {icon ""} {
+ foreach text {"Hi!" ""} {
+ foreach compound $::compoundStrings {
+ .ctb configure -image $image -text $text -compound $compound
+ update; tick
+ }
+ }
+ }
+}
+tock
+
+test ttk-8.2 "Test -compound options with regular button" -body {
+ button .rtb
+ pack .rtb
+
+ foreach image {"" icon} {
+ foreach text {"Hi!" ""} {
+ foreach compound [lrange $::compoundStrings 2 end] {
+ .rtb configure -image $image -text $text -compound $compound
+ update; tick
+ }
+ }
+ }
+}
+tock
+
+test ttk-8.3 "Rerun test 8.1" -body {
+ foreach image {icon ""} {
+ foreach text {"Hi!" ""} {
+ foreach compound $::compoundStrings {
+ .ctb configure -image $image -text $text -compound $compound
+ update; tick
+ }
+ }
+ }
+}
+tock
+
+test ttk-8.4 "ImageChanged" -body {
+ ttk::button .b -image icon
+ icon blank
+} -cleanup { destroy .b }
+
+#------------------------------------------------------------------------
+
+test ttk-9.1 "Traces on nonexistant namespaces" -body {
+ ttk::checkbutton .tcb -variable foo::bar
+} -returnCodes 1 -result "*parent namespace doesn't exist*" -match glob
+
+test ttk-9.2 "Traces on nonexistant namespaces II" -body {
+ ttk::checkbutton .tcb -variable X
+ .tcb configure -variable foo::bar
+} -returnCodes 1 -result "*parent namespace doesn't exist*" -match glob
+
+test ttk-9.3 "Restore saved options on configure error" -body {
+ .tcb cget -variable
+} -result X
+
+test ttk-9.4 "Textvariable tests" -body {
+ set tcbLabel "Testing..."
+ .tcb configure -textvariable tcbLabel
+ .tcb cget -text
+} -result "Testing..."
+
+# Changing -text has no effect if there is a linked -textvariable.
+# Compatible with core widget.
+test ttk-9.5 "Change -text" -body {
+ .tcb configure -text "Changed -text"
+ .tcb cget -text
+} -result "Testing..."
+
+# Unset -textvariable clears the text.
+# NOTE: this is different from core widgets, which automagically reinitalize
+# the -textvariable to the last value of -text.
+#
+test ttk-9.6 "Unset -textvariable" -body {
+ unset tcbLabel
+ list [info exists tcbLabel] [.tcb cget -text]
+} -result [list 0 ""]
+
+test ttk-9.7 "Unset textvariable, comparison" -body {
+#
+# NB: the ttk label behaves differently from the standard label here;
+# NB: this is on purpose: I believe the standard behaviour is the Wrong Thing
+#
+ unset -nocomplain V1 V2
+ label .l -text Foo ; ttk::label .tl -text Foo
+
+ .l configure -textvariable V1 ; .tl configure -textvariable V2
+ list [set V1] [info exists V2]
+} -cleanup { destroy .l .tl } -result [list Foo 0]
+
+test ttk-9.8 "-textvariable overrides -text" -body {
+ ttk::label .tl -textvariable TV
+ set TV Foo
+ .tl configure -text Bar
+ .tl cget -text
+} -cleanup { destroy .tl } -result "Foo"
+
+#
+# Frame widget tests:
+#
+
+test ttk-10.1 "ttk::frame -class resource" -body {
+ ttk::frame .f -class Foo
+} -result .f
+
+test ttk-10.2 "Check widget class" -body {
+ winfo class .f
+} -result Foo
+
+test ttk-10.3 "Check class resource" -body {
+ .f cget -class
+} -result Foo
+
+test ttk-10.4 "Try to modify class resource" -body {
+ .f configure -class Bar
+} -returnCodes 1 -match glob -result "*read-only option*"
+
+test ttk-10.5 "Check class resource again" -body {
+ .f cget -class
+} -result Foo
+
+test ttk-11.1 "-state test, setup" -body {
+ ttk::button .b
+ .b instate disabled
+} -result 0
+
+test ttk-11.2 "-state test, disable" -body {
+ .b configure -state disabled
+ .b instate disabled
+} -result 1
+
+test ttk-11.3 "-state test, reenable" -body {
+ .b configure -state normal
+ .b instate disabled
+} -result 0
+
+test ttk-11.4 "-state test, unrecognized -state value" -body {
+ .b configure -state bogus
+ .b state
+} -result [list]
+
+test ttk-11.5 "-state test, 'active'" -body {
+ .b configure -state active
+ .b state
+} -result [list active] -cleanup { .b state !active }
+
+test ttk-11.6 "-state test, 'readonly'" -body {
+ .b configure -state readonly
+ .b state
+} -result [list readonly] -cleanup { .b state !readonly }
+
+test ttk-11.7 "-state test, cleanup" -body {
+ destroy .b
+}
+
+test ttk-12.1 "-cursor option" -body {
+ ttk::button .b
+ .b cget -cursor
+} -result {}
+
+test ttk-12.2 "-cursor option" -body {
+ .b configure -cursor arrow
+ .b cget -cursor
+} -result arrow
+
+test ttk-12.3 "-borderwidth frame option" -body {
+ destroy .t
+ toplevel .t
+ raise .t
+ pack [set t [ttk::frame .t.f]] -expand true -fill x ;
+ pack [ttk::label $t.l -text "ASDF QWERTY"] -expand true -fill both
+ foreach theme {default alt} {
+ ttk::style theme use $theme
+ foreach relief {flat raised sunken ridge groove solid} {
+ $t configure -relief $relief
+ for {set i 5} {$i >= 0} {incr i -1} {
+ $t configure -borderwidth $i
+ update
+ }
+ }
+ }
+}
+
+test ttk-12.4 "-borderwidth frame option" -body {
+ .t.f configure -relief raised
+ .t.f configure -borderwidth 1
+ ttk::style theme use alt
+ update
+}
+
+
+test ttk-13.1 "Custom styles -- bad -style option" -body {
+ ttk::button .tb1 -style badstyle
+} -returnCodes 1 -result "*badstyle not found*" -match glob
+
+test ttk-13.4 "Custom styles -- bad -style option" -body {
+ ttk::button .tb1
+ .tb1 configure -style badstyle
+} -cleanup {
+ destroy .tb1
+} -returnCodes 1 -result "*badstyle not found*" -match glob
+
+test ttk-13.5 "Custom layouts -- missing element definition" -body {
+ ttk::style layout badstyle {
+ NoSuchElement
+ }
+ ttk::button .tb1 -style badstyle
+} -cleanup {
+ destroy .tb1
+} -result .tb1
+# @@@ Should: signal an error, possibly a background error.
+
+#
+# See #793909
+#
+
+test ttk-14.1 "-variable in nonexistant namespace" -body {
+ ttk::checkbutton .tw -variable ::nsn::foo
+} -returnCodes 1 -result {can't trace *: parent namespace doesn't exist} \
+ -match glob -cleanup { destroy .tw }
+
+test ttk-14.2 "-textvariable in nonexistant namespace" -body {
+ ttk::label .tw -textvariable ::nsn::foo
+} -returnCodes 1 -result {can't trace *: parent namespace doesn't exist} \
+ -match glob -cleanup { destroy .tw }
+
+test ttk-14.3 "-textvariable in nonexistant namespace" -body {
+ ttk::entry .tw -textvariable ::nsn::foo
+} -returnCodes 1 -result {can't trace *: parent namespace doesn't exist} \
+ -match glob -cleanup { destroy .tw }
+
+
+eval destroy [winfo children .]
+
+tcltest::cleanupTests
+
+#*EOF*
diff --git a/tests/ttk/validate.test b/tests/ttk/validate.test
new file mode 100644
index 0000000..417deac
--- /dev/null
+++ b/tests/ttk/validate.test
@@ -0,0 +1,277 @@
+##
+## Entry widget validation tests
+## Derived from core test suite entry-19.1 through entry-19.20
+##
+
+package require Tk 8.5
+package require tcltest 2.1
+namespace import -force tcltest::*
+
+loadTestedCommands
+
+testConstraint ttkEntry 1
+testConstraint coreEntry [expr {![testConstraint ttkEntry]}]
+
+eval tcltest::configure $argv
+
+test validate-0.0 "Setup" -constraints ttkEntry -body {
+ rename entry {}
+ interp alias {} entry {} ttk::entry
+ return;
+}
+
+test validate-0.1 "More setup" -body {
+ destroy .e
+ catch {unset ::e}
+ catch {unset ::vVals}
+ entry .e -validate all \
+ -validatecommand [list doval %W %d %i %P %s %S %v %V] \
+ -invalidcommand bell \
+ -textvariable ::e \
+ ;
+ pack .e
+ proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ return 1
+ }
+}
+
+# The validation tests build each one upon the previous, so cascading
+# failures aren't good
+#
+test validate-1.1 {entry widget validation - insert} -body {
+ .e insert 0 a
+ set ::vVals
+} -result {.e 1 0 a {} a all key}
+
+test validate-1.2 {entry widget validation - insert} -body {
+ .e insert 1 b
+ set ::vVals
+} -result {.e 1 1 ab a b all key}
+
+test validate-1.3 {entry widget validation - insert} -body {
+ .e insert end c
+ set ::vVals
+} -result {.e 1 2 abc ab c all key}
+
+test validate-1.4 {entry widget validation - insert} -body {
+ .e insert 1 123
+ list $::vVals $::e
+} -result {{.e 1 1 a123bc abc 123 all key} a123bc}
+
+test validate-1.5 {entry widget validation - delete} -body {
+ .e delete 2
+ set ::vVals
+} -result {.e 0 2 a13bc a123bc 2 all key}
+
+test validate-1.6 {entry widget validation - delete} -body {
+ .e configure -validate key
+ .e delete 1 3
+ set ::vVals
+} -result {.e 0 1 abc a13bc 13 key key}
+
+test validate-1.7 {entry widget validation - vmode focus} -body {
+ set ::vVals {}
+ .e configure -validate focus
+ .e insert end d
+ set ::vVals
+} -result {}
+
+test validate-1.8 {entry widget validation - vmode focus} -body {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} -result {.e -1 -1 abcd abcd {} focus focusin}
+
+test validate-1.9 {entry widget validation - vmode focus} -body {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} -result {.e -1 -1 abcd abcd {} focus focusout}
+
+.e configure -validate all
+test validate-1.10 {entry widget validation - vmode all} -body {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} -result {.e -1 -1 abcd abcd {} all focusin}
+
+test validate-1.11 {entry widget validation} -body {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} -result {.e -1 -1 abcd abcd {} all focusout}
+.e configure -validate focusin
+
+test validate-1.12 {entry widget validation} -body {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} -result {.e -1 -1 abcd abcd {} focusin focusin}
+
+test validate-1.13 {entry widget validation} -body {
+ set ::vVals {}
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} -result {}
+.e configure -validate focuso
+
+test validate-1.14 {entry widget validation} -body {
+ focus -force .e
+ # update necessary to process FocusIn event
+ update
+ set ::vVals
+} -result {}
+
+test validate-1.15 {entry widget validation} -body {
+ focus -force .
+ # update necessary to process FocusOut event
+ update
+ set ::vVals
+} -result {.e -1 -1 abcd abcd {} focusout focusout}
+
+# DIFFERENCE: core entry temporarily sets "-validate all", ttk::entry doesn't.
+test validate-1.16 {entry widget validation} -body {
+ .e configure -validate all
+ list [.e validate] $::vVals
+} -result {1 {.e -1 -1 abcd abcd {} all forced}}
+
+# DIFFERENCE: ttk::entry does not perform validation when setting the -variable
+test validate-1.17 {entry widget validation} -constraints coreEntry -body {
+ .e configure -validate all
+ set ::e newdata
+ list [.e cget -validate] $::vVals
+} -result {all {.e -1 -1 newdata abcd {} all forced}}
+
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ return 0
+}
+
+test validate-1.18 {entry widget validation} -constraints coreEntry -body {
+ .e configure -validate all
+ set ::e nextdata
+ list [.e cget -validate] $::vVals
+} -result {none {.e -1 -1 nextdata newdata {} all forced}}
+# DIFFERENCE: ttk::entry doesn't validate when setting linked -variable
+# DIFFERENCE: ttk::entry doesn't disable validation
+
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ set ::e mydata
+ return 1
+}
+
+## This sets validate to none because it shows that we prevent a possible
+## loop condition in the validation, when the entry textvar is also set
+test validate-1.19 {entry widget validation} -constraints coreEntry -body {
+ .e configure -validate all
+ .e validate
+ list [.e cget -validate] [.e get] $::vVals
+} -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}}
+
+## This leaves validate alone because we trigger validation through the
+## textvar (a write trace), and the write during validation triggers
+## nothing (by definition of avoiding loops on var traces). This is
+## one of those "dangerous" conditions where the user will have a
+## different value in the entry widget shown as is in the textvar.
+
+# DIFFERENCE: ttk entry doesn't get out of sync w/textvar
+test validate-1.20 {entry widget validation} -constraints coreEntry -body {
+ .e configure -validate all
+ set ::e testdata
+ list [.e cget -validate] [.e get] $::e $::vVals
+} -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}}
+
+#
+# New tests, -JE:
+#
+proc doval {W d i P s S v V} {
+ set ::vVals [list $W $d $i $P $s $S $v $V]
+ .e delete 0 end;
+ .e insert end dovaldata
+ return 0
+}
+test validate-2.1 "Validation script changes value" -body {
+ .e configure -validate none
+ set ::e testdata
+ .e configure -validate all
+ .e validate
+ list [.e get] $::e $::vVals
+} -result {dovaldata dovaldata {.e -1 -1 testdata testdata {} all forced}}
+# DIFFERENCE: core entry disables validation, ttk entry does not.
+
+destroy .e
+catch {unset ::e ::vVals}
+
+# See bug #1236979
+
+test validate-2.2 "configure in -validatecommand" -body {
+ proc validate-2.2 {win str} {
+ $win configure -foreground black
+ return 1
+ }
+ ttk::entry .e -textvariable var -validatecommand {validate-2.2 %W %P}
+ .e validate
+} -result 1 -cleanup { destroy .e }
+
+
+### invalid state behavior
+#
+
+test validate-3.0 "Setup" -body {
+ set ::E "123"
+ ttk::entry .e \
+ -validatecommand {string is integer -strict %P} \
+ -validate all \
+ -textvariable ::E \
+ ;
+ return [list [.e get] [.e state]]
+} -result [list 123 {}]
+
+test validate-3.1 "insert - valid" -body {
+ .e insert end "4"
+ return [list [.e get] [.e state]]
+} -result [list 1234 {}]
+
+test validate-3.2 "insert - invalid" -body {
+ .e insert end "X"
+ return [list [.e get] [.e state]]
+} -result [list 1234 {}]
+
+test validate-3.3 "force invalid value" -body {
+ append ::E "XY"
+ return [list [.e get] [.e state]]
+} -result [list 1234XY {}]
+
+test validate-3.4 "revalidate" -body {
+ return [list [.e validate] [.e get] [.e state]]
+} -result [list 0 1234XY {invalid}]
+
+testConstraint NA 0
+# the next two tests (used to) exercise validation lockout protection --
+# if the widget is currently invalid, all edits are allowed.
+# This behavior is currently disabled.
+#
+test validate-3.5 "all edits allowed while invalid" -constraints NA -body {
+ .e delete 4
+ return [list [.e get] [.e state]]
+} -result [list 1234Y {invalid}]
+
+test validate-3.6 "...until the value becomes valid" -constraints NA -body {
+ .e delete 4
+ return [list [.e get] [.e state]]
+} -result [list 1234 {}]
+
+test validate-3.last "Cleanup" -body { destroy .e }
+
+
+###
+tcltest::cleanupTests
diff --git a/unix/Makefile.in b/unix/Makefile.in
index f339bb7..4bfdc38 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -5,7 +5,7 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.116 2006/09/27 18:43:35 andreas_kupries Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.117 2006/10/31 01:42:27 hobbs Exp $
# Current Tk version; used in various names.
@@ -299,9 +299,11 @@ RANLIB = @RANLIB@
SRC_DIR = @srcdir@
TOP_DIR = $(SRC_DIR)/..
GENERIC_DIR = $(TOP_DIR)/generic
+TTK_DIR = $(GENERIC_DIR)/ttk
UNIX_DIR = $(TOP_DIR)/unix
BMAP_DIR = $(TOP_DIR)/bitmaps
TOOL_DIR = @TCL_SRC_DIR@/tools
+TEST_DIR = $(TOP_DIR)/tests
MAC_OSX_DIR = $(TOP_DIR)/macosx
XLIB_DIR = $(TOP_DIR)/xlib
@@ -358,6 +360,17 @@ GENERIC_OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o \
tkGrid.o tkMain.o tkObj.o tkOldConfig.o tkOption.o tkPack.o tkPlace.o \
tkSelect.o tkStyle.o tkUndo.o tkUtil.o tkVisual.o tkWindow.o
+TTK_OBJS = \
+ ttkBlink.o ttkButton.o ttkCache.o ttkClamTheme.o ttkClassicTheme.o \
+ ttkDefaultTheme.o ttkElements.o ttkEntry.o ttkFrame.o ttkImage.o \
+ ttkInit.o ttkLabel.o ttkLayout.o ttkManager.o ttkNotebook.o \
+ ttkPanedwindow.o ttkProgress.o ttkScale.o ttkScrollbar.o ttkScroll.o \
+ ttkSeparator.o ttkSquare.o ttkState.o \
+ ttkTagSet.o ttkTheme.o ttkTrace.o ttkTrack.o ttkTreeview.o \
+ ttkWidget.o
+
+TTK_STUB_OBJS = ttkStubInit.o ttkStubLib.o
+
STUB_OBJS = tkStubInit.o tkStubLib.o
STUB_LIB_OBJS = tkStubLib.o tkStubImg.o
@@ -378,17 +391,22 @@ AQUA_OBJS = tkMacOSXBitmap.o tkMacOSXButton.o tkMacOSXClipboard.o \
tkMacOSXSubwindows.o tkMacOSXWindowEvent.o \
tkMacOSXWm.o tkMacOSXXStubs.o tkMacOSXCarbonEvents.o \
tkFileFilter.o tkMacWinMenu.o tkPointer.o tkUnix3d.o tkUnixScale.o \
- xcolors.o xdraw.o xgc.o ximage.o xutil.o
+ xcolors.o xdraw.o xgc.o ximage.o xutil.o \
+ ttkMacOSXTheme.o
AQUA_TKTEST_OBJS = tkMacOSXTest.o
OBJS = $(GENERIC_OBJS) $(WIDG_OBJS) $(CANV_OBJS) $(IMAGE_OBJS) $(TEXT_OBJS) \
- $(STUB_OBJS) $(@TK_WINDOWINGSYSTEM@_OBJS) @PLAT_OBJS@
+ $(STUB_OBJS) $(TTK_OBJS) $(TTK_STUB_OBJS) \
+ $(@TK_WINDOWINGSYSTEM@_OBJS) @PLAT_OBJS@
TK_DECLS = \
$(GENERIC_DIR)/tk.decls \
$(GENERIC_DIR)/tkInt.decls
+TTK_DECLS = \
+ $(TTK_DIR)/ttk.decls
+
GENERIC_SRCS = \
$(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \
$(GENERIC_DIR)/tkAtom.c $(GENERIC_DIR)/tkBind.c \
@@ -429,6 +447,40 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tkSquare.c $(GENERIC_DIR)/tkTest.c \
$(GENERIC_DIR)/tkStubInit.c $(GENERIC_DIR)/tkStubLib.c
+TTK_SRCS = \
+ $(TTK_DIR)/ttkBlink.c \
+ $(TTK_DIR)/ttkButton.c \
+ $(TTK_DIR)/ttkCache.c \
+ $(TTK_DIR)/ttkClamTheme.c \
+ $(TTK_DIR)/ttkClassicTheme.c \
+ $(TTK_DIR)/ttkDefaultTheme.c \
+ $(TTK_DIR)/ttkElements.c \
+ $(TTK_DIR)/ttkEntry.c \
+ $(TTK_DIR)/ttkFrame.c \
+ $(TTK_DIR)/ttkImage.c \
+ $(TTK_DIR)/ttkInit.c \
+ $(TTK_DIR)/ttkLabel.c \
+ $(TTK_DIR)/ttkLayout.c \
+ $(TTK_DIR)/ttkManager.c \
+ $(TTK_DIR)/ttkNotebook.c \
+ $(TTK_DIR)/ttkPanedwindow.c \
+ $(TTK_DIR)/ttkProgress.c \
+ $(TTK_DIR)/ttkScale.c \
+ $(TTK_DIR)/ttkScrollbar.c \
+ $(TTK_DIR)/ttkScroll.c \
+ $(TTK_DIR)/ttkSeparator.c \
+ $(TTK_DIR)/ttkSquare.c \
+ $(TTK_DIR)/ttkState.c \
+ $(TTK_DIR)/ttkTagSet.c \
+ $(TTK_DIR)/ttkTheme.c \
+ $(TTK_DIR)/ttkTrace.c \
+ $(TTK_DIR)/ttkTrack.c \
+ $(TTK_DIR)/ttkTreeview.c \
+ $(TTK_DIR)/ttkWidget.c
+
+TTK_STUB_SRCS = \
+ $(TTK_DIR)/ttkStubInit.c $(TTK_DIR)/ttkStubLib.c
+
X11_SRCS = \
$(UNIX_DIR)/tkAppInit.c $(UNIX_DIR)/tkUnix.c \
$(UNIX_DIR)/tkUnix3d.c \
@@ -467,7 +519,8 @@ AQUA_SRCS = \
$(GENERIC_DIR)/tkFileFilter.c $(GENERIC_DIR)/tkMacWinMenu.c \
$(GENERIC_DIR)/tkPointer.c $(UNIX_DIR)/tkUnix3d.c \
$(UNIX_DIR)/tkUnixScale.c $(XLIB_DIR)/xcolors.c $(XLIB_DIR)/xdraw.c \
- $(XLIB_DIR)/xgc.c $(XLIB_DIR)/ximage.c $(XLIB_DIR)/xutil.c
+ $(XLIB_DIR)/xgc.c $(XLIB_DIR)/ximage.c $(XLIB_DIR)/xutil.c \
+ $(TTK_DIR)/ttkMacOSXTheme.c
SRCS = $(GENERIC_SRCS) $(@TK_WINDOWINGSYSTEM@_SRCS) @PLAT_SRCS@
@@ -491,6 +544,12 @@ HDRS = bltList.h \
DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget
+SHELL_ENV = \
+ @LD_LIBRARY_PATH_VAR@=`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}; \
+ export @LD_LIBRARY_PATH_VAR@; \
+ TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
+ TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY;
+
all: binaries libraries doc
binaries: ${LIB_FILE} ${STUB_LIB_FILE} wish
@@ -567,43 +626,34 @@ xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE)
# args to tcltest, ie:
# % make test TESTFLAGS="-verbose bps -file fileName.test"
-test: tktest
- @LD_LIBRARY_PATH_VAR@=`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}; \
- export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
- TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
- ./tktest $(TOP_DIR)/tests/all.tcl -geometry +0+0 \
+test: test-classic test-ttk
+ @
+
+test-classic: tktest
+ $(SHELL_ENV) ./tktest $(TEST_DIR)/all.tcl -geometry +0+0 $(TESTFLAGS)
+
+test-ttk: tktest
+ $(SHELL_ENV) ./tktest $(TEST_DIR)/ttk/all.tcl -geometry +0+0 \
$(TESTFLAGS)
# Tests with different languages
testlang: tktest
- @LD_LIBRARY_PATH_VAR@=`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}; \
- export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
- TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
+ $(SHELL_ENV) \
for lang in $(LOCALES) ; \
do \
LANG=$(lang); export LANG; \
- ./tktest $(TOP_DIR)/tests/all.tcl -geometry +0+0 \
+ ./tktest $(TEST_DIR)/all.tcl -geometry +0+0 \
$(TESTFLAGS); \
done
# Useful target to launch a built tktest with the proper path,...
runtest: tktest
- @LD_LIBRARY_PATH_VAR@=`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}; \
- export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
- TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
- ./tktest
+ $(SHELL_ENV) ./tktest
# This target can be used to run wish from the build directory
# via `make shell` or `make shell SCRIPT=/tmp/foo.tcl`
shell: wish
- @LD_LIBRARY_PATH_VAR@=`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}; \
- export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
- TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
- ./wish $(SCRIPT)
+ $(SHELL_ENV) ./wish $(SCRIPT)
# This target can be used to run wish inside either gdb or insight
gdb: wish
@@ -674,7 +724,7 @@ install-libraries: libraries
XLIB_INCLUDE_INSTALL_DIR=$(INCLUDE_INSTALL_DIR)/X11; fi; \
for i in $(INCLUDE_INSTALL_DIR) $${XLIB_INCLUDE_INSTALL_DIR} \
$(SCRIPT_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)/images \
- $(SCRIPT_INSTALL_DIR)/msgs; \
+ $(SCRIPT_INSTALL_DIR)/msgs $(SCRIPT_INSTALL_DIR)/ttk; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
@@ -702,6 +752,13 @@ install-libraries: libraries
do \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
done;
+ @echo "Installing library ttk directory";
+ @for i in $(TOP_DIR)/library/ttk/*.tcl; \
+ do \
+ if [ -f $$i ] ; then \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/ttk; \
+ fi; \
+ done;
@echo "Installing library images directory";
@for i in $(TOP_DIR)/library/images/*; \
do \
@@ -1252,6 +1309,102 @@ ximage.o: $(XLIB_DIR)/ximage.c
xutil.o: $(XLIB_DIR)/xutil.c
$(CC) -c $(CC_SWITCHES) $(XLIB_DIR)/xutil.c
+ttkBlink.o: $(TTK_DIR)/ttkBlink.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkBlink.c
+
+ttkButton.o: $(TTK_DIR)/ttkButton.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkButton.c
+
+ttkCache.o: $(TTK_DIR)/ttkCache.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkCache.c
+
+ttkClamTheme.o: $(TTK_DIR)/ttkClamTheme.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkClamTheme.c
+
+ttkClassicTheme.o: $(TTK_DIR)/ttkClassicTheme.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkClassicTheme.c
+
+ttkDefaultTheme.o: $(TTK_DIR)/ttkDefaultTheme.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkDefaultTheme.c
+
+ttkElements.o: $(TTK_DIR)/ttkElements.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkElements.c
+
+ttkEntry.o: $(TTK_DIR)/ttkEntry.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkEntry.c
+
+ttkFrame.o: $(TTK_DIR)/ttkFrame.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkFrame.c
+
+ttkImage.o: $(TTK_DIR)/ttkImage.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkImage.c
+
+ttkInit.o: $(TTK_DIR)/ttkInit.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkInit.c
+
+ttkLabel.o: $(TTK_DIR)/ttkLabel.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkLabel.c
+
+ttkLayout.o: $(TTK_DIR)/ttkLayout.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkLayout.c
+
+ttkManager.o: $(TTK_DIR)/ttkManager.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkManager.c
+
+ttkNotebook.o: $(TTK_DIR)/ttkNotebook.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkNotebook.c
+
+ttkPanedwindow.o: $(TTK_DIR)/ttkPanedwindow.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkPanedwindow.c
+
+ttkProgress.o: $(TTK_DIR)/ttkProgress.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkProgress.c
+
+ttkScale.o: $(TTK_DIR)/ttkScale.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkScale.c
+
+ttkScroll.o: $(TTK_DIR)/ttkScroll.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkScroll.c
+
+ttkScrollbar.o: $(TTK_DIR)/ttkScrollbar.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkScrollbar.c
+
+ttkSeparator.o: $(TTK_DIR)/ttkSeparator.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkSeparator.c
+
+ttkSquare.o: $(TTK_DIR)/ttkSquare.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkSquare.c
+
+ttkState.o: $(TTK_DIR)/ttkState.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkState.c
+
+ttkStubInit.o: $(TTK_DIR)/ttkStubInit.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkStubInit.c
+
+ttkStubLib.o: $(TTK_DIR)/ttkStubLib.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkStubLib.c
+
+ttkTagSet.o: $(TTK_DIR)/ttkTagSet.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTagSet.c
+
+ttkTheme.o: $(TTK_DIR)/ttkTheme.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTheme.c
+
+ttkTrace.o: $(TTK_DIR)/ttkTrace.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTrace.c
+
+ttkTrack.o: $(TTK_DIR)/ttkTrack.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTrack.c
+
+ttkTreeview.o: $(TTK_DIR)/ttkTreeview.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkTreeview.c
+
+ttkWidget.o: $(TTK_DIR)/ttkWidget.c
+ $(CC) -c $(CC_SWITCHES) $(TTK_DIR)/ttkWidget.c
+
+ttkMacOSXTheme.o: $(MAC_OSX_DIR)/ttkMacOSXTheme.c
+ $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/ttkMacOSXTheme.c
+
.c.o:
$(CC) -c $(CC_SWITCHES) $<
@@ -1265,9 +1418,16 @@ $(GENERIC_DIR)/tkStubInit.c: $(GENERIC_DIR)/tk.decls \
@echo "Developers may want to run \"make genstubs\" to regenerate."
@echo "This warning can be safely ignored, do not report as a bug!"
+$(TTK_DIR)/ttkStubInit.c: $(TTK_DIR)/ttk.decls
+ @echo "Warning: ttkStubInit.c may be out of date."
+ @echo "Developers may want to run \"make genstubs\" to regenerate."
+ @echo "This warning can be safely ignored, do not report as a bug!"
+
genstubs:
$(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
$(GENERIC_DIR)/tk.decls $(GENERIC_DIR)/tkInt.decls
+# Need the Ttk specific genstubs as well
+# $(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(TTK_DIR) $(TTK_DIR)/ttk.decls
#
# Target to check that all exported functions have an entry in the stubs
@@ -1447,11 +1607,11 @@ dist: $(UNIX_DIR)/configure
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
$(TCLDIR)/doc/man.macros $(DISTDIR)/doc
mkdir $(DISTDIR)/tests
- cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/tests/*.test \
- $(TOP_DIR)/tests/*.tcl $(TOP_DIR)/tests/README \
- $(TOP_DIR)/tests/*.gif $(TOP_DIR)/tests/*.ppm \
- $(TOP_DIR)/tests/*.xbm \
- $(TOP_DIR)/tests/option.file* $(DISTDIR)/tests
+ cp -p $(TOP_DIR)/license.terms $(TEST_DIR)/*.test \
+ $(TEST_DIR)/*.tcl $(TEST_DIR)/README \
+ $(TEST_DIR)/*.gif $(TEST_DIR)/*.ppm \
+ $(TEST_DIR)/*.xbm \
+ $(TEST_DIR)/option.file* $(DISTDIR)/tests
#
# The following target can only be used for non-patch releases. Use
@@ -1500,9 +1660,7 @@ html-tk:
BUILD_HTML = \
@if test -f "$(BUILD_TCLSH)"; then \
- @LD_LIBRARY_PATH_VAR@=$(TCL_BIN_DIR):$${@LD_LIBRARY_PATH_VAR@}; export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
- TCLSH="$(BUILD_TCLSH)"; else \
+ $(SHELL_ENV) TCLSH="$(BUILD_TCLSH)"; else \
TCLSH="$(TCL_EXE)"; fi ;\
$${TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) \
--srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS)
diff --git a/win/Makefile.in b/win/Makefile.in
index a2ac0c2..963dcda 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -4,7 +4,7 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.69 2006/09/27 18:43:35 andreas_kupries Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.70 2006/10/31 01:42:27 hobbs Exp $
TCLVERSION = @TCL_VERSION@
TCLPATCHL = @TCL_PATCH_LEVEL@
@@ -113,6 +113,7 @@ ROOT_DIR = $(SRC_DIR)/..
WIN_DIR = $(SRC_DIR)
UNIX_DIR = $(SRC_DIR)/../unix
GENERIC_DIR = $(SRC_DIR)/../generic
+TTK_DIR = $(GENERIC_DIR)/ttk
BITMAP_DIR = $(ROOT_DIR)/bitmaps
XLIB_DIR = $(ROOT_DIR)/xlib
RC_DIR = $(WIN_DIR)/rc
@@ -149,7 +150,7 @@ MAN2TCL = man2tcl$(EXEEXT)
# makefile to look into these paths when resolving .c to .obj
# dependencies.
-VPATH = $(GENERIC_DIR):$(WIN_DIR):$(UNIX_DIR):$(XLIB_DIR):$(RC_DIR)
+VPATH = $(GENERIC_DIR):$(TTK_DIR):$(WIN_DIR):$(UNIX_DIR):$(XLIB_DIR):$(RC_DIR)
# warning flags
CFLAGS_WARNING = @CFLAGS_WARNING@
@@ -346,7 +347,44 @@ TK_OBJS = \
tkVisual.$(OBJEXT) \
tkStubInit.$(OBJEXT) \
tkStubLib.$(OBJEXT) \
- tkWindow.$(OBJEXT)
+ tkWindow.$(OBJEXT) \
+ $(TTK_OBJS)
+
+TTK_OBJS = \
+ ttkWinMonitor.$(OBJEXT) \
+ ttkWinTheme.$(OBJEXT) \
+ ttkWinXPTheme.$(OBJEXT) \
+ ttkBlink.$(OBJEXT) \
+ ttkButton.$(OBJEXT) \
+ ttkCache.$(OBJEXT) \
+ ttkClamTheme.$(OBJEXT) \
+ ttkClassicTheme.$(OBJEXT) \
+ ttkDefaultTheme.$(OBJEXT) \
+ ttkElements.$(OBJEXT) \
+ ttkEntry.$(OBJEXT) \
+ ttkFrame.$(OBJEXT) \
+ ttkImage.$(OBJEXT) \
+ ttkInit.$(OBJEXT) \
+ ttkLabel.$(OBJEXT) \
+ ttkLayout.$(OBJEXT) \
+ ttkManager.$(OBJEXT) \
+ ttkNotebook.$(OBJEXT) \
+ ttkPanedwindow.$(OBJEXT) \
+ ttkProgress.$(OBJEXT) \
+ ttkScale.$(OBJEXT) \
+ ttkScrollbar.$(OBJEXT) \
+ ttkScroll.$(OBJEXT) \
+ ttkSeparator.$(OBJEXT) \
+ ttkSquare.$(OBJEXT) \
+ ttkState.$(OBJEXT) \
+ ttkTagSet.$(OBJEXT) \
+ ttkTheme.$(OBJEXT) \
+ ttkTrace.$(OBJEXT) \
+ ttkTrack.$(OBJEXT) \
+ ttkTreeview.$(OBJEXT) \
+ ttkWidget.$(OBJEXT) \
+ ttkStubInit.$(OBJEXT) \
+ ttkStubLib.$(OBJEXT)
STUB_OBJS = \
tkStubLib.$(OBJEXT) \
@@ -358,6 +396,11 @@ CORE_DOCS = $(TCL_DOCS) $(TK_DOCS)
DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget
+SHELL_ENV = \
+ @TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \
+ TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \
+ PATH="$(TCL_BIN_DIR):$(PATH)"; export PATH;
+
# Main targets. The default target -- all -- builds the binaries,
# performs any post processing on libraries or documents.
@@ -385,26 +428,23 @@ $(MAN2TCL): $(TCL_SRC_DIR_NATIVE)/tools/man2tcl.c
# args to tcltest, ie:
# % make test TESTFLAGS="-verbose bps -file fileName.test"
-test: binaries $(TKTEST)
- @TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \
- TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \
- PATH="$(TCL_BIN_DIR):$(PATH)"; export PATH; \
- ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
- | ./$(CAT32)
+test: test-classic test-ttk
+
+test-classic: binaries $(TKTEST)
+ $(SHELL_ENV) ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" \
+ $(TESTFLAGS) | ./$(CAT32)
+
+test-ttk: binaries $(TKTEST)
+ $(SHELL_ENV) ./$(TKTEST) "$(ROOT_DIR_NATIVE)/tests/ttk/all.tcl" \
+ $(TESTFLAGS) | ./$(CAT32)
runtest: binaries $(TKTEST)
- @TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \
- TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \
- PATH="$(TCL_BIN_DIR):$(PATH)"; export PATH; \
- ./$(TKTEST) $(TESTFLAGS) $(SCRIPT)
+ $(SHELL_ENV) ./$(TKTEST) $(TESTFLAGS) $(SCRIPT)
# This target can be used to run wish from the build directory
# via `make shell` or `make shell SCRIPT=foo.tcl`
shell: binaries
- @TCL_LIBRARY="$(TCL_SRC_DIR_NATIVE)/library"; export TCL_LIBRARY; \
- TK_LIBRARY="$(ROOT_DIR_NATIVE)/library"; export TK_LIBRARY; \
- PATH="$(TCL_BIN_DIR):$(PATH)"; export PATH; \
- ./$(WISH) $(SCRIPT)
+ $(SHELL_ENV) ./$(WISH) $(SCRIPT)
# This target can be used to run wish inside either gdb or insight
gdb: binaries
@@ -454,7 +494,7 @@ install-libraries: libraries
@for i in $(INSTALL_ROOT)$(prefix)/lib \
$(INCLUDE_INSTALL_DIR) $(INCLUDE_INSTALL_DIR)/X11 \
$(SCRIPT_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)/images \
- $(SCRIPT_INSTALL_DIR)/msgs; \
+ $(SCRIPT_INSTALL_DIR)/msgs $(SCRIPT_INSTALL_DIR)/ttk; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
@@ -479,6 +519,13 @@ install-libraries: libraries
do \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
done;
+ @echo "Installing library ttk directory";
+ @for i in $(ROOT_DIR)/library/ttk/*.tcl; \
+ do \
+ if [ -f $$i ] ; then \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/ttk; \
+ fi; \
+ done;
@echo "Installing library images directory";
@for i in $(ROOT_DIR)/library/images/*; \
do \
@@ -611,7 +658,7 @@ tkSquare.$(OBJEXT): tkSquare.c
# Implicit rule for all object files that will end up in the Tcl library
.c.$(OBJEXT):
- $(CC) -c $(STUB_CC_SWITCHES) -DBUILD_tk @DEPARG@ $(CC_OBJNAME)
+ $(CC) -c $(STUB_CC_SWITCHES) -DBUILD_tk -DBUILD_ttk @DEPARG@ $(CC_OBJNAME)
.rc.$(RES):
$(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(TCL_PLATFORM_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@
diff --git a/win/configure b/win/configure
index a2b911c..8a3063c 100755
--- a/win/configure
+++ b/win/configure
@@ -3727,6 +3727,70 @@ fi
#--------------------------------------------------------------------
+# Windows XP theme engine header for Ttk
+#--------------------------------------------------------------------
+
+echo "$as_me:$LINENO: checking for uxtheme.h" >&5
+echo $ECHO_N "checking for uxtheme.h... $ECHO_C" >&6
+if test "${ac_cv_header_uxtheme_h+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <windows.h>
+
+#include <uxtheme.h>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_header_uxtheme_h=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_header_uxtheme_h=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_uxtheme_h" >&5
+echo "${ECHO_T}$ac_cv_header_uxtheme_h" >&6
+if test $ac_cv_header_uxtheme_h = yes; then
+ cat >>confdefs.h <<\_ACEOF
+#define HAVE_UXTHEME_H 1
+_ACEOF
+
+else
+ { echo "$as_me:$LINENO: xpnative theme will be unavailable" >&5
+echo "$as_me: xpnative theme will be unavailable" >&6;}
+fi
+
+
+
+#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option. This macro depends on C flags, and should be called
# after SC_CONFIG_CFLAGS macro is called.
diff --git a/win/configure.in b/win/configure.in
index 232eb29..601c3f6 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -3,7 +3,7 @@
# generate the file "configure", which is run during Tk installation
# to configure the system for the local environment.
#
-# RCS: @(#) $Id: configure.in,v 1.64 2006/10/23 19:46:14 dgp Exp $
+# RCS: @(#) $Id: configure.in,v 1.65 2006/10/31 01:42:28 hobbs Exp $
AC_INIT(../generic/tk.h)
AC_PREREQ(2.59)
@@ -138,6 +138,14 @@ AC_CHECK_HEADER(errno.h, , MAN2TCLFLAGS="-DNO_ERRNO_H")
AC_SUBST(MAN2TCLFLAGS)
#--------------------------------------------------------------------
+# Windows XP theme engine header for Ttk
+#--------------------------------------------------------------------
+
+AC_CHECK_HEADER([uxtheme.h], [AC_DEFINE(HAVE_UXTHEME_H)],
+ [AC_MSG_NOTICE([xpnative theme will be unavailable])],
+ [#include <windows.h>])
+
+#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option. This macro depends on C flags, and should be called
# after SC_CONFIG_CFLAGS macro is called.
diff --git a/win/ttkWinMonitor.c b/win/ttkWinMonitor.c
new file mode 100644
index 0000000..b13c36d
--- /dev/null
+++ b/win/ttkWinMonitor.c
@@ -0,0 +1,164 @@
+/* $Id: ttkWinMonitor.c,v 1.1 2006/10/31 01:42:28 hobbs Exp $
+ */
+
+#ifdef _MSC_VER
+#define WIN32_LEAN_AND_MEAN
+#endif
+
+#include <windows.h>
+#include <tcl.h>
+#include <tk.h>
+#include <tkPlatDecls.h>
+#include "ttk/ttkTheme.h"
+
+#if !defined(WM_THEMECHANGED)
+#define WM_THEMECHANGED 0x031A
+#endif
+
+static LRESULT WINAPI WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp);
+
+/*
+ * RegisterSystemColors --
+ * Register all known Windows system colors (as per GetSysColor)
+ * as Tk named colors.
+ */
+
+typedef struct {
+ const char *name;
+ int index;
+} SystemColorEntry;
+
+static SystemColorEntry sysColors[] = {
+ { "System3dDarkShadow", COLOR_3DDKSHADOW },
+ { "System3dLight", COLOR_3DLIGHT },
+ { "SystemActiveBorder", COLOR_ACTIVEBORDER },
+ { "SystemActiveCaption", COLOR_ACTIVECAPTION },
+ { "SystemAppWorkspace", COLOR_APPWORKSPACE },
+ { "SystemBackground", COLOR_BACKGROUND },
+ { "SystemButtonFace", COLOR_BTNFACE },
+ { "SystemButtonHighlight", COLOR_BTNHIGHLIGHT },
+ { "SystemButtonShadow", COLOR_BTNSHADOW },
+ { "SystemButtonText", COLOR_BTNTEXT },
+ { "SystemCaptionText", COLOR_CAPTIONTEXT },
+ { "SystemDisabledText", COLOR_GRAYTEXT },
+ { "SystemGrayText", COLOR_GRAYTEXT },
+ { "SystemHighlight", COLOR_HIGHLIGHT },
+ { "SystemHighlightText", COLOR_HIGHLIGHTTEXT },
+ { "SystemInactiveBorder", COLOR_INACTIVEBORDER },
+ { "SystemInactiveCaption", COLOR_INACTIVECAPTION },
+ { "SystemInactiveCaptionText", COLOR_INACTIVECAPTIONTEXT },
+ { "SystemInfoBackground", COLOR_INFOBK },
+ { "SystemInfoText", COLOR_INFOTEXT },
+ { "SystemMenu", COLOR_MENU },
+ { "SystemMenuText", COLOR_MENUTEXT },
+ { "SystemScrollbar", COLOR_SCROLLBAR },
+ { "SystemWindow", COLOR_WINDOW },
+ { "SystemWindowFrame", COLOR_WINDOWFRAME },
+ { "SystemWindowText", COLOR_WINDOWTEXT },
+ { NULL, 0 }
+};
+
+static void RegisterSystemColors(Tcl_Interp *interp)
+{
+ Ttk_ResourceCache cache = Ttk_GetResourceCache(interp);
+ SystemColorEntry *sysColor;
+
+ for (sysColor = sysColors; sysColor->name; ++sysColor) {
+ DWORD pixel = GetSysColor(sysColor->index);
+ XColor colorSpec;
+ colorSpec.red = GetRValue(pixel) * 257;
+ colorSpec.green = GetGValue(pixel) * 257;
+ colorSpec.blue = GetBValue(pixel) * 257;
+ Ttk_RegisterNamedColor(cache, sysColor->name, &colorSpec);
+ }
+}
+
+static HWND
+CreateThemeMonitorWindow(HINSTANCE hinst, Tcl_Interp *interp)
+{
+ WNDCLASSEX wc;
+ HWND hwnd = NULL;
+ CHAR title[32] = "TtkMonitorWindow";
+ CHAR name[32] = "TtkMonitorClass";
+
+ wc.cbSize = sizeof(WNDCLASSEX);
+ wc.style = CS_HREDRAW | CS_VREDRAW;
+ wc.lpfnWndProc = (WNDPROC)WndProc;
+ wc.cbClsExtra = 0;
+ wc.cbWndExtra = 0;
+ wc.hInstance = hinst;
+ wc.hIcon = LoadIcon(NULL, IDI_APPLICATION);
+ wc.hIconSm = LoadIcon(NULL, IDI_APPLICATION);
+ wc.hCursor = LoadCursor(NULL, IDC_ARROW);
+ wc.hbrBackground = (HBRUSH)COLOR_WINDOW;
+ wc.lpszMenuName = name;
+ wc.lpszClassName = name;
+
+ if (RegisterClassEx(&wc)) {
+ hwnd = CreateWindow( name, title, WS_OVERLAPPEDWINDOW,
+ CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
+ NULL, NULL, hinst, NULL );
+ SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG)interp);
+ ShowWindow(hwnd, SW_HIDE);
+ UpdateWindow(hwnd);
+ }
+ return hwnd;
+}
+
+static void
+DestroyThemeMonitorWindow(void *clientData)
+{
+ HWND hwnd = (HWND)clientData;
+ DestroyWindow(hwnd);
+}
+
+static LRESULT WINAPI
+WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp)
+{
+ Tcl_Interp *interp = (Tcl_Interp *)GetWindowLongPtr(hwnd, GWLP_USERDATA);
+ Ttk_Theme theme;
+
+ switch (msg) {
+ case WM_DESTROY:
+ break;
+
+ case WM_SYSCOLORCHANGE:
+ RegisterSystemColors(interp);
+ break;
+
+ case WM_THEMECHANGED:
+ /*
+ * Reset the application theme to 'xpnative' if present,
+ * which will in turn fall back to 'winnative' if XP theming
+ * is disabled.
+ */
+ theme = Ttk_GetTheme(interp, "xpnative");
+ if (theme) {
+ Ttk_UseTheme(interp, theme);
+ /* @@@ What to do about errors here? */
+ }
+ break;
+ }
+ return DefWindowProc(hwnd, msg, wp, lp);
+}
+
+/*
+ * Windows-specific platform initialization:
+ */
+
+extern int WinTheme_Init(Tcl_Interp *, HWND hwnd);
+extern int XPTheme_Init(Tcl_Interp *, HWND hwnd);
+
+int Ttk_WinPlatformInit(Tcl_Interp *interp)
+{
+ HWND hwnd;
+
+ hwnd = CreateThemeMonitorWindow(Tk_GetHINSTANCE(), interp);
+ Ttk_RegisterCleanup(interp, (ClientData)hwnd, DestroyThemeMonitorWindow);
+
+ WinTheme_Init(interp, hwnd);
+ XPTheme_Init(interp, hwnd);
+
+ return TCL_OK;
+}
+
diff --git a/win/ttkWinTheme.c b/win/ttkWinTheme.c
new file mode 100644
index 0000000..eb3a9eb
--- /dev/null
+++ b/win/ttkWinTheme.c
@@ -0,0 +1,730 @@
+/* winTheme.c - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sf.net>
+ *
+ * $Id: ttkWinTheme.c,v 1.1 2006/10/31 01:42:28 hobbs Exp $
+ */
+
+#ifdef _MSC_VER
+#define WIN32_LEAN_AND_MEAN
+#endif
+
+#include <windows.h>
+
+#include <tk.h>
+#include <tkWinInt.h>
+
+#ifndef DFCS_HOT /* Windows 98/Me, Windows 200/XP only */
+#define DFCS_HOT 0
+#endif
+
+#include "ttk/ttkTheme.h"
+
+/*
+ * BoxToRect --
+ * Helper routine. Converts a Ttk_Box to a Win32 RECT.
+ */
+static RECT BoxToRect(Ttk_Box b)
+{
+ RECT rc;
+ rc.top = b.y;
+ rc.left = b.x;
+ rc.bottom = b.y + b.height;
+ rc.right = b.x + b.width;
+ return rc;
+}
+
+/*
+ * ReliefToEdge --
+ * Convert a Tk "relief" value into an Windows "edge" value.
+ * NB: Caller must check for RELIEF_FLAT and RELIEF_SOLID,
+ * which must be handled specially.
+ *
+ * Passing the BF_FLAT flag to DrawEdge() yields something similar
+ * to TK_RELIEF_SOLID. TK_RELIEF_FLAT can be implemented by not
+ * drawing anything.
+ */
+static unsigned int ReliefToEdge(int relief)
+{
+ switch (relief) {
+ case TK_RELIEF_RAISED: return EDGE_RAISED;
+ case TK_RELIEF_SUNKEN: return EDGE_SUNKEN;
+ case TK_RELIEF_RIDGE: return EDGE_BUMP;
+ case TK_RELIEF_GROOVE: return EDGE_ETCHED;
+ case TK_RELIEF_SOLID: return BDR_RAISEDOUTER;
+ default:
+ case TK_RELIEF_FLAT: return BDR_RAISEDOUTER;
+ }
+}
+
+/* ---------------------------------------------------------------------- */
+
+static Ttk_StateTable checkbutton_statemap[] =
+{
+ { DFCS_CHECKED|DFCS_INACTIVE, TTK_STATE_SELECTED|TTK_STATE_DISABLED, 0 },
+ { DFCS_CHECKED|DFCS_PUSHED, TTK_STATE_SELECTED|TTK_STATE_PRESSED, 0 },
+ { DFCS_CHECKED, TTK_STATE_SELECTED, 0 },
+ { DFCS_INACTIVE, TTK_STATE_DISABLED, TTK_STATE_SELECTED },
+ { DFCS_PUSHED, TTK_STATE_PRESSED, TTK_STATE_SELECTED},
+ { 0, 0, 0 }
+};
+
+static Ttk_StateTable pushbutton_statemap[] =
+{
+ { DFCS_INACTIVE, TTK_STATE_DISABLED, 0 },
+ { DFCS_PUSHED, TTK_STATE_PRESSED, 0 },
+ { DFCS_HOT, TTK_STATE_ACTIVE, 0 },
+ { 0, 0, 0 }
+};
+
+static Ttk_StateTable arrow_statemap[] =
+{
+ { DFCS_INACTIVE, TTK_STATE_DISABLED, 0 },
+ { DFCS_PUSHED | DFCS_FLAT, TTK_STATE_PRESSED, 0 },
+ { 0, 0, 0 }
+};
+
+/*------------------------------------------------------------------------
+ * +++ FrameControlElement --
+ * General-purpose element for things drawn with DrawFrameControl
+ */
+typedef struct
+{
+ const char *name; /* element name */
+ int classId; /* class id for DrawFrameControl */
+ int partId; /* part id for DrawFrameControl */
+ int cxId; /* system metric id for size in x */
+ int cyId; /* system metric id for size in y */
+ Ttk_StateTable *stateMap; /* map Tk states to Win32 flags */
+ Ttk_Padding padding; /* additional placement padding */
+} FrameControlElementData;
+
+static FrameControlElementData FrameControlElements[] =
+{
+ { "Checkbutton.indicator",
+ DFC_BUTTON, DFCS_BUTTONCHECK, SM_CYMENUCHECK, SM_CYMENUCHECK,
+ checkbutton_statemap, {0,0,4,0} },
+ { "Radiobutton.indicator",
+ DFC_BUTTON, DFCS_BUTTONRADIO, SM_CYMENUCHECK, SM_CYMENUCHECK,
+ checkbutton_statemap, {0,0,4,0} },
+ { "uparrow",
+ DFC_SCROLL, DFCS_SCROLLUP, SM_CXVSCROLL, SM_CYVSCROLL,
+ arrow_statemap, {0,0,0,0} },
+ { "downarrow",
+ DFC_SCROLL, DFCS_SCROLLDOWN, SM_CXVSCROLL, SM_CYVSCROLL,
+ arrow_statemap, {0,0,0,0} },
+ { "leftarrow",
+ DFC_SCROLL, DFCS_SCROLLLEFT, SM_CXHSCROLL, SM_CYHSCROLL,
+ arrow_statemap, {0,0,0,0} },
+ { "rightarrow",
+ DFC_SCROLL, DFCS_SCROLLRIGHT, SM_CXHSCROLL, SM_CYHSCROLL,
+ arrow_statemap, {0,0,0,0} },
+ { "sizegrip",
+ DFC_SCROLL, DFCS_SCROLLSIZEGRIP, SM_CXVSCROLL, SM_CYHSCROLL,
+ arrow_statemap, {0,0,0,0} },
+
+ { 0,0,0,0,0,0, {0,0,0,0} }
+};
+
+/* ---------------------------------------------------------------------- */
+
+static void FrameControlElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ FrameControlElementData *elementData = clientData;
+ *widthPtr = GetSystemMetrics(elementData->cxId);
+ *heightPtr = GetSystemMetrics(elementData->cyId);
+ *paddingPtr = elementData->padding;
+}
+
+static void FrameControlElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ FrameControlElementData *elementData = clientData;
+ RECT rc = BoxToRect(b);
+ TkWinDCState dcState;
+ HDC hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+
+ DrawFrameControl(hdc, &rc,
+ elementData->classId,
+ elementData->partId|Ttk_StateTableLookup(elementData->stateMap, state));
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+}
+
+static Ttk_ElementSpec FrameControlElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ FrameControlElementGeometry,
+ FrameControlElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Border element implementation.
+ */
+
+typedef struct {
+ Tcl_Obj *reliefObj;
+} BorderElement;
+
+static Ttk_ElementOptionSpec BorderElementOptions[] = {
+ { "-relief",TK_OPTION_RELIEF,Tk_Offset(BorderElement,reliefObj), "flat" },
+ {NULL}
+};
+
+static void BorderElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ paddingPtr->left = paddingPtr->right = GetSystemMetrics(SM_CXEDGE);
+ paddingPtr->top = paddingPtr->bottom = GetSystemMetrics(SM_CYEDGE);
+}
+
+static void BorderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ BorderElement *border = elementRecord;
+ RECT rc = BoxToRect(b);
+ int relief = TK_RELIEF_FLAT;
+ TkWinDCState dcState;
+ HDC hdc;
+
+ Tk_GetReliefFromObj(NULL, border->reliefObj, &relief);
+
+ if (relief != TK_RELIEF_FLAT) {
+ UINT xFlags = (relief == TK_RELIEF_SOLID) ? BF_FLAT : 0;
+ hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+ DrawEdge(hdc, &rc, ReliefToEdge(relief), BF_RECT | xFlags);
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+ }
+}
+
+static Ttk_ElementSpec BorderElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(BorderElement),
+ BorderElementOptions,
+ BorderElementGeometry,
+ BorderElementDraw
+};
+
+/*
+ * Entry field borders:
+ * Sunken border; also fill with window color.
+ */
+
+typedef struct
+{
+ Tcl_Obj *backgroundObj;
+} FieldElement;
+
+static Ttk_ElementOptionSpec FieldElementOptions[] =
+{
+ { "-fieldbackground", TK_OPTION_BORDER,
+ Tk_Offset(FieldElement,backgroundObj), "white" },
+ {NULL}
+};
+
+static void
+FieldElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ paddingPtr->left = paddingPtr->right = GetSystemMetrics(SM_CXEDGE);
+ paddingPtr->top = paddingPtr->bottom = GetSystemMetrics(SM_CYEDGE);
+}
+
+static void
+FieldElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ FieldElement *field = elementRecord;
+ Tk_3DBorder bg = Tk_Get3DBorderFromObj(tkwin, field->backgroundObj);
+ RECT rc = BoxToRect(b);
+ TkWinDCState dcState;
+ HDC hdc;
+
+ Tk_Fill3DRectangle(
+ tkwin, d, bg, b.x, b.y, b.width, b.height, 0, TK_RELIEF_FLAT);
+
+ hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+ DrawEdge(hdc, &rc, EDGE_SUNKEN, BF_RECT);
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+}
+
+static Ttk_ElementSpec FieldElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(FieldElement),
+ FieldElementOptions,
+ FieldElementGeometry,
+ FieldElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Button borders.
+ * Drawn with DrawFrameControl instead of DrawEdge;
+ * Also draw default indicator and focus ring.
+ */
+typedef struct {
+ Tcl_Obj *reliefObj;
+ Tcl_Obj *highlightColorObj;
+ Tcl_Obj *defaultStateObj;
+} ButtonBorderElement;
+
+static Ttk_ElementOptionSpec ButtonBorderElementOptions[] = {
+ { "-relief",TK_OPTION_RELIEF,
+ Tk_Offset(ButtonBorderElement,reliefObj), "flat" },
+ { "-highlightcolor",TK_OPTION_COLOR,
+ Tk_Offset(ButtonBorderElement,highlightColorObj), "black" },
+ { "-default", TK_OPTION_ANY,
+ Tk_Offset(ButtonBorderElement,defaultStateObj), "disabled" },
+ {NULL}
+};
+
+static void ButtonBorderElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ButtonBorderElement *bd = elementRecord;
+ int relief = TK_RELIEF_RAISED;
+ int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+ short int cx, cy;
+
+ Tk_GetReliefFromObj(NULL, bd->reliefObj, &relief);
+ Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+ cx = GetSystemMetrics(SM_CXEDGE);
+ cy = GetSystemMetrics(SM_CYEDGE);
+
+ /* Space for default indicator:
+ */
+ if (defaultState != TTK_BUTTON_DEFAULT_DISABLED) {
+ ++cx; ++cy;
+ }
+
+ /* Space for focus ring:
+ */
+ cx += 2;
+ cy += 2;
+
+ *paddingPtr = Ttk_MakePadding(cx,cy,cx,cy);
+}
+
+static void ButtonBorderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ButtonBorderElement *bd = elementRecord;
+ int relief = TK_RELIEF_FLAT;
+ int defaultState = TTK_BUTTON_DEFAULT_DISABLED;
+ TkWinDCState dcState;
+ HDC hdc;
+ RECT rc;
+
+ Tk_GetReliefFromObj(NULL, bd->reliefObj, &relief);
+ Ttk_GetButtonDefaultStateFromObj(NULL, bd->defaultStateObj, &defaultState);
+
+ if (defaultState == TTK_BUTTON_DEFAULT_ACTIVE) {
+ XColor *highlightColor =
+ Tk_GetColorFromObj(tkwin, bd->highlightColorObj);
+ GC gc = Tk_GCForColor(highlightColor, d);
+ XDrawRectangle(Tk_Display(tkwin), d, gc, b.x,b.y,b.width-1,b.height-1);
+ }
+ if (defaultState != TTK_BUTTON_DEFAULT_DISABLED) {
+ ++b.x; ++b.y; b.width -= 2; b.height -= 2;
+ }
+
+ hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+
+ rc = BoxToRect(b);
+ DrawFrameControl(hdc, &rc,
+ DFC_BUTTON, /* classId */
+ DFCS_BUTTONPUSH | Ttk_StateTableLookup(pushbutton_statemap, state));
+
+ /* Draw focus ring:
+ */
+ if (state & TTK_STATE_FOCUS) {
+ short int borderWidth = 3; /* @@@ Use GetSystemMetrics?*/
+ rc = BoxToRect(Ttk_PadBox(b, Ttk_UniformPadding(borderWidth)));
+ DrawFocusRect(hdc, &rc);
+ }
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+}
+
+static Ttk_ElementSpec ButtonBorderElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(ButtonBorderElement),
+ ButtonBorderElementOptions,
+ ButtonBorderElementGeometry,
+ ButtonBorderElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Focus element.
+ * Draw dashed focus rectangle.
+ */
+
+static void FocusElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ *paddingPtr = Ttk_UniformPadding(1);
+}
+
+static void FocusElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ if (state & TTK_STATE_FOCUS) {
+ RECT rc = BoxToRect(b);
+ TkWinDCState dcState;
+ HDC hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+ DrawFocusRect(hdc, &rc);
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+ }
+}
+
+static Ttk_ElementSpec FocusElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ FocusElementGeometry,
+ FocusElementDraw
+};
+
+/* FillFocusElement --
+ * Draws a focus ring filled with the selection color
+ */
+
+typedef struct {
+ Tcl_Obj *fillColorObj;
+} FillFocusElement;
+
+static Ttk_ElementOptionSpec FillFocusElementOptions[] = {
+ { "-focusfill", TK_OPTION_COLOR,
+ Tk_Offset(FillFocusElement,fillColorObj), "white" },
+ { NULL }
+};
+
+ /* @@@ FIX THIS */
+static void FillFocusElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ FillFocusElement *focus = elementRecord;
+ if (state & TTK_STATE_FOCUS) {
+ RECT rc = BoxToRect(b);
+ TkWinDCState dcState;
+ XColor *fillColor = Tk_GetColorFromObj(tkwin, focus->fillColorObj);
+ GC gc = Tk_GCForColor(fillColor, d);
+ HDC hdc;
+
+ XFillRectangle(Tk_Display(tkwin),d,gc, b.x,b.y,b.width,b.height);
+ hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+ DrawFocusRect(hdc, &rc);
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+ }
+}
+
+/*
+ * ComboboxFocusElement --
+ * Read-only comboboxes have a filled focus ring, editable ones do not.
+ */
+static void ComboboxFocusElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ if (state & TTK_STATE_READONLY) {
+ FillFocusElementDraw(clientData, elementRecord, tkwin, d, b, state);
+ }
+}
+
+static Ttk_ElementSpec ComboboxFocusElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(FillFocusElement),
+ FillFocusElementOptions,
+ FocusElementGeometry,
+ ComboboxFocusElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Scrollbar trough element.
+ *
+ * The native windows scrollbar is drawn using a pattern brush giving a
+ * stippled appearance when the trough might otherwise be invisible.
+ * We can deal with this here.
+ */
+
+typedef struct { /* clientData for Trough element */
+ HBRUSH PatternBrush;
+ HBITMAP PatternBitmap;
+} TroughClientData;
+
+static const WORD Pattern[] = {
+ 0x5555, 0xaaaa, 0x5555, 0xaaaa, 0x5555, 0xaaaa, 0x5555, 0xaaaa
+};
+
+static void TroughClientDataDeleteProc(void *clientData)
+{
+ TroughClientData *cd = clientData;
+ DeleteObject(cd->PatternBrush);
+ DeleteObject(cd->PatternBitmap);
+ ckfree(clientData);
+}
+
+static TroughClientData *TroughClientDataInit(Tcl_Interp *interp)
+{
+ TroughClientData *cd = (TroughClientData*)ckalloc(sizeof(*cd));
+ cd->PatternBitmap = CreateBitmap(8, 8, 1, 1, Pattern);
+ cd->PatternBrush = CreatePatternBrush(cd->PatternBitmap);
+ Ttk_RegisterCleanup(interp, cd, TroughClientDataDeleteProc);
+ return cd;
+}
+
+static void TroughElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ TroughClientData *cd = clientData;
+ TkWinDCState dcState;
+ HDC hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+ HBRUSH hbr;
+ COLORREF bk, oldbk, oldtxt;
+
+ hbr = SelectObject(hdc, GetSysColorBrush(COLOR_SCROLLBAR));
+ bk = GetSysColor(COLOR_3DHIGHLIGHT);
+ oldtxt = SetTextColor(hdc, GetSysColor(COLOR_3DFACE));
+ oldbk = SetBkColor(hdc, bk);
+
+ /* WAS: if (bk (COLOR_3DHIGHLIGHT) == GetSysColor(COLOR_WINDOW)) ... */
+ if (GetSysColor(COLOR_SCROLLBAR) == GetSysColor(COLOR_BTNFACE)) {
+ /* Draw using the pattern brush */
+ SelectObject(hdc, cd->PatternBrush);
+ }
+
+ PatBlt(hdc, b.x, b.y, b.width, b.height, PATCOPY);
+ SetBkColor(hdc, oldbk);
+ SetTextColor(hdc, oldtxt);
+ SelectObject(hdc, hbr);
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+}
+
+static Ttk_ElementSpec TroughElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ NullElementGeometry,
+ TroughElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Thumb element.
+ */
+
+typedef struct
+{
+ Tcl_Obj *orientObj;
+} ThumbElement;
+
+static Ttk_ElementOptionSpec ThumbElementOptions[] =
+{
+ { "-orient", TK_OPTION_ANY,Tk_Offset(ThumbElement,orientObj),"horizontal"},
+ { NULL }
+};
+
+static void ThumbElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ThumbElement *thumbPtr = elementRecord;
+ int orient;
+
+ Ttk_GetOrientFromObj(NULL, thumbPtr->orientObj, &orient);
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ *widthPtr = GetSystemMetrics(SM_CXHTHUMB);
+ *heightPtr = GetSystemMetrics(SM_CYHSCROLL);
+ } else {
+ *widthPtr = GetSystemMetrics(SM_CXVSCROLL);
+ *heightPtr = GetSystemMetrics(SM_CYVTHUMB);
+ }
+}
+
+static void ThumbElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ RECT rc = BoxToRect(b);
+ TkWinDCState dcState;
+ HDC hdc;
+
+ /* Windows doesn't show a thumb when the scrollbar is disabled */
+ if (state & TTK_STATE_DISABLED)
+ return;
+
+ hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+ DrawEdge(hdc, &rc, EDGE_RAISED, BF_RECT | BF_MIDDLE);
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+}
+
+static Ttk_ElementSpec ThumbElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(ThumbElement),
+ ThumbElementOptions,
+ ThumbElementGeometry,
+ ThumbElementDraw
+};
+
+/* ----------------------------------------------------------------------
+ * The slider element is the shaped thumb used in the slider widget.
+ * Windows likes to call this a trackbar.
+ */
+
+typedef struct
+{
+ Tcl_Obj *orientObj; /* orientation of the slider widget */
+} SliderElement;
+
+static Ttk_ElementOptionSpec SliderElementOptions[] =
+{
+ { "-orient", TK_OPTION_ANY, Tk_Offset(SliderElement,orientObj),
+ "horizontal" },
+ { NULL }
+};
+
+static void SliderElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ SliderElement *slider = elementRecord;
+ int orient;
+
+ Ttk_GetOrientFromObj(NULL, slider->orientObj, &orient);
+ if (orient == TTK_ORIENT_HORIZONTAL) {
+ *widthPtr = (GetSystemMetrics(SM_CXHTHUMB) / 2) | 1;
+ *heightPtr = GetSystemMetrics(SM_CYHSCROLL);
+ } else {
+ *widthPtr = GetSystemMetrics(SM_CXVSCROLL);
+ *heightPtr = (GetSystemMetrics(SM_CYVTHUMB) / 2) | 1;
+ }
+}
+
+static void SliderElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ RECT rc = BoxToRect(b);
+ TkWinDCState dcState;
+ HDC hdc;
+
+ hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+ DrawEdge(hdc, &rc, EDGE_RAISED, BF_RECT | BF_MIDDLE);
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+}
+
+static Ttk_ElementSpec SliderElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(SliderElement),
+ SliderElementOptions,
+ SliderElementGeometry,
+ SliderElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Notebook elements.
+ */
+
+static void ClientElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ paddingPtr->left = paddingPtr->right = GetSystemMetrics(SM_CXEDGE);
+ paddingPtr->top = paddingPtr->bottom = GetSystemMetrics(SM_CYEDGE);
+}
+
+static void ClientElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ RECT rc = BoxToRect(b);
+ TkWinDCState dcState;
+ HDC hdc = TkWinGetDrawableDC(Tk_Display(tkwin), d, &dcState);
+ DrawEdge(hdc, &rc, EDGE_RAISED, BF_RECT | BF_SOFT);
+ TkWinReleaseDrawableDC(d, hdc, &dcState);
+}
+
+static Ttk_ElementSpec ClientElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ ClientElementGeometry,
+ ClientElementDraw
+};
+
+/*------------------------------------------------------------------------
+ * +++ Layouts.
+ */
+
+TTK_BEGIN_LAYOUT(ButtonLayout)
+ TTK_GROUP("Button.border", TTK_FILL_BOTH,
+ TTK_GROUP("Button.padding", TTK_FILL_BOTH,
+ TTK_NODE("Button.label", TTK_FILL_BOTH)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(ComboboxLayout)
+ TTK_GROUP("Combobox.field", TTK_FILL_BOTH,
+ TTK_NODE("Combobox.downarrow", TTK_PACK_RIGHT|TTK_FILL_Y)
+ TTK_GROUP("Combobox.padding", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_BOTH,
+ TTK_GROUP("Combobox.focus", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_BOTH,
+ TTK_NODE("Combobox.textarea", TTK_FILL_BOTH))))
+TTK_END_LAYOUT
+
+
+/* ---------------------------------------------------------------------- */
+
+int WinTheme_Init(Tcl_Interp *interp, HWND hwnd)
+{
+ Ttk_Theme themePtr, parentPtr;
+ FrameControlElementData *fce = FrameControlElements;
+
+ parentPtr = Ttk_GetTheme(interp, "alt");
+ themePtr = Ttk_CreateTheme(interp, "winnative", parentPtr);
+ if (!themePtr) {
+ return TCL_ERROR;
+ }
+
+ Ttk_RegisterElementSpec(themePtr, "border", &BorderElementSpec, NULL);
+ Ttk_RegisterElementSpec(themePtr, "Button.border",
+ &ButtonBorderElementSpec, NULL);
+ Ttk_RegisterElementSpec(themePtr, "field", &FieldElementSpec, NULL);
+ Ttk_RegisterElementSpec(themePtr, "focus", &FocusElementSpec, NULL);
+ Ttk_RegisterElementSpec(themePtr, "Combobox.focus",
+ &ComboboxFocusElementSpec, NULL);
+ Ttk_RegisterElementSpec(themePtr, "thumb", &ThumbElementSpec, NULL);
+ Ttk_RegisterElementSpec(themePtr, "slider", &SliderElementSpec, NULL);
+ Ttk_RegisterElementSpec(themePtr, "Scrollbar.trough", &TroughElementSpec,
+ TroughClientDataInit(interp));
+
+ Ttk_RegisterElementSpec(themePtr, "client", &ClientElementSpec, NULL);
+
+ for (fce = FrameControlElements; fce->name != 0; ++fce) {
+ Ttk_RegisterElementSpec(themePtr, fce->name,
+ &FrameControlElementSpec, fce);
+ }
+
+ Ttk_RegisterLayout(themePtr, "TButton", ButtonLayout);
+ Ttk_RegisterLayout(themePtr, "TCombobox", ComboboxLayout);
+
+ Tcl_PkgProvide(interp, "ttk::theme::winnative", TTK_VERSION);
+ return TCL_OK;
+}
+
diff --git a/win/ttkWinXPTheme.c b/win/ttkWinXPTheme.c
new file mode 100644
index 0000000..107aa55
--- /dev/null
+++ b/win/ttkWinXPTheme.c
@@ -0,0 +1,998 @@
+/*
+ * $Id: ttkWinXPTheme.c,v 1.1 2006/10/31 01:42:28 hobbs Exp $
+ *
+ * Tk theme engine which uses the Windows XP "Visual Styles" API
+ * Adapted from Georgios Petasis' XP theme patch.
+ *
+ * Copyright (c) 2003 by Georgios Petasis, petasis@iit.demokritos.gr.
+ * Copyright (c) 2003 by Joe English
+ * Copyright (c) 2003 by Pat Thoyts
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * See also:
+ *
+ * <URL: http://msdn.microsoft.com/library/en-us/
+ * shellcc/platform/commctls/userex/refentry.asp >
+ */
+
+#ifndef HAVE_UXTHEME_H
+/* Stub for platforms that lack the XP theme API headers: */
+#include <windows.h>
+#include <tcl.h>
+int XPTheme_Init(Tcl_Interp *interp, HWND hwnd) { return TCL_OK; }
+#else
+
+#define WINVER 0x0501 /* Requires Windows XP APIs */
+
+#include <windows.h>
+#include <uxtheme.h>
+#include <tmschema.h>
+
+#include <tkWinInt.h>
+
+#include "ttk/ttkTheme.h"
+
+typedef HTHEME (STDAPICALLTYPE OpenThemeDataProc)(HWND hwnd,
+ LPCWSTR pszClassList);
+typedef HRESULT (STDAPICALLTYPE CloseThemeDataProc)(HTHEME hTheme);
+typedef HRESULT (STDAPICALLTYPE DrawThemeBackgroundProc)(HTHEME hTheme,
+ HDC hdc, int iPartId, int iStateId, const RECT *pRect,
+ OPTIONAL const RECT *pClipRect);
+typedef HRESULT (STDAPICALLTYPE DrawThemeParentBackgroundProc)(HWND hwnd,
+ HDC hdc, OPTIONAL const RECT *prc);
+typedef HRESULT (STDAPICALLTYPE DrawThemeEdgeProc)(HTHEME hTheme, HDC hdc,
+ int iPartId, int iStateId, const RECT *pDestRect,
+ UINT uEdge, UINT uFlags, RECT *pContentRect);
+typedef HRESULT (STDAPICALLTYPE DrawThemeTextProc)(HTHEME hTheme, HDC hdc,
+ int iPartId, int iStateId, LPCWSTR pszText, int iCharCount,
+ DWORD dwTextFlags, DWORD dwTextFlags2, const RECT *pRect);
+typedef HRESULT (STDAPICALLTYPE GetThemeMarginsProc)(HTHEME, HDC,
+ int iPartId, int iStateId, int iPropId,
+ OPTIONAL RECT *prc, MARGINS *pMargins);
+typedef HRESULT (STDAPICALLTYPE GetThemePartSizeProc)(HTHEME,HDC,
+ int iPartId, int iStateId,
+ RECT *prc, enum THEMESIZE eSize, SIZE *psz);
+typedef HRESULT (STDAPICALLTYPE GetThemeTextExtentProc)(HTHEME hTheme, HDC hdc,
+ int iPartId, int iStateId, LPCWSTR pszText, int iCharCount,
+ DWORD dwTextFlags, const RECT *pBoundingRect, RECT *pExtentRect);
+typedef BOOL (STDAPICALLTYPE IsThemeActiveProc)(VOID);
+
+typedef struct
+{
+ OpenThemeDataProc *OpenThemeData;
+ CloseThemeDataProc *CloseThemeData;
+ DrawThemeBackgroundProc *DrawThemeBackground;
+ DrawThemeParentBackgroundProc *DrawThemeParentBackground;
+ DrawThemeEdgeProc *DrawThemeEdge;
+ DrawThemeTextProc *DrawThemeText;
+ GetThemePartSizeProc *GetThemePartSize;
+ GetThemeTextExtentProc *GetThemeTextExtent;
+ IsThemeActiveProc *IsThemeActive;
+
+ HWND stubWindow;
+} XPThemeProcs;
+
+typedef struct
+{
+ HINSTANCE hlibrary;
+ XPThemeProcs *procs;
+} XPThemeData;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LoadXPThemeProcs --
+ * Initialize XP theming support.
+ *
+ * XP theme support is included in UXTHEME.DLL
+ * We dynamically load this DLL at runtime instead of linking
+ * to it at build-time.
+ *
+ * Returns:
+ * A pointer to an XPThemeProcs table if successful, NULL otherwise.
+ */
+
+static XPThemeProcs *
+LoadXPThemeProcs(HINSTANCE *phlib)
+{
+ OSVERSIONINFO os;
+
+ /*
+ * We have to check whether we are running at least on Windows XP.
+ * In order to determine this we call GetVersionEx directly, although
+ * it would be a good idea to wrap it inside a function similar to
+ * TkWinGetPlatformId...
+ */
+ ZeroMemory(&os, sizeof(os));
+ os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ GetVersionEx(&os);
+ if (os.dwMajorVersion >= 5 && os.dwMinorVersion >= 1) {
+ /*
+ * We are running under Windows XP or a newer version.
+ * Load the library "uxtheme.dll", where the native widget
+ * drawing routines are implemented.
+ */
+ HINSTANCE handle;
+ *phlib = handle = LoadLibrary("uxtheme.dll");
+ if (handle != 0)
+ {
+ /*
+ * We have successfully loaded the library. Proceed in storing the
+ * addresses of the functions we want to use.
+ */
+ XPThemeProcs *procs = (XPThemeProcs*)ckalloc(sizeof(XPThemeProcs));
+#define LOADPROC(name) \
+ (0 != (procs->name = (name ## Proc *)GetProcAddress(handle, #name) ))
+
+ if ( LOADPROC(OpenThemeData)
+ && LOADPROC(CloseThemeData)
+ && LOADPROC(DrawThemeBackground)
+ && LOADPROC(DrawThemeParentBackground)
+ && LOADPROC(DrawThemeEdge)
+ && LOADPROC(DrawThemeText)
+ && LOADPROC(GetThemePartSize)
+ && LOADPROC(GetThemeTextExtent)
+ && LOADPROC(IsThemeActive)
+ )
+ {
+ return procs;
+ }
+#undef LOADPROC
+ ckfree((char*)procs);
+ }
+ }
+ return 0;
+}
+
+/*
+ * XPThemeDeleteProc --
+ *
+ * Release any theme allocated resources.
+ */
+
+static void
+XPThemeDeleteProc(void *clientData)
+{
+ XPThemeData *themeData = clientData;
+ FreeLibrary(themeData->hlibrary);
+ ckfree(clientData);
+}
+
+static int
+XPThemeEnabled(Ttk_Theme theme, void *clientData)
+{
+ XPThemeData *themeData = clientData;
+ return themeData->procs->IsThemeActive();
+}
+
+/*
+ * BoxToRect --
+ * Helper routine. Returns a RECT data structure.
+ */
+static RECT
+BoxToRect(Ttk_Box b)
+{
+ RECT rc;
+ rc.top = b.y;
+ rc.left = b.x;
+ rc.bottom = b.y + b.height;
+ rc.right = b.x + b.width;
+ return rc;
+}
+
+/*
+ * Map Tk state bitmaps to XP style enumerated values.
+ */
+static Ttk_StateTable null_statemap[] = { {0,0,0} };
+
+/*
+ * Pushbuttons (Tk: "Button")
+ */
+static Ttk_StateTable pushbutton_statemap[] =
+{
+ { PBS_DISABLED, TTK_STATE_DISABLED, 0 },
+ { PBS_PRESSED, TTK_STATE_PRESSED, 0 },
+ { PBS_HOT, TTK_STATE_ACTIVE, 0 },
+ { PBS_DEFAULTED, TTK_STATE_ALTERNATE, 0 },
+ { PBS_NORMAL, 0, 0 }
+};
+
+/*
+ * Checkboxes (Tk: "Checkbutton")
+ *
+ * Missing: CBS_MIXEDDISABLED CBS_MIXEDHOT CBS_MIXEDNORMAL CBS_MIXEDPRESSED
+ */
+static Ttk_StateTable checkbox_statemap[] =
+{
+{CBS_CHECKEDDISABLED, TTK_STATE_DISABLED|TTK_STATE_SELECTED, 0},
+{CBS_CHECKEDPRESSED, TTK_STATE_PRESSED|TTK_STATE_SELECTED, 0},
+{CBS_CHECKEDHOT, TTK_STATE_ACTIVE|TTK_STATE_SELECTED, 0},
+{CBS_CHECKEDNORMAL, TTK_STATE_SELECTED, 0},
+{CBS_UNCHECKEDDISABLED, TTK_STATE_DISABLED, TTK_STATE_SELECTED},
+{CBS_UNCHECKEDPRESSED, TTK_STATE_PRESSED, TTK_STATE_SELECTED},
+{CBS_UNCHECKEDHOT, TTK_STATE_ACTIVE, TTK_STATE_SELECTED},
+{CBS_UNCHECKEDNORMAL, 0,0 }
+};
+
+/*
+ * Radiobuttons:
+ */
+static Ttk_StateTable radiobutton_statemap[] =
+{
+{RBS_CHECKEDDISABLED, TTK_STATE_DISABLED|TTK_STATE_SELECTED, 0},
+{RBS_CHECKEDPRESSED, TTK_STATE_PRESSED|TTK_STATE_SELECTED, 0},
+{RBS_CHECKEDHOT, TTK_STATE_ACTIVE|TTK_STATE_SELECTED, 0},
+{RBS_CHECKEDNORMAL, TTK_STATE_SELECTED, 0},
+{RBS_UNCHECKEDDISABLED, TTK_STATE_DISABLED, TTK_STATE_SELECTED},
+{RBS_UNCHECKEDPRESSED, TTK_STATE_PRESSED, TTK_STATE_SELECTED},
+{RBS_UNCHECKEDHOT, TTK_STATE_ACTIVE, TTK_STATE_SELECTED},
+{RBS_UNCHECKEDNORMAL, 0,0 }
+};
+
+/*
+ * Groupboxes (tk: "frame")
+ */
+static Ttk_StateTable groupbox_statemap[] =
+{
+{GBS_DISABLED, TTK_STATE_DISABLED, 0},
+{GBS_NORMAL, 0,0 }
+};
+
+/*
+ * Edit fields (tk: "entry")
+ */
+static Ttk_StateTable edittext_statemap[] =
+{
+ { ETS_DISABLED, TTK_STATE_DISABLED, 0 },
+ { ETS_READONLY, TTK_STATE_READONLY, 0 },
+ { ETS_FOCUSED, TTK_STATE_FOCUS, 0 },
+ { ETS_HOT, TTK_STATE_ACTIVE, 0 },
+ { ETS_NORMAL, 0, 0 }
+/* NOT USED: ETS_ASSIST, ETS_SELECTED */
+};
+
+/*
+ * Combobox text field statemap:
+ * Same as edittext_statemap, but doesn't use ETS_READONLY
+ * (fixes: #1032409)
+ */
+static Ttk_StateTable combotext_statemap[] =
+{
+ { ETS_DISABLED, TTK_STATE_DISABLED, 0 },
+ { ETS_FOCUSED, TTK_STATE_FOCUS, 0 },
+ { ETS_HOT, TTK_STATE_ACTIVE, 0 },
+ { ETS_NORMAL, 0, 0 }
+};
+
+/*
+ * Combobox button: (CBP_DROPDOWNBUTTON)
+ */
+static Ttk_StateTable combobox_statemap[] = {
+ { CBXS_DISABLED, TTK_STATE_DISABLED, 0 },
+ { CBXS_PRESSED, TTK_STATE_PRESSED, 0 },
+ { CBXS_HOT, TTK_STATE_ACTIVE, 0 },
+ { CBXS_NORMAL, 0, 0 }
+};
+
+/*
+ * Toolbar buttons (TP_BUTTON):
+ */
+static Ttk_StateTable toolbutton_statemap[] = {
+ { TS_DISABLED, TTK_STATE_DISABLED, 0 },
+ { TS_PRESSED, TTK_STATE_PRESSED, 0 },
+ { TS_HOTCHECKED, TTK_STATE_SELECTED|TTK_STATE_ACTIVE, 0 },
+ { TS_CHECKED, TTK_STATE_SELECTED, 0 },
+ { TS_HOT, TTK_STATE_ACTIVE, 0 },
+ { TS_NORMAL, 0,0 }
+};
+
+/*
+ * Scrollbars (Tk: "Scrollbar.thumb")
+ */
+static Ttk_StateTable scrollbar_statemap[] =
+{
+ { SCRBS_DISABLED, TTK_STATE_DISABLED, 0 },
+ { SCRBS_PRESSED, TTK_STATE_PRESSED, 0 },
+ { SCRBS_HOT, TTK_STATE_ACTIVE, 0 },
+ { SCRBS_NORMAL, 0, 0 }
+};
+
+static Ttk_StateTable uparrow_statemap[] =
+{
+ { ABS_UPDISABLED, TTK_STATE_DISABLED, 0 },
+ { ABS_UPPRESSED, TTK_STATE_PRESSED, 0 },
+ { ABS_UPHOT, TTK_STATE_ACTIVE, 0 },
+ { ABS_UPNORMAL, 0, 0 }
+};
+
+static Ttk_StateTable downarrow_statemap[] =
+{
+ { ABS_DOWNDISABLED, TTK_STATE_DISABLED, 0 },
+ { ABS_DOWNPRESSED, TTK_STATE_PRESSED, 0 },
+ { ABS_DOWNHOT, TTK_STATE_ACTIVE, 0 },
+ { ABS_DOWNNORMAL, 0, 0 }
+};
+
+static Ttk_StateTable leftarrow_statemap[] =
+{
+ { ABS_LEFTDISABLED, TTK_STATE_DISABLED, 0 },
+ { ABS_LEFTPRESSED, TTK_STATE_PRESSED, 0 },
+ { ABS_LEFTHOT, TTK_STATE_ACTIVE, 0 },
+ { ABS_LEFTNORMAL, 0, 0 }
+};
+
+static Ttk_StateTable rightarrow_statemap[] =
+{
+ { ABS_RIGHTDISABLED,TTK_STATE_DISABLED, 0 },
+ { ABS_RIGHTPRESSED, TTK_STATE_PRESSED, 0 },
+ { ABS_RIGHTHOT, TTK_STATE_ACTIVE, 0 },
+ { ABS_RIGHTNORMAL, 0, 0 }
+};
+
+/*
+ * Trackbar thumb: (Tk: "scale slider")
+ */
+static Ttk_StateTable scale_statemap[] =
+{
+ { TUS_DISABLED, TTK_STATE_DISABLED, 0 },
+ { TUS_PRESSED, TTK_STATE_PRESSED, 0 },
+ { TUS_FOCUSED, TTK_STATE_FOCUS, 0 },
+ { TUS_HOT, TTK_STATE_ACTIVE, 0 },
+ { TUS_NORMAL, 0, 0 }
+};
+
+static Ttk_StateTable tabitem_statemap[] =
+{
+ { TIS_DISABLED, TTK_STATE_DISABLED, 0 },
+ { TIS_SELECTED, TTK_STATE_SELECTED, 0 },
+ { TIS_HOT, TTK_STATE_ACTIVE, 0 },
+ { TIS_FOCUSED, TTK_STATE_FOCUS, 0 },
+ { TIS_NORMAL, 0, 0 },
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ * +++ Element data:
+ *
+ * The following structure is passed as the 'clientData' pointer
+ * to most elements in this theme. It contains data relevant
+ * to a single XP Theme "part".
+ *
+ * <<NOTE-GetThemeMargins>>:
+ * In theory, we should be call GetThemeMargins(...TMT_CONTENTRECT...)
+ * to calculate the internal padding. In practice, this routine
+ * only seems to work properly for BP_PUSHBUTTON. So we hardcode
+ * the required padding at element registration time instead.
+ *
+ * <<NOTE-GetThemePartSize>>:
+ * This gives bogus metrics for some parts (in particular,
+ * BP_PUSHBUTTONS). Set the IGNORE_THEMESIZE flag to skip this call.
+ */
+
+typedef struct /* XP element specifications */
+{
+ const char *elementName; /* Tk theme engine element name */
+ Ttk_ElementSpec *elementSpec;
+ /* Element spec (usually GenericElementSpec) */
+ LPCWSTR className; /* Windows window class name */
+ int partId; /* BP_PUSHBUTTON, BP_CHECKBUTTON, etc. */
+ Ttk_StateTable *statemap; /* Map Tk states to XP states */
+ Ttk_Padding padding; /* See NOTE-GetThemeMargins */
+ int flags;
+# define IGNORE_THEMESIZE 0x1 /* See NOTE-GetThemePartSize */
+} ElementInfo;
+
+typedef struct
+{
+ /*
+ * Static data, initialized when element is registered:
+ */
+ ElementInfo *info;
+ XPThemeProcs *procs; /* Pointer to theme procedure table */
+
+ /*
+ * Dynamic data, allocated by InitElementData:
+ */
+ HTHEME hTheme;
+ HDC hDC;
+ HWND hwnd;
+
+ /* For TkWinDrawableReleaseDC: */
+ Drawable drawable;
+ TkWinDCState dcState;
+} ElementData;
+
+static ElementData *
+NewElementData(XPThemeProcs *procs, ElementInfo *info)
+{
+ ElementData *elementData = (ElementData*)ckalloc(sizeof(ElementData));
+
+ elementData->procs = procs;
+ elementData->info = info;
+ elementData->hTheme = elementData->hDC = 0;
+
+ return elementData;
+}
+
+static void DestroyElementData(void *elementData)
+{
+ ckfree(elementData);
+}
+
+/*
+ * InitElementData --
+ * Looks up theme handle. If Drawable argument is non-NULL,
+ * also initializes DC.
+ *
+ * Returns:
+ * 1 on success, 0 on error.
+ * Caller must later call FreeElementData() so this element
+ * can be reused.
+ */
+
+static int
+InitElementData(ElementData *elementData, Tk_Window tkwin, Drawable d)
+{
+ Window win = Tk_WindowId(tkwin);
+
+ if (win != None) {
+ elementData->hwnd = Tk_GetHWND(win);
+ } else {
+ elementData->hwnd = elementData->procs->stubWindow;
+ }
+
+ elementData->hTheme = elementData->procs->OpenThemeData(
+ elementData->hwnd, elementData->info->className);
+
+ if (!elementData->hTheme)
+ return 0;
+
+ elementData->drawable = d;
+ if (d != 0) {
+ elementData->hDC = TkWinGetDrawableDC(Tk_Display(tkwin), d,
+ &elementData->dcState);
+ }
+
+ return 1;
+}
+
+static void
+FreeElementData(ElementData *elementData)
+{
+ elementData->procs->CloseThemeData(elementData->hTheme);
+ if (elementData->drawable != 0) {
+ TkWinReleaseDrawableDC(
+ elementData->drawable, elementData->hDC, &elementData->dcState);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * +++ Generic element implementation.
+ *
+ * Used for elements which are handled entirely by the XP Theme API,
+ * such as radiobutton and checkbutton indicators, scrollbar arrows, etc.
+ */
+
+static void
+GenericElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ElementData *elementData = clientData;
+ HRESULT result;
+ SIZE size;
+
+ if (!InitElementData(elementData, tkwin, 0))
+ return;
+
+ if (!(elementData->info->flags & IGNORE_THEMESIZE)) {
+ result = elementData->procs->GetThemePartSize(
+ elementData->hTheme,
+ elementData->hDC,
+ elementData->info->partId,
+ Ttk_StateTableLookup(elementData->info->statemap, 0),
+ NULL /*RECT *prc*/,
+ TS_TRUE,
+ &size);
+
+ if (SUCCEEDED(result)) {
+ *widthPtr = size.cx;
+ *heightPtr = size.cy;
+ }
+ }
+
+ /* See NOTE-GetThemeMargins
+ */
+ *paddingPtr = elementData->info->padding;
+}
+
+static void
+GenericElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ElementData *elementData = clientData;
+ RECT rc = BoxToRect(b);
+
+ if (!InitElementData(elementData, tkwin, d))
+ return;
+
+ elementData->procs->DrawThemeBackground(
+ elementData->hTheme,
+ elementData->hDC,
+ elementData->info->partId,
+ Ttk_StateTableLookup(elementData->info->statemap, state),
+ &rc,
+ NULL/*pContentRect*/);
+
+ FreeElementData(elementData);
+}
+
+static Ttk_ElementSpec GenericElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ GenericElementGeometry,
+ GenericElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Scrollbar thumb element.
+ * Same as a GenericElement, but don't draw in the disabled state.
+ */
+
+static void
+ThumbElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ElementData *elementData = clientData;
+ unsigned stateId = Ttk_StateTableLookup(elementData->info->statemap, state);
+ RECT rc = BoxToRect(b);
+
+ /*
+ * Don't draw the thumb if we are disabled.
+ */
+ if (state & TTK_STATE_DISABLED)
+ return;
+
+ if (!InitElementData(elementData, tkwin, d))
+ return;
+
+ elementData->procs->DrawThemeBackground(elementData->hTheme,
+ elementData->hDC, elementData->info->partId, stateId,
+ &rc, NULL);
+
+ FreeElementData(elementData);
+}
+
+static Ttk_ElementSpec ThumbElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ GenericElementGeometry,
+ ThumbElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Progress bar element.
+ * Increases the requested length of PP_CHUNK and PP_CHUNKVERT parts
+ * so that indeterminate progress bars show 3 bars instead of 1.
+ */
+
+static void PbarElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ ElementData *elementData = clientData;
+ int nBars = 3;
+
+ GenericElementGeometry(clientData, elementRecord, tkwin,
+ widthPtr, heightPtr, paddingPtr);
+
+ if (elementData->info->partId == PP_CHUNK) {
+ *widthPtr *= nBars;
+ } else if (elementData->info->partId == PP_CHUNKVERT) {
+ *heightPtr *= nBars;
+ }
+}
+
+static Ttk_ElementSpec PbarElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ PbarElementGeometry,
+ GenericElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Notebook tab element.
+ * Same as generic element, with additional logic to select
+ * proper iPartID for the leftmost tab.
+ *
+ * Notes: TABP_TABITEMRIGHTEDGE (or TABP_TOPTABITEMRIGHTEDGE,
+ * which appears to be identical) should be used if the
+ * tab is exactly at the right edge of the notebook, but
+ * not if it's simply the rightmost tab. This information
+ * is not available.
+ *
+ * The TIS_* and TTKS_* definitions are identical, so
+ * we can use the same statemap no matter what the partId.
+ */
+static void TabElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ ElementData *elementData = clientData;
+ int partId = elementData->info->partId;
+ RECT rc = BoxToRect(b);
+
+ if (!InitElementData(elementData, tkwin, d))
+ return;
+ if (state & TTK_STATE_USER1)
+ partId = TABP_TABITEMLEFTEDGE;
+ elementData->procs->DrawThemeBackground(
+ elementData->hTheme, elementData->hDC, partId,
+ Ttk_StateTableLookup(elementData->info->statemap, state), &rc, NULL);
+ FreeElementData(elementData);
+}
+
+static Ttk_ElementSpec TabElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ GenericElementGeometry,
+ TabElementDraw
+};
+
+/*----------------------------------------------------------------------
+ * +++ Tree indicator element.
+ *
+ * Generic element, but don't display at all if TTK_STATE_LEAF (=USER2) set
+ */
+
+#define TTK_STATE_OPEN TTK_STATE_USER1
+#define TTK_STATE_LEAF TTK_STATE_USER2
+
+static Ttk_StateTable header_statemap[] =
+{
+ { HIS_PRESSED, TTK_STATE_PRESSED, 0 },
+ { HIS_HOT, TTK_STATE_ACTIVE, 0 },
+ { HIS_NORMAL, 0,0 },
+};
+
+static Ttk_StateTable tvpglyph_statemap[] =
+{
+ { GLPS_OPENED, TTK_STATE_OPEN, 0 },
+ { GLPS_CLOSED, 0,0 },
+};
+
+static void TreeIndicatorElementDraw(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ if (!(state & TTK_STATE_LEAF)) {
+ GenericElementDraw(clientData,elementRecord,tkwin,d,b,state);
+ }
+}
+
+static Ttk_ElementSpec TreeIndicatorElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(NullElement),
+ NullElementOptions,
+ GenericElementGeometry,
+ TreeIndicatorElementDraw
+};
+
+#if BROKEN_TEXT_ELEMENT
+
+/*
+ *----------------------------------------------------------------------
+ * Text element (does not work yet).
+ *
+ * According to "Using Windows XP Visual Styles", we need to select
+ * a font into the DC before calling DrawThemeText().
+ * There's just no easy way to get an HFONT out of a Tk_Font.
+ * Maybe GetThemeFont() would work?
+ *
+ */
+
+typedef struct
+{
+ Tcl_Obj *textObj;
+ Tcl_Obj *fontObj;
+} TextElement;
+
+static Ttk_ElementOptionSpec TextElementOptions[] =
+{
+ { "-text", TK_OPTION_STRING,
+ Tk_Offset(TextElement,textObj), "" },
+ { "-font", TK_OPTION_FONT,
+ Tk_Offset(TextElement,fontObj), DEFAULT_FONT },
+ { NULL }
+};
+
+static void
+TextElementGeometry(
+ void *clientData, void *elementRecord, Tk_Window tkwin,
+ int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr)
+{
+ TextElement *element = elementRecord;
+ ElementData *elementData = clientData;
+ RECT rc = {0, 0};
+ HRESULT hr = S_OK;
+
+ if (!InitElementData(elementData, tkwin, 0))
+ return;
+
+ hr = elementData->procs->GetThemeTextExtent(
+ elementData->hTheme,
+ elementData->hDC,
+ elementData->info->partId,
+ Ttk_StateTableLookup(elementData->info->statemap, 0),
+ Tcl_GetUnicode(element->textObj),
+ -1,
+ DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
+ NULL,
+ &rc);
+
+ if (SUCCEEDED(hr)) {
+ *widthPtr = rc.right - rc.left;
+ *heightPtr = rc.bottom - rc.top;
+ }
+ if (*widthPtr < 80) *widthPtr = 80;
+ if (*heightPtr < 20) *heightPtr = 20;
+
+ FreeElementData(elementData);
+}
+
+static void
+TextElementDraw(
+ ClientData clientData, void *elementRecord, Tk_Window tkwin,
+ Drawable d, Ttk_Box b, unsigned int state)
+{
+ TextElement *element = elementRecord;
+ ElementData *elementData = clientData;
+ RECT rc = BoxToRect(b);
+ HRESULT hr = S_OK;
+
+ if (!InitElementData(elementData, tkwin, d))
+ return;
+
+ hr = elementData->procs->DrawThemeText(
+ elementData->hTheme,
+ elementData->hDC,
+ elementData->info->partId,
+ Ttk_StateTableLookup(elementData->info->statemap, state),
+ Tcl_GetUnicode(element->textObj),
+ -1,
+ DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
+ (state & TTK_STATE_DISABLED) ? DTT_GRAYED : 0,
+ &rc);
+ FreeElementData(elementData);
+}
+
+static Ttk_ElementSpec TextElementSpec =
+{
+ TK_STYLE_VERSION_2,
+ sizeof(TextElement),
+ TextElementOptions,
+ TextElementGeometry,
+ TextElementDraw
+};
+
+#endif /* BROKEN_TEXT_ELEMENT */
+
+/*----------------------------------------------------------------------
+ * +++ Widget layouts:
+ */
+
+TTK_BEGIN_LAYOUT(ButtonLayout)
+ TTK_GROUP("Button.button", TTK_FILL_BOTH,
+ TTK_GROUP("Button.focus", TTK_FILL_BOTH,
+ TTK_GROUP("Button.padding", TTK_FILL_BOTH,
+ TTK_NODE("Button.label", TTK_FILL_BOTH))))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(MenubuttonLayout)
+ TTK_NODE("Menubutton.dropdown", TTK_PACK_RIGHT|TTK_FILL_Y)
+ TTK_GROUP("Menubutton.button", TTK_PACK_RIGHT|TTK_EXPAND|TTK_FILL_BOTH,
+ TTK_GROUP("Menubutton.padding", TTK_PACK_LEFT|TTK_EXPAND|TTK_FILL_X,
+ TTK_NODE("Menubutton.label", 0)))
+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_GROUP("Horizontal.Scrollbar.thumb", TTK_FILL_BOTH|TTK_UNIT,
+ TTK_NODE("Horizontal.Scrollbar.grip", 0)))
+TTK_END_LAYOUT
+
+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_GROUP("Vertical.Scrollbar.thumb", TTK_FILL_BOTH|TTK_UNIT,
+ TTK_NODE("Vertical.Scrollbar.grip", 0)))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(VerticalScaleLayout)
+ TTK_GROUP("Scale.focus", TTK_EXPAND|TTK_FILL_BOTH,
+ TTK_GROUP("Vertical.Scale.trough", TTK_EXPAND|TTK_FILL_BOTH,
+ TTK_NODE("Vertical.Scale.track", TTK_FILL_Y)
+ TTK_NODE("Vertical.Scale.slider", TTK_PACK_TOP) ))
+TTK_END_LAYOUT
+
+TTK_BEGIN_LAYOUT(HorizontalScaleLayout)
+ TTK_GROUP("Scale.focus", TTK_EXPAND|TTK_FILL_BOTH,
+ TTK_GROUP("Horizontal.Scale.trough", TTK_EXPAND|TTK_FILL_BOTH,
+ TTK_NODE("Horizontal.Scale.track", TTK_FILL_X)
+ TTK_NODE("Horizontal.Scale.slider", TTK_PACK_LEFT) ))
+TTK_END_LAYOUT
+
+/*----------------------------------------------------------------------
+ * +++ XP element info table:
+ */
+
+#define PAD(l,t,r,b) {l,t,r,b}
+#define NOPAD {0,0,0,0}
+
+/* name spec className partId statemap padding flags */
+
+static ElementInfo ElementInfoTable[] = {
+ { "Checkbutton.indicator", &GenericElementSpec, L"BUTTON",
+ BP_CHECKBOX, checkbox_statemap, PAD(0, 0, 4, 0), 0 },
+ { "Radiobutton.indicator", &GenericElementSpec, L"BUTTON",
+ BP_RADIOBUTTON, radiobutton_statemap, PAD(0, 0, 4, 0), 0 },
+ { "Button.button", &GenericElementSpec, L"BUTTON",
+ BP_PUSHBUTTON, pushbutton_statemap, PAD(3, 3, 3, 3), IGNORE_THEMESIZE },
+ { "Labelframe.border", &GenericElementSpec, L"BUTTON",
+ BP_GROUPBOX, groupbox_statemap, PAD(2, 2, 2, 2), 0 },
+ { "Entry.field", &GenericElementSpec, L"EDIT", EP_EDITTEXT,
+ edittext_statemap, PAD(1, 1, 1, 1), 0 },
+ { "Combobox.field", &GenericElementSpec, L"EDIT",
+ EP_EDITTEXT, combotext_statemap, PAD(1, 1, 1, 1), 0 },
+ { "Combobox.downarrow", &GenericElementSpec, L"COMBOBOX",
+ CP_DROPDOWNBUTTON, combobox_statemap, NOPAD, 0 },
+ { "Vertical.Scrollbar.trough", &GenericElementSpec, L"SCROLLBAR",
+ SBP_UPPERTRACKVERT, scrollbar_statemap, NOPAD, 0 },
+ { "Vertical.Scrollbar.thumb", &ThumbElementSpec, L"SCROLLBAR",
+ SBP_THUMBBTNVERT, scrollbar_statemap, NOPAD, 0 },
+ { "Vertical.Scrollbar.grip", &GenericElementSpec, L"SCROLLBAR",
+ SBP_GRIPPERVERT, scrollbar_statemap, NOPAD, 0 },
+ { "Horizontal.Scrollbar.trough", &GenericElementSpec, L"SCROLLBAR",
+ SBP_UPPERTRACKHORZ, scrollbar_statemap, NOPAD, 0 },
+ { "Horizontal.Scrollbar.thumb", &ThumbElementSpec, L"SCROLLBAR",
+ SBP_THUMBBTNHORZ, scrollbar_statemap, NOPAD, 0 },
+ { "Horizontal.Scrollbar.grip", &GenericElementSpec, L"SCROLLBAR",
+ SBP_GRIPPERHORZ, scrollbar_statemap, NOPAD, 0 },
+ { "Scrollbar.uparrow", &GenericElementSpec, L"SCROLLBAR",
+ SBP_ARROWBTN, uparrow_statemap, NOPAD, 0 },
+ { "Scrollbar.downarrow", &GenericElementSpec, L"SCROLLBAR",
+ SBP_ARROWBTN, downarrow_statemap, NOPAD, 0 },
+ { "Scrollbar.leftarrow", &GenericElementSpec, L"SCROLLBAR",
+ SBP_ARROWBTN, leftarrow_statemap, NOPAD, 0 },
+ { "Scrollbar.rightarrow", &GenericElementSpec, L"SCROLLBAR",
+ SBP_ARROWBTN, rightarrow_statemap, NOPAD, 0 },
+ { "Horizontal.Scale.slider", &GenericElementSpec, L"TRACKBAR",
+ TKP_THUMB, scale_statemap, NOPAD, 0 },
+ { "Vertical.Scale.slider", &GenericElementSpec, L"TRACKBAR",
+ TKP_THUMBVERT, scale_statemap, NOPAD, 0 },
+ { "Horizontal.Scale.track", &GenericElementSpec, L"TRACKBAR",
+ TKP_TRACK, scale_statemap, NOPAD, 0 },
+ { "Vertical.Scale.track", &GenericElementSpec, L"TRACKBAR",
+ TKP_TRACKVERT, scale_statemap, NOPAD, 0 },
+ /* ttk::progressbar elements */
+ { "Horizontal.Progressbar.pbar", &PbarElementSpec, L"PROGRESS",
+ PP_CHUNK, null_statemap, NOPAD, 0 },
+ { "Vertical.Progressbar.pbar", &PbarElementSpec, L"PROGRESS",
+ PP_CHUNKVERT, null_statemap, NOPAD, 0 },
+ { "Horizontal.Progressbar.trough", &GenericElementSpec, L"PROGRESS",
+ PP_BAR, null_statemap, PAD(3,3,3,3), IGNORE_THEMESIZE },
+ { "Vertical.Progressbar.trough", &GenericElementSpec, L"PROGRESS",
+ PP_BARVERT, null_statemap, PAD(3,3,3,3), IGNORE_THEMESIZE },
+ /* ttk::notebook */
+ { "tab", &TabElementSpec, L"TAB",
+ TABP_TABITEM, tabitem_statemap, PAD(3,3,3,0), 0 },
+ { "client", &GenericElementSpec, L"TAB",
+ TABP_PANE, null_statemap, PAD(1,1,3,3), 0 },
+ { "NotebookPane.background", &GenericElementSpec, L"TAB",
+ TABP_BODY, null_statemap, NOPAD, 0 },
+ { "Toolbutton.border", &GenericElementSpec, L"TOOLBAR",
+ TP_BUTTON, toolbutton_statemap, NOPAD,0 },
+ { "Menubutton.button", &GenericElementSpec, L"TOOLBAR",
+ TP_SPLITBUTTON,toolbutton_statemap, NOPAD,0 },
+ { "Menubutton.dropdown", &GenericElementSpec, L"TOOLBAR",
+ TP_SPLITBUTTONDROPDOWN,toolbutton_statemap, NOPAD,0 },
+ { "Treeitem.indicator", &TreeIndicatorElementSpec, L"TREEVIEW",
+ TVP_GLYPH, tvpglyph_statemap, PAD(1,1,6,0), 0 },
+ { "Treeheading.border", &GenericElementSpec, L"HEADER",
+ HP_HEADERITEM, header_statemap, PAD(4,0,4,0),0 },
+ { "sizegrip", &GenericElementSpec, L"STATUS",
+ SP_GRIPPER, null_statemap, NOPAD,0 },
+
+#if BROKEN_TEXT_ELEMENT
+ { "Labelframe.text", &TextElementSpec, L"BUTTON",
+ BP_GROUPBOX, groupbox_statemap, NOPAD,0 },
+#endif
+
+ { 0,0,0,0,0,NOPAD,0 }
+};
+#undef PAD
+
+/*----------------------------------------------------------------------
+ * +++ Initialization routine:
+ */
+
+int XPTheme_Init(Tcl_Interp *interp, HWND hwnd)
+{
+ XPThemeData *themeData;
+ XPThemeProcs *procs;
+ HINSTANCE hlibrary;
+ Ttk_Theme themePtr, parentPtr;
+ ElementInfo *infoPtr;
+
+ procs = LoadXPThemeProcs(&hlibrary);
+ if (!procs)
+ return TCL_ERROR;
+ procs->stubWindow = hwnd;
+
+ /*
+ * Create the new style engine.
+ */
+ parentPtr = Ttk_GetTheme(interp, "winnative");
+ themePtr = Ttk_CreateTheme(interp, "xpnative", parentPtr);
+
+ if (!themePtr)
+ return TCL_ERROR;
+
+ /*
+ * Set theme data and cleanup proc
+ */
+
+ themeData = (XPThemeData *)ckalloc(sizeof(XPThemeData));
+ themeData->procs = procs;
+ themeData->hlibrary = hlibrary;
+
+ Ttk_SetThemeEnabledProc(themePtr, XPThemeEnabled, themeData);
+ Ttk_RegisterCleanup(interp, themeData, XPThemeDeleteProc);
+
+ /*
+ * New elements:
+ */
+ for (infoPtr = ElementInfoTable; infoPtr->elementName != 0; ++infoPtr) {
+ ClientData clientData = NewElementData(procs, infoPtr);
+ Ttk_RegisterElementSpec(
+ themePtr, infoPtr->elementName, infoPtr->elementSpec, clientData);
+ Ttk_RegisterCleanup(interp, clientData, DestroyElementData);
+ }
+
+ Ttk_RegisterElementSpec(themePtr, "Scale.trough", &NullElementSpec, 0);
+
+ /*
+ * Layouts:
+ */
+ Ttk_RegisterLayout(themePtr, "TButton", ButtonLayout);
+ Ttk_RegisterLayout(themePtr, "TMenubutton", MenubuttonLayout);
+ Ttk_RegisterLayout(themePtr, "Vertical.TScrollbar",
+ VerticalScrollbarLayout);
+ Ttk_RegisterLayout(themePtr, "Horizontal.TScrollbar",
+ HorizontalScrollbarLayout);
+ Ttk_RegisterLayout(themePtr, "Vertical.TScale", VerticalScaleLayout);
+ Ttk_RegisterLayout(themePtr, "Horizontal.TScale", HorizontalScaleLayout);
+
+ Tcl_PkgProvide(interp, "ttk::theme::xpnative", TTK_VERSION);
+
+ return TCL_OK;
+}
+
+#endif /* HAVE_UXTHEME_H */