From 89cb52358e92bd6496cf8068147b904a689dd870 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 30 Sep 2003 14:54:29 +0000 Subject: Added [package require] to demos. [FRQ 815118] --- ChangeLog | 12 +++++++++ library/demos/browse | 4 ++- library/demos/hello | 6 +++-- library/demos/ixset | 68 ++++++++++++++++++++++++--------------------------- library/demos/rmt | 53 ++++++++++++++++++++------------------- library/demos/rolodex | 12 ++++++++- library/demos/square | 9 ++++++- library/demos/tcolor | 3 ++- library/demos/timer | 5 +++- library/demos/widget | 7 ++++-- 10 files changed, 109 insertions(+), 70 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0a207cb..4201ce0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2003-09-30 Donal K. Fellows + + * library/demos/browse: Added suitable [package require] + * library/demos/hello: lines to all the Tk demo scripts + * library/demos/ixset: which are not run as part of + * library/demos/rmt: something larger. [FRQ 815118] + * library/demos/rolodex: + * library/demos/square: + * library/demos/tcolor: + * library/demos/timer: + * library/demos/widget: + 2003-09-30 Pat Thoyts * tests/safe.test: Accomodate TIP #150 in the results. diff --git a/library/demos/browse b/library/demos/browse index b881b4d..ced8385 100644 --- a/library/demos/browse +++ b/library/demos/browse @@ -7,7 +7,9 @@ exec wish "$0" ${1+"$@"} # directory and allows you to open files or subdirectories by # double-clicking. # -# RCS: @(#) $Id: browse,v 1.4 2001/11/05 10:13:53 dkf Exp $ +# RCS: @(#) $Id: browse,v 1.5 2003/09/30 14:54:29 dkf Exp $ + +package require Tk # Create a scrollbar on the right side of the main window and a listbox # on the left side. diff --git a/library/demos/hello b/library/demos/hello index ac5cdff..6461f46 100644 --- a/library/demos/hello +++ b/library/demos/hello @@ -6,8 +6,10 @@ 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.3 2001/10/29 16:42:20 dkf Exp $ -# +# RCS: @(#) $Id: hello,v 1.4 2003/09/30 14:54:30 dkf Exp $ + +package require Tk + # The first line below creates the button, and the second line # asks the packer to shrink-wrap the application's main window # around the button. diff --git a/library/demos/ixset b/library/demos/ixset index 3ae2689..21a099f 100644 --- a/library/demos/ixset +++ b/library/demos/ixset @@ -9,7 +9,10 @@ exec wish "$0" ${1+"$@"} # 91/11/23 : pda@masi.ibp.fr, jt@ratp.fr : design # 92/08/01 : pda@masi.ibp.fr : cleaning # -# RCS: @(#) $Id: ixset,v 1.4 2001/11/05 10:13:53 dkf Exp $ +# RCS: @(#) $Id: ixset,v 1.5 2003/09/30 14:54:30 dkf Exp $ + +package require Tcl 8.4 +package require Tk # # Button actions @@ -55,38 +58,31 @@ proc readsettings {} { set xfd [open "|xset q" r] while {[gets $xfd line] > -1} { - set kw [lindex $line 0] - - case $kw in { - {auto} - { - set rpt [lindex $line 1] - if {[expr "{$rpt} == {repeat:}"]} then { - set kbdrep [lindex $line 2] - set kbdcli [lindex $line 6] - } - } - {bell} - { - set bellvol [lindex $line 2] - set bellpit [lindex $line 5] - set belldur [lindex $line 8] - } - {acceleration:} - { - set mouseacc [lindex $line 1] - set mousethr [lindex $line 3] - } - {prefer} - { - set bla [lindex $line 2] - set screenbla [expr "{$bla} == {yes} ? {blank} : {noblank}"] - } - {timeout:} - { - set screentim [lindex $line 1] - set screencyc [lindex $line 3] + switch -- [lindex $line 0] { + auto { + set rpt [lindex $line 1] + if {$rpt eq "repeat:"} { + set kbdrep [lindex $line 2] + set kbdcli [lindex $line 6] } + } + bell { + set bellvol [lindex $line 2] + set bellpit [lindex $line 5] + set belldur [lindex $line 8] + } + acceleration: { + set mouseacc [lindex $line 1] + set mousethr [lindex $line 3] + } + prefer { + set bla [lindex $line 2] + set screenbla [expr {$bla eq "yes" ? "blank" : "noblank"}] + } + timeout: { + set screentim [lindex $line 1] + set screencyc [lindex $line 3] + } } } close $xfd @@ -116,7 +112,7 @@ proc writesettings {} { set bellpit [.bell.val.pit.entry get] set belldur [.bell.val.dur.entry get] - if {[expr "{$kbdrep} == {on}"]} then { + if {$kbdrep eq "on"} { set kbdcli [.kbd.val.cli get] } else { set kbdcli "off" @@ -152,7 +148,7 @@ proc dispsettings {} { .bell.val.dur.entry delete 0 end .bell.val.dur.entry insert 0 $belldur - .kbd.val.onoff [expr "{$kbdrep} == {on} ? {select} : {deselect}"] + .kbd.val.onoff [expr {$kbdrep eq "on" ? "select" : "deselect"}] .kbd.val.cli set $kbdcli .mouse.hor.acc.entry delete 0 end @@ -160,8 +156,8 @@ proc dispsettings {} { .mouse.hor.thr.entry delete 0 end .mouse.hor.thr.entry insert 0 $mousethr - .screen.blank [expr "{$screenbla}=={blank} ? {select} : {deselect}"] - .screen.pat [expr "{$screenbla}!={blank} ? {select} : {deselect}"] + .screen.blank [expr {$screenbla eq "blank" ? "select" : "deselect"}] + .screen.pat [expr {$screenbla ne "blank" ? "select" : "deselect"}] .screen.tim.entry delete 0 end .screen.tim.entry insert 0 $screentim .screen.cyc.entry delete 0 end diff --git a/library/demos/rmt b/library/demos/rmt index 2dcb47b..0e14cdb 100644 --- a/library/demos/rmt +++ b/library/demos/rmt @@ -7,7 +7,10 @@ exec wish "$0" "$@" # Tk applications. It allows you to select an application and # then type commands to that application. # -# RCS: @(#) $Id: rmt,v 1.3 2001/10/29 16:23:32 dkf Exp $ +# RCS: @(#) $Id: rmt,v 1.4 2003/09/30 14:54:30 dkf Exp $ + +package require Tcl 8.4 +package require Tk wm title . "Tk Remote Controller" wm iconname . "Tk Remote" @@ -62,58 +65,60 @@ bind .t { } bind .t { catch {.t tag remove sel sel.first promptEnd} - if {[.t tag nextrange sel 1.0 end] == ""} { - if [.t compare insert < promptEnd] { + if {[.t tag nextrange sel 1.0 end] eq ""} { + if {[.t compare insert < promptEnd]} { break } } } bind .t { catch {.t tag remove sel sel.first promptEnd} - if {[.t tag nextrange sel 1.0 end] == ""} { - if [.t compare insert <= promptEnd] { + if {[.t tag nextrange sel 1.0 end] eq ""} { + if {[.t compare insert <= promptEnd]} { break } } } bind .t { - if [.t compare insert < promptEnd] { + if {[.t compare insert < promptEnd]} { break } } bind .t { - if [.t compare insert < promptEnd] { + if {[.t compare insert < promptEnd]} { .t mark set insert promptEnd } } bind .t { - if [.t compare insert < promptEnd] { + if {[.t compare insert < promptEnd]} { break } } bind .t { - if [.t compare insert < promptEnd] { + if {[.t compare insert < promptEnd]} { break } } bind .t { - if [.t compare insert <= promptEnd] { + if {[.t compare insert <= promptEnd]} { break } } bind .t { - if [.t compare insert <= promptEnd] { + if {[.t compare insert <= promptEnd]} { break } } -auto_load tkTextInsert -proc tkTextInsert {w s} { - if {$s == ""} { +### This next bit *isn't* nice - DKF ### +auto_load tk::TextInsert +proc tk::TextInsert {w s} { + if {$s eq ""} { return } catch { - if {[$w compare sel.first <= insert] - && [$w compare sel.last >= insert]} { + if { + [$w compare sel.first <= insert] && [$w compare sel.last >= insert] + } then { $w tag remove sel sel.first promptEnd $w delete sel.first sel.last } @@ -145,23 +150,21 @@ proc invoke {} { global app executing lastCommand set cmd [.t get promptEnd insert] incr executing 1 - if [info complete $cmd] { - if {$cmd == "!!\n"} { + if {[info complete $cmd]} { + if {$cmd eq "!!\n"} { set cmd $lastCommand } else { set lastCommand $cmd } - if {$app == "local"} { + if {$app eq "local"} { set result [catch [list uplevel #0 $cmd] msg] } else { set result [catch [list send $app $cmd] msg] } if {$result != 0} { .t insert insert "Error: $msg\n" - } else { - if {$msg != ""} { - .t insert insert $msg\n - } + } elseif {$msg ne ""} { + .t insert insert $msg\n } prompt .t mark set promptEnd insert @@ -179,14 +182,14 @@ proc invoke {} { proc newApp appName { global app executing set app $appName - if !$executing { + if {!$executing} { .t mark gravity promptEnd right .t delete "promptEnd linestart" promptEnd .t insert promptEnd "$appName: " .t tag add bold "promptEnd linestart" promptEnd .t mark gravity promptEnd left } - return {} + return } # The procedure below will fill in the applications sub-menu with a list diff --git a/library/demos/rolodex b/library/demos/rolodex index e117edf..30946aa 100644 --- a/library/demos/rolodex +++ b/library/demos/rolodex @@ -8,7 +8,9 @@ exec wish "$0" ${1+"$@"} # feel of a rolodex program, although it's lifeless and doesn't # actually do the rolodex application. # -# RCS: @(#) $Id: rolodex,v 1.4 2001/11/05 10:13:53 dkf Exp $ +# RCS: @(#) $Id: rolodex,v 1.5 2003/09/30 14:54:30 dkf Exp $ + +package require Tk foreach i [winfo child .] { catch {destroy $i} @@ -43,6 +45,10 @@ pack .buttons.clear .buttons.add .buttons.search .buttons.delete \ # Phase 1: Add menus, dialog boxes #------------------------------------------ +# DKF - note that this is an old-style menu bar; I just have not yet +# got around to converting the context help code to work with the new +# menu system and its <> virtual event. + frame .menu -relief raised -borderwidth 1 pack .menu -before .frame -side top -fill x @@ -194,3 +200,7 @@ set helpTopics(version) "This is version $version." -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..743148d 100644 --- a/library/demos/square +++ b/library/demos/square @@ -11,7 +11,10 @@ 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.3 2003/09/30 14:54:30 dkf Exp $ + +package require Tk ;# We use Tk generally, and... +package require Tktest ;# ... we use the square widget too. square .s pack .s -expand yes -fill both @@ -53,3 +56,7 @@ proc timer {} { .s size [expr {$s+$inc}] after 30 timer } + +# Local Variables: +# mode: tcl +# End: diff --git a/library/demos/tcolor b/library/demos/tcolor index ae3cad0..c94d459 100644 --- a/library/demos/tcolor +++ b/library/demos/tcolor @@ -7,8 +7,9 @@ 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.3 2001/10/29 16:23:32 dkf Exp $ +# RCS: @(#) $Id: tcolor,v 1.4 2003/09/30 14:54:30 dkf Exp $ +package require Tk 8.4 wm title . "Color Editor" # Global variables that control the program: diff --git a/library/demos/timer b/library/demos/timer index 5255403..99e6f4c 100644 --- a/library/demos/timer +++ b/library/demos/timer @@ -5,7 +5,10 @@ exec wish "$0" "$@" # timer -- # This script generates a counter with start and stop buttons. # -# RCS: @(#) $Id: timer,v 1.3 2001/10/29 16:23:33 dkf Exp $ +# RCS: @(#) $Id: timer,v 1.4 2003/09/30 14:54:30 dkf Exp $ + +package require Tcl 8.4 +package require Tk label .counter -text 0.00 -relief raised -width 10 -padx 2m -pady 1m button .start -text Start -command { diff --git a/library/demos/widget b/library/demos/widget index ae32937..0b538f3 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -11,10 +11,13 @@ exec wish "$0" "$@" # ".tcl" files is this directory, which are sourced by this script # as needed. # -# RCS: @(#) $Id: widget,v 1.16 2003/09/25 05:37:00 das Exp $ +# RCS: @(#) $Id: widget,v 1.17 2003/09/30 14:54:30 dkf Exp $ -eval destroy [winfo child .] +package require Tcl 8.4 +package require Tk 8.4 package require msgcat + +eval destroy [winfo child .] ::msgcat::mcload [file join $tk_library demos] namespace import ::msgcat::mc wm title . [mc "Widget Demonstration"] -- cgit v0.12