diff options
Diffstat (limited to 'library/demos')
| -rw-r--r-- | library/demos/combo.tcl | 10 | ||||
| -rw-r--r-- | library/demos/toolbar.tcl | 69 | ||||
| -rw-r--r-- | library/demos/tree.tcl | 13 | ||||
| -rw-r--r-- | library/demos/ttknote.tcl | 10 | ||||
| -rw-r--r-- | library/demos/ttkprogress.tcl | 21 | ||||
| -rw-r--r-- | library/demos/widget | 4 |
6 files changed, 77 insertions, 50 deletions
diff --git a/library/demos/combo.tcl b/library/demos/combo.tcl index ed9c585..2ebce5b 100644 --- a/library/demos/combo.tcl +++ b/library/demos/combo.tcl @@ -2,7 +2,7 @@ # # This demonstration script creates several combobox widgets. # -# RCS: @(#) $Id: combo.tcl,v 1.1 2007/10/22 14:21:10 dkf Exp $ +# RCS: @(#) $Id: combo.tcl,v 1.2 2007/10/23 06:31:16 das Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -18,7 +18,7 @@ wm title $w "Combobox Demonstration" wm iconname $w "combo" positionWindow $w -label $w.msg -font $font -wraplength 5i -justify left -text "Three different\ +ttk::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\ @@ -28,12 +28,16 @@ label $w.msg -font $font -wraplength 5i -justify left -text "Three different\ 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 +pack $w.msg -side top -fill x ## See Code / Dismiss buttons set btns [addSeeDismiss $w.buttons $w {firstValue secondValue ozCity}] pack $btns -side bottom -fill x +ttk::frame $w.f +pack $w.f -fill both -expand 1 +set w $w.f + set australianCities { Canberra Sydney Melbourne Perth Adelaide Brisbane Hobart Darwin "Alice Springs" diff --git a/library/demos/toolbar.tcl b/library/demos/toolbar.tcl index 0f25ce9..073d538 100644 --- a/library/demos/toolbar.tcl +++ b/library/demos/toolbar.tcl @@ -2,7 +2,7 @@ # # 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 $ +# RCS: @(#) $Id: toolbar.tcl,v 1.2 2007/10/23 06:31:16 das Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -18,46 +18,57 @@ wm title $w "Toolbar Demonstration" wm iconname $w "toolbar" positionWindow $w +if {[tk windowingsystem] ne "aqua"} { + 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." +} else { 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." + a toolbar that is styled correctly. The buttons are configured to\ + be \u201Ctoolbar style\u201D buttons by telling them that they are\ + to use the Toolbutton style." +} ## 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 +if {[tk windowingsystem] ne "aqua"} { + ttk::separator $t.tearoff.to -orient vertical + ttk::separator $t.tearoff.to2 -orient vertical + pack $t.tearoff.to -fill y -expand 1 -padx 2 -side left + pack $t.tearoff.to2 -fill y -expand 1 -side left +} 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 +if {[tk windowingsystem] ne "aqua"} { + ## 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 } - 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 diff --git a/library/demos/tree.tcl b/library/demos/tree.tcl index 505b711..80f9612 100644 --- a/library/demos/tree.tcl +++ b/library/demos/tree.tcl @@ -3,7 +3,7 @@ # 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 $ +# RCS: @(#) $Id: tree.tcl,v 1.2 2007/10/23 06:31:16 das Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -21,7 +21,7 @@ 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 +pack $w.msg -fill x ## See Code / Dismiss pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x @@ -74,8 +74,13 @@ proc populateTree {tree node} { ## 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" +if {[tk windowingsystem] ne "aqua"} { + ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" + ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" +} else { + scrollbar $w.vsb -orient vertical -command "$w.tree yview" + 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 diff --git a/library/demos/ttknote.tcl b/library/demos/ttknote.tcl index 9f10ed7..6630efb 100644 --- a/library/demos/ttknote.tcl +++ b/library/demos/ttknote.tcl @@ -3,7 +3,7 @@ # 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 $ +# RCS: @(#) $Id: ttknote.tcl,v 1.2 2007/10/23 06:31:16 das Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -22,6 +22,10 @@ positionWindow $w ## See Code / Dismiss pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x +ttk::frame $w.f +pack $w.f -fill both -expand 1 +set w $w.f + ## Make the notebook and set up Ctrl+Tab traversal ttk::notebook $w.note pack $w.note -fill both -expand 1 -padx 2 -pady 3 @@ -37,8 +41,8 @@ ttk::button $w.note.msg.b -text "Neat!" -underline 0 -command { 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 $w.note.msg.m - -sticky new -pady 2 +grid $w.note.msg.b $w.note.msg.l -pady {2 4} grid rowconfigure $w.note.msg 1 -weight 1 grid columnconfigure $w.note.msg {0 1} -weight 1 -uniform 1 diff --git a/library/demos/ttkprogress.tcl b/library/demos/ttkprogress.tcl index 06e6a21..e209ab3 100644 --- a/library/demos/ttkprogress.tcl +++ b/library/demos/ttkprogress.tcl @@ -2,7 +2,7 @@ # # This demonstration script creates several progress bar widgets. # -# RCS: @(#) $Id: ttkprogress.tcl,v 1.1 2007/10/22 14:21:16 dkf Exp $ +# RCS: @(#) $Id: ttkprogress.tcl,v 1.2 2007/10/23 06:31:16 das Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -18,8 +18,16 @@ 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 +ttk::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." +pack $w.msg -side top -fill x + +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x + +ttk::frame $w.f +pack $w.f -fill both -expand 1 +set w $w.f proc doBars {op args} { foreach w $args { @@ -38,9 +46,4 @@ 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 +grid columnconfigure $w all -weight 1 diff --git a/library/demos/widget b/library/demos/widget index 3e3a1f3..b6b633b 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.39 2007/10/22 14:21:10 dkf Exp $ +# RCS: @(#) $Id: widget,v 1.40 2007/10/23 06:31:16 das Exp $ package require Tcl 8.5 package require Tk 8.5 @@ -376,7 +376,7 @@ addFormattedText { @@new @@demo ttkmenu Themed menu buttons @@new - @@demo toolbar Detachable toolbar + @@demo toolbar Themed toolbar @@subtitle Common Dialogs @@demo msgbox Message boxes |