Updates to demos

8 files changed, 176 insertions, 128 deletions

diff --git a/library/demos/browse b/library/demos/browse
index d3f55e3..63883f7 100644
--- a/library/demos/browse
+++ b/library/demos/browse
@@ -7,7 +7,7 @@ exec wish "$0" "$@"
 # 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.18.1 2001/10/12 10:56:13 dkf Exp $
 
 # Create a scrollbar on the right side of the main window and a listbox
 # on the left side.
@@ -24,11 +24,12 @@ 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 &
+	exec [info nameofexecutable] $browseScript $file &
     } else {
 	if [file isfile $file] {
 	    if [info exists env(EDITOR)] {
@@ -42,11 +43,16 @@ proc browse {dir 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] {
+foreach i [lsort [glob * .* *.*]] {
+    switch [file type $i] {
+	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/hello b/library/demos/hello
index c6bd8c8..6db1c81 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.18.1 2001/10/12 10:56:13 dkf 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/ixset b/library/demos/ixset
index c5bcfd3..9c9991e 100644
--- a/library/demos/ixset
+++ b/library/demos/ixset
@@ -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.18.1 2001/10/12 10:56:13 dkf Exp $
 
 #
 # Button actions
@@ -310,3 +310,7 @@ dispsettings
 #
 # Now, wait for user actions...
 #
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/library/demos/rmt b/library/demos/rmt
index 1ed865b..c1812b8 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.18.1 2001/10/12 10:56:13 dkf 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..84b817d 100644
--- a/library/demos/rolodex
+++ b/library/demos/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.18.1 2001/10/12 10:56:13 dkf Exp $
 
 foreach i [winfo child .] {
     catch {destroy $i}
 }
 
+set version 1.1
+
 #------------------------------------------
 # Phase 0: create the front end.
 #------------------------------------------
@@ -145,19 +147,20 @@ 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}
@@ -180,7 +183,7 @@ set helpTopics(context) {Unfortunately, this application doesn't support context
 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
 
@@ -194,3 +197,7 @@ set helpTopics(version) {This is version 1.0.}
 	-underline 3
 .menu.help.m add command -label "On Version..." -command {Help version}  \
 	-underline 3
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/library/demos/square b/library/demos/square
index b02e187..45d946e 100644
--- a/library/demos/square
+++ b/library/demos/square
@@ -11,7 +11,7 @@ exec wish "$0" "$@"
 # Button-1 press/drag:		moves square to mouse
 # "a":				toggle size animation on/off
 #
-# RCS: @(#) $Id: square,v 1.2 1998/09/14 18:23:30 stanton Exp $
+# RCS: @(#) $Id: square,v 1.2.18.1 2001/10/12 10:56:13 dkf Exp $
 
 square .s
 pack .s -expand yes -fill both
@@ -26,7 +26,7 @@ focus .s
 
 proc center {x y} {
     set a [.s size]
-    .s position [expr $x-($a/2)] [expr $y-($a/2)]
+    .s position [expr {$x-($a/2)}] [expr {$y-($a/2)}]
 }
 
 # The procedures below provide a simple form of animation where
@@ -48,8 +48,11 @@ proc timer {} {
     global inc
     set s [.s size]
     if {$inc == 0} return
-    if {$s >= 40} {set inc -3}
-    if {$s <= 10} {set inc 3}
+    if {$s >= 40} {set inc -3} elseif {$s <= 10} {set inc 3}
     .s size [expr {$s+$inc}]
     after 30 timer
 }
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/library/demos/tcolor b/library/demos/tcolor
index 4eeb893..e5f6770 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.18.1 2001/10/12 10:56:13 dkf Exp $
 
 wm title . "Color Editor"
 
@@ -81,10 +81,12 @@ pack .command -in .bot -expand yes -fill x -ipadx 0.25c
 
 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] {
+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]
@@ -100,8 +102,8 @@ foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
     pack .names -in .middle.left -side left
     pack .scroll -in .middle.left -side right -fill y
     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 insert end [lrange $line 3 end]
 	}
     }
     close $f
@@ -147,19 +149,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}]]
@@ -170,7 +174,7 @@ proc tc_scaleChanged args {
     }
     set color [format "#%04x%04x%04x" $red $green $blue]
     .swatch config -bg $color
-    if $autoUpdate doUpdate
+    if {$autoUpdate} doUpdate
     update idletasks
 }
 
@@ -182,16 +186,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}]]
@@ -214,9 +220,9 @@ proc tc_loadNamedColor name {
 	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 +230,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
+    if {$autoUpdate} doUpdate
 }
 
 # The procedure below is invoked when a new color space is selected.
@@ -240,26 +246,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 Red
+	    set label2 Green
+	    set label3 Blue
+	    tc_setScales
+	    return
+	}
+	cmy {
+	    set label1 Cyan
+	    set label2 Magenta
+	    set label3 Yellow
+	    tc_setScales
+	    return
+	}
+	hsb {
+	    set label1 Hue
+	    set label2 Saturation
+	    set label3 Brightness
+	    tc_setScales
+	    return
+	}
     }
 }
 
@@ -271,20 +279,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 +303,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 +323,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 +361,7 @@ proc doUpdate {} {
 }
 
 changeColorSpace hsb
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/library/demos/timer b/library/demos/timer
index 5ac504c..a044090 100644
--- a/library/demos/timer
+++ b/library/demos/timer
@@ -5,36 +5,42 @@ 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.18.1 2001/10/12 10:56:13 dkf 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: