summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/bgerror.tcl12
-rw-r--r--library/clrpick.tcl6
-rw-r--r--library/demos/arrow.tcl89
-rw-r--r--library/demos/clrpick.tcl4
-rw-r--r--library/demos/cscroll.tcl16
-rw-r--r--library/demos/ctext.tcl39
-rw-r--r--library/demos/filebox.tcl6
-rw-r--r--library/demos/floor.tcl4
-rw-r--r--library/demos/hscale.tcl4
-rw-r--r--library/demos/items.tcl4
-rw-r--r--library/demos/plot.tcl17
-rw-r--r--library/demos/puzzle.tcl8
-rw-r--r--library/demos/ruler.tcl18
-rw-r--r--library/demos/twind.tcl21
-rw-r--r--library/demos/vscale.tcl4
-rw-r--r--library/msgbox.tcl22
-rw-r--r--library/xmfbox.tcl6
17 files changed, 142 insertions, 138 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index 51a9be3..9586518 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -9,8 +9,8 @@
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
#
-# RCS: @(#) $Id: bgerror.tcl,v 1.14 2001/03/30 07:04:58 hobbs Exp $
-# $Id: bgerror.tcl,v 1.14 2001/03/30 07:04:58 hobbs Exp $
+# RCS: @(#) $Id: bgerror.tcl,v 1.15 2001/06/14 10:56:58 dkf Exp $
+# $Id: bgerror.tcl,v 1.15 2001/06/14 10:56:58 dkf Exp $
option add *ErrorDialog.function.text [::msgcat::mc "Save To Log"] \
widgetDefault
@@ -238,10 +238,10 @@ proc bgerror err {
set parent [winfo parent .bgerrorDialog]
set width [winfo reqwidth .bgerrorDialog]
set height [winfo reqheight .bgerrorDialog]
- set x [expr ([winfo screenwidth .bgerrorDialog] - $width )/2 - \
- [winfo vrootx $parent]]
- set y [expr ([winfo screenheight .bgerrorDialog] - $height)/2 - \
- [winfo vrooty $parent]]
+ set x [expr {([winfo screenwidth .bgerrorDialog] - $width )/2 - \
+ [winfo vrootx $parent]}]
+ set y [expr {([winfo screenheight .bgerrorDialog] - $height)/2 - \
+ [winfo vrooty $parent]}]
.bgerrorDialog configure -width $width
wm geometry .bgerrorDialog +$x+$y
wm deiconify .bgerrorDialog
diff --git a/library/clrpick.tcl b/library/clrpick.tcl
index c173015..2cc74f1 100644
--- a/library/clrpick.tcl
+++ b/library/clrpick.tcl
@@ -3,7 +3,7 @@
# Color selection dialog for platforms that do not support a
# standard color selection dialog.
#
-# RCS: @(#) $Id: clrpick.tcl,v 1.11 2000/06/30 06:38:38 ericm Exp $
+# RCS: @(#) $Id: clrpick.tcl,v 1.12 2001/06/14 10:56:58 dkf Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
@@ -198,7 +198,7 @@ proc tkColorDialog_BuildDialog {w} {
set stripsFrame [frame $topFrame.colorStrip]
set maxWidth [::msgcat::mcmax Red Green Blue]
- set maxWidth [expr $maxWidth<6?6:$maxWidth]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
set colorList [list \
red [::msgcat::mc "Red"] \
green [::msgcat::mc "Green"] \
@@ -276,7 +276,7 @@ proc tkColorDialog_BuildDialog {w} {
#
set botFrame [frame $w.bot -relief raised -bd 1]
set maxWidth [::msgcat::mcmax OK Cancel]
- set maxWidth [expr $maxWidth<8?8:$maxWidth]
+ set maxWidth [expr {$maxWidth<8?8:$maxWidth}]
button $botFrame.ok -text [::msgcat::mc "OK"] \
-width $maxWidth -under 0 \
-command [list tkColorDialog_OkCmd $w]
diff --git a/library/demos/arrow.tcl b/library/demos/arrow.tcl
index 78befc3..5d37233 100644
--- a/library/demos/arrow.tcl
+++ b/library/demos/arrow.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widget that displays a
# large line with an arrowhead whose shape can be edited interactively.
#
-# RCS: @(#) $Id: arrow.tcl,v 1.2 1998/09/14 18:23:26 stanton Exp $
+# RCS: @(#) $Id: arrow.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -33,68 +33,69 @@ proc arrowSetup c {
# Create the arrow and outline.
$c delete all
- eval "$c create line $v(x1) $v(y) $v(x2) $v(y) -width [expr 10*$v(width)] \
- -arrowshape {[expr 10*$v(a)] [expr 10*$v(b)] [expr 10*$v(c)]} \
- -arrow last $v(bigLineStyle)"
- set xtip [expr $v(x2)-10*$v(b)]
- set deltaY [expr 10*$v(c)+5*$v(width)]
- $c create line $v(x2) $v(y) $xtip [expr $v(y)+$deltaY] \
- [expr $v(x2)-10*$v(a)] $v(y) $xtip [expr $v(y)-$deltaY] \
+ eval {$c create line $v(x1) $v(y) $v(x2) $v(y) -arrow last \
+ -width [expr {10*$v(width)}] -arrowshape [list \
+ [expr {10*$v(a)}] [expr {10*$v(b)}] [expr {10*$v(c)}]]} \
+ $v(bigLineStyle)
+ set xtip [expr {$v(x2)-10*$v(b)}]
+ set deltaY [expr {10*$v(c)+5*$v(width)}]
+ $c create line $v(x2) $v(y) $xtip [expr {$v(y)+$deltaY}] \
+ [expr {$v(x2)-10*$v(a)}] $v(y) $xtip [expr {$v(y)-$deltaY}] \
$v(x2) $v(y) -width 2 -capstyle round -joinstyle round
# Create the boxes for reshaping the line and arrowhead.
- eval "$c create rect [expr $v(x2)-10*$v(a)-5] [expr $v(y)-5] \
- [expr $v(x2)-10*$v(a)+5] [expr $v(y)+5] $v(boxStyle) \
- -tags {box1 box}"
- eval "$c create rect [expr $xtip-5] [expr $v(y)-$deltaY-5] \
- [expr $xtip+5] [expr $v(y)-$deltaY+5] $v(boxStyle) \
- -tags {box2 box}"
- eval "$c create rect [expr $v(x1)-5] [expr $v(y)-5*$v(width)-5] \
- [expr $v(x1)+5] [expr $v(y)-5*$v(width)+5] $v(boxStyle) \
- -tags {box3 box}"
+ eval {$c create rect [expr {$v(x2)-10*$v(a)-5}] [expr {$v(y)-5}] \
+ [expr {$v(x2)-10*$v(a)+5}] [expr {$v(y)+5}] \
+ -tags {box1 box}} $v(boxStyle)
+ eval {$c create rect [expr {$xtip-5}] [expr {$v(y)-$deltaY-5}] \
+ [expr {$xtip+5}] [expr {$v(y)-$deltaY+5}] \
+ -tags {box2 box}} $v(boxStyle)
+ eval {$c create rect [expr {$v(x1)-5}] [expr {$v(y)-5*$v(width)-5}] \
+ [expr {$v(x1)+5}] [expr {$v(y)-5*$v(width)+5}] \
+ -tags {box3 box}} $v(boxStyle)
if {$cur != ""} {
eval $c itemconfigure $cur $v(activeStyle)
}
# Create three arrows in actual size with the same parameters
- $c create line [expr $v(x2)+50] 0 [expr $v(x2)+50] 1000 \
+ $c create line [expr {$v(x2)+50}] 0 [expr {$v(x2)+50}] 1000 \
-width 2
- set tmp [expr $v(x2)+100]
- $c create line $tmp [expr $v(y)-125] $tmp [expr $v(y)-75] \
+ set tmp [expr {$v(x2)+100}]
+ $c create line $tmp [expr {$v(y)-125}] $tmp [expr {$v(y)-75}] \
-width $v(width) \
-arrow both -arrowshape "$v(a) $v(b) $v(c)"
- $c create line [expr $tmp-25] $v(y) [expr $tmp+25] $v(y) \
+ $c create line [expr {$tmp-25}] $v(y) [expr {$tmp+25}] $v(y) \
-width $v(width) \
-arrow both -arrowshape "$v(a) $v(b) $v(c)"
- $c create line [expr $tmp-25] [expr $v(y)+75] [expr $tmp+25] \
- [expr $v(y)+125] -width $v(width) \
+ $c create line [expr {$tmp-25}] [expr {$v(y)+75}] [expr {$tmp+25}] \
+ [expr {$v(y)+125}] -width $v(width) \
-arrow both -arrowshape "$v(a) $v(b) $v(c)"
# Create a bunch of other arrows and text items showing the
# current dimensions.
- set tmp [expr $v(x2)+10]
- $c create line $tmp [expr $v(y)-5*$v(width)] \
- $tmp [expr $v(y)-$deltaY] \
+ set tmp [expr {$v(x2)+10}]
+ $c create line $tmp [expr {$v(y)-5*$v(width)}] \
+ $tmp [expr {$v(y)-$deltaY}] \
-arrow both -arrowshape $v(smallTips)
- $c create text [expr $v(x2)+15] [expr $v(y)-$deltaY+5*$v(c)] \
+ $c create text [expr {$v(x2)+15}] [expr {$v(y)-$deltaY+5*$v(c)}] \
-text $v(c) -anchor w
- set tmp [expr $v(x1)-10]
- $c create line $tmp [expr $v(y)-5*$v(width)] \
- $tmp [expr $v(y)+5*$v(width)] \
+ set tmp [expr {$v(x1)-10}]
+ $c create line $tmp [expr {$v(y)-5*$v(width)}] \
+ $tmp [expr {$v(y)+5*$v(width)}] \
-arrow both -arrowshape $v(smallTips)
- $c create text [expr $v(x1)-15] $v(y) -text $v(width) -anchor e
- set tmp [expr $v(y)+5*$v(width)+10*$v(c)+10]
- $c create line [expr $v(x2)-10*$v(a)] $tmp $v(x2) $tmp \
+ $c create text [expr {$v(x1)-15}] $v(y) -text $v(width) -anchor e
+ set tmp [expr {$v(y)+5*$v(width)+10*$v(c)+10}]
+ $c create line [expr {$v(x2)-10*$v(a)}] $tmp $v(x2) $tmp \
-arrow both -arrowshape $v(smallTips)
- $c create text [expr $v(x2)-5*$v(a)] [expr $tmp+5] \
+ $c create text [expr {$v(x2)-5*$v(a)}] [expr {$tmp+5}] \
-text $v(a) -anchor n
- set tmp [expr $tmp+25]
- $c create line [expr $v(x2)-10*$v(b)] $tmp $v(x2) $tmp \
+ set tmp [expr {$tmp+25}]
+ $c create line [expr {$v(x2)-10*$v(b)}] $tmp $v(x2) $tmp \
-arrow both -arrowshape $v(smallTips)
- $c create text [expr $v(x2)-5*$v(b)] [expr $tmp+5] \
+ $c create text [expr {$v(x2)-5*$v(b)}] [expr {$tmp+5}] \
-text $v(b) -anchor n
$c create text $v(x1) 310 -text "-width $v(width)" \
@@ -168,7 +169,7 @@ bind $c <Any-ButtonRelease-1> "arrowSetup $c"
proc arrowMove1 {c x y} {
upvar #0 demo_arrowInfo v
- set newA [expr ($v(x2)+5-round([$c canvasx $x]))/10]
+ set newA [expr {($v(x2)+5-round([$c canvasx $x]))/10}]
if {$newA < 0} {
set newA 0
}
@@ -176,7 +177,7 @@ proc arrowMove1 {c x y} {
set newA 25
}
if {$newA != $v(a)} {
- $c move box1 [expr 10*($v(a)-$newA)] 0
+ $c move box1 [expr {10*($v(a)-$newA)}] 0
set v(a) $newA
}
}
@@ -192,14 +193,14 @@ proc arrowMove1 {c x y} {
proc arrowMove2 {c x y} {
upvar #0 demo_arrowInfo v
- set newB [expr ($v(x2)+5-round([$c canvasx $x]))/10]
+ set newB [expr {($v(x2)+5-round([$c canvasx $x]))/10}]
if {$newB < 0} {
set newB 0
}
if {$newB > 25} {
set newB 25
}
- set newC [expr ($v(y)+5-round([$c canvasy $y])-5*$v(width))/10]
+ set newC [expr {($v(y)+5-round([$c canvasy $y])-5*$v(width))/10}]
if {$newC < 0} {
set newC 0
}
@@ -207,7 +208,7 @@ proc arrowMove2 {c x y} {
set newC 20
}
if {($newB != $v(b)) || ($newC != $v(c))} {
- $c move box2 [expr 10*($v(b)-$newB)] [expr 10*($v(c)-$newC)]
+ $c move box2 [expr {10*($v(b)-$newB)}] [expr {10*($v(c)-$newC)}]
set v(b) $newB
set v(c) $newC
}
@@ -224,7 +225,7 @@ proc arrowMove2 {c x y} {
proc arrowMove3 {c x y} {
upvar #0 demo_arrowInfo v
- set newWidth [expr ($v(y)+2-round([$c canvasy $y]))/5]
+ set newWidth [expr {($v(y)+2-round([$c canvasy $y]))/5}]
if {$newWidth < 0} {
set newWidth 0
}
@@ -232,7 +233,7 @@ proc arrowMove3 {c x y} {
set newWidth 20
}
if {$newWidth != $v(width)} {
- $c move box3 0 [expr 5*($v(width)-$newWidth)]
+ $c move box3 0 [expr {5*($v(width)-$newWidth)}]
set v(width) $newWidth
}
}
diff --git a/library/demos/clrpick.tcl b/library/demos/clrpick.tcl
index eee1d7e..5c1f018 100644
--- a/library/demos/clrpick.tcl
+++ b/library/demos/clrpick.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script prompts the user to select a color.
#
-# RCS: @(#) $Id: clrpick.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $
+# RCS: @(#) $Id: clrpick.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -38,7 +38,7 @@ proc setColor {w button name options} {
set initialColor [$button cget -$name]
set color [tk_chooseColor -title "Choose a $name color" -parent $w \
-initialcolor $initialColor]
- if [string compare $color ""] {
+ if {[string compare $color ""]} {
setColor_helper $w $options $color
}
grab release $w
diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl
index 0289911..8aad050 100644
--- a/library/demos/cscroll.tcl
+++ b/library/demos/cscroll.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a simple canvas that can be
# scrolled in two dimensions.
#
-# RCS: @(#) $Id: cscroll.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $
+# RCS: @(#) $Id: cscroll.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -48,9 +48,9 @@ set bg [lindex [$c config -bg] 4]
for {set i 0} {$i < 20} {incr i} {
set x [expr {-10 + 3*$i}]
for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} {
- $c create rect ${x}c ${y}c [expr $x+2]c [expr $y+2]c \
+ $c create rect ${x}c ${y}c [expr {$x+2}]c [expr {$y+2}]c \
-outline black -fill $bg -tags rect
- $c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \
+ $c create text [expr {$x+1}]c [expr {$y+1}]c -text "$i,$j" \
-anchor center -tags text
}
}
@@ -65,14 +65,14 @@ proc scrollEnter canvas {
global oldFill
set id [$canvas find withtag current]
if {[lsearch [$canvas gettags current] text] >= 0} {
- set id [expr $id-1]
+ set id [expr {$id-1}]
}
set oldFill [lindex [$canvas itemconfig $id -fill] 4]
if {[winfo depth $canvas] > 1} {
$canvas itemconfigure $id -fill SeaGreen1
} else {
$canvas itemconfigure $id -fill black
- $canvas itemconfigure [expr $id+1] -fill white
+ $canvas itemconfigure [expr {$id+1}] -fill white
}
}
@@ -80,17 +80,17 @@ proc scrollLeave canvas {
global oldFill
set id [$canvas find withtag current]
if {[lsearch [$canvas gettags current] text] >= 0} {
- set id [expr $id-1]
+ set id [expr {$id-1}]
}
$canvas itemconfigure $id -fill $oldFill
- $canvas itemconfigure [expr $id+1] -fill black
+ $canvas itemconfigure [expr {$id+1}] -fill black
}
proc scrollButton canvas {
global oldFill
set id [$canvas find withtag current]
if {[lsearch [$canvas gettags current] text] < 0} {
- set id [expr $id+1]
+ set id [expr {$id+1}]
}
puts stdout "You buttoned at [lindex [$canvas itemconf $id -text] 4]"
}
diff --git a/library/demos/ctext.tcl b/library/demos/ctext.tcl
index 51af609..fb120a8 100644
--- a/library/demos/ctext.tcl
+++ b/library/demos/ctext.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widget with a text
# item that can be edited and reconfigured in various ways.
#
-# RCS: @(#) $Id: ctext.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $
+# RCS: @(#) $Id: ctext.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -58,7 +58,7 @@ $c bind text <2> "textPaste $c @%x,%y"
# to be edited.
proc mkTextConfig {w x y option value color} {
- set item [$w create rect [expr $x] [expr $y] [expr $x+30] [expr $y+30] \
+ set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \
-outline black -fill $color -width 1]
$w bind $item <1> "$w itemconf text $option $value"
$w addtag config withtag $item
@@ -68,19 +68,20 @@ set x 50
set y 50
set color LightSkyBlue1
mkTextConfig $c $x $y -anchor se $color
-mkTextConfig $c [expr $x+30] [expr $y] -anchor s $color
-mkTextConfig $c [expr $x+60] [expr $y] -anchor sw $color
-mkTextConfig $c [expr $x] [expr $y+30] -anchor e $color
-mkTextConfig $c [expr $x+30] [expr $y+30] -anchor center $color
-mkTextConfig $c [expr $x+60] [expr $y+30] -anchor w $color
-mkTextConfig $c [expr $x] [expr $y+60] -anchor ne $color
-mkTextConfig $c [expr $x+30] [expr $y+60] -anchor n $color
-mkTextConfig $c [expr $x+60] [expr $y+60] -anchor nw $color
-set item [$c create rect [expr $x+40] [expr $y+40] [expr $x+50] [expr $y+50] \
+mkTextConfig $c [expr {$x+30}] [expr {$y }] -anchor s $color
+mkTextConfig $c [expr {$x+60}] [expr {$y }] -anchor sw $color
+mkTextConfig $c [expr {$x }] [expr {$y+30}] -anchor e $color
+mkTextConfig $c [expr {$x+30}] [expr {$y+30}] -anchor center $color
+mkTextConfig $c [expr {$x+60}] [expr {$y+30}] -anchor w $color
+mkTextConfig $c [expr {$x }] [expr {$y+60}] -anchor ne $color
+mkTextConfig $c [expr {$x+30}] [expr {$y+60}] -anchor n $color
+mkTextConfig $c [expr {$x+60}] [expr {$y+60}] -anchor nw $color
+set item [$c create rect \
+ [expr {$x+40}] [expr {$y+40}] [expr {$x+50}] [expr {$y+50}] \
-outline black -fill red]
$c bind $item <1> "$c itemconf text -anchor center"
-$c create text [expr $x+45] [expr $y-5] -text {Text Position} -anchor s \
- -font {Times 24} -fill brown
+$c create text [expr {$x+45}] [expr {$y-5}] \
+ -text {Text Position} -anchor s -font {Times 24} -fill brown
# Lastly, create some items that allow the text's justification to be
# changed.
@@ -89,10 +90,10 @@ set x 350
set y 50
set color SeaGreen2
mkTextConfig $c $x $y -justify left $color
-mkTextConfig $c [expr $x+30] [expr $y] -justify center $color
-mkTextConfig $c [expr $x+60] [expr $y] -justify right $color
-$c create text [expr $x+45] [expr $y-5] -text {Justification} -anchor s \
- -font {Times 24} -fill brown
+mkTextConfig $c [expr {$x+30}] $y -justify center $color
+mkTextConfig $c [expr {$x+60}] $y -justify right $color
+$c create text [expr {$x+45}] [expr {$y-5}] \
+ -text {Justification} -anchor s -font {Times 24} -fill brown
$c bind config <Enter> "textEnter $c"
$c bind config <Leave> "$c itemconf current -fill \$textConfigFill"
@@ -131,7 +132,7 @@ proc textB1Move {w x y} {
}
proc textBs {w} {
- if ![catch {$w dchars text sel.first sel.last}] {
+ if {![catch {$w dchars text sel.first sel.last}]} {
return
}
set char [expr {[$w index text insert] - 1}]
@@ -139,7 +140,7 @@ proc textBs {w} {
}
proc textDel {w} {
- if ![catch {$w dchars text sel.first sel.last}] {
+ if {![catch {$w dchars text sel.first sel.last}]} {
return
}
$w dchars text insert
diff --git a/library/demos/filebox.tcl b/library/demos/filebox.tcl
index 9fd69fa..4401d06 100644
--- a/library/demos/filebox.tcl
+++ b/library/demos/filebox.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script prompts the user to select a file.
#
-# RCS: @(#) $Id: filebox.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $
+# RCS: @(#) $Id: filebox.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -35,7 +35,7 @@ foreach i {open save} {
pack $f -fill x -padx 1c -pady 3
}
-if ![string compare $tcl_platform(platform) unix] {
+if {![string compare $tcl_platform(platform) unix]} {
checkbutton $w.strict -text "Use Motif Style Dialog" \
-variable tk_strictMotif -onvalue 1 -offvalue 0
pack $w.strict -anchor c
@@ -62,7 +62,7 @@ proc fileDialog {w ent operation} {
set file [tk_getSaveFile -filetypes $types -parent $w \
-initialfile Untitled -defaultextension .txt]
}
- if [string compare $file ""] {
+ if {[string compare $file ""]} {
$ent delete 0 end
$ent insert 0 $file
$ent xview end
diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl
index 0afb625..2435544 100644
--- a/library/demos/floor.tcl
+++ b/library/demos/floor.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widet that displays the
# floorplan for DEC's Western Research Laboratory.
#
-# RCS: @(#) $Id: floor.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $
+# RCS: @(#) $Id: floor.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -94,7 +94,7 @@ proc newRoom w {
proc roomChanged {w args} {
global currentRoom floorItems colors
$w delete highlight
- if [catch {set item $floorItems($currentRoom)}] {
+ if {[catch {set item $floorItems($currentRoom)}]} {
return
}
set new [eval \
diff --git a/library/demos/hscale.tcl b/library/demos/hscale.tcl
index fca7f20..a9b3761 100644
--- a/library/demos/hscale.tcl
+++ b/library/demos/hscale.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script shows an example with a horizontal scale.
#
-# RCS: @(#) $Id: hscale.tcl,v 1.2 1998/09/14 18:23:28 stanton Exp $
+# RCS: @(#) $Id: hscale.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -38,7 +38,7 @@ $w.frame.scale set 75
proc setWidth {w width} {
incr width 21
- set x2 [expr $width - 30]
+ set x2 [expr {$width - 30}]
if {$x2 < 21} {
set x2 21
}
diff --git a/library/demos/items.tcl b/library/demos/items.tcl
index a91ab61..91ea32a 100644
--- a/library/demos/items.tcl
+++ b/library/demos/items.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas that displays the
# canvas item types.
#
-# RCS: @(#) $Id: items.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $
+# RCS: @(#) $Id: items.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -271,7 +271,7 @@ proc itemDrag {c x y} {
global lastX lastY
set x [$c canvasx $x]
set y [$c canvasy $y]
- $c move current [expr $x-$lastX] [expr $y-$lastY]
+ $c move current [expr {$x-$lastX}] [expr {$y-$lastY}]
set lastX $x
set lastY $y
}
diff --git a/library/demos/plot.tcl b/library/demos/plot.tcl
index a1109c2..011f140 100644
--- a/library/demos/plot.tcl
+++ b/library/demos/plot.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widget showing a 2-D
# plot with data points that can be dragged with the mouse.
#
-# RCS: @(#) $Id: plot.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $
+# RCS: @(#) $Id: plot.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -38,20 +38,21 @@ $c create text 225 20 -text "A Simple Plot" -font $plotFont -fill brown
for {set i 0} {$i <= 10} {incr i} {
set x [expr {100 + ($i*30)}]
$c create line $x 250 $x 245 -width 2
- $c create text $x 254 -text [expr 10*$i] -anchor n -font $plotFont
+ $c create text $x 254 -text [expr {10*$i}] -anchor n -font $plotFont
}
for {set i 0} {$i <= 5} {incr i} {
set y [expr {250 - ($i*40)}]
$c create line 100 $y 105 $y -width 2
- $c create text 96 $y -text [expr $i*50].0 -anchor e -font $plotFont
+ $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $plotFont
}
-foreach point {{12 56} {20 94} {33 98} {32 120} {61 180}
- {75 160} {98 223}} {
+foreach point {
+ {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223}
+} {
set x [expr {100 + (3*[lindex $point 0])}]
set y [expr {250 - (4*[lindex $point 1])/5}]
- set item [$c create oval [expr $x-6] [expr $y-6] \
- [expr $x+6] [expr $y+6] -width 1 -outline black \
+ set item [$c create oval [expr {$x-6}] [expr {$y-6}] \
+ [expr {$x+6}] [expr {$y+6}] -width 1 -outline black \
-fill SkyBlue2]
$c addtag point withtag $item
}
@@ -92,7 +93,7 @@ proc plotDown {w x y} {
proc plotMove {w x y} {
global plot
- $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)]
+ $w move selected [expr {$x-$plot(lastX)}] [expr {$y-$plot(lastY)}]
set plot(lastX) $x
set plot(lastY) $y
}
diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl
index e3ee8cc..b0fa685 100644
--- a/library/demos/puzzle.tcl
+++ b/library/demos/puzzle.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a 15-puzzle game using a collection
# of buttons.
#
-# RCS: @(#) $Id: puzzle.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $
+# RCS: @(#) $Id: puzzle.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -60,10 +60,10 @@ pack $w.frame -side top -pady 1c -padx 1c
destroy $w.s
set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12}
-for {set i 0} {$i < 15} {set i [expr $i+1]} {
+for {set i 0} {$i < 15} {set i [expr {$i+1}]} {
set num [lindex $order $i]
- set xpos($num) [expr ($i%4)*.25]
- set ypos($num) [expr ($i/4)*.25]
+ set xpos($num) [expr {($i%4)*.25}]
+ set ypos($num) [expr {($i/4)*.25}]
button $w.frame.$num -relief raised -text $num -highlightthickness 0 \
-command "puzzleSwitch $w $num"
place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \
diff --git a/library/demos/ruler.tcl b/library/demos/ruler.tcl
index fa20566..86f18dc 100644
--- a/library/demos/ruler.tcl
+++ b/library/demos/ruler.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widget that displays a ruler
# with tab stops that can be set, moved, and deleted.
#
-# RCS: @(#) $Id: ruler.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $
+# RCS: @(#) $Id: ruler.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -19,8 +19,8 @@ if {![info exists widgetDemo]} {
proc rulerMkTab {c x y} {
upvar #0 demo_rulerInfo v
- $c create polygon $x $y [expr $x+$v(size)] [expr $y+$v(size)] \
- [expr $x-$v(size)] [expr $y+$v(size)]
+ $c create polygon $x $y [expr {$x+$v(size)}] [expr {$y+$v(size)}] \
+ [expr {$x-$v(size)}] [expr {$y+$v(size)}]
}
set w .ruler
@@ -63,7 +63,7 @@ if {[winfo depth $c] > 1} {
$c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1
for {set i 0} {$i < 12} {incr i} {
- set x [expr $i+1]
+ set x [expr {$i+1}]
$c create line ${x}c 1c ${x}c 0.6c -width 1
$c create line $x.25c 1c $x.25c 0.8c -width 1
$c create line $x.5c 1c $x.5c 0.7c -width 1
@@ -110,7 +110,7 @@ proc rulerNewTab {c x y} {
proc rulerSelectTab {c x y} {
upvar #0 demo_rulerInfo v
set v(x) [$c canvasx $x $v(grid)]
- set v(y) [expr $v(top)+2]
+ set v(y) [expr {$v(top)+2}]
$c addtag active withtag current
eval "$c itemconf active $v(activeStyle)"
$c raise active
@@ -139,13 +139,13 @@ proc rulerMoveTab {c x y} {
set cx $v(right)
}
if {($cy >= $v(top)) && ($cy <= $v(bottom))} {
- set cy [expr $v(top)+2]
+ set cy [expr {$v(top)+2}]
eval "$c itemconf active $v(activeStyle)"
} else {
- set cy [expr $cy-$v(size)-2]
+ set cy [expr {$cy-$v(size)-2}]
eval "$c itemconf active $v(deleteStyle)"
}
- $c move active [expr $cx-$v(x)] [expr $cy-$v(y)]
+ $c move active [expr {$cx-$v(x)}] [expr {$cy-$v(y)}]
set v(x) $cx
set v(y) $cy
}
@@ -164,7 +164,7 @@ proc rulerReleaseTab c {
if {[$c find withtag active] == {}} {
return
}
- if {$v(y) != [expr $v(top)+2]} {
+ if {$v(y) != $v(top)+2} {
$c delete active
} else {
eval "$c itemconf active $v(normalStyle)"
diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl
index bdb8337..8dff2dd 100644
--- a/library/demos/twind.tcl
+++ b/library/demos/twind.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a text widget with a bunch of
# embedded windows.
#
-# RCS: @(#) $Id: twind.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $
+# RCS: @(#) $Id: twind.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -115,7 +115,7 @@ proc textWindOff w {
proc textWindPlot t {
set c $t.c
- if [winfo exists $c] {
+ if {[winfo exists $c]} {
return
}
canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow
@@ -129,20 +129,21 @@ proc textWindPlot t {
for {set i 0} {$i <= 10} {incr i} {
set x [expr {100 + ($i*30)}]
$c create line $x 250 $x 245 -width 2
- $c create text $x 254 -text [expr 10*$i] -anchor n -font $font
+ $c create text $x 254 -text [expr {10*$i}] -anchor n -font $font
}
for {set i 0} {$i <= 5} {incr i} {
set y [expr {250 - ($i*40)}]
$c create line 100 $y 105 $y -width 2
- $c create text 96 $y -text [expr $i*50].0 -anchor e -font $font
+ $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font
}
- foreach point {{12 56} {20 94} {33 98} {32 120} {61 180}
- {75 160} {98 223}} {
+ foreach point {
+ {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223}
+ } {
set x [expr {100 + (3*[lindex $point 0])}]
set y [expr {250 - (4*[lindex $point 1])/5}]
- set item [$c create oval [expr $x-6] [expr $y-6] \
- [expr $x+6] [expr $y+6] -width 1 -outline black \
+ set item [$c create oval [expr {$x-6}] [expr {$y-6}] \
+ [expr {$x+6}] [expr {$y+6}] -width 1 -outline black \
-fill SkyBlue2]
$c addtag point withtag $item
}
@@ -175,14 +176,14 @@ proc embPlotDown {w x y} {
proc embPlotMove {w x y} {
global embPlot
- $w move selected [expr $x-$embPlot(lastX)] [expr $y-$embPlot(lastY)]
+ $w move selected [expr {$x-$embPlot(lastX)}] [expr {$y-$embPlot(lastY)}]
set embPlot(lastX) $x
set embPlot(lastY) $y
}
proc textWindDel w {
set t $w.f.text
- if [winfo exists $t.c] {
+ if {[winfo exists $t.c]} {
$t delete $t.c
while {[string first [$t get plot] " \t\n"] >= 0} {
$t delete plot
diff --git a/library/demos/vscale.tcl b/library/demos/vscale.tcl
index d50089f..cb89ec3 100644
--- a/library/demos/vscale.tcl
+++ b/library/demos/vscale.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script shows an example with a vertical scale.
#
-# RCS: @(#) $Id: vscale.tcl,v 1.2 1998/09/14 18:23:30 stanton Exp $
+# RCS: @(#) $Id: vscale.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -39,7 +39,7 @@ $w.frame.scale set 75
proc setHeight {w height} {
incr height 21
- set y2 [expr $height - 30]
+ set y2 [expr {$height - 30}]
if {$y2 < 21} {
set y2 21
}
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 1ed1acc..87b3e10 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -3,7 +3,7 @@
# Implements messageboxes for platforms that do not have native
# messagebox support.
#
-# RCS: @(#) $Id: msgbox.tcl,v 1.12 2000/06/30 06:38:38 ericm Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.13 2001/06/14 10:56:58 dkf Exp $
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
@@ -170,8 +170,8 @@ proc tkMessageBox {args} {
switch -- $data(-type) {
abortretryignore {
- set maxWidth [::msgcat::mcmax Abort Retry Ignore]
- set maxWidth [expr $maxWidth<6?6:$maxWidth]
+ set maxWidth [::msgcat::mcmax Abort Retry Ignore]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
set buttons [list \
[list abort -width $maxWidth -text [::msgcat::mc "Abort"] \
-under 0]\
@@ -191,8 +191,8 @@ proc tkMessageBox {args} {
}
}
okcancel {
- set maxWidth [::msgcat::mcmax OK Cancel]
- set maxWidth [expr $maxWidth<6?6:$maxWidth]
+ set maxWidth [::msgcat::mcmax OK Cancel]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
set buttons [list \
[list ok -width $maxWidth \
-text [::msgcat::mc "OK"] -under 0] \
@@ -201,8 +201,8 @@ proc tkMessageBox {args} {
]
}
retrycancel {
- set maxWidth [::msgcat::mcmax Retry Cancel]
- set maxWidth [expr $maxWidth<6?6:$maxWidth]
+ set maxWidth [::msgcat::mcmax Retry Cancel]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
set buttons [list \
[list retry -width $maxWidth \
-text [::msgcat::mc "Retry"] -under 0] \
@@ -211,8 +211,8 @@ proc tkMessageBox {args} {
]
}
yesno {
- set maxWidth [::msgcat::mcmax Yes No]
- set maxWidth [expr $maxWidth<6?6:$maxWidth]
+ set maxWidth [::msgcat::mcmax Yes No]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
set buttons [list \
[list yes -width $maxWidth \
-text [::msgcat::mc "Yes"] -under 0]\
@@ -221,8 +221,8 @@ proc tkMessageBox {args} {
]
}
yesnocancel {
- set maxWidth [::msgcat::mcmax Yes No Cancel]
- set maxWidth [expr $maxWidth<6?6:$maxWidth]
+ set maxWidth [::msgcat::mcmax Yes No Cancel]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
set buttons [list \
[list yes -width $maxWidth \
-text [::msgcat::mc "Yes"] -under 0]\
diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl
index 1861abc..ae964e8 100644
--- a/library/xmfbox.tcl
+++ b/library/xmfbox.tcl
@@ -4,7 +4,7 @@
# Unix platform. This implementation is used only if the
# "tk_strictMotif" flag is set.
#
-# RCS: @(#) $Id: xmfbox.tcl,v 1.14 2000/06/30 20:19:07 ericm Exp $
+# RCS: @(#) $Id: xmfbox.tcl,v 1.15 2001/06/14 10:56:58 dkf Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Scriptics Corporation
@@ -347,8 +347,8 @@ proc tkMotifFDialog_BuildUI {w} {
# The buttons
#
- set maxWidth [::msgcat::mcmax OK Filter Cancel]
- set maxWidth [expr $maxWidth<6?6:$maxWidth]
+ set maxWidth [::msgcat::mcmax OK Filter Cancel]
+ set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
set data(okBtn) [button $bot.ok -text [::msgcat::mc "OK"] \
-width $maxWidth -under 0 \
-command [list tkMotifFDialog_OkCmd $w]]
generated by cgit v0.12 at 2024-11-09 22:38:44 (GMT)