diff options
116 files changed, 37030 insertions, 64 deletions
@@ -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], ¤tIndex) != 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 */ |