summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorhobbs <hobbs>2006-10-31 01:42:25 (GMT)
committerhobbs <hobbs>2006-10-31 01:42:25 (GMT)
commit397a2c9832bf618f26be267501cf49ab06a562ec (patch)
tree61d5e957eccfcba57b0dd27ebc73db085385834e /library
parent18d330543869e240c2bd12fc9fbb8d5027f5cad6 (diff)
downloadtk-397a2c9832bf618f26be267501cf49ab06a562ec.zip
tk-397a2c9832bf618f26be267501cf49ab06a562ec.tar.gz
tk-397a2c9832bf618f26be267501cf49ab06a562ec.tar.bz2
* doc/ttk_Geometry.3, doc/ttk_Theme.3, doc/ttk_button.n:
* doc/ttk_checkbutton.n, doc/ttk_combobox.n, doc/ttk_dialog.n: * doc/ttk_entry.n, doc/ttk_frame.n, doc/ttk_image.n: * doc/ttk_intro.n, doc/ttk_label.n, doc/ttk_labelframe.n: * doc/ttk_menubutton.n, doc/ttk_notebook.n, doc/ttk_panedwindow.n: * doc/ttk_progressbar.n, doc/ttk_radiobutton.n, doc/ttk_scrollbar.n: * doc/ttk_separator.n, doc/ttk_sizegrip.n, doc/ttk_style.n: * doc/ttk_treeview.n, doc/ttk_widget.n,: * generic/ttk/ttk.decls, generic/ttk/ttkBlink.c: * generic/ttk/ttkButton.c, generic/ttk/ttkCache.c: * generic/ttk/ttkClamTheme.c, generic/ttk/ttkClassicTheme.c: * generic/ttk/ttkDecls.h, generic/ttk/ttkDefaultTheme.c: * generic/ttk/ttkElements.c, generic/ttk/ttkEntry.c: * generic/ttk/ttkFrame.c, generic/ttk/ttkImage.c: * generic/ttk/ttkInit.c, generic/ttk/ttkLabel.c: * generic/ttk/ttkLayout.c, generic/ttk/ttkManager.c: * generic/ttk/ttkManager.h, generic/ttk/ttkNotebook.c: * generic/ttk/ttkPanedwindow.c, generic/ttk/ttkProgress.c: * generic/ttk/ttkScale.c, generic/ttk/ttkScroll.c: * generic/ttk/ttkScrollbar.c, generic/ttk/ttkSeparator.c: * generic/ttk/ttkSquare.c, generic/ttk/ttkState.c: * generic/ttk/ttkStubInit.c, generic/ttk/ttkStubLib.c: * generic/ttk/ttkTagSet.c, generic/ttk/ttkTheme.c: * generic/ttk/ttkTheme.h, generic/ttk/ttkThemeInt.h: * generic/ttk/ttkTrace.c, generic/ttk/ttkTrack.c: * generic/ttk/ttkTreeview.c, generic/ttk/ttkWidget.c: * generic/ttk/ttkWidget.h: * library/demos/ttk_demo.tcl, library/demos/ttk_iconlib.tcl: * library/demos/ttk_repeater.tcl: * library/ttk/altTheme.tcl, library/ttk/aquaTheme.tcl: * library/ttk/button.tcl, library/ttk/clamTheme.tcl: * library/ttk/classicTheme.tcl, library/ttk/combobox.tcl: * library/ttk/cursors.tcl, library/ttk/defaults.tcl: * library/ttk/dialog.tcl, library/ttk/entry.tcl: * library/ttk/fonts.tcl, library/ttk/icons.tcl: * library/ttk/keynav.tcl, library/ttk/menubutton.tcl: * library/ttk/notebook.tcl, library/ttk/panedwindow.tcl: * library/ttk/progress.tcl, library/ttk/scale.tcl: * library/ttk/scrollbar.tcl, library/ttk/sizegrip.tcl: * library/ttk/treeview.tcl, library/ttk/ttk.tcl: * library/ttk/utils.tcl, library/ttk/winTheme.tcl: * library/ttk/xpTheme.tcl: * macosx/ttkMacOSXTheme.c: * tests/ttk/all.tcl, tests/ttk/bwidget.test, tests/ttk/combobox.test: * tests/ttk/entry.test, tests/ttk/image.test: * tests/ttk/labelframe.test, tests/ttk/layout.test: * tests/ttk/misc.test, tests/ttk/notebook.test: * tests/ttk/panedwindow.test, tests/ttk/progressbar.test: * tests/ttk/scrollbar.test, tests/ttk/treetags.test: * tests/ttk/treeview.test, tests/ttk/ttk.test, tests/ttk/validate.test: * win/ttkWinMonitor.c, win/ttkWinTheme.c, win/ttkWinXPTheme.c: First import of Ttk themed Tk widgets as branched from tile 0.7.8 * generic/tkInt.h, generic/tkWindow.c: add Ttk_Init call, copy tk classic widgets to ::tk namespace. * library/tk.tcl: add source of ttk/ttk.tcl, define $::ttk::library. * unix/Makefile.in, win/Makefile.in: add Ttk build bits * win/configure, win/configure.in: check for uxtheme.h (XP theme).
Diffstat (limited to 'library')
-rw-r--r--library/demos/ttk_demo.tcl883
-rw-r--r--library/demos/ttk_iconlib.tcl110
-rw-r--r--library/demos/ttk_repeater.tcl117
-rw-r--r--library/tk.tcl26
-rw-r--r--library/ttk/altTheme.tcl85
-rw-r--r--library/ttk/aquaTheme.tcl60
-rw-r--r--library/ttk/button.tcl85
-rw-r--r--library/ttk/clamTheme.tcl119
-rw-r--r--library/ttk/classicTheme.tcl94
-rw-r--r--library/ttk/combobox.tcl360
-rw-r--r--library/ttk/cursors.tcl35
-rw-r--r--library/ttk/defaults.tcl95
-rw-r--r--library/ttk/dialog.tcl272
-rw-r--r--library/ttk/entry.tcl580
-rw-r--r--library/ttk/fonts.tcl132
-rw-r--r--library/ttk/icons.tcl105
-rw-r--r--library/ttk/keynav.tcl163
-rw-r--r--library/ttk/menubutton.tcl171
-rw-r--r--library/ttk/notebook.tcl205
-rw-r--r--library/ttk/panedwindow.tcl87
-rw-r--r--library/ttk/progress.tcl51
-rw-r--r--library/ttk/scale.tcl54
-rw-r--r--library/ttk/scrollbar.tcl107
-rw-r--r--library/ttk/sizegrip.tcl77
-rw-r--r--library/ttk/treeview.tcl423
-rw-r--r--library/ttk/ttk.tcl200
-rw-r--r--library/ttk/utils.tcl234
-rw-r--r--library/ttk/winTheme.tcl61
-rw-r--r--library/ttk/xpTheme.tcl51
29 files changed, 5035 insertions, 7 deletions
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}
+ }
+}