summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <dkf@noemail.net>2005-07-25 09:05:58 (GMT)
committerdkf <dkf@noemail.net>2005-07-25 09:05:58 (GMT)
commit5823e7fe9bef0d239ad9f95d9c6b2156b03595aa (patch)
tree500381c93622d097f72623503a4192b8a2313845
parent3d7b2be382c2e5fe292b2c8e99edbb086d09eda1 (diff)
downloadtk-5823e7fe9bef0d239ad9f95d9c6b2156b03595aa.zip
tk-5823e7fe9bef0d239ad9f95d9c6b2156b03595aa.tar.gz
tk-5823e7fe9bef0d239ad9f95d9c6b2156b03595aa.tar.bz2
Apply some of the changes suggested in [Patch 1237759]
FossilOrigin-Name: f4f7febb1fd0d382ec64762edd93acd98eedff6f
-rw-r--r--ChangeLog5
-rw-r--r--library/button.tcl16
-rw-r--r--library/choosedir.tcl37
-rw-r--r--library/comdlg.tcl21
-rw-r--r--library/console.tcl10
-rw-r--r--library/dialog.tcl25
-rw-r--r--library/entry.tcl32
-rw-r--r--library/focus.tcl23
-rw-r--r--library/listbox.tcl28
-rw-r--r--library/menu.tcl230
-rw-r--r--library/palette.tcl4
-rw-r--r--library/panedwindow.tcl75
-rw-r--r--library/safetk.tcl4
-rw-r--r--library/scale.tcl34
-rw-r--r--library/scrlbar.tcl22
-rw-r--r--library/spinbox.tcl12
-rw-r--r--library/tearoff.tcl18
-rw-r--r--library/tk.tcl101
-rw-r--r--library/tkfbox.tcl222
-rw-r--r--library/xmfbox.tcl73
20 files changed, 500 insertions, 492 deletions
diff --git a/ChangeLog b/ChangeLog
index dd90a41..d529c56 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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
}
}