diff options
Diffstat (limited to 'library/demos')
| -rw-r--r-- | library/demos/ttk_demo.tcl | 883 | ||||
| -rw-r--r-- | library/demos/ttk_iconlib.tcl | 110 | ||||
| -rw-r--r-- | library/demos/ttk_repeater.tcl | 117 |
3 files changed, 1110 insertions, 0 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* |