diff options
| author | hobbs <hobbs> | 1999-09-02 17:02:52 (GMT) |
|---|---|---|
| committer | hobbs <hobbs> | 1999-09-02 17:02:52 (GMT) |
| commit | 2abe00f21824a55ee6096189dc4979ca29af2e2e (patch) | |
| tree | ccf3e977fda229d63d171853a7b5e3c8e3564996 | |
| parent | b598f1d55d8f6a4aefb4d53d8639f8f04bf94cf2 (diff) | |
| download | tk-2abe00f21824a55ee6096189dc4979ca29af2e2e.zip tk-2abe00f21824a55ee6096189dc4979ca29af2e2e.tar.gz tk-2abe00f21824a55ee6096189dc4979ca29af2e2e.tar.bz2 | |
1999-09-01 Jeff Hobbs <hobbs@scriptics.com>
* library/msgbox.tcl: changed the behavior of tk_messageBox on
Unix to be more Windows like in handling of <Return> and the
default button
* library/button.tcl:
* library/clrpick.tcl:
* library/comdlg.tcl:
* library/console.tcl:
* library/dialog.tcl:
* library/entry.tcl:
* library/focus.tcl:
* library/listbox.tcl:
* library/menu.tcl:
* library/msgbox.tcl:
* library/palette.tcl:
* library/safetk.tcl:
* library/scale.tcl:
* library/scrlbar.tcl:
* library/tearoff.tcl:
* library/text.tcl:
* library/tk.tcl:
* library/tkfbox.tcl:
* library/xmfbox.tcl: updated commands to use [string] ops
instead of expr equality operators
| -rw-r--r-- | library/button.tcl | 28 | ||||
| -rw-r--r-- | library/clrpick.tcl | 80 | ||||
| -rw-r--r-- | library/comdlg.tcl | 23 | ||||
| -rw-r--r-- | library/console.tcl | 56 | ||||
| -rw-r--r-- | library/dialog.tcl | 27 | ||||
| -rw-r--r-- | library/entry.tcl | 20 | ||||
| -rw-r--r-- | library/focus.tcl | 30 | ||||
| -rw-r--r-- | library/listbox.tcl | 24 | ||||
| -rw-r--r-- | library/menu.tcl | 280 | ||||
| -rw-r--r-- | library/msgbox.tcl | 59 | ||||
| -rw-r--r-- | library/palette.tcl | 19 | ||||
| -rw-r--r-- | library/safetk.tcl | 51 | ||||
| -rw-r--r-- | library/scale.tcl | 33 | ||||
| -rw-r--r-- | library/scrlbar.tcl | 48 | ||||
| -rw-r--r-- | library/tearoff.tcl | 20 | ||||
| -rw-r--r-- | library/text.tcl | 45 | ||||
| -rw-r--r-- | library/tk.tcl | 62 | ||||
| -rw-r--r-- | library/tkfbox.tcl | 161 | ||||
| -rw-r--r-- | library/xmfbox.tcl | 126 |
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} { |