summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/button.tcl28
-rw-r--r--library/clrpick.tcl80
-rw-r--r--library/comdlg.tcl23
-rw-r--r--library/console.tcl56
-rw-r--r--library/dialog.tcl27
-rw-r--r--library/entry.tcl20
-rw-r--r--library/focus.tcl30
-rw-r--r--library/listbox.tcl24
-rw-r--r--library/menu.tcl280
-rw-r--r--library/msgbox.tcl59
-rw-r--r--library/palette.tcl19
-rw-r--r--library/safetk.tcl51
-rw-r--r--library/scale.tcl33
-rw-r--r--library/scrlbar.tcl48
-rw-r--r--library/tearoff.tcl20
-rw-r--r--library/text.tcl45
-rw-r--r--library/tk.tcl62
-rw-r--r--library/tkfbox.tcl161
-rw-r--r--library/xmfbox.tcl126
19 files changed, 593 insertions, 599 deletions
diff --git a/library/button.tcl b/library/button.tcl
index 7c33bc2..8feeba8 100644
--- a/library/button.tcl
+++ b/library/button.tcl
@@ -4,7 +4,7 @@
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
-# RCS: @(#) $Id: button.tcl,v 1.5 1999/08/09 16:52:06 hobbs Exp $
+# RCS: @(#) $Id: button.tcl,v 1.6 1999/09/02 17:02:52 hobbs Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -143,7 +143,7 @@ if {[string match "windows" $tcl_platform(platform)]} {
proc tkButtonEnter w {
global tkPriv
if {[string compare [$w cget -state] "disabled"] \
- && ![string compare $tkPriv(buttonWindow) $w]} {
+ && [string equal $tkPriv(buttonWindow) $w]} {
$w configure -state active -relief sunken
}
set tkPriv(window) $w
@@ -164,7 +164,7 @@ proc tkButtonLeave w {
if {[string compare [$w cget -state] "disabled"]} {
$w configure -state normal
}
- if {![string compare $tkPriv(buttonWindow) $w]} {
+ if {[string equal $tkPriv(buttonWindow) $w]} {
$w configure -relief $tkPriv(relief)
}
set tkPriv(window) ""
@@ -182,7 +182,7 @@ proc tkButtonLeave w {
proc tkCheckRadioEnter w {
global tkPriv
if {[string compare [$w cget -state] "disabled"] \
- && ![string compare $tkPriv(buttonWindow) $w]} {
+ && [string equal $tkPriv(buttonWindow) $w]} {
$w configure -state active
}
set tkPriv(window) $w
@@ -234,10 +234,10 @@ proc tkCheckRadioDown w {
proc tkButtonUp w {
global tkPriv
- if {![string compare $tkPriv(buttonWindow) $w]} {
+ if {[string equal $tkPriv(buttonWindow) $w]} {
set tkPriv(buttonWindow) ""
$w configure -relief $tkPriv(relief)
- if {![string compare $tkPriv(window) $w]
+ if {[string equal $tkPriv(window) $w]
&& [string compare [$w cget -state] "disabled"]} {
$w configure -state normal
uplevel #0 [list $w invoke]
@@ -265,7 +265,7 @@ proc tkButtonEnter {w} {
global tkPriv
if {[string compare [$w cget -state] "disabled"]} {
$w configure -state active
- if {![string compare $tkPriv(buttonWindow) $w]} {
+ if {[string equal $tkPriv(buttonWindow) $w]} {
$w configure -state active -relief sunken
}
}
@@ -287,7 +287,7 @@ proc tkButtonLeave w {
if {[string compare [$w cget -state] "disabled"]} {
$w configure -state normal
}
- if {![string compare $tkPriv(buttonWindow) $w]} {
+ if {[string equal $tkPriv(buttonWindow) $w]} {
$w configure -relief $tkPriv(relief)
}
set tkPriv(window) ""
@@ -321,10 +321,10 @@ proc tkButtonDown w {
proc tkButtonUp w {
global tkPriv
- if {![string compare $w $tkPriv(buttonWindow)]} {
+ if {[string equal $w $tkPriv(buttonWindow)]} {
set tkPriv(buttonWindow) ""
$w configure -relief $tkPriv(relief)
- if {![string compare $w $tkPriv(window)] \
+ if {[string equal $w $tkPriv(window)] \
&& [string compare [$w cget -state] "disabled"]} {
uplevel #0 [list $w invoke]
}
@@ -350,7 +350,7 @@ if {[string match "macintosh" $tcl_platform(platform)]} {
proc tkButtonEnter {w} {
global tkPriv
if {[string compare [$w cget -state] "disabled"]} {
- if {![string compare $w $tkPriv(buttonWindow)]} {
+ if {[string equal $w $tkPriv(buttonWindow)]} {
$w configure -state active
}
}
@@ -369,7 +369,7 @@ proc tkButtonEnter {w} {
proc tkButtonLeave w {
global tkPriv
- if {![string compare $w $tkPriv(buttonWindow)]} {
+ if {[string equal $w $tkPriv(buttonWindow)]} {
$w configure -state normal
}
set tkPriv(window) ""
@@ -402,10 +402,10 @@ proc tkButtonDown w {
proc tkButtonUp w {
global tkPriv
- if {![string compare $w $tkPriv(buttonWindow)]} {
+ if {[string equal $w $tkPriv(buttonWindow)]} {
$w configure -state normal
set tkPriv(buttonWindow) ""
- if {![string compare $w $tkPriv(window)]
+ if {[string equal $w $tkPriv(window)]
&& [string compare [$w cget -state] "disabled"]} {
uplevel #0 [list $w invoke]
}
diff --git a/library/clrpick.tcl b/library/clrpick.tcl
index 5fdf467..9fa56ff 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.5 1999/08/10 15:27:49 hobbs Exp $
+# RCS: @(#) $Id: clrpick.tcl,v 1.6 1999/09/02 17:02:52 hobbs Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
@@ -102,7 +102,7 @@ proc tkColorDialog {args} {
destroy $w
unset data
if {[string compare $oldGrab ""]} {
- if {![string compare $grabStatus "global"]} {
+ if {[string equal $grabStatus "global"]} {
grab -global $oldGrab
} else {
grab $oldGrab
@@ -147,8 +147,7 @@ proc tkColorDialog_InitValues {w} {
#
# canvasWidth is the width of the entire canvas, including the indents
#
- set data(canvasWidth) [expr {$data(BARS_WIDTH) + \
- $data(PLGN_WIDTH)}]
+ set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}]
# Set the initial color, specified by -initialcolor, or the
# color chosen by the user the last time.
@@ -181,10 +180,10 @@ proc tkColorDialog_Config {w argList} {
#
tclParseConfigSpec $w $specs "" $argList
- if {![string compare $data(-title) ""]} {
+ if {[string equal $data(-title) ""]} {
set data(-title) " "
}
- if {![string compare $data(-initialcolor) ""]} {
+ if {[string equal $data(-initialcolor) ""]} {
if {[info exists tkPriv(selectColor)] && \
[string compare $tkPriv(selectColor) ""]} {
set data(-initialcolor) $tkPriv(selectColor)
@@ -250,18 +249,18 @@ proc tkColorDialog_BuildDialog {w} {
set data($color,sel) $f.sel
bind $data($color,col) <Configure> \
- "tkColorDialog_DrawColorScale $w $color 1"
+ [list tkColorDialog_DrawColorScale $w $color 1]
bind $data($color,col) <Enter> \
- "tkColorDialog_EnterColorBar $w $color"
+ [list tkColorDialog_EnterColorBar $w $color]
bind $data($color,col) <Leave> \
- "tkColorDialog_LeaveColorBar $w $color"
+ [list tkColorDialog_LeaveColorBar $w $color]
bind $data($color,sel) <Enter> \
- "tkColorDialog_EnterColorBar $w $color"
+ [list tkColorDialog_EnterColorBar $w $color]
bind $data($color,sel) <Leave> \
- "tkColorDialog_LeaveColorBar $w $color"
-
- bind $box.entry <Return> "tkColorDialog_HandleRGBEntry $w"
+ [list tkColorDialog_LeaveColorBar $w $color]
+
+ bind $box.entry <Return> [list tkColorDialog_HandleRGBEntry $w]
}
pack $stripsFrame -side left -fill both -padx 4 -pady 10
@@ -280,7 +279,7 @@ proc tkColorDialog_BuildDialog {w} {
pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
pack $data(finalCanvas) -expand yes -fill both
- bind $ent <Return> "tkColorDialog_HandleSelEntry $w"
+ bind $ent <Return> [list tkColorDialog_HandleSelEntry $w]
pack $selFrame -side left -fill none -anchor nw
pack $topFrame -side top -expand yes -fill both -anchor nw
@@ -289,9 +288,9 @@ proc tkColorDialog_BuildDialog {w} {
#
set botFrame [frame $w.bot -relief raised -bd 1]
button $botFrame.ok -text OK -width 8 -under 0 \
- -command "tkColorDialog_OkCmd $w"
+ -command [list tkColorDialog_OkCmd $w]
button $botFrame.cancel -text Cancel -width 8 -under 0 \
- -command "tkColorDialog_CancelCmd $w"
+ -command [list tkColorDialog_CancelCmd $w]
set data(okBtn) $botFrame.ok
set data(cancelBtn) $botFrame.cancel
@@ -303,15 +302,15 @@ proc tkColorDialog_BuildDialog {w} {
# Accelerator bindings
- bind $w <Alt-r> "focus $data(red,entry)"
- bind $w <Alt-g> "focus $data(green,entry)"
- bind $w <Alt-b> "focus $data(blue,entry)"
- bind $w <Alt-s> "focus $ent"
- bind $w <KeyPress-Escape> "tkButtonInvoke $data(cancelBtn)"
- bind $w <Alt-c> "tkButtonInvoke $data(cancelBtn)"
- bind $w <Alt-o> "tkButtonInvoke $data(okBtn)"
+ bind $w <Alt-r> [list focus $data(red,entry)]
+ bind $w <Alt-g> [list focus $data(green,entry)]
+ bind $w <Alt-b> [list focus $data(blue,entry)]
+ bind $w <Alt-s> [list focus $ent]
+ bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]
- wm protocol $w WM_DELETE_WINDOW "tkColorDialog_CancelCmd $w"
+ wm protocol $w WM_DELETE_WINDOW [list tkColorDialog_CancelCmd $w]
}
# tkColorDialog_SetRGBValue --
@@ -386,48 +385,47 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} {
# Draw the selection polygons
tkColorDialog_CreateSelector $w $sel $c
$sel bind $data($c,index) <ButtonPress-1> \
- "tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1"
+ [list tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1]
$sel bind $data($c,index) <B1-Motion> \
- "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]
$sel bind $data($c,index) <ButtonRelease-1> \
- "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]
set height [winfo height $col]
# Create an invisible region under the colorstrip to catch mouse clicks
# that aren't on the selector.
set data($c,clickRegion) [$sel create rectangle 0 0 \
- $data(canvasWidth) $height -fill {} -outline {}]
+ $data(canvasWidth) $height -fill {} -outline {}]
bind $col <ButtonPress-1> \
- "tkColorDialog_StartMove $w $sel $c %x $data(colorPad)"
+ [list tkColorDialog_StartMove $w $sel $c %x $data(colorPad)]
bind $col <B1-Motion> \
- "tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)"
+ [list tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)]
bind $col <ButtonRelease-1> \
- "tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)"
+ [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)]
$sel bind $data($c,clickRegion) <ButtonPress-1> \
- "tkColorDialog_StartMove $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_StartMove $w $sel $c %x $data(selPad)]
$sel bind $data($c,clickRegion) <B1-Motion> \
- "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]
$sel bind $data($c,clickRegion) <ButtonRelease-1> \
- "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]
} else {
# l is the canvas index of the first colorbar.
set l $data(lines,$c,start)
}
# Draw the color bars.
- set highlightW [expr \
- {[$col cget -highlightthickness] + [$col cget -bd]}]
+ set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]
for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
set intensity [expr {$i * $data(intensityIncr)}]
set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
- if { $c == "red" } {
+ if {[string equal $c "red"]} {
set color [format "#%02x%02x%02x" \
$intensity \
$data(green,intensity) \
$data(blue,intensity)]
- } elseif { $c == "green" } {
+ } elseif {[string equal $c "green"]} {
set color [format "#%02x%02x%02x" \
$data(red,intensity) \
$intensity \
@@ -488,9 +486,9 @@ proc tkColorDialog_RedrawFinalColor {w} {
set data(finalColor) $color
set data(selection) $color
set data(finalRGB) [list \
- $data(red,intensity) \
- $data(green,intensity) \
- $data(blue,intensity)]
+ $data(red,intensity) \
+ $data(green,intensity) \
+ $data(blue,intensity)]
}
# tkColorDialog_RedrawColorBars --
diff --git a/library/comdlg.tcl b/library/comdlg.tcl
index a8a9fdb..f603a6a 100644
--- a/library/comdlg.tcl
+++ b/library/comdlg.tcl
@@ -3,7 +3,7 @@
# Some functions needed for the common dialog boxes. Probably need to go
# in a different file.
#
-# RCS: @(#) $Id: comdlg.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $
+# RCS: @(#) $Id: comdlg.tcl,v 1.5 1999/09/02 17:02:52 hobbs Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
@@ -100,7 +100,7 @@ proc tclListValidFlags {v} {
# This procedure is used to sort strings in a case-insenstive mode.
#
proc tclSortNoCase {str1 str2} {
- return [string compare [string toupper $str1] [string toupper $str2]]
+ string compare -nocase $str1 $str2
}
@@ -142,9 +142,9 @@ proc tkFocusGroup_Create {t} {
if {![info exists tkPriv(fg,$t)]} {
set tkPriv(fg,$t) 1
set tkPriv(focus,$t) ""
- bind $t <FocusIn> "tkFocusGroup_In $t %W %d"
- bind $t <FocusOut> "tkFocusGroup_Out $t %W %d"
- bind $t <Destroy> "tkFocusGroup_Destroy $t %W"
+ bind $t <FocusIn> [list tkFocusGroup_In $t %W %d]
+ bind $t <FocusOut> [list tkFocusGroup_Out $t %W %d]
+ bind $t <Destroy> [list tkFocusGroup_Destroy $t %W]
}
}
@@ -184,7 +184,7 @@ proc tkFocusGroup_BindOut {t w cmd} {
proc tkFocusGroup_Destroy {t w} {
global tkPriv tkFocusIn tkFocusOut
- if {![string compare $t $w]} {
+ if {[string equal $t $w]} {
unset tkPriv(fg,$t)
unset tkPriv(focus,$t)
@@ -195,10 +195,9 @@ proc tkFocusGroup_Destroy {t w} {
unset tkFocusOut($name)
}
} else {
- if {[info exists tkPriv(focus,$t)]} {
- if {![string compare $tkPriv(focus,$t) $w]} {
- set tkPriv(focus,$t) ""
- }
+ if {[info exists tkPriv(focus,$t)] && \
+ [string equal $tkPriv(focus,$t) $w]} {
+ set tkPriv(focus,$t) ""
}
catch {
unset tkFocusIn($t,$w)
@@ -224,7 +223,7 @@ proc tkFocusGroup_In {t w detail} {
if {![info exists tkPriv(focus,$t)]} {
return
}
- if {![string compare $tkPriv(focus,$t) $w]} {
+ if {[string equal $tkPriv(focus,$t) $w]} {
# This is already in focus
#
return
@@ -286,7 +285,7 @@ proc tkFDGetFileTypes {string} {
set name "$label ("
set sep ""
foreach ext $fileTypes($label) {
- if {![string compare $ext ""]} {
+ if {[string equal $ext ""]} {
continue
}
regsub {^[.]} $ext "*." ext
diff --git a/library/console.tcl b/library/console.tcl
index baf9812..f8ad8ea 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -4,7 +4,7 @@
# can be used by non-unix systems that do not have built-in support
# for shells.
#
-# RCS: @(#) $Id: console.tcl,v 1.6 1999/08/10 15:27:49 hobbs Exp $
+# RCS: @(#) $Id: console.tcl,v 1.7 1999/09/02 17:02:52 hobbs Exp $
#
# Copyright (c) 1998-1999 Scriptics Corp.
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
@@ -31,7 +31,7 @@ proc tkConsoleInit {} {
if {[string compare $tcl_platform(platform) "macintosh"]} {
set mod "Ctrl"
} else {
- set mod "Cmd"
+ set mod "Cmd"
}
menu .menubar
@@ -40,34 +40,34 @@ proc tkConsoleInit {} {
menu .menubar.file -tearoff 0
.menubar.file add command -label "Source..." -underline 0 \
- -command tkConsoleSource
+ -command tkConsoleSource
.menubar.file add command -label "Hide Console" -underline 0 \
- -command {wm withdraw .}
+ -command {wm withdraw .}
if {[string compare $tcl_platform(platform) "macintosh"]} {
.menubar.file add command -label "Exit" -underline 1 -command exit
} else {
- .menubar.file add command -label "Quit" -command exit -accel Cmd-Q
+ .menubar.file add command -label "Quit" -command exit -accel Cmd-Q
}
menu .menubar.edit -tearoff 0
.menubar.edit add command -label "Cut" -underline 2 \
- -command { event generate .console <<Cut>> } -accel "$mod+X"
+ -command { event generate .console <<Cut>> } -accel "$mod+X"
.menubar.edit add command -label "Copy" -underline 0 \
- -command { event generate .console <<Copy>> } -accel "$mod+C"
+ -command { event generate .console <<Copy>> } -accel "$mod+C"
.menubar.edit add command -label "Paste" -underline 1 \
- -command { event generate .console <<Paste>> } -accel "$mod+V"
+ -command { event generate .console <<Paste>> } -accel "$mod+V"
if {[string compare $tcl_platform(platform) "windows"]} {
- .menubar.edit add command -label "Clear" -underline 2 \
- -command { event generate .console <<Clear>> }
+ .menubar.edit add command -label "Clear" -underline 2 \
+ -command { event generate .console <<Clear>> }
} else {
.menubar.edit add command -label "Delete" -underline 0 \
- -command { event generate .console <<Clear>> } -accel "Del"
+ -command { event generate .console <<Clear>> } -accel "Del"
.menubar add cascade -label Help -menu .menubar.help -underline 0
menu .menubar.help -tearoff 0
.menubar.help add command -label "About..." -underline 0 \
- -command tkConsoleAbout
+ -command tkConsoleAbout
}
. configure -menu .menubar
@@ -76,7 +76,7 @@ proc tkConsoleInit {} {
scrollbar .sb -command ".console yview"
pack .sb -side right -fill both
pack .console -fill both -expand 1 -side left
- if {![string compare $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
.console configure -font {Monaco 9 normal} -highlightthickness 0
}
@@ -128,20 +128,20 @@ proc tkConsoleInvoke {args} {
set cmd ""
if {[llength $ranges]} {
set pos 0
- while {[string compare [lindex $ranges $pos] ""]} {
+ while {[string compare [lindex $ranges $pos] ""]} {
set start [lindex $ranges $pos]
set end [lindex $ranges [incr pos]]
append cmd [.console get $start $end]
incr pos
}
}
- if {![string compare $cmd ""]} {
+ if {[string equal $cmd ""]} {
tkConsolePrompt
} elseif {[info complete $cmd]} {
.console mark set output end
.console tag delete input
set result [consoleinterp record $cmd]
- if {[string compare $result ""]} {
+ if {[string compare $result ""]} {
puts $result
}
tkConsoleHistory reset
@@ -190,7 +190,7 @@ proc tkConsoleHistory {cmd} {
} else {
set cmd "history event $histNum"
}
- if {[string compare $cmd ""]} {
+ if {[string compare $cmd ""]} {
catch {consoleinterp eval $cmd} cmd
}
.console delete promptEnd end
@@ -211,7 +211,7 @@ proc tkConsoleHistory {cmd} {
# partial - Flag to specify which prompt to print.
proc tkConsolePrompt {{partial normal}} {
- if {![string compare $partial "normal"]} {
+ if {[string equal $partial "normal"]} {
set temp [.console index "end - 1 char"]
.console mark set output end
if {[consoleinterp eval "info exists tcl_prompt1"]} {
@@ -269,21 +269,17 @@ proc tkConsoleBind {win} {
break
}
bind $win <Delete> {
- if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
+ if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
%W tag remove sel sel.first promptEnd
- } else {
- if {[%W compare insert < promptEnd]} {
- break
- }
+ } elseif {[%W compare insert < promptEnd]} {
+ break
}
}
bind $win <BackSpace> {
- if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
+ if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
%W tag remove sel sel.first promptEnd
- } else {
- if {[%W compare insert <= promptEnd]} {
- break
- }
+ } elseif {[%W compare insert <= promptEnd]} {
+ break
}
}
foreach left {Control-a Home} {
@@ -369,7 +365,7 @@ proc tkConsoleBind {win} {
}
bind $win <F9> {
eval destroy [winfo child .]
- if {![string compare $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
source -rsrc Console
} else {
source [file join $tk_library console.tcl]
@@ -417,7 +413,7 @@ proc tkConsoleBind {win} {
# s - The string to insert (usually just a single character)
proc tkConsoleInsert {w s} {
- if {![string compare $s ""]} {
+ if {[string equal $s ""]} {
return
}
catch {
diff --git a/library/dialog.tcl b/library/dialog.tcl
index be5a81e..b46aa1e 100644
--- a/library/dialog.tcl
+++ b/library/dialog.tcl
@@ -3,7 +3,7 @@
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
-# RCS: @(#) $Id: dialog.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $
+# RCS: @(#) $Id: dialog.tcl,v 1.5 1999/09/02 17:02:52 hobbs Exp $
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -47,13 +47,13 @@ proc tk_dialog {w title text bitmap default args} {
# even though its grab keeps the rest of the application from being used.
wm transient $w [winfo toplevel [winfo parent $w]]
- if {![string compare $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
unsupported1 style $w dBoxProc
}
frame $w.bot
frame $w.top
- if {![string compare $tcl_platform(platform) "unix"]} {
+ if {[string equal $tcl_platform(platform) "unix"]} {
$w.bot configure -relief raised -bd 1
$w.top configure -relief raised -bd 1
}
@@ -65,7 +65,7 @@ proc tk_dialog {w title text bitmap default args} {
# overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
- if {![string compare $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
option add *Dialog.msg.font system widgetDefault
} else {
option add *Dialog.msg.font {Times 18} widgetDefault
@@ -74,7 +74,8 @@ proc tk_dialog {w title text bitmap default args} {
label $w.msg -justify left -text $text
pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
if {[string compare $bitmap ""]} {
- if {![string compare $tcl_platform(platform) "macintosh"] && ![string compare $bitmap "error"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"] && \
+ [string equal $bitmap "error"]} {
set bitmap "stop"
}
label $w.bitmap -bitmap $bitmap
@@ -85,7 +86,7 @@ proc tk_dialog {w title text bitmap default args} {
set i 0
foreach but $args {
- button $w.button$i -text $but -command "set tkPriv(button) $i"
+ button $w.button$i -text $but -command [list set tkPriv(button) $i]
if {$i == $default} {
$w.button$i configure -default active
} else {
@@ -94,10 +95,10 @@ proc tk_dialog {w title text bitmap default args} {
grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10
grid columnconfigure $w.bot $i
# We boost the size of some Mac buttons for l&f
- if {![string compare $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
set tmp [string tolower $but]
- if {![string compare $tmp "ok"] || ![string compare $tmp "cancel"]} {
- grid columnconfigure $w.bot $i -minsize [expr 59 + 20]
+ if {[string equal $tmp "ok"] || [string equal $tmp "cancel"]} {
+ grid columnconfigure $w.bot $i -minsize [expr {59 + 20}]
}
}
incr i
@@ -108,10 +109,10 @@ proc tk_dialog {w title text bitmap default args} {
if {$default >= 0} {
bind $w <Return> "
- [list $w.button$default] configure -state active -relief sunken
- update idletasks
- after 100
- set tkPriv(button) $default
+ [list $w.button$default] configure -state active -relief sunken
+ update idletasks
+ after 100
+ set tkPriv(button) $default
"
}
diff --git a/library/entry.tcl b/library/entry.tcl
index 2bb27c2..72c9ce6 100644
--- a/library/entry.tcl
+++ b/library/entry.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
-# RCS: @(#) $Id: entry.tcl,v 1.7 1999/08/09 16:52:06 hobbs Exp $
+# RCS: @(#) $Id: entry.tcl,v 1.8 1999/09/02 17:02:52 hobbs Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -50,7 +50,7 @@ bind Entry <<Copy>> {
bind Entry <<Paste>> {
global tcl_platform
catch {
- if {[string compare $tcl_platform(platform) "unix"]} {
+ if {[string compare $tcl_platform(platform) "unix"]} {
catch {
%W delete sel.first sel.last
}
@@ -202,7 +202,7 @@ bind Entry <Escape> {# nothing}
bind Entry <Return> {# nothing}
bind Entry <KP_Enter> {# nothing}
bind Entry <Tab> {# nothing}
-if {![string compare $tcl_platform(platform) "macintosh"]} {
+if {[string equal $tcl_platform(platform) "macintosh"]} {
bind Entry <Command-KeyPress> {# nothing}
}
@@ -336,7 +336,7 @@ proc tkEntryButton1 {w x} {
set tkPriv(pressX) $x
$w icursor [tkEntryClosestGap $w $x]
$w selection from insert
- if {![string compare [$w cget -state] "normal"]} {focus $w}
+ if {[string equal [$w cget -state] "normal"]} {focus $w}
}
# tkEntryMouseSelect --
@@ -406,7 +406,7 @@ proc tkEntryPaste {w x} {
$w icursor [tkEntryClosestGap $w $x]
catch {$w insert insert [selection get -displayof $w]}
- if {![string compare [$w cget -state] "normal"]} {focus $w}
+ if {[string equal [$w cget -state] "normal"]} {focus $w}
}
# tkEntryAutoScan --
@@ -463,7 +463,7 @@ proc tkEntryKeySelect {w new} {
# s - The string to insert (usually just a single character)
proc tkEntryInsert {w s} {
- if {![string compare $s ""]} {
+ if {[string equal $s ""]} {
return
}
catch {
@@ -571,7 +571,7 @@ proc tkEntryTranspose w {
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
-if {![string compare $tcl_platform(platform) "windows"]} {
+if {[string equal $tcl_platform(platform) "windows"]} {
proc tkEntryNextWord {w start} {
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos >= 0} {
@@ -617,9 +617,9 @@ proc tkEntryPreviousWord {w start} {
proc tkEntryGetSelection {w} {
set entryString [string range [$w get] [$w index sel.first] \
- [expr [$w index sel.last] - 1]]
- if {[$w cget -show] != ""} {
- regsub -all . $entryString [string index [$w cget -show] 0] entryString
+ [expr {[$w index sel.last] - 1}]]
+ if {[string compare [$w cget -show] ""]} {
+ regsub -all . $entryString [string index [$w cget -show] 0] entryString
}
return $entryString
}
diff --git a/library/focus.tcl b/library/focus.tcl
index 5ece432..b455242 100644
--- a/library/focus.tcl
+++ b/library/focus.tcl
@@ -3,7 +3,7 @@
# This file defines several procedures for managing the input
# focus.
#
-# RCS: @(#) $Id: focus.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $
+# RCS: @(#) $Id: focus.tcl,v 1.5 1999/09/02 17:02:52 hobbs Exp $
#
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
@@ -38,7 +38,7 @@ proc tk_focusNext w {
incr i
if {$i < [llength $children]} {
set cur [lindex $children $i]
- if {![string compare [winfo toplevel $cur] $cur]} {
+ if {[string equal [winfo toplevel $cur] $cur]} {
continue
} else {
break
@@ -50,14 +50,14 @@ proc tk_focusNext w {
# look for its next sibling.
set cur $parent
- if {![string compare [winfo toplevel $cur] $cur]} {
+ if {[string equal [winfo toplevel $cur] $cur]} {
break
}
set parent [winfo parent $parent]
set children [winfo children $parent]
set i [lsearch -exact $children $cur]
}
- if {![string compare $w $cur] || [tkFocusOK $cur]} {
+ if {[string equal $w $cur] || [tkFocusOK $cur]} {
return $cur
}
}
@@ -82,7 +82,7 @@ proc tk_focusPrev w {
# among its siblings. Also, if the window is a top-level,
# then reposition to just after the last child of the window.
- if {![string compare [winfo toplevel $cur] $cur]} {
+ if {[string equal [winfo toplevel $cur] $cur]} {
set parent $cur
set children [winfo children $cur]
set i [llength $children]
@@ -100,7 +100,7 @@ proc tk_focusPrev w {
while {$i > 0} {
incr i -1
set cur [lindex $children $i]
- if {![string compare [winfo toplevel $cur] $cur]} {
+ if {[string equal [winfo toplevel $cur] $cur]} {
continue
}
set parent $cur
@@ -108,7 +108,7 @@ proc tk_focusPrev w {
set i [llength $children]
}
set cur $parent
- if {![string compare $w $cur] || [tkFocusOK $cur]} {
+ if {[string equal $w $cur] || [tkFocusOK $cur]} {
return $cur
}
}
@@ -137,7 +137,7 @@ proc tkFocusOK w {
return [winfo viewable $w]
} else {
set value [uplevel #0 $value $w]
- if {[string compare $value ""]} {
+ if {[string compare $value ""]} {
return $value
}
}
@@ -146,7 +146,7 @@ proc tkFocusOK w {
return 0
}
set code [catch {$w cget -state} value]
- if {($code == 0) && ![string compare $value "disabled"]} {
+ if {($code == 0) && [string equal $value "disabled"]} {
return 0
}
regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
@@ -165,12 +165,12 @@ proc tkFocusOK w {
proc tk_focusFollowsMouse {} {
set old [bind all <Enter>]
set script {
- if {![string compare "%d" "NotifyAncestor"]
- || ![string compare "%d" "NotifyNonlinear"]
- || ![string compare "%d" "NotifyInferior"]} {
- if {[tkFocusOK %W]} {
- focus %W
- }
+ if {[string equal "%d" "NotifyAncestor"] \
+ || [string equal "%d" "NotifyNonlinear"] \
+ || [string equal "%d" "NotifyInferior"]} {
+ if {[tkFocusOK %W]} {
+ focus %W
+ }
}
}
if {[string compare $old ""]} {
diff --git a/library/listbox.tcl b/library/listbox.tcl
index d273a28..341f108 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
-# RCS: @(#) $Id: listbox.tcl,v 1.6 1999/08/09 16:52:06 hobbs Exp $
+# RCS: @(#) $Id: listbox.tcl,v 1.7 1999/09/02 17:02:52 hobbs Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
@@ -136,7 +136,7 @@ bind Listbox <Shift-Control-End> {
tkListboxDataExtend %W [%W index end]
}
bind Listbox <<Copy>> {
- if {![string compare [selection own -displayof %W] "%W"]} {
+ if {[string equal [selection own -displayof %W] "%W"]} {
clipboard clear -displayof %W
clipboard append -displayof %W [selection get -displayof %W]
}
@@ -162,7 +162,7 @@ bind Listbox <Control-slash> {
bind Listbox <Control-backslash> {
if {[string compare [%W cget -selectmode] "browse"]} {
%W selection clear 0 end
- event generate %W <<ListboxSelect>>
+ event generate %W <<ListboxSelect>>
}
}
@@ -197,7 +197,7 @@ bind Listbox <MouseWheel> {
proc tkListboxBeginSelect {w el} {
global tkPriv
- if {![string compare [$w cget -selectmode] "multiple"]} {
+ if {[string equal [$w cget -selectmode] "multiple"]} {
if {[$w selection includes $el]} {
$w selection clear $el
} else {
@@ -280,7 +280,7 @@ proc tkListboxMotion {w el} {
# one under the pointer). Must be in numerical form.
proc tkListboxBeginExtend {w el} {
- if {![string compare [$w cget -selectmode] "extended"]} {
+ if {[string equal [$w cget -selectmode] "extended"]} {
if {[$w selection includes anchor]} {
tkListboxMotion $w $el
} else {
@@ -304,7 +304,7 @@ proc tkListboxBeginExtend {w el} {
proc tkListboxBeginToggle {w el} {
global tkPriv
- if {![string compare [$w cget -selectmode] "extended"]} {
+ if {[string equal [$w cget -selectmode] "extended"]} {
set tkPriv(listboxSelection) [$w curselection]
set tkPriv(listboxPrev) $el
$w selection anchor $el
@@ -313,7 +313,7 @@ proc tkListboxBeginToggle {w el} {
} else {
$w selection set $el
}
- event generate $w <<ListboxSelect>>
+ event generate $w <<ListboxSelect>>
}
}
@@ -365,7 +365,7 @@ proc tkListboxUpDown {w amount} {
browse {
$w selection clear 0 end
$w selection set active
- event generate $w <<ListboxSelect>>
+ event generate $w <<ListboxSelect>>
}
extended {
$w selection clear 0 end
@@ -373,7 +373,7 @@ proc tkListboxUpDown {w amount} {
$w selection anchor active
set tkPriv(listboxPrev) [$w index active]
set tkPriv(listboxSelection) {}
- event generate $w <<ListboxSelect>>
+ event generate $w <<ListboxSelect>>
}
}
}
@@ -410,13 +410,13 @@ proc tkListboxExtendUpDown {w amount} {
proc tkListboxDataExtend {w el} {
set mode [$w cget -selectmode]
- if {![string compare $mode "extended"]} {
+ if {[string equal $mode "extended"]} {
$w activate $el
$w see $el
if {[$w selection includes anchor]} {
tkListboxMotion $w $el
}
- } elseif {![string compare $mode "multiple"]} {
+ } elseif {[string equal $mode "multiple"]} {
$w activate $el
$w see $el
}
@@ -465,7 +465,7 @@ proc tkListboxCancel w {
proc tkListboxSelectAll w {
set mode [$w cget -selectmode]
- if {![string compare $mode "single"] || ![string compare $mode "browse"]} {
+ if {[string equal $mode "single"] || [string equal $mode "browse"]} {
$w selection clear 0 end
$w selection set active
} else {
diff --git a/library/menu.tcl b/library/menu.tcl
index 6c4e153..2c2c751 100644
--- a/library/menu.tcl
+++ b/library/menu.tcl
@@ -4,7 +4,7 @@
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
-# RCS: @(#) $Id: menu.tcl,v 1.7 1999/07/22 16:31:48 redman Exp $
+# RCS: @(#) $Id: menu.tcl,v 1.8 1999/09/02 17:02:52 hobbs Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -119,9 +119,9 @@ bind Menu <FocusIn> {}
bind Menu <Enter> {
set tkPriv(window) %W
- if {![string compare [%W cget -type] "tearoff"]} {
- if {[string compare "%m" "NotifyUngrab"]} {
- if {![string compare $tcl_platform(platform) "unix"]} {
+ if {[string equal [%W cget -type] "tearoff"]} {
+ if {[string compare "%m" "NotifyUngrab"]} {
+ if {[string equal $tcl_platform(platform) "unix"]} {
tk_menuSetFocus %W
}
}
@@ -169,7 +169,7 @@ bind Menu <KeyPress> {
# The following bindings apply to all windows, and are used to
# implement keyboard menu traversal.
-if {![string compare $tcl_platform(platform) "unix"]} {
+if {[string equal $tcl_platform(platform) "unix"]} {
bind all <Alt-KeyPress> {
tkTraverseToMenu %W %A
}
@@ -222,7 +222,7 @@ proc tkMbLeave w {
if {![winfo exists $w]} {
return
}
- if {![string compare [$w cget -state] "active"]} {
+ if {[string equal [$w cget -state] "active"]} {
$w configure -state normal
}
}
@@ -243,16 +243,16 @@ proc tkMbPost {w {x {}} {y {}}} {
global tkPriv errorInfo
global tcl_platform
- if {![string compare [$w cget -state] "disabled"] ||
- ![string compare $w $tkPriv(postedMb)]} {
+ if {[string equal [$w cget -state] "disabled"] || \
+ [string equal $w $tkPriv(postedMb)]} {
return
}
set menu [$w cget -menu]
- if {![string compare $menu ""]} {
+ if {[string equal $menu ""]} {
return
}
- set tearoff [expr {![string compare $tcl_platform(platform) "unix"] \
- || ![string compare [$menu cget -type] "tearoff"]}]
+ set tearoff [expr {[string equal $tcl_platform(platform) "unix"] \
+ || [string equal [$menu cget -type] "tearoff"]}]
if {[string first $w $menu] != 0} {
error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
}
@@ -276,7 +276,7 @@ proc tkMbPost {w {x {}} {y {}}} {
update idletasks
if {[catch {
- switch [$w cget -direction] {
+ switch [$w cget -direction] {
above {
set x [winfo rootx $w]
set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
@@ -301,7 +301,7 @@ proc tkMbPost {w {x {}} {y {}}} {
}
}
$menu post $x $y
- if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
+ if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
$menu activate $entry
tkGenerateMenuSelect $menu
}
@@ -320,14 +320,14 @@ proc tkMbPost {w {x {}} {y {}}} {
}
}
$menu post $x $y
- if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
+ if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
$menu activate $entry
tkGenerateMenuSelect $menu
}
}
default {
if {[$w cget -indicatoron]} {
- if {![string compare $y {}]} {
+ if {[string equal $y {}]} {
set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
}
@@ -336,8 +336,8 @@ proc tkMbPost {w {x {}} {y {}}} {
$menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
}
}
- }
- } msg]} {
+ }
+ } msg]} {
# Error posting menu (e.g. bogus -postcommand). Unpost it and
# reflect the error.
@@ -387,17 +387,17 @@ proc tkMenuUnpost menu {
# what was posted.
catch {
- if {[string compare $mb ""]} {
+ if {[string compare $mb ""]} {
set menu [$mb cget -menu]
$menu unpost
set tkPriv(postedMb) {}
$mb configure -cursor $tkPriv(cursor)
$mb configure -relief $tkPriv(relief)
- } elseif {[string compare $tkPriv(popup) ""]} {
+ } elseif {[string compare $tkPriv(popup) ""]} {
$tkPriv(popup) unpost
set tkPriv(popup) {}
- } elseif {[string compare [$menu cget -type] "menubar"]
- && [string compare [$menu cget -type] "tearoff"]} {
+ } elseif {[string compare [$menu cget -type] "menubar"] \
+ && [string compare [$menu cget -type] "tearoff"]} {
# We're in a cascaded sub-menu from a torn-off menu or popup.
# Unpost all the menus up to the toplevel one (but not
# including the top-level torn-off one) and deactivate the
@@ -405,7 +405,7 @@ proc tkMenuUnpost menu {
while 1 {
set parent [winfo parent $menu]
- if {[string compare [winfo class $parent] "Menu"]
+ if {[string compare [winfo class $parent] "Menu"] \
|| ![winfo ismapped $parent]} {
break
}
@@ -413,13 +413,13 @@ proc tkMenuUnpost menu {
$parent postcascade none
tkGenerateMenuSelect $parent
set type [$parent cget -type]
- if {![string compare $type "menubar"] ||
- ![string compare $type "tearoff"]} {
+ if {[string equal $type "menubar"] || \
+ [string equal $type "tearoff"]} {
break
}
set menu $parent
}
- if {[string compare [$menu cget -type] "menubar"]} {
+ if {[string compare [$menu cget -type] "menubar"]} {
$menu unpost
}
}
@@ -428,18 +428,18 @@ proc tkMenuUnpost menu {
if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) ""]} {
# Release grab, if any, and restore the previous grab, if there
# was one.
- if {[string compare $menu ""]} {
+ if {[string compare $menu ""]} {
set grab [grab current $menu]
- if {[string compare $grab ""]} {
+ if {[string compare $grab ""]} {
grab release $grab
}
}
tkRestoreOldGrab
- if {[string compare $tkPriv(menuBar) ""]} {
+ if {[string compare $tkPriv(menuBar) ""]} {
$tkPriv(menuBar) configure -cursor $tkPriv(cursor)
set tkPriv(menuBar) {}
}
- if {[string compare $tcl_platform(platform) "unix"]} {
+ if {[string compare $tcl_platform(platform) "unix"]} {
set tkPriv(tearoff) 0
}
}
@@ -459,21 +459,21 @@ proc tkMenuUnpost menu {
proc tkMbMotion {w upDown rootx rooty} {
global tkPriv
- if {![string compare $tkPriv(inMenubutton) $w]} {
+ if {[string equal $tkPriv(inMenubutton) $w]} {
return
}
set new [winfo containing $rootx $rooty]
- if {[string compare $new $tkPriv(inMenubutton)]
- && (![string compare $new ""]
- || ![string compare [winfo toplevel $new] [winfo toplevel $w]])} {
- if {[string compare $tkPriv(inMenubutton) ""]} {
+ if {[string compare $new $tkPriv(inMenubutton)] \
+ && ([string equal $new ""] \
+ || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {
+ if {[string compare $tkPriv(inMenubutton) ""]} {
tkMbLeave $tkPriv(inMenubutton)
}
- if {[string compare $new ""]
- && ![string compare [winfo class $new] "Menubutton"]
- && ([$new cget -indicatoron] == 0)
+ if {[string compare $new ""] \
+ && [string equal [winfo class $new] "Menubutton"] \
+ && ([$new cget -indicatoron] == 0) \
&& ([$w cget -indicatoron] == 0)} {
- if {![string compare $upDown "down"]} {
+ if {[string equal $upDown "down"]} {
tkMbPost $new $rootx $rooty
} else {
tkMbEnter $new
@@ -495,10 +495,11 @@ proc tkMbButtonUp w {
global tcl_platform
set menu [$w cget -menu]
- set tearoff [expr {($tcl_platform(platform) == "unix") \
- || (($menu != {}) && ([$menu cget -type] == "tearoff"))}]
- if {($tearoff != 0) && ($tkPriv(postedMb) == $w)
- && ($tkPriv(inMenubutton) == $w)} {
+ set tearoff [expr {[string equal $tcl_platform(platform) "unix"] || \
+ ([string compare $menu {}] && \
+ [string equal [$menu cget -type] "tearoff"])}]
+ if {($tearoff != 0) && [string equal $tkPriv(postedMb) $w] \
+ && [string equal $tkPriv(inMenubutton) $w]} {
tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]
} else {
tkMenuUnpost {}
@@ -520,10 +521,10 @@ proc tkMbButtonUp w {
proc tkMenuMotion {menu x y state} {
global tkPriv
- if {![string compare $menu $tkPriv(window)]} {
- if {![string compare [$menu cget -type] "menubar"]} {
+ if {[string equal $menu $tkPriv(window)]} {
+ if {[string equal [$menu cget -type] "menubar"]} {
if {[info exists tkPriv(focus)] && \
- [string compare $menu $tkPriv(focus)]} {
+ [string compare $menu $tkPriv(focus)]} {
$menu activate @$x,$y
tkGenerateMenuSelect $menu
}
@@ -563,13 +564,13 @@ proc tkMenuButtonDown menu {
if {[string compare $tkPriv(postedMb) ""]} {
grab -global $tkPriv(postedMb)
} else {
- while {![string compare [$menu cget -type] "normal"]
- && ![string compare [winfo class [winfo parent $menu]] "Menu"]
+ while {[string equal [$menu cget -type] "normal"] \
+ && [string equal [winfo class [winfo parent $menu]] "Menu"] \
&& [winfo ismapped [winfo parent $menu]]} {
set menu [winfo parent $menu]
}
- if {![string compare $tkPriv(menuBar) {}]} {
+ if {[string equal $tkPriv(menuBar) {}]} {
set tkPriv(menuBar) $menu
set tkPriv(cursor) [$menu cget -cursor]
$menu configure -cursor arrow
@@ -580,14 +581,14 @@ proc tkMenuButtonDown menu {
# restore the grab, since the old grab window will not be viewable
# anymore.
- if {[string compare $menu [grab current $menu]]} {
+ if {[string compare $menu [grab current $menu]]} {
tkSaveGrabInfo $menu
}
# Must re-grab even if the grab window hasn't changed, in order
# to release the implicit grab from the button press.
- if {![string compare $tcl_platform(platform) "unix"]} {
+ if {[string equal $tcl_platform(platform) "unix"]} {
grab -global $menu
}
}
@@ -606,11 +607,11 @@ proc tkMenuButtonDown menu {
proc tkMenuLeave {menu rootx rooty state} {
global tkPriv
set tkPriv(window) {}
- if {![string compare [$menu index active] "none"]} {
+ if {[string equal [$menu index active] "none"]} {
return
}
- if {![string compare [$menu type active] "cascade"]
- && ![string compare [winfo containing $rootx $rooty] \
+ if {[string equal [$menu type active] "cascade"]
+ && [string equal [winfo containing $rootx $rooty] \
[$menu entrycget active -menu]]} {
return
}
@@ -631,7 +632,7 @@ proc tkMenuLeave {menu rootx rooty state} {
proc tkMenuInvoke {w buttonRelease} {
global tkPriv
- if {$buttonRelease && ![string compare $tkPriv(window) {}]} {
+ if {$buttonRelease && [string equal $tkPriv(window) {}]} {
# Mouse was pressed over a menu without a menu button, then
# dragged off the menu (possibly with a cascade posted) and
# released. Unpost everything and quit.
@@ -642,14 +643,14 @@ proc tkMenuInvoke {w buttonRelease} {
tkMenuUnpost $w
return
}
- if {![string compare [$w type active] "cascade"]} {
+ if {[string equal [$w type active] "cascade"]} {
$w postcascade active
set menu [$w entrycget active -menu]
tkMenuFirstEntry $menu
- } elseif {![string compare [$w type active] "tearoff"]} {
+ } elseif {[string equal [$w type active] "tearoff"]} {
tkMenuUnpost $w
tkTearOffMenu $w
- } elseif {![string compare [$w cget -type] "menubar"]} {
+ } elseif {[string equal [$w cget -type] "menubar"]} {
$w postcascade none
$w activate none
event generate $w <<MenuSelect>>
@@ -672,7 +673,7 @@ proc tkMenuEscape menu {
set parent [winfo parent $menu]
if {[string compare [winfo class $parent] "Menu"]} {
tkMenuUnpost $menu
- } elseif {![string compare [$parent cget -type] "menubar"]} {
+ } elseif {[string equal [$parent cget -type] "menubar"]} {
tkMenuUnpost $menu
tkRestoreOldGrab
} else {
@@ -684,7 +685,7 @@ proc tkMenuEscape menu {
# differently depending on whether the menu is a menu bar or not.
proc tkMenuUpArrow {menu} {
- if {![string compare [$menu cget -type] "menubar"]} {
+ if {[string equal [$menu cget -type] "menubar"]} {
tkMenuNextMenu $menu left
} else {
tkMenuNextEntry $menu -1
@@ -692,7 +693,7 @@ proc tkMenuUpArrow {menu} {
}
proc tkMenuDownArrow {menu} {
- if {![string compare [$menu cget -type] "menubar"]} {
+ if {[string equal [$menu cget -type] "menubar"]} {
tkMenuNextMenu $menu right
} else {
tkMenuNextEntry $menu 1
@@ -700,7 +701,7 @@ proc tkMenuDownArrow {menu} {
}
proc tkMenuLeftArrow {menu} {
- if {![string compare [$menu cget -type] "menubar"]} {
+ if {[string equal [$menu cget -type] "menubar"]} {
tkMenuNextEntry $menu -1
} else {
tkMenuNextMenu $menu left
@@ -708,7 +709,7 @@ proc tkMenuLeftArrow {menu} {
}
proc tkMenuRightArrow {menu} {
- if {![string compare [$menu cget -type] "menubar"]} {
+ if {[string equal [$menu cget -type] "menubar"]} {
tkMenuNextEntry $menu 1
} else {
tkMenuNextMenu $menu right
@@ -730,22 +731,22 @@ proc tkMenuNextMenu {menu direction} {
# First handle traversals into and out of cascaded menus.
- if {![string compare $direction "right"]} {
+ if {[string equal $direction "right"]} {
set count 1
set parent [winfo parent $menu]
set class [winfo class $parent]
- if {![string compare [$menu type active] "cascade"]} {
+ if {[string equal [$menu type active] "cascade"]} {
$menu postcascade active
set m2 [$menu entrycget active -menu]
- if {[string compare $m2 ""]} {
+ if {[string compare $m2 ""]} {
tkMenuFirstEntry $m2
}
return
} else {
set parent [winfo parent $menu]
- while {[string compare $parent "."]} {
- if {![string compare [winfo class $parent] "Menu"]
- && ![string compare [$parent cget -type] "menubar"]} {
+ while {[string compare $parent "."]} {
+ if {[string equal [winfo class $parent] "Menu"] \
+ && [string equal [$parent cget -type] "menubar"]} {
tk_menuSetFocus $parent
tkMenuNextEntry $parent 1
return
@@ -756,8 +757,8 @@ proc tkMenuNextMenu {menu direction} {
} else {
set count -1
set m2 [winfo parent $menu]
- if {![string compare [winfo class $m2] "Menu"]} {
- if {[string compare [$m2 cget -type] "menubar"]} {
+ if {[string equal [winfo class $m2] "Menu"]} {
+ if {[string compare [$m2 cget -type] "menubar"]} {
$menu activate none
tkGenerateMenuSelect $menu
tk_menuSetFocus $m2
@@ -776,8 +777,8 @@ proc tkMenuNextMenu {menu direction} {
# or previous menubutton, if that makes sense.
set m2 [winfo parent $menu]
- if {![string compare [winfo class $m2] "Menu"]} {
- if {![string compare [$m2 cget -type] "menubar"]} {
+ if {[string equal [winfo class $m2] "Menu"]} {
+ if {[string equal [$m2 cget -type] "menubar"]} {
tk_menuSetFocus $m2
tkMenuNextEntry $m2 -1
return
@@ -785,7 +786,7 @@ proc tkMenuNextMenu {menu direction} {
}
set w $tkPriv(postedMb)
- if {![string compare $w ""]} {
+ if {[string equal $w ""]} {
return
}
set buttons [winfo children [winfo parent $w]]
@@ -799,13 +800,13 @@ proc tkMenuNextMenu {menu direction} {
incr i -$length
}
set mb [lindex $buttons $i]
- if {![string compare [winfo class $mb] "Menubutton"]
- && [string compare [$mb cget -state] "disabled"]
- && [string compare [$mb cget -menu] ""]
- && [string compare [[$mb cget -menu] index last] "none"]} {
+ if {[string equal [winfo class $mb] "Menubutton"] \
+ && [string compare [$mb cget -state] "disabled"] \
+ && [string compare [$mb cget -menu] ""] \
+ && [string compare [[$mb cget -menu] index last] "none"]} {
break
}
- if {![string compare $mb $w]} {
+ if {[string equal $mb $w]} {
return
}
incr i $count
@@ -826,13 +827,13 @@ proc tkMenuNextMenu {menu direction} {
proc tkMenuNextEntry {menu count} {
global tkPriv
- if {![string compare [$menu index last] "none"]} {
+ if {[string equal [$menu index last] "none"]} {
return
}
set length [expr {[$menu index last]+1}]
set quitAfter $length
set active [$menu index active]
- if {![string compare $active "none"]} {
+ if {[string equal $active "none"]} {
set i 0
} else {
set i [expr {$active + $count}]
@@ -851,7 +852,7 @@ proc tkMenuNextEntry {menu count} {
incr i -$length
}
if {[catch {$menu entrycget $i -state} state] == 0} {
- if {$state != "disabled"} {
+ if {[string compare $state "disabled"]} {
break
}
}
@@ -863,9 +864,12 @@ proc tkMenuNextEntry {menu count} {
}
$menu activate $i
tkGenerateMenuSelect $menu
- if {![string compare [$menu type $i] "cascade"]} {
+ if {[string equal [$menu type $i] "cascade"]} {
set cascade [$menu entrycget $i -menu]
- if {[string compare $cascade ""]} {
+ if {[string compare $cascade ""]} {
+ # Here we auto-post a cascade. This is necessary when
+ # we traverse left/right in the menubar, but undesirable when
+ # we traverse up/down in a menu.
$menu postcascade $i
tkMenuFirstEntry $cascade
}
@@ -895,29 +899,27 @@ proc tkMenuFind {w char} {
foreach child $windowlist {
# Don't descend into other toplevels.
- if {[winfo toplevel [focus]] != [winfo toplevel $child] } {
+ if {[string compare [winfo toplevel [focus]] \
+ [winfo toplevel $child]]} {
continue
}
- switch [winfo class $child] {
- Menu {
- if {![string compare [$child cget -type] "menubar"]} {
- if {![string compare $char ""]} {
+ if {[string equal [winfo class $child] "Menu"] && \
+ [string equal [$child cget -type] "menubar"]} {
+ if {[string equal $char ""]} {
+ return $child
+ }
+ set last [$child index last]
+ for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
+ if {[string equal [$child type $i] "separator"]} {
+ continue
+ }
+ set char2 [string index [$child entrycget $i -label] \
+ [$child entrycget $i -underline]]
+ if {[string equal $char [string tolower $char2]] \
+ || [string equal $char ""]} {
+ if {[string compare [$child entrycget $i -state] "disabled"]} {
return $child
}
- set last [$child index last]
- for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
- if {![string compare [$child type $i] "separator"]} {
- continue
- }
- set char2 [string index [$child entrycget $i -label] \
- [$child entrycget $i -underline]]
- if {![string compare $char [string tolower $char2]] \
- || ![string compare $char ""]} {
- if {[string compare [$child entrycget $i -state] "disabled"]} {
- return $child
- }
- }
- }
}
}
}
@@ -925,16 +927,17 @@ proc tkMenuFind {w char} {
foreach child $windowlist {
# Don't descend into other toplevels.
- if {[winfo toplevel [focus]] != [winfo toplevel $child] } {
+ if {[string compare [winfo toplevel [focus]] \
+ [winfo toplevel $child]]} {
continue
}
switch [winfo class $child] {
Menubutton {
set char2 [string index [$child cget -text] \
[$child cget -underline]]
- if {![string compare $char [string tolower $char2]]
- || ![string compare $char ""]} {
- if {[string compare [$child cget -state] "disabled"]} {
+ if {[string equal $char [string tolower $char2]] \
+ || [string equal $char ""]} {
+ if {[string compare [$child cget -state] "disabled"]} {
return $child
}
}
@@ -942,7 +945,7 @@ proc tkMenuFind {w char} {
default {
set match [tkMenuFind $child $char]
- if {[string compare $match ""]} {
+ if {[string compare $match ""]} {
return $match
}
}
@@ -965,22 +968,22 @@ proc tkMenuFind {w char} {
proc tkTraverseToMenu {w char} {
global tkPriv
- if {![string compare $char ""]} {
+ if {[string equal $char ""]} {
return
}
- while {![string compare [winfo class $w] "Menu"]} {
- if {[string compare [$w cget -type] "menubar"]
- && ![string compare $tkPriv(postedMb) ""]} {
+ while {[string equal [winfo class $w] "Menu"]} {
+ if {[string compare [$w cget -type] "menubar"] \
+ && [string equal $tkPriv(postedMb) ""]} {
return
}
- if {![string compare [$w cget -type] "menubar"]} {
+ if {[string equal [$w cget -type] "menubar"]} {
break
}
set w [winfo parent $w]
}
set w [tkMenuFind [winfo toplevel $w] $char]
if {[string compare $w ""]} {
- if {![string compare [winfo class $w] "Menu"]} {
+ if {[string equal [winfo class $w] "Menu"]} {
tk_menuSetFocus $w
set tkPriv(window) $w
tkSaveGrabInfo $w
@@ -1004,7 +1007,7 @@ proc tkTraverseToMenu {w char} {
proc tkFirstMenu w {
set w [tkMenuFind [winfo toplevel $w] ""]
if {[string compare $w ""]} {
- if {![string compare [winfo class $w] "Menu"]} {
+ if {[string equal [winfo class $w] "Menu"]} {
tk_menuSetFocus $w
set tkPriv(window) $w
tkSaveGrabInfo $w
@@ -1029,27 +1032,26 @@ proc tkFirstMenu w {
# nothing happens.
proc tkTraverseWithinMenu {w char} {
- if {![string compare $char ""]} {
+ if {[string equal $char ""]} {
return
}
set char [string tolower $char]
set last [$w index last]
- if {![string compare $last "none"]} {
+ if {[string equal $last "none"]} {
return
}
for {set i 0} {$i <= $last} {incr i} {
if {[catch {set char2 [string index \
- [$w entrycget $i -label] \
- [$w entrycget $i -underline]]}]} {
+ [$w entrycget $i -label] [$w entrycget $i -underline]]}]} {
continue
}
- if {![string compare $char [string tolower $char2]]} {
- if {![string compare [$w type $i] "cascade"]} {
+ if {[string equal $char [string tolower $char2]]} {
+ if {[string equal [$w type $i] "cascade"]} {
$w activate $i
$w postcascade active
event generate $w <<MenuSelect>>
set m2 [$w entrycget $i -menu]
- if {[string compare $m2 ""]} {
+ if {[string compare $m2 ""]} {
tkMenuFirstEntry $m2
}
} else {
@@ -1073,7 +1075,7 @@ proc tkTraverseWithinMenu {w char} {
# menu - Name of the menu window (possibly empty).
proc tkMenuFirstEntry menu {
- if {![string compare $menu ""]} {
+ if {[string equal $menu ""]} {
return
}
tk_menuSetFocus $menu
@@ -1081,18 +1083,18 @@ proc tkMenuFirstEntry menu {
return
}
set last [$menu index last]
- if {![string compare $last "none"]} {
+ if {[string equal $last "none"]} {
return
}
for {set i 0} {$i <= $last} {incr i} {
- if {([catch {set state [$menu entrycget $i -state]}] == 0)
- && [string compare $state "disabled"]
- && [string compare [$menu type $i] "tearoff"]} {
+ if {([catch {set state [$menu entrycget $i -state]}] == 0) \
+ && [string compare $state "disabled"] \
+ && [string compare [$menu type $i] "tearoff"]} {
$menu activate $i
tkGenerateMenuSelect $menu
- if {![string compare [$menu type $i] "cascade"]} {
+ if {[string equal [$menu type $i] "cascade"]} {
set cascade [$menu entrycget $i -menu]
- if {[string compare $cascade ""]} {
+ if {[string compare $cascade ""]} {
$menu postcascade $i
tkMenuFirstEntry $cascade
}
@@ -1120,12 +1122,12 @@ proc tkMenuFindName {menu s} {
return $i
}
set last [$menu index last]
- if {![string compare $last "none"]} {
+ if {[string equal $last "none"]} {
return
}
for {set i 0} {$i <= $last} {incr i} {
if {![catch {$menu entrycget $i -label} label]} {
- if {![string compare $label $s]} {
+ if {[string equal $label $s]} {
return $i
}
}
@@ -1159,8 +1161,8 @@ proc tkPostOverPoint {menu x y {entry {}}} {
incr x [expr {-[winfo reqwidth $menu]/2}]
}
$menu post $x $y
- if {[string compare $entry {}]
- && [string compare [$menu entrycget $entry -state] "disabled"]} {
+ if {[string compare $entry {}] \
+ && [string compare [$menu entrycget $entry -state] "disabled"]} {
$menu activate $entry
tkGenerateMenuSelect $menu
}
@@ -1195,7 +1197,7 @@ proc tkRestoreOldGrab {} {
# be visible anymore.
catch {
- if {![string compare $tkPriv(grabStatus) "global"]} {
+ if {[string equal $tkPriv(grabStatus) "global"]} {
grab set -global $tkPriv(oldGrab)
} else {
grab set $tkPriv(oldGrab)
@@ -1207,7 +1209,7 @@ proc tkRestoreOldGrab {} {
proc tk_menuSetFocus {menu} {
global tkPriv
- if {![info exists tkPriv(focus)] || ![string compare $tkPriv(focus) {}]} {
+ if {![info exists tkPriv(focus)] || [string equal $tkPriv(focus) {}]} {
set tkPriv(focus) [focus]
}
focus $menu
@@ -1216,8 +1218,8 @@ proc tk_menuSetFocus {menu} {
proc tkGenerateMenuSelect {menu} {
global tkPriv
- if {![string compare $tkPriv(activeMenu) $menu] \
- && ![string compare $tkPriv(activeItem) [$menu index active]]} {
+ if {[string equal $tkPriv(activeMenu) $menu] \
+ && [string equal $tkPriv(activeItem) [$menu index active]]} {
return
}
@@ -1241,12 +1243,12 @@ proc tkGenerateMenuSelect {menu} {
proc tk_popup {menu x y {entry {}}} {
global tkPriv
global tcl_platform
- if {[string compare $tkPriv(popup) ""]
- || [string compare $tkPriv(postedMb) ""]} {
+ if {[string compare $tkPriv(popup) ""] \
+ || [string compare $tkPriv(postedMb) ""]} {
tkMenuUnpost {}
}
tkPostOverPoint $menu $x $y $entry
- if {![string compare $tcl_platform(platform) "unix"] \
+ if {[string equal $tcl_platform(platform) "unix"] \
&& [winfo viewable $menu]} {
tkSaveGrabInfo $menu
grab -global $menu
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index ea04e86..2497a47 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.5 1999/04/16 01:51:26 stanton Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.6 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
@@ -51,11 +51,11 @@ proc tkMessageBox {args} {
if {[lsearch {info warning error question} $data(-icon)] == -1} {
error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
}
- if {![string compare $tcl_platform(platform) "macintosh"]} {
- switch -- $data(-icon) {
- "error" {set data(-icon) "stop"}
- "warning" {set data(-icon) "caution"}
- "info" {set data(-icon) "note"}
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
+ switch -- $data(-icon) {
+ "error" {set data(-icon) "stop"}
+ "warning" {set data(-icon) "caution"}
+ "info" {set data(-icon) "note"}
}
}
@@ -75,7 +75,7 @@ proc tkMessageBox {args} {
set buttons {
{ok -width 6 -text OK -under 0}
}
- if {![string compare $data(-default) ""]} {
+ if {[string equal $data(-default) ""]} {
set data(-default) "ok"
}
}
@@ -112,7 +112,7 @@ proc tkMessageBox {args} {
if {[string compare $data(-default) ""]} {
set valid 0
foreach btn $buttons {
- if {![string compare [lindex $btn 0] $data(-default)]} {
+ if {[string equal [lindex $btn 0] $data(-default)]} {
set valid 1
break
}
@@ -140,7 +140,7 @@ proc tkMessageBox {args} {
wm iconname $w Dialog
wm protocol $w WM_DELETE_WINDOW { }
wm transient $w $data(-parent)
- if {![string compare $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
unsupported1 style $w dBoxProc
}
@@ -158,7 +158,7 @@ proc tkMessageBox {args} {
# overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
- if {![string compare $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
option add *Dialog.msg.font system widgetDefault
} else {
option add *Dialog.msg.font {Times 18} widgetDefault
@@ -177,36 +177,49 @@ proc tkMessageBox {args} {
foreach but $buttons {
set name [lindex $but 0]
set opts [lrange $but 1 end]
- if {![llength $opts]} {
+ if {![llength $opts]} {
# Capitalize the first letter of $name
- set capName [string toupper \
- [string index $name 0]][string range $name 1 end]
+ set capName [string toupper $name 0]
set opts [list -text $capName]
}
- eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
+ eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
- if {![string compare $name $data(-default)]} {
+ if {[string equal $name $data(-default)]} {
$w.$name configure -default active
}
- pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
+ pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
# create the binding for the key accelerator, based on the underline
#
set underIdx [$w.$name cget -under]
if {$underIdx >= 0} {
set key [string index [$w.$name cget -text] $underIdx]
- bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
- bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
+ bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
+ bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
}
incr i
}
- # 6. Create a binding for <Return> on the dialog if there is a
- # default button.
+ if {[string compare {} $data(-default)]} {
+ bind $w <FocusIn> {
+ if {[string equal Button [winfo class %W]]} {
+ %W configure -default active
+ }
+ }
+ bind $w <FocusOut> {
+ if {[string equal Button [winfo class %W]]} {
+ %W configure -default normal
+ }
+ }
+ }
- if {[string compare $data(-default) ""]} {
- bind $w <Return> [list tkButtonInvoke $w.$data(-default)]
+ # 6. Create a binding for <Return> on the dialog
+
+ bind $w <Return> {
+ if {[string equal Button [winfo class %W]]} {
+ tkButtonInvoke %W
+ }
}
# 7. Withdraw the window, then update all the geometry information
@@ -246,7 +259,7 @@ proc tkMessageBox {args} {
catch {focus $oldFocus}
destroy $w
if {[string compare $oldGrab ""]} {
- if {![string compare $grabStatus "global"]} {
+ if {[string equal $grabStatus "global"]} {
grab -global $oldGrab
} else {
grab $oldGrab
diff --git a/library/palette.tcl b/library/palette.tcl
index 45000b0..de34604 100644
--- a/library/palette.tcl
+++ b/library/palette.tcl
@@ -3,7 +3,7 @@
# This file contains procedures that change the color palette used
# by Tk.
#
-# RCS: @(#) $Id: palette.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $
+# RCS: @(#) $Id: palette.tcl,v 1.5 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
#
@@ -24,6 +24,11 @@
# for the option database, such as activeForeground, not -activeforeground.
proc tk_setPalette {args} {
+ if {[winfo depth .] == 1} {
+ # Just return on monochrome displays, otherwise errors will occur
+ return
+ }
+
global tkPalette
# Create an array that has the complete new palette. If some colors
@@ -95,8 +100,8 @@ proc tk_setPalette {args} {
# defaults are currently for this platform.
toplevel .___tk_set_palette
wm withdraw .___tk_set_palette
- foreach q {button canvas checkbutton entry frame label listbox menubutton menu message \
- radiobutton scale scrollbar text} {
+ foreach q {button canvas checkbutton entry frame label listbox \
+ menubutton menu message radiobutton scale scrollbar text} {
$q .___tk_set_palette.$q
}
@@ -188,10 +193,10 @@ proc tkRecolorTree {w colors} {
proc tkDarken {color percent} {
foreach {red green blue} [winfo rgb . $color] {
- set red [expr {($red/256)*$percent/100}]
- set green [expr {($green/256)*$percent/100}]
- set blue [expr {($blue/256)*$percent/100}]
- break
+ set red [expr {($red/256)*$percent/100}]
+ set green [expr {($green/256)*$percent/100}]
+ set blue [expr {($blue/256)*$percent/100}]
+ break
}
if {$red > 255} {
set red 255
diff --git a/library/safetk.tcl b/library/safetk.tcl
index 0ceaebe..e732932 100644
--- a/library/safetk.tcl
+++ b/library/safetk.tcl
@@ -2,7 +2,7 @@
#
# Support procs to use Tk in safe interpreters.
#
-# RCS: @(#) $Id: safetk.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $
+# RCS: @(#) $Id: safetk.tcl,v 1.5 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
@@ -48,7 +48,7 @@ namespace eval ::safe {
# of the more conventional findInAccessPath.
# Might be usefull for masters without Tk really loaded too.
::interp eval $slave [list set tk_library [::safe::interpAddToAccessPath $slave $tk_library]]
- return $slave;
+ return $slave
}
@@ -86,11 +86,11 @@ proc ::safe::loadTk {} {}
# create a decorated toplevel
- ::tcl::Lassign [tkTopLevel $slave $display] w use;
-
+ ::tcl::Lassign [tkTopLevel $slave $display] w use
+
# set our delete hook (slave arg is added by interpDelete)
# to clean up both window related code and tkInit(slave)
- Set [DeleteHookName $slave] [list tkDelete {} $w];
+ Set [DeleteHookName $slave] [list tkDelete {} $w]
} else {
@@ -205,15 +205,15 @@ proc ::safe::tkDelete {W window slave} {
# we are going to be called for each widget... skip untill it's
# top level
- Log $slave "Called tkDelete $W $window" NOTICE;
+ Log $slave "Called tkDelete $W $window" NOTICE
if {[::interp exists $slave]} {
if {[catch {::safe::interpDelete $slave} msg]} {
- Log $slave "Deletion error : $msg";
+ Log $slave "Deletion error : $msg"
}
}
if {[winfo exists $window]} {
- Log $slave "Destroy toplevel $window" NOTICE;
- destroy $window;
+ Log $slave "Destroy toplevel $window" NOTICE
+ destroy $window
}
# clean up tkInit(slave)
@@ -222,49 +222,48 @@ proc ::safe::tkDelete {W window slave} {
}
proc ::safe::tkTopLevel {slave display} {
- variable tkSafeId;
- incr tkSafeId;
- set w ".safe$tkSafeId";
+ variable tkSafeId
+ incr tkSafeId
+ set w ".safe$tkSafeId"
if {[catch {toplevel $w -screen $display -class SafeTk} msg]} {
return -code error "Unable to create toplevel for\
- safe slave \"$slave\" ($msg)";
+ safe slave \"$slave\" ($msg)"
}
Log $slave "New toplevel $w" NOTICE
set msg "Untrusted Tcl applet ($slave)"
- wm title $w $msg;
+ wm title $w $msg
# Control frame
set wc $w.fc
- frame $wc -bg red -borderwidth 3 -relief ridge ;
+ frame $wc -bg red -borderwidth 3 -relief ridge
# We will destroy the interp when the window is destroyed
bindtags $wc [concat Safe$wc [bindtags $wc]]
- bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $slave];
+ bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $slave]
- label $wc.l -text $msg \
- -padx 2 -pady 0 -anchor w;
+ label $wc.l -text $msg -padx 2 -pady 0 -anchor w
# We want the button to be the last visible item
# (so be packed first) and at the right and not resizing horizontally
# frame the button so it does not expand horizontally
# but still have the default background instead of red one from the parent
- frame $wc.fb -bd 0 ;
+ frame $wc.fb -bd 0
button $wc.fb.b -text "Delete" \
-bd 1 -padx 2 -pady 0 -highlightthickness 0 \
-command [list ::safe::tkDelete $w $w $slave]
- pack $wc.fb.b -side right -fill both ;
- pack $wc.fb -side right -fill both -expand 1;
- pack $wc.l -side left -fill both -expand 1;
- pack $wc -side bottom -fill x ;
+ pack $wc.fb.b -side right -fill both
+ pack $wc.fb -side right -fill both -expand 1
+ pack $wc.l -side left -fill both -expand 1
+ pack $wc -side bottom -fill x
# Container frame
- frame $w.c -container 1;
- pack $w.c -fill both -expand 1;
+ frame $w.c -container 1
+ pack $w.c -fill both -expand 1
# return both the toplevel window name and the id to use for embedding
- list $w [winfo id $w.c] ;
+ list $w [winfo id $w.c]
}
}
diff --git a/library/scale.tcl b/library/scale.tcl
index e36dbe8..d1a7f07 100644
--- a/library/scale.tcl
+++ b/library/scale.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
#
-# RCS: @(#) $Id: scale.tcl,v 1.4 1999/04/16 01:51:27 stanton Exp $
+# RCS: @(#) $Id: scale.tcl,v 1.5 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
@@ -32,7 +32,7 @@ bind Scale <Leave> {
if {$tk_strictMotif} {
%W config -activebackground $tkPriv(activeBg)
}
- if {![string compare [%W cget -state] "active"]} {
+ if {[string equal [%W cget -state] "active"]} {
%W configure -state normal
}
}
@@ -107,10 +107,10 @@ bind Scale <End> {
proc tkScaleActivate {w x y} {
global tkPriv
- if {![string compare [$w cget -state] "disabled"]} {
- return
+ if {[string equal [$w cget -state] "disabled"]} {
+ return
}
- if {![string compare [$w identify $x $y] "slider"]} {
+ if {[string equal [$w identify $x $y] "slider"]} {
$w configure -state active
} else {
$w configure -state normal
@@ -129,11 +129,11 @@ proc tkScaleButtonDown {w x y} {
global tkPriv
set tkPriv(dragging) 0
set el [$w identify $x $y]
- if {![string compare $el "trough1"]} {
+ if {[string equal $el "trough1"]} {
tkScaleIncrement $w up little initial
- } elseif {![string compare $el "trough2"]} {
+ } elseif {[string equal $el "trough2"]} {
tkScaleIncrement $w down little initial
- } elseif {![string compare $el "slider"]} {
+ } elseif {[string equal $el "slider"]} {
set tkPriv(dragging) 1
set tkPriv(initValue) [$w get]
set coords [$w coords]
@@ -158,8 +158,7 @@ proc tkScaleDrag {w x y} {
if {!$tkPriv(dragging)} {
return
}
- $w set [$w get [expr {$x - $tkPriv(deltaX)}] \
- [expr {$y - $tkPriv(deltaY)}]]
+ $w set [$w get [expr {$x-$tkPriv(deltaX)}] [expr {$y-$tkPriv(deltaY)}]]
}
# tkScaleEndDrag --
@@ -194,7 +193,7 @@ proc tkScaleEndDrag {w} {
proc tkScaleIncrement {w dir big repeat} {
global tkPriv
if {![winfo exists $w]} return
- if {![string compare $big "big"]} {
+ if {[string equal $big "big"]} {
set inc [$w cget -bigincrement]
if {$inc == 0} {
set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
@@ -205,15 +204,15 @@ proc tkScaleIncrement {w dir big repeat} {
} else {
set inc [$w cget -resolution]
}
- if {([$w cget -from] > [$w cget -to]) ^ ![string compare $dir "up"]} {
+ if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir "up"]} {
set inc [expr {-$inc}]
}
$w set [expr {[$w get] + $inc}]
- if {![string compare $repeat "again"]} {
+ if {[string equal $repeat "again"]} {
set tkPriv(afterId) [after [$w cget -repeatinterval] \
tkScaleIncrement $w $dir $big again]
- } elseif {![string compare $repeat "initial"]} {
+ } elseif {[string equal $repeat "initial"]} {
set delay [$w cget -repeatdelay]
if {$delay > 0} {
set tkPriv(afterId) [after $delay \
@@ -233,9 +232,9 @@ proc tkScaleIncrement {w dir big repeat} {
proc tkScaleControlPress {w x y} {
set el [$w identify $x $y]
- if {![string compare $el "trough1"]} {
+ if {[string equal $el "trough1"]} {
$w set [$w cget -from]
- } elseif {![string compare $el "trough2"]} {
+ } elseif {[string equal $el "trough2"]} {
$w set [$w cget -to]
}
}
@@ -252,7 +251,7 @@ proc tkScaleControlPress {w x y} {
proc tkScaleButton2Down {w x y} {
global tkPriv
- if {![string compare [$w cget -state] "disabled"]} {
+ if {[string equal [$w cget -state] "disabled"]} {
return
}
$w configure -state active
diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl
index 93d4a3c..d33121b 100644
--- a/library/scrlbar.tcl
+++ b/library/scrlbar.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk scrollbar widgets.
# It also provides procedures that help in implementing the bindings.
#
-# RCS: @(#) $Id: scrlbar.tcl,v 1.5 1999/04/16 01:51:27 stanton Exp $
+# RCS: @(#) $Id: scrlbar.tcl,v 1.6 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -17,8 +17,9 @@
#-------------------------------------------------------------------------
# Standard Motif bindings:
-if {[string compare $tcl_platform(platform) "windows"] &&
- [string compare $tcl_platform(platform) "macintosh"]} {
+if {[string compare $tcl_platform(platform) "windows"] && \
+ [string compare $tcl_platform(platform) "macintosh"]} {
+
bind Scrollbar <Enter> {
if {$tk_strictMotif} {
set tkPriv(activeBg) [%W cget -activebackground]
@@ -144,7 +145,7 @@ proc tkScrollButtonDown {w x y} {
set tkPriv(relief) [$w cget -activerelief]
$w configure -activerelief sunken
set element [$w identify $x $y]
- if {![string compare $element "slider"]} {
+ if {[string equal $element "slider"]} {
tkScrollStartDrag $w $x $y
} else {
tkScrollSelect $w $element initial
@@ -186,16 +187,16 @@ proc tkScrollSelect {w element repeat} {
global tkPriv
if {![winfo exists $w]} return
switch -- $element {
- "arrow1" {tkScrollByUnits $w hv -1}
- "trough1" {tkScrollByPages $w hv -1}
- "trough2" {tkScrollByPages $w hv 1}
- "arrow2" {tkScrollByUnits $w hv 1}
- default {return}
+ "arrow1" {tkScrollByUnits $w hv -1}
+ "trough1" {tkScrollByPages $w hv -1}
+ "trough2" {tkScrollByPages $w hv 1}
+ "arrow2" {tkScrollByUnits $w hv 1}
+ default {return}
}
- if {![string compare $repeat "again"]} {
+ if {[string equal $repeat "again"]} {
set tkPriv(afterId) [after [$w cget -repeatinterval] \
tkScrollSelect $w $element again]
- } elseif {![string compare $repeat "initial"]} {
+ } elseif {[string equal $repeat "initial"]} {
set delay [$w cget -repeatdelay]
if {$delay > 0} {
set tkPriv(afterId) [after $delay tkScrollSelect $w $element again]
@@ -214,7 +215,7 @@ proc tkScrollSelect {w element repeat} {
proc tkScrollStartDrag {w x y} {
global tkPriv
- if {![string compare [$w cget -command] ""]} {
+ if {[string equal [$w cget -command] ""]} {
return
}
set tkPriv(pressX) $x
@@ -223,13 +224,11 @@ proc tkScrollStartDrag {w x y} {
set iv0 [lindex $tkPriv(initValues) 0]
if {[llength $tkPriv(initValues)] == 2} {
set tkPriv(initPos) $iv0
+ } elseif {$iv0 == 0} {
+ set tkPriv(initPos) 0.0
} else {
- if {$iv0 == 0} {
- set tkPriv(initPos) 0.0
- } else {
- set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \
- / [lindex $tkPriv(initValues) 0]}]
- }
+ set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \
+ / [lindex $tkPriv(initValues) 0]}]
}
}
@@ -246,7 +245,7 @@ proc tkScrollStartDrag {w x y} {
proc tkScrollDrag {w x y} {
global tkPriv
- if {![string compare $tkPriv(initPos) ""]} {
+ if {[string equal $tkPriv(initPos) ""]} {
return
}
set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]]
@@ -276,7 +275,7 @@ proc tkScrollDrag {w x y} {
proc tkScrollEndDrag {w x y} {
global tkPriv
- if {![string compare $tkPriv(initPos) ""]} {
+ if {[string equal $tkPriv(initPos) ""]} {
return
}
if {[$w cget -jump]} {
@@ -300,7 +299,7 @@ proc tkScrollEndDrag {w x y} {
proc tkScrollByUnits {w orient amount} {
set cmd [$w cget -command]
- if {![string compare $cmd ""] || ([string first \
+ if {[string equal $cmd ""] || ([string first \
[string index [$w cget -orient] 0] $orient] < 0)} {
return
}
@@ -325,7 +324,7 @@ proc tkScrollByUnits {w orient amount} {
proc tkScrollByPages {w orient amount} {
set cmd [$w cget -command]
- if {![string compare $cmd ""] || ([string first \
+ if {[string equal $cmd ""] || ([string first \
[string index [$w cget -orient] 0] $orient] < 0)} {
return
}
@@ -349,7 +348,7 @@ proc tkScrollByPages {w orient amount} {
proc tkScrollToPos {w pos} {
set cmd [$w cget -command]
- if {![string compare $cmd ""]} {
+ if {[string equal $cmd ""]} {
return
}
set info [$w get]
@@ -395,8 +394,7 @@ proc tkScrollTopBottom {w x y} {
proc tkScrollButton2Down {w x y} {
global tkPriv
set element [$w identify $x $y]
- if {![string compare $element "arrow1"]
- || ![string compare $element "arrow2"]} {
+ if {[string match {arrow[12]} $element]} {
tkScrollButtonDown $w $x $y
return
}
diff --git a/library/tearoff.tcl b/library/tearoff.tcl
index 7a240c3..c9e3231 100644
--- a/library/tearoff.tcl
+++ b/library/tearoff.tcl
@@ -2,7 +2,7 @@
#
# This file contains procedures that implement tear-off menus.
#
-# RCS: @(#) $Id: tearoff.tcl,v 1.4 1999/04/16 01:51:27 stanton Exp $
+# RCS: @(#) $Id: tearoff.tcl,v 1.5 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -40,11 +40,11 @@ proc tkTearOffMenu {w {x 0} {y 0}} {
}
set parent [winfo parent $w]
- while {[string compare [winfo toplevel $parent] $parent]
- || ![string compare [winfo class $parent] "Menu"]} {
+ while {[string compare [winfo toplevel $parent] $parent] \
+ || [string equal [winfo class $parent] "Menu"]} {
set parent [winfo parent $parent]
}
- if {![string compare $parent "."]} {
+ if {[string equal $parent "."]} {
set parent ""
}
for {set i 1} 1 {incr i} {
@@ -114,14 +114,14 @@ proc tkMenuDup {src dst type} {
if {[llength $option] == 2} {
continue
}
- if {[string compare [lindex $option 0] "-type"] == 0} {
+ if {[string equal [lindex $option 0] "-type"]} {
continue
}
lappend cmd [lindex $option 0] [lindex $option 4]
}
eval $cmd
set last [$src index last]
- if {![string compare $last "none"]} {
+ if {[string equal $last "none"]} {
return
}
for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
@@ -140,8 +140,8 @@ proc tkMenuDup {src dst type} {
# Copy tags to x, replacing each substring of src with dst.
while {[set index [string first $src $tags]] != -1} {
- append x [string range $tags 0 [expr {$index - 1}]]$dst
- set tags [string range $tags [expr {$index + $srcLen}] end]
+ append x [string range $tags 0 [expr {$index - 1}]]$dst
+ set tags [string range $tags [expr {$index + $srcLen}] end]
}
append x $tags
@@ -155,9 +155,9 @@ proc tkMenuDup {src dst type} {
# Copy script to x, replacing each substring of event with dst.
while {[set index [string first $event $script]] != -1} {
- append x [string range $script 0 [expr {$index - 1}]]
+ append x [string range $script 0 [expr {$index - 1}]]
append x $dst
- set script [string range $script [expr {$index + $eventLen}] end]
+ set script [string range $script [expr {$index + $eventLen}] end]
}
append x $script
diff --git a/library/text.tcl b/library/text.tcl
index a780bda..f3eb662 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk text widgets and provides
# procedures that help in implementing the bindings.
#
-# RCS: @(#) $Id: text.tcl,v 1.6 1999/04/16 01:51:27 stanton Exp $
+# RCS: @(#) $Id: text.tcl,v 1.7 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -272,8 +272,8 @@ bind Text <Meta-KeyPress> {# nothing}
bind Text <Control-KeyPress> {# nothing}
bind Text <Escape> {# nothing}
bind Text <KP_Enter> {# nothing}
-if {![string compare $tcl_platform(platform) "macintosh"]} {
- bind Text <Command-KeyPress> {# nothing}
+if {[string equal $tcl_platform(platform) "macintosh"]} {
+ bind Text <Command-KeyPress> {# nothing}
}
# Additional emacs-like bindings:
@@ -381,7 +381,7 @@ bind Text <Meta-Delete> {
# Macintosh only bindings:
# if text black & highlight black -> text white, other text the same
-if {![string compare $tcl_platform(platform) "macintosh"]} {
+if {[string equal $tcl_platform(platform) "macintosh"]} {
bind Text <FocusIn> {
%W tag configure sel -borderwidth 0
%W configure -selectbackground systemHighlight -selectforeground systemHighlightText
@@ -469,7 +469,7 @@ bind Text <MouseWheel> {
proc tkTextClosestGap {w x y} {
set pos [$w index @$x,$y]
set bbox [$w bbox $pos]
- if {![string compare $bbox ""]} {
+ if {[string equal $bbox ""]} {
return $pos
}
if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
@@ -496,7 +496,7 @@ proc tkTextButton1 {w x y} {
set tkPriv(pressX) $x
$w mark set insert [tkTextClosestGap $w $x $y]
$w mark set anchor insert
- if {![string compare [$w cget -state] "normal"]} {focus $w}
+ if {[string equal [$w cget -state] "normal"]} {focus $w}
}
# tkTextSelectTo --
@@ -552,8 +552,8 @@ proc tkTextSelectTo {w x y} {
}
}
if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} {
- if {[string compare $tcl_platform(platform) "unix"]
- && [$w compare $cur < anchor]} {
+ if {[string compare $tcl_platform(platform) "unix"] \
+ && [$w compare $cur < anchor]} {
$w mark set insert $first
} else {
$w mark set insert $last
@@ -605,7 +605,7 @@ proc tkTextKeyExtend {w index} {
proc tkTextPaste {w x y} {
$w mark set insert [tkTextClosestGap $w $x $y]
catch {$w insert insert [selection get -displayof $w]}
- if {![string compare [$w cget -state] "normal"]} {focus $w}
+ if {[string equal [$w cget -state] "normal"]} {focus $w}
}
# tkTextAutoScan --
@@ -671,7 +671,7 @@ proc tkTextSetCursor {w pos} {
proc tkTextKeySelect {w new} {
global tkPriv
- if {![string compare [$w tag nextrange sel 1.0 end] ""]} {
+ if {[string equal [$w tag nextrange sel 1.0 end] ""]} {
if {[$w compare $new < insert]} {
$w tag add sel $new insert
} else {
@@ -712,7 +712,7 @@ proc tkTextKeySelect {w new} {
proc tkTextResetAnchor {w index} {
global tkPriv
- if {![string compare [$w tag ranges sel] ""]} {
+ if {[string equal [$w tag ranges sel] ""]} {
$w mark set anchor $index
return
}
@@ -759,12 +759,11 @@ proc tkTextResetAnchor {w index} {
# s - The string to insert (usually just a single character)
proc tkTextInsert {w s} {
- if {![string compare $s ""] ||
- ![string compare [$w cget -state] "disabled"]} {
+ if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} {
return
}
catch {
- if {[$w compare sel.first <= insert]
+ if {[$w compare sel.first <= insert] \
&& [$w compare sel.last >= insert]} {
$w delete sel.first sel.last
}
@@ -791,7 +790,7 @@ proc tkTextUpDownLine {w n} {
set i [$w index insert]
scan $i "%d.%d" line char
- if {[string compare $tkPriv(prevPos) $i] != 0} {
+ if {[string compare $tkPriv(prevPos) $i]} {
set tkPriv(char) $char
}
set new [$w index [expr {$line + $n}].$tkPriv(char)]
@@ -814,14 +813,14 @@ proc tkTextUpDownLine {w n} {
proc tkTextPrevPara {w pos} {
set pos [$w index "$pos linestart"]
while 1 {
- if {(![string compare [$w get "$pos - 1 line"] "\n"]
- && [string compare [$w get $pos] "\n"])
- || ![string compare $pos "1.0"]} {
+ if {([string equal [$w get "$pos - 1 line"] "\n"] \
+ && [string compare [$w get $pos] "\n"]) \
+ || [string equal $pos "1.0"]} {
if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \
dummy index]} {
set pos [$w index "$pos + [lindex $index 0] chars"]
}
- if {[$w compare $pos != insert] || ![string compare $pos 1.0]} {
+ if {[$w compare $pos != insert] || [string equal $pos 1.0]} {
return $pos
}
}
@@ -846,7 +845,7 @@ proc tkTextNextPara {w start} {
}
set pos [$w index "$pos + 1 line"]
}
- while {![string compare [$w get $pos] "\n"]} {
+ while {[string equal [$w get $pos] "\n"]} {
set pos [$w index "$pos + 1 line"]
if {[$w compare $pos == end]} {
return [$w index "end - 1c"]
@@ -874,7 +873,7 @@ proc tkTextNextPara {w start} {
proc tkTextScrollPages {w count} {
set bbox [$w bbox insert]
$w yview scroll $count pages
- if {![string compare $bbox ""]} {
+ if {[string equal $bbox ""]} {
return [$w index @[expr {[winfo height $w]/2}],0]
}
return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
@@ -944,7 +943,7 @@ proc tk_textCut w {
proc tk_textPaste w {
global tcl_platform
catch {
- if {[string compare $tcl_platform(platform) "unix"]} {
+ if {[string compare $tcl_platform(platform) "unix"]} {
catch {
$w delete sel.first sel.last
}
@@ -963,7 +962,7 @@ proc tk_textPaste w {
# w - The text window in which the cursor is to move.
# start - Position at which to start search.
-if {![string compare $tcl_platform(platform) "windows"]} {
+if {[string equal $tcl_platform(platform) "windows"]} {
proc tkTextNextWord {w start} {
tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \
tcl_startOfNextWord
diff --git a/library/tk.tcl b/library/tk.tcl
index ae68609..7328b8e 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
# Initialization script normally executed in the interpreter for each
# Tk-based application. Arranges class bindings for widgets.
#
-# RCS: @(#) $Id: tk.tcl,v 1.10 1999/08/13 02:58:17 hobbs Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.11 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -56,33 +56,29 @@ proc tkScreenChanged screen {
return
}
array set tkPriv {
- activeMenu {}
- activeItem {}
- afterId {}
- buttons 0
- buttonWindow {}
- dragging 0
- focus {}
- grab {}
- initPos {}
- inMenubutton {}
- listboxPrev {}
- menuBar {}
- mouseMoved 0
- oldGrab {}
- popup {}
- postedMb {}
- pressX 0
- pressY 0
- prevPos 0
- selectMode char
+ activeMenu {}
+ activeItem {}
+ afterId {}
+ buttons 0
+ buttonWindow {}
+ dragging 0
+ focus {}
+ grab {}
+ initPos {}
+ inMenubutton {}
+ listboxPrev {}
+ menuBar {}
+ mouseMoved 0
+ oldGrab {}
+ popup {}
+ postedMb {}
+ pressX 0
+ pressY 0
+ prevPos 0
+ selectMode char
}
set tkPriv(screen) $screen
- if {[string compare $tcl_platform(platform) "unix"] == 0} {
- set tkPriv(tearoff) 1
- } else {
- set tkPriv(tearoff) 0
- }
+ set tkPriv(tearoff) [string equal $tcl_platform(platform) "unix"]
set tkPriv(window) {}
}
@@ -119,12 +115,12 @@ proc tkEventMotifBindings {n1 dummy dummy} {
# using compiled code.
#----------------------------------------------------------------------
-if {![string compare [info commands tk_chooseColor] ""]} {
+if {[string equal [info commands tk_chooseColor] ""]} {
proc tk_chooseColor {args} {
return [eval tkColorDialog $args]
}
}
-if {![string compare [info commands tk_getOpenFile] ""]} {
+if {[string equal [info commands tk_getOpenFile] ""]} {
proc tk_getOpenFile {args} {
if {$::tk_strictMotif} {
return [eval tkMotifFDialog open $args]
@@ -133,7 +129,7 @@ if {![string compare [info commands tk_getOpenFile] ""]} {
}
}
}
-if {![string compare [info commands tk_getSaveFile] ""]} {
+if {[string equal [info commands tk_getSaveFile] ""]} {
proc tk_getSaveFile {args} {
if {$::tk_strictMotif} {
return [eval tkMotifFDialog save $args]
@@ -142,7 +138,7 @@ if {![string compare [info commands tk_getSaveFile] ""]} {
}
}
}
-if {![string compare [info commands tk_messageBox] ""]} {
+if {[string equal [info commands tk_messageBox] ""]} {
proc tk_messageBox {args} {
return [eval tkMessageBox $args]
}
@@ -180,8 +176,8 @@ switch $tcl_platform(platform) {
# Read in files that define all of the class bindings.
# ----------------------------------------------------------------------
-if {[string compare $tcl_platform(platform) "macintosh"] &&
- [string compare {} $tk_library]} {
+if {[string compare $tcl_platform(platform) "macintosh"] && \
+ [string compare {} $tk_library]} {
source [file join $tk_library button.tcl]
source [file join $tk_library entry.tcl]
source [file join $tk_library listbox.tcl]
@@ -221,7 +217,7 @@ proc tkCancelRepeat {} {
# w - Window to which focus should be set.
proc tkTabToWindow {w} {
- if {![string compare [winfo class $w] Entry]} {
+ if {[string equal [winfo class $w] Entry]} {
$w selection range 0 end
$w icursor end
}
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index ec56b48..0ffe6c3 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -11,7 +11,7 @@
# files by clicking on the file icons or by entering a filename
# in the "Filename:" entry.
#
-# RCS: @(#) $Id: tkfbox.tcl,v 1.9 1999/04/16 01:51:27 stanton Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.10 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -76,8 +76,8 @@ proc tkIconList_Create {w} {
pack $data(sbar) -side bottom -fill x -padx 2
pack $data(canvas) -expand yes -fill both
- $data(sbar) config -command "$data(canvas) xview"
- $data(canvas) config -xscrollcommand "$data(sbar) set"
+ $data(sbar) config -command [list $data(canvas) xview]
+ $data(canvas) config -xscrollcommand [list $data(sbar) set]
# Initializes the max icon/text width and height and other variables
#
@@ -91,25 +91,26 @@ proc tkIconList_Create {w} {
# Creates the event bindings.
#
- bind $data(canvas) <Configure> "tkIconList_Arrange $w"
-
- bind $data(canvas) <1> "tkIconList_Btn1 $w %x %y"
- bind $data(canvas) <B1-Motion> "tkIconList_Motion1 $w %x %y"
- bind $data(canvas) <B1-Leave> "tkIconList_Leave1 $w %x %y"
- bind $data(canvas) <B1-Enter> "tkCancelRepeat"
- bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
- bind $data(canvas) <Double-ButtonRelease-1> "tkIconList_Double1 $w %x %y"
-
- bind $data(canvas) <Up> "tkIconList_UpDown $w -1"
- bind $data(canvas) <Down> "tkIconList_UpDown $w 1"
- bind $data(canvas) <Left> "tkIconList_LeftRight $w -1"
- bind $data(canvas) <Right> "tkIconList_LeftRight $w 1"
- bind $data(canvas) <Return> "tkIconList_ReturnKey $w"
- bind $data(canvas) <KeyPress> "tkIconList_KeyPress $w %A"
+ bind $data(canvas) <Configure> [list tkIconList_Arrange $w]
+
+ bind $data(canvas) <1> [list tkIconList_Btn1 $w %x %y]
+ bind $data(canvas) <B1-Motion> [list tkIconList_Motion1 $w %x %y]
+ bind $data(canvas) <B1-Leave> [list tkIconList_Leave1 $w %x %y]
+ bind $data(canvas) <B1-Enter> [list tkCancelRepeat]
+ bind $data(canvas) <ButtonRelease-1> [list tkCancelRepeat]
+ bind $data(canvas) <Double-ButtonRelease-1> \
+ [list tkIconList_Double1 $w %x %y]
+
+ bind $data(canvas) <Up> [list tkIconList_UpDown $w -1]
+ bind $data(canvas) <Down> [list tkIconList_UpDown $w 1]
+ bind $data(canvas) <Left> [list tkIconList_LeftRight $w -1]
+ bind $data(canvas) <Right> [list tkIconList_LeftRight $w 1]
+ bind $data(canvas) <Return> [list tkIconList_ReturnKey $w]
+ bind $data(canvas) <KeyPress> [list tkIconList_KeyPress $w %A]
bind $data(canvas) <Control-KeyPress> ";"
- bind $data(canvas) <Alt-KeyPress> ";"
+ bind $data(canvas) <Alt-KeyPress> ";"
- bind $data(canvas) <FocusIn> "tkIconList_FocusIn $w"
+ bind $data(canvas) <FocusIn> [list tkIconList_FocusIn $w]
return $w
}
@@ -288,7 +289,7 @@ proc tkIconList_Arrange {w} {
set data(noScroll) 1
} else {
$data(canvas) config -scrollregion "$pad $pad $sW $H"
- $data(sbar) config -command "$data(canvas) xview"
+ $data(sbar) config -command [list $data(canvas) xview]
set data(noScroll) 0
}
@@ -325,7 +326,7 @@ proc tkIconList_See {w rTag} {
return
}
set sRegion [$data(canvas) cget -scrollregion]
- if {![string compare $sRegion {}]} {
+ if {[string equal $sRegion {}]} {
return
}
@@ -370,7 +371,7 @@ proc tkIconList_SelectAtXY {w x y} {
upvar #0 $w data
tkIconList_Select $w [$data(canvas) find closest \
- [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
+ [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
}
proc tkIconList_Select {w rTag {callBrowse 1}} {
@@ -387,7 +388,7 @@ proc tkIconList_Select {w rTag {callBrowse 1}} {
if {![info exists data(rect)]} {
set data(rect) [$data(canvas) create rect 0 0 0 0 \
- -fill #a0a0ff -outline #a0a0ff]
+ -fill #a0a0ff -outline #a0a0ff]
}
$data(canvas) lower $data(rect)
set bbox [$data(canvas) bbox $tTag]
@@ -396,10 +397,8 @@ proc tkIconList_Select {w rTag {callBrowse 1}} {
set data(curItem) $serial
set data(selected) $text
- if {$callBrowse} {
- if {[string compare $data(-browsecmd) ""]} {
- eval $data(-browsecmd) [list $text]
- }
+ if {$callBrowse && [string compare $data(-browsecmd) ""]} {
+ eval $data(-browsecmd) [list $text]
}
}
@@ -449,7 +448,7 @@ proc tkIconList_Motion1 {w x y} {
proc tkIconList_Double1 {w x y} {
upvar #0 $w data
- if {$data(curItem) != {}} {
+ if {[string compare $data(curItem) {}]} {
tkIconList_Invoke $w
}
}
@@ -473,7 +472,7 @@ proc tkIconList_FocusIn {w} {
return
}
- if {$data(curItem) == {}} {
+ if {[string equal $data(curItem) {}]} {
set rTag [lindex [lindex $data(list) 0] 2]
tkIconList_Select $w $rTag
}
@@ -494,12 +493,12 @@ proc tkIconList_UpDown {w amount} {
return
}
- if {$data(curItem) == {}} {
+ if {[string equal $data(curItem) {}]} {
set rTag [lindex [lindex $data(list) 0] 2]
} else {
set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]
- if {![string compare $rTag ""]} {
+ if {[string equal $rTag ""]} {
set rTag $oldRTag
}
}
@@ -524,13 +523,13 @@ proc tkIconList_LeftRight {w amount} {
if {![info exists data(list)]} {
return
}
- if {$data(curItem) == {}} {
+ if {[string equal $data(curItem) {}]} {
set rTag [lindex [lindex $data(list) 0] 2]
} else {
set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]
set rTag [lindex [lindex $data(list) $newItem] 2]
- if {![string compare $rTag ""]} {
+ if {[string equal $rTag ""]} {
set rTag $oldRTag
}
}
@@ -569,11 +568,11 @@ proc tkIconList_Goto {w text} {
return
}
- if {[string length $text] == 0} {
+ if {[string equal {} $text]} {
return
}
- if {$data(curItem) == {} || $data(curItem) == 0} {
+ if {[string equal $data(curItem) {}] || $data(curItem) == 0} {
set start 0
} else {
set start $data(curItem)
@@ -590,7 +589,7 @@ proc tkIconList_Goto {w text} {
# with $text
while 1 {
set sub [string range $textList($i) 0 $len0]
- if {[string compare $text $sub] == 0} {
+ if {[string equal $text $sub]} {
set theIndex $i
break
}
@@ -640,7 +639,7 @@ proc tkFDialog {type args} {
tkFDialog_Config $dataName $type $args
- if {![string compare $data(-parent) .]} {
+ if {[string equal $data(-parent) .]} {
set w .$dataName
} else {
set w $data(-parent).$dataName
@@ -671,7 +670,7 @@ proc tkFDialog {type args} {
# Initialize the file types menu
#
- if {$data(-filetypes) != {}} {
+ if {[llength $data(-filetypes)]} {
$data(typeMenu) delete 0 end
foreach type $data(-filetypes) {
set title [lindex $type 0]
@@ -708,7 +707,7 @@ proc tkFDialog {type args} {
set oldFocus [focus]
set oldGrab [grab current $w]
- if {$oldGrab != ""} {
+ if {[string compare $oldGrab ""]} {
set grabStatus [grab status $oldGrab]
}
grab $w
@@ -729,8 +728,8 @@ proc tkFDialog {type args} {
catch {focus $oldFocus}
grab release $w
wm withdraw $w
- if {$oldGrab != ""} {
- if {$grabStatus == "global"} {
+ if {[string compare $oldGrab ""]} {
+ if {[string equal $grabStatus "global"]} {
grab -global $oldGrab
} else {
grab $oldGrab
@@ -780,8 +779,8 @@ proc tkFDialog_Config {dataName type argList} {
#
tclParseConfigSpec $dataName $specs "" $argList
- if {![string compare $data(-title) ""]} {
- if {![string compare $type "open"]} {
+ if {[string equal $data(-title) ""]} {
+ if {[string equal $type "open"]} {
set data(-title) "Open"
} else {
set data(-title) "Save As"
@@ -918,31 +917,31 @@ static char updir_bits[] = {
# Set up the event handlers
#
- bind $data(ent) <Return> "tkFDialog_ActivateEnt $w"
+ bind $data(ent) <Return> [list tkFDialog_ActivateEnt $w]
- $data(upBtn) config -command "tkFDialog_UpDirCmd $w"
- $data(okBtn) config -command "tkFDialog_OkCmd $w"
- $data(cancelBtn) config -command "tkFDialog_CancelCmd $w"
+ $data(upBtn) config -command [list tkFDialog_UpDirCmd $w]
+ $data(okBtn) config -command [list tkFDialog_OkCmd $w]
+ $data(cancelBtn) config -command [list tkFDialog_CancelCmd $w]
- bind $w <Alt-d> "focus $data(dirMenuBtn)"
+ bind $w <Alt-d> [list focus $data(dirMenuBtn)]
bind $w <Alt-t> [format {
- if {"[%s cget -state]" == "normal"} {
+ if {[string equal [%s cget -state] "normal"]} {
focus %s
}
} $data(typeMenuBtn) $data(typeMenuBtn)]
- bind $w <Alt-n> "focus $data(ent)"
- bind $w <KeyPress-Escape> "tkButtonInvoke $data(cancelBtn)"
- bind $w <Alt-c> "tkButtonInvoke $data(cancelBtn)"
- bind $w <Alt-o> "tkFDialog_InvokeBtn $w Open"
- bind $w <Alt-s> "tkFDialog_InvokeBtn $w Save"
+ bind $w <Alt-n> [list focus $data(ent)]
+ bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-o> [list tkFDialog_InvokeBtn $w Open]
+ bind $w <Alt-s> [list tkFDialog_InvokeBtn $w Save]
- wm protocol $w WM_DELETE_WINDOW "tkFDialog_CancelCmd $w"
+ wm protocol $w WM_DELETE_WINDOW [list tkFDialog_CancelCmd $w]
# Build the focus group for all the entries
#
tkFocusGroup_Create $w
- tkFocusGroup_BindIn $w $data(ent) "tkFDialog_EntFocusIn $w"
- tkFocusGroup_BindOut $w $data(ent) "tkFDialog_EntFocusOut $w"
+ tkFocusGroup_BindIn $w $data(ent) [list tkFDialog_EntFocusIn $w]
+ tkFocusGroup_BindOut $w $data(ent) [list tkFDialog_EntFocusOut $w]
}
# tkFDialog_UpdateWhenIdle --
@@ -1021,10 +1020,10 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
# Make the dir list
#
foreach f [lsort -dictionary [glob -nocomplain .* *]] {
- if {![string compare $f .]} {
+ if {[string equal $f .]} {
continue
}
- if {![string compare $f ..]} {
+ if {[string equal $f ..]} {
continue
}
if {[file isdir ./$f]} {
@@ -1036,7 +1035,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
}
# Make the file list
#
- if {![string compare $data(filter) *]} {
+ if {[string equal $data(filter) *]} {
set files [lsort -dictionary \
[glob -nocomplain .* *]]
} else {
@@ -1077,7 +1076,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
# Restore the Open/Save Button
#
- if {![string compare $data(type) open]} {
+ if {[string equal $data(type) open]} {
$data(okBtn) config -text "Open"
} else {
$data(okBtn) config -text "Save"
@@ -1096,9 +1095,9 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
proc tkFDialog_SetPathSilently {w path} {
upvar #0 [winfo name $w] data
- trace vdelete data(selectPath) w "tkFDialog_SetPath $w"
+ trace vdelete data(selectPath) w [list tkFDialog_SetPath $w]
set data(selectPath) $path
- trace variable data(selectPath) w "tkFDialog_SetPath $w"
+ trace variable data(selectPath) w [list tkFDialog_SetPath $w]
}
@@ -1163,7 +1162,7 @@ proc tkFDialogResolveFile {context text defaultext} {
set path [tkFDialog_JoinFile $context $text]
- if {[file ext $path] == ""} {
+ if {[string equal [file ext $path] ""]} {
set path "$path$defaultext"
}
@@ -1179,9 +1178,7 @@ proc tkFDialogResolveFile {context text defaultext} {
if {[file exists $path]} {
if {[file isdirectory $path]} {
- if {[catch {
- cd $path
- }]} {
+ if {[catch {cd $path}]} {
return [list CHDIR $path ""]
}
set directory [pwd]
@@ -1189,9 +1186,7 @@ proc tkFDialogResolveFile {context text defaultext} {
set flag OK
cd $appPWD
} else {
- if {[catch {
- cd [file dirname $path]
- }]} {
+ if {[catch {cd [file dirname $path]}]} {
return [list CHDIR [file dirname $path] ""]
}
set directory [pwd]
@@ -1202,9 +1197,7 @@ proc tkFDialogResolveFile {context text defaultext} {
} else {
set dirname [file dirname $path]
if {[file exists $dirname]} {
- if {[catch {
- cd $dirname
- }]} {
+ if {[catch {cd $dirname}]} {
return [list CHDIR $dirname ""]
}
set directory [pwd]
@@ -1243,7 +1236,7 @@ proc tkFDialog_EntFocusIn {w} {
tkIconList_Unselect $data(icons)
- if {![string compare $data(type) open]} {
+ if {[string equal $data(type) open]} {
$data(okBtn) config -text "Open"
} else {
$data(okBtn) config -text "Save"
@@ -1271,7 +1264,7 @@ proc tkFDialog_ActivateEnt {w} {
switch -- $flag {
OK {
- if {![string compare $file ""]} {
+ if {[string equal $file ""]} {
# user has entered an existing (sub)directory
set data(selectPath) $path
$data(ent) delete 0 end
@@ -1286,7 +1279,7 @@ proc tkFDialog_ActivateEnt {w} {
set data(filter) $file
}
FILE {
- if {![string compare $data(type) open]} {
+ if {[string equal $data(type) open]} {
tk_messageBox -icon warning -type ok -parent $data(-parent) \
-message "File \"[file join $path $file]\" does not exist."
$data(ent) select from 0
@@ -1329,7 +1322,7 @@ proc tkFDialog_ActivateEnt {w} {
proc tkFDialog_InvokeBtn {w key} {
upvar #0 [winfo name $w] data
- if {![string compare [$data(okBtn) cget -text] $key]} {
+ if {[string equal [$data(okBtn) cget -text] $key]} {
tkButtonInvoke $data(okBtn)
}
}
@@ -1389,7 +1382,7 @@ proc tkFDialog_CancelCmd {w} {
proc tkFDialog_ListBrowse {w text} {
upvar #0 [winfo name $w] data
- if {$text == ""} {
+ if {[string equal $text ""]} {
return
}
@@ -1398,7 +1391,7 @@ proc tkFDialog_ListBrowse {w text} {
$data(ent) delete 0 end
$data(ent) insert 0 $text
- if {![string compare $data(type) open]} {
+ if {[string equal $data(type) open]} {
$data(okBtn) config -text "Open"
} else {
$data(okBtn) config -text "Save"
@@ -1414,7 +1407,7 @@ proc tkFDialog_ListBrowse {w text} {
proc tkFDialog_ListInvoke {w text} {
upvar #0 [winfo name $w] data
- if {$text == ""} {
+ if {[string equal $text ""]} {
return
}
@@ -1448,20 +1441,20 @@ proc tkFDialog_Done {w {selectFilePath ""}} {
upvar #0 [winfo name $w] data
global tkPriv
- if {![string compare $selectFilePath ""]} {
+ if {[string equal $selectFilePath ""]} {
set selectFilePath [tkFDialog_JoinFile $data(selectPath) \
$data(selectFile)]
set tkPriv(selectFile) $data(selectFile)
set tkPriv(selectPath) $data(selectPath)
if {[file exists $selectFilePath] &&
- ![string compare $data(type) save]} {
+ [string equal $data(type) save]} {
set reply [tk_messageBox -icon warning -type yesno\
-parent $data(-parent) -message "File\
\"$selectFilePath\" already exists.\nDo\
you want to overwrite it?"]
- if {![string compare $reply "no"]} {
+ if {[string equal $reply "no"]} {
return
}
}
diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl
index 2080c97..30932b2 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.7 1999/04/16 01:51:27 stanton Exp $
+# RCS: @(#) $Id: xmfbox.tcl,v 1.8 1999/09/02 17:02:53 hobbs Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
@@ -37,7 +37,7 @@ proc tkMotifFDialog {type args} {
set oldFocus [focus]
set oldGrab [grab current $w]
- if {$oldGrab != ""} {
+ if {[string compare $oldGrab ""]} {
set grabStatus [grab status $oldGrab]
}
grab $w
@@ -55,8 +55,8 @@ proc tkMotifFDialog {type args} {
catch {focus $oldFocus}
grab release $w
wm withdraw $w
- if {$oldGrab != ""} {
- if {$grabStatus == "global"} {
+ if {[string compare $oldGrab ""]} {
+ if {[string equal $grabStatus "global"]} {
grab -global $oldGrab
} else {
grab $oldGrab
@@ -90,7 +90,7 @@ proc tkMotifFDialog_Create {dataName type argList} {
tkMotifFDialog_Config $dataName $type $argList
- if {![string compare $data(-parent) .]} {
+ if {[string equal $data(-parent) .]} {
set w .$dataName
} else {
set w $data(-parent).$dataName
@@ -123,10 +123,10 @@ proc tkMotifFDialog_Create {dataName type argList} {
wm withdraw $w
update idletasks
- set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]]
- set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]]
+ set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
+ - [winfo vrootx [winfo parent $w]]}]
+ set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
+ - [winfo vrooty [winfo parent $w]]}]
wm geom $w +$x+$y
wm deiconify $w
wm title $w $data(-title)
@@ -174,8 +174,8 @@ proc tkMotifFDialog_Config {dataName type argList} {
#
tclParseConfigSpec $dataName $specs "" $argList
- if {![string compare $data(-title) ""]} {
- if {![string compare $type "open"]} {
+ if {[string equal $data(-title) ""]} {
+ if {[string equal $type "open"]} {
set data(-title) "Open"
} else {
set data(-title) "Save As"
@@ -281,30 +281,30 @@ proc tkMotifFDialog_BuildUI {w} {
# The buttons
#
set data(okBtn) [button $bot.ok -text OK -width 6 -under 0 \
- -command "tkMotifFDialog_OkCmd $w"]
+ -command [list tkMotifFDialog_OkCmd $w]]
set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \
- -command "tkMotifFDialog_FilterCmd $w"]
+ -command [list tkMotifFDialog_FilterCmd $w]]
set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \
- -command "tkMotifFDialog_CancelCmd $w"]
+ -command [list tkMotifFDialog_CancelCmd $w]]
pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
-side left
# Create the bindings:
#
- bind $w <Alt-t> "focus $data(fEnt)"
- bind $w <Alt-d> "focus $data(dList)"
- bind $w <Alt-l> "focus $data(fList)"
- bind $w <Alt-s> "focus $data(sEnt)"
+ bind $w <Alt-t> [list focus $data(fEnt)]
+ bind $w <Alt-d> [list focus $data(dList)]
+ bind $w <Alt-l> [list focus $data(fList)]
+ bind $w <Alt-s> [list focus $data(sEnt)]
- bind $w <Alt-o> "tkButtonInvoke $bot.ok "
- bind $w <Alt-f> "tkButtonInvoke $bot.filter"
- bind $w <Alt-c> "tkButtonInvoke $bot.cancel"
+ bind $w <Alt-o> [list tkButtonInvoke $bot.ok]
+ bind $w <Alt-f> [list tkButtonInvoke $bot.filter]
+ bind $w <Alt-c> [list tkButtonInvoke $bot.cancel]
- bind $data(fEnt) <Return> "tkMotifFDialog_ActivateFEnt $w"
- bind $data(sEnt) <Return> "tkMotifFDialog_ActivateSEnt $w"
+ bind $data(fEnt) <Return> [list tkMotifFDialog_ActivateFEnt $w]
+ bind $data(sEnt) <Return> [list tkMotifFDialog_ActivateSEnt $w]
- wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w"
+ wm protocol $w WM_DELETE_WINDOW [list tkMotifFDialog_CancelCmd $w]
}
# tkMotifFDialog_MakeSList --
@@ -325,12 +325,9 @@ proc tkMotifFDialog_BuildUI {w} {
proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {
label $f.lab -text $label -under $under -anchor w
listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\
- -xscrollcommand "$f.h set" \
- -yscrollcommand "$f.v set"
- scrollbar $f.v -orient vertical -takefocus 0 \
- -command "$f.l yview"
- scrollbar $f.h -orient horizontal -takefocus 0 \
- -command "$f.l xview"
+ -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set]
+ scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview]
+ scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]
grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
-padx 2 -pady 2
grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
@@ -344,16 +341,17 @@ proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {
# bindings for the listboxes
#
set list $f.l
- bind $list <Up> "tkMotifFDialog_Browse$cmdPrefix $w"
- bind $list <Down> "tkMotifFDialog_Browse$cmdPrefix $w"
- bind $list <space> "tkMotifFDialog_Browse$cmdPrefix $w"
- bind $list <1> "tkMotifFDialog_Browse$cmdPrefix $w"
- bind $list <B1-Motion> "tkMotifFDialog_Browse$cmdPrefix $w"
- bind $list <Double-ButtonRelease-1> "tkMotifFDialog_Activate$cmdPrefix $w"
- bind $list <Return> "tkMotifFDialog_Browse$cmdPrefix $w; \
- tkMotifFDialog_Activate$cmdPrefix $w"
-
- bindtags $list "Listbox $list [winfo toplevel $list] all"
+ bind $list <Up> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <Down> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <space> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <1> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <B1-Motion> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <Double-ButtonRelease-1> \
+ [list tkMotifFDialog_Activate$cmdPrefix $w]
+ bind $list <Return> "tkMotifFDialog_Browse$cmdPrefix [list $w]; \
+ tkMotifFDialog_Activate$cmdPrefix [list $w]"
+
+ bindtags $list [list Listbox $list [winfo toplevel $list] all]
tkListBoxKeyAccel_Set $list
return $f.l
@@ -382,10 +380,10 @@ proc tkMotifFDialog_InterpFilter {w} {
# Perform tilde substitution
#
set badTilde 0
- if {[string compare [string index $text 0] ~] == 0} {
+ if {[string equal [string index $text 0] ~]} {
set list [file split $text]
set tilde [lindex $list 0]
- if [catch {set tilde [glob $tilde]}] {
+ if {[catch {set tilde [glob $tilde]}]} {
set badTilde 1
} else {
set text [eval file join [concat $tilde [lrange $list 1 end]]]
@@ -396,7 +394,7 @@ proc tkMotifFDialog_InterpFilter {w} {
# with the current selectPath.
set relative 0
- if {[file pathtype $text] == "relative"} {
+ if {[string equal [file pathtype $text] "relative"]} {
set relative 1
} elseif {$badTilde} {
set relative 1
@@ -415,7 +413,7 @@ proc tkMotifFDialog_InterpFilter {w} {
set resolved [tkFDialog_JoinFile [file dirname $text] [file tail $text]]
- if [file isdirectory $resolved] {
+ if {[file isdirectory $resolved]} {
set dir $resolved
set fil $data(filter)
} else {
@@ -467,9 +465,7 @@ proc tkMotifFDialog_LoadFiles {w} {
$data(fList) delete 0 end
set appPWD [pwd]
- if [catch {
- cd $data(selectPath)
- }] {
+ if {[catch {cd $data(selectPath)}]} {
cd $appPWD
$data(dList) insert end ".."
@@ -479,13 +475,13 @@ proc tkMotifFDialog_LoadFiles {w} {
# Make the dir list
#
foreach f [lsort -dictionary [glob -nocomplain .* *]] {
- if [file isdir ./$f] {
+ if {[file isdir ./$f]} {
$data(dList) insert end $f
}
}
# Make the file list
#
- if ![string compare $data(filter) *] {
+ if {[string equal $data(filter) *]} {
set files [lsort -dictionary [glob -nocomplain .* *]]
} else {
set files [lsort -dictionary \
@@ -494,10 +490,10 @@ proc tkMotifFDialog_LoadFiles {w} {
set top 0
foreach f $files {
- if ![file isdir ./$f] {
+ if {![file isdir ./$f]} {
regsub {^[.]/} $f "" f
$data(fList) insert end $f
- if [string match .* $f] {
+ if {[string match .* $f]} {
incr top
}
}
@@ -525,11 +521,11 @@ proc tkMotifFDialog_BrowseDList {w} {
upvar #0 [winfo name $w] data
focus $data(dList)
- if {![string compare [$data(dList) curselection] ""]} {
+ if {[string equal [$data(dList) curselection] ""]} {
return
}
set subdir [$data(dList) get [$data(dList) curselection]]
- if {![string compare $subdir ""]} {
+ if {[string equal $subdir ""]} {
return
}
@@ -570,11 +566,11 @@ proc tkMotifFDialog_BrowseDList {w} {
proc tkMotifFDialog_ActivateDList {w} {
upvar #0 [winfo name $w] data
- if {![string compare [$data(dList) curselection] ""]} {
+ if {[string equal [$data(dList) curselection] ""]} {
return
}
set subdir [$data(dList) get [$data(dList) curselection]]
- if {![string compare $subdir ""]} {
+ if {[string equal $subdir ""]} {
return
}
@@ -619,11 +615,11 @@ proc tkMotifFDialog_BrowseFList {w} {
upvar #0 [winfo name $w] data
focus $data(fList)
- if {![string compare [$data(fList) curselection] ""]} {
+ if {[string equal [$data(fList) curselection] ""]} {
return
}
set data(selectFile) [$data(fList) get [$data(fList) curselection]]
- if {![string compare $data(selectFile) ""]} {
+ if {[string equal $data(selectFile) ""]} {
return
}
@@ -653,11 +649,11 @@ proc tkMotifFDialog_BrowseFList {w} {
proc tkMotifFDialog_ActivateFList {w} {
upvar #0 [winfo name $w] data
- if {![string compare [$data(fList) curselection] ""]} {
+ if {[string equal [$data(fList) curselection] ""]} {
return
}
set data(selectFile) [$data(fList) get [$data(fList) curselection]]
- if {![string compare $data(selectFile) ""]} {
+ if {[string equal $data(selectFile) ""]} {
return
} else {
tkMotifFDialog_ActivateSEnt $w
@@ -707,7 +703,7 @@ proc tkMotifFDialog_ActivateSEnt {w} {
set selectFile [file tail $selectFilePath]
set selectPath [file dirname $selectFilePath]
- if {![string compare $selectFilePath ""]} {
+ if {[string equal $selectFilePath ""]} {
tkMotifFDialog_FilterCmd $w
return
}
@@ -732,19 +728,19 @@ proc tkMotifFDialog_ActivateSEnt {w} {
}
if {![file exists $selectFilePath]} {
- if {![string compare $data(type) open]} {
+ if {[string equal $data(type) open]} {
tk_messageBox -icon warning -type ok \
-message "File \"$selectFilePath\" does not exist."
return
}
} else {
- if {![string compare $data(type) save]} {
+ if {[string equal $data(type) save]} {
set message [format %s%s \
"File \"$selectFilePath\" already exists.\n\n" \
"Replace existing file?"]
set answer [tk_messageBox -icon warning -type yesno \
-message $message]
- if {![string compare $answer "no"]} {
+ if {[string equal $answer "no"]} {
return
}
}
@@ -778,8 +774,8 @@ proc tkMotifFDialog_CancelCmd {w} {
proc tkListBoxKeyAccel_Set {w} {
bind Listbox <Any-KeyPress> ""
- bind $w <Destroy> "tkListBoxKeyAccel_Unset $w"
- bind $w <Any-KeyPress> "tkListBoxKeyAccel_Key $w %A"
+ bind $w <Destroy> [list tkListBoxKeyAccel_Unset $w]
+ bind $w <Any-KeyPress> [list tkListBoxKeyAccel_Key $w %A]
}
proc tkListBoxKeyAccel_Unset {w} {