diff options
| -rw-r--r-- | ChangeLog | 21 | ||||
| -rw-r--r-- | library/demos/combo.tcl | 60 | ||||
| -rw-r--r-- | library/demos/en.msg | 4 | ||||
| -rw-r--r-- | library/demos/nl.msg | 75 | ||||
| -rw-r--r-- | library/demos/toolbar.tcl | 95 | ||||
| -rw-r--r-- | library/demos/tree.tcl | 91 | ||||
| -rw-r--r-- | library/demos/ttkbut.tcl | 41 | ||||
| -rw-r--r-- | library/demos/ttknote.tcl | 56 | ||||
| -rw-r--r-- | library/demos/ttkprogress.tcl | 46 | ||||
| -rw-r--r-- | library/demos/widget | 56 |
10 files changed, 464 insertions, 81 deletions
@@ -1,11 +1,20 @@ +2007-10-22 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/widget: Added more demos, reorganized to make Tk and + Ttk demos seem to be more coherent whole. Made localization a bit + easier by reducing the amount of duplication. + * library/demos/{combo,toolbar,tree,ttknote,ttkprogress}.tcl: New + demos of new (mostly) Ttk widgets. + * library/demos/ttkbut.tcl: Improvements. + 2007-10-21 Joe English <jenglish@users.sourceforge.net> - * library/ttk/combobox.tcl: ttk::combobox overhaul; - fixes [#1814778, #1780286, #1609168, #1349586] - * library/ttk/aquaTheme.tcl: Factored out aqua-specific - combobox -postposition adjustments. - * generic/ttk/ttkTrack.c: Detect [grab]s and unpress - pressed element; combobox workaround no longer needed. + * library/ttk/combobox.tcl: ttk::combobox overhaul; fixes [#1814778, + #1780286, #1609168, #1349586] + * library/ttk/aquaTheme.tcl: Factored out aqua-specific combobox + -postposition adjustments. + * generic/ttk/ttkTrack.c: Detect [grab]s and unpress pressed element; + combobox workaround no longer needed. 2007-10-22 Daniel Steffen <das@users.sourceforge.net> diff --git a/library/demos/combo.tcl b/library/demos/combo.tcl new file mode 100644 index 0000000..ed9c585 --- /dev/null +++ b/library/demos/combo.tcl @@ -0,0 +1,60 @@ +# combo.tcl -- +# +# This demonstration script creates several combobox widgets. +# +# RCS: @(#) $Id: combo.tcl,v 1.1 2007/10/22 14:21:10 dkf Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk +package require Ttk + +set w .combo +catch {destroy $w} +toplevel $w +wm title $w "Combobox Demonstration" +wm iconname $w "combo" +positionWindow $w + +label $w.msg -font $font -wraplength 5i -justify left -text "Three different\ + combo-boxes are displayed below. You can add characters to the first\ + one by pointing, clicking and typing, just as with an entry; pressing\ + Return will cause the current value to be added to the list that is\ + selectable from the drop-down list, and you can choose other values\ + by pressing the Down key, using the arrow keys to pick another one,\ + and pressing Return again. The second combo-box is fixed to a\ + particular value, and cannot be modified at all. The third one only\ + allows you to select values from its drop-down list of Australian\ + cities." +pack $w.msg -side top + +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w {firstValue secondValue ozCity}] +pack $btns -side bottom -fill x + +set australianCities { + Canberra Sydney Melbourne Perth Adelaide Brisbane + Hobart Darwin "Alice Springs" +} +set secondValue unchangable +set ozCity Sydney + +ttk::labelframe $w.c1 -text "Fully Editable" +ttk::combobox $w.c1.c -textvariable firstValue +ttk::labelframe $w.c2 -text Disabled +ttk::combobox $w.c2.c -textvariable secondValue -state disabled +ttk::labelframe $w.c3 -text "Defined List Only" +ttk::combobox $w.c3.c -textvariable ozCity -state readonly \ + -values $australianCities +bind $w.c1.c <Return> { + if {[%W get] ni [%W cget -values]} { + %W configure -values [concat [%W cget -values] [list [%W get]]] + } +} + +pack $w.c1 $w.c2 $w.c3 -side top -pady 5 -padx 10 +pack $w.c1.c -pady 5 -padx 10 +pack $w.c2.c -pady 5 -padx 10 +pack $w.c3.c -pady 5 -padx 10 diff --git a/library/demos/en.msg b/library/demos/en.msg index e3914c5..d4783fe 100644 --- a/library/demos/en.msg +++ b/library/demos/en.msg @@ -5,8 +5,10 @@ ::msgcat::mcset en "&About..." ::msgcat::mcset en "<F1>" ::msgcat::mcset en "&Quit" -::msgcat::mcset en "Meta-Q" ;# Displayed hotkey +::msgcat::mcset en "Meta+Q" ;# Displayed hotkey ::msgcat::mcset en "Meta-q" ;# Actual binding sequence +::msgcat::mcset en "Ctrl+Q" ;# Displayed hotkey +::msgcat::mcset en "Control-q" ;# Actual binding sequence ::msgcat::mcset en "Variable values" ::msgcat::mcset en "Variable values:" ::msgcat::mcset en "OK" diff --git a/library/demos/nl.msg b/library/demos/nl.msg index cf89099..1c3a8c3 100644 --- a/library/demos/nl.msg +++ b/library/demos/nl.msg @@ -5,68 +5,42 @@ mcset nl "About..." "Info..." mcset nl "&About..." "&Info..." mcset nl "<F1>" "<F1>" mcset nl "&Quit" "&Einde" -mcset nl "Meta-Q" "Meta-E" ;# Displayed hotkey +mcset nl "Meta+Q" "Meta+E" ;# Displayed hotkey mcset nl "Meta-q" "Meta-e" ;# Actual binding sequence +mcset nl "Ctrl+Q" "Ctrl+E" ;# Displayed hotkey +mcset nl "Control-q" "Control-e" ;# Actual binding sequence mcset nl "Dismiss" "Sluiten" -mcset nl "See Code" "Bekijk Code" mcset nl "See Variables" "Bekijk Variabelen" mcset nl "Variable Values" "Waarden Variabelen" mcset nl "OK" "OK" mcset nl "Run the \"%s\" sample program" "Start voorbeeld \"%s\"" -mcset nl "Rerun Demo" "Herstart Demo" mcset nl "Print Code" "Code Afdrukken" mcset nl "Demo code: %s" "Code van Demo %s" mcset nl "About Widget Demo" "Over deze demonstratie" mcset nl "Tk widget demonstration" "Demonstratie van Tk widgets" mcset nl "Copyright (c) %s" "Copyright (c) %s" -mcset nl { - @@title - Tk Widget Demonstrations - @@newline - @@normal - @@newline - - This application provides a front end for several short scripts - that demonstrate what you can do with Tk widgets. Each of the - numbered lines below describes a demonstration; you can click on - it to invoke the demonstration. Once the demonstration window - appears, you can click the - @@bold - See Code - @@normal - button to see the Tcl/Tk code that created the demonstration. If - you wish, you can edit the code and click the - @@bold - Rerun Demo - @@normal - button in the code window to reinvoke the demonstration with the - modified code. - @@newline -} { - @@title - Demostratie van Tk widgets - @@newline - @@normal - @@newline - - Dit programma is een schil rond enkele korte scripts waarmee - gedemonstreerd wordt wat je kunt doen met Tk widgets. Elk van de - genummerde regels hieronder omschrijft een demonstratie; je kunt de - demonstratie starten door op de regel te klikken. - Zodra het nieuwe venster verschijnt, kun je op de knop - @@bold - Bekijk Code - @@normal - drukken om de achterliggende Tcl/Tk code te zien. Als je dat wilt, - kun je de code wijzigen en op de knop - @@bold - Herstart Demo - @@normal - drukken in het codevenster om de demonstratie uit te voeren met de - nieuwe code. - @@newline -} +mcset nl "Tk Widget Demonstrations" "Demostratie van Tk widgets" +mcset nl "This application provides a front end for several short scripts" \ + "Dit programma is een schil rond enkele korte scripts waarmee" +mcset nl "that demonstrate what you can do with Tk widgets. Each of the" \ + "gedemonstreerd wordt wat je kunt doen met Tk widgets. Elk van de" +mcset nl "numbered lines below describes a demonstration; you can click on" \ + "genummerde regels hieronder omschrijft een demonstratie; je kunt de" +mcset nl "it to invoke the demonstration. Once the demonstration window" \ + "demonstratie starten door op de regel te klikken." +mcset nl "appears, you can click the" \ + "Zodra het nieuwe venster verschijnt, kun je op de knop" +mcset nl "See Code" "Bekijk Code" ;# This is also button text! +mcset nl "button to see the Tcl/Tk code that created the demonstration. If" \ + "drukken om de achterliggende Tcl/Tk code te zien. Als je dat wilt," +mcset nl "you wish, you can edit the code and click the" \ + "kun je de code wijzigen en op de knop" +mcset nl "Rerun Demo" "Herstart Demo" ;# This is also button text! +mcset nl "button in the code window to reinvoke the demonstration with the" \ + "drukken in het codevenster om de demonstratie uit te voeren met de" +mcset nl "modified code." \ + "nieuwe code." mcset nl "Labels, buttons, checkbuttons, and radiobuttons" \ "Labels, knoppen, vinkjes/aankruishokjes en radioknoppen" @@ -142,4 +116,3 @@ mcset nl "A dialog box with a local grab" \ "Een dialoogvenster met een locale \"grab\"" mcset nl "A dialog box with a global grab" \ "Een dialoogvenster met een globale \"grab\"" - diff --git a/library/demos/toolbar.tcl b/library/demos/toolbar.tcl new file mode 100644 index 0000000..0f25ce9 --- /dev/null +++ b/library/demos/toolbar.tcl @@ -0,0 +1,95 @@ +# toolbar.tcl -- +# +# This demonstration script creates a toolbar that can be torn off. +# +# RCS: @(#) $Id: toolbar.tcl,v 1.1 2007/10/22 14:21:10 dkf Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk +package require Ttk + +set w .toolbar +destroy $w +toplevel $w +wm title $w "Toolbar Demonstration" +wm iconname $w "toolbar" +positionWindow $w + +ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\ + a toolbar that is styled correctly and which can be torn off. The\ + buttons are configured to be \u201Ctoolbar style\u201D buttons by\ + telling them that they are to use the Toolbutton style. At the left\ + end of the toolbar is a simple marker that the cursor changes to a\ + movement icon over; drag that away from the toolbar to tear off the\ + whole toolbar into a separate toplevel widget. When the dragged-off\ + toolbar is no longer needed, just close it like any normal toplevel\ + and it will reattach to the window it was torn off from." + +## Set up the toolbar hull +set t [frame $w.toolbar] ;# Must be a frame! +ttk::separator $w.sep +ttk::frame $t.tearoff -cursor fleur +ttk::separator $t.tearoff.to -orient vertical +ttk::separator $t.tearoff.to2 -orient vertical +ttk::frame $t.contents +pack $t.tearoff.to -fill y -expand 1 -padx 2 -side left +pack $t.tearoff.to2 -fill y -expand 1 -side left +grid $t.tearoff $t.contents -sticky nsew +grid columnconfigure $t $t.contents -weight 1 +grid columnconfigure $t.contents 1000 -weight 1 + +## Bindings so that the toolbar can be torn off and reattached +bind $t.tearoff <B1-Motion> [list tearoff $t %X %Y] +bind $t.tearoff.to <B1-Motion> [list tearoff $t %X %Y] +bind $t.tearoff.to2 <B1-Motion> [list tearoff $t %X %Y] +proc tearoff {w x y} { + if {[string match $w* [winfo containing $x $y]]} { + return + } + grid remove $w + grid remove $w.tearoff + wm manage $w + wm protocol $w WM_DELETE_WINDOW [list untearoff $w] +} +proc untearoff {w} { + wm forget $w + grid $w.tearoff + grid $w +} + +## Toolbar contents +ttk::button $t.button -text "Button" -style Toolbutton -command [list \ + $w.txt insert end "Button Pressed\n"] +ttk::checkbutton $t.check -text "Check" -variable check -style Toolbutton \ + -command [concat [list $w.txt insert end] {"check is $check\n"}] +ttk::menubutton $t.menu -text "Menu" -menu $t.menu.m +ttk::combobox $t.combo -value [lsort [font families]] -state readonly +menu $t.menu.m +$t.menu.m add command -label "Just" -command [list $w.txt insert end Just\n] +$t.menu.m add command -label "An" -command [list $w.txt insert end An\n] +$t.menu.m add command -label "Example" \ + -command [list $w.txt insert end Example\n] +bind $t.combo <<ComboboxSelected>> [list changeFont $w.txt $t.combo] +proc changeFont {txt combo} { + $txt configure -font [list [$combo get] 10] +} + +## Some content for the rest of the toplevel +text $w.txt -width 40 -height 10 +interp alias {} doInsert {} $w.txt insert end ;# Make bindings easy to write + +## Arrange contents +grid $t.button $t.check $t.menu $t.combo -in $t.contents -padx 2 -sticky ns +grid $t -sticky ew +grid $w.sep -sticky ew +grid $w.msg -sticky ew +grid $w.txt -sticky nsew +grid rowconfigure $w $w.txt -weight 1 +grid columnconfigure $w $w.txt -weight 1 + +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +grid $btns -sticky ew diff --git a/library/demos/tree.tcl b/library/demos/tree.tcl new file mode 100644 index 0000000..505b711 --- /dev/null +++ b/library/demos/tree.tcl @@ -0,0 +1,91 @@ +# tree.tcl -- +# +# This demonstration script creates a toplevel window containing a Ttk +# tree widget. +# +# RCS: @(#) $Id: tree.tcl,v 1.1 2007/10/22 14:21:11 dkf Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk +package require Ttk + +set w .tree +catch {destroy $w} +toplevel $w +wm title $w "Directory Browser" +wm iconname $w "tree" +positionWindow $w + +## Explanatory text +ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which allows the user to browse a hierarchical data-set such as a filesystem. The tree widget not only allows for the tree part itself, but it also supports an arbitrary number of additional columns which can show additional data (in this case, the size of the files found in your filesystem). You can also change the width of the columns by dragging the boundary between them." +pack $w.msg + +## See Code / Dismiss +pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x + +## Code to populate the roots of the tree (can be more than one on Windows) +proc populateRoots {tree} { + foreach dir [lsort -dictionary [file volumes]] { + populateTree $tree [$tree insert {} end -text $dir \ + -values [list $dir directory]] + } +} + +## Code to populate a node of the tree +proc populateTree {tree node} { + if {[$tree set $node type] ne "directory"} { + return + } + set path [$tree set $node fullpath] + $tree delete [$tree children $node] + foreach f [lsort -dictionary [glob -nocomplain -dir $path *]] { + set type [file type $f] + set id [$tree insert $node end -text [file tail $f] \ + -values [list $f $type]] + + if {$type eq "directory"} { + ## Make it so that this node is openable + $tree insert $id 0 -text dummy ;# a dummy + $tree item $id -text [file tail $f]/ + + } elseif {$type eq "file"} { + set size [file size $f] + ## Format the file size nicely + if {$size >= 1024*1024*1024} { + set size [format %.1f\ GB [expr {$size/1024/1024/1024.}]] + } elseif {$size >= 1024*1024} { + set size [format %.1f\ MB [expr {$size/1024/1024.}]] + } elseif {$size >= 1024} { + set size [format %.1f\ kB [expr {$size/1024.}]] + } else { + append size " bytes" + } + $tree set $id size $size + } + } + + # Stop this code from rerunning on the current node + $tree set $node type processedDirectory +} + +## Create the tree and set it up +ttk::treeview $w.tree -columns {fullpath type size} -displaycolumns {size} \ + -yscroll "$w.vsb set" -xscroll "$w.hsb set" +ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" +ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" +$w.tree heading \#0 -text "Directory Structure" +$w.tree heading size -text "File Size" +$w.tree column size -stretch 0 -width 70 +populateRoots $w.tree +bind $w.tree <<TreeviewOpen>> {populateTree %W [%W focus]} + +## Arrange the tree and its scrollbars in the toplevel +lower [ttk::frame $w.dummy] +pack $w.dummy -fill both -expand 1 +grid $w.tree $w.vsb -sticky nsew -in $w.dummy +grid $w.hsb -sticky nsew -in $w.dummy +grid columnconfigure $w.dummy 0 -weight 1 +grid rowconfigure $w.dummy 0 -weight 1 diff --git a/library/demos/ttkbut.tcl b/library/demos/ttkbut.tcl index 9af0963..1d058eb 100644 --- a/library/demos/ttkbut.tcl +++ b/library/demos/ttkbut.tcl @@ -4,7 +4,7 @@ # simple Ttk widgets, such as labels, labelframes, buttons, checkbuttons and # radiobuttons. # -# RCS: @(#) $Id: ttkbut.tcl,v 1.2 2007/10/17 18:21:49 das Exp $ +# RCS: @(#) $Id: ttkbut.tcl,v 1.3 2007/10/22 14:21:10 dkf Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -20,13 +20,14 @@ wm title $w "Simple Ttk Widgets" wm iconname $w "ttkbut" positionWindow $w -ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains checkbuttons, with a separator widget between the first pair and the second. The third group has a collection of linked radiobuttons." +ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the \u201cEnabled\u201d button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons." pack $w.msg -side top -fill x ## See Code / Dismiss -pack [addSeeDismiss $w.seeDismiss $w {cheese tomato basil oregano happyness}]\ +pack [addSeeDismiss $w.seeDismiss $w {enabled cheese tomato basil oregano happyness}]\ -side bottom -fill x +## Add buttons for setting the theme ttk::labelframe $w.buttons -text "Buttons" foreach theme [ttk::themes] { ttk::button $w.buttons.$theme -text $theme \ @@ -34,15 +35,42 @@ foreach theme [ttk::themes] { pack $w.buttons.$theme -pady 2 } +## Helper procedure for the top checkbutton +proc setState {rootWidget exceptThese value} { + if {$rootWidget in $exceptThese} { + return + } + ## Non-Ttk widgets (e.g. the toplevel) will fail, so make it silent + catch { + $rootWidget state $value + } + ## Recursively invoke on all children of this root that are in the same + ## toplevel widget + foreach w [winfo children $rootWidget] { + if {[winfo toplevel $w] eq [winfo toplevel $rootWidget]} { + setState $w $exceptThese $value + } + } +} + +## Set up the checkbutton group ttk::labelframe $w.checks -text "Checkbuttons" +ttk::checkbutton $w.checks.e -text Enabled -variable enabled -command { + setState .ttkbut .ttkbut.checks.e \ + [expr {$enabled ? "!disabled" : "disabled"}] +} +set enabled 1 +## See ttk_widget(n) for other possible state flags +ttk::separator $w.checks.sep1 ttk::checkbutton $w.checks.c1 -text Cheese -variable cheese ttk::checkbutton $w.checks.c2 -text Tomato -variable tomato -ttk::separator $w.checks.sep +ttk::separator $w.checks.sep2 ttk::checkbutton $w.checks.c3 -text Basil -variable basil ttk::checkbutton $w.checks.c4 -text Oregano -variable oregano -pack $w.checks.c1 $w.checks.c2 $w.checks.sep $w.checks.c3 $w.checks.c4 \ - -fill x -pady 2 +pack $w.checks.e $w.checks.sep1 $w.checks.c1 $w.checks.c2 $w.checks.sep2 \ + $w.checks.c3 $w.checks.c4 -fill x -pady 2 +## Set up the radiobutton group ttk::labelframe $w.radios -text "Radiobuttons" ttk::radiobutton $w.radios.r1 -text "Great" -variable happyness -value great ttk::radiobutton $w.radios.r2 -text "Good" -variable happyness -value good @@ -52,6 +80,7 @@ ttk::radiobutton $w.radios.r5 -text "Awful" -variable happyness -value awful pack $w.radios.r1 $w.radios.r2 $w.radios.r3 $w.radios.r4 $w.radios.r5 \ -fill x -padx 3 -pady 2 +## Arrange things neatly pack [ttk::frame $w.f] -fill both -expand 1 lower $w.f grid $w.buttons $w.checks $w.radios -in $w.f -sticky nwe -pady 2 -padx 3 diff --git a/library/demos/ttknote.tcl b/library/demos/ttknote.tcl new file mode 100644 index 0000000..9f10ed7 --- /dev/null +++ b/library/demos/ttknote.tcl @@ -0,0 +1,56 @@ +# ttknote.tcl -- +# +# This demonstration script creates a toplevel window containing a Ttk +# notebook widget. +# +# RCS: @(#) $Id: ttknote.tcl,v 1.1 2007/10/22 14:21:16 dkf Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk +package require Ttk + +set w .ttknote +catch {destroy $w} +toplevel $w +wm title $w "Ttk Notebook Widget" +wm iconname $w "ttknote" +positionWindow $w + +## See Code / Dismiss +pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x + +## Make the notebook and set up Ctrl+Tab traversal +ttk::notebook $w.note +pack $w.note -fill both -expand 1 -padx 2 -pady 3 +ttk::notebook::enableTraversal $w.note + +## Popuplate the first pane +ttk::frame $w.note.msg +ttk::label $w.note.msg.m -font $font -wraplength 4i -justify left -anchor n -text "Ttk is the new Tk themed widget set. One of the widgets it includes is the notebook widget, which provides a set of tabs that allow the selection of a group of panels, each with distinct content. They are a feature of many modern user interfaces. Not only can the tabs be selected with the mouse, but they can also be switched between using Ctrl+Tab when the notebook page heading itself is selected. Note that the second tab is disabled, and cannot be selected." +ttk::button $w.note.msg.b -text "Neat!" -underline 0 -command { + set neat "Yeah, I know..." + after 500 {set neat {}} +} +bind $w <Alt-n> "focus $w.note.msg.b; $w.note.msg.b invoke" +ttk::label $w.note.msg.l -textvariable neat +$w.note add $w.note.msg -text "Description" -underline 0 -padding 2 +grid $w.note.msg.m - -sticky new +grid $w.note.msg.b $w.note.msg.l +grid rowconfigure $w.note.msg 1 -weight 1 +grid columnconfigure $w.note.msg {0 1} -weight 1 -uniform 1 + +## Populate the second pane. Note that the content doesn't really matter +ttk::frame $w.note.disabled +$w.note add $w.note.disabled -text "Disabled" -state disabled + +## Popuplate the third pane +ttk::frame $w.note.editor +$w.note add $w.note.editor -text "Text Editor" -underline 0 +text $w.note.editor.t -width 40 -height 10 -wrap char \ + -yscroll "$w.note.editor.s set" +scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview" +pack $w.note.editor.s -side right -fill y -padx {0 2} -pady 2 +pack $w.note.editor.t -fill both -expand 1 -pady 2 -padx {2 0} diff --git a/library/demos/ttkprogress.tcl b/library/demos/ttkprogress.tcl new file mode 100644 index 0000000..06e6a21 --- /dev/null +++ b/library/demos/ttkprogress.tcl @@ -0,0 +1,46 @@ +# ttkprogress.tcl -- +# +# This demonstration script creates several progress bar widgets. +# +# RCS: @(#) $Id: ttkprogress.tcl,v 1.1 2007/10/22 14:21:16 dkf Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk +package require Ttk + +set w .ttkprogress +catch {destroy $w} +toplevel $w +wm title $w "Progress Bar Demonstration" +wm iconname $w "ttkprogress" +positionWindow $w + +label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a \u201Cdeterminate\u201D progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an \u201Cindeterminate\u201D progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath." +grid $w.msg - -sticky ew + +proc doBars {op args} { + foreach w $args { + $w $op + } +} +ttk::progressbar $w.p1 -mode determinate +ttk::progressbar $w.p2 -mode indeterminate +ttk::button $w.start -text "Start Progress" -command [list \ + doBars start $w.p1 $w.p2] +ttk::button $w.stop -text "Stop Progress" -command [list \ + doBars stop $w.p1 $w.p2] + +grid $w.p1 - -pady 5 -padx 10 +grid $w.p2 - -pady 5 -padx 10 +grid $w.start $w.stop -padx 10 -pady 5 +grid configure $w.start -sticky e +grid configure $w.stop -sticky w + +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +grid $btns - - -sticky ews +grid columnconfigure $w 2 -weight 1 +grid rowconfigure $w $btns -weight 1 diff --git a/library/demos/widget b/library/demos/widget index 994189b..3e3a1f3 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -10,7 +10,7 @@ exec wish "$0" "$@" # separate ".tcl" files is this directory, which are sourced by this script as # needed. # -# RCS: @(#) $Id: widget,v 1.38 2007/10/21 14:51:47 das Exp $ +# RCS: @(#) $Id: widget,v 1.39 2007/10/22 14:21:10 dkf Exp $ package require Tcl 8.5 package require Tk 8.5 @@ -85,13 +85,15 @@ image create photo ::img::print -format GIF -data { ryhH5pgnEQA7 } -image create photo ::img::new -format GIF -data { +# Note that this is run through the message catalog! This is because this is +# actually an image of a word. +image create photo ::img::new -format GIF -data [mc { R0lGODlhHgAOALMPALMAANyIiOu7u8dEROaqqvru7sxVVeGZmbgREfXd3b0iItZ3 d8IzM9FmZvDMzP///yH5BAEAAA8ALAAAAAAeAA4AAASa8MlJq7046827WVOCHEkw nANhUgJlEBIABJIwL3K+4IcUALCHjfbItYZDSgJgkBiYPmBMAUAkkLPKs/BAyLgM wAQwOAAY2ByCaw4QAFQSoDEePJ6DmU1xInYZTw5nOEFFdgVUelkVDTIMd3AKFGQ1 MgI2AwEmQW8APZ0gdRONAks5nhIFVVxdAAkUAS2pAVwFl7ITB4UqHb0XEQA7 -} +}] #---------------------------------------------------------------- # The code below create the main window, consisting of a menu bar and a text @@ -113,11 +115,18 @@ if {[tk windowingsystem] eq "aqua"} { menu .menuBar.file -tearoff 0 ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \ -command {aboutBox} -accelerator [mc "<F1>"] + bind . <F1> {aboutBox} .menuBar.file add sep - ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ - -command {exit} -accelerator [mc "Meta-Q"] - bind . <[mc "Meta-q"]> {exit} - bind . <F1> {aboutBox} + if {[string match win* [tk windowingsystem]]} { + # Windows doesn't usually have a Meta key + ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ + -command {exit} -accelerator [mc "Ctrl+Q"] + bind . <[mc "Control-q"]> {exit} + } else { + ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ + -command {exit} -accelerator [mc "Meta-Q"] + bind . <[mc "Meta-q"]> {exit} + } } . configure -menu .menuBar @@ -221,14 +230,16 @@ set lastLine "" # passing it through the message catalog to allow for localization. # Lines starting with @@ are formatting directives (insert title, insert # demo hyperlink, begin newline, or change style) and all other lines -# are literal strings to be inserted. Blank lines are ignored. +# are literal strings to be inserted. Substitutions are performed, +# allowing processing pieces through the message catalog. Blank lines +# are ignored. # proc addFormattedText {formattedText} { set style normal set isNL 1 set demoCount 0 set new 0 - foreach line [split [mc $formattedText] \n] { + foreach line [split $formattedText \n] { set line [string trim $line] if {$line eq ""} { continue @@ -246,7 +257,8 @@ proc addFormattedText {formattedText} { set isNL 1 } subtitle { - .t insert end "\n" {} [mc $values] subtitle " \n " demospace + .t insert end "\n" {} [mc $values] subtitle \ + " \n " demospace set demoCount 0 } demo { @@ -272,7 +284,7 @@ proc addFormattedText {formattedText} { .t insert end " " $style } set isNL 0 - .t insert end $line $style + .t insert end [mc $line] $style } } @@ -310,16 +322,20 @@ addFormattedText { @@new @@demo ttkbut The simple Themed Tk widgets - @@subtitle Listboxes + @@subtitle Listboxes and Trees @@demo states The 50 states @@demo colors Colors: change the color scheme for the application @@demo sayings A collection of famous and infamous sayings + @@new + @@demo tree A directory browser tree - @@subtitle Entries and Spin-boxes + @@subtitle Entries, Spin-boxes and Combo-boxes @@demo entry1 Entries without scrollbars @@demo entry2 Entries with scrollbars @@demo entry3 Validated entries and password fields @@demo spin Spin-boxes + @@new + @@demo combo Combo-boxes @@demo form Simple Rolodex-like form @@subtitle Text @@ -340,21 +356,27 @@ addFormattedText { @@demo floor A building floor plan @@demo cscroll A simple scrollable canvas - @@subtitle Scales + @@subtitle Scales and Progress Bars @@demo hscale Horizontal scale @@demo vscale Vertical scale + @@new + @@demo ttkprogress Progress bar - @@subtitle Paned Windows + @@subtitle Paned Windows and Notebooks @@demo paned1 Horizontal paned window @@demo paned2 Vertical paned window @@new @@demo ttkpane Themed nested panes + @@new + @@demo ttknote Notebook widget - @@subtitle Menus + @@subtitle Menus and Toolbars @@demo menu Menus and cascades (sub-menus) @@demo menubu Menu-buttons @@new @@demo ttkmenu Themed menu buttons + @@new + @@demo toolbar Detachable toolbar @@subtitle Common Dialogs @@demo msgbox Message boxes @@ -699,7 +721,7 @@ proc PrintTextWin32 {filename} { # proc aboutBox {} { tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \ - -message "[mc {Tk widget demonstration application}] + -message "[mc {Tk widget demonstration application}] [mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}] [mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}] |