diff options
Diffstat (limited to 'library/demos')
-rw-r--r-- | library/demos/browse | 36 | ||||
-rw-r--r-- | library/demos/dialog2.tcl | 4 | ||||
-rw-r--r-- | library/demos/entry3.tcl | 187 | ||||
-rw-r--r-- | library/demos/hello | 6 | ||||
-rw-r--r-- | library/demos/image2.tcl | 48 | ||||
-rw-r--r-- | library/demos/ixset | 137 | ||||
-rw-r--r-- | library/demos/labelframe.tcl | 7 | ||||
-rw-r--r-- | library/demos/menu.tcl | 8 | ||||
-rw-r--r-- | library/demos/radio.tcl | 43 | ||||
-rw-r--r-- | library/demos/rmt | 35 | ||||
-rw-r--r-- | library/demos/rolodex | 78 | ||||
-rw-r--r-- | library/demos/spin.tcl | 55 | ||||
-rw-r--r-- | library/demos/tcolor | 280 | ||||
-rw-r--r-- | library/demos/text.tcl | 18 | ||||
-rw-r--r-- | library/demos/timer | 35 | ||||
-rw-r--r-- | library/demos/widget | 234 |
16 files changed, 780 insertions, 431 deletions
diff --git a/library/demos/browse b/library/demos/browse index d3f55e3..8c46b80 100644 --- a/library/demos/browse +++ b/library/demos/browse @@ -1,13 +1,13 @@ #!/bin/sh # the next line restarts using wish \ -exec wish "$0" "$@" +exec wish "$0" ${1+"$@"} # browse -- # This script generates a directory browser, which lists the working # directory and allows you to open files or subdirectories by # double-clicking. # -# RCS: @(#) $Id: browse,v 1.2 1998/09/14 18:23:27 stanton Exp $ +# RCS: @(#) $Id: browse,v 1.2.24.1 2002/02/05 02:25:16 wolfsuit Exp $ # Create a scrollbar on the right side of the main window and a listbox # on the left side. @@ -24,29 +24,35 @@ wm minsize . 1 1 # the file is a regular file then the Mx editor is invoked to display # the file. +set browseScript [file join [pwd] $argv0] proc browse {dir file} { - global env + global env browseScript if {[string compare $dir "."] != 0} {set file $dir/$file} - if [file isdirectory $file] { - exec browse $file & - } else { - if [file isfile $file] { - if [info exists env(EDITOR)] { + switch [file type $file] { + directory { + exec [info nameofexecutable] $browseScript $file & + } + file { + if {[info exists env(EDITOR)]} { eval exec $env(EDITOR) $file & } else { exec xedit $file & } - } else { + } + default { puts stdout "\"$file\" isn't a directory or regular file" } } } -# Fill the listbox with a list of all the files in the directory (run -# the "ls" command to get that information). +# Fill the listbox with a list of all the files in the directory. -if $argc>0 {set dir [lindex $argv 0]} else {set dir "."} -foreach i [exec ls -a $dir] { +if {$argc>0} {set dir [lindex $argv 0]} else {set dir "."} +foreach i [lsort [glob * .* *.*]] { + if {[file type $i] eq "directory"} { + # Safe to do since it is still a directory. + append i / + } .list insert end $i } @@ -54,3 +60,7 @@ foreach i [exec ls -a $dir] { bind all <Control-c> {destroy .} bind .list <Double-Button-1> {foreach i [selection get] {browse $dir $i}} + +# Local Variables: +# mode: tcl +# End: diff --git a/library/demos/dialog2.tcl b/library/demos/dialog2.tcl index 0252ee0..40aee75 100644 --- a/library/demos/dialog2.tcl +++ b/library/demos/dialog2.tcl @@ -2,7 +2,7 @@ # # This demonstration script creates a dialog box with a global grab. # -# RCS: @(#) $Id: dialog2.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $ +# RCS: @(#) $Id: dialog2.tcl,v 1.2.24.1 2002/02/05 02:25:16 wolfsuit Exp $ after idle { .dialog2.msg configure -wraplength 4i @@ -10,7 +10,7 @@ after idle { after 100 { grab -global .dialog2 } -set i [tk_dialog .dialog2 "Dialog with local grab" {This dialog box uses a global grab, so it prevents you from interacting with anything on your display until you invoke one of the buttons below. Global grabs are almost always a bad idea; don't use them unless you're truly desperate.} warning 0 OK Cancel {Show Code}] +set i [tk_dialog .dialog2 "Dialog with global grab" {This dialog box uses a global grab, so it prevents you from interacting with anything on your display until you invoke one of the buttons below. Global grabs are almost always a bad idea; don't use them unless you're truly desperate.} warning 0 OK Cancel {Show Code}] switch $i { 0 {puts "You pressed OK"} diff --git a/library/demos/entry3.tcl b/library/demos/entry3.tcl new file mode 100644 index 0000000..9c81521 --- /dev/null +++ b/library/demos/entry3.tcl @@ -0,0 +1,187 @@ +# entry2.tcl -- +# +# This demonstration script creates several entry widgets whose +# permitted input is constrained in some way. It also shows off a +# password entry. +# +# RCS: @(#) $Id: entry3.tcl,v 1.1.2.1 2002/02/05 02:25:16 wolfsuit Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .entry3 +catch {destroy $w} +toplevel $w +wm title $w "Constrained Entry Demonstration" +wm iconname $w "entry3" +positionWindow $w + + +label $w.msg -font $font -wraplength 5i -justify left -text "Four different\ + entries are displayed below. You can add characters by pointing,\ + clicking and typing, though each is constrained in what it will\ + accept. The first only accepts integers or the empty string\ + (checking when focus leaves it) and will flash to indicate any\ + problem. The second only accepts strings with fewer than ten\ + characters and sounds the bell when an attempt to go over the limit\ + is made. The third accepts US phone numbers, mapping letters to\ + their digit equivalent and sounding the bell on encountering an\ + illegal character or if trying to type over a character that is not\ + a digit. The fourth is a password field that accepts up to eight\ + 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 + + +# focusAndFlash -- +# Error handler for entry widgets that forces the focus onto the +# widget and makes the widget flash by exchanging the foreground and +# background colours at intervals of 200ms (i.e. at approximately +# 2.5Hz). +# +# Arguments: +# W - Name of entry widget to flash +# fg - Initial foreground colour +# bg - Initial background colour +# count - Counter to control the number of times flashed + +proc focusAndFlash {W fg bg {count 9}} { + focus -force $W + if {$count<1} { + $W configure -foreground $fg -background $bg + } else { + if {$count%2} { + $W configure -foreground $bg -background $fg + } else { + $W configure -foreground $fg -background $bg + } + after 200 [list focusAndFlash $W $fg $bg [expr {$count-1}]] + } +} + +labelframe $w.l1 -text "Integer Entry" +entry $w.l1.e -validate focus -vcmd {string is integer %P} +$w.l1.e configure -invalidcommand \ + "focusAndFlash %W [$w.l1.e cget -fg] [$w.l1.e cget -bg]" +pack $w.l1.e -fill x -expand 1 -padx 1m -pady 1m + +labelframe $w.l2 -text "Length-Constrained Entry" +entry $w.l2.e -validate key -invcmd bell -vcmd {expr {[string length %P]<10}} +pack $w.l2.e -fill x -expand 1 -padx 1m -pady 1m + +### PHONE NUMBER ENTRY ### +# Note that the source to this is quite a bit longer as the behaviour +# demonstrated is a lot more ambitious than with the others. + +# Initial content for the third entry widget +set entry3content "1-(000)-000-0000" +# Mapping from alphabetic characters to numbers. This is probably +# wrong, but it is the only mapping I have; the UK doesn't really go +# for associating letters with digits for some reason. +set phoneNumberMap {} +foreach {chars digit} {abc 2 def 3 ghi 4 jkl 5 mno 6 pqrs 7 tuv 8 wxyz 9} { + foreach char [split $chars ""] { + lappend phoneNumberMap $char $digit [string toupper $char] $digit + } +} + +# validatePhoneChange -- +# Checks that the replacement (mapped to a digit) of the given +# character in an entry widget at the given position will leave a +# valid phone number in the widget. +# +# W - The entry widget to validate +# vmode - The widget's validation mode +# idx - The index where replacement is to occur +# char - The character (or string, though that will always be +# refused) to be overwritten at that point. + +proc validatePhoneChange {W vmode idx char} { + global phoneNumberMap entry3content + if {$idx == -1} {return 1} + after idle [list $W configure -validate $vmode -invcmd bell] + if { + !($idx<3 || $idx==6 || $idx==7 || $idx==11 || $idx>15) && + [string match {[0-9A-Za-z]} $char] + } then { + $W delete $idx + $W insert $idx [string map $phoneNumberMap $char] + after idle [list phoneSkipRight $W -1] + return 1 + } + return 0 +} + +# phoneSkipLeft -- +# Skip over fixed characters in a phone-number string when moving left. +# +# Arguments: +# W - The entry widget containing the phone-number. + +proc phoneSkipLeft {W} { + set idx [$W index insert] + if {$idx == 8} { + # Skip back two extra characters + $W icursor [incr idx -2] + } elseif {$idx == 7 || $idx == 12} { + # Skip back one extra character + $W icursor [incr idx -1] + } elseif {$idx <= 3} { + # Can't move any further + bell + return -code break + } +} + +# phoneSkipRight -- +# Skip over fixed characters in a phone-number string when moving right. +# +# Arguments: +# W - The entry widget containing the phone-number. +# add - Offset to add to index before calculation (used by validation.) + +proc phoneSkipRight {W {add 0}} { + set idx [$W index insert] + if {$idx+$add == 5} { + # Skip forward two extra characters + $W icursor [incr idx 2] + } elseif {$idx+$add == 6 || $idx+$add == 10} { + # Skip forward one extra character + $W icursor [incr idx] + } elseif {$idx+$add == 15 && !$add} { + # Can't move any further + bell + return -code break + } +} + +labelframe $w.l3 -text "US Phone-Number Entry" +entry $w.l3.e -validate key -invcmd bell -textvariable entry3content \ + -vcmd {validatePhoneChange %W %v %i %S} +# Click to focus goes to the first editable character... +bind $w.l3.e <FocusIn> { + if {"%d" ne "NotifyAncestor"} { + %W icursor 3 + after idle {%W selection clear} + } +} +bind $w.l3.e <Left> {phoneSkipLeft %W} +bind $w.l3.e <Right> {phoneSkipRight %W} +pack $w.l3.e -fill x -expand 1 -padx 1m -pady 1m + +labelframe $w.l4 -text "Password Entry" +entry $w.l4.e -validate key -show "*" -vcmd {expr {[string length %P]<=8}} +pack $w.l4.e -fill x -expand 1 -padx 1m -pady 1m + +lower [frame $w.mid] +grid $w.l1 $w.l2 -in $w.mid -padx 3m -pady 1m -sticky ew +grid $w.l3 $w.l4 -in $w.mid -padx 3m -pady 1m -sticky ew +grid columnconfigure $w.mid {0 1} -uniform 1 +pack $w.msg -side top +pack $w.buttons -side bottom -fill x -pady 2m +pack $w.mid -fill both -expand 1 diff --git a/library/demos/hello b/library/demos/hello index c6bd8c8..270e6f2 100644 --- a/library/demos/hello +++ b/library/demos/hello @@ -6,7 +6,7 @@ exec wish "$0" "$@" # Simple Tk script to create a button that prints "Hello, world". # Click on the button to terminate the program. # -# RCS: @(#) $Id: hello,v 1.2 1998/09/14 18:23:28 stanton Exp $ +# RCS: @(#) $Id: hello,v 1.2.24.1 2002/02/05 02:25:16 wolfsuit Exp $ # # The first line below creates the button, and the second line # asks the packer to shrink-wrap the application's main window @@ -16,3 +16,7 @@ button .hello -text "Hello, world" -command { puts stdout "Hello, world"; destroy . } pack .hello + +# Local Variables: +# mode: tcl +# End: diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl index 6d3be0f..05f6bbc 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.3 2001/08/10 08:33:35 dkf Exp $ +# RCS: @(#) $Id: image2.tcl,v 1.3.2.1 2002/02/05 02:25:16 wolfsuit Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -25,6 +25,23 @@ proc loadDir w { } } +# selectAndLoadDir -- +# This procedure pops up a dialog to ask for a directory to load into +# the listobx and (if the user presses OK) reloads the directory +# listbox from the directory named in the demo's entry. +# +# Arguments: +# w - Name of the toplevel window of the demo. + +proc selectAndLoadDir w { + global dirName + set dir [tk_chooseDirectory -initialdir $dirName -parent $w -mustexist 1] + if {[string length $dir] != 0} { + set dirName $dir + loadDir $w + } +} + # loadImage -- # Given the name of the toplevel window of the demo and the mouse # position, extracts the directory entry under the mouse and loads @@ -57,14 +74,18 @@ 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 -label $w.dirLabel -text "Directory:" +frame $w.mid +pack $w.mid -fill both -expand 1 + +labelframe $w.dir -text "Directory:" set dirName [file join $tk_library demos images] -entry $w.dirName -width 30 -textvariable dirName -bind $w.dirName <Return> "loadDir $w" -frame $w.spacer1 -height 3m -width 20 -label $w.fileLabel -text "File:" -frame $w.f -pack $w.dirLabel $w.dirName $w.spacer1 $w.fileLabel $w.f -side top -anchor w +entry $w.dir.e -width 30 -textvariable dirName +button $w.dir.b -pady 0 -padx 2m -text "Select Dir." \ + -command "selectAndLoadDir $w" +bind $w.dir.e <Return> "loadDir $w" +pack $w.dir.e -side left -fill y -padx 2m -pady 2m +pack $w.dir.b -side left -fill y -padx {0 2m} -pady 2m +labelframe $w.f -text "File:" -padx 2m -pady 2m listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" scrollbar $w.f.scroll -command "$w.f.list yview" @@ -74,7 +95,10 @@ bind $w.f.list <Double-1> "loadImage $w %x %y" catch {image delete image2a} image create photo image2a -frame $w.spacer2 -height 3m -width 20 -label $w.imageLabel -text "Image:" -label $w.image -image image2a -pack $w.spacer2 $w.imageLabel $w.image -side top -anchor w +labelframe $w.image -text "Image:" +label $w.image.image -image image2a +pack $w.image.image -padx 2m -pady 2m + +grid $w.dir - -sticky w -padx 1m -pady 1m -in $w.mid +grid $w.f $w.image -sticky nw -padx 1m -pady 1m -in $w.mid +grid columnconfigure $w.mid 1 -weight 1 diff --git a/library/demos/ixset b/library/demos/ixset index c5bcfd3..f30bf95 100644 --- a/library/demos/ixset +++ b/library/demos/ixset @@ -1,6 +1,6 @@ #!/bin/sh # the next line restarts using wish \ -exec wish "$0" "$@" +exec wish "$0" ${1+"$@"} # ixset -- # A nice interface to "xset" to change X server settings @@ -9,7 +9,7 @@ exec wish "$0" "$@" # 91/11/23 : pda@masi.ibp.fr, jt@ratp.fr : design # 92/08/01 : pda@masi.ibp.fr : cleaning # -# RCS: @(#) $Id: ixset,v 1.2 1998/09/14 18:23:29 stanton Exp $ +# RCS: @(#) $Id: ixset,v 1.2.24.1 2002/02/05 02:25:16 wolfsuit Exp $ # # Button actions @@ -27,10 +27,15 @@ proc ok {} { proc cancel {} { readsettings dispsettings + .buttons.apply configure -state disabled + .buttons.cancel configure -state disabled } -# apply is just "writesettings" - +proc apply {} { + writesettings + .buttons.apply configure -state disabled + .buttons.cancel configure -state disabled +} # # Read current settings @@ -120,8 +125,8 @@ proc writesettings {} { set mouseacc [.mouse.hor.acc.entry get] set mousethr [.mouse.hor.thr.entry get] - set screentim [.screen.val.le.tim.entry get] - set screencyc [.screen.val.le.cyc.entry get] + set screentim [.screen.tim.entry get] + set screencyc [.screen.cyc.entry get] exec xset \ b $bellvol $bellpit $belldur \ @@ -155,12 +160,12 @@ proc dispsettings {} { .mouse.hor.thr.entry delete 0 end .mouse.hor.thr.entry insert 0 $mousethr - .screen.val.rb.blank [expr "{$screenbla}=={blank} ? {select} : {deselect}"] - .screen.val.rb.pat [expr "{$screenbla}!={blank} ? {select} : {deselect}"] - .screen.val.le.tim.entry delete 0 end - .screen.val.le.tim.entry insert 0 $screentim - .screen.val.le.cyc.entry delete 0 end - .screen.val.le.cyc.entry insert 0 $screencyc + .screen.blank [expr "{$screenbla}=={blank} ? {select} : {deselect}"] + .screen.pat [expr "{$screenbla}!={blank} ? {select} : {deselect}"] + .screen.tim.entry delete 0 end + .screen.tim.entry insert 0 $screentim + .screen.cyc.entry delete 0 end + .screen.cyc.entry insert 0 $screencyc } @@ -168,12 +173,17 @@ proc dispsettings {} { # Create all windows, and pack them # -proc labelentry {path text length} { +proc labelentry {path text length {range {}}} { frame $path label $path.label -text $text - entry $path.entry -width $length -relief sunken - pack $path.label -side left -expand y - pack $path.entry -side right -expand y + if {[llength $range]} { + spinbox $path.entry -width $length -relief sunken \ + -from [lindex $range 0] -to [lindex $range 1] + } else { + entry $path.entry -width $length -relief sunken + } + pack $path.label -side left + pack $path.entry -side right -expand y -fill x } proc createwindows {} { @@ -182,38 +192,57 @@ proc createwindows {} { # frame .buttons - button .buttons.ok -command "ok" -text "Ok" - button .buttons.apply -command "writesettings" -text "Apply" - button .buttons.cancel -command "cancel" -text "Cancel" - button .buttons.quit -command "quit" -text "Quit" + button .buttons.ok -default active -command ok -text "Ok" + button .buttons.apply -default normal -command apply -text "Apply" \ + -state disabled + button .buttons.cancel -default normal -command cancel -text "Cancel" \ + -state disabled + button .buttons.quit -default normal -command quit -text "Quit" pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \ -side left -expand yes -pady 5 + bind . <Return> {.buttons.ok flash; .buttons.ok invoke} + bind . <Escape> {.buttons.quit flash; .buttons.quit invoke} + bind . <1> { + if {![string match .buttons* %W]} { + .buttons.apply configure -state normal + .buttons.cancel configure -state normal + } + } + bind . <Key> { + if {![string match .buttons* %W]} { + switch -glob %K { + Return - Escape - Tab - *Shift* {} + default { + .buttons.apply configure -state normal + .buttons.cancel configure -state normal + } + } + } + } + # # Bell settings # - frame .bell -relief raised -borderwidth 2 - label .bell.label -text "Bell Settings" + labelframe .bell -text "Bell Settings" -padx 1.5m -pady 1.5m scale .bell.vol \ -from 0 -to 100 -length 200 -tickinterval 20 \ -label "Volume (%)" -orient horizontal frame .bell.val - labelentry .bell.val.pit "Pitch (Hz)" 6 - labelentry .bell.val.dur "Duration (ms)" 6 + labelentry .bell.val.pit "Pitch (Hz)" 6 {25 20000} + labelentry .bell.val.dur "Duration (ms)" 6 {1 10000} pack .bell.val.pit -side left -padx 5 pack .bell.val.dur -side right -padx 5 - pack .bell.label .bell.vol .bell.val -side top -expand yes + pack .bell.vol .bell.val -side top -expand yes # # Keyboard settings # - frame .kbd -relief raised -borderwidth 2 - - label .kbd.label -text "Keyboard Repeat Settings" + labelframe .kbd -text "Keyboard Repeat Settings" -padx 1.5m -pady 1.5m frame .kbd.val checkbutton .kbd.val.onoff \ @@ -223,62 +252,52 @@ proc createwindows {} { scale .kbd.val.cli \ -from 0 -to 100 -length 200 -tickinterval 20 \ -label "Click Volume (%)" -orient horizontal - pack .kbd.val.onoff -side left -expand yes -fill both - pack .kbd.val.cli -side left -expand yes + pack .kbd.val.onoff -side left -fill x -expand yes -padx {0 1m} + pack .kbd.val.cli -side left -expand yes -fill x -padx {1m 0} - pack .kbd.label -side top -expand yes pack .kbd.val -side top -expand yes -pady 2 -fill x # # Mouse settings # - frame .mouse -relief raised -borderwidth 2 + labelframe .mouse -text "Mouse Settings" -padx 1.5m -pady 1.5m - label .mouse.label -text "Mouse Settings" frame .mouse.hor - labelentry .mouse.hor.acc "Acceleration" 3 - labelentry .mouse.hor.thr "Threshold (pixels)" 3 + labelentry .mouse.hor.acc "Acceleration" 5 + labelentry .mouse.hor.thr "Threshold (pixels)" 3 {1 2000} - pack .mouse.hor.acc -side left - pack .mouse.hor.thr -side right + pack .mouse.hor.acc -side left -padx {0 1m} + pack .mouse.hor.thr -side right -padx {1m 0} - pack .mouse.label -side top pack .mouse.hor -side top -expand yes # # Screen Saver settings # - frame .screen -relief raised -borderwidth 2 + labelframe .screen -text "Screen-saver Settings" -padx 1.5m -pady 1.5m - label .screen.label -text "Screen-saver Settings" - frame .screen.val - - frame .screen.val.rb - radiobutton .screen.val.rb.blank \ + radiobutton .screen.blank \ -variable screenblank -text "Blank" -relief flat \ - -value "blank" -variable screenbla - radiobutton .screen.val.rb.pat \ + -value "blank" -variable screenbla -anchor w + radiobutton .screen.pat \ -variable screenblank -text "Pattern" -relief flat \ - -value "noblank" -variable screenbla - pack .screen.val.rb.blank .screen.val.rb.pat -side top -pady 2 -anchor w - frame .screen.val.le - labelentry .screen.val.le.tim "Timeout (s)" 5 - labelentry .screen.val.le.cyc "Cycle (s)" 5 - pack .screen.val.le.tim .screen.val.le.cyc -side top -pady 2 -anchor e - - pack .screen.val.rb .screen.val.le -side left + -value "noblank" -variable screenbla -anchor w + labelentry .screen.tim "Timeout (s)" 5 {1 100000} + labelentry .screen.cyc "Cycle (s)" 5 {1 100000} - pack .screen.label -side top - pack .screen.val -side top -expand y + grid .screen.blank .screen.tim -sticky e + grid .screen.pat .screen.cyc -sticky e + grid configure .screen.blank .screen.pat -sticky ew # # Main window # pack .buttons -side top -fill both - pack .bell .kbd .mouse .screen -side top -fill both -ipady 5 -expand yes + pack .bell .kbd .mouse .screen -side top -fill both -expand yes \ + -padx 1m -pady 1m # # Let the user resize our window @@ -310,3 +329,7 @@ dispsettings # # Now, wait for user actions... # + +# Local Variables: +# mode: tcl +# End: diff --git a/library/demos/labelframe.tcl b/library/demos/labelframe.tcl index 89931cf..d81e65a 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.1 2001/09/26 21:36:19 pspjuth Exp $ +# RCS: @(#) $Id: labelframe.tcl,v 1.1.2.1 2002/02/05 02:25:16 wolfsuit Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -19,7 +19,8 @@ positionWindow $w # Some information label $w.msg -font $font -wraplength 4i -justify left -text "Labelframes are\ -typically used to group related widgets together." + used to group related widgets together. The label may be either \ + plain text or another widget." pack $w.msg -side top # The bottom buttons @@ -42,7 +43,7 @@ labelframe $w.f -text "Value" -padx 2 -pady 2 grid $w.f -row 0 -column 0 -pady 2m -padx 2m foreach value {1 2 3 4} { - radiobutton $w.f.b$value -text $value -width 3 \ + radiobutton $w.f.b$value -text "This is value $value" \ -variable lfdummy -value $value pack $w.f.b$value -side top -fill x -pady 2 } diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl index ab0217e..5b16259 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.2.24.1 2001/10/15 09:22:00 wolfsuit Exp $ +# RCS: @(#) $Id: menu.tcl,v 1.2.24.2 2002/02/05 02:25:16 wolfsuit Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -133,6 +133,12 @@ menu $m -tearoff 0 foreach i {{An entry} {Another entry} {Does nothing} {Does almost nothing} {Make life meaningful}} { $m add command -label $i -command [list puts "You invoked \"$i\""] } +$m entryconfigure "Does almost nothing" \ + -bitmap questhead -compound left -command { + tk_dialog .compound {Compound Menu Entry} {The menu entry you invoked\ + displays both a bitmap and a text string. Other than this, it\ + is just like any other menu entry.} {} 0 OK +} set m $w.menu.colors $w.menu add cascade -label "Colors" -menu $m -underline 1 diff --git a/library/demos/radio.tcl b/library/demos/radio.tcl index 0788b90..7ad3c5e 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.3 2001/09/26 21:36:19 pspjuth Exp $ +# RCS: @(#) $Id: radio.tcl,v 1.3.2.1 2002/02/05 02:25:16 wolfsuit Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -15,30 +15,45 @@ toplevel $w wm title $w "Radiobutton Demonstration" wm iconname $w "radio" positionWindow $w -label $w.msg -font $font -wraplength 5i -justify left -text "Two 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." +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" +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 -labelframe $w.left -pady 2 -text "Point Size" -labelframe $w.right -pady 2 -text "Color" -pack $w.left $w.right -side left -expand yes -pady .5c -padx .5c +labelframe $w.left -pady 2 -text "Point Size" -padx 2 +labelframe $w.mid -pady 2 -text "Color" -padx 2 +labelframe $w.right -pady 2 -text "Alignment" -padx 2 +pack $w.left $w.mid $w.right -side left -expand yes -pady .5c -padx .5c -foreach i {10 12 18 24} { +foreach i {10 12 14 18 24} { radiobutton $w.left.b$i -text "Point Size $i" -variable size \ -relief flat -value $i - pack $w.left.b$i -side top -pady 2 -anchor w + pack $w.left.b$i -side top -pady 2 -anchor w -fill x } -foreach color {Red Green Blue Yellow Orange Purple} { - set lower [string tolower $color] - radiobutton $w.right.$lower -text $color -variable color \ - -relief flat -value $lower - pack $w.right.$lower -side top -pady 2 -anchor w +foreach c {Red Green Blue Yellow Orange Purple} { + set lower [string tolower $c] + radiobutton $w.mid.$lower -text $c -variable color \ + -relief flat -value $lower -anchor w \ + -command "$w.mid configure -fg \$color" + pack $w.mid.$lower -side top -pady 2 -fill x } + +label $w.right.l -text "Label" -bitmap questhead -compound left +$w.right.l configure -width [winfo reqwidth $w.right.l] -compound top +$w.right.l configure -height [winfo reqheight $w.right.l] +foreach a {Top Left Right Bottom} { + set lower [string tolower $a] + radiobutton $w.right.$lower -text $a -variable align \ + -relief flat -value $lower -indicatoron 0 -width 7 \ + -command "$w.right.l configure -compound \$align" +} +grid x $w.right.top +grid $w.right.left $w.right.l $w.right.right +grid x $w.right.bottom diff --git a/library/demos/rmt b/library/demos/rmt index 1ed865b..71530e7 100644 --- a/library/demos/rmt +++ b/library/demos/rmt @@ -7,7 +7,7 @@ exec wish "$0" "$@" # Tk applications. It allows you to select an application and # then type commands to that application. # -# RCS: @(#) $Id: rmt,v 1.2 1998/09/14 18:23:29 stanton Exp $ +# RCS: @(#) $Id: rmt,v 1.2.24.1 2002/02/05 02:25:16 wolfsuit Exp $ wm title . "Tk Remote Controller" wm iconname . "Tk Remote" @@ -32,22 +32,21 @@ set lastCommand "" # Create menu bar. Arrange to recreate all the information in the # applications sub-menu whenever it is cascaded to. -frame .menu -relief raised -bd 2 -pack .menu -side top -fill x -menubutton .menu.file -text "File" -menu .menu.file.m -underline 0 -menu .menu.file.m -.menu.file.m add cascade -label "Select Application" \ - -menu .menu.file.m.apps -underline 0 -.menu.file.m add command -label "Quit" -command "destroy ." -underline 0 -menu .menu.file.m.apps -postcommand fillAppsMenu -pack .menu.file -side left +. configure -menu [menu .menu] +menu .menu.file +menu .menu.file.apps -postcommand fillAppsMenu +.menu add cascade -label "File" -underline 0 -menu .menu.file +.menu.file add cascade -label "Select Application" -underline 0 \ + -menu .menu.file.apps +.menu.file add command -label "Quit" -command "destroy ." -underline 0 # Create text window and scrollbar. text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true scrollbar .s -command ".t yview" -pack .s -side right -fill both -pack .t -side left +grid .t .s -sticky nsew +grid rowconfigure . 0 -weight 1 +grid columnconfigure . 0 -weight 1 # Create a binding to forward commands to the target application, # plus modify many of the built-in bindings so that only information @@ -123,6 +122,7 @@ proc tkTextInsert {w s} { $w see insert } +.t configure -font {Courier 12} .t tag configure bold -font {Courier 12 bold} # The procedure below is used to print out a prompt at the @@ -193,13 +193,18 @@ proc newApp appName { # of all the applications that currently exist. proc fillAppsMenu {} { - catch {.menu.file.m.apps delete 0 last} + set m .menu.file.apps + catch {$m delete 0 last} foreach i [lsort [winfo interps]] { - .menu.file.m.apps add command -label $i -command [list newApp $i] + $m add command -label $i -command [list newApp $i] } - .menu.file.m.apps add command -label local -command {newApp local} + $m add command -label local -command {newApp local} } set app [winfo name .] prompt focus .t + +# Local Variables: +# mode: tcl +# End: diff --git a/library/demos/rolodex b/library/demos/rolodex index 7b22bad..dd2502b 100644 --- a/library/demos/rolodex +++ b/library/demos/rolodex @@ -1,6 +1,6 @@ #!/bin/sh # the next line restarts using wish \ -exec wish "$0" "$@" +exec wish "$0" ${1+"$@"} # rolodex -- # This script was written as an entry in Tom LaStrange's rolodex @@ -8,12 +8,14 @@ exec wish "$0" "$@" # feel of a rolodex program, although it's lifeless and doesn't # actually do the rolodex application. # -# RCS: @(#) $Id: rolodex,v 1.2 1998/09/14 18:23:29 stanton Exp $ +# RCS: @(#) $Id: rolodex,v 1.2.24.1 2002/02/05 02:25:16 wolfsuit Exp $ foreach i [winfo child .] { catch {destroy $i} } +set version 1.2 + #------------------------------------------ # Phase 0: create the front end. #------------------------------------------ @@ -23,12 +25,9 @@ pack .frame -side top -fill y -anchor center set names {{} Name: Address: {} {} {Home Phone:} {Work Phone:} Fax:} foreach i {1 2 3 4 5 6 7} { - frame .frame.$i - pack .frame.$i -side top -pady 2 -anchor e - - label .frame.$i.label -text [lindex $names $i] -anchor e - entry .frame.$i.entry -width 30 -relief sunken - pack .frame.$i.entry .frame.$i.label -side right + label .frame.label$i -text [lindex $names $i] -anchor e + entry .frame.entry$i -width 35 + grid .frame.label$i .frame.entry$i -sticky ew -pady 2 -padx 1 } frame .buttons @@ -77,7 +76,7 @@ proc fileAction {} { proc addAction {} { global names foreach i {1 2 3 4 5 6 7} { - puts stderr [format "%-12s %s" [lindex $names $i] [.frame.$i.entry get]] + puts stderr [format "%-12s %s" [lindex $names $i] [.frame.entry$i get]] } } .buttons.add config -command addAction @@ -88,20 +87,20 @@ proc addAction {} { proc clearAction {} { foreach i {1 2 3 4 5 6 7} { - .frame.$i.entry delete 0 end + .frame.entry$i delete 0 end } } .buttons.clear config -command clearAction proc fillCard {} { clearAction - .frame.1.entry insert 0 "John Ousterhout" - .frame.2.entry insert 0 "CS Division, Department of EECS" - .frame.3.entry insert 0 "University of California" - .frame.4.entry insert 0 "Berkeley, CA 94720" - .frame.5.entry insert 0 "private" - .frame.6.entry insert 0 "510-642-0865" - .frame.7.entry insert 0 "510-642-5775" + .frame.entry1 insert 0 "John Ousterhout" + .frame.entry2 insert 0 "CS Division, Department of EECS" + .frame.entry3 insert 0 "University of California" + .frame.entry4 insert 0 "Berkeley, CA 94720" + .frame.entry5 insert 0 "private" + .frame.entry6 insert 0 "510-642-0865" + .frame.entry7 insert 0 "510-642-5775" } .buttons.search config -command "addAction; fillCard" @@ -123,7 +122,7 @@ bind . <Control-f> fileAction .menu.file.m entryconfig 2 -accel Ctrl+Q bind . <Control-q> {destroy .} -focus .frame.1.entry +focus .frame.entry1 #---------------------------------------------------- # Phase 6: help @@ -145,42 +144,43 @@ proc Help {topic {x 0} {y 0}} { } proc getMenuTopic {w x y} { - return $w.[$w index @[expr $y-[winfo rooty $w]]] + return $w.[$w index @[expr {$y-[winfo rooty $w]}]] } -bind . <Any-F1> {Help [winfo containing %X %Y] %X %Y} -bind . <Any-Help> {Help [winfo containing %X %Y] %X %Y} +event add <<Help>> <F1> <Help> +bind . <<Help>> {Help [winfo containing %X %Y] %X %Y} +bind Menu <<Help>> {Help [winfo containing %X %Y] %X %Y} # Help text and commands follow: set helpTopics(.menu.file) {This is the "file" menu. It can be used to invoke some overall operations on the rolodex applications, such as loading a file or exiting.} set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y} -set helpTopics(.menu.file.m.0) {The "Load" entry in the "File" menu posts a dialog box that you can use to select a rolodex file} -set helpTopics(.menu.file.m.1) {The "Exit" entry in the "File" menu causes the rolodex application to terminate} +set helpTopics(.menu.file.m.1) {The "Load" entry in the "File" menu posts a dialog box that you can use to select a rolodex file} +set helpTopics(.menu.file.m.2) {The "Exit" entry in the "File" menu causes the rolodex application to terminate} set helpCmds(.menu.file.m.none) {set topic ".menu.file"} -set helpTopics(.frame.1.entry) {In this field of the rolodex entry you should type the person's name} -set helpTopics(.frame.2.entry) {In this field of the rolodex entry you should type the first line of the person's address} -set helpTopics(.frame.3.entry) {In this field of the rolodex entry you should type the second line of the person's address} -set helpTopics(.frame.4.entry) {In this field of the rolodex entry you should type the third line of the person's address} -set helpTopics(.frame.5.entry) {In this field of the rolodex entry you should type the person's home phone number, or "private" if the person doesn't want his or her number publicized} -set helpTopics(.frame.6.entry) {In this field of the rolodex entry you should type the person's work phone number} -set helpTopics(.frame.7.entry) {In this field of the rolodex entry you should type the phone number for the person's FAX machine} - -set helpCmds(.frame.1.label) {set topic .frame.1.entry} -set helpCmds(.frame.2.label) {set topic .frame.2.entry} -set helpCmds(.frame.3.label) {set topic .frame.3.entry} -set helpCmds(.frame.4.label) {set topic .frame.4.entry} -set helpCmds(.frame.5.label) {set topic .frame.5.entry} -set helpCmds(.frame.6.label) {set topic .frame.6.entry} -set helpCmds(.frame.7.label) {set topic .frame.7.entry} +set helpTopics(.frame.entry1) {In this field of the rolodex entry you should type the person's name} +set helpTopics(.frame.entry2) {In this field of the rolodex entry you should type the first line of the person's address} +set helpTopics(.frame.entry3) {In this field of the rolodex entry you should type the second line of the person's address} +set helpTopics(.frame.entry4) {In this field of the rolodex entry you should type the third line of the person's address} +set helpTopics(.frame.entry5) {In this field of the rolodex entry you should type the person's home phone number, or "private" if the person doesn't want his or her number publicized} +set helpTopics(.frame.entry6) {In this field of the rolodex entry you should type the person's work phone number} +set helpTopics(.frame.entry7) {In this field of the rolodex entry you should type the phone number for the person's FAX machine} + +set helpCmds(.frame.label1) {set topic .frame.entry1} +set helpCmds(.frame.label2) {set topic .frame.entry2} +set helpCmds(.frame.label3) {set topic .frame.entry3} +set helpCmds(.frame.label4) {set topic .frame.entry4} +set helpCmds(.frame.label5) {set topic .frame.entry5} +set helpCmds(.frame.label6) {set topic .frame.entry6} +set helpCmds(.frame.label7) {set topic .frame.entry7} set helpTopics(context) {Unfortunately, this application doesn't support context-sensitive help in the usual way, because when this demo was written Tk didn't have a grab mechanism and this is needed for context-sensitive help. Instead, you can achieve much the same effect by simply moving the mouse over the window you're curious about and pressing the Help or F1 keys. You can do this anytime.} set helpTopics(help) {This application provides only very crude help. Besides the entries in this menu, you can get help on individual windows by moving the mouse cursor over the window and pressing the Help or F1 keys.} set helpTopics(window) {This window is a dummy rolodex application created as part of Tom LaStrange's toolkit benchmark. It doesn't really do anything useful except to demonstrate a few features of the Tk toolkit.} set helpTopics(keys) "The following accelerator keys are defined for this application (in addition to those already available for the entry windows):\n\nCtrl+A:\t\tAdd\nCtrl+C:\t\tClear\nCtrl+D:\t\tDelete\nCtrl+F:\t\tEnter file name\nCtrl+Q:\t\tExit application (quit)\nCtrl+S:\t\tSearch (dummy operation)" -set helpTopics(version) {This is version 1.0.} +set helpTopics(version) "This is version $version." # Entries in "Help" menu diff --git a/library/demos/spin.tcl b/library/demos/spin.tcl new file mode 100644 index 0000000..9446e6c --- /dev/null +++ b/library/demos/spin.tcl @@ -0,0 +1,55 @@ +# spin.tcl -- +# +# This demonstration script creates several spinbox widgets. +# +# RCS: @(#) $Id: spin.tcl,v 1.1.2.1 2002/02/05 02:25:16 wolfsuit Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .spin +catch {destroy $w} +toplevel $w +wm title $w "Spinbox Demonstration" +wm iconname $w "spin" +positionWindow $w + +label $w.msg -font $font -wraplength 5i -justify left -text "Three different\ + spin-boxes 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 values that are too large to fit in the\ + window all at once, you can scan through the value by dragging with\ + mouse button2 pressed. Note that the first spin-box will only permit\ + you to type in integers, and the third selects from a list of\ + 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 + +set australianCities { + Canberra Sydney Melbourne Perth Adelaide Brisbane + Hobart Darwin "Alice Springs" +} + +spinbox $w.s1 -from 1 -to 10 -width 10 -validate key \ + -vcmd {string is integer %P} +spinbox $w.s2 -from 0 -to 3 -increment .5 -format %05.2f -width 10 +spinbox $w.s3 -values $australianCities -width 10 + +#entry $w.e1 +#entry $w.e2 +#entry $w.e3 +pack $w.s1 $w.s2 $w.s3 -side top -pady 5 -padx 10 ;#-fill x + +#$w.e1 insert 0 "Initial value" +#$w.e2 insert end "This entry contains a long value, much too long " +#$w.e2 insert end "to fit in the window at one time, so long in fact " +#$w.e2 insert end "that you'll have to scan or scroll to see the end." diff --git a/library/demos/tcolor b/library/demos/tcolor index 4eeb893..a5cbee4 100644 --- a/library/demos/tcolor +++ b/library/demos/tcolor @@ -7,7 +7,7 @@ exec wish "$0" "$@" # create colors using either the RGB, HSB, or CYM color spaces # and apply the color to existing applications. # -# RCS: @(#) $Id: tcolor,v 1.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: tcolor,v 1.2.24.1 2002/02/05 02:25:16 wolfsuit Exp $ wm title . "Color Editor" @@ -41,67 +41,70 @@ set updating 0 set autoUpdate 1 set name "" +if {$tcl_platform(platform) eq "unix"} { + option add *Entry.background white +} + # Create the menu bar at the top of the window. -frame .menu -relief raised -borderwidth 2 -pack .menu -side top -fill x -menubutton .menu.file -text File -menu .menu.file.m -underline 0 -menu .menu.file.m -.menu.file.m add radio -label "RGB color space" -variable colorSpace \ +. configure -menu [menu .menu] +menu .menu.file +.menu add cascade -menu .menu.file -label File -underline 0 +.menu.file add radio -label "RGB color space" -variable colorSpace \ -value rgb -underline 0 -command {changeColorSpace rgb} -.menu.file.m add radio -label "CMY color space" -variable colorSpace \ +.menu.file add radio -label "CMY color space" -variable colorSpace \ -value cmy -underline 0 -command {changeColorSpace cmy} -.menu.file.m add radio -label "HSB color space" -variable colorSpace \ +.menu.file add radio -label "HSB color space" -variable colorSpace \ -value hsb -underline 0 -command {changeColorSpace hsb} -.menu.file.m add separator -.menu.file.m add radio -label "Automatic updates" -variable autoUpdate \ +.menu.file add separator +.menu.file add radio -label "Automatic updates" -variable autoUpdate \ -value 1 -underline 0 -.menu.file.m add radio -label "Manual updates" -variable autoUpdate \ +.menu.file add radio -label "Manual updates" -variable autoUpdate \ -value 0 -underline 0 -.menu.file.m add separator -.menu.file.m add command -label "Exit program" -underline 0 \ - -command "destroy ." -pack .menu.file -side left +.menu.file add separator +.menu.file add command -label "Exit program" -underline 0 -command {exit} # Create the command entry window at the bottom of the window, along # with the update button. -frame .bot -relief raised -borderwidth 2 -pack .bot -side bottom -fill x -label .commandLabel -text "Command:" -entry .command -relief sunken -borderwidth 2 -textvariable command \ +labelframe .command -text "Command:" -padx {1m 0} +entry .command.e -relief sunken -borderwidth 2 -textvariable command \ -font {Courier 12} -button .update -text Update -command doUpdate -pack .commandLabel -in .bot -side left -pack .update -in .bot -side right -pady .1c -padx .25c -pack .command -in .bot -expand yes -fill x -ipadx 0.25c +button .command.update -text Update -command doUpdate +pack .command.update -side right -pady .1c -padx {.25c 0} +pack .command.e -expand yes -fill x -ipadx 0.25c + # Create the listbox that holds all of the color names in rgb.txt, # if an rgb.txt file can be found. -frame .middle -relief raised -borderwidth 2 -pack .middle -side top -fill both -foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt - /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt - /usr/openwin/lib/X11/rgb.txt} { - if ![file readable $i] { +grid .command -sticky nsew -row 2 -columnspan 3 -padx 1m -pady {0 1m} + +grid columnconfigure . {1 2} -weight 1 +grid rowconfigure . 0 -weight 1 +foreach i { + /usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt + /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt + /usr/openwin/lib/X11/rgb.txt +} { + if {![file readable $i]} { continue; } set f [open $i] - frame .middle.left - pack .middle.left -side left -padx .25c -pady .25c - listbox .names -width 20 -height 12 -yscrollcommand ".scroll set" \ + labelframe .names -text "Select:" -padx .1c -pady .1c + grid .names -row 0 -column 0 -sticky nsew -padx .15c -pady .15c -rowspan 2 + grid columnconfigure . 0 -weight 1 + listbox .names.lb -width 20 -height 12 -yscrollcommand ".names.s set" \ -relief sunken -borderwidth 2 -exportselection false - bind .names <Double-1> { - tc_loadNamedColor [.names get [.names curselection]] + bind .names.lb <Double-1> { + tc_loadNamedColor [.names.lb get [.names.lb curselection]] } - scrollbar .scroll -orient vertical -command ".names yview" \ + scrollbar .names.s -orient vertical -command ".names.lb yview" \ -relief sunken -borderwidth 2 - pack .names -in .middle.left -side left - pack .scroll -in .middle.left -side right -fill y + pack .names.lb .names.s -side left -fill y -expand 1 while {[gets $f line] >= 0} { - if {[llength $line] == 4} { - .names insert end [lindex $line 3] + if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} { + .names.lb insert end $col } } close $f @@ -111,35 +114,33 @@ foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt # Create the three scales for editing the color, and the entry for # typing in a color value. -frame .middle.middle -pack .middle.middle -side left -expand yes -fill y -frame .middle.middle.1 -frame .middle.middle.2 -frame .middle.middle.3 -frame .middle.middle.4 -pack .middle.middle.1 .middle.middle.2 .middle.middle.3 -side top -expand yes -pack .middle.middle.4 -side top -expand yes -fill x +frame .adjust foreach i {1 2 3} { - label .label$i -textvariable label$i + label .adjust.l$i -textvariable label$i -pady 0 + labelframe .adjust.$i -labelwidget .adjust.l$i -padx 1m -pady 1m scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \ -command tc_scaleChanged - pack .scale$i .label$i -in .middle.middle.$i -side top -anchor w + pack .scale$i -in .adjust.$i + pack .adjust.$i } -label .nameLabel -text "Name:" -entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \ +grid .adjust -row 0 -column 1 -sticky nsew -padx .15c -pady .15c + +labelframe .name -text "Name:" -padx 1m -pady 1m +entry .name.e -relief sunken -borderwidth 2 -textvariable name -width 10 \ -font {Courier 12} -pack .nameLabel -in .middle.middle.4 -side left -pack .name -in .middle.middle.4 -side right -expand 1 -fill x -bind .name <Return> {tc_loadNamedColor $name} +pack .name.e -side right -expand 1 -fill x +bind .name.e <Return> {tc_loadNamedColor $name} +grid .name -column 1 -row 1 -sticky nsew -padx .15c -pady .15c # Create the color display swatch on the right side of the window. -frame .middle.right -pack .middle.right -side left -pady .25c -padx .25c -anchor s -frame .swatch -width 2c -height 5c -background $color -label .value -textvariable color -width 13 -font {Courier 12} -pack .swatch -in .middle.right -side top -expand yes -fill both -pack .value -in .middle.right -side bottom -pady .25c +labelframe .sample -text "Color:" -padx 1m -pady 1m +frame .sample.swatch -width 2c -height 5c -background $color +label .sample.value -textvariable color -width 13 -font {Courier 12} +pack .sample.swatch -side top -expand yes -fill both +pack .sample.value -side bottom -pady .25c +grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2 + # The procedure below is invoked when one of the scales is adjusted. # It propagates color information from the current scale readings @@ -147,19 +148,21 @@ pack .value -in .middle.right -side bottom -pady .25c proc tc_scaleChanged args { global red green blue colorSpace color updating autoUpdate - if $updating { + if {$updating} { return } - if {$colorSpace == "rgb"} { - set red [format %.0f [expr [.scale1 get]*65.535]] - set green [format %.0f [expr [.scale2 get]*65.535]] - set blue [format %.0f [expr [.scale3 get]*65.535]] - } else { - if {$colorSpace == "cmy"} { + switch $colorSpace { + rgb { + set red [format %.0f [expr {[.scale1 get]*65.535}]] + set green [format %.0f [expr {[.scale2 get]*65.535}]] + set blue [format %.0f [expr {[.scale3 get]*65.535}]] + } + cmy { set red [format %.0f [expr {65535 - [.scale1 get]*65.535}]] set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]] set blue [format %.0f [expr {65535 - [.scale3 get]*65.535}]] - } else { + } + hsb { set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \ [expr {[.scale2 get]/1000.0}] \ [expr {[.scale3 get]/1000.0}]] @@ -169,8 +172,8 @@ proc tc_scaleChanged args { } } set color [format "#%04x%04x%04x" $red $green $blue] - .swatch config -bg $color - if $autoUpdate doUpdate + .sample.swatch config -bg $color + if {$autoUpdate} doUpdate update idletasks } @@ -182,16 +185,18 @@ proc tc_scaleChanged args { proc tc_setScales {} { global red green blue colorSpace updating set updating 1 - if {$colorSpace == "rgb"} { - .scale1 set [format %.0f [expr $red/65.535]] - .scale2 set [format %.0f [expr $green/65.535]] - .scale3 set [format %.0f [expr $blue/65.535]] - } else { - if {$colorSpace == "cmy"} { - .scale1 set [format %.0f [expr (65535-$red)/65.535]] - .scale2 set [format %.0f [expr (65535-$green)/65.535]] - .scale3 set [format %.0f [expr (65535-$blue)/65.535]] - } else { + switch $colorSpace { + rgb { + .scale1 set [format %.0f [expr {$red/65.535}]] + .scale2 set [format %.0f [expr {$green/65.535}]] + .scale3 set [format %.0f [expr {$blue/65.535}]] + } + cmy { + .scale1 set [format %.0f [expr {(65535-$red)/65.535}]] + .scale2 set [format %.0f [expr {(65535-$green)/65.535}]] + .scale3 set [format %.0f [expr {(65535-$blue)/65.535}]] + } + hsb { set list [rgbToHsv $red $green $blue] .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]] .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]] @@ -209,14 +214,14 @@ proc tc_loadNamedColor name { global red green blue color autoUpdate if {[string index $name 0] != "#"} { - set list [winfo rgb .swatch $name] + set list [winfo rgb .sample.swatch $name] set red [lindex $list 0] set green [lindex $list 1] set blue [lindex $list 2] } else { - case [string length $name] { - 4 {set format "#%1x%1x%1x"; set shift 12} - 7 {set format "#%2x%2x%2x"; set shift 8} + switch [string length $name] { + 4 {set format "#%1x%1x%1x"; set shift 12} + 7 {set format "#%2x%2x%2x"; set shift 8} 10 {set format "#%3x%3x%3x"; set shift 4} 13 {set format "#%4x%4x%4x"; set shift 0} default {error "syntax error in color name \"$name\""} @@ -224,14 +229,14 @@ proc tc_loadNamedColor name { if {[scan $name $format red green blue] != 3} { error "syntax error in color name \"$name\"" } - set red [expr $red<<$shift] - set green [expr $green<<$shift] - set blue [expr $blue<<$shift] + set red [expr {$red<<$shift}] + set green [expr {$green<<$shift}] + set blue [expr {$blue<<$shift}] } tc_setScales set color [format "#%04x%04x%04x" $red $green $blue] - .swatch config -bg $color - if $autoUpdate doUpdate + .sample.swatch config -bg $color + if {$autoUpdate} doUpdate } # The procedure below is invoked when a new color space is selected. @@ -240,26 +245,28 @@ proc tc_loadNamedColor name { proc changeColorSpace space { global label1 label2 label3 - if {$space == "rgb"} { - set label1 Red - set label2 Green - set label3 Blue - tc_setScales - return - } - if {$space == "cmy"} { - set label1 Cyan - set label2 Magenta - set label3 Yellow - tc_setScales - return - } - if {$space == "hsb"} { - set label1 Hue - set label2 Saturation - set label3 Brightness - tc_setScales - return + switch $space { + rgb { + set label1 "Adjust Red:" + set label2 "Adjust Green:" + set label3 "Adjust Blue:" + tc_setScales + return + } + cmy { + set label1 "Adjust Cyan:" + set label2 "Adjust Magenta:" + set label3 "Adjust Yellow:" + tc_setScales + return + } + hsb { + set label1 "Adjust Hue:" + set label2 "Adjust Saturation:" + set label3 "Adjust Brightness:" + tc_setScales + return + } } } @@ -271,20 +278,18 @@ proc changeColorSpace space { proc rgbToHsv {red green blue} { if {$red > $green} { - set max $red.0 - set min $green.0 + set max [expr {double($red)}] + set min [expr {double($green)}] } else { - set max $green.0 - set min $red.0 + set max [expr {double($green)}] + set min [expr {double($red)}] } if {$blue > $max} { - set max $blue.0 - } else { - if {$blue < $min} { - set min $blue.0 - } + set max [expr {double($blue)}] + } elseif {$blue < $min} { + set min [expr {double($blue)}] } - set range [expr $max-$min] + set range [expr {$max-$min}] if {$max == 0} { set sat 0 } else { @@ -297,16 +302,14 @@ proc rgbToHsv {red green blue} { set gc [expr {($max - $green)/$range}] set bc [expr {($max - $blue)/$range}] if {$red == $max} { - set hue [expr {.166667*($bc - $gc)}] + set hue [expr {($bc - $gc)/6.0}] + } elseif {$green == $max} { + set hue [expr {(2 + $rc - $bc)/6.0}] } else { - if {$green == $max} { - set hue [expr {.166667*(2 + $rc - $bc)}] - } else { - set hue [expr {.166667*(4 + $gc - $rc)}] - } + set hue [expr {(4 + $gc - $rc)/6.0}] } if {$hue < 0.0} { - set hue [expr $hue + 1.0] + set hue [expr {$hue + 1.0}] } } return [list $hue $sat [expr {$max/65535}]] @@ -319,27 +322,28 @@ proc rgbToHsv {red green blue} { # Computer Graphics" by Foley and Van Dam. proc hsbToRgb {hue sat value} { - set v [format %.0f [expr 65535.0*$value]] + set v [format %.0f [expr {65535.0*$value}]] if {$sat == 0} { return "$v $v $v" } else { - set hue [expr $hue*6.0] + set hue [expr {$hue*6.0}] if {$hue >= 6.0} { set hue 0.0 } scan $hue. %d i - set f [expr $hue-$i] + set f [expr {$hue-$i}] set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]] set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]] set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]] - case $i \ - 0 {return "$v $t $p"} \ - 1 {return "$q $v $p"} \ - 2 {return "$p $v $t"} \ - 3 {return "$p $q $v"} \ - 4 {return "$t $p $v"} \ + switch $i { + 0 {return "$v $t $p"} + 1 {return "$q $v $p"} + 2 {return "$p $v $t"} + 3 {return "$p $q $v"} + 4 {return "$t $p $v"} 5 {return "$v $p $q"} - error "i value $i is out of range" + default {error "i value $i is out of range"} + } } } @@ -356,3 +360,7 @@ proc doUpdate {} { } changeColorSpace hsb + +# Local Variables: +# mode: tcl +# End: diff --git a/library/demos/text.tcl b/library/demos/text.tcl index 78a4d56..2237acd 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.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: text.tcl,v 1.2.24.1 2002/02/05 02:25:16 wolfsuit Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -23,7 +23,7 @@ button $w.buttons.code -text "See Code" -command "showCode $w" pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 \ - -height 30 + -height 30 -undo 1 -autosep 1 scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both @@ -66,7 +66,19 @@ the insertion cursor to the end of the line, or it deletes the newline character if that is the only thing left on the line. Control-o opens a new line by inserting a newline character to the right of the insertion cursor. Control-t transposes the two characters on either side of the -insertion cursor. +insertion cursor. Control-z undoes the last editing action performed, +and } + +switch $tcl_platform(platform) { + "unix" - "macintosh" { + $w.text insert end "Control-Shift-z" + } + "windows" { + $w.text insert end "Control-y" + } +} + +$w.text insert end { redoes undone edits. 7. Resize the window. This widget has been configured with the "setGrid" option on, so that if you resize the window it will always resize to an diff --git a/library/demos/timer b/library/demos/timer index 5ac504c..44f1d26 100644 --- a/library/demos/timer +++ b/library/demos/timer @@ -5,36 +5,43 @@ exec wish "$0" "$@" # timer -- # This script generates a counter with start and stop buttons. # -# RCS: @(#) $Id: timer,v 1.2 1998/09/14 18:23:30 stanton Exp $ +# RCS: @(#) $Id: timer,v 1.2.24.1 2002/02/05 02:25:16 wolfsuit Exp $ -label .counter -text 0.00 -relief raised -width 10 +label .counter -text 0.00 -relief raised -width 10 -padx 2m -pady 1m button .start -text Start -command { - if $stopped { + if {$stopped} { set stopped 0 + set startMoment [clock clicks -milliseconds] tick + .stop configure -state normal + .start configure -state disabled } } -button .stop -text Stop -command {set stopped 1} +button .stop -text Stop -state disabled -command { + set stopped 1 + .stop configure -state disabled + .start configure -state normal +} pack .counter -side bottom -fill both pack .start -side left -fill both -expand yes pack .stop -side right -fill both -expand yes -set seconds 0 -set hundredths 0 +set startMoment {} + set stopped 1 proc tick {} { - global seconds hundredths stopped - if $stopped return + global startMoment stopped + if {$stopped} {return} after 50 tick - set hundredths [expr $hundredths+5] - if {$hundredths >= 100} { - set hundredths 0 - set seconds [expr $seconds+1] - } - .counter config -text [format "%d.%02d" $seconds $hundredths] + set elapsedMS [expr {[clock clicks -milliseconds] - $startMoment}] + .counter config -text [format "%.2f" [expr {double($elapsedMS)/1000}]] } bind . <Control-c> {destroy .} bind . <Control-q> {destroy .} focus . + +# Local Variables: +# mode: tcl +# End: diff --git a/library/demos/widget b/library/demos/widget index d98c7e8..2787244 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -11,11 +11,30 @@ exec wish "$0" "$@" # ".tcl" files is this directory, which are sourced by this script # as needed. # -# RCS: @(#) $Id: widget,v 1.3.2.1 2001/10/15 09:22:00 wolfsuit Exp $ +# RCS: @(#) $Id: widget,v 1.3.2.2 2002/02/05 02:25:16 wolfsuit Exp $ eval destroy [winfo child .] wm title . "Widget Demonstration" +if {$tcl_platform(platform) eq "unix"} { + # This won't work everywhere, but there's no other way in core Tk + # at the moment to display a coloured icon. + image create photo TclPowered \ + -file [file join $tk_library images logo64.gif] + wm iconwindow . [toplevel ._iconWindow] + pack [label ._iconWindow.i -image TclPowered] + wm iconname . "tkWidgetDemo" +} + +array set widgetFont { + main {Helvetica 12} + bold {Helvetica 12 bold} + title {Helvetica 18 bold} + status {Helvetica 10} + vars {Helvetica 14} +} + set widgetDemo 1 +set font $widgetFont(main) #---------------------------------------------------------------- # The code below create the main window, consisting of a menu bar @@ -23,7 +42,6 @@ set widgetDemo 1 # all of the demos as hypertext items. #---------------------------------------------------------------- -set font {Helvetica 14} menu .menuBar -tearoff 0 .menuBar add cascade -menu .menuBar.file -label "File" -underline 0 menu .menuBar.file -tearoff 0 @@ -46,9 +64,9 @@ bind . <F1> aboutBox frame .statusBar label .statusBar.lab -text " " -relief sunken -bd 1 \ - -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w + -font $widgetFont(status) -anchor w label .statusBar.foo -width 8 -relief sunken -bd 1 \ - -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w + -font $widgetFont(status) -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 @@ -57,8 +75,9 @@ frame .textFrame scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \ -takefocus 1 pack .s -in .textFrame -side right -fill y -text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \ - -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0 +text .t -yscrollcommand {.s set} -wrap word -width 70 -height 30 \ + -font $widgetFont(main) -setgrid 1 -highlightthickness 0 \ + -padx 4 -pady 2 -takefocus 0 pack .t -in .textFrame -expand y -fill both -padx 1 pack .textFrame -expand yes -fill both @@ -66,7 +85,8 @@ pack .textFrame -expand yes -fill both # section titles and demo descriptions. Also define the bindings for # tags. -.t tag configure title -font {Helvetica 18 bold} +.t tag configure title -font $widgetFont(title) +.t tag configure bold -font $widgetFont(bold) # 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 @@ -120,119 +140,82 @@ set lastLine "" # Create the text for the text widget. -.t insert end "Tk Widget Demonstrations\n" title -.t insert end { -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 "See Code" button to see the Tcl/Tk code that created the demonstration. If you wish, you can edit the code and click the "Rerun Demo" button in the code window to reinvoke the demonstration with the modified code. +proc addDemoSection {title demos} { + .t insert end "\n" {} $title title " \n " demospace + set num 0 + foreach {name description} $demos { + .t insert end "[incr num]. $description." [list demo demo-$name] + .t insert end " \n " demospace + } +} +.t insert end "Tk Widget Demonstrations\n" title +.t insert end "\nThis 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 " {} "See Code" bold " button to see the\ + Tcl/Tk code that created the demonstration. If you wish, you can\ + edit the code and click the " {} "Rerun Demo" bold " button in the\ + code window to reinvoke the demonstration with the modified code.\n" + +addDemoSection "Labels, buttons, checkbuttons, and radiobuttons" { + label "Labels (text and bitmaps)" + button "Buttons" + check "Check-buttons (select any of a group)" + radio "Radio-buttons (select one of a group)" + puzzle "A 15-puzzle game made out of buttons" + icon "Iconic buttons that use bitmaps" + image1 "Two labels displaying images" + image2 "A simple user interface for viewing images" + labelframe "Labelled frames" +} +addDemoSection "Listboxes" { + states "The 50 states" + colors "Colors: change the color scheme for the application" + sayings "A collection of famous and infamous sayings" +} +addDemoSection "Entries and Spin-boxes" { + entry1 "Entries without scrollbars" + entry2 "Entries with scrollbars" + entry3 "Validated entries and password fields" + spin "Spin-boxes" + form "Simple Rolodex-like form" +} +addDemoSection "Text" { + text "Basic editable text" + style "Text display styles" + bind "Hypertext (tag bindings)" + twind "A text widget with embedded windows" + search "A search tool built with a text widget" +} +addDemoSection "Canvases" { + items "The canvas item types" + plot "A simple 2-D plot" + ctext "Text items in canvases" + arrow "An editor for arrowheads on canvas lines" + ruler "A ruler with adjustable tab stops" + floor "A building floor plan" + cscroll "A simple scrollable canvas" +} +addDemoSection "Scales" { + vscale "Vertical scale" + hscale "Horizontal scale" +} +addDemoSection "Menus" { + menu "Menus and cascades (sub-menus)" + menubu "Menu-buttons" +} +addDemoSection "Common Dialogs" { + msgbox "Message boxes" + filebox "File selection dialog" + clrpick "Color picker" +} +addDemoSection "Miscellaneous" { + bitmap "The built-in bitmaps" + dialog1 "A dialog box with a local grab" + dialog2 "A dialog box with a global grab" } -.t insert end "Labels, buttons, checkbuttons, and radiobuttons" title -.t insert end " \n " {demospace} -.t insert end "1. Labels (text and bitmaps)." {demo demo-label} -.t insert end " \n " {demospace} -.t insert end "2. Buttons." {demo demo-button} -.t insert end " \n " {demospace} -.t insert end "3. Checkbuttons (select any of a group)." {demo demo-check} -.t insert end " \n " {demospace} -.t insert end "4. Radiobuttons (select one of a group)." {demo demo-radio} -.t insert end " \n " {demospace} -.t insert end "5. A 15-puzzle game made out of buttons." {demo demo-puzzle} -.t insert end " \n " {demospace} -.t insert end "6. Iconic buttons that use bitmaps." {demo demo-icon} -.t insert end " \n " {demospace} -.t insert end "7. Two labels displaying images." {demo demo-image1} -.t insert end " \n " {demospace} -.t insert end "8. A simple user interface for viewing images." \ - {demo demo-image2} -.t insert end " \n " {demospace} - -.t insert end \n {} "Listboxes" title -.t insert end " \n " {demospace} -.t insert end "1. 50 states." {demo demo-states} -.t insert end " \n " {demospace} -.t insert end "2. Colors: change the color scheme for the application." \ - {demo demo-colors} -.t insert end " \n " {demospace} -.t insert end "3. A collection of famous sayings." {demo demo-sayings} -.t insert end " \n " {demospace} - -.t insert end \n {} "Entries" title -.t insert end " \n " {demospace} -.t insert end "1. Without scrollbars." {demo demo-entry1} -.t insert end " \n " {demospace} -.t insert end "2. With scrollbars." {demo demo-entry2} -.t insert end " \n " {demospace} -.t insert end "3. Simple Rolodex-like form." {demo demo-form} -.t insert end " \n " {demospace} - -.t insert end \n {} "Text" title -.t insert end " \n " {demospace} -.t insert end "1. Basic editable text." {demo demo-text} -.t insert end " \n " {demospace} -.t insert end "2. Text display styles." {demo demo-style} -.t insert end " \n " {demospace} -.t insert end "3. Hypertext (tag bindings)." {demo demo-bind} -.t insert end " \n " {demospace} -.t insert end "4. A text widget with embedded windows." {demo demo-twind} -.t insert end " \n " {demospace} -.t insert end "5. A search tool built with a text widget." {demo demo-search} -.t insert end " \n " {demospace} - -.t insert end \n {} "Canvases" title -.t insert end " \n " {demospace} -.t insert end "1. The canvas item types." {demo demo-items} -.t insert end " \n " {demospace} -.t insert end "2. A simple 2-D plot." {demo demo-plot} -.t insert end " \n " {demospace} -.t insert end "3. Text items in canvases." {demo demo-ctext} -.t insert end " \n " {demospace} -.t insert end "4. An editor for arrowheads on canvas lines." {demo demo-arrow} -.t insert end " \n " {demospace} -.t insert end "5. A ruler with adjustable tab stops." {demo demo-ruler} -.t insert end " \n " {demospace} -.t insert end "6. A building floor plan." {demo demo-floor} -.t insert end " \n " {demospace} -.t insert end "7. A simple scrollable canvas." {demo demo-cscroll} -.t insert end " \n " {demospace} - -.t insert end \n {} "Scales" title -.t insert end " \n " {demospace} -.t insert end "1. Vertical scale." {demo demo-vscale} -.t insert end " \n " {demospace} -.t insert end "2. Horizontal scale." {demo demo-hscale} -.t insert end " \n " {demospace} - -.t insert end \n {} "Menus" title -.t insert end " \n " {demospace} -.t insert end "1. Menus and cascades." \ - {demo demo-menu} -.t insert end " \n " {demospace} -.t insert end "2. Menubuttons"\ - {demo demo-menubu} -.t insert end " \n " {demospace} - -.t insert end \n {} "Labelframes" title -.t insert end " \n " {demospace} -.t insert end "1. Labelframe." \ - {demo demo-labelframe} -.t insert end " \n " {demospace} - -.t insert end \n {} "Common Dialogs" title -.t insert end " \n " {demospace} -.t insert end "1. Message boxes." {demo demo-msgbox} -.t insert end " \n " {demospace} -.t insert end "2. File selection dialog." {demo demo-filebox} -.t insert end " \n " {demospace} -.t insert end "3. Color picker." {demo demo-clrpick} -.t insert end " \n " {demospace} - -.t insert end \n {} "Miscellaneous" title -.t insert end " \n " {demospace} -.t insert end "1. The built-in bitmaps." {demo demo-bitmap} -.t insert end " \n " {demospace} -.t insert end "2. A dialog box with a local grab." {demo demo-dialog1} -.t insert end " \n " {demospace} -.t insert end "3. A dialog box with a global grab." {demo demo-dialog2} -.t insert end " \n " {demospace} .t configure -state disabled focus .s @@ -257,11 +240,12 @@ proc positionWindow w { # args - Any number of names of variables. proc showVars {w args} { + global widgetFont catch {destroy $w} toplevel $w wm title $w "Variable values" label $w.title -text "Variable values:" -width 20 -anchor center \ - -font {Helvetica 18} + -font $widgetFont(vars) pack $w.title -side top -fill x set len 1 foreach i $args { @@ -391,7 +375,15 @@ proc showCode w { # proc aboutBox {} { tk_messageBox -icon info -type ok -title "About Widget Demo" -message \ -"Tk widget demonstration\n\n\ -Copyright (c) 1996-1997 Sun Microsystems, Inc." +"Tk widget demonstration + +Copyright (c) 1996-1997 Sun Microsystems, Inc. + +Copyright (c) 1997-2000 Ajuba Solutions, Inc. + +Copyright (c) 2001 Donal K. Fellows" } +# Local Variables: +# mode: tcl +# End: |