summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog12
-rw-r--r--library/demos/browse4
-rw-r--r--library/demos/hello6
-rw-r--r--library/demos/ixset68
-rw-r--r--library/demos/rmt53
-rw-r--r--library/demos/rolodex12
-rw-r--r--library/demos/square9
-rw-r--r--library/demos/tcolor3
-rw-r--r--library/demos/timer5
-rw-r--r--library/demos/widget7
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 <fellowsd@cs.man.ac.uk>
+
+ * 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 <patthoyts@users.sourceforge.net>
* 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 <Return> {
}
bind .t <Delete> {
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 <BackSpace> {
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 <Control-d> {
- if [.t compare insert < promptEnd] {
+ if {[.t compare insert < promptEnd]} {
break
}
}
bind .t <Control-k> {
- if [.t compare insert < promptEnd] {
+ if {[.t compare insert < promptEnd]} {
.t mark set insert promptEnd
}
}
bind .t <Control-t> {
- if [.t compare insert < promptEnd] {
+ if {[.t compare insert < promptEnd]} {
break
}
}
bind .t <Meta-d> {
- if [.t compare insert < promptEnd] {
+ if {[.t compare insert < promptEnd]} {
break
}
}
bind .t <Meta-BackSpace> {
- if [.t compare insert <= promptEnd] {
+ if {[.t compare insert <= promptEnd]} {
break
}
}
bind .t <Control-h> {
- 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 <<MenuSelect>> 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"]
generated by cgit v0.12 at 2024-11-09 20:37:02 (GMT)