diff options
| author | andreask <andreask> | 2013-01-22 19:30:43 (GMT) |
|---|---|---|
| committer | andreask <andreask> | 2013-01-22 19:30:43 (GMT) |
| commit | 48c9fcb7281cc6aa076113db874c7ae0e105795d (patch) | |
| tree | 7187940ff056462bfa41705a2ce04d0ed07d424e /library | |
| parent | 41f5d19540b0b3f053da352e1569c9a4ed019dd5 (diff) | |
| download | tk-contrib_patrick_fradin_code_cleanup.zip tk-contrib_patrick_fradin_code_cleanup.tar.gz tk-contrib_patrick_fradin_code_cleanup.tar.bz2 | |
Contribution by Patrick Fradin <patrick.fradin@planar.com>contrib_patrick_fradin_code_cleanup
Quoting his mail:
<pre>
==========================================================
Hi Jeff,
I spent some of my time to contribute to the TclTk community ! I'm in
late for Christmas gift but like we said in French : "Mieux vaut tard
que jamais". ;-)
I've use TclDevKit 5.3.0 tclchecker to analyse TclTk code in Tcl and
Tk library directories (library, tools and tests) to correct a lot of
warnings and few errors. (encapsulate some expr, use 'chan xxx'
instead of fconfigure, fileevent...)
I've made some improvements too :
Examples :
- Use 'lassign' instead of many 'lindex' of 'foreach/break' loop.
- Use 'in' or 'ni' operators instead of 'lsearch -exact' or to
factorise some eq/ne && / || tests.
- Use 'eq' or 'ne' to tests strings instead of '==' or '!='.
- Use 'unset -nocomplain' to avoid 'catch {unset...}'.
- Remove some useless catch around 'destroy' calls.
- Use expand {*} instead of 'eval'. Don't touch a lot of code because
I don't know all structs and lists. I think it could be a greater
improvement to reduce 'eval' calls.
Due to previous experience, I dot not change any indentation ! ;-)
==========================================================
</pre>
Diffstat (limited to 'library')
114 files changed, 2826 insertions, 2651 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl index d1ed60a..ae73fba 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -38,8 +38,8 @@ proc ::tk::dialog::error::Return {which code} { proc ::tk::dialog::error::Details {} { set w .bgerrorDialog - set caption [option get $w.function text {}] - set command [option get $w.function command {}] + set caption [option get $w.function text ""] + set command [option get $w.function command ""] if { ($caption eq "") || ($command eq "") } { grid forget $w.function } @@ -61,7 +61,7 @@ proc ::tk::dialog::error::SaveToLog {text} { ] set filename [tk_getSaveFile -title [mc "Select Log File"] \ -filetypes $types -defaultextension .log -parent .bgerrorDialog] - if {$filename ne {}} { + if {$filename ne ""} { set f [open $filename w] puts -nonewline $f $text close $f @@ -81,7 +81,7 @@ proc ::tk::dialog::error::DeleteByProtocol {} { set button 1 } -proc ::tk::dialog::error::ReturnInDetails w { +proc ::tk::dialog::error::ReturnInDetails {w} { bind $w <Return> {}; # Remove this binding $w invoke return -code break @@ -97,7 +97,7 @@ proc ::tk::dialog::error::ReturnInDetails w { # Arguments: # err - The error message. # -proc ::tk::dialog::error::bgerror err { +proc ::tk::dialog::error::bgerror {err} { global errorInfo tcl_platform variable button @@ -121,9 +121,9 @@ proc ::tk::dialog::error::bgerror err { set displayedErr "" set lines 0 set maxLine 45 - foreach line [split $err \n] { + foreach line [split $err "\n"] { if { [string length $line] > $maxLine } { - append displayedErr "[string range $line 0 [expr {$maxLine-3}]]..." + append displayedErr "[string range $line 0 [expr {$maxLine - 3}]]..." break } if { $lines > 4 } { @@ -153,7 +153,7 @@ proc ::tk::dialog::error::bgerror err { wm protocol $dlg WM_DELETE_WINDOW [namespace code DeleteByProtocol] if {$windowingsystem eq "aqua"} { - ::tk::unsupported::MacWindowStyle style $dlg moveableAlert {} + ::tk::unsupported::MacWindowStyle style $dlg moveableAlert "" } elseif {$windowingsystem eq "x11"} { wm attributes $dlg -type dialog } @@ -184,7 +184,7 @@ proc ::tk::dialog::error::bgerror err { set wrapwidth [winfo screenwidth $dlg] # ...minus the width of the icon, padding and a fudge factor for # the window manager decorations and aesthetics. - set wrapwidth [expr {$wrapwidth-60-[winfo pixels $dlg 9m]}] + set wrapwidth [expr {$wrapwidth - 60 - [winfo pixels $dlg 9m]}] ttk::label $dlg.msg -justify left -text $text -wraplength $wrapwidth ttk::label $dlg.bitmap -image ::tk::icons::error @@ -259,7 +259,7 @@ proc ::tk::dialog::error::bgerror err { namespace eval :: { # Fool the indexer - proc bgerror err {} - rename bgerror {} + proc bgerror {err} {} + rename bgerror "" namespace import ::tk::dialog::error::bgerror } diff --git a/library/button.tcl b/library/button.tcl index a1f0a26..7b9849f 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -145,7 +145,7 @@ if {"win32" eq [tk windowingsystem]} { # Arguments: # w - The name of the widget. -proc ::tk::ButtonEnter w { +proc ::tk::ButtonEnter {w} { variable ::tk::Priv if {[$w cget -state] ne "disabled"} { @@ -172,7 +172,7 @@ proc ::tk::ButtonEnter w { # Arguments: # w - The name of the widget. -proc ::tk::ButtonLeave w { +proc ::tk::ButtonLeave {w} { variable ::tk::Priv if {[$w cget -state] ne "disabled"} { $w configure -state normal @@ -182,8 +182,8 @@ proc ::tk::ButtonLeave w { # That is signaled by the existence of Priv($w,prelief). if {[info exists Priv($w,relief)]} { - if {[info exists Priv($w,prelief)] && \ - $Priv($w,prelief) eq [$w cget -relief]} { + if {[info exists Priv($w,prelief)] && + ($Priv($w,prelief) eq [$w cget -relief])} { $w configure -relief $Priv($w,relief) } unset -nocomplain Priv($w,relief) Priv($w,prelief) @@ -201,7 +201,7 @@ proc ::tk::ButtonLeave w { # Arguments: # w - The name of the widget. -proc ::tk::ButtonDown w { +proc ::tk::ButtonDown {w} { variable ::tk::Priv # Only save the button's relief if it does not yet exist. If there @@ -235,7 +235,7 @@ proc ::tk::ButtonDown w { # Arguments: # w - The name of the widget. -proc ::tk::ButtonUp w { +proc ::tk::ButtonUp {w} { variable ::tk::Priv if {$Priv(buttonWindow) eq $w} { set Priv(buttonWindow) "" @@ -243,8 +243,8 @@ proc ::tk::ButtonUp w { # Restore the button's relief if it was cached. if {[info exists Priv($w,relief)]} { - if {[info exists Priv($w,prelief)] && \ - $Priv($w,prelief) eq [$w cget -relief]} { + if {[info exists Priv($w,prelief)] && + ($Priv($w,prelief) eq [$w cget -relief])} { $w configure -relief $Priv($w,relief) } unset -nocomplain Priv($w,relief) Priv($w,prelief) @@ -253,7 +253,7 @@ proc ::tk::ButtonUp w { # Clean up the after event from the auto-repeater after cancel $Priv(afterId) - if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} { + if {($Priv(window) eq $w) && ([$w cget -state] ne "disabled")} { $w configure -state normal # Only invoke the command if it wasn't already invoked by the @@ -274,7 +274,7 @@ proc ::tk::ButtonUp w { # Arguments: # w - The name of the widget. -proc ::tk::CheckRadioEnter w { +proc ::tk::CheckRadioEnter {w} { variable ::tk::Priv if {[$w cget -state] ne "disabled"} { if {$Priv(buttonWindow) eq $w} { @@ -298,7 +298,7 @@ proc ::tk::CheckRadioEnter w { # Arguments: # w - The name of the widget. -proc ::tk::CheckRadioDown w { +proc ::tk::CheckRadioDown {w} { variable ::tk::Priv if {![info exists Priv($w,relief)]} { set Priv($w,relief) [$w cget -relief] @@ -355,7 +355,7 @@ proc ::tk::ButtonEnter {w} { # Arguments: # w - The name of the widget. -proc ::tk::ButtonLeave w { +proc ::tk::ButtonLeave {w} { variable ::tk::Priv if {[$w cget -state] ne "disabled"} { $w configure -state normal @@ -365,8 +365,8 @@ proc ::tk::ButtonLeave w { # That is signaled by the existence of Priv($w,prelief). if {[info exists Priv($w,relief)]} { - if {[info exists Priv($w,prelief)] && \ - $Priv($w,prelief) eq [$w cget -relief]} { + if {[info exists Priv($w,prelief)] && + ($Priv($w,prelief) eq [$w cget -relief])} { $w configure -relief $Priv($w,relief) } unset -nocomplain Priv($w,relief) Priv($w,prelief) @@ -384,7 +384,7 @@ proc ::tk::ButtonLeave w { # Arguments: # w - The name of the widget. -proc ::tk::ButtonDown w { +proc ::tk::ButtonDown {w} { variable ::tk::Priv # Only save the button's relief if it does not yet exist. If there @@ -418,7 +418,7 @@ proc ::tk::ButtonDown w { # Arguments: # w - The name of the widget. -proc ::tk::ButtonUp w { +proc ::tk::ButtonUp {w} { variable ::tk::Priv if {$w eq $Priv(buttonWindow)} { set Priv(buttonWindow) "" @@ -426,8 +426,8 @@ proc ::tk::ButtonUp w { # Restore the button's relief if it was cached. if {[info exists Priv($w,relief)]} { - if {[info exists Priv($w,prelief)] && \ - $Priv($w,prelief) eq [$w cget -relief]} { + if {[info exists Priv($w,prelief)] && + ($Priv($w,prelief) eq [$w cget -relief])} { $w configure -relief $Priv($w,relief) } unset -nocomplain Priv($w,relief) Priv($w,prelief) @@ -436,7 +436,7 @@ proc ::tk::ButtonUp w { # Clean up the after event from the auto-repeater after cancel $Priv(afterId) - if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} { + if {($Priv(window) eq $w) && ([$w cget -state] ne "disabled")} { # Only invoke the command if it wasn't already invoked by the # auto-repeater functionality if { $Priv(repeated) == 0 } { @@ -489,7 +489,7 @@ proc ::tk::ButtonEnter {w} { # Arguments: # w - The name of the widget. -proc ::tk::ButtonLeave w { +proc ::tk::ButtonLeave {w} { variable ::tk::Priv if {$w eq $Priv(buttonWindow)} { $w configure -state normal @@ -499,8 +499,8 @@ proc ::tk::ButtonLeave w { # That is signaled by the existence of Priv($w,prelief). if {[info exists Priv($w,relief)]} { - if {[info exists Priv($w,prelief)] && \ - $Priv($w,prelief) eq [$w cget -relief]} { + if {[info exists Priv($w,prelief)] && + ($Priv($w,prelief) eq [$w cget -relief])} { $w configure -relief $Priv($w,relief) } unset -nocomplain Priv($w,relief) Priv($w,prelief) @@ -518,7 +518,7 @@ proc ::tk::ButtonLeave w { # Arguments: # w - The name of the widget. -proc ::tk::ButtonDown w { +proc ::tk::ButtonDown {w} { variable ::tk::Priv if {[$w cget -state] ne "disabled"} { @@ -544,7 +544,7 @@ proc ::tk::ButtonDown w { # Arguments: # w - The name of the widget. -proc ::tk::ButtonUp w { +proc ::tk::ButtonUp {w} { variable ::tk::Priv if {$Priv(buttonWindow) eq $w} { set Priv(buttonWindow) "" @@ -553,8 +553,8 @@ proc ::tk::ButtonUp w { # Restore the button's relief if it was cached. if {[info exists Priv($w,relief)]} { - if {[info exists Priv($w,prelief)] && \ - $Priv($w,prelief) eq [$w cget -relief]} { + if {[info exists Priv($w,prelief)] && + ($Priv($w,prelief) eq [$w cget -relief])} { $w configure -relief $Priv($w,relief) } unset -nocomplain Priv($w,relief) Priv($w,prelief) @@ -563,7 +563,7 @@ proc ::tk::ButtonUp w { # Clean up the after event from the auto-repeater after cancel $Priv(afterId) - if {$Priv(window) eq $w && [$w cget -state] ne "disabled"} { + if {($Priv(window) eq $w) && ([$w cget -state] ne "disabled")} { # Only invoke the command if it wasn't already invoked by the # auto-repeater functionality if { $Priv(repeated) == 0 } { @@ -586,7 +586,7 @@ proc ::tk::ButtonUp w { # Arguments: # w - The name of the widget. -proc ::tk::ButtonInvoke w { +proc ::tk::ButtonInvoke {w} { if {[$w cget -state] ne "disabled"} { set oldRelief [$w cget -relief] set oldState [$w cget -state] @@ -657,7 +657,7 @@ proc ::tk::CheckInvoke {w} { # Additional logic to switch the "selected" colors around if necessary # (when we're indicator-less). - if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} { + if {(![$w cget -indicatoron]) && [info exist Priv($w,selectcolor)]} { if {[$w cget -selectcolor] eq $Priv($w,aselectcolor)} { $w configure -selectcolor $Priv($w,selectcolor) } else { @@ -695,13 +695,13 @@ proc ::tk::CheckEnter {w} { # Compute what the "selected and active" color should be. - if {![$w cget -indicatoron] && [$w cget -selectcolor] ne ""} { + if {(![$w cget -indicatoron]) && ([$w cget -selectcolor] ne "")} { set Priv($w,selectcolor) [$w cget -selectcolor] lassign [winfo rgb $w [$w cget -selectcolor]] r1 g1 b1 lassign [winfo rgb $w [$w cget -activebackground]] r2 g2 b2 set Priv($w,aselectcolor) \ - [format "#%04x%04x%04x" [expr {($r1+$r2)/2}] \ - [expr {($g1+$g2)/2}] [expr {($b1+$b2)/2}]] + [format "#%04x%04x%04x" [expr {($r1 + $r2) / 2}] \ + [expr {($g1 + $g2) / 2}] [expr {($b1 + $b2) / 2}]] # use uplevel to work with other var resolvers if {[uplevel #0 [list set [$w cget -variable]]] eq [$w cget -onvalue]} { @@ -728,7 +728,7 @@ proc ::tk::CheckLeave {w} { # Restore the original button "selected" color; assume that the user # wasn't monkeying around with things too much. - if {![$w cget -indicatoron] && [info exist Priv($w,selectcolor)]} { + if {(![$w cget -indicatoron]) && [info exist Priv($w,selectcolor)]} { $w configure -selectcolor $Priv($w,selectcolor) } unset -nocomplain Priv($w,selectcolor) Priv($w,aselectcolor) @@ -737,8 +737,8 @@ proc ::tk::CheckLeave {w} { # signaled by the existence of Priv($w,prelief). if {[info exists Priv($w,relief)]} { - if {[info exists Priv($w,prelief)] && \ - $Priv($w,prelief) eq [$w cget -relief]} { + if {[info exists Priv($w,prelief)] && + ($Priv($w,prelief) eq [$w cget -relief])} { $w configure -relief $Priv($w,relief) } unset -nocomplain Priv($w,relief) Priv($w,prelief) diff --git a/library/choosedir.tcl b/library/choosedir.tcl index c0ab326..b2a3968 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -24,7 +24,7 @@ namespace eval ::tk::dialog::file::chooseDir { proc ::tk::dialog::file::chooseDir:: {args} { variable ::tk::Priv set dataName __tk_choosedir - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data Config $dataName $args if {$data(-parent) eq "."} { @@ -118,7 +118,7 @@ proc ::tk::dialog::file::chooseDir:: {args} { foreach trace [trace info variable data(selectPath)] { trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] } - $data(dirMenuBtn) configure -textvariable {} + $data(dirMenuBtn) configure -textvariable "" # Return value to user # @@ -131,7 +131,7 @@ proc ::tk::dialog::file::chooseDir:: {args} { # Configures the Tk choosedir dialog according to the argument list # proc ::tk::dialog::file::chooseDir::Config {dataName argList} { - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data # 0: Delete all variable that were set on data(selectPath) the # last time the file dialog is used. The traces may cause troubles @@ -194,7 +194,7 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { # Gets called when user presses Return in the "Selection" entry or presses OK. # proc ::tk::dialog::file::chooseDir::OkCmd {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data # This is the brains behind selecting non-existant directories. Here's # the flowchart: @@ -221,7 +221,7 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { return } set text [file join {*}[file split [string trim $text]]] - if {![file exists $text] || ![file isdirectory $text]} { + if {(![file exists $text]) || (![file isdirectory $text])} { # Entry contains an invalid directory. If it's the same as the # last time they came through here, reset the saved value and end # the dialog. Otherwise, save the value (so we can do this test @@ -249,7 +249,7 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { # Change state of OK button to match -mustexist correctness of entry # proc ::tk::dialog::file::chooseDir::IsOK? {w text} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set ok [file isdirectory $text] $data(okBtn) configure -state [expr {$ok ? "normal" : "disabled"}] @@ -259,7 +259,7 @@ proc ::tk::dialog::file::chooseDir::IsOK? {w text} { } proc ::tk::dialog::file::chooseDir::DblClick {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set selection [$data(icons) selection get] if {[llength $selection] != 0} { set filenameFragment [$data(icons) get [lindex $selection 0]] @@ -275,7 +275,7 @@ proc ::tk::dialog::file::chooseDir::DblClick {w} { # keys, etc) # proc ::tk::dialog::file::chooseDir::ListBrowse {w text} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data if {$text eq ""} { return @@ -295,13 +295,13 @@ proc ::tk::dialog::file::chooseDir::ListBrowse {w text} { # script that calls tk_getOpenFile or tk_getSaveFile # proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data variable ::tk::Priv if {$selectFilePath eq ""} { set selectFilePath $data(selectPath) } - if {$data(-mustexist) && ![file isdirectory $selectFilePath]} { + if {$data(-mustexist) && (![file isdirectory $selectFilePath])} { return } set Priv(selectFilePath) $selectFilePath diff --git a/library/clrpick.tcl b/library/clrpick.tcl index 3772a30..e7224f9 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -31,17 +31,19 @@ namespace eval ::tk::dialog::color { proc ::tk::dialog::color:: {args} { variable ::tk::Priv set dataName __tk__color - upvar ::tk::dialog::color::$dataName data + upvar 1 ::tk::dialog::color::$dataName data set w .$dataName # The lines variables track the start and end indices of the line # elements in the colorbar canvases. - set data(lines,red,start) 0 - set data(lines,red,last) -1 - set data(lines,green,start) 0 - set data(lines,green,last) -1 - set data(lines,blue,start) 0 - set data(lines,blue,last) -1 + array set data { + lines,red,start 0 + lines,red,last -1 + lines,green,start 0 + lines,green,last -1 + lines,blue,start 0 + lines,blue,last -1 + } # This is the actual number of lines that are drawn in each color strip. # Note that the bars may be of any width. @@ -67,10 +69,8 @@ proc ::tk::dialog::color:: {args} { set sc [winfo screen $data(-parent)] set winExists [winfo exists $w] - if {!$winExists || $sc ne [winfo screen $w]} { - if {$winExists} { - destroy $w - } + if {(!$winExists) || ($sc ne [winfo screen $w])} { + destroy $w toplevel $w -class TkColorDialog -screen $sc if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog} BuildDialog $w @@ -117,7 +117,7 @@ proc ::tk::dialog::color:: {args} { # Get called during initialization or when user resets NUM_COLORBARS # proc ::tk::dialog::color::InitValues {dataName} { - upvar ::tk::dialog::color::$dataName data + upvar 1 ::tk::dialog::color::$dataName data # IntensityIncr is the difference in color intensity between a colorbar # and its neighbors. @@ -142,7 +142,7 @@ proc ::tk::dialog::color::InitValues {dataName} { # # maxX is the x coordinate of the last colorbar # - set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}] + set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent) - 1}] # # canvasWidth is the width of the entire canvas, including the indents @@ -153,11 +153,12 @@ proc ::tk::dialog::color::InitValues {dataName} { # color chosen by the user the last time. set data(selection) $data(-initialcolor) set data(finalColor) $data(-initialcolor) - set rgb [winfo rgb . $data(selection)] - set data(red,intensity) [expr {[lindex $rgb 0]/0x100}] - set data(green,intensity) [expr {[lindex $rgb 1]/0x100}] - set data(blue,intensity) [expr {[lindex $rgb 2]/0x100}] + lassign [winfo rgb . $data(selection)] red green blue + + set data(red,intensity) [expr {$red / 0x100}] + set data(green,intensity) [expr {$green / 0x100}] + set data(blue,intensity) [expr {$blue / 0x100}] } # ::tk::dialog::color::Config -- @@ -166,11 +167,11 @@ proc ::tk::dialog::color::InitValues {dataName} { # proc ::tk::dialog::color::Config {dataName argList} { variable ::tk::Priv - upvar ::tk::dialog::color::$dataName data + upvar 1 ::tk::dialog::color::$dataName data # 1: the configuration specs # - if {[info exists Priv(selectColor)] && $Priv(selectColor) ne ""} { + if {[info exists Priv(selectColor)] && ($Priv(selectColor) ne "")} { set defaultColor $Priv(selectColor) } else { set defaultColor [. cget -background] @@ -205,23 +206,18 @@ proc ::tk::dialog::color::Config {dataName argList} { # Build the dialog. # proc ::tk::dialog::color::BuildDialog {w} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data # TopFrame contains the color strips and the color selection # - set topFrame [frame $w.top -relief raised -bd 1] + set topFrame [frame $w.top -relief raised -borderwidth 1] # StripsFrame contains the colorstrips and the individual RGB entries set stripsFrame [frame $topFrame.colorStrip] set maxWidth [::tk::mcmaxamp &Red &Green &Blue] - set maxWidth [expr {$maxWidth<6 ? 6 : $maxWidth}] - set colorList { - red "&Red" - green "&Green" - blue "&Blue" - } - foreach {color l} $colorList { + set maxWidth [expr {($maxWidth < 6) ? 6 : $maxWidth}] + foreach {color l} [list red "&Red" green "&Green" blue "&Blue"] { # each f frame contains an [R|G|B] entry and the equiv. color strip. set f [frame $stripsFrame.$color] @@ -240,12 +236,12 @@ proc ::tk::dialog::color::BuildDialog {w} { pack $box -side left -fill both set height [expr { - [winfo reqheight $box.entry] - - 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd]) + [winfo reqheight $box.entry] - + (2 * ([$box.entry cget -highlightthickness] + [$box.entry cget -borderwidth])) }] canvas $f.color -height $height \ - -width $data(BARS_WIDTH) -relief sunken -bd 2 + -width $data(BARS_WIDTH) -relief sunken -borderwidth 2 canvas $f.sel -height $data(PLGN_HEIGHT) \ -width $data(canvasWidth) -highlightthickness 0 pack $f.color -expand yes -fill both @@ -283,8 +279,8 @@ proc ::tk::dialog::color::BuildDialog {w} { set ent [entry $selFrame.ent \ -textvariable ::tk::dialog::color::[winfo name $w](selection) \ -width 16] - set f1 [frame $selFrame.f1 -relief sunken -bd 2] - set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70] + set f1 [frame $selFrame.f1 -relief sunken -borderwidth 2] + set data(finalCanvas) [frame $f1.demo -borderwidth 0 -width 100 -height 70] pack $lab $ent -side top -fill x -padx 4 -pady 2 pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10 @@ -297,7 +293,7 @@ proc ::tk::dialog::color::BuildDialog {w} { # the botFrame frame contains the buttons # - set botFrame [frame $w.bot -relief raised -bd 1] + set botFrame [frame $w.bot -relief raised -borderwidth 1] ::tk::AmpWidget button $botFrame.ok -text [mc "&OK"] \ -command [list tk::dialog::color::OkCmd $w] @@ -327,12 +323,10 @@ proc ::tk::dialog::color::BuildDialog {w} { # # Sets the current selection of the dialog box # -proc ::tk::dialog::color::SetRGBValue {w color} { - upvar ::tk::dialog::color::[winfo name $w] data +proc ::tk::dialog::color::SetRGBValue {w a_color} { + upvar 1 ::tk::dialog::color::[winfo name $w] data - set data(red,intensity) [lindex $color 0] - set data(green,intensity) [lindex $color 1] - set data(blue,intensity) [lindex $color 2] + lassign $a_color data(red,intensity) data(green,intensity) data(blue,intensity) RedrawColorBars $w all @@ -347,10 +341,10 @@ proc ::tk::dialog::color::SetRGBValue {w color} { # # Converts a screen coordinate to intensity # -proc ::tk::dialog::color::XToRgb {w x} { - upvar ::tk::dialog::color::[winfo name $w] data +proc ::tk::dialog::color::XToRgb {w a_x} { + upvar 1 ::tk::dialog::color::[winfo name $w] data - set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}] + set x [expr {($a_x * $data(intensityIncr)) / $data(colorbarWidth)}] if {$x > 255} { set x 255 } @@ -362,9 +356,9 @@ proc ::tk::dialog::color::XToRgb {w x} { # Converts an intensity to screen coordinate. # proc ::tk::dialog::color::RgbToX {w color} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data - return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}] + return [expr {($color * $data(colorbarWidth) / $data(intensityIncr))}] } # ::tk::dialog::color::DrawColorScale -- @@ -373,7 +367,7 @@ proc ::tk::dialog::color::RgbToX {w color} { # scale canvases is changed. # proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data # col: color bar canvas # sel: selector canvas @@ -407,7 +401,7 @@ proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { # Create an invisible region under the colorstrip to catch mouse clicks # that aren't on the selector. set data($c,clickRegion) [$sel create rectangle 0 0 \ - $data(canvasWidth) $height -fill {} -outline {}] + $data(canvasWidth) $height -fill "" -outline ""] bind $col <ButtonPress-1> \ [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)] @@ -428,7 +422,7 @@ proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { } # Draw the color bars. - set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}] + set highlightW [expr {[$col cget -highlightthickness] + [$col cget -borderwidth]}] for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} { set intensity [expr {$i * $data(intensityIncr)}] set startx [expr {$i * $data(colorbarWidth) + $highlightW}] @@ -445,7 +439,7 @@ proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { if {$create} { set index [$col create rect $startx $highlightW \ - [expr {$startx +$data(colorbarWidth)}] \ + [expr {$startx + $data(colorbarWidth)}] \ [expr {[winfo height $col] + $highlightW}] \ -fill $color -outline $color] } else { @@ -469,7 +463,7 @@ proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { # $data($c,intensity). # proc ::tk::dialog::color::CreateSelector {w sel c } { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data set data($c,index) [$sel create polygon \ 0 $data(PLGN_HEIGHT) \ $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \ @@ -483,12 +477,12 @@ proc ::tk::dialog::color::CreateSelector {w sel c } { # Combines the intensities of the three colors into the final color # proc ::tk::dialog::color::RedrawFinalColor {w} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data set color [format "#%02x%02x%02x" $data(red,intensity) \ $data(green,intensity) $data(blue,intensity)] - $data(finalCanvas) configure -bg $color + $data(finalCanvas) configure -background $color set data(finalColor) $color set data(selection) $color set data(finalRGB) [list \ @@ -504,9 +498,9 @@ proc ::tk::dialog::color::RedrawFinalColor {w} { # Then all colorstrips will be updated # proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data - switch $colorChanged { + switch -- $colorChanged { red { DrawColorScale $w green DrawColorScale $w blue @@ -541,7 +535,7 @@ proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { # Params: sel is the selector canvas window, color is the color of the strip. # proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data if {!$dontMove} { MoveSelector $w $sel $color $x $delta @@ -558,7 +552,7 @@ proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { # x is a x-coordinate. # proc ::tk::dialog::color::MoveSelector {w sel color x delta} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data incr x -$delta @@ -582,10 +576,10 @@ proc ::tk::dialog::color::MoveSelector {w sel color x delta} { # Params: sel is the selector canvas, color is the color of the strip, # x is the x-coord of the mouse. # -proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} { - upvar ::tk::dialog::color::[winfo name $w] data +proc ::tk::dialog::color::ReleaseMouse {w sel color a_x delta} { + upvar 1 ::tk::dialog::color::[winfo name $w] data - set x [MoveSelector $w $sel $color $x $delta] + set x [MoveSelector $w $sel $color $a_x $delta] # Determine exactly what color we are looking at. set data($color,intensity) [XToRgb $w $x] @@ -599,12 +593,12 @@ proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} { # colorstrips # proc ::tk::dialog::color::ResizeColorBars {w} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0) - } then { + } { set data(BARS_WIDTH) $data(NUM_COLORBARS) } InitValues [winfo name $w] @@ -619,7 +613,7 @@ proc ::tk::dialog::color::ResizeColorBars {w} { # Handles the return keypress event in the "Selection:" entry # proc ::tk::dialog::color::HandleSelEntry {w} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data set text [string trim $data(selection)] # Check to make sure that the color is valid @@ -628,9 +622,10 @@ proc ::tk::dialog::color::HandleSelEntry {w} { return } - set R [expr {[lindex $color 0]/0x100}] - set G [expr {[lindex $color 1]/0x100}] - set B [expr {[lindex $color 2]/0x100}] + lassign $color red green blue + set R [expr {$red / 0x100}] + set G [expr {$green / 0x100}] + set B [expr {$blue / 0x100}] SetRGBValue $w "$R $G $B" set data(selection) $text @@ -641,11 +636,11 @@ proc ::tk::dialog::color::HandleSelEntry {w} { # Handles the return keypress event in the R, G or B entry # proc ::tk::dialog::color::HandleRGBEntry {w} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data foreach c {red green blue} { if {[catch { - set data($c,intensity) [expr {int($data($c,intensity))}] + set data($c,intensity) [expr { int ($data($c,intensity))}] }]} { set data($c,intensity) 0 } @@ -665,7 +660,7 @@ proc ::tk::dialog::color::HandleRGBEntry {w} { # mouse cursor enters a color bar # proc ::tk::dialog::color::EnterColorBar {w color} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data $data($color,sel) itemconfigure $data($color,index) -fill red } @@ -673,7 +668,7 @@ proc ::tk::dialog::color::EnterColorBar {w color} { # mouse leaves enters a color bar # proc ::tk::dialog::color::LeaveColorBar {w color} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data $data($color,sel) itemconfigure $data($color,index) -fill black } @@ -682,7 +677,7 @@ proc ::tk::dialog::color::LeaveColorBar {w color} { # proc ::tk::dialog::color::OkCmd {w} { variable ::tk::Priv - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data set Priv(selectColor) $data(finalColor) } diff --git a/library/comdlg.tcl b/library/comdlg.tcl index f89754c..1966b9c 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -45,10 +45,8 @@ proc tclParseConfigSpec {w specs flags argList} { } set cmdsw [lindex $spec 0] set cmd($cmdsw) "" - set rname($cmdsw) [lindex $spec 1] - set rclass($cmdsw) [lindex $spec 2] - set def($cmdsw) [lindex $spec 3] - set verproc($cmdsw) [lindex $spec 4] + + lassign $spec _cmdsw_ rname($cmdsw) rclass($cmdsw) def($cmdsw) verproc($cmdsw) } if {[llength $argList] & 1} { @@ -81,7 +79,7 @@ proc tclParseConfigSpec {w specs flags argList} { } proc tclListValidFlags {v} { - upvar $v cmd + upvar 1 $v cmd set len [llength [array names cmd]] set i 1 @@ -205,7 +203,7 @@ proc ::tk::FocusGroup_In {t w detail} { variable FocusIn variable ::tk::Priv - if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} { + if {$detail ni "NotifyNonlinear NotifyNonlinearVirtual"} { # This is caused by mouse moving out&in of the window *or* # ordinary keypresses some window managers (ie: CDE [Bug: 2960]). return @@ -238,7 +236,7 @@ proc ::tk::FocusGroup_Out {t w detail} { variable FocusOut variable ::tk::Priv - if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} { + if {$detail ni "NotifyNonlinear NotifyNonlinearVirtual"} { # This is caused by mouse moving out of the window return } @@ -260,18 +258,19 @@ proc ::tk::FocusGroup_Out {t w detail} { # and Windows platform. # proc ::tk::FDGetFileTypes {string} { + array set fileTypes {} foreach t $string { - if {[llength $t] < 2 || [llength $t] > 3} { + if {[llength $t] ni "2 3"} { return -code error -errorcode {TK VALUE FILE_TYPE} \ "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" } lappend fileTypes([lindex $t 0]) {*}[lindex $t 1] } - set types {} + set types [list] foreach t $string { set label [lindex $t 0] - set exts {} + set exts [list] if {[info exists hasDoneType($label)]} { continue @@ -297,7 +296,7 @@ proc ::tk::FDGetFileTypes {string} { regsub {^[.]} $ext "*." ext if {![info exists hasGotExt($label,$ext)]} { if {$doAppend} { - if {[string length $sep] && [string length $name]>40} { + if {[string length $sep] && ([string length $name] > 40)} { set doAppend 0 append name $sep... } else { diff --git a/library/console.tcl b/library/console.tcl index e93a39d..17870fd 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -32,7 +32,7 @@ namespace eval ::tk::console { } # simple compat function for tkcon code added for this console -interp alias {} EvalAttached {} consoleinterp eval +interp alias "" EvalAttached "" consoleinterp eval # ::tk::ConsoleInit -- # This procedure constructs and configures the console windows. @@ -61,29 +61,29 @@ proc ::tk::ConsoleInit {} { menu .menubar.file -tearoff 0 AmpMenuArgs .menubar.file add command -label [mc "&Source..."] \ - -command {tk::ConsoleSource} + -command "tk::ConsoleSource" AmpMenuArgs .menubar.file add command -label [mc "&Hide Console"] \ - -command {wm withdraw .} + -command "wm withdraw ." AmpMenuArgs .menubar.file add command -label [mc "&Clear Console"] \ -command {.console delete 1.0 "promptEnd linestart"} if {[tk windowingsystem] ne "aqua"} { - AmpMenuArgs .menubar.file add command -label [mc E&xit] -command {exit} + AmpMenuArgs .menubar.file add command -label [mc E&xit] -command "exit" } menu .menubar.edit -tearoff 0 - AmpMenuArgs .menubar.edit add command -label [mc Cu&t] -accel "$mod+X"\ - -command {event generate .console <<Cut>>} - AmpMenuArgs .menubar.edit add command -label [mc &Copy] -accel "$mod+C"\ - -command {event generate .console <<Copy>>} - AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\ - -command {event generate .console <<Paste>>} + AmpMenuArgs .menubar.edit add command -label [mc Cu&t] -accelerator "$mod+X"\ + -command "event generate .console <<Cut>>" + AmpMenuArgs .menubar.edit add command -label [mc &Copy] -accelerator "$mod+C"\ + -command "event generate .console <<Copy>>" + AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accelerator "$mod+V"\ + -command "event generate .console <<Paste>>" if {$tcl_platform(platform) ne "windows"} { AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \ - -command {event generate .console <<Clear>>} + -command "event generate .console <<Clear>>" } else { AmpMenuArgs .menubar.edit add command -label [mc &Delete] \ - -command {event generate .console <<Clear>>} -accel "Del" + -command "event generate .console <<Clear>>" -accelerator "Del" AmpMenuArgs .menubar add cascade -label [mc &Help] -menu .menubar.help menu .menubar.help -tearoff 0 @@ -98,7 +98,7 @@ proc ::tk::ConsoleInit {} { set index [.menubar.edit index tk_choose_font_marker] .menubar.edit entryconfigure $index \ -label [mc "Show Fonts"]\ - -accelerator "$mod-T"\ + -acceleratorerator "$mod-T"\ -command [list ::tk::console::FontchooserToggle] bind Console <<TkFontchooserVisibility>> \ [list ::tk::console::FontchooserVisibility $index] @@ -111,9 +111,9 @@ proc ::tk::ConsoleInit {} { bind Console <FocusOut> [list ::tk::console::FontchooserFocus %W 0] } AmpMenuArgs .menubar.edit add command -label [mc "&Increase Font Size"] \ - -accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>} + -accelerator "$mod++" -command "event generate .console <<Console_FontSizeIncr>>" AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \ - -accel "$mod+-" -command {event generate .console <<Console_FontSizeDecr>>} + -accelerator "$mod+-" -command "event generate .console <<Console_FontSizeDecr>>" if {[tk windowingsystem] eq "aqua"} { .menubar add cascade -label [mc Window] -menu [menu .menubar.window] @@ -126,12 +126,12 @@ proc ::tk::ConsoleInit {} { catch {font create TkConsoleFont {*}[font configure TkFixedFont]} set families [font families] switch -exact -- [tk windowingsystem] { - aqua { set preferred {Monaco 10} } - win32 { set preferred {ProFontWindows 8 Consolas 8} } - default { set preferred {} } + aqua { set preferred "Monaco 10" } + win32 { set preferred "ProFontWindows 8 Consolas 8" } + default { set preferred "" } } foreach {family size} $preferred { - if {[lsearch -exact $families $family] != -1} { + if {$family in $families} { font configure TkConsoleFont -family $family -size $size break } @@ -170,7 +170,7 @@ proc ::tk::ConsoleInit {} { focus $con # Avoid listing this console in [winfo interps] - if {[info command ::send] eq "::send"} {rename ::send {}} + if {[info command ::send] eq "::send"} {rename ::send ""} wm protocol . WM_DELETE_WINDOW { wm withdraw . } wm title . [mc "Console"] @@ -269,14 +269,14 @@ proc ::tk::ConsoleInvoke {args} { # cmd - Which action to take: prev, next, reset. set ::tk::HistNum 1 -proc ::tk::ConsoleHistory {cmd} { +proc ::tk::ConsoleHistory {a_cmd} { variable HistNum - switch $cmd { + switch -- $a_cmd { prev { incr HistNum -1 if {$HistNum == 0} { - set cmd {history event [expr {[history nextid] -1}]} + set cmd {history event [expr {[history nextid] - 1}]} } else { set cmd "history event $HistNum" } @@ -306,6 +306,7 @@ proc ::tk::ConsoleHistory {cmd} { reset { set HistNum 1 } + default {} } } @@ -477,8 +478,8 @@ proc ::tk::ConsoleBind {w} { break } bind Console <Delete> { - if {{} ne [%W tag nextrange sel 1.0 end] \ - && [%W compare sel.first >= promptEnd]} { + if {("" ne [%W tag nextrange sel 1.0 end]) && + [%W compare sel.first >= promptEnd]} { %W delete sel.first sel.last } elseif {[%W compare insert >= promptEnd]} { %W delete insert @@ -486,11 +487,11 @@ proc ::tk::ConsoleBind {w} { } } bind Console <BackSpace> { - if {{} ne [%W tag nextrange sel 1.0 end] \ - && [%W compare sel.first >= promptEnd]} { + if {("" ne [%W tag nextrange sel 1.0 end]) && + [%W compare sel.first >= promptEnd]} { %W delete sel.first sel.last - } elseif {[%W compare insert != 1.0] && \ - [%W compare insert > promptEnd]} { + } elseif {[%W compare insert != 1.0] && + [%W compare insert > promptEnd]} { %W delete insert-1c %W see insert } @@ -568,8 +569,9 @@ proc ::tk::ConsoleBind {w} { bind Console <KeyPress> { tk::ConsoleInsert %W %A } + global tk_library bind Console <F9> { - eval destroy [winfo child .] + destroy {*}[winfo child .] source [file join $tk_library console.tcl] } if {[tk windowingsystem] eq "aqua"} { @@ -584,7 +586,7 @@ proc ::tk::ConsoleBind {w} { bind Console <<Console_FontSizeIncr>> { set size [font configure TkConsoleFont -size] if {$size < 0} {set sign -1} else {set sign 1} - set size [expr {(abs($size) + 1) * $sign}] + set size [expr {( ( abs ($size) ) + 1) * $sign}] font configure TkConsoleFont -size $size if {$::tk::console::useFontchooser} { tk fontchooser configure -font TkConsoleFont @@ -592,9 +594,9 @@ proc ::tk::ConsoleBind {w} { } bind Console <<Console_FontSizeDecr>> { set size [font configure TkConsoleFont -size] - if {abs($size) < 2} { return } + if { ( abs ($size) ) < 2} { return } if {$size < 0} {set sign -1} else {set sign 1} - set size [expr {(abs($size) - 1) * $sign}] + set size [expr {( ( abs ($size) ) - 1) * $sign}] font configure TkConsoleFont -size $size if {$::tk::console::useFontchooser} { tk fontchooser configure -font TkConsoleFont @@ -697,10 +699,11 @@ proc ::tk::ConsoleExit {} { # None. proc ::tk::ConsoleAbout {} { + global tcl_patchLevel tk_patchLevel tk_messageBox -type ok -message "[mc {Tcl for Windows}] -Tcl $::tcl_patchLevel -Tk $::tk_patchLevel" +Tcl $tcl_patchLevel +Tk $tk_patchLevel" } # ::tk::console::Fontchooser* -- @@ -725,7 +728,7 @@ proc ::tk::console::FontchooserFocus {w isFocusIn} { tk fontchooser configure -parent $w -font TkConsoleFont \ -command [namespace code [list FontchooserApply]] } else { - tk fontchooser configure -parent $w -font {} -command {} + tk fontchooser configure -parent $w -font "" -command "" } } proc ::tk::console::FontchooserApply {font args} { @@ -741,7 +744,7 @@ proc ::tk::console::FontchooserApply {font args} { # Arguments: # w - console text widget -proc ::tk::console::TagProc w { +proc ::tk::console::TagProc {w} { if {!$::tk::console::magicKeys} { return } @@ -786,16 +789,16 @@ proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { if {!$::tk::console::magicKeys} { return } - if {{} ne [set ix [$w search -back $c1 insert $lim]]} { + if {"" ne [set ix [$w search -back $c1 insert $lim]]} { while { - [string match {\\} [$w get $ix-1c]] && - [set ix [$w search -back $c1 $ix-1c $lim]] ne {} + [string match {\\} [$w get $ix-1c]] && + ([set ix [$w search -back $c1 $ix-1c $lim]] ne "") } {} set i1 insert-1c - while {$ix ne {}} { + while {$ix ne ""} { set i0 $ix set j 0 - while {[set i0 [$w search $c2 $i0 $i1]] ne {}} { + while {[set i0 [$w search $c2 $i0 $i1]] ne ""} { append i0 +1c if {[string match {\\} [$w get $i0-2c]]} { continue @@ -806,14 +809,14 @@ proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { break } set i1 $ix - while {$j && [set ix [$w search -back $c1 $ix $lim]] ne {}} { + while {$j && ([set ix [$w search -back $c1 $ix $lim]] ne "")} { if {[string match {\\} [$w get $ix-1c]]} { continue } incr j -1 } } - if {[string match {} $ix]} { + if {[string match "" $ix]} { set ix [$w index $lim] } } else { @@ -843,7 +846,7 @@ proc ::tk::console::MatchQuote {w {lim 1.0}} { } set i insert-1c set j 0 - while {[set i [$w search -back \" $i $lim]] ne {}} { + while {[set i [$w search -back \" $i $lim]] ne ""} { if {[string match {\\} [$w get $i-1c]]} { continue } @@ -852,7 +855,7 @@ proc ::tk::console::MatchQuote {w {lim 1.0}} { } incr j } - if {$j&1} { + if {$j & 1} { if {$::tk::console::blinkRange} { Blink $w $i0 [$w index insert] } else { @@ -895,7 +898,7 @@ proc ::tk::console::Blink {w args} { proc ::tk::console::ConstrainBuffer {w size} { if {[$w index end] > $size} { - $w delete 1.0 [expr {int([$w index end])-$size}].0 + $w delete 1.0 [expr { ( int ([$w index end]) ) - $size}].0 } } @@ -926,7 +929,7 @@ proc ::tk::console::Expand {w {type ""}} { return } set str [$w get $tmp insert] - switch -glob $type { + switch -glob -- $type { path* { set res [ExpandPathname $str] } @@ -937,9 +940,9 @@ proc ::tk::console::Expand {w {type ""}} { set res [ExpandVariable $str] } default { - set res {} + set res "" foreach t {Pathname Procname Variable} { - if {![catch {Expand$t $str} res] && ($res ne "")} { + if {(![catch {Expand$t $str} res]) && ($res ne "")} { break } } @@ -972,7 +975,7 @@ proc ::tk::console::Expand {w {type ""}} { # Returns: list containing longest unique match followed by all the # possible further matches -proc ::tk::console::ExpandPathname str { +proc ::tk::console::ExpandPathname {str} { set pwd [EvalAttached pwd] if {[catch {EvalAttached [list cd [file dirname $str]]} err opt]} { return -options $opt $err @@ -980,31 +983,31 @@ proc ::tk::console::ExpandPathname str { set dir [file tail $str] ## Check to see if it was known to be a directory and keep the trailing ## slash if so (file tail cuts it off) - if {[string match */ $str]} { - append dir / + if {[string match "*/" $str]} { + append dir "/" } if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} { - set match {} + set match "" } else { if {[llength $m] > 1} { global tcl_platform - if {[string match windows $tcl_platform(platform)]} { + if {"windows" eq $tcl_platform(platform)} { ## Windows is screwy because it's case insensitive set tmp [ExpandBestMatch [string tolower $m] \ [string tolower $dir]] ## Don't change case if we haven't changed the word - if {[string length $dir]==[string length $tmp]} { + if {[string length $dir] == [string length $tmp]} { set tmp $dir } } else { set tmp [ExpandBestMatch $m $dir] } - if {[string match ?*/* $str]} { + if {[string match "?*/*" $str]} { set tmp [file dirname $str]/$tmp - } elseif {[string match /* $str]} { + } elseif {[string match "/*" $str]} { set tmp /$tmp } - regsub -all { } $tmp {\\ } tmp + regsub -all " " $tmp {\\ } tmp set match [linsert $m 0 $tmp] } else { ## This may look goofy, but it handles spaces in path names @@ -1012,12 +1015,12 @@ proc ::tk::console::ExpandPathname str { if {[file isdir $match]} { append match / } - if {[string match ?*/* $str]} { + if {[string match "?*/*" $str]} { set match [file dirname $str]/$match - } elseif {[string match /* $str]} { + } elseif {[string match "/*" $str]} { set match /$match } - regsub -all { } $match {\\ } match + regsub -all " " $match {\\ } match ## Why is this one needed and the ones below aren't!! set match [list $match] } @@ -1038,22 +1041,22 @@ proc ::tk::console::ExpandPathname str { # Returns: list containing longest unique match followed by all the # possible further matches -proc ::tk::console::ExpandProcname str { +proc ::tk::console::ExpandProcname {str} { set match [EvalAttached [list info commands $str*]] - if {[llength $match] == 0} { + if {![llength $match]} { set ns [EvalAttached \ "namespace children \[namespace current\] [list $str*]"] - if {[llength $ns]==1} { + if {[llength $ns] == 1} { set match [EvalAttached [list info commands ${ns}::*]] } else { set match $ns } } if {[llength $match] > 1} { - regsub -all { } [ExpandBestMatch $match $str] {\\ } str + regsub -all " " [ExpandBestMatch $match $str] {\\ } str set match [linsert $match 0 $str] } else { - regsub -all { } $match {\\ } match + regsub -all " " $match {\\ } match } return $match } @@ -1070,8 +1073,8 @@ proc ::tk::console::ExpandProcname str { # Returns: list containing longest unique match followed by all the # possible further matches -proc ::tk::console::ExpandVariable str { - if {[regexp {([^\(]*)\((.*)} $str -> ary str]} { +proc ::tk::console::ExpandVariable {str} { + if {[regexp {([^\(]*)\((.*)} $str ___ ary str]} { ## Looks like they're trying to expand an array. set match [EvalAttached [list array names $ary $str*]] if {[llength $match] > 1} { @@ -1087,10 +1090,10 @@ proc ::tk::console::ExpandVariable str { } else { set match [EvalAttached [list info vars $str*]] if {[llength $match] > 1} { - regsub -all { } [ExpandBestMatch $match $str] {\\ } str + regsub -all " " [ExpandBestMatch $match $str] {\\ } str set match [linsert $match 0 $str] } else { - regsub -all { } $match {\\ } match + regsub -all " " $match {\\ } match } } return $match @@ -1108,13 +1111,13 @@ proc ::tk::console::ExpandVariable str { # # Returns: longest unique match in the list -proc ::tk::console::ExpandBestMatch {l {e {}}} { +proc ::tk::console::ExpandBestMatch {a_l {e ""}} { set ec [lindex $l 0] - if {[llength $l]>1} { - set e [expr {[string length $e] - 1}] + if {[llength $a_l] > 1} { + set le [expr {[string length $e] - 1}] set ei [expr {[string length $ec] - 1}] - foreach l $l { - while {$ei>=$e && [string first $ec $l]} { + foreach l $a_l { + while {($ei >= $le) && [string first $ec $l]} { set ec [string range $ec 0 [incr ei -1]] } } diff --git a/library/demos/anilabel.tcl b/library/demos/anilabel.tcl index 61e6315..797f41f 100644 --- a/library/demos/anilabel.tcl +++ b/library/demos/anilabel.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .anilabel -catch {destroy $w} +destroy $w toplevel $w wm title $w "Animated Label Demonstration" wm iconname $w "anilabel" @@ -77,7 +77,7 @@ proc SelectNextImageFrame {w interval} { if {[catch { # Note that we get an error if the index is out of range $image configure -format "GIF -index [incr idx]" - }]} then { + }]} { $image configure -format "GIF -index 0" } } diff --git a/library/demos/aniwave.tcl b/library/demos/aniwave.tcl index 6122132..11d01d8 100644 --- a/library/demos/aniwave.tcl +++ b/library/demos/aniwave.tcl @@ -11,7 +11,7 @@ if {![info exists widgetDemo]} { package require Tk set w .aniwave -catch {destroy $w} +destroy $w toplevel $w wm title $w "Animated Wave Demonstration" wm iconname $w "aniwave" @@ -33,8 +33,8 @@ array set animationCallbacks {} # Creates a coordinates list of a wave. This code does a very sketchy # job and relies on Tk's line smoothing to make things look better. -set waveCoords {} -for {set x -10} {$x<=300} {incr x 5} { +set waveCoords [list] +for {set x -10} {$x <= 300} {incr x 5} { lappend waveCoords $x 100 } lappend waveCoords $x 0 [incr x 5] 200 @@ -56,13 +56,13 @@ trace add variable waveCoords write [list waveCoordsTracer $w] proc basicMotion {} { global waveCoords direction set oc $waveCoords - for {set i 1} {$i<[llength $oc]} {incr i 2} { + for {set i 1} {$i < [llength $oc]} {incr i 2} { if {$direction eq "left"} { lset waveCoords $i [lindex $oc \ - [expr {$i+2>[llength $oc] ? 1 : $i+2}]] + [expr {(($i + 2) > [llength $oc]) ? 1 : ($i + 2)}]] } else { lset waveCoords $i \ - [lindex $oc [expr {$i-2<0 ? "end" : $i-2}]] + [lindex $oc [expr {(($i - 2) < 0) ? "end" : ($i - 2)}]] } } } @@ -84,8 +84,8 @@ proc reverser {} { # using the [after] command. This procedure is the fundamental basis # for all animated effect handling in Tk. proc move {} { - basicMotion - reverser + basicMotion + reverser # Theoretically 100 frames-per-second (==10ms between frames) global animationCallbacks @@ -94,7 +94,7 @@ proc move {} { # Initialise our remaining animation variables set direction "left" -set animateAfterCallback {} +set animateAfterCallback "" # Arrange for the animation loop to stop when the canvas is deleted bind $w.c <Destroy> { after cancel $animationCallbacks(simpleWave) diff --git a/library/demos/arrow.tcl b/library/demos/arrow.tcl index 5011f6f..af367f1 100644 --- a/library/demos/arrow.tcl +++ b/library/demos/arrow.tcl @@ -18,13 +18,13 @@ package require Tk # Arguments: # c - Name of the canvas widget. -proc arrowSetup c { +proc arrowSetup {c} { upvar #0 demo_arrowInfo v # Remember the current box, if there is one. set tags [$c gettags current] - if {$tags != ""} { + if {$tags ne ""} { set cur [lindex $tags [lsearch -glob $tags box?]] } else { set cur "" @@ -33,81 +33,81 @@ proc arrowSetup c { # Create the arrow and outline. $c delete all - eval {$c create line $v(x1) $v(y) $v(x2) $v(y) -arrow last \ - -width [expr {10*$v(width)}] -arrowshape [list \ - [expr {10*$v(a)}] [expr {10*$v(b)}] [expr {10*$v(c)}]]} \ - $v(bigLineStyle) - set xtip [expr {$v(x2)-10*$v(b)}] - set deltaY [expr {10*$v(c)+5*$v(width)}] - $c create line $v(x2) $v(y) $xtip [expr {$v(y)+$deltaY}] \ - [expr {$v(x2)-10*$v(a)}] $v(y) $xtip [expr {$v(y)-$deltaY}] \ + $c create line $v(x1) $v(y) $v(x2) $v(y) -arrow last \ + -width [expr {10 * $v(width)}] \ + -arrowshape [list [expr {10 * $v(a)}] [expr {10 * $v(b)}] [expr {10 * $v(c)}]] \ + {*}$v(bigLineStyle) + set xtip [expr {$v(x2) - (10 * $v(b))}] + set deltaY [expr {(10 * $v(c)) + (5 * $v(width))}] + $c create line $v(x2) $v(y) $xtip [expr {$v(y) + $deltaY}] \ + [expr {$v(x2) - (10 * $v(a))}] $v(y) $xtip [expr {$v(y) - $deltaY}] \ $v(x2) $v(y) -width 2 -capstyle round -joinstyle round # Create the boxes for reshaping the line and arrowhead. - eval {$c create rect [expr {$v(x2)-10*$v(a)-5}] [expr {$v(y)-5}] \ - [expr {$v(x2)-10*$v(a)+5}] [expr {$v(y)+5}] \ - -tags {box1 box}} $v(boxStyle) - eval {$c create rect [expr {$xtip-5}] [expr {$v(y)-$deltaY-5}] \ - [expr {$xtip+5}] [expr {$v(y)-$deltaY+5}] \ - -tags {box2 box}} $v(boxStyle) - eval {$c create rect [expr {$v(x1)-5}] [expr {$v(y)-5*$v(width)-5}] \ - [expr {$v(x1)+5}] [expr {$v(y)-5*$v(width)+5}] \ - -tags {box3 box}} $v(boxStyle) - if {$cur != ""} { - eval $c itemconfigure $cur $v(activeStyle) + $c create rect [expr {$v(x2) - (10 * $v(a)) - 5}] [expr {$v(y) - 5}] \ + [expr {$v(x2) - (10 * $v(a)) + 5}] [expr {$v(y) + 5}] \ + -tags {box1 box} {*}$v(boxStyle) + $c create rect [expr {$xtip - 5}] [expr {$v(y) - $deltaY - 5}] \ + [expr {$xtip + 5}] [expr {($v(y) - $deltaY) + 5}] \ + -tags {box2 box} {*}$v(boxStyle) + $c create rect [expr {$v(x1) - 5}] [expr {$v(y) - (5 * $v(width)) - 5}] \ + [expr {$v(x1) + 5}] [expr {$v(y) - (5 * $v(width)) + 5}] \ + -tags {box3 box} {*}$v(boxStyle) + if {$cur ne ""} { + $c itemconfigure $cur {*}$v(activeStyle) } # Create three arrows in actual size with the same parameters - $c create line [expr {$v(x2)+50}] 0 [expr {$v(x2)+50}] 1000 \ + $c create line [expr {$v(x2) + 50}] 0 [expr {$v(x2) + 50}] 1000 \ -width 2 - set tmp [expr {$v(x2)+100}] - $c create line $tmp [expr {$v(y)-125}] $tmp [expr {$v(y)-75}] \ + set tmp [expr {$v(x2) + 100}] + $c create line $tmp [expr {$v(y) - 125}] $tmp [expr {$v(y) - 75}] \ -width $v(width) \ -arrow both -arrowshape "$v(a) $v(b) $v(c)" - $c create line [expr {$tmp-25}] $v(y) [expr {$tmp+25}] $v(y) \ + $c create line [expr {$tmp - 25}] $v(y) [expr {$tmp + 25}] $v(y) \ -width $v(width) \ -arrow both -arrowshape "$v(a) $v(b) $v(c)" - $c create line [expr {$tmp-25}] [expr {$v(y)+75}] [expr {$tmp+25}] \ - [expr {$v(y)+125}] -width $v(width) \ + $c create line [expr {$tmp - 25}] [expr {$v(y) + 75}] [expr {$tmp + 25}] \ + [expr {$v(y) + 125}] -width $v(width) \ -arrow both -arrowshape "$v(a) $v(b) $v(c)" # Create a bunch of other arrows and text items showing the # current dimensions. - set tmp [expr {$v(x2)+10}] - $c create line $tmp [expr {$v(y)-5*$v(width)}] \ - $tmp [expr {$v(y)-$deltaY}] \ + set tmp [expr {$v(x2) + 10}] + $c create line $tmp [expr {$v(y) - (5 * $v(width))}] \ + $tmp [expr {$v(y) - $deltaY}] \ -arrow both -arrowshape $v(smallTips) - $c create text [expr {$v(x2)+15}] [expr {$v(y)-$deltaY+5*$v(c)}] \ + $c create text [expr {$v(x2) + 15}] [expr {($v(y) - $deltaY) + (5 * $v(c))}] \ -text $v(c) -anchor w - set tmp [expr {$v(x1)-10}] - $c create line $tmp [expr {$v(y)-5*$v(width)}] \ - $tmp [expr {$v(y)+5*$v(width)}] \ + set tmp [expr {$v(x1) - 10}] + $c create line $tmp [expr {$v(y) - (5 * $v(width))}] \ + $tmp [expr {$v(y) + (5 * $v(width))}] \ -arrow both -arrowshape $v(smallTips) - $c create text [expr {$v(x1)-15}] $v(y) -text $v(width) -anchor e - set tmp [expr {$v(y)+5*$v(width)+10*$v(c)+10}] - $c create line [expr {$v(x2)-10*$v(a)}] $tmp $v(x2) $tmp \ + $c create text [expr {$v(x1) - 15}] $v(y) -text $v(width) -anchor e + set tmp [expr {$v(y) + (5 * $v(width)) + (10 * $v(c)) + 10}] + $c create line [expr {$v(x2) - (10 * $v(a))}] $tmp $v(x2) $tmp \ -arrow both -arrowshape $v(smallTips) - $c create text [expr {$v(x2)-5*$v(a)}] [expr {$tmp+5}] \ + $c create text [expr {$v(x2) - (5 * $v(a))}] [expr {$tmp + 5}] \ -text $v(a) -anchor n - set tmp [expr {$tmp+25}] - $c create line [expr {$v(x2)-10*$v(b)}] $tmp $v(x2) $tmp \ + set tmp [expr {$tmp + 25}] + $c create line [expr {$v(x2) - (10 * $v(b))}] $tmp $v(x2) $tmp \ -arrow both -arrowshape $v(smallTips) - $c create text [expr {$v(x2)-5*$v(b)}] [expr {$tmp+5}] \ + $c create text [expr {$v(x2) - (5 * $v(b))}] [expr {$tmp + 5}] \ -text $v(b) -anchor n $c create text $v(x1) 310 -text "-width $v(width)" \ - -anchor w -font {Helvetica 18} + -anchor w -font "Helvetica 18" $c create text $v(x1) 330 -text "-arrowshape {$v(a) $v(b) $v(c)}" \ - -anchor w -font {Helvetica 18} + -anchor w -font "Helvetica 18" incr v(count) } set w .arrow -catch {destroy $w} +destroy $w toplevel $w wm title $w "Arrowhead Editor Demonstration" wm iconname $w "arrow" @@ -124,16 +124,18 @@ pack $btns -side bottom -fill x canvas $c -width 500 -height 350 -relief sunken -borderwidth 2 pack $c -expand yes -fill both -set demo_arrowInfo(a) 8 -set demo_arrowInfo(b) 10 -set demo_arrowInfo(c) 3 -set demo_arrowInfo(width) 2 -set demo_arrowInfo(motionProc) arrowMoveNull -set demo_arrowInfo(x1) 40 -set demo_arrowInfo(x2) 350 -set demo_arrowInfo(y) 150 -set demo_arrowInfo(smallTips) {5 5 2} -set demo_arrowInfo(count) 0 +array set demo_arrowInfo { + a 8 + b 10 + c 3 + width 2 + motionProc arrowMoveNull + x1 40 + x2 350 + y 150 + smallTips "5 5 2" + count 0 +} if {[winfo depth $c] > 1} { set demo_arrowInfo(bigLineStyle) "-fill SkyBlue1" set demo_arrowInfo(boxStyle) "-fill {} -outline black -width 1" @@ -167,7 +169,7 @@ bind $c <Any-ButtonRelease-1> "arrowSetup $c" proc arrowMove1 {c x y} { upvar #0 demo_arrowInfo v - set newA [expr {($v(x2)+5-round([$c canvasx $x]))/10}] + set newA [expr {(($v(x2) + 5) - ( round ([$c canvasx $x]))) / 10}] if {$newA < 0} { set newA 0 } @@ -175,7 +177,7 @@ proc arrowMove1 {c x y} { set newA 25 } if {$newA != $v(a)} { - $c move box1 [expr {10*($v(a)-$newA)}] 0 + $c move box1 [expr {10 * ($v(a) - $newA)}] 0 set v(a) $newA } } @@ -191,14 +193,14 @@ proc arrowMove1 {c x y} { proc arrowMove2 {c x y} { upvar #0 demo_arrowInfo v - set newB [expr {($v(x2)+5-round([$c canvasx $x]))/10}] + set newB [expr {(($v(x2) + 5) - ( round ([$c canvasx $x]))) / 10}] if {$newB < 0} { set newB 0 } if {$newB > 25} { set newB 25 } - set newC [expr {($v(y)+5-round([$c canvasy $y])-5*$v(width))/10}] + set newC [expr {(($v(y) + 5) - ( round ([$c canvasy $y])) - (5 * $v(width))) / 10}] if {$newC < 0} { set newC 0 } @@ -206,7 +208,7 @@ proc arrowMove2 {c x y} { set newC 20 } if {($newB != $v(b)) || ($newC != $v(c))} { - $c move box2 [expr {10*($v(b)-$newB)}] [expr {10*($v(c)-$newC)}] + $c move box2 [expr {10 * ($v(b) - $newB)}] [expr {10 * ($v(c) - $newC)}] set v(b) $newB set v(c) $newC } @@ -223,7 +225,7 @@ proc arrowMove2 {c x y} { proc arrowMove3 {c x y} { upvar #0 demo_arrowInfo v - set newWidth [expr {($v(y)+2-round([$c canvasy $y]))/5}] + set newWidth [expr {(($v(y) + 2) - ( round ([$c canvasy $y]))) / 5}] if {$newWidth < 0} { set newWidth 0 } @@ -231,7 +233,7 @@ proc arrowMove3 {c x y} { set newWidth 20 } if {$newWidth != $v(width)} { - $c move box3 0 [expr {5*($v(width)-$newWidth)}] + $c move box3 0 [expr {5 * ($v(width) - $newWidth)}] set v(width) $newWidth } } diff --git a/library/demos/bind.tcl b/library/demos/bind.tcl index d9bc22f..e1a064f 100644 --- a/library/demos/bind.tcl +++ b/library/demos/bind.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .bind -catch {destroy $w} +destroy $w toplevel $w wm title $w "Text Demonstration - Tag Bindings" wm iconname $w "bind" @@ -43,22 +43,22 @@ The same tag mechanism that controls display styles in text widgets can also be } $w.text insert end \ -{1. Samples of all the different types of items that can be created in canvas widgets.} d1 +"1. Samples of all the different types of items that can be created in canvas widgets." d1 $w.text insert end \n\n $w.text insert end \ -{2. A simple two-dimensional plot that allows you to adjust the positions of the data points.} d2 +"2. A simple two-dimensional plot that allows you to adjust the positions of the data points." d2 $w.text insert end \n\n $w.text insert end \ -{3. Anchoring and justification modes for text items.} d3 +"3. Anchoring and justification modes for text items." d3 $w.text insert end \n\n $w.text insert end \ -{4. An editor for arrow-head shapes for line items.} d4 +"4. An editor for arrow-head shapes for line items." d4 $w.text insert end \n\n $w.text insert end \ -{5. A ruler with facilities for editing tab stops.} d5 +"5. A ruler with facilities for editing tab stops." d5 $w.text insert end \n\n $w.text insert end \ -{6. A grid that demonstrates how canvases can be scrolled.} d6 +"6. A grid that demonstrates how canvases can be scrolled." d6 # Create bindings for tags. diff --git a/library/demos/bitmap.tcl b/library/demos/bitmap.tcl index 453987d..daa1b2f 100644 --- a/library/demos/bitmap.tcl +++ b/library/demos/bitmap.tcl @@ -33,7 +33,7 @@ proc bitmapRow {w args} { } set w .bitmap -catch {destroy $w} +destroy $w toplevel $w wm title $w "Bitmap Demonstration" wm iconname $w "bitmap" diff --git a/library/demos/browse b/library/demos/browse index d107f28..2e20f9a 100644 --- a/library/demos/browse +++ b/library/demos/browse @@ -27,16 +27,16 @@ wm minsize . 1 1 set browseScript [file join [pwd] $argv0] proc browse {dir file} { global env browseScript - if {[string compare $dir "."] != 0} {set file $dir/$file} - switch [file type $file] { + if {$dir ne "."} {set file [file join $dir $file]} + switch -- [file type $file] { directory { - exec [info nameofexecutable] $browseScript $file & + exec -- [info nameofexecutable] $browseScript $file & } file { if {[info exists env(EDITOR)]} { - eval exec $env(EDITOR) $file & + eval exec -- $env(EDITOR) $file & } else { - exec xedit $file & + exec -- xedit $file & } } default { @@ -47,7 +47,7 @@ proc browse {dir file} { # Fill the listbox with a list of all the files in the directory. -if {$argc>0} {set dir [lindex $argv 0]} else {set dir "."} +if {$argc > 0} {set dir [lindex $argv 0]} else {set dir "."} foreach i [lsort [glob * .* *.*]] { if {[file type $i] eq "directory"} { # Safe to do since it is still a directory. diff --git a/library/demos/button.tcl b/library/demos/button.tcl index bb943e6..4daef7a 100644 --- a/library/demos/button.tcl +++ b/library/demos/button.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .button -catch {destroy $w} +destroy $w toplevel $w wm title $w "Button Demonstration" wm iconname $w "button" diff --git a/library/demos/check.tcl b/library/demos/check.tcl index c072096..f257643 100644 --- a/library/demos/check.tcl +++ b/library/demos/check.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .check -catch {destroy $w} +destroy $w toplevel $w wm title $w "Checkbutton Demonstration" wm iconname $w "check" @@ -54,9 +54,9 @@ proc tristate_check {n1 n2 op} { set sober 1 } } else { - if {$wipers == 1 && $brakes == 1 && $sober == 1} { + if {($wipers == 1) && ($brakes == 1) && ($sober == 1)} { set safety all - } elseif {$wipers == 1 || $brakes == 1 || $sober == 1} { + } elseif {($wipers == 1) || ($brakes == 1) || ($sober == 1)} { set safety partial } else { set safety none @@ -65,7 +65,7 @@ proc tristate_check {n1 n2 op} { set in_check 0 } -trace variable wipers w tristate_check -trace variable brakes w tristate_check -trace variable sober w tristate_check -trace variable safety w tristate_check +trace add variable wipers write tristate_check +trace add variable brakes write tristate_check +trace add variable sober write tristate_check +trace add variable safety write tristate_check diff --git a/library/demos/clrpick.tcl b/library/demos/clrpick.tcl index ba50b75..87e33a4 100644 --- a/library/demos/clrpick.tcl +++ b/library/demos/clrpick.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .clrpick -catch {destroy $w} +destroy $w toplevel $w wm title $w "Color Selection Dialog" wm iconname $w "colors" @@ -36,7 +36,7 @@ proc setColor {w button name options} { set initialColor [$button cget -$name] set color [tk_chooseColor -title "Choose a $name color" -parent $w \ -initialcolor $initialColor] - if {[string compare $color ""]} { + if {$color ne ""} { setColor_helper $w $options $color } grab release $w diff --git a/library/demos/colors.tcl b/library/demos/colors.tcl index 99dec92..4250e79 100644 --- a/library/demos/colors.tcl +++ b/library/demos/colors.tcl @@ -11,7 +11,7 @@ if {![info exists widgetDemo]} { package require Tk set w .colors -catch {destroy $w} +destroy $w toplevel $w wm title $w "Listbox Demonstration (colors)" wm iconname $w "Listbox" diff --git a/library/demos/combo.tcl b/library/demos/combo.tcl index 8631904..8c17c0e 100644 --- a/library/demos/combo.tcl +++ b/library/demos/combo.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .combo -catch {destroy $w} +destroy $w toplevel $w wm title $w "Combobox Demonstration" wm iconname $w "combo" @@ -45,10 +45,13 @@ set ozCity Sydney ttk::labelframe $w.c1 -text "Fully Editable" ttk::combobox $w.c1.c -textvariable firstValue ttk::labelframe $w.c2 -text Disabled -ttk::combobox $w.c2.c -textvariable secondValue -state disabled +ttk::combobox $w.c2.c -textvariable secondValue ttk::labelframe $w.c3 -text "Defined List Only" -ttk::combobox $w.c3.c -textvariable ozCity -state readonly \ - -values $australianCities +ttk::combobox $w.c3.c -textvariable ozCity -values $australianCities + +$w.c2.c state disabled +$w.c3.c state readonly + bind $w.c1.c <Return> { if {[%W get] ni [%W cget -values]} { %W configure -values [concat [%W cget -values] [list [%W get]]] diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index f6e88f4..db8c7c4 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .cscroll -catch {destroy $w} +destroy $w toplevel $w wm title $w "Scrollable Canvas Demonstration" wm iconname $w "cscroll" @@ -41,14 +41,13 @@ grid $w.vscroll -in $w.grid -padx 1 -pady 1 \ grid $w.hscroll -in $w.grid -padx 1 -pady 1 \ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news - -set bg [lindex [$c config -bg] 4] +set bg [lindex [$c configure -background] 4] for {set i 0} {$i < 20} {incr i} { - set x [expr {-10 + 3*$i}] + set x [expr {-10 + (3 * $i)}] for {set j 0; set y -10} {$j < 10} {incr j; incr y 3} { - $c create rect ${x}c ${y}c [expr {$x+2}]c [expr {$y+2}]c \ + $c create rect ${x}c ${y}c [expr {$x + 2}]c [expr {$y + 2}]c \ -outline black -fill $bg -tags rect - $c create text [expr {$x+1}]c [expr {$y+1}]c -text "$i,$j" \ + $c create text [expr {$x + 1}]c [expr {$y + 1}]c -text "$i,$j" \ -anchor center -tags text } } @@ -73,36 +72,36 @@ if {[tk windowingsystem] eq "aqua"} { } } -proc scrollEnter canvas { +proc scrollEnter {canvas} { global oldFill set id [$canvas find withtag current] - if {[lsearch [$canvas gettags current] text] >= 0} { - set id [expr {$id-1}] + if {"text" in [$canvas gettags current]} { + set id [expr {$id - 1}] } set oldFill [lindex [$canvas itemconfig $id -fill] 4] if {[winfo depth $canvas] > 1} { $canvas itemconfigure $id -fill SeaGreen1 } else { $canvas itemconfigure $id -fill black - $canvas itemconfigure [expr {$id+1}] -fill white + $canvas itemconfigure [expr {$id + 1}] -fill white } } -proc scrollLeave canvas { +proc scrollLeave {canvas} { global oldFill set id [$canvas find withtag current] - if {[lsearch [$canvas gettags current] text] >= 0} { - set id [expr {$id-1}] + if {"text" in [$canvas gettags current]} { + set id [expr {$id - 1}] } $canvas itemconfigure $id -fill $oldFill - $canvas itemconfigure [expr {$id+1}] -fill black + $canvas itemconfigure [expr {$id + 1}] -fill black } -proc scrollButton canvas { +proc scrollButton {canvas} { global oldFill set id [$canvas find withtag current] - if {[lsearch [$canvas gettags current] text] < 0} { - set id [expr {$id+1}] + if {"text" ni [$canvas gettags current]} { + set id [expr {$id + 1}] } puts stdout "You buttoned at [lindex [$canvas itemconf $id -text] 4]" } diff --git a/library/demos/ctext.tcl b/library/demos/ctext.tcl index 4b8c644..3eacdda 100644 --- a/library/demos/ctext.tcl +++ b/library/demos/ctext.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .ctext -catch {destroy $w} +destroy $w toplevel $w wm title $w "Canvas Text Demonstration" wm iconname $w "Text" @@ -34,7 +34,7 @@ pack $btns -side bottom -fill x canvas $c -relief flat -borderwidth 0 -width 500 -height 350 pack $w.c -side top -expand yes -fill both -set textFont {Helvetica 24} +set textFont "Helvetica 24" $c create rectangle 245 195 255 205 -outline black -fill red @@ -56,14 +56,14 @@ $c bind text <2> "textPaste $c @%x,%y" # to be edited. proc mkTextConfigBox {w x y option value color} { - set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \ + set item [$w create rect $x $y [expr {$x + 30}] [expr {$y + 30}] \ -outline black -fill $color -width 1] $w bind $item <1> "$w itemconf text $option $value" $w addtag config withtag $item } proc mkTextConfigPie {w x y a option value color} { - set item [$w create arc $x $y [expr {$x+90}] [expr {$y+90}] \ - -start [expr {$a-15}] -extent 30 -outline black -fill $color \ + set item [$w create arc $x $y [expr {$x + 90}] [expr {$y + 90}] \ + -start [expr {$a - 15}] -extent 30 -outline black -fill $color \ -width 1] $w bind $item <1> "$w itemconf text $option $value" $w addtag config withtag $item @@ -73,20 +73,20 @@ set x 50 set y 50 set color LightSkyBlue1 mkTextConfigBox $c $x $y -anchor se $color -mkTextConfigBox $c [expr {$x+30}] [expr {$y }] -anchor s $color -mkTextConfigBox $c [expr {$x+60}] [expr {$y }] -anchor sw $color -mkTextConfigBox $c [expr {$x }] [expr {$y+30}] -anchor e $color -mkTextConfigBox $c [expr {$x+30}] [expr {$y+30}] -anchor center $color -mkTextConfigBox $c [expr {$x+60}] [expr {$y+30}] -anchor w $color -mkTextConfigBox $c [expr {$x }] [expr {$y+60}] -anchor ne $color -mkTextConfigBox $c [expr {$x+30}] [expr {$y+60}] -anchor n $color -mkTextConfigBox $c [expr {$x+60}] [expr {$y+60}] -anchor nw $color +mkTextConfigBox $c [expr {$x + 30}] [expr {$y }] -anchor s $color +mkTextConfigBox $c [expr {$x + 60}] [expr {$y }] -anchor sw $color +mkTextConfigBox $c [expr {$x }] [expr {$y + 30}] -anchor e $color +mkTextConfigBox $c [expr {$x + 30}] [expr {$y + 30}] -anchor center $color +mkTextConfigBox $c [expr {$x + 60}] [expr {$y + 30}] -anchor w $color +mkTextConfigBox $c [expr {$x }] [expr {$y + 60}] -anchor ne $color +mkTextConfigBox $c [expr {$x + 30}] [expr {$y + 60}] -anchor n $color +mkTextConfigBox $c [expr {$x + 60}] [expr {$y + 60}] -anchor nw $color set item [$c create rect \ - [expr {$x+40}] [expr {$y+40}] [expr {$x+50}] [expr {$y+50}] \ + [expr {$x + 40}] [expr {$y + 40}] [expr {$x + 50}] [expr {$y + 50}] \ -outline black -fill red] $c bind $item <1> "$c itemconf text -anchor center" -$c create text [expr {$x+45}] [expr {$y-5}] \ - -text {Text Position} -anchor s -font {Times 20} -fill brown +$c create text [expr {$x + 45}] [expr {$y - 5}] \ + -text "Text Position" -anchor s -font "Times 20" -fill brown # Now create some items that allow the text's angle to be changed. @@ -105,8 +105,8 @@ mkTextConfigPie $c $x $y 240 -angle 330 $color mkTextConfigPie $c $x $y 270 -angle 0 $color mkTextConfigPie $c $x $y 300 -angle 30 $color mkTextConfigPie $c $x $y 330 -angle 60 $color -$c create text [expr {$x+45}] [expr {$y-5}] \ - -text {Text Angle} -anchor s -font {Times 20} -fill brown +$c create text [expr {$x + 45}] [expr {$y - 5}] \ + -text "Text Angle" -anchor s -font "Times 20" -fill brown # Lastly, create some items that allow the text's justification to be # changed. @@ -115,15 +115,15 @@ set x 350 set y 50 set color SeaGreen2 mkTextConfigBox $c $x $y -justify left $color -mkTextConfigBox $c [expr {$x+30}] $y -justify center $color -mkTextConfigBox $c [expr {$x+60}] $y -justify right $color -$c create text [expr {$x+45}] [expr {$y-5}] \ - -text {Justification} -anchor s -font {Times 20} -fill brown +mkTextConfigBox $c [expr {$x + 30}] $y -justify center $color +mkTextConfigBox $c [expr {$x + 60}] $y -justify right $color +$c create text [expr {$x + 45}] [expr {$y - 5}] \ + -text "Justification" -anchor s -font "Times 20" -fill brown $c bind config <Enter> "textEnter $c" $c bind config <Leave> "$c itemconf current -fill \$textConfigFill" -set textConfigFill {} +set textConfigFill "" proc textEnter {w} { global textConfigFill @@ -132,7 +132,7 @@ proc textEnter {w} { } proc textInsert {w string} { - if {$string == ""} { + if {$string eq ""} { return } catch {$w dchars text sel.first sel.last} diff --git a/library/demos/dialog1.tcl b/library/demos/dialog1.tcl index 5c572be..92e2cd4 100644 --- a/library/demos/dialog1.tcl +++ b/library/demos/dialog1.tcl @@ -4,10 +4,11 @@ after idle {.dialog1.msg configure -wraplength 4i} set i [tk_dialog .dialog1 "Dialog with local grab" {This is a modal dialog box. It uses Tk's "grab" command to create a "local grab" on the dialog box. The grab prevents any pointer-related events from getting to any other windows in the application until you have answered the dialog by invoking one of the buttons below. However, you can still interact with other applications.} \ -info 0 OK Cancel {Show Code}] +info 0 OK Cancel "Show Code"] -switch $i { +switch -- $i { 0 {puts "You pressed OK"} 1 {puts "You pressed Cancel"} 2 {showCode .dialog1} + default {exit} } diff --git a/library/demos/dialog2.tcl b/library/demos/dialog2.tcl index 2f45da8..55b9ae4 100644 --- a/library/demos/dialog2.tcl +++ b/library/demos/dialog2.tcl @@ -8,10 +8,11 @@ after idle { after 100 { grab -global .dialog2 } -set i [tk_dialog .dialog2 "Dialog with global grab" {This dialog box uses a global grab, so it prevents you from interacting with anything on your display until you invoke one of the buttons below. Global grabs are almost always a bad idea; don't use them unless you're truly desperate.} warning 0 OK Cancel {Show Code}] +set i [tk_dialog .dialog2 "Dialog with global grab" "This dialog box uses a global grab, so it prevents you from interacting with anything on your display until you invoke one of the buttons below. Global grabs are almost always a bad idea; don't use them unless you're truly desperate." warning 0 OK Cancel "Show Code"] -switch $i { +switch -- $i { 0 {puts "You pressed OK"} 1 {puts "You pressed Cancel"} 2 {showCode .dialog2} + default {exit} } diff --git a/library/demos/entry1.tcl b/library/demos/entry1.tcl index eef8964..afd665c 100644 --- a/library/demos/entry1.tcl +++ b/library/demos/entry1.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .entry1 -catch {destroy $w} +destroy $w toplevel $w wm title $w "Entry Demonstration (no scrollbars)" wm iconname $w "entry1" diff --git a/library/demos/entry2.tcl b/library/demos/entry2.tcl index d0ca35a..799d3f1 100644 --- a/library/demos/entry2.tcl +++ b/library/demos/entry2.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .entry2 -catch {destroy $w} +destroy $w toplevel $w wm title $w "Entry Demonstration (with scrollbars)" wm iconname $w "entry2" diff --git a/library/demos/entry3.tcl b/library/demos/entry3.tcl index d4435c6..6cc9048 100644 --- a/library/demos/entry3.tcl +++ b/library/demos/entry3.tcl @@ -11,7 +11,7 @@ if {![info exists widgetDemo]} { package require Tk set w .entry3 -catch {destroy $w} +destroy $w toplevel $w wm title $w "Constrained Entry Demonstration" wm iconname $w "entry3" @@ -49,15 +49,15 @@ pack $btns -side bottom -fill x proc focusAndFlash {W fg bg {count 9}} { focus -force $W - if {$count<1} { + if {$count < 1} { $W configure -foreground $fg -background $bg } else { - if {$count%2} { + if {$count % 2} { $W configure -foreground $bg -background $fg } else { $W configure -foreground $fg -background $bg } - after 200 [list focusAndFlash $W $fg $bg [expr {$count-1}]] + after 200 [list focusAndFlash $W $fg $bg [expr {$count - 1}]] } } @@ -70,7 +70,7 @@ $w.l1.e configure -invalidcommand \ pack $w.l1.e -fill x -expand 1 -padx 1m -pady 1m labelframe $w.l2 -text "Length-Constrained Entry" -entry $w.l2.e -validate key -invcmd bell -vcmd {expr {[string length %P]<10}} +entry $w.l2.e -validate key -invcmd bell -vcmd {expr {[string length %P] < 10}} pack $w.l2.e -fill x -expand 1 -padx 1m -pady 1m ### PHONE NUMBER ENTRY ### @@ -82,7 +82,7 @@ set entry3content "1-(000)-000-0000" # Mapping from alphabetic characters to numbers. This is probably # wrong, but it is the only mapping I have; the UK doesn't really go # for associating letters with digits for some reason. -set phoneNumberMap {} +set phoneNumberMap "" foreach {chars digit} {abc 2 def 3 ghi 4 jkl 5 mno 6 pqrs 7 tuv 8 wxyz 9} { foreach char [split $chars ""] { lappend phoneNumberMap $char $digit [string toupper $char] $digit @@ -105,9 +105,9 @@ proc validatePhoneChange {W vmode idx char} { if {$idx == -1} {return 1} after idle [list $W configure -validate $vmode -invcmd bell] if { - !($idx<3 || $idx==6 || $idx==7 || $idx==11 || $idx>15) && + (!(($idx < 3) || ($idx in "6 7 11") || ($idx > 15))) && [string match {[0-9A-Za-z]} $char] - } then { + } { $W delete $idx $W insert $idx [string map $phoneNumberMap $char] after idle [list phoneSkipRight $W -1] @@ -127,7 +127,7 @@ proc phoneSkipLeft {W} { if {$idx == 8} { # Skip back two extra characters $W icursor [incr idx -2] - } elseif {$idx == 7 || $idx == 12} { + } elseif {$idx in "7 12"} { # Skip back one extra character $W icursor [incr idx -1] } elseif {$idx <= 3} { @@ -146,13 +146,13 @@ proc phoneSkipLeft {W} { proc phoneSkipRight {W {add 0}} { set idx [$W index insert] - if {$idx+$add == 5} { + if {($idx + $add) == 5} { # Skip forward two extra characters $W icursor [incr idx 2] - } elseif {$idx+$add == 6 || $idx+$add == 10} { + } elseif {(($idx + $add) == 6) || (($idx + $add) == 10)} { # Skip forward one extra character $W icursor [incr idx] - } elseif {$idx+$add == 15 && !$add} { + } elseif {(($idx + $add) == 15) && (!$add)} { # Can't move any further bell return -code break @@ -174,7 +174,7 @@ bind $w.l3.e <<NextChar>> {phoneSkipRight %W} pack $w.l3.e -fill x -expand 1 -padx 1m -pady 1m labelframe $w.l4 -text "Password Entry" -entry $w.l4.e -validate key -show "*" -vcmd {expr {[string length %P]<=8}} +entry $w.l4.e -validate key -show "*" -vcmd {expr {[string length %P] <= 8}} pack $w.l4.e -fill x -expand 1 -padx 1m -pady 1m lower [frame $w.mid] diff --git a/library/demos/filebox.tcl b/library/demos/filebox.tcl index e06ebba..61cee5e 100644 --- a/library/demos/filebox.tcl +++ b/library/demos/filebox.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .filebox -catch {destroy $w} +destroy $w toplevel $w wm title $w "File Selection Dialogs" wm iconname $w "filebox" @@ -61,7 +61,7 @@ proc fileDialog {w ent operation} { {"Image Files" "" {GIFF JPEG}} {"All files" *} } - if {$operation == "open"} { + if {$operation eq "open"} { global selected_type if {![info exists selected_type]} { set selected_type "Tcl Scripts" @@ -73,7 +73,7 @@ proc fileDialog {w ent operation} { set file [tk_getSaveFile -filetypes $types -parent $w \ -initialfile Untitled -defaultextension .txt] } - if {[string compare $file ""]} { + if {$file ne ""} { $ent delete 0 end $ent insert 0 $file $ent xview end diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl index 827600b..1f6760b 100644 --- a/library/demos/floor.tcl +++ b/library/demos/floor.tcl @@ -42,14 +42,13 @@ proc floorDisplay {w active} { # Create a dummy item just to mark this point in the display list, # so we can insert highlights here. - $w create rect 0 100 1 101 -fill {} -outline {} -tags marker + $w create rect 0 100 1 101 -fill "" -outline "" -tags marker # Add the walls and labels for the active floor, along with # transparent polygons that define the rooms on the floor. # Make sure that the room polygons are on top. - catch {unset floorLabels} - catch {unset floorItems} + unset -nocomplain floorLabels floorItems fg$active $w $colors(offices) $w raise room @@ -73,11 +72,11 @@ proc floorDisplay {w active} { # Arguments: # w - The name of the canvas window. -proc newRoom w { +proc newRoom {w} { global currentRoom floorLabels set id [$w find withtag current] - if {$id != ""} { + if {$id ne ""} { set currentRoom $floorLabels($id) } update idletasks @@ -114,6 +113,8 @@ proc roomChanged {w args} { # outline - Color to use for the floor's outline. proc bg1 {w fill outline} { + set tags [list floor1 bg] + $w create poly 347 80 349 82 351 84 353 85 363 92 375 99 386 104 \ 386 129 398 129 398 162 484 162 484 129 559 129 559 133 725 \ 133 725 129 802 129 802 389 644 389 644 391 559 391 559 327 \ @@ -127,105 +128,105 @@ proc bg1 {w fill outline} { 22 223 17 227 13 231 8 236 4 242 2 246 0 260 0 283 1 300 5 \ 321 14 335 22 348 25 365 29 363 39 358 48 352 56 337 70 \ 344 76 347 80 \ - -tags {floor1 bg} -fill $fill - $w create line 386 129 398 129 -fill $outline -tags {floor1 bg} - $w create line 258 355 258 387 -fill $outline -tags {floor1 bg} - $w create line 60 387 60 391 -fill $outline -tags {floor1 bg} - $w create line 0 337 0 391 -fill $outline -tags {floor1 bg} - $w create line 60 391 0 391 -fill $outline -tags {floor1 bg} - $w create line 3 114 3 337 -fill $outline -tags {floor1 bg} - $w create line 258 387 60 387 -fill $outline -tags {floor1 bg} - $w create line 484 162 398 162 -fill $outline -tags {floor1 bg} - $w create line 398 162 398 129 -fill $outline -tags {floor1 bg} - $w create line 484 278 484 311 -fill $outline -tags {floor1 bg} - $w create line 484 311 508 311 -fill $outline -tags {floor1 bg} - $w create line 508 327 508 311 -fill $outline -tags {floor1 bg} - $w create line 559 327 508 327 -fill $outline -tags {floor1 bg} - $w create line 644 391 559 391 -fill $outline -tags {floor1 bg} - $w create line 644 389 644 391 -fill $outline -tags {floor1 bg} - $w create line 559 129 484 129 -fill $outline -tags {floor1 bg} - $w create line 484 162 484 129 -fill $outline -tags {floor1 bg} - $w create line 725 133 559 133 -fill $outline -tags {floor1 bg} - $w create line 559 129 559 133 -fill $outline -tags {floor1 bg} - $w create line 725 129 802 129 -fill $outline -tags {floor1 bg} - $w create line 802 389 802 129 -fill $outline -tags {floor1 bg} - $w create line 3 337 0 337 -fill $outline -tags {floor1 bg} - $w create line 559 391 559 327 -fill $outline -tags {floor1 bg} - $w create line 802 389 644 389 -fill $outline -tags {floor1 bg} - $w create line 725 133 725 129 -fill $outline -tags {floor1 bg} - $w create line 8 25 8 114 -fill $outline -tags {floor1 bg} - $w create line 8 114 3 114 -fill $outline -tags {floor1 bg} - $w create line 30 25 8 25 -fill $outline -tags {floor1 bg} - $w create line 484 278 395 278 -fill $outline -tags {floor1 bg} - $w create line 30 25 30 5 -fill $outline -tags {floor1 bg} - $w create line 93 5 30 5 -fill $outline -tags {floor1 bg} - $w create line 98 5 93 5 -fill $outline -tags {floor1 bg} - $w create line 104 7 98 5 -fill $outline -tags {floor1 bg} - $w create line 110 10 104 7 -fill $outline -tags {floor1 bg} - $w create line 116 16 110 10 -fill $outline -tags {floor1 bg} - $w create line 119 20 116 16 -fill $outline -tags {floor1 bg} - $w create line 122 28 119 20 -fill $outline -tags {floor1 bg} - $w create line 123 32 122 28 -fill $outline -tags {floor1 bg} - $w create line 123 68 123 32 -fill $outline -tags {floor1 bg} - $w create line 220 68 123 68 -fill $outline -tags {floor1 bg} - $w create line 386 129 386 104 -fill $outline -tags {floor1 bg} - $w create line 386 104 375 99 -fill $outline -tags {floor1 bg} - $w create line 375 99 363 92 -fill $outline -tags {floor1 bg} - $w create line 353 85 363 92 -fill $outline -tags {floor1 bg} - $w create line 220 68 220 34 -fill $outline -tags {floor1 bg} - $w create line 337 70 352 56 -fill $outline -tags {floor1 bg} - $w create line 352 56 358 48 -fill $outline -tags {floor1 bg} - $w create line 358 48 363 39 -fill $outline -tags {floor1 bg} - $w create line 363 39 365 29 -fill $outline -tags {floor1 bg} - $w create line 365 29 348 25 -fill $outline -tags {floor1 bg} - $w create line 348 25 335 22 -fill $outline -tags {floor1 bg} - $w create line 335 22 321 14 -fill $outline -tags {floor1 bg} - $w create line 321 14 300 5 -fill $outline -tags {floor1 bg} - $w create line 300 5 283 1 -fill $outline -tags {floor1 bg} - $w create line 283 1 260 0 -fill $outline -tags {floor1 bg} - $w create line 260 0 246 0 -fill $outline -tags {floor1 bg} - $w create line 246 0 242 2 -fill $outline -tags {floor1 bg} - $w create line 242 2 236 4 -fill $outline -tags {floor1 bg} - $w create line 236 4 231 8 -fill $outline -tags {floor1 bg} - $w create line 231 8 227 13 -fill $outline -tags {floor1 bg} - $w create line 223 17 227 13 -fill $outline -tags {floor1 bg} - $w create line 221 22 223 17 -fill $outline -tags {floor1 bg} - $w create line 220 34 221 22 -fill $outline -tags {floor1 bg} - $w create line 340 360 335 363 -fill $outline -tags {floor1 bg} - $w create line 335 363 331 365 -fill $outline -tags {floor1 bg} - $w create line 331 365 326 366 -fill $outline -tags {floor1 bg} - $w create line 326 366 304 366 -fill $outline -tags {floor1 bg} - $w create line 304 355 304 366 -fill $outline -tags {floor1 bg} - $w create line 395 288 400 288 -fill $outline -tags {floor1 bg} - $w create line 404 288 400 288 -fill $outline -tags {floor1 bg} - $w create line 409 290 404 288 -fill $outline -tags {floor1 bg} - $w create line 413 292 409 290 -fill $outline -tags {floor1 bg} - $w create line 418 297 413 292 -fill $outline -tags {floor1 bg} - $w create line 421 302 418 297 -fill $outline -tags {floor1 bg} - $w create line 422 309 421 302 -fill $outline -tags {floor1 bg} - $w create line 421 318 422 309 -fill $outline -tags {floor1 bg} - $w create line 421 318 417 325 -fill $outline -tags {floor1 bg} - $w create line 417 325 411 330 -fill $outline -tags {floor1 bg} - $w create line 411 330 405 332 -fill $outline -tags {floor1 bg} - $w create line 405 332 397 333 -fill $outline -tags {floor1 bg} - $w create line 397 333 344 333 -fill $outline -tags {floor1 bg} - $w create line 344 333 340 334 -fill $outline -tags {floor1 bg} - $w create line 340 334 336 336 -fill $outline -tags {floor1 bg} - $w create line 336 336 335 338 -fill $outline -tags {floor1 bg} - $w create line 335 338 332 342 -fill $outline -tags {floor1 bg} - $w create line 331 347 332 342 -fill $outline -tags {floor1 bg} - $w create line 332 351 331 347 -fill $outline -tags {floor1 bg} - $w create line 334 354 332 351 -fill $outline -tags {floor1 bg} - $w create line 336 357 334 354 -fill $outline -tags {floor1 bg} - $w create line 341 359 336 357 -fill $outline -tags {floor1 bg} - $w create line 341 359 340 360 -fill $outline -tags {floor1 bg} - $w create line 395 288 395 278 -fill $outline -tags {floor1 bg} - $w create line 304 355 258 355 -fill $outline -tags {floor1 bg} - $w create line 347 80 344 76 -fill $outline -tags {floor1 bg} - $w create line 344 76 337 70 -fill $outline -tags {floor1 bg} - $w create line 349 82 347 80 -fill $outline -tags {floor1 bg} - $w create line 351 84 349 82 -fill $outline -tags {floor1 bg} - $w create line 353 85 351 84 -fill $outline -tags {floor1 bg} + -tags $tags -fill $fill + $w create line 386 129 398 129 -fill $outline -tags $tags + $w create line 258 355 258 387 -fill $outline -tags $tags + $w create line 60 387 60 391 -fill $outline -tags $tags + $w create line 0 337 0 391 -fill $outline -tags $tags + $w create line 60 391 0 391 -fill $outline -tags $tags + $w create line 3 114 3 337 -fill $outline -tags $tags + $w create line 258 387 60 387 -fill $outline -tags $tags + $w create line 484 162 398 162 -fill $outline -tags $tags + $w create line 398 162 398 129 -fill $outline -tags $tags + $w create line 484 278 484 311 -fill $outline -tags $tags + $w create line 484 311 508 311 -fill $outline -tags $tags + $w create line 508 327 508 311 -fill $outline -tags $tags + $w create line 559 327 508 327 -fill $outline -tags $tags + $w create line 644 391 559 391 -fill $outline -tags $tags + $w create line 644 389 644 391 -fill $outline -tags $tags + $w create line 559 129 484 129 -fill $outline -tags $tags + $w create line 484 162 484 129 -fill $outline -tags $tags + $w create line 725 133 559 133 -fill $outline -tags $tags + $w create line 559 129 559 133 -fill $outline -tags $tags + $w create line 725 129 802 129 -fill $outline -tags $tags + $w create line 802 389 802 129 -fill $outline -tags $tags + $w create line 3 337 0 337 -fill $outline -tags $tags + $w create line 559 391 559 327 -fill $outline -tags $tags + $w create line 802 389 644 389 -fill $outline -tags $tags + $w create line 725 133 725 129 -fill $outline -tags $tags + $w create line 8 25 8 114 -fill $outline -tags $tags + $w create line 8 114 3 114 -fill $outline -tags $tags + $w create line 30 25 8 25 -fill $outline -tags $tags + $w create line 484 278 395 278 -fill $outline -tags $tags + $w create line 30 25 30 5 -fill $outline -tags $tags + $w create line 93 5 30 5 -fill $outline -tags $tags + $w create line 98 5 93 5 -fill $outline -tags $tags + $w create line 104 7 98 5 -fill $outline -tags $tags + $w create line 110 10 104 7 -fill $outline -tags $tags + $w create line 116 16 110 10 -fill $outline -tags $tags + $w create line 119 20 116 16 -fill $outline -tags $tags + $w create line 122 28 119 20 -fill $outline -tags $tags + $w create line 123 32 122 28 -fill $outline -tags $tags + $w create line 123 68 123 32 -fill $outline -tags $tags + $w create line 220 68 123 68 -fill $outline -tags $tags + $w create line 386 129 386 104 -fill $outline -tags $tags + $w create line 386 104 375 99 -fill $outline -tags $tags + $w create line 375 99 363 92 -fill $outline -tags $tags + $w create line 353 85 363 92 -fill $outline -tags $tags + $w create line 220 68 220 34 -fill $outline -tags $tags + $w create line 337 70 352 56 -fill $outline -tags $tags + $w create line 352 56 358 48 -fill $outline -tags $tags + $w create line 358 48 363 39 -fill $outline -tags $tags + $w create line 363 39 365 29 -fill $outline -tags $tags + $w create line 365 29 348 25 -fill $outline -tags $tags + $w create line 348 25 335 22 -fill $outline -tags $tags + $w create line 335 22 321 14 -fill $outline -tags $tags + $w create line 321 14 300 5 -fill $outline -tags $tags + $w create line 300 5 283 1 -fill $outline -tags $tags + $w create line 283 1 260 0 -fill $outline -tags $tags + $w create line 260 0 246 0 -fill $outline -tags $tags + $w create line 246 0 242 2 -fill $outline -tags $tags + $w create line 242 2 236 4 -fill $outline -tags $tags + $w create line 236 4 231 8 -fill $outline -tags $tags + $w create line 231 8 227 13 -fill $outline -tags $tags + $w create line 223 17 227 13 -fill $outline -tags $tags + $w create line 221 22 223 17 -fill $outline -tags $tags + $w create line 220 34 221 22 -fill $outline -tags $tags + $w create line 340 360 335 363 -fill $outline -tags $tags + $w create line 335 363 331 365 -fill $outline -tags $tags + $w create line 331 365 326 366 -fill $outline -tags $tags + $w create line 326 366 304 366 -fill $outline -tags $tags + $w create line 304 355 304 366 -fill $outline -tags $tags + $w create line 395 288 400 288 -fill $outline -tags $tags + $w create line 404 288 400 288 -fill $outline -tags $tags + $w create line 409 290 404 288 -fill $outline -tags $tags + $w create line 413 292 409 290 -fill $outline -tags $tags + $w create line 418 297 413 292 -fill $outline -tags $tags + $w create line 421 302 418 297 -fill $outline -tags $tags + $w create line 422 309 421 302 -fill $outline -tags $tags + $w create line 421 318 422 309 -fill $outline -tags $tags + $w create line 421 318 417 325 -fill $outline -tags $tags + $w create line 417 325 411 330 -fill $outline -tags $tags + $w create line 411 330 405 332 -fill $outline -tags $tags + $w create line 405 332 397 333 -fill $outline -tags $tags + $w create line 397 333 344 333 -fill $outline -tags $tags + $w create line 344 333 340 334 -fill $outline -tags $tags + $w create line 340 334 336 336 -fill $outline -tags $tags + $w create line 336 336 335 338 -fill $outline -tags $tags + $w create line 335 338 332 342 -fill $outline -tags $tags + $w create line 331 347 332 342 -fill $outline -tags $tags + $w create line 332 351 331 347 -fill $outline -tags $tags + $w create line 334 354 332 351 -fill $outline -tags $tags + $w create line 336 357 334 354 -fill $outline -tags $tags + $w create line 341 359 336 357 -fill $outline -tags $tags + $w create line 341 359 340 360 -fill $outline -tags $tags + $w create line 395 288 395 278 -fill $outline -tags $tags + $w create line 304 355 258 355 -fill $outline -tags $tags + $w create line 347 80 344 76 -fill $outline -tags $tags + $w create line 344 76 337 70 -fill $outline -tags $tags + $w create line 349 82 347 80 -fill $outline -tags $tags + $w create line 351 84 349 82 -fill $outline -tags $tags + $w create line 353 85 351 84 -fill $outline -tags $tags } # bg2 -- @@ -239,48 +240,50 @@ proc bg1 {w fill outline} { # outline - Color to use for the floor's outline. proc bg2 {w fill outline} { + set tags [list floor2 bg] + $w create poly 559 129 484 129 484 162 398 162 398 129 315 129 \ 315 133 176 133 176 129 96 129 96 133 3 133 3 339 0 339 0 391 \ 60 391 60 387 258 387 258 329 350 329 350 311 395 311 395 280 \ 484 280 484 311 508 311 508 327 558 327 558 391 644 391 644 \ 367 802 367 802 129 725 129 725 133 559 133 559 129 \ - -tags {floor2 bg} -fill $fill - $w create line 350 311 350 329 -fill $outline -tags {floor2 bg} - $w create line 398 129 398 162 -fill $outline -tags {floor2 bg} - $w create line 802 367 802 129 -fill $outline -tags {floor2 bg} - $w create line 802 129 725 129 -fill $outline -tags {floor2 bg} - $w create line 725 133 725 129 -fill $outline -tags {floor2 bg} - $w create line 559 129 559 133 -fill $outline -tags {floor2 bg} - $w create line 559 133 725 133 -fill $outline -tags {floor2 bg} - $w create line 484 162 484 129 -fill $outline -tags {floor2 bg} - $w create line 559 129 484 129 -fill $outline -tags {floor2 bg} - $w create line 802 367 644 367 -fill $outline -tags {floor2 bg} - $w create line 644 367 644 391 -fill $outline -tags {floor2 bg} - $w create line 644 391 558 391 -fill $outline -tags {floor2 bg} - $w create line 558 327 558 391 -fill $outline -tags {floor2 bg} - $w create line 558 327 508 327 -fill $outline -tags {floor2 bg} - $w create line 508 327 508 311 -fill $outline -tags {floor2 bg} - $w create line 484 311 508 311 -fill $outline -tags {floor2 bg} - $w create line 484 280 484 311 -fill $outline -tags {floor2 bg} - $w create line 398 162 484 162 -fill $outline -tags {floor2 bg} - $w create line 484 280 395 280 -fill $outline -tags {floor2 bg} - $w create line 395 280 395 311 -fill $outline -tags {floor2 bg} - $w create line 258 387 60 387 -fill $outline -tags {floor2 bg} - $w create line 3 133 3 339 -fill $outline -tags {floor2 bg} - $w create line 3 339 0 339 -fill $outline -tags {floor2 bg} - $w create line 60 391 0 391 -fill $outline -tags {floor2 bg} - $w create line 0 339 0 391 -fill $outline -tags {floor2 bg} - $w create line 60 387 60 391 -fill $outline -tags {floor2 bg} - $w create line 258 329 258 387 -fill $outline -tags {floor2 bg} - $w create line 350 329 258 329 -fill $outline -tags {floor2 bg} - $w create line 395 311 350 311 -fill $outline -tags {floor2 bg} - $w create line 398 129 315 129 -fill $outline -tags {floor2 bg} - $w create line 176 133 315 133 -fill $outline -tags {floor2 bg} - $w create line 176 129 96 129 -fill $outline -tags {floor2 bg} - $w create line 3 133 96 133 -fill $outline -tags {floor2 bg} - $w create line 315 133 315 129 -fill $outline -tags {floor2 bg} - $w create line 176 133 176 129 -fill $outline -tags {floor2 bg} - $w create line 96 133 96 129 -fill $outline -tags {floor2 bg} + -tags $tags -fill $fill + $w create line 350 311 350 329 -fill $outline -tags $tags + $w create line 398 129 398 162 -fill $outline -tags $tags + $w create line 802 367 802 129 -fill $outline -tags $tags + $w create line 802 129 725 129 -fill $outline -tags $tags + $w create line 725 133 725 129 -fill $outline -tags $tags + $w create line 559 129 559 133 -fill $outline -tags $tags + $w create line 559 133 725 133 -fill $outline -tags $tags + $w create line 484 162 484 129 -fill $outline -tags $tags + $w create line 559 129 484 129 -fill $outline -tags $tags + $w create line 802 367 644 367 -fill $outline -tags $tags + $w create line 644 367 644 391 -fill $outline -tags $tags + $w create line 644 391 558 391 -fill $outline -tags $tags + $w create line 558 327 558 391 -fill $outline -tags $tags + $w create line 558 327 508 327 -fill $outline -tags $tags + $w create line 508 327 508 311 -fill $outline -tags $tags + $w create line 484 311 508 311 -fill $outline -tags $tags + $w create line 484 280 484 311 -fill $outline -tags $tags + $w create line 398 162 484 162 -fill $outline -tags $tags + $w create line 484 280 395 280 -fill $outline -tags $tags + $w create line 395 280 395 311 -fill $outline -tags $tags + $w create line 258 387 60 387 -fill $outline -tags $tags + $w create line 3 133 3 339 -fill $outline -tags $tags + $w create line 3 339 0 339 -fill $outline -tags $tags + $w create line 60 391 0 391 -fill $outline -tags $tags + $w create line 0 339 0 391 -fill $outline -tags $tags + $w create line 60 387 60 391 -fill $outline -tags $tags + $w create line 258 329 258 387 -fill $outline -tags $tags + $w create line 350 329 258 329 -fill $outline -tags $tags + $w create line 395 311 350 311 -fill $outline -tags $tags + $w create line 398 129 315 129 -fill $outline -tags $tags + $w create line 176 133 315 133 -fill $outline -tags $tags + $w create line 176 129 96 129 -fill $outline -tags $tags + $w create line 3 133 96 133 -fill $outline -tags $tags + $w create line 315 133 315 129 -fill $outline -tags $tags + $w create line 176 133 176 129 -fill $outline -tags $tags + $w create line 96 133 96 129 -fill $outline -tags $tags } # bg3 -- @@ -294,32 +297,34 @@ proc bg2 {w fill outline} { # outline - Color to use for the floor's outline. proc bg3 {w fill outline} { + set tags [list floor3 bg] + $w create poly 159 300 107 300 107 248 159 248 159 129 96 129 96 \ 133 21 133 21 331 0 331 0 391 60 391 60 370 159 370 159 300 \ - -tags {floor3 bg} -fill $fill + -tags $tags -fill $fill $w create poly 258 370 258 329 350 329 350 311 399 311 399 129 \ 315 129 315 133 176 133 176 129 159 129 159 370 258 370 \ - -tags {floor3 bg} -fill $fill - $w create line 96 133 96 129 -fill $outline -tags {floor3 bg} - $w create line 176 129 96 129 -fill $outline -tags {floor3 bg} - $w create line 176 129 176 133 -fill $outline -tags {floor3 bg} - $w create line 315 133 176 133 -fill $outline -tags {floor3 bg} - $w create line 315 133 315 129 -fill $outline -tags {floor3 bg} - $w create line 399 129 315 129 -fill $outline -tags {floor3 bg} - $w create line 399 311 399 129 -fill $outline -tags {floor3 bg} - $w create line 399 311 350 311 -fill $outline -tags {floor3 bg} - $w create line 350 329 350 311 -fill $outline -tags {floor3 bg} - $w create line 350 329 258 329 -fill $outline -tags {floor3 bg} - $w create line 258 370 258 329 -fill $outline -tags {floor3 bg} - $w create line 60 370 258 370 -fill $outline -tags {floor3 bg} - $w create line 60 370 60 391 -fill $outline -tags {floor3 bg} - $w create line 60 391 0 391 -fill $outline -tags {floor3 bg} - $w create line 0 391 0 331 -fill $outline -tags {floor3 bg} - $w create line 21 331 0 331 -fill $outline -tags {floor3 bg} - $w create line 21 331 21 133 -fill $outline -tags {floor3 bg} - $w create line 96 133 21 133 -fill $outline -tags {floor3 bg} + -tags $tags -fill $fill + $w create line 96 133 96 129 -fill $outline -tags $tags + $w create line 176 129 96 129 -fill $outline -tags $tags + $w create line 176 129 176 133 -fill $outline -tags $tags + $w create line 315 133 176 133 -fill $outline -tags $tags + $w create line 315 133 315 129 -fill $outline -tags $tags + $w create line 399 129 315 129 -fill $outline -tags $tags + $w create line 399 311 399 129 -fill $outline -tags $tags + $w create line 399 311 350 311 -fill $outline -tags $tags + $w create line 350 329 350 311 -fill $outline -tags $tags + $w create line 350 329 258 329 -fill $outline -tags $tags + $w create line 258 370 258 329 -fill $outline -tags $tags + $w create line 60 370 258 370 -fill $outline -tags $tags + $w create line 60 370 60 391 -fill $outline -tags $tags + $w create line 60 391 0 391 -fill $outline -tags $tags + $w create line 0 391 0 331 -fill $outline -tags $tags + $w create line 21 331 0 331 -fill $outline -tags $tags + $w create line 21 331 21 133 -fill $outline -tags $tags + $w create line 96 133 21 133 -fill $outline -tags $tags $w create line 107 300 159 300 159 248 107 248 107 300 \ - -fill $outline -tags {floor3 bg} + -fill $outline -tags $tags } # fg1 -- @@ -333,356 +338,360 @@ proc bg3 {w fill outline} { proc fg1 {w color} { global floorLabels floorItems - set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor1 room}] + set tags_room [list floor1 room] + set tags_label [list floor1 label] + set tags_wall [list floor1 wall] + + set i [$w create polygon 375 246 375 172 341 172 341 246 -fill "" -tags $tags_room] set floorLabels($i) 101 - set {floorItems(101)} $i - $w create text 358 209 -text 101 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor1 room}] - set floorLabels($i) {Pub Lift1} + set floorItems(101) $i + $w create text 358 209 -text 101 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 307 240 339 240 339 206 307 206 -fill "" -tags $tags_room] + set floorLabels($i) "Pub Lift1" set {floorItems(Pub Lift1)} $i - $w create text 323 223 -text {Pub Lift1} -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor1 room}] - set floorLabels($i) {Priv Lift1} + $w create text 323 223 -text "Pub Lift1" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 339 205 307 205 307 171 339 171 -fill "" -tags $tags_room] + set floorLabels($i) "Priv Lift1" set {floorItems(Priv Lift1)} $i - $w create text 323 188 -text {Priv Lift1} -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 42 389 42 337 1 337 1 389 -fill {} -tags {floor1 room}] + $w create text 323 188 -text "Priv Lift1" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 42 389 42 337 1 337 1 389 -fill "" -tags $tags_room] set floorLabels($i) 110 - set {floorItems(110)} $i - $w create text 21.5 363 -text 110 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 59 389 59 385 90 385 90 337 44 337 44 389 -fill {} -tags {floor1 room}] + set floorItems(110) $i + $w create text 21.5 363 -text 110 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 59 389 59 385 90 385 90 337 44 337 44 389 -fill "" -tags $tags_room] set floorLabels($i) 109 - set {floorItems(109)} $i - $w create text 67 363 -text 109 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 51 300 51 253 6 253 6 300 -fill {} -tags {floor1 room}] + set floorItems(109) $i + $w create text 67 363 -text 109 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 51 300 51 253 6 253 6 300 -fill "" -tags $tags_room] set floorLabels($i) 111 - set {floorItems(111)} $i - $w create text 28.5 276.5 -text 111 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 98 248 98 309 79 309 79 248 -fill {} -tags {floor1 room}] + set floorItems(111) $i + $w create text 28.5 276.5 -text 111 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 98 248 98 309 79 309 79 248 -fill "" -tags $tags_room] set floorLabels($i) 117B - set {floorItems(117B)} $i - $w create text 88.5 278.5 -text 117B -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 51 251 51 204 6 204 6 251 -fill {} -tags {floor1 room}] + set floorItems(117B) $i + $w create text 88.5 278.5 -text 117B -fill $color -anchor c -tags $tags_label + set i [$w create polygon 51 251 51 204 6 204 6 251 -fill "" -tags $tags_room] set floorLabels($i) 112 - set {floorItems(112)} $i - $w create text 28.5 227.5 -text 112 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 6 156 51 156 51 203 6 203 -fill {} -tags {floor1 room}] + set floorItems(112) $i + $w create text 28.5 227.5 -text 112 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 6 156 51 156 51 203 6 203 -fill "" -tags $tags_room] set floorLabels($i) 113 - set {floorItems(113)} $i - $w create text 28.5 179.5 -text 113 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 85 169 79 169 79 192 85 192 -fill {} -tags {floor1 room}] + set floorItems(113) $i + $w create text 28.5 179.5 -text 113 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 85 169 79 169 79 192 85 192 -fill "" -tags $tags_room] set floorLabels($i) 117A - set {floorItems(117A)} $i - $w create text 82 180.5 -text 117A -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 77 302 77 168 53 168 53 302 -fill {} -tags {floor1 room}] + set floorItems(117A) $i + $w create text 82 180.5 -text 117A -fill $color -anchor c -tags $tags_label + set i [$w create polygon 77 302 77 168 53 168 53 302 -fill "" -tags $tags_room] set floorLabels($i) 117 - set {floorItems(117)} $i - $w create text 65 235 -text 117 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 51 155 51 115 6 115 6 155 -fill {} -tags {floor1 room}] + set floorItems(117) $i + $w create text 65 235 -text 117 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 51 155 51 115 6 115 6 155 -fill "" -tags $tags_room] set floorLabels($i) 114 - set {floorItems(114)} $i - $w create text 28.5 135 -text 114 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 95 115 53 115 53 168 95 168 -fill {} -tags {floor1 room}] + set floorItems(114) $i + $w create text 28.5 135 -text 114 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 95 115 53 115 53 168 95 168 -fill "" -tags $tags_room] set floorLabels($i) 115 - set {floorItems(115)} $i - $w create text 74 141.5 -text 115 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 87 113 87 27 10 27 10 113 -fill {} -tags {floor1 room}] + set floorItems(115) $i + $w create text 74 141.5 -text 115 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 87 113 87 27 10 27 10 113 -fill "" -tags $tags_room] set floorLabels($i) 116 - set {floorItems(116)} $i - $w create text 48.5 70 -text 116 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 89 91 128 91 128 113 89 113 -fill {} -tags {floor1 room}] + set floorItems(116) $i + $w create text 48.5 70 -text 116 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 89 91 128 91 128 113 89 113 -fill "" -tags $tags_room] set floorLabels($i) 118 - set {floorItems(118)} $i - $w create text 108.5 102 -text 118 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 178 128 178 132 216 132 216 91 163 91 163 112 149 112 149 128 -fill {} -tags {floor1 room}] + set floorItems(118) $i + $w create text 108.5 102 -text 118 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 178 128 178 132 216 132 216 91 163 91 163 112 149 112 149 128 -fill "" -tags $tags_room] set floorLabels($i) 120 - set {floorItems(120)} $i - $w create text 189.5 111.5 -text 120 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 79 193 87 193 87 169 136 169 136 192 156 192 156 169 175 169 175 246 79 246 -fill {} -tags {floor1 room}] + set floorItems(120) $i + $w create text 189.5 111.5 -text 120 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 79 193 87 193 87 169 136 169 136 192 156 192 156 169 175 169 175 246 79 246 -fill "" -tags $tags_room] set floorLabels($i) 122 - set {floorItems(122)} $i - $w create text 131 207.5 -text 122 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 138 169 154 169 154 191 138 191 -fill {} -tags {floor1 room}] + set floorItems(122) $i + $w create text 131 207.5 -text 122 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 138 169 154 169 154 191 138 191 -fill "" -tags $tags_room] set floorLabels($i) 121 - set {floorItems(121)} $i - $w create text 146 180 -text 121 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 99 300 126 300 126 309 99 309 -fill {} -tags {floor1 room}] + set floorItems(121) $i + $w create text 146 180 -text 121 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 99 300 126 300 126 309 99 309 -fill "" -tags $tags_room] set floorLabels($i) 106A - set {floorItems(106A)} $i - $w create text 112.5 304.5 -text 106A -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 128 299 128 309 150 309 150 248 99 248 99 299 -fill {} -tags {floor1 room}] + set floorItems(106A) $i + $w create text 112.5 304.5 -text 106A -fill $color -anchor c -tags $tags_label + set i [$w create polygon 128 299 128 309 150 309 150 248 99 248 99 299 -fill "" -tags $tags_room] set floorLabels($i) 105 - set {floorItems(105)} $i - $w create text 124.5 278.5 -text 105 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 174 309 174 300 152 300 152 309 -fill {} -tags {floor1 room}] + set floorItems(105) $i + $w create text 124.5 278.5 -text 105 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 174 309 174 300 152 300 152 309 -fill "" -tags $tags_room] set floorLabels($i) 106B - set {floorItems(106B)} $i - $w create text 163 304.5 -text 106B -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 176 299 176 309 216 309 216 248 152 248 152 299 -fill {} -tags {floor1 room}] + set floorItems(106B) $i + $w create text 163 304.5 -text 106B -fill $color -anchor c -tags $tags_label + set i [$w create polygon 176 299 176 309 216 309 216 248 152 248 152 299 -fill "" -tags $tags_room] set floorLabels($i) 104 - set {floorItems(104)} $i - $w create text 184 278.5 -text 104 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 138 385 138 337 91 337 91 385 -fill {} -tags {floor1 room}] + set floorItems(104) $i + $w create text 184 278.5 -text 104 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 138 385 138 337 91 337 91 385 -fill "" -tags $tags_room] set floorLabels($i) 108 - set {floorItems(108)} $i - $w create text 114.5 361 -text 108 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 256 337 140 337 140 385 256 385 -fill {} -tags {floor1 room}] + set floorItems(108) $i + $w create text 114.5 361 -text 108 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 256 337 140 337 140 385 256 385 -fill "" -tags $tags_room] set floorLabels($i) 107 - set {floorItems(107)} $i - $w create text 198 361 -text 107 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 300 353 300 329 260 329 260 353 -fill {} -tags {floor1 room}] + set floorItems(107) $i + $w create text 198 361 -text 107 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 300 353 300 329 260 329 260 353 -fill "" -tags $tags_room] set floorLabels($i) Smoking - set {floorItems(Smoking)} $i - $w create text 280 341 -text Smoking -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 314 135 314 170 306 170 306 246 177 246 177 135 -fill {} -tags {floor1 room}] + set floorItems(Smoking) $i + $w create text 280 341 -text Smoking -fill $color -anchor c -tags $tags_label + set i [$w create polygon 314 135 314 170 306 170 306 246 177 246 177 135 -fill "" -tags $tags_room] set floorLabels($i) 123 - set {floorItems(123)} $i - $w create text 245.5 190.5 -text 123 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 217 248 301 248 301 326 257 326 257 310 217 310 -fill {} -tags {floor1 room}] + set floorItems(123) $i + $w create text 245.5 190.5 -text 123 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 217 248 301 248 301 326 257 326 257 310 217 310 -fill "" -tags $tags_room] set floorLabels($i) 103 - set {floorItems(103)} $i - $w create text 259 287 -text 103 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 396 188 377 188 377 169 316 169 316 131 396 131 -fill {} -tags {floor1 room}] + set floorItems(103) $i + $w create text 259 287 -text 103 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 396 188 377 188 377 169 316 169 316 131 396 131 -fill "" -tags $tags_room] set floorLabels($i) 124 - set {floorItems(124)} $i - $w create text 356 150 -text 124 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 397 226 407 226 407 189 377 189 377 246 397 246 -fill {} -tags {floor1 room}] + set floorItems(124) $i + $w create text 356 150 -text 124 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 397 226 407 226 407 189 377 189 377 246 397 246 -fill "" -tags $tags_room] set floorLabels($i) 125 - set {floorItems(125)} $i - $w create text 392 217.5 -text 125 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 399 187 409 187 409 207 474 207 474 164 399 164 -fill {} -tags {floor1 room}] + set floorItems(125) $i + $w create text 392 217.5 -text 125 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 399 187 409 187 409 207 474 207 474 164 399 164 -fill "" -tags $tags_room] set floorLabels($i) 126 - set {floorItems(126)} $i - $w create text 436.5 185.5 -text 126 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 409 209 409 229 399 229 399 253 486 253 486 239 474 239 474 209 -fill {} -tags {floor1 room}] + set floorItems(126) $i + $w create text 436.5 185.5 -text 126 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 409 209 409 229 399 229 399 253 486 253 486 239 474 239 474 209 -fill "" -tags $tags_room] set floorLabels($i) 127 - set {floorItems(127)} $i - $w create text 436.5 231 -text 127 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 501 164 501 174 495 174 495 188 490 188 490 204 476 204 476 164 -fill {} -tags {floor1 room}] + set floorItems(127) $i + $w create text 436.5 231 -text 127 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 501 164 501 174 495 174 495 188 490 188 490 204 476 204 476 164 -fill "" -tags $tags_room] set floorLabels($i) MShower - set {floorItems(MShower)} $i - $w create text 488.5 184 -text MShower -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 497 176 513 176 513 204 492 204 492 190 497 190 -fill {} -tags {floor1 room}] + set floorItems(MShower) $i + $w create text 488.5 184 -text MShower -fill $color -anchor c -tags $tags_label + set i [$w create polygon 497 176 513 176 513 204 492 204 492 190 497 190 -fill "" -tags $tags_room] set floorLabels($i) Closet - set {floorItems(Closet)} $i - $w create text 502.5 190 -text Closet -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 476 237 476 206 513 206 513 254 488 254 488 237 -fill {} -tags {floor1 room}] + set floorItems(Closet) $i + $w create text 502.5 190 -text Closet -fill $color -anchor c -tags $tags_label + set i [$w create polygon 476 237 476 206 513 206 513 254 488 254 488 237 -fill "" -tags $tags_room] set floorLabels($i) WShower - set {floorItems(WShower)} $i - $w create text 494.5 230 -text WShower -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 486 131 558 131 558 135 724 135 724 166 697 166 697 275 553 275 531 254 515 254 515 174 503 174 503 161 486 161 -fill {} -tags {floor1 room}] + set floorItems(WShower) $i + $w create text 494.5 230 -text WShower -fill $color -anchor c -tags $tags_label + set i [$w create polygon 486 131 558 131 558 135 724 135 724 166 697 166 697 275 553 275 531 254 515 254 515 174 503 174 503 161 486 161 -fill "" -tags $tags_room] set floorLabels($i) 130 - set {floorItems(130)} $i - $w create text 638.5 205 -text 130 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 308 242 339 242 339 248 342 248 342 246 397 246 397 276 393 276 393 309 300 309 300 248 308 248 -fill {} -tags {floor1 room}] + set floorItems(130) $i + $w create text 638.5 205 -text 130 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 308 242 339 242 339 248 342 248 342 246 397 246 397 276 393 276 393 309 300 309 300 248 308 248 -fill "" -tags $tags_room] set floorLabels($i) 102 - set {floorItems(102)} $i - $w create text 367.5 278.5 -text 102 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 397 255 486 255 486 276 397 276 -fill {} -tags {floor1 room}] + set floorItems(102) $i + $w create text 367.5 278.5 -text 102 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 397 255 486 255 486 276 397 276 -fill "" -tags $tags_room] set floorLabels($i) 128 - set {floorItems(128)} $i - $w create text 441.5 265.5 -text 128 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 510 309 486 309 486 255 530 255 552 277 561 277 561 325 510 325 -fill {} -tags {floor1 room}] + set floorItems(128) $i + $w create text 441.5 265.5 -text 128 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 510 309 486 309 486 255 530 255 552 277 561 277 561 325 510 325 -fill "" -tags $tags_room] set floorLabels($i) 129 - set {floorItems(129)} $i - $w create text 535.5 293 -text 129 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 696 281 740 281 740 387 642 387 642 389 561 389 561 277 696 277 -fill {} -tags {floor1 room}] + set floorItems(129) $i + $w create text 535.5 293 -text 129 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 696 281 740 281 740 387 642 387 642 389 561 389 561 277 696 277 -fill "" -tags $tags_room] set floorLabels($i) 133 - set {floorItems(133)} $i - $w create text 628.5 335 -text 133 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 742 387 742 281 800 281 800 387 -fill {} -tags {floor1 room}] + set floorItems(133) $i + $w create text 628.5 335 -text 133 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 742 387 742 281 800 281 800 387 -fill "" -tags $tags_room] set floorLabels($i) 132 - set {floorItems(132)} $i - $w create text 771 334 -text 132 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 800 168 800 280 699 280 699 168 -fill {} -tags {floor1 room}] + set floorItems(132) $i + $w create text 771 334 -text 132 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 800 168 800 280 699 280 699 168 -fill "" -tags $tags_room] set floorLabels($i) 134 - set {floorItems(134)} $i - $w create text 749.5 224 -text 134 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 726 131 726 166 800 166 800 131 -fill {} -tags {floor1 room}] + set floorItems(134) $i + $w create text 749.5 224 -text 134 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 726 131 726 166 800 166 800 131 -fill "" -tags $tags_room] set floorLabels($i) 135 - set {floorItems(135)} $i - $w create text 763 148.5 -text 135 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 340 360 335 363 331 365 326 366 304 366 304 312 396 312 396 288 400 288 404 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 342 331 347 332 351 334 354 336 357 341 359 -fill {} -tags {floor1 room}] - set floorLabels($i) {Ramona Stair} + set floorItems(135) $i + $w create text 763 148.5 -text 135 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 340 360 335 363 331 365 326 366 304 366 304 312 396 312 396 288 400 288 404 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 342 331 347 332 351 334 354 336 357 341 359 -fill "" -tags $tags_room] + set floorLabels($i) "Ramona Stair" set {floorItems(Ramona Stair)} $i - $w create text 368 323 -text {Ramona Stair} -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 30 23 30 5 93 5 98 5 104 7 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 87 90 87 90 23 -fill {} -tags {floor1 room}] - set floorLabels($i) {University Stair} + $w create text 368 323 -text "Ramona Stair" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 30 23 30 5 93 5 98 5 104 7 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 87 90 87 90 23 -fill "" -tags $tags_room] + set floorLabels($i) "University Stair" set {floorItems(University Stair)} $i - $w create text 155 77.5 -text {University Stair} -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 282 37 295 40 312 49 323 56 337 70 352 56 358 48 363 39 365 29 348 25 335 22 321 14 300 5 283 1 260 0 246 0 242 2 236 4 231 8 227 13 223 17 221 22 220 34 260 34 -fill {} -tags {floor1 room}] - set floorLabels($i) {Plaza Stair} + $w create text 155 77.5 -text "University Stair" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 282 37 295 40 312 49 323 56 337 70 352 56 358 48 363 39 365 29 348 25 335 22 321 14 300 5 283 1 260 0 246 0 242 2 236 4 231 8 227 13 223 17 221 22 220 34 260 34 -fill "" -tags $tags_room] + set floorLabels($i) "Plaza Stair" set {floorItems(Plaza Stair)} $i - $w create text 317.5 28.5 -text {Plaza Stair} -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 220 34 260 34 282 37 295 40 312 49 323 56 337 70 350 83 365 94 377 100 386 104 386 128 220 128 -fill {} -tags {floor1 room}] - set floorLabels($i) {Plaza Deck} + $w create text 317.5 28.5 -text "Plaza Stair" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 220 34 260 34 282 37 295 40 312 49 323 56 337 70 350 83 365 94 377 100 386 104 386 128 220 128 -fill "" -tags $tags_room] + set floorLabels($i) "Plaza Deck" set {floorItems(Plaza Deck)} $i - $w create text 303 81 -text {Plaza Deck} -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 257 336 77 336 6 336 6 301 77 301 77 310 257 310 -fill {} -tags {floor1 room}] + $w create text 303 81 -text "Plaza Deck" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 257 336 77 336 6 336 6 301 77 301 77 310 257 310 -fill "" -tags $tags_room] set floorLabels($i) 106 - set {floorItems(106)} $i - $w create text 131.5 318.5 -text 106 -fill $color -anchor c -tags {floor1 label} - set i [$w create polygon 146 110 162 110 162 91 130 91 130 115 95 115 95 128 114 128 114 151 157 151 157 153 112 153 112 130 97 130 97 168 175 168 175 131 146 131 -fill {} -tags {floor1 room}] + set floorItems(106) $i + $w create text 131.5 318.5 -text 106 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 146 110 162 110 162 91 130 91 130 115 95 115 95 128 114 128 114 151 157 151 157 153 112 153 112 130 97 130 97 168 175 168 175 131 146 131 -fill "" -tags $tags_room] set floorLabels($i) 119 - set {floorItems(119)} $i - $w create text 143.5 133 -text 119 -fill $color -anchor c -tags {floor1 label} - $w create line 155 191 155 189 -fill $color -tags {floor1 wall} - $w create line 155 177 155 169 -fill $color -tags {floor1 wall} - $w create line 96 129 96 169 -fill $color -tags {floor1 wall} - $w create line 78 169 176 169 -fill $color -tags {floor1 wall} - $w create line 176 247 176 129 -fill $color -tags {floor1 wall} - $w create line 340 206 307 206 -fill $color -tags {floor1 wall} - $w create line 340 187 340 170 -fill $color -tags {floor1 wall} - $w create line 340 210 340 201 -fill $color -tags {floor1 wall} - $w create line 340 247 340 224 -fill $color -tags {floor1 wall} - $w create line 340 241 307 241 -fill $color -tags {floor1 wall} - $w create line 376 246 376 170 -fill $color -tags {floor1 wall} - $w create line 307 247 307 170 -fill $color -tags {floor1 wall} - $w create line 376 170 307 170 -fill $color -tags {floor1 wall} - $w create line 315 129 315 170 -fill $color -tags {floor1 wall} - $w create line 147 129 176 129 -fill $color -tags {floor1 wall} - $w create line 202 133 176 133 -fill $color -tags {floor1 wall} - $w create line 398 129 315 129 -fill $color -tags {floor1 wall} - $w create line 258 352 258 387 -fill $color -tags {floor1 wall} - $w create line 60 387 60 391 -fill $color -tags {floor1 wall} - $w create line 0 337 0 391 -fill $color -tags {floor1 wall} - $w create line 60 391 0 391 -fill $color -tags {floor1 wall} - $w create line 3 114 3 337 -fill $color -tags {floor1 wall} - $w create line 258 387 60 387 -fill $color -tags {floor1 wall} - $w create line 52 237 52 273 -fill $color -tags {floor1 wall} - $w create line 52 189 52 225 -fill $color -tags {floor1 wall} - $w create line 52 140 52 177 -fill $color -tags {floor1 wall} - $w create line 395 306 395 311 -fill $color -tags {floor1 wall} - $w create line 531 254 398 254 -fill $color -tags {floor1 wall} - $w create line 475 178 475 238 -fill $color -tags {floor1 wall} - $w create line 502 162 398 162 -fill $color -tags {floor1 wall} - $w create line 398 129 398 188 -fill $color -tags {floor1 wall} - $w create line 383 188 376 188 -fill $color -tags {floor1 wall} - $w create line 408 188 408 194 -fill $color -tags {floor1 wall} - $w create line 398 227 398 254 -fill $color -tags {floor1 wall} - $w create line 408 227 398 227 -fill $color -tags {floor1 wall} - $w create line 408 222 408 227 -fill $color -tags {floor1 wall} - $w create line 408 206 408 210 -fill $color -tags {floor1 wall} - $w create line 408 208 475 208 -fill $color -tags {floor1 wall} - $w create line 484 278 484 311 -fill $color -tags {floor1 wall} - $w create line 484 311 508 311 -fill $color -tags {floor1 wall} - $w create line 508 327 508 311 -fill $color -tags {floor1 wall} - $w create line 559 327 508 327 -fill $color -tags {floor1 wall} - $w create line 644 391 559 391 -fill $color -tags {floor1 wall} - $w create line 644 389 644 391 -fill $color -tags {floor1 wall} - $w create line 514 205 475 205 -fill $color -tags {floor1 wall} - $w create line 496 189 496 187 -fill $color -tags {floor1 wall} - $w create line 559 129 484 129 -fill $color -tags {floor1 wall} - $w create line 484 162 484 129 -fill $color -tags {floor1 wall} - $w create line 725 133 559 133 -fill $color -tags {floor1 wall} - $w create line 559 129 559 133 -fill $color -tags {floor1 wall} - $w create line 725 149 725 167 -fill $color -tags {floor1 wall} - $w create line 725 129 802 129 -fill $color -tags {floor1 wall} - $w create line 802 389 802 129 -fill $color -tags {floor1 wall} - $w create line 739 167 802 167 -fill $color -tags {floor1 wall} - $w create line 396 188 408 188 -fill $color -tags {floor1 wall} - $w create line 0 337 9 337 -fill $color -tags {floor1 wall} - $w create line 58 337 21 337 -fill $color -tags {floor1 wall} - $w create line 43 391 43 337 -fill $color -tags {floor1 wall} - $w create line 105 337 75 337 -fill $color -tags {floor1 wall} - $w create line 91 387 91 337 -fill $color -tags {floor1 wall} - $w create line 154 337 117 337 -fill $color -tags {floor1 wall} - $w create line 139 387 139 337 -fill $color -tags {floor1 wall} - $w create line 227 337 166 337 -fill $color -tags {floor1 wall} - $w create line 258 337 251 337 -fill $color -tags {floor1 wall} - $w create line 258 328 302 328 -fill $color -tags {floor1 wall} - $w create line 302 355 302 311 -fill $color -tags {floor1 wall} - $w create line 395 311 302 311 -fill $color -tags {floor1 wall} - $w create line 484 278 395 278 -fill $color -tags {floor1 wall} - $w create line 395 294 395 278 -fill $color -tags {floor1 wall} - $w create line 473 278 473 275 -fill $color -tags {floor1 wall} - $w create line 473 256 473 254 -fill $color -tags {floor1 wall} - $w create line 533 257 531 254 -fill $color -tags {floor1 wall} - $w create line 553 276 551 274 -fill $color -tags {floor1 wall} - $w create line 698 276 553 276 -fill $color -tags {floor1 wall} - $w create line 559 391 559 327 -fill $color -tags {floor1 wall} - $w create line 802 389 644 389 -fill $color -tags {floor1 wall} - $w create line 741 314 741 389 -fill $color -tags {floor1 wall} - $w create line 698 280 698 167 -fill $color -tags {floor1 wall} - $w create line 707 280 698 280 -fill $color -tags {floor1 wall} - $w create line 802 280 731 280 -fill $color -tags {floor1 wall} - $w create line 741 280 741 302 -fill $color -tags {floor1 wall} - $w create line 698 167 727 167 -fill $color -tags {floor1 wall} - $w create line 725 137 725 129 -fill $color -tags {floor1 wall} - $w create line 514 254 514 175 -fill $color -tags {floor1 wall} - $w create line 496 175 514 175 -fill $color -tags {floor1 wall} - $w create line 502 175 502 162 -fill $color -tags {floor1 wall} - $w create line 475 166 475 162 -fill $color -tags {floor1 wall} - $w create line 496 176 496 175 -fill $color -tags {floor1 wall} - $w create line 491 189 496 189 -fill $color -tags {floor1 wall} - $w create line 491 205 491 189 -fill $color -tags {floor1 wall} - $w create line 487 238 475 238 -fill $color -tags {floor1 wall} - $w create line 487 240 487 238 -fill $color -tags {floor1 wall} - $w create line 487 252 487 254 -fill $color -tags {floor1 wall} - $w create line 315 133 304 133 -fill $color -tags {floor1 wall} - $w create line 256 133 280 133 -fill $color -tags {floor1 wall} - $w create line 78 247 270 247 -fill $color -tags {floor1 wall} - $w create line 307 247 294 247 -fill $color -tags {floor1 wall} - $w create line 214 133 232 133 -fill $color -tags {floor1 wall} - $w create line 217 247 217 266 -fill $color -tags {floor1 wall} - $w create line 217 309 217 291 -fill $color -tags {floor1 wall} - $w create line 217 309 172 309 -fill $color -tags {floor1 wall} - $w create line 154 309 148 309 -fill $color -tags {floor1 wall} - $w create line 175 300 175 309 -fill $color -tags {floor1 wall} - $w create line 151 300 175 300 -fill $color -tags {floor1 wall} - $w create line 151 247 151 309 -fill $color -tags {floor1 wall} - $w create line 78 237 78 265 -fill $color -tags {floor1 wall} - $w create line 78 286 78 309 -fill $color -tags {floor1 wall} - $w create line 106 309 78 309 -fill $color -tags {floor1 wall} - $w create line 130 309 125 309 -fill $color -tags {floor1 wall} - $w create line 99 309 99 247 -fill $color -tags {floor1 wall} - $w create line 127 299 99 299 -fill $color -tags {floor1 wall} - $w create line 127 309 127 299 -fill $color -tags {floor1 wall} - $w create line 155 191 137 191 -fill $color -tags {floor1 wall} - $w create line 137 169 137 191 -fill $color -tags {floor1 wall} - $w create line 78 171 78 169 -fill $color -tags {floor1 wall} - $w create line 78 190 78 218 -fill $color -tags {floor1 wall} - $w create line 86 192 86 169 -fill $color -tags {floor1 wall} - $w create line 86 192 78 192 -fill $color -tags {floor1 wall} - $w create line 52 301 3 301 -fill $color -tags {floor1 wall} - $w create line 52 286 52 301 -fill $color -tags {floor1 wall} - $w create line 52 252 3 252 -fill $color -tags {floor1 wall} - $w create line 52 203 3 203 -fill $color -tags {floor1 wall} - $w create line 3 156 52 156 -fill $color -tags {floor1 wall} - $w create line 8 25 8 114 -fill $color -tags {floor1 wall} - $w create line 63 114 3 114 -fill $color -tags {floor1 wall} - $w create line 75 114 97 114 -fill $color -tags {floor1 wall} - $w create line 108 114 129 114 -fill $color -tags {floor1 wall} - $w create line 129 114 129 89 -fill $color -tags {floor1 wall} - $w create line 52 114 52 128 -fill $color -tags {floor1 wall} - $w create line 132 89 88 89 -fill $color -tags {floor1 wall} - $w create line 88 25 88 89 -fill $color -tags {floor1 wall} - $w create line 88 114 88 89 -fill $color -tags {floor1 wall} - $w create line 218 89 144 89 -fill $color -tags {floor1 wall} - $w create line 147 111 147 129 -fill $color -tags {floor1 wall} - $w create line 162 111 147 111 -fill $color -tags {floor1 wall} - $w create line 162 109 162 111 -fill $color -tags {floor1 wall} - $w create line 162 96 162 89 -fill $color -tags {floor1 wall} - $w create line 218 89 218 94 -fill $color -tags {floor1 wall} - $w create line 218 89 218 119 -fill $color -tags {floor1 wall} - $w create line 8 25 88 25 -fill $color -tags {floor1 wall} - $w create line 258 337 258 328 -fill $color -tags {floor1 wall} - $w create line 113 129 96 129 -fill $color -tags {floor1 wall} - $w create line 302 355 258 355 -fill $color -tags {floor1 wall} - $w create line 386 104 386 129 -fill $color -tags {floor1 wall} - $w create line 377 100 386 104 -fill $color -tags {floor1 wall} - $w create line 365 94 377 100 -fill $color -tags {floor1 wall} - $w create line 350 83 365 94 -fill $color -tags {floor1 wall} - $w create line 337 70 350 83 -fill $color -tags {floor1 wall} - $w create line 337 70 323 56 -fill $color -tags {floor1 wall} - $w create line 312 49 323 56 -fill $color -tags {floor1 wall} - $w create line 295 40 312 49 -fill $color -tags {floor1 wall} - $w create line 282 37 295 40 -fill $color -tags {floor1 wall} - $w create line 260 34 282 37 -fill $color -tags {floor1 wall} - $w create line 253 34 260 34 -fill $color -tags {floor1 wall} - $w create line 386 128 386 104 -fill $color -tags {floor1 wall} - $w create line 113 152 156 152 -fill $color -tags {floor1 wall} - $w create line 113 152 156 152 -fill $color -tags {floor1 wall} - $w create line 113 152 113 129 -fill $color -tags {floor1 wall} + set floorItems(119) $i + $w create text 143.5 133 -text 119 -fill $color -anchor c -tags $tags_label + $w create line 155 191 155 189 -fill $color -tags $tags_wall + $w create line 155 177 155 169 -fill $color -tags $tags_wall + $w create line 96 129 96 169 -fill $color -tags $tags_wall + $w create line 78 169 176 169 -fill $color -tags $tags_wall + $w create line 176 247 176 129 -fill $color -tags $tags_wall + $w create line 340 206 307 206 -fill $color -tags $tags_wall + $w create line 340 187 340 170 -fill $color -tags $tags_wall + $w create line 340 210 340 201 -fill $color -tags $tags_wall + $w create line 340 247 340 224 -fill $color -tags $tags_wall + $w create line 340 241 307 241 -fill $color -tags $tags_wall + $w create line 376 246 376 170 -fill $color -tags $tags_wall + $w create line 307 247 307 170 -fill $color -tags $tags_wall + $w create line 376 170 307 170 -fill $color -tags $tags_wall + $w create line 315 129 315 170 -fill $color -tags $tags_wall + $w create line 147 129 176 129 -fill $color -tags $tags_wall + $w create line 202 133 176 133 -fill $color -tags $tags_wall + $w create line 398 129 315 129 -fill $color -tags $tags_wall + $w create line 258 352 258 387 -fill $color -tags $tags_wall + $w create line 60 387 60 391 -fill $color -tags $tags_wall + $w create line 0 337 0 391 -fill $color -tags $tags_wall + $w create line 60 391 0 391 -fill $color -tags $tags_wall + $w create line 3 114 3 337 -fill $color -tags $tags_wall + $w create line 258 387 60 387 -fill $color -tags $tags_wall + $w create line 52 237 52 273 -fill $color -tags $tags_wall + $w create line 52 189 52 225 -fill $color -tags $tags_wall + $w create line 52 140 52 177 -fill $color -tags $tags_wall + $w create line 395 306 395 311 -fill $color -tags $tags_wall + $w create line 531 254 398 254 -fill $color -tags $tags_wall + $w create line 475 178 475 238 -fill $color -tags $tags_wall + $w create line 502 162 398 162 -fill $color -tags $tags_wall + $w create line 398 129 398 188 -fill $color -tags $tags_wall + $w create line 383 188 376 188 -fill $color -tags $tags_wall + $w create line 408 188 408 194 -fill $color -tags $tags_wall + $w create line 398 227 398 254 -fill $color -tags $tags_wall + $w create line 408 227 398 227 -fill $color -tags $tags_wall + $w create line 408 222 408 227 -fill $color -tags $tags_wall + $w create line 408 206 408 210 -fill $color -tags $tags_wall + $w create line 408 208 475 208 -fill $color -tags $tags_wall + $w create line 484 278 484 311 -fill $color -tags $tags_wall + $w create line 484 311 508 311 -fill $color -tags $tags_wall + $w create line 508 327 508 311 -fill $color -tags $tags_wall + $w create line 559 327 508 327 -fill $color -tags $tags_wall + $w create line 644 391 559 391 -fill $color -tags $tags_wall + $w create line 644 389 644 391 -fill $color -tags $tags_wall + $w create line 514 205 475 205 -fill $color -tags $tags_wall + $w create line 496 189 496 187 -fill $color -tags $tags_wall + $w create line 559 129 484 129 -fill $color -tags $tags_wall + $w create line 484 162 484 129 -fill $color -tags $tags_wall + $w create line 725 133 559 133 -fill $color -tags $tags_wall + $w create line 559 129 559 133 -fill $color -tags $tags_wall + $w create line 725 149 725 167 -fill $color -tags $tags_wall + $w create line 725 129 802 129 -fill $color -tags $tags_wall + $w create line 802 389 802 129 -fill $color -tags $tags_wall + $w create line 739 167 802 167 -fill $color -tags $tags_wall + $w create line 396 188 408 188 -fill $color -tags $tags_wall + $w create line 0 337 9 337 -fill $color -tags $tags_wall + $w create line 58 337 21 337 -fill $color -tags $tags_wall + $w create line 43 391 43 337 -fill $color -tags $tags_wall + $w create line 105 337 75 337 -fill $color -tags $tags_wall + $w create line 91 387 91 337 -fill $color -tags $tags_wall + $w create line 154 337 117 337 -fill $color -tags $tags_wall + $w create line 139 387 139 337 -fill $color -tags $tags_wall + $w create line 227 337 166 337 -fill $color -tags $tags_wall + $w create line 258 337 251 337 -fill $color -tags $tags_wall + $w create line 258 328 302 328 -fill $color -tags $tags_wall + $w create line 302 355 302 311 -fill $color -tags $tags_wall + $w create line 395 311 302 311 -fill $color -tags $tags_wall + $w create line 484 278 395 278 -fill $color -tags $tags_wall + $w create line 395 294 395 278 -fill $color -tags $tags_wall + $w create line 473 278 473 275 -fill $color -tags $tags_wall + $w create line 473 256 473 254 -fill $color -tags $tags_wall + $w create line 533 257 531 254 -fill $color -tags $tags_wall + $w create line 553 276 551 274 -fill $color -tags $tags_wall + $w create line 698 276 553 276 -fill $color -tags $tags_wall + $w create line 559 391 559 327 -fill $color -tags $tags_wall + $w create line 802 389 644 389 -fill $color -tags $tags_wall + $w create line 741 314 741 389 -fill $color -tags $tags_wall + $w create line 698 280 698 167 -fill $color -tags $tags_wall + $w create line 707 280 698 280 -fill $color -tags $tags_wall + $w create line 802 280 731 280 -fill $color -tags $tags_wall + $w create line 741 280 741 302 -fill $color -tags $tags_wall + $w create line 698 167 727 167 -fill $color -tags $tags_wall + $w create line 725 137 725 129 -fill $color -tags $tags_wall + $w create line 514 254 514 175 -fill $color -tags $tags_wall + $w create line 496 175 514 175 -fill $color -tags $tags_wall + $w create line 502 175 502 162 -fill $color -tags $tags_wall + $w create line 475 166 475 162 -fill $color -tags $tags_wall + $w create line 496 176 496 175 -fill $color -tags $tags_wall + $w create line 491 189 496 189 -fill $color -tags $tags_wall + $w create line 491 205 491 189 -fill $color -tags $tags_wall + $w create line 487 238 475 238 -fill $color -tags $tags_wall + $w create line 487 240 487 238 -fill $color -tags $tags_wall + $w create line 487 252 487 254 -fill $color -tags $tags_wall + $w create line 315 133 304 133 -fill $color -tags $tags_wall + $w create line 256 133 280 133 -fill $color -tags $tags_wall + $w create line 78 247 270 247 -fill $color -tags $tags_wall + $w create line 307 247 294 247 -fill $color -tags $tags_wall + $w create line 214 133 232 133 -fill $color -tags $tags_wall + $w create line 217 247 217 266 -fill $color -tags $tags_wall + $w create line 217 309 217 291 -fill $color -tags $tags_wall + $w create line 217 309 172 309 -fill $color -tags $tags_wall + $w create line 154 309 148 309 -fill $color -tags $tags_wall + $w create line 175 300 175 309 -fill $color -tags $tags_wall + $w create line 151 300 175 300 -fill $color -tags $tags_wall + $w create line 151 247 151 309 -fill $color -tags $tags_wall + $w create line 78 237 78 265 -fill $color -tags $tags_wall + $w create line 78 286 78 309 -fill $color -tags $tags_wall + $w create line 106 309 78 309 -fill $color -tags $tags_wall + $w create line 130 309 125 309 -fill $color -tags $tags_wall + $w create line 99 309 99 247 -fill $color -tags $tags_wall + $w create line 127 299 99 299 -fill $color -tags $tags_wall + $w create line 127 309 127 299 -fill $color -tags $tags_wall + $w create line 155 191 137 191 -fill $color -tags $tags_wall + $w create line 137 169 137 191 -fill $color -tags $tags_wall + $w create line 78 171 78 169 -fill $color -tags $tags_wall + $w create line 78 190 78 218 -fill $color -tags $tags_wall + $w create line 86 192 86 169 -fill $color -tags $tags_wall + $w create line 86 192 78 192 -fill $color -tags $tags_wall + $w create line 52 301 3 301 -fill $color -tags $tags_wall + $w create line 52 286 52 301 -fill $color -tags $tags_wall + $w create line 52 252 3 252 -fill $color -tags $tags_wall + $w create line 52 203 3 203 -fill $color -tags $tags_wall + $w create line 3 156 52 156 -fill $color -tags $tags_wall + $w create line 8 25 8 114 -fill $color -tags $tags_wall + $w create line 63 114 3 114 -fill $color -tags $tags_wall + $w create line 75 114 97 114 -fill $color -tags $tags_wall + $w create line 108 114 129 114 -fill $color -tags $tags_wall + $w create line 129 114 129 89 -fill $color -tags $tags_wall + $w create line 52 114 52 128 -fill $color -tags $tags_wall + $w create line 132 89 88 89 -fill $color -tags $tags_wall + $w create line 88 25 88 89 -fill $color -tags $tags_wall + $w create line 88 114 88 89 -fill $color -tags $tags_wall + $w create line 218 89 144 89 -fill $color -tags $tags_wall + $w create line 147 111 147 129 -fill $color -tags $tags_wall + $w create line 162 111 147 111 -fill $color -tags $tags_wall + $w create line 162 109 162 111 -fill $color -tags $tags_wall + $w create line 162 96 162 89 -fill $color -tags $tags_wall + $w create line 218 89 218 94 -fill $color -tags $tags_wall + $w create line 218 89 218 119 -fill $color -tags $tags_wall + $w create line 8 25 88 25 -fill $color -tags $tags_wall + $w create line 258 337 258 328 -fill $color -tags $tags_wall + $w create line 113 129 96 129 -fill $color -tags $tags_wall + $w create line 302 355 258 355 -fill $color -tags $tags_wall + $w create line 386 104 386 129 -fill $color -tags $tags_wall + $w create line 377 100 386 104 -fill $color -tags $tags_wall + $w create line 365 94 377 100 -fill $color -tags $tags_wall + $w create line 350 83 365 94 -fill $color -tags $tags_wall + $w create line 337 70 350 83 -fill $color -tags $tags_wall + $w create line 337 70 323 56 -fill $color -tags $tags_wall + $w create line 312 49 323 56 -fill $color -tags $tags_wall + $w create line 295 40 312 49 -fill $color -tags $tags_wall + $w create line 282 37 295 40 -fill $color -tags $tags_wall + $w create line 260 34 282 37 -fill $color -tags $tags_wall + $w create line 253 34 260 34 -fill $color -tags $tags_wall + $w create line 386 128 386 104 -fill $color -tags $tags_wall + $w create line 113 152 156 152 -fill $color -tags $tags_wall + $w create line 113 152 156 152 -fill $color -tags $tags_wall + $w create line 113 152 113 129 -fill $color -tags $tags_wall } # fg2 -- @@ -696,363 +705,367 @@ proc fg1 {w color} { proc fg2 {w color} { global floorLabels floorItems - set i [$w create polygon 748 188 755 188 755 205 758 205 758 222 800 222 800 168 748 168 -fill {} -tags {floor2 room}] + set tags_room [list floor2 room] + set tags_label [list floor2 label] + set tags_wall [list floor2 wall] + + set i [$w create polygon 748 188 755 188 755 205 758 205 758 222 800 222 800 168 748 168 -fill "" -tags $tags_room] set floorLabels($i) 238 - set {floorItems(238)} $i - $w create text 774 195 -text 238 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 726 188 746 188 746 166 800 166 800 131 726 131 -fill {} -tags {floor2 room}] + set floorItems(238) $i + $w create text 774 195 -text 238 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 726 188 746 188 746 166 800 166 800 131 726 131 -fill "" -tags $tags_room] set floorLabels($i) 237 - set {floorItems(237)} $i - $w create text 763 148.5 -text 237 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 497 187 497 204 559 204 559 324 641 324 643 324 643 291 641 291 641 205 696 205 696 291 694 291 694 314 715 314 715 291 715 205 755 205 755 190 724 190 724 187 -fill {} -tags {floor2 room}] + set floorItems(237) $i + $w create text 763 148.5 -text 237 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 497 187 497 204 559 204 559 324 641 324 643 324 643 291 641 291 641 205 696 205 696 291 694 291 694 314 715 314 715 291 715 205 755 205 755 190 724 190 724 187 -fill "" -tags $tags_room] set floorLabels($i) 246 - set {floorItems(246)} $i - $w create text 600 264 -text 246 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 694 279 643 279 643 314 694 314 -fill {} -tags {floor2 room}] + set floorItems(246) $i + $w create text 600 264 -text 246 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 694 279 643 279 643 314 694 314 -fill "" -tags $tags_room] set floorLabels($i) 247 - set {floorItems(247)} $i - $w create text 668.5 296.5 -text 247 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 232 250 308 250 308 242 339 242 339 246 397 246 397 255 476 255 476 250 482 250 559 250 559 274 482 274 482 278 396 278 396 274 232 274 -fill {} -tags {floor2 room}] + set floorItems(247) $i + $w create text 668.5 296.5 -text 247 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 232 250 308 250 308 242 339 242 339 246 397 246 397 255 476 255 476 250 482 250 559 250 559 274 482 274 482 278 396 278 396 274 232 274 -fill "" -tags $tags_room] set floorLabels($i) 202 - set {floorItems(202)} $i - $w create text 285.5 260 -text 202 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 53 228 53 338 176 338 233 338 233 196 306 196 306 180 175 180 175 169 156 169 156 196 176 196 176 228 -fill {} -tags {floor2 room}] + set floorItems(202) $i + $w create text 285.5 260 -text 202 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 53 228 53 338 176 338 233 338 233 196 306 196 306 180 175 180 175 169 156 169 156 196 176 196 176 228 -fill "" -tags $tags_room] set floorLabels($i) 206 - set {floorItems(206)} $i - $w create text 143 267 -text 206 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 51 277 6 277 6 338 51 338 -fill {} -tags {floor2 room}] + set floorItems(206) $i + $w create text 143 267 -text 206 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 51 277 6 277 6 338 51 338 -fill "" -tags $tags_room] set floorLabels($i) 212 - set {floorItems(212)} $i - $w create text 28.5 307.5 -text 212 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 557 276 486 276 486 309 510 309 510 325 557 325 -fill {} -tags {floor2 room}] + set floorItems(212) $i + $w create text 28.5 307.5 -text 212 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 557 276 486 276 486 309 510 309 510 325 557 325 -fill "" -tags $tags_room] set floorLabels($i) 245 - set {floorItems(245)} $i - $w create text 521.5 300.5 -text 245 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 560 389 599 389 599 326 560 326 -fill {} -tags {floor2 room}] + set floorItems(245) $i + $w create text 521.5 300.5 -text 245 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 560 389 599 389 599 326 560 326 -fill "" -tags $tags_room] set floorLabels($i) 244 - set {floorItems(244)} $i - $w create text 579.5 357.5 -text 244 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 601 389 601 326 643 326 643 389 -fill {} -tags {floor2 room}] + set floorItems(244) $i + $w create text 579.5 357.5 -text 244 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 601 389 601 326 643 326 643 389 -fill "" -tags $tags_room] set floorLabels($i) 243 - set {floorItems(243)} $i - $w create text 622 357.5 -text 243 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 688 316 645 316 645 365 688 365 -fill {} -tags {floor2 room}] + set floorItems(243) $i + $w create text 622 357.5 -text 243 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 688 316 645 316 645 365 688 365 -fill "" -tags $tags_room] set floorLabels($i) 242 - set {floorItems(242)} $i - $w create text 666.5 340.5 -text 242 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 802 367 759 367 759 226 802 226 -fill {} -tags {floor2 room}] - set floorLabels($i) {Barbecue Deck} + set floorItems(242) $i + $w create text 666.5 340.5 -text 242 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 802 367 759 367 759 226 802 226 -fill "" -tags $tags_room] + set floorLabels($i) "Barbecue Deck" set {floorItems(Barbecue Deck)} $i - $w create text 780.5 296.5 -text {Barbecue Deck} -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 755 262 755 314 717 314 717 262 -fill {} -tags {floor2 room}] + $w create text 780.5 296.5 -text "Barbecue Deck" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 755 262 755 314 717 314 717 262 -fill "" -tags $tags_room] set floorLabels($i) 240 - set {floorItems(240)} $i - $w create text 736 288 -text 240 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 755 316 689 316 689 365 755 365 -fill {} -tags {floor2 room}] + set floorItems(240) $i + $w create text 736 288 -text 240 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 755 316 689 316 689 365 755 365 -fill "" -tags $tags_room] set floorLabels($i) 241 - set {floorItems(241)} $i - $w create text 722 340.5 -text 241 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 755 206 717 206 717 261 755 261 -fill {} -tags {floor2 room}] + set floorItems(241) $i + $w create text 722 340.5 -text 241 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 755 206 717 206 717 261 755 261 -fill "" -tags $tags_room] set floorLabels($i) 239 - set {floorItems(239)} $i - $w create text 736 233.5 -text 239 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 695 277 643 277 643 206 695 206 -fill {} -tags {floor2 room}] + set floorItems(239) $i + $w create text 736 233.5 -text 239 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 695 277 643 277 643 206 695 206 -fill "" -tags $tags_room] set floorLabels($i) 248 - set {floorItems(248)} $i - $w create text 669 241.5 -text 248 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 676 135 676 185 724 185 724 135 -fill {} -tags {floor2 room}] + set floorItems(248) $i + $w create text 669 241.5 -text 248 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 676 135 676 185 724 185 724 135 -fill "" -tags $tags_room] set floorLabels($i) 236 - set {floorItems(236)} $i - $w create text 700 160 -text 236 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 675 135 635 135 635 145 628 145 628 185 675 185 -fill {} -tags {floor2 room}] + set floorItems(236) $i + $w create text 700 160 -text 236 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 675 135 635 135 635 145 628 145 628 185 675 185 -fill "" -tags $tags_room] set floorLabels($i) 235 - set {floorItems(235)} $i - $w create text 651.5 160 -text 235 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 626 143 633 143 633 135 572 135 572 143 579 143 579 185 626 185 -fill {} -tags {floor2 room}] + set floorItems(235) $i + $w create text 651.5 160 -text 235 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 626 143 633 143 633 135 572 135 572 143 579 143 579 185 626 185 -fill "" -tags $tags_room] set floorLabels($i) 234 - set {floorItems(234)} $i - $w create text 606 160 -text 234 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 557 135 571 135 571 145 578 145 578 185 527 185 527 131 557 131 -fill {} -tags {floor2 room}] + set floorItems(234) $i + $w create text 606 160 -text 234 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 557 135 571 135 571 145 578 145 578 185 527 185 527 131 557 131 -fill "" -tags $tags_room] set floorLabels($i) 233 - set {floorItems(233)} $i - $w create text 552.5 158 -text 233 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 476 249 557 249 557 205 476 205 -fill {} -tags {floor2 room}] + set floorItems(233) $i + $w create text 552.5 158 -text 233 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 476 249 557 249 557 205 476 205 -fill "" -tags $tags_room] set floorLabels($i) 230 - set {floorItems(230)} $i - $w create text 516.5 227 -text 230 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 476 164 486 164 486 131 525 131 525 185 476 185 -fill {} -tags {floor2 room}] + set floorItems(230) $i + $w create text 516.5 227 -text 230 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 476 164 486 164 486 131 525 131 525 185 476 185 -fill "" -tags $tags_room] set floorLabels($i) 232 - set {floorItems(232)} $i - $w create text 500.5 158 -text 232 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 476 186 495 186 495 204 476 204 -fill {} -tags {floor2 room}] + set floorItems(232) $i + $w create text 500.5 158 -text 232 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 476 186 495 186 495 204 476 204 -fill "" -tags $tags_room] set floorLabels($i) 229 - set {floorItems(229)} $i - $w create text 485.5 195 -text 229 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 474 207 409 207 409 187 399 187 399 164 474 164 -fill {} -tags {floor2 room}] + set floorItems(229) $i + $w create text 485.5 195 -text 229 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 474 207 409 207 409 187 399 187 399 164 474 164 -fill "" -tags $tags_room] set floorLabels($i) 227 - set {floorItems(227)} $i - $w create text 436.5 185.5 -text 227 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 399 228 399 253 474 253 474 209 409 209 409 228 -fill {} -tags {floor2 room}] + set floorItems(227) $i + $w create text 436.5 185.5 -text 227 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 399 228 399 253 474 253 474 209 409 209 409 228 -fill "" -tags $tags_room] set floorLabels($i) 228 - set {floorItems(228)} $i - $w create text 436.5 231 -text 228 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 397 246 397 226 407 226 407 189 377 189 377 246 -fill {} -tags {floor2 room}] + set floorItems(228) $i + $w create text 436.5 231 -text 228 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 397 246 397 226 407 226 407 189 377 189 377 246 -fill "" -tags $tags_room] set floorLabels($i) 226 - set {floorItems(226)} $i - $w create text 392 217.5 -text 226 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 377 169 316 169 316 131 397 131 397 188 377 188 -fill {} -tags {floor2 room}] + set floorItems(226) $i + $w create text 392 217.5 -text 226 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 377 169 316 169 316 131 397 131 397 188 377 188 -fill "" -tags $tags_room] set floorLabels($i) 225 - set {floorItems(225)} $i - $w create text 356.5 150 -text 225 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 234 198 306 198 306 249 234 249 -fill {} -tags {floor2 room}] + set floorItems(225) $i + $w create text 356.5 150 -text 225 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 234 198 306 198 306 249 234 249 -fill "" -tags $tags_room] set floorLabels($i) 224 - set {floorItems(224)} $i - $w create text 270 223.5 -text 224 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 270 179 306 179 306 170 314 170 314 135 270 135 -fill {} -tags {floor2 room}] + set floorItems(224) $i + $w create text 270 223.5 -text 224 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 270 179 306 179 306 170 314 170 314 135 270 135 -fill "" -tags $tags_room] set floorLabels($i) 223 - set {floorItems(223)} $i - $w create text 292 157 -text 223 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 268 179 221 179 221 135 268 135 -fill {} -tags {floor2 room}] + set floorItems(223) $i + $w create text 292 157 -text 223 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 268 179 221 179 221 135 268 135 -fill "" -tags $tags_room] set floorLabels($i) 222 - set {floorItems(222)} $i - $w create text 244.5 157 -text 222 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 177 179 219 179 219 135 177 135 -fill {} -tags {floor2 room}] + set floorItems(222) $i + $w create text 244.5 157 -text 222 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 177 179 219 179 219 135 177 135 -fill "" -tags $tags_room] set floorLabels($i) 221 - set {floorItems(221)} $i - $w create text 198 157 -text 221 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 299 327 349 327 349 284 341 284 341 276 299 276 -fill {} -tags {floor2 room}] + set floorItems(221) $i + $w create text 198 157 -text 221 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 299 327 349 327 349 284 341 284 341 276 299 276 -fill "" -tags $tags_room] set floorLabels($i) 204 - set {floorItems(204)} $i - $w create text 324 301.5 -text 204 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 234 276 297 276 297 327 257 327 257 338 234 338 -fill {} -tags {floor2 room}] + set floorItems(204) $i + $w create text 324 301.5 -text 204 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 234 276 297 276 297 327 257 327 257 338 234 338 -fill "" -tags $tags_room] set floorLabels($i) 205 - set {floorItems(205)} $i - $w create text 265.5 307 -text 205 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 256 385 256 340 212 340 212 385 -fill {} -tags {floor2 room}] + set floorItems(205) $i + $w create text 265.5 307 -text 205 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 256 385 256 340 212 340 212 385 -fill "" -tags $tags_room] set floorLabels($i) 207 - set {floorItems(207)} $i - $w create text 234 362.5 -text 207 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 210 340 164 340 164 385 210 385 -fill {} -tags {floor2 room}] + set floorItems(207) $i + $w create text 234 362.5 -text 207 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 210 340 164 340 164 385 210 385 -fill "" -tags $tags_room] set floorLabels($i) 208 - set {floorItems(208)} $i - $w create text 187 362.5 -text 208 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 115 340 162 340 162 385 115 385 -fill {} -tags {floor2 room}] + set floorItems(208) $i + $w create text 187 362.5 -text 208 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 115 340 162 340 162 385 115 385 -fill "" -tags $tags_room] set floorLabels($i) 209 - set {floorItems(209)} $i - $w create text 138.5 362.5 -text 209 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 89 228 89 156 53 156 53 228 -fill {} -tags {floor2 room}] + set floorItems(209) $i + $w create text 138.5 362.5 -text 209 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 89 228 89 156 53 156 53 228 -fill "" -tags $tags_room] set floorLabels($i) 217 - set {floorItems(217)} $i - $w create text 71 192 -text 217 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 89 169 97 169 97 190 89 190 -fill {} -tags {floor2 room}] + set floorItems(217) $i + $w create text 71 192 -text 217 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 89 169 97 169 97 190 89 190 -fill "" -tags $tags_room] set floorLabels($i) 217A - set {floorItems(217A)} $i - $w create text 93 179.5 -text 217A -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 89 156 89 168 95 168 95 135 53 135 53 156 -fill {} -tags {floor2 room}] + set floorItems(217A) $i + $w create text 93 179.5 -text 217A -fill $color -anchor c -tags $tags_label + set i [$w create polygon 89 156 89 168 95 168 95 135 53 135 53 156 -fill "" -tags $tags_room] set floorLabels($i) 216 - set {floorItems(216)} $i - $w create text 71 145.5 -text 216 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 51 179 51 135 6 135 6 179 -fill {} -tags {floor2 room}] + set floorItems(216) $i + $w create text 71 145.5 -text 216 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 51 179 51 135 6 135 6 179 -fill "" -tags $tags_room] set floorLabels($i) 215 - set {floorItems(215)} $i - $w create text 28.5 157 -text 215 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 51 227 6 227 6 180 51 180 -fill {} -tags {floor2 room}] + set floorItems(215) $i + $w create text 28.5 157 -text 215 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 51 227 6 227 6 180 51 180 -fill "" -tags $tags_room] set floorLabels($i) 214 - set {floorItems(214)} $i - $w create text 28.5 203.5 -text 214 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 51 275 6 275 6 229 51 229 -fill {} -tags {floor2 room}] + set floorItems(214) $i + $w create text 28.5 203.5 -text 214 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 51 275 6 275 6 229 51 229 -fill "" -tags $tags_room] set floorLabels($i) 213 - set {floorItems(213)} $i - $w create text 28.5 252 -text 213 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 114 340 67 340 67 385 114 385 -fill {} -tags {floor2 room}] + set floorItems(213) $i + $w create text 28.5 252 -text 213 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 114 340 67 340 67 385 114 385 -fill "" -tags $tags_room] set floorLabels($i) 210 - set {floorItems(210)} $i - $w create text 90.5 362.5 -text 210 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 59 389 59 385 65 385 65 340 1 340 1 389 -fill {} -tags {floor2 room}] + set floorItems(210) $i + $w create text 90.5 362.5 -text 210 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 59 389 59 385 65 385 65 340 1 340 1 389 -fill "" -tags $tags_room] set floorLabels($i) 211 - set {floorItems(211)} $i - $w create text 33 364.5 -text 211 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 393 309 350 309 350 282 342 282 342 276 393 276 -fill {} -tags {floor2 room}] + set floorItems(211) $i + $w create text 33 364.5 -text 211 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 393 309 350 309 350 282 342 282 342 276 393 276 -fill "" -tags $tags_room] set floorLabels($i) 203 - set {floorItems(203)} $i - $w create text 367.5 292.5 -text 203 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 99 191 91 191 91 226 174 226 174 198 154 198 154 192 109 192 109 169 99 169 -fill {} -tags {floor2 room}] + set floorItems(203) $i + $w create text 367.5 292.5 -text 203 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 99 191 91 191 91 226 174 226 174 198 154 198 154 192 109 192 109 169 99 169 -fill "" -tags $tags_room] set floorLabels($i) 220 - set {floorItems(220)} $i - $w create text 132.5 208.5 -text 220 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor2 room}] - set floorLabels($i) {Priv Lift2} + set floorItems(220) $i + $w create text 132.5 208.5 -text 220 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 339 205 307 205 307 171 339 171 -fill "" -tags $tags_room] + set floorLabels($i) "Priv Lift2" set {floorItems(Priv Lift2)} $i - $w create text 323 188 -text {Priv Lift2} -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor2 room}] - set floorLabels($i) {Pub Lift 2} + $w create text 323 188 -text "Priv Lift2" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 307 240 339 240 339 206 307 206 -fill "" -tags $tags_room] + set floorLabels($i) "Pub Lift 2" set {floorItems(Pub Lift 2)} $i - $w create text 323 223 -text {Pub Lift 2} -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor2 room}] + $w create text 323 223 -text "Pub Lift 2" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 175 168 97 168 97 131 175 131 -fill "" -tags $tags_room] set floorLabels($i) 218 - set {floorItems(218)} $i - $w create text 136 149.5 -text 218 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor2 room}] + set floorItems(218) $i + $w create text 136 149.5 -text 218 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 154 191 111 191 111 169 154 169 -fill "" -tags $tags_room] set floorLabels($i) 219 - set {floorItems(219)} $i - $w create text 132.5 180 -text 219 -fill $color -anchor c -tags {floor2 label} - set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor2 room}] + set floorItems(219) $i + $w create text 132.5 180 -text 219 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 375 246 375 172 341 172 341 246 -fill "" -tags $tags_room] set floorLabels($i) 201 - set {floorItems(201)} $i - $w create text 358 209 -text 201 -fill $color -anchor c -tags {floor2 label} - $w create line 641 186 678 186 -fill $color -tags {floor2 wall} - $w create line 757 350 757 367 -fill $color -tags {floor2 wall} - $w create line 634 133 634 144 -fill $color -tags {floor2 wall} - $w create line 634 144 627 144 -fill $color -tags {floor2 wall} - $w create line 572 133 572 144 -fill $color -tags {floor2 wall} - $w create line 572 144 579 144 -fill $color -tags {floor2 wall} - $w create line 398 129 398 162 -fill $color -tags {floor2 wall} - $w create line 174 197 175 197 -fill $color -tags {floor2 wall} - $w create line 175 197 175 227 -fill $color -tags {floor2 wall} - $w create line 757 206 757 221 -fill $color -tags {floor2 wall} - $w create line 396 188 408 188 -fill $color -tags {floor2 wall} - $w create line 727 189 725 189 -fill $color -tags {floor2 wall} - $w create line 747 167 802 167 -fill $color -tags {floor2 wall} - $w create line 747 167 747 189 -fill $color -tags {floor2 wall} - $w create line 755 189 739 189 -fill $color -tags {floor2 wall} - $w create line 769 224 757 224 -fill $color -tags {floor2 wall} - $w create line 802 224 802 129 -fill $color -tags {floor2 wall} - $w create line 802 129 725 129 -fill $color -tags {floor2 wall} - $w create line 725 189 725 129 -fill $color -tags {floor2 wall} - $w create line 725 186 690 186 -fill $color -tags {floor2 wall} - $w create line 676 133 676 186 -fill $color -tags {floor2 wall} - $w create line 627 144 627 186 -fill $color -tags {floor2 wall} - $w create line 629 186 593 186 -fill $color -tags {floor2 wall} - $w create line 579 144 579 186 -fill $color -tags {floor2 wall} - $w create line 559 129 559 133 -fill $color -tags {floor2 wall} - $w create line 725 133 559 133 -fill $color -tags {floor2 wall} - $w create line 484 162 484 129 -fill $color -tags {floor2 wall} - $w create line 559 129 484 129 -fill $color -tags {floor2 wall} - $w create line 526 129 526 186 -fill $color -tags {floor2 wall} - $w create line 540 186 581 186 -fill $color -tags {floor2 wall} - $w create line 528 186 523 186 -fill $color -tags {floor2 wall} - $w create line 511 186 475 186 -fill $color -tags {floor2 wall} - $w create line 496 190 496 186 -fill $color -tags {floor2 wall} - $w create line 496 205 496 202 -fill $color -tags {floor2 wall} - $w create line 475 205 527 205 -fill $color -tags {floor2 wall} - $w create line 558 205 539 205 -fill $color -tags {floor2 wall} - $w create line 558 205 558 249 -fill $color -tags {floor2 wall} - $w create line 558 249 475 249 -fill $color -tags {floor2 wall} - $w create line 662 206 642 206 -fill $color -tags {floor2 wall} - $w create line 695 206 675 206 -fill $color -tags {floor2 wall} - $w create line 695 278 642 278 -fill $color -tags {floor2 wall} - $w create line 642 291 642 206 -fill $color -tags {floor2 wall} - $w create line 695 291 695 206 -fill $color -tags {floor2 wall} - $w create line 716 208 716 206 -fill $color -tags {floor2 wall} - $w create line 757 206 716 206 -fill $color -tags {floor2 wall} - $w create line 757 221 757 224 -fill $color -tags {floor2 wall} - $w create line 793 224 802 224 -fill $color -tags {floor2 wall} - $w create line 757 262 716 262 -fill $color -tags {floor2 wall} - $w create line 716 220 716 264 -fill $color -tags {floor2 wall} - $w create line 716 315 716 276 -fill $color -tags {floor2 wall} - $w create line 757 315 703 315 -fill $color -tags {floor2 wall} - $w create line 757 325 757 224 -fill $color -tags {floor2 wall} - $w create line 757 367 644 367 -fill $color -tags {floor2 wall} - $w create line 689 367 689 315 -fill $color -tags {floor2 wall} - $w create line 647 315 644 315 -fill $color -tags {floor2 wall} - $w create line 659 315 691 315 -fill $color -tags {floor2 wall} - $w create line 600 325 600 391 -fill $color -tags {floor2 wall} - $w create line 627 325 644 325 -fill $color -tags {floor2 wall} - $w create line 644 391 644 315 -fill $color -tags {floor2 wall} - $w create line 615 325 575 325 -fill $color -tags {floor2 wall} - $w create line 644 391 558 391 -fill $color -tags {floor2 wall} - $w create line 563 325 558 325 -fill $color -tags {floor2 wall} - $w create line 558 391 558 314 -fill $color -tags {floor2 wall} - $w create line 558 327 508 327 -fill $color -tags {floor2 wall} - $w create line 558 275 484 275 -fill $color -tags {floor2 wall} - $w create line 558 302 558 275 -fill $color -tags {floor2 wall} - $w create line 508 327 508 311 -fill $color -tags {floor2 wall} - $w create line 484 311 508 311 -fill $color -tags {floor2 wall} - $w create line 484 275 484 311 -fill $color -tags {floor2 wall} - $w create line 475 208 408 208 -fill $color -tags {floor2 wall} - $w create line 408 206 408 210 -fill $color -tags {floor2 wall} - $w create line 408 222 408 227 -fill $color -tags {floor2 wall} - $w create line 408 227 398 227 -fill $color -tags {floor2 wall} - $w create line 398 227 398 254 -fill $color -tags {floor2 wall} - $w create line 408 188 408 194 -fill $color -tags {floor2 wall} - $w create line 383 188 376 188 -fill $color -tags {floor2 wall} - $w create line 398 188 398 162 -fill $color -tags {floor2 wall} - $w create line 398 162 484 162 -fill $color -tags {floor2 wall} - $w create line 475 162 475 254 -fill $color -tags {floor2 wall} - $w create line 398 254 475 254 -fill $color -tags {floor2 wall} - $w create line 484 280 395 280 -fill $color -tags {floor2 wall} - $w create line 395 311 395 275 -fill $color -tags {floor2 wall} - $w create line 307 197 293 197 -fill $color -tags {floor2 wall} - $w create line 278 197 233 197 -fill $color -tags {floor2 wall} - $w create line 233 197 233 249 -fill $color -tags {floor2 wall} - $w create line 307 179 284 179 -fill $color -tags {floor2 wall} - $w create line 233 249 278 249 -fill $color -tags {floor2 wall} - $w create line 269 179 269 133 -fill $color -tags {floor2 wall} - $w create line 220 179 220 133 -fill $color -tags {floor2 wall} - $w create line 155 191 110 191 -fill $color -tags {floor2 wall} - $w create line 90 190 98 190 -fill $color -tags {floor2 wall} - $w create line 98 169 98 190 -fill $color -tags {floor2 wall} - $w create line 52 133 52 165 -fill $color -tags {floor2 wall} - $w create line 52 214 52 177 -fill $color -tags {floor2 wall} - $w create line 52 226 52 262 -fill $color -tags {floor2 wall} - $w create line 52 274 52 276 -fill $color -tags {floor2 wall} - $w create line 234 275 234 339 -fill $color -tags {floor2 wall} - $w create line 226 339 258 339 -fill $color -tags {floor2 wall} - $w create line 211 387 211 339 -fill $color -tags {floor2 wall} - $w create line 214 339 177 339 -fill $color -tags {floor2 wall} - $w create line 258 387 60 387 -fill $color -tags {floor2 wall} - $w create line 3 133 3 339 -fill $color -tags {floor2 wall} - $w create line 165 339 129 339 -fill $color -tags {floor2 wall} - $w create line 117 339 80 339 -fill $color -tags {floor2 wall} - $w create line 68 339 59 339 -fill $color -tags {floor2 wall} - $w create line 0 339 46 339 -fill $color -tags {floor2 wall} - $w create line 60 391 0 391 -fill $color -tags {floor2 wall} - $w create line 0 339 0 391 -fill $color -tags {floor2 wall} - $w create line 60 387 60 391 -fill $color -tags {floor2 wall} - $w create line 258 329 258 387 -fill $color -tags {floor2 wall} - $w create line 350 329 258 329 -fill $color -tags {floor2 wall} - $w create line 395 311 350 311 -fill $color -tags {floor2 wall} - $w create line 398 129 315 129 -fill $color -tags {floor2 wall} - $w create line 176 133 315 133 -fill $color -tags {floor2 wall} - $w create line 176 129 96 129 -fill $color -tags {floor2 wall} - $w create line 3 133 96 133 -fill $color -tags {floor2 wall} - $w create line 66 387 66 339 -fill $color -tags {floor2 wall} - $w create line 115 387 115 339 -fill $color -tags {floor2 wall} - $w create line 163 387 163 339 -fill $color -tags {floor2 wall} - $w create line 234 275 276 275 -fill $color -tags {floor2 wall} - $w create line 288 275 309 275 -fill $color -tags {floor2 wall} - $w create line 298 275 298 329 -fill $color -tags {floor2 wall} - $w create line 341 283 350 283 -fill $color -tags {floor2 wall} - $w create line 321 275 341 275 -fill $color -tags {floor2 wall} - $w create line 375 275 395 275 -fill $color -tags {floor2 wall} - $w create line 315 129 315 170 -fill $color -tags {floor2 wall} - $w create line 376 170 307 170 -fill $color -tags {floor2 wall} - $w create line 307 250 307 170 -fill $color -tags {floor2 wall} - $w create line 376 245 376 170 -fill $color -tags {floor2 wall} - $w create line 340 241 307 241 -fill $color -tags {floor2 wall} - $w create line 340 245 340 224 -fill $color -tags {floor2 wall} - $w create line 340 210 340 201 -fill $color -tags {floor2 wall} - $w create line 340 187 340 170 -fill $color -tags {floor2 wall} - $w create line 340 206 307 206 -fill $color -tags {floor2 wall} - $w create line 293 250 307 250 -fill $color -tags {floor2 wall} - $w create line 271 179 238 179 -fill $color -tags {floor2 wall} - $w create line 226 179 195 179 -fill $color -tags {floor2 wall} - $w create line 176 129 176 179 -fill $color -tags {floor2 wall} - $w create line 182 179 176 179 -fill $color -tags {floor2 wall} - $w create line 174 169 176 169 -fill $color -tags {floor2 wall} - $w create line 162 169 90 169 -fill $color -tags {floor2 wall} - $w create line 96 169 96 129 -fill $color -tags {floor2 wall} - $w create line 175 227 90 227 -fill $color -tags {floor2 wall} - $w create line 90 190 90 227 -fill $color -tags {floor2 wall} - $w create line 52 179 3 179 -fill $color -tags {floor2 wall} - $w create line 52 228 3 228 -fill $color -tags {floor2 wall} - $w create line 52 276 3 276 -fill $color -tags {floor2 wall} - $w create line 155 177 155 169 -fill $color -tags {floor2 wall} - $w create line 110 191 110 169 -fill $color -tags {floor2 wall} - $w create line 155 189 155 197 -fill $color -tags {floor2 wall} - $w create line 350 283 350 329 -fill $color -tags {floor2 wall} - $w create line 162 197 155 197 -fill $color -tags {floor2 wall} - $w create line 341 275 341 283 -fill $color -tags {floor2 wall} + set floorItems(201) $i + $w create text 358 209 -text 201 -fill $color -anchor c -tags $tags_label + $w create line 641 186 678 186 -fill $color -tags $tags_wall + $w create line 757 350 757 367 -fill $color -tags $tags_wall + $w create line 634 133 634 144 -fill $color -tags $tags_wall + $w create line 634 144 627 144 -fill $color -tags $tags_wall + $w create line 572 133 572 144 -fill $color -tags $tags_wall + $w create line 572 144 579 144 -fill $color -tags $tags_wall + $w create line 398 129 398 162 -fill $color -tags $tags_wall + $w create line 174 197 175 197 -fill $color -tags $tags_wall + $w create line 175 197 175 227 -fill $color -tags $tags_wall + $w create line 757 206 757 221 -fill $color -tags $tags_wall + $w create line 396 188 408 188 -fill $color -tags $tags_wall + $w create line 727 189 725 189 -fill $color -tags $tags_wall + $w create line 747 167 802 167 -fill $color -tags $tags_wall + $w create line 747 167 747 189 -fill $color -tags $tags_wall + $w create line 755 189 739 189 -fill $color -tags $tags_wall + $w create line 769 224 757 224 -fill $color -tags $tags_wall + $w create line 802 224 802 129 -fill $color -tags $tags_wall + $w create line 802 129 725 129 -fill $color -tags $tags_wall + $w create line 725 189 725 129 -fill $color -tags $tags_wall + $w create line 725 186 690 186 -fill $color -tags $tags_wall + $w create line 676 133 676 186 -fill $color -tags $tags_wall + $w create line 627 144 627 186 -fill $color -tags $tags_wall + $w create line 629 186 593 186 -fill $color -tags $tags_wall + $w create line 579 144 579 186 -fill $color -tags $tags_wall + $w create line 559 129 559 133 -fill $color -tags $tags_wall + $w create line 725 133 559 133 -fill $color -tags $tags_wall + $w create line 484 162 484 129 -fill $color -tags $tags_wall + $w create line 559 129 484 129 -fill $color -tags $tags_wall + $w create line 526 129 526 186 -fill $color -tags $tags_wall + $w create line 540 186 581 186 -fill $color -tags $tags_wall + $w create line 528 186 523 186 -fill $color -tags $tags_wall + $w create line 511 186 475 186 -fill $color -tags $tags_wall + $w create line 496 190 496 186 -fill $color -tags $tags_wall + $w create line 496 205 496 202 -fill $color -tags $tags_wall + $w create line 475 205 527 205 -fill $color -tags $tags_wall + $w create line 558 205 539 205 -fill $color -tags $tags_wall + $w create line 558 205 558 249 -fill $color -tags $tags_wall + $w create line 558 249 475 249 -fill $color -tags $tags_wall + $w create line 662 206 642 206 -fill $color -tags $tags_wall + $w create line 695 206 675 206 -fill $color -tags $tags_wall + $w create line 695 278 642 278 -fill $color -tags $tags_wall + $w create line 642 291 642 206 -fill $color -tags $tags_wall + $w create line 695 291 695 206 -fill $color -tags $tags_wall + $w create line 716 208 716 206 -fill $color -tags $tags_wall + $w create line 757 206 716 206 -fill $color -tags $tags_wall + $w create line 757 221 757 224 -fill $color -tags $tags_wall + $w create line 793 224 802 224 -fill $color -tags $tags_wall + $w create line 757 262 716 262 -fill $color -tags $tags_wall + $w create line 716 220 716 264 -fill $color -tags $tags_wall + $w create line 716 315 716 276 -fill $color -tags $tags_wall + $w create line 757 315 703 315 -fill $color -tags $tags_wall + $w create line 757 325 757 224 -fill $color -tags $tags_wall + $w create line 757 367 644 367 -fill $color -tags $tags_wall + $w create line 689 367 689 315 -fill $color -tags $tags_wall + $w create line 647 315 644 315 -fill $color -tags $tags_wall + $w create line 659 315 691 315 -fill $color -tags $tags_wall + $w create line 600 325 600 391 -fill $color -tags $tags_wall + $w create line 627 325 644 325 -fill $color -tags $tags_wall + $w create line 644 391 644 315 -fill $color -tags $tags_wall + $w create line 615 325 575 325 -fill $color -tags $tags_wall + $w create line 644 391 558 391 -fill $color -tags $tags_wall + $w create line 563 325 558 325 -fill $color -tags $tags_wall + $w create line 558 391 558 314 -fill $color -tags $tags_wall + $w create line 558 327 508 327 -fill $color -tags $tags_wall + $w create line 558 275 484 275 -fill $color -tags $tags_wall + $w create line 558 302 558 275 -fill $color -tags $tags_wall + $w create line 508 327 508 311 -fill $color -tags $tags_wall + $w create line 484 311 508 311 -fill $color -tags $tags_wall + $w create line 484 275 484 311 -fill $color -tags $tags_wall + $w create line 475 208 408 208 -fill $color -tags $tags_wall + $w create line 408 206 408 210 -fill $color -tags $tags_wall + $w create line 408 222 408 227 -fill $color -tags $tags_wall + $w create line 408 227 398 227 -fill $color -tags $tags_wall + $w create line 398 227 398 254 -fill $color -tags $tags_wall + $w create line 408 188 408 194 -fill $color -tags $tags_wall + $w create line 383 188 376 188 -fill $color -tags $tags_wall + $w create line 398 188 398 162 -fill $color -tags $tags_wall + $w create line 398 162 484 162 -fill $color -tags $tags_wall + $w create line 475 162 475 254 -fill $color -tags $tags_wall + $w create line 398 254 475 254 -fill $color -tags $tags_wall + $w create line 484 280 395 280 -fill $color -tags $tags_wall + $w create line 395 311 395 275 -fill $color -tags $tags_wall + $w create line 307 197 293 197 -fill $color -tags $tags_wall + $w create line 278 197 233 197 -fill $color -tags $tags_wall + $w create line 233 197 233 249 -fill $color -tags $tags_wall + $w create line 307 179 284 179 -fill $color -tags $tags_wall + $w create line 233 249 278 249 -fill $color -tags $tags_wall + $w create line 269 179 269 133 -fill $color -tags $tags_wall + $w create line 220 179 220 133 -fill $color -tags $tags_wall + $w create line 155 191 110 191 -fill $color -tags $tags_wall + $w create line 90 190 98 190 -fill $color -tags $tags_wall + $w create line 98 169 98 190 -fill $color -tags $tags_wall + $w create line 52 133 52 165 -fill $color -tags $tags_wall + $w create line 52 214 52 177 -fill $color -tags $tags_wall + $w create line 52 226 52 262 -fill $color -tags $tags_wall + $w create line 52 274 52 276 -fill $color -tags $tags_wall + $w create line 234 275 234 339 -fill $color -tags $tags_wall + $w create line 226 339 258 339 -fill $color -tags $tags_wall + $w create line 211 387 211 339 -fill $color -tags $tags_wall + $w create line 214 339 177 339 -fill $color -tags $tags_wall + $w create line 258 387 60 387 -fill $color -tags $tags_wall + $w create line 3 133 3 339 -fill $color -tags $tags_wall + $w create line 165 339 129 339 -fill $color -tags $tags_wall + $w create line 117 339 80 339 -fill $color -tags $tags_wall + $w create line 68 339 59 339 -fill $color -tags $tags_wall + $w create line 0 339 46 339 -fill $color -tags $tags_wall + $w create line 60 391 0 391 -fill $color -tags $tags_wall + $w create line 0 339 0 391 -fill $color -tags $tags_wall + $w create line 60 387 60 391 -fill $color -tags $tags_wall + $w create line 258 329 258 387 -fill $color -tags $tags_wall + $w create line 350 329 258 329 -fill $color -tags $tags_wall + $w create line 395 311 350 311 -fill $color -tags $tags_wall + $w create line 398 129 315 129 -fill $color -tags $tags_wall + $w create line 176 133 315 133 -fill $color -tags $tags_wall + $w create line 176 129 96 129 -fill $color -tags $tags_wall + $w create line 3 133 96 133 -fill $color -tags $tags_wall + $w create line 66 387 66 339 -fill $color -tags $tags_wall + $w create line 115 387 115 339 -fill $color -tags $tags_wall + $w create line 163 387 163 339 -fill $color -tags $tags_wall + $w create line 234 275 276 275 -fill $color -tags $tags_wall + $w create line 288 275 309 275 -fill $color -tags $tags_wall + $w create line 298 275 298 329 -fill $color -tags $tags_wall + $w create line 341 283 350 283 -fill $color -tags $tags_wall + $w create line 321 275 341 275 -fill $color -tags $tags_wall + $w create line 375 275 395 275 -fill $color -tags $tags_wall + $w create line 315 129 315 170 -fill $color -tags $tags_wall + $w create line 376 170 307 170 -fill $color -tags $tags_wall + $w create line 307 250 307 170 -fill $color -tags $tags_wall + $w create line 376 245 376 170 -fill $color -tags $tags_wall + $w create line 340 241 307 241 -fill $color -tags $tags_wall + $w create line 340 245 340 224 -fill $color -tags $tags_wall + $w create line 340 210 340 201 -fill $color -tags $tags_wall + $w create line 340 187 340 170 -fill $color -tags $tags_wall + $w create line 340 206 307 206 -fill $color -tags $tags_wall + $w create line 293 250 307 250 -fill $color -tags $tags_wall + $w create line 271 179 238 179 -fill $color -tags $tags_wall + $w create line 226 179 195 179 -fill $color -tags $tags_wall + $w create line 176 129 176 179 -fill $color -tags $tags_wall + $w create line 182 179 176 179 -fill $color -tags $tags_wall + $w create line 174 169 176 169 -fill $color -tags $tags_wall + $w create line 162 169 90 169 -fill $color -tags $tags_wall + $w create line 96 169 96 129 -fill $color -tags $tags_wall + $w create line 175 227 90 227 -fill $color -tags $tags_wall + $w create line 90 190 90 227 -fill $color -tags $tags_wall + $w create line 52 179 3 179 -fill $color -tags $tags_wall + $w create line 52 228 3 228 -fill $color -tags $tags_wall + $w create line 52 276 3 276 -fill $color -tags $tags_wall + $w create line 155 177 155 169 -fill $color -tags $tags_wall + $w create line 110 191 110 169 -fill $color -tags $tags_wall + $w create line 155 189 155 197 -fill $color -tags $tags_wall + $w create line 350 283 350 329 -fill $color -tags $tags_wall + $w create line 162 197 155 197 -fill $color -tags $tags_wall + $w create line 341 275 341 283 -fill $color -tags $tags_wall } # fg3 -- @@ -1066,232 +1079,236 @@ proc fg2 {w color} { proc fg3 {w color} { global floorLabels floorItems - set i [$w create polygon 89 228 89 180 70 180 70 228 -fill {} -tags {floor3 room}] + set tags_room [list floor3 room] + set tags_label [list floor3 label] + set tags_wall [list floor3 wall] + + set i [$w create polygon 89 228 89 180 70 180 70 228 -fill "" -tags $tags_room] set floorLabels($i) 316 - set {floorItems(316)} $i - $w create text 79.5 204 -text 316 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 115 368 162 368 162 323 115 323 -fill {} -tags {floor3 room}] + set floorItems(316) $i + $w create text 79.5 204 -text 316 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 115 368 162 368 162 323 115 323 -fill "" -tags $tags_room] set floorLabels($i) 309 - set {floorItems(309)} $i - $w create text 138.5 345.5 -text 309 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 164 323 164 368 211 368 211 323 -fill {} -tags {floor3 room}] + set floorItems(309) $i + $w create text 138.5 345.5 -text 309 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 164 323 164 368 211 368 211 323 -fill "" -tags $tags_room] set floorLabels($i) 308 - set {floorItems(308)} $i - $w create text 187.5 345.5 -text 308 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 256 368 212 368 212 323 256 323 -fill {} -tags {floor3 room}] + set floorItems(308) $i + $w create text 187.5 345.5 -text 308 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 256 368 212 368 212 323 256 323 -fill "" -tags $tags_room] set floorLabels($i) 307 - set {floorItems(307)} $i - $w create text 234 345.5 -text 307 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 244 276 297 276 297 327 260 327 260 321 244 321 -fill {} -tags {floor3 room}] + set floorItems(307) $i + $w create text 234 345.5 -text 307 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 244 276 297 276 297 327 260 327 260 321 244 321 -fill "" -tags $tags_room] set floorLabels($i) 305 - set {floorItems(305)} $i - $w create text 270.5 301.5 -text 305 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 251 219 251 203 244 203 244 219 -fill {} -tags {floor3 room}] + set floorItems(305) $i + $w create text 270.5 301.5 -text 305 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 251 219 251 203 244 203 244 219 -fill "" -tags $tags_room] set floorLabels($i) 324B - set {floorItems(324B)} $i - $w create text 247.5 211 -text 324B -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 251 249 244 249 244 232 251 232 -fill {} -tags {floor3 room}] + set floorItems(324B) $i + $w create text 247.5 211 -text 324B -fill $color -anchor c -tags $tags_label + set i [$w create polygon 251 249 244 249 244 232 251 232 -fill "" -tags $tags_room] set floorLabels($i) 324A - set {floorItems(324A)} $i - $w create text 247.5 240.5 -text 324A -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 223 135 223 179 177 179 177 135 -fill {} -tags {floor3 room}] + set floorItems(324A) $i + $w create text 247.5 240.5 -text 324A -fill $color -anchor c -tags $tags_label + set i [$w create polygon 223 135 223 179 177 179 177 135 -fill "" -tags $tags_room] set floorLabels($i) 320 - set {floorItems(320)} $i - $w create text 200 157 -text 320 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 114 368 114 323 67 323 67 368 -fill {} -tags {floor3 room}] + set floorItems(320) $i + $w create text 200 157 -text 320 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 114 368 114 323 67 323 67 368 -fill "" -tags $tags_room] set floorLabels($i) 310 - set {floorItems(310)} $i - $w create text 90.5 345.5 -text 310 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 23 277 23 321 68 321 68 277 -fill {} -tags {floor3 room}] + set floorItems(310) $i + $w create text 90.5 345.5 -text 310 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 23 277 23 321 68 321 68 277 -fill "" -tags $tags_room] set floorLabels($i) 312 - set {floorItems(312)} $i - $w create text 45.5 299 -text 312 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 23 229 68 229 68 275 23 275 -fill {} -tags {floor3 room}] + set floorItems(312) $i + $w create text 45.5 299 -text 312 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 23 229 68 229 68 275 23 275 -fill "" -tags $tags_room] set floorLabels($i) 313 - set {floorItems(313)} $i - $w create text 45.5 252 -text 313 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 68 227 23 227 23 180 68 180 -fill {} -tags {floor3 room}] + set floorItems(313) $i + $w create text 45.5 252 -text 313 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 68 227 23 227 23 180 68 180 -fill "" -tags $tags_room] set floorLabels($i) 314 - set {floorItems(314)} $i - $w create text 45.5 203.5 -text 314 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 95 179 95 135 23 135 23 179 -fill {} -tags {floor3 room}] + set floorItems(314) $i + $w create text 45.5 203.5 -text 314 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 95 179 95 135 23 135 23 179 -fill "" -tags $tags_room] set floorLabels($i) 315 - set {floorItems(315)} $i - $w create text 59 157 -text 315 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 99 226 99 204 91 204 91 226 -fill {} -tags {floor3 room}] + set floorItems(315) $i + $w create text 59 157 -text 315 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 99 226 99 204 91 204 91 226 -fill "" -tags $tags_room] set floorLabels($i) 316B - set {floorItems(316B)} $i - $w create text 95 215 -text 316B -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 91 202 99 202 99 180 91 180 -fill {} -tags {floor3 room}] + set floorItems(316B) $i + $w create text 95 215 -text 316B -fill $color -anchor c -tags $tags_label + set i [$w create polygon 91 202 99 202 99 180 91 180 -fill "" -tags $tags_room] set floorLabels($i) 316A - set {floorItems(316A)} $i - $w create text 95 191 -text 316A -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 97 169 109 169 109 192 154 192 154 198 174 198 174 226 101 226 101 179 97 179 -fill {} -tags {floor3 room}] + set floorItems(316A) $i + $w create text 95 191 -text 316A -fill $color -anchor c -tags $tags_label + set i [$w create polygon 97 169 109 169 109 192 154 192 154 198 174 198 174 226 101 226 101 179 97 179 -fill "" -tags $tags_room] set floorLabels($i) 319 - set {floorItems(319)} $i - $w create text 141.5 209 -text 319 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 65 368 58 368 58 389 1 389 1 333 23 333 23 323 65 323 -fill {} -tags {floor3 room}] + set floorItems(319) $i + $w create text 141.5 209 -text 319 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 65 368 58 368 58 389 1 389 1 333 23 333 23 323 65 323 -fill "" -tags $tags_room] set floorLabels($i) 311 - set {floorItems(311)} $i - $w create text 29.5 361 -text 311 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor3 room}] + set floorItems(311) $i + $w create text 29.5 361 -text 311 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 154 191 111 191 111 169 154 169 -fill "" -tags $tags_room] set floorLabels($i) 318 - set {floorItems(318)} $i - $w create text 132.5 180 -text 318 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor3 room}] + set floorItems(318) $i + $w create text 132.5 180 -text 318 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 175 168 97 168 97 131 175 131 -fill "" -tags $tags_room] set floorLabels($i) 317 - set {floorItems(317)} $i - $w create text 136 149.5 -text 317 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 274 194 274 221 306 221 306 194 -fill {} -tags {floor3 room}] + set floorItems(317) $i + $w create text 136 149.5 -text 317 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 274 194 274 221 306 221 306 194 -fill "" -tags $tags_room] set floorLabels($i) 323 - set {floorItems(323)} $i - $w create text 290 207.5 -text 323 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 306 222 274 222 274 249 306 249 -fill {} -tags {floor3 room}] + set floorItems(323) $i + $w create text 290 207.5 -text 323 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 306 222 274 222 274 249 306 249 -fill "" -tags $tags_room] set floorLabels($i) 325 - set {floorItems(325)} $i - $w create text 290 235.5 -text 325 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 263 179 224 179 224 135 263 135 -fill {} -tags {floor3 room}] + set floorItems(325) $i + $w create text 290 235.5 -text 325 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 263 179 224 179 224 135 263 135 -fill "" -tags $tags_room] set floorLabels($i) 321 - set {floorItems(321)} $i - $w create text 243.5 157 -text 321 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 314 169 306 169 306 192 273 192 264 181 264 135 314 135 -fill {} -tags {floor3 room}] + set floorItems(321) $i + $w create text 243.5 157 -text 321 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 314 169 306 169 306 192 273 192 264 181 264 135 314 135 -fill "" -tags $tags_room] set floorLabels($i) 322 - set {floorItems(322)} $i - $w create text 293.5 163.5 -text 322 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor3 room}] - set floorLabels($i) {Pub Lift3} + set floorItems(322) $i + $w create text 293.5 163.5 -text 322 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 307 240 339 240 339 206 307 206 -fill "" -tags $tags_room] + set floorLabels($i) "Pub Lift3" set {floorItems(Pub Lift3)} $i - $w create text 323 223 -text {Pub Lift3} -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor3 room}] - set floorLabels($i) {Priv Lift3} + $w create text 323 223 -text "Pub Lift3" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 339 205 307 205 307 171 339 171 -fill "" -tags $tags_room] + set floorLabels($i) "Priv Lift3" set {floorItems(Priv Lift3)} $i - $w create text 323 188 -text {Priv Lift3} -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 350 284 376 284 376 276 397 276 397 309 350 309 -fill {} -tags {floor3 room}] + $w create text 323 188 -text "Priv Lift3" -fill $color -anchor c -tags $tags_label + set i [$w create polygon 350 284 376 284 376 276 397 276 397 309 350 309 -fill "" -tags $tags_room] set floorLabels($i) 303 - set {floorItems(303)} $i - $w create text 373.5 292.5 -text 303 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 272 203 272 249 252 249 252 230 244 230 244 221 252 221 252 203 -fill {} -tags {floor3 room}] + set floorItems(303) $i + $w create text 373.5 292.5 -text 303 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 272 203 272 249 252 249 252 230 244 230 244 221 252 221 252 203 -fill "" -tags $tags_room] set floorLabels($i) 324 - set {floorItems(324)} $i - $w create text 262 226 -text 324 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 299 276 299 327 349 327 349 284 341 284 341 276 -fill {} -tags {floor3 room}] + set floorItems(324) $i + $w create text 262 226 -text 324 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 299 276 299 327 349 327 349 284 341 284 341 276 -fill "" -tags $tags_room] set floorLabels($i) 304 - set {floorItems(304)} $i - $w create text 324 301.5 -text 304 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor3 room}] + set floorItems(304) $i + $w create text 324 301.5 -text 304 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 375 246 375 172 341 172 341 246 -fill "" -tags $tags_room] set floorLabels($i) 301 - set {floorItems(301)} $i - $w create text 358 209 -text 301 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 397 246 377 246 377 185 397 185 -fill {} -tags {floor3 room}] + set floorItems(301) $i + $w create text 358 209 -text 301 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 397 246 377 246 377 185 397 185 -fill "" -tags $tags_room] set floorLabels($i) 327 - set {floorItems(327)} $i - $w create text 387 215.5 -text 327 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 316 131 316 169 377 169 377 185 397 185 397 131 -fill {} -tags {floor3 room}] + set floorItems(327) $i + $w create text 387 215.5 -text 327 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 316 131 316 169 377 169 377 185 397 185 397 131 -fill "" -tags $tags_room] set floorLabels($i) 326 - set {floorItems(326)} $i - $w create text 356.5 150 -text 326 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 308 251 242 251 242 274 342 274 342 282 375 282 375 274 397 274 397 248 339 248 339 242 308 242 -fill {} -tags {floor3 room}] + set floorItems(326) $i + $w create text 356.5 150 -text 326 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 308 251 242 251 242 274 342 274 342 282 375 282 375 274 397 274 397 248 339 248 339 242 308 242 -fill "" -tags $tags_room] set floorLabels($i) 302 - set {floorItems(302)} $i - $w create text 319.5 261 -text 302 -fill $color -anchor c -tags {floor3 label} - set i [$w create polygon 70 321 242 321 242 200 259 200 259 203 272 203 272 193 263 180 242 180 175 180 175 169 156 169 156 196 177 196 177 228 107 228 70 228 70 275 107 275 107 248 160 248 160 301 107 301 107 275 70 275 -fill {} -tags {floor3 room}] + set floorItems(302) $i + $w create text 319.5 261 -text 302 -fill $color -anchor c -tags $tags_label + set i [$w create polygon 70 321 242 321 242 200 259 200 259 203 272 203 272 193 263 180 242 180 175 180 175 169 156 169 156 196 177 196 177 228 107 228 70 228 70 275 107 275 107 248 160 248 160 301 107 301 107 275 70 275 -fill "" -tags $tags_room] set floorLabels($i) 306 - set {floorItems(306)} $i - $w create text 200.5 284.5 -text 306 -fill $color -anchor c -tags {floor3 label} - $w create line 341 275 341 283 -fill $color -tags {floor3 wall} - $w create line 162 197 155 197 -fill $color -tags {floor3 wall} - $w create line 396 247 399 247 -fill $color -tags {floor3 wall} - $w create line 399 129 399 311 -fill $color -tags {floor3 wall} - $w create line 258 202 243 202 -fill $color -tags {floor3 wall} - $w create line 350 283 350 329 -fill $color -tags {floor3 wall} - $w create line 251 231 243 231 -fill $color -tags {floor3 wall} - $w create line 243 220 251 220 -fill $color -tags {floor3 wall} - $w create line 243 250 243 202 -fill $color -tags {floor3 wall} - $w create line 155 197 155 190 -fill $color -tags {floor3 wall} - $w create line 110 192 110 169 -fill $color -tags {floor3 wall} - $w create line 155 192 110 192 -fill $color -tags {floor3 wall} - $w create line 155 177 155 169 -fill $color -tags {floor3 wall} - $w create line 176 197 176 227 -fill $color -tags {floor3 wall} - $w create line 69 280 69 274 -fill $color -tags {floor3 wall} - $w create line 21 276 69 276 -fill $color -tags {floor3 wall} - $w create line 69 262 69 226 -fill $color -tags {floor3 wall} - $w create line 21 228 69 228 -fill $color -tags {floor3 wall} - $w create line 21 179 75 179 -fill $color -tags {floor3 wall} - $w create line 69 179 69 214 -fill $color -tags {floor3 wall} - $w create line 90 220 90 227 -fill $color -tags {floor3 wall} - $w create line 90 204 90 202 -fill $color -tags {floor3 wall} - $w create line 90 203 100 203 -fill $color -tags {floor3 wall} - $w create line 90 187 90 179 -fill $color -tags {floor3 wall} - $w create line 90 227 176 227 -fill $color -tags {floor3 wall} - $w create line 100 179 100 227 -fill $color -tags {floor3 wall} - $w create line 100 179 87 179 -fill $color -tags {floor3 wall} - $w create line 96 179 96 129 -fill $color -tags {floor3 wall} - $w create line 162 169 96 169 -fill $color -tags {floor3 wall} - $w create line 173 169 176 169 -fill $color -tags {floor3 wall} - $w create line 182 179 176 179 -fill $color -tags {floor3 wall} - $w create line 176 129 176 179 -fill $color -tags {floor3 wall} - $w create line 195 179 226 179 -fill $color -tags {floor3 wall} - $w create line 224 133 224 179 -fill $color -tags {floor3 wall} - $w create line 264 179 264 133 -fill $color -tags {floor3 wall} - $w create line 238 179 264 179 -fill $color -tags {floor3 wall} - $w create line 273 207 273 193 -fill $color -tags {floor3 wall} - $w create line 273 235 273 250 -fill $color -tags {floor3 wall} - $w create line 273 224 273 219 -fill $color -tags {floor3 wall} - $w create line 273 193 307 193 -fill $color -tags {floor3 wall} - $w create line 273 222 307 222 -fill $color -tags {floor3 wall} - $w create line 273 250 307 250 -fill $color -tags {floor3 wall} - $w create line 384 247 376 247 -fill $color -tags {floor3 wall} - $w create line 340 206 307 206 -fill $color -tags {floor3 wall} - $w create line 340 187 340 170 -fill $color -tags {floor3 wall} - $w create line 340 210 340 201 -fill $color -tags {floor3 wall} - $w create line 340 247 340 224 -fill $color -tags {floor3 wall} - $w create line 340 241 307 241 -fill $color -tags {floor3 wall} - $w create line 376 247 376 170 -fill $color -tags {floor3 wall} - $w create line 307 250 307 170 -fill $color -tags {floor3 wall} - $w create line 376 170 307 170 -fill $color -tags {floor3 wall} - $w create line 315 129 315 170 -fill $color -tags {floor3 wall} - $w create line 376 283 366 283 -fill $color -tags {floor3 wall} - $w create line 376 283 376 275 -fill $color -tags {floor3 wall} - $w create line 399 275 376 275 -fill $color -tags {floor3 wall} - $w create line 341 275 320 275 -fill $color -tags {floor3 wall} - $w create line 341 283 350 283 -fill $color -tags {floor3 wall} - $w create line 298 275 298 329 -fill $color -tags {floor3 wall} - $w create line 308 275 298 275 -fill $color -tags {floor3 wall} - $w create line 243 322 243 275 -fill $color -tags {floor3 wall} - $w create line 243 275 284 275 -fill $color -tags {floor3 wall} - $w create line 258 322 226 322 -fill $color -tags {floor3 wall} - $w create line 212 370 212 322 -fill $color -tags {floor3 wall} - $w create line 214 322 177 322 -fill $color -tags {floor3 wall} - $w create line 163 370 163 322 -fill $color -tags {floor3 wall} - $w create line 165 322 129 322 -fill $color -tags {floor3 wall} - $w create line 84 322 117 322 -fill $color -tags {floor3 wall} - $w create line 71 322 64 322 -fill $color -tags {floor3 wall} - $w create line 115 322 115 370 -fill $color -tags {floor3 wall} - $w create line 66 322 66 370 -fill $color -tags {floor3 wall} - $w create line 52 322 21 322 -fill $color -tags {floor3 wall} - $w create line 21 331 0 331 -fill $color -tags {floor3 wall} - $w create line 21 331 21 133 -fill $color -tags {floor3 wall} - $w create line 96 133 21 133 -fill $color -tags {floor3 wall} - $w create line 176 129 96 129 -fill $color -tags {floor3 wall} - $w create line 315 133 176 133 -fill $color -tags {floor3 wall} - $w create line 315 129 399 129 -fill $color -tags {floor3 wall} - $w create line 399 311 350 311 -fill $color -tags {floor3 wall} - $w create line 350 329 258 329 -fill $color -tags {floor3 wall} - $w create line 258 322 258 370 -fill $color -tags {floor3 wall} - $w create line 60 370 258 370 -fill $color -tags {floor3 wall} - $w create line 60 370 60 391 -fill $color -tags {floor3 wall} - $w create line 0 391 0 331 -fill $color -tags {floor3 wall} - $w create line 60 391 0 391 -fill $color -tags {floor3 wall} - $w create line 307 250 307 242 -fill $color -tags {floor3 wall} - $w create line 273 250 307 250 -fill $color -tags {floor3 wall} - $w create line 258 250 243 250 -fill $color -tags {floor3 wall} + set floorItems(306) $i + $w create text 200.5 284.5 -text 306 -fill $color -anchor c -tags $tags_label + $w create line 341 275 341 283 -fill $color -tags $tags_wall + $w create line 162 197 155 197 -fill $color -tags $tags_wall + $w create line 396 247 399 247 -fill $color -tags $tags_wall + $w create line 399 129 399 311 -fill $color -tags $tags_wall + $w create line 258 202 243 202 -fill $color -tags $tags_wall + $w create line 350 283 350 329 -fill $color -tags $tags_wall + $w create line 251 231 243 231 -fill $color -tags $tags_wall + $w create line 243 220 251 220 -fill $color -tags $tags_wall + $w create line 243 250 243 202 -fill $color -tags $tags_wall + $w create line 155 197 155 190 -fill $color -tags $tags_wall + $w create line 110 192 110 169 -fill $color -tags $tags_wall + $w create line 155 192 110 192 -fill $color -tags $tags_wall + $w create line 155 177 155 169 -fill $color -tags $tags_wall + $w create line 176 197 176 227 -fill $color -tags $tags_wall + $w create line 69 280 69 274 -fill $color -tags $tags_wall + $w create line 21 276 69 276 -fill $color -tags $tags_wall + $w create line 69 262 69 226 -fill $color -tags $tags_wall + $w create line 21 228 69 228 -fill $color -tags $tags_wall + $w create line 21 179 75 179 -fill $color -tags $tags_wall + $w create line 69 179 69 214 -fill $color -tags $tags_wall + $w create line 90 220 90 227 -fill $color -tags $tags_wall + $w create line 90 204 90 202 -fill $color -tags $tags_wall + $w create line 90 203 100 203 -fill $color -tags $tags_wall + $w create line 90 187 90 179 -fill $color -tags $tags_wall + $w create line 90 227 176 227 -fill $color -tags $tags_wall + $w create line 100 179 100 227 -fill $color -tags $tags_wall + $w create line 100 179 87 179 -fill $color -tags $tags_wall + $w create line 96 179 96 129 -fill $color -tags $tags_wall + $w create line 162 169 96 169 -fill $color -tags $tags_wall + $w create line 173 169 176 169 -fill $color -tags $tags_wall + $w create line 182 179 176 179 -fill $color -tags $tags_wall + $w create line 176 129 176 179 -fill $color -tags $tags_wall + $w create line 195 179 226 179 -fill $color -tags $tags_wall + $w create line 224 133 224 179 -fill $color -tags $tags_wall + $w create line 264 179 264 133 -fill $color -tags $tags_wall + $w create line 238 179 264 179 -fill $color -tags $tags_wall + $w create line 273 207 273 193 -fill $color -tags $tags_wall + $w create line 273 235 273 250 -fill $color -tags $tags_wall + $w create line 273 224 273 219 -fill $color -tags $tags_wall + $w create line 273 193 307 193 -fill $color -tags $tags_wall + $w create line 273 222 307 222 -fill $color -tags $tags_wall + $w create line 273 250 307 250 -fill $color -tags $tags_wall + $w create line 384 247 376 247 -fill $color -tags $tags_wall + $w create line 340 206 307 206 -fill $color -tags $tags_wall + $w create line 340 187 340 170 -fill $color -tags $tags_wall + $w create line 340 210 340 201 -fill $color -tags $tags_wall + $w create line 340 247 340 224 -fill $color -tags $tags_wall + $w create line 340 241 307 241 -fill $color -tags $tags_wall + $w create line 376 247 376 170 -fill $color -tags $tags_wall + $w create line 307 250 307 170 -fill $color -tags $tags_wall + $w create line 376 170 307 170 -fill $color -tags $tags_wall + $w create line 315 129 315 170 -fill $color -tags $tags_wall + $w create line 376 283 366 283 -fill $color -tags $tags_wall + $w create line 376 283 376 275 -fill $color -tags $tags_wall + $w create line 399 275 376 275 -fill $color -tags $tags_wall + $w create line 341 275 320 275 -fill $color -tags $tags_wall + $w create line 341 283 350 283 -fill $color -tags $tags_wall + $w create line 298 275 298 329 -fill $color -tags $tags_wall + $w create line 308 275 298 275 -fill $color -tags $tags_wall + $w create line 243 322 243 275 -fill $color -tags $tags_wall + $w create line 243 275 284 275 -fill $color -tags $tags_wall + $w create line 258 322 226 322 -fill $color -tags $tags_wall + $w create line 212 370 212 322 -fill $color -tags $tags_wall + $w create line 214 322 177 322 -fill $color -tags $tags_wall + $w create line 163 370 163 322 -fill $color -tags $tags_wall + $w create line 165 322 129 322 -fill $color -tags $tags_wall + $w create line 84 322 117 322 -fill $color -tags $tags_wall + $w create line 71 322 64 322 -fill $color -tags $tags_wall + $w create line 115 322 115 370 -fill $color -tags $tags_wall + $w create line 66 322 66 370 -fill $color -tags $tags_wall + $w create line 52 322 21 322 -fill $color -tags $tags_wall + $w create line 21 331 0 331 -fill $color -tags $tags_wall + $w create line 21 331 21 133 -fill $color -tags $tags_wall + $w create line 96 133 21 133 -fill $color -tags $tags_wall + $w create line 176 129 96 129 -fill $color -tags $tags_wall + $w create line 315 133 176 133 -fill $color -tags $tags_wall + $w create line 315 129 399 129 -fill $color -tags $tags_wall + $w create line 399 311 350 311 -fill $color -tags $tags_wall + $w create line 350 329 258 329 -fill $color -tags $tags_wall + $w create line 258 322 258 370 -fill $color -tags $tags_wall + $w create line 60 370 258 370 -fill $color -tags $tags_wall + $w create line 60 370 60 391 -fill $color -tags $tags_wall + $w create line 0 391 0 331 -fill $color -tags $tags_wall + $w create line 60 391 0 391 -fill $color -tags $tags_wall + $w create line 307 250 307 242 -fill $color -tags $tags_wall + $w create line 273 250 307 250 -fill $color -tags $tags_wall + $w create line 258 250 243 250 -fill $color -tags $tags_wall } # Below is the "main program" that creates the floorplan demonstration. set w .floor global c currentRoom colors activeFloor -catch {destroy $w} +destroy $w toplevel $w wm title $w "Floorplan Canvas Demonstration" wm iconname $w "Floorplan" @@ -1363,4 +1380,4 @@ bind $c <2> "$c scan mark %x %y" bind $c <B2-Motion> "$c scan dragto %x %y" bind $c <Destroy> "unset currentRoom" set currentRoom "" -trace variable currentRoom w "roomChanged $c" +trace add variable currentRoom write "roomChanged $c" diff --git a/library/demos/fontchoose.tcl b/library/demos/fontchoose.tcl index def30c3..a449136 100644 --- a/library/demos/fontchoose.tcl +++ b/library/demos/fontchoose.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .fontchoose -catch {destroy $w} +destroy $w toplevel $w wm title $w "Font Selection Dialog" wm iconname $w "fontchooser" @@ -39,7 +39,6 @@ bind $w <<TkFontchooserVisibility>> { } } - set f [ttk::frame $w.f -relief sunken -padding 2] text $f.msg -font FontchooseDemoFont -width 40 -height 6 -borderwidth 0 \ diff --git a/library/demos/form.tcl b/library/demos/form.tcl index 4d80437..3461247 100644 --- a/library/demos/form.tcl +++ b/library/demos/form.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .form -catch {destroy $w} +destroy $w toplevel $w wm title $w "Form Demonstration" wm iconname $w "form" diff --git a/library/demos/goldberg.tcl b/library/demos/goldberg.tcl index 284b5c2..6c12f0e 100644 --- a/library/demos/goldberg.tcl +++ b/library/demos/goldberg.tcl @@ -43,7 +43,7 @@ if {![info exists widgetDemo]} { package require Tk set w .goldberg -catch {destroy $w} +destroy $w toplevel $w wm title $w "Tk Goldberg (demonstration)" wm iconname $w "goldberg" @@ -72,26 +72,54 @@ set S(cnt) 0 set S(message) "\\nWelcome\\nto\\nTcl/Tk" array set speed {1 10 2 20 3 50 4 80 5 100 6 150 7 200 8 300 9 400 10 500} -set MSTART 0; set MGO 1; set MPAUSE 2; set MSSTEP 3; set MBSTEP 4; set MDONE 5 -set S(mode) $::MSTART +set MSTART 0 +set MGO 1 +set MPAUSE 2 +set MSSTEP 3 +set MBSTEP 4 +set MDONE 5 +set S(mode) $MSTART # Colors for everything set C(fg) black set C(bg) gray75 set C(bg) cornflowerblue -set C(0) white; set C(1a) darkgreen; set C(1b) yellow -set C(2) red; set C(3a) green; set C(3b) darkblue -set C(4) $C(fg); set C(5a) brown; set C(5b) white -set C(6) magenta; set C(7) green; set C(8) $C(fg) -set C(9) blue4; set C(10a) white; set C(10b) cyan -set C(11a) yellow; set C(11b) mediumblue; set C(12) tan2 -set C(13a) yellow; set C(13b) red; set C(14) white -set C(15a) green; set C(15b) yellow; set C(16) gray65 -set C(17) \#A65353; set C(18) $C(fg); set C(19) gray50 -set C(20) cyan; set C(21) gray65; set C(22) $C(20) -set C(23a) blue; set C(23b) red; set C(23c) yellow -set C(24a) red; set C(24b) white; +set C(0) white +set C(1a) darkgreen +set C(1b) yellow +set C(2) red +set C(3a) green +set C(3b) darkblue +set C(4) $C(fg) +set C(5a) brown +set C(5b) white +set C(6) magenta +set C(7) green +set C(8) $C(fg) +set C(9) blue4 +set C(10a) white +set C(10b) cyan +set C(11a) yellow +set C(11b) mediumblue +set C(12) tan2 +set C(13a) yellow +set C(13b) red +set C(14) white +set C(15a) green +set C(15b) yellow +set C(16) gray65 +set C(17) "#A65353" +set C(18) $C(fg) +set C(19) gray50 +set C(20) cyan +set C(21) gray65 +set C(22) $C(20) +set C(23a) blue +set C(23b) red +set C(23c) yellow +set C(24a) red +set C(24b) white proc DoDisplay {w} { global S C @@ -107,6 +135,7 @@ proc DoDisplay {w} { bind $w.c <3> [list $w.pause invoke] bind $w.c <Destroy> { + global animationCallbacks after cancel $animationCallbacks(goldberg) unset animationCallbacks(goldberg) } @@ -153,9 +182,9 @@ proc DoCtrlFrame {w} { raise $w.details raise $w.details.cb grid rowconfigure $w.ctrl 50 -weight 1 - trace variable ::S(mode) w [list ActiveGUI $w] - trace variable ::S(details) w [list ActiveGUI $w] - trace variable ::S(speed) w [list ActiveGUI $w] + trace add variable ::S(mode) write [list ActiveGUI $w] + trace add variable ::S(details) write [list ActiveGUI $w] + trace add variable ::S(speed) write [list ActiveGUI $w] grid $w.message -in $w.ctrl -row 98 -sticky ew -pady 5 grid $w.message.e -sticky nsew @@ -228,9 +257,9 @@ proc ActiveGUI {w var1 var2 op} { set m $S(mode) set S(pause) [expr {$m == 2}] $w.start config -state $z([expr {$m != $MGO}]) - $w.pause config -state $z([expr {$m != $MSTART && $m != $MDONE}]) - $w.step config -state $z([expr {$m != $MGO && $m != $MDONE}]) - $w.bstep config -state $z([expr {$m != $MGO && $m != $MDONE}]) + $w.pause config -state $z([expr {($m != $MSTART) && ($m != $MDONE)}]) + $w.step config -state $z([expr {($m != $MGO) && ($m != $MDONE)}]) + $w.bstep config -state $z([expr {($m != $MGO) && ($m != $MDONE)}]) $w.reset config -state $z([expr {$m != $MSTART}]) if {$S(details)} { @@ -238,7 +267,7 @@ proc ActiveGUI {w var1 var2 op} { } else { grid forget $w.details.f } - set S(speed) [expr {round($S(speed))}] + set S(speed) [expr { round ($S(speed))}] $w.speed config -text "Speed: $S(speed)" } @@ -266,10 +295,10 @@ proc DoButton {w what} { } } -proc Go {w {who {}}} { +proc Go {w {who ""}} { global S speed animationCallbacks MGO MPAUSE MSSTEP MBSTEP - set now [clock clicks -milliseconds] + set now [clock milliseconds] catch {after cancel $animationCallbacks(goldberg)} if {$who ne ""} { ;# Start here for debugging set S(active) $who; @@ -283,11 +312,11 @@ proc Go {w {who {}}} { if {$S(mode) == $MSSTEP} { ;# Single step set S(mode) $MPAUSE } - if {$S(mode) == $MBSTEP && $n} { ;# Big step + if {($S(mode) == $MBSTEP) && $n} { ;# Big step set S(mode) $MSSTEP } - set elapsed [expr {[clock click -milliseconds] - $now}] + set elapsed [expr {[clock milliseconds] - $now}] set delay [expr {$speed($S(speed)) - $elapsed}] if {$delay <= 0} { set delay 1 @@ -300,11 +329,11 @@ proc NextStep {w} { global S MSTART MDONE set rval 0 ;# Return value - if {$S(mode) != $MSTART && $S(mode) != $MDONE} { + if {($S(mode) != $MSTART) && ($S(mode) != $MDONE)} { incr S(cnt) } - set alive {} - foreach {who} $S(active) { + set alive [list] + foreach who $S(active) { set n ["Move$who" $w] if {$n & 1} { ;# This guy still alive lappend alive $who @@ -315,7 +344,7 @@ proc NextStep {w} { } if {$n & 4} { ;# End of puzzle flag set S(mode) $MDONE ;# Done mode - set S(active) {} ;# No more animation + set S(active) "" ;# No more animation return 1 } } @@ -323,7 +352,8 @@ proc NextStep {w} { return $rval } proc About {w} { - set msg "$::S(title)\nby Keith Vetter, March 2003\n(Reproduced by kind\ + global S + set msg "$S(title)\nby Keith Vetter, March 2003\n(Reproduced by kind\ permission of the author)\n\n\"Man will always find a difficult\ means to perform a simple task.\"\nRube Goldberg" tk_messageBox -parent $w -message $msg -title About @@ -335,7 +365,8 @@ proc About {w} { # START HERE! banner proc Draw0 {w} { - set color $::C(0) + global C + set color $C(0) set xy {579 119} $w.c create text $xy -text "START HERE!" -fill $color -anchor w \ -tag I0 -font {{Times Roman} 12 italic bold} @@ -344,11 +375,12 @@ proc Draw0 {w} { -arrowshape {18 18 5} $w.c bind I0 <1> Start } -proc Move0 {w {step {}}} { - set step [GetStep 0 $step] +proc Move0 {w {a_step ""}} { + global S MSTART + set step [GetStep 0 $a_step] - if {$::S(mode) > $::MSTART} { ;# Start the ball rolling - MoveAbs $w I0 {-100 -100} ;# Hide the banner + if {$S(mode) > $MSTART} { ;# Start the ball rolling + MoveAbs $w I0 {-100 -100} ;# Hide the banner return 2 } @@ -363,19 +395,20 @@ proc Move0 {w {step {}}} { # Dropping ball proc Draw1 {w} { - set color $::C(1a) - set color2 $::C(1b) + global C + set color $C(1a) + set color2 $C(1b) set xy {844 133 800 133 800 346 820 346 820 168 844 168 844 133} - $w.c create poly $xy -width 3 -fill $color -outline {} + $w.c create poly $xy -width 3 -fill $color -outline "" set xy {771 133 685 133 685 168 751 168 751 346 771 346 771 133} - $w.c create poly $xy -width 3 -fill $color -outline {} + $w.c create poly $xy -width 3 -fill $color -outline "" set xy [box 812 122 9] - $w.c create oval $xy -tag I1 -fill $color2 -outline {} + $w.c create oval $xy -tag I1 -fill $color2 -outline "" $w.c bind I1 <1> Start } -proc Move1 {w {step {}}} { - set step [GetStep 1 $step] +proc Move1 {w {a_step ""}} { + set step [GetStep 1 $a_step] set pos { {807 122} {802 122} {797 123} {793 124} {789 129} {785 153} {785 203} {785 278 x} {785 367} {810 392} {816 438} {821 503} @@ -398,28 +431,29 @@ proc Move1 {w {step {}}} { # Lighting the match proc Draw2 {w} { + global C set color red - set color $::C(2) + set color $C(2) set xy {750 369 740 392 760 392} ;# Fulcrum - $w.c create poly $xy -fill $::C(fg) -outline $::C(fg) + $w.c create poly $xy -fill $C(fg) -outline $C(fg) set xy {628 335 660 383} ;# Strike box - $w.c create rect $xy -fill {} -outline $::C(fg) + $w.c create rect $xy -fill "" -outline $C(fg) for {set y 0} {$y < 3} {incr y} { - set yy [expr {335+$y*16}] + set yy [expr {335 + ($y * 16)}] $w.c create bitmap 628 $yy -bitmap gray25 -anchor nw \ - -foreground $::C(fg) + -foreground $C(fg) $w.c create bitmap 644 $yy -bitmap gray25 -anchor nw \ - -foreground $::C(fg) + -foreground $C(fg) } set xy {702 366 798 366} ;# Lever - $w.c create line $xy -fill $::C(fg) -width 6 -tag I2_0 + $w.c create line $xy -fill $C(fg) -width 6 -tag I2_0 set xy {712 363 712 355} ;# R strap - $w.c create line $xy -fill $::C(fg) -width 3 -tag I2_1 + $w.c create line $xy -fill $C(fg) -width 3 -tag I2_1 set xy {705 363 705 355} ;# L strap - $w.c create line $xy -fill $::C(fg) -width 3 -tag I2_2 + $w.c create line $xy -fill $C(fg) -width 3 -tag I2_2 set xy {679 356 679 360 717 360 717 356 679 356} ;# Match stick - $w.c create line $xy -fill $::C(fg) -tag I2_3 + $w.c create line $xy -fill $C(fg) -tag I2_3 #set xy {662 352 680 365} ;# Match head set xy { @@ -428,8 +462,9 @@ proc Draw2 {w} { } $w.c create poly $xy -fill $color -outline $color -tag I2_4 } -proc Move2 {w {step {}}} { - set step [GetStep 2 $step] +proc Move2 {w {a_step ""}} { + global C + set step [GetStep 2 $a_step] set stages {0 0 1 2 0 2 1 0 1 2 0 2 1} set xy(0) { @@ -453,39 +488,40 @@ proc Move2 {w {step {}}} { for {set i 0} {[$w.c find withtag I2_$i] ne ""} {incr i} { RotateItem $w I2_$i $Ox $Oy $beta } - $w.c create poly -tag I2 -smooth 1 -fill $::C(2) ;# For the flame + $w.c create poly -tag I2 -smooth 1 -fill $C(2) ;# For the flame return 1 } $w.c coords I2 $xy([lindex $stages $step]) - return [expr {$step == 7 ? 3 : 1}] + return [expr {($step == 7) ? 3 : 1}] } # Weight and pulleys proc Draw3 {w} { - set color $::C(3a) - set color2 $::C(3b) + global C + set color $C(3a) + set color2 $C(3b) set xy {602 296 577 174 518 174} foreach {x y} $xy { ;# 3 Pulleys - $w.c create oval [box $x $y 13] -fill $color -outline $::C(fg) \ + $w.c create oval [box $x $y 13] -fill $color -outline $C(fg) \ -width 3 - $w.c create oval [box $x $y 2] -fill $::C(fg) -outline $::C(fg) + $w.c create oval [box $x $y 2] -fill $C(fg) -outline $C(fg) } set xy {750 309 670 309} ;# Wall to flame - $w.c create line $xy -tag I3_s -width 3 -fill $::C(fg) -smooth 1 + $w.c create line $xy -tag I3_s -width 3 -fill $C(fg) -smooth 1 set xy {670 309 650 309} ;# Flame to pulley 1 - $w.c create line $xy -tag I3_0 -width 3 -fill $::C(fg) + $w.c create line $xy -tag I3_0 -width 3 -fill $C(fg) set xy {650 309 600 309} ;# Flame to pulley 1 - $w.c create line $xy -tag I3_1 -width 3 -fill $::C(fg) + $w.c create line $xy -tag I3_1 -width 3 -fill $C(fg) set xy {589 296 589 235} ;# Pulley 1 half way to 2 - $w.c create line $xy -tag I3_2 -width 3 -fill $::C(fg) + $w.c create line $xy -tag I3_2 -width 3 -fill $C(fg) set xy {589 235 589 174} ;# Pulley 1 other half to 2 - $w.c create line $xy -width 3 -fill $::C(fg) + $w.c create line $xy -width 3 -fill $C(fg) set xy {577 161 518 161} ;# Across the top - $w.c create line $xy -width 3 -fill $::C(fg) + $w.c create line $xy -width 3 -fill $C(fg) set xy {505 174 505 205} ;# Down to weight - $w.c create line $xy -tag I3_w -width 3 -fill $::C(fg) + $w.c create line $xy -tag I3_w -width 3 -fill $C(fg) # Draw the weight as 2 circles, two rectangles and 1 rounded rectangle set xy {515 207 495 207} @@ -494,7 +530,8 @@ proc Draw3 {w} { -outline $color2 $w.c create oval [box $x2 $y2 6] -tag I3_ -fill $color2 \ -outline $color2 - incr y1 -6; incr y2 6 + incr y1 -6 + incr y2 6 $w.c create rect $x1 $y1 $x2 $y2 -tag I3_ -fill $color2 \ -outline $color2 } @@ -505,10 +542,10 @@ proc Draw3 {w} { $w.c create line $xy -tag I3_ -fill $color2 -width 10 set xy {502 393 522 393 522 465} ;# Bottom weight target - $w.c create line $xy -tag I3__ -fill $::C(fg) -join miter -width 10 + $w.c create line $xy -tag I3__ -fill $C(fg) -join miter -width 10 } -proc Move3 {w {step {}}} { - set step [GetStep 3 $step] +proc Move3 {w {a_step ""}} { + set step [GetStep 3 $a_step] set pos {{505 247} {505 297} {505 386.5} {505 386.5}} set rope(0) {750 309 729 301 711 324 690 300} @@ -533,7 +570,8 @@ proc Move3 {w {step {}}} { # Cage and door proc Draw4 {w} { - set color $::C(4) + global C + set color $C(4) lassign {527 356 611 464} x0 y0 x1 y1 for {set y $y0} {$y <= $y1} {incr y 12} { ;# Horizontal bars @@ -546,8 +584,8 @@ proc Draw4 {w} { set xy {518 464 518 428} ;# Swing gate $w.c create line $xy -tag I4 -fill $color -width 3 } -proc Move4 {w {step {}}} { - set step [GetStep 4 $step] +proc Move4 {w {a_step ""}} { + set step [GetStep 4 $a_step] set angles {-10 -20 -30 -30} if {$step >= [llength $angles]} { @@ -555,16 +593,17 @@ proc Move4 {w {step {}}} { } RotateItem $w I4 518 464 [lindex $angles $step] $w.c raise I4 - return [expr {$step == 3 ? 3 : 1}] + return [expr {($step == 3) ? 3 : 1}] } # Mouse proc Draw5 {w} { - set color $::C(5a) - set color2 $::C(5b) + global C + set color $C(5a) + set color2 $C(5b) set xy {377 248 410 248 410 465 518 465} ;# Mouse course lappend xy 518 428 451 428 451 212 377 212 - $w.c create poly $xy -fill $color2 -outline $::C(fg) -width 3 + $w.c create poly $xy -fill $color2 -outline $C(fg) -width 3 set xy { 534.5 445.5 541 440 552 436 560 436 569 440 574 446 575 452 574 454 @@ -575,8 +614,8 @@ proc Draw5 {w} { $w.c create line $xy -tag {I5 I5_1} -fill $color -smooth 1 -width 3 set xy [box 540 446 2] ;# Eye set xy {540 444 541 445 541 447 540 448 538 447 538 445} - #.c create oval $xy -tag {I5 I5_2} -fill $::C(bg) -outline {} - $w.c create poly $xy -tag {I5 I5_2} -fill $::C(bg) -outline {} -smooth 1 + #.c create oval $xy -tag {I5 I5_2} -fill $C(bg) -outline "" + $w.c create poly $xy -tag {I5 I5_2} -fill $C(bg) -outline "" -smooth 1 set xy {538 454 535 461} ;# Front leg $w.c create line $xy -tag {I5 I5_3} -fill $color -width 2 set xy {566 455 569 462} ;# Back leg @@ -586,8 +625,8 @@ proc Draw5 {w} { set xy {560 455 558 460} ;# 2nd back leg $w.c create line $xy -tag {I5 I5_6} -fill $color -width 2 } -proc Move5 {w {step {}}} { - set step [GetStep 5 $step] +proc Move5 {w {a_step ""}} { + set step [GetStep 5 $a_step] set pos { {553 452} {533 452} {513 452} {493 452} {473 452} @@ -628,47 +667,48 @@ array set XY6 { 13,16 {360 403} } proc Draw6 {w} { - set color $::C(6) + global C XY6 + set color $C(6) set xy {324 130 391 204} ;# Ball holder set xy [RoundRect $w $xy 10] - $w.c create poly $xy -smooth 1 -outline $::C(fg) -width 3 -fill $color + $w.c create poly $xy -smooth 1 -outline $C(fg) -width 3 -fill $color set xy {339 204 376 253} ;# Below the ball holder - $w.c create rect $xy -fill {} -outline $::C(fg) -width 3 -fill $color \ + $w.c create rect $xy -fill "" -outline $C(fg) -width 3 -fill $color \ -tag I6c set xy [box 346 339 28] - $w.c create oval $xy -fill $color -outline {} ;# Rotor - $w.c create arc $xy -outline $::C(fg) -width 2 -style arc \ + $w.c create oval $xy -fill $color -outline "" ;# Rotor + $w.c create arc $xy -outline $C(fg) -width 2 -style arc \ -start 80 -extent 205 - $w.c create arc $xy -outline $::C(fg) -width 2 -style arc \ + $w.c create arc $xy -outline $C(fg) -width 2 -style arc \ -start -41 -extent 85 set xy [box 346 339 15] ;# Center of rotor - $w.c create oval $xy -outline $::C(fg) -fill $::C(fg) -tag I6m + $w.c create oval $xy -outline $C(fg) -fill $C(fg) -tag I6m set xy {352 312 352 254 368 254 368 322} ;# Top drop to rotor - $w.c create poly $xy -fill $color -outline {} - $w.c create line $xy -fill $::C(fg) -width 2 + $w.c create poly $xy -fill $color -outline "" + $w.c create line $xy -fill $C(fg) -width 2 set xy {353 240 367 300} ;# Poke bottom hole - $w.c create rect $xy -fill $color -outline {} + $w.c create rect $xy -fill $color -outline "" set xy {341 190 375 210} ;# Poke another hole - $w.c create rect $xy -fill $color -outline {} + $w.c create rect $xy -fill $color -outline "" set xy {368 356 368 403 389 403 389 464 320 464 320 403 352 403 352 366} - $w.c create poly $xy -fill $color -outline {} -width 2 ;# Below rotor - $w.c create line $xy -fill $::C(fg) -width 2 + $w.c create poly $xy -fill $color -outline "" -width 2 ;# Below rotor + $w.c create line $xy -fill $C(fg) -width 2 set xy [box 275 342 7] ;# On/off rotor - $w.c create oval $xy -outline $::C(fg) -fill $::C(fg) + $w.c create oval $xy -outline $C(fg) -fill $C(fg) set xy {276 334 342 325} ;# Fan belt top - $w.c create line $xy -fill $::C(fg) -width 3 + $w.c create line $xy -fill $C(fg) -width 3 set xy {276 349 342 353} ;# Fan belt bottom - $w.c create line $xy -fill $::C(fg) -width 3 + $w.c create line $xy -fill $C(fg) -width 3 set xy {337 212 337 247} ;# What the mouse pushes - $w.c create line $xy -fill $::C(fg) -width 3 -tag I6_ + $w.c create line $xy -fill $C(fg) -width 3 -tag I6_ set xy {392 212 392 247} - $w.c create line $xy -fill $::C(fg) -width 3 -tag I6_ + $w.c create line $xy -fill $C(fg) -width 3 -tag I6_ set xy {337 230 392 230} - $w.c create line $xy -fill $::C(fg) -width 7 -tag I6_ + $w.c create line $xy -fill $C(fg) -width 7 -tag I6_ set who -1 ;# All the balls set colors {red cyan orange green blue darkblue} @@ -677,24 +717,26 @@ proc Draw6 {w} { for {set i 0} {$i < 17} {incr i} { set loc [expr {-1 * $i}] set color [lindex $colors $i] - $w.c create oval [box {*}$::XY6($loc) 5] -fill $color \ + $w.c create oval [box {*}$XY6($loc) 5] -fill $color \ -outline $color -tag I6_b$i } Draw6a $w 12 ;# The wheel } proc Draw6a {w beta} { + global C $w.c delete I6_0 lassign {346 339} Ox Oy for {set i 0} {$i < 4} {incr i} { - set b [expr {$beta + $i * 45}] + set b [expr {$beta + ($i * 45)}] lassign [RotateC 28 0 0 0 $b] x y - set xy [list [expr {$Ox+$x}] [expr {$Oy+$y}] \ - [expr {$Ox-$x}] [expr {$Oy-$y}]] - $w.c create line $xy -tag I6_0 -fill $::C(fg) -width 2 + set xy [list [expr {$Ox + $x}] [expr {$Oy + $y}] \ + [expr {$Ox - $x}] [expr {$Oy - $y}]] + $w.c create line $xy -tag I6_0 -fill $C(fg) -width 2 } } -proc Move6 {w {step {}}} { - set step [GetStep 6 $step] +proc Move6 {w {a_step ""}} { + global XY6 + set step [GetStep 6 $a_step] if {$step > 62} { return 0 } @@ -703,21 +745,21 @@ proc Move6 {w {step {}}} { $w.c move I6_ -7 0 if {$step == 1} { ;# Poke a hole set xy {348 226 365 240} - $w.c create rect $xy -fill [$w.c itemcget I6c -fill] -outline {} + $w.c create rect $xy -fill [$w.c itemcget I6c -fill] -outline "" } return 1 } set s [expr {$step - 1}] ;# Do the gumball drop dance - for {set i 0} {$i <= int(($s-1) / 3)} {incr i} { + for {set i 0} {$i <= ( int (($s - 1) / 3))} {incr i} { set tag "I6_b$i" if {[$w.c find withtag $tag] eq ""} break - set loc [expr {$s - 3 * $i}] + set loc [expr {$s - (3 * $i)}] if {[info exists ::XY6($loc,$i)]} { - MoveAbs $w $tag $::XY6($loc,$i) + MoveAbs $w $tag $XY6($loc,$i) } elseif {[info exists ::XY6($loc)]} { - MoveAbs $w $tag $::XY6($loc) + MoveAbs $w $tag $XY6($loc) } } if {($s % 3) == 1} { @@ -726,38 +768,39 @@ proc Move6 {w {step {}}} { set tag "I6_b$i" if {[$w.c find withtag $tag] eq ""} break set loc [expr {$first - $i}] - MoveAbs $w $tag $::XY6($loc) + MoveAbs $w $tag $XY6($loc) } } if {$s >= 3} { ;# Rotate the motor set idx [expr {$s % 3}] #Draw6a $w [lindex {12 35 64} $idx] - Draw6a $w [expr {12 + $s * 15}] + Draw6a $w [expr {12 + ($s * 15)}] } - return [expr {$s == 3 ? 3 : 1}] + return [expr {($s == 3) ? 3 : 1}] } # On/off switch proc Draw7 {w} { - set color $::C(7) + global C + set color $C(7) set xy {198 306 277 374} ;# Box - $w.c create rect $xy -outline $::C(fg) -width 2 -fill $color -tag I7z + $w.c create rect $xy -outline $C(fg) -width 2 -fill $color -tag I7z $w.c lower I7z set xy {275 343 230 349} - $w.c create line $xy -tag I7 -fill $::C(fg) -arrow last \ + $w.c create line $xy -tag I7 -fill $C(fg) -arrow last \ -arrowshape {23 23 8} -width 6 set xy {225 324} ;# On button - $w.c create oval [box {*}$xy 3] -fill $::C(fg) -outline $::C(fg) + $w.c create oval [box {*}$xy 3] -fill $C(fg) -outline $C(fg) set xy {218 323} ;# On text set font {{Times Roman} 8} - $w.c create text $xy -text "on" -anchor e -fill $::C(fg) -font $font + $w.c create text $xy -text "on" -anchor e -fill $C(fg) -font $font set xy {225 350} ;# Off button - $w.c create oval [box {*}$xy 3] -fill $::C(fg) -outline $::C(fg) + $w.c create oval [box {*}$xy 3] -fill $C(fg) -outline $C(fg) set xy {218 349} ;# Off button - $w.c create text $xy -text "off" -anchor e -fill $::C(fg) -font $font + $w.c create text $xy -text "off" -anchor e -fill $C(fg) -font $font } -proc Move7 {w {step {}}} { - set step [GetStep 7 $step] +proc Move7 {w {a_step ""}} { + set step [GetStep 7 $a_step] set numsteps 30 if {$step > $numsteps} { return 0 @@ -765,15 +808,16 @@ proc Move7 {w {step {}}} { set beta [expr {30.0 / $numsteps}] RotateItem $w I7 275 343 $beta - return [expr {$step == $numsteps ? 3 : 1}] + return [expr {($step == $numsteps) ? 3 : 1}] } # Electricity to the fan proc Draw8 {w} { - Sine $w 271 248 271 306 5 8 -tag I8_s -fill $::C(8) -width 3 + global C + Sine $w 271 248 271 306 5 8 -tag I8_s -fill $C(8) -width 3 } -proc Move8 {w {step {}}} { - set step [GetStep 8 $step] +proc Move8 {w {a_step ""}} { + set step [GetStep 8 $a_step] if {$step > 3} { return 0 @@ -789,12 +833,13 @@ proc Move8 {w {step {}}} { } else { $w.c delete I8 } - return [expr {$step == 2 ? 3 : 1}] + return [expr {($step == 2) ? 3 : 1}] } # Fan proc Draw9 {w} { - set color $::C(9) + global C + set color $C(9) set xy {266 194 310 220} $w.c create oval $xy -outline $color -fill $color set xy {280 209 296 248} @@ -806,16 +851,16 @@ proc Draw9 {w} { $w.c create poly $xy -fill $color set xy {255 206 265 234} ;# Fan blades - $w.c create oval $xy -fill {} -outline $::C(fg) -width 3 -tag I9_0 + $w.c create oval $xy -fill "" -outline $C(fg) -width 3 -tag I9_0 set xy {255 176 265 204} - $w.c create oval $xy -fill {} -outline $::C(fg) -width 3 -tag I9_0 + $w.c create oval $xy -fill "" -outline $C(fg) -width 3 -tag I9_0 set xy {255 206 265 220} - $w.c create oval $xy -fill {} -outline $::C(fg) -width 1 -tag I9_1 + $w.c create oval $xy -fill "" -outline $C(fg) -width 1 -tag I9_1 set xy {255 190 265 204} - $w.c create oval $xy -fill {} -outline $::C(fg) -width 1 -tag I9_1 + $w.c create oval $xy -fill "" -outline $C(fg) -width 1 -tag I9_1 } -proc Move9 {w {step {}}} { - set step [GetStep 9 $step] +proc Move9 {w {a_step ""}} { + set step [GetStep 9 $a_step] if {$step & 1} { $w.c itemconfig I9_0 -width 4 @@ -834,27 +879,28 @@ proc Move9 {w {step {}}} { # Boat proc Draw10 {w} { - set color $::C(10a) - set color2 $::C(10b) + global C + set color $C(10a) + set color2 $C(10b) set xy {191 230 233 230 233 178 191 178} ;# Sail - $w.c create poly $xy -fill $color -width 3 -outline $::C(fg) -tag I10 + $w.c create poly $xy -fill $color -width 3 -outline $C(fg) -tag I10 set xy [box 209 204 31] ;# Front - $w.c create arc $xy -outline {} -fill $color -style pie \ + $w.c create arc $xy -outline "" -fill $color -style pie \ -start 120 -extent 120 -tag I10 - $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \ + $w.c create arc $xy -outline $C(fg) -width 3 -style arc \ -start 120 -extent 120 -tag I10 set xy [box 249 204 31] ;# Back - $w.c create arc $xy -outline {} -fill $::C(bg) -width 3 -style pie \ + $w.c create arc $xy -outline "" -fill $C(bg) -width 3 -style pie \ -start 120 -extent 120 -tag I10 - $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \ + $w.c create arc $xy -outline $C(fg) -width 3 -style arc \ -start 120 -extent 120 -tag I10 set xy {200 171 200 249} ;# Mast - $w.c create line $xy -fill $::C(fg) -width 3 -tag I10 + $w.c create line $xy -fill $C(fg) -width 3 -tag I10 set xy {159 234 182 234} ;# Bow sprit - $w.c create line $xy -fill $::C(fg) -width 3 -tag I10 + $w.c create line $xy -fill $C(fg) -width 3 -tag I10 set xy {180 234 180 251 220 251} ;# Hull - $w.c create line $xy -fill $::C(fg) -width 6 -tag I10 + $w.c create line $xy -fill $C(fg) -width 6 -tag I10 set xy {92 255 221 255} ;# Waves Sine $w {*}$xy 2 25 -fill $color2 -width 1 -tag I10w @@ -863,16 +909,16 @@ proc Draw10 {w} { set xy [concat $xy 222 266 222 277 99 277] $w.c create poly $xy -fill $color2 -outline $color2 set xy {222 266 222 277 97 277 97 266} ;# Water bottom - $w.c create line $xy -fill $::C(fg) -width 3 + $w.c create line $xy -fill $C(fg) -width 3 set xy [box 239 262 17] - $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \ + $w.c create arc $xy -outline $C(fg) -width 3 -style arc \ -start 95 -extent 103 set xy [box 76 266 21] - $w.c create arc $xy -outline $::C(fg) -width 3 -style arc -extent 190 + $w.c create arc $xy -outline $C(fg) -width 3 -style arc -extent 190 } -proc Move10 {w {step {}}} { - set step [GetStep 10 $step] +proc Move10 {w {a_step ""}} { + set step [GetStep 10 $a_step] set pos { {195 212} {193 212} {190 212} {186 212} {181 212} {176 212} {171 212} {166 212} {161 212} {156 212} {151 212} {147 212} {142 212} @@ -893,34 +939,35 @@ proc Move10 {w {step {}}} { # 2nd ball drop proc Draw11 {w} { - set color $::C(11a) - set color2 $::C(11b) + global C + set color $C(11a) + set color2 $C(11b) set xy {23 264 55 591} ;# Color the down tube - $w.c create rect $xy -fill $color -outline {} + $w.c create rect $xy -fill $color -outline "" set xy [box 71 460 48] ;# Color the outer loop - $w.c create oval $xy -fill $color -outline {} + $w.c create oval $xy -fill $color -outline "" set xy {55 264 55 458} ;# Top right side - $w.c create line $xy -fill $::C(fg) -width 3 + $w.c create line $xy -fill $C(fg) -width 3 set xy {55 504 55 591} ;# Bottom right side - $w.c create line $xy -fill $::C(fg) -width 3 + $w.c create line $xy -fill $C(fg) -width 3 set xy [box 71 460 48] ;# Outer loop - $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \ + $w.c create arc $xy -outline $C(fg) -width 3 -style arc \ -start 110 -extent -290 -tag I11i set xy [box 71 460 16] ;# Inner loop - $w.c create oval $xy -outline $::C(fg) -fill {} -width 3 -tag I11i - $w.c create oval $xy -outline $::C(fg) -fill $::C(bg) -width 3 + $w.c create oval $xy -outline $C(fg) -fill "" -width 3 -tag I11i + $w.c create oval $xy -outline $C(fg) -fill $C(bg) -width 3 set xy {23 264 23 591} ;# Left side - $w.c create line $xy -fill $::C(fg) -width 3 + $w.c create line $xy -fill $C(fg) -width 3 set xy [box 1 266 23] ;# Top left curve - $w.c create arc $xy -outline $::C(fg) -width 3 -style arc -extent 90 + $w.c create arc $xy -outline $C(fg) -width 3 -style arc -extent 90 set xy [box 75 235 9] ;# The ball - $w.c create oval $xy -fill $color2 -outline {} -width 3 -tag I11 + $w.c create oval $xy -fill $color2 -outline "" -width 3 -tag I11 } -proc Move11 {w {step {}}} { - set step [GetStep 11 $step] +proc Move11 {w {a_step ""}} { + set step [GetStep 11 $a_step] set pos { {75 235} {70 235} {65 237} {56 240} {46 247} {38 266} {38 296} {38 333} {38 399} {38 475} {74 496} {105 472} {100 437} {65 423} @@ -940,6 +987,7 @@ proc Move11 {w {step {}}} { # Hand proc Draw12 {w} { + global C set xy {20 637 20 617 20 610 20 590 40 590 40 590 60 590 60 610 60 610} lappend xy 60 610 65 620 60 631 ;# Thumb lappend xy 60 631 60 637 60 662 60 669 52 669 56 669 50 669 50 662 50 637 @@ -951,11 +999,11 @@ proc Draw12 {w} { set x2 [expr {$x - 10}] lappend xy $x $y0 $x1 $y1 $x2 $y0 } - $w.c create poly $xy -fill $::C(12) -outline $::C(fg) -smooth 1 -tag I12 \ + $w.c create poly $xy -fill $C(12) -outline $C(fg) -smooth 1 -tag I12 \ -width 3 } -proc Move12 {w {step {}}} { - set step [GetStep 12 $step] +proc Move12 {w {a_step ""}} { + set step [GetStep 12 $a_step] set pos {{42.5 641 x}} if {$step >= [llength $pos]} { return 0 @@ -971,42 +1019,44 @@ proc Move12 {w {step {}}} { # Fax proc Draw13 {w} { - set color $::C(13a) + global C + set color $C(13a) set xy {86 663 149 663 149 704 50 704 50 681 64 681 86 671} set xy2 {784 663 721 663 721 704 820 704 820 681 806 681 784 671} set radii {2 9 9 8 5 5 2} - RoundPoly $w.c $xy $radii -width 3 -outline $::C(fg) -fill $color - RoundPoly $w.c $xy2 $radii -width 3 -outline $::C(fg) -fill $color + RoundPoly $w.c $xy $radii -width 3 -outline $C(fg) -fill $color + RoundPoly $w.c $xy2 $radii -width 3 -outline $C(fg) -fill $color set xy {56 677} - $w.c create rect [box {*}$xy 4] -fill {} -outline $::C(fg) -width 3 \ + $w.c create rect [box {*}$xy 4] -fill "" -outline $C(fg) -width 3 \ -tag I13 set xy {809 677} - $w.c create rect [box {*}$xy 4] -fill {} -outline $::C(fg) -width 3 \ + $w.c create rect [box {*}$xy 4] -fill "" -outline $C(fg) -width 3 \ -tag I13R set xy {112 687} ;# Label - $w.c create text $xy -text "FAX" -fill $::C(fg) \ - -font {{Times Roman} 12 bold} + $w.c create text $xy -text "FAX" -fill $C(fg) \ + -font "{Times Roman} 12 bold" set xy {762 687} - $w.c create text $xy -text "FAX" -fill $::C(fg) \ - -font {{Times Roman} 12 bold} + $w.c create text $xy -text "FAX" -fill $C(fg) \ + -font "{Times Roman} 12 bold" set xy {138 663 148 636 178 636} ;# Paper guide - $w.c create line $xy -smooth 1 -fill $::C(fg) -width 3 + $w.c create line $xy -smooth 1 -fill $C(fg) -width 3 set xy {732 663 722 636 692 636} - $w.c create line $xy -smooth 1 -fill $::C(fg) -width 3 + $w.c create line $xy -smooth 1 -fill $C(fg) -width 3 - Sine $w 149 688 720 688 5 15 -tag I13_s -fill $::C(fg) -width 3 + Sine $w 149 688 720 688 5 15 -tag I13_s -fill $C(fg) -width 3 } -proc Move13 {w {step {}}} { - set step [GetStep 13 $step] +proc Move13 {w {a_step ""}} { + global C + set step [GetStep 13 $a_step] set numsteps 7 - if {$step == $numsteps+2} { + if {$step == ($numsteps + 2)} { MoveAbs $w I13_star {-100 -100} - $w.c itemconfig I13R -fill $::C(13b) -width 2 + $w.c itemconfig I13R -fill $C(13b) -width 2 return 2 } if {$step == 0} { ;# Button down @@ -1016,14 +1066,15 @@ proc Move13 {w {step {}}} { } lassign [Anchor $w I13_s w] x0 y0 lassign [Anchor $w I13_s e] x1 y1 - set x [expr {$x0 + ($x1-$x0) * ($step - 1) / double($numsteps)}] + set x [expr {$x0 + ((($x1 - $x0) * ($step - 1)) / (1.0 * $numsteps))}] MoveAbs $w I13_star [list $x $y0] return 1 } # Paper in fax proc Draw14 {w} { - set color $::C(14) + global C + set color $C(14) set xy {102 661 113 632 130 618} ;# Left paper edge $w.c create line $xy -smooth 1 -fill $color -width 3 -tag I14L_0 set xy {148 629 125 640 124 662} ;# Right paper edge @@ -1044,7 +1095,8 @@ proc Draw14 {w} { $w.c lower I14R_1 } proc Draw14a {w side} { - set color $::C(14) + global C + set color $C(14) set xy [$w.c coords I14${side}_0] set xy2 [$w.c coords I14${side}_1] lassign $xy x0 y0 x1 y1 x2 y2 @@ -1057,12 +1109,12 @@ proc Draw14a {w side} { -width 3 $w.c lower I14$side } -proc Move14 {w {step {}}} { - set step [GetStep 14 $step] +proc Move14 {w {a_step ""}} { + set step [GetStep 14 $a_step] # Paper going down - set sc [expr {.9 - .05*$step}] - if {$sc < .3} { + set sc [expr {0.9 - (0.05 * $step)}] + if {$sc < 0.3} { $w.c delete I14L return 0 } @@ -1074,7 +1126,7 @@ proc Move14 {w {step {}}} { Draw14a $w L # Paper going up - set sc [expr {.35 + .05*$step}] + set sc [expr {0.35 + (0.05 * $step)}] set sc [expr {1 / $sc}] lassign [$w.c coords I14R_0] Ox Oy @@ -1083,41 +1135,43 @@ proc Move14 {w {step {}}} { $w.c scale I14R_1 $Ox $Oy $sc $sc Draw14a $w R - return [expr {$step == 10 ? 3 : 1}] + return [expr {($step == 10) ? 3 : 1}] } # Light beam proc Draw15 {w} { - set color $::C(15a) + global C + set color $C(15a) set xy {824 599 824 585 820 585 829 585} - $w.c create line $xy -fill $::C(fg) -width 3 -tag I15a + $w.c create line $xy -fill $C(fg) -width 3 -tag I15a set xy {789 599 836 643} - $w.c create rect $xy -fill $color -outline $::C(fg) -width 3 + $w.c create rect $xy -fill $color -outline $C(fg) -width 3 set xy {778 610 788 632} - $w.c create rect $xy -fill $color -outline $::C(fg) -width 3 + $w.c create rect $xy -fill $color -outline $C(fg) -width 3 set xy {766 617 776 625} - $w.c create rect $xy -fill $color -outline $::C(fg) -width 3 + $w.c create rect $xy -fill $color -outline $C(fg) -width 3 set xy {633 600 681 640} - $w.c create rect $xy -fill $color -outline $::C(fg) -width 3 + $w.c create rect $xy -fill $color -outline $C(fg) -width 3 set xy {635 567 657 599} - $w.c create rect $xy -fill $color -outline $::C(fg) -width 2 + $w.c create rect $xy -fill $color -outline $C(fg) -width 2 set xy {765 557 784 583} - $w.c create rect $xy -fill $color -outline $::C(fg) -width 2 + $w.c create rect $xy -fill $color -outline $C(fg) -width 2 - Sine $w 658 580 765 580 3 15 -tag I15_s -fill $::C(fg) -width 3 + Sine $w 658 580 765 580 3 15 -tag I15_s -fill $C(fg) -width 3 } proc Move15a {w} { - set color $::C(15b) + global C + set color $C(15b) $w.c scale I15a 824 599 1 .3 ;# Button down set xy {765 621 681 621} $w.c create line $xy -dash "-" -width 3 -fill $color -tag I15 } -proc Move15 {w {step {}}} { - set step [GetStep 15 $step] +proc Move15 {w {a_step ""}} { + set step [GetStep 15 $a_step] set numsteps 6 - if {$step == $numsteps+2} { + if {$step == ($numsteps + 2)} { MoveAbs $w I15_star {-100 -100} return 2 } @@ -1129,28 +1183,29 @@ proc Move15 {w {step {}}} { } lassign [Anchor $w I15_s w] x0 y0 lassign [Anchor $w I15_s e] x1 y1 - set x [expr {$x0 + ($x1-$x0) * ($step - 1) / double($numsteps)}] + set x [expr {$x0 + ((($x1 - $x0) * ($step - 1)) / (1.0 * $numsteps))}] MoveAbs $w I15_star [list $x $y0] return 1 } # Bell proc Draw16 {w} { - set color $::C(16) + global C + set color $C(16) set xy {722 485 791 556} - $w.c create rect $xy -fill {} -outline $::C(fg) -width 3 + $w.c create rect $xy -fill "" -outline $C(fg) -width 3 set xy [box 752 515 25] ;# Bell $w.c create oval $xy -fill $color -outline black -tag I16b -width 2 set xy [box 752 515 5] ;# Bell button $w.c create oval $xy -fill black -outline black -tag I16b set xy {784 523 764 549} ;# Clapper - $w.c create line $xy -width 3 -tag I16c -fill $::C(fg) + $w.c create line $xy -width 3 -tag I16c -fill $C(fg) set xy [box 784 523 4] - $w.c create oval $xy -fill $::C(fg) -outline $::C(fg) -tag I16d + $w.c create oval $xy -fill $C(fg) -outline $C(fg) -tag I16d } -proc Move16 {w {step {}}} { - set step [GetStep 16 $step] +proc Move16 {w {a_step ""}} { + set step [GetStep 16 $a_step] # Note: we never stop lassign {760 553} Ox Oy @@ -1164,73 +1219,75 @@ proc Move16 {w {step {}}} { RotateItem $w I16c $Ox $Oy $beta RotateItem $w I16d $Ox $Oy $beta - return [expr {$step == 1 ? 3 : 1}] + return [expr {($step == 1) ? 3 : 1}] } # Cat proc Draw17 {w} { - set color $::C(17) + global C + set color $C(17) set xy {584 556 722 556} - $w.c create line $xy -fill $::C(fg) -width 3 + $w.c create line $xy -fill $C(fg) -width 3 set xy {584 485 722 485} - $w.c create line $xy -fill $::C(fg) -width 3 + $w.c create line $xy -fill $C(fg) -width 3 set xy {664 523 717 549} ;# Body - $w.c create arc $xy -outline $::C(fg) -fill $color -width 3 \ + $w.c create arc $xy -outline $C(fg) -fill $color -width 3 \ -style chord -start 128 -extent -260 -tag I17 set xy {709 554 690 543} ;# Paw - $w.c create oval $xy -outline $::C(fg) -fill $color -width 3 -tag I17 + $w.c create oval $xy -outline $C(fg) -fill $color -width 3 -tag I17 set xy {657 544 676 555} - $w.c create oval $xy -outline $::C(fg) -fill $color -width 3 -tag I17 + $w.c create oval $xy -outline $C(fg) -fill $color -width 3 -tag I17 set xy [box 660 535 15] ;# Lower face - $w.c create arc $xy -outline $::C(fg) -width 3 -style arc \ + $w.c create arc $xy -outline $C(fg) -width 3 -style arc \ -start 150 -extent 240 -tag I17_ - $w.c create arc $xy -outline {} -fill $color -width 1 -style chord \ + $w.c create arc $xy -outline "" -fill $color -width 1 -style chord \ -start 150 -extent 240 -tag I17_ set xy {674 529 670 513 662 521 658 521 650 513 647 529} ;# Ears - $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_ - $w.c create poly $xy -fill $color -outline {} -width 1 -tag {I17_ I17_c} + $w.c create line $xy -fill $C(fg) -width 3 -tag I17_ + $w.c create poly $xy -fill $color -outline "" -width 1 -tag {I17_ I17_c} set xy {652 542 628 539} ;# Whiskers - $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_ + $w.c create line $xy -fill $C(fg) -width 3 -tag I17_ set xy {652 543 632 545} - $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_ + $w.c create line $xy -fill $C(fg) -width 3 -tag I17_ set xy {652 546 632 552} - $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_ + $w.c create line $xy -fill $C(fg) -width 3 -tag I17_ set xy {668 543 687 538} - $w.c create line $xy -fill $::C(fg) -width 3 -tag {I17_ I17w} + $w.c create line $xy -fill $C(fg) -width 3 -tag {I17_ I17w} set xy {668 544 688 546} - $w.c create line $xy -fill $::C(fg) -width 3 -tag {I17_ I17w} + $w.c create line $xy -fill $C(fg) -width 3 -tag {I17_ I17w} set xy {668 547 688 553} - $w.c create line $xy -fill $::C(fg) -width 3 -tag {I17_ I17w} + $w.c create line $xy -fill $C(fg) -width 3 -tag {I17_ I17w} set xy {649 530 654 538 659 530} ;# Left eye - $w.c create line $xy -fill $::C(fg) -width 2 -smooth 1 -tag I17 + $w.c create line $xy -fill $C(fg) -width 2 -smooth 1 -tag I17 set xy {671 530 666 538 661 530} ;# Right eye - $w.c create line $xy -fill $::C(fg) -width 2 -smooth 1 -tag I17 + $w.c create line $xy -fill $C(fg) -width 2 -smooth 1 -tag I17 set xy {655 543 660 551 665 543} ;# Mouth - $w.c create line $xy -fill $::C(fg) -width 2 -smooth 1 -tag I17 + $w.c create line $xy -fill $C(fg) -width 2 -smooth 1 -tag I17 } -proc Move17 {w {step {}}} { - set step [GetStep 17 $step] +proc Move17 {w {a_step ""}} { + global C + set step [GetStep 17 $a_step] if {$step == 0} { $w.c delete I17 ;# Delete most of the cat set xy {655 543 660 535 665 543} ;# Mouth - $w.c create line $xy -fill $::C(fg) -width 3 -smooth 1 -tag I17_ + $w.c create line $xy -fill $C(fg) -width 3 -smooth 1 -tag I17_ set xy [box 654 530 4] ;# Left eye - $w.c create oval $xy -outline $::C(fg) -width 3 -fill {} -tag I17_ + $w.c create oval $xy -outline $C(fg) -width 3 -fill "" -tag I17_ set xy [box 666 530 4] ;# Right eye - $w.c create oval $xy -outline $::C(fg) -width 3 -fill {} -tag I17_ + $w.c create oval $xy -outline $C(fg) -width 3 -fill "" -tag I17_ $w.c move I17_ 0 -20 ;# Move face up set xy {652 528 652 554} ;# Front leg - $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_ + $w.c create line $xy -fill $C(fg) -width 3 -tag I17_ set xy {670 528 670 554} ;# 2nd front leg - $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_ + $w.c create line $xy -fill $C(fg) -width 3 -tag I17_ set xy { 675 506 694 489 715 513 715 513 715 513 716 525 716 525 716 525 @@ -1238,13 +1295,13 @@ proc Move17 {w {step {}}} { 677 512 } ;# Body $w.c create poly $xy -fill [$w.c itemcget I17_c -fill] \ - -outline $::C(fg) -width 3 -smooth 1 -tag I17_ + -outline $C(fg) -width 3 -smooth 1 -tag I17_ set xy {716 514 716 554} ;# Back leg - $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_ + $w.c create line $xy -fill $C(fg) -width 3 -tag I17_ set xy {694 532 694 554} ;# 2nd back leg - $w.c create line $xy -fill $::C(fg) -width 3 -tag I17_ + $w.c create line $xy -fill $C(fg) -width 3 -tag I17_ set xy {715 514 718 506 719 495 716 488};# Tail - $w.c create line $xy -fill $::C(fg) -width 3 -smooth 1 -tag I17_ + $w.c create line $xy -fill $C(fg) -width 3 -smooth 1 -tag I17_ $w.c raise I17w ;# Make whiskers visible $w.c move I17_ -5 0 ;# Move away from wall a bit @@ -1255,20 +1312,21 @@ proc Move17 {w {step {}}} { # Sling shot proc Draw18 {w} { - set color $::C(18) + global C + set color $C(18) set xy {721 506 627 506} ;# Sling hold - $w.c create line $xy -width 4 -fill $::C(fg) -tag I18 + $w.c create line $xy -width 4 -fill $C(fg) -tag I18 set xy {607 500 628 513} ;# Sling rock - $w.c create oval $xy -fill $color -outline {} -tag I18a + $w.c create oval $xy -fill $color -outline "" -tag I18a set xy {526 513 606 507 494 502} ;# Sling band - $w.c create line $xy -fill $::C(fg) -width 4 -tag I18b + $w.c create line $xy -fill $C(fg) -width 4 -tag I18b set xy { 485 490 510 540 510 575 510 540 535 491 } ;# Sling - $w.c create line $xy -fill $::C(fg) -width 6 + $w.c create line $xy -fill $C(fg) -width 6 } -proc Move18 {w {step {}}} { - set step [GetStep 18 $step] +proc Move18 {w {a_step ""}} { + set step [GetStep 18 $a_step] set pos { {587 506} {537 506} {466 506} {376 506} {266 506 x} {136 506} @@ -1305,74 +1363,75 @@ proc Move18 {w {step {}}} { # Water pipe proc Draw19 {w} { - set color $::C(19) + global C + set color $C(19) set xx {249 181 155 118 86 55 22 0} foreach {x1 x2} $xx { - $w.c create rect $x1 453 $x2 467 -fill $color -outline {} -tag I19 - $w.c create line $x1 453 $x2 453 -fill $::C(fg) -width 1;# Pipe top - $w.c create line $x1 467 $x2 467 -fill $::C(fg) -width 1;# Pipe bottom + $w.c create rect $x1 453 $x2 467 -fill $color -outline "" -tag I19 + $w.c create line $x1 453 $x2 453 -fill $C(fg) -width 1;# Pipe top + $w.c create line $x1 467 $x2 467 -fill $C(fg) -width 1;# Pipe bottom } $w.c raise I11i set xy [box 168 460 16] ;# Bulge by the joint - $w.c create oval $xy -fill $color -outline {} - $w.c create arc $xy -outline $::C(fg) -width 1 -style arc \ + $w.c create oval $xy -fill $color -outline "" + $w.c create arc $xy -outline $C(fg) -width 1 -style arc \ -start 21 -extent 136 - $w.c create arc $xy -outline $::C(fg) -width 1 -style arc \ + $w.c create arc $xy -outline $C(fg) -width 1 -style arc \ -start -21 -extent -130 set xy {249 447 255 473} ;# First joint 26x6 - $w.c create rect $xy -fill $color -outline $::C(fg) -width 1 + $w.c create rect $xy -fill $color -outline $C(fg) -width 1 set xy [box 257 433 34] ;# Bend up - $w.c create arc $xy -outline {} -fill $color -width 1 \ + $w.c create arc $xy -outline "" -fill $color -width 1 \ -style pie -start 0 -extent -91 - $w.c create arc $xy -outline $::C(fg) -width 1 \ + $w.c create arc $xy -outline $C(fg) -width 1 \ -style arc -start 0 -extent -90 set xy [box 257 433 20] - $w.c create arc $xy -outline {} -fill $::C(bg) -width 1 \ + $w.c create arc $xy -outline "" -fill $C(bg) -width 1 \ -style pie -start 0 -extent -92 - $w.c create arc $xy -outline $::C(fg) -width 1 \ + $w.c create arc $xy -outline $C(fg) -width 1 \ -style arc -start 0 -extent -90 set xy [box 257 421 34] ;# Bend left - $w.c create arc $xy -outline {} -fill $color -width 1 \ + $w.c create arc $xy -outline "" -fill $color -width 1 \ -style pie -start 1 -extent 91 - $w.c create arc $xy -outline $::C(fg) -width 1 \ + $w.c create arc $xy -outline $C(fg) -width 1 \ -style arc -start 0 -extent 90 set xy [box 257 421 20] - $w.c create arc $xy -outline {} -fill $::C(bg) -width 1 \ + $w.c create arc $xy -outline "" -fill $C(bg) -width 1 \ -style pie -start 0 -extent 90 - $w.c create arc $xy -outline $::C(fg) -width 1 \ + $w.c create arc $xy -outline $C(fg) -width 1 \ -style arc -start 0 -extent 90 set xy [box 243 421 34] ;# Bend down - $w.c create arc $xy -outline {} -fill $color -width 1 \ + $w.c create arc $xy -outline "" -fill $color -width 1 \ -style pie -start 90 -extent 90 - $w.c create arc $xy -outline $::C(fg) -width 1 \ + $w.c create arc $xy -outline $C(fg) -width 1 \ -style arc -start 90 -extent 90 set xy [box 243 421 20] - $w.c create arc $xy -outline {} -fill $::C(bg) -width 1 \ + $w.c create arc $xy -outline "" -fill $C(bg) -width 1 \ -style pie -start 90 -extent 90 - $w.c create arc $xy -outline $::C(fg) -width 1 \ + $w.c create arc $xy -outline $C(fg) -width 1 \ -style arc -start 90 -extent 90 set xy {270 427 296 433} ;# 2nd joint bottom - $w.c create rect $xy -fill $color -outline $::C(fg) -width 1 + $w.c create rect $xy -fill $color -outline $C(fg) -width 1 set xy {270 421 296 427} ;# 2nd joint top - $w.c create rect $xy -fill $color -outline $::C(fg) -width 1 + $w.c create rect $xy -fill $color -outline $C(fg) -width 1 set xy {249 382 255 408} ;# Third joint right - $w.c create rect $xy -fill $color -outline $::C(fg) -width 1 + $w.c create rect $xy -fill $color -outline $C(fg) -width 1 set xy {243 382 249 408} ;# Third joint left - $w.c create rect $xy -fill $color -outline $::C(fg) -width 1 + $w.c create rect $xy -fill $color -outline $C(fg) -width 1 set xy {203 420 229 426} ;# Last joint - $w.c create rect $xy -fill $color -outline $::C(fg) -width 1 + $w.c create rect $xy -fill $color -outline $C(fg) -width 1 set xy [box 168 460 6] ;# Handle joint - $w.c create oval $xy -fill $::C(fg) -outline {} -tag I19a + $w.c create oval $xy -fill $C(fg) -outline "" -tag I19a set xy {168 460 168 512} ;# Handle bar - $w.c create line $xy -fill $::C(fg) -width 5 -tag I19b + $w.c create line $xy -fill $C(fg) -width 5 -tag I19b } -proc Move19 {w {step {}}} { - set step [GetStep 19 $step] +proc Move19 {w {a_step ""}} { + set step [GetStep 19 $a_step] set angles {30 30 30} if {$step == [llength $angles]} { @@ -1384,10 +1443,9 @@ proc Move19 {w {step {}}} { } # Water pouring -proc Draw20 {w} { -} -proc Move20 {w {step {}}} { - set step [GetStep 20 $step] +proc Draw20 {args} {} +proc Move20 {w {a_step ""}} { + set step [GetStep 20 $a_step] set pos {451 462 473 484 496 504 513 523 532} set freq {20 40 40 40 40 40 40 40 40} @@ -1409,7 +1467,8 @@ proc Move20 {w {step {}}} { return 1 } proc H2O {w y f} { - set color $::C(20) + global C + set color $C(20) $w.c delete I20 Sine $w 208 428 208 $y 4 $f -tag {I20 I20s} -width 3 -fill $color \ @@ -1424,28 +1483,30 @@ proc H2O {w y f} { # Bucket proc Draw21 {w} { - set color $::C(21) + global C + set color $C(21) set xy {217 451 244 490} ;# Right handle - $w.c create line $xy -fill $::C(fg) -width 2 -tag I21_a + $w.c create line $xy -fill $C(fg) -width 2 -tag I21_a set xy {201 467 182 490} ;# Left handle - $w.c create line $xy -fill $::C(fg) -width 2 -tag I21_a + $w.c create line $xy -fill $C(fg) -width 2 -tag I21_a set xy {245 490 237 535} ;# Right side set xy2 {189 535 181 490} ;# Left side - $w.c create poly [concat $xy $xy2] -fill $color -outline {} \ + $w.c create poly [concat $xy $xy2] -fill $color -outline "" \ -tag {I21 I21f} - $w.c create line $xy -fill $::C(fg) -width 2 -tag I21 - $w.c create line $xy2 -fill $::C(fg) -width 2 -tag I21 + $w.c create line $xy -fill $C(fg) -width 2 -tag I21 + $w.c create line $xy2 -fill $C(fg) -width 2 -tag I21 set xy {182 486 244 498} ;# Top - $w.c create oval $xy -fill $color -outline {} -width 2 -tag {I21 I21f} - $w.c create oval $xy -fill {} -outline $::C(fg) -width 2 -tag {I21 I21t} + $w.c create oval $xy -fill $color -outline "" -width 2 -tag {I21 I21f} + $w.c create oval $xy -fill "" -outline $C(fg) -width 2 -tag {I21 I21t} set xy {189 532 237 540} ;# Bottom - $w.c create oval $xy -fill $color -outline $::C(fg) -width 2 \ + $w.c create oval $xy -fill $color -outline $C(fg) -width 2 \ -tag {I21 I21b} } -proc Move21 {w {step {}}} { - set step [GetStep 21 $step] +proc Move21 {w {a_step ""}} { + global C + set step [GetStep 21 $a_step] set numsteps 30 if {$step >= $numsteps} { @@ -1456,33 +1517,33 @@ proc Move21 {w {step {}}} { #lassign [$w.c coords I21t] X1 Y1 X2 Y2 lassign {183 492 243 504} X1 Y1 X2 Y2 - set f [expr {$step / double($numsteps)}] + set f [expr {$step / (1.0 * $numsteps)}] set y2 [expr {$y2 - 3}] - set xx1 [expr {$x1 + ($X1 - $x1) * $f}] - set yy1 [expr {$y1 + ($Y1 - $y1) * $f}] - set xx2 [expr {$x2 + ($X2 - $x2) * $f}] - set yy2 [expr {$y2 + ($Y2 - $y2) * $f}] + set xx1 [expr {$x1 + (($X1 - $x1) * $f)}] + set yy1 [expr {$y1 + (($Y1 - $y1) * $f)}] + set xx2 [expr {$x2 + (($X2 - $x2) * $f)}] + set yy2 [expr {$y2 + (($Y2 - $y2) * $f)}] #H2O $w $yy1 40 - $w.c itemconfig I21b -fill $::C(20) + $w.c itemconfig I21b -fill $C(20) $w.c delete I21w $w.c create poly $x2 $y2 $x1 $y1 $xx1 $yy1 $xx2 $yy1 -tag {I21 I21w} \ - -outline {} -fill $::C(20) + -outline "" -fill $C(20) $w.c lower I21w I21 $w.c raise I21b $w.c lower I21f - return [expr {$step == $numsteps-1 ? 3 : 1}] + return [expr {($step == ($numsteps - 1)) ? 3 : 1}] } # Bucket drop -proc Draw22 {w} { -} -proc Move22 {w {step {}}} { - set step [GetStep 22 $step] +proc Draw22 {args} {} +proc Move22 {w {a_step ""}} { + global C + set step [GetStep 22 $a_step] set pos {{213 513} {213 523} {213 543 x} {213 583} {213 593}} - if {$step == 0} {$w.c itemconfig I21f -fill $::C(22)} + if {$step == 0} {$w.c itemconfig I21f -fill $C(22)} if {$step >= [llength $pos]} { return 0 } @@ -1499,31 +1560,32 @@ proc Move22 {w {step {}}} { # Blow dart proc Draw23 {w} { - set color $::C(23a) - set color2 $::C(23b) - set color3 $::C(23c) + global C + set color $C(23a) + set color2 $C(23b) + set color3 $C(23c) set xy {185 623 253 650} ;# Block - $w.c create rect $xy -fill black -outline $::C(fg) -width 2 -tag I23a + $w.c create rect $xy -fill black -outline $C(fg) -width 2 -tag I23a set xy {187 592 241 623} ;# Balloon - $w.c create oval $xy -outline {} -fill $color -tag I23b - $w.c create arc $xy -outline $::C(fg) -width 3 -tag I23b \ + $w.c create oval $xy -outline "" -fill $color -tag I23b + $w.c create arc $xy -outline $C(fg) -width 3 -tag I23b \ -style arc -start 12 -extent 336 set xy {239 604 258 589 258 625 239 610} ;# Balloon nozzle - $w.c create poly $xy -outline {} -fill $color -tag I23b - $w.c create line $xy -fill $::C(fg) -width 3 -tag I23b + $w.c create poly $xy -outline "" -fill $color -tag I23b + $w.c create line $xy -fill $C(fg) -width 3 -tag I23b set xy {285 611 250 603} ;# Dart body - $w.c create oval $xy -fill $color2 -outline $::C(fg) -width 3 -tag I23d + $w.c create oval $xy -fill $color2 -outline $C(fg) -width 3 -tag I23d set xy {249 596 249 618 264 607 249 596} ;# Dart tail - $w.c create poly $xy -fill $color3 -outline $::C(fg) -width 3 -tag I23d + $w.c create poly $xy -fill $color3 -outline $C(fg) -width 3 -tag I23d set xy {249 607 268 607} ;# Dart detail - $w.c create line $xy -fill $::C(fg) -width 3 -tag I23d + $w.c create line $xy -fill $C(fg) -width 3 -tag I23d set xy {285 607 305 607} ;# Dart needle - $w.c create line $xy -fill $::C(fg) -width 3 -tag I23d + $w.c create line $xy -fill $C(fg) -width 3 -tag I23d } -proc Move23 {w {step {}}} { - set step [GetStep 23 $step] +proc Move23 {w {a_step ""}} { + set step [GetStep 23 $a_step] set pos { {277 607} {287 607} {307 607 x} {347 607} {407 607} {487 607} @@ -1547,26 +1609,27 @@ proc Move23 {w {step {}}} { # Balloon proc Draw24 {w} { - set color $::C(24a) + global C + set color $C(24a) set xy {366 518 462 665} ;# Balloon - $w.c create oval $xy -fill $color -outline $::C(fg) -width 3 -tag I24 + $w.c create oval $xy -fill $color -outline $C(fg) -width 3 -tag I24 set xy {414 666 414 729} ;# String - $w.c create line $xy -fill $::C(fg) -width 3 -tag I24 + $w.c create line $xy -fill $C(fg) -width 3 -tag I24 set xy {410 666 404 673 422 673 418 666} ;# Nozzle - $w.c create poly $xy -fill $color -outline $::C(fg) -width 3 -tag I24 + $w.c create poly $xy -fill $color -outline $C(fg) -width 3 -tag I24 set xy {387 567 390 549 404 542} ;# Reflections - $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24 + $w.c create line $xy -fill $C(fg) -smooth 1 -width 2 -tag I24 set xy {395 568 399 554 413 547} - $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24 + $w.c create line $xy -fill $C(fg) -smooth 1 -width 2 -tag I24 set xy {403 570 396 555 381 553} - $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24 + $w.c create line $xy -fill $C(fg) -smooth 1 -width 2 -tag I24 set xy {408 564 402 547 386 545} - $w.c create line $xy -fill $::C(fg) -smooth 1 -width 2 -tag I24 + $w.c create line $xy -fill $C(fg) -smooth 1 -width 2 -tag I24 } -proc Move24 {w {step {}}} { - global S - set step [GetStep 24 $step] +proc Move24 {w {a_step ""}} { + global S C + set step [GetStep 24 $a_step] if {$step > 4} { return 0 @@ -1582,7 +1645,7 @@ proc Move24 {w {step {}}} { 494 627 548 613 548 613 480 574 577 473 577 473 474 538 445 508 431 441 431 440 400 502 347 465 347 465 } - $w.c create poly $xy -tag I24 -fill $::C(24b) -outline $::C(24a) \ + $w.c create poly $xy -tag I24 -fill $C(24b) -outline $C(24a) \ -width 10 -smooth 1 set msg [subst $S(message)] $w.c create text [Centroid $w I24] -text $msg -tag {I24 I24t} \ @@ -1590,21 +1653,21 @@ proc Move24 {w {step {}}} { return 1 } - $w.c itemconfig I24t -font [list {Times Roman} [expr {18 + 6*$step}] bold] + $w.c itemconfig I24t -font [list {Times Roman} [expr {18 + (6 * $step)}] bold] $w.c move I24 0 -60 $w.c scale I24 {*}[Centroid $w I24] 1.25 1.25 return 1 } # Displaying the message -proc Move25 {w {step {}}} { - global S - set step [GetStep 25 $step] +proc Move25 {w {a_step ""}} { + global S XY + set step [GetStep 25 $a_step] if {$step == 0} { - set ::XY(25) [clock clicks -milliseconds] + set XY(25) [clock milliseconds] return 1 } - set elapsed [expr {[clock clicks -milliseconds] - $::XY(25)}] + set elapsed [expr {[clock milliseconds] - $XY(25)}] if {$elapsed < 5000} { return 1 } @@ -1612,21 +1675,21 @@ proc Move25 {w {step {}}} { } # Collapsing balloon -proc Move26 {w {step {}}} { +proc Move26 {w {a_step ""}} { global S - set step [GetStep 26 $step] + set step [GetStep 26 $a_step] if {$step >= 3} { $w.c delete I24 I26 $w.c create text 430 755 -anchor s -tag I26 \ - -text "click to continue" -font {{Times Roman} 24 bold} + -text "click to continue" -font "{Times Roman} 24 bold" bind $w.c <1> [list Reset $w] return 4 } $w.c scale I24 {*}[Centroid $w I24] .8 .8 $w.c move I24 0 60 - $w.c itemconfig I24t -font [list {Times Roman} [expr {30 - 6*$step}] bold] + $w.c itemconfig I24t -font [list "Times Roman" [expr {30 - (6 * $step)}] bold] return 1 } @@ -1636,7 +1699,7 @@ proc Move26 {w {step {}}} { # proc box {x y r} { - return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]] + return [list [expr {$x - $r}] [expr {$y - $r}] [expr {$x + $r}] [expr {$y + $r}]] } proc MoveAbs {w item xy} { @@ -1649,22 +1712,22 @@ proc MoveAbs {w item xy} { proc RotateItem {w item Ox Oy beta} { set xy [$w.c coords $item] - set xy2 {} + set xy2 [list] foreach {x y} $xy { lappend xy2 {*}[RotateC $x $y $Ox $Oy $beta] } $w.c coords $item $xy2 } -proc RotateC {x y Ox Oy beta} { +proc RotateC {a_x a_y Ox Oy a_beta} { # rotates vector (Ox,Oy)->(x,y) by beta degrees clockwise - set x [expr {$x - $Ox}] ;# Shift to origin - set y [expr {$y - $Oy}] + set x [expr {$a_x - $Ox}] ;# Shift to origin + set y [expr {$a_y - $Oy}] - set beta [expr {$beta * atan(1) * 4 / 180.0}] ;# Radians - set xx [expr {$x * cos($beta) - $y * sin($beta)}] ;# Rotate - set yy [expr {$x * sin($beta) + $y * cos($beta)}] + set beta [expr {($a_beta * ( atan (1)) * 4) / 180.0}] ;# Radians + set xx [expr {($x * ( cos ($beta))) - ($y * ( sin ($beta)))}] ;# Rotate + set yy [expr {($x * ( sin ($beta))) + ($y * ( cos ($beta)))}] set xx [expr {$xx + $Ox}] ;# Shift back set yy [expr {$yy + $Oy}] @@ -1673,10 +1736,10 @@ proc RotateC {x y Ox Oy beta} { } proc Reset {w} { - global S + global S MSTART DrawAll $w bind $w.c <1> {} - set S(mode) $::MSTART + set S(mode) $MSTART set S(active) 0 } @@ -1685,7 +1748,7 @@ proc GetStep {who step} { global STEP if {$step ne ""} { set STEP($who) $step - } elseif {![info exists STEP($who)] || $STEP($who) eq ""} { + } elseif {(![info exists STEP($who)]) || ($STEP($who) eq "")} { set STEP($who) 0 } else { incr STEP($who) @@ -1694,27 +1757,27 @@ proc GetStep {who step} { } proc ResetStep {} { - global STEP - set ::S(cnt) 0 + global STEP S + set S(cnt) 0 foreach a [array names STEP] { set STEP($a) "" } } proc Sine {w x0 y0 x1 y1 amp freq args} { - set PI [expr {4 * atan(1)}] + set PI [expr {4 * ( atan (1) )}] set step 2 - set xy {} + set xy [list] if {$y0 == $y1} { ;# Horizontal for {set x $x0} {$x <= $x1} {incr x $step} { - set beta [expr {($x - $x0) * 2 * $PI / $freq}] - set y [expr {$y0 + $amp * sin($beta)}] + set beta [expr {(($x - $x0) * 2 * $PI) / $freq}] + set y [expr {$y0 + ($amp * ( sin ($beta) ))}] lappend xy $x $y } } else { for {set y $y0} {$y <= $y1} {incr y $step} { - set beta [expr {($y - $y0) * 2 * $PI / $freq}] - set x [expr {$x0 + $amp * sin($beta)}] + set beta [expr {(($y - $y0) * 2 * $PI) / $freq}] + set x [expr {$x0 + ($amp * ( sin ($beta) ))}] lappend xy $x $y } } @@ -1728,10 +1791,10 @@ proc RoundRect {w xy radius args} { # Make sure that the radius of the curve is less than 3/8 size of the box! set maxr 0.75 - if {$d > $maxr * ($x3 - $x0)} { + if {$d > ($maxr * ($x3 - $x0))} { set d [expr {$maxr * ($x3 - $x0)}] } - if {$d > $maxr * ($y3 - $y0)} { + if {$d > ($maxr * ($y3 - $y0))} { set d [expr {$maxr * ($y3 - $y0)}] } @@ -1740,25 +1803,25 @@ proc RoundRect {w xy radius args} { set y1 [expr { $y0 + $d }] set y2 [expr { $y3 - $d }] - set xy [list $x0 $y0 $x1 $y0 $x2 $y0 $x3 $y0 $x3 $y1 $x3 $y2] - lappend xy $x3 $y3 $x2 $y3 $x1 $y3 $x0 $y3 $x0 $y2 $x0 $y1 - return $xy + set new_xy [list $x0 $y0 $x1 $y0 $x2 $y0 $x3 $y0 $x3 $y1 $x3 $y2] + lappend new_xy $x3 $y3 $x2 $y3 $x1 $y3 $x0 $y3 $x0 $y2 $x0 $y1 + return $new_xy } proc RoundPoly {canv xy radii args} { set lenXY [llength $xy] set lenR [llength $radii] - if {$lenXY != 2*$lenR} { + if {$lenXY != (2 * $lenR)} { error "wrong number of vertices and radii" } - set knots {} + set knots [list] lassign [lrange $xy end-1 end] x0 y0 lassign $xy x1 y1 lappend xy {*}[lrange $xy 0 1] for {set i 0} {$i < $lenXY} {incr i 2} { - set radius [lindex $radii [expr {$i/2}]] + set radius [lindex $radii [expr {$i / 2}]] set r [winfo pixels $canv $radius] lassign [lrange $xy [expr {$i + 2}] [expr {$i + 3}]] x2 y2 @@ -1781,18 +1844,18 @@ proc _RoundPoly2 {x0 y0 x1 y1 x2 y2 radius} { set v2x [expr {$x2 - $x1}] set v2y [expr {$y2 - $y1}] - set vlen1 [expr {sqrt($v1x*$v1x + $v1y*$v1y)}] - set vlen2 [expr {sqrt($v2x*$v2x + $v2y*$v2y)}] - if {$d > $maxr * $vlen1} { + set vlen1 [expr { sqrt (($v1x * $v1x) + ($v1y * $v1y))}] + set vlen2 [expr { sqrt (($v2x * $v2x) + ($v2y * $v2y))}] + if {$d > ($maxr * $vlen1)} { set d [expr {$maxr * $vlen1}] } - if {$d > $maxr * $vlen2} { + if {$d > ($maxr * $vlen2)} { set d [expr {$maxr * $vlen2}] } - lappend xy [expr {$x1 + $d * $v1x/$vlen1}] [expr {$y1 + $d * $v1y/$vlen1}] + lappend xy [expr {$x1 + (($d * $v1x) / $vlen1)}] [expr {$y1 + (($d * $v1y) / $vlen1)}] lappend xy $x1 $y1 - lappend xy [expr {$x1 + $d * $v2x/$vlen2}] [expr {$y1 + $d * $v2y/$vlen2}] + lappend xy [expr {$x1 + (($d * $v2x) / $vlen2)}] [expr {$y1 + (($d * $v2y) / $vlen2)}] return $xy } @@ -1813,14 +1876,14 @@ proc Anchor {w item where} { lassign [$w.c bbox $item] x1 y1 x2 y2 if {[string match *n* $where]} { set y $y1 - } elseif {[string match *s* $where]} { + } elseif {[string match "*s*" $where]} { set y $y2 } else { set y [expr {($y1 + $y2) / 2.0}] } - if {[string match *w* $where]} { + if {[string match "*w*" $where]} { set x $x1 - } elseif {[string match *e* $where]} { + } elseif {[string match "*e*" $where]} { set x $x2 } else { set x [expr {($x1 + $x2) / 2.0}] diff --git a/library/demos/hscale.tcl b/library/demos/hscale.tcl index 1df144d..b6445ed 100644 --- a/library/demos/hscale.tcl +++ b/library/demos/hscale.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .hscale -catch {destroy $w} +destroy $w toplevel $w wm title $w "Horizontal Scale Demonstration" wm iconname $w "hscale" @@ -34,9 +34,9 @@ pack $w.frame.canvas -side top -expand yes -anchor s -fill x -padx 15 pack $w.frame.scale -side bottom -expand yes -anchor n $w.frame.scale set 75 -proc setWidth {w width} { - incr width 21 - set x2 [expr {$width - 30}] +proc setWidth {w a_width} { + set width [expr {$a_width + 21}] + set x2 [expr {$width - 30}] if {$x2 < 21} { set x2 21 } diff --git a/library/demos/icon.tcl b/library/demos/icon.tcl index 224d8f9..4c4b90a 100644 --- a/library/demos/icon.tcl +++ b/library/demos/icon.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .icon -catch {destroy $w} +destroy $w toplevel $w wm title $w "Iconic Button Demonstration" wm iconname $w "icon" diff --git a/library/demos/image1.tcl b/library/demos/image1.tcl index 0bd2f49..b2fac6f 100644 --- a/library/demos/image1.tcl +++ b/library/demos/image1.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .image1 -catch {destroy $w} +destroy $w toplevel $w wm title $w "Image Demonstration #1" wm iconname $w "Image1" diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl index a17da31..b1c3bbb 100644 --- a/library/demos/image2.tcl +++ b/library/demos/image2.tcl @@ -16,7 +16,7 @@ package require Tk # Arguments: # w - Name of the toplevel window of the demo. -proc loadDir w { +proc loadDir {w} { global dirName $w.f.list delete 0 end @@ -33,7 +33,7 @@ proc loadDir w { # Arguments: # w - Name of the toplevel window of the demo. -proc selectAndLoadDir w { +proc selectAndLoadDir {w} { global dirName set dir [tk_chooseDirectory -initialdir $dirName -parent $w -mustexist 1] if {$dir ne ""} { @@ -57,14 +57,14 @@ proc loadImage {w x y} { set file [file join $dirName [$w.f.list get @$x,$y]] if {[catch { image2a configure -file $file - }]} then { + }]} { # Mark the file as not loadable - $w.f.list itemconfigure @$x,$y -bg \#c00000 -selectbackground \#ff0000 + $w.f.list itemconfigure @$x,$y -background "#c00000" -selectbackground "#ff0000" } } set w .image2 -catch {destroy $w} +destroy $w toplevel $w wm title $w "Image Demonstration #2" wm iconname $w "Image2" diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 177e9a4..1404779 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .items -catch {destroy $w} +destroy $w toplevel $w wm title $w "Canvas Item Demonstration" wm iconname $w "Items" @@ -106,14 +106,14 @@ $c create polygon 22c 4.5c 25c 4.5c 25c 6.75c 28c 6.75c \ $c create text 5c 8.2c -text Rectangles -anchor n $c create rectangle 1c 9.5c 4c 12.5c -outline $red -width 3m -tags item $c create rectangle 0.5c 13.5c 4.5c 15.5c -fill $green -tags item -$c create rectangle 6c 10c 9c 15c -outline {} \ +$c create rectangle 6c 10c 9c 15c -outline "" \ -stipple @[file join $tk_demoDirectory images gray25.xbm] \ -fill $blue -tags item $c create text 15c 8.2c -text Ovals -anchor n $c create oval 11c 9.5c 14c 12.5c -outline $red -width 3m -tags item $c create oval 10.5c 13.5c 14.5c 15.5c -fill $green -tags item -$c create oval 16c 10c 19c 15c -outline {} \ +$c create oval 16c 10c 19c 15c -outline "" \ -stipple @[file join $tk_demoDirectory images gray25.xbm] \ -fill $blue -tags item @@ -136,9 +136,9 @@ $c create arc 6.5c 17c 9.5c 20c -width 4m -style arc \ -outline $blue -start -135 -extent 270 -tags item \ -outlinestipple @[file join $tk_demoDirectory images gray25.xbm] $c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \ - -fill {} -outline $red -start 225 -extent -90 -tags item + -fill "" -outline $red -start 225 -extent -90 -tags item $c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \ - -fill $blue -outline {} -start 45 -extent 270 -tags item + -fill $blue -outline "" -start 45 -extent 270 -tags item image create photo items.ousterhout \ -file [file join $tk_demoDirectory images ouster.png] @@ -183,26 +183,25 @@ proc itemEnter {c} { global restoreCmd if {[winfo depth $c] == 1} { - set restoreCmd {} + set restoreCmd "" return } set type [$c type current] - if {$type == "window" || $type == "image"} { - set restoreCmd {} + if {$type in "window image"} { + set restoreCmd "" return - } elseif {$type == "bitmap"} { + } elseif {$type eq "bitmap"} { set bg [lindex [$c itemconf current -background] 4] set restoreCmd [list $c itemconfig current -background $bg] $c itemconfig current -background SteelBlue2 return - } elseif {$type == "image"} { + } elseif {$type eq "image"} { set restoreCmd [list $c itemconfig current -state normal] $c itemconfig current -state active return } set fill [lindex [$c itemconfig current -fill] 4] - if {(($type == "rectangle") || ($type == "oval") || ($type == "arc")) - && ($fill == "")} { + if {($type in "rectangle oval arc") && ($fill eq "")} { set outline [lindex [$c itemconfig current -outline] 4] set restoreCmd "$c itemconfig current -outline $outline" $c itemconfig current -outline SteelBlue2 @@ -228,10 +227,10 @@ proc itemMark {c x y} { $c delete area } -proc itemStroke {c x y} { +proc itemStroke {c a_x a_y} { global areaX1 areaY1 areaX2 areaY2 - set x [$c canvasx $x] - set y [$c canvasy $y] + set x [$c canvasx $a_x] + set y [$c canvasy $a_y] if {($areaX1 != $x) && ($areaY1 != $y)} { $c delete area $c addtag area withtag [$c create rect $areaX1 $areaY1 $x $y \ @@ -273,11 +272,11 @@ proc itemStartDrag {c x y} { set lastY [$c canvasy $y] } -proc itemDrag {c x y} { +proc itemDrag {c a_x a_y} { global lastX lastY - set x [$c canvasx $x] - set y [$c canvasy $y] - $c move current [expr {$x-$lastX}] [expr {$y-$lastY}] + set x [$c canvasx $a_x] + set y [$c canvasy $a_y] + $c move current [expr {$x - $lastX}] [expr {$y - $lastY}] set lastX $x set lastY $y } diff --git a/library/demos/ixset b/library/demos/ixset index 06b644d..0cae5f0 100644 --- a/library/demos/ixset +++ b/library/demos/ixset @@ -21,19 +21,19 @@ proc quit {} { } proc ok {} { - writesettings + writesettings quit } proc cancel {} { - readsettings - dispsettings + readsettings + dispsettings .buttons.apply configure -state disabled .buttons.cancel configure -state disabled } proc apply {} { - writesettings + writesettings .buttons.apply configure -state disabled .buttons.cancel configure -state disabled } @@ -43,16 +43,27 @@ proc apply {} { # proc readsettings {} { - global kbdrep ; set kbdrep "on" - global kbdcli ; set kbdcli 0 - global bellvol ; set bellvol 100 - global bellpit ; set bellpit 440 - global belldur ; set belldur 100 - global mouseacc ; set mouseacc "3/1" - global mousethr ; set mousethr 4 - global screenbla ; set screenbla "blank" - global screentim ; set screentim 600 - global screencyc ; set screencyc 600 + global belldur + global bellpit + global bellvol + global kbdcli + global kbdrep + global mouseacc + global mousethr + global screenbla + global screencyc + global screentim + + set belldur 100 + set bellpit 440 + set bellvol 100 + set kbdcli 0 + set kbdrep "on" + set mouseacc "3/1" + set mousethr 4 + set screenbla "blank" + set screencyc 600 + set screentim 600 set xfd [open "|xset q" r] while {[gets $xfd line] > -1} { @@ -75,12 +86,13 @@ proc readsettings {} { } prefer { set bla [lindex $line 2] - set screenbla [expr {$bla eq "yes" ? "blank" : "noblank"}] + set screenbla [expr {($bla eq "yes") ? "blank" : "noblank"}] } timeout: { set screentim [lindex $line 1] set screencyc [lindex $line 3] } + default {} } } close $xfd @@ -146,7 +158,7 @@ proc dispsettings {} { .bell.val.dur.entry delete 0 end .bell.val.dur.entry insert 0 $belldur - .kbd.val.onoff [expr {$kbdrep eq "on" ? "select" : "deselect"}] + .kbd.val.onoff [expr {($kbdrep eq "on") ? "select" : "deselect"}] .kbd.val.cli set $kbdcli .mouse.hor.acc.entry delete 0 end @@ -154,20 +166,19 @@ proc dispsettings {} { .mouse.hor.thr.entry delete 0 end .mouse.hor.thr.entry insert 0 $mousethr - .screen.blank [expr {$screenbla eq "blank" ? "select" : "deselect"}] - .screen.pat [expr {$screenbla ne "blank" ? "select" : "deselect"}] + .screen.blank [expr {($screenbla eq "blank") ? "select" : "deselect"}] + .screen.pat [expr {($screenbla ne "blank") ? "select" : "deselect"}] .screen.tim.entry delete 0 end .screen.tim.entry insert 0 $screentim .screen.cyc.entry delete 0 end .screen.cyc.entry insert 0 $screencyc } - # # Create all windows, and pack them # -proc labelentry {path text length {range {}}} { +proc labelentry {path text length {range ""}} { frame $path label $path.label -text $text if {[llength $range]} { @@ -196,8 +207,14 @@ proc createwindows {} { pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \ -side left -expand yes -pady 5 - bind . <Return> {.buttons.ok flash; .buttons.ok invoke} - bind . <Escape> {.buttons.quit flash; .buttons.quit invoke} + bind . <Return> { + .buttons.ok flash + .buttons.ok invoke + } + bind . <Escape> { + .buttons.quit flash + .buttons.quit invoke + } bind . <1> { if {![string match .buttons* %W]} { .buttons.apply configure -state normal @@ -206,7 +223,7 @@ proc createwindows {} { } bind . <Key> { if {![string match .buttons* %W]} { - switch -glob %K { + switch -glob -- %K { Return - Escape - Tab - *Shift* {} default { .buttons.apply configure -state normal diff --git a/library/demos/knightstour.tcl b/library/demos/knightstour.tcl index 73ca3a3..6b51969 100644 --- a/library/demos/knightstour.tcl +++ b/library/demos/knightstour.tcl @@ -25,12 +25,13 @@ package require Tk 8.5 # Return a list of accessible squares from a given square proc ValidMoves {square} { - set moves {} + set moves [list] foreach pair {{-1 -2} {-2 -1} {-2 1} {-1 2} {1 2} {2 1} {2 -1} {1 -2}} { - set col [expr {($square % 8) + [lindex $pair 0]}] - set row [expr {($square / 8) + [lindex $pair 1]}] - if {$row > -1 && $row < 8 && $col > -1 && $col < 8} { - lappend moves [expr {$row * 8 + $col}] + lassign $pair i_col i_row + set col [expr {($square % 8) + $i_col}] + set row [expr {($square / 8) + $i_row}] + if {($row > -1) && ($row < 8) && ($col > -1) && ($col < 8)} { + lappend moves [expr {($row * 8) + $col}] } } return $moves @@ -72,17 +73,17 @@ proc Next {square} { # Select the square nearest the edge of the board proc Edgemost {a b} { - set colA [expr {3-int(abs(3.5-($a%8)))}] - set colB [expr {3-int(abs(3.5-($b%8)))}] - set rowA [expr {3-int(abs(3.5-($a/8)))}] - set rowB [expr {3-int(abs(3.5-($b/8)))}] - return [expr {($colA * $rowA) < ($colB * $rowB) ? $a : $b}] + set colA [expr {3 - ( int ( abs (3.5 - ($a % 8))))}] + set colB [expr {3 - ( int ( abs (3.5 - ($b % 8))))}] + set rowA [expr {3 - ( int ( abs (3.5 - ($a / 8))))}] + set rowB [expr {3 - ( int ( abs (3.5 - ($b / 8))))}] + return [expr {(($colA * $rowA) < ($colB * $rowB)) ? $a : $b}] } # Display a square number as a standard chess square notation. proc N {square} { - return [format %c%d [expr {97 + $square % 8}] \ - [expr {$square / 8 + 1}]] + return [format %c%d [expr {97 + ($square % 8)}] \ + [expr {($square / 8) + 1}]] } # Perform a Knight's move and schedule the next move. @@ -92,12 +93,12 @@ proc MovePiece {dlg last square} { variable continuous $dlg.f.txt insert end "[llength $visited]. [N $last] .. [N $square]\n" {} $dlg.f.txt see end - $dlg.f.c itemconfigure [expr {1+$last}] -state normal -outline black - $dlg.f.c itemconfigure [expr {1+$square}] -state normal -outline red - $dlg.f.c moveto knight {*}[lrange [$dlg.f.c coords [expr {1+$square}]] 0 1] + $dlg.f.c itemconfigure [expr {1 + $last}] -state normal -outline black + $dlg.f.c itemconfigure [expr {1 + $square}] -state normal -outline red + $dlg.f.c moveto knight {*}[lrange [$dlg.f.c coords [expr {1 + $square}]] 0 1] lappend visited $square set next [Next $square] - if {$next ne -1} { + if {$next ne "-1"} { variable aid [after $delay [list MovePiece $dlg $square $next]] } else { $dlg.tf.b1 configure -state normal @@ -109,7 +110,7 @@ proc MovePiece {dlg last square} { $dlg.f.txt insert end "Success\n" {} if {$continuous} { after [expr {$delay * 2}] [namespace code \ - [list Tour $dlg [expr {int(rand() * 64)}]]] + [list Tour $dlg [expr { ( int ( ( rand ()) * 64))}]]] } } } else { @@ -119,16 +120,16 @@ proc MovePiece {dlg last square} { } # Begin a new tour of the board given a random start position -proc Tour {dlg {square {}}} { - variable visited {} +proc Tour {dlg {square ""}} { + variable visited "" $dlg.f.txt delete 1.0 end $dlg.tf.b1 configure -state disabled for {set n 0} {$n < 64} {incr n} { $dlg.f.c itemconfigure $n -state disabled -outline black } - if {$square eq {}} { + if {$square eq ""} { set coords [lrange [$dlg.f.c coords knight] 0 1] - set square [expr {[$dlg.f.c find closest {*}$coords 0 65]-1}] + set square [expr {[$dlg.f.c find closest {*}$coords 0 65] - 1}] } variable initial $square after idle [list MovePiece $dlg $initial $initial] @@ -140,12 +141,12 @@ proc Stop {} { } proc Exit {dlg} { - Stop + Stop destroy $dlg } proc SetDelay {new} { - variable delay [expr {int($new)}] + variable delay [expr { int ($new)}] } proc DragStart {w x y} { @@ -156,20 +157,21 @@ proc DragStart {w x y} { proc DragMotion {w x y} { variable dragging if {[info exists dragging]} { - $w move selected [expr {$x - [lindex $dragging 0]}] \ - [expr {$y - [lindex $dragging 1]}] - variable dragging [list $x $y] + lassign $dragging x_d y_d + $w move selected [expr {$x - $x_d}] [expr {$y - $y_d}] + set dragging [list $x $y] } } proc DragEnd {w x y} { set square [$w find closest $x $y 0 65] $w moveto selected {*}[lrange [$w coords $square] 0 1] $w dtag selected - variable dragging ; unset dragging + variable dragging + unset dragging } proc CreateGUI {} { - catch {destroy .knightstour} + destroy .knightstour set dlg [toplevel .knightstour] wm title $dlg "Knights tour" wm withdraw $dlg @@ -193,12 +195,14 @@ proc CreateGUI {} { for {set row 7} {$row != -1} {incr row -1} { for {set col 0} {$col < 8} {incr col} { if {(($col & 1) ^ ($row & 1))} { - set fill tan3 ; set dfill tan4 + set fill tan3 + set dfill tan4 } else { - set fill bisque ; set dfill bisque3 + set fill bisque + set dfill bisque3 } - set coords [list [expr {$col * 30 + 4}] [expr {$row * 30 + 4}] \ - [expr {$col * 30 + 30}] [expr {$row * 30 + 30}]] + set coords [list [expr {($col * 30) + 4}] [expr {($row * 30) + 4}] \ + [expr {($col * 30) + 30}] [expr {($row * 30) + 30}]] $c create rectangle $coords -fill $fill -disabledfill $dfill \ -width 2 -state disabled } @@ -228,7 +232,9 @@ proc CreateGUI {} { grid $f - - - - - -sticky news set things [list $dlg.tf.ls $dlg.tf.sc $dlg.tf.cc $dlg.tf.b1] - if {![info exists ::widgetDemo]} { + + global widgetDemo + if {![info exists widgetDemo]} { lappend things $dlg.tf.b2 if {[tk windowingsystem] ne "aqua"} { set things [linsert $things 0 [ttk::sizegrip $dlg.tf.sg]] @@ -241,7 +247,7 @@ proc CreateGUI {} { pack configure [lindex $things end] -padx {16 4} } grid $dlg.tf - - - - - -sticky ew - if {[info exists ::widgetDemo]} { + if {[info exists widgetDemo]} { grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew } diff --git a/library/demos/label.tcl b/library/demos/label.tcl index 13463f7..690fc9a 100644 --- a/library/demos/label.tcl +++ b/library/demos/label.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .label -catch {destroy $w} +destroy $w toplevel $w wm title $w "Label Demonstration" wm iconname $w "label" diff --git a/library/demos/labelframe.tcl b/library/demos/labelframe.tcl index 21d079f..3ac2ecc 100644 --- a/library/demos/labelframe.tcl +++ b/library/demos/labelframe.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .labelframe -catch {destroy $w} +destroy $w toplevel $w wm title $w "Labelframe Demonstration" wm iconname $w "labelframe" @@ -46,11 +46,12 @@ foreach value {1 2 3 4} { # Using a label window to control a group of options. - +set lfdummy2 0 proc lfEnableButtons {w} { + global lfdummy2 foreach child [winfo children $w] { - if {$child == "$w.cb"} continue - if {$::lfdummy2} { + if {$child eq "$w.cb"} continue + if {$lfdummy2} { $child configure -state normal } else { $child configure -state disabled @@ -72,5 +73,4 @@ foreach str {Option1 Option2 Option3} { } lfEnableButtons $w.f2 - grid columnconfigure $w {0 1} -weight 1 diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl index 7a4dd4c..4e099c3 100644 --- a/library/demos/mclist.tcl +++ b/library/demos/mclist.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .mclist -catch {destroy $w} +destroy $w toplevel $w wm title $w "Multi-Column List" wm iconname $w "mclist" @@ -74,7 +74,7 @@ set font [ttk::style lookup Treeview -font] foreach {country capital currency} $data { $w.tree insert {} end -values [list $country $capital $currency] foreach col {country capital currency} { - set len [font measure $font "[set $col] "] + set len [font measure $font "[set [set col]] "] if {[$w.tree column $col -width] < $len} { $w.tree column $col -width $len } @@ -86,7 +86,7 @@ proc SortBy {tree col direction} { # Determine currently sorted column and its sort direction foreach c {country capital currency} { set s [$tree heading $c state] - if {("selected" in $s || "alternate" in $s) && $col ne $c} { + if {(("selected" in $s) || ("alternate" in $s)) && ($col ne $c)} { # Sorted column has changed $tree heading $c -image noArrow state {!selected !alternate !user1} set direction [expr {"alternate" in $s}] @@ -94,7 +94,7 @@ proc SortBy {tree col direction} { } # Build something we can sort - set data {} + set data [list] foreach row [$tree children {}] { lappend data [list [$tree set $row $col] $row] } @@ -109,11 +109,11 @@ proc SortBy {tree col direction} { # Switch the heading so that it will sort in the opposite direction $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] \ - state [expr {$direction?"!selected alternate":"selected !alternate"}] + state [expr {$direction ? "!selected alternate" : "selected !alternate"}] if {[ttk::style theme use] eq "aqua"} { # Aqua theme displays native sort arrows when user1 state is set $tree heading $col state "user1" } else { - $tree heading $col -image [expr {$direction?"upArrow":"downArrow"}] + $tree heading $col -image [expr {$direction ? "upArrow" : "downArrow"}] } } diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl index e19df57..d1acd10 100644 --- a/library/demos/menu.tcl +++ b/library/demos/menu.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .menu -catch {destroy $w} +destroy $w toplevel $w wm title $w "Menu Demonstration" wm iconname $w "menu" @@ -18,7 +18,10 @@ positionWindow $w label $w.msg -font $font -wraplength 4i -justify left if {[tk windowingsystem] eq "aqua"} { - catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1} + catch { + set origUseCustomMDEF $::tk::mac::useCustomMDEF + set ::tk::mac::useCustomMDEF 1 + } $w.msg configure -text "This window has a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by selecting the first item in the menu." } else { $w.msg configure -text "This window contains a menubar with cascaded menus. You can post a menu from the keyboard by typing Alt+x, where \"x\" is the character underlined on the menu. You can then traverse among the menus using the arrow keys. When a menu is posted, you can invoke the current entry by typing space, or you can invoke any entry by typing its underlined character. If a menu entry has an accelerator, you can invoke the entry without posting the menu just by typing the accelerator. The rightmost menu can be torn off into a palette by selecting the first item in the menu." @@ -129,7 +132,7 @@ $m entryconfigure 2 -columnbreak 1 set m $w.menu.more $w.menu add cascade -label "More" -menu $m -underline 0 menu $m -tearoff 0 -foreach i {{An entry} {Another entry} {Does nothing} {Does almost nothing} {Make life meaningful}} { +foreach i {"An entry" "Another entry" "Does nothing" "Does almost nothing" "Make life meaningful"} { $m add command -label $i -command [list puts "You invoked \"$i\""] } $m entryconfigure "Does almost nothing" -bitmap questhead -compound left \ @@ -150,7 +153,7 @@ foreach i {red orange yellow green blue} { $w configure -menu $w.menu bind Menu <<MenuSelect>> { - global $menustatus + global [set menustatus] if {[catch {%W entrycget active -label} label]} { set label " " } diff --git a/library/demos/menubu.tcl b/library/demos/menubu.tcl index 86326b5..50e3988 100644 --- a/library/demos/menubu.tcl +++ b/library/demos/menubu.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .menubu -catch {destroy $w} +destroy $w toplevel $w wm title $w "Menu Button Demonstration" wm iconname $w "menubutton" @@ -18,7 +18,12 @@ positionWindow $w frame $w.body pack $w.body -expand 1 -fill both -if {[tk windowingsystem] eq "aqua"} {catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1}} +if {[tk windowingsystem] eq "aqua"} { + catch { + set origUseCustomMDEF $::tk::mac::useCustomMDEF + set ::tk::mac::useCustomMDEF 1 + } +} menubutton $w.body.below -text "Below" -underline 0 -direction below -menu $w.body.below.m -relief raised menu $w.body.below.m -tearoff 0 diff --git a/library/demos/msgbox.tcl b/library/demos/msgbox.tcl index bd98bf2..7961107 100644 --- a/library/demos/msgbox.tcl +++ b/library/demos/msgbox.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .msgbox -catch {destroy $w} +destroy $w toplevel $w wm title $w "Message Box Demonstration" wm iconname $w "messagebox" diff --git a/library/demos/paned1.tcl b/library/demos/paned1.tcl index 783b7f3..8541dde 100644 --- a/library/demos/paned1.tcl +++ b/library/demos/paned1.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .paned1 -catch {destroy $w} +destroy $w toplevel $w wm title $w "Horizontal Paned Window Demonstration" wm iconname $w "paned1" diff --git a/library/demos/paned2.tcl b/library/demos/paned2.tcl index f481d14..3a364c3 100644 --- a/library/demos/paned2.tcl +++ b/library/demos/paned2.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .paned2 -catch {destroy $w} +destroy $w toplevel $w wm title $w "Vertical Paned Window Demonstration" wm iconname $w "paned2" diff --git a/library/demos/pendulum.tcl b/library/demos/pendulum.tcl index d344d8d..4fff99a 100644 --- a/library/demos/pendulum.tcl +++ b/library/demos/pendulum.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .pendulum -catch {destroy $w} +destroy $w toplevel $w wm title $w "Pendulum Animation Demonstration" wm iconname $w "pendulum" @@ -34,7 +34,7 @@ canvas $w.c -width 320 -height 200 -background white -bd 2 -relief sunken $w.c create text 5 5 -anchor nw -text "Click to Adjust Bob Start Position" # Coordinates of these items don't matter; they will be set properly below $w.c create line 0 25 320 25 -tags plate -fill grey50 -width 2 -$w.c create oval 155 20 165 30 -tags pivot -fill grey50 -outline {} +$w.c create oval 155 20 165 30 -tags pivot -fill grey50 -outline "" $w.c create line 1 1 1 1 -tags rod -fill black -width 3 $w.c create oval 1 1 2 2 -tags bob -fill yellow -outline black pack $w.c -in $w.p.l1 -fill both -expand true @@ -45,7 +45,7 @@ pack $w.c -in $w.p.l1 -fill both -expand true canvas $w.k -width 320 -height 200 -background white -bd 2 -relief sunken $w.k create line 160 200 160 0 -fill grey75 -arrow last -tags y_axis $w.k create line 0 100 320 100 -fill grey75 -arrow last -tags x_axis -for {set i 90} {$i>=0} {incr i -10} { +for {set i 90} {$i >= 0} {incr i -10} { # Coordinates of these items don't matter; they will be set properly below $w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i } @@ -55,7 +55,7 @@ $w.k create text 0 0 -anchor ne -text "\u03b4\u03b8" -tags label_dtheta pack $w.k -in $w.p.l2 -fill both -expand true # Initialize some variables -set points {} +set points [list] set Theta 45.0 set dTheta 0.0 set pi 3.1415926535897933 @@ -68,22 +68,22 @@ set home 160 # the pendulum from the length of the pendulum rod and its angle, the # length and angle are computed in reverse from the given location # (which is taken to be the centre of the pendulum bob.) -proc showPendulum {canvas {at {}} {x {}} {y {}}} { +proc showPendulum {canvas {at ""} {x ""} {y ""}} { global Theta dTheta pi length home - if {$at eq "at" && ($x!=$home || $y!=25)} { + if {($at eq "at") && (($x != $home) || ($y != 25))} { set dTheta 0.0 set x2 [expr {$x - $home}] set y2 [expr {$y - 25}] - set length [expr {hypot($x2, $y2)}] - set Theta [expr {atan2($x2, $y2) * 180/$pi}] + set length [expr { hypot ($x2, $y2)}] + set Theta [expr { ( ( atan2 ($x2, $y2) ) * 180) / $pi}] } else { - set angle [expr {$Theta * $pi/180}] - set x [expr {$home + $length*sin($angle)}] - set y [expr {25 + $length*cos($angle)}] + set angle [expr {($Theta * $pi) / 180}] + set x [expr {$home + ($length * ( sin ($angle)))}] + set y [expr {25 + ($length * ( cos ($angle)))}] } $canvas coords rod $home 25 $x $y $canvas coords bob \ - [expr {$x-15}] [expr {$y-15}] [expr {$x+15}] [expr {$y+15}] + [expr {$x - 15}] [expr {$y - 15}] [expr {$x + 15}] [expr {$y + 15}] } showPendulum $w.c @@ -92,12 +92,12 @@ showPendulum $w.c # respect to time.) proc showPhase {canvas} { global Theta dTheta points psw psh - lappend points [expr {$Theta+$psw}] [expr {-20*$dTheta+$psh}] + lappend points [expr {$Theta + $psw}] [expr {(-20 * $dTheta) + $psh}] if {[llength $points] > 100} { set points [lrange $points end-99 end] } - for {set i 0} {$i<100} {incr i 10} { - set list [lrange $points end-[expr {$i-1}] end-[expr {$i-12}]] + for {set i 0} {$i < 100} {incr i 10} { + set list [lrange $points end-[expr {$i - 1}] end-[expr {$i - 12}]] if {[llength $list] >= 4} { $canvas coords graph$i $list } @@ -126,16 +126,16 @@ bind $w.c <ButtonRelease-1> { } bind $w.c <Configure> { %W coords plate 0 25 %w 25 - set home [expr %w/2] - %W coords pivot [expr $home-5] 20 [expr $home+5] 30 + set home [expr {%w / 2}] + %W coords pivot [expr {$home - 5}] 20 [expr {$home + 5}] 30 } bind $w.k <Configure> { - set psh [expr %h/2] - set psw [expr %w/2] - %W coords x_axis 2 $psh [expr %w-2] $psh - %W coords y_axis $psw [expr %h-2] $psw 2 - %W coords label_dtheta [expr $psw-4] 6 - %W coords label_theta [expr %w-6] [expr $psh+4] + set psh [expr {%h / 2}] + set psw [expr {%w / 2}] + %W coords x_axis 2 $psh [expr {%w - 2}] $psh + %W coords y_axis $psw [expr {%h - 2}] $psw 2 + %W coords label_dtheta [expr {$psw - 4}] 6 + %W coords label_theta [expr {%w - 6}] [expr {$psh + 4}] } # This procedure is the "business" part of the simulation that does @@ -143,7 +143,7 @@ bind $w.k <Configure> { # pendulum. proc recomputeAngle {} { global Theta dTheta pi length - set scaling [expr {3000.0/$length/$length}] + set scaling [expr {(3000.0 / $length) / $length}] # To estimate the integration accurately, we really need to # compute the end-point of our time-step. But to do *that*, we @@ -157,22 +157,22 @@ proc recomputeAngle {} { # But my math skills are not good enough to solve this! # first estimate - set firstDDTheta [expr {-sin($Theta * $pi/180)*$scaling}] + set firstDDTheta [expr {- ( sin (($Theta * $pi) / 180) ) * $scaling}] set midDTheta [expr {$dTheta + $firstDDTheta}] - set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}] + set midTheta [expr {$Theta + (($dTheta + $midDTheta) / 2)}] # second estimate - set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}] - set midDTheta [expr {$dTheta + ($firstDDTheta + $midDDTheta)/2}] - set midTheta [expr {$Theta + ($dTheta + $midDTheta)/2}] + set midDDTheta [expr {- ( sin (($midTheta * $pi) / 180) ) * $scaling}] + set midDTheta [expr {$dTheta + (($firstDDTheta + $midDDTheta) / 2)}] + set midTheta [expr {$Theta + (($dTheta + $midDTheta) / 2)}] # Now we do a double-estimate approach for getting the final value # first estimate - set midDDTheta [expr {-sin($midTheta * $pi/180)*$scaling}] + set midDDTheta [expr {- ( sin (($midTheta * $pi) / 180) ) * $scaling}] set lastDTheta [expr {$midDTheta + $midDDTheta}] - set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}] + set lastTheta [expr {$midTheta + (($midDTheta + $lastDTheta) / 2)}] # second estimate - set lastDDTheta [expr {-sin($lastTheta * $pi/180)*$scaling}] - set lastDTheta [expr {$midDTheta + ($midDDTheta + $lastDDTheta)/2}] - set lastTheta [expr {$midTheta + ($midDTheta + $lastDTheta)/2}] + set lastDDTheta [expr {- ( sin ( ($lastTheta * $pi) / 180) ) * $scaling}] + set lastDTheta [expr {$midDTheta + (($midDDTheta + $lastDDTheta) / 2)}] + set lastTheta [expr {$midTheta + (($midDTheta + $lastDTheta) / 2)}] # Now put the values back in our globals set dTheta $lastDTheta set Theta $lastTheta @@ -180,11 +180,11 @@ proc recomputeAngle {} { # This method ties together the simulation engine and the graphical # display code that visualizes it. -proc repeat w { +proc repeat {w} { global animationCallbacks # Simulate - recomputeAngle + recomputeAngle # Update the display showPendulum $w.c diff --git a/library/demos/plot.tcl b/library/demos/plot.tcl index e7f0361..b1b87bd 100644 --- a/library/demos/plot.tcl +++ b/library/demos/plot.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .plot -catch {destroy $w} +destroy $w toplevel $w wm title $w "Plot Demonstration" wm iconname $w "Plot" @@ -27,30 +27,31 @@ pack $btns -side bottom -fill x canvas $c -relief raised -width 450 -height 300 pack $w.c -side top -fill x -set plotFont {Helvetica 18} +set plotFont "Helvetica 18" $c create line 100 250 400 250 -width 2 $c create line 100 250 100 50 -width 2 $c create text 225 20 -text "A Simple Plot" -font $plotFont -fill brown for {set i 0} {$i <= 10} {incr i} { - set x [expr {100 + ($i*30)}] + set x [expr {100 + ($i * 30)}] $c create line $x 250 $x 245 -width 2 - $c create text $x 254 -text [expr {10*$i}] -anchor n -font $plotFont + $c create text $x 254 -text [expr {10 * $i}] -anchor n -font $plotFont } for {set i 0} {$i <= 5} {incr i} { - set y [expr {250 - ($i*40)}] + set y [expr {250 - ($i * 40)}] $c create line 100 $y 105 $y -width 2 - $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $plotFont + $c create text 96 $y -text [expr {$i * 50}].0 -anchor e -font $plotFont } foreach point { {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} } { - set x [expr {100 + (3*[lindex $point 0])}] - set y [expr {250 - (4*[lindex $point 1])/5}] - set item [$c create oval [expr {$x-6}] [expr {$y-6}] \ - [expr {$x+6}] [expr {$y+6}] -width 1 -outline black \ + lassign $point p_x p_y + set x [expr {100 + (3 * $p_x)}] + set y [expr {250 - ((4 * $p_y) / 5)}] + set item [$c create oval [expr {$x - 6}] [expr {$y - 6}] \ + [expr {$x + 6}] [expr {$y + 6}] -width 1 -outline black \ -fill SkyBlue2] $c addtag point withtag $item } @@ -91,7 +92,7 @@ proc plotDown {w x y} { proc plotMove {w x y} { global plot - $w move selected [expr {$x-$plot(lastX)}] [expr {$y-$plot(lastY)}] + $w move selected [expr {$x - $plot(lastX)}] [expr {$y - $plot(lastY)}] set plot(lastX) $x set plot(lastY) $y } diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl index fb8ab4c..1a9ddd0 100644 --- a/library/demos/puzzle.tcl +++ b/library/demos/puzzle.tcl @@ -16,14 +16,14 @@ package require Tk proc puzzleSwitch {w num} { global xpos ypos - if {(($ypos($num) >= ($ypos(space) - .01)) - && ($ypos($num) <= ($ypos(space) + .01)) - && ($xpos($num) >= ($xpos(space) - .26)) - && ($xpos($num) <= ($xpos(space) + .26))) - || (($xpos($num) >= ($xpos(space) - .01)) - && ($xpos($num) <= ($xpos(space) + .01)) - && ($ypos($num) >= ($ypos(space) - .26)) - && ($ypos($num) <= ($ypos(space) + .26)))} { + if {(($ypos($num) >= ($ypos(space) - .01)) && + ($ypos($num) <= ($ypos(space) + .01)) && + ($xpos($num) >= ($xpos(space) - .26)) && + ($xpos($num) <= ($xpos(space) + .26))) || + (($xpos($num) >= ($xpos(space) - .01)) && + ($xpos($num) <= ($xpos(space) + .01)) && + ($ypos($num) >= ($ypos(space) - .26)) && + ($ypos($num) <= ($ypos(space) + .26)))} { set tmp $xpos(space) set xpos(space) $xpos($num) set xpos($num) $tmp @@ -35,7 +35,7 @@ proc puzzleSwitch {w num} { } set w .puzzle -catch {destroy $w} +destroy $w toplevel $w wm title $w "15-Puzzle Demonstration" wm iconname $w "15-Puzzle" @@ -68,11 +68,11 @@ frame $w.frame -width $frameSize -height $frameSize -borderwidth 2\ pack $w.frame -side top -pady 1c -padx 1c destroy $w.s -set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12} -for {set i 0} {$i < 15} {set i [expr {$i+1}]} { +set order [list 3 1 6 2 5 7 15 13 4 11 8 9 14 10 12] +for {set i 0} {$i < 15} {set i [expr {$i + 1}]} { set num [lindex $order $i] - set xpos($num) [expr {($i%4)*.25}] - set ypos($num) [expr {($i/4)*.25}] + set xpos($num) [expr {($i % 4) * .25}] + set ypos($num) [expr {($i / 4) * .25}] button $w.frame.$num -relief raised -text $num -highlightthickness 0 \ -command "puzzleSwitch $w $num" place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \ diff --git a/library/demos/radio.tcl b/library/demos/radio.tcl index 5c73703..26217ec 100644 --- a/library/demos/radio.tcl +++ b/library/demos/radio.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .radio -catch {destroy $w} +destroy $w toplevel $w wm title $w "Radiobutton Demonstration" wm iconname $w "radio" @@ -25,7 +25,7 @@ grid $btns -row 3 -column 0 -columnspan 3 -sticky ew labelframe $w.left -pady 2 -text "Point Size" -padx 2 labelframe $w.mid -pady 2 -text "Color" -padx 2 labelframe $w.right -pady 2 -text "Alignment" -padx 2 -button $w.tristate -text Tristate -command "set size multi; set color multi" \ +button $w.tristate -text Tristate -command "lassign [list multi multi] size color" \ -pady 2 -padx 2 if {[tk windowingsystem] eq "aqua"} { $w.tristate configure -padx 10 @@ -50,7 +50,6 @@ foreach c {Red Green Blue Yellow Orange Purple} { pack $w.mid.$lower -side top -pady 2 -fill x } - label $w.right.l -text "Label" -bitmap questhead -compound left $w.right.l configure -width [winfo reqwidth $w.right.l] -compound top $w.right.l configure -height [winfo reqheight $w.right.l] diff --git a/library/demos/rmt b/library/demos/rmt index 51886de..81c9f8c 100644 --- a/library/demos/rmt +++ b/library/demos/rmt @@ -116,7 +116,7 @@ proc tk::TextInsert {w s} { catch { if { [$w compare sel.first <= insert] && [$w compare sel.last >= insert] - } then { + } { $w tag remove sel sel.first promptEnd $w delete sel.first sel.last } @@ -125,8 +125,8 @@ proc tk::TextInsert {w s} { $w see insert } -.t configure -font {Courier 12} -.t tag configure bold -font {Courier 12 bold} +.t configure -font "Courier 12" +.t tag configure bold -font "Courier 12 bold" # The procedure below is used to print out a prompt at the # insertion point (which should be at the beginning of a line @@ -177,7 +177,7 @@ proc invoke {} { # the text item (in which case a new prompt is about to be output # so there's no need to change the old one). -proc newApp appName { +proc newApp {appName} { global app executing set app $appName if {!$executing} { diff --git a/library/demos/rolodex b/library/demos/rolodex index 8941570..b4ddcd4 100644 --- a/library/demos/rolodex +++ b/library/demos/rolodex @@ -10,9 +10,7 @@ exec wish "$0" ${1+"$@"} package require Tk -foreach i [winfo child .] { - catch {destroy $i} -} +destroy {*}[winfo children .] set version 1.2 @@ -23,7 +21,7 @@ set version 1.2 frame .frame -relief flat pack .frame -side top -fill y -anchor center -set names {{} Name: Address: {} {} {Home Phone:} {Work Phone:} Fax:} +set names {"" Name: Address: "" "" {Home Phone:} {Work Phone:} Fax:} foreach i {1 2 3 4 5 6 7} { label .frame.label$i -text [lindex $names $i] -anchor e entry .frame.entry$i -width 35 @@ -61,7 +59,7 @@ menu .menu.help.m pack .menu.help -side right proc deleteAction {} { - if {[tk_dialog .delete {Confirm Action} {Are you sure?} {} 0 Cancel] + if {[tk_dialog .delete "Confirm Action" "Are you sure?" "" 0 Cancel] == 0} { clearAction } @@ -69,8 +67,8 @@ proc deleteAction {} { .buttons.delete config -command deleteAction proc fileAction {} { - tk_dialog .fileSelection {File Selection} {This is a dummy file selection dialog box, which is used because there isn't a good file selection dialog built into Tk yet.} {} 0 OK - puts stderr {dummy file name} + tk_dialog .fileSelection "File Selection" "This is a dummy file selection dialog box, which is used because there isn't a good file selection dialog built into Tk yet." "" 0 OK + puts stderr "dummy file name" } #------------------------------------------ @@ -113,13 +111,13 @@ proc fillCard {} { #---------------------------------------------------- .buttons.clear config -text "Clear Ctrl+C" -bind . <Control-c> clearAction +bind . <Control-c> "clearAction " .buttons.add config -text "Add Ctrl+A" -bind . <Control-a> addAction +bind . <Control-a> "addAction " .buttons.search config -text "Search Ctrl+S" -bind . <Control-s> "addAction; fillCard" +bind . <Control-s> "addAction ; fillCard " .buttons.delete config -text "Delete... Ctrl+D" -bind . <Control-d> deleteAction +bind . <Control-d> "deleteAction " .menu.file.m entryconfig 1 -accel Ctrl+F bind . <Control-f> fileAction @@ -134,21 +132,21 @@ focus .frame.entry1 proc Help {topic {x 0} {y 0}} { global helpTopics helpCmds - if {$topic == ""} return + if {$topic eq ""} return while {[info exists helpCmds($topic)]} { set topic [eval $helpCmds($topic)] } - if [info exists helpTopics($topic)] { + if {[info exists helpTopics($topic)]} { set msg $helpTopics($topic) } else { set msg "Sorry, but no help is available for this topic" } - tk_dialog .help {Rolodex Help} "Information on $topic:\n\n$msg" \ - {} 0 OK + tk_dialog .help "Rolodex Help" "Information on $topic:\n\n$msg" \ + "" 0 OK } proc getMenuTopic {w x y} { - return $w.[$w index @[expr {$y-[winfo rooty $w]}]] + return $w.[$w index @[expr {$y - [winfo rooty $w]}]] } event add <<Help>> <F1> <Help> @@ -172,13 +170,9 @@ set helpTopics(.frame.entry5) {In this field of the rolodex entry you should typ set helpTopics(.frame.entry6) {In this field of the rolodex entry you should type the person's work phone number} set helpTopics(.frame.entry7) {In this field of the rolodex entry you should type the phone number for the person's FAX machine} -set helpCmds(.frame.label1) {set topic .frame.entry1} -set helpCmds(.frame.label2) {set topic .frame.entry2} -set helpCmds(.frame.label3) {set topic .frame.entry3} -set helpCmds(.frame.label4) {set topic .frame.entry4} -set helpCmds(.frame.label5) {set topic .frame.entry5} -set helpCmds(.frame.label6) {set topic .frame.entry6} -set helpCmds(.frame.label7) {set topic .frame.entry7} +foreach id [list 1 2 3 4 5 6 7] { + set helpCmds(.frame.label$id) "set topic .frame.entry$id" +} set helpTopics(context) {Unfortunately, this application doesn't support context-sensitive help in the usual way, because when this demo was written Tk didn't have a grab mechanism and this is needed for context-sensitive help. Instead, you can achieve much the same effect by simply moving the mouse over the window you're curious about and pressing the Help or F1 keys. You can do this anytime.} set helpTopics(help) {This application provides only very crude help. Besides the entries in this menu, you can get help on individual windows by moving the mouse cursor over the window and pressing the Help or F1 keys.} diff --git a/library/demos/ruler.tcl b/library/demos/ruler.tcl index 557b680..0a6990f 100644 --- a/library/demos/ruler.tcl +++ b/library/demos/ruler.tcl @@ -19,12 +19,12 @@ package require Tk proc rulerMkTab {c x y} { upvar #0 demo_rulerInfo v - $c create polygon $x $y [expr {$x+$v(size)}] [expr {$y+$v(size)}] \ - [expr {$x-$v(size)}] [expr {$y+$v(size)}] + $c create polygon $x $y [expr {$x + $v(size)}] [expr {$y + $v(size)}] \ + [expr {$x - $v(size)}] [expr {$y + $v(size)}] } set w .ruler -catch {destroy $w} +destroy $w toplevel $w wm title $w "Ruler Demonstration" wm iconname $w "ruler" @@ -61,7 +61,7 @@ if {[winfo depth $c] > 1} { $c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1 for {set i 0} {$i < 12} {incr i} { - set x [expr {$i+1}] + set x [expr {$i + 1}] $c create line ${x}c 1c ${x}c 0.6c -width 1 $c create line $x.25c 1c $x.25c 0.8c -width 1 $c create line $x.5c 1c $x.5c 0.7c -width 1 @@ -108,7 +108,7 @@ proc rulerNewTab {c x y} { proc rulerSelectTab {c x y} { upvar #0 demo_rulerInfo v set v(x) [$c canvasx $x $v(grid)] - set v(y) [expr {$v(top)+2}] + set v(y) [expr {$v(top) + 2}] $c addtag active withtag current eval "$c itemconf active $v(activeStyle)" $c raise active @@ -125,7 +125,7 @@ proc rulerSelectTab {c x y} { proc rulerMoveTab {c x y} { upvar #0 demo_rulerInfo v - if {[$c find withtag active] == ""} { + if {[$c find withtag active] eq ""} { return } set cx [$c canvasx $x $v(grid)] @@ -137,13 +137,13 @@ proc rulerMoveTab {c x y} { set cx $v(right) } if {($cy >= $v(top)) && ($cy <= $v(bottom))} { - set cy [expr {$v(top)+2}] + set cy [expr {$v(top) + 2}] eval "$c itemconf active $v(activeStyle)" } else { - set cy [expr {$cy-$v(size)-2}] + set cy [expr {($cy - $v(size)) - 2}] eval "$c itemconf active $v(deleteStyle)" } - $c move active [expr {$cx-$v(x)}] [expr {$cy-$v(y)}] + $c move active [expr {$cx - $v(x)}] [expr {$cy - $v(y)}] set v(x) $cx set v(y) $cy } @@ -157,15 +157,15 @@ proc rulerMoveTab {c x y} { # c - The canvas widget. # x, y - The coordinates of the mouse. -proc rulerReleaseTab c { +proc rulerReleaseTab {c} { upvar #0 demo_rulerInfo v - if {[$c find withtag active] == {}} { + if {[$c find withtag active] eq ""} { return } - if {$v(y) != $v(top)+2} { + if {$v(y) != ($v(top) + 2)} { $c delete active } else { - eval "$c itemconf active $v(normalStyle)" + eval "$c itemconfigure active $v(normalStyle)" $c dtag active } } diff --git a/library/demos/sayings.tcl b/library/demos/sayings.tcl index 4d26ffe..848c342 100644 --- a/library/demos/sayings.tcl +++ b/library/demos/sayings.tcl @@ -11,7 +11,7 @@ if {![info exists widgetDemo]} { package require Tk set w .sayings -catch {destroy $w} +destroy $w toplevel $w wm title $w "Listbox Demonstration (well-known sayings)" wm iconname $w "sayings" @@ -27,7 +27,6 @@ pack $btns -side bottom -fill x frame $w.frame -borderwidth 10 pack $w.frame -side top -expand yes -fill both -padx 1c - scrollbar $w.frame.yscroll -command "$w.frame.list yview" scrollbar $w.frame.xscroll -orient horizontal \ -command "$w.frame.list xview" @@ -40,5 +39,4 @@ grid $w.frame.xscroll -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news grid rowconfig $w.frame 0 -weight 1 -minsize 0 grid columnconfig $w.frame 0 -weight 1 -minsize 0 - $w.frame.list insert 0 "Don't speculate, measure" "Waste not, want not" "Early to bed and early to rise makes a man healthy, wealthy, and wise" "Ask not what your country can do for you, ask what you can do for your country" "I shall return" "NOT" "A picture is worth a thousand words" "User interfaces are hard to build" "Thou shalt not steal" "A penny for your thoughts" "Fool me once, shame on you; fool me twice, shame on me" "Every cloud has a silver lining" "Where there's smoke there's fire" "It takes one to know one" "Curiosity killed the cat" "Take this job and shove it" "Up a creek without a paddle" "I'm mad as hell and I'm not going to take it any more" "An apple a day keeps the doctor away" "Don't look a gift horse in the mouth" "Measure twice, cut once" diff --git a/library/demos/search.tcl b/library/demos/search.tcl index 9f44e16..10705d3 100644 --- a/library/demos/search.tcl +++ b/library/demos/search.tcl @@ -41,13 +41,14 @@ proc textLoadFile {w file} { proc textSearch {w string tag} { $w tag remove search 0.0 end - if {$string == ""} { + if {$string eq ""} { return } set cur 1.0 - while 1 { + while {1} { + set length 0 set cur [$w search -count length $string $cur end] - if {$cur == ""} { + if {$cur eq ""} { break } $w tag add $tag $cur "$cur + $length char" @@ -76,7 +77,7 @@ proc textToggle {cmd1 sleep1 cmd2 sleep2} { } set w .search -catch {destroy $w} +destroy $w toplevel $w wm title $w "Text Demonstration - Search and Highlight" wm iconname $w "search" diff --git a/library/demos/spin.tcl b/library/demos/spin.tcl index d897e6d..f8aefbb 100644 --- a/library/demos/spin.tcl +++ b/library/demos/spin.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .spin -catch {destroy $w} +destroy $w toplevel $w wm title $w "Spinbox Demonstration" wm iconname $w "spin" @@ -38,7 +38,7 @@ set australianCities { } spinbox $w.s1 -from 1 -to 10 -width 10 -validate key \ - -vcmd {string is integer %P} + -validatecommand {string is integer %P} spinbox $w.s2 -from 0 -to 3 -increment .5 -format %05.2f -width 10 spinbox $w.s3 -values $australianCities -width 10 diff --git a/library/demos/square b/library/demos/square index 08c362b..8c1e497 100644 --- a/library/demos/square +++ b/library/demos/square @@ -27,7 +27,7 @@ focus .s proc center {x y} { set a [.s size] - .s position [expr $x-($a/2)] [expr $y-($a/2)] + .s position [expr {$x - ($a / 2)}] [expr {$y - ($a / 2)}] } # The procedures below provide a simple form of animation where @@ -51,7 +51,7 @@ proc timer {} { if {$inc == 0} return if {$s >= 40} {set inc -3} if {$s <= 10} {set inc 3} - .s size [expr {$s+$inc}] + .s size [expr {$s + $inc}] after 30 timer } diff --git a/library/demos/states.tcl b/library/demos/states.tcl index e76540d..aafa9b1 100644 --- a/library/demos/states.tcl +++ b/library/demos/states.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .states -catch {destroy $w} +destroy $w toplevel $w wm title $w "Listbox Demonstration (50 states)" wm iconname $w "states" diff --git a/library/demos/style.tcl b/library/demos/style.tcl index 614ea1f..0be4ccb 100644 --- a/library/demos/style.tcl +++ b/library/demos/style.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .style -catch {destroy $w} +destroy $w toplevel $w wm title $w "Text Demonstration - Display Styles" wm iconname $w "style" @@ -37,7 +37,7 @@ $w.text tag configure big -font "$family 14 bold" $w.text tag configure verybig -font "Helvetica 24 bold" $w.text tag configure tiny -font "Times 8 bold" if {[winfo depth $w] > 1} { - $w.text tag configure color1 -background #a0b7ce + $w.text tag configure color1 -background "#a0b7ce" $w.text tag configure color2 -foreground red $w.text tag configure raised -relief raised -borderwidth 1 $w.text tag configure sunken -relief sunken -borderwidth 1 diff --git a/library/demos/tcolor b/library/demos/tcolor index 6e50c61..fbda604 100644 --- a/library/demos/tcolor +++ b/library/demos/tcolor @@ -96,7 +96,7 @@ foreach i { scrollbar .names.s -orient vertical -command ".names.lb yview" pack .names.lb .names.s -side left -fill y -expand 1 while {[gets $f line] >= 0} { - if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line -> col]} { + if {[regexp {^\s*\d+\s+\d+\s+\d+\s+(\S+)$} $line ___ col]} { .names.lb insert end $col } } @@ -138,30 +138,29 @@ grid .sample -row 0 -column 2 -sticky nsew -padx .15c -pady .15c -rowspan 2 # It propagates color information from the current scale readings # to everywhere else that it is used. -proc tc_scaleChanged args { +proc tc_scaleChanged {args} { global red green blue colorSpace color updating autoUpdate if {$updating} { return } - switch $colorSpace { + switch -- $colorSpace { rgb { - set red [format %.0f [expr {[.scale1 get]*65.535}]] - set green [format %.0f [expr {[.scale2 get]*65.535}]] - set blue [format %.0f [expr {[.scale3 get]*65.535}]] + set red [format %.0f [expr {[.scale1 get] * 65.535}]] + set green [format %.0f [expr {[.scale2 get] * 65.535}]] + set blue [format %.0f [expr {[.scale3 get] * 65.535}]] } cmy { - set red [format %.0f [expr {65535 - [.scale1 get]*65.535}]] - set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]] - set blue [format %.0f [expr {65535 - [.scale3 get]*65.535}]] + set red [format %.0f [expr {65535 - ([.scale1 get] * 65.535)}]] + set green [format %.0f [expr {65535 - ([.scale2 get] * 65.535)}]] + set blue [format %.0f [expr {65535 - ([.scale3 get] * 65.535)}]] } hsb { - set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \ - [expr {[.scale2 get]/1000.0}] \ - [expr {[.scale3 get]/1000.0}]] - set red [lindex $list 0] - set green [lindex $list 1] - set blue [lindex $list 2] + set list [hsbToRgb [expr {[.scale1 get] / 1000.0}] \ + [expr {[.scale2 get] / 1000.0}] \ + [expr {[.scale3 get] / 1000.0}]] + lassign $list red green blue } + default {} } set color [format "#%04x%04x%04x" $red $green $blue] .sample.swatch config -bg $color @@ -177,23 +176,24 @@ proc tc_scaleChanged args { proc tc_setScales {} { global red green blue colorSpace updating set updating 1 - switch $colorSpace { + switch -- $colorSpace { rgb { - .scale1 set [format %.0f [expr {$red/65.535}]] - .scale2 set [format %.0f [expr {$green/65.535}]] - .scale3 set [format %.0f [expr {$blue/65.535}]] + .scale1 set [format %.0f [expr {$red / 65.535}]] + .scale2 set [format %.0f [expr {$green / 65.535}]] + .scale3 set [format %.0f [expr {$blue / 65.535}]] } cmy { - .scale1 set [format %.0f [expr {(65535-$red)/65.535}]] - .scale2 set [format %.0f [expr {(65535-$green)/65.535}]] - .scale3 set [format %.0f [expr {(65535-$blue)/65.535}]] + .scale1 set [format %.0f [expr {(65535 - $red ) / 65.535}]] + .scale2 set [format %.0f [expr {(65535 - $green) / 65.535}]] + .scale3 set [format %.0f [expr {(65535 - $blue ) / 65.535}]] } hsb { - set list [rgbToHsv $red $green $blue] - .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]] - .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]] - .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]] + lassign [rgbToHsv $red $green $blue] hue sat val + .scale1 set [format %.0f [expr {$hue * 1000.0}]] + .scale2 set [format %.0f [expr {$sat * 1000.0}]] + .scale3 set [format %.0f [expr {$val * 1000.0}]] } + default {} } set updating 0 } @@ -202,28 +202,39 @@ proc tc_setScales {} { # selected from the listbox or typed into the entry. It loads # the color into the editor. -proc tc_loadNamedColor name { +proc tc_loadNamedColor {name} { global red green blue color autoUpdate - if {[string index $name 0] != "#"} { - set list [winfo rgb .sample.swatch $name] - set red [lindex $list 0] - set green [lindex $list 1] - set blue [lindex $list 2] + if {[string index $name 0] ne "#"} { + lassign [winfo rgb .sample.swatch $name] red green blue } else { - switch [string length $name] { - 4 {set format "#%1x%1x%1x"; set shift 12} - 7 {set format "#%2x%2x%2x"; set shift 8} - 10 {set format "#%3x%3x%3x"; set shift 4} - 13 {set format "#%4x%4x%4x"; set shift 0} - default {error "syntax error in color name \"$name\""} + switch -- [string length $name] { + 4 { + set format "#%1x%1x%1x" + set shift 12 + } + 7 { + set format "#%2x%2x%2x" + set shift 8 + } + 10 { + set format "#%3x%3x%3x" + set shift 4 + } + 13 { + set format "#%4x%4x%4x" + set shift 0 + } + default { + error "syntax error in color name \"$name\"" + } } if {[scan $name $format red green blue] != 3} { error "syntax error in color name \"$name\"" } - set red [expr {$red<<$shift}] - set green [expr {$green<<$shift}] - set blue [expr {$blue<<$shift}] + set red [expr {$red << $shift}] + set green [expr {$green << $shift}] + set blue [expr {$blue << $shift}] } tc_setScales set color [format "#%04x%04x%04x" $red $green $blue] @@ -235,9 +246,9 @@ proc tc_loadNamedColor name { # It changes the labels on the scales and re-loads the scales with # the appropriate values for the current color in the new color space -proc changeColorSpace space { +proc changeColorSpace {space} { global label1 label2 label3 - switch $space { + switch -- $space { rgb { set label1 "Adjust Red:" set label2 "Adjust Green:" @@ -259,6 +270,7 @@ proc changeColorSpace space { tc_setScales return } + default {} } } @@ -270,41 +282,41 @@ proc changeColorSpace space { proc rgbToHsv {red green blue} { if {$red > $green} { - set max [expr {double($red)}] - set min [expr {double($green)}] + set max [expr { double ($red)}] + set min [expr { double ($green)}] } else { - set max [expr {double($green)}] - set min [expr {double($red)}] + set max [expr { double ($green)}] + set min [expr { double ($red)}] } if {$blue > $max} { - set max [expr {double($blue)}] + set max [expr { double ($blue)}] } elseif {$blue < $min} { - set min [expr {double($blue)}] + set min [expr { double ($blue)}] } - set range [expr {$max-$min}] + set range [expr {$max - $min}] if {$max == 0} { set sat 0 } else { - set sat [expr {($max-$min)/$max}] + set sat [expr {($max - $min) / $max}] } if {$sat == 0} { set hue 0 } else { - set rc [expr {($max - $red)/$range}] - set gc [expr {($max - $green)/$range}] - set bc [expr {($max - $blue)/$range}] + set rc [expr {($max - $red) / $range}] + set gc [expr {($max - $green) / $range}] + set bc [expr {($max - $blue) / $range}] if {$red == $max} { - set hue [expr {($bc - $gc)/6.0}] + set hue [expr {($bc - $gc) / 6.0}] } elseif {$green == $max} { - set hue [expr {(2 + $rc - $bc)/6.0}] + set hue [expr {((2 + $rc) - $bc) / 6.0}] } else { - set hue [expr {(4 + $gc - $rc)/6.0}] + set hue [expr {((4 + $gc) - $rc) / 6.0}] } if {$hue < 0.0} { set hue [expr {$hue + 1.0}] } } - return [list $hue $sat [expr {$max/65535}]] + return [list $hue $sat [expr {$max / 65535}]] } # The procedure below converts an HSB value to RGB. It takes hue, saturation, @@ -314,20 +326,20 @@ proc rgbToHsv {red green blue} { # Computer Graphics" by Foley and Van Dam. proc hsbToRgb {hue sat value} { - set v [format %.0f [expr {65535.0*$value}]] + set v [format %.0f [expr {65535.0 * $value}]] if {$sat == 0} { return "$v $v $v" } else { - set hue [expr {$hue*6.0}] + set hue [expr {$hue * 6.0}] if {$hue >= 6.0} { set hue 0.0 } scan $hue. %d i - set f [expr {$hue-$i}] - set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]] - set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]] - set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]] - switch $i { + set f [expr {$hue - $i}] + set p [format %.0f [expr {65535.0 * $value * (1 - $sat)}]] + set q [format %.0f [expr {65535.0 * $value * (1 - ($sat * $f))}]] + set t [format %.0f [expr {65535.0 * $value * (1 - ($sat * (1 - $f)))}]] + switch -- $i { 0 {return "$v $t $p"} 1 {return "$q $v $p"} 2 {return "$p $v $t"} diff --git a/library/demos/text.tcl b/library/demos/text.tcl index 785e9e6..2301ad5 100644 --- a/library/demos/text.tcl +++ b/library/demos/text.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .text -catch {destroy $w} +destroy $w toplevel $w wm title $w "Text Demonstration - Basic Facilities" wm iconname $w "text" @@ -29,11 +29,11 @@ pack $w.text -expand yes -fill both # TIP 324 Demo: [tk fontchooser] proc fontchooserToggle {} { - tk fontchooser [expr {[tk fontchooser configure -visible] ? + tk fontchooser [expr {[tk fontchooser configure -visible] ? "hide" : "show"}] } proc fontchooserVisibility {w} { - $w configure -text [expr {[tk fontchooser configure -visible] ? + $w configure -text [expr {[tk fontchooser configure -visible] ? "Hide Font Dialog" : "Show Font Dialog"}] } proc fontchooserFocus {w} { @@ -92,13 +92,14 @@ cursor. Control-t transposes the two characters on either side of the insertion cursor. Control-z undoes the last editing action performed, and } -switch [tk windowingsystem] { +switch -- [tk windowingsystem] { "aqua" - "x11" { $w.text insert end "Control-Shift-z" } "win32" { $w.text insert end "Control-y" } + default {} } $w.text insert end { redoes undone edits. diff --git a/library/demos/textpeer.tcl b/library/demos/textpeer.tcl index e94284e..8a70267 100644 --- a/library/demos/textpeer.tcl +++ b/library/demos/textpeer.tcl @@ -11,7 +11,7 @@ if {![info exists widgetDemo]} { package require Tk set w .textpeer -catch {destroy $w} +destroy $w toplevel $w wm title $w "Text Widget Peering Demonstration" wm iconname $w "textpeer" diff --git a/library/demos/timer b/library/demos/timer index e10b840..6f0be41 100644 --- a/library/demos/timer +++ b/library/demos/timer @@ -12,7 +12,7 @@ label .counter -text 0.00 -relief raised -width 10 -padx 2m -pady 1m button .start -text Start -command { if {$stopped} { set stopped 0 - set startMoment [clock clicks -milliseconds] + set startMoment [clock milliseconds] tick .stop configure -state normal .start configure -state disabled @@ -27,7 +27,7 @@ pack .counter -side bottom -fill both pack .start -side left -fill both -expand yes pack .stop -side right -fill both -expand yes -set startMoment {} +set startMoment "" set stopped 1 @@ -35,8 +35,8 @@ proc tick {} { global startMoment stopped if {$stopped} {return} after 50 tick - set elapsedMS [expr {[clock clicks -milliseconds] - $startMoment}] - .counter config -text [format "%.2f" [expr {double($elapsedMS)/1000}]] + set elapsedMS [expr {[clock milliseconds] - $startMoment}] + .counter config -text [format "%.2f" [expr {$elapsedMS * 1e-3}]] } bind . <Control-c> {destroy .} diff --git a/library/demos/toolbar.tcl b/library/demos/toolbar.tcl index 0ae4669..7dcfa5c 100644 --- a/library/demos/toolbar.tcl +++ b/library/demos/toolbar.tcl @@ -63,7 +63,10 @@ ttk::button $t.button -text "Button" -style Toolbutton -command [list \ ttk::checkbutton $t.check -text "Check" -variable check -style Toolbutton \ -command [concat [list $w.txt insert end] {"check is $check\n"}] ttk::menubutton $t.menu -text "Menu" -menu $t.menu.m -ttk::combobox $t.combo -value [lsort [font families]] -state readonly +ttk::combobox $t.combo -value [lsort [font families]] + +$t.combo state readonly + menu $t.menu.m $t.menu.m add command -label "Just" -command [list $w.txt insert end Just\n] $t.menu.m add command -label "An" -command [list $w.txt insert end An\n] @@ -76,7 +79,7 @@ proc changeFont {txt combo} { ## Some content for the rest of the toplevel text $w.txt -width 40 -height 10 -interp alias {} doInsert {} $w.txt insert end ;# Make bindings easy to write +interp alias "" doInsert "" $w.txt insert end ;# Make bindings easy to write ## Arrange contents grid $t.button $t.check $t.menu $t.combo -in $t.contents -padx 2 -sticky ns diff --git a/library/demos/tree.tcl b/library/demos/tree.tcl index 71c32c1..288e90c 100644 --- a/library/demos/tree.tcl +++ b/library/demos/tree.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .tree -catch {destroy $w} +destroy $w toplevel $w wm title $w "Directory Browser" wm iconname $w "tree" @@ -51,12 +51,12 @@ proc populateTree {tree node} { } elseif {$type eq "file"} { set size [file size $f] ## Format the file size nicely - if {$size >= 1024*1024*1024} { - set size [format %.1f\ GB [expr {$size/1024/1024/1024.}]] - } elseif {$size >= 1024*1024} { - set size [format %.1f\ MB [expr {$size/1024/1024.}]] + if {$size >= (1024 ** 3)} { + set size [format %.1f\ GB [expr {$size / (1024.0 ** 3)}]] + } elseif {$size >= (1024 ** 2)} { + set size [format %.1f\ MB [expr {$size / (1024.0 ** 2)}]] } elseif {$size >= 1024} { - set size [format %.1f\ kB [expr {$size/1024.}]] + set size [format %.1f\ kB [expr {$size / 1024.0}]] } else { append size " bytes" } diff --git a/library/demos/ttkbut.tcl b/library/demos/ttkbut.tcl index 904cd31..79bad3d 100644 --- a/library/demos/ttkbut.tcl +++ b/library/demos/ttkbut.tcl @@ -11,7 +11,7 @@ if {![info exists widgetDemo]} { package require Tk set w .ttkbut -catch {destroy $w} +destroy $w toplevel $w wm title $w "Simple Ttk Widgets" wm iconname $w "ttkbut" @@ -26,7 +26,7 @@ pack [addSeeDismiss $w.seeDismiss $w {enabled cheese tomato basil oregano happyn ## Add buttons for setting the theme ttk::labelframe $w.buttons -text "Buttons" -foreach theme [ttk::themes] { +foreach theme [ttk::style theme names] { ttk::button $w.buttons.$theme -text $theme \ -command [list ttk::setTheme $theme] pack $w.buttons.$theme -pady 2 diff --git a/library/demos/ttkmenu.tcl b/library/demos/ttkmenu.tcl index 0084dd6..5e92586 100644 --- a/library/demos/ttkmenu.tcl +++ b/library/demos/ttkmenu.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .ttkmenu -catch {destroy $w} +destroy $w toplevel $w wm title $w "Ttk Menu Buttons" wm iconname $w "ttkmenu" @@ -35,7 +35,7 @@ menu $w.m3.menu -tearoff 0 menu $w.m4.menu -tearoff 0 menu $w.m5.menu -tearoff 0 -foreach theme [ttk::themes] { +foreach theme [ttk::style theme names] { $w.m1.menu add command -label $theme -command [list ttk::setTheme $theme] $w.m2.menu add command -label $theme -command [list ttk::setTheme $theme] $w.m3.menu add command -label $theme -command [list ttk::setTheme $theme] diff --git a/library/demos/ttknote.tcl b/library/demos/ttknote.tcl index 50a9258..bf12103 100644 --- a/library/demos/ttknote.tcl +++ b/library/demos/ttknote.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .ttknote -catch {destroy $w} +destroy $w toplevel $w wm title $w "Ttk Notebook Widget" wm iconname $w "ttknote" @@ -33,7 +33,7 @@ ttk::frame $w.note.msg ttk::label $w.note.msg.m -font $font -wraplength 4i -justify left -anchor n -text "Ttk is the new Tk themed widget set. One of the widgets it includes is the notebook widget, which provides a set of tabs that allow the selection of a group of panels, each with distinct content. They are a feature of many modern user interfaces. Not only can the tabs be selected with the mouse, but they can also be switched between using Ctrl+Tab when the notebook page heading itself is selected. Note that the second tab is disabled, and cannot be selected." ttk::button $w.note.msg.b -text "Neat!" -underline 0 -command { set neat "Yeah, I know..." - after 500 {set neat {}} + after 500 {set neat ""} } bind $w <Alt-n> "focus $w.note.msg.b; $w.note.msg.b invoke" ttk::label $w.note.msg.l -textvariable neat diff --git a/library/demos/ttkpane.tcl b/library/demos/ttkpane.tcl index 7575d76..b414ec7 100644 --- a/library/demos/ttkpane.tcl +++ b/library/demos/ttkpane.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .ttkpane -catch {destroy $w} +destroy $w toplevel $w wm title $w "Themed Nested Panes" wm iconname $w "ttkpane" @@ -64,7 +64,7 @@ set testzones { } # Force a pre-load of all the timezones needed; otherwise can end up # poor-looking synch problems! -set zones {} +set zones [list] foreach zone $testzones { if {![catch {clock format 0 -timezone $zone}]} { lappend zones $zone diff --git a/library/demos/ttkprogress.tcl b/library/demos/ttkprogress.tcl index 8a72cf9..d29430b 100644 --- a/library/demos/ttkprogress.tcl +++ b/library/demos/ttkprogress.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .ttkprogress -catch {destroy $w} +destroy $w toplevel $w wm title $w "Progress Bar Demonstration" wm iconname $w "ttkprogress" diff --git a/library/demos/ttkscale.tcl b/library/demos/ttkscale.tcl index 1a95416..5189821 100644 --- a/library/demos/ttkscale.tcl +++ b/library/demos/ttkscale.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .ttkscale -catch {destroy $w} +destroy $w toplevel $w -bg [ttk::style lookup TLabel -background] wm title $w "Themed Scale Demonstration" wm iconname $w "ttkscale" @@ -28,7 +28,7 @@ ttk::frame $w.frame -borderwidth 10 pack $w.frame -side top -fill x # List of colors from rainbox; "Indigo" is not a standard color -set colorList {Red Orange Yellow Green Blue Violet} +set colorList [list Red Orange Yellow Green Blue Violet] ttk::label $w.frame.label ttk::scale $w.frame.scale -from 0 -to 5 -command [list apply {{w idx} { set c [lindex $::colorList [tcl::mathfunc::int $idx]] diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index 8f3c12e..e13fdb5 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .twind -catch {destroy $w} +destroy $w toplevel $w wm title $w "Text Demonstration - Embedded Windows and Other Features" wm iconname $w "Embedded Windows" @@ -164,47 +164,48 @@ $t insert end "\n\nFinally, images fit comfortably in text widgets too:" $t image create end -image \ [image create photo -file [file join $tk_demoDirectory images ouster.png]] - -proc textWindBigB w { +proc textWindBigB {w} { $w configure -borderwidth 15 } -proc textWindBigH w { +proc textWindBigH {w} { $w configure -highlightthickness 15 } -proc textWindBigP w { +proc textWindBigP {w} { $w configure -padx 15 -pady 15 } -proc textWindSmallB w { - $w configure -borderwidth $::text_normal(border) +proc textWindSmallB {w} { + global text_normal + $w configure -borderwidth $text_normal(border) } -proc textWindSmallH w { - $w configure -highlightthickness $::text_normal(highlight) +proc textWindSmallH {w} { + global text_normal + $w configure -highlightthickness $text_normal(highlight) } -proc textWindSmallP w { - $w configure -padx $::text_normal(pad) -pady $::text_normal(pad) +proc textWindSmallP {w} { + global text_normal + $w configure -padx $text_normal(pad) -pady $text_normal(pad) } - -proc textWindOn w { - catch {destroy $w.scroll2} +proc textWindOn {w} { + destroy $w.scroll2 set t $w.f.text scrollbar $w.scroll2 -orient horizontal -command "$t xview" pack $w.scroll2 -after $w.buttons -side bottom -fill x $t configure -xscrollcommand "$w.scroll2 set" -wrap none } -proc textWindOff w { - catch {destroy $w.scroll2} +proc textWindOff {w} { + destroy $w.scroll2 set t $w.f.text - $t configure -xscrollcommand {} -wrap word + $t configure -xscrollcommand "" -wrap word } -proc textWindPlot t { +proc textWindPlot {t} { set c $t.c if {[winfo exists $c]} { return @@ -225,30 +226,31 @@ proc createPlot {t} { canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow - set font {Helvetica 18} + set font "Helvetica 18" $c create line 100 250 400 250 -width 2 $c create line 100 250 100 50 -width 2 $c create text 225 20 -text "A Simple Plot" -font $font -fill brown for {set i 0} {$i <= 10} {incr i} { - set x [expr {100 + ($i*30)}] + set x [expr {100 + ($i * 30)}] $c create line $x 250 $x 245 -width 2 - $c create text $x 254 -text [expr {10*$i}] -anchor n -font $font + $c create text $x 254 -text [expr {10 * $i}] -anchor n -font $font } for {set i 0} {$i <= 5} {incr i} { - set y [expr {250 - ($i*40)}] + set y [expr {250 - ($i * 40)}] $c create line 100 $y 105 $y -width 2 - $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font + $c create text 96 $y -text [expr {$i * 50}].0 -anchor e -font $font } foreach point { {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} } { - set x [expr {100 + (3*[lindex $point 0])}] - set y [expr {250 - (4*[lindex $point 1])/5}] - set item [$c create oval [expr {$x-6}] [expr {$y-6}] \ - [expr {$x+6}] [expr {$y+6}] -width 1 -outline black \ + lassign $point p_x p_y + set x [expr {100 + (3 * $p_x)}] + set y [expr {250 - ((4 * $p_y) / 5)}] + set item [$c create oval [expr {$x - 6}] [expr {$y - 6}] \ + [expr {$x + 6}] [expr {$y + 6}] -width 1 -outline black \ -fill SkyBlue2] $c addtag point withtag $item } @@ -275,12 +277,12 @@ proc embPlotDown {w x y} { proc embPlotMove {w x y} { global embPlot - $w move selected [expr {$x-$embPlot(lastX)}] [expr {$y-$embPlot(lastY)}] + $w move selected [expr {$x - $embPlot(lastX)}] [expr {$y - $embPlot(lastY)}] set embPlot(lastX) $x set embPlot(lastY) $y } -proc textWindDel t { +proc textWindDel {t} { if {[winfo exists $t.c]} { $t delete $t.c while {[string first [$t get plot] " \t\n"] >= 0} { @@ -290,7 +292,7 @@ proc textWindDel t { } } -proc embDefBg t { +proc embDefBg {t} { $t configure -background [lindex [$t configure -background] 3] } diff --git a/library/demos/unicodeout.tcl b/library/demos/unicodeout.tcl index faa9f90..a34ddc6 100644 --- a/library/demos/unicodeout.tcl +++ b/library/demos/unicodeout.tcl @@ -10,7 +10,7 @@ if {![info exists widgetDemo]} { package require Tk set w .unicodeout -catch {destroy $w} +destroy $w toplevel $w wm title $w "Unicode Label Demonstration" wm iconname $w "unicodeout" @@ -47,7 +47,7 @@ proc addSample {w language args} { ## A helper procedure that determines what form to use to express languages ## that have complex rendering rules... proc usePresentationFormsFor {language} { - switch [tk windowingsystem] { + switch -- [tk windowingsystem] { aqua { # OSX wants natural character order; the renderer knows how to # compose things for display for all languages. @@ -90,7 +90,7 @@ proc usePresentationFormsFor {language} { ## engine might take a while, so make sure we're displaying something in the ## meantime... pack [label $w.wait -text "Please wait while loading fonts..." \ - -font {Helvetica 12 italic}] + -font "Helvetica 12 italic"] set oldCursor [$w cget -cursor] $w conf -cursor watch update diff --git a/library/demos/vscale.tcl b/library/demos/vscale.tcl index 2c7ea76..6beebd3 100644 --- a/library/demos/vscale.tcl +++ b/library/demos/vscale.tcl @@ -9,7 +9,7 @@ if {![info exists widgetDemo]} { package require Tk set w .vscale -catch {destroy $w} +destroy $w toplevel $w wm title $w "Vertical Scale Demonstration" wm iconname $w "vscale" @@ -35,8 +35,8 @@ pack $w.frame.scale -side left -anchor ne pack $w.frame.canvas -side left -anchor nw -fill y $w.frame.scale set 75 -proc setHeight {w height} { - incr height 21 +proc setHeight {w a_height} { + set height [expr {$a_height + 21}] set y2 [expr {$height - 30}] if {$y2 < 21} { set y2 21 diff --git a/library/demos/widget b/library/demos/widget index 8b92f9a..e67d743 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -14,7 +14,7 @@ package require Tcl 8.5 package require Tk 8.5 package require msgcat -eval destroy [winfo child .] +destroy {*}[winfo children .] set tk_demoDirectory [file join [pwd] [file dirname [info script]]] ::msgcat::mcload $tk_demoDirectory namespace import ::msgcat::mc @@ -31,7 +31,7 @@ if {[tk windowingsystem] eq "x11"} { if {"defaultFont" ni [font names]} { # TIP #145 defines some standard named fonts - if {"TkDefaultFont" in [font names] && "TkFixedFont" in [font names]} { + if {("TkDefaultFont" in [font names]) && ("TkFixedFont" in [font names])} { # FIX ME: the following technique of cloning the font to copy it works # fine but means that if the system font is changed by Tk # cannot update the copied font. font alias might be useful @@ -109,7 +109,7 @@ if {[tk windowingsystem] ne "aqua"} { -command {tkAboutDialog} -accelerator [mc "<F1>"] bind . <F1> {tkAboutDialog} .menuBar.file add sep - if {[string match win* [tk windowingsystem]]} { + if {[string match "win*" [tk windowingsystem]]} { # Windows doesn't usually have a Meta key ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \ -command {exit} -accelerator [mc "Ctrl+Q"] @@ -139,7 +139,7 @@ pack .statusBar -side bottom -fill x -pady 2 set textheight 30 catch { set textheight [expr { - ([winfo screenheight .] * 0.7) / + ([winfo screenheight .] * 0.7) / [font metrics mainFont -displayof . -linespace] }] } @@ -242,7 +242,7 @@ proc addFormattedText {formattedText} { if {$line eq ""} { continue } - if {[string match @@* $line]} { + if {[string match "@@*" $line]} { set data [string range $line 2 end] set key [lindex $data 0] set values [lrange $data 1 end] @@ -441,7 +441,7 @@ proc addSeeDismiss {w show {vars {}} {extra {}}} { # Arguments: # w - The name of the window to position. -proc positionWindow w { +proc positionWindow {w} { wm geometry $w +300+300 } @@ -454,7 +454,7 @@ proc positionWindow w { # args - Any number of names of variables. proc showVars {w args} { - catch {destroy $w} + destroy $w toplevel $w if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog} wm title $w [mc "Variable values"] @@ -464,7 +464,7 @@ proc showVars {w args} { set f [ttk::labelframe $b.title -text [mc "Variable values:"]] foreach var $args { ttk::label $f.n$var -text "$var:" -anchor w - ttk::label $f.v$var -textvariable $var -anchor w + ttk::label $f.v$var -textvariable [set var] -anchor w grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w } ttk::button $b.ok -text [mc "OK"] \ @@ -494,7 +494,7 @@ proc showVars {w args} { # Arguments: # index - The index of the character that the user clicked on. -proc invoke index { +proc invoke {index} { global tk_demoDirectory set tags [.t tag names $index] set i [lsearch -glob $tags demo-*] @@ -517,7 +517,7 @@ proc invoke index { # Show the name of the demo program in the status bar. This procedure is # called when the user moves the cursor over a demo description. # -proc showStatus index { +proc showStatus {index} { set tags [.t tag names $index] set i [lsearch -glob $tags demo-*] set cursor [.t cget -cursor] @@ -552,7 +552,7 @@ proc evalShowCode {w} { # w - The name of the demonstration's window, which can be used to # derive the name of the file containing its code. -proc showCode w { +proc showCode {w} { global tk_demoDirectory set file [string range $w 1 end].tcl set top .code @@ -626,17 +626,18 @@ proc showCode w { # file - Name of the original file (implicitly for title) proc printCode {w file} { + global env tcl_platform set code [$w get 1.0 end-1c] set dir "." - if {[info exists ::env(HOME)]} { - set dir "$::env(HOME)" + if {[info exists env(HOME)]} { + set dir $env(HOME) } - if {[info exists ::env(TMP)]} { - set dir $::env(TMP) + if {[info exists env(TMP)]} { + set dir $env(TMP) } - if {[info exists ::env(TEMP)]} { - set dir $::env(TEMP) + if {[info exists env(TEMP)]} { + set dir $env(TEMP) } set filename [file join $dir "tkdemo-$file"] @@ -644,7 +645,7 @@ proc printCode {w file} { puts $outfile $code close $outfile - switch -- $::tcl_platform(platform) { + switch -- $tcl_platform(platform) { unix { if {[catch {exec lp -c $filename} msg]} { tk_messageBox -title "Print spooling failure" \ @@ -659,7 +660,7 @@ proc printCode {w file} { } default { tk_messageBox -title "Operation not Implemented" \ - -message "Wow! Unknown platform: $::tcl_platform(platform)" + -message "Wow! Unknown platform: $tcl_platform(platform)" } } @@ -667,7 +668,7 @@ proc printCode {w file} { # Be careful to throw away the temporary file in a gentle manner ... # if {[file exists $filename]} { - catch {file delete $filename} + catch {file delete -- $filename} } } diff --git a/library/dialog.tcl b/library/dialog.tcl index 6a9babb..a064c45 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -27,21 +27,22 @@ # args - One or more strings to display in buttons across the # bottom of the dialog box. -proc ::tk_dialog {w title text bitmap default args} { +proc ::tk_dialog {w title text bitmap a_default args} { global tcl_platform variable ::tk::Priv # Check that $default was properly given - if {[string is integer -strict $default]} { - if {$default >= [llength $args]} { + if {[string is integer -strict $a_default]} { + if {$a_default >= [llength $args]} { return -code error -errorcode {TK DIALOG BAD_DEFAULT} \ "default button index greater than number of buttons\ specified for tk_dialog" } - } elseif {"" eq $default} { + set default $a_default + } elseif {"" eq $a_default} { set default -1 } else { - set default [lsearch -exact $args $default] + set default [lsearch -exact $args $a_default] } set windowingsystem [tk windowingsystem] @@ -72,7 +73,7 @@ proc ::tk_dialog {w title text bitmap default args} { } if {$windowingsystem eq "aqua"} { - ::tk::unsupported::MacWindowStyle style $w moveableModal {} + ::tk::unsupported::MacWindowStyle style $w moveableModal "" } elseif {$windowingsystem eq "x11"} { wm attributes $w -type dialog } @@ -80,8 +81,8 @@ proc ::tk_dialog {w title text bitmap default args} { frame $w.bot frame $w.top if {$windowingsystem eq "x11"} { - $w.bot configure -relief raised -bd 1 - $w.top configure -relief raised -bd 1 + $w.bot configure -relief raised -borderwidth 1 + $w.top configure -relief raised -borderwidth 1 } pack $w.bot -side bottom -fill both pack $w.top -side top -fill both -expand 1 @@ -97,7 +98,7 @@ proc ::tk_dialog {w title text bitmap default args} { label $w.msg -justify left -text $text pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m if {$bitmap ne ""} { - if {$windowingsystem eq "aqua" && $bitmap eq "error"} { + if {($windowingsystem eq "aqua") && ($bitmap eq "error")} { set bitmap "stop" } label $w.bitmap -bitmap $bitmap @@ -120,7 +121,7 @@ proc ::tk_dialog {w title text bitmap default args} { # We boost the size of some Mac buttons for l&f if {$windowingsystem eq "aqua"} { set tmp [string tolower $but] - if {$tmp eq "ok" || $tmp eq "cancel"} { + if {$tmp in "ok cancel"} { grid columnconfigure $w.bot $i -minsize 90 } grid configure $w.button$i -pady 7 diff --git a/library/entry.tcl b/library/entry.tcl index f28547e..7f54dfc 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -62,8 +62,9 @@ bind Entry <<Clear>> { catch { %W delete sel.first sel.last } } bind Entry <<PasteSelection>> { - if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] - || !$tk::Priv(mouseMoved)} { + if {$tk_strictMotif || + (![info exists tk::Priv(mouseMoved)]) || + (!$tk::Priv(mouseMoved))} { tk::EntryPaste %W %x } } @@ -298,7 +299,7 @@ bind Entry <B2-Motion> { proc ::tk::EntryClosestGap {w x} { set pos [$w index @$x] set bbox [$w bbox $pos] - if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { + if {($x - [lindex $bbox 0]) < ([lindex $bbox 2] / 2)} { return $pos } incr pos @@ -342,10 +343,10 @@ proc ::tk::EntryMouseSelect {w x} { set cur [EntryClosestGap $w $x] set anchor [$w index anchor] - if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} { + if {($cur != $anchor) || ( abs ($Priv(pressX) - $x) >= 3)} { set Priv(mouseMoved) 1 } - switch $Priv(selectMode) { + switch -- $Priv(selectMode) { char { if {$Priv(mouseMoved)} { if {$cur < $anchor} { @@ -360,7 +361,7 @@ proc ::tk::EntryMouseSelect {w x} { word { if {$cur < [$w index anchor]} { set before [tcl_wordBreakBefore [$w get] $cur] - set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]] + set after [tcl_wordBreakAfter [$w get] [expr {$anchor - 1}]] } else { set before [tcl_wordBreakBefore [$w get] $anchor] set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]] @@ -376,6 +377,7 @@ proc ::tk::EntryMouseSelect {w x} { line { $w selection range 0 end } + default {} } if {$Priv(mouseMoved)} { $w icursor $cur @@ -477,7 +479,7 @@ proc ::tk::EntryInsert {w s} { # Arguments: # w - The entry window in which to backspace. -proc ::tk::EntryBackspace w { +proc ::tk::EntryBackspace {w} { if {[$w selection present]} { $w delete sel.first sel.last } else { @@ -486,10 +488,8 @@ proc ::tk::EntryBackspace w { $w delete $x } if {[$w index @0] >= [$w index insert]} { - set range [$w xview] - set left [lindex $range 0] - set right [lindex $range 1] - $w xview moveto [expr {$left - ($right - $left)/2.0}] + lassign [$w xview] left right + $w xview moveto [expr {$left - (($right - $left) / 2.0)}] } } } @@ -501,7 +501,7 @@ proc ::tk::EntryBackspace w { # Arguments: # w - The entry window. -proc ::tk::EntrySeeInsert w { +proc ::tk::EntrySeeInsert {w} { set c [$w index insert] if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} { $w xview $c @@ -533,17 +533,17 @@ proc ::tk::EntrySetCursor {w pos} { # Arguments: # w - The entry window. -proc ::tk::EntryTranspose w { +proc ::tk::EntryTranspose {w} { set i [$w index insert] if {$i < [$w index end]} { incr i } - set first [expr {$i-2}] + set first [expr {$i - 2}] if {$first < 0} { return } set data [$w get] - set new [string index $data [expr {$i-1}]][string index $data $first] + set new [string index $data [expr {$i - 1}]][string index $data $first] $w delete $first $i $w insert insert $new EntrySeeInsert $w @@ -625,7 +625,7 @@ proc ::tk::EntryScanDrag {w x} { # motion binding without the initial press. [Bug #220269] if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x } # allow for a delta - if {abs($x-$::tk::Priv(x)) > 2} { + if { abs ($x - $::tk::Priv(x)) > 2} { set ::tk::Priv(mouseMoved) 1 } $w scan dragto $x diff --git a/library/focus.tcl b/library/focus.tcl index 640406e..36d0855 100644 --- a/library/focus.tcl +++ b/library/focus.tcl @@ -20,7 +20,7 @@ # Arguments: # w - Name of a window. -proc ::tk_focusNext w { +proc ::tk_focusNext {w} { set cur $w while {1} { @@ -55,7 +55,7 @@ proc ::tk_focusNext w { set children [winfo children $parent] set i [lsearch -exact $children $cur] } - if {$w eq $cur || [tk::FocusOK $cur]} { + if {($w eq $cur) || [tk::FocusOK $cur]} { return $cur } } @@ -72,7 +72,7 @@ proc ::tk_focusNext w { # Arguments: # w - Name of a window. -proc ::tk_focusPrev w { +proc ::tk_focusPrev {w} { set cur $w while {1} { @@ -106,7 +106,7 @@ proc ::tk_focusPrev w { set i [llength $children] } set cur $parent - if {$w eq $cur || [tk::FocusOK $cur]} { + if {($w eq $cur) || [tk::FocusOK $cur]} { return $cur } } @@ -126,7 +126,7 @@ proc ::tk_focusPrev w { # Arguments: # w - Name of a window. -proc ::tk::FocusOK w { +proc ::tk::FocusOK {w} { set code [catch {$w cget -takefocus} value] if {($code == 0) && ($value ne "")} { if {$value == 0} { @@ -144,7 +144,7 @@ proc ::tk::FocusOK w { return 0 } set code [catch {$w cget -state} value] - if {($code == 0) && $value eq "disabled"} { + if {($code == 0) && ($value eq "disabled")} { return 0 } regexp Key|Focus "[bind $w] [bind [winfo class $w]]" diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index 179476c..8c9bb8c 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -20,7 +20,7 @@ namespace eval ::tk::fontchooser { [::msgcat::mc "Bold Italic"] \ ] - set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} + set S(sizes) [list 8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72] set S(strike) 0 set S(under) 0 set S(first) 1 @@ -31,9 +31,9 @@ namespace eval ::tk::fontchooser { set S(-font) TkDefaultFont # Canonical versions of font families, styles, etc. for easier searching - set S(fonts,lcase) {} + set S(fonts,lcase) [list] foreach font $S(fonts) { lappend S(fonts,lcase) [string tolower $font]} - set S(styles,lcase) {} + set S(styles,lcase) [list] foreach style $S(styles) { lappend S(styles,lcase) [string tolower $style]} set S(sizes,lcase) $S(sizes) @@ -56,7 +56,7 @@ namespace eval ::tk::fontchooser { proc ::tk::fontchooser::Show {} { variable S if {![winfo exists $S(W)]} { - Create + Create wm transient $S(W) [winfo toplevel $S(-parent)] tk::PlaceWindow $S(W) widget $S(-parent) } @@ -78,10 +78,10 @@ proc ::tk::fontchooser::Configure {args} { {-command "" "" ""} } - if {[llength $args] == 0} { - set result {} + if {![llength $args]} { + set result [list] foreach spec $specs { - foreach {name xx yy default} $spec break + lassign $spec name xx yy default lappend result $name \ [expr {[info exists S($name)] ? $S($name) : $default}] } @@ -91,7 +91,7 @@ proc ::tk::fontchooser::Configure {args} { } if {[llength $args] == 1} { set option [lindex $args 0] - if {[string equal $option "-visible"]} { + if {$option eq "-visible"} { return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] } elseif {[info exists S($option)]} { return $S($option) @@ -113,7 +113,7 @@ proc ::tk::fontchooser::Configure {args} { if {[string trim $S(-title)] eq ""} { set S(-title) [::msgcat::mc "Font"] } - if {[winfo exists $S(W)] && [lsearch $args -font] != -1} { + if {[winfo exists $S(W)] && ("-font" in $args)} { Init $S(-font) event generate $S(-parent) <<TkFontchooserFontChanged>> } @@ -132,7 +132,7 @@ proc ::tk::fontchooser::Create {} { # Now build the dialog if {![winfo exists $S(W)]} { toplevel $S(W) -class TkFontDialog - if {[package provide tcltest] ne {}} {set ::tk_dialog $S(W)} + if {[package provide tcltest] ne ""} {set ::tk_dialog $S(W)} wm withdraw $S(W) wm title $S(W) $S(-title) wm transient $S(W) [winfo toplevel $S(-parent)] @@ -275,11 +275,11 @@ proc ::tk::::fontchooser::Done {ok} { if {! $ok} { set S(result) "" } - trace vdelete S(size) w [namespace code [list Tracer]] - trace vdelete S(style) w [namespace code [list Tracer]] - trace vdelete S(font) w [namespace code [list Tracer]] + trace remove variable S(size) write [namespace code [list Tracer]] + trace remove variable S(style) write [namespace code [list Tracer]] + trace remove variable S(font) write [namespace code [list Tracer]] destroy $S(W) - if {$ok && $S(-command) ne ""} { + if {$ok && ($S(-command) ne "")} { uplevel #0 $S(-command) [list $S(result)] } } @@ -309,7 +309,7 @@ proc ::tk::fontchooser::Apply {} { proc ::tk::fontchooser::Init {{defaultFont ""}} { variable S - if {$S(first) || $defaultFont ne ""} { + if {$S(first) || ($defaultFont ne "")} { if {$defaultFont eq ""} { set defaultFont [[entry .___e] cget -font] destroy .___e @@ -320,7 +320,7 @@ proc ::tk::fontchooser::Init {{defaultFont ""}} { set S(strike) $F(-overstrike) set S(under) $F(-underline) set S(style) "Regular" - if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} { + if {($F(-weight) eq "bold") && ($F(-slant) eq "italic")} { set S(style) "Bold Italic" } elseif {$F(-weight) eq "bold"} { set S(style) "Bold" @@ -382,7 +382,7 @@ proc ::tk::fontchooser::Tracer {var1 var2 op} { # unless in the font size list set n [lsearch -glob $S(${var}s,lcase) "$value*"] set bad 1 - if {$var ne "size" || ! [string is double -strict $value]} { + if {($var ne "size") || (![string is double -strict $value])} { set nstate disabled } } @@ -434,8 +434,8 @@ proc ::tk::fontchooser::ttk_slistbox {w args} { grid $f.list $f.vs -sticky news grid rowconfigure $f 0 -weight 1 grid columnconfigure $f 0 -weight 1 - interp hide {} $w - interp alias {} $w {} $f.list + interp hide "" $w + interp alias "" $w "" $f.list } err opt]} { destroy $f return -options $opt $err diff --git a/library/iconlist.tcl b/library/iconlist.tcl index 62b0b2d..4e463c1 100644 --- a/library/iconlist.tcl +++ b/library/iconlist.tcl @@ -34,7 +34,7 @@ package require Tk 8.6 numItems oldX oldY options rect selected selection textList constructor args { next {*}$args - set accelCB {} + set accelCB "" } destructor { my Reset @@ -53,7 +53,7 @@ package require Tk 8.6 method index i { if {![info exist list]} { - set list {} + set list [list] } switch -regexp -- $i { "^-?[0-9]+$" { @@ -192,7 +192,7 @@ package require Tk 8.6 set maxTH 1 set numItems 0 set noScroll 1 - set selection {} + set selection "" set index(anchor) "" $sbar set 0.0 1.0 $canvas xview moveto 0 @@ -244,7 +244,7 @@ package require Tk 8.6 # double-clicking or pressing the Return key). # method invoke {} { - if {$options(-command) ne "" && [llength $selection]} { + if {($options(-command) ne "") && [llength $selection]} { uplevel #0 $options(-command) } } @@ -261,22 +261,20 @@ package require Tk 8.6 return } - if {$rTag < 0 || $rTag >= [llength $list]} { + if {($rTag < 0) || ($rTag >= [llength $list])} { return } - set bbox [$canvas bbox item$rTag] - set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}] + lassign [$canvas bbox item$rTag] x1 ___ x2 + set pad [expr {[$canvas cget -highlightthickness] + [$canvas cget -borderwidth]}] - set x1 [lindex $bbox 0] - set x2 [lindex $bbox 2] incr x1 [expr {$pad * -2}] incr x2 [expr {$pad * -1}] - set cW [expr {[winfo width $canvas] - $pad*2}] + set cW [expr {[winfo width $canvas] - ($pad * 2)}] - set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}] - set dispX [expr {int([lindex [$canvas xview] 0]*$scrollW)}] + set scrollW [expr {([lindex $sRegion 2] - [lindex $sRegion 0]) + 1}] + set dispX [expr { int ([lindex [$canvas xview] 0] * $scrollW)}] set oldDispX $dispX # check if out of the right edge @@ -291,7 +289,7 @@ package require Tk 8.6 } if {$oldDispX ne $dispX} { - set fraction [expr {double($dispX) / double($scrollW)}] + set fraction [expr {($dispX * 1.0) / $scrollW}] $canvas xview moveto $fraction } } @@ -311,13 +309,13 @@ package require Tk 8.6 set W [winfo width $canvas] set H [winfo height $canvas] - set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}] + set pad [expr {[$canvas cget -highlightthickness] + [$canvas cget -borderwidth]}] if {$pad < 2} { set pad 2 } - incr W [expr {$pad*-2}] - incr H [expr {$pad*-2}] + incr W [expr {$pad * -2}] + incr H [expr {$pad * -2}] set dx [expr {$maxIW + $maxTW + 8}] if {$maxTH > $maxIH} { @@ -335,12 +333,12 @@ package require Tk 8.6 set usedColumn 1 lassign $sublist iTag tTag rTag iW iH tW tH - set i_dy [expr {($dy - $iH)/2}] - set t_dy [expr {($dy - $tH)/2}] + set i_dy [expr {($dy - $iH) / 2}] + set t_dy [expr {($dy - $tH) / 2}] $canvas coords $iTag $x [expr {$y + $i_dy}] $canvas coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}] - $canvas coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}] + $canvas coords $rTag $x $y [expr {$x + $dx}] [expr {$y + $dy}] incr y $dy if {($y + $dy) > $H} { @@ -367,7 +365,7 @@ package require Tk 8.6 set noScroll 0 } - set itemsPerColumn [expr {($H-$pad) / $dy}] + set itemsPerColumn [expr {($H - $pad) / $dy}] if {$itemsPerColumn < 1} { set itemsPerColumn 1 } @@ -420,7 +418,7 @@ package require Tk 8.6 set maxTH 1 set numItems 0 set noScroll 1 - set selection {} + set selection "" set index(anchor) "" set fg [option get $canvas foreground Foreground] if {$fg eq ""} { @@ -591,7 +589,7 @@ package require Tk 8.6 return } set curr [$w selection get] - if {[llength $curr] == 0} { + if {![llength $curr]} { set i 0 } else { set i [$w index anchor] @@ -617,7 +615,7 @@ package require Tk 8.6 return } set curr [$w selection get] - if {[llength $curr] == 0} { + if {![llength $curr]} { set i 0 } else { set i [$w index anchor] @@ -645,7 +643,7 @@ package require Tk 8.6 if {![info exists list]} { return } - if {$text eq "" || $numItems == 0} { + if {($text eq "") || ($numItems == 0)} { return } diff --git a/library/icons.tcl b/library/icons.tcl index e53a1bd..7aebbdd 100644 --- a/library/icons.tcl +++ b/library/icons.tcl @@ -12,7 +12,7 @@ namespace eval ::tk::icons {} -image create photo ::tk::icons::warning -data { +image create photo ::tk::icons::warning -data " iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABSZJREFU WIXll1toVEcYgL+Zc87u2Yu7MYmrWRuTJuvdiMuqiJd4yYKXgMQKVkSjFR80kFIVJfWCWlvpg4h9 8sXGWGof8iKNICYSo6JgkCBEJRG8ImYThNrNxmaTeM7pQ5IlJkabi0/9YZhhZv7///4z/8zPgf+7 @@ -38,9 +38,9 @@ image create photo ::tk::icons::warning -data { 1DSwLCzDANPEMozusWFgmWZ33288YK3/nGlixuM0v3xpWfDX0Z4i1VupXEWwIgRnJfhGPfQ+YsLr +7DzNFwCuvqWyiRg7DSYoIBu9smPkYqEd4AwIN4ITUAL0A4Da7UC6ICdEfy2fUBMoAvo7GnWKNoe mfwLcAuinuFNL7QAAAAASUVORK5CYII= -} +" -image create photo ::tk::icons::error -data { +image create photo ::tk::icons::error -data " iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABiRJREFU WIXFl11sHFcVgL97Z/bX693sbtd2ipOqCU7sQKukFYUigQgv/a+hoZGoqipvfQKpAsEDD0hIvCHE j/pQ3sIDUdOiIqUyqXioEFSUhqit7cRJFJpEruxs1mt77Z3d2Z259/KwM5vZXTtOERJXOrozZ+6e @@ -70,9 +70,9 @@ image create photo ::tk::icons::error -data { eE6TVq1Be3WD9ZtrTc9tWetw7k341dtwBagDTmTeESAdAAxH5z0w9iQ8ehi+moWxBGRsiPvguVBf h8qH8P6f4dxSp9PrdN73cN6k859R3U0J0nS+28JMpIM5FUgCiNP5X2ECox7gAk06KQ8ldLzZ7/xO ANHnscBhCkgGjuOB3gb8CEAbaAWO3UA34DQ6/gPnmhBFs5mqXAAAAABJRU5ErkJggg== -} +" -image create photo ::tk::icons::information -data { +image create photo ::tk::icons::information -data " iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABmJLR0QA/wD/AP+gvaeTAAAACXBI WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gUdFDM4pWaDogAABwNJREFUWMPFlltsVNcVhv+199ln bh7PjAdfMGNDcA04EKMkJlIsBVJVbRqlEVUrqyW0QAtFTVWpjVpFfamUF6K+tCTKQyXn0jaiShOr @@ -107,9 +107,9 @@ image create photo ::tk::icons::information -data { ZOTVatUWte+otsTXg2pQSwagG6r/jwsAQul0erqjo+OesbGx1tHRUT+fz48dP378j57neQD8mtB1 B1TtnV9zo64loJqoXhtFDUQHEGhvb2/2fZ9nMpliTcAFYNdC1sIBYN1sCeq5Ca9bqtWcu9Fe3FDl 9Uqvu3HLjfhvTUo85WzjhogAAAAASUVORK5CYII= -} +" -image create photo ::tk::icons::question -data { +image create photo ::tk::icons::question -data " iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAACG5JREFU WIXFl3twVdUVxn97n3Nubm7euZcghEdeBBICEQUFIgVECqIo1uJMp3WodqyjMzpjZ7TTh20cK31N /2jL2FYdKXaqRcbnDKGpoBFaAY1BHgHMgyRKQkJy87yv3Nyzd/84594k1RlppzPumTXn3Dl3r/Wd @@ -150,4 +150,4 @@ image create photo ::tk::icons::question -data { 6XUDh4BBIHwlDIBTohlANpBhWb6s7PKNK30FCzZa6dnVYORoIX2OExVF26Px8NCZSN/5d0bb3mlK JGIhHLpDwLAL4jPnxSs9nBqABXhddrw4XdRygSrABuKuxYBx9/6KDqlf2vo3PYe56vmkuwMAAAAA SUVORK5CYII= -} +" diff --git a/library/listbox.tcl b/library/listbox.tcl index 01fb03d..fe446bf 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -250,12 +250,12 @@ proc ::tk::ListboxBeginSelect {w el {focus 1}} { $w selection clear 0 end $w selection set $el $w selection anchor $el - set Priv(listboxSelection) {} + set Priv(listboxSelection) "" set Priv(listboxPrev) $el } event generate $w <<ListboxSelect>> # check existence as ListboxSelect may destroy us - if {$focus && [winfo exists $w] && [$w cget -state] eq "normal"} { + if {$focus && [winfo exists $w] && ([$w cget -state] eq "normal")} { focus $w } } @@ -276,7 +276,7 @@ proc ::tk::ListboxMotion {w el} { return } set anchor [$w index anchor] - switch [$w cget -selectmode] { + switch -- [$w cget -selectmode] { browse { $w selection clear 0 end $w selection set $el @@ -314,6 +314,7 @@ proc ::tk::ListboxMotion {w el} { set Priv(listboxPrev) $el event generate $w <<ListboxSelect>> } + default {} } } @@ -411,7 +412,7 @@ proc ::tk::ListboxUpDown {w amount} { variable ::tk::Priv $w activate [expr {[$w index active] + $amount}] $w see active - switch [$w cget -selectmode] { + switch -- [$w cget -selectmode] { browse { $w selection clear 0 end $w selection set active @@ -422,9 +423,10 @@ proc ::tk::ListboxUpDown {w amount} { $w selection set active $w selection anchor active set Priv(listboxPrev) [$w index active] - set Priv(listboxSelection) {} + set Priv(listboxSelection) "" event generate $w <<ListboxSelect>> } + default {} } } @@ -488,7 +490,7 @@ proc ::tk::ListboxDataExtend {w el} { # Arguments: # w - The listbox widget. -proc ::tk::ListboxCancel w { +proc ::tk::ListboxCancel {w} { variable ::tk::Priv if {[$w cget -selectmode] ne "extended"} { return @@ -523,9 +525,9 @@ proc ::tk::ListboxCancel w { # Arguments: # w - The listbox widget. -proc ::tk::ListboxSelectAll w { +proc ::tk::ListboxSelectAll {w} { set mode [$w cget -selectmode] - if {$mode eq "single" || $mode eq "browse"} { + if {$mode in "single browse"} { $w selection clear 0 end $w selection set active } else { diff --git a/library/megawidget.tcl b/library/megawidget.tcl index 9b9be92..c39e222 100644 --- a/library/megawidget.tcl +++ b/library/megawidget.tcl @@ -15,7 +15,7 @@ package require Tk 8.6 ::oo::class create ::tk::Megawidget { superclass ::oo::class method unknown {w args} { - if {[string match .* $w]} { + if {[string match ".*" $w]} { [self] create $w {*}$args return $w } @@ -30,7 +30,7 @@ package require Tk 8.6 ::oo::class create ::tk::MegawidgetClass { variable w hull OptionSpecification options IdleCallbacks - constructor args { + constructor {args} { # Extract the "widget name" from the object name set w [namespace tail [self]] @@ -63,10 +63,10 @@ package require Tk 8.6 } } - method configure args { + method configure {args} { tclParseConfigSpec [my varname options] $OptionSpecification "" $args } - method cget option { + method cget {option} { return $options($option) } diff --git a/library/menu.tcl b/library/menu.tcl index cfe7536..f3256e8 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -195,14 +195,14 @@ if {[tk windowingsystem] eq "x11"} { # Arguments: # w - The name of the widget. -proc ::tk::MbEnter w { +proc ::tk::MbEnter {w} { variable ::tk::Priv if {$Priv(inMenubutton) ne ""} { MbLeave $Priv(inMenubutton) } set Priv(inMenubutton) $w - if {[$w cget -state] ne "disabled" && [tk windowingsystem] ne "aqua"} { + if {([$w cget -state] ne "disabled") && ([tk windowingsystem] ne "aqua")} { $w configure -state active } } @@ -214,14 +214,14 @@ proc ::tk::MbEnter w { # Arguments: # w - The name of the widget. -proc ::tk::MbLeave w { +proc ::tk::MbLeave {w} { variable ::tk::Priv - set Priv(inMenubutton) {} + set Priv(inMenubutton) "" if {![winfo exists $w]} { return } - if {[$w cget -state] eq "active" && [tk windowingsystem] ne "aqua"} { + if {([$w cget -state] eq "active") && ([tk windowingsystem] ne "aqua")} { $w configure -state normal } } @@ -238,27 +238,27 @@ proc ::tk::MbLeave w { # option menus. If not specified, then the center # of the menubutton is used for an option menu. -proc ::tk::MbPost {w {x {}} {y {}}} { +proc ::tk::MbPost {w {x ""} {y ""}} { global errorInfo variable ::tk::Priv global tcl_platform - if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} { + if {([$w cget -state] eq "disabled") || ($w eq $Priv(postedMb))} { return } set menu [$w cget -menu] if {$menu eq ""} { return } - set tearoff [expr {[tk windowingsystem] eq "x11" \ - || [$menu cget -type] eq "tearoff"}] + set tearoff [expr {([tk windowingsystem] eq "x11") || + ([$menu cget -type] eq "tearoff")}] if {[string first $w $menu] != 0} { return -code error -errorcode {TK MENUBUTTON POST_NONCHILD} \ "can't post $menu: it isn't a descendant of $w" } set cur $Priv(postedMb) if {$cur ne ""} { - MenuUnpost {} + MenuUnpost "" } if {$::tk_strictMotif} { set Priv(cursor) [$w cget -cursor] @@ -282,7 +282,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { update idletasks if {[catch { - switch [$w cget -direction] { + switch -- [$w cget -direction] { above { set x [winfo rootx $w] set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}] @@ -298,46 +298,46 @@ proc ::tk::MbPost {w {x {}} {y {}}} { # if we go offscreen to the bottom, show as 'above' set mh [winfo reqheight $menu] if {($y + $mh) > ([winfo vrooty $w] + [winfo vrootheight $w])} { - set y [expr {[winfo vrooty $w] + [winfo vrootheight $w] + [winfo rooty $w] - $mh}] + set y [expr {([winfo vrooty $w] + [winfo vrootheight $w] + [winfo rooty $w]) - $mh}] } PostOverPoint $menu $x $y } left { set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}] - set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] + set y [expr {((2 * [winfo rooty $w]) + [winfo height $w]) / 2}] set entry [MenuFindName $menu [$w cget -text]] if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ - + [winfo reqheight $menu])/2}] + + [winfo reqheight $menu]) / 2}] } else { incr y [expr {-([$menu yposition $entry] \ - + [$menu yposition [expr {$entry+1}]])/2}] + + [$menu yposition [expr {$entry + 1}]]) / 2}] } } PostOverPoint $menu $x $y - if {$entry ne "" \ - && [$menu entrycget $entry -state] ne "disabled"} { + if {($entry ne "") && + ([$menu entrycget $entry -state] ne "disabled")} { $menu activate $entry GenerateMenuSelect $menu } } right { set x [expr {[winfo rootx $w] + [winfo width $w]}] - set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] + set y [expr {((2 * [winfo rooty $w]) + [winfo height $w]) / 2}] set entry [MenuFindName $menu [$w cget -text]] if {[$w cget -indicatoron]} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ - + [winfo reqheight $menu])/2}] + + [winfo reqheight $menu]) / 2}] } else { incr y [expr {-([$menu yposition $entry] \ - + [$menu yposition [expr {$entry+1}]])/2}] + + [$menu yposition [expr {$entry + 1}]]) / 2}] } } PostOverPoint $menu $x $y - if {$entry ne "" \ - && [$menu entrycget $entry -state] ne "disabled"} { + if {($entry ne "") && + ([$menu entrycget $entry -state] ne "disabled")} { $menu activate $entry GenerateMenuSelect $menu } @@ -345,12 +345,12 @@ proc ::tk::MbPost {w {x {}} {y {}}} { default { if {[$w cget -indicatoron]} { if {$y eq ""} { - set x [expr {[winfo rootx $w] + [winfo width $w]/2}] - set y [expr {[winfo rooty $w] + [winfo height $w]/2}] + set x [expr {[winfo rootx $w] + ([winfo width $w] / 2)}] + set y [expr {[winfo rooty $w] + ([winfo height $w] / 2)}] } PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]] } else { - PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}] + PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w] + [winfo height $w]}] } } } @@ -358,7 +358,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { # Error posting menu (e.g. bogus -postcommand). Unpost it and # reflect the error. - MenuUnpost {} + MenuUnpost "" return -options $opt $msg } @@ -388,7 +388,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { # menu - Name of a menu to unpost. Ignored if there # is a posted menubutton. -proc ::tk::MenuUnpost menu { +proc ::tk::MenuUnpost {menu} { global tcl_platform variable ::tk::Priv set mb $Priv(postedMb) @@ -412,7 +412,7 @@ proc ::tk::MenuUnpost menu { if {$mb ne ""} { set menu [$mb cget -menu] $menu unpost - set Priv(postedMb) {} + set Priv(postedMb) "" if {$::tk_strictMotif} { $mb configure -cursor $Priv(cursor) } @@ -423,8 +423,8 @@ proc ::tk::MenuUnpost menu { } } elseif {$Priv(popup) ne ""} { $Priv(popup) unpost - set Priv(popup) {} - } elseif {[$menu cget -type] ne "menubar" && [$menu cget -type] ne "tearoff"} { + set Priv(popup) "" + } elseif {[$menu cget -type] ni "menubar 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 @@ -432,14 +432,14 @@ proc ::tk::MenuUnpost menu { while {1} { set parent [winfo parent $menu] - if {[winfo class $parent] ne "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 {$type eq "menubar" || $type eq "tearoff"} { + if {$type in "menubar tearoff"} { break } set menu $parent @@ -450,7 +450,7 @@ proc ::tk::MenuUnpost menu { } } - if {($Priv(tearoff) != 0) || $Priv(menuBar) ne ""} { + if {($Priv(tearoff) != 0) || ($Priv(menuBar) ne "")} { # Release grab, if any, and restore the previous grab, if there # was one. if {$menu ne ""} { @@ -464,7 +464,7 @@ proc ::tk::MenuUnpost menu { if {$::tk_strictMotif} { $Priv(menuBar) configure -cursor $Priv(cursor) } - set Priv(menuBar) {} + set Priv(menuBar) "" } if {[tk windowingsystem] ne "x11"} { set Priv(tearoff) 0 @@ -490,15 +490,15 @@ proc ::tk::MbMotion {w upDown rootx rooty} { return } set new [winfo containing $rootx $rooty] - if {$new ne $Priv(inMenubutton) \ - && ($new eq "" || [winfo toplevel $new] eq [winfo toplevel $w])} { + if {($new ne $Priv(inMenubutton)) && + (($new eq "") || ([winfo toplevel $new] eq [winfo toplevel $w]))} { if {$Priv(inMenubutton) ne ""} { MbLeave $Priv(inMenubutton) } - if {$new ne "" \ - && [winfo class $new] eq "Menubutton" \ - && ([$new cget -indicatoron] == 0) \ - && ([$w cget -indicatoron] == 0)} { + if {($new ne "") && + ([winfo class $new] eq "Menubutton") && + ([$new cget -indicatoron] == 0) && + ([$w cget -indicatoron] == 0)} { if {$upDown eq "down"} { MbPost $new $rootx $rooty } else { @@ -516,18 +516,19 @@ proc ::tk::MbMotion {w upDown rootx rooty} { # Arguments: # w - The name of the menubutton widget. -proc ::tk::MbButtonUp w { +proc ::tk::MbButtonUp {w} { variable ::tk::Priv global tcl_platform set menu [$w cget -menu] - set tearoff [expr {[tk windowingsystem] eq "x11" || \ - ($menu ne "" && [$menu cget -type] eq "tearoff")}] - if {($tearoff != 0) && $Priv(postedMb) eq $w \ - && $Priv(inMenubutton) eq $w} { + set tearoff [expr {([tk windowingsystem] eq "x11") || + (($menu ne "") && ([$menu cget -type] eq "tearoff"))}] + if {($tearoff != 0) && + ($Priv(postedMb) eq $w) && + ($Priv(inMenubutton) eq $w)} { MenuFirstEntry [$Priv(postedMb) cget -menu] } else { - MenuUnpost {} + MenuUnpost "" } } @@ -549,7 +550,7 @@ proc ::tk::MenuMotion {menu x y state} { if {$menu eq $Priv(window)} { set activeindex [$menu index active] if {[$menu cget -type] eq "menubar"} { - if {[info exists Priv(focus)] && $menu ne $Priv(focus)} { + if {[info exists Priv(focus)] && ($menu ne $Priv(focus))} { $menu activate @$x,$y GenerateMenuSelect $menu } @@ -558,12 +559,12 @@ proc ::tk::MenuMotion {menu x y state} { GenerateMenuSelect $menu } set index [$menu index @$x,$y] - if {[info exists Priv(menuActivated)] \ - && $index ne "none" \ - && $index ne $activeindex} { + if {[info exists Priv(menuActivated)] && + ($index ne "none") && + ($index ne $activeindex)} { set mode [option get $menu clickToFocus ClickToFocus] if {[string is false $mode]} { - set delay [expr {[$menu cget -type] eq "menubar" ? 0 : 50}] + set delay [expr {([$menu cget -type] eq "menubar") ? 0 : 50}] if {[$menu type $index] eq "cascade"} { set Priv(menuActivatedTimer) \ [after $delay [list $menu postcascade active]] @@ -591,7 +592,7 @@ proc ::tk::MenuMotion {menu x y state} { # Arguments: # menu - The menu window. -proc ::tk::MenuButtonDown menu { +proc ::tk::MenuButtonDown {menu} { variable ::tk::Priv global tcl_platform @@ -599,16 +600,16 @@ proc ::tk::MenuButtonDown menu { return } $menu postcascade active - if {$Priv(postedMb) ne "" && [winfo viewable $Priv(postedMb)]} { + if {($Priv(postedMb) ne "") && [winfo viewable $Priv(postedMb)]} { grab -global $Priv(postedMb) } else { - while {[$menu cget -type] eq "normal" \ - && [winfo class [winfo parent $menu]] eq "Menu" \ - && [winfo ismapped [winfo parent $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 {$Priv(menuBar) eq {}} { + if {$Priv(menuBar) eq ""} { set Priv(menuBar) $menu if {$::tk_strictMotif} { set Priv(cursor) [$menu cget -cursor] @@ -649,13 +650,12 @@ proc ::tk::MenuButtonDown menu { proc ::tk::MenuLeave {menu rootx rooty state} { variable ::tk::Priv - set Priv(window) {} + set Priv(window) "" if {[$menu index active] eq "none"} { return } - if {[$menu type active] eq "cascade" \ - && [winfo containing $rootx $rooty] eq \ - [$menu entrycget active -menu]} { + if {([$menu type active] eq "cascade") && + ([winfo containing $rootx $rooty] eq [$menu entrycget active -menu])} { return } $menu activate none @@ -675,7 +675,7 @@ proc ::tk::MenuLeave {menu rootx rooty state} { proc ::tk::MenuInvoke {w buttonRelease} { variable ::tk::Priv - if {$buttonRelease && $Priv(window) eq ""} { + 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. @@ -718,7 +718,7 @@ proc ::tk::MenuInvoke {w buttonRelease} { } } else { set active [$w index active] - if {$Priv(popup) eq "" || $active ne "none"} { + if {($Priv(popup) eq "") || ($active ne "none")} { MenuUnpost $w } uplevel #0 [list $w invoke active] @@ -733,7 +733,7 @@ proc ::tk::MenuInvoke {w buttonRelease} { # Arguments: # menu - Name of the menu window. -proc ::tk::MenuEscape menu { +proc ::tk::MenuEscape {menu} { set parent [winfo parent $menu] if {[winfo class $parent] ne "Menu"} { MenuUnpost $menu @@ -809,8 +809,8 @@ proc ::tk::MenuNextMenu {menu direction} { } else { set parent [winfo parent $menu] while {$parent ne "."} { - if {[winfo class $parent] eq "Menu" \ - && [$parent cget -type] eq "menubar"} { + if {([winfo class $parent] eq "Menu") && + ([$parent cget -type] eq "menubar")} { tk_menuSetFocus $parent MenuNextEntry $parent 1 return @@ -838,7 +838,7 @@ proc ::tk::MenuNextMenu {menu direction} { # or previous menubutton, if that makes sense. set m2 [winfo parent $menu] - if {[winfo class $m2] eq "Menu" && [$m2 cget -type] eq "menubar"} { + if {([winfo class $m2] eq "Menu") && ([$m2 cget -type] eq "menubar")} { tk_menuSetFocus $m2 MenuNextEntry $m2 -1 return @@ -859,10 +859,10 @@ proc ::tk::MenuNextMenu {menu direction} { incr i -$length } set mb [lindex $buttons $i] - if {[winfo class $mb] eq "Menubutton" \ - && [$mb cget -state] ne "disabled" \ - && [$mb cget -menu] ne "" \ - && [[$mb cget -menu] index last] ne "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 {$mb eq $w} { @@ -887,7 +887,7 @@ proc ::tk::MenuNextEntry {menu count} { if {[$menu index last] eq "none"} { return } - set length [expr {[$menu index last]+1}] + set length [expr {[$menu index last] + 1}] set quitAfter $length set active [$menu index active] if {$active eq "none"} { @@ -908,10 +908,11 @@ proc ::tk::MenuNextEntry {menu count} { while {$i >= $length} { incr i -$length } - if {[catch {$menu entrycget $i -state} state] == 0} { - if {$state ne "disabled" && \ - ($i!=0 || [$menu cget -type] ne "tearoff" \ - || [$menu type 0] ne "tearoff")} { + if {![catch {$menu entrycget $i -state} state]} { + if {($state ne "disabled") && + (($i != 0) || + ([$menu cget -type] ne "tearoff") || + ([$menu type 0] ne "tearoff"))} { break } } @@ -924,7 +925,7 @@ proc ::tk::MenuNextEntry {menu count} { $menu activate $i GenerateMenuSelect $menu - if {[$menu type $i] eq "cascade" && [$menu cget -type] eq "menubar"} { + if {([$menu type $i] eq "cascade") && ([$menu cget -type] eq "menubar")} { set cascade [$menu entrycget $i -menu] if {$cascade ne ""} { # Here we auto-post a cascade. This is necessary when @@ -952,8 +953,8 @@ proc ::tk::MenuNextEntry {menu count} { # may be either upper or lower case, and # will match either upper or lower case. -proc ::tk::MenuFind {w char} { - set char [string tolower $char] +proc ::tk::MenuFind {w a_char} { + set char [string tolower $a_char] set windowlist [winfo child $w] foreach child $windowlist { @@ -961,8 +962,8 @@ proc ::tk::MenuFind {w char} { if {[winfo toplevel $w] ne [winfo toplevel $child]} { continue } - if {[winfo class $child] eq "Menu" && \ - [$child cget -type] eq "menubar"} { + if {([winfo class $child] eq "Menu") && + ([$child cget -type] eq "menubar")} { if {$char eq ""} { return $child } @@ -973,7 +974,7 @@ proc ::tk::MenuFind {w char} { } set char2 [string index [$child entrycget $i -label] \ [$child entrycget $i -underline]] - if {$char eq [string tolower $char2] || $char eq ""} { + if {($char eq [string tolower $char2]) || ($char eq "")} { if {[$child entrycget $i -state] ne "disabled"} { return $child } @@ -991,7 +992,7 @@ proc ::tk::MenuFind {w char} { Menubutton { set char2 [string index [$child cget -text] \ [$child cget -underline]] - if {$char eq [string tolower $char2] || $char eq ""} { + if {($char eq [string tolower $char2]) || ($char eq "")} { if {[$child cget -state] ne "disabled"} { return $child } @@ -1006,7 +1007,7 @@ proc ::tk::MenuFind {w char} { } } } - return {} + return "" } # ::tk::TraverseToMenu -- @@ -1057,7 +1058,7 @@ proc ::tk::TraverseToMenu {w char} { # w - Name of a window. Selects which toplevel # to search for menubuttons. -proc ::tk::FirstMenu w { +proc ::tk::FirstMenu {w} { variable ::tk::Priv set w [MenuFind [winfo toplevel $w] ""] if {$w ne ""} { @@ -1128,7 +1129,7 @@ proc ::tk::TraverseWithinMenu {w char} { # Arguments: # menu - Name of the menu window (possibly empty). -proc ::tk::MenuFirstEntry menu { +proc ::tk::MenuFirstEntry {menu} { if {$menu eq ""} { return } @@ -1141,15 +1142,15 @@ proc ::tk::MenuFirstEntry menu { return } for {set i 0} {$i <= $last} {incr i} { - if {([catch {set state [$menu entrycget $i -state]}] == 0) \ - && $state ne "disabled" && [$menu type $i] ne "tearoff"} { + if {(![catch {set state [$menu entrycget $i -state]}]) && + ($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 {[$menu type $i] eq "cascade" && [$menu cget -type] eq "menubar"} { + if {([$menu type $i] eq "cascade") && ([$menu cget -type] eq "menubar")} { set cascade [$menu entrycget $i -menu] if {$cascade ne ""} { $menu postcascade $i @@ -1204,18 +1205,18 @@ proc ::tk::MenuFindName {menu s} { # If omitted or specified as {}, then the menu's # upper-left corner goes at (x,y). -proc ::tk::PostOverPoint {menu x y {entry {}}} { +proc ::tk::PostOverPoint {menu x y {entry ""}} { global tcl_platform if {$entry ne ""} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ - + [winfo reqheight $menu])/2}] + + [winfo reqheight $menu]) / 2}] } else { incr y [expr {-([$menu yposition $entry] \ - + [$menu yposition [expr {$entry+1}]])/2}] + + [$menu yposition [expr {$entry + 1}]]) / 2}] } - incr x [expr {-[winfo reqwidth $menu]/2}] + incr x [expr {-[winfo reqwidth $menu] / 2}] } if {[tk windowingsystem] eq "win32"} { @@ -1248,7 +1249,7 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} { } } $menu post $x $y - if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} { + if {($entry ne "") && ([$menu entrycget $entry -state] ne "disabled")} { $menu activate $entry GenerateMenuSelect $menu } @@ -1262,7 +1263,7 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} { # w - Name of a window; used to select the display # whose grab information is to be recorded. -proc tk::SaveGrabInfo w { +proc tk::SaveGrabInfo {w} { variable ::tk::Priv set Priv(oldGrab) [grab current $w] if {$Priv(oldGrab) ne ""} { @@ -1294,7 +1295,7 @@ proc ::tk::RestoreOldGrab {} { proc ::tk_menuSetFocus {menu} { variable ::tk::Priv - if {![info exists Priv(focus)] || $Priv(focus) eq ""} { + if {(![info exists Priv(focus)]) || ($Priv(focus) eq "")} { set Priv(focus) [focus] } focus $menu @@ -1303,8 +1304,8 @@ proc ::tk_menuSetFocus {menu} { proc ::tk::GenerateMenuSelect {menu} { variable ::tk::Priv - if {$Priv(activeMenu) eq $menu \ - && $Priv(activeItem) eq [$menu index active]} { + if {($Priv(activeMenu) eq $menu) && + ($Priv(activeItem) eq [$menu index active])} { return } @@ -1325,14 +1326,14 @@ proc ::tk::GenerateMenuSelect {menu} { # If omitted or specified as {}, then menu's # upper-left corner goes at (x,y). -proc ::tk_popup {menu x y {entry {}}} { +proc ::tk_popup {menu x y {entry ""}} { variable ::tk::Priv global tcl_platform - if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} { - tk::MenuUnpost {} + if {($Priv(popup) ne "") || ($Priv(postedMb) ne "")} { + tk::MenuUnpost "" } tk::PostOverPoint $menu $x $y $entry - if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} { + if {([tk windowingsystem] eq "x11") && [winfo viewable $menu]} { tk::SaveGrabInfo $menu grab -global $menu set Priv(popup) $menu diff --git a/library/mkpsenc.tcl b/library/mkpsenc.tcl index 50224eb..d27969e 100644 --- a/library/mkpsenc.tcl +++ b/library/mkpsenc.tcl @@ -12,12 +12,12 @@ namespace eval ::tk { # Now check for known. Even if it is known, it can be other than we # need. GhostScript seems to be happy with such approach set result "\[\n" - for {set i 0} {$i<256} {incr i 8} { - for {set j 0} {$j<8} {incr j} { + for {set i 0} {$i < 256} {incr i 8} { + for {set j 0} {$j < 8} {incr j} { set enc [encoding convertfrom "iso8859-1" \ - [format %c [expr {$i+$j}]]] + [format %c [expr {$i + $j}]]] catch { - set hexcode {} + set hexcode "" set hexcode [format %04X [scan $enc %c]] } if {[info exists psglyphs($hexcode)]} { @@ -1090,7 +1090,7 @@ namespace eval ::tk { FB4B afii57700 } - variable ps_preamble {} + variable ps_preamble "" namespace eval ps { namespace ensemble create diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 10e91f1..dd2756f 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -133,7 +133,7 @@ proc ::tk::MessageBox {args} { variable ::tk::Priv set w ::tk::PrivMsgBox - upvar $w data + upvar 1 $w data # # The default value of the title is space (" ") not the empty string @@ -163,6 +163,7 @@ proc ::tk::MessageBox {args} { "error" {set data(-icon) "stop"} "warning" {set data(-icon) "caution"} "info" {set data(-icon) "note"} + default {} } option add *Dialog*background systemDialogBackgroundActive widgetDefault option add *Dialog*Button.highlightBackground \ @@ -182,7 +183,7 @@ proc ::tk::MessageBox {args} { } ok { set names [list ok] - set labels {&OK} + set labels [list &OK] set cancel ok } okcancel { @@ -213,7 +214,7 @@ proc ::tk::MessageBox {args} { } } - set buttons {} + set buttons [list] foreach name $names lab $labels { lappend buttons [list $name -text [mc $lab]] } @@ -252,8 +253,8 @@ proc ::tk::MessageBox {args} { # 3. Create the top-level window and divide it into top # and bottom parts. - catch {destroy $w} - toplevel $w -class Dialog -bg $bg + destroy $w + toplevel $w -class Dialog -background $bg wm title $w $data(-title) wm iconname $w Dialog wm protocol $w WM_DELETE_WINDOW [list $w.$cancel invoke] @@ -270,7 +271,7 @@ proc ::tk::MessageBox {args} { } if {$windowingsystem eq "aqua"} { - ::tk::unsupported::MacWindowStyle style $w moveableModal {} + ::tk::unsupported::MacWindowStyle style $w moveableModal "" } elseif {$windowingsystem eq "x11"} { wm attributes $w -type dialog } @@ -299,7 +300,7 @@ proc ::tk::MessageBox {args} { # ttk::label has no -bitmap option label $w.bitmap -bitmap $data(-icon) -background $bg } else { - switch $data(-icon) { + switch -- $data(-icon) { error { ttk::label $w.bitmap -image ::tk::icons::error } @@ -350,9 +351,7 @@ proc ::tk::MessageBox {args} { # We boost the size of some Mac buttons for l&f if {$windowingsystem eq "aqua"} { set tmp [string tolower $name] - if {$tmp eq "ok" || $tmp eq "cancel" || $tmp eq "yes" || - $tmp eq "no" || $tmp eq "abort" || $tmp eq "retry" || - $tmp eq "ignore"} { + if {$tmp in "ok cancel yes no abort retry ignore"} { grid columnconfigure $w.bot $i -minsize 90 } grid configure $w.$name -pady 7 diff --git a/library/obsolete.tcl b/library/obsolete.tcl index 3ee7f28..f84cd16 100644 --- a/library/obsolete.tcl +++ b/library/obsolete.tcl @@ -15,8 +15,8 @@ # they are no-ops. You should not use these procedures anymore, since # they may be removed in some future release. -proc tk_menuBar args {} -proc tk_bindForTraversal args {} +proc tk_menuBar {args} {} +proc tk_bindForTraversal {args} {} # ::tk::classic::restore -- # @@ -61,9 +61,9 @@ proc ::tk::classic::restore_font {args} { option add *Dialog.dtl.font system 21; # TkCaptionFont option add *ErrorDialog*Label.font system 21; # TkCaptionFont } else { - option add *Dialog.msg.font {Times 12} 21; # TkCaptionFont - option add *Dialog.dtl.font {Times 10} 21; # TkCaptionFont - option add *ErrorDialog*Label.font {Times -18} 21; # TkCaptionFont + option add *Dialog.msg.font "Times 12" 21; # TkCaptionFont + option add *Dialog.dtl.font "Times 10" 21; # TkCaptionFont + option add *ErrorDialog*Label.font "Times -18" 21; # TkCaptionFont } } diff --git a/library/optMenu.tcl b/library/optMenu.tcl index 7cfdaa0..aa2c2fb 100644 --- a/library/optMenu.tcl +++ b/library/optMenu.tcl @@ -31,7 +31,7 @@ proc ::tk_optionMenu {w varName firstValue args} { if {![info exists var]} { set var $firstValue } - menubutton $w -textvariable $varName -indicatoron 1 -menu $w.menu \ + menubutton $w -textvariable [set varName] -indicatoron 1 -menu $w.menu \ -relief raised -highlightthickness 1 -anchor c \ -direction flush menu $w.menu -tearoff 0 diff --git a/library/palette.tcl b/library/palette.tcl index 924dd61..14e007d 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -44,8 +44,8 @@ proc ::tk_setPalette {args} { # Note that the range of each value in the triple returned by # [winfo rgb] is 0-65535, and your eyes are more sensitive to # green than to red, and more to red than to blue. - foreach {r g b} $bg {break} - if {$r+1.5*$g+0.5*$b > 100000} { + lassign $bg r g b + if {($r + (1.5 * $g) + (0.5 * $b)) > 100000} { set new(foreground) black } else { set new(foreground) white @@ -53,8 +53,8 @@ proc ::tk_setPalette {args} { } lassign [winfo rgb . $new(foreground)] fg_r fg_g fg_b lassign $bg bg_r bg_g bg_b - set darkerBg [format #%02x%02x%02x [expr {(9*$bg_r)/2560}] \ - [expr {(9*$bg_g)/2560}] [expr {(9*$bg_b)/2560}]] + 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} { @@ -64,9 +64,9 @@ proc ::tk_setPalette {args} { } if {![info exists new(disabledForeground)]} { set new(disabledForeground) [format #%02x%02x%02x \ - [expr {(3*$bg_r + $fg_r)/1024}] \ - [expr {(3*$bg_g + $fg_g)/1024}] \ - [expr {(3*$bg_b + $fg_b)/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) @@ -78,9 +78,9 @@ proc ::tk_setPalette {args} { # greater. foreach i {0 1 2} color $bg { - set light($i) [expr {$color/256}] - set inc1 [expr {($light($i)*15)/100}] - set inc2 [expr {(255-$light($i))/3}] + set light($i) [expr {$color / 256}] + set inc1 [expr {($light($i) * 15) / 100}] + set inc2 [expr {(255 - $light($i)) / 3}] if {$inc1 > $inc2} { incr light($i) $inc1 } else { @@ -157,8 +157,8 @@ proc ::tk_setPalette {args} { # each value is the value for that option. proc ::tk::RecolorTree {w colors} { - upvar $colors c - set result {} + upvar 1 $colors c + set result "" set prototype .___tk_set_palette.[string tolower [winfo class $w]] if {![winfo exists $prototype]} { unset prototype @@ -172,9 +172,9 @@ proc ::tk::RecolorTree {w colors} { # dbOption, then use it, otherwise use the defaults # for the widget. set defaultcolor [option get $w $dbOption $class] - if {$defaultcolor eq "" || \ - ([info exists prototype] && \ - [$prototype cget $option] ne "$defaultcolor")} { + if {($defaultcolor eq "") || + ([info exists prototype] && + ([$prototype cget $option] ne "$defaultcolor"))} { set defaultcolor [lindex $value 3] } if {$defaultcolor ne ""} { @@ -211,9 +211,9 @@ proc ::tk::RecolorTree {w colors} { proc ::tk::Darken {color percent} { foreach {red green blue} [winfo rgb . $color] { - set red [expr {($red/256)*$percent/100}] - set green [expr {($green/256)*$percent/100}] - set blue [expr {($blue/256)*$percent/100}] + set red [expr {(($red / 256) * $percent) / 100}] + set green [expr {(($green / 256) * $percent) / 100}] + set blue [expr {(($blue / 256) * $percent) / 100}] break } if {$red > 255} { diff --git a/library/panedwindow.tcl b/library/panedwindow.tcl index d3dfabc..7cb07f6 100644 --- a/library/panedwindow.tcl +++ b/library/panedwindow.tcl @@ -31,22 +31,24 @@ namespace eval ::tk::panedwindow {} # Results: # None # -proc ::tk::panedwindow::MarkSash {w x y proxy} { +proc ::tk::panedwindow::MarkSash {w x y a_proxy} { variable ::tk::Priv if {[$w cget -opaqueresize]} { set proxy 0 + } else { + set proxy $a_proxy } set what [$w identify $x $y] if { [llength $what] == 2 } { lassign $what index which - if {!$::tk_strictMotif || $which eq "handle"} { + if {(!$::tk_strictMotif) || ($which eq "handle")} { if {!$proxy} { $w sash mark $index $x $y } set Priv(sash) $index lassign [$w sash coord $index] sx sy - set Priv(dx) [expr {$sx-$x}] - set Priv(dy) [expr {$sy-$y}] + set Priv(dx) [expr {$sx - $x}] + set Priv(dy) [expr {$sy - $y}] # Do this to init the proxy location DragSash $w $x $y $proxy } @@ -65,17 +67,19 @@ proc ::tk::panedwindow::MarkSash {w x y proxy} { # Results: # Moves sash # -proc ::tk::panedwindow::DragSash {w x y proxy} { +proc ::tk::panedwindow::DragSash {w x y a_proxy} { variable ::tk::Priv if {[$w cget -opaqueresize]} { set proxy 0 + } else { + set proxy $a_proxy } if {[info exists Priv(sash)]} { if {$proxy} { - $w proxy place [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}] + $w proxy place [expr {$x + $Priv(dx)}] [expr {$y + $Priv(dy)}] } else { $w sash place $Priv(sash) \ - [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}] + [expr {$x + $Priv(dx)}] [expr {$y + $Priv(dy)}] } } } @@ -90,10 +94,12 @@ proc ::tk::panedwindow::DragSash {w x y proxy} { # Results: # Returns ... # -proc ::tk::panedwindow::ReleaseSash {w proxy} { +proc ::tk::panedwindow::ReleaseSash {w a_proxy} { variable ::tk::Priv if {[$w cget -opaqueresize]} { set proxy 0 + } else { + set proxy $a_proxy } if {[info exists Priv(sash)]} { if {$proxy} { @@ -121,8 +127,8 @@ proc ::tk::panedwindow::ReleaseSash {w proxy} { proc ::tk::panedwindow::Motion {w x y} { variable ::tk::Priv set id [$w identify $x $y] - if {([llength $id] == 2) && \ - (!$::tk_strictMotif || [lindex $id 1] eq "handle")} { + if {([llength $id] == 2) && + ((!$::tk_strictMotif) || ([lindex $id 1] eq "handle"))} { if {![info exists Priv($w,panecursor)]} { set Priv($w,panecursor) [$w cget -cursor] if {[$w cget -sashcursor] ne ""} { diff --git a/library/safetk.tcl b/library/safetk.tcl index 9f8e25d..ab6fbbd 100644 --- a/library/safetk.tcl +++ b/library/safetk.tcl @@ -63,8 +63,8 @@ proc ::safe::loadTk {} {} ::tcl::OptProc ::safe::loadTk { {slave -interp "name of the slave interpreter"} - {-use -windowId {} "window Id to use (new toplevel otherwise)"} - {-display -displayName {} "display name to use (current one otherwise)"} + {-use -windowId "" "window Id to use (new toplevel otherwise)"} + {-display -displayName "" "display name to use (current one otherwise)"} } { set displayGiven [::tcl::OptProcArgGiven "-display"] if {!$displayGiven} { @@ -89,7 +89,7 @@ proc ::safe::loadTk {} {} # set our delete hook (slave arg is added by interpDelete) # to clean up both window related code and tkInit(slave) - set state(cleanupHook) [list tkDelete {} $w] + set state(cleanupHook) [list tkDelete "" $w] } else { # set our delete hook (slave arg is added by interpDelete) # to clean up tkInit(slave) @@ -125,7 +125,7 @@ proc ::safe::loadTk {} {} # Prepares the slave for tk with those parameters tkInterpInit $slave [list "-use" $use "-display" $display] - load {} Tk $slave + load "" Tk $slave return $slave } diff --git a/library/scale.tcl b/library/scale.tcl index d9e7d27..c050700 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -148,12 +148,13 @@ proc ::tk::ScaleButtonDown {w x y} { } elseif {$el eq "slider"} { set Priv(dragging) 1 set Priv(initValue) [$w get] - set coords [$w coords] - set Priv(deltaX) [expr {$x - [lindex $coords 0]}] - set Priv(deltaY) [expr {$y - [lindex $coords 1]}] + lassign [$w coords] x_c y_c + set Priv(deltaX) [expr {$x - $x_c}] + set Priv(deltaY) [expr {$y - $y_c}] switch -exact -- $Priv($w,relief) { "raised" { $w configure -sliderrelief sunken } "ridge" { $w configure -sliderrelief groove } + default {} } } } @@ -173,7 +174,7 @@ proc ::tk::ScaleDrag {w x y} { if {!$Priv(dragging)} { return } - $w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]] + $w set [$w get [expr {$x - $Priv(deltaX)}] [expr {$y - $Priv(deltaY)}]] } # ::tk::ScaleEndDrag -- @@ -214,7 +215,7 @@ proc ::tk::ScaleIncrement {w dir big repeat} { if {$big eq "big"} { set inc [$w cget -bigincrement] if {$inc == 0} { - set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}] + set inc [expr { ( abs ([$w cget -to] - [$w cget -from])) / 10.0}] } if {$inc < [$w cget -resolution]} { set inc [$w cget -resolution] diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 1f8c7d2..089b36e 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -37,7 +37,7 @@ bind Scrollbar <Leave> { if {$tk_strictMotif && [info exists tk::Priv(activeBg)]} { %W configure -activebackground $tk::Priv(activeBg) } - %W activate {} + %W activate "" } bind Scrollbar <1> { tk::ScrollButtonDown %W %x %y @@ -128,7 +128,7 @@ bind Scrollbar <<LineEnd>> { tk::ScrollToPos %W 1 } } -switch [tk windowingsystem] { +switch -- [tk windowingsystem] { "aqua" { bind Scrollbar <MouseWheel> { tk::ScrollByUnits %W v [expr {- (%D)}] @@ -157,6 +157,7 @@ switch [tk windowingsystem] { bind Scrollbar <Shift-4> {tk::ScrollByUnits %W h -5} bind Scrollbar <Shift-5> {tk::ScrollByUnits %W h 5} } + default {} } # tk::ScrollButtonDown -- # This procedure is invoked when a button is pressed in a scrollbar. @@ -258,8 +259,8 @@ proc ::tk::ScrollStartDrag {w x y} { } elseif {$iv0 == 0} { set Priv(initPos) 0.0 } else { - set Priv(initPos) [expr {(double([lindex $Priv(initValues) 2])) \ - / [lindex $Priv(initValues) 0]}] + set Priv(initPos) \ + [expr {([lindex $Priv(initValues) 2] * 1.0) / [lindex $Priv(initValues) 0]}] } } @@ -285,7 +286,7 @@ proc ::tk::ScrollDrag {w x y} { $w set [expr {[lindex $Priv(initValues) 0] + $delta}] \ [expr {[lindex $Priv(initValues) 1] + $delta}] } else { - set delta [expr {round($delta * [lindex $Priv(initValues) 0])}] + set delta [expr { round ($delta * [lindex $Priv(initValues) 0])}] eval [list $w] set [lreplace $Priv(initValues) 2 3 \ [expr {[lindex $Priv(initValues) 2] + $delta}] \ [expr {[lindex $Priv(initValues) 3] + $delta}]] @@ -330,8 +331,8 @@ proc ::tk::ScrollEndDrag {w x y} { proc ::tk::ScrollByUnits {w orient amount} { set cmd [$w cget -command] - if {$cmd eq "" || ([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] @@ -355,15 +356,15 @@ proc ::tk::ScrollByUnits {w orient amount} { proc ::tk::ScrollByPages {w orient amount} { set cmd [$w cget -command] - if {$cmd eq "" || ([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] if {[llength $info] == 2} { uplevel #0 $cmd scroll $amount pages } else { - uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}] + uplevel #0 $cmd [expr {[lindex $info 2] + ($amount * ([lindex $info 1] - 1))}] } } @@ -386,7 +387,7 @@ proc ::tk::ScrollToPos {w pos} { if {[llength $info] == 2} { uplevel #0 $cmd moveto $pos } else { - uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}] + uplevel #0 $cmd [expr { round ([lindex $info 0] * $pos)}] } } @@ -401,9 +402,9 @@ proc ::tk::ScrollToPos {w pos} { proc ::tk::ScrollTopBottom {w x y} { variable ::tk::Priv set element [$w identify $x $y] - if {[string match *1 $element]} { + if {[string match "*1" $element]} { ScrollToPos $w 0 - } elseif {[string match *2 $element]} { + } elseif {[string match "*2" $element]} { ScrollToPos $w 1 } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 641584d..8efef70 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -67,8 +67,9 @@ bind Spinbox <<Clear>> { %W delete sel.first sel.last } bind Spinbox <<PasteSelection>> { - if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] - || !$tk::Priv(mouseMoved)} { + if {$tk_strictMotif || + (![info exists tk::Priv(mouseMoved)]) || + (!$tk::Priv(mouseMoved))} { ::tk::spinbox::Paste %W %x } } @@ -322,8 +323,8 @@ proc ::tk::spinbox::Invoke {w elem} { proc ::tk::spinbox::ClosestGap {w x} { set pos [$w index @$x] - set bbox [$w bbox $pos] - if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { + lassign [$w bbox $pos] x1 ___ x2 + if {($x - $x1) < ($x2 / 2)} { return $pos } incr pos @@ -349,7 +350,7 @@ proc ::tk::spinbox::ButtonDown {w x y} { set Priv(element) "entry" } - switch -exact $Priv(element) { + switch -exact -- $Priv(element) { "buttonup" - "buttondown" { if {"disabled" ne [$w cget -state]} { $w selection element $Priv(element) @@ -419,7 +420,7 @@ proc ::tk::spinbox::ButtonUp {w x y} { # x - The x-coordinate of the mouse. # cursor - optional place to set cursor. -proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { +proc ::tk::spinbox::MouseSelect {w x {cursor ""}} { variable ::tk::Priv if {$Priv(element) ne "entry"} { @@ -429,10 +430,10 @@ proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { } set cur [::tk::spinbox::ClosestGap $w $x] set anchor [$w index anchor] - if {($cur ne $anchor) || (abs($Priv(pressX) - $x) >= 3)} { + if {($cur ne $anchor) || ( abs ($Priv(pressX) - $x) >= 3)} { set Priv(mouseMoved) 1 } - switch $Priv(selectMode) { + switch -- $Priv(selectMode) { char { if {$Priv(mouseMoved)} { if {$cur < $anchor} { @@ -447,7 +448,7 @@ proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { word { if {$cur < [$w index anchor]} { set before [tcl_wordBreakBefore [$w get] $cur] - set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]] + set after [tcl_wordBreakAfter [$w get] [expr {$anchor - 1}]] } else { set before [tcl_wordBreakBefore [$w get] $anchor] set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]] @@ -463,8 +464,9 @@ proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { line { $w selection range 0 end } + default {} } - if {$cursor ne {} && $cursor ne "ignore"} { + if {$cursor ni "{} ignore"} { catch {$w icursor $cursor} } update idletasks diff --git a/library/tearoff.tcl b/library/tearoff.tcl index 6da2a0f..b756a1d 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -44,14 +44,14 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} { } set parent [winfo parent $w] - while {[winfo toplevel $parent] ne $parent \ - || [winfo class $parent] eq "Menu"} { + while {([winfo toplevel $parent] ne $parent) || + ([winfo class $parent] eq "Menu")} { set parent [winfo parent $parent] } if {$parent eq "."} { set parent "" } - for {set i 1} 1 {incr i} { + for {set i 1} {1} {incr i} { set menu $parent.tearoff$i if {![winfo exists $menu]} { break @@ -75,6 +75,7 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} { Menu { wm title $menu [$parent entrycget active -label] } + default {} } } @@ -90,7 +91,7 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} { $menu post $x $y - if {[winfo exists $menu] == 0} { + if {![winfo exists $menu]} { return "" } diff --git a/library/text.tcl b/library/text.tcl index e59a86e..769b578 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -259,8 +259,9 @@ bind Text <<Clear>> { catch {%W delete sel.first sel.last} } bind Text <<PasteSelection>> { - if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] - || !$tk::Priv(mouseMoved)} { + if {$tk_strictMotif || + (![info exists tk::Priv(mouseMoved)]) || + (!$tk::Priv(mouseMoved))} { tk::TextPasteSelection %W %x %y } } @@ -288,12 +289,12 @@ if {[tk windowingsystem] eq "aqua"} { # Additional emacs-like bindings: bind Text <Control-d> { - if {!$tk_strictMotif && [%W compare end != insert+1c]} { + if {(!$tk_strictMotif) && [%W compare end != insert+1c]} { %W delete insert } } bind Text <Control-k> { - if {!$tk_strictMotif && [%W compare end != insert+1c]} { + if {(!$tk_strictMotif) && [%W compare end != insert+1c]} { if {[%W compare insert == {insert lineend}]} { %W delete insert } else { @@ -327,7 +328,7 @@ bind Text <Meta-b> { } } bind Text <Meta-d> { - if {!$tk_strictMotif && [%W compare end != insert+1c]} { + if {(!$tk_strictMotif) && [%W compare end != insert+1c]} { %W delete insert [tk::TextNextWord %W insert] } } @@ -370,7 +371,7 @@ bind Text <<Paste>> { # A few additional bindings of my own. bind Text <Control-h> { - if {!$tk_strictMotif && [%W compare insert != 1.0]} { + if {(!$tk_strictMotif) && [%W compare insert != 1.0]} { %W delete insert-1c %W see insert } @@ -385,7 +386,7 @@ bind Text <B2-Motion> { tk::TextScanDrag %W %x %y } } -set ::tk::Priv(prevPos) {} +set ::tk::Priv(prevPos) "" # The MouseWheel will typically only fire on Windows and MacOS X. # However, someone could use the "event generate" command to produce one @@ -414,16 +415,16 @@ if {[tk windowingsystem] eq "aqua"} { # The following code ensure equal +/- behaviour. bind Text <MouseWheel> { if {%D >= 0} { - %W yview scroll [expr {-%D/3}] pixels + %W yview scroll [expr {-%D / 3}] pixels } else { - %W yview scroll [expr {(2-%D)/3}] pixels + %W yview scroll [expr {(2 - %D) / 3}] pixels } } bind Text <Shift-MouseWheel> { if {%D >= 0} { - %W xview scroll [expr {-%D/3}] pixels + %W xview scroll [expr {-%D / 3}] pixels } else { - %W xview scroll [expr {(2-%D)/3}] pixels + %W xview scroll [expr {(2 - %D) / 3}] pixels } } } @@ -471,7 +472,7 @@ proc ::tk::TextClosestGap {w x y} { if {$bbox eq ""} { return $pos } - if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { + if {($x - [lindex $bbox 0]) < ([lindex $bbox 2] / 2)} { return $pos } $w index "$pos + 1 char" @@ -506,8 +507,8 @@ proc ::tk::TextButton1 {w x y} { } # Allow focus in any case on Windows, because that will let the # selection be displayed even for state disabled text widgets. - if {[tk windowingsystem] eq "win32" \ - || [$w cget -state] eq "normal"} { + if {([tk windowingsystem] eq "win32") || + ([$w cget -state] eq "normal")} { focus $w } if {[$w cget -autoseparators]} { @@ -552,7 +553,7 @@ proc ::tk::TextSelectTo {w x y {extend 0}} { $w mark set $anchorname $cur } set anchor [$w index $anchorname] - if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} { + if {[$w compare $cur != $anchor] || ( abs ($Priv(pressX) - $x) >= 3)} { set Priv(mouseMoved) 1 } switch -- $Priv(selectMode) { @@ -599,6 +600,7 @@ proc ::tk::TextSelectTo {w x y {extend 0}} { set first [$w index $first] set last [$w index "$last + 1c"] } + default {} } if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} { $w tag remove sel 0.0 end @@ -791,19 +793,19 @@ proc ::tk::TextResetAnchor {w index} { scan $a "%d.%d" lineA chA scan $b "%d.%d" lineB chB scan $c "%d.%d" lineC chC - if {$lineB < $lineC+2} { + if {$lineB < ($lineC + 2)} { set total [string length [$w get $b $c]] if {$total <= 2} { return } - if {[string length [$w get $b $a]] < ($total/2)} { + if {[string length [$w get $b $a]] < ($total / 2)} { $w mark set $anchorname sel.last } else { $w mark set $anchorname sel.first } return } - if {($lineA-$lineB) < ($lineC-$lineA)} { + if {($lineA - $lineB) < ($lineC - $lineA)} { $w mark set $anchorname sel.last } else { $w mark set $anchorname sel.first @@ -835,7 +837,7 @@ proc ::tk::TextCursorInSelection {w} { # s - The string to insert (usually just a single character) proc ::tk::TextInsert {w s} { - if {$s eq "" || [$w cget -state] eq "disabled"} { + if {($s eq "") || ([$w cget -state] eq "disabled")} { return } set compound 0 @@ -896,16 +898,16 @@ proc ::tk::TextUpDownLine {w n} { # w - The text window in which the cursor is to move. # pos - Position at which to start search. -proc ::tk::TextPrevPara {w pos} { - set pos [$w index "$pos linestart"] +proc ::tk::TextPrevPara {w a_pos} { + set pos [$w index "$a_pos linestart"] while {1} { - if {([$w get "$pos - 1 line"] eq "\n" && ([$w get $pos] ne "\n")) \ - || $pos eq "1.0"} { + if {(([$w get "$pos - 1 line"] eq "\n") && ([$w get $pos] ne "\n")) || + ($pos eq "1.0")} { if {[regexp -indices -- {^[ \t]+(.)} \ - [$w get $pos "$pos lineend"] -> index]} { + [$w get $pos "$pos lineend"] ___ index]} { set pos [$w index "$pos + [lindex $index 0] chars"] } - if {[$w compare $pos != insert] || [lindex [split $pos .] 0]==1} { + if {[$w compare $pos != insert] || ([lindex [split $pos .] 0] == 1)} { return $pos } } @@ -937,7 +939,7 @@ proc ::tk::TextNextPara {w start} { } } if {[regexp -indices -- {^[ \t]+(.)} \ - [$w get $pos "$pos lineend"] -> index]} { + [$w get $pos "$pos lineend"] ___ index]} { return [$w index "$pos + [lindex $index 0] chars"] } return $pos @@ -959,7 +961,7 @@ proc ::tk::TextScrollPages {w count} { set bbox [$w bbox insert] $w yview scroll $count pages if {$bbox eq ""} { - return [$w index @[expr {[winfo height $w]/2}],0] + return [$w index @[expr {[winfo height $w] / 2}],0] } return [$w index @[lindex $bbox 0],[lindex $bbox 1]] } @@ -974,7 +976,7 @@ proc ::tk::TextScrollPages {w count} { # Arguments: # w - Text window in which to transpose. -proc ::tk::TextTranspose w { +proc ::tk::TextTranspose {w} { set pos insert if {[$w compare $pos != "$pos lineend"]} { set pos [$w index "$pos + 1 char"] @@ -1005,7 +1007,7 @@ proc ::tk::TextTranspose w { # Arguments: # w - Name of a text widget. -proc ::tk_textCopy w { +proc ::tk_textCopy {w} { if {![catch {set data [$w get sel.first sel.last]}]} { clipboard clear -displayof $w clipboard append -displayof $w $data @@ -1020,7 +1022,7 @@ proc ::tk_textCopy w { # Arguments: # w - Name of a text widget. -proc ::tk_textCut w { +proc ::tk_textCut {w} { if {![catch {set data [$w get sel.first sel.last]}]} { clipboard clear -displayof $w clipboard append -displayof $w $data @@ -1035,7 +1037,7 @@ proc ::tk_textCut w { # Arguments: # w - Name of a text widget. -proc ::tk_textPaste w { +proc ::tk_textPaste {w} { global tcl_platform if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} { set oldSeparator [$w cget -autoseparators] diff --git a/library/tk.tcl b/library/tk.tcl index 282a9c7..95fb982 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -30,7 +30,7 @@ namespace eval ::tk { set max 0 foreach string $args { set len [string length $string] - if {$len>$max} { + if {$len > $max} { set max $len } } @@ -56,9 +56,10 @@ namespace eval ::ttk { # Add Ttk & 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] && ($::tk_library ne "") - && ($::tk_library ni $::auto_path) -} then { +if {[info exists ::auto_path] && + ($::tk_library ne "") && + ($::tk_library ni $::auto_path) +} { lappend ::auto_path $::tk_library $::ttk::library } @@ -87,40 +88,40 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { update idletasks set checkBounds 1 if {$place eq ""} { - set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}] - set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}] + 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 -length [string length $place] $place "pointer"]} { ## place at POINTER (centered if $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}] + 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 -length [string length $place] $place "widget"] && \ - [winfo exists $anchor] && [winfo ismapped $anchor]} { + } elseif {[string equal -length [string length $place] $place "widget"] && + [winfo exists $anchor] && [winfo ismapped $anchor]} { ## center about WIDGET $anchor, widget must be mapped set x [expr {[winfo rootx $anchor] + \ - ([winfo width $anchor]-[winfo reqwidth $w])/2}] + (([winfo width $anchor] - [winfo reqwidth $w]) / 2)}] set y [expr {[winfo rooty $anchor] + \ - ([winfo height $anchor]-[winfo reqheight $w])/2}] + (([winfo height $anchor] - [winfo reqheight $w]) / 2)}] } else { - set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}] - set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}] + set x [expr {([winfo screenwidth $w] - [winfo reqwidth $w]) / 2}] + set y [expr {([winfo screenheight $w] - [winfo reqheight $w]) / 2}] set checkBounds 0 } if {$checkBounds} { if {$x < [winfo vrootx $w]} { set x [winfo vrootx $w] - } elseif {$x > ([winfo vrootx $w]+[winfo vrootwidth $w]-[winfo reqwidth $w])} { - set x [expr {[winfo vrootx $w]+[winfo vrootwidth $w]-[winfo reqwidth $w]}] + } elseif {$x > (([winfo vrootx $w] + [winfo vrootwidth $w]) - [winfo reqwidth $w])} { + set x [expr {([winfo vrootx $w] + [winfo vrootwidth $w]) - [winfo reqwidth $w]}] } if {$y < [winfo vrooty $w]} { set y [winfo vrooty $w] - } elseif {$y > ([winfo vrooty $w]+[winfo vrootheight $w]-[winfo reqheight $w])} { - set y [expr {[winfo vrooty $w]+[winfo vrootheight $w]-[winfo reqheight $w]}] + } elseif {$y > (([winfo vrooty $w] + [winfo vrootheight $w]) - [winfo reqheight $w])} { + set y [expr {([winfo vrooty $w] + [winfo vrootheight $w]) - [winfo reqheight $w]}] } if {[tk windowingsystem] eq "aqua"} { # Avoid the native menu bar which sits on top of everything. @@ -142,9 +143,9 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { # Results: # Returns nothing # -proc ::tk::SetFocusGrab {grab {focus {}}} { +proc ::tk::SetFocusGrab {grab {focus ""}} { set index "$grab,$focus" - upvar ::tk::FocusGrab($index) data + upvar 1 ::tk::FocusGrab($index) data lappend data [focus] set oldGrab [grab current $grab] @@ -172,7 +173,7 @@ proc ::tk::SetFocusGrab {grab {focus {}}} { proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { set index "$grab,$focus" if {[info exists ::tk::FocusGrab($index)]} { - foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break } + lassign $::tk::FocusGrab($index) oldFocus oldGrab oldStatus unset ::tk::FocusGrab($index) } else { set oldGrab "" @@ -212,7 +213,7 @@ if {[tk windowingsystem] ne "win32"} { selection get -displayof $w -selection $sel -type UTF8_STRING } txt] && [catch { selection get -displayof $w -selection $sel - } txt]} then { + } txt]} { return -code error -errorcode {TK SELECTION NONE} \ "could not find default selection" } else { @@ -223,7 +224,7 @@ if {[tk windowingsystem] ne "win32"} { proc ::tk::GetSelection {w {sel PRIMARY}} { if {[catch { selection get -displayof $w -selection $sel - } txt]} then { + } txt]} { return -code error -errorcode {TK SELECTION NONE} \ "could not find default selection" } else { @@ -242,7 +243,7 @@ if {[tk windowingsystem] ne "win32"} { # Arguments: # screen - The name of the new screen. -proc ::tk::ScreenChanged screen { +proc ::tk::ScreenChanged {screen} { # Extract the display name. set disp [string range $screen 0 [string last . $screen]-1] @@ -283,7 +284,7 @@ proc ::tk::ScreenChanged screen { } set Priv(screen) $screen set Priv(tearoff) [string equal [tk windowingsystem] "x11"] - set Priv(window) {} + set Priv(window) "" } # Do initial setup for Priv, so that it is always bound to something @@ -301,7 +302,7 @@ tk::ScreenChanged [winfo screen .] # n1 - the name of the variable being changed ("::tk_strictMotif"). proc ::tk::EventMotifBindings {n1 dummy dummy} { - upvar $n1 name + upvar 1 $n1 name if {$name} { set op delete @@ -367,7 +368,7 @@ switch -exact -- [tk windowingsystem] { event add <<Undo>> <Control-Key-z> <Control-Lock-Key-Z> event add <<Redo>> <Control-Key-Z> <Control-Lock-Key-z> event add <<ContextMenu>> <Button-3> - if {[info exists tcl_platform(os)] && $tcl_platform(os) eq "Darwin"} { + if {[info exists tcl_platform(os)] && ($tcl_platform(os) eq "Darwin")} { event add <<ContextMenu>> <Button-2> } @@ -482,6 +483,7 @@ switch -exact -- [tk windowingsystem] { event add <<SelectPrevPara>> <Shift-Option-Down> event add <<ToggleSelection>> <Command-ButtonPress-1> } + default {} } # ---------------------------------------------------------------------- @@ -527,7 +529,7 @@ bind all <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]} proc ::tk::CancelRepeat {} { variable ::tk::Priv after cancel $Priv(afterId) - set Priv(afterId) {} + set Priv(afterId) "" } # ::tk::TabToWindow -- @@ -557,7 +559,7 @@ proc ::tk::TabToWindow {w} { proc ::tk::UnderlineAmpersand {text} { set s [string map {&& & & \ufeff} $text] set idx [string first \ufeff $s] - return [list [string map {\ufeff {}} $s] $idx] + return [list [string map {\ufeff ""} $s] $idx] } # ::tk::SetAmpText -- @@ -574,7 +576,7 @@ proc ::tk::SetAmpText {widget text} { # options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpWidget {class path args} { - set options {} + set options [list] foreach {opt val} $args { if {$opt eq "-text"} { lassign [UnderlineAmpersand $val] newtext under @@ -595,7 +597,7 @@ proc ::tk::AmpWidget {class path args} { # -label and -underline options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpMenuArgs {widget add type args} { - set options {} + set options [list] foreach {opt val} $args { if {$opt eq "-label"} { lassign [UnderlineAmpersand $val] newlabel under @@ -613,11 +615,8 @@ proc ::tk::AmpMenuArgs {widget add type args} { # proc ::tk::FindAltKeyTarget {path char} { set class [winfo class $path] - if {$class in { - Button Checkbutton Label Radiobutton - TButton TCheckbutton TLabel TRadiobutton - } && [string equal -nocase $char \ - [string index [$path cget -text] [$path cget -underline]]]} { + if {($class in "Button Checkbutton Label Radiobutton TButton TCheckbutton TLabel TRadiobutton") && + [string equal -nocase $char [string index [$path cget -text] [$path cget -underline]]]} { return $path } set subwins [concat [grid slaves $path] [pack slaves $path] \ diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index 6604575..272bcb0 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -24,7 +24,7 @@ namespace eval ::tk::dialog::file { # Create the images if they did not already exist. if {![info exists ::tk::Priv(updirImage)]} { - set ::tk::Priv(updirImage) [image create photo -data { + set ::tk::Priv(updirImage) [image create photo -data " iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/gD+AP7rGN SCAAAACXBIWXMAAA3WAAAN1gGQb3mcAAAACXZwQWcAAAAWAAAAFgDcxelYAAAENUlE QVQ4y7WUbWiVZRjHf/f9POcc9+Kc5bC2aIq5sGG0XnTzNU13zAIlFMNc9CEhTCKwCC @@ -52,10 +52,10 @@ namespace eval ::tk::dialog::file { WHRjcmVhdGUtZGF0ZQAyMDA5LTA0LTA2VDIxOjI1OjQxLTAzOjAw8s+uCAAAACV0RV h0bW9kaWZ5LWRhdGUAMjAwOC0wMS0wM1QxNTowODoyMS0wMjowMJEc/44AAAAZdEVY dFNvZnR3YXJlAHd3dy5pbmtzY2FwZS5vcmeb7jwaAAAAAElFTkSuQmCC - }] + "] } if {![info exists ::tk::Priv(folderImage)]} { - set ::tk::Priv(folderImage) [image create photo -data { + set ::tk::Priv(folderImage) [image create photo -data " iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiA AAAAlwSFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBl Lm9yZ5vuPBoAAAHCSURBVDiNpZAxa5NRFIafc+9XLCni4BC6FBycMnbrLpkcgtDVX6 @@ -68,10 +68,10 @@ namespace eval ::tk::dialog::file { K5uGPmmDtZF3VpoUm2ArhqQaRiUjcMf81p1G60UEVhcjZfAFTVUkrgkS+jc06mDX9n vq4YhJ9nlxZExMwMEaHJRutOdWuIIsJFUoBSuTvHJ4YIfP46unV4qdlsjsBRZRtb/X fHd5+C8+P7+J8BIoxFwovfRxYhnhxjpzEAAAAASUVORK5CYII= - }] + "] } if {![info exists ::tk::Priv(fileImage)]} { - set ::tk::Priv(fileImage) [image create photo -data { + set ::tk::Priv(fileImage) [image create photo -data " iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gva eTAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QQWFA84umAmQgAAANpJREFU OMutkj1uhDAQhb8HSLtbISGfgZ+zbJkix0HmFhwhUdocBnMBGvqtTIqIFSReWKK8ai @@ -79,7 +79,7 @@ namespace eval ::tk::dialog::file { A+89zrlVwlKSqKrqVy/J8lAUxSZBSMny4ZLgp54iyPM8UPHGNJ2IomibAKDv+9VlWZ bABbgB5/0WQgSSkC4PF2JF4JzbHN430c4vhAm0TyCJruuClefph4yCBCGT3T3Isoy/ KDHGfDZNcz2SZIx547/0BVRRX7n8uT/sAAAAAElFTkSuQmCC - }] + "] } } @@ -94,13 +94,13 @@ namespace eval ::tk::dialog::file { # args Options parsed by the procedure. # -proc ::tk::dialog::file:: {type args} { +proc ::tk::dialog::file:: {a_type args} { variable ::tk::Priv variable showHiddenBtn set dataName __tk_filedialog - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data - Config $dataName $type $args + Config $dataName $a_type $args if {$data(-parent) eq "."} { set w .$dataName @@ -177,8 +177,7 @@ proc ::tk::dialog::file:: {type args} { } } foreach type $data(-filetypes) { - set title [lindex $type 0] - set filter [lindex $type 1] + lassign $type title filter $data(typeMenu) add command -label $title \ -command [list ::tk::dialog::file::SetFilter $w $type] # [string first] avoids glob-pattern char issues @@ -226,7 +225,7 @@ proc ::tk::dialog::file:: {type args} { foreach trace [trace info variable data(selectPath)] { trace remove variable data(selectPath) {*}$trace } - $data(dirMenuBtn) configure -textvariable {} + $data(dirMenuBtn) configure -textvariable "" return $Priv(selectFilePath) } @@ -236,7 +235,7 @@ proc ::tk::dialog::file:: {type args} { # Configures the TK filedialog according to the argument list # proc ::tk::dialog::file::Config {dataName type argList} { - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data set data(type) $type @@ -330,7 +329,7 @@ proc ::tk::dialog::file::Config {dataName type argList} { proc ::tk::dialog::file::Create {w class} { set dataName [lindex [split $w .] end] - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data variable ::tk::Priv global tk_library @@ -431,10 +430,10 @@ proc ::tk::dialog::file::Create {w class} { # once will do). [Bug 987169] set data(okBtn) [::tk::AmpWidget ttk::button $f2.ok \ - -text [mc "&OK"] -default active];# -pady 3] + -text [mc "&OK"] -default active];# -pady 3 bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w] set data(cancelBtn) [::tk::AmpWidget ttk::button $f2.cancel \ - -text [mc "&Cancel"] -default normal];# -pady 3] + -text [mc "&Cancel"] -default normal];# -pady 3 # grid the widgets in f2 # @@ -507,7 +506,7 @@ proc ::tk::dialog::file::Create {w class} { proc ::tk::dialog::file::SetSelectMode {w multi} { set dataName __tk_filedialog - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data if { $multi } { set fNameCaption [mc "File &names:"] } else { @@ -527,7 +526,7 @@ proc ::tk::dialog::file::SetSelectMode {w multi} { # multiple concurrent events. # proc ::tk::dialog::file::UpdateWhenIdle {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data if {[info exists data(updateId)]} { return @@ -552,7 +551,7 @@ proc ::tk::dialog::file::Update {w} { } set dataName [winfo name $w] - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data variable ::tk::Priv variable showHiddenVar global tk_library @@ -564,7 +563,7 @@ proc ::tk::dialog::file::Update {w} { set appPWD [pwd] if {[catch { cd $data(selectPath) - }]} then { + }]} { # We cannot change directory to $data(selectPath). $data(selectPath) # should have been checked before ::tk::dialog::file::Update is # called, so we normally won't come to here. Anyways, give an error @@ -640,7 +639,7 @@ proc ::tk::dialog::file::Update {w} { # Sets data(selectPath) without invoking the trace procedure # proc ::tk::dialog::file::SetPathSilently {w path} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set cb [list ::tk::dialog::file::SetPath $w] trace remove variable data(selectPath) write $cb @@ -653,7 +652,7 @@ proc ::tk::dialog::file::SetPathSilently {w path} { # proc ::tk::dialog::file::SetPath {w name1 name2 op} { if {[winfo exists $w]} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data UpdateWhenIdle $w # On directory dialogs, we keep the entry in sync with the currentdir. if {[winfo class $w] eq "TkChooseDir"} { @@ -666,7 +665,7 @@ proc ::tk::dialog::file::SetPath {w name1 name2 op} { # This proc gets called whenever data(filter) is set # proc ::tk::dialog::file::SetFilter {w type} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set data(filterType) $type set data(filter) [lindex $type 1] @@ -734,17 +733,19 @@ proc ::tk::dialog::file::SetFilter {w type} { # subdirectory name # proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { - set appPWD [pwd] + global env + set appPWD [pwd] set path [JoinFile $context $text] # If the file has no extension, append the default. Be careful not to do # this for directories, otherwise typing a dirname in the box will give # back "dirname.extension" instead of trying to change dir. if { - ![file isdirectory $path] && ([file ext $path] eq "") && - ![string match {$*} [file tail $path]] - } then { + (![file isdirectory $path]) && + ([file ext $path] eq "") && + (![string match {$*} [file tail $path]]) + } { set path "$path$defaultext" } @@ -787,8 +788,8 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { # It's nothing else, so check to see if it is an env-reference if {$expandEnv && [string match {$*} $file]} { set var [string range $file 1 end] - if {[info exist ::env($var)]} { - return [ResolveFile $context $::env($var) $defaultext 0] + if {[info exist env($var)]} { + return [ResolveFile $context $env($var) $defaultext 0] } } if {[regexp {[*?]} $file]} { @@ -803,8 +804,8 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { # It's nothing else, so check to see if it is an env-reference if {$expandEnv && [string match {$*} $file]} { set var [string range $file 1 end] - if {[info exist ::env($var)]} { - return [ResolveFile $context $::env($var) $defaultext 0] + if {[info exist env($var)]} { + return [ResolveFile $context $env($var) $defaultext 0] } } } @@ -819,7 +820,7 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { # entry box is the selection. # proc ::tk::dialog::file::EntFocusIn {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data if {[$data(ent) get] ne ""} { $data(ent) selection range 0 end @@ -839,7 +840,7 @@ proc ::tk::dialog::file::EntFocusIn {w} { } proc ::tk::dialog::file::EntFocusOut {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data $data(ent) selection clear } @@ -848,7 +849,7 @@ proc ::tk::dialog::file::EntFocusOut {w} { # Gets called when user presses Return in the "File name" entry. # proc ::tk::dialog::file::ActivateEnt {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set text [$data(ent) get] if {$data(-multiple)} { @@ -863,7 +864,7 @@ proc ::tk::dialog::file::ActivateEnt {w} { # Verification procedure # proc ::tk::dialog::file::VerifyFileName {w filename} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set list [ResolveFile $data(selectPath) $filename $data(-defaultextension)] foreach {flag path file} $list { @@ -926,13 +927,14 @@ proc ::tk::dialog::file::VerifyFileName {w filename} { $data(ent) selection range 0 end $data(ent) icursor end } + default {} } } # Gets called when user presses the Alt-s or Alt-o keys. # proc ::tk::dialog::file::InvokeBtn {w key} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data if {[$data(okBtn) cget -text] eq $key} { $data(okBtn) invoke @@ -942,7 +944,7 @@ proc ::tk::dialog::file::InvokeBtn {w key} { # Gets called when user presses the "parent directory" button # proc ::tk::dialog::file::UpDirCmd {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data if {$data(selectPath) ne "/"} { set data(selectPath) [file dirname $data(selectPath)] @@ -953,7 +955,7 @@ proc ::tk::dialog::file::UpDirCmd {w} { # filename begins with ~ # proc ::tk::dialog::file::JoinFile {path file} { - if {[string match {~*} $file] && [file exists $path/$file]} { + if {[string match "~*" $file] && [file exists [file join $path $file]]} { return [file join $path ./$file] } else { return [file join $path $file] @@ -963,17 +965,17 @@ proc ::tk::dialog::file::JoinFile {path file} { # Gets called when user presses the "OK" button # proc ::tk::dialog::file::OkCmd {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data - set filenames {} + set filenames [list] foreach item [$data(icons) selection get] { lappend filenames [$data(icons) get $item] } if { - ([llength $filenames] && !$data(-multiple)) || + ([llength $filenames] && (!$data(-multiple))) || ($data(-multiple) && ([llength $filenames] == 1)) - } then { + } { set filename [lindex $filenames 0] set file [JoinFile $data(selectPath) $filename] if {[file isdirectory $file]} { @@ -988,7 +990,7 @@ proc ::tk::dialog::file::OkCmd {w} { # Gets called when user presses the "Cancel" button # proc ::tk::dialog::file::CancelCmd {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data variable ::tk::Priv bind $data(okBtn) <Destroy> {} @@ -998,7 +1000,7 @@ proc ::tk::dialog::file::CancelCmd {w} { # Gets called when user destroys the dialog directly [Bug 987169] # proc ::tk::dialog::file::Destroyed {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data variable ::tk::Priv set Priv(selectFilePath) "" @@ -1008,17 +1010,17 @@ proc ::tk::dialog::file::Destroyed {w} { # keys, etc) # proc ::tk::dialog::file::ListBrowse {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data - set text {} + set text [list] foreach item [$data(icons) selection get] { lappend text [$data(icons) get $item] } - if {[llength $text] == 0} { + if {![llength $text]} { return } if {$data(-multiple)} { - set newtext {} + set newtext [list] foreach file $text { set fullfile [JoinFile $data(selectPath) $file] if { ![file isdirectory $fullfile] } { @@ -1052,16 +1054,16 @@ proc ::tk::dialog::file::ListBrowse {w} { # etc) # proc ::tk::dialog::file::ListInvoke {w filenames} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data - if {[llength $filenames] == 0} { + if {![llength $filenames]} { return } set file [JoinFile $data(selectPath) [lindex $filenames 0]] set class [winfo class $w] - if {$class eq "TkChooseDir" || [file isdirectory $file]} { + if {($class eq "TkChooseDir") || [file isdirectory $file]} { set appPWD [pwd] if {[catch {cd $file}]} { tk_messageBox -type ok -parent $w -icon warning -message \ @@ -1089,12 +1091,12 @@ proc ::tk::dialog::file::ListInvoke {w filenames} { # that calls tk_getOpenFile or tk_getSaveFile # proc ::tk::dialog::file::Done {w {selectFilePath ""}} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data variable ::tk::Priv if {$selectFilePath eq ""} { if {$data(-multiple)} { - set selectFilePath {} + set selectFilePath "" foreach f $data(selectFile) { lappend selectFilePath [JoinFile $data(selectPath) $f] } @@ -1114,10 +1116,13 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { } } if { - [info exists data(-typevariable)] && $data(-typevariable) ne "" - && [info exists data(-filetypes)] && [llength $data(-filetypes)] - && [info exists data(filterType)] && $data(filterType) ne "" - } then { + [info exists data(-typevariable)] && + ($data(-typevariable) ne "") && + [info exists data(-filetypes)] && + [llength $data(-filetypes)] && + [info exists data(filterType)] && + ($data(filterType) ne "") + } { upvar #0 $data(-typevariable) typeVariable set typeVariable [lindex $data(filterType) 0] } @@ -1145,7 +1150,7 @@ proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} { variable showHiddenVar upvar 1 data(filter) filter - if {$filter eq "*" || $overrideFilter} { + if {($filter eq "*") || $overrideFilter} { set patterns [list *] if {$showHiddenVar} { lappend patterns .* @@ -1159,14 +1164,14 @@ proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} { set opts [list -tails -directory $dir -type $type -nocomplain] - set result {} + set result [list] catch { # We have a catch because we might have a really bad pattern (e.g., # with an unbalanced brace); even [glob -nocomplain] doesn't like it. # Using a catch ensures that it just means we match nothing instead of # throwing a nasty error at the user... foreach f [glob {*}$opts -- {*}$patterns] { - if {$f eq "." || $f eq ".."} { + if {$f in ". .."} { continue } lappend result $f @@ -1177,10 +1182,10 @@ proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} { proc ::tk::dialog::file::CompleteEnt {w} { variable showHiddenVar - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set f [$data(ent) get] if {$data(-multiple)} { - if {![string is list $f] || [llength $f] != 1} { + if {(![string is list $f]) || ([llength $f] != 1)} { return -code break } set f [lindex $f 0] @@ -1190,7 +1195,7 @@ proc ::tk::dialog::file::CompleteEnt {w} { set files [if {[winfo class $w] eq "TkFDialog"} { GlobFiltered $data(selectPath) {f b c l p s} }] - set dirs2 {} + set dirs2 [list] foreach d [GlobFiltered $data(selectPath) d] {lappend dirs2 $d/} set targets [concat \ @@ -1200,7 +1205,7 @@ proc ::tk::dialog::file::CompleteEnt {w} { if {[llength $targets] == 1} { # We have a winner! set f [lindex $targets 0] - } elseif {$f in $targets || [llength $targets] == 0} { + } elseif {($f in $targets) || (![llength $targets])} { if {[string length $f] > 0} { bell } @@ -1211,7 +1216,7 @@ proc ::tk::dialog::file::CompleteEnt {w} { return } set t0 [lindex $targets 0] - for {set len [string length $t0]} {$len>0} {} { + for {set len [string length $t0]} {$len > 0} {} { set allmatch 1 foreach s $targets { if {![string equal -length $len $s $t0]} { diff --git a/library/ttk/button.tcl b/library/ttk/button.tcl index 9f2cec7..199d0fa 100644 --- a/library/ttk/button.tcl +++ b/library/ttk/button.tcl @@ -52,7 +52,8 @@ bind TRadiobutton <KeyPress-Down> { ttk::button::RadioTraverse %W +1 } proc ttk::button::activate {w} { $w instate disabled { return } set oldState [$w state pressed] - update idletasks; after 100 ;# block event loop to avoid reentrancy + update idletasks + after 100 ;# block event loop to avoid reentrancy $w state $oldState $w invoke } @@ -66,9 +67,9 @@ proc ttk::button::activate {w} { proc ttk::button::RadioTraverse {w dir} { set group [list] foreach sibling [winfo children [winfo parent $w]] { - if { [winfo class $sibling] eq "TRadiobutton" - && [$sibling cget -variable] eq [$w cget -variable] - && ![$sibling instate disabled] + if { ([winfo class $sibling] eq "TRadiobutton") && + ([$sibling cget -variable] eq [$w cget -variable]) && + (![$sibling instate disabled]) } { lappend group $sibling } diff --git a/library/ttk/classicTheme.tcl b/library/ttk/classicTheme.tcl index 7e3eff5..01c577e 100644 --- a/library/ttk/classicTheme.tcl +++ b/library/ttk/classicTheme.tcl @@ -6,7 +6,8 @@ namespace eval ttk::theme::classic { - variable colors; array set colors { + variable colors + array set colors { -frame "#d9d9d9" -window "#ffffff" -activebg "#ececec" diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index 03821a2..6c90ac8 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -76,6 +76,7 @@ switch -- [tk windowingsystem] { # NB: *only* do this on Windows (see #1814778) bind ComboboxListbox <FocusOut> { ttk::combobox::LBCancel %W } } + default {} } ### Combobox popdown window bindings. @@ -101,6 +102,7 @@ switch -- [tk windowingsystem] { aqua { option add *TCombobox*Listbox.borderWidth 0 } + default {} } ### Binding procedures. @@ -149,8 +151,8 @@ proc ttk::combobox::Drag {w x} { # Set cursor. # proc ttk::combobox::Motion {w x y} { - if { [$w identify $x $y] eq "textarea" - && [$w instate {!readonly !disabled}] + if { ([$w identify $x $y] eq "textarea") && + [$w instate {!readonly !disabled}] } { ttk::setCursor $w text } else { @@ -185,7 +187,7 @@ proc ttk::combobox::Scroll {cb dir} { set max [llength [$cb cget -values]] set current [$cb current] incr current $dir - if {$max != 0 && $current == $current % $max} { + if {($max != 0) && ($current == ($current % $max))} { SelectEntry $cb $current } } @@ -216,6 +218,7 @@ proc ttk::combobox::LBTab {lb dir} { switch -- $dir { next { set newFocus [tk_focusNext $cb] } prev { set newFocus [tk_focusPrev $cb] } + default {} } if {$newFocus ne ""} { @@ -307,12 +310,6 @@ proc ttk::combobox::PopdownToplevel {w} { toplevel $w -class ComboboxPopdown wm withdraw $w switch -- [tk windowingsystem] { - default - - x11 { - $w configure -relief flat -borderwidth 0 - wm attributes $w -type combo - wm overrideredirect $w true - } win32 { $w configure -relief flat -borderwidth 0 wm overrideredirect $w true @@ -324,6 +321,11 @@ proc ttk::combobox::PopdownToplevel {w} { help {noActivates hideOnSuspend} wm resizable $w 0 0 } + default { + $w configure -relief flat -borderwidth 0 + wm attributes $w -type combo + wm overrideredirect $w true + } } return $w } @@ -370,11 +372,11 @@ proc ttk::combobox::PlacePopdown {cb popdown} { set h [winfo height $cb] set postoffset [ttk::style lookup TCombobox -postoffset {} {0 0 0 0}] foreach var {x y w h} delta $postoffset { - incr $var $delta + incr [set var] $delta } set H [winfo reqheight $popdown] - if {$y + $h + $H > [winfo screenheight $popdown]} { + if {($y + $h + $H) > [winfo screenheight $popdown]} { set Y [expr {$y - $H}] } else { set Y [expr {$y + $h}] @@ -403,6 +405,7 @@ proc ttk::combobox::Post {cb} { # See <<NOTE-WM-TRANSIENT>> switch -- [tk windowingsystem] { x11 - win32 { wm transient $popdown [winfo toplevel $cb] } + default {} } # Post the listbox: diff --git a/library/ttk/cursors.tcl b/library/ttk/cursors.tcl index 75f7791..be6aa1b 100644 --- a/library/ttk/cursors.tcl +++ b/library/ttk/cursors.tcl @@ -70,7 +70,7 @@ namespace eval ttk { # Platform-specific overrides for Windows and OSX. # - switch [tk windowingsystem] { + switch -- [tk windowingsystem] { "win32" { array set Cursors { none {} @@ -118,6 +118,7 @@ namespace eval ttk { } } } + default {} } } @@ -176,7 +177,7 @@ proc ttk::CursorSampler {f} { return $f } -if {[info exists argv0] && $argv0 eq [info script]} { +if {[info exists argv0] && ($argv0 eq [info script])} { wm title . "[array size ::ttk::Cursors] cursors" pack [ttk::CursorSampler .f] -expand true -fill both bind . <KeyPress-Escape> [list destroy .] diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index f5ba19e..783cda1 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -192,7 +192,8 @@ proc ttk::entry::Clear {w} { ## Cut -- Copy selection to clipboard then delete it. # proc ttk::entry::Cut {w} { - Copy $w; Clear $w + Copy $w + Clear $w } ### Navigation procedures. @@ -204,7 +205,7 @@ proc ttk::entry::Cut {w} { proc ttk::entry::ClosestGap {w x} { set pos [$w index @$x] set bbox [$w bbox $pos] - if {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} { + if {($x - [lindex $bbox 0]) > ([lindex $bbox 2] / 2)} { incr pos } return $pos @@ -216,7 +217,7 @@ proc ttk::entry::See {w {index insert}} { update idletasks ;# ensure scroll data up-to-date set c [$w index $index] # @@@ OR: check [$w index left] / [$w index right] - if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} { + if {($c < [$w index @0]) || ($c >= [$w index @[winfo width $w]])} { $w xview $c } } @@ -232,7 +233,7 @@ set ::ttk::entry::State(startNext) \ proc ttk::entry::NextWord {w start} { variable State set pos [tcl_endOfWord [$w get] [$w index $start]] - if {$pos >= 0 && $State(startNext)} { + if {($pos >= 0) && $State(startNext)} { set pos [tcl_startOfNextWord [$w get] $pos] } if {$pos < 0} { @@ -291,8 +292,8 @@ proc ttk::entry::Move {w where} { # # Returns: selection anchor. # -proc ttk::entry::ExtendTo {w index} { - set index [$w index $index] +proc ttk::entry::ExtendTo {w a_index} { + set index [$w index $a_index] set insert [$w index insert] # Figure out selection anchor: @@ -302,8 +303,8 @@ proc ttk::entry::ExtendTo {w index} { set selfirst [$w index sel.first] set sellast [$w index sel.last] - if { ($index < $selfirst) - || ($insert == $selfirst && $index <= $sellast) + if { ($index < $selfirst) || + (($insert == $selfirst) && ($index <= $sellast)) } { set anchor $sellast } else { @@ -377,7 +378,10 @@ proc ttk::entry::Select {w x mode} { switch -- $mode { word { WordSelect $w $cur $cur } line { LineSelect $w $cur $cur } - char { # no-op } + char { + # no-op + } + default {} } set State(anchor) $cur @@ -398,10 +402,11 @@ proc ttk::entry::DragTo {w x} { variable State set cur [ClosestGap $w $x] - switch $State(selectMode) { + switch -- $State(selectMode) { char { CharSelect $w $State(anchor) $cur } word { WordSelect $w $State(anchor) $cur } line { LineSelect $w $State(anchor) $cur } + default {} } } @@ -491,10 +496,10 @@ proc ttk::entry::ScanDrag {w x} { variable State set dx [expr {$State(scanX) - $x}] - if {abs($dx) > $State(deadband)} { + if { ( abs ($dx) ) > $State(deadband)} { set State(scanMoved) 1 } - set left [expr {$State(scanIndex) + ($dx*$State(scanNum))/$State(scanDen)}] + set left [expr {$State(scanIndex) + (($dx * $State(scanNum)) / $State(scanDen))}] $w xview $left if {$left != [set newLeft [$w index @0]]} { @@ -564,10 +569,8 @@ proc ttk::entry::Backspace {w} { $w delete $x if {[$w index @0] >= [$w index insert]} { - set range [$w xview] - set left [lindex $range 0] - set right [lindex $range 1] - $w xview moveto [expr {$left - ($right - $left)/2.0}] + lassign [$w xview] left right + $w xview moveto [expr {$left - (($right - $left) / 2.0)}] } } diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl index 52298c5..44de6c3 100644 --- a/library/ttk/fonts.tcl +++ b/library/ttk/fonts.tcl @@ -82,7 +82,7 @@ switch -- [tk windowingsystem] { set F(family) "MS Sans Serif" } } else { - if {[lsearch -exact [font families] Tahoma] != -1} { + if {"Tahoma" in [font families]} { set F(family) "Tahoma" } else { set F(family) "MS Sans Serif" @@ -122,9 +122,8 @@ switch -- [tk windowingsystem] { font configure TkMenuFont -family $F(family) -size $F(menusize) font configure TkSmallCaptionFont -family $F(family) -size $F(labelsize) } - default - - x11 { - if {![catch {tk::pkgconfig get fontsystem} F(fs)] && $F(fs) eq "xft"} { + default { + if {(![catch {tk::pkgconfig get fontsystem} F(fs)]) && ($F(fs) eq "xft")} { set F(family) "sans-serif" set F(fixed) "monospace" } else { diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl index 093bb02..16af971 100644 --- a/library/ttk/menubutton.tcl +++ b/library/ttk/menubutton.tcl @@ -81,10 +81,10 @@ proc ttk::menubutton::PostPosition {mb menu} { set sh [expr {[winfo screenheight $menu] - $bh - $mh}] switch -- $dir { - above { if {$y >= $mh} { incr y -$mh } { incr y $bh } } - below { if {$y <= $sh} { incr y $bh } { incr y -$mh } } - left { if {$x >= $mw} { incr x -$mw } { incr x $bw } } - right { if {$x <= $sw} { incr x $bw } { incr x -$mw } } + above { if {$y >= $mh} { incr y -$mh } else { incr y $bh } } + below { if {$y <= $sh} { incr y $bh } else { incr y -$mh } } + left { if {$x >= $mw} { incr x -$mw } else { incr x $bw } } + right { if {$x <= $sw} { incr x $bw } else { incr x -$mw } } flush { # post menu atop menubutton. # If there's a menu entry whose label matches the @@ -95,6 +95,7 @@ proc ttk::menubutton::PostPosition {mb menu} { incr y -[$menu yposition $index] } } + default {} } return [list $x $y] @@ -104,10 +105,10 @@ proc ttk::menubutton::PostPosition {mb menu} { # Post the menu and set a grab on the menu. # proc ttk::menubutton::Popdown {mb} { - if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} { + if {[$mb instate disabled] || ([set menu [$mb cget -menu]] eq "")} { return } - foreach {x y} [PostPosition $mb $menu] { break } + lassign [PostPosition $mb $menu] x y tk_popup $menu $x $y } @@ -118,10 +119,10 @@ proc ttk::menubutton::Popdown {mb} { # proc ttk::menubutton::Pulldown {mb} { variable State - if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} { + if {[$mb instate disabled] || ([set menu [$mb cget -menu]] eq "")} { return } - foreach {x y} [PostPosition $mb $menu] { break } + lassign [PostPosition $mb $menu] x y set State(pulldown) 1 set State(oldcursor) [$mb cget -cursor] @@ -158,8 +159,8 @@ proc ttk::menubutton::FindMenuEntry {menu s} { return "" } for {set i 0} {$i <= $last} {incr i} { - if {![catch {$menu entrycget $i -label} label] - && ($label eq $s)} { + if {(![catch {$menu entrycget $i -label} label]) && + ($label eq $s)} { return $i } } diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index 72b85e6..6d2c88e 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -32,7 +32,10 @@ proc ttk::notebook::ActivateTab {w tab} { set newtab [$w select] ;# NOTE: might not be $tab, if $tab is disabled if {[focus] eq $w} { return } - if {$newtab eq $oldtab} { focus $w ; return } + if {$newtab eq $oldtab} { + focus $w + return + } update idletasks ;# needed so focus logic sees correct mapped states if {[set f [ttk::focusFirst $newtab]] ne ""} { @@ -60,7 +63,7 @@ proc ttk::notebook::CycleTab {w dir} { if {[$w index end] != 0} { set current [$w index current] set select [expr {($current + $dir) % [$w index end]}] - while {[$w tab $select -state] != "normal" && ($select != $current)} { + while {([$w tab $select -state] ne "normal") && ($select != $current)} { set select [expr {($select + $dir) % [$w index end]}] } if {$select != $current} { @@ -74,13 +77,13 @@ proc ttk::notebook::CycleTab {w dir} { # specified mnemonic. If found, returns path name of tab; # otherwise returns "" # -proc ttk::notebook::MnemonicTab {nb key} { - set key [string toupper $key] +proc ttk::notebook::MnemonicTab {nb a_key} { + set key [string toupper $a_key] foreach tab [$nb tabs] { set label [$nb tab $tab -text] set underline [$nb tab $tab -underline] set mnemonic [string toupper [string index $label $underline]] - if {$mnemonic ne "" && $mnemonic eq $key} { + if {($mnemonic ne "") && ($mnemonic eq $key)} { return $tab } } @@ -160,8 +163,8 @@ proc ttk::notebook::EnclosingNotebook {w} { set top [winfo toplevel $w] if {![info exists TLNotebooks($top)]} { return } - while {$w ne $top && $w ne ""} { - if {[lsearch -exact $TLNotebooks($top) $w] >= 0} { + while {$w ni "$top {}"} { + if {$w in $TLNotebooks($top)} { return $w } set w [winfo parent $w] diff --git a/library/ttk/panedwindow.tcl b/library/ttk/panedwindow.tcl index a2e073b..67906c6 100644 --- a/library/ttk/panedwindow.tcl +++ b/library/ttk/panedwindow.tcl @@ -48,6 +48,7 @@ proc ttk::panedwindow::Drag {w x y} { switch -- [$w cget -orient] { horizontal { set delta [expr {$x - $State(pressX)}] } vertical { set delta [expr {$y - $State(pressY)}] } + default {} } $w sashpos $State(sash) [expr {$State(sashPos) + $delta}] } @@ -63,7 +64,7 @@ proc ttk::panedwindow::Release {w x y} { proc ttk::panedwindow::ResetCursor {w} { variable State if {!$State(pressed)} { - ttk::setCursor $w {} + ttk::setCursor $w "" } } @@ -74,6 +75,7 @@ proc ttk::panedwindow::SetCursor {w x y} { switch -- [$w cget -orient] { horizontal { set cursor hresize } vertical { set cursor vresize } + default {} } } ttk::setCursor $w $cursor diff --git a/library/ttk/scale.tcl b/library/ttk/scale.tcl index 69b9dd8..0816d9e 100644 --- a/library/ttk/scale.tcl +++ b/library/ttk/scale.tcl @@ -49,6 +49,7 @@ proc ttk::scale::Press {w x y} { set State(dragging) 1 set State(initial) [$w get] } + default {} } } @@ -69,6 +70,7 @@ proc ttk::scale::Jump {w x y} { *slider { Press $w $x $y } + default {} } } diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index 4bd5107..15cd805 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -11,7 +11,7 @@ if {[tk windowingsystem] eq "aqua"} { proc ttk::scrollbar {w args} { set constructor ::tk::scrollbar foreach {option _} $args { - if {$option eq "-class" || $option eq "-style"} { + if {$option in "-class -style"} { set constructor ::ttk::_scrollbar break } @@ -80,6 +80,7 @@ proc ttk::scrollbar::Press {w x y} { set State(first) [lindex [$w get] 0] } } + default {} } } diff --git a/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl index 153e310..7b86640 100644 --- a/library/ttk/sizegrip.tcl +++ b/library/ttk/sizegrip.tcl @@ -14,6 +14,7 @@ switch -- [tk windowingsystem] { aqua { # Aqua sizegrips use default Arrow cursor. } + default {} } namespace eval ttk::sizegrip { @@ -83,14 +84,15 @@ proc ttk::sizegrip::Drag {W X Y} { set w $State(width) set h $State(height) if {$State(resizeX)} { - set w [expr {$w + ($X - $State(pressX))/$State(widthInc)}] + set w [expr {$w + (($X - $State(pressX)) / $State(widthInc))}] } if {$State(resizeY)} { - set h [expr {$h + ($Y - $State(pressY))/$State(heightInc)}] + set h [expr {$h + (($Y - $State(pressY)) / $State(heightInc))}] } if {$w <= 0} { set w 1 } if {$h <= 0} { set h 1 } - set x $State(x) ; set y $State(y) + set x $State(x) + set y $State(y) wm geometry $State(toplevel) ${w}x${h}+${x}+${y} } diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl index 1aa0ccb..20cae97 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -29,8 +29,8 @@ ttk::bindMouseWheel TSpinbox [list ttk::spinbox::MouseWheel %W] # Sets cursor. # proc ttk::spinbox::Motion {w x y} { - if { [$w identify $x $y] eq "textarea" - && [$w instate {!readonly !disabled}] + if { ([$w identify $x $y] eq "textarea") && + [$w instate {!readonly !disabled}] } { ttk::setCursor $w text } else { @@ -50,13 +50,14 @@ proc ttk::spinbox::Press {w x y} { *leftarrow - *downarrow { ttk::Repeatedly event generate $w <<Decrement>> } *spinbutton { - if {$y * 2 >= [winfo height $w]} { + if {($y * 2) >= [winfo height $w]} { set event <<Decrement>> } else { set event <<Increment>> } ttk::Repeatedly event generate $w $event } + default {} } } @@ -69,6 +70,7 @@ proc ttk::spinbox::DoubleClick {w x y} { switch -glob -- [$w identify $x $y] { *textarea { SelectAll $w } * { Press $w $x $y } + default {} } } @@ -140,7 +142,7 @@ proc ttk::spinbox::Spin {w dir} { $w set [lindex $values $index] } else { if {[catch { - set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}] + set v [expr {[scan [$w get] %f] + ($dir * [$w cget -increment])}] }]} { set v [$w cget -from] } @@ -157,11 +159,11 @@ proc ttk::spinbox::FormatValue {w val} { set fmt [$w cget -format] if {$fmt eq ""} { # Try to guess a suitable -format based on -increment. - set delta [expr {abs([$w cget -increment])}] - if {0 < $delta && $delta < 1} { + set delta [expr { abs ([$w cget -increment])}] + if {(0 < $delta) && ($delta < 1)} { # NB: This guesses wrong if -increment has more than 1 # significant digit itself, e.g., -increment 0.25 - set nsd [expr {int(ceil(-log10($delta)))}] + set nsd [expr { int ( ceil (- ( log10 ($delta))))}] set fmt "%.${nsd}f" } else { set fmt "%.0f" diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index 8772587..41ab69f 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -7,8 +7,8 @@ namespace eval ttk::treeview { # Enter/Leave/Motion # - set State(activeWidget) {} - set State(activeHeading) {} + set State(activeWidget) "" + set State(activeHeading) "" # Press/drag/release: # @@ -19,7 +19,7 @@ namespace eval ttk::treeview { set State(resizeColumn) #0 # For pressmode == "heading" - set State(heading) {} + set State(heading) "" } ### Widget bindings. @@ -75,7 +75,7 @@ proc ttk::treeview::Keynav {w dir} { set focus [lindex [$w children $focus] 0] } else { set up $focus - while {$up ne "" && [set down [$w next $up]] eq ""} { + while {($up ne "") && ([set down [$w next $up]] eq "")} { set up [$w parent $up] } set focus $down @@ -91,9 +91,10 @@ proc ttk::treeview::Keynav {w dir} { right { OpenItem $w $focus } + default {} } - if {$focus != {}} { + if {$focus ne ""} { SelectOp $w $focus choose } } @@ -102,12 +103,13 @@ proc ttk::treeview::Keynav {w dir} { # Sets cursor, active element ... # proc ttk::treeview::Motion {w x y} { - set cursor {} - set activeHeading {} + set cursor "" + set activeHeading "" switch -- [$w identify region $x $y] { separator { set cursor hresize } heading { set activeHeading [$w identify column $x $y] } + default {} } ttk::setCursor $w $cursor @@ -119,11 +121,11 @@ proc ttk::treeview::Motion {w x y} { proc ttk::treeview::ActivateHeading {w heading} { variable State - if {$w != $State(activeWidget) || $heading != $State(activeHeading)} { - if {$State(activeHeading) != {}} { + if {($w ne $State(activeWidget)) || ($heading ne $State(activeHeading))} { + if {$State(activeHeading) ne ""} { $State(activeWidget) heading $State(activeHeading) state !active } - if {$heading != {}} { + if {$heading ne ""} { $w heading $heading state active } set State(activeHeading) $heading @@ -166,8 +168,10 @@ proc ttk::treeview::Press {w x y} { switch -glob -- [$w identify element $x $y] { *indicator - *disclosure { Toggle $w $item } + default {} } } + default {} } } @@ -175,17 +179,19 @@ proc ttk::treeview::Press {w x y} { # proc ttk::treeview::Drag {w x y} { variable State - switch $State(pressMode) { + switch -- $State(pressMode) { resize { resize.drag $w $x } heading { heading.drag $w $x $y } + default {} } } proc ttk::treeview::Release {w x y} { variable State - switch $State(pressMode) { + switch -- $State(pressMode) { resize { resize.release $w $x } heading { heading.release $w } + default {} } set State(pressMode) none Motion $w $x $y @@ -221,8 +227,8 @@ proc ttk::treeview::heading.press {w x y} { proc ttk::treeview::heading.drag {w x y} { variable State - if { [$w identify region $x $y] eq "heading" - && [$w identify column $x $y] eq $State(heading) + if { ([$w identify region $x $y] eq "heading") && + ([$w identify column $x $y] eq $State(heading)) } { $w heading $State(heading) state pressed } else { @@ -232,7 +238,7 @@ proc ttk::treeview::heading.drag {w x y} { proc ttk::treeview::heading.release {w} { variable State - if {[lsearch -exact [$w heading $State(heading) state] pressed] >= 0} { + if {"pressed" in [$w heading $State(heading) state]} { after 0 [$w heading $State(heading) -command] } $w heading $State(heading) state !pressed @@ -304,7 +310,7 @@ proc ttk::treeview::ScanBetween {tv item1 item2 item} { variable between variable selectingBetween - if {$item eq $item1 || $item eq $item2} { + if {$item in "$item1 $item2"} { lappend between $item set selectingBetween [expr {!$selectingBetween}] } elseif {$selectingBetween} { diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl index 7bae211..1df95cf 100644 --- a/library/ttk/ttk.tcl +++ b/library/ttk/ttk.tcl @@ -21,7 +21,7 @@ source [file join $::ttk::library utils.tcl] # $old and $new must be fully namespace-qualified. # proc ttk::deprecated {old new} { - interp alias {} $old {} ttk::do'deprecate $old $new + interp alias "" $old "" ttk::do'deprecate $old $new } ## do'deprecate -- # Implementation procedure for deprecated commands -- @@ -29,7 +29,7 @@ proc ttk::deprecated {old new} { # proc ttk::do'deprecate {old new args} { deprecated'warning $old $new - interp alias {} $old {} $new + interp alias "" $old "" $new uplevel 1 [linsert $args 0 $new] } @@ -133,7 +133,7 @@ proc ttk::LoadThemes {} { xpnative {xpTheme.tcl vistaTheme.tcl} aqua aquaTheme.tcl } { - if {[lsearch -exact $builtinThemes $theme] >= 0} { + if {$theme in $builtinThemes} { foreach script $scripts { uplevel #0 [list source [file join $library $script]] } @@ -141,7 +141,8 @@ proc ttk::LoadThemes {} { } } -ttk::LoadThemes; rename ::ttk::LoadThemes {} +ttk::LoadThemes +rename ::ttk::LoadThemes "" ### Select platform-specific default theme: # @@ -157,9 +158,9 @@ proc ttk::DefaultTheme {} { set preferred [list aqua vista xpnative winnative] set userTheme [option get . tkTheme TkTheme] - if {$userTheme ne {} && ![catch { + if {($userTheme ne "") && (![catch { uplevel #0 [list package require ttk::theme::$userTheme] - }]} { + }])} { return $userTheme } @@ -171,6 +172,7 @@ proc ttk::DefaultTheme {} { return "default" } -ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {} +ttk::setTheme [ttk::DefaultTheme] +rename ttk::DefaultTheme "" #*EOF* diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index 7cc1bb7..27f92c0 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -30,14 +30,14 @@ proc ttk::takefocus {w} { proc ttk::GuessTakeFocus {w} { # Don't traverse to widgets with '-state disabled': # - if {![catch {$w cget -state} state] && $state eq "disabled"} { + if {(![catch {$w cget -state} state]) && ($state eq "disabled")} { return 0 } # Allow traversal to widgets with explicit key or focus bindings: # - if {[regexp {Key|Focus} [concat [bind $w] [bind [winfo class $w]]]]} { - return 1; + if {[regexp "Key|Focus" [concat [bind $w] [bind [winfo class $w]]]]} { + return 1 } # Default is nontraversable: @@ -144,10 +144,13 @@ proc ttk::SaveGrab {w} { set grabbed [grab current $w] if {[winfo exists $grabbed]} { - switch [grab status $grabbed] { + switch -- [grab status $grabbed] { global { set restoreGrab [list grab -global $grabbed] } local { set restoreGrab [list grab $grabbed] } - none { ;# grab window is really in a different interp } + none { + # grab window is really in a different interp + } + default {} } } @@ -306,11 +309,12 @@ proc ttk::bindMouseWheel {bindtag callback} { bind $bindtag <ButtonPress-5> "$callback +1" } win32 { - bind $bindtag <MouseWheel> [append callback { [expr {-(%D/120)}]}] + bind $bindtag <MouseWheel> [append callback { [expr {-(%D / 120)}]}] } aqua { bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ] } + default {} } } @@ -345,6 +349,7 @@ switch -- [tk windowingsystem] { bind TtkScrollable <Shift-Option-MouseWheel> \ { %W xview scroll [expr {-10*(%D)}] units } } + default {} } #*EOF* diff --git a/library/unsupported.tcl b/library/unsupported.tcl index 2c68e78..2c1d5e6 100644 --- a/library/unsupported.tcl +++ b/library/unsupported.tcl @@ -230,12 +230,12 @@ namespace eval ::tk::unsupported { proc ::tk::unsupported::ExposePrivateCommand {cmd} { variable PrivateCommands set cmds [array get PrivateCommands $cmd] - if {[llength $cmds] == 0} { + if {![llength $cmds]} { return -code error -errorcode {TK EXPOSE_PRIVATE_COMMAND} \ - "No compatibility support for \[$cmd]" + "No compatibility support for \[$cmd\]" } foreach {old new} $cmds { - namespace eval :: [list interp alias {} $old {}] $new + namespace eval :: [list interp alias "" $old ""] $new } } @@ -258,7 +258,7 @@ proc ::tk::unsupported::ExposePrivateCommand {cmd} { proc ::tk::unsupported::ExposePrivateVariable {var} { variable PrivateVariables set vars [array get PrivateVariables $var] - if {[llength $vars] == 0} { + if {![llength $vars]} { return -code error -errorcode {TK EXPOSE_PRIVATE_VARIABLE} \ "No compatibility support for \$$var" } diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 0578361..b3065aa 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -36,7 +36,7 @@ namespace eval ::tk::dialog::file {} proc ::tk::MotifFDialog {type args} { variable ::tk::Priv set dataName __tk_filedialog - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data set w [MotifFDialog_Create $dataName $type $args] @@ -78,7 +78,7 @@ proc ::tk::MotifFDialog {type args} { # Pathname of the file dialog. proc ::tk::MotifFDialog_Create {dataName type argList} { - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data MotifFDialog_Config $dataName $type $argList @@ -142,7 +142,7 @@ proc ::tk::MotifFDialog_Create {dataName type argList} { # none proc ::tk::MotifFDialog_FileTypes {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set f $w.top.f3.types destroy $f @@ -177,16 +177,16 @@ proc ::tk::MotifFDialog_FileTypes {w} { MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)] #don't produce radiobuttons for only one filetype - if {[llength $data(-filetypes)] == 1} { + if {![llength $data(-filetypes)]} { return } frame $f set cnt 0 - if {$data(-filetypes) ne {}} { + if {$data(-filetypes) ne ""} { foreach type $data(-filetypes) { set title [lindex [lindex $type 0] 0] - set filter [lindex $type 1] + set filter [lindex $type 1]; # NOT USED ?! radiobutton $f.b$cnt \ -text $title \ -variable ::tk::dialog::file::[winfo name $w](fileType) \ @@ -206,7 +206,7 @@ proc ::tk::MotifFDialog_FileTypes {w} { # This proc gets called whenever data(filter) is set # proc ::tk::MotifFDialog_SetFilter {w type} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data variable ::tk::Priv set data(filter) [lindex $type 1] @@ -228,7 +228,7 @@ proc ::tk::MotifFDialog_SetFilter {w type} { # argList Options parsed by the procedure. proc ::tk::MotifFDialog_Config {dataName type argList} { - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data set data(type) $type @@ -267,7 +267,7 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { if {$data(-title) eq ""} { if {$type eq "open"} { if {$data(-multiple) != 0} { - set data(-title) "[mc {Open Multiple Files}]" + set data(-title) [mc "Open Multiple Files"] } else { set data(-title) [mc "Open"] } @@ -281,7 +281,7 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { # if {$data(-initialdir) ne ""} { if {[file isdirectory $data(-initialdir)]} { - set data(selectPath) [lindex [glob $data(-initialdir)] 0] + set data(selectPath) [lindex [glob -- $data(-initialdir)] 0] } else { set data(selectPath) [pwd] } @@ -322,13 +322,13 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { proc ::tk::MotifFDialog_BuildUI {w} { set dataName [lindex [split $w .] end] - upvar ::tk::dialog::file::$dataName data + upvar 1 ::tk::dialog::file::$dataName data # Create the dialog toplevel and internal frames. # toplevel $w -class TkMotifFDialog - set top [frame $w.top -relief raised -bd 1] - set bot [frame $w.bot -relief raised -bd 1] + set top [frame $w.top -relief raised -borderwidth 1] + set bot [frame $w.bot -relief raised -borderwidth 1] pack $w.bot -side bottom -fill x pack $w.top -side top -expand yes -fill both @@ -380,7 +380,7 @@ proc ::tk::MotifFDialog_BuildUI {w} { # The buttons # set maxWidth [::tk::mcmaxamp &OK &Filter &Cancel] - set maxWidth [expr {$maxWidth<6?6:$maxWidth}] + set maxWidth [expr {($maxWidth < 6) ? 6 : $maxWidth}] set data(okBtn) [::tk::AmpWidget button $bot.ok -text [mc "&OK"] \ -width $maxWidth \ -command [list tk::MotifFDialog_OkCmd $w]] @@ -401,13 +401,13 @@ proc ::tk::MotifFDialog_BuildUI {w} { bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w] bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w] bind $w <Escape> [list tk::MotifFDialog_CancelCmd $w] - bind $w.bot <Destroy> {set ::tk::Priv(selectFilePath) {}} + bind $w.bot <Destroy> {set ::tk::Priv(selectFilePath) ""} wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w] } proc ::tk::MotifFDialog_SetListMode {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data if {$data(-multiple) != 0} { set selectmode extended @@ -481,7 +481,7 @@ proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} { # pattern itself. proc ::tk::MotifFDialog_InterpFilter {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set text [string trim [$data(fEnt) get]] @@ -491,7 +491,7 @@ proc ::tk::MotifFDialog_InterpFilter {w} { if {[string index $text 0] eq "~"} { set list [file split $text] set tilde [lindex $list 0] - if {[catch {set tilde [glob $tilde]}]} { + if {[catch {set tilde [glob -- $tilde]}]} { set badTilde 1 } else { set text [eval file join [concat $tilde [lrange $list 1 end]]] @@ -544,7 +544,7 @@ proc ::tk::MotifFDialog_InterpFilter {w} { # None. proc ::tk::MotifFDialog_Update {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data $data(fEnt) delete 0 end $data(fEnt) insert 0 \ @@ -568,7 +568,7 @@ proc ::tk::MotifFDialog_Update {w} { # None. proc ::tk::MotifFDialog_LoadFiles {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data $data(dList) delete 0 end $data(fList) delete 0 end @@ -598,7 +598,7 @@ proc ::tk::MotifFDialog_LoadFiles {w} { } else { foreach pat $data(filter) { if {[string match $pat $f]} { - if {[string match .* $f]} { + if {[string match ".*" $f]} { incr top } lappend flist $f @@ -629,7 +629,7 @@ proc ::tk::MotifFDialog_LoadFiles {w} { # None. proc ::tk::MotifFDialog_BrowseDList {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data focus $data(dList) if {[$data(dList) curselection] eq ""} { @@ -675,7 +675,7 @@ proc ::tk::MotifFDialog_BrowseDList {w} { # None. proc ::tk::MotifFDialog_ActivateDList {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data if {[$data(dList) curselection] eq ""} { return @@ -723,14 +723,14 @@ proc ::tk::MotifFDialog_ActivateDList {w} { # None. proc ::tk::MotifFDialog_BrowseFList {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data focus $data(fList) set data(selectFile) "" foreach item [$data(fList) curselection] { lappend data(selectFile) [$data(fList) get $item] } - if {[llength $data(selectFile)] == 0} { + if {![llength $data(selectFile)]} { return } @@ -765,7 +765,7 @@ proc ::tk::MotifFDialog_BrowseFList {w} { # None. proc ::tk::MotifFDialog_ActivateFList {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data if {[$data(fList) curselection] eq ""} { return @@ -791,11 +791,9 @@ proc ::tk::MotifFDialog_ActivateFList {w} { # None. proc ::tk::MotifFDialog_ActivateFEnt {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data - set list [MotifFDialog_InterpFilter $w] - set data(selectPath) [lindex $list 0] - set data(filter) [lindex $list 1] + lassign [MotifFDialog_InterpFilter $w] data(selectPath) data(filter) MotifFDialog_Update $w } @@ -815,7 +813,7 @@ proc ::tk::MotifFDialog_ActivateFEnt {w} { proc ::tk::MotifFDialog_ActivateSEnt {w} { variable ::tk::Priv - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data set selectFilePath [string trim [$data(sEnt) get]] @@ -829,7 +827,7 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} { } if {[file isdirectory [lindex $selectFilePath 0]]} { - set data(selectPath) [lindex [glob $selectFilePath] 0] + set data(selectPath) [lindex [glob -- $selectFilePath] 0] set data(selectFile) "" MotifFDialog_Update $w return @@ -841,7 +839,7 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} { set item [file join $data(selectPath) $item] } elseif {![file exists [file dirname $item]]} { tk_messageBox -icon warning -type ok \ - -message [mc {Directory "%1$s" does not exist.} \ + -message [mc "Directory \"%1$s\" does not exist." \ [file dirname $item]] return } @@ -849,13 +847,13 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} { if {![file exists $item]} { if {$data(type) eq "open"} { tk_messageBox -icon warning -type ok \ - -message [mc {File "%1$s" does not exist.} $item] + -message [mc "File \"%1$s\" does not exist." $item] return } - } elseif {$data(type) eq "save" && $data(-confirmoverwrite)} { + } elseif {($data(type) eq "save") && $data(-confirmoverwrite)} { set message [format %s%s \ [mc "File \"%1\$s\" already exists.\n\n" $selectFilePath] \ - [mc {Replace existing file?}]] + [mc "Replace existing file?"]] set answer [tk_messageBox -icon warning -type yesno \ -message $message] if {$answer eq "no"} { @@ -867,8 +865,10 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} { } # Return selected filter - if {[info exists data(-typevariable)] && $data(-typevariable) ne "" - && [info exists data(-filetypes)] && $data(-filetypes) ne ""} { + if {[info exists data(-typevariable)] && + ($data(-typevariable) ne "") && + [info exists data(-filetypes)] && + ($data(-filetypes) ne "")} { upvar #0 $data(-typevariable) typeVariable set typeVariable [lindex $data(-filetypes) $data(fileType) 0] } @@ -884,15 +884,14 @@ proc ::tk::MotifFDialog_ActivateSEnt {w} { set Priv(selectPath) [file dirname [lindex $newFileList 0]] } - proc ::tk::MotifFDialog_OkCmd {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data MotifFDialog_ActivateSEnt $w } proc ::tk::MotifFDialog_FilterCmd {w} { - upvar ::tk::dialog::file::[winfo name $w] data + upvar 1 ::tk::dialog::file::[winfo name $w] data MotifFDialog_ActivateFEnt $w } @@ -947,10 +946,10 @@ proc ::tk::ListBoxKeyAccel_Key {w key} { [list tk::ListBoxKeyAccel_Reset $w]] } -proc ::tk::ListBoxKeyAccel_Goto {w string} { +proc ::tk::ListBoxKeyAccel_Goto {w a_string} { variable ::tk::Priv - set string [string tolower $string] + set string [string tolower $a_string] set end [$w index end] set theIndex -1 |