diff options
41 files changed, 343 insertions, 319 deletions
@@ -1,3 +1,46 @@ +2003-08-20 Jeff Hobbs <jeffh@ActiveState.com> + + * library/demos/widget: Redo code view dialog, use named fonts, + * library/demos/arrow.tcl: add basic see/dismiss routine with + * library/demos/bind.tcl: images for better look & feel + * library/demos/bitmap.tcl: + * library/demos/button.tcl: + * library/demos/check.tcl: + * library/demos/clrpick.tcl: + * library/demos/colors.tcl: + * library/demos/cscroll.tcl: + * library/demos/ctext.tcl: + * library/demos/entry1.tcl: + * library/demos/entry2.tcl: + * library/demos/entry3.tcl: + * library/demos/filebox.tcl: + * library/demos/floor.tcl: + * library/demos/form.tcl: + * library/demos/hscale.tcl: + * library/demos/icon.tcl: + * library/demos/image1.tcl: + * library/demos/image2.tcl: + * library/demos/items.tcl: + * library/demos/label.tcl: + * library/demos/labelframe.tcl: + * library/demos/menu.tcl: + * library/demos/menubu.tcl: + * library/demos/paned1.tcl: + * library/demos/paned2.tcl: + * library/demos/plot.tcl: + * library/demos/puzzle.tcl: + * library/demos/radio.tcl: + * library/demos/ruler.tcl: + * library/demos/sayings.tcl: + * library/demos/search.tcl: + * library/demos/spin.tcl: + * library/demos/states.tcl: + * library/demos/style.tcl: + * library/demos/text.tcl: + * library/demos/twind.tcl: + * library/demos/unicodeout.tcl: + * library/demos/vscale.tcl: + 2003-08-20 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tkCanvPs.c (Tk_PostscriptFont): Use Tcl_Obj-based diff --git a/library/demos/arrow.tcl b/library/demos/arrow.tcl index 5d37233..b8d33ee 100644 --- a/library/demos/arrow.tcl +++ b/library/demos/arrow.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widget that displays a # large line with an arrowhead whose shape can be edited interactively. # -# RCS: @(#) $Id: arrow.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: arrow.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -118,11 +118,9 @@ set c $w.c label $w.msg -font $font -wraplength 5i -justify left -text "This widget allows you to experiment with different widths and arrowhead shapes for lines in canvases. To change the line width or the shape of the arrowhead, drag any of the three boxes attached to the oversized arrow. The arrows on the right give examples at normal scale. The text at the bottom shows the configuration options as you'd enter them for a canvas line item." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x canvas $c -width 500 -height 350 -relief sunken -borderwidth 2 pack $c -expand yes -fill both diff --git a/library/demos/bind.tcl b/library/demos/bind.tcl index 6b29612..246683a 100644 --- a/library/demos/bind.tcl +++ b/library/demos/bind.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget with bindings set # up for hypertext-like effects. # -# RCS: @(#) $Id: bind.tcl,v 1.2 1998/09/14 18:23:26 stanton Exp $ +# RCS: @(#) $Id: bind.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -16,11 +16,9 @@ wm title $w "Text Demonstration - Tag Bindings" wm iconname $w "bind" positionWindow $w -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ -width 60 -height 24 -font $font -wrap word diff --git a/library/demos/bitmap.tcl b/library/demos/bitmap.tcl index cdb6f13..dd8fd7a 100644 --- a/library/demos/bitmap.tcl +++ b/library/demos/bitmap.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window that displays # all of Tk's built-in bitmaps. # -# RCS: @(#) $Id: bitmap.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $ +# RCS: @(#) $Id: bitmap.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -43,11 +43,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "This window displays all of Tk's built-in bitmaps, along with the names you can use for them in Tcl scripts." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.frame bitmapRow $w.frame.0 error gray12 gray25 gray50 gray75 diff --git a/library/demos/button.tcl b/library/demos/button.tcl index 896f72c..8211f4b 100644 --- a/library/demos/button.tcl +++ b/library/demos/button.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several button widgets. # -# RCS: @(#) $Id: button.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $ +# RCS: @(#) $Id: button.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,18 +19,21 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "If you click on any of the four buttons below, the background of the button area will change to the color indicated in the button. You can press Tab to move among the buttons, then press Space to invoke the current button." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x + +proc colorrefresh {w col} { + $w configure -bg $col + $w.buttons configure -bg $col +} button $w.b1 -text "Peach Puff" -width 10 \ - -command "$w config -bg PeachPuff1; $w.buttons config -bg PeachPuff1" + -command [list colorrefresh $w PeachPuff1] button $w.b2 -text "Light Blue" -width 10 \ - -command "$w config -bg LightBlue1; $w.buttons config -bg LightBlue1" + -command [list colorrefresh $w LightBlue1] button $w.b3 -text "Sea Green" -width 10 \ - -command "$w config -bg SeaGreen2; $w.buttons config -bg SeaGreen2" + -command [list colorrefresh $w SeaGreen2] button $w.b4 -text "Yellow" -width 10 \ - -command "$w config -bg Yellow1; $w.buttons config -bg Yellow1" + -command [list colorrefresh $w Yellow1] pack $w.b1 $w.b2 $w.b3 $w.b4 -side top -expand yes -pady 2 diff --git a/library/demos/check.tcl b/library/demos/check.tcl index 6842d2e..82c5d18 100644 --- a/library/demos/check.tcl +++ b/library/demos/check.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several checkbuttons. # -# RCS: @(#) $Id: check.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $ +# RCS: @(#) $Id: check.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,13 +19,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "Three checkbuttons are displayed below. If you click on a button, it will toggle the button's selection state and set a Tcl variable to a value indicating the state of the checkbutton. Click the \"See Variables\" button to see the current values of the variables." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -button $w.buttons.vars -text "See Variables" \ - -command "showVars $w.dialog wipers brakes sober" -pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w [list wipers brakes sober]] +pack $btns -side bottom -fill x checkbutton $w.b1 -text "Wipers OK" -variable wipers -relief flat checkbutton $w.b2 -text "Brakes OK" -variable brakes -relief flat diff --git a/library/demos/clrpick.tcl b/library/demos/clrpick.tcl index 5c1f018..0f97ad0 100644 --- a/library/demos/clrpick.tcl +++ b/library/demos/clrpick.tcl @@ -2,7 +2,7 @@ # # This demonstration script prompts the user to select a color. # -# RCS: @(#) $Id: clrpick.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: clrpick.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -18,11 +18,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "Press the buttons below to choose the foreground and background colors for the widgets in this window." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x button $w.back -text "Set background color ..." \ -command \ diff --git a/library/demos/colors.tcl b/library/demos/colors.tcl index 0a58db9..9f48837 100644 --- a/library/demos/colors.tcl +++ b/library/demos/colors.tcl @@ -4,7 +4,7 @@ # many of the colors from the X color database. You can click on # a color to change the application's palette. # -# RCS: @(#) $Id: colors.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $ +# RCS: @(#) $Id: colors.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -20,11 +20,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "A listbox containing several color names is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by dragging in the listbox window with button 2 pressed. If you double-click button 1 on a color, then the application's color palette will be set to match that color" pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.frame -borderwidth 10 pack $w.frame -side top -expand yes -fill y diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 8aad050..573bdeb 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a simple canvas that can be # scrolled in two dimensions. # -# RCS: @(#) $Id: cscroll.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: cscroll.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -20,11 +20,9 @@ set c $w.c label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.grid scrollbar $w.hscroll -orient horiz -command "$c xview" diff --git a/library/demos/ctext.tcl b/library/demos/ctext.tcl index fb120a8..d016ef8 100644 --- a/library/demos/ctext.tcl +++ b/library/demos/ctext.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widget with a text # item that can be edited and reconfigured in various ways. # -# RCS: @(#) $Id: ctext.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: ctext.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -27,11 +27,9 @@ label $w.msg -font $font -wraplength 5i -justify left -text "This window display the character just after the insertion cursor." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x canvas $c -relief flat -borderwidth 0 -width 500 -height 350 pack $w.c -side top -expand yes -fill both diff --git a/library/demos/entry1.tcl b/library/demos/entry1.tcl index 5d00b2c..58f8b36 100644 --- a/library/demos/entry1.tcl +++ b/library/demos/entry1.tcl @@ -3,7 +3,7 @@ # This demonstration script creates several entry widgets without # scrollbars. # -# RCS: @(#) $Id: entry1.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $ +# RCS: @(#) $Id: entry1.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,11 +19,9 @@ positionWindow $w label $w.msg -font $font -wraplength 5i -justify left -text "Three different entries are displayed below. You can add characters by pointing, clicking and typing. The normal Motif editing characters are supported, along with many Emacs bindings. For example, Backspace and Control-h delete the character to the left of the insertion cursor and Delete and Control-d delete the chararacter to the right of the insertion cursor. For entries that are too large to fit in the window all at once, you can scan through the entries by dragging with mouse button2 pressed." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x entry $w.e1 entry $w.e2 diff --git a/library/demos/entry2.tcl b/library/demos/entry2.tcl index ffd9ae6..c40f451 100644 --- a/library/demos/entry2.tcl +++ b/library/demos/entry2.tcl @@ -3,7 +3,7 @@ # This demonstration script is the same as the entry1.tcl script # except that it creates scrollbars for the entries. # -# RCS: @(#) $Id: entry2.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $ +# RCS: @(#) $Id: entry2.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,11 +19,9 @@ positionWindow $w label $w.msg -font $font -wraplength 5i -justify left -text "Three different entries are displayed below, with a scrollbar for each entry. You can add characters by pointing, clicking and typing. The normal Motif editing characters are supported, along with many Emacs bindings. For example, Backspace and Control-h delete the character to the left of the insertion cursor and Delete and Control-d delete the chararacter to the right of the insertion cursor. For entries that are too large to fit in the window all at once, you can scan through the entries with the scrollbars, or by dragging with mouse button2 pressed." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.frame -borderwidth 10 pack $w.frame -side top -fill x -expand 1 diff --git a/library/demos/entry3.tcl b/library/demos/entry3.tcl index 3e88a7a..68f7e35 100644 --- a/library/demos/entry3.tcl +++ b/library/demos/entry3.tcl @@ -4,7 +4,7 @@ # permitted input is constrained in some way. It also shows off a # password entry. # -# RCS: @(#) $Id: entry3.tcl,v 1.1 2001/11/19 14:02:29 dkf Exp $ +# RCS: @(#) $Id: entry3.tcl,v 1.2 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -32,11 +32,9 @@ label $w.msg -font $font -wraplength 5i -justify left -text "Four different\ characters (silently ignoring further ones), and displaying them as\ asterisk characters." -frame $w.buttons -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 - +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x # focusAndFlash -- # Error handler for entry widgets that forces the focus onto the diff --git a/library/demos/filebox.tcl b/library/demos/filebox.tcl index 4401d06..860b29b 100644 --- a/library/demos/filebox.tcl +++ b/library/demos/filebox.tcl @@ -2,7 +2,7 @@ # # This demonstration script prompts the user to select a file. # -# RCS: @(#) $Id: filebox.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: filebox.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -18,11 +18,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x foreach i {open save} { set f [frame $w.$i] diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl index 2435544..e9c0a83 100644 --- a/library/demos/floor.tcl +++ b/library/demos/floor.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widet that displays the # floorplan for DEC's Western Research Laboratory. # -# RCS: @(#) $Id: floor.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: floor.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -1301,11 +1301,9 @@ wm minsize $w 100 100 label $w.msg -font $font -wraplength 8i -justify left -text "This window contains a canvas widget showing the floorplan of Digital Equipment Corporation's Western Research Laboratory. It has three levels. At any given time one of the levels is active, meaning that you can see its room structure. To activate a level, click the left mouse button anywhere on it. As the mouse moves over the active level, the room under the mouse lights up and its room number appears in the \"Room:\" entry. You can also type a room number in the entry and the room will light up." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x set f [frame $w.frame] pack $f -side top -fill both -expand yes diff --git a/library/demos/form.tcl b/library/demos/form.tcl index a6d5062..b3e8f23 100644 --- a/library/demos/form.tcl +++ b/library/demos/form.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a simple form with a bunch # of entry widgets. # -# RCS: @(#) $Id: form.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $ +# RCS: @(#) $Id: form.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,11 +19,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "This window contains a simple form where you can type in the various entries and use tabs to move circularly between the entries." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x foreach i {f1 f2 f3 f4 f5} { frame $w.$i -bd 2 diff --git a/library/demos/hscale.tcl b/library/demos/hscale.tcl index a9b3761..8c73695 100644 --- a/library/demos/hscale.tcl +++ b/library/demos/hscale.tcl @@ -2,7 +2,7 @@ # # This demonstration script shows an example with a horizontal scale. # -# RCS: @(#) $Id: hscale.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: hscale.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -18,11 +18,9 @@ positionWindow $w label $w.msg -font $font -wraplength 3.5i -justify left -text "An arrow and a horizontal scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the length of the arrow." pack $w.msg -side top -padx .5c -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.frame -borderwidth 10 pack $w.frame -side top -fill x diff --git a/library/demos/icon.tcl b/library/demos/icon.tcl index 6a561c4..89289c0 100644 --- a/library/demos/icon.tcl +++ b/library/demos/icon.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # buttons that display bitmaps instead of text. # -# RCS: @(#) $Id: icon.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $ +# RCS: @(#) $Id: icon.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,11 +19,9 @@ positionWindow $w label $w.msg -font $font -wraplength 5i -justify left -text "This window shows three ways of using bitmaps or images in radiobuttons and checkbuttons. On the left are two radiobuttons, each of which displays a bitmap and an indicator. In the middle is a checkbutton that displays a different image depending on whether it is selected or not. On the right is a checkbutton that displays a single bitmap but changes its background color to indicate whether or not it is selected." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x image create bitmap flagup \ -file [file join $tk_library demos images flagup.bmp] \ diff --git a/library/demos/image1.tcl b/library/demos/image1.tcl index 06da5a8..4f44716 100644 --- a/library/demos/image1.tcl +++ b/library/demos/image1.tcl @@ -2,7 +2,7 @@ # # This demonstration script displays two image widgets. # -# RCS: @(#) $Id: image1.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $ +# RCS: @(#) $Id: image1.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -18,11 +18,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration displays two images, each in a separate label widget." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x catch {image delete image1a} image create photo image1a -file [file join $tk_library demos images earth.gif] diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl index 9328e8a..d5cbab0 100644 --- a/library/demos/image2.tcl +++ b/library/demos/image2.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a simple collection of widgets # that allow you to select and view images in a Tk label. # -# RCS: @(#) $Id: image2.tcl,v 1.6 2002/08/12 13:38:48 dkf Exp $ +# RCS: @(#) $Id: image2.tcl,v 1.7 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -68,11 +68,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration allows you to view images using a Tk \"photo\" image. First type a directory name in the listbox, then type Return to load the directory into the listbox. Then double-click on a file name in the listbox to see that image." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.mid pack $w.mid -fill both -expand 1 diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 91ea32a..24c3f4c 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas that displays the # canvas item types. # -# RCS: @(#) $Id: items.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: items.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -20,11 +20,9 @@ set c $w.frame.c label $w.msg -font $font -wraplength 5i -justify left -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Button-1 drag:\tmoves item under pointer.\n Button-2 drag:\trepositions view.\n Button-3 drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.frame pack $w.frame -side top -fill both -expand yes diff --git a/library/demos/label.tcl b/library/demos/label.tcl index 47babe6..3d31538 100644 --- a/library/demos/label.tcl +++ b/library/demos/label.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several label widgets. # -# RCS: @(#) $Id: label.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $ +# RCS: @(#) $Id: label.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,11 +19,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "Five labels are displayed below: three textual ones on the left, and a bitmap label and a text label on the right. Labels are pretty boring because you can't do anything with them." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.left frame $w.right diff --git a/library/demos/labelframe.tcl b/library/demos/labelframe.tcl index af8954b..53832d4 100644 --- a/library/demos/labelframe.tcl +++ b/library/demos/labelframe.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several labelframe widgets. # -# RCS: @(#) $Id: labelframe.tcl,v 1.2 2001/10/30 11:21:50 dkf Exp $ +# RCS: @(#) $Id: labelframe.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -23,13 +23,9 @@ label $w.msg -font $font -wraplength 4i -justify left -text "Labelframes are\ plain text or another widget." pack $w.msg -side top -# The bottom buttons - -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -width 15 -button $w.buttons.code -text "See Code" -command "showCode $w" -width 15 -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x # Demo area diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl index 9352d73..97272e8 100644 --- a/library/demos/menu.tcl +++ b/library/demos/menu.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a window with a bunch of menus # and cascaded menus using menubars. # -# RCS: @(#) $Id: menu.tcl,v 1.4 2002/08/31 06:12:28 das Exp $ +# RCS: @(#) $Id: menu.tcl,v 1.5 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -31,11 +31,9 @@ label $w.statusBar.label -textvariable menustatus -relief sunken -bd 1 -font "He pack $w.statusBar.label -side left -padx 2 -expand yes -fill both pack $w.statusBar -side bottom -fill x -pady 2 -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x menu $w.menu -tearoff 0 diff --git a/library/demos/menubu.tcl b/library/demos/menubu.tcl index bfe6e5b..e298741 100644 --- a/library/demos/menubu.tcl +++ b/library/demos/menubu.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a window with a bunch of menus # and cascaded menus using menubuttons. # -# # RCS: @(#) $Id: menubu.tcl,v 1.3 2002/08/31 06:12:28 das Exp $ +# # RCS: @(#) $Id: menubu.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -43,11 +43,9 @@ $w.body.above.m add command -label "Above menu: first item" -command "puts \"You $w.body.above.m add command -label "Above menu: second item" -command "puts \"You have selected the second item from the Above menu.\"" grid $w.body.above -row 2 -column 1 -sticky s -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode .menubu" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x set body $w.body.center label $body.label -wraplength 300 -font "Helvetica 14" -justify left -text "This is a demonstration of menubuttons. The \"Below\" menubutton pops its menu below the button; the \"Right\" button pops to the right, etc. There are two option menus directly below this text; one is just a standard menu and the other is a 16-color palette." diff --git a/library/demos/paned1.tcl b/library/demos/paned1.tcl index dbdd582..607ec9f 100644 --- a/library/demos/paned1.tcl +++ b/library/demos/paned1.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # a paned window that separates two windows horizontally. # -# RCS: @(#) $Id: paned1.tcl,v 1.1 2002/02/22 14:07:01 dkf Exp $ +# RCS: @(#) $Id: paned1.tcl,v 1.2 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,11 +19,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two coloured windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)" pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x panedwindow $w.pane pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m diff --git a/library/demos/paned2.tcl b/library/demos/paned2.tcl index 95495e6..b7d9adf 100644 --- a/library/demos/paned2.tcl +++ b/library/demos/paned2.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # a paned window that separates two windows vertically. # -# RCS: @(#) $Id: paned2.tcl,v 1.1 2002/02/22 14:07:01 dkf Exp $ +# RCS: @(#) $Id: paned2.tcl,v 1.2 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,11 +19,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two scrolled windows below can be used to divide the area between them. Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)" pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x # Create the pane itself panedwindow $w.pane -orient vertical @@ -63,7 +61,7 @@ pack $f.list -fill both -expand 1 # The bottom window is a text widget with scrollbar set f [frame $w.pane.bottom] text $f.text -xscrollcommand "$f.xscr set" -yscrollcommand "$f.yscr set" \ - -width 30 -wrap none + -width 30 -height 8 -wrap none scrollbar $f.xscr -orient horizontal -command "$f.text xview" scrollbar $f.yscr -orient vertical -command "$f.text yview" grid $f.text $f.yscr -sticky nsew diff --git a/library/demos/plot.tcl b/library/demos/plot.tcl index 011f140..c4032fd 100644 --- a/library/demos/plot.tcl +++ b/library/demos/plot.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widget showing a 2-D # plot with data points that can be dragged with the mouse. # -# RCS: @(#) $Id: plot.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: plot.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -20,11 +20,9 @@ set c $w.c label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget containing a simple 2-dimensional plot. You can doctor the data by dragging any of the points with mouse button 1." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x canvas $c -relief raised -width 450 -height 300 pack $w.c -side top -fill x diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl index fe48733..61d8a80 100644 --- a/library/demos/puzzle.tcl +++ b/library/demos/puzzle.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a 15-puzzle game using a collection # of buttons. # -# RCS: @(#) $Id: puzzle.tcl,v 1.4 2002/08/31 06:12:28 das Exp $ +# RCS: @(#) $Id: puzzle.tcl,v 1.5 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -44,11 +44,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "A 15-puzzle appears below as a collection of buttons. Click on any of the pieces next to the space, and that piece will slide over the space. Continue this until the pieces are arranged in numerical order from upper-left to lower-right." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x # Special trick: select a darker color for the space by creating a # scrollbar widget and using its trough color. diff --git a/library/demos/radio.tcl b/library/demos/radio.tcl index 172200b..a636cb8 100644 --- a/library/demos/radio.tcl +++ b/library/demos/radio.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several radiobutton widgets. # -# RCS: @(#) $Id: radio.tcl,v 1.4 2001/11/12 14:32:50 dkf Exp $ +# RCS: @(#) $Id: radio.tcl,v 1.5 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -18,13 +18,9 @@ positionWindow $w label $w.msg -font $font -wraplength 5i -justify left -text "Three groups of radiobuttons are displayed below. If you click on a button then the button will become selected exclusively among all the buttons in its group. A Tcl variable is associated with each group to indicate which of the group's buttons is selected. Click the \"See Variables\" button to see the current values of the variables." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -button $w.buttons.vars -text "See Variables" \ - -command "showVars $w.dialog size color align" -pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w [list size color align]] +pack $btns -side bottom -fill x labelframe $w.left -pady 2 -text "Point Size" -padx 2 labelframe $w.mid -pady 2 -text "Color" -padx 2 diff --git a/library/demos/ruler.tcl b/library/demos/ruler.tcl index 86f18dc..02f7c06 100644 --- a/library/demos/ruler.tcl +++ b/library/demos/ruler.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a canvas widget that displays a ruler # with tab stops that can be set, moved, and deleted. # -# RCS: @(#) $Id: ruler.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: ruler.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -35,11 +35,9 @@ set c $w.c label $w.msg -font $font -wraplength 5i -justify left -text "This canvas widget shows a mock-up of a ruler. You can create tab stops by dragging them out of the well to the right of the ruler. You can also drag existing tab stops. If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x canvas $c -width 14.8c -height 2.5c pack $w.c -side top -fill x diff --git a/library/demos/sayings.tcl b/library/demos/sayings.tcl index a31012f..f6262ff 100644 --- a/library/demos/sayings.tcl +++ b/library/demos/sayings.tcl @@ -4,7 +4,7 @@ # both horizontally and vertically. It displays a collection of # well-known sayings. # -# RCS: @(#) $Id: sayings.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: sayings.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -20,11 +20,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "The listbox below contains a collection of well-known sayings. You can scan the list using either of the scrollbars or by dragging in the listbox window with button 2 pressed." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.frame -borderwidth 10 pack $w.frame -side top -expand yes -fill y diff --git a/library/demos/search.tcl b/library/demos/search.tcl index d5740b6..b72b4ac 100644 --- a/library/demos/search.tcl +++ b/library/demos/search.tcl @@ -4,7 +4,7 @@ # allow you to load a file into a text widget, then perform searches # on that file. # -# RCS: @(#) $Id: search.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: search.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -82,11 +82,9 @@ wm title $w "Text Demonstration - Search and Highlight" wm iconname $w "search" positionWindow $w -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.file label $w.file.label -text "File name:" -width 13 -anchor w diff --git a/library/demos/spin.tcl b/library/demos/spin.tcl index 61b4a38..20bb336 100644 --- a/library/demos/spin.tcl +++ b/library/demos/spin.tcl @@ -2,7 +2,7 @@ # # This demonstration script creates several spinbox widgets. # -# RCS: @(#) $Id: spin.tcl,v 1.1 2001/10/30 11:21:50 dkf Exp $ +# RCS: @(#) $Id: spin.tcl,v 1.2 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -28,11 +28,9 @@ label $w.msg -font $font -wraplength 5i -justify left -text "Three different\ Australian cities." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x set australianCities { Canberra Sydney Melbourne Perth Adelaide Brisbane diff --git a/library/demos/states.tcl b/library/demos/states.tcl index 7b7df6d..d60c658 100644 --- a/library/demos/states.tcl +++ b/library/demos/states.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a listbox widget that displays # the names of the 50 states in the United States of America. # -# RCS: @(#) $Id: states.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: states.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,11 +19,9 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left -text "A listbox containing the 50 states is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by scanning. To scan, press button 2 in the widget and drag up or down." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.frame -borderwidth .5c pack $w.frame -side top -expand yes -fill y diff --git a/library/demos/style.tcl b/library/demos/style.tcl index bc3ce80..035e2b3 100644 --- a/library/demos/style.tcl +++ b/library/demos/style.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget that illustrates the # various display styles that may be set for tags. # -# RCS: @(#) $Id: style.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: style.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -16,11 +16,9 @@ wm title $w "Text Demonstration - Display Styles" wm iconname $w "style" positionWindow $w -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ -width 70 -height 32 -wrap word diff --git a/library/demos/text.tcl b/library/demos/text.tcl index ca06917..242dd54 100644 --- a/library/demos/text.tcl +++ b/library/demos/text.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget that describes # the basic editing functions. # -# RCS: @(#) $Id: text.tcl,v 1.3 2001/11/15 11:55:26 dkf Exp $ +# RCS: @(#) $Id: text.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -16,11 +16,9 @@ wm title $w "Text Demonstration - Basic Facilities" wm iconname $w "text" positionWindow $w -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 \ -height 30 -undo 1 -autosep 1 diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index 8dff2dd..d03c818 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget with a bunch of # embedded windows. # -# RCS: @(#) $Id: twind.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: twind.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -16,11 +16,9 @@ wm title $w "Text Demonstration - Embedded Windows" wm iconname $w "Embedded Windows" positionWindow $w -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken set t $w.f.text diff --git a/library/demos/unicodeout.tcl b/library/demos/unicodeout.tcl index bdf6fe6..a0b2677 100644 --- a/library/demos/unicodeout.tcl +++ b/library/demos/unicodeout.tcl @@ -3,7 +3,7 @@ # This demonstration script shows how you can produce output (in label # widgets) using many different alphabets. # -# RCS: @(#) $Id: unicodeout.tcl,v 1.2 2003/02/21 13:05:06 dkf Exp $ +# RCS: @(#) $Id: unicodeout.tcl,v 1.3 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -16,7 +16,7 @@ wm title $w "Unicode Label Demonstration" wm iconname $w "unicodeout" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left \ +label $w.msg -font $font -wraplength 4i -anchor w -justify left \ -text "This is a sample of Tk's support for languages that use\ non-Western character sets. However, what you will actually see\ below depends largely on what character sets you have installed,\ @@ -26,11 +26,9 @@ label $w.msg -font $font -wraplength 4i -justify left \ portable fashion." pack $w.msg -side top -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x pack [label $w.wait -text "Please wait while loading fonts..." \ -font {Helvetica 12 italic}] diff --git a/library/demos/vscale.tcl b/library/demos/vscale.tcl index cb89ec3..52979a5 100644 --- a/library/demos/vscale.tcl +++ b/library/demos/vscale.tcl @@ -2,7 +2,7 @@ # # This demonstration script shows an example with a vertical scale. # -# RCS: @(#) $Id: vscale.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ +# RCS: @(#) $Id: vscale.tcl,v 1.4 2003/08/20 23:02:18 hobbs Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -18,11 +18,9 @@ positionWindow $w label $w.msg -font $font -wraplength 3.5i -justify left -text "An arrow and a vertical scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the size of the arrow." pack $w.msg -side top -padx .5c -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +pack $btns -side bottom -fill x frame $w.frame -borderwidth 10 pack $w.frame diff --git a/library/demos/widget b/library/demos/widget index e0fde72..f9c5932 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -11,7 +11,7 @@ exec wish "$0" "$@" # ".tcl" files is this directory, which are sourced by this script # as needed. # -# RCS: @(#) $Id: widget,v 1.10 2003/05/19 14:44:04 dkf Exp $ +# RCS: @(#) $Id: widget,v 1.11 2003/08/20 23:02:18 hobbs Exp $ eval destroy [winfo child .] package require msgcat @@ -28,16 +28,37 @@ if {$tcl_platform(platform) eq "unix"} { wm iconname . [mc "tkWidgetDemo"] } -array set widgetFont { - main {Helvetica 12} - bold {Helvetica 12 bold} - title {Helvetica 18 bold} - status {Helvetica 10} - vars {Helvetica 14} +if {[lsearch -exact [font names] defaultFont] == -1} { + font create mainFont -family Helvetica -size 12 + font create fixedFont -family Courier -size 10 + font create boldFont -family Helvetica -size 12 -weight bold + font create titleFont -family Helvetica -size 18 -weight bold + font create statusFont -family Helvetica -size 10 + font create varsFont -family Helvetica -size 14 } set widgetDemo 1 -set font $widgetFont(main) +set font mainFont + +image create photo ::img::refresh -format GIF -data { + R0lGODlhEAAQAPMAAMz/zCpnKdb/1z9mPypbKBtLGy9NMPL/9Or+6+P+4j1Y + PwQKBP7//xMLFAYBCAEBASH5BAEAAAAALAAAAAAQABAAAwR0EAD3Gn0Vyw0e + ++CncU7IIAezMA/nhUqSLJizvSdCEEjy2ZIV46AwDAoDHwPYGSoEiUJAAGJ6 + EDHBNCFINW5OqABKSFk/B9lUa94IDwIFgewFMwQDQwCZQCztTgM9Sl8SOEMG + KSAthiaOjBMPDhQONBiXABEAOw== +} + +image create photo ::img::view -format GIF -data { + R0lGODlhEAAQAPMAAMz/zP///8DAwICAgH9/fwAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAwRIcMhJB7h3hM33 + KFjWdQQYap1QrCaGBmrRrS4nj5b53jOgbwXBKGACoYLDIuAoHCmZyYvR1rT5 + RMAq8LqcIYGsrjPsW1XOmFUEADs= +} + +image create photo ::img::delete -format GIF -data { + R0lGODlhEAAOAKEAAIQAAO/n3v///////yH5BAEKAAIALAAAAAAQAA4AAAIm + lI9pAKHbIHNoVhYhTdjlJ2AWKG2g+CldmB6rxo2uybYhbS80eRQAOw== +} #---------------------------------------------------------------- # The code below create the main window, consisting of a menu bar @@ -69,20 +90,20 @@ bind . <Meta-q> {exit} frame .statusBar label .statusBar.lab -text " " -relief sunken -bd 1 \ - -font $widgetFont(status) -anchor w + -font statusFont -anchor w label .statusBar.foo -width 8 -relief sunken -bd 1 \ - -font $widgetFont(status) -anchor w + -font statusFont -anchor w pack .statusBar.lab -side left -padx 2 -expand yes -fill both pack .statusBar.foo -side left -padx 2 pack .statusBar -side bottom -fill x -pady 2 frame .textFrame scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \ - -takefocus 1 + -takefocus 1 -bd 1 pack .s -in .textFrame -side right -fill y text .t -yscrollcommand {.s set} -wrap word -width 70 -height 30 \ - -font $widgetFont(main) -setgrid 1 -highlightthickness 0 \ - -padx 4 -pady 2 -takefocus 0 + -font mainFont -setgrid 1 -highlightthickness 0 \ + -padx 4 -pady 2 -takefocus 0 -bd 1 pack .t -in .textFrame -expand y -fill both -padx 1 pack .textFrame -expand yes -fill both @@ -90,8 +111,8 @@ pack .textFrame -expand yes -fill both # section titles and demo descriptions. Also define the bindings for # tags. -.t tag configure title -font $widgetFont(title) -.t tag configure bold -font $widgetFont(bold) +.t tag configure title -font titleFont +.t tag configure bold -font boldFont # We put some "space" characters to the left and right of each demo description # so that the descriptions are highlighted only when the mouse cursor @@ -283,6 +304,33 @@ addDemoSection "Miscellaneous" { .t configure -state disabled focus .s +# addSeeDismiss -- +# Add "See Code" and "Dismiss" button frame, with optional "See Vars" +# +# Arguments: +# w - The name of the frame to use. + +proc addSeeDismiss {w show {vars {}}} { + ## See Code / Dismiss buttons + frame $w + button $w.dismiss -text [mc "Dismiss"] \ + -image ::img::refresh -compound left \ + -command [list destroy [winfo toplevel $w]] + button $w.code -text [mc "See Code"] \ + -image ::img::view -compound left \ + -command [list showCode $show] + if {[llength $vars]} { + button $w.vars -text [mc "See Variables"] \ + -image ::img::view -compound left \ + -command [concat [list showVars $w.dialog] $vars] + grid x $w.vars $w.code $w.dismiss -padx 4 -pady {6 4} + } else { + grid x $w.code $w.dismiss -padx 4 -pady {6 4} + } + grid columnconfigure $w 0 -weight 1 + return $w +} + # positionWindow -- # This procedure is invoked by most of the demos to position a # new demo window. @@ -303,31 +351,26 @@ proc positionWindow w { # args - Any number of names of variables. proc showVars {w args} { - global widgetFont catch {destroy $w} toplevel $w wm title $w [mc "Variable values"] - label $w.title -text [mc "Variable values:"] -width 20 -anchor center \ - -font $widgetFont(vars) - pack $w.title -side top -fill x - set len 1 - foreach i $args { - if {[string length $i] > $len} { - set len [string length $i] - } - } - foreach i $args { - frame $w.$i - label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w - label $w.$i.value -textvar $i -anchor w - pack $w.$i.name -side left - pack $w.$i.value -side left -expand 1 -fill x - pack $w.$i -side top -anchor w -fill x + + set f [labelframe $w.title -text [mc "Variable values:"] -font varsFont] + foreach var $args { + label $f.n$var -text "$var:" -anchor w + label $f.v$var -textvariable $var -anchor w + grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w } button $w.ok -text [mc "OK"] -command [list destroy $w] -default active - bind $w <Return> [list tkButtonInvoke $w.ok] - bind $w <Escape> [list tkButtonInvoke $w.ok] - pack $w.ok -side bottom -pady 2 + bind $w <Return> [list $w.ok invoke] + bind $w <Escape> [list $w.ok invoke] + + grid $f -sticky news -padx 4 + grid $w.ok -sticky e -padx 4 -pady {6 4} + grid columnconfig $f 1 -weight 1 + grid rowconfigure $f 100 -weight 1 + grid columnconfig $w 0 -weight 1 + grid rowconfigure $w 0 -weight 1 } # invoke -- @@ -378,6 +421,15 @@ proc showStatus index { } } +# evalShowCode -- +# +# Arguments: +# w - Name of text widget containing code to eval + +proc evalShowCode {w} { + set code [$w get 1.0 end-1c] + uplevel #0 $code +} # showCode -- # This procedure creates a toplevel window that displays the code for @@ -390,46 +442,54 @@ proc showStatus index { proc showCode w { global tk_library set file [string range $w 1 end].tcl - if {![winfo exists .code]} { - toplevel .code - frame .code.buttons - pack .code.buttons -side bottom -fill x - button .code.buttons.dismiss -text [mc "Dismiss"] \ - -default active -command {destroy .code} - button .code.buttons.rerun -text [mc "Rerun Demo"] -command { - eval [.code.text get 1.0 end] - } - pack .code.buttons.dismiss .code.buttons.rerun -side left \ - -expand 1 -pady 2 - frame .code.frame - pack .code.frame -expand yes -fill both -padx 1 -pady 1 - text .code.text -height 40 -wrap word \ - -xscrollcommand {.code.xscroll set} \ - -yscrollcommand {.code.yscroll set} \ - -setgrid 1 -highlightthickness 0 -pady 2 -padx 3 - scrollbar .code.xscroll -command {.code.text xview} \ - -highlightthickness 0 -orient horizontal - scrollbar .code.yscroll -command {.code.text yview} \ - -highlightthickness 0 -orient vertical - - grid .code.text -in .code.frame -padx 1 -pady 1 \ - -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news - grid .code.yscroll -in .code.frame -padx 1 -pady 1 \ - -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news -# grid .code.xscroll -in .code.frame -padx 1 -pady 1 \ -# -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news - grid rowconfig .code.frame 0 -weight 1 -minsize 0 - grid columnconfig .code.frame 0 -weight 1 -minsize 0 + set top .code + if {![winfo exists $top]} { + toplevel $top + + set t [frame $top.f] + set text [text $t.text -font fixedFont -height 30 -wrap word -bd 1 \ + -xscrollcommand [list $t.xscroll set] \ + -yscrollcommand [list $t.yscroll set] \ + -setgrid 1 -highlightthickness 0 -pady 2 -padx 3] + scrollbar $t.xscroll -command [list $t.text xview] \ + -highlightthickness 0 -orient horizontal -bd 1 + scrollbar $t.yscroll -command [list $t.text yview] \ + -highlightthickness 0 -orient vertical -bd 1 + + grid $t.text $t.yscroll -sticky news + #grid $t.xscroll + grid rowconfigure $t 0 -weight 1 + grid columnconfig $t 0 -weight 1 + + set btns [frame $top.btns] + + button $btns.dismiss -text [mc "Dismiss"] \ + -default active -command [list destroy $top] \ + -image ::img::delete -compound left + button $btns.rerun -text [mc "Rerun Demo"] \ + -command [list evalShowCode $text] \ + -image ::img::refresh -compound left + + grid x $btns.rerun $btns.dismiss -padx 4 -pady {6 4} + grid columnconfigure $btns 0 -weight 1 + + grid $t -sticky news + grid $btns -sticky ew + grid rowconfigure $top 0 -weight 1 + grid columnconfig $top 0 -weight 1 + + bind $top <Return> [list $btns.dismiss invoke] + bind $top <Escape> [list $btns.dismiss invoke] } else { - wm deiconify .code - raise .code + wm deiconify $top + raise $top } - wm title .code [mc "Demo code: %s" [file join $tk_library demos $file]] - wm iconname .code $file + wm title $top [mc "Demo code: %s" [file join $tk_library demos $file]] + wm iconname $top $file set id [open [file join $tk_library demos $file]] - .code.text delete 1.0 end - .code.text insert 1.0 [read $id] - .code.text mark set insert 1.0 + $top.f.text delete 1.0 end + $top.f.text insert 1.0 [read $id] + $top.f.text mark set insert 1.0 close $id } @@ -439,7 +499,7 @@ proc showCode w { # 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.}] |