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, 0 insertions, 1110 deletions
diff --git a/library/demos/ttk_demo.tcl b/library/demos/ttk_demo.tcl deleted file mode 100644 index 0686b62..0000000 --- a/library/demos/ttk_demo.tcl +++ /dev/null @@ -1,883 +0,0 @@ -# -# $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 deleted file mode 100644 index 9a93ece..0000000 --- a/library/demos/ttk_iconlib.tcl +++ /dev/null @@ -1,110 +0,0 @@ -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 deleted file mode 100644 index b515ed4..0000000 --- a/library/demos/ttk_repeater.tcl +++ /dev/null @@ -1,117 +0,0 @@ -# -# $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* |