diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | library/button.tcl | 16 | ||||
| -rw-r--r-- | library/choosedir.tcl | 37 | ||||
| -rw-r--r-- | library/comdlg.tcl | 21 | ||||
| -rw-r--r-- | library/console.tcl | 10 | ||||
| -rw-r--r-- | library/dialog.tcl | 25 | ||||
| -rw-r--r-- | library/entry.tcl | 32 | ||||
| -rw-r--r-- | library/focus.tcl | 23 | ||||
| -rw-r--r-- | library/listbox.tcl | 28 | ||||
| -rw-r--r-- | library/menu.tcl | 230 | ||||
| -rw-r--r-- | library/palette.tcl | 4 | ||||
| -rw-r--r-- | library/panedwindow.tcl | 75 | ||||
| -rw-r--r-- | library/safetk.tcl | 4 | ||||
| -rw-r--r-- | library/scale.tcl | 34 | ||||
| -rw-r--r-- | library/scrlbar.tcl | 22 | ||||
| -rw-r--r-- | library/spinbox.tcl | 12 | ||||
| -rw-r--r-- | library/tearoff.tcl | 18 | ||||
| -rw-r--r-- | library/tk.tcl | 101 | ||||
| -rw-r--r-- | library/tkfbox.tcl | 222 | ||||
| -rw-r--r-- | library/xmfbox.tcl | 73 |
20 files changed, 500 insertions, 492 deletions
@@ -1,3 +1,8 @@ +2005-07-25 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/*.tcl: Updated to use more 8.4 and 8.5 features as part + of resolving [Patch 1237759]. + 2005-07-22 Mo DeJong <mdejong@users.sourceforge.net> * win/tkWinX.c: Define _WIN32_WINNT with NT SP 3 data diff --git a/library/button.tcl b/library/button.tcl index 0810375..28c233b 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.18 2004/03/17 18:15:44 das Exp $ +# RCS: @(#) $Id: button.tcl,v 1.19 2005/07/25 09:06:01 dkf Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -18,7 +18,7 @@ # The code below creates the default class bindings for buttons. #------------------------------------------------------------------------- -if {[string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "aqua"} { bind Radiobutton <Enter> { tk::ButtonEnter %W } @@ -38,7 +38,7 @@ if {[string equal [tk windowingsystem] "aqua"]} { tk::ButtonUp %W } } -if {[string equal "windows" $tcl_platform(platform)]} { +if {"windows" eq $tcl_platform(platform)} { bind Checkbutton <equal> { tk::CheckRadioInvoke %W select } @@ -68,7 +68,7 @@ if {[string equal "windows" $tcl_platform(platform)]} { tk::CheckRadioEnter %W } } -if {[string equal "x11" [tk windowingsystem]]} { +if {"x11" eq [tk windowingsystem]} { bind Checkbutton <Return> { if {!$tk_strictMotif} { tk::CheckRadioInvoke %W @@ -127,7 +127,7 @@ bind Radiobutton <Leave> { tk::ButtonLeave %W } -if {[string equal "windows" $tcl_platform(platform)]} { +if {"windows" eq $tcl_platform(platform)} { ######################### # Windows implementation @@ -308,7 +308,7 @@ proc ::tk::CheckRadioDown w { } -if {[string equal "x11" [tk windowingsystem]]} { +if {"x11" eq [tk windowingsystem]} { ##################### # Unix implementation @@ -416,7 +416,7 @@ proc ::tk::ButtonDown w { proc ::tk::ButtonUp w { variable ::tk::Priv - if {[string equal $w $Priv(buttonWindow)]} { + if {$w eq $Priv(buttonWindow)} { set Priv(buttonWindow) "" # Restore the button's relief if it was cached. @@ -444,7 +444,7 @@ proc ::tk::ButtonUp w { } -if {[string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "aqua"} { #################### # Mac implementation diff --git a/library/choosedir.tcl b/library/choosedir.tcl index 0307c15..1a054bd 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -5,7 +5,7 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: choosedir.tcl,v 1.16 2005/04/12 20:33:12 hobbs Exp $ +# RCS: @(#) $Id: choosedir.tcl,v 1.17 2005/07/25 09:06:01 dkf Exp $ # Make sure the tk::dialog namespace, in which all dialogs should live, exists namespace eval ::tk::dialog {} @@ -27,9 +27,9 @@ proc ::tk::dialog::file::chooseDir:: {args} { variable ::tk::Priv set dataName __tk_choosedir upvar ::tk::dialog::file::$dataName data - ::tk::dialog::file::chooseDir::Config $dataName $args + Config $dataName $args - if {[string equal $data(-parent) .]} { + if {$data(-parent) eq "."} { set w .$dataName } else { set w $data(-parent).$dataName @@ -39,7 +39,7 @@ proc ::tk::dialog::file::chooseDir:: {args} { # if {![winfo exists $w]} { ::tk::dialog::file::Create $w TkChooseDir - } elseif {[string compare [winfo class $w] TkChooseDir]} { + } elseif {[winfo class $w] ne "TkChooseDir"} { destroy $w ::tk::dialog::file::Create $w TkChooseDir } else { @@ -202,24 +202,24 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { # that directory. set selection [tk::IconList_Curselection $data(icons)] - if { [llength $selection] != 0 } { + if {[llength $selection] != 0} { set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]] set iconText [file join $data(selectPath) $iconText] - ::tk::dialog::file::chooseDir::Done $w $iconText + Done $w $iconText } else { set text [$data(ent) get] - if { [string equal $text ""] } { + if {$text eq ""} { return } - set text [eval file join [file split [string trim $text]]] - if { ![file exists $text] || ![file isdirectory $text] } { + set text [file join {expand}[file split [string trim $text]]] + if {![file exists $text] || ![file isdirectory $text]} { # Entry contains an invalid directory. If it's the same as the # last time they came through here, reset the saved value and end # the dialog. Otherwise, save the value (so we can do this test # next time). - if { [string equal $text $data(previousEntryText)] } { + if {$text eq $data(previousEntryText)} { set data(previousEntryText) "" - ::tk::dialog::file::chooseDir::Done $w $text + Done $w $text } else { set data(previousEntryText) $text } @@ -227,8 +227,8 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { # Entry contains a valid directory. If it is the same as the # current directory, end the dialog. Otherwise, change to that # directory. - if { [string equal $text $data(selectPath)] } { - ::tk::dialog::file::chooseDir::Done $w $text + if {$text eq $data(selectPath)} { + Done $w $text } else { set data(selectPath) $text } @@ -240,7 +240,7 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { proc ::tk::dialog::file::chooseDir::DblClick {w} { upvar ::tk::dialog::file::[winfo name $w] data set selection [tk::IconList_Curselection $data(icons)] - if { [llength $selection] != 0 } { + if {[llength $selection] != 0} { set filenameFragment \ [tk::IconList_Get $data(icons) [lindex $selection 0]] set file $data(selectPath) @@ -257,7 +257,7 @@ proc ::tk::dialog::file::chooseDir::DblClick {w} { proc ::tk::dialog::file::chooseDir::ListBrowse {w text} { upvar ::tk::dialog::file::[winfo name $w] data - if {[string equal $text ""]} { + if {$text eq ""} { return } @@ -278,12 +278,11 @@ proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} { upvar ::tk::dialog::file::[winfo name $w] data variable ::tk::Priv - if {[string equal $selectFilePath ""]} { + if {$selectFilePath eq ""} { set selectFilePath $data(selectPath) } - if { $data(-mustexist) } { - if { ![file exists $selectFilePath] || \ - ![file isdir $selectFilePath] } { + if {$data(-mustexist)} { + if {![file exists $selectFilePath] || ![file isdir $selectFilePath]} { return } } diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 5192791..1a7ab8f 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.10 2005/04/05 13:56:35 dgp Exp $ +# RCS: @(#) $Id: comdlg.tcl,v 1.11 2005/07/25 09:06:01 dkf Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # @@ -121,7 +121,7 @@ proc tclListValidFlags {v} { # proc ::tk::FocusGroup_Create {t} { variable ::tk::Priv - if {[string compare [winfo toplevel $t] $t]} { + if {[winfo toplevel $t] ne $t} { error "$t is not a toplevel window" } if {![info exists Priv(fg,$t)]} { @@ -173,7 +173,7 @@ proc ::tk::FocusGroup_Destroy {t w} { variable FocusOut variable ::tk::Priv - if {[string equal $t $w]} { + if {$t eq $w} { unset Priv(fg,$t) unset Priv(focus,$t) @@ -184,8 +184,7 @@ proc ::tk::FocusGroup_Destroy {t w} { unset FocusOut($name) } } else { - if {[info exists Priv(focus,$t)] && \ - [string equal $Priv(focus,$t) $w]} { + if {[info exists Priv(focus,$t)] && ($Priv(focus,$t) eq $w)} { set Priv(focus,$t) "" } catch { @@ -206,8 +205,7 @@ proc ::tk::FocusGroup_In {t w detail} { variable FocusIn variable ::tk::Priv - if {[string compare $detail NotifyNonlinear] && \ - [string compare $detail NotifyNonlinearVirtual]} { + if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"]} { # This is caused by mouse moving out&in of the window *or* # ordinary keypresses some window managers (ie: CDE [Bug: 2960]). return @@ -219,7 +217,7 @@ proc ::tk::FocusGroup_In {t w detail} { if {![info exists Priv(focus,$t)]} { return } - if {[string equal $Priv(focus,$t) $w]} { + if {$Priv(focus,$t) eq $w} { # This is already in focus # return @@ -240,8 +238,7 @@ proc ::tk::FocusGroup_Out {t w detail} { variable FocusOut variable ::tk::Priv - if {[string compare $detail NotifyNonlinear] && \ - [string compare $detail NotifyNonlinearVirtual]} { + if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} { # This is caused by mouse moving out of the window return } @@ -267,7 +264,7 @@ proc ::tk::FDGetFileTypes {string} { if {[llength $t] < 2 || [llength $t] > 3} { error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" } - eval lappend [list fileTypes([lindex $t 0])] [lindex $t 1] + lappend fileTypes([lindex $t 0]) {expand}[lindex $t 1] } set types {} @@ -292,7 +289,7 @@ proc ::tk::FDGetFileTypes {string} { set sep "" set doAppend 1 foreach ext $fileTypes($label) { - if {[string equal $ext ""]} { + if {$ext eq ""} { continue } regsub {^[.]} $ext "*." ext diff --git a/library/console.tcl b/library/console.tcl index 893e086..ddd52e6 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.28 2005/05/31 04:59:38 hobbs Exp $ +# RCS: @(#) $Id: console.tcl,v 1.29 2005/07/25 09:06:01 dkf Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. @@ -83,7 +83,7 @@ proc ::tk::ConsoleInit {} { AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\ -command {event generate .console <<Paste>>} - if {[string compare $tcl_platform(platform) "windows"]} { + if {$tcl_platform(platform) ne "windows"} { AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \ -command {event generate .console <<Clear>>} } else { @@ -169,7 +169,7 @@ proc ::tk::ConsoleSource {} { -filetypes [list \ [list [mc "Tcl Scripts"] .tcl] \ [list [mc "All Files"] *]]] - if {[string compare $filename ""]} { + if {$filename ne ""} { set cmd [list source $filename] if {[catch {consoleinterp eval $cmd} result]} { ConsoleOutput stderr "$result\n" @@ -190,7 +190,7 @@ proc ::tk::ConsoleInvoke {args} { set cmd "" if {[llength $ranges]} { set pos 0 - while {[string compare [lindex $ranges $pos] ""]} { + while {[lindex $ranges $pos] ne ""} { set start [lindex $ranges $pos] set end [lindex $ranges [incr pos]] append cmd [.console get $start $end] @@ -957,7 +957,7 @@ proc ::tk::console::ExpandProcname str { # possible further matches proc ::tk::console::ExpandVariable str { - if {[regexp {([^\(]*)\((.*)} $str junk ary str]} { + if {[regexp {([^\(]*)\((.*)} $str -> ary str]} { ## Looks like they're trying to expand an array. set match [EvalAttached [list array names $ary $str*]] if {[llength $match] > 1} { diff --git a/library/dialog.tcl b/library/dialog.tcl index 45569fc..2c5830d 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.17 2004/03/17 18:15:44 das Exp $ +# RCS: @(#) $Id: dialog.tcl,v 1.18 2005/07/25 09:06:01 dkf Exp $ # # Copyright (c) 1992-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -39,7 +39,7 @@ proc ::tk_dialog {w title text bitmap default args} { return -code error "default button index greater than number of\ buttons specified for tk_dialog" } - } elseif {[string equal {} $default]} { + } elseif {"" eq $default} { set default -1 } else { set default [lsearch -exact $args $default] @@ -65,13 +65,13 @@ proc ::tk_dialog {w title text bitmap default args} { wm transient $w [winfo toplevel [winfo parent $w]] } - if {[string equal [tk windowingsystem] "aqua"]} { + if {[tk windowingsystem] eq "aqua"} { ::tk::unsupported::MacWindowStyle style $w dBoxProc } frame $w.bot frame $w.top - if {[string equal [tk windowingsystem] "x11"]} { + if {[tk windowingsystem] eq "x11"} { $w.bot configure -relief raised -bd 1 $w.top configure -relief raised -bd 1 } @@ -84,7 +84,7 @@ proc ::tk_dialog {w title text bitmap default args} { # overridden by the caller). option add *Dialog.msg.wrapLength 3i widgetDefault - if {[string equal [tk windowingsystem] "aqua"]} { + if {[tk windowingsystem] eq "aqua"} { option add *Dialog.msg.font system widgetDefault } else { option add *Dialog.msg.font {Times 12} widgetDefault @@ -92,9 +92,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 equal [tk windowingsystem] "aqua"] &&\ - [string equal $bitmap "error"]} { + if {$bitmap ne ""} { + if {[tk windowingsystem] eq "aqua" && $bitmap eq "error"} { set bitmap "stop" } label $w.bitmap -bitmap $bitmap @@ -115,9 +114,9 @@ proc ::tk_dialog {w title text bitmap default args} { -padx 10 -pady 4 grid columnconfigure $w.bot $i # We boost the size of some Mac buttons for l&f - if {[string equal [tk windowingsystem] "aqua"]} { + if {[tk windowingsystem] eq "aqua"} { set tmp [string tolower $but] - if {[string equal $tmp "ok"] || [string equal $tmp "cancel"]} { + if {$tmp eq "ok" || $tmp eq "cancel"} { grid columnconfigure $w.bot $i -minsize [expr {59 + 20}] } } @@ -169,7 +168,7 @@ proc ::tk_dialog {w title text bitmap default args} { set oldFocus [focus] set oldGrab [grab current $w] - if {[string compare $oldGrab ""]} { + if {$oldGrab ne ""} { set grabStatus [grab status $oldGrab] } grab $w @@ -195,8 +194,8 @@ proc ::tk_dialog {w title text bitmap default args} { bind $w <Destroy> {} destroy $w } - if {[string compare $oldGrab ""]} { - if {[string compare $grabStatus "global"]} { + if {$oldGrab ne ""} { + if {$grabStatus ne "global"} { grab $oldGrab } else { grab -global $oldGrab diff --git a/library/entry.tcl b/library/entry.tcl index e882972..32b1973 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.23 2004/10/19 18:56:01 jenglish Exp $ +# RCS: @(#) $Id: entry.tcl,v 1.24 2005/07/25 09:06:00 dkf 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 [tk windowingsystem] "x11"]} { + if {[tk windowingsystem] ne "x11"} { catch { %W delete sel.first sel.last } @@ -209,13 +209,13 @@ bind Entry <Escape> {# nothing} bind Entry <Return> {# nothing} bind Entry <KP_Enter> {# nothing} bind Entry <Tab> {# nothing} -if {[string equal [tk windowingsystem] "aqua"]} { - bind Entry <Command-KeyPress> {# nothing} +if {[tk windowingsystem] eq "aqua"} { + bind Entry <Command-KeyPress> {# nothing} } # On Windows, paste is done using Shift-Insert. Shift-Insert already # generates the <<Paste>> event, so we don't need to do anything here. -if {[string compare $tcl_platform(platform) "windows"]} { +if {$tcl_platform(platform) ne "windows"} { bind Entry <Insert> { catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]} } @@ -337,7 +337,9 @@ proc ::tk::EntryButton1 {w x} { set Priv(pressX) $x $w icursor [EntryClosestGap $w $x] $w selection from insert - if {[string compare "disabled" [$w cget -state]]} {focus $w} + if {"disabled" ne [$w cget -state]} { + focus $w + } } # ::tk::EntryMouseSelect -- @@ -408,7 +410,9 @@ proc ::tk::EntryMouseSelect {w x} { proc ::tk::EntryPaste {w x} { $w icursor [EntryClosestGap $w $x] catch {$w insert insert [::tk::GetSelection $w PRIMARY]} - if {[string compare "disabled" [$w cget -state]]} {focus $w} + if {"disabled" ne [$w cget -state]} { + focus $w + } } # ::tk::EntryAutoScan -- @@ -424,7 +428,9 @@ proc ::tk::EntryPaste {w x} { proc ::tk::EntryAutoScan {w} { variable ::tk::Priv set x $Priv(x) - if {![winfo exists $w]} return + if {![winfo exists $w]} { + return + } if {$x >= [winfo width $w]} { $w xview scroll 2 units EntryMouseSelect $w $x @@ -465,7 +471,7 @@ proc ::tk::EntryKeySelect {w new} { # s - The string to insert (usually just a single character) proc ::tk::EntryInsert {w s} { - if {[string equal $s ""]} { + if {$s eq ""} { return } catch { @@ -492,7 +498,9 @@ proc ::tk::EntryBackspace w { $w delete sel.first sel.last } else { set x [expr {[$w index insert] - 1}] - if {$x >= 0} {$w delete $x} + if {$x >= 0} { + $w delete $x + } if {[$w index @0] >= [$w index insert]} { set range [$w xview] set left [lindex $range 0] @@ -567,7 +575,7 @@ proc ::tk::EntryTranspose w { # w - The entry window in which the cursor is to move. # start - Position at which to start search. -if {[string equal $tcl_platform(platform) "windows"]} { +if {$tcl_platform(platform) eq "windows"} { proc ::tk::EntryNextWord {w start} { set pos [tcl_endOfWord [$w get] [$w index $start]] if {$pos >= 0} { @@ -649,7 +657,7 @@ proc ::tk::EntryScanDrag {w x} { proc ::tk::EntryGetSelection {w} { set entryString [string range [$w get] [$w index sel.first] \ [expr {[$w index sel.last] - 1}]] - if {[string compare [$w cget -show] ""]} { + if {[$w cget -show] ne ""} { return [string repeat [string index [$w cget -show] 0] \ [string length $entryString]] } diff --git a/library/focus.tcl b/library/focus.tcl index 75bf410..5894e94 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.9 2001/08/01 16:21:11 dgp Exp $ +# RCS: @(#) $Id: focus.tcl,v 1.10 2005/07/25 09:06:00 dkf 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 equal [winfo toplevel $cur] $cur]} { + if {[winfo toplevel $cur] eq $cur} { continue } else { break @@ -50,14 +50,14 @@ proc ::tk_focusNext w { # look for its next sibling. set cur $parent - if {[string equal [winfo toplevel $cur] $cur]} { + if {[winfo toplevel $cur] eq $cur} { break } set parent [winfo parent $parent] set children [winfo children $parent] set i [lsearch -exact $children $cur] } - if {[string equal $w $cur] || [tk::FocusOK $cur]} { + if {$w eq $cur || [tk::FocusOK $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 equal [winfo toplevel $cur] $cur]} { + if {[winfo toplevel $cur] eq $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 equal [winfo toplevel $cur] $cur]} { + if {[winfo toplevel $cur] eq $cur} { continue } set parent $cur @@ -108,7 +108,7 @@ proc ::tk_focusPrev w { set i [llength $children] } set cur $parent - if {[string equal $w $cur] || [tk::FocusOK $cur]} { + if {$w eq $cur || [tk::FocusOK $cur]} { return $cur } } @@ -146,7 +146,7 @@ proc ::tk::FocusOK w { return 0 } set code [catch {$w cget -state} value] - if {($code == 0) && [string equal $value "disabled"]} { + if {($code == 0) && $value eq "disabled"} { return 0 } regexp Key|Focus "[bind $w] [bind [winfo class $w]]" @@ -165,15 +165,14 @@ proc ::tk::FocusOK w { proc ::tk_focusFollowsMouse {} { set old [bind all <Enter>] set script { - if {[string equal "%d" "NotifyAncestor"] \ - || [string equal "%d" "NotifyNonlinear"] \ - || [string equal "%d" "NotifyInferior"]} { + if {"%d" eq "NotifyAncestor" || "%d" eq "NotifyNonlinear" \ + || "%d" eq "NotifyInferior"} { if {[tk::FocusOK %W]} { focus %W } } } - if {[string compare $old ""]} { + if {$old ne ""} { bind all <Enter> "$old; $script" } else { bind all <Enter> $script diff --git a/library/listbox.tcl b/library/listbox.tcl index ff3b549..9143f22 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.13 2002/08/31 06:12:28 das Exp $ +# RCS: @(#) $Id: listbox.tcl,v 1.14 2005/07/25 09:06:00 dkf 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> { tk::ListboxDataExtend %W [%W index end] } bind Listbox <<Copy>> { - if {[string equal [selection own -displayof %W] "%W"]} { + if {[selection own -displayof %W] eq "%W"} { clipboard clear -displayof %W clipboard append -displayof %W [selection get -displayof %W] } @@ -160,7 +160,7 @@ bind Listbox <Control-slash> { tk::ListboxSelectAll %W } bind Listbox <Control-backslash> { - if {[string compare [%W cget -selectmode] "browse"]} { + if {[%W cget -selectmode] ne "browse"} { %W selection clear 0 end event generate %W <<ListboxSelect>> } @@ -183,7 +183,7 @@ bind Listbox <MouseWheel> { %W yview scroll [expr {- (%D / 120) * 4}] units } -if {[string equal "x11" [tk windowingsystem]]} { +if {"x11" eq [tk windowingsystem]} { # Support for mousewheels on Linux/Unix commonly comes through mapping # the wheel to the extended buttons. If you have a mousewheel, find # Linux configuration info at: @@ -214,7 +214,7 @@ if {[string equal "x11" [tk windowingsystem]]} { proc ::tk::ListboxBeginSelect {w el} { variable ::tk::Priv - if {[string equal [$w cget -selectmode] "multiple"]} { + if {[$w cget -selectmode] eq "multiple"} { if {[$w selection includes $el]} { $w selection clear $el } else { @@ -255,7 +255,7 @@ proc ::tk::ListboxMotion {w el} { } extended { set i $Priv(listboxPrev) - if {[string equal {} $i]} { + if {$i eq ""} { set i $el $w selection set $el } @@ -300,7 +300,7 @@ proc ::tk::ListboxMotion {w el} { # one under the pointer). Must be in numerical form. proc ::tk::ListboxBeginExtend {w el} { - if {[string equal [$w cget -selectmode] "extended"]} { + if {[$w cget -selectmode] eq "extended"} { if {[$w selection includes anchor]} { ListboxMotion $w $el } else { @@ -324,7 +324,7 @@ proc ::tk::ListboxBeginExtend {w el} { proc ::tk::ListboxBeginToggle {w el} { variable ::tk::Priv - if {[string equal [$w cget -selectmode] "extended"]} { + if {[$w cget -selectmode] eq "extended"} { set Priv(listboxSelection) [$w curselection] set Priv(listboxPrev) $el $w selection anchor $el @@ -410,7 +410,7 @@ proc ::tk::ListboxUpDown {w amount} { proc ::tk::ListboxExtendUpDown {w amount} { variable ::tk::Priv - if {[string compare [$w cget -selectmode] "extended"]} { + if {[$w cget -selectmode] ne "extended"} { return } set active [$w index active] @@ -436,13 +436,13 @@ proc ::tk::ListboxExtendUpDown {w amount} { proc ::tk::ListboxDataExtend {w el} { set mode [$w cget -selectmode] - if {[string equal $mode "extended"]} { + if {$mode eq "extended"} { $w activate $el $w see $el if {[$w selection includes anchor]} { ListboxMotion $w $el } - } elseif {[string equal $mode "multiple"]} { + } elseif {$mode eq "multiple"} { $w activate $el $w see $el } @@ -460,12 +460,12 @@ proc ::tk::ListboxDataExtend {w el} { proc ::tk::ListboxCancel w { variable ::tk::Priv - if {[string compare [$w cget -selectmode] "extended"]} { + if {[$w cget -selectmode] ne "extended"} { return } set first [$w index anchor] set last $Priv(listboxPrev) - if { [string equal $last ""] } { + if {$last eq ""} { # Not actually doing any selection right now return } @@ -495,7 +495,7 @@ proc ::tk::ListboxCancel w { proc ::tk::ListboxSelectAll w { set mode [$w cget -selectmode] - if {[string equal $mode "single"] || [string equal $mode "browse"]} { + if {$mode eq "single" || $mode eq "browse"} { $w selection clear 0 end $w selection set active } else { diff --git a/library/menu.tcl b/library/menu.tcl index e8e2f7c..5589475 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.21 2005/05/27 18:06:26 tmh Exp $ +# RCS: @(#) $Id: menu.tcl,v 1.22 2005/07/25 09:06:00 dkf Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -169,7 +169,7 @@ bind Menu <KeyPress> { # The following bindings apply to all windows, and are used to # implement keyboard menu traversal. -if {[string equal [tk windowingsystem] "x11"]} { +if {[tk windowingsystem] eq "x11"} { bind all <Alt-KeyPress> { tk::TraverseToMenu %W %A } @@ -199,11 +199,11 @@ if {[string equal [tk windowingsystem] "x11"]} { proc ::tk::MbEnter w { variable ::tk::Priv - if {[string compare $Priv(inMenubutton) ""]} { + if {$Priv(inMenubutton) ne ""} { MbLeave $Priv(inMenubutton) } set Priv(inMenubutton) $w - if {[string compare [$w cget -state] "disabled"]} { + if {[$w cget -state] ne "disabled"} { $w configure -state active } } @@ -222,7 +222,7 @@ proc ::tk::MbLeave w { if {![winfo exists $w]} { return } - if {[string equal [$w cget -state] "active"]} { + if {[$w cget -state] eq "active"} { $w configure -state normal } } @@ -248,7 +248,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { return } set menu [$w cget -menu] - if {[string equal $menu ""]} { + if {$menu eq ""} { return } set tearoff [expr {[tk windowingsystem] eq "x11" \ @@ -257,7 +257,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)" } set cur $Priv(postedMb) - if {[string compare $cur ""]} { + if {$cur ne ""} { MenuUnpost {} } set Priv(cursor) [$w cget -cursor] @@ -338,7 +338,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { } default { if {[$w cget -indicatoron]} { - if {[string equal $y {}]} { + if {$y eq ""} { set x [expr {[winfo rootx $w] + [winfo width $w]/2}] set y [expr {[winfo rooty $w] + [winfo height $w]/2}] } @@ -400,17 +400,17 @@ proc ::tk::MenuUnpost menu { # what was posted. catch { - if {[string compare $mb ""]} { + if {$mb ne ""} { set menu [$mb cget -menu] $menu unpost set Priv(postedMb) {} $mb configure -cursor $Priv(cursor) $mb configure -relief $Priv(relief) - } elseif {[string compare $Priv(popup) ""]} { + } elseif {$Priv(popup) ne ""} { $Priv(popup) unpost set Priv(popup) {} - } elseif {[string compare [$menu cget -type] "menubar"] \ - && [string compare [$menu cget -type] "tearoff"]} { + } elseif {[$menu cget -type] ne "menubar" \ + && [$menu cget -type] ne "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 @@ -418,7 +418,7 @@ proc ::tk::MenuUnpost menu { while {1} { set parent [winfo parent $menu] - if {[string compare [winfo class $parent] "Menu"] \ + if {[winfo class $parent] ne "Menu" \ || ![winfo ismapped $parent]} { break } @@ -426,13 +426,12 @@ proc ::tk::MenuUnpost menu { $parent postcascade none GenerateMenuSelect $parent set type [$parent cget -type] - if {[string equal $type "menubar"] || \ - [string equal $type "tearoff"]} { + if {$type eq "menubar" || $type eq "tearoff"]} { break } set menu $parent } - if {[string compare [$menu cget -type] "menubar"]} { + if {[$menu cget -type] ne "menubar"} { $menu unpost } } @@ -441,9 +440,9 @@ proc ::tk::MenuUnpost menu { if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} { # Release grab, if any, and restore the previous grab, if there # was one. - if {[string compare $menu ""]} { + if {$menu ne ""} { set grab [grab current $menu] - if {[string compare $grab ""]} { + if {$grab ne ""} { grab release $grab } } @@ -472,21 +471,20 @@ proc ::tk::MenuUnpost menu { proc ::tk::MbMotion {w upDown rootx rooty} { variable ::tk::Priv - if {[string equal $Priv(inMenubutton) $w]} { + if {$Priv(inMenubutton) eq $w} { return } set new [winfo containing $rootx $rooty] - if {[string compare $new $Priv(inMenubutton)] \ - && ([string equal $new ""] \ - || [string equal [winfo toplevel $new] [winfo toplevel $w]])} { - if {[string compare $Priv(inMenubutton) ""]} { + if {$new ne $Priv(inMenubutton) \ + && ($new eq "" || [winfo toplevel $new] eq [winfo toplevel $w])} { + if {$Priv(inMenubutton) ne ""} { MbLeave $Priv(inMenubutton) } - if {[string compare $new ""] \ - && [string equal [winfo class $new] "Menubutton"] \ + if {$new ne "" \ + && [winfo class $new] eq "Menubutton" \ && ([$new cget -indicatoron] == 0) \ && ([$w cget -indicatoron] == 0)} { - if {[string equal $upDown "down"]} { + if {$upDown eq "down"} { MbPost $new $rootx $rooty } else { MbEnter $new @@ -533,10 +531,9 @@ proc ::tk::MbButtonUp w { proc ::tk::MenuMotion {menu x y state} { variable ::tk::Priv - if {[string equal $menu $Priv(window)]} { - if {[string equal [$menu cget -type] "menubar"]} { - if {[info exists Priv(focus)] && \ - [string compare $menu $Priv(focus)]} { + if {$menu eq $Priv(window)} { + if {[$menu cget -type] eq "menubar"} { + if {[info exists Priv(focus)] && $menu ne $Priv(focus)} { $menu activate @$x,$y GenerateMenuSelect $menu } @@ -573,17 +570,16 @@ proc ::tk::MenuButtonDown menu { return } $menu postcascade active - if {[string compare $Priv(postedMb) ""] && \ - [winfo viewable $Priv(postedMb)]} { + if {$Priv(postedMb) ne "" && [winfo viewable $Priv(postedMb)]} { grab -global $Priv(postedMb) } else { - while {[string equal [$menu cget -type] "normal"] \ - && [string equal [winfo class [winfo parent $menu]] "Menu"] \ + while {[$menu cget -type] eq "normal" \ + && [winfo class [winfo parent $menu]] eq "Menu" \ && [winfo ismapped [winfo parent $menu]]} { set menu [winfo parent $menu] } - if {[string equal $Priv(menuBar) {}]} { + if {$Priv(menuBar) eq {}} { set Priv(menuBar) $menu set Priv(cursor) [$menu cget -cursor] $menu configure -cursor arrow @@ -594,14 +590,14 @@ proc ::tk::MenuButtonDown menu { # restore the grab, since the old grab window will not be viewable # anymore. - if {[string compare $menu [grab current $menu]]} { + if {$menu ne [grab current $menu]} { SaveGrabInfo $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 equal [tk windowingsystem] "x11"]} { + if {[tk windowingsystem] eq "x11"} { grab -global $menu } } @@ -620,12 +616,12 @@ proc ::tk::MenuButtonDown menu { proc ::tk::MenuLeave {menu rootx rooty state} { variable ::tk::Priv set Priv(window) {} - if {[string equal [$menu index active] "none"]} { + if {[$menu index active] eq "none"} { return } - if {[string equal [$menu type active] "cascade"] - && [string equal [winfo containing $rootx $rooty] \ - [$menu entrycget active -menu]]} { + if {[$menu type active] eq "cascade" \ + && [winfo containing $rootx $rooty] eq \ + [$menu entrycget active -menu]} { return } $menu activate none @@ -645,7 +641,7 @@ proc ::tk::MenuLeave {menu rootx rooty state} { proc ::tk::MenuInvoke {w buttonRelease} { variable ::tk::Priv - if {$buttonRelease && [string equal $Priv(window) {}]} { + if {$buttonRelease && $Priv(window) eq ""} { # 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. @@ -656,14 +652,14 @@ proc ::tk::MenuInvoke {w buttonRelease} { MenuUnpost $w return } - if {[string equal [$w type active] "cascade"]} { + if {[$w type active] eq "cascade"} { $w postcascade active set menu [$w entrycget active -menu] MenuFirstEntry $menu - } elseif {[string equal [$w type active] "tearoff"]} { + } elseif {[$w type active] eq "tearoff"} { ::tk::TearOffMenu $w MenuUnpost $w - } elseif {[string equal [$w cget -type] "menubar"]} { + } elseif {[$w cget -type] eq "menubar"} { $w postcascade none set active [$w index active] set isCascade [string equal [$w type $active] "cascade"] @@ -705,9 +701,9 @@ proc ::tk::MenuInvoke {w buttonRelease} { proc ::tk::MenuEscape menu { set parent [winfo parent $menu] - if {[string compare [winfo class $parent] "Menu"]} { + if {[winfo class $parent] ne "Menu"} { MenuUnpost $menu - } elseif {[string equal [$parent cget -type] "menubar"]} { + } elseif {[$parent cget -type] eq "menubar"} { MenuUnpost $menu RestoreOldGrab } else { @@ -719,7 +715,7 @@ proc ::tk::MenuEscape menu { # differently depending on whether the menu is a menu bar or not. proc ::tk::MenuUpArrow {menu} { - if {[string equal [$menu cget -type] "menubar"]} { + if {[$menu cget -type] eq "menubar"} { MenuNextMenu $menu left } else { MenuNextEntry $menu -1 @@ -727,7 +723,7 @@ proc ::tk::MenuUpArrow {menu} { } proc ::tk::MenuDownArrow {menu} { - if {[string equal [$menu cget -type] "menubar"]} { + if {[$menu cget -type] eq "menubar"} { MenuNextMenu $menu right } else { MenuNextEntry $menu 1 @@ -735,7 +731,7 @@ proc ::tk::MenuDownArrow {menu} { } proc ::tk::MenuLeftArrow {menu} { - if {[string equal [$menu cget -type] "menubar"]} { + if {[$menu cget -type] eq "menubar"} { MenuNextEntry $menu -1 } else { MenuNextMenu $menu left @@ -743,7 +739,7 @@ proc ::tk::MenuLeftArrow {menu} { } proc ::tk::MenuRightArrow {menu} { - if {[string equal [$menu cget -type] "menubar"]} { + if {[$menu cget -type] eq "menubar"} { MenuNextEntry $menu 1 } else { MenuNextMenu $menu right @@ -765,22 +761,22 @@ proc ::tk::MenuNextMenu {menu direction} { # First handle traversals into and out of cascaded menus. - if {[string equal $direction "right"]} { + if {$direction eq "right"} { set count 1 set parent [winfo parent $menu] set class [winfo class $parent] - if {[string equal [$menu type active] "cascade"]} { + if {[$menu type active] eq "cascade"} { $menu postcascade active set m2 [$menu entrycget active -menu] - if {[string compare $m2 ""]} { + if {$m2 ne ""} { MenuFirstEntry $m2 } return } else { set parent [winfo parent $menu] - while {[string compare $parent "."]} { - if {[string equal [winfo class $parent] "Menu"] \ - && [string equal [$parent cget -type] "menubar"]} { + while {$parent ne "."} { + if {[winfo class $parent] eq "Menu" \ + && [$parent cget -type] eq "menubar"} { tk_menuSetFocus $parent MenuNextEntry $parent 1 return @@ -791,33 +787,31 @@ proc ::tk::MenuNextMenu {menu direction} { } else { set count -1 set m2 [winfo parent $menu] - if {[string equal [winfo class $m2] "Menu"]} { + if {[winfo class $m2] eq "Menu"} { $menu activate none GenerateMenuSelect $menu tk_menuSetFocus $m2 $m2 postcascade none - if {[string compare [$m2 cget -type] "menubar"]} { + if {[$m2 cget -type] ne "menubar"} { return } } } - # Can't traverse into or out of a cascaded menu. Go to the next + # Can't traverse into or out of a cascaded menu. Go to the next # or previous menubutton, if that makes sense. set m2 [winfo parent $menu] - if {[string equal [winfo class $m2] "Menu"]} { - if {[string equal [$m2 cget -type] "menubar"]} { - tk_menuSetFocus $m2 - MenuNextEntry $m2 -1 - return - } + if {[winfo class $m2] eq "Menu" && [$m2 cget -type] eq "menubar"} { + tk_menuSetFocus $m2 + MenuNextEntry $m2 -1 + return } set w $Priv(postedMb) - if {[string equal $w ""]} { + if {$w eq ""} { return } set buttons [winfo children [winfo parent $w]] @@ -831,13 +825,13 @@ proc ::tk::MenuNextMenu {menu direction} { incr i -$length } set mb [lindex $buttons $i] - 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"]} { + if {[winfo class $mb] eq "Menubutton" \ + && [$mb cget -state] ne "disabled" \ + && [$mb cget -menu] ne "" \ + && [[$mb cget -menu] index last] ne "none"} { break } - if {[string equal $mb $w]} { + if {$mb eq $w} { return } incr i $count @@ -856,14 +850,13 @@ proc ::tk::MenuNextMenu {menu direction} { # -1 means go to the next higher entry. proc ::tk::MenuNextEntry {menu count} { - - if {[string equal [$menu index last] "none"]} { + if {[$menu index last] eq "none"} { return } set length [expr {[$menu index last]+1}] set quitAfter $length set active [$menu index active] - if {[string equal $active "none"]} { + if {$active eq "none"} { set i 0 } else { set i [expr {$active + $count}] @@ -897,10 +890,9 @@ proc ::tk::MenuNextEntry {menu count} { $menu activate $i GenerateMenuSelect $menu - if {[string equal [$menu type $i] "cascade"] \ - && [string equal [$menu cget -type] "menubar"]} { + if {[$menu type $i] eq "cascade" && [$menu cget -type] eq "menubar"} { set cascade [$menu entrycget $i -menu] - if {[string compare $cascade ""]} { + if {$cascade ne ""} { # 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. @@ -932,24 +924,23 @@ proc ::tk::MenuFind {w char} { foreach child $windowlist { # Don't descend into other toplevels. - if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} { + if {[winfo toplevel $w] ne [winfo toplevel $child]} { continue } - if {[string equal [winfo class $child] "Menu"] && \ - [string equal [$child cget -type] "menubar"]} { - if {[string equal $char ""]} { + if {[winfo class $child] eq "Menu" && \ + [$child cget -type] eq "menubar"} { + if {$char eq ""} { return $child } set last [$child index last] for {set i [$child cget -tearoff]} {$i <= $last} {incr i} { - if {[string equal [$child type $i] "separator"]} { + if {[$child type $i] eq "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"]} { + if {$char eq [string tolower $char2] || $char eq ""} { + if {[$child entrycget $i -state] ne "disabled"} { return $child } } @@ -959,16 +950,15 @@ proc ::tk::MenuFind {w char} { foreach child $windowlist { # Don't descend into other toplevels. - if {[string compare [winfo toplevel $w] [winfo toplevel $child]]} { + if {[winfo toplevel $w] ne [winfo toplevel $child]} { continue } - switch [winfo class $child] { + switch -- [winfo class $child] { Menubutton { set char2 [string index [$child cget -text] \ [$child cget -underline]] - if {[string equal $char [string tolower $char2]] \ - || [string equal $char ""]} { - if {[string compare [$child cget -state] "disabled"]} { + if {$char eq [string tolower $char2] || $char eq ""} { + if {[$child cget -state] ne "disabled"} { return $child } } @@ -976,7 +966,7 @@ proc ::tk::MenuFind {w char} { default { set match [MenuFind $child $char] - if {[string compare $match ""]} { + if {$match ne ""} { return $match } } @@ -999,22 +989,21 @@ proc ::tk::MenuFind {w char} { proc ::tk::TraverseToMenu {w char} { variable ::tk::Priv - if {[string equal $char ""]} { + if {$char eq ""} { return } - while {[string equal [winfo class $w] "Menu"]} { - if {[string compare [$w cget -type] "menubar"] \ - && [string equal $Priv(postedMb) ""]} { + while {[winfo class $w] eq "Menu"} { + if {[$w cget -type] ne "menubar" && $Priv(postedMb) eq ""} { return } - if {[string equal [$w cget -type] "menubar"]} { + if {[$w cget -type] eq "menubar"} { break } set w [winfo parent $w] } set w [MenuFind [winfo toplevel $w] $char] - if {[string compare $w ""]} { - if {[string equal [winfo class $w] "Menu"]} { + if {$w ne ""} { + if {[winfo class $w] eq "Menu"} { tk_menuSetFocus $w set Priv(window) $w SaveGrabInfo $w @@ -1038,8 +1027,8 @@ proc ::tk::TraverseToMenu {w char} { proc ::tk::FirstMenu w { variable ::tk::Priv set w [MenuFind [winfo toplevel $w] ""] - if {[string compare $w ""]} { - if {[string equal [winfo class $w] "Menu"]} { + if {$w ne ""} { + if {[winfo class $w] eq "Menu"} { tk_menuSetFocus $w set Priv(window) $w SaveGrabInfo $w @@ -1064,12 +1053,12 @@ proc ::tk::FirstMenu w { # nothing happens. proc ::tk::TraverseWithinMenu {w char} { - if {[string equal $char ""]} { + if {$char eq ""} { return } set char [string tolower $char] set last [$w index last] - if {[string equal $last "none"]} { + if {$last eq "none"} { return } for {set i 0} {$i <= $last} {incr i} { @@ -1077,13 +1066,13 @@ proc ::tk::TraverseWithinMenu {w char} { [$w entrycget $i -label] [$w entrycget $i -underline]]}]} { continue } - if {[string equal $char [string tolower $char2]]} { - if {[string equal [$w type $i] "cascade"]} { + if {$char eq [string tolower $char2]} { + if {[$w type $i] eq "cascade"} { $w activate $i $w postcascade active event generate $w <<MenuSelect>> set m2 [$w entrycget $i -menu] - if {[string compare $m2 ""]} { + if {$m2 ne ""} { MenuFirstEntry $m2 } } else { @@ -1107,31 +1096,30 @@ proc ::tk::TraverseWithinMenu {w char} { # menu - Name of the menu window (possibly empty). proc ::tk::MenuFirstEntry menu { - if {[string equal $menu ""]} { + if {$menu eq ""} { return } tk_menuSetFocus $menu - if {[string compare [$menu index active] "none"]} { + if {[$menu index active] ne "none"} { return } set last [$menu index last] - if {[string equal $last "none"]} { + if {$last eq "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"]} { + && $state ne "disabled" && [$menu type $i] ne "tearoff"} { $menu activate $i GenerateMenuSelect $menu # Only post the cascade if the current menu is a menubar; # otherwise, if the first entry of the cascade is a cascade, # we can get an annoying cascading effect resulting in a bunch of # menus getting posted (bug 676) - if {[string equal [$menu type $i] "cascade"] && \ - [string equal [$menu cget -type] "menubar"]} { + if {[$menu type $i] eq "cascade" \ + && [$menu cget -type] eq "menubar"} { set cascade [$menu entrycget $i -menu] - if {[string compare $cascade ""]} { + if {$cascade ne ""} { $menu postcascade $i MenuFirstEntry $cascade } @@ -1159,12 +1147,12 @@ proc ::tk::MenuFindName {menu s} { return $i } set last [$menu index last] - if {[string equal $last "none"]} { + if {$last eq "none"} { return } for {set i 0} {$i <= $last} {incr i} { if {![catch {$menu entrycget $i -label} label]} { - if {[string equal $label $s]} { + if {$label eq $s} { return $i } } @@ -1187,7 +1175,7 @@ proc ::tk::MenuFindName {menu s} { proc ::tk::PostOverPoint {menu x y {entry {}}} { global tcl_platform - if {[string compare $entry {}]} { + if {$entry ne ""} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ + [winfo reqheight $menu])/2}] @@ -1252,7 +1240,7 @@ proc ::tk::RestoreOldGrab {} { # be visible anymore. catch { - if {[string equal $Priv(grabStatus) "global"]} { + if {$Priv(grabStatus) eq "global"} { grab set -global $Priv(oldGrab) } else { grab set $Priv(oldGrab) @@ -1264,7 +1252,7 @@ proc ::tk::RestoreOldGrab {} { proc ::tk_menuSetFocus {menu} { variable ::tk::Priv - if {![info exists Priv(focus)] || [string equal $Priv(focus) {}]} { + if {![info exists Priv(focus)] || $Priv(focus) eq ""} { set Priv(focus) [focus] } focus $menu @@ -1273,8 +1261,8 @@ proc ::tk_menuSetFocus {menu} { proc ::tk::GenerateMenuSelect {menu} { variable ::tk::Priv - if {[string equal $Priv(activeMenu) $menu] \ - && [string equal $Priv(activeItem) [$menu index active]]} { + if {$Priv(activeMenu) eq $menu \ + && $Priv(activeItem) eq [$menu index active]} { return } diff --git a/library/palette.tcl b/library/palette.tcl index 55834d3..0ec5b94 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.8 2001/11/29 10:54:21 dkf Exp $ +# RCS: @(#) $Id: palette.tcl,v 1.9 2005/07/25 09:06:00 dkf Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # @@ -174,7 +174,7 @@ proc ::tk::RecolorTree {w colors} { # dbOption, then use it, otherwise use the defaults # for the widget. set defaultcolor [option get $w $dbOption $class] - if {[string match {} $defaultcolor] || \ + if {$defaultcolor eq "" || \ ([info exists prototype] && \ [$prototype cget $option] ne "$defaultcolor")} { set defaultcolor [winfo rgb . [lindex $value 3]] diff --git a/library/panedwindow.tcl b/library/panedwindow.tcl index e09dd7a..f1f9f9a 100644 --- a/library/panedwindow.tcl +++ b/library/panedwindow.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk panedwindow widgets and # provides procedures that help in implementing those bindings. # -# RCS: @(#) $Id: panedwindow.tcl,v 1.10 2005/02/12 00:48:33 hobbs Exp $ +# RCS: @(#) $Id: panedwindow.tcl,v 1.11 2005/07/25 09:06:00 dkf Exp $ # bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 } @@ -35,16 +35,21 @@ namespace eval ::tk::panedwindow {} # None # proc ::tk::panedwindow::MarkSash {w x y proxy} { - if {[$w cget -opaqueresize]} { set proxy 0 } + variable ::tk::Priv + if {[$w cget -opaqueresize]} { + set proxy 0 + } set what [$w identify $x $y] if { [llength $what] == 2 } { - foreach {index which} $what break - if { !$::tk_strictMotif || [string equal $which "handle"] } { - if {!$proxy} { $w sash mark $index $x $y } - set ::tk::Priv(sash) $index - foreach {sx sy} [$w sash coord $index] break - set ::tk::Priv(dx) [expr {$sx-$x}] - set ::tk::Priv(dy) [expr {$sy-$y}] + lassign $what index which + if {!$::tk_strictMotif || $which eq "handle"} { + if {!$proxy} { + $w sash mark $index $x $y + } + set Priv(sash) $index + lassign [$w sash coord $index] sx sy + set Priv(dx) [expr {$sx-$x}] + set Priv(dy) [expr {$sy-$y}] # Do this to init the proxy location DragSash $w $x $y $proxy } @@ -64,14 +69,16 @@ proc ::tk::panedwindow::MarkSash {w x y proxy} { # Moves sash # proc ::tk::panedwindow::DragSash {w x y proxy} { - if {[$w cget -opaqueresize]} { set proxy 0 } - if { [info exists ::tk::Priv(sash)] } { + variable ::tk::Priv + if {[$w cget -opaqueresize]} { + set proxy 0 + } + if {[info exists Priv(sash)]} { if {$proxy} { - $w proxy place \ - [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}] + $w proxy place [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}] } else { - $w sash place $::tk::Priv(sash) \ - [expr {$x+$::tk::Priv(dx)}] [expr {$y+$::tk::Priv(dy)}] + $w sash place $Priv(sash) \ + [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}] } } } @@ -87,14 +94,17 @@ proc ::tk::panedwindow::DragSash {w x y proxy} { # Returns ... # proc ::tk::panedwindow::ReleaseSash {w proxy} { - if {[$w cget -opaqueresize]} { set proxy 0 } - if { [info exists ::tk::Priv(sash)] } { + variable ::tk::Priv + if {[$w cget -opaqueresize]} { + set proxy 0 + } + if {[info exists Priv(sash)]} { if {$proxy} { - foreach {x y} [$w proxy coord] break - $w sash place $::tk::Priv(sash) $x $y + lassign [$w proxy coord] x y + $w sash place $Priv(sash) $x $y $w proxy forget } - unset ::tk::Priv(sash) ::tk::Priv(dx) ::tk::Priv(dy) + unset Priv(sash) Priv(dx) Priv(dy) } } @@ -115,17 +125,15 @@ proc ::tk::panedwindow::Motion {w x y} { variable ::tk::Priv set id [$w identify $x $y] if {([llength $id] == 2) && \ - (!$::tk_strictMotif || [string equal [lindex $id 1] "handle"])} { - if { ![info exists Priv($w,panecursor)] } { + (!$::tk_strictMotif || [lindex $id 1] eq "handle")} { + if {![info exists Priv($w,panecursor)]} { set Priv($w,panecursor) [$w cget -cursor] - if { [string equal [$w cget -sashcursor] ""] } { - if { [string equal [$w cget -orient] "horizontal"] } { - $w configure -cursor sb_h_double_arrow - } else { - $w configure -cursor sb_v_double_arrow - } - } else { + if {[$w cget -sashcursor] ne ""} { $w configure -cursor [$w cget -sashcursor] + } elseif {[$w cget -orient] eq "horizontal"} { + $w configure -cursor sb_h_double_arrow + } else { + $w configure -cursor sb_v_double_arrow } if {[info exists Priv($w,pwAfterId)]} { after cancel $Priv($w,pwAfterId) @@ -135,7 +143,7 @@ proc ::tk::panedwindow::Motion {w x y} { } return } - if { [info exists Priv($w,panecursor)] } { + if {[info exists Priv($w,panecursor)]} { $w configure -cursor $Priv($w,panecursor) unset Priv($w,panecursor) } @@ -181,8 +189,9 @@ proc ::tk::panedwindow::Cursor {w} { # Restores the default cursor # proc ::tk::panedwindow::Leave {w} { - if {[info exists ::tk::Priv($w,panecursor)]} { - $w configure -cursor $::tk::Priv($w,panecursor) - unset ::tk::Priv($w,panecursor) + variable ::tk::Priv + if {[info exists Priv($w,panecursor)]} { + $w configure -cursor $Priv($w,panecursor) + unset Priv($w,panecursor) } } diff --git a/library/safetk.tcl b/library/safetk.tcl index 1993ade..5a14dde 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.8 2000/10/31 01:11:51 hobbs Exp $ +# RCS: @(#) $Id: safetk.tcl,v 1.9 2005/07/25 09:06:00 dkf Exp $ # # Copyright (c) 1997 Sun Microsystems, Inc. # @@ -126,7 +126,7 @@ proc ::safe::loadTk {} {} set nDisplay $display } } - if {[string compare $nDisplay $display]} { + if {$nDisplay ne $display} { if {$displayGiven} { error "conflicting -display $display and -use\ $use -> $nDisplay" diff --git a/library/scale.tcl b/library/scale.tcl index ce68b98..01138d3 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.12 2003/10/03 00:40:45 patthoyts Exp $ +# RCS: @(#) $Id: scale.tcl,v 1.13 2005/07/25 09:06:00 dkf 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 $tk::Priv(activeBg) } - if {[string equal [%W cget -state] "active"]} { + if {[%W cget -state] eq "active"} { %W configure -state normal } } @@ -62,7 +62,7 @@ bind Scale <ButtonRelease-2> { tk::ScaleEndDrag %W tk::ScaleActivate %W %x %y } -if {[string equal $tcl_platform(platform) "windows"]} { +if {$tcl_platform(platform) eq "windows"} { # On Windows do the same with button 3, as that is the right mouse button bind Scale <3> [bind Scale <2>] bind Scale <B3-Motion> [bind Scale <B2-Motion>] @@ -114,15 +114,15 @@ bind Scale <End> { # x, y - Mouse coordinates. proc ::tk::ScaleActivate {w x y} { - if {[string equal [$w cget -state] "disabled"]} { + if {[$w cget -state] eq "disabled"} { return } - if {[string equal [$w identify $x $y] "slider"]} { + if {[$w identify $x $y] eq "slider"} { set state active } else { set state normal } - if {[string compare [$w cget -state] $state]} { + if {[$w cget -state] ne $state} { $w configure -state $state } } @@ -143,11 +143,11 @@ proc ::tk::ScaleButtonDown {w x y} { # save the relief set Priv($w,relief) [$w cget -sliderrelief] - if {[string equal $el "trough1"]} { + if {$el eq "trough1"} { ScaleIncrement $w up little initial - } elseif {[string equal $el "trough2"]} { + } elseif {$el eq "trough2"} { ScaleIncrement $w down little initial - } elseif {[string equal $el "slider"]} { + } elseif {$el eq "slider"} { set Priv(dragging) 1 set Priv(initValue) [$w get] set coords [$w coords] @@ -213,7 +213,7 @@ proc ::tk::ScaleEndDrag {w} { proc ::tk::ScaleIncrement {w dir big repeat} { variable ::tk::Priv if {![winfo exists $w]} return - if {[string equal $big "big"]} { + if {$big eq "big"} { set inc [$w cget -bigincrement] if {$inc == 0} { set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}] @@ -224,15 +224,15 @@ proc ::tk::ScaleIncrement {w dir big repeat} { } else { set inc [$w cget -resolution] } - if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir "up"]} { + if {([$w cget -from] > [$w cget -to]) ^ ($dir eq "up")} { set inc [expr {-$inc}] } $w set [expr {[$w get] + $inc}] - if {[string equal $repeat "again"]} { + if {$repeat eq "again"} { set Priv(afterId) [after [$w cget -repeatinterval] \ [list tk::ScaleIncrement $w $dir $big again]] - } elseif {[string equal $repeat "initial"]} { + } elseif {$repeat eq "initial"} { set delay [$w cget -repeatdelay] if {$delay > 0} { set Priv(afterId) [after $delay \ @@ -252,9 +252,9 @@ proc ::tk::ScaleIncrement {w dir big repeat} { proc ::tk::ScaleControlPress {w x y} { set el [$w identify $x $y] - if {[string equal $el "trough1"]} { + if {$el eq "trough1"} { $w set [$w cget -from] - } elseif {[string equal $el "trough2"]} { + } elseif {$el eq "trough2"} { $w set [$w cget -to] } } @@ -271,8 +271,8 @@ proc ::tk::ScaleControlPress {w x y} { proc ::tk::ScaleButton2Down {w x y} { variable ::tk::Priv - if {[string equal [$w cget -state] "disabled"]} { - return + if {[$w cget -state] eq "disabled"} { + return } $w configure -state active diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index b31686d..6be187b 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.10 2002/08/31 06:12:28 das Exp $ +# RCS: @(#) $Id: scrlbar.tcl,v 1.11 2005/07/25 09:06:00 dkf Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -17,7 +17,7 @@ #------------------------------------------------------------------------- # Standard Motif bindings: -if {[string equal [tk windowingsystem] "x11"]} { +if {[tk windowingsystem] eq "x11"} { bind Scrollbar <Enter> { if {$tk_strictMotif} { @@ -144,7 +144,7 @@ proc tk::ScrollButtonDown {w x y} { set Priv(relief) [$w cget -activerelief] $w configure -activerelief sunken set element [$w identify $x $y] - if {[string equal $element "slider"]} { + if {$element eq "slider"} { ScrollStartDrag $w $x $y } else { ScrollSelect $w $element initial @@ -195,10 +195,10 @@ proc ::tk::ScrollSelect {w element repeat} { "arrow2" {ScrollByUnits $w hv 1} default {return} } - if {[string equal $repeat "again"]} { + if {$repeat eq "again"} { set Priv(afterId) [after [$w cget -repeatinterval] \ [list tk::ScrollSelect $w $element again]] - } elseif {[string equal $repeat "initial"]} { + } elseif {$repeat eq "initial"} { set delay [$w cget -repeatdelay] if {$delay > 0} { set Priv(afterId) [after $delay \ @@ -218,7 +218,7 @@ proc ::tk::ScrollSelect {w element repeat} { proc ::tk::ScrollStartDrag {w x y} { variable ::tk::Priv - if {[string equal [$w cget -command] ""]} { + if {[$w cget -command] eq ""} { return } set Priv(pressX) $x @@ -248,7 +248,7 @@ proc ::tk::ScrollStartDrag {w x y} { proc ::tk::ScrollDrag {w x y} { variable ::tk::Priv - if {[string equal $Priv(initPos) ""]} { + if {$Priv(initPos) eq ""} { return } set delta [$w delta [expr {$x - $Priv(pressX)}] [expr {$y - $Priv(pressY)}]] @@ -278,7 +278,7 @@ proc ::tk::ScrollDrag {w x y} { proc ::tk::ScrollEndDrag {w x y} { variable ::tk::Priv - if {[string equal $Priv(initPos) ""]} { + if {$Priv(initPos) eq ""} { return } if {[$w cget -jump]} { @@ -302,7 +302,7 @@ proc ::tk::ScrollEndDrag {w x y} { proc ::tk::ScrollByUnits {w orient amount} { set cmd [$w cget -command] - if {[string equal $cmd ""] || ([string first \ + if {$cmd eq "" || ([string first \ [string index [$w cget -orient] 0] $orient] < 0)} { return } @@ -327,7 +327,7 @@ proc ::tk::ScrollByUnits {w orient amount} { proc ::tk::ScrollByPages {w orient amount} { set cmd [$w cget -command] - if {[string equal $cmd ""] || ([string first \ + if {$cmd eq "" || ([string first \ [string index [$w cget -orient] 0] $orient] < 0)} { return } @@ -351,7 +351,7 @@ proc ::tk::ScrollByPages {w orient amount} { proc ::tk::ScrollToPos {w pos} { set cmd [$w cget -command] - if {[string equal $cmd ""]} { + if {$cmd eq ""} { return } set info [$w get] diff --git a/library/spinbox.tcl b/library/spinbox.tcl index d8d2d8a..f470888 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -4,7 +4,7 @@ # procedures that help in implementing those bindings. The spinbox builds # off the entry widget, so it can reuse Entry bindings and procedures. # -# RCS: @(#) $Id: spinbox.tcl,v 1.8 2004/10/19 18:56:01 jenglish Exp $ +# RCS: @(#) $Id: spinbox.tcl,v 1.9 2005/07/25 09:06:00 dkf Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -217,13 +217,13 @@ bind Spinbox <Escape> {# nothing} bind Spinbox <Return> {# nothing} bind Spinbox <KP_Enter> {# nothing} bind Spinbox <Tab> {# nothing} -if {[string equal [tk windowingsystem] "aqua"]} { - bind Spinbox <Command-KeyPress> {# nothing} +if {[tk windowingsystem] eq "aqua"} { + bind Spinbox <Command-KeyPress> {# nothing} } # On Windows, paste is done using Shift-Insert. Shift-Insert already # generates the <<Paste>> event, so we don't need to do anything here. -if {[string compare $tcl_platform(platform) "windows"]} { +if {$tcl_platform(platform) ne "windows"} { bind Spinbox <Insert> { catch {::tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]} } @@ -500,7 +500,9 @@ proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { proc ::tk::spinbox::Paste {w x} { $w icursor [::tk::spinbox::ClosestGap $w $x] catch {$w insert insert [::tk::GetSelection $w PRIMARY]} - if {[string equal "disabled" [$w cget -state]]} {focus $w} + if {"disabled" eq [$w cget -state]} { + focus $w + } } # ::tk::spinbox::Motion -- diff --git a/library/tearoff.tcl b/library/tearoff.tcl index f8b6856..ae74389 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.9 2004/03/17 18:15:45 das Exp $ +# RCS: @(#) $Id: tearoff.tcl,v 1.10 2005/07/25 09:06:00 dkf Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -44,11 +44,11 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} { } set parent [winfo parent $w] - while {[string compare [winfo toplevel $parent] $parent] \ - || [string equal [winfo class $parent] "Menu"]} { + while {[winfo toplevel $parent] ne $parent \ + || [winfo class $parent] eq "Menu"} { set parent [winfo parent $parent] } - if {[string equal $parent "."]} { + if {$parent eq "."} { set parent "" } for {set i 1} 1 {incr i} { @@ -65,10 +65,10 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} { # entry. If it's a menubutton then use its text. set parent [winfo parent $w] - if {[string compare [$menu cget -title] ""]} { + if {[$menu cget -title] ne ""} { wm title $menu [$menu cget -title] } else { - switch [winfo class $parent] { + switch -- [winfo class $parent] { Menubutton { wm title $menu [$parent cget -text] } @@ -96,7 +96,7 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} { # now. set cmd [$w cget -tearoffcommand] - if {[string compare $cmd ""]} { + if {$cmd ne ""} { uplevel #0 $cmd [list $w $menu] } return $menu @@ -118,14 +118,14 @@ proc ::tk::MenuDup {src dst type} { if {[llength $option] == 2} { continue } - if {[string equal [lindex $option 0] "-type"]} { + if {[lindex $option 0] eq "-type"} { continue } lappend cmd [lindex $option 0] [lindex $option 4] } eval $cmd set last [$src index last] - if {[string equal $last "none"]} { + if {$last eq "none"} { return } for {set i [$src cget -tearoff]} {$i <= $last} {incr i} { diff --git a/library/tk.tcl b/library/tk.tcl index 995083d..a98fc82 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.54 2004/10/19 18:56:01 jenglish Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.55 2005/07/25 09:06:00 dkf Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -25,7 +25,7 @@ namespace eval ::tk { # The msgcat package is not available. Supply our own # minimal replacement. proc mc {src args} { - return [eval [list format $src] $args] + return [format $src {expand}$args] } proc mcmax {args} { set max 0 @@ -50,7 +50,7 @@ namespace eval ::tk { # Add Tk's directory to the end of the auto-load search path, if it # isn't already on the path: -if {[info exists ::auto_path] && [string compare {} $::tk_library] && \ +if {[info exists ::auto_path] && $::tk_library ne "" && \ [lsearch -exact $::auto_path $::tk_library] < 0} { lappend ::auto_path $::tk_library } @@ -174,13 +174,13 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { catch {focus $oldFocus} grab release $grab - if {[string equal $destroy "withdraw"]} { + if {$destroy eq "withdraw"} { wm withdraw $grab } else { destroy $grab } if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} { - if {[string equal $oldStatus "global"]} { + if {$oldStatus eq "global"} { grab -global $oldGrab } else { grab $oldGrab @@ -200,7 +200,7 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { # Results: # Returns the selection, or an error if none could be found # -if {[string equal $tcl_platform(platform) "unix"]} { +if {$tcl_platform(platform) eq "unix"} { proc ::tk::GetSelection {w {sel PRIMARY}} { if {[catch {selection get -displayof $w -selection $sel \ -type UTF8_STRING} txt] \ @@ -307,37 +307,37 @@ proc ::tk::EventMotifBindings {n1 dummy dummy} { # using compiled code. #---------------------------------------------------------------------- -if {[string equal [info commands tk_chooseColor] ""]} { +if {![llength [info commands tk_chooseColor]]} { proc ::tk_chooseColor {args} { - return [eval tk::dialog::color:: $args] + return [tk::dialog::color:: {expand}$args] } } -if {[string equal [info commands tk_getOpenFile] ""]} { +if {![llength [info commands tk_getOpenFile]]} { proc ::tk_getOpenFile {args} { if {$::tk_strictMotif} { - return [eval tk::MotifFDialog open $args] + return [tk::MotifFDialog open {expand}$args] } else { - return [eval ::tk::dialog::file:: open $args] + return [::tk::dialog::file:: open {expand}$args] } } } -if {[string equal [info commands tk_getSaveFile] ""]} { +if {![llength [info commands tk_getSaveFile]]} { proc ::tk_getSaveFile {args} { if {$::tk_strictMotif} { - return [eval tk::MotifFDialog save $args] + return [tk::MotifFDialog save {expand}$args] } else { - return [eval ::tk::dialog::file:: save $args] + return [::tk::dialog::file:: save {expand}$args] } } } -if {[string equal [info commands tk_messageBox] ""]} { +if {![llength [info commands tk_messageBox]]} { proc ::tk_messageBox {args} { - return [eval tk::MessageBox $args] + return [tk::MessageBox {expand}$args] } } -if {[string equal [info command tk_chooseDirectory] ""]} { +if {![llength [info command tk_chooseDirectory]]} { proc ::tk_chooseDirectory {args} { - return [eval ::tk::dialog::file::chooseDir:: $args] + return [::tk::dialog::file::chooseDir:: {expand}$args] } } @@ -345,7 +345,7 @@ if {[string equal [info command tk_chooseDirectory] ""]} { # Define the set of common virtual events. #---------------------------------------------------------------------- -switch [tk windowingsystem] { +switch -- [tk windowingsystem] { "x11" { event add <<Cut>> <Control-Key-x> <Key-F20> event add <<Copy>> <Control-Key-c> <Key-F16> @@ -478,9 +478,8 @@ proc ::tk::UnderlineAmpersand {text} { # sets -text and -underline options for the widget # proc ::tk::SetAmpText {widget text} { - foreach {newtext under} [::tk::UnderlineAmpersand $text] { - $widget configure -text $newtext -underline $under - } + lassign [UnderlineAmpersand $text] newtext under + $widget configure -text $newtext -underline $under } # ::tk::AmpWidget -- @@ -488,21 +487,20 @@ proc ::tk::SetAmpText {widget text} { # -underline options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpWidget {class path args} { - set wcmd [list $class $path] + set options {} foreach {opt val} $args { - if {[string equal $opt {-text}]} { - foreach {newtext under} [::tk::UnderlineAmpersand $val] { - lappend wcmd -text $newtext -underline $under - } + if {$opt eq "-text"} { + lassign [UnderlineAmpersand $val] newtext under + lappend options -text $newtext -underline $under } else { - lappend wcmd $opt $val + lappend options $opt $val } } - eval $wcmd - if {$class=="button"} { + set result [$class $path {expand}$options] + if {$class eq "button"} { bind $path <<AltUnderlined>> [list $path invoke] } - return $path + return $result } # ::tk::AmpMenuArgs -- @@ -510,17 +508,16 @@ proc ::tk::AmpWidget {class path args} { # -label and -underline options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpMenuArgs {widget add type args} { - set resultArgs [list $widget add $type] + set options {} foreach {opt val} $args { - if {[string equal $opt {-label}]} { - foreach {newlabel under} [::tk::UnderlineAmpersand $val] { - lappend resultArgs -label $newlabel -underline $under - } + if {$opt eq "-label"} { + lassign [UnderlineAmpersand $val] newlabel under + lappend options -label $newlabel -underline $under } else { - lappend resultArgs $opt $val + lappend options $opt $val } } - eval $resultArgs + $widget add $type {expand}$options } # ::tk::FindAltKeyTarget -- @@ -528,19 +525,21 @@ proc ::tk::AmpMenuArgs {widget add type args} { # to find button or label which has $char as underlined character # proc ::tk::FindAltKeyTarget {path char} { - switch [winfo class $path] { + switch -- [winfo class $path] { Button - Label { if {[string equal -nocase $char \ - [string index [$path cget -text] \ - [$path cget -underline]]]} {return $path} else {return {}} + [string index [$path cget -text] [$path cget -underline]]]} { + return $path + } else { + return {} + } } default { - foreach child \ - [concat [grid slaves $path] \ - [pack slaves $path] \ - [place slaves $path] ] { - if {""!=[set target [::tk::FindAltKeyTarget $child $char]]} { + foreach child [concat [grid slaves $path] \ + [pack slaves $path] [place slaves $path]] { + set target [FindAltKeyTarget $child $char] + if {$target ne ""} { return $target } } @@ -554,7 +553,7 @@ proc ::tk::FindAltKeyTarget {path char} { # to button or label which has appropriate underlined character # proc ::tk::AltKeyInDialog {path key} { - set target [::tk::FindAltKeyTarget $path $key] + set target [FindAltKeyTarget $path $key] if { $target == ""} return event generate $target <<AltUnderlined>> } @@ -566,8 +565,10 @@ proc ::tk::AltKeyInDialog {path key} { proc ::tk::mcmaxamp {args} { set maxlen 0 foreach arg $args { - set length [string length [lindex [::tk::UnderlineAmpersand [mc $arg]] 0]] - if {$length>$maxlen} { + # Should we run [mc] in caller's namespace? + lassign [UnderlineAmpersand [mc $arg]] msg + set length [string length $msg] + if {$length > $maxlen} { set maxlen $length } } @@ -575,7 +576,7 @@ proc ::tk::mcmaxamp {args} { } # For now, turn off the custom mdef proc for the mac: -if {[string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "aqua"} { namespace eval ::tk::mac { set useCustomMDEF 0 } diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 0960aad..1de6d0c 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.51 2005/04/12 20:33:13 hobbs Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.52 2005/07/25 09:06:00 dkf Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -44,10 +44,10 @@ proc ::tk::IconList_Index {w i} { } switch -regexp -- $i { "^-?[0-9]+$" { - if { $i < 0 } { + if {$i < 0} { set i 0 } - if { $i >= [llength $data(list)] } { + if {$i >= [llength $data(list)]} { set i [expr {[llength $data(list)] - 1}] } return $i @@ -76,18 +76,18 @@ proc ::tk::IconList_Selection {w op args} { upvar ::tk::$w data switch -exact -- $op { "anchor" { - if { [llength $args] == 1 } { + if {[llength $args] == 1} { set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]] } else { return $data(index,anchor) } } "clear" { - if { [llength $args] == 2 } { + if {[llength $args] == 2} { foreach {first last} $args { break } - } elseif { [llength $args] == 1 } { + } elseif {[llength $args] == 1} { set first [set last [lindex $args 0]] } else { error "wrong # args: should be [lindex [info level 0] 0] path\ @@ -95,7 +95,7 @@ proc ::tk::IconList_Selection {w op args} { } set first [IconList_Index $w $first] set last [IconList_Index $w $last] - if { $first > $last } { + if {$first > $last} { set tmp $first set first $last set last $tmp @@ -174,7 +174,7 @@ proc ::tk::IconList_DrawSelection {w} { } set bbox [$data(canvas) bbox $tTag] - $data(canvas) create rect $bbox -fill \#a0a0ff -outline \#a0a0ff \ + $data(canvas) create rect $bbox -fill \#a0a0ff -outline \#a0a0ff \ -tags selection } $data(canvas) lower selection @@ -500,7 +500,7 @@ proc ::tk::IconList_See {w rTag} { return } set sRegion [$data(canvas) cget -scrollregion] - if {[string equal $sRegion {}]} { + if {$sRegion eq ""} { return } @@ -545,7 +545,9 @@ proc ::tk::IconList_Btn1 {w x y} { focus $data(canvas) set i [IconList_Index $w @$x,$y] - if {$i eq ""} return + if {$i eq ""} { + return + } IconList_Selection $w clear 0 end IconList_Selection $w set $i IconList_Selection $w anchor $i @@ -557,7 +559,9 @@ proc ::tk::IconList_CtrlBtn1 {w x y} { if { $data(-multiple) } { focus $data(canvas) set i [IconList_Index $w @$x,$y] - if {$i eq ""} return + if {$i eq ""} { + return + } if { [IconList_Selection $w includes $i] } { IconList_Selection $w clear $i } else { @@ -573,9 +577,11 @@ proc ::tk::IconList_ShiftBtn1 {w x y} { if { $data(-multiple) } { focus $data(canvas) set i [IconList_Index $w @$x,$y] - if {$i eq ""} return + if {$i eq ""} { + return + } set a [IconList_Index $w anchor] - if { [string equal $a ""] } { + if {$a eq ""} { set a $i } IconList_Selection $w clear 0 end @@ -590,7 +596,9 @@ proc ::tk::IconList_Motion1 {w x y} { set Priv(x) $x set Priv(y) $y set i [IconList_Index $w @$x,$y] - if {$i eq ""} return + if {$i eq ""} { + return + } IconList_Selection $w clear 0 end IconList_Selection $w set $i } @@ -601,7 +609,9 @@ proc ::tk::IconList_ShiftMotion1 {w x y} { set Priv(x) $x set Priv(y) $y set i [IconList_Index $w @$x,$y] - if {$i eq ""} return + if {$i eq ""} { + return + } IconList_Selection $w clear 0 end IconList_Selection $w set anchor $i } @@ -662,7 +672,9 @@ proc ::tk::IconList_UpDown {w amount} { set i 0 } else { set i [tk::IconList_Index $w anchor] - if {$i eq ""} return + if {$i eq ""} { + return + } incr i $amount } IconList_Selection $w clear 0 end @@ -691,7 +703,9 @@ proc ::tk::IconList_LeftRight {w amount} { set i 0 } else { set i [IconList_Index $w anchor] - if {$i eq ""} return + if {$i eq ""} { + return + } incr i [expr {$amount*$data(itemsPerColumn)}] } IconList_Selection $w clear 0 end @@ -727,7 +741,7 @@ proc ::tk::IconList_Goto {w text} { return } - if {[string equal {} $text]} { + if {$text eq ""} { return } @@ -748,7 +762,7 @@ proc ::tk::IconList_Goto {w text} { # with $text while {1} { set sub [string range $textList($i) 0 $len0] - if {[string equal $text $sub]} { + if {$text eq $sub} { set theIndex $i break } @@ -804,21 +818,21 @@ proc ::tk::dialog::file:: {type args} { set dataName __tk_filedialog upvar ::tk::dialog::file::$dataName data - ::tk::dialog::file::Config $dataName $type $args + Config $dataName $type $args - if {[string equal $data(-parent) .]} { - set w .$dataName + if {$data(-parent) eq "."} { + set w .$dataName } else { - set w $data(-parent).$dataName + set w $data(-parent).$dataName } # (re)create the dialog box if necessary # if {![winfo exists $w]} { - ::tk::dialog::file::Create $w TkFDialog + Create $w TkFDialog } elseif {[winfo class $w] ne "TkFDialog"} { destroy $w - ::tk::dialog::file::Create $w TkFDialog + Create $w TkFDialog } else { set data(dirMenuBtn) $w.f1.menu set data(dirMenu) $w.f1.menu.menu @@ -831,7 +845,7 @@ proc ::tk::dialog::file:: {type args} { set data(okBtn) $w.f2.ok set data(cancelBtn) $w.f2.cancel set data(hiddenBtn) $w.f2.hidden - ::tk::dialog::file::SetSelectMode $w $data(-multiple) + SetSelectMode $w $data(-multiple) } if {$::tk::dialog::file::showHiddenBtn} { $data(hiddenBtn) configure -state normal @@ -870,9 +884,9 @@ proc ::tk::dialog::file:: {type args} { set title [lindex $type 0] set filter [lindex $type 1] $data(typeMenu) add command -label $title \ - -command [list ::tk::dialog::file::SetFilter $w $type] + -command [list ::tk::dialog::file::SetFilter $w $type] } - ::tk::dialog::file::SetFilter $w [lindex $data(-filetypes) 0] + SetFilter $w [lindex $data(-filetypes) 0] $data(typeMenuBtn) config -state normal $data(typeMenuLab) config -state normal } else { @@ -880,7 +894,7 @@ proc ::tk::dialog::file:: {type args} { $data(typeMenuBtn) config -state disabled -takefocus 0 $data(typeMenuLab) config -state disabled } - ::tk::dialog::file::UpdateWhenIdle $w + UpdateWhenIdle $w # Withdraw the window, then update all the geometry information # so we know how big it wants to be, then center the window in the @@ -948,7 +962,7 @@ proc ::tk::dialog::file::Config {dataName type argList} { # The "-multiple" option is only available for the "open" file dialog. # - if { [string equal $type "open"] } { + if {$type eq "open"} { lappend specs {-multiple "" "" "0"} } @@ -965,7 +979,7 @@ proc ::tk::dialog::file::Config {dataName type argList} { tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList if {$data(-title) eq ""} { - if {[string equal $type "open"]} { + if {$type eq "open"} { set data(-title) "[mc "Open"]" } else { set data(-title) "[mc "Save As"]" @@ -998,7 +1012,7 @@ proc ::tk::dialog::file::Config {dataName type argList} { # Set -multiple to a one or zero value (not other boolean types # like "yes") so we can use it in tests more easily. - if {![string compare $type save]} { + if {$type eq "save"} { set data(-multiple) 0 } elseif {$data(-multiple)} { set data(-multiple) 1 @@ -1019,7 +1033,7 @@ proc ::tk::dialog::file::Create {w class} { # set f1 [frame $w.f1] bind [::tk::AmpWidget label $f1.lab -text "[mc "&Directory:"]" ] \ - <<AltUnderlined>> [list focus $f1.menu] + <<AltUnderlined>> [list focus $f1.menu] set data(dirMenuBtn) $f1.menu set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] ""] @@ -1046,7 +1060,7 @@ static char updir_bits[] = { # data(icons): the IconList that list the files and directories. # - if { [string equal $class TkFDialog] } { + if {$class eq "TkFDialog"} { if { $data(-multiple) } { set fNameCaption [mc "File &names:"] } else { @@ -1059,8 +1073,7 @@ static char updir_bits[] = { set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w] } set data(icons) [::tk::IconList $w.icons \ - -command $iconListCommand \ - -multiple $data(-multiple)] + -command $iconListCommand -multiple $data(-multiple)] bind $data(icons) <<ListboxSelect>> \ [list ::tk::dialog::file::ListBrowse $w] @@ -1077,7 +1090,7 @@ static char updir_bits[] = { set ::tk::$w.icons(font) [$data(ent) cget -font] # Make the file types bits only if this is a File Dialog - if { [string equal $class TkFDialog] } { + if {$class eq "TkFDialog"} { set data(typeMenuLab) [::tk::AmpWidget label $f2.lab2 \ -text $fTypeCaption -anchor e -pady [$f2.lab cget -pady]] set data(typeMenuBtn) [menubutton $f2.menu -indicatoron 1 \ @@ -1085,7 +1098,7 @@ static char updir_bits[] = { set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0] $data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \ -relief raised -bd 2 -anchor w - bind $data(typeMenuLab) <<AltUnderlined>> [list \ + bind $data(typeMenuLab) <<AltUnderlined>> [list \ focus $data(typeMenuBtn)] } @@ -1118,7 +1131,7 @@ static char updir_bits[] = { # grid $f2.lab $f2.ent $data(okBtn) -padx 4 -sticky ew grid configure $f2.ent -padx 2 - if { [string equal $class TkFDialog] } { + if {$class eq "TkFDialog"} { grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \ -padx 4 -sticky ew grid configure $data(typeMenuBtn) -padx 0 @@ -1145,11 +1158,11 @@ static char updir_bits[] = { # Set up event handlers specific to File or Directory Dialogs # - if { [string equal $class TkFDialog] } { + if {$class eq "TkFDialog"} { bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w] $data(okBtn) config -command [list ::tk::dialog::file::OkCmd $w] bind $w <Alt-t> [format { - if {[string equal [%s cget -state] "normal"]} { + if {[%s cget -state] eq "normal"} { focus %s } } $data(typeMenuBtn) $data(typeMenuBtn)] @@ -1256,7 +1269,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] # we normally won't come to here. Anyways, give an error and abort # action. tk_messageBox -type ok -parent $w -icon warning -message \ - [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)] + [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)] cd $appPWD return } @@ -1293,10 +1306,12 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] # but 'd'irectory type files. # set cmd [list glob -tails -directory [pwd] \ - -type {f b c l p s} -nocomplain] - if {[string equal $data(filter) *]} { + -type {f b c l p s} -nocomplain] + if {$data(filter) eq "*"} { lappend cmd * - if {$showHidden} { lappend cmd .* } + if {$showHidden} { + lappend cmd .* + } } else { eval [list lappend cmd] $data(filter) } @@ -1325,10 +1340,10 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] # cd $appPWD - if { [string equal $class TkFDialog] } { + if {$class eq "TkFDialog"} { # Restore the Open/Save Button if this is a File Dialog # - if {[string equal $data(type) open]} { + if {$data(type) eq "open"} { ::tk::SetAmpText $data(okBtn) [mc "&Open"] } else { ::tk::SetAmpText $data(okBtn) [mc "&Save"] @@ -1359,9 +1374,9 @@ proc ::tk::dialog::file::SetPathSilently {w path} { proc ::tk::dialog::file::SetPath {w name1 name2 op} { if {[winfo exists $w]} { upvar ::tk::dialog::file::[winfo name $w] data - ::tk::dialog::file::UpdateWhenIdle $w + UpdateWhenIdle $w # On directory dialogs, we keep the entry in sync with the currentdir. - if { [string equal [winfo class $w] TkChooseDir] } { + if {[winfo class $w] eq "TkChooseDir"} { $data(ent) delete 0 end $data(ent) insert end $data(selectPath) } @@ -1402,7 +1417,7 @@ proc ::tk::dialog::file::SetFilter {w type} { $icons(sbar) set 0.0 0.0 - ::tk::dialog::file::UpdateWhenIdle $w + UpdateWhenIdle $w } # tk::dialog::file::ResolveFile -- @@ -1443,7 +1458,7 @@ proc ::tk::dialog::file::SetFilter {w type} { proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { set appPWD [pwd] - set path [::tk::dialog::file::JoinFile $context $text] + set path [JoinFile $context $text] # If the file has no extension, append the default. Be careful not # to do this for directories, otherwise typing a dirname in the box @@ -1528,16 +1543,16 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { proc ::tk::dialog::file::EntFocusIn {w} { upvar ::tk::dialog::file::[winfo name $w] data - if {[string compare [$data(ent) get] ""]} { + if {[$data(ent) get] ne ""} { $data(ent) selection range 0 end $data(ent) icursor end } else { $data(ent) selection clear } - if { [string equal [winfo class $w] TkFDialog] } { + if {[winfo class $w] eq "TkFDialog"} { # If this is a File Dialog, make sure the buttons are labeled right. - if {[string equal $data(type) open]} { + if {$data(type) eq "open"} { ::tk::SetAmpText $data(okBtn) [mc "&Open"] } else { ::tk::SetAmpText $data(okBtn) [mc "&Save"] @@ -1568,15 +1583,14 @@ proc ::tk::dialog::file::ActivateEnt {w} { if {[llength $selIcos] == 0 && $text ne ""} { # This assumes the user typed something in without selecting # files - so assume they only type in a single filename. - ::tk::dialog::file::VerifyFileName $w $text + VerifyFileName $w $text } else { foreach item $selIcos { - ::tk::dialog::file::VerifyFileName $w \ - [::tk::IconList_Get $data(icons) $item] + VerifyFileName $w [::tk::IconList_Get $data(icons) $item] } } } else { - ::tk::dialog::file::VerifyFileName $w $text + VerifyFileName $w $text } } @@ -1585,26 +1599,25 @@ proc ::tk::dialog::file::ActivateEnt {w} { proc ::tk::dialog::file::VerifyFileName {w filename} { upvar ::tk::dialog::file::[winfo name $w] data - set list [::tk::dialog::file::ResolveFile $data(selectPath) $filename \ - $data(-defaultextension)] + set list [ResolveFile $data(selectPath) $filename $data(-defaultextension)] foreach {flag path file} $list { break } switch -- $flag { OK { - if {[string equal $file ""]} { + if {$file eq ""} { # user has entered an existing (sub)directory set data(selectPath) $path $data(ent) delete 0 end } else { - ::tk::dialog::file::SetPathSilently $w $path + SetPathSilently $w $path if {$data(-multiple)} { lappend data(selectFile) $file } else { set data(selectFile) $file } - ::tk::dialog::file::Done $w + Done $w } } PATTERN { @@ -1612,38 +1625,37 @@ proc ::tk::dialog::file::VerifyFileName {w filename} { set data(filter) $file } FILE { - if {[string equal $data(type) open]} { + if {$data(type) eq "open"} { tk_messageBox -icon warning -type ok -parent $w \ - -message "[mc "File \"%1\$s\" does not exist." [file join $path $file]]" + -message [mc "File \"%1\$s\" does not exist." \ + [file join $path $file]] $data(ent) selection range 0 end $data(ent) icursor end } else { - ::tk::dialog::file::SetPathSilently $w $path + SetPathSilently $w $path if {$data(-multiple)} { lappend data(selectFile) $file } else { set data(selectFile) $file } - ::tk::dialog::file::Done $w + Done $w } } PATH { tk_messageBox -icon warning -type ok -parent $w \ - -message "[mc "Directory \"%1\$s\" does not exist." $path]" + -message [mc "Directory \"%1\$s\" does not exist." $path] $data(ent) selection range 0 end $data(ent) icursor end } CHDIR { - tk_messageBox -type ok -parent $w -message \ - "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $path]"\ - -icon warning + tk_messageBox -type ok -parent $w -message -icon warning \ + [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $path] $data(ent) selection range 0 end $data(ent) icursor end } ERROR { - tk_messageBox -type ok -parent $w -message \ - "[mc "Invalid file name \"%1\$s\"." $path]"\ - -icon warning + tk_messageBox -type ok -parent $w -message -icon warning \ + [mc "Invalid file name \"%1\$s\"." $path] $data(ent) selection range 0 end $data(ent) icursor end } @@ -1655,7 +1667,7 @@ proc ::tk::dialog::file::VerifyFileName {w filename} { proc ::tk::dialog::file::InvokeBtn {w key} { upvar ::tk::dialog::file::[winfo name $w] data - if {[string equal [$data(okBtn) cget -text] $key]} { + if {[$data(okBtn) cget -text] eq $key} { ::tk::ButtonInvoke $data(okBtn) } } @@ -1665,7 +1677,7 @@ proc ::tk::dialog::file::InvokeBtn {w key} { proc ::tk::dialog::file::UpDirCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data - if {[string compare $data(selectPath) "/"]} { + if {$data(selectPath) ne "/"} { set data(selectPath) [file dirname $data(selectPath)] } } @@ -1694,14 +1706,14 @@ proc ::tk::dialog::file::OkCmd {w} { if {([llength $filenames] && !$data(-multiple)) || \ ($data(-multiple) && ([llength $filenames] == 1))} { set filename [lindex $filenames 0] - set file [::tk::dialog::file::JoinFile $data(selectPath) $filename] + set file [JoinFile $data(selectPath) $filename] if {[file isdirectory $file]} { - ::tk::dialog::file::ListInvoke $w [list $filename] + ListInvoke $w [list $filename] return } } - ::tk::dialog::file::ActivateEnt $w + ActivateEnt $w } # Gets called when user presses the "Cancel" button @@ -1739,7 +1751,7 @@ proc ::tk::dialog::file::ListBrowse {w} { if { [llength $text] > 1 } { set newtext {} foreach file $text { - set fullfile [::tk::dialog::file::JoinFile $data(selectPath) $file] + set fullfile [JoinFile $data(selectPath) $file] if { ![file isdirectory $fullfile] } { lappend newtext $file } @@ -1748,24 +1760,22 @@ proc ::tk::dialog::file::ListBrowse {w} { set isDir 0 } else { set text [lindex $text 0] - set file [::tk::dialog::file::JoinFile $data(selectPath) $text] + set file [JoinFile $data(selectPath) $text] set isDir [file isdirectory $file] } if {!$isDir} { $data(ent) delete 0 end $data(ent) insert 0 $text - if { [string equal [winfo class $w] TkFDialog] } { - if {[string equal $data(type) open]} { + if {[winfo class $w] eq "TkFDialog"} { + if {$data(type) eq "open"} { ::tk::SetAmpText $data(okBtn) [mc "&Open"] } else { ::tk::SetAmpText $data(okBtn) [mc "&Save"] } } - } else { - if { [string equal [winfo class $w] TkFDialog] } { - ::tk::SetAmpText $data(okBtn) [mc "&Open"] - } + } elseif {[winfo class $w] eq "TkFDialog"} { + ::tk::SetAmpText $data(okBtn) [mc "&Open"] } } @@ -1779,16 +1789,14 @@ proc ::tk::dialog::file::ListInvoke {w filenames} { return } - set file [::tk::dialog::file::JoinFile $data(selectPath) \ - [lindex $filenames 0]] + set file [JoinFile $data(selectPath) [lindex $filenames 0]] set class [winfo class $w] - if {[string equal $class TkChooseDir] || [file isdirectory $file]} { + if {$class eq "TkChooseDir" || [file isdirectory $file]} { set appPWD [pwd] if {[catch {cd $file}]} { - tk_messageBox -type ok -parent $w -message \ - "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]"\ - -icon warning + tk_messageBox -type ok -parent $w -message -icon warning \ + [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file] } else { cd $appPWD set data(selectPath) $file @@ -1799,7 +1807,7 @@ proc ::tk::dialog::file::ListInvoke {w filenames} { } else { set data(selectFile) $file } - ::tk::dialog::file::Done $w + Done $w } } @@ -1815,29 +1823,25 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { upvar ::tk::dialog::file::[winfo name $w] data variable ::tk::Priv - if {[string equal $selectFilePath ""]} { + if {$selectFilePath eq ""} { if {$data(-multiple)} { set selectFilePath {} foreach f $data(selectFile) { - lappend selectFilePath [::tk::dialog::file::JoinFile \ - $data(selectPath) $f] + lappend selectFilePath [JoinFile $data(selectPath) $f] } } else { - set selectFilePath [::tk::dialog::file::JoinFile \ - $data(selectPath) $data(selectFile)] + set selectFilePath [JoinFile $data(selectPath) $data(selectFile)] } - set Priv(selectFile) $data(selectFile) - set Priv(selectPath) $data(selectPath) - - if {[string equal $data(type) save]} { - if {[file exists $selectFilePath]} { - set reply [tk_messageBox -icon warning -type yesno\ - -parent $w -message \ - "[mc "File \"%1\$s\" already exists.\nDo you want to overwrite it?" $selectFilePath]"] - if {[string equal $reply "no"]} { + set Priv(selectFile) $data(selectFile) + set Priv(selectPath) $data(selectPath) + + if {($data(type) eq "save") && [file exists $selectFilePath]} { + set reply [tk_messageBox -icon warning -type yesno -parent $w \ + -message [mc "File \"%1\$s\" already exists.\nDo you want\ + to overwrite it?" $selectFilePath]] + if {$reply eq "no"} { return - } } } } diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index db79815..7da9d82 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.26 2004/08/11 21:24:25 dkf Exp $ +# RCS: @(#) $Id: xmfbox.tcl,v 1.27 2005/07/25 09:05:59 dkf Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Scriptics Corporation @@ -84,7 +84,7 @@ proc ::tk::MotifFDialog_Create {dataName type argList} { MotifFDialog_Config $dataName $type $argList - if {[string equal $data(-parent) .]} { + if {$data(-parent) eq "."} { set w .$dataName } else { set w $data(-parent).$dataName @@ -94,7 +94,7 @@ proc ::tk::MotifFDialog_Create {dataName type argList} { # if {![winfo exists $w]} { MotifFDialog_BuildUI $w - } elseif {[string compare [winfo class $w] TkMotifFDialog]} { + } elseif {[winfo class $w] ne "TkMotifFDialog"} { destroy $w MotifFDialog_BuildUI $w } else { @@ -227,7 +227,7 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { {-parent "" "" "."} {-title "" "" ""} } - if { [string equal $type "open"] } { + if {$type eq "open"} { lappend specs {-multiple "" "" "0"} } @@ -244,12 +244,12 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { # tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList - if {[string equal $data(-title) ""]} { - if {[string equal $type "open"]} { + if {$data(-title) eq ""} { + if {$type eq "open"} { if {$data(-multiple) != 0} { set data(-title) "[mc {Open Multiple Files}]" } else { - set data(-title) [mc "Open"] + set data(-title) [mc "Open"] } } else { set data(-title) [mc "Save As"] @@ -259,7 +259,7 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { # 4: set the default directory and selection according to the -initial # settings # - if {[string compare $data(-initialdir) ""]} { + if {$data(-initialdir) ne ""} { if {[file isdirectory $data(-initialdir)]} { set data(selectPath) [lindex [glob $data(-initialdir)] 0] } else { @@ -467,7 +467,7 @@ proc ::tk::MotifFDialog_InterpFilter {w} { # Perform tilde substitution # set badTilde 0 - if {[string equal [string index $text 0] ~]} { + if {[string index $text 0] eq "~"} { set list [file split $text] set tilde [lindex $list 0] if {[catch {set tilde [glob $tilde]}]} { @@ -481,7 +481,7 @@ proc ::tk::MotifFDialog_InterpFilter {w} { # with the current selectPath. set relative 0 - if {[string equal [file pathtype $text] "relative"]} { + if {[file pathtype $text] eq "relative"} { set relative 1 } elseif {$badTilde} { set relative 1 @@ -489,7 +489,7 @@ proc ::tk::MotifFDialog_InterpFilter {w} { if {$relative} { tk_messageBox -icon warning -type ok \ - -message "\"$text\" must be an absolute pathname" + -message "\"$text\" must be an absolute pathname" $data(fEnt) delete 0 end $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ @@ -577,12 +577,12 @@ proc ::tk::MotifFDialog_LoadFiles {w} { } else { foreach pat $data(filter) { if {[string match $pat $f]} { - if {[string match .* $f]} { - incr top - } - lappend flist $f + if {[string match .* $f]} { + incr top + } + lappend flist $f break - } + } } } } @@ -611,11 +611,11 @@ proc ::tk::MotifFDialog_BrowseDList {w} { upvar ::tk::dialog::file::[winfo name $w] data focus $data(dList) - if {[string equal [$data(dList) curselection] ""]} { + if {[$data(dList) curselection] eq ""} { return } set subdir [$data(dList) get [$data(dList) curselection]] - if {[string equal $subdir ""]} { + if {$subdir eq ""} { return } @@ -656,11 +656,11 @@ proc ::tk::MotifFDialog_BrowseDList {w} { proc ::tk::MotifFDialog_ActivateDList {w} { upvar ::tk::dialog::file::[winfo name $w] data - if {[string equal [$data(dList) curselection] ""]} { + if {[$data(dList) curselection] eq ""} { return } set subdir [$data(dList) get [$data(dList) curselection]] - if {[string equal $subdir ""]} { + if {$subdir eq ""} { return } @@ -681,7 +681,7 @@ proc ::tk::MotifFDialog_ActivateDList {w} { set data(selectPath) $newDir MotifFDialog_Update $w - if {[string compare $subdir ..]} { + if {$subdir ne ".."} { $data(dList) selection set 0 $data(dList) activate 0 } else { @@ -727,7 +727,7 @@ proc ::tk::MotifFDialog_BrowseFList {w} { $data(sEnt) insert 0 $data(selectFile) } else { $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ - [lindex $data(selectFile) 0]] + [lindex $data(selectFile) 0]] } $data(sEnt) xview end } @@ -746,11 +746,11 @@ proc ::tk::MotifFDialog_BrowseFList {w} { proc ::tk::MotifFDialog_ActivateFList {w} { upvar ::tk::dialog::file::[winfo name $w] data - if {[string equal [$data(fList) curselection] ""]} { + if {[$data(fList) curselection] eq ""} { return } set data(selectFile) [$data(fList) get [$data(fList) curselection]] - if {[string equal $data(selectFile) ""]} { + if {$data(selectFile) eq ""} { return } else { MotifFDialog_ActivateSEnt $w @@ -798,7 +798,7 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} { set selectFilePath [string trim [$data(sEnt) get]] - if {[string equal $selectFilePath ""]} { + if {$selectFilePath eq ""} { MotifFDialog_FilterCmd $w return } @@ -816,7 +816,7 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} { set newFileList "" foreach item $selectFilePath { - if {[string compare [file pathtype $item] "absolute"]} { + if {[file pathtype $item] ne "absolute"} { set item [file join $data(selectPath) $item] } elseif {![file exists [file dirname $item]]} { tk_messageBox -icon warning -type ok \ @@ -826,22 +826,19 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} { } if {![file exists $item]} { - if {[string equal $data(type) open]} { + if {$data(type) eq "open"} { tk_messageBox -icon warning -type ok \ -message [mc {File "%1$s" does not exist.} $item] return } - } else { - if {[string equal $data(type) save]} { - set message [format %s%s \ - [mc "File \"%1\$s\" already exists.\n\n" \ - $selectFilePath] \ - [mc {Replace existing file?}]] - set answer [tk_messageBox -icon warning -type yesno \ - -message $message] - if {[string equal $answer "no"]} { - return - } + } elseif {$data(type) eq "save"} { + set message [format %s%s \ + [mc "File \"%1\$s\" already exists.\n\n" $selectFilePath] \ + [mc {Replace existing file?}]] + set answer [tk_messageBox -icon warning -type yesno \ + -message $message] + if {$answer eq "no"} { + return } } |