diff options
author | dgp <dgp@users.sourceforge.net> | 2006-01-25 18:21:40 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2006-01-25 18:21:40 (GMT) |
commit | 911327e9df59424c6f3437b3fac76752e1ed0ccd (patch) | |
tree | 9b964605296b4f7dd7bd91a2baa6ebd8c0bf21bc /library | |
parent | 49f0f55d22ec2e4dc849f2e8e97299de2a3e6b44 (diff) | |
download | tk-911327e9df59424c6f3437b3fac76752e1ed0ccd.zip tk-911327e9df59424c6f3437b3fac76752e1ed0ccd.tar.gz tk-911327e9df59424c6f3437b3fac76752e1ed0ccd.tar.bz2 |
* library/bgerror.tcl: Updates to use Tcl 8.4 features. [Patch 1237759] * library/button.tcl:
* library/choosedir.tcl:
* library/clrpick.tcl:
* library/comdlg.tcl:
* library/console.tcl:
* library/dialog.tcl:
* library/entry.tcl:
* library/focus.tcl:
* library/listbox.tcl:
* library/menu.tcl:
* library/msgbox.tcl:
* library/palette.tcl:
* library/panedwindow.tcl:
* library/safetk.tcl:
* library/scale.tcl:
* library/scrlbar.tcl:
* library/spinbox.tcl:
* library/tearoff.tcl:
* library/text.tcl:
* library/tk.tcl:
* library/tkfbox.tcl:
* library/xmfbox.tcl:
Diffstat (limited to 'library')
-rw-r--r-- | library/bgerror.tcl | 18 | ||||
-rw-r--r-- | library/button.tcl | 18 | ||||
-rw-r--r-- | library/choosedir.tcl | 30 | ||||
-rw-r--r-- | library/clrpick.tcl | 13 | ||||
-rw-r--r-- | library/comdlg.tcl | 32 | ||||
-rw-r--r-- | library/console.tcl | 73 | ||||
-rw-r--r-- | library/dialog.tcl | 26 | ||||
-rw-r--r-- | library/entry.tcl | 19 | ||||
-rw-r--r-- | library/focus.tcl | 28 | ||||
-rw-r--r-- | library/listbox.tcl | 32 | ||||
-rw-r--r-- | library/menu.tcl | 217 | ||||
-rw-r--r-- | library/msgbox.tcl | 42 | ||||
-rw-r--r-- | library/palette.tcl | 24 | ||||
-rw-r--r-- | library/panedwindow.tcl | 10 | ||||
-rw-r--r-- | library/safetk.tcl | 4 | ||||
-rw-r--r-- | library/scale.tcl | 32 | ||||
-rw-r--r-- | library/scrlbar.tcl | 27 | ||||
-rw-r--r-- | library/spinbox.tcl | 10 | ||||
-rw-r--r-- | library/tearoff.tcl | 15 | ||||
-rw-r--r-- | library/text.tcl | 37 | ||||
-rw-r--r-- | library/tk.tcl | 54 | ||||
-rw-r--r-- | library/tkfbox.tcl | 115 | ||||
-rw-r--r-- | library/xmfbox.tcl | 55 |
23 files changed, 446 insertions, 485 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl index 40c708a..e3593fa 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -9,8 +9,8 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. # -# RCS: @(#) $Id: bgerror.tcl,v 1.23.2.3 2005/07/28 21:37:48 hobbs Exp $ -# $Id: bgerror.tcl,v 1.23.2.3 2005/07/28 21:37:48 hobbs Exp $ +# RCS: @(#) $Id: bgerror.tcl,v 1.23.2.4 2006/01/25 18:21:41 dgp Exp $ +# $Id: bgerror.tcl,v 1.23.2.4 2006/01/25 18:21:41 dgp Exp $ namespace eval ::tk::dialog::error { namespace import -force ::tk::msgcat::* @@ -88,8 +88,10 @@ proc ::tk::dialog::error::bgerror err { # Ok the application's tkerror either failed or was not found # we use the default dialog then : + set windowingsystem [tk windowingsystem] + if {($tcl_platform(platform) eq "macintosh") - || ([tk windowingsystem] eq "aqua")} { + || ($windowingsystem eq "aqua")} { set ok [mc Ok] set messageFont system set textRelief flat @@ -130,7 +132,7 @@ proc ::tk::dialog::error::bgerror err { # 1. Create the top-level window and divide it into top # and bottom parts. - catch {destroy .bgerrorDialog} + destroy .bgerrorDialog toplevel .bgerrorDialog -class ErrorDialog wm withdraw .bgerrorDialog wm title .bgerrorDialog $title @@ -138,13 +140,13 @@ proc ::tk::dialog::error::bgerror err { wm protocol .bgerrorDialog WM_DELETE_WINDOW { } if {($tcl_platform(platform) eq "macintosh") - || ([tk windowingsystem] eq "aqua")} { + || ($windowingsystem eq "aqua")} { ::tk::unsupported::MacWindowStyle style .bgerrorDialog zoomDocProc } frame .bgerrorDialog.bot frame .bgerrorDialog.top - if {[tk windowingsystem] eq "x11"} { + if {$windowingsystem eq "x11"} { .bgerrorDialog.bot configure -relief raised -bd 1 .bgerrorDialog.top configure -relief raised -bd 1 } @@ -181,7 +183,7 @@ proc ::tk::dialog::error::bgerror err { label .bgerrorDialog.msg -justify left -text $text -font $messageFont \ -wraplength $wrapwidth if {($tcl_platform(platform) eq "macintosh") - || ([tk windowingsystem] eq "aqua")} { + || ($windowingsystem eq "aqua")} { # On the Macintosh, use the stop bitmap label .bgerrorDialog.bitmap -bitmap stop } else { @@ -217,7 +219,7 @@ proc ::tk::dialog::error::bgerror err { grid columnconfigure .bgerrorDialog.bot $i -weight 1 # We boost the size of some Mac buttons for l&f if {($tcl_platform(platform) eq "macintosh") - || ([tk windowingsystem] eq "aqua")} { + || ($windowingsystem eq "aqua")} { if {($name eq "ok") || ($name eq "dismiss")} { grid columnconfigure .bgerrorDialog.bot $i -minsize 79 } diff --git a/library/button.tcl b/library/button.tcl index f6cea6a..a4c3447 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.17 2002/09/04 02:05:52 hobbs Exp $ +# RCS: @(#) $Id: button.tcl,v 1.17.2.1 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -18,8 +18,7 @@ # The code below creates the default class bindings for buttons. #------------------------------------------------------------------------- -if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { bind Radiobutton <Enter> { tk::ButtonEnter %W } @@ -39,7 +38,7 @@ if {[string equal [tk windowingsystem] "classic"] tk::ButtonUp %W } } -if {[string equal "windows" $tcl_platform(platform)]} { +if {"windows" eq $tcl_platform(platform)} { bind Checkbutton <equal> { tk::CheckRadioInvoke %W select } @@ -69,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 @@ -128,7 +127,7 @@ bind Radiobutton <Leave> { tk::ButtonLeave %W } -if {[string equal "windows" $tcl_platform(platform)]} { +if {"windows" eq $tcl_platform(platform)} { ######################### # Windows implementation @@ -309,7 +308,7 @@ proc ::tk::CheckRadioDown w { } -if {[string equal "x11" [tk windowingsystem]]} { +if {"x11" eq [tk windowingsystem]} { ##################### # Unix implementation @@ -417,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. @@ -445,8 +444,7 @@ proc ::tk::ButtonUp w { } -if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { #################### # Mac implementation diff --git a/library/choosedir.tcl b/library/choosedir.tcl index 073dedc..4a3e648 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.15.2.1 2005/04/12 20:33:35 hobbs Exp $ +# RCS: @(#) $Id: choosedir.tcl,v 1.15.2.2 2006/01/25 18:21:41 dgp Exp $ # Make sure the tk::dialog namespace, in which all dialogs should live, exists namespace eval ::tk::dialog {} @@ -29,7 +29,7 @@ proc ::tk::dialog::file::chooseDir:: {args} { upvar ::tk::dialog::file::$dataName data ::tk::dialog::file::chooseDir::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 { @@ -71,7 +71,7 @@ proc ::tk::dialog::file::chooseDir:: {args} { wm transient $w $data(-parent) } - trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w] + trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w] $data(dirMenuBtn) configure \ -textvariable ::tk::dialog::file::${dataName}(selectPath) @@ -107,8 +107,8 @@ proc ::tk::dialog::file::chooseDir:: {args} { # Cleanup traces on selectPath variable # - foreach trace [trace vinfo data(selectPath)] { - trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1] + foreach trace [trace info variable data(selectPath)] { + trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] } $data(dirMenuBtn) configure -textvariable {} @@ -129,8 +129,8 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { # last time the file dialog is used. The traces may cause troubles # if the dialog is now used with a different -parent option. # - foreach trace [trace vinfo data(selectPath)] { - trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1] + foreach trace [trace info variable data(selectPath)] { + trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] } # 1: the configuration specs @@ -153,7 +153,7 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { # tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList - if {$data(-title) == ""} { + if {$data(-title) eq ""} { set data(-title) "[mc "Choose Directory"]" } @@ -165,7 +165,7 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { # 4: set the default directory and selection according to the -initial # settings # - if {$data(-initialdir) != ""} { + if {$data(-initialdir) ne ""} { # Ensure that initialdir is an absolute path name. if {[file isdirectory $data(-initialdir)]} { set old [pwd] @@ -208,7 +208,7 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { ::tk::dialog::file::chooseDir::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]]] @@ -217,7 +217,7 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { # 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 } else { @@ -227,7 +227,7 @@ 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)] } { + if { $text eq $data(selectPath) } { ::tk::dialog::file::chooseDir::Done $w $text } else { set data(selectPath) $text @@ -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,7 +278,7 @@ 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) } { diff --git a/library/clrpick.tcl b/library/clrpick.tcl index 8f1acbb..c154c8b 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -3,7 +3,7 @@ # Color selection dialog for platforms that do not support a # standard color selection dialog. # -# RCS: @(#) $Id: clrpick.tcl,v 1.20 2003/02/21 14:40:26 dkf Exp $ +# RCS: @(#) $Id: clrpick.tcl,v 1.20.2.1 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # @@ -69,7 +69,7 @@ proc ::tk::dialog::color:: {args} { set sc [winfo screen $data(-parent)] set winExists [winfo exists $w] - if {!$winExists || [string compare $sc [winfo screen $w]]} { + if {!$winExists || $sc ne [winfo screen $w]} { if {$winExists} { destroy $w } @@ -171,8 +171,7 @@ proc ::tk::dialog::color::Config {dataName argList} { # 1: the configuration specs # - if {[info exists Priv(selectColor)] && \ - [string compare $Priv(selectColor) ""]} { + if {[info exists Priv(selectColor)] && $Priv(selectColor) ne ""} { set defaultColor $Priv(selectColor) } else { set defaultColor [. cget -background] @@ -188,7 +187,7 @@ proc ::tk::dialog::color::Config {dataName argList} { # tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList - if {[string equal $data(-title) ""]} { + if {$data(-title) eq ""} { set data(-title) " " } if {[catch {winfo rgb . $data(-initialcolor)} err]} { @@ -429,12 +428,12 @@ proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} { set intensity [expr {$i * $data(intensityIncr)}] set startx [expr {$i * $data(colorbarWidth) + $highlightW}] - if {[string equal $c "red"]} { + if {$c eq "red"} { set color [format "#%02x%02x%02x" \ $intensity \ $data(green,intensity) \ $data(blue,intensity)] - } elseif {[string equal $c "green"]} { + } elseif {$c eq "green"} { set color [format "#%02x%02x%02x" \ $data(red,intensity) \ $intensity \ diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 9cc5d74..51154bb 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.9 2003/02/21 13:32:14 dkf Exp $ +# RCS: @(#) $Id: comdlg.tcl,v 1.9.2.1 2006/01/25 18:21:41 dgp 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,16 +184,10 @@ 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 { - unset FocusIn($t,$w) - } - catch { - unset FocusOut($t,$w) - } + unset -nocomplain FocusIn($t,$w) FocusOut($t,$w) } } @@ -206,8 +200,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 +212,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 +233,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 } @@ -279,11 +271,11 @@ proc ::tk::FDGetFileTypes {string} { continue } - set name "$label (" + set name "$label \(" set sep "" set doAppend 1 foreach ext $fileTypes($label) { - if {[string equal $ext ""]} { + if {$ext eq ""} { continue } regsub {^[.]} $ext "*." ext @@ -299,9 +291,9 @@ proc ::tk::FDGetFileTypes {string} { lappend exts $ext set hasGotExt($label,$ext) 1 } - set sep , + set sep "," } - append name ")" + append name "\)" lappend types [list $name $exts] set hasDoneType($label) 1 diff --git a/library/console.tcl b/library/console.tcl index fba7fec..037eb59 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.22.2.4 2005/11/30 01:22:55 hobbs Exp $ +# RCS: @(#) $Id: console.tcl,v 1.22.2.5 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. @@ -49,8 +49,8 @@ proc ::tk::ConsoleInit {} { wm withdraw . } - if {[string equal $tcl_platform(platform) "macintosh"] - || [string equal [tk windowingsystem] "aqua"]} { + if {$tcl_platform(platform) eq "macintosh" + || [tk windowingsystem] eq "aqua"} { set mod "Cmd" } else { set mod "Ctrl" @@ -67,8 +67,8 @@ proc ::tk::ConsoleInit {} { -underline 0 -command {wm withdraw .} .menubar.file add command -label [mc "Clear Console"] \ -underline 0 -command {.console delete 1.0 "promptEnd linestart"} - if {[string equal $tcl_platform(platform) "macintosh"] - || [string equal [tk windowingsystem] "aqua"]} { + if {$tcl_platform(platform) eq "macintosh" + || [tk windowingsystem] eq "aqua"} { .menubar.file add command -label [mc "Quit"] \ -command exit -accel Cmd-Q } else { @@ -84,7 +84,7 @@ proc ::tk::ConsoleInit {} { .menubar.edit add command -label [mc "Paste"] -underline 1 \ -command { event generate .console <<Paste>> } -accel "$mod+V" - if {[string compare $tcl_platform(platform) "windows"]} { + if {$tcl_platform(platform) ne "windows"} { .menubar.edit add command -label [mc "Clear"] -underline 2 \ -command { event generate .console <<Clear>> } } else { @@ -111,7 +111,7 @@ proc ::tk::ConsoleInit {} { $con configure -font systemfixed } "unix" { - if {[string equal [tk windowingsystem] "aqua"]} { + if {[tk windowingsystem] eq "aqua"} { $con configure -font {Monaco 9 normal} -highlightthickness 0 } } @@ -172,7 +172,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" @@ -193,20 +193,20 @@ 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] incr pos } } - if {[string equal $cmd ""]} { + if {$cmd eq ""} { ConsolePrompt } elseif {[info complete $cmd]} { .console mark set output end .console tag delete input set result [consoleinterp record $cmd] - if {[string compare $result ""]} { + if {$result ne ""} { puts $result } ConsoleHistory reset @@ -255,7 +255,7 @@ proc ::tk::ConsoleHistory {cmd} { } else { set cmd "history event $HistNum" } - if {[string compare $cmd ""]} { + if {$cmd ne ""} { catch {consoleinterp eval $cmd} cmd } .console delete promptEnd end @@ -277,7 +277,7 @@ proc ::tk::ConsoleHistory {cmd} { proc ::tk::ConsolePrompt {{partial normal}} { set w .console - if {[string equal $partial "normal"]} { + if {$partial eq "normal"} { set temp [$w index "end - 1 char"] $w mark set output end if {[consoleinterp eval "info exists tcl_prompt1"]} { @@ -379,8 +379,7 @@ proc ::tk::ConsoleBind {w} { break } bind Console <Delete> { - if {[string compare {} [%W tag nextrange sel 1.0 end]] \ - && [%W compare sel.first >= promptEnd]} { + if {[%W tag nextrange sel 1.0 end] ne "" && [%W compare sel.first >= promptEnd]} { %W delete sel.first sel.last } elseif {[%W compare insert >= promptEnd]} { %W delete insert @@ -388,8 +387,7 @@ proc ::tk::ConsoleBind {w} { } } bind Console <BackSpace> { - if {[string compare {} [%W tag nextrange sel 1.0 end]] \ - && [%W compare sel.first >= promptEnd]} { + if {[%W tag nextrange sel 1.0 end] ne "" && [%W compare sel.first >= promptEnd]} { %W delete sel.first sel.last } elseif {[%W compare insert != 1.0] && \ [%W compare insert > promptEnd]} { @@ -470,14 +468,13 @@ proc ::tk::ConsoleBind {w} { } bind Console <F9> { eval destroy [winfo child .] - if {[string equal $tcl_platform(platform) "macintosh"]} { + if {$tcl_platform(platform) eq "macintosh"} { if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console} } else { source [file join $tk_library console.tcl] } } - if {[string equal $::tcl_platform(platform) "macintosh"] - || [string equal [tk windowingsystem] "aqua"]} { + if {$::tcl_platform(platform) eq "macintosh" || [tk windowingsystem] eq "aqua"} { bind Console <Command-q> { exit } @@ -513,28 +510,28 @@ proc ::tk::ConsoleBind {w} { ## Bindings for doing special things based on certain keys ## bind PostConsole <Key-parenright> { - if {[string compare \\ [%W get insert-2c]]} { + if {"\\" ne [%W get insert-2c]} { ::tk::console::MatchPair %W \( \) promptEnd } } bind PostConsole <Key-bracketright> { - if {[string compare \\ [%W get insert-2c]]} { + if {"\\" ne [%W get insert-2c]} { ::tk::console::MatchPair %W \[ \] promptEnd } } bind PostConsole <Key-braceright> { - if {[string compare \\ [%W get insert-2c]]} { + if {"\\" ne [%W get insert-2c]} { ::tk::console::MatchPair %W \{ \} promptEnd } } bind PostConsole <Key-quotedbl> { - if {[string compare \\ [%W get insert-2c]]} { + if {"\\" ne [%W get insert-2c]} { ::tk::console::MatchQuote %W promptEnd } } bind PostConsole <KeyPress> { - if {"%A" != ""} { + if {"%A" ne ""} { ::tk::console::TagProc %W } break @@ -552,7 +549,7 @@ proc ::tk::ConsoleBind {w} { # s - The string to insert (usually just a single character) proc ::tk::ConsoleInsert {w s} { - if {[string equal $s ""]} { + if {$s eq ""} { return } catch { @@ -625,7 +622,7 @@ proc ::tk::console::TagProc w { if {!$::tk::console::magicKeys} { return } set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]" set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c] - if {$i == ""} {set i promptEnd} else {append i +2c} + if {$i eq ""} {set i promptEnd} else {append i +2c} regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c if {[llength [EvalAttached [list info commands $c]]]} { $w tag add proc $i "insert-1c wordend" @@ -658,24 +655,23 @@ proc ::tk::console::TagProc w { proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { if {!$::tk::console::magicKeys} { return } - if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} { + if {[set ix [$w search -back $c1 insert $lim]] ne ""} { while { [string match {\\} [$w get $ix-1c]] && - [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]] + [set ix [$w search -back $c1 $ix-1c $lim]] ne "" } {} set i1 insert-1c - while {[string compare {} $ix]} { + while {$ix ne ""} { set i0 $ix set j 0 - while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} { + while {[set i0 [$w search $c2 $i0 $i1]] ne ""} { append i0 +1c if {[string match {\\} [$w get $i0-2c]]} continue incr j } if {!$j} break set i1 $ix - while {$j && [string compare {} \ - [set ix [$w search -back $c1 $ix $lim]]]} { + while {$j && [set ix [$w search -back $c1 $ix $lim]] ne ""} { if {[string match {\\} [$w get $ix-1c]]} continue incr j -1 } @@ -704,7 +700,7 @@ proc ::tk::console::MatchQuote {w {lim 1.0}} { if {!$::tk::console::magicKeys} { return } set i insert-1c set j 0 - while {[string compare [set i [$w search -back \" $i $lim]] {}]} { + while {[set i [$w search -back \" $i $lim]] ne ""} { if {[string match {\\} [$w get $i-1c]]} continue if {!$j} {set i0 $i} incr j @@ -774,7 +770,7 @@ proc ::tk::console::ConstrainBuffer {w size} { proc ::tk::console::Expand {w {type ""}} { set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]" set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c] - if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c} + if {$tmp eq ""} {set tmp promptEnd} else {append tmp +2c} if {[$w compare $tmp >= insert]} { return } set str [$w get $tmp insert] switch -glob $type { @@ -784,7 +780,7 @@ proc ::tk::console::Expand {w {type ""}} { default { set res {} foreach t {Pathname Procname Variable} { - if {![catch {Expand$t $str} res] && ($res != "")} { break } + if {![catch {Expand$t $str} res] && ($res ne "")} { break } } } } @@ -793,8 +789,7 @@ proc ::tk::console::Expand {w {type ""}} { set repl [lindex $res 0] $w delete $tmp insert $w insert $tmp $repl {input stdin} - if {($len > 1) && $::tk::console::showMatches \ - && [string equal $repl $str]} { + if {($len > 1) && $::tk::console::showMatches && $repl eq $str} { puts stdout [lsort [lreplace $res 0 0]] } } else { bell } @@ -959,4 +954,4 @@ proc ::tk::console::ExpandBestMatch {l {e {}}} { } # now initialize the console -::tk::ConsoleInit +::tk::ConsoleInit diff --git a/library/dialog.tcl b/library/dialog.tcl index 3d64b4d..404593e 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.14.2.2 2005/10/05 04:14:19 hobbs Exp $ +# RCS: @(#) $Id: dialog.tcl,v 1.14.2.3 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1992-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -34,12 +34,13 @@ proc ::tk_dialog {w title text bitmap default args} { variable ::tk::Priv # Check that $default was properly given - if {[string is int $default]} { + if {[string is integer -strict $default]} { if {$default >= [llength $args]} { return -code error "default button index greater than number of\ buttons specified for tk_dialog" } - } elseif {[string equal {} $default]} { + # Never call if -strict option is omitted in previous test ! + } elseif {"" eq $default} { set default -1 } else { set default [lsearch -exact $args $default] @@ -48,7 +49,7 @@ proc ::tk_dialog {w title text bitmap default args} { # 1. Create the top-level window and divide it into top # and bottom parts. - catch {destroy $w} + destroy $w toplevel $w -class Dialog wm title $w $title wm iconname $w Dialog @@ -65,14 +66,15 @@ proc ::tk_dialog {w title text bitmap default args} { wm transient $w [winfo toplevel [winfo parent $w]] } - if {[string equal $tcl_platform(platform) "macintosh"] - || [string equal [tk windowingsystem] "aqua"]} { + set windowingsystem [tk windowingsystem] + + if {$tcl_platform(platform) eq "macintosh" || $windowingsystem eq "aqua"} { ::tk::unsupported::MacWindowStyle style $w dBoxProc } frame $w.bot frame $w.top - if {[string equal [tk windowingsystem] "x11"]} { + if {$windowingsystem eq "x11"} { $w.bot configure -relief raised -bd 1 $w.top configure -relief raised -bd 1 } @@ -84,8 +86,7 @@ proc ::tk_dialog {w title text bitmap default args} { # overridden by the caller). option add *Dialog.msg.wrapLength 3i widgetDefault - if {[string equal $tcl_platform(platform) "macintosh"] - || [string equal [tk windowingsystem] "aqua"]} { + if {$tcl_platform(platform) eq "macintosh" || $windowingsystem eq "aqua"} { option add *Dialog.msg.font system widgetDefault } else { option add *Dialog.msg.font {Times 12} widgetDefault @@ -95,7 +96,7 @@ proc ::tk_dialog {w title text bitmap default args} { pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m if {$bitmap ne ""} { if {($tcl_platform(platform) eq "macintosh" - || [tk windowingsystem] eq "aqua") && ($bitmap eq "error")} { + || $windowingsystem eq "aqua") && ($bitmap eq "error")} { set bitmap "stop" } label $w.bitmap -bitmap $bitmap @@ -116,10 +117,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 $tcl_platform(platform) "macintosh"] - || [string equal [tk windowingsystem] "aqua"]} { + if {$tcl_platform(platform) eq "macintosh" || $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}] } } diff --git a/library/entry.tcl b/library/entry.tcl index 8828909..3fb4e67 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.21 2003/01/23 23:30:11 drh Exp $ +# RCS: @(#) $Id: entry.tcl,v 1.21.2.1 2006/01/25 18:21:41 dgp 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 } @@ -204,14 +204,13 @@ bind Entry <Escape> {# nothing} bind Entry <Return> {# nothing} bind Entry <KP_Enter> {# nothing} bind Entry <Tab> {# nothing} -if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "classic" || [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]} } @@ -333,7 +332,7 @@ 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 -- @@ -404,7 +403,7 @@ 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 -- @@ -461,7 +460,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 { @@ -563,7 +562,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} { @@ -645,7 +644,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..88e8cd4 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.9.4.1 2006/01/25 18:21:41 dgp 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 } } @@ -130,14 +130,14 @@ proc ::tk_focusPrev w { proc ::tk::FocusOK w { set code [catch {$w cget -takefocus} value] - if {($code == 0) && ($value != "")} { + if {($code == 0) && ($value ne "")} { if {$value == 0} { return 0 } elseif {$value == 1} { return [winfo viewable $w] } else { set value [uplevel #0 $value [list $w]] - if {$value != ""} { + if {$value ne ""} { return $value } } @@ -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,15 @@ 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 5cec546..fb5c47b 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.2.3 2005/09/10 14:54:17 das Exp $ +# RCS: @(#) $Id: listbox.tcl,v 1.13.2.4 2006/01/25 18:21:41 dgp 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>> } @@ -178,9 +178,7 @@ bind Listbox <B2-Motion> { # The MouseWheel will typically only fire on Windows and Mac OS X. # However, someone could use the "event generate" command to produce # one on other platforms. - -if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { bind Listbox <MouseWheel> { %W yview scroll [expr {- (%D)}] units } @@ -199,7 +197,7 @@ if {[string equal [tk windowingsystem] "classic"] } } -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: @@ -230,7 +228,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 { @@ -271,7 +269,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 } @@ -316,7 +314,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 { @@ -340,7 +338,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 @@ -426,7 +424,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] @@ -452,13 +450,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 } @@ -476,12 +474,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 } @@ -511,7 +509,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 021e891..aedeb95 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.18.2.3 2005/12/01 17:47:14 hobbs Exp $ +# RCS: @(#) $Id: menu.tcl,v 1.18.2.4 2006/01/25 18:21:41 dgp 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,16 @@ 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,21 +417,19 @@ proc ::tk::MenuUnpost menu { while {1} { set parent [winfo parent $menu] - if {[string compare [winfo class $parent] "Menu"] \ - || ![winfo ismapped $parent]} { + if {[winfo class $parent] ne "Menu" || ![winfo ismapped $parent]} { break } $parent activate none $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 +438,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 +469,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 +529,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 +568,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 +588,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 +614,11 @@ 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 +638,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 +649,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 +698,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 +712,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 +720,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 +728,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 +736,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 +758,21 @@ 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,14 +783,14 @@ 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 } } @@ -808,8 +800,8 @@ proc ::tk::MenuNextMenu {menu direction} { # 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"]} { + if {[winfo class $m2] eq "Menu"} { + if {[$m2 cget -type] eq "menubar"} { tk_menuSetFocus $m2 MenuNextEntry $m2 -1 return @@ -817,7 +809,7 @@ proc ::tk::MenuNextMenu {menu direction} { } set w $Priv(postedMb) - if {[string equal $w ""]} { + if {$w eq ""} { return } set buttons [winfo children [winfo parent $w]] @@ -831,13 +823,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 +848,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 +888,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 +922,22 @@ 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 +947,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] { 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 +963,7 @@ proc ::tk::MenuFind {w char} { default { set match [MenuFind $child $char] - if {[string compare $match ""]} { + if {$match ne ""} { return $match } } @@ -999,22 +986,20 @@ 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) ""]} { - return - } - if {[string equal [$w cget -type] "menubar"]} { + while {[winfo class $w] eq "Menu"} { + if {[$w cget -type] eq "menubar"} { break + } elseif {$Priv(postedMb) eq ""} { + return } 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 +1023,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 +1049,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 +1062,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 +1092,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 +1143,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 } } @@ -1252,7 +1236,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 +1248,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 +1257,7 @@ 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/msgbox.tcl b/library/msgbox.tcl index a1f2ed1..fdf987a 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -3,7 +3,7 @@ # Implements messageboxes for platforms that do not have native # messagebox support. # -# RCS: @(#) $Id: msgbox.tcl,v 1.24.2.2 2004/05/13 23:28:34 dkf Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.24.2.3 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -157,8 +157,10 @@ proc ::tk::MessageBox {args} { if {[lsearch -exact {info warning error question} $data(-icon)] == -1} { error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" } - if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { + + # Store tk windowingsystem to avoid too many calls + set windowingsystem [tk windowingsystem] + if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} { switch -- $data(-icon) { "error" {set data(-icon) "stop"} "warning" {set data(-icon) "caution"} @@ -210,13 +212,13 @@ proc ::tk::MessageBox {args} { # If no default button was specified, the default default is the # first button (Bug: 2218). - if {$data(-default) == ""} { + if {$data(-default) eq ""} { set data(-default) [lindex [lindex $buttons 0] 0] } set valid 0 foreach btn $buttons { - if {[string equal [lindex $btn 0] $data(-default)]} { + if {[lindex $btn 0] eq $data(-default)} { set valid 1 break } @@ -228,7 +230,7 @@ proc ::tk::MessageBox {args} { # 2. Set the dialog to be a child window of $parent # # - if {[string compare $data(-parent) .]} { + if {$data(-parent) ne "."} { set w $data(-parent).__tk__messagebox } else { set w .__tk__messagebox @@ -237,7 +239,7 @@ proc ::tk::MessageBox {args} { # 3. Create the top-level window and divide it into top # and bottom parts. - catch {destroy $w} + destroy $w toplevel $w -class Dialog wm title $w $data(-title) wm iconname $w Dialog @@ -256,8 +258,7 @@ proc ::tk::MessageBox {args} { wm transient $w $data(-parent) } - if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { + if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} { unsupported::MacWindowStyle style $w dBoxProc } @@ -265,8 +266,7 @@ proc ::tk::MessageBox {args} { pack $w.bot -side bottom -fill both frame $w.top -background $bg pack $w.top -side top -fill both -expand 1 - if {![string equal [tk windowingsystem] "classic"] - && ![string equal [tk windowingsystem] "aqua"]} { + if {$windowingsystem ne "classic" && $windowingsystem ne "aqua"} { $w.bot configure -relief raised -bd 1 $w.top configure -relief raised -bd 1 } @@ -276,8 +276,7 @@ proc ::tk::MessageBox {args} { # overridden by the caller). option add *Dialog.msg.wrapLength 3i widgetDefault - if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { + if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} { option add *Dialog.msg.font system widgetDefault } else { option add *Dialog.msg.font {Times 14} widgetDefault @@ -285,9 +284,8 @@ proc ::tk::MessageBox {args} { label $w.msg -anchor nw -justify left -text $data(-message) \ -background $bg - if {[string compare $data(-icon) ""]} { - if {([string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]) + if {$data(-icon) ne ""} { + if {($windowingsystem eq "classic" || $windowingsystem eq "aqua") || ([winfo depth $w] < 4) || $tk_strictMotif} { label $w.bitmap -bitmap $data(-icon) -background $bg } else { @@ -345,7 +343,7 @@ proc ::tk::MessageBox {args} { eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \ [list -command [list set tk::Priv(button) $name]] - if {[string equal $name $data(-default)]} { + if {$name eq $data(-default)} { $w.$name configure -default active } else { $w.$name configure -default normal @@ -365,14 +363,14 @@ proc ::tk::MessageBox {args} { } bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A] - if {[string compare {} $data(-default)]} { + if {$data(-default) ne ""} { bind $w <FocusIn> { - if {[string equal Button [winfo class %W]]} { + if {"Button" eq [winfo class %W]} { %W configure -default active } } bind $w <FocusOut> { - if {[string equal Button [winfo class %W]]} { + if {"Button" eq [winfo class %W]} { %W configure -default normal } } @@ -381,7 +379,7 @@ proc ::tk::MessageBox {args} { # 6. Create a binding for <Return> on the dialog bind $w <Return> { - if {[string equal Button [winfo class %W]]} { + if {"Button" eq [winfo class %W]} { tk::ButtonInvoke %W } } @@ -394,7 +392,7 @@ proc ::tk::MessageBox {args} { # 8. Set a grab and claim the focus too. - if {[string compare $data(-default) ""]} { + if {$data(-default) ne ""} { set focus $w.$data(-default) } else { set focus $w diff --git a/library/palette.tcl b/library/palette.tcl index 55834d3..05d59e7 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.8.2.1 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # @@ -52,9 +52,13 @@ proc ::tk_setPalette {args} { set new(foreground) white } } - set fg [winfo rgb . $new(foreground)] - set darkerBg [format #%02x%02x%02x [expr {(9*[lindex $bg 0])/2560}] \ - [expr {(9*[lindex $bg 1])/2560}] [expr {(9*[lindex $bg 2])/2560}]] + + # To avoir too many lindex... + foreach {fg_r fg_g fg_b} [winfo rgb . $new(foreground)] {break} + foreach {bg_r bg_g bg_b} $bg {break} + + set darkerBg [format #%02x%02x%02x [expr {(9*$bg_r)/2560}] \ + [expr {(9*$bg_g)/2560}] [expr {(9*$bg_b)/2560}]] foreach i {activeForeground insertBackground selectForeground \ highlightColor} { if {![info exists new($i)]} { @@ -63,9 +67,9 @@ proc ::tk_setPalette {args} { } if {![info exists new(disabledForeground)]} { set new(disabledForeground) [format #%02x%02x%02x \ - [expr {(3*[lindex $bg 0] + [lindex $fg 0])/1024}] \ - [expr {(3*[lindex $bg 1] + [lindex $fg 1])/1024}] \ - [expr {(3*[lindex $bg 2] + [lindex $fg 2])/1024}]] + [expr {(3*$bg_r + $fg_r)/1024}] \ + [expr {(3*$bg_g + $fg_g)/1024}] \ + [expr {(3*$bg_b + $fg_b)/1024}]] } if {![info exists new(highlightBackground)]} { set new(highlightBackground) $new(background) @@ -76,8 +80,8 @@ proc ::tk_setPalette {args} { # up by 15% or 1/3 of the way to full white, whichever is # greater. - foreach i {0 1 2} { - set light($i) [expr {[lindex $bg $i]/256}] + foreach i {0 1 2} color "$bg_r $bg_g $bg_b" { + set light($i) [expr {$color/256}] set inc1 [expr {($light($i)*15)/100}] set inc2 [expr {(255-$light($i))/3}] if {$inc1 > $inc2} { @@ -128,7 +132,7 @@ proc ::tk_setPalette {args} { eval [tk::RecolorTree . new] - catch {destroy .___tk_set_palette} + destroy .___tk_set_palette # Change the option database so that future windows will get the # same colors. diff --git a/library/panedwindow.tcl b/library/panedwindow.tcl index 5bf72f6..68ce7c7 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.6.2.3 2005/02/12 00:48:05 hobbs Exp $ +# RCS: @(#) $Id: panedwindow.tcl,v 1.6.2.4 2006/01/25 18:21:41 dgp Exp $ # bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 } @@ -39,7 +39,7 @@ proc ::tk::panedwindow::MarkSash {w x y proxy} { set what [$w identify $x $y] if { [llength $what] == 2 } { foreach {index which} $what break - if { !$::tk_strictMotif || [string equal $which "handle"] } { + if { !$::tk_strictMotif || $which eq "handle" } { if {!$proxy} { $w sash mark $index $x $y } set ::tk::Priv(sash) $index foreach {sx sy} [$w sash coord $index] break @@ -115,11 +115,11 @@ 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"])} { + (!$::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"] } { + if { [$w cget -sashcursor] eq "" } { + if { [$w cget -orient] eq "horizontal" } { $w configure -cursor sb_h_double_arrow } else { $w configure -cursor sb_v_double_arrow diff --git a/library/safetk.tcl b/library/safetk.tcl index 1993ade..33ec8a6 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.8.8.1 2006/01/25 18:21:41 dgp 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 4373434..54827f9 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.9.2.3 2003/10/03 00:42:17 patthoyts Exp $ +# RCS: @(#) $Id: scale.tcl,v 1.9.2.4 2006/01/25 18:21:41 dgp 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,7 +271,7 @@ proc ::tk::ScaleControlPress {w x y} { proc ::tk::ScaleButton2Down {w x y} { variable ::tk::Priv - if {[string equal [$w cget -state] "disabled"]} { + if {[$w cget -state] eq "disabled"} { return } $w configure -state active diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 49cd1b6..516fb38 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.2.1 2004/02/17 07:17:17 das Exp $ +# RCS: @(#) $Id: scrlbar.tcl,v 1.10.2.2 2006/01/25 18:21:41 dgp 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} { @@ -130,8 +130,7 @@ bind Scrollbar <End> { tk::ScrollToPos %W 1 } } -if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { bind Scrollbar <MouseWheel> { tk::ScrollByUnits %W v [expr {- (%D)}] } @@ -159,7 +158,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 @@ -210,10 +209,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 \ @@ -233,7 +232,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 @@ -263,7 +262,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)}]] @@ -293,7 +292,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]} { @@ -317,8 +316,7 @@ proc ::tk::ScrollEndDrag {w x y} { proc ::tk::ScrollByUnits {w orient amount} { set cmd [$w cget -command] - if {[string equal $cmd ""] || ([string first \ - [string index [$w cget -orient] 0] $orient] < 0)} { + if {$cmd eq "" || ([string first [string index [$w cget -orient] 0] $orient] < 0)} { return } set info [$w get] @@ -342,8 +340,7 @@ proc ::tk::ScrollByUnits {w orient amount} { proc ::tk::ScrollByPages {w orient amount} { set cmd [$w cget -command] - if {[string equal $cmd ""] || ([string first \ - [string index [$w cget -orient] 0] $orient] < 0)} { + if {$cmd eq "" || ([string first [string index [$w cget -orient] 0] $orient] < 0)} { return } set info [$w get] @@ -366,7 +363,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 8d0a52b..5cce031 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.6 2002/08/31 06:12:28 das Exp $ +# RCS: @(#) $Id: spinbox.tcl,v 1.6.2.1 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -212,14 +212,14 @@ bind Spinbox <Escape> {# nothing} bind Spinbox <Return> {# nothing} bind Spinbox <KP_Enter> {# nothing} bind Spinbox <Tab> {# nothing} -if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { + +if {[tk windowingsystem] eq "classic" || [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]} } @@ -496,7 +496,7 @@ 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 8bcdc81..053ebd9 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.7 2001/08/01 16:21:11 dgp Exp $ +# RCS: @(#) $Id: tearoff.tcl,v 1.7.4.1 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -40,11 +40,10 @@ 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} { @@ -61,7 +60,7 @@ 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] { @@ -92,7 +91,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 @@ -114,14 +113,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/text.tcl b/library/text.tcl index 8e77e98..6d94ff6 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -3,7 +3,7 @@ # This file defines the default bindings for Tk text widgets and provides # procedures that help in implementing the bindings. # -# RCS: @(#) $Id: text.tcl,v 1.24.2.7 2005/09/10 14:54:17 das Exp $ +# RCS: @(#) $Id: text.tcl,v 1.24.2.8 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -180,7 +180,7 @@ bind Text <Control-Shift-End> { } bind Text <Tab> { - if { [string equal [%W cget -state] "normal"] } { + if { [%W cget -state] eq "normal" } { tk::TextInsert %W \t focus %W break @@ -276,8 +276,8 @@ bind Text <Meta-KeyPress> {# nothing} bind Text <Control-KeyPress> {# nothing} bind Text <Escape> {# nothing} bind Text <KP_Enter> {# nothing} -if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { + +if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { bind Text <Command-KeyPress> {# nothing} } @@ -394,8 +394,7 @@ bind Text <Meta-Delete> { # Macintosh only bindings: # if text black & highlight black -> text white, other text the same -if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { bind Text <FocusIn> { %W tag configure sel -borderwidth 0 %W configure -selectbackground systemHighlight -selectforeground systemHighlightText @@ -458,8 +457,7 @@ set ::tk::Priv(prevPos) {} # However, someone could use the "event generate" command to produce # one on other platforms. -if {[string equal [tk windowingsystem] "classic"] - || [string equal [tk windowingsystem] "aqua"]} { +if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { bind Text <MouseWheel> { %W yview scroll [expr {- (%D)}] units } @@ -478,7 +476,7 @@ if {[string equal [tk windowingsystem] "classic"] } } -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: @@ -508,7 +506,7 @@ if {[string equal "x11" [tk windowingsystem]]} { proc ::tk::TextClosestGap {w x y} { set pos [$w index @$x,$y] set bbox [$w bbox $pos] - if {[string equal $bbox ""]} { + if {$bbox eq ""} { return $pos } if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { @@ -537,8 +535,7 @@ proc ::tk::TextButton1 {w x y} { $w mark set anchor insert # Allow focus in any case on Windows, because that will let the # selection be displayed even for state disabled text widgets. - if {[string equal $::tcl_platform(platform) "windows"] \ - || [string equal [$w cget -state] "normal"]} {focus $w} + if {$::tcl_platform(platform) eq "windows" || [$w cget -state] eq "normal"} {focus $w} if {[$w cget -autoseparators]} {$w edit separator} } @@ -662,7 +659,7 @@ proc ::tk::TextPasteSelection {w x y} { $w configure -autoseparators 1 } } - if {[string equal [$w cget -state] "normal"]} {focus $w} + if {[$w cget -state] eq "normal"} {focus $w} } # ::tk::TextAutoScan -- @@ -727,7 +724,7 @@ proc ::tk::TextSetCursor {w pos} { proc ::tk::TextKeySelect {w new} { - if {[string equal [$w tag nextrange sel 1.0 end] ""]} { + if {[$w tag nextrange sel 1.0 end] eq ""} { if {[$w compare $new < insert]} { $w tag add sel $new insert } else { @@ -767,7 +764,7 @@ proc ::tk::TextKeySelect {w new} { proc ::tk::TextResetAnchor {w index} { - if {[string equal [$w tag ranges sel] ""]} { + if {[$w tag ranges sel] eq ""} { # Don't move the anchor if there is no selection now; this makes # the widget behave "correctly" when the user clicks once, then # shift-clicks somewhere -- ie, the area between the two clicks will be @@ -817,7 +814,7 @@ proc ::tk::TextResetAnchor {w index} { # s - The string to insert (usually just a single character) proc ::tk::TextInsert {w s} { - if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} { + if {$s eq "" || [$w cget -state] eq "disabled"} { return } set compound 0 @@ -882,8 +879,8 @@ proc ::tk::TextUpDownLine {w n} { proc ::tk::TextPrevPara {w pos} { set pos [$w index "$pos linestart"] while {1} { - if {([string equal [$w get "$pos - 1 line"] "\n"] \ - && [$w get $pos] ne "\n") || [string equal $pos 1.0]} { + if {([$w get "$pos - 1 line"] eq "\n" \ + && [$w get $pos] ne "\n") || $pos eq "1.0"} { if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \ dummy index]} { set pos [$w index "$pos + [lindex $index 0] chars"] @@ -941,7 +938,7 @@ proc ::tk::TextNextPara {w start} { proc ::tk::TextScrollPages {w count} { set bbox [$w bbox insert] $w yview scroll $count pages - if {[string equal $bbox ""]} { + if {$bbox eq ""} { return [$w index @[expr {[winfo height $w]/2}],0] } return [$w index @[lindex $bbox 0],[lindex $bbox 1]] @@ -1048,7 +1045,7 @@ proc ::tk_textPaste w { # w - The text window in which the cursor is to move. # start - Position at which to start search. -if {[string equal $tcl_platform(platform) "windows"]} { +if {$tcl_platform(platform) eq "windows"} { proc ::tk::TextNextWord {w start} { TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \ tcl_startOfNextWord diff --git a/library/tk.tcl b/library/tk.tcl index 57c6926..60e807b 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.46.2.2 2004/10/29 11:16:37 patthoyts Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.46.2.3 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -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 } @@ -79,20 +79,21 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { wm withdraw $w update idletasks set checkBounds 1 + set place_len [string length $place] if {$place eq ""} { set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}] set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}] set checkBounds 0 - } elseif {[string equal -len [string length $place] $place "pointer"]} { + } elseif {[string equal -length $place_len $place "pointer"]} { ## place at POINTER (centered if $anchor == center) - if {[string equal -len [string length $anchor] $anchor "center"]} { + if {[string equal -length [string length $anchor] $anchor "center"]} { set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}] set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}] } else { set x [winfo pointerx $w] set y [winfo pointery $w] } - } elseif {[string equal -len [string length $place] $place "widget"] && \ + } elseif {[string equal -length $place_len $place "widget"] && \ [winfo exists $anchor] && [winfo ismapped $anchor]} { ## center about WIDGET $anchor, widget must be mapped set x [expr {[winfo rootx $anchor] + \ @@ -104,7 +105,10 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}] set checkBounds 0 } - if {[tk windowingsystem] eq "win32"} { + + set windowingsystem [tk windowingsystem] + + if {$windowingsystem eq "win32"} { # Bug 533519: win32 multiple desktops may produce negative geometry. set checkBounds 0 } @@ -119,8 +123,7 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { } elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} { set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}] } - if {[tk windowingsystem] eq "macintosh" \ - || [tk windowingsystem] eq "aqua"} { + if {$windowingsystem eq "macintosh" || $windowingsystem eq "aqua"} { # Avoid the native menu bar which sits on top of everything. if {$y < 20} { set y 20 } } @@ -175,13 +178,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 @@ -201,7 +204,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] \ @@ -308,12 +311,12 @@ proc ::tk::EventMotifBindings {n1 dummy dummy} { # using compiled code. #---------------------------------------------------------------------- -if {[string equal [info commands tk_chooseColor] ""]} { +if {[info commands tk_chooseColor] eq ""} { proc ::tk_chooseColor {args} { return [eval tk::dialog::color:: $args] } } -if {[string equal [info commands tk_getOpenFile] ""]} { +if {[info commands tk_getOpenFile] eq ""} { proc ::tk_getOpenFile {args} { if {$::tk_strictMotif} { return [eval tk::MotifFDialog open $args] @@ -322,7 +325,7 @@ if {[string equal [info commands tk_getOpenFile] ""]} { } } } -if {[string equal [info commands tk_getSaveFile] ""]} { +if {[info commands tk_getSaveFile] eq ""} { proc ::tk_getSaveFile {args} { if {$::tk_strictMotif} { return [eval tk::MotifFDialog save $args] @@ -331,12 +334,12 @@ if {[string equal [info commands tk_getSaveFile] ""]} { } } } -if {[string equal [info commands tk_messageBox] ""]} { +if {[info commands tk_messageBox] eq ""} { proc ::tk_messageBox {args} { return [eval tk::MessageBox $args] } } -if {[string equal [info command tk_chooseDirectory] ""]} { +if {[info command tk_chooseDirectory] eq ""} { proc ::tk_chooseDirectory {args} { return [eval ::tk::dialog::file::chooseDir:: $args] } @@ -364,7 +367,7 @@ switch [tk windowingsystem] { # This seems to be correct on *some* HP systems. catch { event add <<PrevWindow>> <hpBackTab> } - trace variable ::tk_strictMotif w ::tk::EventMotifBindings + trace add variable ::tk_strictMotif write ::tk::EventMotifBindings set ::tk_strictMotif $::tk_strictMotif } "win32" { @@ -399,7 +402,7 @@ switch [tk windowingsystem] { # ---------------------------------------------------------------------- if {$::tk_library ne ""} { - if {[string equal $tcl_platform(platform) "macintosh"]} { + if {$tcl_platform(platform) eq "macintosh"} { proc ::tk::SourceLibFile {file} { if {[catch { namespace eval :: \ @@ -456,8 +459,9 @@ proc ::tk::CancelRepeat {} { # w - Window to which focus should be set. proc ::tk::TabToWindow {w} { - if {[string equal [winfo class $w] Entry] \ - || [string equal [winfo class $w] Spinbox]} { + set wclass [winfo class $w] + + if {$wclass eq "Entry" || $wclass eq "Spinbox"} { $w selection range 0 end $w icursor end } @@ -509,7 +513,7 @@ proc ::tk::SetAmpText {widget text} { proc ::tk::AmpWidget {class path args} { set wcmd [list $class $path] foreach {opt val} $args { - if {[string equal $opt {-text}]} { + if {$opt eq "-text"} { foreach {newtext under} [::tk::UnderlineAmpersand $val] { lappend wcmd -text $newtext -underline $under } @@ -518,7 +522,7 @@ proc ::tk::AmpWidget {class path args} { } } eval $wcmd - if {$class=="button"} { + if {$class eq "button"} { bind $path <<AltUnderlined>> [list $path invoke] } return $path @@ -541,7 +545,7 @@ proc ::tk::FindAltKeyTarget {path char} { [concat [grid slaves $path] \ [pack slaves $path] \ [place slaves $path] ] { - if {""!=[set target [::tk::FindAltKeyTarget $child $char]]} { + if {"" ne [set target [::tk::FindAltKeyTarget $child $char]]} { return $target } } @@ -556,7 +560,7 @@ proc ::tk::FindAltKeyTarget {path char} { # proc ::tk::AltKeyInDialog {path key} { set target [::tk::FindAltKeyTarget $path $key] - if { $target == ""} return + if { $target eq ""} return event generate $target <<AltUnderlined>> } @@ -576,7 +580,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 5a9fb58..02bea96 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.38.2.9 2005/11/22 11:00:38 dkf Exp $ +# RCS: @(#) $Id: tkfbox.tcl,v 1.38.2.10 2006/01/25 18:21:41 dgp Exp $ # # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -320,10 +320,7 @@ proc ::tk::IconList_DeleteAll {w} { upvar ::tk::$w:itemList itemList $data(canvas) delete all - catch {unset data(selected)} - catch {unset data(rect)} - catch {unset data(list)} - catch {unset itemList} + unset -nocomplain data(selected) data(rect) data(list) itemList set data(maxIW) 1 set data(maxIH) 1 set data(maxTW) 1 @@ -464,7 +461,7 @@ proc ::tk::IconList_Arrange {w} { set data(itemsPerColumn) 1 } - if {$data(curItem) != ""} { + if {$data(curItem) ne ""} { IconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0 } } @@ -475,7 +472,7 @@ proc ::tk::IconList_Arrange {w} { proc ::tk::IconList_Invoke {w} { upvar ::tk::$w data - if {$data(-command) != "" && [llength $data(selection)]} { + if {$data(-command) ne "" && [llength $data(selection)]} { uplevel #0 $data(-command) } } @@ -492,7 +489,7 @@ proc ::tk::IconList_See {w rTag} { return } set sRegion [$data(canvas) cget -scrollregion] - if {[string equal $sRegion {}]} { + if {$sRegion eq ""} { return } @@ -526,7 +523,7 @@ proc ::tk::IconList_See {w rTag} { set dispX $x1 } - if {$oldDispX != $dispX} { + if {$oldDispX ne $dispX} { set fraction [expr {double($dispX)/double($scrollW)}] $data(canvas) xview moveto $fraction } @@ -539,7 +536,7 @@ proc ::tk::IconList_Btn1 {w x y} { set x [expr {int([$data(canvas) canvasx $x])}] set y [expr {int([$data(canvas) canvasy $y])}] set i [IconList_Index $w @${x},${y}] - if {$i==""} return + if {$i eq ""} return IconList_Selection $w clear 0 end IconList_Selection $w set $i IconList_Selection $w anchor $i @@ -553,7 +550,7 @@ proc ::tk::IconList_CtrlBtn1 {w x y} { set x [expr {int([$data(canvas) canvasx $x])}] set y [expr {int([$data(canvas) canvasy $y])}] set i [IconList_Index $w @${x},${y}] - if {$i==""} return + if {$i eq ""} return if { [IconList_Selection $w includes $i] } { IconList_Selection $w clear $i } else { @@ -571,9 +568,9 @@ proc ::tk::IconList_ShiftBtn1 {w x y} { set x [expr {int([$data(canvas) canvasx $x])}] set y [expr {int([$data(canvas) canvasy $y])}] set i [IconList_Index $w @${x},${y}] - if {$i==""} 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 @@ -591,7 +588,7 @@ proc ::tk::IconList_Motion1 {w x y} { set x [expr {int([$data(canvas) canvasx $x])}] set y [expr {int([$data(canvas) canvasy $y])}] set i [IconList_Index $w @${x},${y}] - if {$i==""} return + if {$i eq ""} return IconList_Selection $w clear 0 end IconList_Selection $w set $i } @@ -652,7 +649,7 @@ proc ::tk::IconList_UpDown {w amount} { set i 0 } else { set i [tk::IconList_Index $w anchor] - if {$i==""} return + if {$i eq ""} return incr i $amount } IconList_Selection $w clear 0 end @@ -681,7 +678,7 @@ proc ::tk::IconList_LeftRight {w amount} { set i 0 } else { set i [IconList_Index $w anchor] - if {$i==""} return + if {$i eq ""} return incr i [expr {$amount*$data(itemsPerColumn)}] } IconList_Selection $w clear 0 end @@ -717,11 +714,11 @@ proc ::tk::IconList_Goto {w text} { return } - if {[string equal {} $text]} { + if {$text eq ""} { return } - if {$data(curItem) == "" || $data(curItem) == 0} { + if {$data(curItem) eq "" || $data(curItem) == 0} { set start 0 } else { set start $data(curItem) @@ -738,7 +735,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 } @@ -762,7 +759,7 @@ proc ::tk::IconList_Goto {w text} { proc ::tk::IconList_Reset {w} { variable ::tk::Priv - catch {unset Priv(ILAccel,$w)} + unset -nocomplain Priv(ILAccel,$w) } #---------------------------------------------------------------------- @@ -796,7 +793,7 @@ proc ::tk::dialog::file:: {type args} { ::tk::dialog::file::Config $dataName $type $args - if {[string equal $data(-parent) .]} { + if {$data(-parent) eq "."} { set w .$dataName } else { set w $data(-parent).$dataName @@ -832,7 +829,7 @@ proc ::tk::dialog::file:: {type args} { } # Make sure subseqent uses of this dialog are independent [Bug 845189] - catch {unset data(extUsed)} + unset -nocomplain data(extUsed) # Dialog boxes should be transient with respect to their parent, # so that they will always stay on top of their parent window. However, @@ -848,7 +845,7 @@ proc ::tk::dialog::file:: {type args} { # Add traces on the selectPath variable # - trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w] + trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w] $data(dirMenuBtn) configure \ -textvariable ::tk::dialog::file::${dataName}(selectPath) @@ -900,8 +897,8 @@ proc ::tk::dialog::file:: {type args} { # Cleanup traces on selectPath variable # - foreach trace [trace vinfo data(selectPath)] { - trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1] + foreach trace [trace info variable data(selectPath)] { + trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] } $data(dirMenuBtn) configure -textvariable {} @@ -921,8 +918,8 @@ proc ::tk::dialog::file::Config {dataName type argList} { # last time the file dialog is used. The traces may cause troubles # if the dialog is now used with a different -parent option. - foreach trace [trace vinfo data(selectPath)] { - trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1] + foreach trace [trace info variable data(selectPath)] { + trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] } # 1: the configuration specs @@ -938,7 +935,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"} } @@ -954,8 +951,8 @@ proc ::tk::dialog::file::Config {dataName type argList} { # tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList - if {$data(-title) == ""} { - if {[string equal $type "open"]} { + if {$data(-title) eq ""} { + if {$type eq "open"} { set data(-title) "[mc "Open"]" } else { set data(-title) "[mc "Save As"]" @@ -965,7 +962,7 @@ proc ::tk::dialog::file::Config {dataName type argList} { # 4: set the default directory and selection according to the -initial # settings # - if {$data(-initialdir) != ""} { + if {$data(-initialdir) ne ""} { # Ensure that initialdir is an absolute path name. if {[file isdirectory $data(-initialdir)]} { set old [pwd] @@ -988,7 +985,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 @@ -1036,7 +1033,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 { @@ -1067,7 +1064,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 \ @@ -1108,7 +1105,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 @@ -1135,11 +1132,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)] @@ -1224,7 +1221,7 @@ proc ::tk::dialog::file::Update {w} { upvar ::tk::dialog::file::$dataName data variable ::tk::Priv global tk_library - catch {unset data(updateId)} + unset -nocomplain data(updateId) if {![info exists Priv(folderImage)]} { set Priv(folderImage) [image create photo -data { @@ -1284,7 +1281,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] # set cmd [list glob -tails -directory [pwd] \ -type {f b c l p s} -nocomplain] - if {[string equal $data(filter) *]} { + if {$data(filter) eq "*"} { lappend cmd * if {$showHidden} { lappend cmd .* } } else { @@ -1315,10 +1312,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"] @@ -1338,9 +1335,9 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] proc ::tk::dialog::file::SetPathSilently {w path} { upvar ::tk::dialog::file::[winfo name $w] data - trace vdelete data(selectPath) w [list ::tk::dialog::file::SetPath $w] + trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w] set data(selectPath) $path - trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w] + trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w] } @@ -1351,7 +1348,7 @@ proc ::tk::dialog::file::SetPath {w name1 name2 op} { upvar ::tk::dialog::file::[winfo name $w] data ::tk::dialog::file::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) } @@ -1436,7 +1433,7 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext} { # If the file has no extension, append the default. Be careful not # to do this for directories, otherwise typing a dirname in the box # will give back "dirname.extension" instead of trying to change dir. - if {![file isdirectory $path] && [string equal [file ext $path] ""]} { + if {![file isdirectory $path] && [file ext $path] eq ""} { set path "$path$defaultext" } @@ -1500,16 +1497,16 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext} { 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"] @@ -1565,7 +1562,7 @@ proc ::tk::dialog::file::VerifyFileName {w filename} { 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 @@ -1584,7 +1581,7 @@ 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]]" $data(ent) selection range 0 end @@ -1627,7 +1624,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) } } @@ -1637,7 +1634,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)] } } @@ -1727,15 +1724,15 @@ proc ::tk::dialog::file::ListBrowse {w} { $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] } { + if { [winfo class $w] eq "TkFDialog" } { ::tk::SetAmpText $data(okBtn) [mc "&Open"] } } @@ -1755,7 +1752,7 @@ proc ::tk::dialog::file::ListInvoke {w filenames} { [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 \ @@ -1787,7 +1784,7 @@ 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) { @@ -1802,12 +1799,12 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { set Priv(selectFile) $data(selectFile) set Priv(selectPath) $data(selectPath) - if {[string equal $data(type) save]} { + if {$data(type) eq "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"]} { + if {$reply eq "no"} { return } } diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 6093da3..1899a33 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.25.2.1 2004/10/27 16:37:59 dgp Exp $ +# RCS: @(#) $Id: xmfbox.tcl,v 1.25.2.2 2006/01/25 18:21:41 dgp 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 { @@ -147,10 +147,10 @@ proc ::tk::MotifFDialog_FileTypes {w} { upvar ::tk::dialog::file::[winfo name $w] data set f $w.top.f3.types - catch {destroy $f} + destroy $f # No file types: use "*" as the filter and display no radio-buttons - if {$data(-filetypes) == ""} { + if {$data(-filetypes) eq ""} { set data(filter) * return } @@ -168,7 +168,7 @@ proc ::tk::MotifFDialog_FileTypes {w} { frame $f set cnt 0 - if {$data(-filetypes) != {}} { + if {$data(-filetypes) ne ""} { foreach type $data(-filetypes) { set title [lindex [lindex $type 0] 0] set filter [lindex $type 1] @@ -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,8 +244,8 @@ 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 { @@ -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 @@ -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 { @@ -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,20 +826,20 @@ 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]} { + if {$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 {[string equal $answer "no"]} { + if {$answer eq "no"} { return } } @@ -890,8 +890,7 @@ proc ::tk::ListBoxKeyAccel_Unset {w} { variable ::tk::Priv catch {after cancel $Priv(lbAccel,$w,afterId)} - catch {unset Priv(lbAccel,$w)} - catch {unset Priv(lbAccel,$w,afterId)} + unset -nocomplain Priv(lbAccel,$w) Priv(lbAccel,$w,afterId) } # ::tk::ListBoxKeyAccel_Key-- @@ -911,7 +910,7 @@ proc ::tk::ListBoxKeyAccel_Unset {w} { proc ::tk::ListBoxKeyAccel_Key {w key} { variable ::tk::Priv - if { $key == "" } { + if { $key eq "" } { return } append Priv(lbAccel,$w) $key @@ -953,7 +952,7 @@ proc ::tk::ListBoxKeyAccel_Goto {w string} { proc ::tk::ListBoxKeyAccel_Reset {w} { variable ::tk::Priv - catch {unset Priv(lbAccel,$w)} + unset -nocomplain Priv(lbAccel,$w) } proc ::tk_getFileType {} { |