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 | |
| 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>
223 files changed, 5301 insertions, 5592 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 diff --git a/tests/arc.tcl b/tests/arc.tcl index d0a93ea..29444b4 100644 --- a/tests/arc.tcl +++ b/tests/arc.tcl @@ -1,7 +1,7 @@ # This file creates a visual test for arcs. It is part of the Tk # visual test suite, which is invoked via the "visual" script. -catch {destroy .t} +destroy .t toplevel .t wm title .t "Visual Tests for Canvas Arcs" wm iconname .t "Arcs" @@ -42,23 +42,23 @@ set outline black .t.c create arc 500 260 620 460 -start 30 -extent 150 -fill {} -width 14 \ -style chord -outline $outline .t.c create arc 20 450 140 570 -start 135 -extent 270 -fill $fill1 -width 14 \ - -style pieslice -outline {} + -style pieslice -outline "" .t.c create arc 180 450 300 570 -start 30 -extent -90 -fill $fill1 -width 14 \ - -style pieslice -outline {} + -style pieslice -outline "" .t.c create arc 340 450 460 570 -start 320 -extent 270 -fill $fill1 -width 14 \ - -style chord -outline {} + -style chord -outline "" .t.c create arc 500 450 620 570 -start 350 -extent -110 -fill $fill1 -width 14 \ - -style chord -outline {} + -style chord -outline "" .t.c addtag arc withtag all .t.c addtag circle withtag [.t.c create oval 320 200 340 220 -fill MistyRose3] .t.c bind arc <Any-Enter> { set prevFill [lindex [.t.c itemconf current -fill] 4] set prevOutline [lindex [.t.c itemconf current -outline] 4] - if {($prevFill != "") || ($prevOutline == "")} { + if {($prevFill ne "") || ($prevOutline eq "")} { .t.c itemconf current -fill $fill3 } - if {$prevOutline != ""} { + if {$prevOutline ne ""} { .t.c itemconf current -outline $outline2 } } @@ -99,7 +99,7 @@ bind .t.c <Shift-1> { } bind .t.c <Shift-B1-Motion> { - .t.c move circle [expr %x-$curx] [expr %y-$cury] + .t.c move circle [expr {%x - $curx}] [expr {%y - $cury}] set curx %x set cury %y } @@ -127,7 +127,7 @@ bind .t.c a { } incr i $delta c -start $i - c -extent [expr 360-2*$i] + c -extent [expr {360 - (2 * $i)}] after 20 update } diff --git a/tests/bevel.tcl b/tests/bevel.tcl index 950b714..70c45fc 100644 --- a/tests/bevel.tcl +++ b/tests/bevel.tcl @@ -2,15 +2,15 @@ # widgets. It is part of the Tk visual test suite, which is invoked # via the "visual" script. -catch {destroy .t} +destroy .t toplevel .t wm title .t "Visual Tests for Borders in Text Widgets" wm iconname .t "Text Borders" wm geom .t +0+0 text .t.t -width 60 -height 30 -setgrid true -xscrollcommand {.t.h set} \ - -font {Courier 12} \ - -yscrollcommand {.t.v set} -wrap none -relief raised -bd 2 + -font "Courier 12" \ + -yscrollcommand {.t.v set} -wrap none -relief raised -borderwidth 2 scrollbar .t.v -orient vertical -command ".t.t yview" scrollbar .t.h -orient horizontal -command ".t.t xview" button .t.quit -text Quit -command {destroy .t} @@ -21,10 +21,10 @@ pack .t.t -expand yes -fill both wm minsize .t 1 1 if {[winfo depth .t] > 1} { - .t.t tag configure r1 -relief raised -borderwidth 2 -background #b2dfee - .t.t tag configure r2 -relief raised -borderwidth 2 -background #b2dfee \ + .t.t tag configure r1 -relief raised -borderwidth 2 -background "#b2dfee" + .t.t tag configure r2 -relief raised -borderwidth 2 -background "#b2dfee" \ -offset 2 - .t.t tag configure s1 -relief sunken -borderwidth 2 -background #b2dfee + .t.t tag configure s1 -relief sunken -borderwidth 2 -background "#b2dfee" } else { .t.t tag configure r1 -relief raised -borderwidth 2 -background white .t.t tag configure r2 -relief raised -borderwidth 2 -background white \ diff --git a/tests/bind.test b/tests/bind.test index c777d66..78da4f5 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -25,7 +25,6 @@ foreach event [bind all] { bind all $event {} } - proc unsetBindings {} { bind all <Enter> {} bind Test <Enter> {} @@ -35,7 +34,6 @@ proc unsetBindings {} { bind .t <Enter> {} } - test bind-1.1 {bind command} -body { bind } -returnCodes error -result {wrong # args: should be "bind window ?pattern? ?command?"} @@ -162,7 +160,6 @@ test bind-2.12 {bindtags command} -body { destroy .t.f } -result {a .gorp b} - test bind-3.1 {TkFreeBindingTags procedure} -body { frame .t.f bindtags .t.f "a b c d" @@ -178,7 +175,6 @@ test bind-3.2 {TkFreeBindingTags procedure} -body { destroy .t.f } -result {} - test bind-4.1 {TkBindEventProc procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -279,7 +275,6 @@ test bind-4.5 {TkBindEventProc procedure} -setup { unsetBindings } -result {} - test bind-5.1 {Tk_CreateBindingTable procedure} -body { canvas .t.c .t.c bind foo @@ -287,7 +282,6 @@ test bind-5.1 {Tk_CreateBindingTable procedure} -body { destroy .t.c } -result {} - test bind-6.1 {Tk_DeleteBindTable procedure} -body { canvas .t.c .t.c bind foo <1> {string 1} @@ -403,7 +397,6 @@ test bind-11.3 {Tk_GetAllBindings procedure} -body { destroy .t.f } -result {<Triple-Button-1> a<Leave>b abcd} - test bind-12.1 {Tk_DeleteAllBindings procedure} -body { frame .t.f -class Test -width 150 -height 100 destroy .t.f @@ -1569,7 +1562,6 @@ test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup { bind Test <Double-1> {} } -result {single single(Test) single double(Test) single double(Test)} - test bind-16.1 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2172,7 +2164,6 @@ test bind-16.44 {ExpandPercents procedure} -setup { destroy .t.f } -result {?? ??} - test bind-17.1 {event command} -body { event } -returnCodes error -result {wrong # args: should be "event option ?arg?"} @@ -2287,7 +2278,6 @@ test bind-17.18 {event command} -body { event foo } -returnCodes error -result {bad option "foo": must be add, delete, generate, or info} - test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} -body { event add asd <Ctrl-v> } -returnCodes error -result {virtual event "asd" is badly formed} @@ -2334,7 +2324,6 @@ test bind-18.7 {CreateVirtualEvent procedure: existing virtual} -body { event delete <<xyz>> } -result {<<xyz>> {<Button-2> <Control-Key-v>}} - test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} -body { event add xyz {} } -returnCodes error -result {virtual event "xyz" is badly formed} @@ -2621,7 +2610,6 @@ test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} -setup { event delete <<abc>> } -result {{xyz abc def xyz abc} <Button-2> <Button-2> {}} - test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} -body { event info asd } -returnCodes error -result {virtual event "asd" is badly formed} @@ -2646,7 +2634,6 @@ test bind-20.4 {GetVirtualEvent procedure: owns many} -setup { event delete <<xyz>> } -result {<Control-Key-v> <Button-2> spack} - test bind-21.1 {GetAllVirtualEvents procedure: no events} -body { foreach p [event info] {event delete $p} event info @@ -4849,7 +4836,6 @@ test bind-23.4 {GetVirtualEventUid procedure} -setup { event info <<asd>> } -result {} - test bind-24.1 {FindSequence procedure: no event} -body { bind .t {} test } -returnCodes error -result {no events specified in binding} @@ -5383,8 +5369,6 @@ test bind-25.49 {modifier names} -setup { destroy .t.f } -result <Extended-Key-Return> - - test bind-26.1 {event names} -setup { frame .t.f -class Test -width 150 -height 100 } -body { @@ -5711,7 +5695,6 @@ test bind-26.24 {event names: Unmap} -setup { destroy .t.f } -result {{event Unmap} <Unmap>} - test bind-27.1 {button names} -body { bind .t <Expose-1> foo } -returnCodes error -result {specified button "1" for non-button event} @@ -5863,7 +5846,6 @@ test bind-28.8 {keysym names} -setup { destroy .t.f } -result {X x {keysym X}} - test bind-29.1 {Tk_BackgroundError procedure} -setup { proc bgerror msg { global x errorInfo @@ -5916,7 +5898,6 @@ test bind-29.2 {Tk_BackgroundError procedure} -setup { "error Message2" (command bound to event)}} - test bind-30.1 {MouseWheel events} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -5957,7 +5938,6 @@ test bind-30.3 {MouseWheel events} -setup { destroy .t.f } -result {240 10 30} - test bind-31.1 {virtual event user_data field - bad generation} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f diff --git a/tests/border.test b/tests/border.test index 78d0fcd..34e1f7f 100644 --- a/tests/border.test +++ b/tests/border.test @@ -15,7 +15,7 @@ test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} -constraints } -body { set x orange lindex $x 0 - button .b1 -bg $x -text .b1 + button .b1 -background $x -text .b1 lindex $x 0 testborder orange } -cleanup { @@ -27,10 +27,10 @@ test border-1.2 {Tk_AllocBorderFromObj - discard stale border} -constraints { set result {} } -body { set x orange - button .b1 -bg $x -text First + button .b1 -background $x -text First destroy .b1 lappend result [testborder orange] - button .b2 -bg $x -text Second + button .b2 -background $x -text Second lappend result [testborder orange] } -cleanup { destroy .b1 .b2 @@ -41,9 +41,9 @@ test border-1.3 {Tk_AllocBorderFromObj - reuse existing border} -constraints { set result {} } -body { set x orange - button .b1 -bg $x -text First + button .b1 -background $x -text First lappend result [testborder orange] - button .b2 -bg $x -text Second + button .b2 -background $x -text Second pack .b1 .b2 -side top lappend result [testborder orange] } -cleanup { @@ -57,13 +57,13 @@ test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} -constraints set result {} } -body { set x purple - button .b1 -bg $x -text First + button .b1 -background $x -text First pack .b1 -side top lappend result [testborder purple] - button .t.b -bg $x -text Second + button .t.b -background $x -text Second pack .t.b -side top lappend result [testborder purple] - button .b2 -bg $x -text Third + button .b2 -background $x -text Third pack .b2 -side top lappend result [testborder purple] } -cleanup { @@ -78,11 +78,11 @@ test border-2.1 {Tk_Free3DBorder - reference counts} -constraints { set result {} } -body { set x purple - button .b1 -bg $x -text First + button .b1 -background $x -text First pack .b1 -side top - button .t.b -bg $x -text Second + button .t.b -background $x -text Second pack .t.b -side top - button .b2 -bg $x -text Third + button .b2 -background $x -text Third pack .b2 -side top lappend result [testborder purple] destroy .b1 @@ -104,16 +104,16 @@ test border-2.2 {Tk_Free3DBorder - unlinking from list} -constraints { set result {} } -body { set x purple - button .b -bg $x -text .b1 - button .t.b1 -bg $x -text .t.b1 - button .t.b2 -bg $x -text .t.b2 - button .t2.b1 -bg $x -text .t2.b1 - button .t2.b2 -bg $x -text .t2.b2 - button .t2.b3 -bg $x -text .t2.b3 - button .t3.b1 -bg $x -text .t3.b1 - button .t3.b2 -bg $x -text .t3.b2 - button .t3.b3 -bg $x -text .t3.b3 - button .t3.b4 -bg $x -text .t3.b4 + button .b -background $x -text .b1 + button .t.b1 -background $x -text .t.b1 + button .t.b2 -background $x -text .t.b2 + button .t2.b1 -background $x -text .t2.b1 + button .t2.b2 -background $x -text .t2.b2 + button .t2.b3 -background $x -text .t2.b3 + button .t3.b1 -background $x -text .t3.b1 + button .t3.b2 -background $x -text .t3.b2 + button .t3.b3 -background $x -text .t3.b3 + button .t3.b4 -background $x -text .t3.b4 lappend result [testborder purple] destroy .t2 lappend result [testborder purple] @@ -133,11 +133,11 @@ test border-3.1 {FreeBorderObjProc} -constraints { set result {} } -body { set x [format purple] - button .b -bg $x -text .b1 + button .b -background $x -text .b1 set y [format purple] - .b configure -bg $y + .b configure -background $y set z [format purple] - .b configure -bg $z + .b configure -background $z lappend result [testborder purple] set x red lappend result [testborder purple] diff --git a/tests/bugs.tcl b/tests/bugs.tcl index 83d9519..bbe3661 100644 --- a/tests/bugs.tcl +++ b/tests/bugs.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[info procs test] != "test"} { +if {[info procs test] ne "test"} { source defs } @@ -23,7 +23,7 @@ test crash-1.0 {imgPhoto} { } {} test crash-1.1 {color} { - . configure -bg rgb:345 + . configure -background rgb:345 set foo "" } {} diff --git a/tests/butGeom.tcl b/tests/butGeom.tcl index 2ee8fdc..d858677 100644 --- a/tests/butGeom.tcl +++ b/tests/butGeom.tcl @@ -1,7 +1,7 @@ # This file creates a visual test for button layout. It is part of # the Tk visual test suite, which is invoked via the "visual" script. -catch {destroy .t} +destroy .t toplevel .t wm title .t "Visual Tests for Button Geometry" wm iconname .t "Button Geometry" @@ -17,7 +17,7 @@ pack .t.quit -side bottom -pady 2m set sepId 1 proc sep {} { global sepId - frame .t.sep$sepId -height 2 -bd 1 -relief sunken + frame .t.sep$sepId -height 2 -borderwidth 1 -relief sunken pack .t.sep$sepId -side top -padx 2m -pady 2m -fill x incr sepId } @@ -81,9 +81,9 @@ frame .t.f4 pack .t.f4 -side top -expand 1 -fill both sep -label .t.l1 -text Label -bd 2 -relief sunken -label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken -label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -bd 2 -relief sunken -underline 50 +label .t.l1 -text Label -borderwidth 2 -relief sunken +label .t.l2 -text "Explicit\nnewlines\n\nin the text" -borderwidth 2 -relief sunken +label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -borderwidth 2 -relief sunken -underline 50 pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \ -expand y -fill both diff --git a/tests/butGeom2.tcl b/tests/butGeom2.tcl index 96ff209..8cc11f3 100644 --- a/tests/butGeom2.tcl +++ b/tests/butGeom2.tcl @@ -1,7 +1,7 @@ # This file creates a visual test for button layout. It is part of # the Tk visual test suite, which is invoked via the "visual" script. -catch {destroy .t} +destroy .t toplevel .t wm title .t "Visual Tests for Button Geometry" wm iconname .t "Button Geometry" @@ -17,7 +17,7 @@ pack .t.quit -side bottom -pady 2m set sepId 1 proc sep {} { global sepId - frame .t.sep$sepId -height 2 -bd 1 -relief sunken + frame .t.sep$sepId -height 2 -borderwidth 1 -relief sunken pack .t.sep$sepId -side top -padx 2m -pady 2m -fill x incr sepId } @@ -33,15 +33,15 @@ label .t.anchorLabel -text "Color:" frame .t.control.left.f -width 6c -height 3c pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top -anchor w foreach opt {activebackground activeforeground background disabledforeground foreground highlightbackground highlightcolor } { - #button .t.color-$opt -text $opt -command "config -$opt \[tk_chooseColor]" + #button .t.color-$opt -text $opt -command "config -$opt \[tk_chooseColor\]" menubutton .t.color-$opt -text $opt -menu .t.color-$opt.m -indicatoron 1 \ - -relief raised -bd 2 + -relief raised -borderwidth 2 menu .t.color-$opt.m -tearoff 0 .t.color-$opt.m add command -label Red -command "config -$opt red" .t.color-$opt.m add command -label Green -command "config -$opt green" .t.color-$opt.m add command -label Blue -command "config -$opt blue" .t.color-$opt.m add command -label Other... \ - -command "config -$opt \[tk_chooseColor]" + -command "config -$opt \[tk_chooseColor\]" pack .t.color-$opt -in .t.control.left.f -fill x } @@ -73,9 +73,9 @@ frame .t.f4 pack .t.f4 -side top -expand 1 -fill both sep -label .t.l1 -text Label -bd 2 -relief sunken -label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken -label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -bd 2 -relief sunken -underline 50 +label .t.l1 -text Label -borderwidth 2 -relief sunken +label .t.l2 -text "Explicit\nnewlines\n\nin the text" -borderwidth 2 -relief sunken +label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -borderwidth 2 -relief sunken -underline 50 pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \ -expand y -fill both diff --git a/tests/button.test b/tests/button.test index 984fd43..b3decc4 100644 --- a/tests/button.test +++ b/tests/button.test @@ -13,7 +13,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands imageInit -proc bogusTrace args { +proc bogusTrace {args} { error "trace aborted" } @@ -330,8 +330,8 @@ test button-1.33 {configuration option: "bd" for label} -setup { pack .l update } -body { - .l configure -bd 4 - .l cget -bd + .l configure -borderwidth 4 + .l cget -borderwidth } -cleanup { destroy .l } -result {4} @@ -340,7 +340,7 @@ test button-1.34 {configuration option: "bd" for label} -setup { pack .l update } -body { - .l configure -bd badValue + .l configure -borderwidth badValue } -cleanup { destroy .l } -returnCodes {error} -result {bad screen distance "badValue"} @@ -349,8 +349,8 @@ test button-1.35 {configuration option: "bd" for button} -setup { pack .b update } -body { - .b configure -bd 4 - .b cget -bd + .b configure -borderwidth 4 + .b cget -borderwidth } -cleanup { destroy .b } -result {4} @@ -359,7 +359,7 @@ test button-1.36 {configuration option: "bd" for button} -setup { pack .b update } -body { - .b configure -bd badValue + .b configure -borderwidth badValue } -cleanup { destroy .b } -returnCodes {error} -result {bad screen distance "badValue"} @@ -368,8 +368,8 @@ test button-1.37 {configuration option: "bd" for checkbutton} -setup { pack .c update } -body { - .c configure -bd 4 - .c cget -bd + .c configure -borderwidth 4 + .c cget -borderwidth } -cleanup { destroy .c } -result {4} @@ -378,7 +378,7 @@ test button-1.38 {configuration option: "bd" for checkbutton} -setup { pack .c update } -body { - .c configure -bd badValue + .c configure -borderwidth badValue } -cleanup { destroy .c } -returnCodes {error} -result {bad screen distance "badValue"} @@ -387,8 +387,8 @@ test button-1.39 {configuration option: "bd" for radiobutton} -setup { pack .r update } -body { - .r configure -bd 4 - .r cget -bd + .r configure -borderwidth 4 + .r cget -borderwidth } -cleanup { destroy .r } -result {4} @@ -397,7 +397,7 @@ test button-1.40 {configuration option: "bd" for radiobutton} -setup { pack .r update } -body { - .r configure -bd badValue + .r configure -borderwidth badValue } -cleanup { destroy .r } -returnCodes {error} -result {bad screen distance "badValue"} @@ -407,8 +407,8 @@ test button-1.41 {configuration option: "bg" for label} -setup { pack .l update } -body { - .l configure -bg #ff0000 - .l cget -bg + .l configure -background #ff0000 + .l cget -background } -cleanup { destroy .l } -result {#ff0000} @@ -417,7 +417,7 @@ test button-1.42 {configuration option: "bg" for label} -setup { pack .l update } -body { - .l configure -bg non-existent + .l configure -background non-existent } -cleanup { destroy .l } -returnCodes {error} -result {unknown color name "non-existent"} @@ -426,8 +426,8 @@ test button-1.43 {configuration option: "bg" for button} -setup { pack .b update } -body { - .b configure -bg #ff0000 - .b cget -bg + .b configure -background #ff0000 + .b cget -background } -cleanup { destroy .b } -result {#ff0000} @@ -436,7 +436,7 @@ test button-1.44 {configuration option: "bg" for button} -setup { pack .b update } -body { - .b configure -bg non-existent + .b configure -background non-existent } -cleanup { destroy .b } -returnCodes {error} -result {unknown color name "non-existent"} @@ -445,8 +445,8 @@ test button-1.45 {configuration option: "bg" for checkbutton} -setup { pack .c update } -body { - .c configure -bg #ff0000 - .c cget -bg + .c configure -background #ff0000 + .c cget -background } -cleanup { destroy .c } -result {#ff0000} @@ -455,7 +455,7 @@ test button-1.46 {configuration option: "bg" for checkbutton} -setup { pack .c update } -body { - .c configure -bg non-existent + .c configure -background non-existent } -cleanup { destroy .c } -returnCodes {error} -result {unknown color name "non-existent"} @@ -464,8 +464,8 @@ test button-1.47 {configuration option: "bg" for radiobutton} -setup { pack .r update } -body { - .r configure -bg #ff0000 - .r cget -bg + .r configure -background #ff0000 + .r cget -background } -cleanup { destroy .r } -result {#ff0000} @@ -474,7 +474,7 @@ test button-1.48 {configuration option: "bg" for radiobutton} -setup { pack .r update } -body { - .r configure -bg non-existent + .r configure -background non-existent } -cleanup { destroy .r } -returnCodes {error} -result {unknown color name "non-existent"} @@ -930,8 +930,8 @@ test button-1.95 {configuration option: "fg" for label} -setup { pack .l update } -body { - .l configure -fg #110022 - .l cget -fg + .l configure -foreground #110022 + .l cget -foreground } -cleanup { destroy .l } -result {#110022} @@ -940,7 +940,7 @@ test button-1.96 {configuration option: "fg" for label} -setup { pack .l update } -body { - .l configure -fg non-existent + .l configure -foreground non-existent } -cleanup { destroy .l } -returnCodes {error} -result {unknown color name "non-existent"} @@ -949,8 +949,8 @@ test button-1.97 {configuration option: "fg" for button} -setup { pack .b update } -body { - .b configure -fg #110022 - .b cget -fg + .b configure -foreground #110022 + .b cget -foreground } -cleanup { destroy .b } -result {#110022} @@ -959,7 +959,7 @@ test button-1.98 {configuration option: "fg" for button} -setup { pack .b update } -body { - .b configure -fg non-existent + .b configure -foreground non-existent } -cleanup { destroy .b } -returnCodes {error} -result {unknown color name "non-existent"} @@ -968,8 +968,8 @@ test button-1.99 {configuration option: "fg" for checkbutton} -setup { pack .c update } -body { - .c configure -fg #110022 - .c cget -fg + .c configure -foreground #110022 + .c cget -foreground } -cleanup { destroy .c } -result {#110022} @@ -978,7 +978,7 @@ test button-1.100 {configuration option: "fg" for checkbutton} -setup { pack .c update } -body { - .c configure -fg non-existent + .c configure -foreground non-existent } -cleanup { destroy .c } -returnCodes {error} -result {unknown color name "non-existent"} @@ -987,8 +987,8 @@ test button-1.101 {configuration option: "fg" for radiobutton} -setup { pack .r update } -body { - .r configure -fg #110022 - .r cget -fg + .r configure -foreground #110022 + .r cget -foreground } -cleanup { destroy .r } -result {#110022} @@ -997,7 +997,7 @@ test button-1.102 {configuration option: "fg" for radiobutton} -setup { pack .r update } -body { - .r configure -fg non-existent + .r configure -foreground non-existent } -cleanup { destroy .r } -returnCodes {error} -result {unknown color name "non-existent"} @@ -2850,16 +2850,16 @@ test button-3.15 {ButtonWidgetCmd procedure, "configure" option} -body { test button-3.16 {ButtonWidgetCmd procedure, "configure" option} -setup { button .b } -body { - .b co -bg #ffffff -fg + .b co -background #ffffff -foreground } -cleanup { destroy .b -} -returnCodes {error} -result {value for "-fg" missing} +} -returnCodes {error} -result {value for "-foreground" missing} test button-3.17 {ButtonWidgetCmd procedure, "configure" option} -setup { button .b } -body { - .b configure -fg #123456 - .b configure -bg #654321 - lindex [.b configure -fg] 4 + .b configure -foreground #123456 + .b configure -background #654321 + lindex [.b configure -foreground] 4 } -cleanup { destroy .b } -result {#123456} @@ -3203,7 +3203,7 @@ test button-4.1 {DestroyButton procedure} -constraints { unset -nocomplain x } -body { button .b1 -image image1 - button .b2 -fg #ff0000 -text "Button 2" + button .b2 -foreground #ff0000 -text "Button 2" button .b3 -state active -text "Button 3" button .b4 -disabledforeground #0000ff -state disabled -text "Button 4" checkbutton .b5 -variable x -text "Checkbutton 5" @@ -3217,15 +3217,15 @@ test button-4.1 {DestroyButton procedure} -constraints { } -result {} test button-5.1 {ConfigureButton - textvariable trace} -body { - button .b -bd 4 -bg green - .b configure -bd 7 -bg red -fg bogus + button .b -borderwidth 4 -background green + .b configure -borderwidth 7 -background red -foreground bogus } -cleanup { destroy .b } -returnCodes {error} -result {unknown color name "bogus"} test button-5.2 {ConfigureButton - textvariable trace} -body { - button .b -bd 4 -bg green - catch {.b configure -bd 7 -bg red -fg bogus} - list [.b cget -bd] [.b cget -bg] + button .b -borderwidth 4 -background green + catch {.b configure -borderwidth 7 -background red -foreground bogus} + list [.b cget -borderwidth] [.b cget -background] } -cleanup { destroy .b } -result {4 green} @@ -3471,10 +3471,10 @@ test button-6.1 {ButtonEventProc procedure} -body { test button-6.2 {ButtonEventProc procedure} -setup { set x {} } -body { - button .b1 -bg #543210 + button .b1 -background #543210 rename .b1 .b2 lappend x [winfo children .] - lappend x [.b2 cget -bg] + lappend x [.b2 cget -background] destroy .b1 lappend x [info command .b*] [winfo children .] } -cleanup { @@ -3727,7 +3727,7 @@ test button-11.1 {ButtonImageProc procedure} -constraints { label .l -highlightthickness 0 -font {Helvetica -12 bold} image create test image1 } -body { - .l configure -image image1 -padx 0 -pady 0 -bd 0 + .l configure -image image1 -padx 0 -pady 0 -borderwidth 0 pack .l set result "[winfo reqwidth .l] [winfo reqheight .l]" image1 changed 0 0 0 0 80 100 diff --git a/tests/canvImg.test b/tests/canvImg.test index 776d268..2fc5740 100644 --- a/tests/canvImg.test +++ b/tests/canvImg.test @@ -18,7 +18,6 @@ canvas .c pack .c update - test canvImg-1.1 {options for image items} -body { .c create image 50 50 -anchor nw -tags i1 .c itemconfigure i1 -anchor @@ -91,7 +90,6 @@ test canvImg-2.6 {CreateImage procedure} -constraints testImageType -body { .c delete all } -returnCodes {error} -result {unknown option "-gorp"} - test canvImg-3.1 {ImageCoords procedure} -constraints testImageType -setup { image create test foo } -body { @@ -141,7 +139,6 @@ test canvImg-3.5 {ImageCoords procedure} -constraints testImageType -setup { image delete foo } -returnCodes {error} -result {wrong # coordinates: expected 0 or 2, got 3} - test canvImg-4.1 {ConfiugreImage procedure} -constraints testImageType -setup { .c delete all } -body { @@ -190,7 +187,6 @@ test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup { image delete foo foo2 } -returnCodes {error} -result {image "lousy" doesn't exist} - test canvImg-5.1 {DeleteImage procedure} -constraints testImageType -setup { .c delete all imageCleanup @@ -219,7 +215,6 @@ test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} -body update } -result {} - test canvImg-6.1 {ComputeImageBbox procedure} -constraints testImageType -setup { image create test foo .c delete all @@ -385,7 +380,7 @@ if {[testConstraint testImageType]} { } test canvImg-8.1 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect 50 70 80 81 .c gettags [.c find closest 70 90] @@ -394,7 +389,7 @@ test canvImg-8.1 {ImageToArea procedure} -constraints testImageType -setup { } -result {rect} test canvImg-8.2 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{50 70 80 79} .c gettags [.c find closest {*}{70 90}] @@ -403,7 +398,7 @@ test canvImg-8.2 {ImageToArea procedure} -constraints testImageType -setup { } -result {image} test canvImg-8.3 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{99 70 110 81} .c gettags [.c find closest {*}{90 90}] @@ -412,7 +407,7 @@ test canvImg-8.3 {ImageToArea procedure} -constraints testImageType -setup { } -result {rect} test canvImg-8.4 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{101 70 110 79} .c gettags [.c find closest {*}{90 90}] @@ -421,7 +416,7 @@ test canvImg-8.4 {ImageToArea procedure} -constraints testImageType -setup { } -result {image} test canvImg-8.5 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{99 100 110 115} .c gettags [.c find closest {*}{90 110}] @@ -430,7 +425,7 @@ test canvImg-8.5 {ImageToArea procedure} -constraints testImageType -setup { } -result {rect} test canvImg-8.6 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{101 100 110 115} .c gettags [.c find closest {*}{90 110}] @@ -439,7 +434,7 @@ test canvImg-8.6 {ImageToArea procedure} -constraints testImageType -setup { } -result {image} test canvImg-8.7 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{99 134 110 145} .c gettags [.c find closest {*}{90 125}] @@ -448,7 +443,7 @@ test canvImg-8.7 {ImageToArea procedure} -constraints testImageType -setup { } -result {rect} test canvImg-8.8 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{101 136 110 145} .c gettags [.c find closest {*}{90 125}] @@ -457,7 +452,7 @@ test canvImg-8.8 {ImageToArea procedure} -constraints testImageType -setup { } -result {image} test canvImg-8.9 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{50 134 80 145} .c gettags [.c find closest {*}{70 125}] @@ -466,7 +461,7 @@ test canvImg-8.9 {ImageToArea procedure} -constraints testImageType -setup { } -result {rect} test canvImg-8.10 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{50 136 80 145} .c gettags [.c find closest {*}{70 125}] @@ -475,7 +470,7 @@ test canvImg-8.10 {ImageToArea procedure} -constraints testImageType -setup { } -result {image} test canvImg-8.11 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{20 134 31 145} .c gettags [.c find closest {*}{40 125}] @@ -484,7 +479,7 @@ test canvImg-8.11 {ImageToArea procedure} -constraints testImageType -setup { } -result {rect} test canvImg-8.12 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{20 136 29 145} .c gettags [.c find closest {*}{40 125}] @@ -493,7 +488,7 @@ test canvImg-8.12 {ImageToArea procedure} -constraints testImageType -setup { } -result {image} test canvImg-8.13 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{20 100 31 115} .c gettags [.c find closest {*}{40 110}] @@ -502,7 +497,7 @@ test canvImg-8.13 {ImageToArea procedure} -constraints testImageType -setup { } -result {rect} test canvImg-8.14 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{20 100 29 115} .c gettags [.c find closest {*}{40 110}] @@ -511,7 +506,7 @@ test canvImg-8.14 {ImageToArea procedure} -constraints testImageType -setup { } -result {image} test canvImg-8.15 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{20 70 31 80} .c gettags [.c find closest {*}{40 90}] @@ -520,7 +515,7 @@ test canvImg-8.15 {ImageToArea procedure} -constraints testImageType -setup { } -result {rect} test canvImg-8.16 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{20 70 29 79} .c gettags [.c find closest {*}{40 90}] @@ -529,7 +524,7 @@ test canvImg-8.16 {ImageToArea procedure} -constraints testImageType -setup { } -result {image} test canvImg-8.17 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{60 70 69 109} .c gettags [.c find closest {*}{70 110}] @@ -538,7 +533,7 @@ test canvImg-8.17 {ImageToArea procedure} -constraints testImageType -setup { } -result {image} test canvImg-8.18 {ImageToArea procedure} -constraints testImageType -setup { .c create image 50 100 -image foo -tags image -anchor nw - .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {} + .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline "" } -body { .c coords rect {*}{60 70 71 111} .c gettags [.c find closest {*}{70 110}] @@ -707,7 +702,6 @@ if {[testConstraint testImageType]} { image delete foo } - test canvImg-9.1 {DisplayImage procedure} -constraints testImageType -setup { .c delete all image create test foo diff --git a/tests/canvMoveto.test b/tests/canvMoveto.test index 79761a4..84f0cba 100644 --- a/tests/canvMoveto.test +++ b/tests/canvMoveto.test @@ -10,7 +10,7 @@ package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands -canvas .c -width 400 -height 300 -bd 2 -relief sunken +canvas .c -width 400 -height 300 -borderwidth 2 -relief sunken .c create rectangle 20 20 80 80 -tag {test rect1} .c create rectangle 40 40 90 100 -tag {test rect2} diff --git a/tests/canvPs.test b/tests/canvPs.test index c7ba958..47dcd0b 100644 --- a/tests/canvPs.test +++ b/tests/canvPs.test @@ -13,7 +13,7 @@ tcltest::loadTestedCommands imageInit # canvas used in 1.* and 2.* test cases -canvas .c -width 400 -height 300 -bd 2 -relief sunken +canvas .c -width 400 -height 300 -borderwidth 2 -relief sunken .c create rectangle 20 20 80 80 -fill red pack .c update @@ -46,7 +46,6 @@ test canvPs-1.2 {test writing to a file, idempotency} -constraints { removeFile bar.ps } -result ok - test canvPs-2.1 {test writing to a channel} -constraints { unixOrPc } -setup { @@ -54,9 +53,9 @@ test canvPs-2.1 {test writing to a channel} -constraints { file delete $foo } -body { set chan [open $foo w] - fconfigure $chan -translation lf + chan configure $chan -translation lf .c postscript -channel $chan - close $chan + chan close $chan file exists $foo } -cleanup { removeFile foo.ps @@ -71,12 +70,12 @@ test canvPs-2.2 {test writing to channel, idempotency} -constraints { } -body { set c1 [open $foo w] set c2 [open $bar w] - fconfigure $c1 -translation lf - fconfigure $c2 -translation lf + chan configure $c1 -translation lf + chan configure $c2 -translation lf .c postscript -channel $c1 .c postscript -channel $c2 - close $c1 - close $c2 + chan close $c1 + chan close $c2 set status ok if {[file size $bar] != [file size $foo]} { set status broken @@ -95,9 +94,9 @@ test canvPs-2.3 {test writing to channel and file, same output} -constraints { file delete $bar } -body { set c1 [open $foo w] - fconfigure $c1 -translation lf + chan configure $c1 -translation lf .c postscript -channel $c1 - close $c1 + chan close $c1 .c postscript -file $bar set status ok if {[file size $foo] != [file size $bar]} { @@ -117,9 +116,9 @@ test canvPs-2.4 {test writing to channel and file, same output} -constraints { file delete $bar } -body { set c1 [open $foo w] - fconfigure $c1 -translation crlf + chan configure $c1 -translation crlf .c postscript -channel $c1 - close $c1 + chan close $c1 .c postscript -file $bar set status ok if {[file size $foo] != [file size $bar]} { @@ -132,7 +131,6 @@ test canvPs-2.4 {test writing to channel and file, same output} -constraints { } -result ok destroy .c - test canvPs-3.1 {test ps generation with an embedded window} -constraints { notAqua } -setup { @@ -174,7 +172,6 @@ test canvPs-3.2 {test ps generation with an embedded window not mapped} -setup { removeFile bar.ps } -result {1} - test canvPs-4.1 {test ps generation with single-point uncolored poly, bug 734498} -body { pack [canvas .c] .c create poly 10 20 10 20 diff --git a/tests/canvPsArc.tcl b/tests/canvPsArc.tcl index ef7ca6c..0120909 100644 --- a/tests/canvPsArc.tcl +++ b/tests/canvPsArc.tcl @@ -2,7 +2,7 @@ # for bitmaps in canvases. It is part of the Tk visual test suite, # which is invoked via the "visual" script. -catch {destroy .t} +destroy .t toplevel .t wm title .t "Postscript Tests for Canvases" wm iconname .t "Postscript" @@ -20,22 +20,22 @@ button .t.bot.quit -text Quit -command {destroy .t} button .t.bot.print -text Print -command "lpr $c" pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1 -canvas $c -width 6i -height 6i -bd 2 -relief sunken +canvas $c -width 6i -height 6i -borderwidth 2 -relief sunken pack $c -expand yes -fill both -padx 2m -pady 2m $c create arc .5i .5i 2i 2i -style pieslice -start 20 -extent 90 \ - -fill black -outline {} + -fill black -outline "" $c create arc 2.5i 0 4.5i 1i -style pieslice -start -45 -extent -135 \ - -fill {} -outline black -outlinestipple gray50 -width 3m + -fill "" -outline black -outlinestipple gray50 -width 3m $c create arc 5.0i .5i 6.5i 2i -style pieslice -start 45 -extent 315 \ -fill black -stipple gray25 -outline black -width 1m $c create arc -.5i 2.5i 2.0i 3.5i -style chord -start 90 -extent 270 \ - -fill black -outline {} + -fill black -outline "" $c create arc 2.5i 2i 4i 6i -style chord -start 20 -extent 140 \ -fill black -stipple gray50 -outline black -width 2m $c create arc 4i 2.5i 8i 4.5i -style chord -start 60 -extent 60 \ - -fill {} -outline black + -fill "" -outline black $c create arc .5i 4.5i 2i 6i -style arc -start 135 -extent 315 -width 3m \ -outline black -outlinestipple gray25 diff --git a/tests/canvPsBmap.tcl b/tests/canvPsBmap.tcl index 4a7a7e2..dd7cc0e 100644 --- a/tests/canvPsBmap.tcl +++ b/tests/canvPsBmap.tcl @@ -2,7 +2,7 @@ # for bitmaps in canvases. It is part of the Tk visual test suite, # which is invoked via the "visual" script. -catch {destroy .t} +destroy .t toplevel .t wm title .t "Postscript Tests for Canvases" wm iconname .t "Postscript" @@ -20,7 +20,7 @@ button .t.bot.quit -text Quit -command {destroy .t} button .t.bot.print -text Print -command "lpr $c" pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1 -canvas $c -width 6i -height 6i -bd 2 -relief sunken +canvas $c -width 6i -height 6i -borderwidth 2 -relief sunken pack $c -expand yes -fill both -padx 2m -pady 2m set canvPsBmapImageDir [file join [file dirname [info script]] images] @@ -28,47 +28,47 @@ set canvPsBmapImageDir [file join [file dirname [info script]] images] $c create bitmap 0.5i 0.5i \ -bitmap @[file join $canvPsBmapImageDir flagdown.xbm] \ -background {} -foreground black -anchor nw -$c create rect 0.47i 0.47i 0.53i 0.53i -fill {} -outline black +$c create rect 0.47i 0.47i 0.53i 0.53i -fill "" -outline black $c create bitmap 3.0i 0.5i \ -bitmap @[file join $canvPsBmapImageDir flagdown.xbm] \ -background {} -foreground black -anchor n -$c create rect 2.97i 0.47i 3.03i 0.53i -fill {} -outline black +$c create rect 2.97i 0.47i 3.03i 0.53i -fill "" -outline black $c create bitmap 5.5i 0.5i \ -bitmap @[file join $canvPsBmapImageDir flagdown.xbm] \ -background black -foreground white -anchor ne -$c create rect 5.47i 0.47i 5.53i 0.53i -fill {} -outline black +$c create rect 5.47i 0.47i 5.53i 0.53i -fill "" -outline black $c create bitmap 0.5i 3.0i \ -bitmap @[file join $canvPsBmapImageDir face.xbm] \ -background {} -foreground black -anchor w -$c create rect 0.47i 2.97i 0.53i 3.03i -fill {} -outline black +$c create rect 0.47i 2.97i 0.53i 3.03i -fill "" -outline black $c create bitmap 3.0i 3.0i \ -bitmap @[file join $canvPsBmapImageDir face.xbm] \ -background {} -foreground black -anchor center -$c create rect 2.97i 2.97i 3.03i 3.03i -fill {} -outline black +$c create rect 2.97i 2.97i 3.03i 3.03i -fill "" -outline black $c create bitmap 5.5i 3.0i \ -bitmap @[file join $canvPsBmapImageDir face.xbm] \ -background blue -foreground black -anchor e -$c create rect 5.47i 2.97i 5.53i 3.03i -fill {} -outline black +$c create rect 5.47i 2.97i 5.53i 3.03i -fill "" -outline black $c create bitmap 0.5i 5.5i \ -bitmap @[file join $canvPsBmapImageDir flagup.xbm] \ -background black -foreground white -anchor sw -$c create rect 0.47i 5.47i 0.53i 5.53i -fill {} -outline black +$c create rect 0.47i 5.47i 0.53i 5.53i -fill "" -outline black $c create bitmap 3.0i 5.5i \ -bitmap @[file join $canvPsBmapImageDir flagup.xbm] \ -background green -foreground white -anchor s -$c create rect 2.97i 5.47i 3.03i 5.53i -fill {} -outline black +$c create rect 2.97i 5.47i 3.03i 5.53i -fill "" -outline black $c create bitmap 5.5i 5.5i \ -bitmap @[file join $canvPsBmapImageDir flagup.xbm] \ -background {} -foreground black -anchor se -$c create rect 5.47i 5.47i 5.53i 5.53i -fill {} -outline black +$c create rect 5.47i 5.47i 5.53i 5.53i -fill "" -outline black diff --git a/tests/canvPsGrph.tcl b/tests/canvPsGrph.tcl index 343979f..1406f1a 100644 --- a/tests/canvPsGrph.tcl +++ b/tests/canvPsGrph.tcl @@ -2,7 +2,7 @@ # for some of the graphical objects in canvases. It is part of the Tk # visual test suite, which is invoked via the "visual" script. -catch {destroy .t} +destroy .t toplevel .t wm title .t "Postscript Tests for Canvases" wm iconname .t "Postscript" @@ -34,15 +34,15 @@ button .t.bot.quit -text Quit -command {destroy .t} button .t.bot.print -text Print -command "lpr $c" pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1 -frame .t.mid -relief sunken -bd 2 +frame .t.mid -relief sunken -borderwidth 2 pack .t.mid -side top -expand yes -fill both -padx 2m -pady 2m -canvas $c -width 400 -height 350 -bd 0 -relief sunken +canvas $c -width 400 -height 350 -borderwidth 0 -relief sunken pack $c -expand yes -fill both -padx 1 -pady 1 -proc mkObjs c { +proc mkObjs {c} { global what $c delete all - if {$what == "rect"} { + if {$what eq "rect"} { $c create rect 0 0 400 350 -outline black $c create rect 2 2 100 50 -fill black -stipple gray25 $c create rect -20 180 80 320 -fill black -stipple gray50 -width .5c @@ -51,13 +51,13 @@ proc mkObjs c { $c create rect 200 330 240 370 -fill black } - if {$what == "oval"} { - $c create oval 50 10 150 80 -fill black -stipple gray25 -outline {} - $c create oval 100 100 200 150 -outline {} -fill black -stipple gray50 + if {$what eq "oval"} { + $c create oval 50 10 150 80 -fill black -stipple gray25 -outline "" + $c create oval 100 100 200 150 -outline "" -fill black -stipple gray50 $c create oval 250 100 400 300 -width .5c } - if {$what == "poly"} { + if {$what eq "poly"} { $c create poly 100 200 200 50 300 200 -smooth yes -stipple gray25 \ -outline black -width 4 $c create poly 100 300 100 250 350 250 350 300 350 300 100 300 100 300 \ @@ -66,10 +66,10 @@ proc mkObjs c { 35 50 35 50 45 20 45 $c create poly 300 20 300 120 380 80 320 100 -fill blue -outline black $c create poly 20 200 100 220 90 100 40 250 \ - -fill {} -outline brown -width 3 + -fill "" -outline brown -width 3 } - if {$what == "line"} { + if {$what eq "line"} { $c create line 20 20 120 20 -arrow both -width 5 $c create line 20 80 150 80 20 200 150 200 -smooth yes $c create line 150 20 150 150 250 150 -width .5c -smooth yes \ diff --git a/tests/canvPsImg.tcl b/tests/canvPsImg.tcl index c06aeaa..57b8f55 100644 --- a/tests/canvPsImg.tcl +++ b/tests/canvPsImg.tcl @@ -5,14 +5,14 @@ # Build a test image in a canvas proc BuildTestImage {} { global BitmapImage PhotoImage visual level - catch {destroy .t.f} + destroy .t.f frame .t.f -visual $visual -colormap new pack .t.f -side top -after .t.top bind .t.f <Enter> {wm colormapwindows .t {.t.f .t}} bind .t.f <Leave> {wm colormapwindows .t {.t .t.f}} canvas .t.f.c -width 550 -height 350 -borderwidth 2 -relief raised pack .t.f.c - .t.f.c create rectangle 25 25 525 325 -fill {} -outline black + .t.f.c create rectangle 25 25 525 325 -fill "" -outline black .t.f.c create image 50 50 -anchor nw -image $BitmapImage .t.f.c create image 250 50 -anchor nw -image $PhotoImage } @@ -30,7 +30,7 @@ proc PrintPostcript { canvas } { exec lpr tmp.ps } -catch {destroy .t} +destroy .t toplevel .t wm title .t "Postscript Tests for Canvases: Images" wm iconname .t "Postscript" diff --git a/tests/canvPsText.tcl b/tests/canvPsText.tcl index 08c9d27..8730788 100644 --- a/tests/canvPsText.tcl +++ b/tests/canvPsText.tcl @@ -2,7 +2,7 @@ # for text in canvases. It is part of the Tk visual test suite, # which is invoked via the "visual" script. -catch {destroy .t} +destroy .t toplevel .t wm title .t "Postscript Tests for Canvases" wm iconname .t "Postscript" @@ -25,46 +25,46 @@ button .t.bot.quit -text Quit -command {destroy .t} button .t.bot.print -text Print -command "lpr $c" pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1 -canvas $c -width 6i -height 7i -bd 2 -relief sunken +canvas $c -width 6i -height 7i -borderwidth 2 -relief sunken pack $c -expand yes -fill both -padx 2m -pady 2m -$c create rect 2.95i 0.45i 3.05i 0.55i -fill {} -outline black +$c create rect 2.95i 0.45i 3.05i 0.55i -fill "" -outline black $c create text 3.0i 0.5i -text "Center Courier Oblique 24" \ -anchor center -tags text -font {Courier 24 italic} -stipple $stipple -$c create rect 2.95i 0.95i 3.05i 1.05i -fill {} -outline black +$c create rect 2.95i 0.95i 3.05i 1.05i -fill "" -outline black $c create text 3.0i 1.0i -text "Northwest Helvetica 24" \ -anchor nw -tags text -font {Helvetica 24} -stipple $stipple -$c create rect 2.95i 1.45i 3.05i 1.55i -fill {} -outline black +$c create rect 2.95i 1.45i 3.05i 1.55i -fill "" -outline black $c create text 3.0i 1.5i -text "North Helvetica Oblique 12 " \ -anchor n -tags text -font {Helvetica 12 italic} -stipple $stipple -$c create rect 2.95i 1.95i 3.05i 2.05i -fill {} -outline blue +$c create rect 2.95i 1.95i 3.05i 2.05i -fill "" -outline blue $c create text 3.0i 2.0i -text "Northeast Helvetica Bold 24" \ -anchor ne -tags text -font {Helvetica 24 bold} -stipple $stipple -$c create rect 2.95i 2.45i 3.05i 2.55i -fill {} -outline black +$c create rect 2.95i 2.45i 3.05i 2.55i -fill "" -outline black $c create text 3.0i 2.5i -text "East Helvetica Bold Oblique 18" \ -anchor e -tags text -font {Helvetica 18 {bold italic}} -stipple $stipple -$c create rect 2.95i 2.95i 3.05i 3.05i -fill {} -outline black +$c create rect 2.95i 2.95i 3.05i 3.05i -fill "" -outline black $c create text 3.0i 3.0i -text "Southeast Times 10" \ -anchor se -tags text -font {Times 10} -stipple $stipple -$c create rect 2.95i 3.45i 3.05i 3.55i -fill {} -outline black +$c create rect 2.95i 3.45i 3.05i 3.55i -fill "" -outline black $c create text 3.0i 3.5i -text "South Times Italic 24" \ -anchor s -tags text -font {Times 24 italic} -stipple $stipple -$c create rect 2.95i 3.95i 3.05i 4.05i -fill {} -outline black +$c create rect 2.95i 3.95i 3.05i 4.05i -fill "" -outline black $c create text 3.0i 4.0i -text "Southwest Times Bold 18" \ -anchor sw -tags text -font {Times 18 bold} -stipple $stipple -$c create rect 2.95i 4.45i 3.05i 4.55i -fill {} -outline black +$c create rect 2.95i 4.45i 3.05i 4.55i -fill "" -outline black $c create text 3.0i 4.5i -text "West Times Bold Italic 24"\ -anchor w -tags text -font {Times 24 {bold italic}} -stipple $stipple -$c create rect 0.95i 5.20i 1.05i 5.30i -fill {} -outline black +$c create rect 0.95i 5.20i 1.05i 5.30i -fill "" -outline black $c create text 1.0i 5.25i -width 1.9i -anchor c -justify left -tags text \ -font {Times 18 bold} -stipple $stipple \ -text "This is a sample text item to see how left justification works" -$c create rect 2.95i 5.20i 3.05i 5.30i -fill {} -outline black +$c create rect 2.95i 5.20i 3.05i 5.30i -fill "" -outline black $c create text 3.0i 5.25i -width 1.8i -anchor c -justify center -tags text \ -font {Times 18 bold} -stipple $stipple \ -text "This is a sample text item to see how center justification works" -$c create rect 4.95i 5.20i 5.05i 5.30i -fill {} -outline black +$c create rect 4.95i 5.20i 5.05i 5.30i -fill "" -outline black $c create text 5.0i 5.25i -width 1.8i -anchor c -justify right -tags text \ -font {Times 18 bold} -stipple $stipple \ -text "This is a sample text item to see how right justification works" @@ -73,9 +73,9 @@ $c create text 3.0i 6.0i -width 5.0i -anchor n -justify right -tags text \ -text "This text is\nright justified\nwith a line length equal to\n\ the size of the enclosing rectangle.\nMake sure it prints right\ justified as well." -$c create rect 0.5i 6.0i 5.5i 6.9i -fill {} -outline black +$c create rect 0.5i 6.0i 5.5i 6.9i -fill "" -outline black -proc setStipple c { +proc setStipple {c} { global stipple $c itemconfigure text -stipple $stipple } diff --git a/tests/canvRect.test b/tests/canvRect.test index a2cc51c..baef2e8 100644 --- a/tests/canvRect.test +++ b/tests/canvRect.test @@ -12,21 +12,21 @@ eval tcltest::configure $argv tcltest::loadTestedCommands # Canvas used in every test case of the whole file -canvas .c -width 400 -height 300 -bd 2 -relief sunken +canvas .c -width 400 -height 300 -borderwidth 2 -relief sunken pack .c update # Rectangle used in canvRect-1.* tests .c create rectangle 20 20 80 80 -tag test test canvRect-1.1 {configuration options: good value for -fill} -body { - .c itemconfigure test -fill #ff0000 + .c itemconfigure test -fill "#ff0000" list [.c itemcget test -fill] [lindex [.c itemconfigure test -fill] 4] } -result {{#ff0000} #ff0000} test canvRect-1.2 {configuration options: bad value for -fill} -body { .c itemconfigure test -fill non-existent } -returnCodes error -result {unknown color name "non-existent"} test canvRect-1.3 {configuration options: good value for -outline} -body { - .c itemconfigure test -outline #123456 + .c itemconfigure test -outline "#123456" list [.c itemcget test -outline] [lindex [.c itemconfigure test -outline] 4] } -result {{#123456} #123456} test canvRect-1.4 {configuration options: bad value for -outline} -body { @@ -56,7 +56,6 @@ test canvRect-1.10 {configuration options: bad value for -width} -body { } -returnCodes error -result {bad screen distance "abc"} .c delete withtag all - test canvRect-2.1 {CreateRectOval procedure} -body { .c create rect } -returnCodes error -result {wrong # args: should be ".c create rect coords ?arg ...?"} @@ -88,7 +87,6 @@ test canvRect-2.8 {CreateRectOval procedure} -body { } -returnCodes error -result {unknown option "-gorp"} .c delete withtag all - test canvRect-3.1 {RectOvalCoords procedure} -body { .c create rectangle 10 20 30 40 -tags x set result {} @@ -140,7 +138,6 @@ test canvRect-3.7 {RectOvalCoords procedure} -body { .c delete withtag all } -returnCodes error -result {wrong # coordinates: expected 0 or 4, got 5} - test canvRect-4.1 {ConfigureRectOval procedure} -body { .c create rectangle 10 20 30 40 -tags x -width 1 .c itemconfigure x -width abc @@ -173,7 +170,7 @@ test canvRect-4.4 {ConfigureRectOval procedure} -constraints nonPortable -body { test canvRect-5.1 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: - .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} + .c create rectangle 10 20 30 40 -tags x -width 1 -outline "" .c coords x 20 15 10 5 .c bbox x } -cleanup { @@ -181,7 +178,7 @@ test canvRect-5.1 {ComputeRectOvalBbox procedure} -constraints nonPortable -body } -result {10 5 20 15} test canvRect-5.2 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: - .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} + .c create rectangle 10 20 30 40 -tags x -width 1 -outline "" .c coords x 10 20 30 10 .c itemconfigure x -width 1 -outline red .c bbox x @@ -190,7 +187,7 @@ test canvRect-5.2 {ComputeRectOvalBbox procedure} -constraints nonPortable -body } -result {9 9 31 21} test canvRect-5.3 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: - .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} + .c create rectangle 10 20 30 40 -tags x -width 1 -outline "" .c coords x 10 20 30 10 .c itemconfigure x -width 2 -outline red .c bbox x @@ -199,7 +196,7 @@ test canvRect-5.3 {ComputeRectOvalBbox procedure} -constraints nonPortable -body } -result {9 9 31 21} test canvRect-5.4 {ComputeRectOvalBbox procedure} -constraints nonPortable -body { # Non-portable due to rounding differences: - .c create rectangle 10 20 30 40 -tags x -width 1 -outline {} + .c create rectangle 10 20 30 40 -tags x -width 1 -outline "" .c coords x 10 20 30 10 .c itemconfigure x -width 3 -outline red .c bbox x @@ -212,7 +209,7 @@ test canvRect-5.4 {ComputeRectOvalBbox procedure} -constraints nonPortable -body test canvRect-6.1 {RectToPoint procedure} -body { set xId [.c create rectangle 10 20 30 35 -tags x -fill green] set yId [.c create rectangle 15 25 25 30 -tags y -fill red] - .c itemconfigure y -outline {} + .c itemconfigure y -outline "" list [expr {[.c find closest 14.9 28] eq $xId}] \ [expr {[.c find closest 15.1 28] eq $yId}] \ [expr {[.c find closest 24.9 28] eq $yId}] \ @@ -223,7 +220,7 @@ test canvRect-6.1 {RectToPoint procedure} -body { test canvRect-6.2 {RectToPoint procedure} -body { set xId [.c create rectangle 10 20 30 35 -tags x -fill green] set yId [.c create rectangle 15 25 25 30 -tags y -fill red] - .c itemconfigure y -outline {} + .c itemconfigure y -outline "" list [expr {[.c find closest 20 24.9] eq $xId}] \ [expr {[.c find closest 20 25.1] eq $yId}] \ [expr {[.c find closest 20 29.9] eq $yId}] \ @@ -258,8 +255,8 @@ test canvRect-6.4 {RectToPoint procedure} -body { test canvRect-6.5 {RectToPoint procedure} -body { set xId [.c create rectangle 10 20 30 35 -tags x -fill green] set yId [.c create rectangle 15 25 25 30 -tags y -fill red] - .c itemconfigure x -fill {} -outline black -width 3 - .c itemconfigure y -outline {} + .c itemconfigure x -fill "" -outline black -width 3 + .c itemconfigure y -outline "" list [expr {[.c find closest 13.2 28] eq $xId}] \ [expr {[.c find closest 13.3 28] eq $yId}] \ [expr {[.c find closest 26.7 28] eq $yId}] \ @@ -270,8 +267,8 @@ test canvRect-6.5 {RectToPoint procedure} -body { test canvRect-6.6 {RectToPoint procedure} -body { set xId [.c create rectangle 10 20 30 35 -tags x -fill green] set yId [.c create rectangle 15 25 25 30 -tags y -fill red] - .c itemconfigure x -fill {} -outline black -width 3 - .c itemconfigure y -outline {} + .c itemconfigure x -fill "" -outline black -width 3 + .c itemconfigure y -outline "" list [expr {[.c find closest 20 23.2] eq $xId}] \ [expr {[.c find closest 20 23.3] eq $yId}] \ [expr {[.c find closest 20 31.7] eq $yId}] \ @@ -281,8 +278,8 @@ test canvRect-6.6 {RectToPoint procedure} -body { } -result {1 1 1 1} test canvRect-6.7 {RectToPoint procedure} -body { - set xId [.c create rectangle 10 20 30 40 -outline {} -fill black] - set yId [.c create rectangle 40 40 50 50 -outline {} -fill black] + set xId [.c create rectangle 10 20 30 40 -outline "" -fill black] + set yId [.c create rectangle 40 40 50 50 -outline "" -fill black] list [expr {[.c find closest 35 35] eq $xId}] \ [expr {[.c find closest 36 36] eq $yId}] \ [expr {[.c find closest 37 37] eq $yId}] \ @@ -291,11 +288,10 @@ test canvRect-6.7 {RectToPoint procedure} -body { .c delete all } -result {1 1 1 1} - test canvRect-7.1 {RectToArea procedure} -body { - set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set xId [.c create rectangle 10 20 30 35 -fill green -outline ""] set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] - set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill "" -outline black -width 3] list [expr {[.c find overlapping 20 50 38 60] eq {}}] \ [expr {[.c find overlapping 20 50 39 60] eq $yId}] \ [expr {[.c find overlapping 20 50 70 60] eq $yId}] \ @@ -305,9 +301,9 @@ test canvRect-7.1 {RectToArea procedure} -body { .c delete all } -result {1 1 1 1 1} test canvRect-7.2 {RectToArea procedure} -body { - set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set xId [.c create rectangle 10 20 30 35 -fill green -outline ""] set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] - set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill "" -outline black -width 3] list [expr {[.c find overlapping 45 20 55 43] eq {}}] \ [expr {[.c find overlapping 45 20 55 44] eq $yId}] \ [expr {[.c find overlapping 45 20 55 80] eq $yId}] \ @@ -317,18 +313,18 @@ test canvRect-7.2 {RectToArea procedure} -body { .c delete all } -result {1 1 1 1 1} test canvRect-7.3 {RectToArea procedure} -body { - set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set xId [.c create rectangle 10 20 30 35 -fill green -outline ""] set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] - set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill "" -outline black -width 3] list [expr {[.c find overlapping 5 25 9.9 30] eq {}}] \ [expr {[.c find overlapping 5 25 10.1 30] eq $xId}] } -cleanup { .c delete all } -result {1 1} test canvRect-7.4 {RectToArea procedure} -body { - set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set xId [.c create rectangle 10 20 30 35 -fill green -outline ""] set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] - set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill "" -outline black -width 3] list [expr {[.c find overlapping 102 152 118 168] eq {}}]\ [expr {[.c find overlapping 101 152 118 168] eq $zId}] \ [expr {[.c find overlapping 102 151 118 168] eq $zId}] \ @@ -338,9 +334,9 @@ test canvRect-7.4 {RectToArea procedure} -body { .c delete all } -result {1 1 1 1 1} test canvRect-7.5 {RectToArea procedure} -body { - set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set xId [.c create rectangle 10 20 30 35 -fill green -outline ""] set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] - set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill "" -outline black -width 3] list [expr {[.c find enclosed 20 40 38 80] eq {}}] \ [expr {[.c find enclosed 20 40 39 80] eq {}}] \ [expr {[.c find enclosed 20 40 70 80] eq $yId}] \ @@ -350,9 +346,9 @@ test canvRect-7.5 {RectToArea procedure} -body { .c delete all } -result {1 1 1 1 1} test canvRect-7.6 {RectToArea procedure} -body { - set xId [.c create rectangle 10 20 30 35 -fill green -outline {}] + set xId [.c create rectangle 10 20 30 35 -fill green -outline ""] set yId [.c create rectangle 40 45 60 70 -fill red -outline black -width 3] - set zId [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3] + set zId [.c create rectangle 100 150 120 170 -fill "" -outline black -width 3] list [expr {[.c find enclosed 20 20 65 43] eq {}}] \ [expr {[.c find enclosed 20 20 65 44] eq {}}] \ [expr {[.c find enclosed 20 20 65 80] eq $yId}] \ @@ -362,11 +358,10 @@ test canvRect-7.6 {RectToArea procedure} -body { .c delete all } -result {1 1 1 1 1} - test canvRect-8.1 {OvalToArea procedure} -body { - set xId [.c create oval 50 100 200 150 -fill green -outline {}] + set xId [.c create oval 50 100 200 150 -fill green -outline ""] set yId [.c create oval 50 100 200 150 -fill red -outline black -width 3] - set zId [.c create oval 50 100 200 150 -fill {} -outline black -width 3] + set zId [.c create oval 50 100 200 150 -fill "" -outline black -width 3] list [expr {[.c find overlapping 20 120 48 130] eq {}}] \ [expr {[.c find overlapping 20 120 49 130] eq "$yId $zId"}] \ [expr {[.c find overlapping 20 120 50.2 130] eq "$xId $yId $zId"}] \ @@ -379,9 +374,9 @@ test canvRect-8.1 {OvalToArea procedure} -body { .c delete all } -result {1 1 1 1 1 1 1 1} test canvRect-8.2 {OvalToArea procedure} -body { - set xId [.c create oval 50 100 200 150 -fill green -outline {}] + set xId [.c create oval 50 100 200 150 -fill green -outline ""] set yId [.c create oval 50 100 200 150 -fill red -outline black -width 3] - set zId [.c create oval 50 100 200 150 -fill {} -outline black -width 3] + set zId [.c create oval 50 100 200 150 -fill "" -outline black -width 3] list [expr {[.c find overlapping 100 50 150 98] eq {}}] \ [expr {[.c find overlapping 100 50 150 99] eq "$yId $zId"}] \ [expr {[.c find overlapping 100 50 150 100.1] eq "$xId $yId $zId"}] \ @@ -394,9 +389,9 @@ test canvRect-8.2 {OvalToArea procedure} -body { .c delete all } -result {1 1 1 1 1 1 1 1} test canvRect-8.3 {OvalToArea procedure} -body { - set xId [.c create oval 50 100 200 150 -fill green -outline {}] + set xId [.c create oval 50 100 200 150 -fill green -outline ""] set yId [.c create oval 50 100 200 150 -fill red -outline black -width 3] - set zId [.c create oval 50 100 200 150 -fill {} -outline black -width 3] + set zId [.c create oval 50 100 200 150 -fill "" -outline black -width 3] list [expr {[.c find overlapping 176 104 177 105] eq {}}] \ [expr {[.c find overlapping 187 116 188 117] eq "$xId $yId"}] \ [expr {[.c find overlapping 192 142 193 143] eq {}}] \ @@ -409,7 +404,6 @@ test canvRect-8.3 {OvalToArea procedure} -body { .c delete all } -result {1 1 1 1 1 1 1 1} - test canvRect-9.1 {ScaleRectOval procedure} -setup { .c delete withtag all } -body { @@ -426,7 +420,6 @@ test canvRect-10.1 {TranslateRectOval procedure} -setup { format {%.6g %.6g %.6g %.6g} {*}[.c coords x] } -result {200 290 300 340} - test canvRect-11.1 {RectOvalToPostscript procedure} -constraints { nonPortable macCrash } -setup { @@ -437,9 +430,9 @@ test canvRect-11.1 {RectOvalToPostscript procedure} -constraints { # This test is non-portable because different color information # will get generated on different displays (e.g. mono displays # vs. color). - .c configure -bd 0 -highlightthickness 0 - .c create rect 50 60 90 80 -fill black -stipple gray50 -outline {} - .c create oval 100 150 200 200 -fill {} -outline #ff0000 -width 5 + .c configure -borderwidth 0 -highlightthickness 0 + .c create rect 50 60 90 80 -fill black -stipple gray50 -outline "" + .c create oval 100 150 200 200 -fill "" -outline "#ff0000" -width 5 update set x [.c postscript] string range $x [string first "-200 -150 translate" $x] end diff --git a/tests/canvText.test b/tests/canvText.test index f0c677f..1b7344e 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -12,7 +12,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands # Canvas used in 1.* - 17.* tests -canvas .c -width 400 -height 300 -bd 2 -relief sunken +canvas .c -width 400 -height 300 -borderwidth 2 -relief sunken pack .c update @@ -92,7 +92,6 @@ test canvasText-1.19 {configuration options: bounding of "angle"} -body { } -result {30.0 330.0 0.0} .c delete test - test canvText-2.1 {CreateText procedure: args} -body { .c create text } -returnCodes {error} -result {wrong # args: should be ".c create text coords ?arg ...?"} @@ -118,7 +117,6 @@ test canvText-2.5 {CreateText procedure} -body { .c delete x } -result {0.0 0.0} - test canvText-3.1 {TextCoords procedure} -body { .c create text 20 20 -tag test .c coords test 0 0 @@ -168,7 +166,6 @@ test canvText-3.6 {TextCoords procedure} -setup { .c delete test } -returnCodes {error} -result {wrong # coordinates: expected 0 or 2, got 3} - test canvText-4.1 {ConfigureText procedure} -setup { .c create text 20 20 -tag test } -body { @@ -252,14 +249,12 @@ test canvText-4.6 {ConfigureText procedure: adjust cursor} -setup { .c delete test } -result {4} - test canvText-5.1 {ConfigureText procedure: adjust cursor} -body { .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 \ -text "xyz" .c delete x } -result {} - test canvText-6.1 {ComputeTextBbox procedure} -constraints fonts -setup { .c delete test } -body { @@ -491,7 +486,7 @@ test canvText-7.9 {DisplayText procedure: select end} -setup { .t.c select from $id 0 .t.c select to $id end update - #catch {destroy .t} + #destroy .t update } -cleanup { destroy .t @@ -688,7 +683,6 @@ test canvText-9.15 {TextInsert procedure: cursor doesn't move} -body { } -result {5} .c delete test - test canvText-10.1 {TextToPoint procedure} -body { .c create text 0 0 -tag test .c itemconfig test -text 0 -anchor center @@ -697,7 +691,6 @@ test canvText-10.1 {TextToPoint procedure} -body { .c delete test } -result {0} - test canvText-11.1 {TextToArea procedure} -setup { .c create text 0 0 -tag test focus .c @@ -721,7 +714,6 @@ test canvText-11.2 {TextToArea procedure} -setup { .c delete test } -result {} - test canvText-12.1 {ScaleText procedure} -body { .c create text 100 100 -tag test .c scale all 50 50 2 2 @@ -730,7 +722,6 @@ test canvText-12.1 {ScaleText procedure} -body { .c delete test } -result {150 150} - test canvText-13.1 {TranslateText procedure} -body { .c create text 100 100 -tag test .c move all 10 10 @@ -739,7 +730,6 @@ test canvText-13.1 {TranslateText procedure} -body { .c delete test } -result {110 110} - test canvText-14.1 {GetTextIndex procedure} -setup { .c create text 0 0 -tag test focus .c @@ -850,7 +840,7 @@ end set font {Courier 12 italic} set ax [font measure $font 0] set ay [font metrics $font -linespace] - .c config -height 300 -highlightthickness 0 -bd 0 + .c config -height 300 -highlightthickness 0 -borderwidth 0 update .c create text 100 100 -tags test .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax] @@ -877,7 +867,7 @@ test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} -setup { test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} -setup { destroy .c - set c [canvas .c -bg black -width 964] + set c [canvas .c -background black -width 964] pack $c $c delete all after 100 "set done 1"; vwait done diff --git a/tests/canvWind.test b/tests/canvWind.test index 436ee2c..3bc8739 100644 --- a/tests/canvWind.test +++ b/tests/canvWind.test @@ -15,13 +15,13 @@ test canvWind-1.1 {DisplayWinItem, windows off-screen vertically} -setup { destroy .t } -body { toplevel .t - canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \ + canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -borderwidth 2 \ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \ -highlightthickness 1 pack .t.c -fill both -expand 1 -padx 20 -pady 20 wm geometry .t +0+0 set f .t.f - frame $f -width 80 -height 50 -bg red + frame $f -width 80 -height 50 -background red .t.c create window 300 400 -window $f -anchor nw .t.c xview moveto .3 .t.c yview moveto .50 @@ -47,13 +47,13 @@ test canvWind-1.2 {DisplayWinItem, windows off-screen vertically} -setup { destroy .t } -body { toplevel .t - canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \ + canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -borderwidth 2 \ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \ -highlightthickness 1 pack .t.c -fill both -expand 1 -padx 20 -pady 20 wm geometry .t +0+0 set f .t.c.f - frame $f -width 80 -height 50 -bg red + frame $f -width 80 -height 50 -background red .t.c create window 300 400 -window $f -anchor nw .t.c xview moveto .3 .t.c yview moveto .50 @@ -79,13 +79,13 @@ test canvWind-1.3 {DisplayWinItem, windows off-screen horizontally} -setup { destroy .t } -body { toplevel .t - canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \ + canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -borderwidth 2 \ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \ -highlightthickness 1 pack .t.c -fill both -expand 1 -padx 20 -pady 20 wm geometry .t +0+0 set f .t.f - frame $f -width 80 -height 50 -bg red + frame $f -width 80 -height 50 -background red .t.c create window 300 400 -window $f -anchor nw .t.c xview moveto .3 .t.c yview moveto .50 @@ -111,13 +111,13 @@ test canvWind-1.4 {DisplayWinItem, windows off-screen horizontally} -setup { destroy .t } -body { toplevel .t - canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \ + canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -borderwidth 2 \ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \ -highlightthickness 1 pack .t.c -fill both -expand 1 -padx 20 -pady 20 wm geometry .t +0+0 set f .t.c.f - frame $f -width 80 -height 50 -bg red + frame $f -width 80 -height 50 -background red .t.c create window 300 400 -window $f -anchor nw .t.c xview moveto .3 .t.c yview moveto .50 diff --git a/tests/canvas.test b/tests/canvas.test index 2b0da48..81c6a8b 100644 --- a/tests/canvas.test +++ b/tests/canvas.test @@ -28,18 +28,18 @@ test canvas-1.2 {configuration options: bad value for "background"} -body { .c configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test canvas-1.3 {configuration options: good value for "bg"} -body { - .c configure -bg #ff0000 - .c cget -bg + .c configure -background #ff0000 + .c cget -background } -result {#ff0000} test canvas-1.4 {configuration options: bad value for "bg"} -body { - .c configure -bg non-existent + .c configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test canvas-1.5 {configuration options: good value for "bd"} -body { - .c configure -bd 4 - .c cget -bd + .c configure -borderwidth 4 + .c cget -borderwidth } -result {4} test canvas-1.6 {configuration options: bad value for "bd"} -body { - .c configure -bd badValue + .c configure -borderwidth badValue } -returnCodes error -result {bad screen distance "badValue"} test canvas-1.7 {configuration options: good value for "borderwidth"} -body { .c configure -borderwidth 1.3 @@ -190,7 +190,7 @@ test canvas-1.47 {configure throws error on bad option} -body { catch {destroy .c} # Canvas used in 2.* test cases -canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \ +canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -borderwidth 0 \ -highlightthickness 0 pack .c update @@ -259,10 +259,10 @@ test canvas-4.1 {ButtonEventProc procedure} -setup { deleteWindows set x {} } -body { - canvas .c1 -bg #543210 + canvas .c1 -background #543210 rename .c1 .c2 lappend x [winfo children .] - lappend x [.c2 cget -bg] + lappend x [.c2 cget -background] destroy .c1 lappend x [info command .c*] [winfo children .] } -result {.c1 #543210 {} {}} @@ -502,7 +502,7 @@ test canvas-11.1 {canvas poly fill check, bug 5783} -setup { } -body { # This would crash in 8.3.0 and 8.3.1 .c create polygon 0 0 100 100 200 50 \ - -fill {} -stipple gray50 -outline black + -fill "" -stipple gray50 -outline black } -result 1 test canvas-11.2 {canvas poly overlap fill check, bug 226357} -setup { destroy .c @@ -730,7 +730,7 @@ test canvas-15.19 "basic coords check: centimeters are larger than pixels" -setu set id [.c create rect 0 0 1cm 1cm] expr {[lindex [.c coords $id] 2]>1} } -result {1} -destroy .c +catch {destroy .c} test canvas-16.1 {arc coords check} -setup { canvas .c diff --git a/tests/choosedir.test b/tests/choosedir.test index fb6e62d..3a2932b 100644 --- a/tests/choosedir.test +++ b/tests/choosedir.test @@ -32,12 +32,12 @@ proc PressButton {btn} { proc EnterDirsByKey {parent dirs} { global tk_strictMotif - if {$parent == "."} { + if {$parent eq "."} { set w .__tk_choosedir } else { set w $parent.__tk_choosedir } - upvar ::tk::dialog::file::__tk_choosedir data + upvar 1 ::tk::dialog::file::__tk_choosedir data foreach dir $dirs { $data(ent) delete 0 end @@ -50,19 +50,19 @@ proc EnterDirsByKey {parent dirs} { proc SendButtonPress {parent btn type} { global tk_strictMotif - if {$parent == "."} { + if {$parent eq "."} { set w .__tk_choosedir } else { set w $parent.__tk_choosedir } - upvar ::tk::dialog::file::__tk_choosedir data + upvar 1 ::tk::dialog::file::__tk_choosedir data set button $data($btn\Btn) - if ![winfo ismapped $button] { + if {![winfo ismapped $button]} { update } - if {$type == "mouse"} { + if {$type eq "mouse"} { PressButton $button } else { event generate $w <Enter> @@ -105,7 +105,6 @@ test choosedir-1.6 {tk_chooseDirectory command} -constraints unix -body { tk_chooseDirectory -parent foo.bar } -returnCodes error -result {bad window path name "foo.bar"} - test choosedir-2.1 {tk_chooseDirectory command, cancel gives null} -constraints { unix notAqua } -body { @@ -113,7 +112,6 @@ test choosedir-2.1 {tk_chooseDirectory command, cancel gives null} -constraints tk_chooseDirectory -title "Press Cancel" -parent $parent } -result {} - test choosedir-3.1 {tk_chooseDirectory -mustexist 1} -constraints { unix notAqua } -body { @@ -132,7 +130,6 @@ test choosedir-3.2 {tk_chooseDirectory -mustexist 0} -constraints { -parent $parent -mustexist 0 } -result $fake - test choosedir-4.1 {tk_chooseDirectory command, initialdir} -constraints { unix notAqua } -body { @@ -150,14 +147,13 @@ test choosedir-4.2 {tk_chooseDirectory command, initialdir} -constraints { test choosedir-4.3 {tk_chooseDirectory command, {} initialdir} -constraints { unix notAqua } -body { - catch {unset ::tk::dialog::file::__tk_choosedir} + unset -nocomplain ::tk::dialog::file::__tk_choosedir ToPressButton $parent ok tk_chooseDirectory \ -title "Press OK" \ -parent $parent -initialdir "" } -result [pwd] - test choosedir-5.1 {tk_chooseDirectory, handles {} entry text} -constraints { unix notAqua } -body { diff --git a/tests/clipboard.test b/tests/clipboard.test index 6077940..23d7e16 100644 --- a/tests/clipboard.test +++ b/tests/clipboard.test @@ -32,7 +32,7 @@ test clipboard-1.1 {ClipboardHandler procedure} -setup { clipboard get } -cleanup { clipboard clear -} -result {test} +} -result "test" test clipboard-1.2 {ClipboardHandler procedure} -setup { clipboard clear } -body { @@ -41,7 +41,7 @@ test clipboard-1.2 {ClipboardHandler procedure} -setup { clipboard get } -cleanup { clipboard clear -} -result {testing} +} -result "testing" test clipboard-1.3 {ClipboardHandler procedure} -setup { clipboard clear } -body { @@ -52,7 +52,7 @@ test clipboard-1.3 {ClipboardHandler procedure} -setup { clipboard get } -cleanup { clipboard clear -} -result {test} +} -result "test" test clipboard-1.4 {ClipboardHandler procedure} -setup { clipboard clear } -body { @@ -60,7 +60,7 @@ test clipboard-1.4 {ClipboardHandler procedure} -setup { clipboard get } -cleanup { clipboard clear -} -result "$longValue" +} -result $longValue test clipboard-1.5 {ClipboardHandler procedure} -setup { clipboard clear } -body { @@ -95,7 +95,7 @@ test clipboard-1.8 {ClipboardHandler procedure} -setup { clipboard get } -cleanup { clipboard clear -} -result {} +} -result "" test clipboard-1.9 {ClipboardHandler procedure} -setup { clipboard clear } -body { @@ -104,7 +104,7 @@ test clipboard-1.9 {ClipboardHandler procedure} -setup { clipboard get } -cleanup { clipboard clear -} -result {Test} +} -result "Test" ############################################################################## @@ -118,7 +118,7 @@ test clipboard-2.1 {ClipboardAppHandler procedure} -setup { } -cleanup { tk appname $oldAppName clipboard clear -} -result {UnexpectedName} +} -result "UnexpectedName" ############################################################################## diff --git a/tests/clrpick.test b/tests/clrpick.test index 5f1b8b5..2a2c9f7 100644 --- a/tests/clrpick.test +++ b/tests/clrpick.test @@ -19,20 +19,20 @@ if {[testConstraint defaultPseudocolor8]} { set i 0 canvas .c pack .c -expand 1 -fill both - while {$i<$numcolors} { - set color \#[format "%02x%02x%02x" $i [expr $i+1] [expr $i+3]] - .c create rectangle [expr 10+$i] [expr 10+$i] [expr 50+$i] [expr 50+$i] -fill $color -outline $color + while {$i < $numcolors} { + set color [format "#%02x%02x%02x" $i [expr {$i + 1}] [expr {$i + 3}]] + .c create rectangle [expr {10 + $i}] [expr {10 + $i}] [expr {50 + $i}] [expr {50 + $i}] -fill $color -outline $color incr i } set i 0 - while {$i<$numcolors} { + while {$i < $numcolors} { set color [.c itemcget $i -fill] - if {$color != ""} { - foreach {r g b} [winfo rgb . $color] {} - set r [expr $r/256] - set g [expr $g/256] - set b [expr $b/256] - if {"$color" != "#[format %02x%02x%02x $r $g $b]"} { + if {$color ne ""} { + lassign [winfo rgb . $color] r g b + set r [expr {$r / 256}] + set g [expr {$g / 256}] + set b [expr {$b / 256}] + if {"$color" ne [format "#%02x%02x%02x" $r $g $b]} { testConstraint colorsLeftover 0 } } @@ -103,7 +103,7 @@ proc PressButton {btn} { proc ChooseColorByKey {parent r g b} { set w .__tk__color - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data update $data(red,entry) delete 0 end @@ -124,14 +124,14 @@ proc ChooseColorByKey {parent r g b} { proc SendButtonPress {parent btn type} { set w .__tk__color - upvar ::tk::dialog::color::[winfo name $w] data + upvar 1 ::tk::dialog::color::[winfo name $w] data set button $data($btn\Btn) - if ![winfo ismapped $button] { + if {![winfo ismapped $button]} { update } - if {$type == "mouse"} { + if {$type eq "mouse"} { PressButton $button } else { event generate $w <Enter> @@ -141,8 +141,6 @@ proc SendButtonPress {parent btn type} { } } - - test clrpick-2.1 {tk_chooseColor command} -constraints { nonUnixUserInteraction colorsLeftover } -setup { @@ -163,20 +161,20 @@ test clrpick-2.1 {tk_chooseColor command} -constraints { ToPressButton . ok tk_chooseColor -title "Press Ok $verylongstring" -initialcolor #404040 \ -parent . -} -result {#404040} +} -result "#404040" test clrpick-2.2 {tk_chooseColor command} -constraints { nonUnixUserInteraction colorsLeftover } -body { set colors "128 128 64" ToChooseColorByKey . 128 128 64 tk_chooseColor -parent . -title "choose #808040" -} -result {#808040} +} -result "#808040" test clrpick-2.3 {tk_chooseColor command} -constraints { nonUnixUserInteraction colorsLeftover } -body { ToPressButton . ok tk_chooseColor -parent . -title "Press OK" -} -result {#808040} +} -result "#808040" test clrpick-2.4 {tk_chooseColor command} -constraints { nonUnixUserInteraction colorsLeftover } -body { @@ -184,14 +182,13 @@ test clrpick-2.4 {tk_chooseColor command} -constraints { tk_chooseColor -parent . -title "Press Cancel" } -result {} - test clrpick-3.1 {tk_chooseColor: background events} -constraints { nonUnixUserInteraction } -body { after 1 {set x 53} ToPressButton . ok tk_chooseColor -parent . -title "Press OK" -initialcolor #000000 -} -result {#000000} +} -result "#000000" test clrpick-3.2 {tk_chooseColor: background events} -constraints { nonUnixUserInteraction } -body { @@ -200,7 +197,6 @@ test clrpick-3.2 {tk_chooseColor: background events} -constraints { tk_chooseColor -parent . -title "Press Cancel" } -result {} - test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} -constraints { unix notAqua } -body { diff --git a/tests/cmap.tcl b/tests/cmap.tcl index cca4c24..2e65a1f 100644 --- a/tests/cmap.tcl +++ b/tests/cmap.tcl @@ -2,7 +2,7 @@ # property. It is part of the Tk visual test suite, which is invoked # via the "visual" script. -catch {destroy .t} +destroy .t toplevel .t -colormap new wm title .t "Visual Test for Colormaps" wm iconname .t "Colormaps" @@ -17,9 +17,9 @@ proc colors {w redInc greenInc blueInc} { set blue 0 for {set y 0} {$y < 8} {incr y} { for {set x 0} {$x < 8} {incr x} { - frame $w.f$x,$y -width 40 -height 40 -bd 2 -relief raised \ - -bg [format #%02x%02x%02x $red $green $blue] - place $w.f$x,$y -x [expr 40*$x] -y [expr 40*$y] + frame $w.f$x,$y -width 40 -height 40 -borderwidth 2 -relief raised \ + -background [format "#%02x%02x%02x" $red $green $blue] + place $w.f$x,$y -x [expr {40 * $x}] -y [expr {40 * $y}] incr red $redInc incr green $greenInc incr blue $blueInc @@ -33,16 +33,16 @@ pack .t.m -side top -fill x button .t.quit -text Quit -command {destroy .t} pack .t.quit -side bottom -pady 3 -ipadx 4 -ipady 2 -frame .t.f -width 700 -height 450 -relief raised -bd 2 +frame .t.f -width 700 -height 450 -relief raised -borderwidth 2 pack .t.f -side top -padx 1c -pady 1c colors .t.f 4 0 0 -frame .t.f.f -width 350 -height 350 -colormap new -bd 2 -relief raised +frame .t.f.f -width 350 -height 350 -colormap new -borderwidth 2 -relief raised place .t.f.f -relx 1.0 -rely 0 -anchor ne colors .t.f.f 0 4 0 bind .t.f.f <Enter> {wm colormapwindows .t {.t.f.f .t}} bind .t.f.f <Leave> {wm colormapwindows .t {.t .t.f.f}} -catch {destroy .t2} +destroy .t2 toplevel .t2 wm title .t2 "Visual Test for Colormaps" wm iconname .t2 "Colormaps" diff --git a/tests/color.test b/tests/color.test index a7ed1f8..f9d86fa 100644 --- a/tests/color.test +++ b/tests/color.test @@ -35,14 +35,14 @@ proc cname4 {r g b} { # ry, gy, by - Change in intensities between adjacent elements in column. proc mkColors {c width height r g b rx gx bx ry gy by} { - catch {destroy $c} - canvas $c -width 400 -height 200 -bd 0 + destroy $c + canvas $c -width 400 -height 200 -borderwidth 0 for {set y 0} {$y < $height} {incr y} { for {set x 0} {$x < $width} {incr x} { - set color [format #%02x%02x%02x [expr $r + $y*$ry + $x*$rx] \ - [expr $g + $y*$gy + $x*$gx] [expr $b + $y*$by + $x*$bx]] - $c create rectangle [expr 10*$x] [expr 20*$y] \ - [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ + set color [format "#%02x%02x%02x" [expr {$r + ($y * $ry) + ($x * $rx)}] \ + [expr {$g + ($y * $gy) + ($x * $gx)}] [expr {$b + ($y * $by) + ($x * $bx)}]] + $c create rectangle [expr {10 * $x}] [expr {20 * $y}] \ + [expr {(10 * $x) + 10}] [expr {(20 * $y) + 20}] -outline "" \ -fill $color } } @@ -57,9 +57,9 @@ proc mkColors {c width height r g b rx gx bx ry gy by} { # r, g, b - Desired intensities, between 0 and 255. proc closest {w r g b} { - set vals [winfo rgb $w [cname $r $g $b]] - list [expr [lindex $vals 0]/256] [expr [lindex $vals 1]/256] \ - [expr [lindex $vals 2]/256] + lassign [winfo rgb $w [cname $r $g $b]] v_r v_g v_b + list [expr {$v_r / 256}] [expr {$v_g / 256}] \ + [expr {$v_b / 256}] } # c255 - @@ -70,8 +70,9 @@ proc closest {w r g b} { # vals - List of intensities. proc c255 {vals} { - list [expr {[lindex $vals 0]/256}] [expr {[lindex $vals 1]/256}] \ - [expr {[lindex $vals 2]/256}] + lassign $vals v_r v_g v_b + list [expr {$v_r / 256}] [expr {$v_g / 256}] \ + [expr {$v_b / 256}] } # colorsFree -- @@ -85,9 +86,9 @@ proc c255 {vals} { # to see if there are colormap entries free. proc colorsFree {w {red 31} {green 245} {blue 192}} { - set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]] - expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \ - && ([lindex $vals 2]/256 == $blue) + lassign [winfo rgb $w [format "#%02x%02x%02x" $red $green $blue]] v_r v_g v_b + expr {(($v_r / 256) == $red) && (($v_g / 256) == $green) \ + && (($v_b / 256) == $blue)} } if {[testConstraint psuedocolor8]} { @@ -120,7 +121,7 @@ test color-1.2 {Tk_AllocColorFromObj - discard stale color} colorsFree { destroy .b1 .b2 button .b1 -foreground $x -text First destroy .b1 - set result {} + set result [list] lappend result [testcolor green] button .b2 -foreground $x -text Second lappend result [testcolor green] @@ -129,7 +130,7 @@ test color-1.3 {Tk_AllocColorFromObj - reuse existing color} colorsFree { set x green destroy .b1 .b2 button .b1 -foreground $x -text First - set result {} + set result [list] lappend result [testcolor green] button .b2 -foreground $x -text Second pack .b1 .b2 -side top @@ -140,7 +141,7 @@ test color-1.4 {Tk_AllocColorFromObj - try other colors in list} colorsFree { destroy .b1 .b2 .t.b button .b1 -foreground $x -text First pack .b1 -side top - set result {} + set result [list] lappend result [testcolor purple] button .t.b -foreground $x -text Second pack .t.b -side top @@ -151,9 +152,9 @@ test color-1.4 {Tk_AllocColorFromObj - try other colors in list} colorsFree { } {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} test color-1.5 {Color table} nonPortable { set fd [open ../xlib/rgb.txt] - set result {} + set result [list] while {[gets $fd line] != -1} { - if {[string index $line 0] == "!"} continue + if {[string index $line 0] ne "!"} continue set rgb [c255 [winfo rgb . [lrange $line 3 end]]] if {$rgb != [lrange $line 0 2] } { append result $line\n @@ -164,26 +165,26 @@ test color-1.5 {Color table} nonPortable { } {} test color-2.1 {Tk_GetColor procedure} colorsFree { - c255 [winfo rgb .t #FF0000] + c255 [winfo rgb .t "#FF0000"] } {255 0 0} test color-2.2 {Tk_GetColor procedure} colorsFree { list [catch {winfo rgb .t noname} msg] $msg } {1 {unknown color name "noname"}} test color-2.3 {Tk_GetColor procedure} colorsFree { - c255 [winfo rgb .t #123456] + c255 [winfo rgb .t "#123456"] } {18 52 86} test color-2.4 {Tk_GetColor procedure} colorsFree { list [catch {winfo rgb .t #xyz} msg] $msg } {1 {invalid color name "#xyz"}} test color-2.5 {Tk_GetColor procedure} colorsFree { - winfo rgb .t #00FF00 + winfo rgb .t "#00FF00" } {0 65535 0} test color-2.6 {Tk_GetColor procedure} {colorsFree nonPortable} { # Red doesn't always map to *pure* red winfo rgb .t red } {65535 0 0} test color-2.7 {Tk_GetColor procedure} colorsFree { - winfo rgb .t #ff0000 + winfo rgb .t "#ff0000" } {65535 0 0} test color-3.1 {Tk_FreeColor procedure, reference counting} colorsFree { @@ -193,7 +194,7 @@ test color-3.1 {Tk_FreeColor procedure, reference counting} colorsFree { mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0 pack .t.c2 update - set last [.t.c2 create rectangle 50 50 70 60 -outline {} \ + set last [.t.c2 create rectangle 50 50 70 60 -outline "" \ -fill [cname 0 240 240]] .t.c delete 1 set result [colorsFree .t] diff --git a/tests/config.test b/tests/config.test index 8f7aa9f..5ba4933 100644 --- a/tests/config.test +++ b/tests/config.test @@ -18,13 +18,12 @@ proc killTables {} { deleteWindows foreach t {alltypes chain2 chain1 configerror internal new notenoughparams twowindows} { - while {[testobjconfig info $t] != ""} { + while {[testobjconfig info $t] ne ""} { testobjconfig delete $t } } } - option clear deleteWindows if {[testConstraint testobjconfig]} { @@ -119,7 +118,6 @@ test config-1.9 {Tk_CreateOptionTable - chained tables} -constraints { killTables } -result {one four one} - test config-2.1 {Tk_DeleteOptionTable - reference counts} -constraints { testobjconfig } -body { @@ -1110,7 +1108,6 @@ test config-4.115 {DoObjConfig - custom internal value} -constraints { killTables } -result {THIS IS A TEST} - test config-5.1 {ObjectIsEmpty - object is already string} -constraints { testobjconfig } -body { @@ -1135,7 +1132,6 @@ test config-5.3 {ObjectIsEmpty - must convert back to string} -constraints { killTables } -result {} - test config-6.1 {GetOptionFromObj - cached answer} -constraints { testobjconfig } -body { @@ -1185,7 +1181,6 @@ test config-6.6 {GetOptionFromObj - synonym} -constraints testobjconfig -body { killTables } -result {red} - if {[testConstraint testobjconfig]} { testobjconfig alltypes .a } @@ -1277,7 +1272,6 @@ if {[testConstraint testobjconfig]} { killTables } - test config-8.1 {Tk_RestoreSavedOptions - restore in proper order} -constraints { testobjconfig } -body { @@ -1548,7 +1542,7 @@ test config-9.12 {Tk_FreeConfigOptions/FreeResources - not special} -constraints test config-9.13 {Tk_FreeConfigOptions/FreeResources - custom internal form} -constraints { testobjconfig } -body { - catch {destroy .fpp} + destroy .fpp testobjconfig internal .foo .foo configure -custom "foobar" destroy .foo @@ -1557,7 +1551,6 @@ if {[testConstraint testobjconfig]} { killTables } - test config-10.1 {Tk_GetOptionInfo - one item} -constraints testobjconfig -body { testobjconfig alltypes .foo .foo configure -relief groove @@ -1592,7 +1585,6 @@ if {[testConstraint testobjconfig]} { killTables } - if {[testConstraint testobjconfig]} { testobjconfig alltypes .a } @@ -1613,7 +1605,6 @@ if {[testConstraint testobjconfig]} { killTables } - if {[testConstraint testobjconfig]} { testobjconfig internal .a } @@ -1702,7 +1693,6 @@ if {[testConstraint testobjconfig]} { killTables } - test config-13.1 {proper cleanup of options with widget destroy} -body { button .w -cursor crosshair destroy .w diff --git a/tests/constraints.tcl b/tests/constraints.tcl index e28b159..fe7c3c5 100644 --- a/tests/constraints.tcl +++ b/tests/constraints.tcl @@ -26,9 +26,9 @@ namespace eval tk { namespace export loadTkCommand proc loadTkCommand {} { - set tklib {} + set tklib "" foreach pair [info loaded {}] { - foreach {lib pfx} $pair break + lassign $pair lib pfx if {$pfx eq "Tk"} { set tklib $lib break @@ -47,37 +47,37 @@ namespace eval tk { proc cleanup {} { variable fd # catch in case the background process has closed $fd - catch {puts $fd exit} - catch {close $fd} + catch {chan puts $fd exit} + catch {chan close $fd} set fd "" } - proc setup args { + proc setup {args} { variable fd if {[info exists fd] && [string length $fd]} { cleanup } set fd [open "|[list [interpreter] \ -geometry +0+0 -name tktest] $args" r+] - puts $fd "puts foo; flush stdout" - flush $fd - if {[gets $fd data] < 0} { + chan puts $fd "puts foo; flush stdout" + chan flush $fd + if {[chan gets $fd data] < 0} { error "unexpected EOF from \"[interpreter]\"" } if {$data ne "foo"} { error "unexpected output from\ background process: \"$data\"" } - puts $fd [loadTkCommand] - flush $fd - fileevent $fd readable [namespace code Ready] + chan puts $fd [loadTkCommand] + chan flush $fd + chan event $fd readable [namespace code Ready] } proc Ready {} { variable fd variable Data variable Done - set x [gets $fd] - if {[eof $fd]} { - fileevent $fd readable {} + set x [chan gets $fd] + if {[chan eof $fd]} { + chan event $fd readable {} set Done 1 } elseif {$x eq "**DONE**"} { set Done 1 @@ -90,15 +90,15 @@ namespace eval tk { variable Data variable Done if {$block} { - fileevent $fd readable {} + chan event $fd readable {} } - puts $fd "[list catch $cmd msg]; update; puts \$msg;\ + chan puts $fd "[list catch $cmd msg]; update; puts \$msg;\ puts **DONE**; flush stdout" - flush $fd + chan flush $fd set Data {} if {$block} { - while {![eof $fd]} { - set line [gets $fd] + while {![chan eof $fd]} { + set line [chan gets $fd] if {$line eq "**DONE**"} { break } @@ -123,12 +123,12 @@ namespace eval tk { namespace export deleteWindows proc deleteWindows {} { - eval destroy [winfo children .] + destroy {*}[winfo children .] } namespace export fixfocus proc fixfocus {} { - catch {destroy .focus} + destroy .focus toplevel .focus wm geometry .focus +0+0 entry .focus.e @@ -191,12 +191,12 @@ testConstraint nonUnixUserInteraction [expr { testConstraint haveDISPLAY [info exists env(DISPLAY)] testConstraint altDisplay [info exists env(TK_ALT_DISPLAY)] testConstraint noExceed [expr { - ![testConstraint unix] || [catch {font actual "\{xyz"}] + (![testConstraint unix]) || [catch {font actual "\{xyz"}] }] # constraints for testing facilities defined in the tktest executable... -testConstraint testImageType [expr {[lsearch [image types] test] >= 0}] -testConstraint testOldImageType [expr {[lsearch [image types] oldtest] >= 0}] +testConstraint testImageType [expr {"test" in [image types]}] +testConstraint testOldImageType [expr {"oldtest" in [image types]}] testConstraint testbitmap [llength [info commands testbitmap]] testConstraint testborder [llength [info commands testborder]] testConstraint testcbind [llength [info commands testcbind]] @@ -218,14 +218,14 @@ testConstraint testwrapper [llength [info commands testwrapper]] # constraint to see what sort of fonts are available testConstraint fonts 1 destroy .e -entry .e -width 0 -font {Helvetica -12} -bd 1 -highlightthickness 1 +entry .e -width 0 -font "Helvetica -12" -borderwidth 1 -highlightthickness 1 .e insert end a.bcd if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} { testConstraint fonts 0 } destroy .e destroy .t -text .t -width 80 -height 20 -font {Times -14} -bd 1 +text .t -width 80 -height 20 -font {Times -14} -borderwidth 1 pack .t .t insert end "This is\na dot." update @@ -235,7 +235,7 @@ if {![string match {{22 3 6 15} {31 18 [34] 15}} $x]} { testConstraint fonts 0 } testConstraint textfonts [expr { - [testConstraint fonts] || [tk windowingsystem] eq "win32" + [testConstraint fonts] || ([tk windowingsystem] eq "win32") }] # constraints for the visuals available.. @@ -246,10 +246,10 @@ testConstraint pseudocolor8 [expr { }] destroy .t testConstraint haveTruecolor24 [expr { - [lsearch -exact [winfo visualsavailable .] {truecolor 24}] >= 0 + "truecolor 24" in [winfo visualsavailable .] }] testConstraint haveGrayscale8 [expr { - [lsearch -exact [winfo visualsavailable .] {grayscale 8}] >= 0 + "grayscale 8" in [winfo visualsavailable .] }] testConstraint defaultPseudocolor8 [expr { ([winfo visual .] eq "pseudocolor") && ([winfo depth .] == 8) diff --git a/tests/cursor.test b/tests/cursor.test index 1039b52..835d767 100644 --- a/tests/cursor.test +++ b/tests/cursor.test @@ -11,11 +11,10 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands - # Tests 2.3 and 2.4 need a helper file with a very specific name and # controlled format. proc setWincur {wincurName} { - upvar $wincurName wincur + upvar 1 $wincurName wincur set wincur(data_octal) { 000 000 002 000 001 000 040 040 000 000 007 000 007 000 060 001 000 000 026 000 000 000 050 000 000 000 040 000 000 000 100 000 @@ -39,7 +38,7 @@ proc setWincur {wincurName} { 377 377 200 001 377 377 001 200 377 377 003 300 377 377 007 340 377 377 017 360 377 377 } - set wincur(data_binary) {} + set wincur(data_binary) "" foreach wincur(num) $wincur(data_octal) { append wincur(data_binary) [binary format c [scan $wincur(num) %o]] } @@ -47,7 +46,6 @@ proc setWincur {wincurName} { set wincur(file) [makeFile $wincur(data_binary) "test file.cur" $wincur(dir)] } - test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} -constraints { testcursor } -body { diff --git a/tests/dialog.test b/tests/dialog.test index 78b6620..63ddccd 100644 --- a/tests/dialog.test +++ b/tests/dialog.test @@ -8,7 +8,7 @@ namespace import -force tcltest::test test dialog-1.1 {tk_dialog command} -body { tk_dialog -} -match glob -returnCodes error -result {wrong # args: should be "tk_dialog w title text bitmap default *"} +} -match glob -returnCodes error -result {wrong # args: should be "tk_dialog w title text bitmap a_default *"} test dialog-1.2 {tk_dialog command} -body { tk_dialog foo foo foo foo foo } -returnCodes error -result {bad window path name "foo"} @@ -18,7 +18,6 @@ test dialog-1.3 {tk_dialog command} -body { destroy .d } -returnCodes error -result {bitmap "fooBitmap" not defined} - test dialog-2.1 {tk_dialog operation} -setup { proc PressButton {btn} { if {![winfo ismapped $btn]} { diff --git a/tests/embed.test b/tests/embed.test index 1fe73ef..65bdc0e 100644 --- a/tests/embed.test +++ b/tests/embed.test @@ -9,7 +9,6 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands - test embed-1.1 {TkpUseWindow procedure, bad window identifier} -setup { deleteWindows } -body { @@ -81,7 +80,6 @@ test embed-1.5.nonwin {TkpUseWindow procedure, -container must be set} -constrai deleteWindows } -returnCodes error -result {window ".container" doesn't have -container option set} - cleanupTests return diff --git a/tests/entry.test b/tests/entry.test index 11408ac..40c09b9 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -12,12 +12,12 @@ eval tcltest::configure $argv tcltest::loadTestedCommands # For xscrollcommand -proc scroll args { +proc scroll {args} { global scrollInfo set scrollInfo $args } # For trace variable -proc override args { +proc override {args} { global x set x 12345 } @@ -39,7 +39,6 @@ proc doval3 {W d i P s S v V} { set cy [font metrics {Courier -12} -linespace] - test entry-1.1 {configuration option: "background" for entry} -setup { entry .e -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .e @@ -65,8 +64,8 @@ test entry-1.3 {configuration option: "bd" for entry} -setup { pack .e update } -body { - .e configure -bd 4 - .e cget -bd + .e configure -borderwidth 4 + .e cget -borderwidth } -cleanup { destroy .e } -result {4} @@ -75,7 +74,7 @@ test entry-1.4 {configuration option: "bd" for entry} -setup { pack .e update } -body { - .e configure -bd badValue + .e configure -borderwidth badValue } -cleanup { destroy .e } -returnCodes {error} -result {bad screen distance "badValue"} @@ -85,8 +84,8 @@ test entry-1.5 {configuration option: "bg" for entry} -setup { pack .e update } -body { - .e configure -bg #ff0000 - .e cget -bg + .e configure -background #ff0000 + .e cget -background } -cleanup { destroy .e } -result {#ff0000} @@ -95,7 +94,7 @@ test entry-1.6 {configuration option: "bg" for entry} -setup { pack .e update } -body { - .e configure -bg non-existent + .e configure -background non-existent } -cleanup { destroy .e } -returnCodes {error} -result {unknown color name "non-existent"} @@ -205,8 +204,8 @@ test entry-1.17 {configuration option: "fg" for entry} -setup { pack .e update } -body { - .e configure -fg #110022 - .e cget -fg + .e configure -foreground #110022 + .e cget -foreground } -cleanup { destroy .e } -result {#110022} @@ -215,7 +214,7 @@ test entry-1.18 {configuration option: "fg" for entry} -setup { pack .e update } -body { - .e configure -fg non-existent + .e configure -foreground non-existent } -cleanup { destroy .e } -returnCodes {error} -result {unknown color name "non-existent"} @@ -627,8 +626,6 @@ test entry-1.58 {configuration option: "xscrollcommand" for entry} -setup { destroy .e } -result {Some command} - - test entry-2.1 {Tk_EntryCmd procedure} -body { entry } -returnCodes error -result {wrong # args: should be "entry pathName ?-option value ...?"} @@ -660,7 +657,6 @@ test entry-2.5 {Tk_EntryCmd procedure} -body { destroy .e } -result {.e} - test entry-3.1 {EntryWidgetCmd procedure} -setup { entry .e pack .e @@ -795,8 +791,8 @@ test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} -setup { test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} -setup { entry .e } -body { - .e configure -bd 4 - .e cget -bd + .e configure -borderwidth 4 + .e cget -borderwidth } -cleanup { destroy .e } -result {4} @@ -819,9 +815,9 @@ test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} -setup { test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} -setup { entry .e } -body { - .e configure -bd 4 - .e configure -bg #ffffff - lindex [.e configure -bd] 4 + .e configure -borderwidth 4 + .e configure -background #ffffff + lindex [.e configure -borderwidth] 4 } -cleanup { destroy .e } -result {4} @@ -1678,7 +1674,6 @@ test entry-5.7 {ConfigureEntry procedure} -setup { destroy .e } -result {0.000000 0.363636} - test entry-5.8 {ConfigureEntry procedure} -constraints { fonts } -setup { @@ -1700,7 +1695,7 @@ test entry-5.9 {ConfigureEntry procedure} -constraints { entry .e -borderwidth 2 -highlightthickness 2 pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised + .e configure -font {Courier -12} -borderwidth 2 -relief raised .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] @@ -1713,7 +1708,7 @@ test entry-5.10 {ConfigureEntry procedure} -constraints { entry .e -borderwidth 2 -highlightthickness 2 pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief flat + .e configure -font {Courier -12} -borderwidth 2 -relief flat .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] @@ -1740,7 +1735,7 @@ test entry-6.1 {EntryComputeGeometry procedure} -constraints { entry .e pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 20 \ -highlightthickness 3 .e insert end 012\t45 update @@ -1754,7 +1749,7 @@ test entry-6.2 {EntryComputeGeometry procedure} -constraints { entry .e pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 20 \ -justify center -highlightthickness 3 .e insert end 012\t45 update @@ -1768,7 +1763,7 @@ test entry-6.3 {EntryComputeGeometry procedure} -constraints { entry .e pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 20 \ + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 20 \ -justify right -highlightthickness 3 .e insert end 012\t45 update @@ -1780,7 +1775,7 @@ test entry-6.4 {EntryComputeGeometry procedure} -setup { entry .e pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 5 + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 6 @@ -1792,7 +1787,7 @@ test entry-6.5 {EntryComputeGeometry procedure} -setup { entry .e -highlightthickness 2 pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 5 + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 7 @@ -1806,7 +1801,7 @@ test entry-6.6 {EntryComputeGeometry procedure} -constraints { entry .e -highlightthickness 2 pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 10 + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 10 .e insert end "01234\t67890" update .e xview 3 @@ -1820,7 +1815,7 @@ test entry-6.7 {EntryComputeGeometry procedure} -constraints { entry .e -highlightthickness 2 pack .e } -body { - .e configure -font {Helvetica -24} -bd 3 -relief raised -width 5 + .e configure -font {Helvetica -24} -borderwidth 3 -relief raised -width 5 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] @@ -1833,7 +1828,7 @@ test entry-6.8 {EntryComputeGeometry procedure} -constraints { entry .e -highlightthickness 2 pack .e } -body { - .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 + .e configure -font {Helvetica -24} -borderwidth 3 -relief raised -width 0 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] @@ -1846,7 +1841,7 @@ test entry-6.9 {EntryComputeGeometry procedure} -constraints { entry .e -highlightthickness 2 pack .e } -body { - .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 + .e configure -font {Helvetica -24} -borderwidth 3 -relief raised -width 0 update list [winfo reqwidth .e] [winfo reqheight .e] } -cleanup { @@ -1858,7 +1853,7 @@ test entry-6.10 {EntryComputeGeometry procedure} -constraints { entry .e -highlightthickness 2 -font {Helvetica -12} pack .e } -body { - .e configure -bd 1 -relief raised -width 0 -show . + .e configure -borderwidth 1 -relief raised -width 0 -show . .e insert 0 12345 update set x [winfo reqwidth .e] @@ -1875,7 +1870,7 @@ test entry-6.11 {EntryComputeGeometry procedure} -constraints { entry .e -highlightthickness 2 pack .e } -body { - .e configure -bd 1 -relief raised -width 0 -show . -font {helvetica 12} + .e configure -borderwidth 1 -relief raised -width 0 -show . -font {helvetica 12} .e insert 0 12345 update set x1 [winfo reqwidth .e] @@ -1893,10 +1888,9 @@ test entry-6.11 {EntryComputeGeometry procedure} -constraints { destroy .e } -result {1 1 1} - test entry-7.1 {InsertChars procedure} -setup { unset -nocomplain contents - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -1911,7 +1905,7 @@ test entry-7.1 {InsertChars procedure} -setup { test entry-7.2 {InsertChars procedure} -setup { unset -nocomplain contents - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -1924,7 +1918,7 @@ test entry-7.2 {InsertChars procedure} -setup { destroy .e } -result {abcdeXXX abcdeXXX {0.000000 1.000000}} test entry-7.3 {InsertChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -1938,7 +1932,7 @@ test entry-7.3 {InsertChars procedure} -setup { destroy .e } -result {5 9 5 8} test entry-7.4 {InsertChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -1952,7 +1946,7 @@ test entry-7.4 {InsertChars procedure} -setup { destroy .e } -result {2 9 2 8} test entry-7.5 {InsertChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -1966,7 +1960,7 @@ test entry-7.5 {InsertChars procedure} -setup { destroy .e } -result {2 9 2 8} test entry-7.6 {InsertChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -1980,7 +1974,7 @@ test entry-7.6 {InsertChars procedure} -setup { destroy .e } -result {2 6 2 5} test entry-7.7 {InsertChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -xscrollcommand scroll @@ -1992,7 +1986,7 @@ test entry-7.7 {InsertChars procedure} -setup { destroy .e } -result {7} test entry-7.8 {InsertChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -2003,7 +1997,7 @@ test entry-7.8 {InsertChars procedure} -setup { destroy .e } -result {4} test entry-7.9 {InsertChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 "This is a very long string" @@ -2015,7 +2009,7 @@ test entry-7.9 {InsertChars procedure} -setup { destroy .e } -result {7} test entry-7.10 {InsertChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 "This is a very long string" @@ -2030,7 +2024,7 @@ test entry-7.10 {InsertChars procedure} -setup { test entry-7.11 {InsertChars procedure} -constraints { fonts } -setup { - entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 0 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 "xyzzy" @@ -2043,7 +2037,7 @@ test entry-7.11 {InsertChars procedure} -constraints { test entry-8.1 {DeleteChars procedure} -setup { unset -nocomplain contents - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2057,7 +2051,7 @@ test entry-8.1 {DeleteChars procedure} -setup { } -result {abe abe {0.000000 1.000000}} test entry-8.2 {DeleteChars procedure} -setup { unset -nocomplain contents - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2071,7 +2065,7 @@ test entry-8.2 {DeleteChars procedure} -setup { } -result {cde cde {0.000000 1.000000}} test entry-8.3 {DeleteChars procedure} -setup { unset -nocomplain contents - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2084,7 +2078,7 @@ test entry-8.3 {DeleteChars procedure} -setup { destroy .e } -result {abc abc {0.000000 1.000000}} test entry-8.4 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2100,7 +2094,7 @@ test entry-8.4 {DeleteChars procedure} -setup { destroy .e } -result {1 6 1 5} test entry-8.5 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2116,7 +2110,7 @@ test entry-8.5 {DeleteChars procedure} -setup { destroy .e } -result {1 5 1 4} test entry-8.6 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2132,7 +2126,7 @@ test entry-8.6 {DeleteChars procedure} -setup { destroy .e } -result {1 2 1 5} test entry-8.7 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2146,7 +2140,7 @@ test entry-8.7 {DeleteChars procedure} -setup { destroy .e } -returnCodes error -result {selection isn't in widget .e} test entry-8.8 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2162,7 +2156,7 @@ test entry-8.8 {DeleteChars procedure} -setup { destroy .e } -result {3 4 3 8} test entry-8.9 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789abcde @@ -2175,7 +2169,7 @@ test entry-8.9 {DeleteChars procedure} -setup { destroy .e } -returnCodes error -result {selection isn't in widget .e} test entry-8.10 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2191,7 +2185,7 @@ test entry-8.10 {DeleteChars procedure} -setup { destroy .e } -result {3 5 5 8} test entry-8.11 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2207,7 +2201,7 @@ test entry-8.11 {DeleteChars procedure} -setup { destroy .e } -result {3 8 4 8} test entry-8.12 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2220,7 +2214,7 @@ test entry-8.12 {DeleteChars procedure} -setup { destroy .e } -result {1} test entry-8.13 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2233,7 +2227,7 @@ test entry-8.13 {DeleteChars procedure} -setup { destroy .e } -result {1} test entry-8.14 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2246,7 +2240,7 @@ test entry-8.14 {DeleteChars procedure} -setup { destroy .e } -result {4} test entry-8.15 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2259,7 +2253,7 @@ test entry-8.15 {DeleteChars procedure} -setup { destroy .e } -result {1} test entry-8.16 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2272,7 +2266,7 @@ test entry-8.16 {DeleteChars procedure} -setup { destroy .e } -result {1} test entry-8.17 {DeleteChars procedure} -setup { - entry .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2285,7 +2279,7 @@ test entry-8.17 {DeleteChars procedure} -setup { destroy .e } -result {4} test entry-8.18 {DeleteChars procedure} -setup { - entry .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + entry .e -width 0 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2310,11 +2304,10 @@ test entry-9.1 {EntryValueChanged procedure} -setup { unset x } -result {12345 12345} - test entry-10.1 {EntrySetValue procedure} -constraints fonts -body { set x abcde set y ab - entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 -width 0 + entry .e -font {Helvetica -12} -highlightthickness 2 -borderwidth 2 -width 0 pack .e .e configure -textvariable x .e configure -textvariable y @@ -2325,7 +2318,7 @@ test entry-10.1 {EntrySetValue procedure} -constraints fonts -body { } -result {ab 24} test entry-10.2 {EntrySetValue procedure, updating selection} -setup { unset -nocomplain x - entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + entry .e -font {Helvetica -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -textvariable x @@ -2338,7 +2331,7 @@ test entry-10.2 {EntrySetValue procedure, updating selection} -setup { } -returnCodes error -result {selection isn't in widget .e} test entry-10.3 {EntrySetValue procedure, updating selection} -setup { unset -nocomplain x - entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + entry .e -font {Helvetica -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -textvariable x @@ -2351,7 +2344,7 @@ test entry-10.3 {EntrySetValue procedure, updating selection} -setup { } -result {4 7} test entry-10.4 {EntrySetValue procedure, updating selection} -setup { unset -nocomplain x - entry .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + entry .e -font {Helvetica -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -textvariable x @@ -2364,7 +2357,7 @@ test entry-10.4 {EntrySetValue procedure, updating selection} -setup { } -result {4 10} test entry-10.5 {EntrySetValue procedure, updating display position} -setup { unset -nocomplain x - entry .e -highlightthickness 2 -bd 2 + entry .e -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -width 10 -font {Courier -12} -textvariable x @@ -2379,7 +2372,7 @@ test entry-10.5 {EntrySetValue procedure, updating display position} -setup { } -result {0} test entry-10.6 {EntrySetValue procedure, updating display position} -setup { unset -nocomplain x - entry .e -highlightthickness 2 -bd 2 + entry .e -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -width 10 -font {Courier -12} -textvariable x @@ -2395,7 +2388,7 @@ test entry-10.6 {EntrySetValue procedure, updating display position} -setup { } -result {10} test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { unset -nocomplain x - entry .e -highlightthickness 2 -bd 2 + entry .e -highlightthickness 2 -borderwidth 2 pack .e update } -body { @@ -2410,7 +2403,7 @@ test entry-10.7 {EntrySetValue procedure, updating insertion cursor} -setup { } -result {3} test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { unset -nocomplain x - entry .e -highlightthickness 2 -bd 2 + entry .e -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -width 10 -font {Courier -12} -textvariable x @@ -2424,7 +2417,7 @@ test entry-10.8 {EntrySetValue procedure, updating insertion cursor} -setup { } -result {5} test entry-11.1 {EntryEventProc procedure} -setup { - entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} + entry .e -highlightthickness 2 -borderwidth 2 -font {Helvetica -12} pack .e } -body { .e insert 0 abcdefg @@ -2436,10 +2429,10 @@ test entry-11.1 {EntryEventProc procedure} -setup { test entry-11.2 {EntryEventProc procedure} -setup { set x {} } -body { - entry .e1 -fg #112233 + entry .e1 -foreground #112233 rename .e1 .e2 lappend x [winfo children .] - lappend x [.e2 cget -fg] + lappend x [.e2 cget -foreground] destroy .e1 lappend x [info command .e*] [winfo children .] } -cleanup { @@ -2454,9 +2447,8 @@ test entry-12.1 {EntryCmdDeletedProc procedure} -body { destroy .b } -result {{} {}} - test entry-13.1 {GetEntryIndex procedure} -setup { - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2473,7 +2465,7 @@ test entry-13.2 {GetEntryIndex procedure} -body { destroy .e } -returnCodes error -result {bad entry index "abogus"} test entry-13.3 {GetEntryIndex procedure} -setup { - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2486,7 +2478,7 @@ test entry-13.3 {GetEntryIndex procedure} -setup { destroy .e } -result {1} test entry-13.4 {GetEntryIndex procedure} -setup { - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2499,7 +2491,7 @@ test entry-13.4 {GetEntryIndex procedure} -setup { destroy .e } -result {4} test entry-13.5 {GetEntryIndex procedure} -setup { - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2520,7 +2512,7 @@ test entry-13.6 {GetEntryIndex procedure} -setup { destroy .e } -returnCodes error -result {bad entry index "ebogus"} test entry-13.7 {GetEntryIndex procedure} -setup { - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2539,7 +2531,7 @@ test entry-13.8 {GetEntryIndex procedure} -setup { destroy .e } -returnCodes error -result {bad entry index "ibogus"} test entry-13.9 {GetEntryIndex procedure} -setup { - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2552,16 +2544,11 @@ test entry-13.9 {GetEntryIndex procedure} -setup { destroy .e } -result {1 6} - - - - - test entry-13.10 {GetEntryIndex procedure} -constraints unix -body { # On unix, when selection is cleared, entry widget's internal # selection range is reset. # Previous settings: - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2581,7 +2568,7 @@ test entry-13.11 {GetEntryIndex procedure} -constraints win -body { # last selected range. When selection ownership is restored to # entry, the old range will be rehighlighted. # Previous settings: - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2599,7 +2586,7 @@ test entry-13.11 {GetEntryIndex procedure} -constraints win -body { test entry-13.12 {GetEntryIndex procedure} -constraints unix -body { # Previous settings: - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2618,7 +2605,7 @@ test entry-13.12 {GetEntryIndex procedure} -constraints unix -body { # it behaves differently? test entry-13.12.1 {GetEntryIndex procedure} -constraints unix -body { # Previous settings: - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2635,7 +2622,7 @@ test entry-13.12.1 {GetEntryIndex procedure} -constraints unix -body { test entry-13.13 {GetEntryIndex procedure} -constraints win -body { # Previous settings: - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2655,7 +2642,7 @@ test entry-13.14 {GetEntryIndex procedure} -constraints win -body { # last selected range. When selection ownership is restored to # entry, the old range will be rehighlighted. # Previous settings: - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2675,7 +2662,7 @@ test entry-13.14.1 {GetEntryIndex procedure} -constraints win -body { # last selected range. When selection ownership is restored to # entry, the old range will be rehighlighted. # Previous settings: - entry .e -font {Courier -12} -width 5 -bd 2 -relief sunken + entry .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2700,7 +2687,7 @@ test entry-13.15 {GetEntryIndex procedure} -body { } -returnCodes error -result {bad entry index "@xyz"} test entry-13.16 {GetEntryIndex procedure} -constraints fonts -body { - entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + entry .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2\ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -2711,7 +2698,7 @@ test entry-13.16 {GetEntryIndex procedure} -constraints fonts -body { destroy .e } -result {4} test entry-13.17 {GetEntryIndex procedure} -constraints fonts -body { - entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + entry .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2\ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -2722,7 +2709,7 @@ test entry-13.17 {GetEntryIndex procedure} -constraints fonts -body { destroy .e } -result {4} test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { - entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + entry .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2\ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -2733,7 +2720,7 @@ test entry-13.18 {GetEntryIndex procedure} -constraints fonts -body { destroy .e } -result {5} test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { - entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + entry .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2\ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -2744,7 +2731,7 @@ test entry-13.19 {GetEntryIndex procedure} -constraints fonts -body { destroy .e } -result {8} test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { - entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + entry .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2\ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -2755,7 +2742,7 @@ test entry-13.20 {GetEntryIndex procedure} -constraints fonts -body { destroy .e } -result {9} test entry-13.21 {GetEntryIndex procedure} -body { - entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + entry .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2\ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -2775,7 +2762,7 @@ test entry-13.22 {GetEntryIndex procedure} -setup { destroy .e } -returnCodes error -result {bad entry index "1xyz"} test entry-13.23 {GetEntryIndex procedure} -body { - entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + entry .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2\ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -2786,7 +2773,7 @@ test entry-13.23 {GetEntryIndex procedure} -body { destroy .e } -result {0} test entry-13.24 {GetEntryIndex procedure} -body { - entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + entry .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2\ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -2797,7 +2784,7 @@ test entry-13.24 {GetEntryIndex procedure} -body { destroy .e } -result {12} test entry-13.25 {GetEntryIndex procedure} -body { - entry .e -width 5 -relief sunken -highlightthickness 2 -bd 2\ + entry .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2\ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -2808,7 +2795,7 @@ test entry-13.25 {GetEntryIndex procedure} -body { destroy .e } -result {21} test entry-13.26 {GetEntryIndex procedure} -constraints fonts -body { - entry .e -highlightthickness 2 -bd 2 -font {Helvetica -12} + entry .e -highlightthickness 2 -borderwidth 2 -font {Helvetica -12} selection clear .e .e configure -show . .e insert 0 XXXYZZY @@ -2908,7 +2895,6 @@ test entry-16.4 {EntryVisibleRange procedure} -body { destroy .e } -result {0.000000 1.000000} - test entry-17.1 {EntryUpdateScrollbar procedure} -body { entry .e -width 10 -xscrollcommand scroll -font {Courier -12} pack .e @@ -2957,7 +2943,6 @@ test entry-17.4 {EntryUpdateScrollbar procedure} -setup { "thisisnotacommand 0.0 1.0" (horizontal scrolling command executed by .e)}} - test entry-18.1 {Entry widget vs hiding} -setup { entry .e } -body { @@ -3272,7 +3257,6 @@ test entry-19.16 {entry widget validation} -setup { destroy .e } -result {1 {.e -1 -1 abcd abcd {} all forced}} - test entry-19.17 {entry widget validation} -setup { unset -nocomplain ::e ::vVals } -body { @@ -3289,7 +3273,6 @@ test entry-19.17 {entry widget validation} -setup { destroy .e } -result {focusout {.e -1 -1 newdata abcd {} focusout forced}} - # proc doval changed - returns 0 test entry-19.18 {entry widget validation} -setup { unset -nocomplain ::e ::vVals @@ -3419,7 +3402,7 @@ test entry-20.7 {widget deletion with textvariable active} -body { # SF bugs 607390 and 617446 set FOO init entry .e -textvariable FOO -validate all \ - -vcmd {%W configure -bg white; format 1} + -vcmd {%W configure -background white; format 1} bind .e <Destroy> { set FOO hello } destroy .e winfo exists .e @@ -3427,7 +3410,6 @@ test entry-20.7 {widget deletion with textvariable active} -body { destroy .e } -result {0} - test entry-21.1 {selection present while disabled, bug 637828} -body { entry .e .e insert end 0123456789 diff --git a/tests/event.test b/tests/event.test index 1548467..99fde64 100644 --- a/tests/event.test +++ b/tests/event.test @@ -100,7 +100,7 @@ proc _keypress_lookup {char} { _init_keypress_lookup } - if {$char == ""} { + if {$char eq ""} { error "empty char" } @@ -121,12 +121,12 @@ proc _keypress {win key} { # a focus follows mouse will not steal away # the focus if the mouse is moved around. - if {[focus] != $win} { + if {[focus] ne $win} { focus -force $win } event generate $win <KeyPress-$keysym> _pause 50 - if {[focus] != $win} { + if {[focus] ne $win} { focus -force $win } event generate $win <KeyRelease-$keysym> @@ -165,7 +165,7 @@ proc _text_ind_to_x_y {text ind} { if {[llength $bbox] != 4} { error "got bbox \{$bbox\} from $text, index $ind" } - foreach {x1 y1 width height} $bbox break + lassign $bbox x1 y1 width height set middle_y [expr {$y1 + ($height / 2)}] return [list $x1 $middle_y] } @@ -173,7 +173,7 @@ proc _text_ind_to_x_y {text ind} { # Return selection only if owned by the given widget proc _get_selection {widget} { - if {[string compare $widget [selection own]] != 0} { + if {$widget ne [selection own]} { return "" } if {[catch {selection get} sel]} { @@ -208,7 +208,7 @@ test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} -setup } -result {destroy} test event-1.2 {event generate <Alt-z>} -setup { deleteWindows - catch {unset ::event12result} + unset -nocomplain ::event12result } -body { set ::event12result 0 pack [entry .e] @@ -223,7 +223,6 @@ test event-1.2 {event generate <Alt-z>} -setup { deleteWindows } -result 1 - test event-2.1(keypress) {type into entry widget and hit Return} -setup { deleteWindows } -body { @@ -349,7 +348,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests lappend result [$e get 1.0 1.end] # Get the x,y coords of the second T in "Tcl/Tk" - foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break + lassign [_text_ind_to_x_y $e $anchor] anchor_x anchor_y # Click down to set the insert cursor position event generate $e <Enter> @@ -362,7 +361,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests set current $anchor while {[$e compare $current <= $selend]} { - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y set current [$e index [list $current + 1 char]] _pause 50 @@ -382,7 +381,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests event generate $e <ButtonPress-1> -x $current_x -y $current_y while {[$e compare $current >= [list $anchor - 4 char]]} { - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y set current [$e index [list $current - 1 char]] _pause 50 @@ -416,7 +415,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests lappend result [$e get] # Get the x,y coords of the second T in "Tcl/Tk" - foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break + lassign [_text_ind_to_x_y $e $anchor] anchor_x anchor_y # Click down to set the insert cursor position event generate $e <Enter> @@ -429,7 +428,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests set current $anchor while {$current <= $selend} { - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y incr current _pause 50 @@ -449,7 +448,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests event generate $e <ButtonPress-1> -x $current_x -y $current_y while {$current >= ($anchor - 4)} { - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y incr current -1 _pause 50 @@ -468,7 +467,6 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests deleteWindows } -result {{A Tcl/Tk selection!} 6 18 {Tk selection} 2 {Tcl/Tk selection}} - test event-4.1(double-click-drag) {click down, click up, click down again, then drag in a text widget} -setup { deleteWindows @@ -481,7 +479,7 @@ test event-4.1(double-click-drag) {click down, click up, click down again, set anchor 1.8 # Get the x,y coords of the second e in "select" - foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break + lassign [_text_ind_to_x_y $e $anchor] anchor_x anchor_y # Click down, release, then click down again event generate $e <Enter> @@ -501,7 +499,7 @@ test event-4.1(double-click-drag) {click down, click up, click down again, # Move mouse one character to the left set current [$e index [list $anchor - 1 char]] - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y _pause 50 @@ -515,7 +513,7 @@ test event-4.1(double-click-drag) {click down, click up, click down again, # Move mouse to the space before the word "select" set current [$e index [list $current - 3 char]] - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y _pause 200 @@ -524,7 +522,7 @@ test event-4.1(double-click-drag) {click down, click up, click down again, # Move mouse to the r in "Word" set current 1.2 - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y _pause 50 @@ -552,7 +550,7 @@ test event-4.2(double-click-drag) {click down, click up, click down again, set anchor 8 # Get the x,y coords of the second e in "select" - foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break + lassign [_text_ind_to_x_y $e $anchor] anchor_x anchor_y # Click down, release, then click down again event generate $e <Enter> @@ -571,7 +569,7 @@ test event-4.2(double-click-drag) {click down, click up, click down again, # Move mouse one character to the left set current [expr {$anchor - 1}] - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y _pause 50 @@ -584,7 +582,7 @@ test event-4.2(double-click-drag) {click down, click up, click down again, # Move mouse to the space before the word "select" set current [expr {$current - 3}] - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y _pause 50 @@ -594,7 +592,7 @@ test event-4.2(double-click-drag) {click down, click up, click down again, # Move mouse to the r in "Word" set current [expr {$current - 2}] - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y _pause 50 @@ -624,7 +622,7 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in a # Triple click one third line leaving mouse down - foreach {anchor_x anchor_y} [_text_ind_to_x_y $e $anchor] break + lassign [_text_ind_to_x_y $e $anchor] anchor_x anchor_y event generate $e <Enter> @@ -647,7 +645,7 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in a # Drag up to second line set current [$e index [list $anchor - 1 line]] - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y _pause 50 @@ -657,7 +655,7 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in a # Drag up to first line set current [$e index [list $current - 1 line]] - foreach {current_x current_y} [_text_ind_to_x_y $e $current] break + lassign [_text_ind_to_x_y $e $current] current_x current_y event generate $e <B1-Motion> -x $current_x -y $current_y _pause 50 @@ -704,7 +702,7 @@ test event-7.1(double-click) {A double click on a lone character # Get x,y coords just inside the left # and right hand side of the letter A - foreach {x1 y1 width height} [$e bbox $anchor] break + lassign [$e bbox $anchor] x1 y1 width height set middle_y [expr {$y1 + ($height / 2)}] @@ -772,7 +770,7 @@ test event-7.2(double-click) {A double click on a lone character # Get x,y coords just inside the left # and right hand side of the letter A - foreach {x1 y1 width height} [$e bbox $anchor] break + lassign [$e bbox $anchor] x1 y1 width height set middle_y [expr {$y1 + ($height / 2)}] diff --git a/tests/filebox.test b/tests/filebox.test index 7b9fa2c..eb5380b 100644 --- a/tests/filebox.test +++ b/tests/filebox.test @@ -54,12 +54,12 @@ proc PressButton {btn} { proc EnterFileByKey {parent fileName fileDir} { global tk_strictMotif - if {$parent == "."} { + if {$parent eq "."} { set w .__tk_filedialog } else { set w $parent.__tk_filedialog } - upvar ::tk::dialog::file::__tk_filedialog data + upvar 1 ::tk::dialog::file::__tk_filedialog data if {$tk_strictMotif} { $data(sEnt) delete 0 end @@ -75,19 +75,19 @@ proc EnterFileByKey {parent fileName fileDir} { proc SendButtonPress {parent btn type} { global tk_strictMotif - if {$parent == "."} { + if {$parent eq "."} { set w .__tk_filedialog } else { set w $parent.__tk_filedialog } - upvar ::tk::dialog::file::__tk_filedialog data + upvar 1 ::tk::dialog::file::__tk_filedialog data set button $data($btn\Btn) - if ![winfo ismapped $button] { + if {![winfo ismapped $button]} { update } - if {$type == "mouse"} { + if {$type eq "mouse"} { PressButton $button } else { event generate $w <Enter> @@ -104,7 +104,7 @@ proc SendButtonPress {parent btn type} { # #---------------------------------------------------------------------- -if {$tcl_platform(platform) == "unix"} { +if {$tcl_platform(platform) eq "unix"} { set modes "0 1" } else { set modes 1 @@ -146,7 +146,7 @@ foreach mode $modes { # set addedExtensions {} - if {$tcl_platform(platform) == "unix"} { + if {$tcl_platform(platform) eq "unix"} { set tk_strictMotif $mode # Extension adding is only done when using the non-motif file # box with an extension-less filename @@ -185,8 +185,8 @@ foreach mode $modes { } -returnCodes error -result {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"} set isNative [expr { - [info commands ::tk::MotifFDialog] eq "" && - [info commands ::tk::dialog::file::] eq "" + ([info commands ::tk::MotifFDialog] eq "") && + ([info commands ::tk::dialog::file::] eq "") }] set parent . @@ -270,8 +270,7 @@ foreach mode $modes { foreach {x res} [list 1 "-unset-" 2 "Text files"] { set t [expr {$x + [llength [array names filters]]}] test filebox-3.$t-$mode "tk_getOpenFile command" nonUnixUserInteraction { - catch {unset tv} - catch {unset typeName} + unset -nocomplain tv typeName ToPressButton $parent ok if {[info exists tv]} { } else { @@ -319,8 +318,8 @@ foreach mode $modes { } -returnCodes error -result {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"} set isNative [expr { - [info commands ::tk::MotifFDialog] eq "" && - [info commands ::tk::dialog::file::] eq "" + ([info commands ::tk::MotifFDialog] eq "") && + ([info commands ::tk::dialog::file::] eq "") }] set parent . diff --git a/tests/focus.test b/tests/focus.test index 45cf73b..3a71d3a 100644 --- a/tests/focus.test +++ b/tests/focus.test @@ -16,7 +16,7 @@ proc focusSetup {} { toplevel .t wm geom .t +0+0 foreach i {b1 b2 b3 b4} { - button .t.$i -text .t.$i -relief raised -bd 2 + button .t.$i -text .t.$i -relief raised -borderwidth 2 pack .t.$i } tkwait visibility .t.b4 @@ -26,7 +26,7 @@ proc focusSetupAlt {} { destroy .alt toplevel .alt -screen $env(TK_ALT_DISPLAY) foreach i {a b c d} { - button .alt.$i -text .alt.$i -relief raised -bd 2 + button .alt.$i -text .alt.$i -relief raised -borderwidth 2 pack .alt.$i } tkwait visibility .alt.d @@ -47,9 +47,8 @@ proc focusClear {} { update } - # Button used in some tests in the whole test file -button .b -text .b -relief raised -bd 2 +button .b -text .b -relief raised -borderwidth 2 pack .b # Make sure the window manager knows who has focus @@ -72,7 +71,6 @@ if {[testConstraint altDisplay]} { focusSetupAlt } - test focus-1.1 {Tk_FocusCmd procedure} -constraints unix -body { focusClear focus @@ -111,8 +109,8 @@ test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} -constraints { focusClear toplevel .t2 wm geom .t2 +10+10 - frame .t2.f -width 200 -height 100 -bd 2 -relief raised - frame .t2.f2 -width 200 -height 100 -bd 2 -relief raised + frame .t2.f -width 200 -height 100 -borderwidth 2 -relief raised + frame .t2.f2 -width 200 -height 100 -borderwidth 2 -relief raised pack .t2.f .t2.f2 bind .t2.f <Destroy> {focus .t2.f} bind .t2.f2 <Destroy> {focus .t2} @@ -220,7 +218,6 @@ test focus-1.25 {Tk_FocusCmd procedure} -constraints unix -body { focus -unknown } -returnCodes error -result {bad option "-unknown": must be -displayof, -force, or -lastfor} - focusSetup test focus-2.1 {TkFocusFilterEvent procedure} -constraints { unix nonPortable testwrapper @@ -455,7 +452,6 @@ test focus-2.17 {TkFocusFilterEvent procedure, Leave events} -constraints { out .t NotifyVirtual } {}} - test focus-3.1 {SetFocus procedure, create record on focus} -constraints { unix testwrapper } -body { @@ -546,7 +542,6 @@ unix nonPortable testwrapper return $focusInfo } -result {} - test focus-4.1 {TkFocusDeadWindow procedure} -constraints { unix testwrapper } -body { @@ -593,7 +588,6 @@ test focus-4.4 {TkFocusDeadWindow procedure} -constraints { } -result {.t} cleanupbg - # I don't know how to test most of the remaining procedures of this file # explicitly; they've already been exercised by the preceding tests. @@ -619,7 +613,6 @@ bind all <FocusIn> {} bind all <FocusOut> {} bind all <KeyPress> {} - fixfocus test focus-6.1 {miscellaneous - embedded application in same process} -constraints { unix testwrapper @@ -631,7 +624,7 @@ test focus-6.1 {miscellaneous - embedded application in same process} -constrain frame .t.f1 -container 1 frame .t.f2 pack .t.f1 .t.f2 - entry .t.f2.e1 -bg red + entry .t.f2.e1 -background red pack .t.f2.e1 bind all <FocusIn> {lappend x "focus in %W %d"} bind all <FocusOut> {lappend x "focus out %W %d"} @@ -639,7 +632,7 @@ test focus-6.1 {miscellaneous - embedded application in same process} -constrain child eval "set argv {-use [winfo id .t.f1]}" load {} Tk child child eval { - entry .e1 -bg lightBlue + entry .e1 -background lightBlue pack .e1 bind all <FocusIn> {lappend x "focus in %W %d"} bind all <FocusOut> {lappend x "focus out %W %d"} @@ -686,13 +679,13 @@ test focus-6.2 {miscellaneous - embedded application in different process} -cons frame .t.f1 -container 1 frame .t.f2 pack .t.f1 .t.f2 - entry .t.f2.e1 -bg red + entry .t.f2.e1 -background red pack .t.f2.e1 bind all <FocusIn> {lappend x "focus in %W %d"} bind all <FocusOut> {lappend x "focus out %W %d"} setupbg -use [winfo id .t.f1] dobg { - entry .e1 -bg lightBlue + entry .e1 -background lightBlue pack .e1 bind all <FocusIn> {lappend x "focus in %W %d"} bind all <FocusOut> {lappend x "focus out %W %d"} @@ -730,8 +723,6 @@ test focus-6.2 {miscellaneous - embedded application in different process} -cons bind all <FocusOut> {} } -result {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} - - deleteWindows # cleanup diff --git a/tests/focusTcl.test b/tests/focusTcl.test index ef848bb..9f93ebe 100644 --- a/tests/focusTcl.test +++ b/tests/focusTcl.test @@ -16,13 +16,13 @@ option add *takeFocus 1 option add *highlightThickness 2 . configure -takefocus 1 -highlightthickness 2 -proc setup1 w { - if {$w == "."} { +proc setup1 {w} { + if {$w eq "."} { set w "" } foreach i {a b c d} { destroy $w.$i - frame $w.$i -width 200 -height 50 -bd 2 -relief raised + frame $w.$i -width 200 -height 50 -borderwidth 2 -relief raised pack $w.$i } .b configure -width 0 -height 0 @@ -36,8 +36,8 @@ proc setup1 w { } } -proc cleanup1 w { - if {$w == "."} { +proc cleanup1 {w} { + if {$w eq "."} { set w "" } foreach i {a b c d} { @@ -48,7 +48,6 @@ proc cleanup1 w { } } - test focusTcl-1.1 {tk_focusNext procedure, no children} -body { tk_focusNext . } -result {.} @@ -133,7 +132,6 @@ test focusTcl-1.12 {tk_focusNext procedure, basic tree traversal} -body { cleanup1 . } -result {.a} - test focusTcl-2.1 {tk_focusNext procedure, toplevels} -setup { deleteWindows } -body { @@ -209,7 +207,6 @@ test focusTcl-2.5 {tk_focusNext procedure, toplevels} -setup { deleteWindows } -result {.t} - test focusTcl-3.1 {tk_focusPrev procedure, no children} -body { tk_focusPrev . } -result {.} @@ -263,7 +260,6 @@ test focusTcl-3.9 {tk_focusPrev procedure, basic tree traversal} -body { cleanup1 . } -result {.} - deleteWindows setup1 . toplevel .t @@ -351,7 +347,6 @@ test focusTcl-4.5 {tk_focusPrev procedure, toplevels} -setup { deleteWindows } -result {.t.b.z} - test focusTcl-5.1 {tkFocusOK procedure, -takefocus 0} -body { setup1 . .b.x configure -takefocus 0 @@ -372,9 +367,9 @@ test focusTcl-5.2 {tkFocusOK procedure, -takefocus 1} -body { } -result {.c .c} test focusTcl-5.3 {tkFocusOK procedure, -takefocus procedure} -body { proc t w { - if {$w == ".b.x"} { + if {$w eq ".b.x"} { return 1 - } elseif {$w == ".b.y"} { + } elseif {$w eq ".b.y"} { return "" } return 0 @@ -473,7 +468,6 @@ test focusTcl-5.11 {tkFocusOK procedure, -takefocus "", check for bindings} -bod bind Frame <Key> {} } -result {.a .b} - . configure -takefocus 0 -highlightthickness 0 option clear diff --git a/tests/font.test b/tests/font.test index dff9fc9..12ea555 100644 --- a/tests/font.test +++ b/tests/font.test @@ -11,19 +11,19 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands - -catch {eval font delete [font names]} +catch {font delete {*}[font names]} deleteWindows # Toplevel used (in some tests) of the whole file toplevel .t wm geom .t +0+0 update idletasks -case [tk windowingsystem] { +switch -- [tk windowingsystem] { x11 {set fixed "fixed"} win32 {set fixed "courier 12"} classic - aqua {set fixed "monaco 9"} + default {set fixed "courier 12"} } @@ -35,20 +35,18 @@ proc csetup {{str ""}} { .t.c focus text } - test font-1.1 {TkFontPkgInit} -setup { catch {interp delete foo} } -body { interp create foo foo eval { - load {} Tk + load "" Tk wm geometry . +0+0 update } interp delete foo } -result {} - test font-2.1 {TkFontPkgFree} -setup { catch {interp delete foo} set x {} @@ -78,7 +76,6 @@ test font-2.1 {TkFontPkgFree} -setup { interp delete foo } -result {{named font "wiggles" doesn't exist} {can't invoke "font" command: application has been destroyed}} - test font-3.1 {font command: general} -body { font } -returnCodes error -result {wrong # args: should be "font option ?arg?"} @@ -86,7 +83,6 @@ test font-3.2 {font command: general} -body { font xyz } -returnCodes error -result {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names} - test font-4.1 {font command: actual: arguments} -body { # (skip < 0) font actual xyz -displayof @@ -112,7 +108,7 @@ test font-4.6 {font command: actual: arguments} -body { test font-4.7 {font command: actual: arguments} -constraints noExceed -body { # (tkfont == NULL) font actual "\{xyz" -} -returnCodes error -result "font \"{xyz\" doesn't exist" +} -returnCodes error -result "font \"\{xyz\" doesn't exist" test font-4.8 {font command: actual: all attributes} -body { # not (objc > 3) so objPtr = NULL lindex [font actual {-family times}] 0 @@ -129,7 +125,6 @@ test font-4.11 {font command: bad option} -body { font actual xyz -style } -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike} - test font-5.1 {font command: configure} -body { # (objc < 3) font configure @@ -191,7 +186,6 @@ test font-5.7 {font command: configure: bad option} -setup { font delete xyz } -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike} - test font-6.1 {font command: create: make up name} -setup { catch {eval font delete [font names]} } -body { @@ -288,7 +282,7 @@ test font-7.3 {font command: delete: loop test} -setup { catch {font delete a d q c e b} lappend x [lsort [font names]] } -cleanup { - catch {eval font delete [font names]} + catch {font delete {*}[font names]} } -result {{a b c d e} {b c e}} test font-7.4 {font command: delete: non-existent} -setup { catch {font delete xyz} @@ -336,7 +330,6 @@ test font-7.7 {font command: delete: actually delete} -setup { font config xyz } -returnCodes error -match glob -result {*} - test font-8.1 {font command: families: arguments} -body { # (skip < 0) font families -displayof @@ -354,7 +347,6 @@ test font-8.4 {font command: families} -body { regexp -nocase times [font families] } -result 1 - test font-9.1 {font command: measure: arguments} -body { # (skip < 0) expr {[font measure xyz -displayof] > 0} @@ -370,7 +362,7 @@ test font-9.3 {font command: measure: arguments} -body { test font-9.4 {font command: measure: arguments} -constraints noExceed -body { # (tkfont == NULL) font measure "\{xyz" abc -} -returnCodes error -result "font \"{xyz\" doesn't exist" +} -returnCodes error -result "font \"\{xyz\" doesn't exist" test font-9.5 {font command: measure} -body { # Tk_TextWidth() expr {[font measure $fixed "abcdefg"] == [font measure $fixed "a"]*7 } @@ -385,7 +377,6 @@ test font-9.8 {font command: measure: arguments} -body { font measure $fixed -displayof . } -returnCodes error -result {wrong # args: should be "font measure font ?-displayof window? text"} - test font-10.1 {font command: metrics: arguments} -body { font metrics xyz -displayof } -returnCodes error -result {value for "-displayof" missing} @@ -408,9 +399,9 @@ test font-10.5 {font command: metrics: arguments} -body { test font-10.6 {font command: metrics: bad font} -constraints noExceed -body { # (tkfont == NULL) font metrics "\{xyz" -} -returnCodes error -result "font \"{xyz\" doesn't exist" +} -returnCodes error -result "font \"\{xyz\" doesn't exist" test font-10.7 {font command: metrics: get all metrics} -setup { - catch {unset a} + unset -nocomplain a } -body { # (objc == 3) array set a [font metrics {-family xyz}] @@ -429,7 +420,6 @@ test font-10.9 {font command: metrics: get individual metrics} -body { font metrics $fixed -fixed } -result 1 - test font-11.1 {font command: names: arguments} -body { # (objc != 2) font names xyz @@ -457,7 +447,7 @@ test font-11.4 {font command: names: loop test: multiple passes} -setup { } -result {abc def xyz} test font-11.5 {font command: names: skip deletePending fonts} -setup { destroy .t.f - catch {eval font delete [font names]} + catch {font delete {*}[font names]} pack [label .t.f] update set x {} @@ -473,7 +463,6 @@ test font-11.5 {font command: names: skip deletePending fonts} -setup { catch {eval font delete [font names]} } -result {{abc xyz} abc} - test font-12.1 {UpdateDependantFonts procedure: no users} -setup { catch {font delete xyz} } -body { @@ -490,7 +479,7 @@ test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { update } -body { font create xyz -family times -size 20 - .t.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0 + .t.f config -font xyz -text "abcd" -padx 0 -borderwidth 0 -highlightthickness 0 set a1 [font measure xyz "abcd"] update set b1 [winfo reqwidth .t.f] @@ -504,7 +493,6 @@ test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup { font delete xyz } -result {1} - test font-13.1 {CreateNamedFont: new named font} -setup { catch {font delete xyz} set x {} @@ -551,17 +539,15 @@ test font-13.4 {CreateNamedFont: recreate "deleted" font} -setup { destroy .t.f } -result {courier} - test font-14.1 {Tk_GetFont procedure} -body { } -result {} - test font-15.1 {Tk_AllocFontFromObj - converting internal reps} -constraints { testfont } -setup { destroy .b1 .b2 } -body { - set x {Times 16} + set x "Times 16" lindex $x 0 button .b1 -font $x lindex $x 0 @@ -669,7 +655,7 @@ test font-15.9 {Tk_AllocFontFromObj procedure: get attribute font} -setup { test font-15.10 {Tk_AllocFontFromObj procedure: no match} -constraints noExceed -body { # (ParseFontNameObj() != TCL_OK) font actual "\{xyz" -} -returnCodes error -result "font \"{xyz\" doesn't exist" +} -returnCodes error -result "font \"\{xyz\" doesn't exist" test font-15.11 {Tk_AllocFontFromObj procedure: get attribute font} -body { # not (ParseFontNameObj() != TCL_OK) lindex [font actual {plan 9}] 0 @@ -678,7 +664,7 @@ test font-15.12 {Tk_AllocFontFromObj procedure: setup tab width} -setup { destroy .l } -body { # Tk_MeasureChars(fontPtr, "0", ...) - label .l -bd 0 -padx 0 -highlightthickness 0 -font $fixed -text "a\tb" + label .l -borderwidth 0 -padx 0 -highlightthickness 0 -font $fixed -text "a\tb" update set res1 [winfo reqwidth .l] set res2 [expr [font measure $fixed "0"]*9] @@ -698,7 +684,6 @@ test font-15.13 {Tk_AllocFontFromObj procedure: underline position} -setup { destroy .t.f } -result {} - test font-16.1 {Tk_NameOfFont procedure} -setup { destroy .t.f pack [label .t.f] @@ -710,7 +695,6 @@ test font-16.1 {Tk_NameOfFont procedure} -setup { destroy .t.f } -result {-family fixed} - test font-17.1 {Tk_FreeFontFromObj - reference counts} -constraints { testfont } -setup { @@ -794,16 +778,15 @@ test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} -setup { destroy .t.f } -result {-family -family} - test font-18.1 {FreeFontObjProc} -constraints testfont -setup { destroy .b1 set result {} } -body { - set x [format {Courier 12}] + set x [format "Courier 12"] button .b1 -font $x - set y [format {Courier 12}] + set y [format "Courier 12"] .b1 configure -font $y - set z [format {Courier 12}] + set z [format "Courier 12"] .b1 configure -font $z lappend result [testfont counts {Courier 12}] set x red @@ -816,7 +799,6 @@ test font-18.1 {FreeFontObjProc} -constraints testfont -setup { return $result } -result {{{1 3}} {{1 2}} {{1 1}} {}} - test font-19.1 {Tk_FontId} -setup { destroy .t.f pack [label .t.f] @@ -828,7 +810,6 @@ test font-19.1 {Tk_FontId} -setup { destroy .t.f } -result {} - test font-20.1 {Tk_GetFontMetrics procedure} -setup { destroy .t.w1 .t.w2 } -body { @@ -838,7 +819,6 @@ test font-20.1 {Tk_GetFontMetrics procedure} -setup { destroy .t.w1 .t.w2 } -result {} - # Procedure used in 21.* tests proc psfontname {name} { destroy .t.c @@ -852,10 +832,10 @@ proc psfontname {name} { .t.c itemconfig text -font $a set end [string first "findfont" $post] incr end -2 - set post [string range $post [expr $end-70] $end] + set post [string range $post [expr {$end - 70}] $end] set start [string first "gsave" $post] destroy .t.c - return [string range $post [expr $start+7] end] + return [string range $post [expr {$start + 7}] end] } test font-21.1 {Tk_PostscriptFontName procedure: native} -constraints { unix @@ -902,7 +882,7 @@ test font-21.7 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {avantgarde 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "avantgarde"} { set x [psfontname avantgarde 12 roman normal] } else { set x AvantGarde-Book @@ -912,7 +892,7 @@ test font-21.8 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {avantgarde 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "avantgarde"} { set x [psfontname avantgarde 12 roman normal] } else { set x AvantGarde-Demi @@ -922,7 +902,7 @@ test font-21.9 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {avantgarde 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "avantgarde"} { set x [psfontname avantgarde 12 roman normal] } else { set x AvantGarde-BookOblique @@ -932,7 +912,7 @@ test font-21.10 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {avantgarde 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "avantgarde"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "avantgarde"} { set x [psfontname avantgarde 12 roman normal] } else { set x AvantGarde-DemiOblique @@ -943,7 +923,7 @@ test font-21.11 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {bookman 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "bookman"} { set x [psfontname avantgarde 12 roman normal] } else { set x Bookman-Light @@ -953,7 +933,7 @@ test font-21.12 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {bookman 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "bookman"} { set x [psfontname avantgarde 12 roman normal] } else { set x Bookman-Demi @@ -963,7 +943,7 @@ test font-21.13 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {bookman 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "bookman"} { set x [psfontname avantgarde 12 roman normal] } else { set x Bookman-LightItalic @@ -973,7 +953,7 @@ test font-21.14 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {bookman 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "bookman"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "bookman"} { set x [psfontname avantgarde 12 roman normal] } else { set x Bookman-DemiItalic @@ -984,7 +964,7 @@ test font-21.15 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {courier 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "courier"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "courier"} { set x [psfontname avantgarde 12 roman normal] } else { set x Courier @@ -994,7 +974,7 @@ test font-21.16 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {courier 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "courier"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "courier"} { set x [psfontname avantgarde 12 roman normal] } else { set x Courier-Bold @@ -1004,7 +984,7 @@ test font-21.17 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {courier 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "courier"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "courier"} { set x [psfontname avantgarde 12 roman normal] } else { set x Courier-Oblique @@ -1014,7 +994,7 @@ test font-21.18 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {courier 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "courier"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "courier"} { set x [psfontname avantgarde 12 roman normal] } else { set x Courier-BoldOblique @@ -1025,7 +1005,7 @@ test font-21.19 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {helvetica 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "helvetica"} { set x [psfontname avantgarde 12 roman normal] } else { set x Helvetica @@ -1035,7 +1015,7 @@ test font-21.20 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {helvetica 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "helvetica"} { set x [psfontname avantgarde 12 roman normal] } else { set x Helvetica-Bold @@ -1045,7 +1025,7 @@ test font-21.21 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {helvetica 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "helvetica"} { set x [psfontname avantgarde 12 roman normal] } else { set x Helvetica-Oblique @@ -1055,7 +1035,7 @@ test font-21.22 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {helvetica 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "helvetica"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "helvetica"} { set x [psfontname avantgarde 12 roman normal] } else { set x Helvetica-BoldOblique @@ -1066,7 +1046,7 @@ test font-21.23 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {{new century schoolbook} 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "new century schoolbook"} { set x [psfontname avantgarde 12 roman normal] } else { set x NewCenturySchlbk-Roman @@ -1076,7 +1056,7 @@ test font-21.24 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {{new century schoolbook} 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "new century schoolbook"} { set x [psfontname avantgarde 12 roman normal] } else { set x NewCenturySchlbk-Bold @@ -1086,7 +1066,7 @@ test font-21.25 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {{new century schoolbook} 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "new century schoolbook"} { set x [psfontname avantgarde 12 roman normal] } else { set x NewCenturySchlbk-Italic @@ -1096,7 +1076,7 @@ test font-21.26 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {{new century schoolbook} 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "new century schoolbook"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "new century schoolbook"} { set x [psfontname avantgarde 12 roman normal] } else { set x NewCenturySchlbk-BoldItalic @@ -1107,7 +1087,7 @@ test font-21.27 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {palatino 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "palatino"} { set x [psfontname avantgarde 12 roman normal] } else { set x Palatino-Roman @@ -1117,7 +1097,7 @@ test font-21.28 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {palatino 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "palatino"} { set x [psfontname avantgarde 12 roman normal] } else { set x Palatino-Bold @@ -1127,7 +1107,7 @@ test font-21.29 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {palatino 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "palatino"} { set x [psfontname avantgarde 12 roman normal] } else { set x Palatino-Italic @@ -1137,7 +1117,7 @@ test font-21.30 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {palatino 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "palatino"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "palatino"} { set x [psfontname avantgarde 12 roman normal] } else { set x Palatino-BoldItalic @@ -1148,7 +1128,7 @@ test font-21.31 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {symbol 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "symbol"} { set x [psfontname avantgarde 12 roman normal] } else { set x Symbol @@ -1158,7 +1138,7 @@ test font-21.32 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {symbol 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "symbol"} { set x [psfontname avantgarde 12 roman normal] } else { set x Symbol @@ -1168,7 +1148,7 @@ test font-21.33 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {symbol 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "symbol"} { set x [psfontname avantgarde 12 roman normal] } else { set x Symbol @@ -1178,7 +1158,7 @@ test font-21.34 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {symbol 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "symbol"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "symbol"} { set x [psfontname avantgarde 12 roman normal] } else { set x Symbol @@ -1189,7 +1169,7 @@ test font-21.35 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {times 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "times"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "times"} { set x [psfontname avantgarde 12 roman normal] } else { set x Times-Roman @@ -1199,7 +1179,7 @@ test font-21.36 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {times 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "times"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "times"} { set x [psfontname avantgarde 12 roman normal] } else { set x Times-Bold @@ -1209,7 +1189,7 @@ test font-21.37 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {times 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "times"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "times"} { set x [psfontname avantgarde 12 roman normal] } else { set x Times-Italic @@ -1219,7 +1199,7 @@ test font-21.38 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {times 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "times"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "times"} { set x [psfontname avantgarde 12 roman normal] } else { set x Times-BoldItalic @@ -1230,7 +1210,7 @@ test font-21.39 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {zapfchancery 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "zapfchancery"} { set x [psfontname avantgarde 12 roman normal] } else { set x ZapfChancery-MediumItalic @@ -1240,7 +1220,7 @@ test font-21.40 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {zapfchancery 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "zapfchancery"} { set x [psfontname avantgarde 12 roman normal] } else { set x ZapfChancery-MediumItalic @@ -1250,7 +1230,7 @@ test font-21.41 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {zapfchancery 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "zapfchancery"} { set x [psfontname avantgarde 12 roman normal] } else { set x ZapfChancery-MediumItalic @@ -1260,7 +1240,7 @@ test font-21.42 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {zapfchancery 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "zapfchancery"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "zapfchancery"} { set x [psfontname avantgarde 12 roman normal] } else { set x ZapfChancery-MediumItalic @@ -1271,7 +1251,7 @@ test font-21.43 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {zapfdingbats 12 roman normal} - if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "zapfdingbats"} { set x [psfontname avantgarde 12 roman normal] } else { set x ZapfDingbats @@ -1281,7 +1261,7 @@ test font-21.44 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {zapfdingbats 12 roman bold} - if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "zapfdingbats"} { set x [psfontname avantgarde 12 roman normal] } else { set x ZapfDingbats @@ -1291,7 +1271,7 @@ test font-21.45 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {zapfdingbats 12 italic normal} - if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "zapfdingbats"} { set x [psfontname avantgarde 12 roman normal] } else { set x ZapfDingbats @@ -1301,7 +1281,7 @@ test font-21.46 {Tk_PostscriptFontName procedure: exhaustive} -constraints { unix } -body { set name {zapfdingbats 12 italic bold} - if {[font actual {avantgarde 12 roman normal} -family] == "zapfdingbats"} { + if {[font actual {avantgarde 12 roman normal} -family] eq "zapfdingbats"} { set x [psfontname avantgarde 12 roman normal] } else { set x ZapfDingbats @@ -1413,20 +1393,18 @@ test font-21.66 {Tk_PostscriptFontName procedure: exhaustive} -constraints { set x [psfontname {{times new roman} 12 italic bold}] } -result {Times-BoldItalic} - test font-22.1 {Tk_TextWidth procedure} -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font "Courier -12" pack .t.l set ax [winfo reqwidth .t.l] - expr {[font measure [.t.l cget -font] "000"] eq $ax*3} + expr {[font measure [.t.l cget -font] "000"] eq ($ax * 3)} } -cleanup { destroy .t.l } -result 1 - test font-23.1 {Tk_UnderlineChars procedure} -setup { destroy .t.t } -body { @@ -1439,10 +1417,9 @@ test font-23.1 {Tk_UnderlineChars procedure} -setup { destroy .t.t } -result {} - # Data used in 24.* tests destroy .t.l -label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ +label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font "Courier -12" pack .t.l update @@ -1589,7 +1566,6 @@ test font-24.15 {Tk_ComputeTextLayout: justification} -setup { destroy .t.c } -result {2 1 0} - test font-25.1 {Tk_FreeTextLayout procedure} -setup { destroy .t.f pack [label .t.f] @@ -1601,7 +1577,6 @@ test font-25.1 {Tk_FreeTextLayout procedure} -setup { destroy .t.f } -result {} - # Canvas created for tests: 26.* destroy .t.c canvas .t.c -closeenough 0 @@ -1658,8 +1633,6 @@ test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} -body { } -result {} destroy .t.f - - # Canvas created for tests: 28.* destroy .t.c canvas .t.c -closeenough 0 @@ -1723,7 +1696,6 @@ test font-28.11 {Tk_PointToChar procedure: below all chunks} -body { } -result {11} destroy .t.c - # Label used in 29.* tests destroy .t.f pack [label .t.f] @@ -1750,8 +1722,6 @@ test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} -body { } -result {} destroy .t.f - - # Canvas created for tests: 30.* destroy .t.c canvas .t.c -closeenough 0 @@ -1894,7 +1864,6 @@ test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} -body { } -result {1} destroy .t.c - # Canvas created for tests 31.* destroy .t.c canvas .t.c -closeenough 0 @@ -1930,7 +1899,6 @@ test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} -body { } -result {} destroy .t.c - test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} -setup { destroy .t.c canvas .t.c -closeenough 0 @@ -1946,7 +1914,7 @@ test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} -setu .t.c insert text end "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n" .t.c insert text end "end" set x [.t.c postscript] - set i [string first "(qwerty" $x] + set i [string first "\(qwerty" $x] string range $x $i [expr {$i + 278}] } -cleanup { destroy .t.c @@ -1985,11 +1953,9 @@ test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} -setu [(end)] } - test font-33.1 {Tk_TextWidth procedure} -body { } -result {} - test font-34.1 {ConfigAttributesObj procedure: arguments} -setup { catch {font delete xyz} } -body { @@ -2088,7 +2054,6 @@ test font-34.13 {ConfigAttributesObj procedure: overstrike} -body { font create xyz -overstrike xyz } -returnCodes error -result {expected boolean value but got "xyz"} - test font-35.1 {GetAttributeInfoObj procedure: one attribute} -setup { catch {font delete xyz} } -body { @@ -2099,7 +2064,6 @@ test font-35.1 {GetAttributeInfoObj procedure: one attribute} -setup { font delete xyz } -result {xyz} - test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} -setup { catch {font delete xyz} } -body { @@ -2112,7 +2076,6 @@ test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} -setup { error } -result {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike} - test font-37.1 {GetAttributeInfoObj procedure: all attributes} -setup { catch {font delete xyz} } -body { @@ -2176,7 +2139,6 @@ test font-37.7 {GetAttributeInfo procedure: overstrike} -setup { font delete xyz } -result {0} - # In tests below, one field is set to "xyz" so that font name doesn't # look like a native X font, so that ParseFontNameObj or TkParseXLFD will # be called. @@ -2201,7 +2163,7 @@ test font-38.6 {ParseFontNameObj procedure: begins with *} -body { } -result [font actual {times 0} -family] test font-38.7 {ParseFontNameObj procedure: arguments} -constraints noExceed -body { font actual "\{xyz" -} -returnCodes error -result "font \"{xyz\" doesn't exist" +} -returnCodes error -result "font \"\{xyz\" doesn't exist" test font-38.8 {ParseFontNameObj procedure: arguments} -constraints noExceed -body { font actual "" } -returnCodes error -result {font "" doesn't exist} @@ -2226,7 +2188,6 @@ test font-38.14 "ParseFontNameObj: bug #2791352" -body { font actual {-invalidfont 8 bold} } -returnCodes error -match glob -result {bad option "-invalidfont": *} - test font-39.1 {NewChunk procedure: test realloc} -setup { destroy .t.f pack [label .t.f] @@ -2237,7 +2198,6 @@ test font-39.1 {NewChunk procedure: test realloc} -setup { destroy .t.f } -result {} - test font-40.1 {TkFontParseXLFD procedure: initial dash} -body { font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family } -result [font actual {times 0} -family] @@ -2255,14 +2215,12 @@ test font-40.5 {TkFontParseXLFD procedure: all fields specified} -body { -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1 } -result [font actual {times 0} -family] - test font-41.1 {TkParseXLFD procedure: arguments} -body { # XLFD with bad pointsize: fallback to some system font. font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-* set x {} } -result {} - test font-42.1 {TkFontParseXLFD procedure: arguments} -body { # XLFD with bad pixelsize: fallback to some system font. font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-* @@ -2285,7 +2243,6 @@ test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} -body { set x {} } -result {} - test font-43.1 {FieldSpecified procedure: specified vs. non-specified} -body { font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-* font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-* @@ -2293,7 +2250,6 @@ test font-43.1 {FieldSpecified procedure: specified vs. non-specified} -body { lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1 } -result [font actual {times 0} -family] - test font-44.1 {TkFontGetPixels: size < 0} -setup { set oldscale [tk scaling] } -body { @@ -2311,7 +2267,6 @@ test font-44.2 {TkFontGetPoints: size >= 0} -constraints noExceed -setup { tk scaling $oldscale } -result {12} - test font-45.1 {TkFontGetAliasList: no match} -body { font actual {snarky 10} -family } -result [font actual {-size 10} -family] @@ -2323,7 +2278,6 @@ test font-45.3 {TkFontGetAliasList: match} -constraints {unix noExceed} -body { font actual {{times new roman} 10} -family } -result [font actual {times 10} -family] - test font-46.1 {font actual, with character, no option, no --} -body { font actual {times 10} a } -match glob -result [list -family [font actual {times 10} -family] -size *\ @@ -2346,7 +2300,6 @@ test font-46.5 {font actual, too many chars} -body { font actual {times 10} 123456789012345678901234567890123456789012345678901 } -returnCodes error -result {expected a single character but got "1234567890123456789012345678901234567..."} - # cleanup cleanupTests return diff --git a/tests/fontchooser.test b/tests/fontchooser.test index 4dad5da..313abb3 100644 --- a/tests/fontchooser.test +++ b/tests/fontchooser.test @@ -11,25 +11,25 @@ tcltest::loadTestedCommands # dialog (hence the wierdness). proc start {cmd} { - set ::tk_dialog {} + set ::tk_dialog "" set ::iter_after 0 after 1 $cmd } proc then {cmd} { set ::command $cmd - set ::dialogresult {} - set ::testfont {} + set ::dialogresult "" + set ::testfont "" afterbody vwait ::dialogresult return $::dialogresult } proc afterbody {} { - if {$::tk_dialog == {}} { + if {$::tk_dialog eq ""} { if {[incr ::iter_after] > 30} { set ::dialogresult ">30 iterations waiting for tk_dialog" return } - after 150 {afterbody} + after 150 {afterbody } return } uplevel #0 {set dialogresult [eval $command]} diff --git a/tests/frame.test b/tests/frame.test index c7b0ed8..0022efe 100644 --- a/tests/frame.test +++ b/tests/frame.test @@ -20,17 +20,17 @@ tcltest::loadTestedCommands # w - Name of toplevel window to create. proc eatColors {w} { - catch {destroy $w} + destroy $w toplevel $w wm geom $w +0+0 - canvas $w.c -width 400 -height 200 -bd 0 + canvas $w.c -width 400 -height 200 -borderwidth 0 pack $w.c for {set y 0} {$y < 8} {incr y} { for {set x 0} {$x < 40} {incr x} { - set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] - $w.c create rectangle [expr 10*$x] [expr 20*$y] \ - [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ - -fill $color + set color [format "#%02x%02x%02x" [expr {$x * 6}] [expr {$y * 30}] 0] + $w.c create rectangle [expr {10 * $x}] [expr {20 * $y}] \ + [expr {(10 * $x) + 10}] [expr {(20 * $y) + 20}] -outline "" \ + -fill $color } } update @@ -47,12 +47,11 @@ proc eatColors {w} { # to see if there are colormap entries free. proc colorsFree {w {red 31} {green 245} {blue 192}} { - set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]] - expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \ - && ([lindex $vals 2]/256 == $blue) + lassign [winfo rgb $w [format "#%02x%02x%02x" $red $green $blue]] v_r v_g v_b + expr {(($v_r / 256) == $red) && (($v_g / 256) == $green) \ + && (($v_b / 256) == $blue)} } - test frame-1.1 {frame configuration options} -setup { deleteWindows } -body { @@ -170,22 +169,22 @@ test frame-1.14 {frame configuration options} -body { .f configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test frame-1.15 {frame configuration options} -body { - .f configure -bd 4 - lindex [.f configure -bd] 4 + .f configure -borderwidth 4 + lindex [.f configure -borderwidth] 4 } -cleanup { - .f configure -bd [lindex [.f configure -bd] 3] + .f configure -borderwidth [lindex [.f configure -borderwidth] 3] } -result {4} test frame-1.16 {frame configuration options} -body { - .f configure -bd badValue + .f configure -borderwidth badValue } -returnCodes error -result {bad screen distance "badValue"} test frame-1.17 {frame configuration options} -body { - .f configure -bg #00ff00 - lindex [.f configure -bg] 4 + .f configure -background #00ff00 + lindex [.f configure -background] 4 } -cleanup { - .f configure -bg [lindex [.f configure -bg] 3] + .f configure -background [lindex [.f configure -background] 3] } -result {#00ff00} test frame-1.18 {frame configuration options} -body { - .f configure -bg non-existent + .f configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test frame-1.19 {frame configuration options} -body { .f configure -borderwidth 1.3 @@ -285,7 +284,6 @@ test frame-1.39 {frame configuration options} -body { } -returnCodes error -result {bad screen distance "badValue"} destroy .f - test frame-2.1 {toplevel configuration options} -setup { deleteWindows } -body { @@ -336,7 +334,7 @@ test frame-2.5 {toplevel configuration options} -setup { test frame-2.6 {toplevel configuration options} -setup { deleteWindows } -body { - catch {destroy .t} + destroy .t toplevel .t -width 200 -height 100 wm geometry .t +0+0 catch {.t configure -container 1} @@ -353,13 +351,12 @@ test frame-2.7 {toplevel configuration options} -setup { deleteWindows } -returnCodes error -result {bad window path name "bogus"} - test frame-2.8 {toplevel configuration options} -constraints { win } -setup { deleteWindows } -body { - catch {destroy .t} + destroy .t toplevel .t -width 200 -height 100 wm geometry .t +0+0 .t configure -use 0x44022 @@ -371,7 +368,7 @@ test frame-2.9 {toplevel configuration options} -constraints { } -setup { deleteWindows } -body { - catch {destroy .t} + destroy .t toplevel .t -width 200 -height 100 wm geometry .t +0+0 catch {.t configure -use 0x44022} @@ -385,7 +382,7 @@ test frame-2.10 {toplevel configuration options} -constraints { } -setup { deleteWindows } -body { - catch {destroy .t} + destroy .t toplevel .t -width 200 -height 100 wm geometry .t +0+0 .t configure -use 0x44022 @@ -397,7 +394,7 @@ test frame-2.11 {toplevel configuration options} -constraints { } -setup { deleteWindows } -body { - catch {destroy .t} + destroy .t toplevel .t -width 200 -height 100 wm geometry .t +0+0 catch {.t configure -use 0x44022} @@ -409,7 +406,7 @@ test frame-2.11 {toplevel configuration options} -constraints { test frame-2.12 {toplevel configuration options} -setup { deleteWindows } -body { - catch {destroy .t} + destroy .t toplevel .t -width 200 -height 100 -visual default wm geometry .t +0+0 .t configure -visual @@ -419,7 +416,7 @@ test frame-2.12 {toplevel configuration options} -setup { test frame-2.13 {toplevel configuration options} -setup { deleteWindows } -body { - catch {destroy .t} + destroy .t toplevel .t -width 200 -height 100 -visual default wm geometry .t +0+0 .t configure -visual best @@ -486,7 +483,6 @@ test frame-2.19 {toplevel configuration options} -setup { deleteWindows } -result {} - destroy .t toplevel .t -width 300 -height 150 wm geometry .t +0+0 @@ -499,18 +495,18 @@ test frame-2.21 {toplevel configuration options} -body { .t configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test frame-2.22 {toplevel configuration options} -body { - .t configure -bd 4 - lindex [.t configure -bd] 4 + .t configure -borderwidth 4 + lindex [.t configure -borderwidth] 4 } -result {4} test frame-2.23 {toplevel configuration options} -body { - .t configure -bd badValue + .t configure -borderwidth badValue } -returnCodes error -result {bad screen distance "badValue"} test frame-2.24 {toplevel configuration options} -body { - .t configure -bg #00ff00 - lindex [.t configure -bg] 4 + .t configure -background #00ff00 + lindex [.t configure -background] 4 } -result {#00ff00} test frame-2.25 {toplevel configuration options} -body { - .t configure -bg non-existent + .t configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test frame-2.26 {toplevel configuration options} -body { .t configure -borderwidth 1.3 @@ -577,7 +573,6 @@ test frame-2.43 {toplevel configuration options} -body { } -returnCodes error -result {bad screen distance "badValue"} destroy .t - test frame-3.1 {TkCreateFrame procedure} -body { frame } -returnCodes error -result {wrong # args: should be "frame pathName ?-option value ...?"} @@ -601,7 +596,7 @@ test frame-3.3 {TkCreateFrame procedure} -setup { test frame-3.4 {TkCreateFrame procedure} -setup { deleteWindows } -body { - toplevel .t -width 350 -class NewClass -bg black -visual default -height 90 + toplevel .t -width 350 -class NewClass -background black -visual default -height 90 wm geometry .t +0+0 update list [lindex [.t configure -width] 4] \ @@ -662,7 +657,7 @@ test frame-3.9 {TkCreateFrame procedure, -use option} -constraints { } -body { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 - toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green + toplevel .x -width 140 -height 300 -use [winfo id .t] -background green tkwait visibility .x list [expr {[winfo rootx .x] - [winfo rootx .t]}] \ [expr {[winfo rooty .x] - [winfo rooty .t]}] \ @@ -678,7 +673,7 @@ test frame-3.10 {TkCreateFrame procedure, -use option} -constraints { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 option add *x.use [winfo id .t] - toplevel .x -width 140 -height 300 -bg green + toplevel .x -width 140 -height 300 -background green tkwait visibility .x list [expr {[winfo rootx .x] - [winfo rootx .t]}] \ [expr {[winfo rooty .x] - [winfo rooty .t]}] \ @@ -700,7 +695,7 @@ test frame-3.11 {TkCreateFrame procedure} -constraints { } -setup { deleteWindows } -body { - toplevel .t -width 300 -height 200 -bg #475601 + toplevel .t -width 300 -height 200 -background #475601 wm geometry .t +0+0 update colorsFree .t @@ -712,7 +707,7 @@ test frame-3.12 {TkCreateFrame procedure} -constraints { } -setup { deleteWindows } -body { - toplevel .t -width 300 -height 200 -bg #475601 -colormap new + toplevel .t -width 300 -height 200 -background #475601 -colormap new wm geometry .t +0+0 update colorsFree .t @@ -726,7 +721,7 @@ test frame-3.13 {TkCreateFrame procedure} -constraints { } -body { option add *t.class Toplevel2 option add *Toplevel2.colormap new - toplevel .t -width 300 -height 200 -bg #475601 + toplevel .t -width 300 -height 200 -background #475601 wm geometry .t +0+0 update option clear @@ -741,7 +736,7 @@ test frame-3.14 {TkCreateFrame procedure} -constraints { } -body { option add *t.class Toplevel3 option add *Toplevel3.Colormap new - toplevel .t -width 300 -height 200 -bg #475601 -colormap new + toplevel .t -width 300 -height 200 -background #475601 -colormap new wm geometry .t +0+0 update option clear @@ -756,7 +751,7 @@ test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -constraints { } -body { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 - toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new + toplevel .x -width 140 -height 300 -use [winfo id .t] -background green -colormap new tkwait visibility .x list [colorsFree .t] [colorsFree .x] } -cleanup { @@ -767,7 +762,7 @@ test frame-3.16 {TkCreateFrame procedure} -constraints { } -setup { deleteWindows } -body { - toplevel .t -width 300 -height 200 -bg #475601 -visual default + toplevel .t -width 300 -height 200 -background #475601 -visual default wm geometry .t +0+0 update colorsFree .t @@ -779,7 +774,7 @@ test frame-3.17 {TkCreateFrame procedure} -constraints { } -setup { deleteWindows } -body { - toplevel .t -width 300 -height 200 -bg #475601 -visual default \ + toplevel .t -width 300 -height 200 -background #475601 -visual default \ -colormap new wm geometry .t +0+0 update @@ -792,7 +787,7 @@ test frame-3.18 {TkCreateFrame procedure} -constraints { } -setup { deleteWindows } -body { - toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 + toplevel .t -visual {grayscale 8} -width 300 -height 200 -background #434343 wm geometry .t +0+0 update colorsFree .t 131 131 131 @@ -806,7 +801,7 @@ test frame-3.19 {TkCreateFrame procedure} -constraints { } -body { option add *t.class T4 option add *T4.visual {grayscale 8} - toplevel .t -width 300 -height 200 -bg #434343 + toplevel .t -width 300 -height 200 -background #434343 wm geometry .t +0+0 update option clear @@ -822,7 +817,7 @@ test frame-3.20 {TkCreateFrame procedure} -constraints { set x ok option add *t.class T5 option add *T5.Visual {grayscale 8} - toplevel .t -width 300 -height 200 -bg #434343 + toplevel .t -width 300 -height 200 -background #434343 wm geometry .t +0+0 update option clear @@ -836,7 +831,7 @@ test frame-3.21 {TkCreateFrame procedure} -constraints { deleteWindows } -body { set x ok - toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 + toplevel .t -visual {grayscale 8} -width 300 -height 200 -background #434343 wm geometry .t +0+0 update colorsFree .t 131 131 131 @@ -854,7 +849,7 @@ test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup { wm geometry .t +0+0 update set result "[winfo reqwidth .t] [winfo reqheight .t]" - frame .t.f -bg red + frame .t.f -background red pack .t.f update lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f] @@ -873,7 +868,6 @@ test frame-3.24 {TkCreateFrame procedure} -setup { wm geometry .t +0+0 } -returnCodes error -result {unknown option "-bogus"} - test frame-4.1 {TkCreateFrame procedure} -setup { deleteWindows } -body { @@ -888,7 +882,6 @@ test frame-4.2 {TkCreateFrame procedure} -setup { deleteWindows } -result {.f 1} - frame .f -highlightcolor black test frame-5.1 {FrameWidgetCommand procedure} -body { .f @@ -979,10 +972,10 @@ test frame-7.2 {FrameEventProc procedure} -setup { deleteWindows set x {} } -body { - frame .f1 -bg #543210 + frame .f1 -background #543210 rename .f1 .f2 lappend x [winfo children .] - lappend x [.f2 cget -bg] + lappend x [.f2 cget -background] destroy .f1 lappend x [info command .f*] [winfo children .] } -cleanup { @@ -1066,7 +1059,6 @@ test frame-9.3 {MapFrame procedure, window deleted while mapping} -setup { deleteWindows } -result {0} - test frame-10.1 {frame widget vs hidden commands} -setup { deleteWindows } -body { @@ -1079,7 +1071,6 @@ test frame-10.1 {frame widget vs hidden commands} -setup { expr {$res1 eq $res2} } -result 1 - test frame-11.1 {TkInstallFrameMenu} -setup { deleteWindows } -body { @@ -1105,11 +1096,10 @@ test frame-11.2 {TkInstallFrameMenu - frame renamed} -setup { deleteWindows } -result {} - test frame-12.1 {FrameWorldChanged procedure} -setup { deleteWindows } -body { - # Test -bd -padx and -pady + # Test -borderwidth -padx and -pady frame .f -borderwidth 2 -padx 3 -pady 4 place .f -x 0 -y 0 -width 40 -height 40 pack [frame .f.f] -fill both -expand 1 @@ -1123,7 +1113,7 @@ test frame-12.2 {FrameWorldChanged procedure} -setup { } -body { # Test all -labelanchor positions set font {helvetica 12} - labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font \ + labelframe .f -highlightthickness 1 -borderwidth 3 -padx 1 -pady 2 -font $font \ -text "Mupp" set fh [expr {[font metrics $font -linespace] + 2 - 3}] set fw [expr {[font measure $font "Mupp"] + 2 - 3}] @@ -1175,7 +1165,6 @@ test frame-12.3 {FrameWorldChanged procedure} -setup { font delete myfont } -result {0} - test frame-13.1 {labelframe configuration options} -setup { deleteWindows } -body { @@ -1256,22 +1245,22 @@ test frame-13.11 {labelframe configuration options} -body { .f configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test frame-13.12 {labelframe configuration options} -body { - .f configure -bd 4 - lindex [.f configure -bd] 4 + .f configure -borderwidth 4 + lindex [.f configure -borderwidth] 4 } -cleanup { - .f configure -bd [lindex [.f configure -bd] 3] + .f configure -borderwidth [lindex [.f configure -borderwidth] 3] } -result {4} test frame-13.13 {labelframe configuration options} -body { - .f configure -bd badValue + .f configure -borderwidth badValue } -returnCodes error -result {bad screen distance "badValue"} test frame-13.14 {labelframe configuration options} -body { - .f configure -bg #00ff00 - lindex [.f configure -bg] 4 + .f configure -background #00ff00 + lindex [.f configure -background] 4 } -cleanup { - .f configure -bg [lindex [.f configure -bg] 3] + .f configure -background [lindex [.f configure -background] 3] } -result {#00ff00} test frame-13.15 {labelframe configuration options} -body { - .f configure -bg non-existent + .f configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test frame-13.16 {labelframe configuration options} -body { .f configure -borderwidth 1.3 @@ -1292,13 +1281,13 @@ test frame-13.19 {labelframe configuration options} -body { .f configure -cursor badValue } -returnCodes error -result {bad cursor spec "badValue"} test frame-13.20 {labelframe configuration options} -body { - .f configure -fg #0000ff - lindex [.f configure -fg] 4 + .f configure -foreground #0000ff + lindex [.f configure -foreground] 4 } -cleanup { - .f configure -fg [lindex [.f configure -fg] 3] + .f configure -foreground [lindex [.f configure -foreground] 3] } -result {#0000ff} test frame-13.21 {labelframe configuration options} -body { - .f configure -fg non-existent + .f configure -foreground non-existent } -returnCodes error -result {unknown color name "non-existent"} test frame-13.22 {labelframe configuration options} -body { .f configure -font {courier 8} @@ -1410,7 +1399,6 @@ test frame-13.44 {labelframe configuration options} -body { } -returnCodes error -result {bad screen distance "badValue"} destroy .f - test frame-14.1 {labelframe labelwidget option} -setup { deleteWindows } -body { diff --git a/tests/geometry.test b/tests/geometry.test index 13cc515..f25164d 100644 --- a/tests/geometry.test +++ b/tests/geometry.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -proc getsize w { +proc getsize {w} { regexp {(^[^+-]*)} [wm geometry $w] foo x return $x } @@ -17,14 +17,13 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test - wm geometry . 300x300 raise . update -frame .f -bd 2 -relief raised -frame .f.f -bd 2 -relief sunken -frame .f.f.f -bd 2 -relief raised +frame .f -borderwidth 2 -relief raised +frame .f.f -borderwidth 2 -relief sunken +frame .f.f.f -borderwidth 2 -relief raised button .b1 -text .b1 button .b2 -text .b2 button .b3 -text .b3 @@ -53,7 +52,6 @@ test geometry-1.2 {Tk_ManageGeometry procedure} -setup { list [winfo x .b1] [winfo y .b1] } -result {0 0} - test geometry-2.1 {Tk_GeometryRequest procedure} -setup { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w @@ -76,7 +74,6 @@ test geometry-2.1 {Tk_GeometryRequest procedure} -setup { destroy .f2 } -result {1 1 150 300 1x1+0+0 150x300+10+20 100x80+10+20} - test geometry-3.1 {Tk_SetInternalBorder procedure} -setup { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w @@ -86,14 +83,13 @@ test geometry-3.1 {Tk_SetInternalBorder procedure} -setup { place .b1 -in .f -x 50 -y 5 update set x [list [winfo x .b1] [winfo y .b1]] - .f configure -bd 5 + .f configure -borderwidth 5 update lappend x [winfo x .b1] [winfo y .b1] } -cleanup { - .f configure -bd 2 + .f configure -borderwidth 2 } -result {72 37 75 40} - test geometry-4.1 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { foreach w {.f .f.f .f.f.f .b1 .b2 .b3} { place forget $w @@ -234,8 +230,8 @@ test geometry-4.8 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup { place .b3 -in .f.f.f -x 50 -y 25 update destroy .f.f - frame .f.f -bd 2 -relief raised - frame .f.f.f -bd 2 -relief raised + frame .f.f -borderwidth 2 -relief raised + frame .f.f.f -borderwidth 2 -relief raised place .f -x 30 -y 25 update list [winfo x .b1] [winfo y .b1] [winfo ismapped .b1] \ diff --git a/tests/get.test b/tests/get.test index ea08c8c..e80cfeb 100644 --- a/tests/get.test +++ b/tests/get.test @@ -99,7 +99,6 @@ test get-1.11 {Tk_GetAnchorFromObj - error} -setup { destroy .b } -returnCodes {error} -result {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center} - test get-2.1 {Tk_GetJustifyFromObj} -setup { button .b } -body { diff --git a/tests/grab.test b/tests/grab.test index 33399cb..e0d03f7 100644 --- a/tests/grab.test +++ b/tests/grab.test @@ -94,7 +94,6 @@ test grab-1.20 {Tk_GrabObjCmd, "grab status window"} -body { grab status .foo } -returnCodes error -result {bad window path name ".foo"} - test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} -body { set curr [grab current .] if { [string length $curr] > 0 } { @@ -125,7 +124,6 @@ test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} -body { grab release . } -result {global} - test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} -body { set curr [grab current .] if { [string length $curr] > 0 } { @@ -144,7 +142,6 @@ test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} -body { grab release . } -result {.} - test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} -body { set curr [grab current .] if { [string length $curr] > 0 } { @@ -160,7 +157,6 @@ test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} -body { lappend result [grab status .] } -result {local none global none} - test grab-5.1 {Tk_GrabObjCmd, grab set} -body { set curr [grab current .] if { [string length $curr] > 0 } { @@ -182,7 +178,6 @@ test grab-5.2 {Tk_GrabObjCmd, grab set} -body { grab release . } -result {. global} - cleanupTests return diff --git a/tests/grid.test b/tests/grid.test index c1d9d06..47fb2ec 100644 --- a/tests/grid.test +++ b/tests/grid.test @@ -17,7 +17,7 @@ namespace import -force tcltest::test proc grid_reset {{test ?} {top .}} { global GRID_VERBOSE if {[info exists GRID_VERBOSE]} { - if {$GRID_VERBOSE eq "" || $GRID_VERBOSE eq $test} { + if {$GRID_VERBOSE in "{} $test"} { puts -nonewline "grid test $test: " flush stdout gets stdin @@ -25,7 +25,7 @@ proc grid_reset {{test ?} {top .}} { } eval destroy [winfo children $top] update - foreach {cols rows} [grid size .] {} + lassign [grid size .] cols rows for {set i 0} {$i <= $cols} {incr i} { grid columnconfigure . $i -weight 0 -minsize 0 -pad 0 -uniform "" } @@ -109,8 +109,8 @@ test grid-2.8 {bbox} -body { grid bbox . 0 0 0 x } -returnCodes error -result {expected integer but got "x"} test grid-2.9 {bbox} -body { - frame .1 -width 75 -height 75 -bg red - frame .2 -width 90 -height 90 -bg red + frame .1 -width 75 -height 75 -background red + frame .2 -width 90 -height 90 -background red grid .1 -row 0 -column 0 grid .2 -row 1 -column 1 update @@ -124,8 +124,8 @@ test grid-2.9 {bbox} -body { grid_reset 2.9 } -result {{0 0 165 165} {0 0 75 75} {0 0 165 165} {75 75 90 90}} test grid-2.10 {bbox} -body { - frame .1 -width 75 -height 75 -bg red - frame .2 -width 90 -height 90 -bg red + frame .1 -width 75 -height 75 -background red + frame .2 -width 90 -height 90 -background red grid .1 -row 0 -column 0 grid .2 -row 1 -column 1 update @@ -225,9 +225,9 @@ test grid-4.4 {forget} -body { grid_reset 4.3.1 } -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} test grid-4.5 {forget, calling Tk_UnmaintainGeometry} -body { - frame .f -bd 2 -relief raised + frame .f -borderwidth 2 -relief raised place .f -x 10 -y 20 -width 200 -height 100 - frame .f2 -width 50 -height 30 -bg red + frame .f2 -width 50 -height 30 -background red grid .f2 -in .f update set x [winfo ismapped .f2] @@ -243,7 +243,7 @@ test grid-5.1 {info: basic argument checking} -body { grid info a b } -returnCodes error -result {wrong # args: should be "grid info window"} test grid-5.2 {info} -body { - frame .1 -width 75 -height 75 -bg red + frame .1 -width 75 -height 75 -background red grid .1 -row 0 -column 0 update grid info .x @@ -251,7 +251,7 @@ test grid-5.2 {info} -body { grid_reset 5.2 } -returnCodes error -result {bad window path name ".x"} test grid-5.3 {info} -body { - frame .1 -width 75 -height 75 -bg red + frame .1 -width 75 -height 75 -background red grid .1 -row 0 -column 0 update grid info .1 @@ -259,7 +259,7 @@ test grid-5.3 {info} -body { grid_reset 5.3 } -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}} test grid-5.4 {info} -body { - frame .1 -width 75 -height 75 -bg red + frame .1 -width 75 -height 75 -background red update grid info .1 } -cleanup { @@ -285,7 +285,7 @@ test grid-6.5 {location: basic argument checking} -body { grid_reset 6.5 } -result {-1 -1} test grid-6.6 {location (x)} -body { - frame .f -width 200 -height 100 -highlightthickness 0 -bg red + frame .f -width 200 -height 100 -highlightthickness 0 -background red grid .f update set got "" @@ -302,7 +302,7 @@ test grid-6.6 {location (x)} -body { grid_reset 6.6 } -result {{-10->-1 0} {0->0 0} {201->1 0}} test grid-6.7 {location (y)} -body { - frame .f -width 200 -height 100 -highlightthickness 0 -bg red + frame .f -width 200 -height 100 -highlightthickness 0 -background red grid .f update set got "" @@ -319,7 +319,7 @@ test grid-6.7 {location (y)} -body { grid_reset 6.7 } -result {{-10->0 -1} {0->0 0} {101->0 1}} test grid-6.8 {location (weights)} -body { - frame .f -width 300 -height 100 -highlightthickness 0 -bg red + frame .f -width 300 -height 100 -highlightthickness 0 -background red frame .a grid .a grid .f -in .a @@ -346,7 +346,7 @@ test grid-6.9 {location: check updates pending} -constraints { } -body { set a "" foreach i {0 1 2} { - frame .$i -width 120 -height 75 -bg red + frame .$i -width 120 -height 75 -background red lappend a [grid location . 150 90] grid .$i -row $i -column $i } @@ -381,12 +381,12 @@ test grid-7.5 {propagate} -body { grid_reset 7.5 } -returnCodes error -result {expected boolean value but got "x"} test grid-7.6 {propagate} -body { - frame .f -width 100 -height 100 -bg red + frame .f -width 100 -height 100 -background red grid .f -row 0 -column 0 update set a [winfo width .f]x[winfo height .f] grid propagate .f 0 - frame .g -width 75 -height 85 -bg green + frame .g -width 75 -height 85 -background green grid .g -in .f -row 0 -column 0 update lappend a [winfo width .f]x[winfo height .f] @@ -426,7 +426,7 @@ test grid-8.3 {size} -body { grid_reset 8.3 } -result {0 0} test grid-8.4 {size} -body { - catch {unset a} + unset -nocomplain a scale .f grid .f -row 0 -column 0 update @@ -445,7 +445,7 @@ test grid-8.4 {size} -body { grid_reset 8.4 } -result {{1 1} {6 5} {664 948} {1 1}} test grid-8.5 {size} -body { - catch {unset a} + unset -nocomplain a scale .f grid .f -row 0 -column 0 update @@ -465,7 +465,7 @@ test grid-8.5 {size} -body { grid_reset 8.5 } -result {{1 1} {1 18} {64 18} {1 1}} test grid-8.6 {size} -body { - catch {unset a} + unset -nocomplain a scale .f grid .f -row 10 -column 50 update @@ -528,7 +528,7 @@ test grid-9.10 {slaves} -body { grid_reset 9.10 } -result {.2 .1 .0} test grid-9.11 {slaves} -body { - catch {unset a} + unset -nocomplain a foreach i {0 1 2} { label .$i -text $i label .$i-x -text $i-x @@ -858,7 +858,7 @@ test grid-11.5 {default widget placement} -body { } -returnCodes error -result {must specify window before shortcut '-'} test grid-11.6 {default widget placement} -body { foreach i {1 2 3 4 5 6} { - frame .f$i -width 50 -height 50 -highlightthickness 0 -bg red + frame .f$i -width 50 -height 50 -highlightthickness 0 -background red } grid .f1 .f2 .f3 .f4 grid .f5 - x .f6 -sticky nsew @@ -873,21 +873,21 @@ test grid-11.6 {default widget placement} -body { grid_reset 11.6 } -result {{0,50 100,50} {150,50 50,50}} test grid-11.7 {default widget placement} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -row 5 -column 5 grid .f x - } -cleanup { grid_reset 11.7 } -returnCodes error -result {must specify window before shortcut '-'} test grid-11.8 {default widget placement} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -row 5 -column 5 grid .f ^ - } -cleanup { grid_reset 11.8 } -returnCodes error -result {must specify window before shortcut '-'} test grid-11.9 {default widget placement} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -row 5 -column 5 grid .f x ^ } -cleanup { @@ -895,7 +895,7 @@ test grid-11.9 {default widget placement} -body { } -returnCodes error -result {can't find slave to extend with "^"} test grid-11.10 {default widget placement} -body { foreach i {1 2 3} { - frame .f$i -width 100 -height 50 -highlightthickness 0 -bg red + frame .f$i -width 100 -height 50 -highlightthickness 0 -background red } grid .f1 .f2 -sticky nsew grid .f3 ^ -sticky nsew @@ -968,7 +968,7 @@ test grid-11.13 {default widget placement} -body { } -result {{0,50 120,50} {120,50 80,50}} test grid-11.14 {default widget placement} -body { foreach i {1 2 3} { - frame .f$i -width 60 -height 60 -highlightthickness 0 -bg red + frame .f$i -width 60 -height 60 -highlightthickness 0 -background red } grid .f1 .f2 grid ^ .f3 @@ -984,7 +984,7 @@ test grid-11.14 {default widget placement} -body { } -result {{0,30 60,60} {60,0 60,60} {60,60 60,60}} test grid-11.15 {^ ^ test with multiple windows} -body { foreach i {1 2 3 4} { - frame .f$i -width 50 -height 50 -bd 1 -relief solid + frame .f$i -width 50 -height 50 -borderwidth 1 -relief solid } grid .f1 .f2 .f3 -sticky ns grid .f4 ^ ^ @@ -1062,8 +1062,8 @@ test grid-11.19 {default widget placement} -body { } -result {50 100 100 50} test grid-12.1 {-sticky} -body { - catch {unset data} - frame .f -width 200 -height 100 -highlightthickness 0 -bg red + unset -nocomplain data + frame .f -width 200 -height 100 -highlightthickness 0 -background red set a "" grid .f grid rowconfigure . 0 -weight 1 @@ -1097,13 +1097,13 @@ test grid-12.1 {-sticky} -body { (nesw) 0 0 250 150 } test grid-12.2 {-sticky} -body { - frame .f -bg red + frame .f -background red grid .f -sticky glue } -cleanup { grid_reset 12.2 } -returnCodes error -result {bad stickyness value "glue": must be a string containing n, e, s, and/or w} test grid-12.3 {-sticky} -body { - frame .f -bg red + frame .f -background red grid .f -sticky {n,s,e,w} array set A [grid info .f] set A(-sticky) @@ -1112,13 +1112,13 @@ test grid-12.3 {-sticky} -body { } -result {nesw} test grid-13.1 {-in} -body { - frame .f -bg red + frame .f -background red grid .f -in .f } -cleanup { grid_reset 13.1 } -returnCodes error -result {window can't be managed in itself} test grid-13.2 {-in} -body { - frame .f -bg red + frame .f -background red list [winfo manager .f] \ [catch {grid .f -in .f} err] $err \ [winfo manager .f] @@ -1126,13 +1126,13 @@ test grid-13.2 {-in} -body { grid_reset 13.1.1 } -result {{} 1 {window can't be managed in itself} {}} test grid-13.3 {-in} -body { - frame .f -bg red + frame .f -background red grid .f -in .bad } -cleanup { grid_reset 13.2 } -returnCodes error -result {bad window path name ".bad"} test grid-13.4 {-in} -body { - frame .f -bg red + frame .f -background red toplevel .top grid .f -in .top } -cleanup { @@ -1140,19 +1140,19 @@ test grid-13.4 {-in} -body { } -returnCodes error -result {can't put .f inside .top} destroy .top test grid-13.5 {-ipadx} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -ipadx x } -cleanup { grid_reset 13.4 } -returnCodes error -result {bad ipadx value "x": must be positive screen distance} test grid-13.6 {-ipadx} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -ipadx {5 5} } -cleanup { grid_reset 13.4.1 } -returnCodes error -result {bad ipadx value "5 5": must be positive screen distance} test grid-13.7 {-ipadx} -body { - frame .f -width 200 -height 100 -highlightthickness 0 -bg red + frame .f -width 200 -height 100 -highlightthickness 0 -background red grid .f update set a [winfo width .f] @@ -1163,19 +1163,19 @@ test grid-13.7 {-ipadx} -body { grid_reset 13.5 } -result {200 202} test grid-13.8 {-ipady} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -ipady x } -cleanup { grid_reset 13.6 } -returnCodes error -result {bad ipady value "x": must be positive screen distance} test grid-13.9 {-ipady} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -ipady {5 5} } -cleanup { grid_reset 13.6.1 } -returnCodes error -result {bad ipady value "5 5": must be positive screen distance} test grid-13.10 {-ipady} -body { - frame .f -width 200 -height 100 -highlightthickness 0 -bg red + frame .f -width 200 -height 100 -highlightthickness 0 -background red grid .f update set a [winfo height .f] @@ -1186,19 +1186,19 @@ test grid-13.10 {-ipady} -body { grid_reset 13.7 } -result {100 102} test grid-13.11 {-padx} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -padx x } -cleanup { grid_reset 13.8 } -returnCodes error -result {bad pad value "x": must be positive screen distance} test grid-13.12 {-padx} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -padx {10 x} } -cleanup { grid_reset 13.8.1 } -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance} test grid-13.13 {-padx} -body { - frame .f -width 200 -height 100 -highlightthickness 0 -bg red + frame .f -width 200 -height 100 -highlightthickness 0 -background red grid .f update set a "[winfo width .f] [winfo width .]" @@ -1209,7 +1209,7 @@ test grid-13.13 {-padx} -body { grid_reset 13.9 } -result {{200 200} {200 202 1}} test grid-13.14 {-padx} -body { - frame .f -width 200 -height 100 -highlightthickness 0 -bg red + frame .f -width 200 -height 100 -highlightthickness 0 -background red grid .f update set a "[winfo width .f] [winfo width .]" @@ -1220,19 +1220,19 @@ test grid-13.14 {-padx} -body { grid_reset 13.9.1 } -result {{200 200} {200 215 10}} test grid-13.15 {-pady} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -pady x } -cleanup { grid_reset 13.10 } -returnCodes error -result {bad pad value "x": must be positive screen distance} test grid-13.16 {-pady} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid .f -pady {10 x} } -cleanup { grid_reset 13.10.1 } -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance} test grid-13.17 {-pady} -body { - frame .f -width 200 -height 100 -highlightthickness 0 -bg red + frame .f -width 200 -height 100 -highlightthickness 0 -background red grid .f update set a "[winfo height .f] [winfo height .]" @@ -1243,7 +1243,7 @@ test grid-13.17 {-pady} -body { grid_reset 13.11 } -result {{100 100} {100 102 1}} test grid-13.18 {-pady} -body { - frame .f -width 200 -height 100 -highlightthickness 0 -bg red + frame .f -width 200 -height 100 -highlightthickness 0 -background red grid .f update set a "[winfo height .f] [winfo height .]" @@ -1254,7 +1254,7 @@ test grid-13.18 {-pady} -body { grid_reset 13.11.1 } -result {{100 100} {100 120 4}} test grid-13.19 {-ipad x and y} -body { - frame .f -width 20 -height 20 -highlightthickness 0 -bg red + frame .f -width 20 -height 20 -highlightthickness 0 -background red grid columnconfigure . 0 -minsize 150 grid rowconfigure . 0 -minsize 100 set a "" @@ -1279,10 +1279,12 @@ test grid-13.20 {reparenting} -body { grid .1 .2 grid .b -in .1 set a "" - catch {unset info}; array set info [grid info .b] + unset -nocomplain info + array set info [grid info .b] lappend a [grid slaves .1],[grid slaves .2],$info(-in) grid .b -in .2 - catch {unset info}; array set info [grid info .b] + unset -nocomplain info + array set info [grid info .b] lappend a [grid slaves .1],[grid slaves .2],$info(-in) unset info return $a @@ -1291,15 +1293,15 @@ test grid-13.20 {reparenting} -body { } -result {.b,,.1 ,.b,.2} test grid-14.1 {structure notify} -body { - frame .f -width 200 -height 100 -highlightthickness 0 -bg red - frame .g -width 200 -height 100 -highlightthickness 0 -bg red + frame .f -width 200 -height 100 -highlightthickness 0 -background red + frame .g -width 200 -height 100 -highlightthickness 0 -background red grid .f grid .g -in .f update set a "" lappend a "[winfo x .g],[winfo y .g] \ [winfo width .g],[winfo height .g]" - .f configure -bd 5 -relief raised + .f configure -borderwidth 5 -relief raised update lappend a "[winfo x .g],[winfo y .g] \ [winfo width .g],[winfo height .g]" @@ -1315,7 +1317,7 @@ test grid-14.2 {structure notify} -body { update set a "" lappend a [grid bbox .],[grid bbox .f] - .f config -bd 20 + .f config -borderwidth 20 update lappend a [grid bbox .],[grid bbox .f] } -cleanup { @@ -1326,7 +1328,7 @@ test grid-14.3 {map notify: bug 1648} -constraints {nonPortable} -body { # A(.) will be incremented is unspecified--the behavior # is different accross window managers. global A - catch {unset A} + unset -nocomplain A bind . <Configure> {incr A(%W)} set A(.) 0 foreach i {0 1 2} { @@ -1336,7 +1338,7 @@ test grid-14.3 {map notify: bug 1648} -constraints {nonPortable} -body { grid .0 .1 .2 update bind <Configure> .1 {destroy .0} - .2 configure -bd 10 + .2 configure -borderwidth 10 update bind . <Configure> {} array get A @@ -1371,7 +1373,7 @@ test grid-15.2 {lost slave} -body { test grid-16.1 {layout centering} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + frame .$i -background gray -width 75 -height 50 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 @@ -1384,7 +1386,7 @@ test grid-16.1 {layout centering} -body { } -result {37 50 225 150} test grid-16.2 {layout weights (expanding)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + frame .$i -background gray -width 75 -height 50 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe grid rowconfigure . $i -weight [expr $i + 1] grid columnconfigure . $i -weight [expr $i + 1] @@ -1402,7 +1404,7 @@ test grid-16.2 {layout weights (expanding)} -body { } -result {120-75 167-100 213-125} test grid-16.3 {layout weights (shrinking)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + frame .$i -background gray -width 100 -height 75 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe grid rowconfigure . $i -weight [expr $i + 1] grid columnconfigure . $i -weight [expr $i + 1] @@ -1420,7 +1422,7 @@ test grid-16.3 {layout weights (shrinking)} -body { } -result {84-63 66-50 50-37} test grid-16.4 {layout weights (shrinking with minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + frame .$i -background gray -width 100 -height 75 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe grid rowconfigure . $i -weight [expr $i + 1] -minsize 45 grid columnconfigure . $i -weight [expr $i + 1] -minsize 65 @@ -1438,7 +1440,7 @@ test grid-16.4 {layout weights (shrinking with minsize)} -body { } -result {70-60 65-45 65-45} test grid-16.5 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + frame .$i -background gray -width 100 -height 75 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe grid rowconfigure . $i -weight 0 -minsize 70 grid columnconfigure . $i -weight 0 -minsize 90 @@ -1456,7 +1458,7 @@ test grid-16.5 {layout weights (shrinking at minsize)} -body { } -result {100-75 100-75 100-75} test grid-16.6 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + frame .$i -background gray -width 100 -height 75 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe grid rowconfigure . $i -weight [expr $i + 1] -minsize 52 grid columnconfigure . $i -weight [expr $i + 1] -minsize 69 @@ -1480,7 +1482,7 @@ test grid-16.6 {layout weights (shrinking at minsize)} -body { # That doesn't happen if previous tests run test grid-16.7 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + frame .$i -background gray -width 100 -height 75 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 @@ -1498,11 +1500,11 @@ test grid-16.7 {layout weights (shrinking at minsize)} -body { } -result {100-75-1 1-1-0 100-75-1} test grid-16.8 {layout internal constraints} -body { foreach i {0 1 2 3 4} { - frame .$i -bg gray -width 30 -height 25 -bd 2 -relief ridge + frame .$i -background gray -width 30 -height 25 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe } - frame .f -bg red -width 250 -height 200 - frame .g -bg green -width 200 -height 180 + frame .f -background red -width 250 -height 200 + frame .g -background green -width 200 -height 180 lower .f raise .g .f grid .f -row 1 -column 1 -rowspan 3 -columnspan 3 -sticky nswe @@ -1712,7 +1714,7 @@ test grid-16.16 {layout span} -body { [list 25 39 29 57 0] [list 30 34 22 64 0]] test grid-16.17 {layout weights (shrinking at minsize)} -body { foreach i {0 1 2 3} { - frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge + frame .$i -background gray -width 100 -height 75 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 @@ -1800,7 +1802,6 @@ test grid-17.1 {forget and pending idle handlers} -body { set result ok } -result ok - test grid-18.1 {test respect for internalborder} -body { toplevel .pack wm geometry .pack 200x200 @@ -1898,7 +1899,7 @@ test grid-21.5 {anchor} -body { } -returnCodes error -result {bad anchor "x": must be n, ne, e, se, s, sw, w, nw, or center} test grid-21.6 {anchor} -body { foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + frame .$i -background gray -width 75 -height 50 -borderwidth 2 -relief ridge grid .$i -row $i -column $i -sticky nswe } grid propagate . 0 @@ -1919,12 +1920,12 @@ test grid-21.7 {anchor} -body { # Test with a non-symmetric internal border. # This only tests vertically, there is currently no way to get # it assymetric horizontally. - labelframe .f -bd 0 + labelframe .f -borderwidth 0 frame .f.x -width 20 -height 20 .f configure -labelwidget .f.x pack .f -fill both -expand 1 foreach i {0 1 2} { - frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge + frame .$i -background gray -width 75 -height 50 -borderwidth 2 -relief ridge grid .$i -in .f -row $i -column $i -sticky nswe } pack propagate . 0 @@ -1974,9 +1975,9 @@ test grid-22.3.1 {remove} { } {-in .a -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns} grid_reset 22.3.1 test grid-22.4 {remove, calling Tk_UnmaintainGeometry} { - frame .f -bd 2 -relief raised + frame .f -borderwidth 2 -relief raised place .f -x 10 -y 20 -width 200 -height 100 - frame .f2 -width 50 -height 30 -bg red + frame .f2 -width 50 -height 30 -background red grid .f2 -in .f update set x [winfo ismapped .f2] diff --git a/tests/image.test b/tests/image.test index 3134ee8..d12ff67 100644 --- a/tests/image.test +++ b/tests/image.test @@ -19,7 +19,6 @@ canvas .c -highlightthickness 2 pack .c update - test image-1.1 {Tk_ImageCmd procedure, "create" option} -body { image } -returnCodes error -result {wrong # args: should be "image option ?args?"} @@ -179,7 +178,6 @@ test image-2.4 {Tk_ImageCmd procedure, "delete" option} -constraints { imageCleanup } -result {img2} - test image-3.1 {Tk_ImageCmd procedure, "height" option} -body { image height } -returnCodes error -result {wrong # args: should be "image height name"} @@ -202,7 +200,6 @@ test image-3.4 {Tk_ImageCmd procedure, "height" option} -constraints { imageCleanup } -result {15 50} - test image-4.1 {Tk_ImageCmd procedure, "names" option} -body { image names x } -returnCodes error -result {wrong # args: should be "image names"} @@ -237,7 +234,6 @@ test image-4.3 {Tk_ImageCmd procedure, "names" option} -setup { interp delete testinterp } -result {} - test image-5.1 {Tk_ImageCmd procedure, "type" option} -body { image type } -returnCodes error -result {wrong # args: should be "image type name"} @@ -295,7 +291,6 @@ test image-5.7 {Tk_ImageCmd procedure, "type" option} -constraints { imageCleanup } -returnCodes error -result {image "myimage" doesn't exist} - test image-6.1 {Tk_ImageCmd procedure, "types" option} -body { image types x } -returnCodes error -result {wrong # args: should be "image types"} @@ -305,7 +300,6 @@ test image-6.2 {Tk_ImageCmd procedure, "types" option} -constraints { lsort [image types] } -result {bitmap oldtest photo test} - test image-7.1 {Tk_ImageCmd procedure, "width" option} -body { image width } -returnCodes error -result {wrong # args: should be "image width name"} @@ -328,7 +322,6 @@ test image-7.4 {Tk_ImageCmd procedure, "width" option} -constraints { imageCleanup } -result {30 60} - test image-8.1 {Tk_ImageCmd procedure, "inuse" option} -constraints { testImageType } -setup { @@ -342,10 +335,9 @@ test image-8.1 {Tk_ImageCmd procedure, "inuse" option} -constraints { lappend res [image inuse myimage2] } -cleanup { imageCleanup - catch {destroy .b} + destroy .b } -result [list 0 1] - test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup { .c delete all imageCleanup @@ -378,7 +370,6 @@ test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup { imageCleanup } -result {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}} - test image-10.1 {Tk_GetImage procedure} -setup { imageCleanup } -body { @@ -399,7 +390,6 @@ test image-10.2 {Tk_GetImage procedure} -constraints testImageType -setup { imageCleanup } -returnCodes error -result {image "mytest" doesn't exist} - test image-11.1 {Tk_FreeImage procedure} -constraints testImageType -setup { .c delete all imageCleanup @@ -449,7 +439,7 @@ test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} -constraints image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update - .c create rectangle 30 40 55 65 -width 0 -fill black -outline {} + .c create rectangle 30 40 55 65 -width 0 -fill black -outline "" set x {} update return $x @@ -464,7 +454,7 @@ test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} -constraints image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update - .c create rectangle 60 40 100 65 -width 0 -fill black -outline {} + .c create rectangle 60 40 100 65 -width 0 -fill black -outline "" set x {} update return $x @@ -479,7 +469,7 @@ test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} -constraints image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update - .c create rectangle 60 70 100 200 -width 0 -fill black -outline {} + .c create rectangle 60 70 100 200 -width 0 -fill black -outline "" set x {} update return $x @@ -494,7 +484,7 @@ test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} -constraints image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update - .c create rectangle 30 70 55 200 -width 0 -fill black -outline {} + .c create rectangle 30 70 55 200 -width 0 -fill black -outline "" set x {} update return $x @@ -509,7 +499,7 @@ test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} -constraints image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update - .c create rectangle 10 20 120 130 -width 0 -fill black -outline {} + .c create rectangle 10 20 120 130 -width 0 -fill black -outline "" set x {} update return $x @@ -524,7 +514,7 @@ test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} -constraints image create test foo -variable x .c create image 50 60 -image foo -tags i1 -anchor nw update - .c create rectangle 55 65 75 70 -width 0 -fill black -outline {} + .c create rectangle 55 65 75 70 -width 0 -fill black -outline "" set x {} update return $x @@ -532,7 +522,6 @@ test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} -constraints imageCleanup } -result {{foo display 5 5 20 5 30 30}} - test image-13.1 {Tk_SizeOfImage procedure} -constraints testImageType -setup { imageCleanup } -body { diff --git a/tests/imgBmap.test b/tests/imgBmap.test index 5ffd7c4..4dd035e 100644 --- a/tests/imgBmap.test +++ b/tests/imgBmap.test @@ -40,23 +40,23 @@ imageCleanup #image create bitmap i1 #.c create image 200 100 -image i1 update -proc bgerror msg { +proc bgerror {msg} { global errMsg set errMsg $msg } test imageBmap-1.1 {options for bitmap images} -body { - image create bitmap i1 -background #123456 + image create bitmap i1 -background "#123456" lindex [i1 configure -background] 4 } -cleanup { image delete i1 -} -result {#123456} +} -result "#123456" test imageBmap-1.2 {options for bitmap images} -setup { destroy .c pack [canvas .c] update } -body { - set errMsg {} + set errMsg "" image create bitmap i1 -background lousy .c create image 200 100 -image i1 update @@ -81,11 +81,11 @@ test imageBmap-1.6 {options for bitmap images} -body { list [catch {image create bitmap i1 -file bogus} msg] [string tolower $msg] } -result {1 {couldn't read bitmap file "bogus": no such file or directory}} test imageBmap-1.7 {options for bitmap images} -body { - image create bitmap i1 -foreground #00ff00 + image create bitmap i1 -foreground "#00ff00" lindex [i1 configure -foreground] 4 } -cleanup { image delete i1 -} -result {#00ff00} +} -result "#00ff00" test imageBmap-1.8 {options for bitmap images} -setup { destroy .c pack [canvas .c] @@ -116,8 +116,7 @@ test imageBmap-1.12 {options for bitmap images} -body { list [catch {image create bitmap i1 -data $data1 -maskfile bogus} msg] \ [string tolower $msg] } -result {1 {couldn't read bitmap file "bogus": no such file or directory}} -rename bgerror {} - +rename bgerror "" test imageBmap-2.1 {ImgBmapCreate procedure} -setup { imageCleanup @@ -136,13 +135,12 @@ test imageBmap-2.2 {ImgBmapCreate procedure} -setup { image delete image1 } -result {image1 image1 0 0 #000000 {}} - test imageBmap-3.1 {ImgBmapConfigureMaster procedure, memory de-allocation} -body { image create bitmap i1 -data $data1 i1 configure -data $data1 } -cleanup { image delete i1 -} -result {} +} -result "" test imageBmap-3.2 {ImgBmapConfigureMaster procedure} -body { image create bitmap i1 -data $data1 list [catch {i1 configure -data bogus} msg] $msg [image width i1] \ @@ -153,7 +151,7 @@ test imageBmap-3.3 {ImgBmapConfigureMaster procedure, memory de-allocation} -bod i1 configure -maskdata $data2 } -cleanup { image delete i1 -} -result {} +} -result "" test imageBmap-3.4 {ImgBmapConfigureMaster procedure} -body { image create bitmap i1 i1 configure -maskdata $data2 @@ -200,7 +198,6 @@ test imageBmap-3.7 {ImgBmapConfigureMaster procedure} -setup { destroy .c } -result {15 14 {100 100 115 114} {200 100 215 114}} - test imageBmap-4.1 {ImgBmapConfigureInstance procedure: check error handling} -setup { destroy .c pack [canvas .c] @@ -215,8 +212,7 @@ test imageBmap-4.1 {ImgBmapConfigureInstance procedure: check error handling} -s } -cleanup { image delete i1 destroy .c -} -result {} - +} -result "" test imageBmap-5.1 {GetBitmapData procedure} -body { list [catch {image create bitmap -file ~bad_user/a/b} msg] \ @@ -330,7 +326,6 @@ test imageBmap-5.17 {GetBitmapData procedure} -setup {imageCleanup} -body { " } -returnCodes error -result {format error in bitmap data} - test imageBmap-6.1 {NextBitmapWord procedure} -setup {imageCleanup} -body { image create bitmap i1 -data {1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890} } -returnCodes error -result {format error in bitmap data} @@ -344,7 +339,6 @@ test imageBmap-6.3 {NextBitmapWord procedure} -setup {imageCleanup} -body { } -returnCodes error -result {format error in bitmap data} removeFile foo3.bm - imageCleanup # Image used in 7.* tests image create bitmap i1 @@ -381,7 +375,6 @@ test imageBmap-7.10 {ImgBmapCmd procedure} -body { i1 gorp } -returnCodes error -result {bad option "gorp": must be cget or configure} - test imageBmap-8.1 {ImgBmapGet/Free procedures, shared instances} -setup { destroy .c pack [canvas .c] @@ -404,8 +397,7 @@ test imageBmap-8.1 {ImgBmapGet/Free procedures, shared instances} -setup { image delete i1 } -cleanup { destroy .c -} -result {} - +} -result "" test imageBmap-9.1 {ImgBmapDisplay procedure, nothing to display} -setup { destroy .c @@ -421,7 +413,7 @@ test imageBmap-9.1 {ImgBmapDisplay procedure, nothing to display} -setup { } -cleanup { image delete i1 destroy .c -} -result {} +} -result "" test imageBmap-9.2 {ImgBmapDisplay procedure, nothing to display} -setup { destroy .c pack [canvas .c] @@ -437,12 +429,11 @@ test imageBmap-9.2 {ImgBmapDisplay procedure, nothing to display} -setup { } -cleanup { image delete i1 destroy .c -} -result {} +} -result "" if {[info exists bgerror]} { rename bgerror {} } - test imageBmap-10.1 {ImgBmapFree procedure, resource freeing} -setup { destroy .c pack [canvas .c] @@ -457,7 +448,7 @@ test imageBmap-10.1 {ImgBmapFree procedure, resource freeing} -setup { image delete i1 } -cleanup { destroy .c -} -result {} +} -result "" test imageBmap-10.2 {ImgBmapFree procedures, unlinking} -setup { destroy .c pack [canvas .c] @@ -482,14 +473,13 @@ test imageBmap-10.2 {ImgBmapFree procedures, unlinking} -setup { } -cleanup { image delete i1 deleteWindows -} -result {} - +} -result "" test imageBmap-11.1 {ImgBmapDelete procedure} -body { image create bitmap i2 -file foo.bm -maskfile foo2.bm image delete i2 info command i2 -} -result {} +} -result "" test imageBmap-11.2 {ImgBmapDelete procedure} -body { image create bitmap i2 -file foo.bm -maskfile foo2.bm rename i2 newi2 @@ -498,7 +488,6 @@ test imageBmap-11.2 {ImgBmapDelete procedure} -body { lappend x [info command new*] } -result {{} newi2 foo.bm {}} - test imageBmap-12.1 {ImgBmapCmdDeletedProc procedure} -body { image create bitmap i2 -file foo.bm -maskfile foo2.bm rename i2 {} diff --git a/tests/imgPPM.test b/tests/imgPPM.test index 456427f..d772d25 100644 --- a/tests/imgPPM.test +++ b/tests/imgPPM.test @@ -17,9 +17,9 @@ imageInit # only suitable for text files proc put {file data} { set f [open $file w] - fconfigure $f -translation lf - puts -nonewline $f $data - close $f + chan configure $f -translation lf + chan puts -nonewline $f $data + chan close $f } test imgPPM-1.1 {FileReadPPM procedure} -body { @@ -60,7 +60,6 @@ test imgPPM-1.9 {FileReadPPM procedure} -body { [image width p1] [image height p1] } -returnCodes ok -result {p1 5 4} - test imgPPM-2.1 {FileWritePPM procedure} -setup { catch {image delete p1} } -body { @@ -74,7 +73,7 @@ test imgPPM-2.1 {FileWritePPM procedure} -setup { test imgPPM-2.2 {FileWritePPM procedure} -setup { catch {image delete p1} - catch {unset data} + unset -nocomplain data } -body { put test.ppm "P6\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" image create photo p1 -file test.ppm @@ -90,7 +89,6 @@ test imgPPM-2.2 {FileWritePPM procedure} -setup { 255 012345678901234567890123456789012345678901234567890123456789} - test imgPPM-3.1 {ReadPPMFileHeader procedure} -body { put test.ppm "# \n#\n#\nP6\n#\n##\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789" image create photo p1 -file test.ppm @@ -154,7 +152,6 @@ test imgPPM-3.13 {ReadPPMFileHeader procedure, file ends too soon} -body { image create photo p1 -file test.ppm } -returnCodes error -result {couldn't recognize data in image file "test.ppm"} - test imgPPM-4.1 {StringReadPPM procedure, data too short [Bug 1822391]} -body { image create photo I -width 1103 -height 997 I put "P5\n1103 997\n255\n" diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test index e85f512..7eabfc8 100644 --- a/tests/imgPhoto.test +++ b/tests/imgPhoto.test @@ -22,8 +22,8 @@ proc foreachPixel {img xVar yVar script} { upvar 1 $xVar x $yVar y set width [image width $img] set height [image height $img] - for {set x 0} {$x<$width} {incr x} { - for {set y 0} {$y<$height} {incr y} { + for {set x 0} {$x < $width} {incr x} { + for {set y 0} {$y < $height} {incr y} { uplevel 1 $script } } diff --git a/tests/listbox.test b/tests/listbox.test index 0805528..3c27cfe 100644 --- a/tests/listbox.test +++ b/tests/listbox.test @@ -11,14 +11,14 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test -set fixed {Courier -12} +set fixed "Courier -12" proc record {name args} { global log lappend log [format {%s %.6g %.6g} $name {*}$args] } -proc getsize w { +proc getsize {w} { regexp {(^[^+-]*)} [wm geometry $w] foo x return $x } @@ -49,7 +49,7 @@ proc mkPartial {{w .partial}} { eleven twelve thirteen fourteen fifteen update scan [wm geometry $w] "%dx%d" width height - wm geometry $w ${width}x[expr $height-3] + wm geometry $w ${width}x[expr {$height - 3}] update } @@ -84,22 +84,22 @@ test listbox-1.4 {configuration options} -body { .l configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test listbox-1.5 {configuration options} -body { - .l configure -bd 4 - list [lindex [.l configure -bd] 4] [.l cget -bd] + .l configure -borderwidth 4 + list [lindex [.l configure -borderwidth] 4] [.l cget -borderwidth] } -cleanup { - .l configure -bd [lindex [.l configure -bd] 3] + .l configure -borderwidth [lindex [.l configure -borderwidth] 3] } -result {4 4} test listbox-1.6 {configuration options} -body { - .l configure -bd badValue + .l configure -borderwidth badValue } -returnCodes error -result {bad screen distance "badValue"} test listbox-1.7 {configuration options} -body { - .l configure -bg #ff0000 - list [lindex [.l configure -bg] 4] [.l cget -bg] + .l configure -background #ff0000 + list [lindex [.l configure -background] 4] [.l cget -background] } -cleanup { - .l configure -bg [lindex [.l configure -bg] 3] + .l configure -background [lindex [.l configure -background] 3] } -result {{#ff0000} #ff0000} test listbox-1.8 {configuration options} -body { - .l configure -bg non-existent + .l configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test listbox-1.9 {configuration options} -body { .l configure -borderwidth 1.3 @@ -138,13 +138,13 @@ test listbox-1.16 {configuration options} -body { .l configure -exportselection xyzzy } -returnCodes error -result {expected boolean value but got "xyzzy"} test listbox-1.17 {configuration options} -body { - .l configure -fg #110022 - list [lindex [.l configure -fg] 4] [.l cget -fg] + .l configure -foreground #110022 + list [lindex [.l configure -foreground] 4] [.l cget -foreground] } -cleanup { - .l configure -fg [lindex [.l configure -fg] 3] + .l configure -foreground [lindex [.l configure -foreground] 3] } -result {{#110022} #110022} test listbox-1.18 {configuration options} -body { - .l configure -fg bogus + .l configure -foreground bogus } -returnCodes error -result {unknown color name "bogus"} test listbox-1.19 {configuration options} -body { .l configure -font {Helvetica 12} @@ -291,13 +291,12 @@ test listbox-1.53 {configuration options} -body { .l configure -yscrollcommand [lindex [.l configure -yscrollcommand] 3] } -result {{Another command} {Another command}} test listbox-1.55 {configuration options} -body { - .l configure -listvar testVariable - list [lindex [.l configure -listvar] 4] [.l cget -listvar] + .l configure -listvariable testVariable + list [lindex [.l configure -listvariable] 4] [.l cget -listvariable] } -cleanup { - .l configure -listvar [lindex [.l configure -listvar] 3] + .l configure -listvariable [lindex [.l configure -listvariable] 3] } -result {testVariable testVariable} - test listbox-2.1 {Tk_ListboxCmd procedure} -body { listbox } -returnCodes error -result {wrong # args: should be "listbox pathName ?-option value ...?"} @@ -336,7 +335,7 @@ test listbox-2.5 {Tk_ListboxCmd procedure} -setup { # Listbox used in 3.1 -3.115 tests destroy .l -listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2 +listbox .l -width 20 -height 5 -borderwidth 4 -highlightthickness 1 -selectborderwidth 2 pack .l .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \ el15 el16 el17 @@ -466,11 +465,11 @@ test listbox-3.26 {ListboxWidgetCmd procedure, "configure" option} -body { .l configure -gorp is_messy } -returnCodes error -result {unknown option "-gorp"} test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} -body { - set oldbd [.l cget -bd] + set oldbd [.l cget -borderwidth] set oldht [.l cget -highlightthickness] - .l configure -bd 3 -highlightthickness 0 - set x "[.l cget -bd] [.l cget -highlightthickness]" - .l configure -bd $oldbd -highlightthickness $oldht + .l configure -borderwidth 3 -highlightthickness 0 + set x "[.l cget -borderwidth] [.l cget -highlightthickness]" + .l configure -borderwidth $oldbd -highlightthickness $oldht set x } -result {3 0} test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} -body { @@ -1060,7 +1059,7 @@ test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last lin # Listbox used in 3.127 -3.137 tests destroy .l -listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2 +listbox .l -width 20 -height 5 -borderwidth 4 -highlightthickness 1 -selectborderwidth 2 pack .l .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \ el15 el16 el17 @@ -1292,18 +1291,18 @@ test listbox-4.8 {ConfigureListbox procedure} -setup { -yscrollcommand "record y" pack .l2 update - .l2 configure -fg black + .l2 configure -foreground black set log {} update set log } -cleanup { destroy .l2 } -result {{y 0 1} {x 0 1}} -test listbox-4.9 {ConfigureListbox procedure, -listvar} -setup { +test listbox-4.9 {ConfigureListbox procedure, -listvariable} -setup { destroy .l2 } -body { set x [list a b c d] - listbox .l2 -listvar x + listbox .l2 -listvariable x .l2 get 0 end } -cleanup { destroy .l2 @@ -1314,7 +1313,7 @@ test listbox-4.10 {ConfigureListbox, no listvar -> existing listvar} -setup { set x [list a b c d] listbox .l2 .l2 insert end 1 2 3 4 - .l2 configure -listvar x + .l2 configure -listvariable x .l2 get 0 end } -cleanup { destroy .l2 @@ -1323,8 +1322,8 @@ test listbox-4.11 {ConfigureListbox procedure, listvar -> no listvar} -setup { destroy .l2 } -body { set x [list a b c d] - listbox .l2 -listvar x - .l2 configure -listvar {} + listbox .l2 -listvariable x + .l2 configure -listvariable {} .l2 insert end 1 2 3 4 list $x [.l2 get 0 end] } -cleanup { @@ -1336,8 +1335,8 @@ test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} -se set x [list a b c d] set y [list 1 2 3 4] listbox .l2 - .l2 configure -listvar x - .l2 configure -listvar y + .l2 configure -listvariable x + .l2 configure -listvariable y .l2 insert end 5 6 7 8 list $x $y } -cleanup { @@ -1346,10 +1345,10 @@ test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} -se test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} -setup { destroy .l2 } -body { - catch {unset x} + unset -nocomplain x listbox .l2 .l2 insert end a b c d - .l2 configure -listvar x + .l2 configure -listvariable x set x } -cleanup { destroy .l2 @@ -1357,8 +1356,8 @@ test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} -setup test listbox-4.14 {ConfigureListbox, non-existant listvar} -setup { destroy .l2 } -body { - catch {unset x} - listbox .l2 -listvar x + unset -nocomplain x + listbox .l2 -listvariable x list [info exists x] $x } -cleanup { destroy .l2 @@ -1366,20 +1365,20 @@ test listbox-4.14 {ConfigureListbox, non-existant listvar} -setup { test listbox-4.15 {ConfigureListbox, listvar -> non-existant listvar} -setup { destroy .l2 } -body { - catch {unset y} + unset -nocomplain x y set x [list a b c d] - listbox .l2 -listvar x - .l2 configure -listvar y + listbox .l2 -listvariable x + .l2 configure -listvariable y list [info exists y] $y } -cleanup { destroy .l2 -} -result [list 1 [list a b c d]] +} -result [list 0 [list a b c d]] test listbox-4.16 {ConfigureListbox, listvar -> same listvar} -setup { destroy .l2 } -body { set x [list a b c d] - listbox .l2 -listvar x - .l2 configure -listvar x + listbox .l2 -listvariable x + .l2 configure -listvariable x set x } -cleanup { destroy .l2 @@ -1389,7 +1388,7 @@ test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} -setup { } -body { listbox .l2 .l2 insert end a b c d - .l2 configure -listvar {} + .l2 configure -listvariable {} .l2 get 0 end } -cleanup { destroy .l2 @@ -1400,8 +1399,8 @@ test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} -setup { listbox .l2 .l2 insert end a b c d set x "this is a \" bad list" - catch {.l2 configure -listvar x} result - list [.l2 get 0 end] [.l2 cget -listvar] $result + catch {.l2 configure -listvariable x} result + list [.l2 get 0 end] [.l2 cget -listvariable] $result } -cleanup { destroy .l2 } -result [list [list a b c d] {} \ @@ -1410,10 +1409,10 @@ test listbox-4.19 {ConfigureListbox, no listvar -> bad non-existent listvar} -se destroy .l2 } -body { unset -nocomplain ::foo - listbox .l2 -listvar foo + listbox .l2 -listvariable foo .l2 insert end a b c d - catch {.l2 configure -listvar ::zoo::bar::foo} result - list [.l2 get 0 end] [.l2 cget -listvar] $foo $result + catch {.l2 configure -listvariable ::zoo::bar::foo} result + list [.l2 get 0 end] [.l2 cget -listvariable] $foo $result } -cleanup { destroy .l2 } -result [list [list a b c d] foo [list a b c d] \ @@ -1446,7 +1445,7 @@ test listbox-5.3 {ListboxComputeGeometry procedure} -constraints { } -setup { destroy .l } -body { - listbox .l -font $fixed -width 0 -height 10 -bd 3 + listbox .l -font $fixed -width 0 -height 10 -borderwidth 3 .l insert 0 Short "Really much longer" Longer pack .l update @@ -1585,11 +1584,11 @@ test listbox-6.12 {InsertEls procedure} -constraints { } -cleanup { destroy .l2 } -result {80 93 122 110} -test listbox-6.13 {InsertEls procedure, check -listvar update} -setup { +test listbox-6.13 {InsertEls procedure, check -listvariable update} -setup { destroy .l2 } -body { set x [list a b c d] - listbox .l2 -listvar x + listbox .l2 -listvariable x .l2 insert 0 1 2 3 4 set x } -cleanup { @@ -1609,19 +1608,18 @@ test listbox-6.14 {InsertEls procedure, check selection update} -setup { test listbox-6.15 {InsertEls procedure, lost namespaced listvar} -body { destroy .l2 namespace eval test { variable foo {a b} } - listbox .l2 -listvar ::test::foo + listbox .l2 -listvariable ::test::foo namespace delete test .l2 insert end c d .l2 delete end .l2 insert end e f catch {set ::test::foo} result - list [.l2 get 0 end] [.l2 cget -listvar] $result + list [.l2 get 0 end] [.l2 cget -listvariable] $result } -cleanup { destroy .l2 } -result [list [list a b c e f] ::test::foo \ {can't read "::test::foo": no such variable}] - test listbox-7.1 {DeleteEls procedure} -body { .l delete 0 end .l insert 0 a b c d e f g h i j @@ -1779,16 +1777,15 @@ test listbox-7.20 {DeleteEls procedure} -constraints { .l2 delete 2 4 lappend x [winfo reqwidth .l2] [winfo reqheight .l2] } -result {80 144 17 93} -test listbox-7.21 {DeleteEls procedure, check -listvar update} -setup { +test listbox-7.21 {DeleteEls procedure, check -listvariable update} -setup { destroy .l2 } -body { set x [list a b c d] - listbox .l2 -listvar x + listbox .l2 -listvariable x .l2 delete 0 1 set x } -result [list c d] - test listbox-8.1 {ListboxEventProc procedure} -constraints { fonts } -setup { @@ -1822,18 +1819,17 @@ test listbox-8.2 {ListboxEventProc procedure} -constraints { test listbox-8.3 {ListboxEventProc procedure} -setup { deleteWindows } -body { - listbox .l1 -bg #543210 + listbox .l1 -background #543210 rename .l1 .l2 set x {} lappend x [winfo children .] - lappend x [.l2 cget -bg] + lappend x [.l2 cget -background] destroy .l1 lappend x [info command .l*] [winfo children .] } -cleanup { deleteWindows } -result {.l1 #543210 {} {}} - test listbox-9.1 {ListboxCmdDeletedProc procedure} -setup { deleteWindows } -body { @@ -2076,7 +2072,6 @@ test listbox-10.20 {GetListboxIndex procedure} -setup { destroy .l } -result 1 - test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} -setup { destroy .l } -body { @@ -2201,8 +2196,8 @@ pack .l .l insert 0 a bb c d e f g h i j k l m n o p q r s .l insert 0 0123456789a123456789b123456789c123456789d123456789 update -set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]] -set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]] +set width [expr {[lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]}] +set height [expr {[lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]}] test listbox-13.1 {ListboxScanTo procedure} -constraints { fonts } -body { @@ -2240,7 +2235,6 @@ test listbox-13.3 {ListboxScanTo procedure} -constraints { lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] } -result {{0.8 1} {0.75 1} {0.64 0.84} {0.25 0.5}} - test listbox-14.1 {NearestListboxElement procedure, partial last line} -body { mkPartial .partial.l nearest [winfo height .partial.l] @@ -2354,7 +2348,6 @@ test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} -b .l curselection } -result {} - test listbox-16.1 {ListboxFetchSelection procedure} -body { .l delete 0 end .l insert 0 a b c "two words" e f g h i \\ k l m n o p @@ -2380,10 +2373,9 @@ test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} - set sel [selection get] string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel } -cleanup { - catch {unset long sel} + unset -nocomplain long sel } -result {0} - test listbox-17.1 {ListboxLostSelection procedure} -setup { destroy .e } -body { @@ -2488,7 +2480,6 @@ test listbox-19.2 {ListboxUpdateVScrollbar procedure} -body { "bogus 0.0 1.0" (horizontal scrolling command executed by listbox)}} - test listbox-20.1 {listbox vs hidden commands} -setup { deleteWindows } -body { @@ -2506,8 +2497,8 @@ test listbox-20.1 {listbox vs hidden commands} -setup { test listbox-21.1 {ListboxListVarProc} -setup { destroy .l } -body { - catch {unset x} - listbox .l -listvar x + unset -nocomplain x + listbox .l -listvariable x set x [list a b c d] .l get 0 end } -cleanup { @@ -2517,7 +2508,7 @@ test listbox-21.2 {ListboxListVarProc} -setup { destroy .l } -body { set x [list a b c d] - listbox .l -listvar x + listbox .l -listvariable x unset x set x } -cleanup { @@ -2527,8 +2518,8 @@ test listbox-21.3 {ListboxListVarProc} -setup { destroy .l } -body { set x [list a b c d] - listbox .l -listvar x - .l configure -listvar {} + listbox .l -listvariable x + .l configure -listvariable {} unset x info exists x } -cleanup { @@ -2538,7 +2529,7 @@ test listbox-21.4 {ListboxListVarProc} -setup { destroy .l } -body { set x [list a b c d] - listbox .l -listvar x + listbox .l -listvariable x lappend x e f g .l size } -cleanup { @@ -2548,7 +2539,7 @@ test listbox-21.5 {ListboxListVarProc, test selection after listvar mod} -setup destroy .l } -body { set x [list a b c d e f g] - listbox .l -listvar x + listbox .l -listvariable x .l selection set end set x [list a b c d] set x [list 0 1 2 3 4 5 6] @@ -2560,7 +2551,7 @@ test listbox-21.6 {ListboxListVarProc, test selection after listvar mod} -setup destroy .l } -body { set x [list a b c d] - listbox .l -listvar x + listbox .l -listvariable x .l selection set 3 lappend x e f g .l curselection @@ -2571,7 +2562,7 @@ test listbox-21.7 {ListboxListVarProc, test selection after listvar mod} -setup destroy .l } -body { set x [list a b c d] - listbox .l -listvar x + listbox .l -listvariable x .l selection set 0 set x [linsert $x 0 1 2 3 4] .l curselection @@ -2582,7 +2573,7 @@ test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} -setup destroy .l } -body { set x [list a b c d] - listbox .l -listvar x + listbox .l -listvariable x .l selection set 2 set x [list a b c] .l curselection @@ -2592,9 +2583,9 @@ test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} -setup test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} -setup { destroy .l } -body { - catch {unset x} + unset -nocomplain x set log {} - listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x + listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvariable x pack .l update lappend x "0000000000" @@ -2608,9 +2599,9 @@ test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} -setup test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} -setup { destroy .l } -body { - catch {unset x} + unset -nocomplain x set log {} - listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x + listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvariable x pack .l update lappend x "0000000000" @@ -2626,8 +2617,8 @@ test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} -setu test listbox-21.11 {ListboxListVarProc, bad list} -setup { destroy .l } -body { - catch {unset x} - listbox .l -listvar x + unset -nocomplain x + listbox .l -listvariable x set x [list a b c d] catch {set x "this is a \" bad list"} result set result @@ -2638,11 +2629,11 @@ test listbox-21.12 {ListboxListVarProc, cleanup item attributes} -setup { destroy .l } -body { set x [list a b c d e f g] - listbox .l -listvar x - .l itemconfigure end -fg red + listbox .l -listvariable x + .l itemconfigure end -foreground red set x [list a b c d] set x [list 0 1 2 3 4 5 6] - .l itemcget end -fg + .l itemcget end -foreground } -cleanup { destroy .l } -result {} @@ -2650,44 +2641,44 @@ test listbox-21.12a {ListboxListVarProc, cleanup item attributes} -setup { destroy .l } -body { set x [list a b c d e f g] - listbox .l -listvar x - .l itemconfigure end -fg red + listbox .l -listvariable x + .l itemconfigure end -foreground red set x [list a b c d] set x [list 0 1 2 3 4 5 6] - .l itemcget end -fg + .l itemcget end -foreground } -cleanup { destroy .l } -result {} test listbox-21.13 {listbox item configurations and listvar based deletions} -setup { destroy .l } -body { - catch {unset x} - listbox .l -listvar x + unset -nocomplain x + listbox .l -listvariable x .l insert end a b c - .l itemconfigure 1 -fg red + .l itemconfigure 1 -foreground red set x [list b c] - .l itemcget 1 -fg + .l itemcget 1 -foreground } -cleanup { destroy .l } -result red test listbox-21.14 {listbox item configurations and listvar based inserts} -setup { destroy .l } -body { - catch {unset x} - listbox .l -listvar x + unset -nocomplain x + listbox .l -listvariable x .l insert end a b c - .l itemconfigure 0 -fg red + .l itemconfigure 0 -foreground red set x [list 1 2 3 4 a b c] - .l itemcget 0 -fg + .l itemcget 0 -foreground } -cleanup { destroy .l } -result red test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} -setup { destroy .l } -body { - catch {unset x} + unset -nocomplain x set log {} - listbox .l -listvar x -yscrollcommand "record y" -font fixed -height 3 + listbox .l -listvariable x -yscrollcommand "record y" -font fixed -height 3 pack .l update lappend x a b c d e f @@ -2699,8 +2690,8 @@ test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} -setup { test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} -setup { destroy .l } -body { - catch {unset x} - listbox .l -listvar x -height 3 + unset -nocomplain x + listbox .l -listvariable x -height 3 pack .l update set x [list 0 1 2 3 4 5] @@ -2787,14 +2778,14 @@ test listbox-23.5 {ConfigureListboxItem, multiple calls} -setup { set i 0 foreach color {red orange yellow green blue white violet} { .l insert end $color - .l itemconfigure $i -bg $color + .l itemconfigure $i -background $color incr i } pack .l update - list [.l itemcget 0 -bg] [.l itemcget 1 -bg] [.l itemcget 2 -bg] \ - [.l itemcget 3 -bg] [.l itemcget 4 -bg] [.l itemcget 5 -bg] \ - [.l itemcget 6 -bg] + list [.l itemcget 0 -background] [.l itemcget 1 -background] [.l itemcget 2 -background] \ + [.l itemcget 3 -background] [.l itemcget 4 -background] [.l itemcget 5 -background] \ + [.l itemcget 6 -background] } -cleanup { destroy .l } -result {red orange yellow green blue white violet} @@ -2813,22 +2804,22 @@ test listbox-23.7 {configuration options} -body { .l configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test listbox-23.8 {configuration options} -body { - .l itemconfigure 0 -bg #ff0000 - list [lindex [.l itemconfigure 0 -bg] 4] [.l itemcget 0 -bg] + .l itemconfigure 0 -background #ff0000 + list [lindex [.l itemconfigure 0 -background] 4] [.l itemcget 0 -background] } -cleanup { - .l configure -bg #ffffff + .l configure -background #ffffff } -result {{#ff0000} #ff0000} test listbox-23.9 {configuration options} -body { - .l configure -bg non-existent + .l configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test listbox-23.10 {configuration options} -body { - .l itemconfigure 0 -fg #110022 - list [lindex [.l itemconfigure 0 -fg] 4] [.l itemcget 0 -fg] + .l itemconfigure 0 -foreground #110022 + list [lindex [.l itemconfigure 0 -foreground] 4] [.l itemcget 0 -foreground] } -cleanup { - .l configure -fg #000000 + .l configure -foreground #000000 } -result {{#110022} #110022} test listbox-23.11 {configuration options} -body { - .l configure -fg bogus + .l configure -foreground bogus } -returnCodes error -result {unknown color name "bogus"} test listbox-23.12 {configuration options} -body { .l itemconfigure 0 -foreground #110022 @@ -2865,7 +2856,7 @@ test listbox-24.1 {itemcget} -setup { } -body { listbox .l .l insert end a b c d - .l itemcget 0 -fg + .l itemcget 0 -foreground } -cleanup { destroy .l } -result {} @@ -2874,8 +2865,8 @@ test listbox-24.2 {itemcget} -setup { } -body { listbox .l .l insert end a b c d - .l itemconfigure 0 -fg red - .l itemcget 0 -fg + .l itemconfigure 0 -foreground red + .l itemcget 0 -foreground } -cleanup { destroy .l } -result red @@ -2907,10 +2898,10 @@ test listbox-25.1 {listbox item configurations and widget based deletions} -setu } -body { listbox .l .l insert end a - .l itemconfigure 0 -fg red + .l itemconfigure 0 -foreground red .l delete 0 end .l insert end a - .l itemcget 0 -fg + .l itemcget 0 -foreground } -cleanup { destroy .l } -result {} @@ -2919,9 +2910,9 @@ test listbox-25.2 {listbox item configurations and widget based inserts} -setup } -body { listbox .l .l insert end a b c - .l itemconfigure 0 -fg red + .l itemconfigure 0 -foreground red .l insert 0 1 2 3 4 - list [.l itemcget 0 -fg] [.l itemcget 4 -fg] + list [.l itemcget 0 -foreground] [.l itemcget 4 -foreground] } -cleanup { destroy .l } -result {{} red} @@ -2989,7 +2980,6 @@ test listbox-26.5 {listbox disabled state disallows active modification} -setup destroy .l } -result 0 - test listbox-27.1 {widget deletion while active} -setup { destroy .l } -body { @@ -3002,7 +2992,6 @@ test listbox-27.1 {widget deletion while active} -setup { destroy .l } -result 0 - test listbox-28.1 {listbox -activestyle} -setup { destroy .l } -body { @@ -3040,7 +3029,6 @@ test listbox-28.4 {listbox -activestyle} -setup { destroy .l } -result underline - test listbox-29.1 {listbox selection behavior, -state disabled} -setup { destroy .l } -body { diff --git a/tests/main.test b/tests/main.test index 7ab624f..19291c1 100644 --- a/tests/main.test +++ b/tests/main.test @@ -25,16 +25,16 @@ test main-2.1 {Tk_MainEx: -encoding option} -constraints stdio -setup { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 - puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]; exit" - close $f + chan configure $f -encoding utf-8 + chan puts $f {puts [list $argv0 $argv $tcl_interactive]} + chan puts -nonewline $f {puts [string equal \u20ac } + chan puts $f "\u20ac]; exit" + chan close $f catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} } -body { - read $f + chan read $f } -cleanup { - close $f + chan close $f removeFile script } -result "script {} 0\n1\n" @@ -42,16 +42,16 @@ test main-2.2 {Tk_MainEx: -encoding option} -constraints stdio -setup { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 - puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]; exit" - close $f + chan configure $f -encoding utf-8 + chan puts $f {puts [list $argv0 $argv $tcl_interactive]} + chan puts -nonewline $f {puts [string equal \u20ac } + chan puts $f "\u20ac]; exit" + chan close $f catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} } -body { - read $f + chan read $f } -cleanup { - close $f + chan close $f removeFile script } -result "script {} 0\n0\n" @@ -60,8 +60,8 @@ test main-2.2 {Tk_MainEx: -encoding option} -constraints stdio -setup { proc type {chan script} { foreach line [split $script \n] { if {[catch { - puts $chan $line - flush $chan + chan puts $chan $line + chan flush $chan }]} { return } @@ -74,20 +74,20 @@ test main-2.3 {Tk_MainEx: -encoding option} -constraints stdio -setup { set script [makeFile {} script] file delete $script set f [open $script w] - fconfigure $f -encoding utf-8 - puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]" - close $f + chan configure $f -encoding utf-8 + chan puts $f {puts [list $argv0 $argv $tcl_interactive]} + chan puts -nonewline $f {puts [string equal \u20ac } + chan puts $f "\u20ac]" + chan close $f catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} } -body { type $f { - puts $argv + chan puts $argv exit } - gets $f + chan gets $f } -cleanup { - close $f + chan close $f removeFile script } -returnCodes ok -result {-enc utf-8 script} diff --git a/tests/menu.test b/tests/menu.test index 595a21b..acc1abd 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -183,12 +183,12 @@ test menu-2.8 {configuration options -background non-existent} -body { .m1 configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} -test menu-2.9 {configuration options -bg #110022} -body { - .m1 configure -bg #110022 - .m1 cget -bg +test menu-2.9 {configuration options -background #110022} -body { + .m1 configure -background #110022 + .m1 cget -background } -result {#110022} -test menu-2.10 {configuration options -bg bogus} -body { - .m1 configure -bg bogus +test menu-2.10 {configuration options -background bogus} -body { + .m1 configure -background bogus } -returnCodes error -result {unknown color name "bogus"} test menu-2.11 {configuration options -borderwidth 1.3} -body { @@ -215,12 +215,12 @@ test menu-2.16 {configuration options -disabledforeground xyzzy} -body { .m1 configure -disabledforeground xyzzy } -returnCodes error -result {unknown color name "xyzzy"} -test menu-2.17 {configuration options -fg #110022} -body { - .m1 configure -fg #110022 - .m1 cget -fg +test menu-2.17 {configuration options -foreground #110022} -body { + .m1 configure -foreground #110022 + .m1 cget -foreground } -result {#110022} -test menu-2.18 {configuration options -fg bogus} -body { - .m1 configure -fg bogus +test menu-2.18 {configuration options -foreground bogus} -body { + .m1 configure -foreground bogus } -returnCodes error -result {unknown color name "bogus"} test menu-2.19 {configuration options -font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*} -body { @@ -1214,8 +1214,6 @@ if {[testConstraint hasEarthPhoto]} { image delete image1 } - - test menu-3.1 {MenuWidgetCmd procedure} -setup { destroy .m1 } -body { @@ -1586,7 +1584,7 @@ test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} -setup { test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add command -label "set foo" -command "set foo hello" list [.m1 invoke 1] [set foo] [unset foo] @@ -1822,11 +1820,10 @@ test menu-3.70 {MenuWidgetCmd procedure, "xposition" option} -setup { destroy .m1 } -result {} - test menu-4.1 {TkInvokeMenu: disabled} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off \ -state disabled @@ -1845,7 +1842,7 @@ test menu-4.2 {TkInvokeMenu: tearoff} -setup { test menu-4.3 {TkInvokeMenu: checkbutton -on} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 \ @@ -1856,7 +1853,7 @@ test menu-4.3 {TkInvokeMenu: checkbutton -on} -setup { test menu-4.4 {TkInvokeMenu: checkbutton -off} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off .m1 invoke 1 @@ -1867,7 +1864,7 @@ test menu-4.4 {TkInvokeMenu: checkbutton -off} -setup { test menu-4.5 {TkInvokeMenu: checkbutton array element} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add checkbutton -label "test" -variable foo(1) -onvalue on list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3 @@ -1877,7 +1874,7 @@ test menu-4.5 {TkInvokeMenu: checkbutton array element} -setup { test menu-4.6 {TkInvokeMenu: radiobutton} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add radiobutton -label "1" -variable foo -value one .m1 add radiobutton -label "2" -variable foo -value two @@ -1889,7 +1886,7 @@ test menu-4.6 {TkInvokeMenu: radiobutton} -setup { test menu-4.7 {TkInvokeMenu: radiobutton} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add radiobutton -label "1" -variable foo -value one .m1 add radiobutton -label "2" -variable foo -value two @@ -1901,7 +1898,7 @@ test menu-4.7 {TkInvokeMenu: radiobutton} -setup { test menu-4.8 {TkInvokeMenu: radiobutton} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add radiobutton -label "1" -variable foo -value one .m1 add radiobutton -label "2" -variable foo -value two @@ -1913,7 +1910,7 @@ test menu-4.8 {TkInvokeMenu: radiobutton} -setup { test menu-4.9 {TkInvokeMenu: radiobutton array element} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add radiobutton -label "1" -variable foo(2) -value one .m1 add radiobutton -label "2" -variable foo(2) -value two @@ -1925,7 +1922,7 @@ test menu-4.9 {TkInvokeMenu: radiobutton array element} -setup { test menu-4.10 {TkInvokeMenu} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add command -label "test" -command "set menu_test menu-4.8" list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 @@ -2060,7 +2057,6 @@ test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} -setup { list [destroy .m2] [destroy .m1] } -result {{} {}} - test menu-6.1 {TkDestroyMenu} -setup { destroy .m1 } -body { @@ -2379,7 +2375,7 @@ test menu-9.4 {ConfigureMenu} -setup { } -body { menu .m1 .m1 add command -label "test" - .m1 configure -fg red + .m1 configure -foreground red } -cleanup { deleteWindows } -result {} @@ -2389,7 +2385,7 @@ test menu-9.5 {ConfigureMenu} -setup { menu .m1 .m1 add command -label "test" .m1 add command -label "two" - .m1 configure -fg red + .m1 configure -foreground red } -cleanup { deleteWindows } -result {} @@ -2400,7 +2396,7 @@ test menu-9.6 {ConfigureMenu} -setup { .m1 add command -label "test" .m1 add command -label "two" .m1 add command -label "three" - .m1 configure -fg red + .m1 configure -foreground red } -cleanup { deleteWindows } -result {} @@ -2409,7 +2405,7 @@ test menu-9.7 {ConfigureMenu} -setup { } -body { menu .m1 .m1 clone .m2 tearoff - list [.m1 configure -fg red] [.m2 cget -fg] + list [.m1 configure -foreground red] [.m2 cget -foreground] } -cleanup { deleteWindows } -result {{} red} @@ -2418,7 +2414,7 @@ test menu-9.8 {ConfigureMenu} -setup { } -body { menu .m1 .m1 clone .m2 tearoff - list [.m2 configure -fg red] [.m1 cget -fg] + list [.m2 configure -foreground red] [.m1 cget -foreground] } -cleanup { deleteWindows } -result {{} red} @@ -2431,11 +2427,10 @@ test menu-9.9 {ConfigureMenu} -setup { deleteWindows } -result {{} {}} - test menu-10.1 {PostProcessEntry: array variable} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 set foo(1) on .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense" @@ -2446,7 +2441,7 @@ test menu-10.1 {PostProcessEntry: array variable} -setup { test menu-10.2 {PostProcessEntry: array variable} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense" set foo(1) @@ -2454,11 +2449,10 @@ test menu-10.2 {PostProcessEntry: array variable} -setup { deleteWindows } -result {off} - test menu-11.1 {ConfigureMenuEntry} -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense" list [.m1 entryconfigure 1 -variable bar] [.m1 entrycget 1 -variable] @@ -2679,7 +2673,6 @@ test menu-11.21 {ConfigureMenuEntry} -constraints { imageCleanup } -result {} - test menu-12.1 {ConfigureMenuCloneEntries} -setup { deleteWindows } -body { @@ -2728,7 +2721,6 @@ test menu-12.4 {ConfigureMenuCloneEntries} -setup { deleteWindows } -result {} - test menu-13.1 {TkGetMenuIndex} -setup { deleteWindows } -body { @@ -3079,11 +3071,10 @@ test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} -setup { deleteWindows } -result {0 .#menubar.#menubar#test.#menubar#test#cascade {}} - test menu-17.1 {MenuVarProc} -setup { deleteWindows } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 set foo "hello" list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ @@ -3095,7 +3086,7 @@ test menu-17.1 {MenuVarProc} -setup { test menu-17.2 {MenuVarProc} -setup { deleteWindows } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ [set foo ""] @@ -3105,7 +3096,7 @@ test menu-17.2 {MenuVarProc} -setup { test menu-17.3 {MenuVarProc} -setup { deleteWindows } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 set foo "hello" list [.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye] \ @@ -3134,7 +3125,6 @@ test menu-17.5 {MenuVarProc} -setup { deleteWindows } -result {{} goodbye {}} - test menu-18.1 {TkActivateMenuEntry} -setup { deleteWindows } -body { @@ -3176,7 +3166,6 @@ test menu-18.4 {TkActivateMenuEntry} -setup { deleteWindows } -result {} - test menu-19.1 {TkPostCommand} -constraints nonUnixUserInteraction -setup { deleteWindows } -body { @@ -3200,7 +3189,7 @@ test menu-20.1 {CloneMenu} -setup { deleteWindows } -body { menu .m1 - .m1 clone .m2] + .m1 clone .m2 } -cleanup { deleteWindows } -result {} @@ -3411,7 +3400,6 @@ test menu-24.3 {TkNewMenuName} -setup { [destroy .m] [destroy hideme] } -result {0 {} {} {} {}} - test menu-25.1 {TkSetWindowMenuBar} -setup { deleteWindows } -body { @@ -3590,7 +3578,6 @@ test menu-25.16 {TkSetWindowMenuBar} -setup { deleteWindows } -result {.t2 {}} - test menu-26.1 {DestroyMenuHashTable} -setup { catch {interp delete testinterp} deleteWindows @@ -3601,7 +3588,6 @@ test menu-26.1 {DestroyMenuHashTable} -setup { interp delete testinterp } -returnCodes ok -result {} - test menu-27.1 {GetMenuHashTable} -setup { catch {interp delete testinterp} deleteWindows @@ -3613,7 +3599,6 @@ test menu-27.1 {GetMenuHashTable} -setup { deleteWindows } -result {0 .m1 {}} - test menu-28.1 {TkCreateMenuReferences - not there before} -setup { deleteWindows } -body { @@ -3631,7 +3616,6 @@ test menu-28.2 {TkCreateMenuReferences - there already} -setup { deleteWindows } -result {.m2} - test menu-29.1 {TkFindMenuReferences - not there} -setup { deleteWindows } -body { @@ -3643,7 +3627,6 @@ test menu-29.1 {TkFindMenuReferences - not there} -setup { deleteWindows } -result {{} {}} - test menu-30.1 {TkFindMenuReferences - there already} -setup { deleteWindows } -body { @@ -3656,7 +3639,6 @@ test menu-30.1 {TkFindMenuReferences - there already} -setup { deleteWindows } -result {{} {}} - test menu-31.1 {TkFreeMenuReferences - menuPtr} -setup { deleteWindows } -body { @@ -3695,7 +3677,6 @@ test menu-31.4 {TkFreeMenuReferences - not empty} -setup { deleteWindows } -result {} - test menu-32.1 {DeleteMenuCloneEntries} -setup { deleteWindows } -body { @@ -3819,7 +3800,6 @@ test menu-32.9 {Ensure deleting of clones doesn't corrupt menu refs} -setup { deleteWindows } -result {.menubar.cascade .#menubar.#menubar#test.#menubar#cascade .menubar.cascade .#menubar.#menubar#test.#menubar#cascade} - test menu-33.1 {menu vs command hiding} -setup { deleteWindows } -body { diff --git a/tests/menuDraw.test b/tests/menuDraw.test index bb632c6..42514f2 100644 --- a/tests/menuDraw.test +++ b/tests/menuDraw.test @@ -19,7 +19,6 @@ test menuDraw-1.1 {TkMenuInitializeDrawingFields} -setup { deleteWindows } -result {.m1} - test menuDraw-2.1 {TkIntializeMenuEntryDrawingFields} -setup { deleteWindows } -body { @@ -29,7 +28,6 @@ test menuDraw-2.1 {TkIntializeMenuEntryDrawingFields} -setup { deleteWindows } -result {} - test menuDraw-3.1 {TkMenuFreeDrawOptions} -setup { deleteWindows } -body { @@ -37,7 +35,6 @@ test menuDraw-3.1 {TkMenuFreeDrawOptions} -setup { destroy .m1 } -result {} - test menuDraw-4.1 {TkMenuEntryFreeDrawOptions} -setup { deleteWindows } -body { @@ -54,7 +51,6 @@ test menuDraw-4.2 {TkMenuEntryFreeDrawOptions} -setup { destroy .m1 } -result {} - test menuDraw-5.1 {TkMenuConfigureDrawOptions - new menu} -setup { deleteWindows } -body { @@ -66,7 +62,7 @@ test menuDraw-5.2 {TkMenuConfigureDrawOptions - old menu} -setup { deleteWindows } -body { menu .m1 - .m1 configure -fg red + .m1 configure -foreground red } -cleanup { deleteWindows } -result {} @@ -78,7 +74,6 @@ test menuDraw-5.3 {TkMenuConfigureDrawOptions - no disabledFg} -setup { deleteWindows } -result {.m1} - test menuDraw-6.1 {TkMenuConfigureEntryDrawOptions - no tkfont specified} -setup { deleteWindows } -body { @@ -218,7 +213,6 @@ test menuDraw-6.16 {TkMenuConfigureEntryDrawOptions - indicatorGC disposal} -set deleteWindows } -result {} - test menuDraw-7.1 {TkEventuallyRecomputeMenu} -setup { deleteWindows } -body { @@ -241,7 +235,6 @@ test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} -setup { deleteWindows } -result {} - test menuDraw-8.1 {TkRecomputeMenu} -constraints { win userInteraction } -setup { @@ -255,11 +248,10 @@ test menuDraw-8.1 {TkRecomputeMenu} -constraints { deleteWindows } -result {} - test menuDraw-9.1 {TkEventuallyRedrawMenu - entry test} -setup { deleteWindows } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 set foo 0 .m1 add radiobutton -variable foo -label test @@ -319,7 +311,6 @@ test menuDraw-10.4 {ComputeMenuGeometry - resize not necessary} -setup { deleteWindows } -result {} - test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} -constraints { testImageType } -setup { @@ -475,7 +466,6 @@ test menuDraw-12.7 {Display menu - extra space at end of menu} -setup { deleteWindows } -result {} - test menuDraw-13.1 {TkMenuEventProc - Expose} -setup { deleteWindows } -body { @@ -517,7 +507,6 @@ test menuDraw-13.5 {TkMenuEventProc - nothing pending} -setup { destroy .m1 } -result {} - test menuDraw-14.1 {TkMenuImageProc} -constraints testImageType -setup { deleteWindows } -body { @@ -542,7 +531,6 @@ test menuDraw-14.2 {TkMenuImageProc} -constraints testImageType -setup { deleteWindows } -result {} - test menuDraw-15.1 {TkPostTearoffMenu - Basic posting} -setup { deleteWindows } -body { @@ -565,7 +553,7 @@ test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} -setup { test menuDraw-15.3 {TkPostTearoffMenu - post command} -setup { deleteWindows } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 -postcommand "set foo .m1" .m1 add command -label "foo" list [catch {tk::TearOffMenu .m1 40 40}] [set foo] [unset foo] [destroy .m1] @@ -598,7 +586,6 @@ test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} -setup { deleteWindows } -returnCodes ok -match glob -result * - test menuDraw-16.1 {TkPostSubmenu} -constraints nonUnixUserInteraction -setup { deleteWindows } -body { @@ -673,7 +660,6 @@ test menuDraw-16.6 {TkPostSubMenu} -constraints { deleteWindows } -result {} - test menuDraw-17.1 {AdjustMenuCoords - menubar} -constraints unix -setup { deleteWindows } -body { @@ -683,7 +669,7 @@ test menuDraw-17.1 {AdjustMenuCoords - menubar} -constraints unix -setup { .m2 add command -label foo . configure -menu .m1 foreach w [winfo children .] { - if {[$w cget -type] == "menubar"} { + if {[$w cget -type] eq "menubar"} { break } } diff --git a/tests/menubut.test b/tests/menubut.test index 6efdb0f..a4934cd 100644 --- a/tests/menubut.test +++ b/tests/menubut.test @@ -26,7 +26,6 @@ option add *Button.borderWidth 2 option add *Button.highlightThickness 2 option add *Button.font {Helvetica -12 bold} - menubutton .mb -text "Test" pack .mb update @@ -67,22 +66,22 @@ test menubutton-1.8 {configuration options} -body { .mb configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test menubutton-1.9 {configuration options} -body { - .mb configure -bd 4 - .mb cget -bd + .mb configure -borderwidth 4 + .mb cget -borderwidth } -cleanup { - .mb configure -bd [lindex [.mb configure -bd] 3] + .mb configure -borderwidth [lindex [.mb configure -borderwidth] 3] } -result {4} test menubutton-1.10 {configuration options} -body { - .mb configure -bd badValue + .mb configure -borderwidth badValue } -returnCodes error -result {bad screen distance "badValue"} test menubutton-1.11 {configuration options} -body { - .mb configure -bg #ff0000 - .mb cget -bg + .mb configure -background #ff0000 + .mb cget -background } -cleanup { - .mb configure -bg [lindex [.mb configure -bg] 3] + .mb configure -background [lindex [.mb configure -background] 3] } -result {#ff0000} test menubutton-1.12 {configuration options} -body { - .mb configure -bg non-existent + .mb configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test menubutton-1.13 {configuration options} -body { .mb configure -bitmap questhead @@ -130,13 +129,13 @@ test menubutton-1.22 {configuration options} -body { .mb configure -disabledforeground xyzzy } -returnCodes error -result {unknown color name "xyzzy"} test menubutton-1.23 {configuration options} -body { - .mb configure -fg #110022 - .mb cget -fg + .mb configure -foreground #110022 + .mb cget -foreground } -cleanup { - .mb configure -fg [lindex [.mb configure -fg] 3] + .mb configure -foreground [lindex [.mb configure -foreground] 3] } -result {#110022} test menubutton-1.24 {configuration options} -body { - .mb configure -fg bogus + .mb configure -foreground bogus } -returnCodes error -result {unknown color name "bogus"} test menubutton-1.25 {configuration options} -body { .mb configure -font {Helvetica 12} @@ -314,7 +313,6 @@ test menubutton-1.59 {configuration options} -body { .mb configure -wraplength 6x } -returnCodes error -result {bad screen distance "6x"} - deleteWindows menubutton .mb -text "Test" pack .mb @@ -326,7 +324,7 @@ test menubutton-2.2 {Tk_MenubuttonCmd procedure} -body { menubutton foo } -returnCodes error -result {bad window path name "foo"} test menubutton-2.3 {Tk_MenubuttonCmd procedure} -body { - catch {destroy .mb} + destroy .mb menubutton .mb winfo class .mb } -result {Menubutton} @@ -342,7 +340,6 @@ test menubutton-2.5 {Tk_ButtonCmd procedure} -setup { winfo exists .mb } -result 0 - deleteWindows menubutton .mb -text "Test Menu" pack .mb @@ -372,12 +369,12 @@ test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} -body { .mb configure -gorp } -returnCodes error -result {unknown option "-gorp"} test menubutton-3.9 {ButtonWidgetCmd procedure, "configure" option} -body { - .mb co -bg #ffffff -fg -} -returnCodes error -result {value for "-fg" missing} + .mb co -background #ffffff -foreground +} -returnCodes error -result {value for "-foreground" missing} test menubutton-3.10 {ButtonWidgetCmd procedure, "configure" option} -body { - .mb configure -fg #123456 - .mb configure -bg #654321 - lindex [.mb configure -fg] 4 + .mb configure -foreground #123456 + .mb configure -background #654321 + lindex [.mb configure -foreground] 4 } -result {#123456} test menubutton-3.11 {ButtonWidgetCmd procedure, "configure" option} -body { .mb foobar @@ -521,17 +518,16 @@ test menubutton-5.1 {MenuButtonEventProc procedure} -setup { deleteWindows set x {} } -body { - menubutton .mb1 -bg #543210 + menubutton .mb1 -background #543210 rename .mb1 .mb2 lappend x [winfo children .] - lappend x [.mb2 cget -bg] + lappend x [.mb2 cget -background] destroy .mb1 lappend x [info command .mb*] [winfo children .] } -cleanup { deleteWindows } -result {.mb1 #543210 {} {}} - test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} -setup { deleteWindows } -body { @@ -542,14 +538,13 @@ test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} -setup { deleteWindows } -result {{} {}} - test menubutton-7.1 {ComputeMenuButtonGeometry procedure} -constraints { testImageType } -setup { deleteWindows image create test image1 } -body { - menubutton .mb -image image1 -bd 4 -highlightthickness 0 + menubutton .mb -image image1 -borderwidth 4 -highlightthickness 0 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } -cleanup { @@ -562,7 +557,7 @@ test menubutton-7.2 {ComputeMenuButtonGeometry procedure} -constraints { deleteWindows image create test image1 } -body { - menubutton .mb -image image1 -bd 1 -highlightthickness 2 + menubutton .mb -image image1 -borderwidth 1 -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } -cleanup { @@ -575,7 +570,7 @@ test menubutton-7.3 {ComputeMenuButtonGeometry procedure} -constraints { deleteWindows image create test image1 } -body { - menubutton .mb -image image1 -bd 0 -highlightthickness 2 -padx 5 -pady 5 + menubutton .mb -image image1 -borderwidth 0 -highlightthickness 2 -padx 5 -pady 5 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } -cleanup { @@ -588,7 +583,7 @@ test menubutton-7.4 {ComputeMenuButtonGeometry procedure} -constraints { deleteWindows image create test image1 } -body { - menubutton .mb -image image1 -bd 2 -relief raised -width 40 \ + menubutton .mb -image image1 -borderwidth 2 -relief raised -width 40 \ -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -602,7 +597,7 @@ test menubutton-7.5 {ComputeMenuButtonGeometry procedure} -constraints { deleteWindows image create test image1 } -body { - menubutton .mb -image image1 -bd 2 -relief raised -height 30 \ + menubutton .mb -image image1 -borderwidth 2 -relief raised -height 30 \ -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -613,7 +608,7 @@ test menubutton-7.5 {ComputeMenuButtonGeometry procedure} -constraints { test menubutton-7.6 {ComputeMenuButtonGeometry procedure} -setup { deleteWindows } -body { - menubutton .mb -bitmap question -bd 2 -relief raised \ + menubutton .mb -bitmap question -borderwidth 2 -relief raised \ -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -623,7 +618,7 @@ test menubutton-7.6 {ComputeMenuButtonGeometry procedure} -setup { test menubutton-7.7 {ComputeMenuButtonGeometry procedure} -setup { deleteWindows } -body { - menubutton .mb -bitmap question -bd 2 -relief raised -width 40 \ + menubutton .mb -bitmap question -borderwidth 2 -relief raised -width 40 \ -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -633,7 +628,7 @@ test menubutton-7.7 {ComputeMenuButtonGeometry procedure} -setup { test menubutton-7.8 {ComputeMenuButtonGeometry procedure} -setup { deleteWindows } -body { - menubutton .mb -bitmap question -bd 2 -relief raised -height 50 \ + menubutton .mb -bitmap question -borderwidth 2 -relief raised -height 50 \ -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -645,7 +640,7 @@ test menubutton-7.9 {ComputeMenuButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - menubutton .mb -text String -bd 2 -relief raised -padx 0 -pady 0 \ + menubutton .mb -text String -borderwidth 2 -relief raised -padx 0 -pady 0 \ -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -657,7 +652,7 @@ test menubutton-7.10 {ComputeMenuButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - menubutton .mb -text String -bd 2 -relief raised -width 20 \ + menubutton .mb -text String -borderwidth 2 -relief raised -width 20 \ -padx 0 -pady 0 -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -669,7 +664,7 @@ test menubutton-7.11 {ComputeMenuButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - menubutton .mb -text String -bd 2 -relief raised -height 2 \ + menubutton .mb -text String -borderwidth 2 -relief raised -height 2 \ -padx 0 -pady 0 -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -681,7 +676,7 @@ test menubutton-7.12 {ComputeMenuButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - menubutton .mb -text String -bd 2 -relief raised -padx 10 -pady 5 \ + menubutton .mb -text String -borderwidth 2 -relief raised -padx 10 -pady 5 \ -highlightthickness 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -693,7 +688,7 @@ test menubutton-7.13 {ComputeMenuButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - menubutton .mb -text String -bd 2 -relief raised \ + menubutton .mb -text String -borderwidth 2 -relief raised \ -highlightthickness 1 -indicatoron 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -709,7 +704,7 @@ test menubutton-7.14 {ComputeMenuButtonGeometry procedure} -constraints { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. - menubutton .mb -image image1 -bd 2 -relief raised \ + menubutton .mb -image image1 -borderwidth 2 -relief raised \ -highlightthickness 2 -indicatoron 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -726,7 +721,7 @@ test menubutton-7.15 {ComputeMenuButtonGeometry procedure} -constraints { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. - menubutton .mb -image image1 -bd 2 -relief raised \ + menubutton .mb -image image1 -borderwidth 2 -relief raised \ -highlightthickness 2 -indicatoron 1 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] @@ -735,7 +730,6 @@ test menubutton-7.15 {ComputeMenuButtonGeometry procedure} -constraints { imageCleanup } -result {65 23} - test menubutton-8.1 {menubutton vs hidden commands} -body { set l [interp hidden] deleteWindows @@ -747,8 +741,6 @@ test menubutton-8.1 {menubutton vs hidden commands} -body { expr {$res1 eq $res2} } -result 1 - - deleteWindows option clear imageFinish diff --git a/tests/message.test b/tests/message.test index dcffc72..242cb16 100644 --- a/tests/message.test +++ b/tests/message.test @@ -11,7 +11,6 @@ namespace import ::tcltest::* tcltest::loadTestedCommands eval tcltest::configure $argv - test message-1.1 {configuration option: "anchor"} -setup { message .m -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .m @@ -77,8 +76,8 @@ test message-1.7 {configuration option: "bd"} -setup { pack .m update } -body { - .m configure -bd 4 - .m cget -bd + .m configure -borderwidth 4 + .m cget -borderwidth } -cleanup { destroy .m } -result {4} @@ -87,7 +86,7 @@ test message-1.8 {configuration option: "bd"} -setup { pack .m update } -body { - .m configure -bd badValue + .m configure -borderwidth badValue } -cleanup { destroy .m } -returnCodes {error} -result {bad screen distance "badValue"} @@ -97,8 +96,8 @@ test message-1.9 {configuration option: "bg"} -setup { pack .m update } -body { - .m configure -bg #ff0000 - .m cget -bg + .m configure -background #ff0000 + .m cget -background } -cleanup { destroy .m } -result {#ff0000} @@ -107,7 +106,7 @@ test message-1.10 {configuration option: "bg"} -setup { pack .m update } -body { - .m configure -bg non-existent + .m configure -background non-existent } -cleanup { destroy .m } -returnCodes {error} -result {unknown color name "non-existent"} @@ -157,8 +156,8 @@ test message-1.15 {configuration option: "fg"} -setup { pack .m update } -body { - .m configure -fg #00ff00 - .m cget -fg + .m configure -foreground #00ff00 + .m cget -foreground } -cleanup { destroy .m } -result {#00ff00} @@ -167,7 +166,7 @@ test message-1.16 {configuration option: "fg"} -setup { pack .m update } -body { - .m configure -fg badValue + .m configure -foreground badValue } -cleanup { destroy .m } -returnCodes {error} -result {unknown color name "badValue"} @@ -394,7 +393,6 @@ test message-1.38 {configuration option: "width"} -setup { destroy .m } -returnCodes {error} -result {bad screen distance "badValue"} - test message-2.1 {Tk_MessageObjCmd procedure} -body { message } -returnCodes {error} -result {wrong # args: should be "message pathName ?-option value ...?"} @@ -415,7 +413,6 @@ test message-2.5 {Tk_MessageObjCmd procedure} -body { winfo child . } -result {} - test message-3.1 {MessageWidgetObjCmd procedure} -setup { message .m } -body { @@ -463,9 +460,9 @@ test message-3.6 {MessageWidgetObjCmd procedure, "configure"} -setup { test message-3.7 {MessageWidgetObjCmd procedure, "configure"} -setup { message .m } -body { - .m configure -bd 4 - .m configure -bg #ffffff - lindex [.m configure -bd] 4 + .m configure -borderwidth 4 + .m configure -background #ffffff + lindex [.m configure -borderwidth] 4 } -cleanup { destroy .m } -result {4} diff --git a/tests/msgbox.test b/tests/msgbox.test index 643ae2c..835575c 100644 --- a/tests/msgbox.test +++ b/tests/msgbox.test @@ -10,7 +10,6 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test - test msgbox-1.1 {tk_messageBox command} -body { tk_messageBox -foo } -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type} @@ -76,9 +75,8 @@ test msgbox-1.19 {tk_messageBox command} -body { tk_messageBox -parent foo.bar } -returnCodes error -result {bad window path name "foo.bar"} - catch {tk_messageBox -foo bar} -set isNative [expr {[info commands tk::MessageBox] == ""}] +set isNative [expr {[info commands tk::MessageBox] eq ""}] proc ChooseMsg {parent btn} { global isNative @@ -101,15 +99,15 @@ proc PressButton {btn} { } proc SendEventToMsg {parent btn type} { - if {$parent != "."} { + if {$parent ne "."} { set w $parent.__tk__messagebox } else { set w .__tk__messagebox } - if ![winfo ismapped $w.$btn] { + if {![winfo ismapped $w.$btn]} { update } - if {$type == "mouse"} { + if {$type eq "mouse"} { PressButton $w.$btn } else { event generate $w <Enter> @@ -418,7 +416,6 @@ test msgbox-2.43 {tk_messageBox command} -constraints { -type yesnocancel -default cancel } -result {cancel} - # These tests will hang your test suite if they fail. test msgbox-3.1 {tk_messageBox handles withdrawn parent} -constraints { nonUnixUserInteraction diff --git a/tests/oldpack.test b/tests/oldpack.test index 72ec065..a70a0ad 100644 --- a/tests/oldpack.test +++ b/tests/oldpack.test @@ -18,16 +18,16 @@ destroy .pack frame .pack place .pack -width 100 -height 100 frame .pack.red -width 10 -height 20 -label .pack.red.l -text R -bd 2 -relief raised +label .pack.red.l -text R -borderwidth 2 -relief raised place .pack.red.l -relwidth 1.0 -relheight 1.0 frame .pack.green -width 30 -height 40 -label .pack.green.l -text G -bd 2 -relief raised +label .pack.green.l -text G -borderwidth 2 -relief raised place .pack.green.l -relwidth 1.0 -relheight 1.0 frame .pack.blue -width 40 -height 40 -label .pack.blue.l -text B -bd 2 -relief raised +label .pack.blue.l -text B -borderwidth 2 -relief raised place .pack.blue.l -relwidth 1.0 -relheight 1.0 frame .pack.violet -width 80 -height 20 -label .pack.violet.l -text P -bd 2 -relief raised +label .pack.violet.l -text P -borderwidth 2 -relief raised place .pack.violet.l -relwidth 1.0 -relheight 1.0 test oldpack-1.1 {basic positioning} -body { @@ -363,8 +363,8 @@ test oldpack-6.3 {geometry propagation} -body { winfo reqwidth .pack} -result 40 test oldpack-6.4 {geometry propagation} -body { winfo reqheight .pack} -result 100 -frame .pack.violet -width 80 -height 20 -bg violet -label .pack.violet.l -text P -bd 2 -relief raised +frame .pack.violet -width 80 -height 20 -background violet +label .pack.violet.l -text P -borderwidth 2 -relief raised place .pack.violet.l -relwidth 1.0 -relheight 1.0 pack append .pack .pack.red left .pack.green right .pack.blue bottom \ .pack.violet top @@ -462,7 +462,7 @@ test oldpack-8.5 {syntax errors} -body { test oldpack-8.6 {syntax errors} -setup { destroy .pack.yellow } -body { - frame .pack.yellow -bg yellow + frame .pack.yellow -background yellow pack after .pack.yellow } -cleanup { destroy .pack.yellow @@ -476,7 +476,7 @@ test oldpack-8.8 {syntax errors} -body { test oldpack-8.9 {syntax errors} -setup { destroy .pack.yellow } -body { - frame .pack.yellow -bg yellow + frame .pack.yellow -background yellow pack before .pack.yellow } -cleanup { destroy .pack.yellow diff --git a/tests/option.test b/tests/option.test index 66df70c..4fdb08a 100644 --- a/tests/option.test +++ b/tests/option.test @@ -58,7 +58,6 @@ test option-1.6 {basic option retrieval} -body { option get . z Color2 } -result {} - test option-2.1 {basic option retrieval} -body { option get .op1 x Color1 } -result green @@ -78,7 +77,6 @@ test option-2.6 {basic option retrieval} -body { option get .op1 z Color2 } -result {} - test option-3.1 {basic option retrieval} -body { option get .op1.op3 x Color1 } -result yellow @@ -98,7 +96,6 @@ test option-3.6 {basic option retrieval} -body { option get .op1.op3 z Color2 } -result {} - test option-4.1 {basic option retrieval} -body { option get .op1.op3.op6 x Color1 } -result blue @@ -118,7 +115,6 @@ test option-4.6 {basic option retrieval} -body { option get .op1.op3.op6 z Color2 } -result black - test option-5.1 {basic option retrieval} -body { option get .op1.op4 x Color1 } -result blue @@ -138,7 +134,6 @@ test option-5.6 {basic option retrieval} -body { option get .op1.op4 z Color2 } -result {} - test option-6.1 {basic option retrieval} -body { option get .op2 x Color1 } -result orange @@ -158,7 +153,6 @@ test option-6.6 {basic option retrieval} -body { option get .op2 z Color2 } -result {} - test option-7.1 {basic option retrieval} -body { option get .op2.op5 x Color1 } -result orange @@ -203,7 +197,6 @@ test option-8.6 {stack pushing/popping} -body { option get .op2.op5 z Color2 } -result purple - test option-9.1 {stack pushing/popping} -body { option get . x Color1 } -result blue @@ -223,7 +216,6 @@ test option-9.6 {stack pushing/popping} -body { option get . z Color2 } -result {} - test option-10.1 {stack pushing/popping} -body { option get .op1.op3.op6 x Color1 } -result blue @@ -243,7 +235,6 @@ test option-10.6 {stack pushing/popping} -body { option get .op1.op3.op6 z Color2 } -result black - test option-11.1 {stack pushing/popping} -body { option get .op1.op3 x Color1 } -result yellow @@ -263,7 +254,6 @@ test option-11.6 {stack pushing/popping} -body { option get .op1.op3 z Color2 } -result {} - test option-12.1 {stack pushing/popping} -body { option get .op1 x Color1 } -result green @@ -358,7 +348,6 @@ test option-14.12 {error conditions} -body { option get .gorp.gorp a A } -returnCodes error -result {bad window path name ".gorp.gorp"} - set option1 [file join [testsDirectory] option.file1] test option-15.1 {database files} -body { option read non-existent @@ -397,13 +386,12 @@ test option-15.9 {database files} -body { option read $option2 } -returnCodes error -result {missing colon on line 2} - test option-16.1 {ReadOptionFile} -body { set option3 [makeFile {} option.file3] set file [open $option3 w] - fconfigure $file -translation crlf - puts $file "*x7: true\n*x8: false" - close $file + chan configure $file -translation crlf + chan puts $file "*x7: true\n*x8: false" + chan close $file option read $option3 userDefault list [option get . x7 color] [option get . x8 color] } -cleanup { diff --git a/tests/pack.test b/tests/pack.test index eac1562..df80562 100644 --- a/tests/pack.test +++ b/tests/pack.test @@ -62,7 +62,6 @@ test pack-1.4 {-side option} -setup { list [winfo geometry .pack.a] [winfo geometry .pack.b] } -result {20x40+280+80 280x200+0+0} - test pack-2.1 {x padding and filling} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -251,7 +250,6 @@ test pack-2.23 {x padding and filling} -setup { expr {$res1 eq $res2} } -result 1 - test pack-3.1 {y padding and filling} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -440,7 +438,6 @@ test pack-3.23 {y padding and filling} -setup { expr {$res1 eq $res2} } -result 1 - test pack-4.1 {anchors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -591,7 +588,6 @@ test pack-5.9 {more anchors} -setup { winfo geometry .pack.b } -result {60x60+160+90} - test pack-6.1 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -703,7 +699,7 @@ test pack-6.12 {-expand option} -setup { wm geometry .pack2 +0+0 pack propagate .pack2 0 foreach i {w1 w2 w3} { - frame .pack2.$i -width 30 -height 30 -bd 2 -relief raised + frame .pack2.$i -width 30 -height 30 -borderwidth 2 -relief raised label .pack2.$i.l -text $i place .pack2.$i.l -relwidth 1.0 -relheight 1.0 } @@ -719,7 +715,7 @@ test pack-6.13 {-expand option} -setup { wm geometry .pack2 +0+0 pack propagate .pack2 0 foreach i {w1 w2 w3} { - frame .pack2.$i -width 30 -height 30 -bd 2 -relief raised + frame .pack2.$i -width 30 -height 30 -borderwidth 2 -relief raised label .pack2.$i.l -text $i place .pack2.$i.l -relwidth 1.0 -relheight 1.0 } @@ -732,7 +728,6 @@ test pack-6.13 {-expand option} -setup { destroy .pack2 } -result {38x42+181+45 38x42+181+178 38x42+181+312} - wm geometry .pack {} test pack-7.1 {requesting size for parent} -setup { pack forget .pack.a .pack.b .pack.c .pack.d @@ -799,8 +794,8 @@ test pack-7.7 {requesting size for parent} -setup { # very small. pack forget .pack.a .pack.b .pack.c .pack.d -frame .pack.right -width 200 -height 10 -bd 2 -relief raised -frame .pack.bottom -width 10 -height 150 -bd 2 -relief raised +frame .pack.right -width 200 -height 10 -borderwidth 2 -relief raised +frame .pack.bottom -width 10 -height 150 -borderwidth 2 -relief raised pack .pack.right -side right pack .pack.bottom -side bottom pack .pack.a .pack.b .pack.c -side top @@ -872,7 +867,6 @@ test pack-8.9 {insufficient space} -body { } -result {20x40+0+20 1 50x30+100+25 1 80x80+20+0 1} pack forget .pack.right .pack.bottom - test pack-9.1 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -945,7 +939,6 @@ test pack-9.10 {window ordering} -setup { pack slaves .pack } -result {.pack.a .pack.c .pack.d .pack.b} - test pack-10.1 {retaining/clearing configuration state} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -977,7 +970,6 @@ test pack-10.4 {bad -in window does not change master} -setup { pack .pack.a -in .pack.a } -returnCodes error -result {can't pack .pack.a inside itself} - test pack-11.1 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -1112,7 +1104,6 @@ test pack-11.19 {info option} -setup { lindex $i [expr [lsearch -exact $i -side]+1] } -result right - test pack-12.1 {command options and errors} -body { pack } -returnCodes error -result {wrong # args: should be "pack option arg ?arg ...?"} @@ -1354,7 +1345,6 @@ test pack-12.46 {command options and errors} -setup { pack lousy .pack } -returnCodes error -result {bad option "lousy": must be configure, forget, info, propagate, or slaves} - test pack-13.1 {window deletion} -setup { pack forget .pack.a .pack.b .pack.c .pack.d .pack.right .pack.bottom } -body { @@ -1368,7 +1358,6 @@ test pack-13.1 {window deletion} -setup { [winfo geometry .pack.b] [winfo geometry .pack.c]] } -result {{.pack.right .pack.bottom .pack.a .pack.b .pack.c} 20x40+30+0 50x30+15+40 80x80+0+70} - test pack-14.1 {respond to changes in expansion} -setup { pack forget .pack.a .pack.b .pack.c .pack.d .pack.right .pack.bottom } -body { @@ -1388,7 +1377,6 @@ test pack-14.1 {respond to changes in expansion} -setup { wm geom .pack {} } -result {20x40+0+0 20x40+90+0 200x150+0+0} - test pack-15.1 {managing geometry with -in option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d destroy .pack.f @@ -1452,7 +1440,7 @@ test pack-15.4 {managing geometry with -in option} -setup { destroy .pack.f1 .pack.f2 } -body { foreach i {1 2} { - frame .pack.f$i -width 100 -height 40 -bd 2 -relief raised + frame .pack.f$i -width 100 -height 40 -borderwidth 2 -relief raised lower .pack.f$i pack propagate .pack.f$i 0 pack .pack.f$i -side top @@ -1478,7 +1466,7 @@ test pack-15.5 {managing geometry with -in option} -setup { destroy .pack.f1 .pack.f2 } -body { foreach i {1 2} { - frame .pack.f$i -width 100 -height 20 -bd 2 -relief raised + frame .pack.f$i -width 100 -height 20 -borderwidth 2 -relief raised lower .pack.f$i pack propagate .pack.f$i 0 pack .pack.f$i -side top @@ -1494,7 +1482,6 @@ test pack-15.5 {managing geometry with -in option} -setup { destroy .pack.f1 .pack.f2 } -result {50x16+25+22 1 50x16+25+22 0} - test pack-16.1 {geometry manager name} -setup { pack forget .pack.a .pack.b .pack.c .pack.d set result {} @@ -1506,7 +1493,6 @@ test pack-16.1 {geometry manager name} -setup { lappend result [winfo manager .pack.a] } -result {{} pack {}} - test pack-17.1 {PackLostSlaveProc procedure} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -1528,7 +1514,6 @@ test pack-17.2 {PackLostSlaveProc procedure} -setup { pack info .pack.a } -returnCodes error -result {window ".pack.a" isn't packed} - test pack-18.1 {unmap slaves when master unmapped} -constraints { tempNotPc } -setup { @@ -1546,7 +1531,7 @@ test pack-18.1 {unmap slaves when master unmapped} -constraints { # Who knows why? eval destroy [winfo child .pack] - frame .pack.a -width 100 -height 50 -relief raised -bd 2 + frame .pack.a -width 100 -height 50 -relief raised -borderwidth 2 pack .pack.a update set result [winfo ismapped .pack.a] @@ -1570,8 +1555,8 @@ test pack-18.2 {unmap slaves when master unmapped} -setup { # as the screen (screen switch causes scale and other tests to fail). wm geometry .pack +100+100 - frame .pack.a -relief raised -bd 2 - frame .pack.b -width 70 -height 30 -relief sunken -bd 2 + frame .pack.a -relief raised -borderwidth 2 + frame .pack.b -width 70 -height 30 -relief sunken -borderwidth 2 pack .pack.a pack .pack.b -in .pack.a update @@ -1588,7 +1573,6 @@ test pack-18.2 {unmap slaves when master unmapped} -setup { lappend result [winfo ismapped .pack.b] } -result {1 0 100 30 0 1} - test pack-19.1 {test respect for internalborder} -setup { catch {eval pack forget [pack slaves .pack]} destroy .pack.l .pack.lf diff --git a/tests/panedwindow.test b/tests/panedwindow.test index f2e01e8..2950f47 100644 --- a/tests/panedwindow.test +++ b/tests/panedwindow.test @@ -26,23 +26,23 @@ test panedwindow-1.1 {configuration options: -background (good)} -body { test panedwindow-1.2 {configuration options: -background (bad)} -body { .p configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} -test panedwindow-1.3 {configuration options: -bd (good)} -body { - .p configure -bd 4 - list [lindex [.p configure -bd] 4] [.p cget -bd] +test panedwindow-1.3 {configuration options: -borderwidth (good)} -body { + .p configure -borderwidth 4 + list [lindex [.p configure -borderwidth] 4] [.p cget -borderwidth] } -cleanup { - .p configure -bd [lindex [.p configure -bd] 3] + .p configure -borderwidth [lindex [.p configure -borderwidth] 3] } -result {4 4} -test panedwindow-1.4 {configuration options: -bd (bad)} -body { - .p configure -bd badValue +test panedwindow-1.4 {configuration options: -borderwidth (bad)} -body { + .p configure -borderwidth badValue } -returnCodes error -result {bad screen distance "badValue"} -test panedwindow-1.5 {configuration options: -bg (good)} -body { - .p configure -bg #ff0000 - list [lindex [.p configure -bg] 4] [.p cget -bg] +test panedwindow-1.5 {configuration options: -background (good)} -body { + .p configure -background #ff0000 + list [lindex [.p configure -background] 4] [.p cget -background] } -cleanup { - .p configure -bg [lindex [.p configure -bg] 3] + .p configure -background [lindex [.p configure -background] 3] } -result {{#ff0000} #ff0000} -test panedwindow-1.6 {configuration options: -bg (bad)} -body { - .p configure -bg non-existent +test panedwindow-1.6 {configuration options: -background (bad)} -body { + .p configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test panedwindow-1.7 {configuration options: -borderwidth (good)} -body { .p configure -borderwidth 1.3 @@ -264,7 +264,6 @@ test panedwindow-1.52 {configuration options: -width (bad)} -body { } -returnCodes error -result {bad screen distance "badValue"} deleteWindows - test panedwindow-2.1 {panedwindow widget command} -setup { deleteWindows } -body { @@ -274,7 +273,6 @@ test panedwindow-2.1 {panedwindow widget command} -setup { deleteWindows } -returnCodes error -result {bad command "foo": must be add, cget, configure, forget, identify, panecget, paneconfigure, panes, proxy, or sash} - test panedwindow-3.1 {panedwindow panes subcommand} -setup { deleteWindows } -body { @@ -288,7 +286,6 @@ test panedwindow-3.1 {panedwindow panes subcommand} -setup { deleteWindows } -result [list [list .b .c] [list .c]] - test panedwindow-4.1 {forget subcommand} -setup { deleteWindows } -body { @@ -364,7 +361,6 @@ test panedwindow-4.6 {forget subcommand, changes reqsize of panedwindow} -setup deleteWindows } -result [list 44 20] - test panedwindow-5.1 {sash subcommand} -setup { deleteWindows } -body { @@ -382,7 +378,6 @@ test panedwindow-5.2 {sash subcommand} -setup { deleteWindows } -returnCodes error -result {bad option "foo": must be coord, dragto, mark, or place} - test panedwindow-6.1 {sash coord subcommand, errors} -setup { deleteWindows } -body { @@ -489,7 +484,6 @@ test panedwindow-6.10 {sash coord subcommand, errors} -setup { deleteWindows } -result [list 1 "invalid sash index" 0 1 "invalid sash index" 1 "invalid sash index"] - test panedwindow-7.1 {sash mark subcommand, errors} -setup { deleteWindows } -body { @@ -552,7 +546,6 @@ test panedwindow-7.7 {sash mark subcommand, set mark} -setup { deleteWindows } -result [list 10 10] - test panedwindow-8.1 {sash dragto subcommand, errors} -setup { deleteWindows } -body { @@ -596,7 +589,6 @@ test panedwindow-8.5 {sash dragto subcommand, errors} -setup { deleteWindows } -returnCodes error -result {expected integer but got "bar"} - test panedwindow-9.1 {sash mark/sash dragto interaction} -setup { deleteWindows } -body { @@ -632,7 +624,6 @@ test panedwindow-9.3 {sash mark/sash dragto, respects minsize} -setup { deleteWindows } -result [list 15 0] - test panedwindow-10.1 {sash place subcommand, errors} -setup { deleteWindows } -body { @@ -709,13 +700,12 @@ test panedwindow-10.9 {sash place subcommand, respects minsize} -setup { deleteWindows } -body { panedwindow .p - .p add [frame .f -width 20 -height 20 -bg pink] + .p add [frame .f -width 20 -height 20 -background pink] .p sash place 0 2 0 } -cleanup { deleteWindows } -returnCodes error -result {invalid sash index} - test panedwindow-11.1 {moving sash changes size of pane to left} -setup { deleteWindows } -body { @@ -899,7 +889,6 @@ test panedwindow-11.15 {moving sash into "virtual" space on last pane increases deleteWindows } -result {68 100} - test panedwindow-12.1 {horizontal panedwindow lays out widgets properly} -setup { deleteWindows set result {} @@ -932,7 +921,7 @@ test panedwindow-12.3 {horizontal panedwindow lays out widgets properly} -setup } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach {win color} {.p.f blue .p.f2 green} { - .p add [frame $win -width 20 -height 20 -bg $color] -padx 10 -pady 5 \ + .p add [frame $win -width 20 -height 20 -background $color] -padx 10 -pady 5 \ -sticky "" } pack .p @@ -1101,7 +1090,6 @@ test panedwindow-12.14 {panedwindow pane height overrides widget width} -setup { deleteWindows } -result [list 10 10] - test panedwindow-13.1 {PanestructureProc, widget yields managements} -setup { deleteWindows } -body { @@ -1136,7 +1124,6 @@ test panedwindow-13.2 {PanedWindowLostSlaveProc, widget yields management} -setu set result } -result {} - test panedwindow-14.1 {panedwindow sticky settings} -setup { deleteWindows } -body { @@ -1288,12 +1275,11 @@ test panedwindow-14.15 {panedwindow sticky settings} -setup { deleteWindows } -result {} - test panedwindow-15.1 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky {} + .p add [frame .p.f -height 20 -width 20 -background red] -sticky {} place .p -width 40 -height 40 update list {} [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1304,7 +1290,7 @@ test panedwindow-15.2 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky n + .p add [frame .p.f -height 20 -width 20 -background red] -sticky n place .p -width 40 -height 40 update list n [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1315,7 +1301,7 @@ test panedwindow-15.3 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky s + .p add [frame .p.f -height 20 -width 20 -background red] -sticky s place .p -width 40 -height 40 update list s [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1326,7 +1312,7 @@ test panedwindow-15.4 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky e + .p add [frame .p.f -height 20 -width 20 -background red] -sticky e place .p -width 40 -height 40 update list e [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1337,7 +1323,7 @@ test panedwindow-15.5 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky w + .p add [frame .p.f -height 20 -width 20 -background red] -sticky w place .p -width 40 -height 40 update list w [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1348,7 +1334,7 @@ test panedwindow-15.6 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky ns + .p add [frame .p.f -height 20 -width 20 -background red] -sticky ns place .p -width 40 -height 40 update list ns [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1359,7 +1345,7 @@ test panedwindow-15.7 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky ew + .p add [frame .p.f -height 20 -width 20 -background red] -sticky ew place .p -width 40 -height 40 update list ew [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1370,7 +1356,7 @@ test panedwindow-15.8 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky nw + .p add [frame .p.f -height 20 -width 20 -background red] -sticky nw place .p -width 40 -height 40 update list nw [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1381,7 +1367,7 @@ test panedwindow-15.9 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky ne + .p add [frame .p.f -height 20 -width 20 -background red] -sticky ne place .p -width 40 -height 40 update list ne [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1392,7 +1378,7 @@ test panedwindow-15.10 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky se + .p add [frame .p.f -height 20 -width 20 -background red] -sticky se place .p -width 40 -height 40 update list se [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1403,7 +1389,7 @@ test panedwindow-15.11 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky sw + .p add [frame .p.f -height 20 -width 20 -background red] -sticky sw place .p -width 40 -height 40 update list sw [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1414,7 +1400,7 @@ test panedwindow-15.12 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky nse + .p add [frame .p.f -height 20 -width 20 -background red] -sticky nse place .p -width 40 -height 40 update list nse [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1425,7 +1411,7 @@ test panedwindow-15.13 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky nsw + .p add [frame .p.f -height 20 -width 20 -background red] -sticky nsw place .p -width 40 -height 40 update list nsw [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1436,7 +1422,7 @@ test panedwindow-15.14 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky sew + .p add [frame .p.f -height 20 -width 20 -background red] -sticky sew place .p -width 40 -height 40 update list sew [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1447,7 +1433,7 @@ test panedwindow-15.15 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky new + .p add [frame .p.f -height 20 -width 20 -background red] -sticky new place .p -width 40 -height 40 update list new [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1458,7 +1444,7 @@ test panedwindow-15.16 {panedwindow sticky works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 - .p add [frame .p.f -height 20 -width 20 -bg red] -sticky news + .p add [frame .p.f -height 20 -width 20 -background red] -sticky news place .p -width 40 -height 40 update list news [winfo x .p.f] [winfo y .p.f] [winfo width .p.f] [winfo height .p.f] @@ -1466,12 +1452,11 @@ test panedwindow-15.16 {panedwindow sticky works} -setup { deleteWindows } -result {news 0 0 40 40} - test panedwindow-16.1 {setting minsize when pane is too small snaps width} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .p.f -height 20 -width 20 -bg red] + .p add [frame .p.f -height 20 -width 20 -background red] set result [winfo reqwidth .p] .p paneconfigure .p.f -minsize 40 lappend result [winfo reqwidth .p] @@ -1479,14 +1464,13 @@ test panedwindow-16.1 {setting minsize when pane is too small snaps width} -setu deleteWindows } -result [list 20 40] - test panedwindow-17.1 {MoveSash, move right} -setup { deleteWindows set result {} } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } # Get the requested width of the paned window @@ -1507,7 +1491,7 @@ test panedwindow-17.2 {MoveSash, move right (unmapped) clipped by reqwidth} -set } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } .p sash place 0 100 0 @@ -1523,7 +1507,7 @@ test panedwindow-17.3 {MoveSash, move right (mapped, width < reqwidth) clipped b } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } # Put the panedwindow up on the display and give it a width < reqwidth @@ -1543,7 +1527,7 @@ test panedwindow-17.4 {MoveSash, move right (mapped, width > reqwidth) clipped b } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } # Put the panedwindow up on the display and give it a width > reqwidth @@ -1563,7 +1547,7 @@ test panedwindow-17.5 {MoveSash, move right respects minsize} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 0 100 0 @@ -1579,7 +1563,7 @@ test panedwindow-17.6 {MoveSash, move right respects minsize} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 0 100 0 @@ -1594,7 +1578,7 @@ test panedwindow-17.7 {MoveSash, move right pushes other sashes} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } .p sash place 0 100 0 @@ -1610,7 +1594,7 @@ test panedwindow-17.8 {MoveSash, move right pushes other sashes, respects minsiz } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 0 100 0 @@ -1626,7 +1610,7 @@ test panedwindow-17.9 {MoveSash, move right respects minsize, exludes pad} -setu } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ + .p add [frame $w -height 20 -width 20 -background $c] \ -sticky nsew -minsize 10 -padx 5 } @@ -1643,7 +1627,7 @@ test panedwindow-17.10 {MoveSash, move right, negative minsize becomes 0} -setup } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ + .p add [frame $w -height 20 -width 20 -background $c] \ -sticky nsew -minsize -50 } @@ -1661,7 +1645,7 @@ test panedwindow-17.11 {MoveSash, move left} -setup { set result {} panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } # Get the requested width of the paned window @@ -1682,7 +1666,7 @@ test panedwindow-17.12 {MoveSash, move left, can't move outside of window} -setu } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } .p sash place 0 -100 0 @@ -1698,7 +1682,7 @@ test panedwindow-17.13 {MoveSash, move left respects minsize} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 0 0 0 @@ -1714,7 +1698,7 @@ test panedwindow-17.14 {MoveSash, move left respects minsize} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 @@ -1729,7 +1713,7 @@ test panedwindow-17.15 {MoveSash, move left pushes other sashes} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } .p sash place 1 0 0 @@ -1745,7 +1729,7 @@ test panedwindow-17.16 {MoveSash, move left pushes other sashes, respects minsiz } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 @@ -1761,7 +1745,7 @@ test panedwindow-17.17 {MoveSash, move left respects minsize, exludes pad} -setu } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ + .p add [frame $w -height 20 -width 20 -background $c] \ -sticky nsew -minsize 10 -padx 5 } @@ -1778,7 +1762,7 @@ test panedwindow-17.18 {MoveSash, move left, negative minsize becomes 0} -setup } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 foreach w {.f1 .f2 .f3} c {red blue green} { - .p add [frame $w -height 20 -width 20 -bg $c] \ + .p add [frame $w -height 20 -width 20 -background $c] \ -sticky nsew -minsize -50 } @@ -1791,7 +1775,6 @@ test panedwindow-17.18 {MoveSash, move left, negative minsize becomes 0} -setup deleteWindows } -result [list [list 8 0] [list 10 0]] - test panedwindow-18.1 {MoveSash, move down} -setup { deleteWindows } -body { @@ -1799,7 +1782,7 @@ test panedwindow-18.1 {MoveSash, move down} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } # Get the requested width of the paned window @@ -1821,7 +1804,7 @@ test panedwindow-18.2 {MoveSash, move down (unmapped) clipped by reqheight} -set panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } .p sash place 0 0 100 @@ -1838,7 +1821,7 @@ test panedwindow-18.3 {MoveSash, move down (mapped, height < reqheight) clipped panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } # Put the panedwindow up on the display and give it a height < reqheight @@ -1859,7 +1842,7 @@ test panedwindow-18.4 {MoveSash, move down (mapped, height > reqheight) clipped panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } # Put the panedwindow up on the display and give it a width > reqwidth @@ -1880,7 +1863,7 @@ test panedwindow-18.5 {MoveSash, move down respects minsize} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 0 0 100 @@ -1897,7 +1880,7 @@ test panedwindow-18.6 {MoveSash, move down respects minsize} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 0 0 100 @@ -1914,7 +1897,7 @@ test panedwindow-18.7 {MoveSash, move down pushes other sashes} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } .p sash place 0 0 100 @@ -1931,7 +1914,7 @@ test panedwindow-18.8 {MoveSash, move down pushes other sashes, respects minsize panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 0 0 100 @@ -1948,7 +1931,7 @@ test panedwindow-18.9 {MoveSash, move down respects minsize, exludes pad} -setup panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ + .p add [frame $w -height 20 -width 20 -background $c] \ -sticky nsew -minsize 10 -pady 5 } @@ -1966,7 +1949,7 @@ test panedwindow-18.10 {MoveSash, move right, negative minsize becomes 0} -setup panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ + .p add [frame $w -height 20 -width 20 -background $c] \ -sticky nsew -minsize -50 } @@ -1985,7 +1968,7 @@ test panedwindow-18.11 {MoveSash, move up} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } # Get the requested width of the paned window @@ -2007,7 +1990,7 @@ test panedwindow-18.12 {MoveSash, move up, can't move outside of window} -setup panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } .p sash place 0 0 -100 @@ -2024,7 +2007,7 @@ test panedwindow-18.13 {MoveSash, move up respects minsize} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 0 0 0 @@ -2041,7 +2024,7 @@ test panedwindow-18.14 {MoveSash, move up respects minsize} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 @@ -2057,7 +2040,7 @@ test panedwindow-18.15 {MoveSash, move up pushes other sashes} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew } .p sash place 1 0 0 @@ -2074,7 +2057,7 @@ test panedwindow-18.16 {MoveSash, move up pushes other sashes, respects minsize} panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] -sticky nsew -minsize 10 + .p add [frame $w -height 20 -width 20 -background $c] -sticky nsew -minsize 10 } .p sash place 1 0 0 @@ -2091,7 +2074,7 @@ test panedwindow-18.17 {MoveSash, move up respects minsize, exludes pad} -setup panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue} { - .p add [frame $w -height 20 -width 20 -bg $c] \ + .p add [frame $w -height 20 -width 20 -background $c] \ -sticky nsew -minsize 10 -pady 5 } @@ -2109,7 +2092,7 @@ test panedwindow-18.18 {MoveSash, move up, negative minsize becomes 0} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical foreach w {.f1 .f2 .f3} c {red blue green} { - .p add [frame $w -height 20 -width 20 -bg $c] \ + .p add [frame $w -height 20 -width 20 -background $c] \ -sticky nsew -minsize -50 } @@ -2132,7 +2115,7 @@ test panedwindow-19.1 {ComputeGeometry, reqheight taken from widgets} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] + .p add [frame $w -width 20 -height 20 -background blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .f3 configure -height 40 @@ -2146,7 +2129,7 @@ test panedwindow-19.2 {ComputeGeometry, reqheight taken from widgets} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] + .p add [frame $w -width 20 -height 20 -background blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -height 40 @@ -2160,7 +2143,7 @@ test panedwindow-19.3 {ComputeGeometry, reqheight taken from widgets} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -pady 20 + .p add [frame $w -width 20 -height 20 -background blue] -pady 20 } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -height 40 @@ -2175,7 +2158,7 @@ test panedwindow-19.4 {ComputeGeometry, reqwidth taken from widgets} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] + .p add [frame $w -width 20 -height 20 -background blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .f3 configure -width 40 @@ -2190,7 +2173,7 @@ test panedwindow-19.5 {ComputeGeometry, reqwidth taken from widgets} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] + .p add [frame $w -width 20 -height 20 -background blue] } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -width 40 @@ -2205,7 +2188,7 @@ test panedwindow-19.6 {ComputeGeometry, reqwidth taken from widgets} -setup { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -padx 20 + .p add [frame $w -width 20 -height 20 -background blue] -padx 20 } set result [list [list [winfo reqwidth .p] [winfo reqheight .p]]] .p paneconfigure .f3 -width 40 @@ -2222,7 +2205,7 @@ test panedwindow-19.7 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 0 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 0 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -2234,7 +2217,7 @@ test panedwindow-19.8 {ComputeGeometry, three panes, reqsize set properly} -setu panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2247,7 +2230,7 @@ test panedwindow-19.9 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2261,7 +2244,7 @@ test panedwindow-19.10 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -2285,7 +2268,7 @@ test panedwindow-19.11 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -orient vertical -sashwidth 0 -handlesize 6 \ -showhandle 0 - .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 0 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2299,7 +2282,7 @@ test panedwindow-19.12 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -2314,7 +2297,7 @@ test panedwindow-19.13 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2329,7 +2312,7 @@ test panedwindow-19.14 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -2351,7 +2334,7 @@ test panedwindow-19.15 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 1 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 1 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -2363,7 +2346,7 @@ test panedwindow-19.16 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2376,7 +2359,7 @@ test panedwindow-19.17 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2390,7 +2373,7 @@ test panedwindow-19.18 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -2414,7 +2397,7 @@ test panedwindow-19.19 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -orient vertical -sashwidth 0 -handlesize 6 \ -showhandle 1 - .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 1 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2428,7 +2411,7 @@ test panedwindow-19.20 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -2443,7 +2426,7 @@ test panedwindow-19.21 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2458,7 +2441,7 @@ test panedwindow-19.22 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -2480,7 +2463,7 @@ test panedwindow-19.23 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 0 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 0 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -2492,7 +2475,7 @@ test panedwindow-19.24 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2505,7 +2488,7 @@ test panedwindow-19.25 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2519,7 +2502,7 @@ test panedwindow-19.26 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -2543,7 +2526,7 @@ test panedwindow-19.27 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -orient vertical -sashwidth 3 -handlesize 6 \ -showhandle 0 - .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 0 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2557,7 +2540,7 @@ test panedwindow-19.28 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -2572,7 +2555,7 @@ test panedwindow-19.29 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2587,7 +2570,7 @@ test panedwindow-19.30 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -2609,7 +2592,7 @@ test panedwindow-19.31 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 1 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 1 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -2621,7 +2604,7 @@ test panedwindow-19.32 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2634,7 +2617,7 @@ test panedwindow-19.33 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2648,7 +2631,7 @@ test panedwindow-19.34 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -2672,7 +2655,7 @@ test panedwindow-19.35 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 0 -sashpad 0 \ -orient vertical -sashwidth 3 -handlesize 6 \ -showhandle 1 - .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 1 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2686,7 +2669,7 @@ test panedwindow-19.36 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -2701,7 +2684,7 @@ test panedwindow-19.37 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2716,7 +2699,7 @@ test panedwindow-19.38 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -2738,7 +2721,7 @@ test panedwindow-19.39 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 0 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 0 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -2750,7 +2733,7 @@ test panedwindow-19.40 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2763,7 +2746,7 @@ test panedwindow-19.41 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2777,7 +2760,7 @@ test panedwindow-19.42 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -2801,7 +2784,7 @@ test panedwindow-19.43 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -orient vertical -sashwidth 0 -handlesize 6 \ -showhandle 0 - .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 0 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2815,7 +2798,7 @@ test panedwindow-19.44 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -2830,7 +2813,7 @@ test panedwindow-19.45 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2845,7 +2828,7 @@ test panedwindow-19.46 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -2867,7 +2850,7 @@ test panedwindow-19.47 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 1 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 1 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -2879,7 +2862,7 @@ test panedwindow-19.48 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2892,7 +2875,7 @@ test panedwindow-19.49 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2906,7 +2889,7 @@ test panedwindow-19.50 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -2930,7 +2913,7 @@ test panedwindow-19.51 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -orient vertical -sashwidth 0 -handlesize 6 \ -showhandle 1 - .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 1 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -2944,7 +2927,7 @@ test panedwindow-19.52 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -2959,7 +2942,7 @@ test panedwindow-19.53 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -2974,7 +2957,7 @@ test panedwindow-19.54 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -2996,7 +2979,7 @@ test panedwindow-19.55 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 0 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 0 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -3008,7 +2991,7 @@ test panedwindow-19.56 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3021,7 +3004,7 @@ test panedwindow-19.57 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3035,7 +3018,7 @@ test panedwindow-19.58 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -3059,7 +3042,7 @@ test panedwindow-19.59 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -orient vertical -sashwidth 3 -handlesize 6 \ -showhandle 0 - .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 0 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3073,7 +3056,7 @@ test panedwindow-19.60 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -3088,7 +3071,7 @@ test panedwindow-19.61 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3103,7 +3086,7 @@ test panedwindow-19.62 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -3125,7 +3108,7 @@ test panedwindow-19.63 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 1 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 1 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -3137,7 +3120,7 @@ test panedwindow-19.64 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3150,7 +3133,7 @@ test panedwindow-19.65 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3164,7 +3147,7 @@ test panedwindow-19.66 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -3188,7 +3171,7 @@ test panedwindow-19.67 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 0 -sashpad 5 \ -orient vertical -sashwidth 3 -handlesize 6 \ -showhandle 1 - .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 1 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3202,7 +3185,7 @@ test panedwindow-19.68 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -3217,7 +3200,7 @@ test panedwindow-19.69 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3232,7 +3215,7 @@ test panedwindow-19.70 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -3254,7 +3237,7 @@ test panedwindow-19.71 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 0 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 0 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -3266,7 +3249,7 @@ test panedwindow-19.72 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3279,7 +3262,7 @@ test panedwindow-19.73 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3293,7 +3276,7 @@ test panedwindow-19.74 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -3317,7 +3300,7 @@ test panedwindow-19.75 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -orient vertical -sashwidth 0 -handlesize 6 \ -showhandle 0 - .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 0 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3331,7 +3314,7 @@ test panedwindow-19.76 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -3346,7 +3329,7 @@ test panedwindow-19.77 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3361,7 +3344,7 @@ test panedwindow-19.78 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -3383,7 +3366,7 @@ test panedwindow-19.79 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 1 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 1 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -3395,7 +3378,7 @@ test panedwindow-19.80 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3408,7 +3391,7 @@ test panedwindow-19.81 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3422,7 +3405,7 @@ test panedwindow-19.82 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -3446,7 +3429,7 @@ test panedwindow-19.83 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -orient vertical -sashwidth 0 -handlesize 6 \ -showhandle 1 - .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 1 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3460,7 +3443,7 @@ test panedwindow-19.84 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -3475,7 +3458,7 @@ test panedwindow-19.85 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3490,7 +3473,7 @@ test panedwindow-19.86 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -3512,7 +3495,7 @@ test panedwindow-19.87 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 0 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 0 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -3524,7 +3507,7 @@ test panedwindow-19.88 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3537,7 +3520,7 @@ test panedwindow-19.89 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3551,7 +3534,7 @@ test panedwindow-19.90 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -3575,7 +3558,7 @@ test panedwindow-19.91 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -orient vertical -sashwidth 3 -handlesize 6 \ -showhandle 0 - .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 0 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3589,7 +3572,7 @@ test panedwindow-19.92 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -3604,7 +3587,7 @@ test panedwindow-19.93 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3619,7 +3602,7 @@ test panedwindow-19.94 {ComputeGeometry/ArrangePanes, slave coords, vert} -setup -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -3641,7 +3624,7 @@ test panedwindow-19.95 {ComputeGeometry, one slave, reqsize set properly} -setup # ever be drawn. panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 1 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 1 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -3653,7 +3636,7 @@ test panedwindow-19.96 {ComputeGeometry, three panes, reqsize set properly} -set panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3666,7 +3649,7 @@ test panedwindow-19.97 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3680,7 +3663,7 @@ test panedwindow-19.98 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -3704,7 +3687,7 @@ test panedwindow-19.99 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 2 -sashpad 0 \ -orient vertical -sashwidth 3 -handlesize 6 \ -showhandle 1 - .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 1 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3718,7 +3701,7 @@ test panedwindow-19.100 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -3733,7 +3716,7 @@ test panedwindow-19.101 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3748,7 +3731,7 @@ test panedwindow-19.102 {ComputeGeometry/ArrangePanes, slave coords, vert} -setu -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -3770,7 +3753,7 @@ test panedwindow-19.103 {ComputeGeometry, one slave, reqsize set properly} -setu # ever be drawn. panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 0 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 0 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -3782,7 +3765,7 @@ test panedwindow-19.104 {ComputeGeometry, three panes, reqsize set properly} -se panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3795,7 +3778,7 @@ test panedwindow-19.105 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3809,7 +3792,7 @@ test panedwindow-19.106 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -3833,7 +3816,7 @@ test panedwindow-19.107 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -orient vertical -sashwidth 0 -handlesize 6 \ -showhandle 0 - .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 0 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3847,7 +3830,7 @@ test panedwindow-19.108 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -3862,7 +3845,7 @@ test panedwindow-19.109 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3877,7 +3860,7 @@ test panedwindow-19.110 {ComputeGeometry/ArrangePanes, slave coords, vert} -setu -sashwidth 0 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -3899,7 +3882,7 @@ test panedwindow-19.111 {ComputeGeometry, one slave, reqsize set properly} -setu # ever be drawn. panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 1 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 1 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -3911,7 +3894,7 @@ test panedwindow-19.112 {ComputeGeometry, three panes, reqsize set properly} -se panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3924,7 +3907,7 @@ test panedwindow-19.113 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -3938,7 +3921,7 @@ test panedwindow-19.114 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 0 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -3962,7 +3945,7 @@ test panedwindow-19.115 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -orient vertical -sashwidth 0 -handlesize 6 \ -showhandle 1 - .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 1 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -3976,7 +3959,7 @@ test panedwindow-19.116 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -3991,7 +3974,7 @@ test panedwindow-19.117 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -4006,7 +3989,7 @@ test panedwindow-19.118 {ComputeGeometry/ArrangePanes, slave coords, vert} -setu -sashwidth 0 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -4028,7 +4011,7 @@ test panedwindow-19.119 {ComputeGeometry, one slave, reqsize set properly} -setu # ever be drawn. panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 0 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 0 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 0 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -4040,7 +4023,7 @@ test panedwindow-19.120 {ComputeGeometry, three panes, reqsize set properly} -se panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -4053,7 +4036,7 @@ test panedwindow-19.121 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -4067,7 +4050,7 @@ test panedwindow-19.122 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 0 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -4091,7 +4074,7 @@ test panedwindow-19.123 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -orient vertical -sashwidth 3 -handlesize 6 \ -showhandle 0 - .p add [frame .f -width 20 -height 20 -bg red] -pady 0 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 0 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -4105,7 +4088,7 @@ test panedwindow-19.124 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -4120,7 +4103,7 @@ test panedwindow-19.125 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -4135,7 +4118,7 @@ test panedwindow-19.126 {ComputeGeometry/ArrangePanes, slave coords, vert} -setu -sashwidth 3 -handlesize 6 -showhandle 0 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -4157,7 +4140,7 @@ test panedwindow-19.127 {ComputeGeometry, one slave, reqsize set properly} -setu # ever be drawn. panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 1 - .p add [frame .p.f -width 20 -height 20 -bg red] -padx 1 -sticky "" + .p add [frame .p.f -width 20 -height 20 -background red] -padx 1 -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { deleteWindows @@ -4169,7 +4152,7 @@ test panedwindow-19.128 {ComputeGeometry, three panes, reqsize set properly} -se panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] -sticky "" + .p add [frame $w -width 20 -height 20 -background blue] -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -4182,7 +4165,7 @@ test panedwindow-19.129 {ComputeGeometry, sash coords} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -4196,7 +4179,7 @@ test panedwindow-19.130 {ComputeGeometry/ArrangePanes, slave coords} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -sashwidth 3 -handlesize 6 -showhandle 1 foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 3 -padx 11 } pack .p @@ -4220,7 +4203,7 @@ test panedwindow-19.131 {ComputeGeometry, one slave, vertical} -setup { panedwindow .p -borderwidth 2 -sashpad 5 \ -orient vertical -sashwidth 3 -handlesize 6 \ -showhandle 1 - .p add [frame .f -width 20 -height 20 -bg red] -pady 1 \ + .p add [frame .f -width 20 -height 20 -background red] -pady 1 \ -sticky "" list [winfo reqwidth .p] [winfo reqheight .p] } -cleanup { @@ -4234,7 +4217,7 @@ test panedwindow-19.132 {ComputeGeometry, three panes, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [winfo reqwidth .p] [winfo reqheight .p] @@ -4249,7 +4232,7 @@ test panedwindow-19.133 {ComputeGeometry, sash coords, vertical} -setup { -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.f1 .f2 .f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky "" } list [.p sash coord 0] [.p sash coord 1] @@ -4264,7 +4247,7 @@ test panedwindow-19.134 {ComputeGeometry/ArrangePanes, slave coords, vert} -setu -sashwidth 3 -handlesize 6 -showhandle 1 \ -orient vertical foreach w {.p.f1 .p.f2 .p.f3} { - .p add [frame $w -width 20 -height 20 -bg blue] \ + .p add [frame $w -width 20 -height 20 -background blue] \ -sticky nsew -pady 11 -padx 3 } pack .p @@ -4279,12 +4262,11 @@ test panedwindow-19.134 {ComputeGeometry/ArrangePanes, slave coords, vert} -setu deleteWindows } -result {{5 13 20 20} {5 71 20 20} {5 129 20 20}} - test panedwindow-20.1 {destroyed widgets are removed from panedwindow} -setup { deleteWindows } -body { panedwindow .p - .p add [frame .f -width 20 -height 20 -bg blue] + .p add [frame .f -width 20 -height 20 -background blue] destroy .f .p panes } -cleanup { @@ -4294,21 +4276,20 @@ test panedwindow-20.2 {destroyed slave causes geometry recomputation} -setup { deleteWindows } -body { panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .f -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 20 -bg red] + .p add [frame .f -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 20 -background red] destroy .f winfo reqwidth .p } -cleanup { deleteWindows } -result 20 - test panedwindow-21.1 {ArrangePanes, extra space is given to the last pane} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .f1 -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 20 -bg red] -sticky nsew + .p add [frame .f1 -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 20 -background red] -sticky nsew place .p -width 100 -x 0 -y 0 update winfo width .f2 @@ -4320,8 +4301,8 @@ test panedwindow-21.2 {ArrangePanes, extra space is given to the last pane} -set } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical - .p add [frame .f1 -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 20 -bg red] -sticky nsew + .p add [frame .f1 -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 20 -background red] -sticky nsew place .p -height 100 -x 0 -y 0 update winfo height .f2 @@ -4332,8 +4313,8 @@ test panedwindow-21.3 {ArrangePanes, explicit height/width are preferred} -setup deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .f1 -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 20 -bg red] -sticky "" + .p add [frame .f1 -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 20 -background red] -sticky "" .p paneconfigure .f1 -width 10 -height 15 pack .p update @@ -4345,8 +4326,8 @@ test panedwindow-21.4 {ArrangePanes, panes clipped by size of pane} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .f1 -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 20 -bg red] + .p add [frame .f1 -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 20 -background red] .p sash place 0 10 0 pack .p update @@ -4359,8 +4340,8 @@ test panedwindow-21.5 {ArrangePanes, panes clipped by size of pane} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical - .p add [frame .f1 -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 20 -bg red] + .p add [frame .f1 -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 20 -background red] .p sash place 0 0 10 pack .p update @@ -4372,8 +4353,8 @@ test panedwindow-21.6 {ArrangePanes, height of pane taken from total height} -se deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ - [frame .p.f2 -width 20 -height 40 -bg red] -sticky "" + .p add [frame .p.f1 -width 20 -height 20 -background blue] \ + [frame .p.f2 -width 20 -height 40 -background red] -sticky "" pack .p update winfo y .p.f1 @@ -4385,8 +4366,8 @@ test panedwindow-21.7 {ArrangePanes, width of pane taken from total width} -setu } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical - .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ - [frame .p.f2 -width 40 -height 40 -bg red] -sticky "" + .p add [frame .p.f1 -width 20 -height 20 -background blue] \ + [frame .p.f2 -width 40 -height 40 -background red] -sticky "" pack .p update winfo x .p.f1 @@ -4397,8 +4378,8 @@ test panedwindow-21.8 {ArrangePanes, panes with width <= 0 are unmapped} -setup deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .f1 -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 40 -bg red] + .p add [frame .f1 -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 40 -background red] pack .p update set result [winfo ismapped .f1] @@ -4412,8 +4393,8 @@ test panedwindow-21.9 {ArrangePanes, panes with width <= 0 are unmapped} -setup deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ - [frame .p.f2 -width 20 -height 40 -bg red] + .p add [frame .p.f1 -width 20 -height 20 -background blue] \ + [frame .p.f2 -width 20 -height 40 -background red] pack .p update set result [winfo ismapped .p.f1] @@ -4427,8 +4408,8 @@ test panedwindow-21.10 {ArrangePanes, panes with width <= 0 are unmapped} -setup deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 -orient vertical - .p add [frame .p.f1 -width 20 -height 20 -bg blue] \ - [frame .p.f2 -width 20 -height 40 -bg red] + .p add [frame .p.f1 -width 20 -height 20 -background blue] \ + [frame .p.f2 -width 20 -height 40 -background red] pack .p update set result [winfo ismapped .p.f1] @@ -4442,8 +4423,8 @@ test panedwindow-21.11 {ArrangePanes, last pane shrinks} -setup { deleteWindows } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .f1 -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 20 -bg red] -sticky nsew + .p add [frame .f1 -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 20 -background red] -sticky nsew place .p -width 40 -x 0 -y 0 update winfo width .f2 @@ -4455,8 +4436,8 @@ test panedwindow-21.12 {ArrangePanes, last pane shrinks} -setup { } -body { panedwindow .p -showhandle false -borderwidth 0 -sashpad 0 -sashwidth 2 \ -orient vertical - .p add [frame .f1 -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 20 -bg red] -sticky nsew + .p add [frame .f1 -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 20 -background red] -sticky nsew place .p -height 40 -x 0 -y 0 update winfo height .f2 @@ -4467,7 +4448,7 @@ test panedwindow-21.13 {ArrangePanes, panedwindow resizes} -setup { deleteWindows } -body { panedwindow .p -width 200 -borderwidth 0 - frame .f1 -height 50 -bg blue + frame .f1 -height 50 -background blue set result [list] lappend result [winfo reqwidth .p] [winfo reqheight .p] .p add .f1 @@ -4480,7 +4461,7 @@ test panedwindow-21.14 {ArrangePanes, panedwindow resizes} -setup { deleteWindows } -body { panedwindow .p -height 200 -borderwidth 0 -orient vertical - frame .f1 -width 50 -bg blue + frame .f1 -width 50 -background blue set result [list] lappend result [winfo reqwidth .p] [winfo reqheight .p] .p add .f1 @@ -4493,8 +4474,8 @@ test panedwindow-21.15 {ArrangePanes, last pane grows} -setup { deleteWindows } -body { panedwindow .p -showhandle false -height 50 - .p add [frame .f1 -width 50 -bg red] [frame .f2 -width 50 -bg white] \ - [frame .f3 -width 50 -bg blue] [frame .f4 -width 50 -bg green] + .p add [frame .f1 -width 50 -background red] [frame .f2 -width 50 -background white] \ + [frame .f3 -width 50 -background blue] [frame .f4 -width 50 -background green] .p sash place 1 250 0 pack .p update @@ -4509,14 +4490,13 @@ test panedwindow-21.15 {ArrangePanes, last pane grows} -setup { deleteWindows } -result {50 150 1 1 211 50 150 1 89 300} - test panedwindow-22.1 {PanedWindowReqProc, react to slave geometry changes} -setup { deleteWindows } -body { # Basically just want to make sure that the PanedWindowReqProc is called panedwindow .p -borderwidth 0 -sashpad 0 -sashwidth 2 - .p add [frame .f1 -width 20 -height 20 -bg blue] \ - [frame .f2 -width 20 -height 40 -bg red] + .p add [frame .f1 -width 20 -height 20 -background blue] \ + [frame .f2 -width 20 -height 40 -background red] set result [winfo reqheight .p] .f1 configure -height 80 lappend result [winfo reqheight .p] @@ -4537,7 +4517,6 @@ test panedwindow-22.2 {PanedWindowReqProc, react to slave geometry changes} -set deleteWindows } -result {10} - test panedwindow-23.1 {ConfigurePanes, can't add panedwindow to itself} -setup { deleteWindows } -body { @@ -4882,10 +4861,10 @@ test panedwindow-23.29 {ConfigurePanes, -hide works} -setup { deleteWindows } -body { panedwindow .p -showhandle false - frame .f1 -width 40 -height 100 -bg red - frame .f2 -width 40 -height 100 -bg white - frame .f3 -width 40 -height 100 -bg blue - frame .f4 -width 40 -height 100 -bg green + frame .f1 -width 40 -height 100 -background red + frame .f2 -width 40 -height 100 -background white + frame .f3 -width 40 -height 100 -background blue + frame .f4 -width 40 -height 100 -background green .p add .f1 .f2 .f3 .f4 pack .p update @@ -4907,10 +4886,10 @@ test panedwindow-23.30 {ConfigurePanes, -hide works} -setup { deleteWindows } -body { panedwindow .p -showhandle false -width 130 -height 100 - frame .f1 -width 40 -bg red - frame .f2 -width 40 -bg white - frame .f3 -width 40 -bg blue - frame .f4 -width 40 -bg green + frame .f1 -width 40 -background red + frame .f2 -width 40 -background white + frame .f3 -width 40 -background blue + frame .f4 -width 40 -background green .p add .f1 .f2 .f3 .f4 pack .p update @@ -4932,9 +4911,9 @@ test panedwindow-23.31 {ConfigurePanes, -hide works, last pane stretches} -setup deleteWindows } -body { panedwindow .p -showhandle false -width 200 -height 200 -borderwidth 0 - frame .f1 -width 50 -bg red - frame .f2 -width 50 -bg green - frame .f3 -width 50 -bg blue + frame .f1 -width 50 -background red + frame .f2 -width 50 -background green + frame .f3 -width 50 -background blue .p add .f1 .f2 .f3 pack .p update @@ -4951,9 +4930,9 @@ test panedwindow-23.32 {ConfigurePanes, -hide works, last pane stretches} -setup } -body { panedwindow .p -showhandle false -width 200 -height 200 \ -borderwidth 0 -orient vertical - frame .f1 -height 50 -bg red - frame .f2 -height 50 -bg green - frame .f3 -height 50 -bg blue + frame .f1 -height 50 -background red + frame .f2 -height 50 -background green + frame .f3 -height 50 -background blue .p add .f1 .f2 .f3 pack .p update @@ -4970,10 +4949,10 @@ test panedwindow-23.33 {ConfigurePanes, -stretch first} -setup { deleteWindows } -body { panedwindow .p -showhandle false -height 100 -width 182 - frame .f1 -width 40 -bg red - frame .f2 -width 40 -bg white - frame .f3 -width 40 -bg blue - frame .f4 -width 40 -bg green + frame .f1 -width 40 -background red + frame .f2 -width 40 -background white + frame .f3 -width 40 -background blue + frame .f4 -width 40 -background green .p add .f1 .f2 .f3 .f4 -stretch first pack .p update @@ -4991,10 +4970,10 @@ test panedwindow-23.34 {ConfigurePanes, -stretch middle} -setup { deleteWindows } -body { panedwindow .p -showhandle false -height 100 -width 182 - frame .f1 -width 40 -bg red - frame .f2 -width 40 -bg white - frame .f3 -width 40 -bg blue - frame .f4 -width 40 -bg green + frame .f1 -width 40 -background red + frame .f2 -width 40 -background white + frame .f3 -width 40 -background blue + frame .f4 -width 40 -background green .p add .f1 .f2 .f3 .f4 -stretch middle pack .p update @@ -5012,10 +4991,10 @@ test panedwindow-23.35 {ConfigurePanes, -stretch always} -setup { deleteWindows } -body { panedwindow .p -showhandle false -height 100 -width 182 - frame .f1 -width 40 -bg red - frame .f2 -width 40 -bg white - frame .f3 -width 40 -bg blue - frame .f4 -width 40 -bg green + frame .f1 -width 40 -background red + frame .f2 -width 40 -background white + frame .f3 -width 40 -background blue + frame .f4 -width 40 -background green .p add .f1 .f2 .f3 .f4 -stretch always pack .p update @@ -5033,10 +5012,10 @@ test panedwindow-23.36 {ConfigurePanes, -stretch never} -setup { deleteWindows } -body { panedwindow .p -showhandle false -height 100 -width 182 - frame .f1 -width 40 -bg red - frame .f2 -width 40 -bg white - frame .f3 -width 40 -bg blue - frame .f4 -width 40 -bg green + frame .f1 -width 40 -background red + frame .f2 -width 40 -background white + frame .f3 -width 40 -background blue + frame .f4 -width 40 -background green .p add .f1 .f2 .f3 .f4 -stretch never pack .p update @@ -5051,7 +5030,6 @@ test panedwindow-23.36 {ConfigurePanes, -stretch never} -setup { deleteWindows } -result {40 40 40 40 40 40 40 40} - test panedwindow-24.1 {Unlink, remove a paned with -before/-after refs} -setup { deleteWindows } -body { @@ -5073,7 +5051,6 @@ test panedwindow-24.1 {Unlink, remove a paned with -before/-after refs} -setup { deleteWindows } -result {.pw.l3 {} .pw.l1} - test panedwindow-25.1 {DestroyPanedWindow} -setup { deleteWindows } -body { @@ -5088,13 +5065,12 @@ test panedwindow-25.1 {DestroyPanedWindow} -setup { set result {} } -result {} - test panedwindow-26.1 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 0 0 } -cleanup { deleteWindows @@ -5102,9 +5078,9 @@ test panedwindow-26.1 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.2 {PanedWindowIdentifyCoords, padding is included} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 20 0 } -cleanup { deleteWindows @@ -5112,9 +5088,9 @@ test panedwindow-26.2 {PanedWindowIdentifyCoords, padding is included} -setup { test panedwindow-26.3 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 22 0 } -cleanup { deleteWindows @@ -5122,9 +5098,9 @@ test panedwindow-26.3 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.4 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 24 0 } -cleanup { deleteWindows @@ -5132,9 +5108,9 @@ test panedwindow-26.4 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.5 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 26 0 } -cleanup { deleteWindows @@ -5142,9 +5118,9 @@ test panedwindow-26.5 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.6 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 26 -1 } -cleanup { deleteWindows @@ -5152,9 +5128,9 @@ test panedwindow-26.6 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.7 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 26 100 } -cleanup { deleteWindows @@ -5162,10 +5138,10 @@ test panedwindow-26.7 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.8 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 22 4 } -cleanup { deleteWindows @@ -5173,10 +5149,10 @@ test panedwindow-26.8 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.9 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 22 5 } -cleanup { deleteWindows @@ -5184,10 +5160,10 @@ test panedwindow-26.9 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.10 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 20 5 } -cleanup { deleteWindows @@ -5195,10 +5171,10 @@ test panedwindow-26.10 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.11 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 20 0 } -cleanup { deleteWindows @@ -5206,10 +5182,10 @@ test panedwindow-26.11 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.12 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -showhandle false -bd 0 -sashwidth 2 -sashpad 2 - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] \ - [frame .f3 -bg green -width 20 -height 20] + panedwindow .p -showhandle false -borderwidth 0 -sashwidth 2 -sashpad 2 + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] \ + [frame .f3 -background green -width 20 -height 20] .p identify 48 0 } -cleanup { deleteWindows @@ -5241,9 +5217,9 @@ test panedwindow-26.15 {identify subcommand errors} -setup { test panedwindow-26.16 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -orient vertical + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 0 0 } -cleanup { deleteWindows @@ -5251,9 +5227,9 @@ test panedwindow-26.16 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.17 {PanedWindowIdentifyCoords, padding is included} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -orient vertical + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 0 20 } -cleanup { deleteWindows @@ -5261,9 +5237,9 @@ test panedwindow-26.17 {PanedWindowIdentifyCoords, padding is included} -setup { test panedwindow-26.18 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -orient vertical + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 0 22 } -cleanup { deleteWindows @@ -5271,9 +5247,9 @@ test panedwindow-26.18 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.19 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -orient vertical + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 0 24 } -cleanup { deleteWindows @@ -5281,9 +5257,9 @@ test panedwindow-26.19 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.20 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -orient vertical + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 0 26 } -cleanup { deleteWindows @@ -5291,9 +5267,9 @@ test panedwindow-26.20 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.21 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -orient vertical + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify -1 26 } -cleanup { deleteWindows @@ -5301,9 +5277,9 @@ test panedwindow-26.21 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.22 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -orient vertical + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 100 26 } -cleanup { deleteWindows @@ -5311,10 +5287,10 @@ test panedwindow-26.22 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.23 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 4 22 } -cleanup { deleteWindows @@ -5322,10 +5298,10 @@ test panedwindow-26.23 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.24 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 6 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 5 22 } -cleanup { deleteWindows @@ -5333,10 +5309,10 @@ test panedwindow-26.24 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.25 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 5 20 } -cleanup { deleteWindows @@ -5344,10 +5320,10 @@ test panedwindow-26.25 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.26 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -bd 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ + panedwindow .p -borderwidth 0 -sashwidth 2 -sashpad 2 -showhandle 1 -handlepad 5 \ -handlesize 8 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] .p identify 0 20 } -cleanup { deleteWindows @@ -5355,16 +5331,15 @@ test panedwindow-26.26 {PanedWindowIdentifyCoords} -setup { test panedwindow-26.27 {PanedWindowIdentifyCoords} -setup { deleteWindows } -body { - panedwindow .p -showhandle false -bd 0 -sashwidth 2 -sashpad 2 -orient vertical - .p add [frame .f -bg red -width 20 -height 20] \ - [frame .f2 -bg blue -width 20 -height 20] \ - [frame .f3 -bg green -width 20 -height 20] + panedwindow .p -showhandle false -borderwidth 0 -sashwidth 2 -sashpad 2 -orient vertical + .p add [frame .f -background red -width 20 -height 20] \ + [frame .f2 -background blue -width 20 -height 20] \ + [frame .f3 -background green -width 20 -height 20] .p identify 0 48 } -cleanup { deleteWindows } -result {1 sash} - test panedwindow-27.1 {destroy the window cleanly on error [Bug #616589]} -setup { deleteWindows } -body { @@ -5383,13 +5358,12 @@ test panedwindow-27.2 {destroy the window cleanly on rename [Bug #616589]} -setu deleteWindows } -result {0} - test panedwindow-28.1 {resizing width} -setup { deleteWindows } -body { - panedwindow .p -bd 5 - frame .f1 -width 100 -height 50 -bg blue - frame .f2 -width 100 -height 50 -bg red + panedwindow .p -borderwidth 5 + frame .f1 -width 100 -height 50 -background blue + frame .f2 -width 100 -height 50 -background red .p add .f1 -sticky news .p add .f2 -sticky news @@ -5410,9 +5384,9 @@ test panedwindow-28.1 {resizing width} -setup { test panedwindow-28.2 {resizing height} -setup { deleteWindows } -body { - panedwindow .p -orient vertical -bd 5 - frame .f1 -width 50 -height 100 -bg blue - frame .f2 -width 50 -height 100 -bg red + panedwindow .p -orient vertical -borderwidth 5 + frame .f1 -width 50 -height 100 -background blue + frame .f2 -width 50 -height 100 -background red .p add .f1 -sticky news .p add .f2 -sticky news @@ -5430,7 +5404,6 @@ test panedwindow-28.2 {resizing height} -setup { deleteWindows } -result {100 110} - test panedwindow-29.1 {display on depths other than the default one} -constraints { pseudocolor8 haveTruecolor24 } -setup { diff --git a/tests/place.test b/tests/place.test index ddfa64c..7262888 100644 --- a/tests/place.test +++ b/tests/place.test @@ -17,11 +17,11 @@ testConstraint memory [llength [info commands memory]] # few of the features are tested. # Widgets used in tests 1.* - 8.* -toplevel .t -width 300 -height 200 -bd 0 +toplevel .t -width 300 -height 200 -borderwidth 0 wm geom .t +0+0 -frame .t.f -width 154 -height 84 -bd 2 -relief raised +frame .t.f -width 154 -height 84 -borderwidth 2 -relief raised place .t.f -x 48 -y 38 -frame .t.f2 -width 30 -height 60 -bd 2 -relief raised +frame .t.f2 -width 30 -height 60 -borderwidth 2 -relief raised update test place-1.1 {Tk_PlaceCmd procedure, "info" option} -setup { @@ -52,7 +52,6 @@ test place-1.3 {Tk_PlaceCmd procedure, "info" option} -setup { destroy ".t.a.b" } -result {-in {.t.a b} -x 1 -relx 0.2 -y 2 -rely 0.2 -width {} -relwidth 0.3 -height 4 -relheight {} -anchor w -bordermode ignore} - test place-2.1 {ConfigureSlave procedure, -height option} -body { place .t.f2 -height abcd } -returnCodes error -result {bad screen distance "abcd"} @@ -73,7 +72,6 @@ test place-2.3 {ConfigureSlave procedure, -height option} -setup { winfo height .t.f2 } -result {60} - test place-3.1 {ConfigureSlave procedure, -relheight option} -body { place .t.f2 -relheight abcd } -returnCodes error -result {expected floating-point number but got "abcd"} @@ -94,7 +92,6 @@ test place-3.3 {ConfigureSlave procedure, -relheight option} -setup { winfo height .t.f2 } -result {60} - test place-4.1 {ConfigureSlave procedure, bad -in options} -setup { place forget .t.f2 } -body { @@ -119,7 +116,6 @@ test place-4.4 {ConfigureSlave procedure, bad -in option} -setup { place .t.f2 -in . } -returnCodes error -result {can't place .t.f2 relative to .} - test place-5.1 {ConfigureSlave procedure, -relwidth option} -body { place .t.f2 -relwidth abcd } -returnCodes error -result {expected floating-point number but got "abcd"} @@ -160,7 +156,6 @@ test place-6.3 {ConfigureSlave procedure, -width option} -setup { winfo width .t.f2 } -result {30} - test place-7.1 {ReconfigurePlacement procedure, computing position} -setup { place forget .t.f2 } -body { @@ -199,7 +194,7 @@ test place-7.5 {ReconfigurePlacement procedure, position rounding} -setup { test place-7.6 {ReconfigurePlacement procedure, position rounding} -setup { destroy .t.f3 } -body { - frame .t.f3 -width 100 -height 100 -bg #f00000 -bd 0 + frame .t.f3 -width 100 -height 100 -background red -borderwidth 0 place .t.f3 -x 0 -y 0 raise .t.f2 place forget .t.f2 @@ -239,7 +234,6 @@ test place-7.10 {ReconfigurePlacement procedure, computing size} -setup { list [winfo width .t.f2] [winfo height .t.f2] } -result {30 60} - test place-8.1 {MasterStructureProc, mapping and unmapping slaves} -setup { place forget .t.f2 place forget .t.f @@ -277,7 +271,6 @@ test place-8.2 {MasterStructureProc, mapping and unmapping slaves} -setup { } -result {1 0 42 32 0 1} destroy .t - test place-9.1 {PlaceObjCmd} -body { place } -returnCodes error -result {wrong # args: should be "place option|pathName args"} @@ -363,7 +356,6 @@ test place-9.12 {PlaceObjCmd, slaves errors} -setup { destroy .foo } -returnCodes error -result {wrong # args: should be "place slaves pathName"} - test place-10.1 {ConfigureSlave} -setup { destroy .foo } -body { @@ -397,7 +389,6 @@ test place-10.4 {ConfigureSlave} -setup { destroy .foo } -returnCodes error -result {value for "-y" missing} - test place-11.1 {PlaceObjCmd, slaves command} -setup { destroy .foo } -body { @@ -417,7 +408,6 @@ test place-11.2 {PlaceObjCmd, slaves command} -setup { destroy .foo .bar } -result [list .bar] - test place-12.1 {PlaceObjCmd, forget command} -setup { destroy .foo } -body { @@ -432,7 +422,6 @@ test place-12.1 {PlaceObjCmd, forget command} -setup { destroy .foo } -result {1 0} - test place-13.1 {test respect for internalborder} -setup { destroy .pack } -body { @@ -452,7 +441,6 @@ test place-13.1 {test respect for internalborder} -setup { destroy .pack } -result {196x188+2+10 177x186+5+7} - test place-14.1 {memory leak testing} -constraints memory -setup { destroy .f proc getbytes {} { diff --git a/tests/raise.test b/tests/raise.test index 461ccbf..95fd11c 100644 --- a/tests/raise.test +++ b/tests/raise.test @@ -21,7 +21,7 @@ proc raise_setup {} { destroy $i } foreach i {a b c d e} { - label .raise.$i -text $i -relief raised -bd 2 + label .raise.$i -text $i -relief raised -borderwidth 2 } place .raise.a -x 20 -y 60 -width 60 -height 80 place .raise.b -x 60 -y 60 -width 60 -height 80 @@ -36,14 +36,14 @@ proc raise_setup {} { proc raise_getOrder {} { set x [winfo rootx .raise] set y [winfo rooty .raise] - list [winfo name [winfo containing [expr $x+50] [expr $y+70]]] \ - [winfo name [winfo containing [expr $x+90] [expr $y+70]]] \ - [winfo name [winfo containing [expr $x+130] [expr $y+70]]] \ - [winfo name [winfo containing [expr $x+70] [expr $y+100]]] \ - [winfo name [winfo containing [expr $x+110] [expr $y+100]]] \ - [winfo name [winfo containing [expr $x+50] [expr $y+130]]] \ - [winfo name [winfo containing [expr $x+90] [expr $y+130]]] \ - [winfo name [winfo containing [expr $x+130] [expr $y+130]]] + list [winfo name [winfo containing [expr {$x + 50}] [expr {$y + 70}]]] \ + [winfo name [winfo containing [expr {$x + 90}] [expr {$y + 70}]]] \ + [winfo name [winfo containing [expr {$x + 130}] [expr {$y + 70}]]] \ + [winfo name [winfo containing [expr {$x + 70}] [expr {$y + 100}]]] \ + [winfo name [winfo containing [expr {$x + 110}] [expr {$y + 100}]]] \ + [winfo name [winfo containing [expr {$x + 50}] [expr {$y + 130}]]] \ + [winfo name [winfo containing [expr {$x + 90}] [expr {$y + 130}]]] \ + [winfo name [winfo containing [expr {$x + 130}] [expr {$y + 130}]]] } # Procedure to set up a collection of top-level windows @@ -60,7 +60,6 @@ proc raise_makeToplevels {} { toplevel .raise wm geom .raise 250x200+0+0 - test raise-1.1 {preserve creation order} -body { raise_setup tkwait visibility .raise.e @@ -91,7 +90,6 @@ test raise-1.5 {preserve creation order} -constraints testmakeexist -body { raise_getOrder } -result {d d d b c e e e} - test raise-2.1 {raise internal windows before creation} -body { raise_setup raise .raise.a @@ -123,7 +121,6 @@ test raise-2.5 {raise internal windows before creation} -body { raise_getOrder } -result {a d d a c e e e} - test raise-3.1 {raise internal windows after creation} -body { raise_setup update @@ -158,7 +155,6 @@ test raise-3.4 {raise internal windows after creation} -constraints { raise_getOrder } -result {d d d a c e e e} - test raise-4.1 {raise relative to nephews} -body { raise_setup update @@ -177,7 +173,6 @@ test raise-4.2 {raise relative to nephews} -setup { destroy .raise2 } -returnCodes error -result {can't raise ".raise.a" above ".raise2"} - test raise-5.1 {lower internal windows} -body { raise_setup update @@ -207,7 +202,6 @@ test raise-5.4 {lower internal windows} -setup { destroy .raise2 } -returnCodes error -result {can't lower ".raise.a" below ".raise2"} - test raise-6.1 {raise/lower toplevel windows} -constraints { nonPortable } -body { @@ -286,7 +280,6 @@ test raise-6.6 {raise/lower toplevel windows} -constraints { [winfo rooty .raise2]] } -result {.raise1 .raise3} - test raise-7.1 {errors in raise/lower commands} -body { raise } -returnCodes error -result {wrong # args: should be "raise window ?aboveThis?"} diff --git a/tests/scale.test b/tests/scale.test index 13ccb4d..87b4768 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -42,13 +42,13 @@ test scale-1.4 {configuration options} -body { .s configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test scale-1.5 {configuration options} -body { - .s configure -bd 4 - .s cget -bd + .s configure -borderwidth 4 + .s cget -borderwidth } -cleanup { - .s configure -bd [lindex [.s configure -bd] 3] + .s configure -borderwidth [lindex [.s configure -borderwidth] 3] } -result {4} test scale-1.6 {configuration options} -body { - .s configure -bd badValue + .s configure -borderwidth badValue } -returnCodes error -result {bad screen distance "badValue"} test scale-1.7 {configuration options} -body { .s configure -bigincrement 12.5 @@ -60,13 +60,13 @@ test scale-1.8 {configuration options} -body { .s configure -bigincrement badValue } -returnCodes error -result {expected floating-point number but got "badValue"} test scale-1.9 {configuration options} -body { - .s configure -bg #ff0000 - .s cget -bg + .s configure -background #ff0000 + .s cget -background } -cleanup { - .s configure -bg [lindex [.s configure -bg] 3] + .s configure -background [lindex [.s configure -background] 3] } -result {#ff0000} test scale-1.10 {configuration options} -body { - .s configure -bg non-existent + .s configure -background non-existent } -returnCodes error -result {unknown color name "non-existent"} test scale-1.11 {configuration options} -body { .s configure -borderwidth 1.3 @@ -102,13 +102,13 @@ test scale-1.18 {configuration options} -body { .s configure -digits badValue } -returnCodes error -result {expected integer but got "badValue"} test scale-1.19 {configuration options} -body { - .s configure -fg #00ff00 - .s cget -fg + .s configure -foreground #00ff00 + .s cget -foreground } -cleanup { - .s configure -fg [lindex [.s configure -fg] 3] + .s configure -foreground [lindex [.s configure -foreground] 3] } -result {#00ff00} test scale-1.20 {configuration options} -body { - .s configure -fg badValue + .s configure -foreground badValue } -returnCodes error -result {unknown color name "badValue"} test scale-1.21 {configuration options} -body { .s configure -font fixed @@ -319,7 +319,6 @@ test scale-1.70 {configuration options} -body { } -returnCodes error -result {bad screen distance "badValue"} destroy .s - test scale-2.1 {Tk_ScaleCmd procedure} -body { scale } -returnCodes error -result {wrong # args: should be "scale pathName ?-option value ...?"} @@ -367,8 +366,8 @@ test scale-3.7 {ScaleWidgetCmd procedure, configure option} -body { .s configure -foo } -returnCodes error -result {unknown option "-foo"} test scale-3.8 {ScaleWidgetCmd procedure, configure option} -body { - .s configure -borderwidth 2 -bg -} -returnCodes error -result {value for "-bg" missing} + .s configure -borderwidth 2 -background +} -returnCodes error -result {value for "-background" missing} test scale-3.9 {ScaleWidgetCmd procedure, coords option} -body { .s coords a b } -returnCodes error -result {wrong # args: should be ".s coords ?value?"} @@ -493,7 +492,6 @@ test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} -setup { destroy .s } -result {} - test scale-4.1 {DestroyScale procedure} -setup { deleteWindows } -body { @@ -505,7 +503,6 @@ test scale-4.1 {DestroyScale procedure} -setup { list [catch {set x foo} msg] $msg $x } -result {0 foo foo} - test scale-5.1 {ConfigureScale procedure} -setup { deleteWindows } -body { @@ -530,7 +527,7 @@ test scale-5.2 {ConfigureScale procedure} -setup { test scale-5.3 {ConfigureScale procedure} -setup { deleteWindows } -body { - catch {unset x} + unset -nocomplain x scale .s -from 0 -to 100 -variable x set result $x lappend result [.s get] @@ -690,7 +687,6 @@ test scale-6.20 {ComputeFormat procedure} -body { } -result {1001.235} destroy .s - test scale-7.1 {ComputeScaleGeometry procedure} -constraints { nonPortable fonts } -setup { @@ -733,7 +729,7 @@ test scale-7.4 {ComputeScaleGeometry procedure} -constraints { } -setup { deleteWindows } -body { - scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \ + scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -borderwidth 5 \ -relief sunken pack .s update @@ -781,7 +777,7 @@ test scale-7.7 {ComputeScaleGeometry procedure} -constraints { test scale-7.8 {ComputeScaleGeometry procedure} -setup { deleteWindows } -body { - scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \ + scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -borderwidth 5 \ -relief raised -highlightthickness 2 pack .s update @@ -790,13 +786,12 @@ test scale-7.8 {ComputeScaleGeometry procedure} -setup { deleteWindows } -result {114 39} - test scale-8.1 {ScaleElement procedure} -constraints { fonts } -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 + scale .s -from 0 -to 100 -orient vertical -borderwidth 1 -tick 20 -length 300 pack .s .s set 30 update @@ -810,7 +805,7 @@ test scale-8.2 {ScaleElement procedure} -constraints { } -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 + scale .s -from 0 -to 100 -orient vertical -borderwidth 1 -tick 20 -length 300 pack .s .s set 30 update @@ -824,7 +819,7 @@ test scale-8.3 {ScaleElement procedure} -constraints { } -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300 + scale .s -from 0 -to 100 -orient vertical -borderwidth 1 -tick 20 -length 300 pack .s .s set 30 update @@ -836,7 +831,7 @@ test scale-8.3 {ScaleElement procedure} -constraints { test scale-8.4 {ScaleElement procedure} -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \ + scale .s -from 0 -to 100 -orient vertical -borderwidth 4 -width 10 \ -highlightthickness 1 -length 300 -showvalue 0 pack .s .s set 30 @@ -851,7 +846,7 @@ test scale-8.5 {ScaleElement procedure} -constraints { } -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -orient horizontal -bd 1 \ + scale .s -from 0 -to 100 -orient horizontal -borderwidth 1 \ -highlightthickness 2 -tick 20 -sliderlength 20 \ -length 200 -label Test pack .s @@ -867,7 +862,7 @@ test scale-8.6 {ScaleElement procedure} -constraints { } -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -orient horizontal -bd 2 \ + scale .s -from 0 -to 100 -orient horizontal -borderwidth 2 \ -highlightthickness 1 -tick 20 -length 200 pack .s .s set 30 @@ -880,7 +875,7 @@ test scale-8.6 {ScaleElement procedure} -constraints { test scale-8.7 {ScaleElement procedure} -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \ + scale .s -from 0 -to 100 -orient horizontal -borderwidth 4 -highlightthickness 2 \ -length 200 -width 10 -showvalue 0 pack .s .s set 30 @@ -893,7 +888,7 @@ test scale-8.7 {ScaleElement procedure} -setup { test scale-8.8 {ScaleElement procedure} -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \ + scale .s -from 0 -to 100 -orient horizontal -borderwidth 1 -highlightthickness 2 \ -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 pack .s .s set 30 @@ -906,7 +901,7 @@ test scale-8.8 {ScaleElement procedure} -setup { test scale-8.9 {ScaleElement procedure} -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \ + scale .s -from 0 -to 100 -orient horizontal -borderwidth 1 -highlightthickness 2 \ -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0 pack .s .s set 80 @@ -922,60 +917,59 @@ test scale-8.9 {ScaleElement procedure} -setup { destroy .s pack [scale .s] test scale-9.1 {PixelToValue procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 update .s get 46 0 } -result 0 test scale-9.2 {PixelToValue procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 update .s get -10 9 } -result 0 test scale-9.3 {PixelToValue procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 update .s get -10 12 } -result 1 test scale-9.4 {PixelToValue procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 update .s get -10 46 } -result 35 test scale-9.5 {PixelToValue procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 update .s get -10 110 } -result 99 test scale-9.6 {PixelToValue procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 update .s get -10 111 } -result 100 test scale-9.7 {PixelToValue procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 update .s get -10 112 } -result 100 test scale-9.8 {PixelToValue procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 update .s get -10 154 } -result 100 test scale-9.9 {PixelToValue procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal update .s get 76 152 } -result 65 destroy .s - test scale-10.1 {ValueToPixel procedure} -constraints { fonts } -setup { deleteWindows } -body { - scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \ + scale .s -from 0 -to 100 -sliderlength 20 -length 124 -borderwidth 2 \ -orient horizontal -label Test -tick 20 pack .s update @@ -988,7 +982,7 @@ test scale-10.2 {ValueToPixel procedure} -constraints { } -setup { deleteWindows } -body { - scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \ + scale .s -from 100 -to 0 -sliderlength 20 -length 122 -borderwidth 1 \ -orient vertical -label Test -tick 20 pack .s update @@ -997,7 +991,6 @@ test scale-10.2 {ValueToPixel procedure} -constraints { deleteWindows } -result {{62 114} {62 74} {62 14}} - test scale-11.1 {ScaleEventProc procedure} -setup { deleteWindows } -body { @@ -1025,10 +1018,10 @@ test scale-11.2 {ScaleEventProc procedure} -setup { deleteWindows set x {} } -body { - scale .s1 -bg #543210 + scale .s1 -background #543210 rename .s1 .s2 lappend x [winfo children .] - lappend x [.s2 cget -bg] + lappend x [.s2 cget -background] destroy .s1 lappend x [info command .s*] [winfo children .] } -cleanup { @@ -1100,85 +1093,84 @@ destroy .s pack [scale .s] update test scale-14.1 {RoundToResolution procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 4.0 update .s get 84 152 } -result 72 test scale-14.2 {RoundToResolution procedure} -body { - .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 0 -to 100 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 4.0 update .s get 86 152 } -result 76 test scale-14.3 {RoundToResolution procedure} -body { - .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 100 -to 0 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 4.0 update .s get 84 152 } -result 28 test scale-14.4 {RoundToResolution procedure} -body { - .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 100 -to 0 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 4.0 update .s get 86 152 } -result 24 test scale-14.5 {RoundToResolution procedure} -body { - .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from -100 -to 0 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 4.0 update .s get 84 152 } -result {-28} test scale-14.6 {RoundToResolution procedure} -body { - .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from -100 -to 0 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 4.0 update .s get 86 152 } -result {-24} test scale-14.7 {RoundToResolution procedure} -body { - .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 0 -to -100 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 4.0 update .s get 84 152 } -result {-72} test scale-14.8 {RoundToResolution procedure} -body { - .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 0 -to -100 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 4.0 update .s get 86 152 } -result {-76} test scale-14.9 {RoundToResolution procedure} -body { - .s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 0 update .s get 84 152 } -result {1.64} test scale-14.10 {RoundToResolution procedure} -body { - .s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 0 update .s get 86 152 } -result {1.69} test scale-14.11 {RoundToResolution procedure} -body { - .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 0 -to 225 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 0 -digits 5 update .s get 84 152 } -result {164.25} test scale-14.12 {RoundToResolution procedure} -body { - .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \ + .s configure -from 0 -to 225 -sliderlength 10 -length 114 -borderwidth 2 \ -orient horizontal -resolution 0 -digits 5 update .s get 86 152 } -result {168.75} destroy .s - test scale-15.1 {ScaleVarProc procedure} -setup { deleteWindows } -body { @@ -1269,7 +1261,6 @@ test scale-15.8 {ScaleVarProc procedure, don't call -command} -setup { deleteWindows } -result {untouched 60} - test scale-16.1 {scale widget vs hidden commands} -body { set l [interp hidden] deleteWindows @@ -1283,7 +1274,6 @@ test scale-16.1 {scale widget vs hidden commands} -body { deleteWindows } -result 1 - test scale-17.1 {bug fix 1786} -setup { deleteWindows } -body { @@ -1306,7 +1296,6 @@ test scale-17.1 {bug fix 1786} -setup { deleteWindows } -result {100} - test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} -setup { deleteWindows } -body { @@ -1356,7 +1345,6 @@ test scale-18.3 {Scale button 2 events [Bug 787065]} -setup { destroy .s } -result {0 {}} - option clear # cleanup diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 3addd28..632e489 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -11,29 +11,29 @@ package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands -proc scroll args { +proc scroll {args} { global scrollInfo set scrollInfo $args } proc getTroughSize {w} { if {[testConstraint testmetrics]} { - if [string match v* [$w cget -orient]] { - return [expr [winfo height $w] - 2*[testmetrics cyvscroll $w]] + if {[string match "v*" [$w cget -orient]]} { + return [expr {[winfo height $w] - (2 * [testmetrics cyvscroll $w])}] } else { - return [expr [winfo width $w] - 2*[testmetrics cxhscroll $w]] + return [expr {[winfo width $w] - (2 * [testmetrics cxhscroll $w])}] } } else { - if [string match v* [$w cget -orient]] { - return [expr [winfo height $w] \ - - ([winfo width $w] \ + if {[string match "v*" [$w cget -orient]]} { + return [expr {[winfo height $w] \ + - ((([winfo width $w] \ - [$w cget -highlightthickness] \ - - [$w cget -bd] + 1)*2] + - [$w cget -borderwidth]) + 1) * 2)}] } else { - return [expr [winfo width $w] \ - - ([winfo height $w] \ + return [expr {[winfo width $w] \ + - ((([winfo height $w] \ - [$w cget -highlightthickness] \ - - [$w cget -bd] + 1)*2] + - [$w cget -borderwidth]) + 1) * 2)}] } } } @@ -43,8 +43,8 @@ proc getTroughSize {w} { # as you fix bugs and add features. foreach {width height} [wm minsize .] { - set height [expr ($height < 200) ? 200 : $height] - set width [expr ($width < 1) ? 1 : $width] + set height [expr {($height < 200) ? 200 : $height}] + set width [expr {($width < 1) ? 1 : $width}] } frame .f -height $height -width $width @@ -60,8 +60,8 @@ foreach test { {bad relief "non-existent": must be flat, groove, raised, ridge, solid, or sunken}} {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-bd 4 4 badValue {bad screen distance "badValue"}} - {-bg #ff0000 #ff0000 non-existent + {-borderwidth 4 4 badValue {bad screen distance "badValue"}} + {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} {-command "set x" {set x} {} {}} @@ -115,14 +115,14 @@ test scrollbar-2.4 {Tk_ScrollbarCmd procedure} { [info command .s] } {1 {unknown option "-gorp"} 0 {}} test scrollbar-2.5 {Tk_ScrollbarCmd procedure} -setup { - catch {destroy .s} + destroy .s } -body { scrollbar .s } -cleanup { destroy .s } -result .s -scrollbar .s -orient vertical -command scroll -highlightthickness 2 -bd 2 +scrollbar .s -orient vertical -command scroll -highlightthickness 2 -borderwidth 2 pack .s -side right -fill y update test scrollbar-3.1 {ScrollbarWidgetCmd procedure} { @@ -162,7 +162,7 @@ test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} { } {0 vertical} scrollbar .s2 test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} { - expr {[.s2 cget -bd] == [lindex [.s2 configure -bd] 3]} + expr {[.s2 cget -borderwidth] == [lindex [.s2 configure -borderwidth] 3]} } 1 test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} emptyTest { # empty test; duplicated scrollbar-3.11 @@ -218,10 +218,10 @@ test scrollbar-3.25 {ScrollbarWidgetCmd procedure, "delta" option} { } {0} test scrollbar-3.26 {ScrollbarWidgetCmd procedure, "delta" option} { format {%.6g} [.s delta 0 20] -} [format %.6g [expr 20.0/([getTroughSize .s]-1)]] +} [format %.6g [expr {20.0 / ([getTroughSize .s] - 1)}]] test scrollbar-3.27 {ScrollbarWidgetCmd procedure, "delta" option} { format {%.6g} [.s delta 0 -20] -} [format %.6g [expr -20.0/([getTroughSize .s]-1)]] +} [format %.6g [expr {-20.0 / ([getTroughSize .s] - 1)}]] test scrollbar-3.28 {ScrollbarWidgetCmd procedure, "delta" option} { toplevel .t -width 250 -height 100 wm geom .t +0+0 @@ -253,13 +253,13 @@ test scrollbar-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} { } {1} test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} { format {%.6g} [.s fraction 4 21] -} [format %.6g [expr (21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \ - /([getTroughSize .s] - 1)]] +} [format %.6g [expr {(21.0 - (([winfo height .s] - [getTroughSize .s]) / 2.0)) \ + / ([getTroughSize .s] - 1)}]] test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} unix { format {%.6g} [.s fraction 4 179] } {1} test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics} { - format {%.6g} [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s]]] + format {%.6g} [.s fraction 4 [expr {200 - [testmetrics cyvscroll .s]}]] } {1} test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} unix { format {%.6g} [.s fraction 4 178] @@ -281,9 +281,9 @@ test scrollbar-3.41 {ScrollbarWidgetCmd procedure, "fraction" option} { format {%.6g} [.t.s fraction 100 0] } {0.5} if {[testConstraint testmetrics]} { - place configure .t.s -width [expr 2*[testmetrics cxhscroll .t.s]+1] + place configure .t.s -width [expr {(2 * [testmetrics cxhscroll .t.s]) + 1}] } else { - place configure .t.s -width [expr [winfo reqwidth .t.s] - 4] + place configure .t.s -width [expr {[winfo reqwidth .t.s] - 4}] } update test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} { @@ -408,25 +408,25 @@ test scrollbar-3.74 {ScrollbarWidgetCmd procedure} { } {1 {bad option "c": must be activate, cget, configure, delta, fraction, get, identify, or set}} test scrollbar-4.1 {ScrollbarEventProc procedure} { - catch {destroy .s1} - scrollbar .s1 -bg #543210 + destroy .s1 + scrollbar .s1 -background #543210 rename .s1 .s2 set x {} lappend x [winfo exists .s1] - lappend x [.s2 cget -bg] + lappend x [.s2 cget -background] destroy .s1 lappend x [info command .s?] [winfo exists .s1] [winfo exists .s2] } {1 #543210 {} 0 0} test scrollbar-5.1 {ScrollbarCmdDeletedProc procedure} { - catch {destroy .s1} + destroy .s1 scrollbar .s1 rename .s1 {} list [info command .s?] [winfo exists .s1] } {{} 0} -catch {destroy .s} -scrollbar .s -orient vertical -relief sunken -bd 2 -highlightthickness 2 +destroy .s +scrollbar .s -orient vertical -relief sunken -borderwidth 2 -highlightthickness 2 pack .s -side left -fill y .s set .2 .4 update @@ -444,16 +444,16 @@ test scrollbar-6.6 {ScrollbarPosition procedure} unix { .s identify 19 100 } {} test scrollbar-6.7 {ScrollbarPosition procedure} { - .s identify [expr [winfo width .s] / 2] -1 + .s identify [expr {[winfo width .s] / 2}] -1 } {} test scrollbar-6.8 {ScrollbarPosition procedure} { - .s identify [expr [winfo width .s] / 2] [expr [winfo height .s]] + .s identify [expr {[winfo width .s] / 2}] [expr {[winfo height .s]}] } {} test scrollbar-6.9 {ScrollbarPosition procedure} { - .s identify -1 [expr [winfo height .s] / 2] + .s identify -1 [expr {[winfo height .s] / 2}] } {} test scrollbar-6.10 {ScrollbarPosition procedure} { - .s identify [winfo width .s] [expr [winfo height .s] / 2] + .s identify [winfo width .s] [expr {[winfo height .s] / 2}] } {} test scrollbar-6.11 {ScrollbarPosition procedure} unix { .s identify 8 4 @@ -462,10 +462,10 @@ test scrollbar-6.12 {ScrollbarPosition procedure} unix { .s identify 8 19 } {arrow1} test scrollbar-6.14 {ScrollbarPosition procedure} win { - .s identify [expr [winfo width .s] / 2] 0 + .s identify [expr {[winfo width .s] / 2}] 0 } {arrow1} test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics win} { - .s identify [expr [winfo width .s] / 2] [expr [testmetrics cyvscroll .s] - 1] + .s identify [expr {[winfo width .s] / 2}] [expr {[testmetrics cyvscroll .s] - 1}] } {arrow1} test scrollbar-6.16 {ScrollbarPosition procedure} unix { .s identify 8 20 @@ -476,11 +476,11 @@ test scrollbar-6.17 {ScrollbarPosition procedure} {unix nonPortable} { .s identify 8 51 } {trough1} test scrollbar-6.18 {ScrollbarPosition procedure} {testmetrics win} { - .s identify [expr [winfo width .s] / 2] [testmetrics cyvscroll .s] + .s identify [expr {[winfo width .s] / 2}] [testmetrics cyvscroll .s] } {trough1} test scrollbar-6.19 {ScrollbarPosition procedure} {testmetrics win} { - .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \ - + [testmetrics cyvscroll .s] - 1] + .s identify [expr {[winfo width .s] / 2}] [expr {int (.2 / [.s delta 0 1]) \ + + [testmetrics cyvscroll .s] - 1}] } {trough1} test scrollbar-6.20 {ScrollbarPosition procedure} unix { .s identify 8 52 @@ -491,12 +491,12 @@ test scrollbar-6.21 {ScrollbarPosition procedure} {unix nonPortable} { .s identify 8 83 } {slider} test scrollbar-6.22 {ScrollbarPosition procedure} {testmetrics win} { - .s identify [expr [winfo width .s] / 2] \ - [expr int(.2 / [.s delta 0 1] + 0.5) + [testmetrics cyvscroll .s]] + .s identify [expr {[winfo width .s] / 2}] \ + [expr { int (.2 / [.s delta 0 1] + 0.5) + [testmetrics cyvscroll .s]}] } {slider} test scrollbar-6.23 {ScrollbarPosition procedure} {testmetrics win} { - .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \ - + [testmetrics cyvscroll .s] - 1] + .s identify [expr {[winfo width .s] / 2}] [expr { int (.4 / [.s delta 0 1]) \ + + [testmetrics cyvscroll .s] - 1}] } {slider} test scrollbar-6.24 {ScrollbarPosition procedure} unix { .s identify 8 84 @@ -509,12 +509,12 @@ test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics win knownBug} { # bug in that GetSystemMetrics(SM_CYVTHUMB) actually returns a value # that is larger than the thumb displayed, skewing the ability to # calculate the trough2 area correctly (Win2k). -- hobbs - .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \ - + [testmetrics cyvscroll .s]] + .s identify [expr {[winfo width .s] / 2}] [expr { int (.4 / [.s delta 0 1]) \ + + [testmetrics cyvscroll .s]}] } {trough2} test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics win} { - .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ - - [testmetrics cyvscroll .s] - 1] + .s identify [expr {[winfo width .s] / 2}] [expr {[winfo height .s] \ + - [testmetrics cyvscroll .s] - 1}] } {trough2} test scrollbar-6.29 {ScrollbarPosition procedure} unix { .s identify 8 180 @@ -523,11 +523,11 @@ test scrollbar-6.30 {ScrollbarPosition procedure} unix { .s identify 8 195 } {arrow2} test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics win} { - .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ - - [testmetrics cyvscroll .s]] + .s identify [expr {[winfo width .s] / 2}] [expr {[winfo height .s] \ + - [testmetrics cyvscroll .s]}] } {arrow2} test scrollbar-6.33 {ScrollbarPosition procedure} win { - .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] - 1] + .s identify [expr {[winfo width .s] / 2}] [expr {[winfo height .s] - 1}] } {arrow2} test scrollbar-6.34 {ScrollbarPosition procedure} unix { .s identify 4 100 @@ -539,13 +539,13 @@ test scrollbar-6.37 {ScrollbarPosition procedure} win { .s identify 0 100 } {trough2} test scrollbar-6.38 {ScrollbarPosition procedure} win { - .s identify [expr [winfo width .s] - 1] 100 + .s identify [expr {[winfo width .s] - 1}] 100 } {trough2} -catch {destroy .t} +destroy .t toplevel .t -width 250 -height 150 wm geometry .t +0+0 -scrollbar .t.s -orient horizontal -relief sunken -bd 2 -highlightthickness 2 +scrollbar .t.s -orient horizontal -relief sunken -borderwidth 2 -highlightthickness 2 place .t.s -width 200 .t.s set .2 .4 update @@ -554,20 +554,20 @@ test scrollbar-6.39 {ScrollbarPosition procedure} unix { .t.s identify 4 8 } {arrow1} test scrollbar-6.40 {ScrollbarPosition procedure} win { - .t.s identify 0 [expr [winfo height .t.s] / 2] + .t.s identify 0 [expr {[winfo height .t.s] / 2}] } {arrow1} test scrollbar-6.41 {ScrollbarPosition procedure} unix { .t.s identify 82 8 } {slider} test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics win} { - .t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll .t.s] \ - - 1] [expr [winfo height .t.s] / 2] + .t.s identify [expr { int (.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll .t.s] \ + - 1}] [expr {[winfo height .t.s] / 2}] } {slider} test scrollbar-6.44 {ScrollbarPosition procedure} unix { .t.s identify 100 18 } {trough2} test scrollbar-6.46 {ScrollbarPosition procedure} win { - .t.s identify 100 [expr [winfo height .t.s] - 1] + .t.s identify 100 [expr {[winfo height .t.s] - 1}] } {trough2} test scrollbar-7.1 {EventuallyRedraw} { @@ -579,7 +579,7 @@ test scrollbar-7.1 {EventuallyRedraw} { lappend result [.s cget -orient] } {horizontal vertical} -catch {destroy .t} +destroy .t toplevel .t wm geometry .t +0+0 test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} { @@ -594,7 +594,7 @@ test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} { .t.f.s set 0 .5 update set result [winfo exists .t.f.s] - event generate .t.f.s <ButtonPress> -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5 + event generate .t.f.s <ButtonPress> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 event generate .t <ButtonRelease> -button 1 update lappend result [winfo exists .t.f.s] [winfo exists .t.f] @@ -613,7 +613,7 @@ test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} { .t.f.s set 0 .5 update set result [winfo exists .t.f.s] - event generate .t.f.s <ButtonPress> -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5 + event generate .t.f.s <ButtonPress> -button 1 -x [expr {[winfo width .t.f.s] / 2}] -y 5 event generate .t.f <ButtonRelease> -button 1 update lappend result [winfo exists .t.f.s] [winfo exists .t.f] @@ -625,15 +625,14 @@ set l [interp hidden] deleteWindows test scrollbar-9.1 {scrollbar widget vs hidden commands} { - catch {destroy .s} + destroy .s scrollbar .s interp hide {} .s destroy .s list [winfo children .] [interp hidden] } [list {} $l] -catch {destroy .s} -catch {destroy .t} +destroy .s .t # cleanup cleanupTests diff --git a/tests/select.test b/tests/select.test index 77bfb2e..7ea661e 100644 --- a/tests/select.test +++ b/tests/select.test @@ -19,8 +19,8 @@ tcltest::loadTestedCommands global longValue selValue selInfo -set selValue {} -set selInfo {} +set selValue "" +set selInfo "" proc handler {type offset count} { global selValue selInfo @@ -29,7 +29,7 @@ proc handler {type offset count} { if {$numBytes <= 0} { return "" } - string range $selValue $offset [expr $numBytes+$offset] + string range $selValue $offset [expr {$numBytes + $offset}] } proc errIncrHandler {type offset count} { @@ -48,10 +48,10 @@ proc errIncrHandler {type offset count} { if {$numBytes <= 0} { return "" } - string range $selValue $offset [expr $numBytes+$offset] + string range $selValue $offset [expr {$numBytes + $offset}] } -proc errHandler args { +proc errHandler {args} { error "selection handler aborted" } @@ -63,7 +63,7 @@ proc badHandler {path type offset count} { if {$numBytes <= 0} { return "" } - string range $selValue $offset [expr $numBytes+$offset] + string range $selValue $offset [expr {$numBytes + $offset}] } proc reallyBadHandler {path type offset count} { global selValue selInfo pass @@ -79,20 +79,20 @@ proc reallyBadHandler {path type offset count} { if {$numBytes <= 0} { return "" } - string range $selValue $offset [expr $numBytes+$offset] + string range $selValue $offset [expr {$numBytes + $offset}] } # Eliminate any existing selection on the screen. This is needed in case # there is a selection in some other application, in order to prevent races # from causing false errors in the tests below. -selection clear . +selection clear -displayof . after 1500 # common setup code -proc setup {{path .f1} {display {}}} { - catch {destroy $path} - if {$display == {}} { +proc setup {{path .f1} {display ""}} { + destroy $path + if {$display eq ""} { frame $path } else { toplevel $path -screen $display @@ -743,7 +743,7 @@ test select-6.18 {Tk_SelectionCmd procedure} -returnCodes error -body { selection get -selectionfoo foo } -result {bad option "-selectionfoo": must be -displayof, -selection, or -type} test select-6.19 {Tk_SelectionCmd procedure} -body { - catch { destroy .f2 } + destroy .f2 selection get -displayof .f2 } -returnCodes error -result {bad window path name ".f2"} test select-6.20 {Tk_SelectionCmd procedure} -returnCodes error -body { @@ -788,7 +788,7 @@ test select-6.28 {Tk_SelectionCmd procedure} -returnCodes error -body { selection handle . foo bar baz blat } -result {wrong # args: should be "selection handle ?-option value ...? window command"} test select-6.29 {Tk_SelectionCmd procedure} -body { - catch { destroy .f2 } + destroy .f2 selection handle .f2 dummy } -returnCodes error -result {bad window path name ".f2"} # selection own @@ -953,25 +953,25 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} -constr lappend x [gets $fd] } set fd [open "|[list [interpreter] -geometry +0+0 -name tktest]" r+] - puts $fd "puts foo; [loadTkCommand]; flush stdout" - flush $fd - gets $fd - fileevent $fd readable [list Ready $fd] + chan puts $fd "puts foo; [loadTkCommand]; flush stdout" + chan flush $fd + chan gets $fd + chan event $fd readable [list Ready $fd] set selValue "Just a simple test" set selInfo "" selection handle .f1 {handler STRING} update - puts $fd {puts "[catch {selection get} msg]:$msg"; puts **DONE**; flush stdout} - flush $fd + chan puts $fd {puts "[catch {selection get} msg]:$msg"; puts **DONE**; flush stdout} + chan flush $fd after 200 selection own . - set x {} + set x "" vwait [namespace which -variable x] - puts $fd {exit} - flush $fd + chan puts $fd {exit} + chan flush $fd # Don't understand why, but the [loadTkCommand] above causes # a "broken pipe" error when Tk was actually [load]ed in the child. - catch {close $fd} + catch {chan close $fd} lappend x $selInfo } -result {{1:PRIMARY selection doesn't exist or form "STRING" not defined} {}} test select-10.2 {ConvertSelection procedure} -constraints unix -setup { diff --git a/tests/send.test b/tests/send.test index e3156a1..3083314 100644 --- a/tests/send.test +++ b/tests/send.test @@ -19,7 +19,7 @@ testConstraint xhost [llength [auto_execok xhost]] # Compute a script that will load Tk into a child interpreter. foreach pkg [info loaded] { - if {[lindex $pkg 1] == "Tk"} { + if {[lindex $pkg 1] eq "Tk"} { set loadTk "load $pkg" break } @@ -29,7 +29,7 @@ foreach pkg [info loaded] { proc newApp {screen name class} { global loadTk - interp create $name + interp create -- $name $name eval [list set argv [list -display $screen -name $name -class $class]] eval $loadTk $name } @@ -312,7 +312,7 @@ test send-8.17 {Tk_SendCmd procedure, deferring events} {secureserver nonPortabl setupbg set app [dobg {tk appname}] raise . ; # Don't want new app obscuring .f - catch {destroy .f} + destroy .f frame .f place .f -x 0 -y 0 bind .f <Expose> {set a exposed} @@ -350,7 +350,7 @@ test send-8.19 {Tk_SendCmd, using modal timeouts} {secureserver} { } {{x y z} no yes} tk appname tktest -catch {destroy .f} +destroy .f frame .f set id [string range [winfo id .f] 2 end] @@ -531,7 +531,7 @@ test send-11.2 {AppendPropCarefully and AppendErrorProc procedures} {secureserve winfo interps tk appname tktest -catch {destroy .f} +destroy .f frame .f set id [string range [winfo id .f] 2 end] diff --git a/tests/spinbox.test b/tests/spinbox.test index b8170c5..657ecec 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -12,12 +12,12 @@ eval tcltest::configure $argv tcltest::loadTestedCommands # For xscrollcommand -proc scroll args { +proc scroll {args} { global scrollInfo set scrollInfo $args } # For trace variable -proc override args { +proc override {args} { global x set x 12345 } @@ -89,8 +89,8 @@ test spinbox-1.5 {configuration option: "bd"} -setup { pack .e update } -body { - .e configure -bd 4 - .e cget -bd + .e configure -borderwidth 4 + .e cget -borderwidth } -cleanup { destroy .e } -result {4} @@ -100,7 +100,7 @@ test spinbox-1.6 {configuration option: "bd" for spinbox} -setup { pack .e update } -body { - .e configure -bd badValue + .e configure -borderwidth badValue } -cleanup { destroy .e } -returnCodes {error} -result {bad screen distance "badValue"} @@ -111,8 +111,8 @@ test spinbox-1.7 {configuration option: "bg"} -setup { pack .e update } -body { - .e configure -bg #ff0000 - .e cget -bg + .e configure -background #ff0000 + .e cget -background } -cleanup { destroy .e } -result {#ff0000} @@ -122,7 +122,7 @@ test spinbox-1.8 {configuration option: "bg" for spinbox} -setup { pack .e update } -body { - .e configure -bg non-existent + .e configure -background non-existent } -cleanup { destroy .e } -returnCodes {error} -result {unknown color name "non-existent"} @@ -299,8 +299,8 @@ test spinbox-1.24 {configuration option: "fg"} -setup { pack .e update } -body { - .e configure -fg #110022 - .e cget -fg + .e configure -foreground #110022 + .e cget -foreground } -cleanup { destroy .e } -result {#110022} @@ -310,7 +310,7 @@ test spinbox-1.25 {configuration option: "fg" for spinbox} -setup { pack .e update } -body { - .e configure -fg bogus + .e configure -foreground bogus } -cleanup { destroy .e } -returnCodes {error} -result {unknown color name "bogus"} @@ -983,7 +983,6 @@ test spinbox-1.85 {configuration option: "xscrollcommand"} -setup { destroy .e } -result {Some command} - test spinbox-2.1 {Tk_SpinboxCmd procedure} -body { spinbox } -returnCodes error -result {wrong # args: should be "spinbox pathName ?-option value ...?"} @@ -1015,7 +1014,6 @@ test spinbox-2.5 {Tk_SpinboxCmd procedure} -body { destroy .e } -result {.e} - test spinbox-3.1 {SpinboxWidgetCmd procedure} -setup { spinbox .e pack .e @@ -1150,8 +1148,8 @@ test spinbox-3.13 {SpinboxWidgetCmd procedure, "cget" widget command} -setup { test spinbox-3.14 {SpinboxWidgetCmd procedure, "cget" widget command} -setup { spinbox .e } -body { - .e configure -bd 4 - .e cget -bd + .e configure -borderwidth 4 + .e cget -borderwidth } -cleanup { destroy .e } -result {4} @@ -1174,9 +1172,9 @@ test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} -setu test spinbox-3.17 {SpinboxWidgetCmd procedure, "configure" widget command} -setup { spinbox .e } -body { - .e configure -bd 4 - .e configure -bg #ffffff - lindex [.e configure -bd] 4 + .e configure -borderwidth 4 + .e configure -background #ffffff + lindex [.e configure -borderwidth] 4 } -cleanup { destroy .e } -result {4} @@ -2041,7 +2039,7 @@ test spinbox-5.9 {ConfigureSpinbox procedure} -constraints { spinbox .e -borderwidth 2 -highlightthickness 2 pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised + .e configure -font {Courier -12} -borderwidth 2 -relief raised .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] @@ -2054,7 +2052,7 @@ test spinbox-5.10 {ConfigureSpinbox procedure} -constraints { spinbox .e -borderwidth 2 -highlightthickness 2 pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief flat + .e configure -font {Courier -12} -borderwidth 2 -relief flat .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] @@ -2081,7 +2079,7 @@ test spinbox-6.1 {SpinboxComputeGeometry procedure} -constraints { spinbox .e pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 20 -highlightthickness 3 + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 20 -highlightthickness 3 .e insert end 012\t45 update list [.e index @61] [.e index @62] @@ -2094,7 +2092,7 @@ test spinbox-6.2 {SpinboxComputeGeometry procedure} -constraints { spinbox .e pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 20 -justify center \ + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 20 -justify center \ -highlightthickness 3 .e insert end 012\t45 update @@ -2108,7 +2106,7 @@ test spinbox-6.3 {SpinboxComputeGeometry procedure} -constraints { spinbox .e pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 20 -justify right \ + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 20 -justify right \ -highlightthickness 3 .e insert end 012\t45 update @@ -2120,7 +2118,7 @@ test spinbox-6.4 {SpinboxComputeGeometry procedure} -setup { spinbox .e pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 5 + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 6 @@ -2132,7 +2130,7 @@ test spinbox-6.5 {SpinboxComputeGeometry procedure} -setup { spinbox .e -highlightthickness 2 pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 5 + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 5 .e insert end "01234567890" update .e xview 7 @@ -2146,7 +2144,7 @@ test spinbox-6.6 {SpinboxComputeGeometry procedure} -constraints { spinbox .e -highlightthickness 2 pack .e } -body { - .e configure -font {Courier -12} -bd 2 -relief raised -width 10 + .e configure -font {Courier -12} -borderwidth 2 -relief raised -width 10 .e insert end "01234\t67890" update .e xview 3 @@ -2160,7 +2158,7 @@ test spinbox-6.7 {SpinboxComputeGeometry procedure} -constraints { spinbox .e -highlightthickness 2 pack .e } -body { - .e configure -font {Helvetica -24} -bd 3 -relief raised -width 5 + .e configure -font {Helvetica -24} -borderwidth 3 -relief raised -width 5 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] @@ -2173,7 +2171,7 @@ test spinbox-6.8 {SpinboxComputeGeometry procedure} -constraints { spinbox .e -highlightthickness 2 pack .e } -body { - .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 + .e configure -font {Helvetica -24} -borderwidth 3 -relief raised -width 0 .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] @@ -2186,17 +2184,16 @@ test spinbox-6.9 {SpinboxComputeGeometry procedure} -constraints { spinbox .e -highlightthickness 2 pack .e } -body { - .e configure -font {Helvetica -24} -bd 3 -relief raised -width 0 + .e configure -font {Helvetica -24} -borderwidth 3 -relief raised -width 0 update list [winfo reqwidth .e] [winfo reqheight .e] } -cleanup { destroy .e } -result {42 39} - test spinbox-7.1 {InsertChars procedure} -setup { unset -nocomplain contents - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2211,7 +2208,7 @@ test spinbox-7.1 {InsertChars procedure} -setup { test spinbox-7.2 {InsertChars procedure} -setup { unset -nocomplain contents - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2224,7 +2221,7 @@ test spinbox-7.2 {InsertChars procedure} -setup { destroy .e } -result {abcdeXXX abcdeXXX {0.000000 1.000000}} test spinbox-7.3 {InsertChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -2238,7 +2235,7 @@ test spinbox-7.3 {InsertChars procedure} -setup { destroy .e } -result {5 9 5 8} test spinbox-7.4 {InsertChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -2252,7 +2249,7 @@ test spinbox-7.4 {InsertChars procedure} -setup { destroy .e } -result {2 9 2 8} test spinbox-7.5 {InsertChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -2266,7 +2263,7 @@ test spinbox-7.5 {InsertChars procedure} -setup { destroy .e } -result {2 9 2 8} test spinbox-7.6 {InsertChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -2280,7 +2277,7 @@ test spinbox-7.6 {InsertChars procedure} -setup { destroy .e } -result {2 6 2 5} test spinbox-7.7 {InsertChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -xscrollcommand scroll @@ -2292,7 +2289,7 @@ test spinbox-7.7 {InsertChars procedure} -setup { destroy .e } -result {7} test spinbox-7.8 {InsertChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789 @@ -2303,7 +2300,7 @@ test spinbox-7.8 {InsertChars procedure} -setup { destroy .e } -result {4} test spinbox-7.9 {InsertChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 "This is a very long string" @@ -2315,7 +2312,7 @@ test spinbox-7.9 {InsertChars procedure} -setup { destroy .e } -result {7} test spinbox-7.10 {InsertChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 "This is a very long string" @@ -2330,7 +2327,7 @@ test spinbox-7.10 {InsertChars procedure} -setup { test spinbox-7.11 {InsertChars procedure} -constraints { fonts } -setup { - spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 "xyzzy" @@ -2343,7 +2340,7 @@ test spinbox-7.11 {InsertChars procedure} -constraints { test spinbox-8.1 {DeleteChars procedure} -setup { unset -nocomplain contents - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2357,7 +2354,7 @@ test spinbox-8.1 {DeleteChars procedure} -setup { } -result {abe abe {0.000000 1.000000}} test spinbox-8.2 {DeleteChars procedure} -setup { unset -nocomplain contents - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2371,7 +2368,7 @@ test spinbox-8.2 {DeleteChars procedure} -setup { } -result {cde cde {0.000000 1.000000}} test spinbox-8.3 {DeleteChars procedure} -setup { unset -nocomplain contents - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2384,7 +2381,7 @@ test spinbox-8.3 {DeleteChars procedure} -setup { destroy .e } -result {abc abc {0.000000 1.000000}} test spinbox-8.4 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2400,7 +2397,7 @@ test spinbox-8.4 {DeleteChars procedure} -setup { destroy .e } -result {1 6 1 5} test spinbox-8.5 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2416,7 +2413,7 @@ test spinbox-8.5 {DeleteChars procedure} -setup { destroy .e } -result {1 5 1 4} test spinbox-8.6 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2432,7 +2429,7 @@ test spinbox-8.6 {DeleteChars procedure} -setup { destroy .e } -result {1 2 1 5} test spinbox-8.7 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2446,7 +2443,7 @@ test spinbox-8.7 {DeleteChars procedure} -setup { destroy .e } -returnCodes error -result {selection isn't in widget .e} test spinbox-8.8 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2462,7 +2459,7 @@ test spinbox-8.8 {DeleteChars procedure} -setup { destroy .e } -result {3 4 3 8} test spinbox-8.9 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e insert 0 0123456789abcde @@ -2475,7 +2472,7 @@ test spinbox-8.9 {DeleteChars procedure} -setup { destroy .e } -returnCodes error -result {selection isn't in widget .e} test spinbox-8.10 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2491,7 +2488,7 @@ test spinbox-8.10 {DeleteChars procedure} -setup { destroy .e } -result {3 5 5 8} test spinbox-8.11 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2507,7 +2504,7 @@ test spinbox-8.11 {DeleteChars procedure} -setup { destroy .e } -result {3 8 4 8} test spinbox-8.12 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2520,7 +2517,7 @@ test spinbox-8.12 {DeleteChars procedure} -setup { destroy .e } -result {1} test spinbox-8.13 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2533,7 +2530,7 @@ test spinbox-8.13 {DeleteChars procedure} -setup { destroy .e } -result {1} test spinbox-8.14 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2546,7 +2543,7 @@ test spinbox-8.14 {DeleteChars procedure} -setup { destroy .e } -result {4} test spinbox-8.15 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2559,7 +2556,7 @@ test spinbox-8.15 {DeleteChars procedure} -setup { destroy .e } -result {1} test spinbox-8.16 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2572,7 +2569,7 @@ test spinbox-8.16 {DeleteChars procedure} -setup { destroy .e } -result {1} test spinbox-8.17 {DeleteChars procedure} -setup { - spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 10 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2585,7 +2582,7 @@ test spinbox-8.17 {DeleteChars procedure} -setup { destroy .e } -result {4} test spinbox-8.18 {DeleteChars procedure} -setup { - spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -bd 2 + spinbox .e -width 0 -font {Courier -12} -highlightthickness 2 -borderwidth 2 pack .e focus .e } -body { @@ -2609,11 +2606,10 @@ test spinbox-9.1 {SpinboxValueChanged procedure} -setup { trace vdelete x w override } -result {12345 12345} - test spinbox-10.1 {SpinboxSetValue procedure} -constraints fonts -body { set x abcde set y ab - spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 -width 0 + spinbox .e -font {Helvetica -12} -highlightthickness 2 -borderwidth 2 -width 0 pack .e .e configure -textvariable x .e configure -textvariable y @@ -2624,7 +2620,7 @@ test spinbox-10.1 {SpinboxSetValue procedure} -constraints fonts -body { } -result {ab 35} test spinbox-10.2 {SpinboxSetValue procedure, updating selection} -setup { unset -nocomplain x - spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + spinbox .e -font {Helvetica -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -textvariable x @@ -2637,7 +2633,7 @@ test spinbox-10.2 {SpinboxSetValue procedure, updating selection} -setup { } -returnCodes error -result {selection isn't in widget .e} test spinbox-10.3 {SpinboxSetValue procedure, updating selection} -setup { unset -nocomplain x - spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + spinbox .e -font {Helvetica -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -textvariable x @@ -2650,7 +2646,7 @@ test spinbox-10.3 {SpinboxSetValue procedure, updating selection} -setup { } -result {4 7} test spinbox-10.4 {SpinboxSetValue procedure, updating selection} -setup { unset -nocomplain x - spinbox .e -font {Helvetica -12} -highlightthickness 2 -bd 2 + spinbox .e -font {Helvetica -12} -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -textvariable x @@ -2663,7 +2659,7 @@ test spinbox-10.4 {SpinboxSetValue procedure, updating selection} -setup { } -result {4 10} test spinbox-10.5 {SpinboxSetValue procedure, updating display position} -setup { unset -nocomplain x - spinbox .e -highlightthickness 2 -bd 2 + spinbox .e -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -width 10 -font {Courier -12} -textvariable x @@ -2678,7 +2674,7 @@ test spinbox-10.5 {SpinboxSetValue procedure, updating display position} -setup } -result {0} test spinbox-10.6 {SpinboxSetValue procedure, updating display position} -setup { unset -nocomplain x - spinbox .e -highlightthickness 2 -bd 2 + spinbox .e -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -width 10 -font {Courier -12} -textvariable x @@ -2694,7 +2690,7 @@ test spinbox-10.6 {SpinboxSetValue procedure, updating display position} -setup } -result {10} test spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} -setup { unset -nocomplain x - spinbox .e -highlightthickness 2 -bd 2 + spinbox .e -highlightthickness 2 -borderwidth 2 pack .e update } -body { @@ -2709,7 +2705,7 @@ test spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} -setup } -result {3} test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} -setup { unset -nocomplain x - spinbox .e -highlightthickness 2 -bd 2 + spinbox .e -highlightthickness 2 -borderwidth 2 pack .e } -body { .e configure -width 10 -font {Courier -12} -textvariable x @@ -2723,7 +2719,7 @@ test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} -setup } -result {5} test spinbox-11.1 {SpinboxEventProc procedure} -setup { - spinbox .e -highlightthickness 2 -bd 2 -font {Helvetica -12} + spinbox .e -highlightthickness 2 -borderwidth 2 -font {Helvetica -12} pack .e } -body { .e insert 0 abcdefg @@ -2735,10 +2731,10 @@ test spinbox-11.1 {SpinboxEventProc procedure} -setup { test spinbox-11.2 {SpinboxEventProc procedure} -setup { set x {} } -body { - spinbox .e1 -fg #112233 + spinbox .e1 -foreground #112233 rename .e1 .e2 lappend x [winfo children .] - lappend x [.e2 cget -fg] + lappend x [.e2 cget -foreground] destroy .e1 lappend x [info command .e*] [winfo children .] } -cleanup { @@ -2753,9 +2749,8 @@ test spinbox-12.1 {SpinboxCmdDeletedProc procedure} -body { destroy .b } -result {{} {}} - test spinbox-13.1 {GetSpinboxIndex procedure} -setup { - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2772,7 +2767,7 @@ test spinbox-13.2 {GetSpinboxIndex procedure} -body { destroy .e } -returnCodes error -result {bad spinbox index "abogus"} test spinbox-13.3 {GetSpinboxIndex procedure} -setup { - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2785,7 +2780,7 @@ test spinbox-13.3 {GetSpinboxIndex procedure} -setup { destroy .e } -result {1} test spinbox-13.4 {GetSpinboxIndex procedure} -setup { - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2798,7 +2793,7 @@ test spinbox-13.4 {GetSpinboxIndex procedure} -setup { destroy .e } -result {4} test spinbox-13.5 {GetSpinboxIndex procedure} -setup { - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2819,7 +2814,7 @@ test spinbox-13.6 {GetSpinboxIndex procedure} -setup { destroy .e } -returnCodes error -result {bad spinbox index "ebogus"} test spinbox-13.7 {GetSpinboxIndex procedure} -setup { - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2838,7 +2833,7 @@ test spinbox-13.8 {GetSpinboxIndex procedure} -setup { destroy .e } -returnCodes error -result {bad spinbox index "ibogus"} test spinbox-13.9 {GetSpinboxIndex procedure} -setup { - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e } -body { .e insert 0 012345678901234567890 @@ -2855,7 +2850,7 @@ test spinbox-13.10 {GetSpinboxIndex procedure} -constraints unix -body { # On unix, when selection is cleared, spinbox widget's internal # selection range is reset. # Previous settings: - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2875,7 +2870,7 @@ test spinbox-13.11 {GetSpinboxIndex procedure} -constraints win -body { # last selected range. When selection ownership is restored to # spinbox, the old range will be rehighlighted. # Previous settings: - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2893,7 +2888,7 @@ test spinbox-13.11 {GetSpinboxIndex procedure} -constraints win -body { test spinbox-13.12 {GetSpinboxIndex procedure} -constraints unix -body { # Previous settings: - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2910,7 +2905,7 @@ test spinbox-13.12 {GetSpinboxIndex procedure} -constraints unix -body { test spinbox-13.12.1 {GetSpinboxIndex procedure} -constraints unix -body { # Previous settings: - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2927,7 +2922,7 @@ test spinbox-13.12.1 {GetSpinboxIndex procedure} -constraints unix -body { test spinbox-13.13 {GetSpinboxIndex procedure} -constraints win -body { # Previous settings: - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2947,7 +2942,7 @@ test spinbox-13.14 {GetSpinboxIndex procedure} -constraints win -body { # last selected range. When selection ownership is restored to # spinbox, the old range will be rehighlighted. # Previous settings: - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2967,7 +2962,7 @@ test spinbox-13.14.1 {GetSpinboxIndex procedure} -constraints win -body { # last selected range. When selection ownership is restored to # spinbox, the old range will be rehighlighted. # Previous settings: - spinbox .e -font {Courier -12} -width 5 -bd 2 -relief sunken + spinbox .e -font {Courier -12} -width 5 -borderwidth 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 @@ -2992,7 +2987,7 @@ test spinbox-13.15 {GetSpinboxIndex procedure} -body { } -returnCodes error -result {bad spinbox index "@xyz"} test spinbox-13.16 {GetSpinboxIndex procedure} -constraints fonts -body { - spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + spinbox .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2 \ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -3003,7 +2998,7 @@ test spinbox-13.16 {GetSpinboxIndex procedure} -constraints fonts -body { destroy .e } -result {4} test spinbox-13.17 {GetSpinboxIndex procedure} -constraints fonts -body { - spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + spinbox .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2 \ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -3014,7 +3009,7 @@ test spinbox-13.17 {GetSpinboxIndex procedure} -constraints fonts -body { destroy .e } -result {4} test spinbox-13.18 {GetSpinboxIndex procedure} -constraints fonts -body { - spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + spinbox .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2 \ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -3025,7 +3020,7 @@ test spinbox-13.18 {GetSpinboxIndex procedure} -constraints fonts -body { destroy .e } -result {5} test spinbox-13.19 {GetSpinboxIndex procedure} -constraints fonts -body { - spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + spinbox .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2 \ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -3036,7 +3031,7 @@ test spinbox-13.19 {GetSpinboxIndex procedure} -constraints fonts -body { destroy .e } -result {8} test spinbox-13.20 {GetSpinboxIndex procedure} -constraints fonts -body { - spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + spinbox .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2 \ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -3047,7 +3042,7 @@ test spinbox-13.20 {GetSpinboxIndex procedure} -constraints fonts -body { destroy .e } -result {9} test spinbox-13.21 {GetSpinboxIndex procedure} -body { - spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + spinbox .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2 \ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -3067,7 +3062,7 @@ test spinbox-13.22 {GetSpinboxIndex procedure} -setup { destroy .e } -returnCodes error -result {bad spinbox index "1xyz"} test spinbox-13.23 {GetSpinboxIndex procedure} -body { - spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + spinbox .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2 \ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -3078,7 +3073,7 @@ test spinbox-13.23 {GetSpinboxIndex procedure} -body { destroy .e } -result {0} test spinbox-13.24 {GetSpinboxIndex procedure} -body { - spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + spinbox .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2 \ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -3089,7 +3084,7 @@ test spinbox-13.24 {GetSpinboxIndex procedure} -body { destroy .e } -result {12} test spinbox-13.25 {GetSpinboxIndex procedure} -body { - spinbox .e -width 5 -relief sunken -highlightthickness 2 -bd 2 \ + spinbox .e -width 5 -relief sunken -highlightthickness 2 -borderwidth 2 \ -font {Courier -12} pack .e .e insert 0 012345678901234567890 @@ -3140,7 +3135,6 @@ test spinbox-15.1 {SpinboxLostSelection} -body { destroy .e } -result {Text Text} - test spinbox-16.1 {SpinboxVisibleRange procedure} -constraints fonts -body { spinbox .e -width 10 -font {Helvetica -12} pack .e @@ -3157,7 +3151,6 @@ test spinbox-16.2 {SpinboxVisibleRange procedure} -body { destroy .e } -result {0.000000 1.000000} - test spinbox-17.1 {SpinboxUpdateScrollbar procedure} -body { spinbox .e -width 10 -xscrollcommand scroll -font {Courier -12} pack .e @@ -3206,7 +3199,6 @@ test spinbox-17.4 {SpinboxUpdateScrollbar procedure} -setup { "thisisnotacommand 0.0 1.0" (horizontal scrolling command executed by .e)}} - test spinbox-18.1 {Spinbox widget vs hiding} -setup { spinbox .e } -body { @@ -3520,7 +3512,6 @@ test spinbox-19.16 {spinbox widget validation} -setup { destroy .e } -result {1 {.e -1 -1 abcd abcd {} all forced}} - test spinbox-19.17 {spinbox widget validation} -setup { unset -nocomplain ::e ::vVals } -body { @@ -3688,7 +3679,6 @@ test spinbox-20.12 {spinbox config, -format specifier does something} -setup { destroy .e } -result {0 01 3 003} - test spinbox-21.1 {spinbox button, out of range checking} -body { spinbox .e -from -10 -to 20 -increment 2 set out {} diff --git a/tests/text.test b/tests/text.test index 5089bb1..648fc3d 100644 --- a/tests/text.test +++ b/tests/text.test @@ -62,8 +62,8 @@ test text-1.5 {configuration option: "bd"} -setup { pack .t update } -body { - .t configure -bd 4 - .t cget -bd + .t configure -borderwidth 4 + .t cget -borderwidth } -cleanup { destroy .t } -result {4} @@ -72,7 +72,7 @@ test text-1.6 {configuration option: "bd"} -setup { pack .t update } -body { - .t configure -bd foo + .t configure -borderwidth foo } -cleanup { destroy .t } -match glob -returnCodes {error} -result {*} @@ -81,8 +81,8 @@ test text-1.7 {configuration option: "bg"} -setup { pack .t update } -body { - .t configure -bg blue - .t cget -bg + .t configure -background blue + .t cget -background } -cleanup { destroy .t } -result {blue} @@ -91,7 +91,7 @@ test text-1.8 {configuration option: "bg"} -setup { pack .t update } -body { - .t configure -bg #xx + .t configure -background #xx } -cleanup { destroy .t } -match glob -returnCodes {error} -result {*} @@ -176,8 +176,8 @@ test text-1.17 {configuration option: "fg"} -setup { pack .t update } -body { - .t configure -fg red - .t cget -fg + .t configure -foreground red + .t cget -foreground } -cleanup { destroy .t } -result {red} @@ -186,7 +186,7 @@ test text-1.18 {configuration option: "fg"} -setup { pack .t update } -body { - .t configure -fg stupid + .t configure -foreground stupid } -cleanup { destroy .t } -match glob -returnCodes {error} -result {*} @@ -849,7 +849,6 @@ test text-1.86 {configuration option: "insertunfocussed"} -setup { destroy .t } -result {bad insertunfocussed "gorp": must be hollow, none, or solid} - test text-2.1 {Tk_TextCmd procedure} -body { text } -returnCodes {error} -result {wrong # args: should be "text pathName ?-option value ...?"} @@ -868,20 +867,20 @@ test text-2.4 {Tk_TextCmd procedure} -body { destroy .t } -result 0 test text-2.5 {Tk_TextCmd procedure} -body { - text .t -bd 2 -fg red + text .t -borderwidth 2 -foreground red } -cleanup { destroy .t } -returnCodes ok -result {.t} test text-2.6 {Tk_TextCmd procedure} -body { - text .t -bd 2 -fg red - list [lindex [.t config -bd] 4] [lindex [.t config -fg] 4] + text .t -borderwidth 2 -foreground red + list [lindex [.t config -borderwidth] 4] [lindex [.t config -foreground] 4] } -cleanup { destroy .t } -result {2 red} test text-2.7 {Tk_TextCmd procedure} -constraints { win } -body { - catch {destroy .t} + destroy .t text .t .t tag cget sel -relief } -cleanup { @@ -890,7 +889,7 @@ test text-2.7 {Tk_TextCmd procedure} -constraints { test text-2.8 {Tk_TextCmd procedure} -constraints { aqua } -body { - catch {destroy .t} + destroy .t text .t .t tag cget sel -relief } -cleanup { @@ -899,7 +898,7 @@ test text-2.8 {Tk_TextCmd procedure} -constraints { test text-2.9 {Tk_TextCmd procedure} -constraints { unix } -body { - catch {destroy .t} + destroy .t text .t .t tag cget sel -relief } -cleanup { @@ -911,7 +910,6 @@ test text-2.10 {Tk_TextCmd procedure} -body { destroy .t } -result {.t Text} - test text-3.1 {TextWidgetCmd procedure, basics} -setup { text .t } -body { @@ -973,13 +971,12 @@ test text-5.3 {TextWidgetCmd procedure, "cget" option} -setup { test text-5.4 {TextWidgetCmd procedure, "cget" option} -setup { text .t } -body { - .t configure -bd 17 - .t cget -bd + .t configure -borderwidth 17 + .t cget -borderwidth } -cleanup { destroy .t } -result {17} - test text-6.1 {TextWidgetCmd procedure, "compare" option} -setup { text .t } -body { @@ -1181,7 +1178,6 @@ test text-7.4 {TextWidgetCmd procedure, "debug" option} -setup { destroy .t } -result {0} - test text-8.1 {TextWidgetCmd procedure, "delete" option} -setup { text .t } -body { @@ -1551,7 +1547,6 @@ test text-8.26 {TextWidgetCmd procedure, "replace" option crash} -setup { destroy .tt } -result {} - test text-9.1 {TextWidgetCmd procedure, "get" option} -setup { text .t } -body { @@ -1996,7 +1991,6 @@ Line 7" destroy .t } -result {Grl} - test text-10.1 {TextWidgetCmd procedure, "count" option} -setup { text .t } -body { @@ -2634,7 +2628,6 @@ test text-10.39 {TextWidgetCmd procedure, "count" option} -setup { destroy .t } -result {2 6 2 5} - test text-11.1 {counting with tag priority eliding} -setup { text .t -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack append . .t {top expand fill} @@ -2819,7 +2812,6 @@ test text-11.9 {counting with tag priority eliding} -setup { destroy .t } -result {1 0 0 1 0 2.0 4.0 4.0 4.0 3.0 3.0 3.0 2.0 1.0 1.0} - test text-12.1 {TextWidgetCmd procedure, "index" option} -setup { text .t } -body { @@ -2862,7 +2854,6 @@ Line 7" destroy .t } -result 1.2 - test text-13.1 {TextWidgetCmd procedure, "insert" option} -setup { [text .t] insert 1.0 "Line 1 aefghijklm @@ -3201,7 +3192,6 @@ test text-14.20 {ConfigureText procedure} -setup { destroy .top } -result {20x10+0+0 15x8+0+0 15x8+0+0} - test text-15.1 {TextWorldChanged procedure, spacing options} -constraints { fonts } -body { @@ -3217,20 +3207,18 @@ test text-15.1 {TextWorldChanged procedure, spacing options} -constraints { destroy .t } -result {140 160 170 150} - test text-16.1 {TextEventProc procedure} -body { - text .tx1 -bg #543210 + text .tx1 -background #543210 rename .tx1 .tx2 set x {} lappend x [winfo exists .tx1] - lappend x [.tx2 cget -bg] + lappend x [.tx2 cget -background] destroy .tx1 lappend x [info command .tx*] [winfo exists .tx1] [winfo exists .tx2] } -cleanup { destroy .txt1 } -result {1 #543210 {} 0 0} - test text-17.1 {TextCmdDeletedProc procedure} -body { text .tx1 rename .tx1 {} @@ -3257,7 +3245,6 @@ test text-17.2 {TextCmdDeletedProc procedure, disabling -setgrid} -constraints { destroy .top } -result {20x10+ 150x140+} - test text-18.1 {InsertChars procedure} -body { text .t .t insert 2.0 abcd\n @@ -3349,7 +3336,6 @@ test text-18.7 {InsertChars procedure, inserting on top visible line} -setup { destroy .t } -result {1.56} - test text-19.1 {DeleteChars procedure} -body { text .t .t get 1.0 end @@ -3544,7 +3530,7 @@ test text-19.15 {DeleteChars procedure, updates affecting topIndex} -setup { test text-19.16 {DeleteChars procedure, updates affecting topIndex} -setup { toplevel .top text .top.t -width 6 -height 10 -wrap word - frame .top.f -width 200 -height 20 -relief raised -bd 2 + frame .top.f -width 200 -height 20 -relief raised -borderwidth 2 pack .top.f .top.t -side left wm geometry .top +0+0 update @@ -3559,7 +3545,6 @@ test text-19.16 {DeleteChars procedure, updates affecting topIndex} -setup { destroy .top } -result {2.3 2.0} - test text-20.1 {TextFetchSelection procedure} -setup { text .t -width 20 -height 10 pack append . .t {top expand fill} @@ -3645,7 +3630,6 @@ test text-20.5 {TextFetchSelection procedure, long selections} -setup { destroy .t } -result {1} - test text-21.1 {TkTextLostSelection procedure} -constraints unix -setup { text .t .t insert 1.0 "Line 1" @@ -3699,7 +3683,6 @@ test text-21.4 {TkTextLostSelection procedure} -body { destroy .t } -result {abc abc} - test text-22.1 {TextSearchCmd procedure, argument parsing} -body { text .t .t search - @@ -3850,7 +3833,7 @@ test text-22.21 {TextSearchCmd procedure, pattern case conversion} -body { test text-22.22 {TextSearchCmd procedure, bad regular expression pattern} -body { text .t .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" - .t search -regexp a( 1.0 + .t search -regexp "a\(" 1.0 } -cleanup { destroy .t } -returnCodes {error} -result {couldn't compile regular expression pattern: parentheses () not balanced} @@ -3993,7 +3976,7 @@ test text-22.41 {TextSearchCmd procedure, firstChar and lastChar} -setup { } -body { .top.t insert 1.0 "This is a line\nand this is another" .top.t insert end "\nand this is yet another" - frame .top.f -width 20 -height 20 -bd 2 -relief raised + frame .top.f -width 20 -height 20 -borderwidth 2 -relief raised .top.t window create 2.5 -window .top.f .top.t search his 2.6 } -cleanup { @@ -4006,7 +3989,7 @@ test text-22.42 {TextSearchCmd procedure, firstChar and lastChar} -setup { } -body { .top.t insert 1.0 "This is a line\nand this is another" .top.t insert end "\nand this is yet another" - frame .top.f -width 20 -height 20 -bd 2 -relief raised + frame .top.f -width 20 -height 20 -borderwidth 2 -relief raised .top.t window create 2.5 -window .top.f .top.t search this 2.6 } -cleanup { @@ -4019,7 +4002,7 @@ test text-22.43 {TextSearchCmd procedure, firstChar and lastChar} -setup { } -body { .top.t insert 1.0 "This is a line\nand this is another" .top.t insert end "\nand this is yet another" - frame .top.f -width 20 -height 20 -bd 2 -relief raised + frame .top.f -width 20 -height 20 -borderwidth 2 -relief raised .top.t window create 2.5 -window .top.f .top.t search is 2.6 } -cleanup { @@ -4032,7 +4015,7 @@ test text-22.44 {TextSearchCmd procedure, firstChar and lastChar} -setup { } -body { .top.t insert 1.0 "This is a line\nand this is another" .top.t insert end "\nand this is yet another" - frame .top.f -width 20 -height 20 -bd 2 -relief raised + frame .top.f -width 20 -height 20 -borderwidth 2 -relief raised .top.t window create 2.5 -window .top.f .top.t search his 2.7 } -cleanup { @@ -4045,7 +4028,7 @@ test text-22.45 {TextSearchCmd procedure, firstChar and lastChar} -setup { } -body { .top.t insert 1.0 "This is a line\nand this is another" .top.t insert end "\nand this is yet another" - frame .top.f -width 20 -height 20 -bd 2 -relief raised + frame .top.f -width 20 -height 20 -borderwidth 2 -relief raised .top.t window create 2.5 -window .top.f .top.t search -backwards "his is another" 2.6 } -cleanup { @@ -4058,7 +4041,7 @@ test text-22.46 {TextSearchCmd procedure, firstChar and lastChar} -setup { } -body { .top.t insert 1.0 "This is a line\nand this is another" .top.t insert end "\nand this is yet another" - frame .top.f -width 20 -height 20 -bd 2 -relief raised + frame .top.f -width 20 -height 20 -borderwidth 2 -relief raised .top.t window create 2.5 -window .top.f .top.t search -backwards "his is" 2.6 } -cleanup { @@ -4081,7 +4064,7 @@ test text-22.48 {TextSearchCmd procedure, firstChar and lastChar} -body { test text-22.49 {TextSearchCmd procedure, firstChar and lastChar} -body { text .t .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" - catch {destroy .t} + destroy .t text .t2 list [.t2 search a 1.0] [.t2 search -backward a 1.0] } -cleanup { @@ -4133,10 +4116,10 @@ test text-22.54 {TextSearchCmd procedure, checking stopIndex} -body { } -result {2.13 {} {} {}} test text-22.55 {TextSearchCmd procedure, embedded windows and index/count} -setup { text .t - frame .t.f1 -width 20 -height 20 -relief raised -bd 2 - frame .t.f2 -width 20 -height 20 -relief raised -bd 2 - frame .t.f3 -width 20 -height 20 -relief raised -bd 2 - frame .t.f4 -width 20 -height 20 -relief raised -bd 2 + frame .t.f1 -width 20 -height 20 -relief raised -borderwidth 2 + frame .t.f2 -width 20 -height 20 -relief raised -borderwidth 2 + frame .t.f3 -width 20 -height 20 -relief raised -borderwidth 2 + frame .t.f4 -width 20 -height 20 -relief raised -borderwidth 2 set result "" } -body { .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" @@ -5555,9 +5538,8 @@ test text-22.225 {TextSearchCmd, strict limits} -body { destroy .t } -result {} - test text-23.1 {TkTextGetTabs procedure} -setup { - text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + text .t -highlightthickness 0 -borderwidth 0 -relief flat -padx 0 -width 100 pack .t } -body { .t insert end "1\t2\t3\t4\t55.5" @@ -5566,7 +5548,7 @@ test text-23.1 {TkTextGetTabs procedure} -setup { destroy .t } -returnCodes {error} -result {unmatched open brace in list} test text-23.2 {TkTextGetTabs procedure} -setup { - text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + text .t -highlightthickness 0 -borderwidth 0 -relief flat -padx 0 -width 100 pack .t } -body { .t insert end "1\t2\t3\t4\t55.5" @@ -5575,7 +5557,7 @@ test text-23.2 {TkTextGetTabs procedure} -setup { destroy .t } -returnCodes {error} -result {bad screen distance "xyz"} test text-23.3 {TkTextGetTabs procedure} -setup { - text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + text .t -highlightthickness 0 -borderwidth 0 -relief flat -padx 0 -width 100 pack .t } -body { .t insert end "1\t2\t3\t4\t55.5" @@ -5586,7 +5568,7 @@ test text-23.3 {TkTextGetTabs procedure} -setup { destroy .t } -result {100 200} test text-23.4 {TkTextGetTabs procedure} -setup { - text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + text .t -highlightthickness 0 -borderwidth 0 -relief flat -padx 0 -width 100 pack .t } -body { .t insert end "1\t2\t3\t4\t55.5" @@ -5600,7 +5582,7 @@ test text-23.4 {TkTextGetTabs procedure} -setup { destroy .t } -result {100 200 300 400} test text-23.5 {TkTextGetTabs procedure} -setup { - text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + text .t -highlightthickness 0 -borderwidth 0 -relief flat -padx 0 -width 100 pack .t } -body { .t insert end "1\t2\t3\t4\t55.5" @@ -5614,7 +5596,7 @@ test text-23.5 {TkTextGetTabs procedure} -setup { destroy .t } -result {105 205 305 405} test text-23.6 {TkTextGetTabs procedure} -setup { - text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + text .t -highlightthickness 0 -borderwidth 0 -relief flat -padx 0 -width 100 pack .t } -body { .t insert end "1\t2\t3\t4\t55.5" @@ -5623,7 +5605,7 @@ test text-23.6 {TkTextGetTabs procedure} -setup { destroy .t } -returnCodes {error} -result {bad tab alignment "lork": must be left, right, center, or numeric} test text-23.7 {TkTextGetTabs procedure} -setup { - text .t -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 + text .t -highlightthickness 0 -borderwidth 0 -relief flat -padx 0 -width 100 pack .t } -body { .t insert end "1\t2\t3\t4\t55.5" @@ -5632,7 +5614,6 @@ test text-23.7 {TkTextGetTabs procedure} -setup { destroy .t } -returnCodes {error} -result {bad screen distance "!44"} - test text-24.1 {TextDumpCmd procedure, bad args} -body { pack [text .t] .t insert 1.0 "One Line" @@ -5908,7 +5889,6 @@ test text-25.1 {text widget vs hidden commands} -body { expr {$x eq $y} } -result {1} - test text-26.1 {bug fix - 1642} -body { pack [text .t] .t insert end "line 1\n" @@ -5922,7 +5902,6 @@ test text-26.1 {bug fix - 1642} -body { destroy .t } -result {2.6} - test text-27.1 {TextEditCmd procedure, argument parsing} -body { pack [text .t] .t edit @@ -6121,7 +6100,6 @@ test text-28.1 {bug fix - 624372, ControlUtfProc long lines} -body { destroy .t } -result {} - test text-29.1 {tabs - must be positive and must be increasing} -body { pack [text .t -wrap none] .t configure -tabs {0} @@ -6155,7 +6133,6 @@ test text-29.4 {tabs - must be positive and must be increasing} -body { destroy .t } -result {1} - test text-30.1 {repeated insert and scroll} -body { pack [text .t] for {set i 0} {$i < 30} {incr i} { @@ -6201,7 +6178,6 @@ test text-30.4 {repeated insert and scroll} -body { destroy .t } -result {1} - test text-31.1 {peer widgets} -body { toplevel .top pack [text .t] @@ -6480,7 +6456,6 @@ test text-31.19 {peer widgets} -body { destroy .t } -returnCodes {error} -result {text doesn't contain any characters tagged with "sel"} - test text-32.1 {line heights on creation} -setup { text .t proc makeText {} { @@ -6518,7 +6493,6 @@ test text-32.1 {line heights on creation} -setup { destroy .t } -result {1} - test text-33.1 {TextWidgetCmd procedure, "peer" option} -setup { text .t } -body { @@ -6787,7 +6761,6 @@ test text-35.3 {widget dump -command destroys widget} -setup { destroy .t } -result {ok} - test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup { proc bgerror {m} {set ::my_error $m} set ::my_error {} diff --git a/tests/textBTree.test b/tests/textBTree.test index 41b3d98..db3b13e 100644 --- a/tests/textBTree.test +++ b/tests/textBTree.test @@ -130,7 +130,6 @@ test btree-1.11 {insertion past end of last line} -body { .t get 1.0 1000000.0 } -result "Line 1\nLine 2\nLine 3ABC\n" - test btree-2.1 {basic deletions} -body { .t delete 1.0 100000.0 .t insert 1.0 "Line 1\nLine 2\nLine 3" @@ -258,7 +257,6 @@ test btree-2.21 {deleting with negative range} -body { .t get 1.0 1000000.0 } -result "Line 1\nLine 2\nLine 3\n" - test btree-3.1 {inserting with tags} -body { setup .t insert 1.0 XXX @@ -290,7 +288,6 @@ test btree-3.6 {inserting with tags} -body { list [.t tag ranges x] [.t tag ranges y] } -result {{1.1 1.2 1.5 1.13 3.2 3.6} {1.5 1.6}} - test btree-4.1 {deleting with tags} -body { setup .t delete 1.6 1.9 @@ -332,7 +329,6 @@ test btree-4.8 {deleting with tags} -body { list [.t tag ranges x] [.t tag ranges y] } -result {{1.1 1.2 2.2 2.6} {}} - test btree-5.1 {very large inserts, with tags} -setup { set bigText1 {} for {set i 0} {$i < 10} {incr i} { @@ -362,7 +358,6 @@ test btree-5.3 {very large inserts, with tags} -body { [.t get 198.0 198.100] } -result {{1.1 1.2 1.5 201.5 202.2 202.6} {1.5 1.6} {Text forlonger line 199} {longer line 2}} - test btree-6.1 {very large deletes, with tags} -setup { set bigText2 {} for {set i 0} {$i < 200} {incr i} { @@ -450,7 +445,6 @@ test btree-6.6 {very large deletes, with tags} -setup { list [.t tag ranges x] [.t tag ranges y] } -result {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}} - test btree-7.1 {tag addition and removal} -setup { .t delete 1.0 end .t tag remove x 1.0 end @@ -584,7 +578,6 @@ test btree-7.11 {tag addition and removal} -setup { .t tag ranges x } -result {1.2 4.0} - test btree-8.1 {tag addition and removal, weird ranges} -body { .t delete 1.0 100000.0 .t tag delete x @@ -642,7 +635,6 @@ test btree-8.8 {tag addition and removal, weird ranges} -body { .t tag ranges x } -result {} - test btree-9.1 {tag names} -body { setup .t tag names @@ -690,7 +682,6 @@ test btree-9.4 {lots of tag names} -setup { .t tag names 150.2 } -result {foo ThisOne {x space} s t} - test btree-10.1 {basic mark facilities} -body { msetup list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3] @@ -706,7 +697,6 @@ test btree-10.3 {basic mark facilities} -body { list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3] } -result {{current insert l1 m1 m2 m3 next x} 1.2 1.8 2.11} - test btree-11.1 {marks and inserts} -body { msetup .t insert 1.1 abcde @@ -738,7 +728,6 @@ test btree-11.6 {marks and inserts} -body { list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } -result {1.2 1.2 1.6 1.6 4.0 4.11} - test btree-12.1 {marks and deletes} -body { msetup .t delete 1.3 1.5 @@ -779,7 +768,6 @@ test btree-12.7 {marks and deletes} -body { list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3] } -result {1.2 1.11 1.5 1.5 1.9 1.9} - test btree-13.1 {tag searching} -setup { .t delete 1.0 100000.0 } -body { @@ -841,7 +829,6 @@ test btree-13.8 {tag searching} -setup { } -result {190.3 191.2} destroy .t - test btree-14.1 {check tag presence} -setup { destroy .t text .t @@ -873,7 +860,6 @@ test btree-14.1 {check tag presence} -setup { destroy .t } -result {x y z} - test btree-15.1 {rebalance with empty node} -setup { destroy .t } -body { @@ -886,7 +872,6 @@ test btree-15.1 {rebalance with empty node} -setup { destroy .t } -result "1\n2\n3\n4\n5\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23\n" - test btree-16.1 {add tag does not push root above level 0} -setup { destroy .t text .t @@ -1053,7 +1038,6 @@ test btree-16.13 {StartSearchBack boundary case} -setup { destroy .t } -result {1.0 1.4} - test btree-17.1 {remove tag does not push root down} -setup { destroy .t text .t @@ -1124,7 +1108,6 @@ test btree-17.6 {text deletion pushes root from level 3 to level 0} -setup { destroy .t } -result {1000.1 1000.10} - test btree-18.1 {tag search back, no tag} -setup { destroy .t text .t diff --git a/tests/textDisp.test b/tests/textDisp.test index 8e99eff..66ade17 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -14,14 +14,14 @@ namespace import -force tcltest::test # The procedure below is used as the scrolling command for the text; # it just saves the scrolling information in a variable "scrollInfo". -proc scroll args { +proc scroll {args} { global scrollInfo set scrollInfo $args } # The procedure below is used to generate errors during scrolling commands. -proc scrollError args { +proc scrollError {args} { error "scrolling error" } @@ -36,7 +36,7 @@ option add *Text.highlightThickness 2 # because some window managers don't allow the overall width of a window # to get very narrow. -catch {destroy .f .t} +destroy .f .t frame .f -width 100 -height 20 pack append . .f left @@ -92,7 +92,7 @@ if {([winfo rooty .] < 50) || ([winfo rootx .] < 50)} { test textDisp-0.1 {double tag elide transition} { # Example from tkchat crash. For some reason can only # get this test case to crash when first. - catch {destroy .top} + destroy .top pack [text .top] foreach val {0 1 2 3} { @@ -122,7 +122,7 @@ test textDisp-0.1 {double tag elide transition} { test textDisp-0.2 {double tag elide transition} { # Example from tkchat crash. For some reason can only # get this test case to crash when first. - catch {destroy .top} + destroy .top pack [text .top] foreach val {0 1 2 3} { @@ -150,7 +150,7 @@ test textDisp-0.2 {double tag elide transition} { } {} test textDisp-0.3 {double tag elide transition} { - catch {destroy .txt} + destroy .txt pack [text .txt] # Note that TRAFFIC should have a higher priority than SYSTEM # in terms of the tag effects. @@ -162,7 +162,7 @@ test textDisp-0.3 {double tag elide transition} { } {} test textDisp-0.4 {double tag elide transition} { - catch {destroy .txt} + destroy .txt pack [text .txt] # Note that TRAFFIC should have a higher priority than SYSTEM # in terms of the tag effects. @@ -175,7 +175,7 @@ test textDisp-0.4 {double tag elide transition} { } {} test textDisp-0.5 {double tag elide transition} { - catch {destroy .txt} + destroy .txt pack [text .txt] .txt tag configure WELCOME -elide 1 .txt tag configure SYSTEM -elide 0 @@ -221,7 +221,7 @@ test textDisp-1.2 {GetStyle procedure, wrapmode} {textfonts} { lappend result [.t bbox 2.20] .t tag add y 1.end 2.2 lappend result [.t bbox 2.20] -} [list [list 5 [expr {5+2*$fixedHeight}] 7 $fixedHeight] [list 40 [expr {5+2*$fixedHeight}] 7 $fixedHeight] {}] +} [list [list 5 [expr {5 + (2 * $fixedHeight)}] 7 $fixedHeight] [list 40 [expr {5 + (2 * $fixedHeight)}] 7 $fixedHeight] {}] .t tag delete x y test textDisp-2.1 {LayoutDLine, basics} { @@ -229,7 +229,7 @@ test textDisp-2.1 {LayoutDLine, basics} { .t delete 1.0 end .t insert 1.0 "This is some sample text for testing." list [.t bbox 1.19] [.t bbox 1.20] -} [list [list [expr 5 + $fixedWidth * 19] 5 $fixedWidth $fixedHeight] [list 5 [expr 5 + $fixedHeight] $fixedWidth $fixedHeight]] +} [list [list [expr {5 + ($fixedWidth * 19)}] 5 $fixedWidth $fixedHeight] [list 5 [expr {5 + $fixedHeight}] $fixedWidth $fixedHeight]] test textDisp-2.2 {LayoutDLine, basics} {textfonts} { .t configure -wrap char .t delete 1.0 end @@ -304,7 +304,7 @@ test textDisp-2.11 {LayoutDLine, newline width} {textfonts} { .t delete 1.0 end .t insert 1.0 "a\nbb\nccc\ndddd" list [.t bbox 2.2] [.t bbox 3.3] -} [list [list 19 [expr {$fixedDiff + 18}] 126 $fixedHeight] [list 26 [expr {2*$fixedDiff + 31}] 119 $fixedHeight]] +} [list [list 19 [expr {$fixedDiff + 18}] 126 $fixedHeight] [list 26 [expr {(2 * $fixedDiff) + 31}] 119 $fixedHeight]] test textDisp-2.12 {LayoutDLine, justification} {textfonts} { .t configure -wrap char .t delete 1.0 end @@ -313,7 +313,7 @@ test textDisp-2.12 {LayoutDLine, justification} {textfonts} { .t tag add x 1.0 end .t tag add y 3.0 3.2 list [.t bbox 1.0] [.t bbox 2.0] [.t bbox 4.0] [.t bbox 4.2] -} [list [list 75 5 70 $fixedHeight] [list 71 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 64 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] [list 78 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] +} [list [list 75 5 70 $fixedHeight] [list 71 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 64 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight] [list 78 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight]] test textDisp-2.13 {LayoutDLine, justification} {textfonts} { .t configure -wrap char .t delete 1.0 end @@ -322,7 +322,7 @@ test textDisp-2.13 {LayoutDLine, justification} {textfonts} { .t tag add x 1.0 end .t tag add y 3.0 3.2 list [.t bbox 1.0] [.t bbox 2.0] [.t bbox 4.0] [.t bbox 4.2] -} [list [list 145 5 0 $fixedHeight] [list 138 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 124 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] [list 138 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] +} [list [list 145 5 0 $fixedHeight] [list 138 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 124 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight] [list 138 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight]] test textDisp-2.14 {LayoutDLine, justification} {textfonts} { .t configure -wrap char .t delete 1.0 end @@ -333,7 +333,7 @@ test textDisp-2.14 {LayoutDLine, justification} {textfonts} { .t tag add y 3.0 4.0 .t tag raise y list [.t bbox 2.0] [.t bbox 3.0] [.t bbox 3.end] [.t bbox 4.0] -} [list [list 71 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 131 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 145 [expr {2*$fixedDiff + 31}] 0 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] +} [list [list 71 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 131 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight] [list 145 [expr {(2 * $fixedDiff) + 31}] 0 $fixedHeight] [list 5 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight]] test textDisp-2.15 {LayoutDLine, justification} {textfonts} { .t configure -wrap char .t delete 1.0 end @@ -344,7 +344,7 @@ test textDisp-2.15 {LayoutDLine, justification} {textfonts} { .t tag add y 3.0 4.0 .t tag lower y list [.t bbox 2.0] [.t bbox 3.0] [.t bbox 3.end] [.t bbox 4.0] -} [list [list 71 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 68 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 82 [expr {2*$fixedDiff + 31}] 63 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] +} [list [list 71 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 68 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight] [list 82 [expr {(2 * $fixedDiff) + 31}] 63 $fixedHeight] [list 5 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight]] test textDisp-2.16 {LayoutDLine, justification} {textfonts} { .t configure -wrap word .t delete 1.0 end @@ -353,7 +353,7 @@ test textDisp-2.16 {LayoutDLine, justification} {textfonts} { .t tag add x 1.1 1.20 .t tag add x 1.21 1.end list [.t bbox 1.0] [.t bbox 1.20] [.t bbox 1.36] [.t bbox 2.0] -} [list [list 5 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 43 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] +} [list [list 5 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 43 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight] [list 5 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight]] test textDisp-2.17 {LayoutDLine, justification} {textfonts} { .t configure -wrap word .t delete 1.0 end @@ -361,7 +361,7 @@ test textDisp-2.17 {LayoutDLine, justification} {textfonts} { .t tag configure x -justify center .t tag add x 1.20 list [.t bbox 1.0] [.t bbox 1.20] [.t bbox 1.36] [.t bbox 2.0] -} [list [list 5 5 7 $fixedHeight] [list 19 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] +} [list [list 5 5 7 $fixedHeight] [list 19 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight] [list 5 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight]] test textDisp-2.18 {LayoutDLine, justification} {textfonts} { .t configure -wrap none .t delete 1.0 end @@ -373,7 +373,7 @@ test textDisp-2.18 {LayoutDLine, justification} {textfonts} { .t tag add y 3.0 .t xview scroll 5 units list [.t bbox 2.0] [.t bbox 3.0] -} [list [list 26 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 40 [expr {2*$fixedDiff + 31}] 7 $fixedHeight]] +} [list [list 26 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 40 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight]] .t tag delete x .t tag delete y test textDisp-2.19 {LayoutDLine, margins} {textfonts} { @@ -383,7 +383,7 @@ test textDisp-2.19 {LayoutDLine, margins} {textfonts} { .t tag configure x -lmargin1 20 -lmargin2 40 -rmargin 15 .t tag add x 1.0 end list [.t bbox 1.0] [.t bbox 1.12] [.t bbox 1.13] [.t bbox 2.0] -} [list [list 25 5 7 $fixedHeight] [list 109 5 36 $fixedHeight] [list 45 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 25 [expr {5*$fixedDiff + 70}] 7 $fixedHeight]] +} [list [list 25 5 7 $fixedHeight] [list 109 5 36 $fixedHeight] [list 45 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 25 [expr {(5 * $fixedDiff) + 70}] 7 $fixedHeight]] test textDisp-2.20 {LayoutDLine, margins} {textfonts} { .t configure -wrap word .t delete 1.0 end @@ -394,7 +394,7 @@ test textDisp-2.20 {LayoutDLine, margins} {textfonts} { .t tag add x 1.0 end .t tag add y 1.13 list [.t bbox 1.0] [.t bbox 1.13] [.t bbox 1.30] [.t bbox 2.0] -} [list [list 25 5 7 $fixedHeight] [list 10 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 15 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 25 [expr {3*$fixedDiff + 44}] 7 $fixedHeight]] +} [list [list 25 5 7 $fixedHeight] [list 10 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 15 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight] [list 25 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight]] test textDisp-2.21 {LayoutDLine, margins} {textfonts} { .t configure -wrap word .t delete 1.0 end @@ -402,7 +402,7 @@ test textDisp-2.21 {LayoutDLine, margins} {textfonts} { .t tag configure x -lmargin1 80 -lmargin2 80 -rmargin 100 .t tag add x 1.0 end list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 1.2] -} [list [list 85 5 60 $fixedHeight] [list 85 [expr {$fixedDiff + 18}] 60 $fixedHeight] [list 85 [expr {2*$fixedDiff + 31}] 60 $fixedHeight]] +} [list [list 85 5 60 $fixedHeight] [list 85 [expr {$fixedDiff + 18}] 60 $fixedHeight] [list 85 [expr {(2 * $fixedDiff) + 31}] 60 $fixedHeight]] .t tag delete x .t tag delete y test textDisp-2.22 {LayoutDLine, spacing options} {textfonts} { @@ -529,7 +529,7 @@ test textDisp-3.1 {different character sizes} {textfonts} { .t tag add big 1.5 1.10 .t tag add big 2.11 2.14 list [.t bbox 1.1] [.t bbox 1.6] [.t dlineinfo 1.0] [.t dlineinfo 3.0] -} [list [list 12 [expr {5+$ascentDiff}] 7 $fixedHeight] [list 52 5 13 27] [list 5 5 114 27 [font metrics $bigFont -ascent]] [list 5 [expr {2* $fixedDiff + 85}] 35 $fixedHeight [expr {$fixedDiff + 10}]]] +} [list [list 12 [expr {5 + $ascentDiff}] 7 $fixedHeight] [list 52 5 13 27] [list 5 5 114 27 [font metrics $bigFont -ascent]] [list 5 [expr {(2 * $fixedDiff) + 85}] 35 $fixedHeight [expr {$fixedDiff + 10}]]] .t configure -wrap char test textDisp-4.1 {UpdateDisplayInfo, basic} {textfonts} { .t delete 1.0 end @@ -539,7 +539,7 @@ test textDisp-4.1 {UpdateDisplayInfo, basic} {textfonts} { .t insert 2.0 "New Line 2" update list [.t bbox 1.0] [.t bbox 2.0] [.t bbox 3.0] $tk_textRelayout -} [list [list 5 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] 2.0] +} [list [list 5 5 7 $fixedHeight] [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight] 2.0] test textDisp-4.2 {UpdateDisplayInfo, re-use tail of text line} {textfonts} { .t delete 1.0 end .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" @@ -549,7 +549,7 @@ test textDisp-4.2 {UpdateDisplayInfo, re-use tail of text line} {textfonts} { .t insert 2.0 X update list [.t bbox 2.0] [.t bbox x] [.t bbox 3.0] $tk_textRelayout -} [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 12 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] {2.0 2.20}] +} [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 12 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight] [list 5 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight] {2.0 2.20}] test textDisp-4.3 {UpdateDisplayInfo, tail of text line shifts} {textfonts} { .t delete 1.0 end .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" @@ -558,7 +558,7 @@ test textDisp-4.3 {UpdateDisplayInfo, tail of text line shifts} {textfonts} { .t delete 2.2 update list [.t bbox 2.0] [.t bbox x] [.t bbox 3.0] $tk_textRelayout -} [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] [list 5 [expr {3*$fixedDiff + 44}] 7 $fixedHeight] {2.0 2.20}] +} [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] [list 5 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight] [list 5 [expr {(3 * $fixedDiff) + 44}] 7 $fixedHeight] {2.0 2.20}] .t mark unset x test textDisp-4.4 {UpdateDisplayInfo, wrap-mode "none"} {textfonts} { .t configure -wrap none @@ -566,9 +566,9 @@ test textDisp-4.4 {UpdateDisplayInfo, wrap-mode "none"} {textfonts} { .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" update list [.t bbox 2.0] [.t bbox 2.25] [.t bbox 3.0] $tk_textRelayout -} [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] {} [list 5 [expr {2*$fixedDiff + 31}] 7 $fixedHeight] {1.0 2.0 3.0}] +} [list [list 5 [expr {$fixedDiff + 18}] 7 $fixedHeight] {} [list 5 [expr {(2 * $fixedDiff) + 31}] 7 $fixedHeight] {1.0 2.0 3.0}] test textDisp-4.5 {UpdateDisplayInfo, tiny window} {textfonts} { - if {$tcl_platform(platform) == "windows"} { + if {$tcl_platform(platform) eq "windows"} { wm overrideredirect . 1 } wm geom . 103x$height @@ -578,8 +578,8 @@ test textDisp-4.5 {UpdateDisplayInfo, tiny window} {textfonts} { .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3" update list [.t bbox 2.0] [.t bbox 2.1] [.t bbox 3.0] $tk_textRelayout -} [list [list 5 [expr {$fixedDiff + 18}] 1 $fixedHeight] {} [list 5 [expr {2*$fixedDiff + 31}] 1 $fixedHeight] {1.0 2.0 3.0}] -if {$tcl_platform(platform) == "windows"} { +} [list [list 5 [expr {$fixedDiff + 18}] 1 $fixedHeight] {} [list 5 [expr {(2 * $fixedDiff) + 31}] 1 $fixedHeight] {1.0 2.0 3.0}] +if {$tcl_platform(platform) eq "windows"} { wm overrideredirect . 0 } test textDisp-4.6 {UpdateDisplayInfo, tiny window} { @@ -590,7 +590,7 @@ test textDisp-4.6 {UpdateDisplayInfo, tiny window} { # the overrideredirect on "." confuses the window manager and # causes subsequent tests to fail. - if {$tcl_platform(platform) == "windows"} { + if {$tcl_platform(platform) eq "windows"} { wm overrideredirect . 1 } frame .f2 -width 20 -height 100 @@ -606,7 +606,7 @@ test textDisp-4.6 {UpdateDisplayInfo, tiny window} { update set x } [list [list 5 5 1 1] {} 1.0] -catch {destroy .f2} +destroy .f2 .t configure -borderwidth 0 -wrap char wm geom . {} update @@ -618,7 +618,7 @@ test textDisp-4.7 {UpdateDisplayInfo, filling in extra vertical space} { # the overrideredirect on "." confuses the window manager and # causes subsequent tests to fail. - if {$tcl_platform(platform) == "windows"} { + if {$tcl_platform(platform) eq "windows"} { wm overrideredirect . 1 } .t delete 1.0 end @@ -648,7 +648,7 @@ test textDisp-4.9 {UpdateDisplayInfo, filling in extra vertical space} {textfont update .t delete 15.0 end list [.t bbox 7.0] [.t bbox 12.0] -} [list [list 3 [expr {2*$fixedDiff + 29}] 7 $fixedHeight] [list 3 [expr {7*$fixedDiff + 94}] 7 $fixedHeight]] +} [list [list 3 [expr {(2 * $fixedDiff) + 29}] 7 $fixedHeight] [list 3 [expr {(7 * $fixedDiff) + 94}] 7 $fixedHeight]] test textDisp-4.10 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\nLine 6 is such a long line that it wraps around.\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17" @@ -670,7 +670,7 @@ test textDisp-4.11 {UpdateDisplayInfo, filling in extra vertical space} { test textDisp-4.12 {UpdateDisplayInfo, filling in extra vertical space} { .t delete 1.0 end .t insert end "1\n2\n3\n4\n5\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16" - button .b -text "Test" -bd 2 -highlightthickness 2 + button .b -text "Test" -borderwidth 2 -highlightthickness 2 .t window create 3.end -window .b .t yview moveto 1 update @@ -783,7 +783,7 @@ test textDisp-4.22 {UpdateDisplayInfo, no horizontal scrolling except for -wrap update .t configure -wrap word list [.t bbox 2.0] [.t bbox 2.16] -} [list [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight] [list 10 [expr {2*$fixedDiff + 29}] 7 $fixedHeight]] +} [list [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight] [list 10 [expr {(2 * $fixedDiff) + 29}] 7 $fixedHeight]] test textDisp-4.23 {UpdateDisplayInfo, no horizontal scrolling except for -wrap none} {textfonts} { .t configure -wrap none .t delete 1.0 end @@ -800,10 +800,10 @@ test textDisp-5.1 {DisplayDLine, handling of spacing} {textfonts} { .t insert 1.0 "abcdefghijkl\nmnopqrstuvwzyz" .t tag configure spacing -spacing1 8 -spacing3 2 .t tag add spacing 1.0 end - frame .t.f1 -width 10 -height 4 -bg black - frame .t.f2 -width 10 -height 4 -bg black - frame .t.f3 -width 10 -height 4 -bg black - frame .t.f4 -width 10 -height 4 -bg black + frame .t.f1 -width 10 -height 4 -background black + frame .t.f2 -width 10 -height 4 -background black + frame .t.f3 -width 10 -height 4 -background black + frame .t.f4 -width 10 -height 4 -background black .t window create 1.3 -window .t.f1 -align top .t window create 1.7 -window .t.f2 -align center .t window create 2.1 -window .t.f3 -align bottom @@ -811,7 +811,7 @@ test textDisp-5.1 {DisplayDLine, handling of spacing} {textfonts} { update list [winfo geometry .t.f1] [winfo geometry .t.f2] \ [winfo geometry .t.f3] [winfo geometry .t.f4] -} [list 10x4+24+11 10x4+55+[expr {$fixedDiff/2 + 15}] 10x4+10+[expr {2*$fixedDiff + 43}] 10x4+76+[expr {2*$fixedDiff + 40}]] +} [list 10x4+24+11 10x4+55+[expr {($fixedDiff / 2) + 15}] 10x4+10+[expr {(2 * $fixedDiff) + 43}] 10x4+76+[expr {(2 * $fixedDiff) + 40}]] .t tag delete spacing # Although the following test produces a useful result, its main @@ -820,7 +820,7 @@ test textDisp-5.1 {DisplayDLine, handling of spacing} {textfonts} { test textDisp-5.2 {DisplayDLine, line resizes during display} { .t delete 1.0 end - frame .t.f -width 20 -height 20 -bd 2 -relief raised + frame .t.f -width 20 -height 20 -borderwidth 2 -relief raised bind .t.f <Configure> {.t.f configure -width 30 -height 30} .t window create insert -window .t.f update @@ -878,7 +878,7 @@ test textDisp-6.4 {scrolling in DisplayText, scrolls interfere} { } {{2.0 2.20 2.40 2.60 4.0 4.20} {2.0 2.20 2.40 2.60 4.0 4.20 6.0}} test textDisp-6.5 {scrolling in DisplayText, scroll source obscured} {nonPortable} { .t configure -wrap char - frame .f2 -bg red + frame .f2 -background red place .f2 -in .t -relx 0.5 -rely 0.5 -relwidth 0.5 -relheight 0.5 .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, a couple of times" @@ -894,9 +894,9 @@ test textDisp-6.5 {scrolling in DisplayText, scroll source obscured} {nonPortabl test textDisp-6.6 {scrolling in DisplayText, Expose events after scroll} {unix nonPortable} { # this test depends on all of the expose events being handled at once .t configure -wrap char - frame .f2 -bg #ff0000 + frame .f2 -background #ff0000 place .f2 -in .t -relx 0.2 -rely 0.5 -relwidth 0.5 -relheight 0.5 - .t configure -bd 2 -relief raised + .t configure -borderwidth 2 -relief raised .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, a couple of times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { @@ -908,7 +908,7 @@ test textDisp-6.6 {scrolling in DisplayText, Expose events after scroll} {unix n update list $tk_textRelayout $tk_textRedraw } {{1.0 9.0 10.0} {borders 1.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0}} -.t configure -bd 0 +.t configure -borderwidth 0 test textDisp-6.7 {DisplayText, vertical scrollbar updates} { .t configure -wrap char .t delete 1.0 end @@ -926,7 +926,7 @@ test textDisp-6.8 {DisplayText, vertical scrollbar updates} { } update ; .t count -update -ypixels 1.0 end ; update set scrollInfo -} [list 0.0 [expr {10.0/13}]] +} [list 0.0 [expr {10.0 / 13}]] .t configure -yscrollcommand {} -xscrollcommand scroll test textDisp-6.9 {DisplayText, horizontal scrollbar updates} { .t configure -wrap none @@ -938,20 +938,20 @@ test textDisp-6.9 {DisplayText, horizontal scrollbar updates} { .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx update set scrollInfo -} [list 0.0 [expr {4.0/11}]] +} [list 0.0 [expr {4.0 / 11}]] # The following group of tests is marked non-portable because # they result in a lot of extra redisplay under Ultrix. I don't # know why this is so. -.t configure -bd 2 -relief raised -wrap char +.t configure -borderwidth 2 -relief raised -wrap char .t delete 1.0 end .t insert 1.0 "Line 1 is so long that it wraps around, a couple of times" foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} { .t insert end "\nLine $i" } test textDisp-7.1 {TkTextRedrawRegion} {nonPortable} { - frame .f2 -bg #ff0000 + frame .f2 -background #ff0000 place .f2 -in .t -relx 0.2 -relwidth 0.6 -rely 0.22 -relheight 0.55 update destroy .f2 @@ -959,7 +959,7 @@ test textDisp-7.1 {TkTextRedrawRegion} {nonPortable} { list $tk_textRelayout $tk_textRedraw } {{} {1.40 2.0 3.0 4.0 5.0 6.0}} test textDisp-7.2 {TkTextRedrawRegion} {nonPortable} { - frame .f2 -bg #ff0000 + frame .f2 -background #ff0000 place .f2 -in .t -relx 0 -relwidth 0.5 -rely 0 -relheight 0.5 update destroy .f2 @@ -967,7 +967,7 @@ test textDisp-7.2 {TkTextRedrawRegion} {nonPortable} { list $tk_textRelayout $tk_textRedraw } {{} {borders 1.0 1.20 1.40 2.0 3.0}} test textDisp-7.3 {TkTextRedrawRegion} {nonPortable} { - frame .f2 -bg #ff0000 + frame .f2 -background #ff0000 place .f2 -in .t -relx 0.5 -relwidth 0.5 -rely 0.5 -relheight 0.5 update destroy .f2 @@ -975,7 +975,7 @@ test textDisp-7.3 {TkTextRedrawRegion} {nonPortable} { list $tk_textRelayout $tk_textRedraw } {{} {borders 4.0 5.0 6.0 7.0 8.0}} test textDisp-7.4 {TkTextRedrawRegion} {nonPortable} { - frame .f2 -bg #ff0000 + frame .f2 -background #ff0000 place .f2 -in .t -relx 0.4 -relwidth 0.2 -rely 0 -relheight 0.2 \ -bordermode ignore update @@ -984,7 +984,7 @@ test textDisp-7.4 {TkTextRedrawRegion} {nonPortable} { list $tk_textRelayout $tk_textRedraw } {{} {borders 1.0 1.20}} test textDisp-7.5 {TkTextRedrawRegion} {nonPortable} { - frame .f2 -bg #ff0000 + frame .f2 -background #ff0000 place .f2 -in .t -relx 0.4 -relwidth 0.2 -rely 1.0 -relheight 0.2 \ -anchor s -bordermode ignore update @@ -993,7 +993,7 @@ test textDisp-7.5 {TkTextRedrawRegion} {nonPortable} { list $tk_textRelayout $tk_textRedraw } {{} {borders 7.0 8.0}} test textDisp-7.6 {TkTextRedrawRegion} {nonPortable} { - frame .f2 -bg #ff0000 + frame .f2 -background #ff0000 place .f2 -in .t -relx 0 -relwidth 0.2 -rely 0.55 -relheight 0.2 \ -anchor w -bordermode ignore update @@ -1002,7 +1002,7 @@ test textDisp-7.6 {TkTextRedrawRegion} {nonPortable} { list $tk_textRelayout $tk_textRedraw } {{} {borders 3.0 4.0 5.0}} test textDisp-7.7 {TkTextRedrawRegion} {nonPortable} { - frame .f2 -bg #ff0000 + frame .f2 -background #ff0000 place .f2 -in .t -relx 1.0 -relwidth 0.2 -rely 0.55 -relheight 0.2 \ -anchor e -bordermode ignore update @@ -1013,7 +1013,7 @@ test textDisp-7.7 {TkTextRedrawRegion} {nonPortable} { test textDisp-7.8 {TkTextRedrawRegion} {nonPortable} { .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2\nLine 3\nLine 4\nLine 5\nLine 6\n" - frame .f2 -bg #ff0000 + frame .f2 -background #ff0000 place .f2 -in .t -relx 0.0 -relwidth 0.4 -rely 0.35 -relheight 0.4 \ -anchor nw -bordermode ignore update @@ -1021,7 +1021,7 @@ test textDisp-7.8 {TkTextRedrawRegion} {nonPortable} { update list $tk_textRelayout $tk_textRedraw } {{} {borders 4.0 5.0 6.0 7.0 eof}} -.t configure -bd 0 +.t configure -borderwidth 0 test textDisp-8.1 {TkTextChanged: redisplay whole lines} {textfonts} { .t configure -wrap word @@ -1034,7 +1034,7 @@ test textDisp-8.1 {TkTextChanged: redisplay whole lines} {textfonts} { .t delete 2.36 2.38 update list $tk_textRelayout $tk_textRedraw [.t bbox 2.32] -} [list {2.0 2.18 2.38} {2.0 2.18 2.38} [list 101 [expr {2*$fixedDiff + 29}] 7 $fixedHeight]] +} [list {2.0 2.18 2.38} {2.0 2.18 2.38} [list 101 [expr {(2 * $fixedDiff) + 29}] 7 $fixedHeight]] .t configure -wrap char test textDisp-8.2 {TkTextChanged, redisplay whole lines} { .t delete 1.0 end @@ -1263,16 +1263,16 @@ test textDisp-10.1 {TkTextRelayoutWindow} { .t delete 1.0 end .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4" update - .t configure -bg black + .t configure -background black update list $tk_textRelayout $tk_textRedraw } {{1.0 2.0 2.20 3.0 3.20 4.0} {borders 1.0 2.0 2.20 3.0 3.20 4.0 eof}} -.t configure -bg [lindex [.t configure -bg] 3] -catch {destroy .top} +.t configure -background [lindex [.t configure -background] 3] +destroy .top test textDisp-10.2 {TkTextRelayoutWindow} { toplevel .top -width 300 -height 200 wm geometry .top +0+0 - text .top.t -font $fixedFont -width 20 -height 10 -relief raised -bd 2 + text .top.t -font $fixedFont -width 20 -height 10 -relief raised -borderwidth 2 place .top.t -x 0 -y 0 -width 20 -height 20 .top.t insert end "First line" .top.t see insert @@ -1281,7 +1281,7 @@ test textDisp-10.2 {TkTextRelayoutWindow} { update .top.t index @0,0 } {1.0} -catch {destroy .top} +destroy .top .t delete 1.0 end .t insert end "Line 1" @@ -1382,7 +1382,7 @@ test textDisp-11.12 {TkTextSetYView, wrapped line is off-screen} { } {2.0 10.20} .t delete 10.0 11.0 test textDisp-11.13 {TkTestSetYView, partially visible last line} { - catch {destroy .top} + destroy .top toplevel .top wm geometry .top +0+0 text .top.t -width 20 -height 5 @@ -1404,7 +1404,7 @@ test textDisp-11.13 {TkTestSetYView, partially visible last line} { # have changed, and the old '2.0 {5.0 6.0}' is quite wrong. list [.top.t index @0,0] $tk_textRedraw } {1.0 5.0} -catch {destroy .top} +destroy .top toplevel .top wm geometry .top +0+0 text .top.t -width 30 -height 3 @@ -1539,7 +1539,7 @@ test textDisp-13.7 {TkTextSeeCmd procedure} {textfonts} { lappend x [.t bbox 30.38] .t see 30.20 lappend x [.t bbox 30.20] -} [list [list 73 [expr {5*$fixedDiff + 68}] 7 $fixedHeight] [list 3 [expr {5*$fixedDiff + 68}] 7 $fixedHeight] [list 3 [expr {5*$fixedDiff + 68}] 7 $fixedHeight] [list 73 [expr {5*$fixedDiff + 68}] 7 $fixedHeight]] +} [list [list 73 [expr {(5 * $fixedDiff) + 68}] 7 $fixedHeight] [list 3 [expr {(5 * $fixedDiff) + 68}] 7 $fixedHeight] [list 3 [expr {(5 * $fixedDiff) + 68}] 7 $fixedHeight] [list 73 [expr {(5 * $fixedDiff) + 68}] 7 $fixedHeight]] test textDisp-13.8 {TkTextSeeCmd procedure} {textfonts} { .t xview moveto 0 .t yview moveto 0 @@ -1554,7 +1554,7 @@ test textDisp-13.8 {TkTextSeeCmd procedure} {textfonts} { lappend x [.t bbox 30.65] .t see 30.90 lappend x [.t bbox 30.90] -} [list [list 73 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight] [list 136 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight] [list 73 [expr {9*$fixedDiff/2 + 64}] 7 $fixedHeight]] +} [list [list 73 [expr {((9 * $fixedDiff) / 2) + 64}] 7 $fixedHeight] [list 136 [expr {((9 * $fixedDiff) / 2) + 64}] 7 $fixedHeight] [list 136 [expr {((9 * $fixedDiff) / 2) + 64}] 7 $fixedHeight] [list 73 [expr {((9 * $fixedDiff) / 2) + 64}] 7 $fixedHeight]] test textDisp-13.9 {TkTextSeeCmd procedure} {textfonts} { wm geom . [expr $width-2]x$height .t xview moveto 0 @@ -1570,12 +1570,12 @@ test textDisp-13.9 {TkTextSeeCmd procedure} {textfonts} { lappend x [.t bbox 30.65] .t see 30.90 lappend x [.t bbox 30.90] -} [list [list 74 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight] [list 138 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight] [list 138 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight] [list 74 [expr {9*$fixedDiff/2 + 66}] 7 $fixedHeight]] +} [list [list 74 [expr {((9 * $fixedDiff) / 2) + 66}] 7 $fixedHeight] [list 138 [expr {((9 * $fixedDiff) / 2) + 66}] 7 $fixedHeight] [list 138 [expr {((9 * $fixedDiff) / 2) + 66}] 7 $fixedHeight] [list 74 [expr {((9 * $fixedDiff) / 2) + 66}] 7 $fixedHeight]] test textDisp-13.10 {TkTextSeeCmd procedure} {} { # SF Bug 641778 set w .tsee destroy $w - text $w -font {Helvetica 8 normal} -bd 16 + text $w -font "Helvetica 8 normal" -borderwidth 16 $w insert end Hello $w see end set res [$w bbox end] @@ -1593,7 +1593,7 @@ test textDisp-14.1 {TkTextXviewCmd procedure} { .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview moveto .5 .t xview -} [list 0.5 [expr {6./7.}]] +} [list 0.5 [expr {6. / 7.}]] .t configure -wrap char test textDisp-14.2 {TkTextXviewCmd procedure} { .t delete 1.0 end @@ -1628,7 +1628,7 @@ test textDisp-14.7 {TkTextXviewCmd procedure} { .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview moveto .3 .t xview -} [list [expr {118.0/392}] [expr {258.0/392}]] +} [list [expr {118.0 / 392}] [expr {258.0 / 392}]] test textDisp-14.8 {TkTextXviewCmd procedure} { .t delete 1.0 end .t insert end xxxxxxxxx\n @@ -1636,7 +1636,7 @@ test textDisp-14.8 {TkTextXviewCmd procedure} { .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview moveto -.4 .t xview -} [list 0.0 [expr {5.0/14}]] +} [list 0.0 [expr {5.0 / 14}]] test textDisp-14.9 {TkTextXviewCmd procedure} { .t delete 1.0 end .t insert end xxxxxxxxx\n @@ -1644,7 +1644,7 @@ test textDisp-14.9 {TkTextXviewCmd procedure} { .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" .t xview m 1.4 .t xview -} [list [expr {9.0/14}] 1.0] +} [list [expr {9.0 / 14}] 1.0] test textDisp-14.10 {TkTextXviewCmd procedure} { list [catch {.t xview scroll a} msg] $msg } {1 {wrong # args: should be ".t xview scroll number units|pages|pixels"}} @@ -1765,7 +1765,7 @@ test textDisp-15.8 {Scrolling near end of window} { # Should scroll and should not crash! .tf.f.t yview scroll 1 unit # Check that it has scrolled - set res [.tf.f.t index @0,[expr [winfo height .tf.f.t] - 15]] + set res [.tf.f.t index @0,[expr {[winfo height .tf.f.t] - 15}]] destroy .tf set res } {12.0} @@ -1779,12 +1779,13 @@ for {set i 2} {$i <= 200} {incr i} { .t tag add big 100.0 105.0 .t insert 151.end { has a lot of extra text, so that it wraps around on the screen several times over.} .t insert 153.end { also has enoug extra text to wrap.} -update ; .t count -update -ypixels 1.0 end +update +.t count -update -ypixels 1.0 end test textDisp-16.1 {TkTextYviewCmd procedure} { .t yview 21.0 set x [.t yview] .t yview 1.0 - list [expr {int([lindex $x 0]*100)}] [expr {int ([lindex $x 1] * 100)}] + list [expr { int ([lindex $x 0] * 100)}] [expr { int ([lindex $x 1] * 100)}] } {9 14} test textDisp-16.2 {TkTextYviewCmd procedure} { list [catch {.t yview 2 3} msg] $msg @@ -1839,8 +1840,8 @@ test textDisp-16.15 {TkTextYviewCmd procedure, "moveto" option} { .t index @0,0 } {151.60} test textDisp-16.16 {TkTextYviewCmd procedure, "moveto" option} {textfonts} { - set count [expr {5 * $bigHeight + 150 * $fixedHeight}] - set extra [expr {0.04 * double($fixedDiff * 150) / double($count)}] + set count [expr {(5 * $bigHeight) + (150 * $fixedHeight)}] + set extra [expr {(0.04 * $fixedDiff * 150.0) / (1.0 * $count)}] .t yview moveto [expr {.753 - $extra}] .t index @0,0 } {151.60} @@ -1849,7 +1850,7 @@ test textDisp-16.17 {TkTextYviewCmd procedure, "moveto" option} { .t index @0,0 } {151.80} test textDisp-16.18 {TkTextYviewCmd procedure, "moveto" roundoff} {textfonts} { - catch {destroy .top1} + destroy .top1 toplevel .top1 wm geometry .top1 +0+0 text .top1.t -height 3 -width 4 -wrap none -setgrid 1 -padx 6 \ @@ -1861,7 +1862,7 @@ test textDisp-16.18 {TkTextYviewCmd procedure, "moveto" roundoff} {textfonts} { set result [.top1.t yview] destroy .top1 set result -} [list [expr {1.0/3}] [expr {5.0/6}]] +} [list [expr {1.0 / 3}] [expr {5.0 / 6}]] test textDisp-16.19 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll a} msg] $msg } {1 {wrong # args: should be ".t yview scroll number units|pages|pixels"}} @@ -1922,7 +1923,7 @@ test textDisp-16.28 {TkTextYviewCmd procedure, "scroll" option, forward pages} { .t yview 98.0 update .t yview scroll 1 page - set res [expr int([.t index @0,0])] + set res [expr { int ([.t index @0,0])}] if {$fixedDiff > 1} { incr res -1 } @@ -1958,7 +1959,7 @@ test textDisp-16.33 {TkTextYviewCmd procedure} { list [catch {.t yview bad_arg 1 2} msg] $msg } {1 {bad option "bad_arg": must be moveto or scroll}} test textDisp-16.34 {TkTextYviewCmd procedure} { - set res {} + set res [list] .t yview 1.0 lappend res [format %.12g [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]] @@ -1981,13 +1982,13 @@ test textDisp-16.34 {TkTextYviewCmd procedure} { test textDisp-16.35 {TkTextYviewCmd procedure} { set res {} .t yview 1.0 - lappend res [expr {round([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] + lappend res [expr { round ([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] .t yview scroll 13 pixels - lappend res [expr {round([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] + lappend res [expr { round ([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] .t yview scroll -4 pixels - lappend res [expr {round([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] + lappend res [expr { round ([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] .t yview scroll -9 pixels - lappend res [expr {round([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] + lappend res [expr { round ([lindex [.t yview] 0] * [.t count -ypixels 1.0 end])}] } {0 13 9 0} test textDisp-16.36 {TkTextYviewCmd procedure} { set res {} @@ -2093,7 +2094,7 @@ test textDisp-18.1 {GetXView procedure} { .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx update set scrollInfo -} [list 0.0 [expr {4.0/11}]] +} [list 0.0 [expr {4.0 / 11}]] test textDisp-18.2 {GetXView procedure} { .t configure -wrap char .t delete 1.0 end @@ -2127,7 +2128,7 @@ test textDisp-18.5 {GetXView procedure} { .t xview scroll 31 units update set scrollInfo -} [list [expr {31.0/55}] [expr {51.0/55}]] +} [list [expr {31.0 / 55}] [expr {51.0 / 55}]] test textDisp-18.6 {GetXView procedure} { .t configure -wrap none .t delete 1.0 end @@ -2148,7 +2149,7 @@ test textDisp-18.6 {GetXView procedure} { .t configure -wrap none update lappend x $scrollInfo -} [list [list [expr {31.0/56}] [expr {51.0/56}]] {0.0 1.0} {0.0 1.0} [list 0.0 [expr {5.0/14}]]] +} [list [list [expr {31.0 / 56}] [expr {51.0 / 56}]] {0.0 1.0} {0.0 1.0} [list 0.0 [expr {5.0 / 14}]]] test textDisp-18.7 {GetXView procedure} { .t configure -wrap none .t delete 1.0 end @@ -2205,7 +2206,9 @@ test textDisp-19.2 {GetYView procedure} { test textDisp-19.3 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end - update; after 10 ; update + update + after 10 + update set scrollInfo "unchanged" .t insert 1.0 "Line 1\nLine 2 is so long that it wraps around\nLine 3" update @@ -2222,7 +2225,7 @@ test textDisp-19.4 {GetYView procedure} { } update set scrollInfo -} [list 0.0 [expr {70.0/91}]] +} [list 0.0 [expr {70.0 / 91}]] test textDisp-19.5 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end @@ -2231,7 +2234,8 @@ test textDisp-19.5 {GetYView procedure} { .t insert end "\nLine $i" } .t insert 2.end " is really quite long; in fact it's so long that it wraps three times" - update ; after 100 + update + after 100 set x $scrollInfo } {0.0 0.625} test textDisp-19.6 {GetYView procedure} { @@ -2255,7 +2259,9 @@ test textDisp-19.7 {GetYView procedure} { } .t insert 2.end " is really quite long; in fact it's so long that it wraps three times" .t yview 2.26 - update; after 1; update + update + after 1 + update set x $scrollInfo } {0.125 0.75} test textDisp-19.8 {GetYView procedure} { @@ -2281,7 +2287,7 @@ test textDisp-19.9 {GetYView procedure} { .t yview 3.0 update set scrollInfo -} [list [expr {4.0/30}] 0.8] +} [list [expr {4.0 / 30}] 0.8] test textDisp-19.10 {GetYView procedure} { .t configure -wrap char .t delete 1.0 end @@ -2292,7 +2298,7 @@ test textDisp-19.10 {GetYView procedure} { .t yview 11.0 update set scrollInfo -} [list [expr {1.0/3}] 1.0] +} [list [expr {1.0 / 3}] 1.0] test textDisp-19.10.1 {Widget manipulation causes height miscount} { .t configure -wrap char .t delete 1.0 end @@ -2456,34 +2462,36 @@ test textDisp-19.11.24 {TextWidgetCmd procedure, "index +/-displaylines"} { } {10.5 12.5 12.5 10.5 10.5 12.5 11.5} .t tag remove elide 1.0 end test textDisp-19.12 {GetYView procedure, partially visible last line} { - catch {destroy .top} + destroy .top toplevel .top wm geometry .top +0+0 text .top.t -width 40 -height 5 -font $fixedFont pack .top.t -expand yes -fill both .top.t insert end "Line 1\nLine 2\nLine 3\nLine 4\nLine 5" # Need to wait for asychronous calculations to complete. - update ; after 10 + update + after 10 scan [wm geom .top] %dx%d twidth theight - wm geom .top ${twidth}x[expr $theight - 3] + wm geom .top ${twidth}x[expr {$theight - 3}] update .top.t yview -} [list 0.0 [expr {(5.0 * $fixedHeight - 3.0)/ (5.0 * $fixedHeight)}]] +} [list 0.0 [expr {((5.0 * $fixedHeight) - 3.0) / (5.0 * $fixedHeight)}]] test textDisp-19.13 {GetYView procedure, partially visible last line} {textfonts} { - catch {destroy .top} + destroy .top toplevel .top wm geometry .top +0+0 text .top.t -width 40 -height 5 -font $fixedFont pack .top.t -expand yes -fill both .top.t insert end "Line 1\nLine 2\nLine 3\nLine 4 has enough text to wrap around at least once" # Need to wait for asychronous calculations to complete. - update ; after 10 + update + after 10 scan [wm geom .top] %dx%d twidth theight - wm geom .top ${twidth}x[expr $theight - 3] + wm geom .top ${twidth}x[expr {$theight - 3}] update .top.t yview -} [list 0.0 [expr {(5.0 * $fixedHeight - 3.0)/ (5.0 * $fixedHeight)}]] -catch {destroy .top} +} [list 0.0 [expr {((5.0 * $fixedHeight) - 3.0) / (5.0 * $fixedHeight)}]] +destroy .top test textDisp-19.14 {GetYView procedure} { .t configure -wrap word .t delete 1.0 end @@ -2494,8 +2502,11 @@ test textDisp-19.14 {GetYView procedure} { .t insert end "\nThis last line wraps around four " .t insert end "times with a bit left on the last line." # Need to update so everything is calculated. - update ; .t count -update -ypixels 1.0 end - update ; after 10 ; update + update + .t count -update -ypixels 1.0 end + update + after 10 + update set scrollInfo "unchanged" .t mark set insert 3.0 .t tag configure x -background red @@ -2542,8 +2553,10 @@ test textDisp-19.16 {count -ypixels} { .t insert end "\nThis last line wraps around four " .t insert end "times with a bit left on the last line." # Need to update so everything is calculated. - update ; .t count -update -ypixels 1.0 end ; update - set res {} + update + .t count -update -ypixels 1.0 end + update + set res [list] lappend res \ [.t count -ypixels 1.0 end] \ [.t count -update -ypixels 1.0 end] \ @@ -2551,7 +2564,7 @@ test textDisp-19.16 {count -ypixels} { [.t count -ypixels 15.0 "16.0 displaylineend +1c"] \ [.t count -ypixels 16.0 "16.0 displaylineend +1c"] \ [.t count -ypixels "16.0 +1 displaylines" "16.0 +4 displaylines +3c"] -} [list [expr {260 + 20 * $fixedDiff}] [expr {260 + 20 * $fixedDiff}] $fixedHeight [expr {2*$fixedHeight}] $fixedHeight [expr {3*$fixedHeight}]] +} [list [expr {260 + (20 * $fixedDiff)}] [expr {260 + (20 * $fixedDiff)}] $fixedHeight [expr {2 * $fixedHeight}] $fixedHeight [expr {3 * $fixedHeight}]] .t delete 1.0 end .t insert end "Line 1" for {set i 2} {$i <= 200} {incr i} { @@ -2569,34 +2582,34 @@ test textDisp-20.2 {FindDLine} {textfonts} { .t yview 100.0 .t yview -pickplace 53.0 list [.t dlineinfo 50.0] [.t dlineinfo 50.14] [.t dlineinfo 50.15] -} [list [list 3 [expr {-1 - $fixedDiff/2}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {-1 - $fixedDiff/2}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {12 + $fixedDiff/2}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] +} [list [list 3 [expr {-1 - ($fixedDiff / 2)}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {-1 - ($fixedDiff / 2)}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {12 + ($fixedDiff / 2)}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] test textDisp-20.3 {FindDLine} {textfonts} { .t yview 100.0 .t yview 49.0 list [.t dlineinfo 50.0] [.t dlineinfo 50.20] [.t dlineinfo 57.0] -} [list [list 3 [expr {$fixedDiff + 16}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {2*$fixedDiff + 29}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] +} [list [list 3 [expr {$fixedDiff + 16}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {(2 * $fixedDiff) + 29}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] test textDisp-20.4 {FindDLine} {textfonts} { .t yview 100.0 .t yview 42.0 list [.t dlineinfo 50.0] [.t dlineinfo 50.20] [.t dlineinfo 50.40] -} [list [list 3 [expr {8*$fixedDiff + 107}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {9*$fixedDiff + 120}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] +} [list [list 3 [expr {(8 * $fixedDiff) + 107}] 105 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {(9 * $fixedDiff) + 120}] 140 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] .t config -wrap none test textDisp-20.5 {FindDLine} {textfonts} { .t yview 100.0 .t yview 48.0 list [.t dlineinfo 50.0] [.t dlineinfo 50.20] [.t dlineinfo 50.40] -} [list [list 3 [expr {3+2*$fixedHeight}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {3+2*$fixedHeight}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {3+2*$fixedHeight}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] +} [list [list 3 [expr {3 + (2 * $fixedHeight)}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {3 + (2 * $fixedHeight)}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {3 + (2 * $fixedHeight)}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] .t config -wrap word test textDisp-21.1 {TkTextPixelIndex} {textfonts} { .t yview 48.0 list [.t index @-10,-10] [.t index @6,6] [.t index @22,6] \ - [.t index @102,6] [.t index @38,[expr {$fixedHeight * 4 + 3}]] [.t index @44,67] + [.t index @102,6] [.t index @38,[expr {($fixedHeight * 4) + 3}]] [.t index @44,67] } {48.0 48.0 48.2 48.7 50.40 50.40} .t insert end \n test textDisp-21.2 {TkTextPixelIndex} {textfonts} { .t yview 195.0 - list [.t index @11,[expr {$fixedHeight * 5 + 5}]] [.t index @11,[expr {$fixedHeight * 6 + 5}]] [.t index @11,[expr {$fixedHeight * 7 + 5}]] \ + list [.t index @11,[expr {($fixedHeight * 5) + 5}]] [.t index @11,[expr {($fixedHeight * 6) + 5}]] [.t index @11,[expr {($fixedHeight * 7) + 5}]] \ [.t index @11,1002] } {197.1 198.1 199.1 201.0} test textDisp-21.3 {TkTextPixelIndex, horizontal scrolling} {textfonts} { @@ -2614,8 +2627,7 @@ test textDisp-21.4 {count -displaylines regression} { Use the Up (cursor) key to scroll up one line at a time. At the second press, the cursor either gets locked or jumps several lines. Connect with Tkcon. The command -.u count -displaylines \ -3.10 2.173 +.u count -displaylines 3.10 2.173 should give answer -1; it gives me 5. Using 8.5a4 (ActiveState beta 4) under Linux. No problem with ActiveState beta 3. @@ -2623,7 +2635,7 @@ Using 8.5a4 (ActiveState beta 4) under Linux. No problem with ActiveState beta toplevel .tt pack [text .tt.u] -side right -.tt.u configure -width 30 -height 27 -wrap word -bg #FFFFFF +.tt.u configure -width 30 -height 27 -wrap word -background "#FFFFFF" .tt.u insert end $message .tt.u mark set insert 3.10 tkwait visibility .tt.u @@ -2648,41 +2660,41 @@ test textDisp-22.1 {TkTextCharBbox} {textfonts} { .t yview 48.0 list [.t bbox 47.2] [.t bbox 48.0] [.t bbox 50.5] [.t bbox 50.40] \ [.t bbox 58.0] -} [list {} [list 3 3 7 $fixedHeight] [list 38 [expr {3+2*$fixedHeight}] 7 $fixedHeight] [list 38 [expr {3+4*$fixedHeight}] 7 $fixedHeight] {}] +} [list {} [list 3 3 7 $fixedHeight] [list 38 [expr {3 + (2 * $fixedHeight)}] 7 $fixedHeight] [list 38 [expr {3 + (4 * $fixedHeight)}] 7 $fixedHeight] {}] test textDisp-22.2 {TkTextCharBbox} {textfonts} { .t config -wrap none .t yview 48.0 list [.t bbox 50.5] [.t bbox 50.40] [.t bbox 57.0] -} [list [list 38 [expr {3+2*$fixedHeight}] 7 $fixedHeight] {} [list 3 [expr {3+9*$fixedHeight}] 7 $fixedHeight]] +} [list [list 38 [expr {3 + (2 * $fixedHeight)}] 7 $fixedHeight] {} [list 3 [expr {3 + (9 * $fixedHeight)}] 7 $fixedHeight]] test textDisp-22.3 {TkTextCharBbox, cut-off lines} {textfonts} { .t config -wrap char .t yview 10.0 - wm geom . ${width}x[expr $height-1] + wm geom . ${width}x[expr {$height - 1}] update list [.t bbox 19.1] [.t bbox 20.1] -} [list [list 10 [expr {3+9*$fixedHeight}] 7 $fixedHeight] [list 10 [expr {3+10*$fixedHeight}] 7 3]] +} [list [list 10 [expr {3 + (9 * $fixedHeight)}] 7 $fixedHeight] [list 10 [expr {3 + (10 * $fixedHeight)}] 7 3]] test textDisp-22.4 {TkTextCharBbox, cut-off lines} {textfonts} { .t config -wrap char .t yview 10.0 wm geom . ${width}x[expr $height+1] update list [.t bbox 19.1] [.t bbox 20.1] -} [list [list 10 [expr {3+9*$fixedHeight}] 7 $fixedHeight] [list 10 [expr {3+10*$fixedHeight}] 7 5]] +} [list [list 10 [expr {3 + (9 * $fixedHeight)}] 7 $fixedHeight] [list 10 [expr {3 + (10 * $fixedHeight)}] 7 5]] test textDisp-22.5 {TkTextCharBbox, cut-off char} {textfonts} { .t config -wrap none .t yview 10.0 - wm geom . [expr $width-95]x$height + wm geom . [expr {$width - 95}]x$height update .t bbox 15.6 -} [list 45 [expr {3+5*$fixedHeight}] 7 $fixedHeight] +} [list 45 [expr {3 + (5 * $fixedHeight)}] 7 $fixedHeight] test textDisp-22.6 {TkTextCharBbox, line visible but not char} {textfonts} { .t config -wrap char .t yview 10.0 .t tag add big 20.2 20.5 - wm geom . ${width}x[expr $height+3] + wm geom . ${width}x[expr {$height + 3}] update list [.t bbox 19.1] [.t bbox 20.1] [.t bbox 20.2] -} [list [list 10 [expr {3+9*$fixedHeight}] 7 $fixedHeight] {} [list 17 [expr {3+10*$fixedHeight}] 14 7]] +} [list [list 10 [expr {3 + (9 * $fixedHeight)}] 7 $fixedHeight] {} [list 17 [expr {3 + (10 * $fixedHeight)}] 14 7]] wm geom . {} update test textDisp-22.7 {TkTextCharBbox, different character sizes} {textfonts} { @@ -2691,7 +2703,7 @@ test textDisp-22.7 {TkTextCharBbox, different character sizes} {textfonts} { .t tag add big 12.2 12.5 update list [.t bbox 12.1] [.t bbox 12.2] -} [list [list 10 [expr {3 + 2*$fixedHeight + $ascentDiff}] 7 $fixedHeight] [list 17 [expr {3+ 2*$fixedHeight}] 14 27]] +} [list [list 10 [expr {3 + (2 * $fixedHeight) + $ascentDiff}] 7 $fixedHeight] [list 17 [expr {3 + (2 * $fixedHeight)}] 14 27]] .t tag remove big 1.0 end test textDisp-22.8 {TkTextCharBbox, horizontal scrolling} {textfonts} { .t configure -wrap none @@ -2708,10 +2720,10 @@ test textDisp-22.9 {TkTextCharBbox, handling of spacing} {textfonts} { .t insert 1.0 "abcdefghijkl\nmnopqrstuvwzyz" .t tag configure spacing -spacing1 8 -spacing3 2 .t tag add spacing 1.0 end - frame .t.f1 -width 10 -height 4 -bg black - frame .t.f2 -width 10 -height 4 -bg black - frame .t.f3 -width 10 -height 4 -bg black - frame .t.f4 -width 10 -height 4 -bg black + frame .t.f1 -width 10 -height 4 -background black + frame .t.f2 -width 10 -height 4 -background black + frame .t.f3 -width 10 -height 4 -background black + frame .t.f4 -width 10 -height 4 -background black .t window create 1.3 -window .t.f1 -align top .t window create 1.7 -window .t.f2 -align center .t window create 2.1 -window .t.f3 -align bottom @@ -2719,7 +2731,7 @@ test textDisp-22.9 {TkTextCharBbox, handling of spacing} {textfonts} { update list [.t bbox .t.f1] [.t bbox .t.f2] [.t bbox .t.f3] [.t bbox .t.f4] \ [.t bbox 1.1] [.t bbox 2.9] -} [list [list 24 11 10 4] [list 55 [expr {$fixedDiff/2 + 15}] 10 4] [list 10 [expr {2*$fixedDiff + 43}] 10 4] [list 76 [expr {2*$fixedDiff + 40}] 10 4] [list 10 11 7 $fixedHeight] [list 69 [expr {$fixedDiff + 34}] 7 $fixedHeight]] +} [list [list 24 11 10 4] [list 55 [expr {($fixedDiff / 2) + 15}] 10 4] [list 10 [expr {(2 * $fixedDiff) + 43}] 10 4] [list 76 [expr {(2 * $fixedDiff) + 40}] 10 4] [list 10 11 7 $fixedHeight] [list 69 [expr {$fixedDiff + 34}] 7 $fixedHeight]] .t tag delete spacing .t delete 1.0 end @@ -2736,34 +2748,34 @@ test textDisp-23.1 {TkTextDLineInfo} {textfonts} { .t yview 48.0 list [.t dlineinfo 47.3] [.t dlineinfo 48.0] [.t dlineinfo 50.40] \ [.t dlineinfo 56.0] -} [list {} [list 3 3 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {4*$fixedDiff + 55}] 126 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] +} [list {} [list 3 3 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {(4 * $fixedDiff) + 55}] 126 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] {}] test textDisp-23.2 {TkTextDLineInfo} {textfonts} { - .t config -bd 4 -wrap word + .t config -borderwidth 4 -wrap word update .t yview 48.0 .t dlineinfo 50.40 -} [list 7 [expr {4*$fixedDiff + 59}] 126 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] -.t config -bd 0 +} [list 7 [expr {(4 * $fixedDiff) + 59}] 126 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] +.t config -borderwidth 0 test textDisp-23.3 {TkTextDLineInfo} {textfonts} { .t config -wrap none update .t yview 48.0 list [.t dlineinfo 50.40] [.t dlineinfo 57.3] -} [list [list 3 [expr {2*$fixedDiff + 29}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {9*$fixedDiff + 120}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] +} [list [list 3 [expr {(2 * $fixedDiff) + 29}] 371 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {(9 * $fixedDiff) + 120}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] test textDisp-23.4 {TkTextDLineInfo, cut-off lines} {textfonts} { .t config -wrap char .t yview 10.0 wm geom . ${width}x[expr $height-1] update list [.t dlineinfo 19.0] [.t dlineinfo 20.0] -} [list [list 3 [expr {9*$fixedDiff + 120}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {10*$fixedDiff + 133}] 49 3 [expr {$fixedDiff + 10}]]] +} [list [list 3 [expr {(9 * $fixedDiff) + 120}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {(10 * $fixedDiff) + 133}] 49 3 [expr {$fixedDiff + 10}]]] test textDisp-23.5 {TkTextDLineInfo, cut-off lines} {textfonts} { .t config -wrap char .t yview 10.0 - wm geom . ${width}x[expr $height+1] + wm geom . ${width}x[expr {$height + 1}] update list [.t dlineinfo 19.0] [.t dlineinfo 20.0] -} [list [list 3 [expr {9*$fixedDiff + 120}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {10*$fixedDiff + 133}] 49 5 [expr {$fixedDiff + 10}]]] +} [list [list 3 [expr {(9 * $fixedDiff) + 120}] 49 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {(10 * $fixedDiff) + 133}] 49 5 [expr {$fixedDiff + 10}]]] wm geom . {} update test textDisp-23.6 {TkTextDLineInfo, horizontal scrolling} {textfonts} { @@ -2775,7 +2787,7 @@ test textDisp-23.6 {TkTextDLineInfo, horizontal scrolling} {textfonts} { .t xview scroll 6 units update list [.t dlineinfo 1.0] [.t dlineinfo 2.0] [.t dlineinfo 3.0] -} [list [list -39 3 70 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list -39 [expr {$fixedDiff + 16}] 364 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list -39 [expr {2*$fixedDiff + 29}] 35 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] +} [list [list -39 3 70 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list -39 [expr {$fixedDiff + 16}] 364 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list -39 [expr {(2 * $fixedDiff) + 29}] 35 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] .t xview moveto 0 test textDisp-23.7 {TkTextDLineInfo, centering} {textfonts} { .t config -wrap word @@ -2788,7 +2800,7 @@ test textDisp-23.7 {TkTextDLineInfo, centering} {textfonts} { .t tag add x 1.0 .t tag add y 3.0 list [.t dlineinfo 1.0] [.t dlineinfo 2.0] [.t dlineinfo 3.0] -} [list [list 38 3 70 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {$fixedDiff + 16}] 119 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 108 [expr {4*$fixedDiff + 55}] 35 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] +} [list [list 38 3 70 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 3 [expr {$fixedDiff + 16}] 119 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]] [list 108 [expr {(4 * $fixedDiff) + 55}] 35 [expr {$fixedDiff + 13}] [expr {$fixedDiff + 10}]]] .t tag delete x y test textDisp-24.1 {TkTextCharLayoutProc} {textfonts} { @@ -2801,7 +2813,7 @@ test textDisp-24.2 {TkTextCharLayoutProc} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" - wm geom . [expr $width+1]x$height + wm geom . [expr {$width + 1}]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 12 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] @@ -2809,7 +2821,7 @@ test textDisp-24.3 {TkTextCharLayoutProc} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" - wm geom . [expr $width-1]x$height + wm geom . [expr {$width - 1}]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 10 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] @@ -2820,7 +2832,7 @@ test textDisp-24.4 {TkTextCharLayoutProc, newline not visible} {textfonts} { wm geom . {} update list [.t bbox 1.19] [.t bbox 1.20] [.t bbox 2.20] -} [list [list 136 3 7 $fixedHeight] [list 143 3 0 $fixedHeight] [list 3 [expr {2*$fixedDiff + 29}] 7 $fixedHeight]] +} [list [list 136 3 7 $fixedHeight] [list 143 3 0 $fixedHeight] [list 3 [expr {(2 * $fixedDiff) + 29}] 7 $fixedHeight]] test textDisp-24.5 {TkTextCharLayoutProc, char doesn't fit, newline not visible} {unix textfonts} { .t configure -wrap char .t delete 1.0 end @@ -2841,7 +2853,7 @@ test textDisp-24.7 {TkTextCharLayoutProc, line ends with space} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a b c d e f g h i j k l m n o p" - wm geom . [expr $width+1]x$height + wm geom . [expr {$width + 1}]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 12 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] @@ -2849,7 +2861,7 @@ test textDisp-24.8 {TkTextCharLayoutProc, line ends with space} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a b c d e f g h i j k l m n o p" - wm geom . [expr $width-1]x$height + wm geom . [expr {$width - 1}]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 10 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] @@ -2857,7 +2869,7 @@ test textDisp-24.9 {TkTextCharLayoutProc, line ends with space} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a b c d e f g h i j k l m n o p" - wm geom . [expr $width-6]x$height + wm geom . [expr {$width - 6}]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 5 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] @@ -2865,7 +2877,7 @@ test textDisp-24.10 {TkTextCharLayoutProc, line ends with space} {textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 "a b c d e f g h i j k l m n o p" - wm geom . [expr $width-7]x$height + wm geom . [expr {$width - 7}]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 4 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 7 $fixedHeight]] @@ -2873,7 +2885,7 @@ test textDisp-24.11 {TkTextCharLayoutProc, line ends with space that doesn't qui .t configure -wrap char .t delete 1.0 end .t insert 1.0 "01234567890123456789 \nabcdefg" - wm geom . [expr $width-2]x$height + wm geom . [expr {$width - 2}]x$height update set result {} lappend result [.t bbox 1.21] [.t bbox 2.0] @@ -2900,7 +2912,7 @@ test textDisp-24.14 {TkTextCharLayoutProc, -wrap none} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" - wm geom . [expr $width+1]x$height + wm geom . [expr {$width + 1}]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 7 $fixedHeight] [list 143 3 5 $fixedHeight]] @@ -2908,12 +2920,12 @@ test textDisp-24.15 {TkTextCharLayoutProc, -wrap none} {textfonts} { .t configure -wrap none .t delete 1.0 end .t insert 1.0 "abcdefghijklmnopqrstuvwxyz" - wm geom . [expr $width-1]x$height + wm geom . [expr {$width - 1}]x$height update list [.t bbox 1.19] [.t bbox 1.20] } [list [list 136 3 7 $fixedHeight] [list 143 3 3 $fixedHeight]] test textDisp-24.16 {TkTextCharLayoutProc, no chars fit} {textfonts} { - if {$tcl_platform(platform) == "windows"} { + if {$tcl_platform(platform) eq "windows"} { wm overrideredirect . 1 } .t configure -wrap char @@ -2922,8 +2934,8 @@ test textDisp-24.16 {TkTextCharLayoutProc, no chars fit} {textfonts} { wm geom . 103x$height update list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 1.2] -} [list [list 3 3 1 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 1 $fixedHeight] [list 3 [expr {2*$fixedDiff + 29}] 1 $fixedHeight]] -if {$tcl_platform(platform) == "windows"} { +} [list [list 3 3 1 $fixedHeight] [list 3 [expr {$fixedDiff + 16}] 1 $fixedHeight] [list 3 [expr {(2 * $fixedDiff) + 29}] 1 $fixedHeight]] +if {$tcl_platform(platform) eq "windows"} { wm overrideredirect . 0 } test textDisp-24.17 {TkTextCharLayoutProc, -wrap word} {textfonts} { @@ -2970,30 +2982,30 @@ test textDisp-24.21 {TkTextCharLayoutProc, word breaks} {textfonts} { .t configure -wrap word .t delete 1.0 end .t insert 1.0 "Sample text xxxxxxx yyyyy zzzzzzz qqqqq rrrr ssss tt u vvvvv" - frame .t.f -width 30 -height 20 -bg black + frame .t.f -width 30 -height 20 -background black .t window create 1.36 -window .t.f .t bbox 1.26 -} [list 3 [expr {$fixedDiff/2 + 19}] 7 $fixedHeight] +} [list 3 [expr {($fixedDiff / 2) + 19}] 7 $fixedHeight] test textDisp-24.22 {TkTextCharLayoutProc, word breaks} {textfonts} { .t configure -wrap word .t delete 1.0 end - frame .t.f -width 30 -height 20 -bg black + frame .t.f -width 30 -height 20 -background black .t insert 1.0 "Sample text xxxxxxx yyyyyyy" .t window create end -window .t.f .t insert end "zzzzzzz qqqqq rrrr ssss tt u vvvvv" .t bbox 1.28 -} [list 33 [expr {$fixedDiff/2 + 19}] 7 $fixedHeight] +} [list 33 [expr {($fixedDiff / 2) + 19}] 7 $fixedHeight] test textDisp-24.23 {TkTextCharLayoutProc, word breaks} {textfonts} { .t configure -wrap word .t delete 1.0 end - frame .t.f -width 30 -height 20 -bg black + frame .t.f -width 30 -height 20 -background black .t insert 1.0 "Sample text xxxxxxx yyyyyyy " .t insert end "zzzzzzz qqqqq rrrr ssss tt" .t window create end -window .t.f .t insert end "u vvvvv" .t bbox .t.f -} [list 3 [expr {2*$fixedDiff + 29}] 30 20] -catch {destroy .t.f} +} [list 3 [expr {(2 * $fixedDiff) + 29}] 30 20] +destroy .t.f .t configure -width 20 update test textDisp-24.24 {TkTextCharLayoutProc, justification and tabs} {textfonts} { @@ -3004,7 +3016,7 @@ test textDisp-24.24 {TkTextCharLayoutProc, justification and tabs} {textfonts} { list [.t bbox 1.0] [.t bbox 1.10] } [list [list 45 3 7 $fixedHeight] [list 94 3 7 $fixedHeight]] -.t configure -width 40 -bd 0 -relief flat -highlightthickness 0 -padx 0 \ +.t configure -width 40 -borderwidth 0 -relief flat -highlightthickness 0 -padx 0 \ -tabs 100 update test textDisp-25.1 {CharBboxProc procedure, check tab width} {textfonts} { @@ -3013,7 +3025,7 @@ test textDisp-25.1 {CharBboxProc procedure, check tab width} {textfonts} { list [.t bbox 1.3] [.t bbox 1.5] [.t bbox 1.6] } [list [list 21 1 79 $fixedHeight] [list 107 1 93 $fixedHeight] [list 200 1 7 $fixedHeight]] -.t configure -width 40 -bd 0 -relief flat -highlightthickness 0 -padx 0 \ +.t configure -width 40 -borderwidth 0 -relief flat -highlightthickness 0 -padx 0 \ -tabs {} update test textDisp-26.1 {AdjustForTab procedure, no tabs} {textfonts} { @@ -3047,9 +3059,9 @@ test textDisp-26.3 {AdjustForTab procedure, not enough tabs specified} { .t tag configure x -tabs {40 70 right} .t tag add x 1.0 end list [lindex [.t bbox 1.2] 0] \ - [expr [lindex [.t bbox 1.4] 0] + [lindex [.t bbox 1.4] 2]] \ - [expr [lindex [.t bbox 1.6] 0] + [lindex [.t bbox 1.6] 2]] \ - [expr [lindex [.t bbox 1.8] 0] + [lindex [.t bbox 1.8] 2]] + [expr {[lindex [.t bbox 1.4] 0] + [lindex [.t bbox 1.4] 2]}] \ + [expr {[lindex [.t bbox 1.6] 0] + [lindex [.t bbox 1.6] 2]}] \ + [expr {[lindex [.t bbox 1.8] 0] + [lindex [.t bbox 1.8] 2]}] } [list 40 70 100 130] test textDisp-26.4 {AdjustForTab procedure, different alignments} { .t delete 1.0 end @@ -3165,7 +3177,7 @@ test textDisp-26.14 {AdjustForTab procedure, not enough space} {textfonts} { .t delete 1.0 end .t insert end "a \tb \tc \td \te \tf \tg\n" .t insert end "Watch the \tX and the \t\t\tY\n" - .t tag configure moop -tabs [expr {8*$fixedWidth}] + .t tag configure moop -tabs [expr {8 * $fixedWidth}] .t insert end "Watch the \tX and the \t\t\tY\n" moop list [lindex [.t bbox 2.11] 0] [lindex [.t bbox 2.24] 0] \ [lindex [.t bbox 3.11] 0] [lindex [.t bbox 3.24] 0] @@ -3175,7 +3187,7 @@ test textDisp-26.14.2 {AdjustForTab procedure, not enough space} {textfonts} { .t configure -tabstyle wordprocessor .t insert end "a \tb \tc \td \te \tf \tg\n" .t insert end "Watch the \tX and the \t\t\tY\n" - .t tag configure moop -tabs [expr {8*$fixedWidth}] + .t tag configure moop -tabs [expr {8 * $fixedWidth}] .t insert end "Watch the \tX and the \t\t\tY\n" moop set res [list [lindex [.t bbox 2.11] 0] [lindex [.t bbox 2.24] 0] \ [lindex [.t bbox 3.11] 0] [lindex [.t bbox 3.24] 0]] @@ -3183,7 +3195,7 @@ test textDisp-26.14.2 {AdjustForTab procedure, not enough space} {textfonts} { set res } [list 112 56 112 56] -.t configure -width 20 -bd 2 -highlightthickness 2 -relief sunken -tabs {} \ +.t configure -width 20 -borderwidth 2 -highlightthickness 2 -relief sunken -tabs {} \ -wrap char update test textDisp-27.1 {SizeOfTab procedure, old-style tabs} {textfonts} { @@ -3253,7 +3265,7 @@ test textDisp-27.7 {SizeOfTab procedure, center alignment, wrap -none (potential # more for 'bb\t' and we're there, with 4 for the border. Since # Tk_GetPixelsFromObj uses the standard 'int(0.5 + float)' rounding, # so must we. - set tab [expr {4 + int(0.5 + $tab + $cm)}] + set tab [expr {4 + int (0.5 + $tab + $cm)}] update set res [.t bbox 2.23] lset res 0 [expr {[lindex $res 0] - $tab}] @@ -3274,7 +3286,7 @@ test textDisp-27.7.1 {SizeOfTab procedure, center alignment, wrap -none (potenti # more for 'bb\t' and we're there, with 4 for the border. Since # Tk_GetPixelsFromObj uses the standard 'int(0.5 + float)' rounding, # so must we. - set tab [expr {4 + int(0.5 + $tab + $cm)}] + set tab [expr {4 + int (0.5 + $tab + $cm)}] update set res [.t bbox 2.23] .t configure -tabstyle tabular @@ -3334,11 +3346,11 @@ test textDisp-27.11 {SizeOfTab procedure, making tabs at least as wide as a spac list [.t bbox 1.5] [.t bbox 1.6] } [list [list 131 5 13 $fixedHeight] [list 4 [expr {$fixedDiff + 18}] 7 $fixedHeight]] -proc bizarre_scroll args { +proc bizarre_scroll {args} { .t2.t delete 5.0 end } test textDisp-28.1 {"yview" option with bizarre scroll command} { - catch {destroy .t2} + destroy .t2 toplevel .t2 text .t2.t -width 40 -height 4 .t2.t insert end "1\n2\n3\n4\n5\n6\n7\n8\n" @@ -3353,7 +3365,7 @@ test textDisp-28.1 {"yview" option with bizarre scroll command} { } {6.0 1.0} test textDisp-29.1 {miscellaneous: lines wrap but are still too long} {textfonts} { - catch {destroy .t2} + destroy .t2 toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ @@ -3362,13 +3374,13 @@ test textDisp-29.1 {miscellaneous: lines wrap but are still too long} {textfonts scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 - frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised + frame .t2.t.f -width 300 -height 50 -borderwidth 2 -relief raised .t2.t window create 1.1 -window .t2.t.f update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list 0.0 [expr {14.0/30}]] 300x50+5+[expr {$fixedDiff + 18}] [list 12 [expr {$fixedDiff + 68}] 7 $fixedHeight]] +} [list [list 0.0 [expr {14.0 / 30}]] 300x50+5+[expr {$fixedDiff + 18}] [list 12 [expr {$fixedDiff + 68}] 7 $fixedHeight]] test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {textfonts} { - catch {destroy .t2} + destroy .t2 toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ @@ -3377,14 +3389,14 @@ test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {textfonts scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 - frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised + frame .t2.t.f -width 300 -height 50 -borderwidth 2 -relief raised .t2.t window create 1.1 -window .t2.t.f .t2.t xview scroll 1 unit update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list [expr {7.0/300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]] +} [list [list [expr {7.0 / 300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]] test textDisp-29.2.1 {miscellaneous: lines wrap but are still too long} {textfonts} { - catch {destroy .t2} + destroy .t2 toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ @@ -3397,9 +3409,9 @@ test textDisp-29.2.1 {miscellaneous: lines wrap but are still too long} {textfon .t2.t xview scroll 5 unit update .t2.t xview -} [list [expr {5.0/90}] [expr {25.0/90}]] +} [list [expr {5.0 / 90}] [expr {25.0 / 90}]] test textDisp-29.2.2 {miscellaneous: lines wrap but are still too long} {textfonts} { - catch {destroy .t2} + destroy .t2 toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ @@ -3408,14 +3420,14 @@ test textDisp-29.2.2 {miscellaneous: lines wrap but are still too long} {textfon scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 - frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised + frame .t2.t.f -width 300 -height 50 -borderwidth 2 -relief raised .t2.t window create 1.1 -window .t2.t.f .t2.t xview scroll 2 unit update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list [expr {14.0/300}] [expr {154.0/300}]] 300x50+-9+[expr {$fixedDiff + 18}] {}] +} [list [list [expr {14.0 / 300}] [expr {154.0 / 300}]] 300x50+-9+[expr {$fixedDiff + 18}] {}] test textDisp-29.2.3 {miscellaneous: lines wrap but are still too long} {textfonts} { - catch {destroy .t2} + destroy .t2 toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ @@ -3424,14 +3436,14 @@ test textDisp-29.2.3 {miscellaneous: lines wrap but are still too long} {textfon scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 - frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised + frame .t2.t.f -width 300 -height 50 -borderwidth 2 -relief raised .t2.t window create 1.1 -window .t2.t.f .t2.t xview scroll 7 pixels update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list [expr {7.0/300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]] +} [list [list [expr {7.0 / 300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]] test textDisp-29.2.4 {miscellaneous: lines wrap but are still too long} {textfonts} { - catch {destroy .t2} + destroy .t2 toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ @@ -3440,19 +3452,19 @@ test textDisp-29.2.4 {miscellaneous: lines wrap but are still too long} {textfon scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 - frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised + frame .t2.t.f -width 300 -height 50 -borderwidth 2 -relief raised .t2.t window create 1.1 -window .t2.t.f .t2.t xview scroll 17 pixels update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list [expr {17.0/300}] [expr {157.0/300}]] 300x50+-12+[expr {$fixedDiff + 18}] {}] +} [list [list [expr {17.0 / 300}] [expr {157.0 / 300}]] 300x50+-12+[expr {$fixedDiff + 18}] {}] test textDisp-29.2.5 {miscellaneous: can show last character} { - catch {destroy .t2} + destroy .t2 toplevel .t2 wm geometry .t2 121x141+200+200 text .t2.t -width 5 -height 5 -font {Arial 10} \ -wrap none -xscrollcommand ".t2.s set" \ - -bd 2 -highlightthickness 0 -padx 1 + -borderwidth 2 -highlightthickness 0 -padx 1 .t2.t insert end "WWWWWWWWWWWWi" scrollbar .t2.s -orient horizontal -command ".t2.t xview" grid .t2.t -row 0 -column 0 -sticky nsew @@ -3460,22 +3472,23 @@ test textDisp-29.2.5 {miscellaneous: can show last character} { grid columnconfigure .t2 0 -weight 1 grid rowconfigure .t2 0 -weight 1 grid rowconfigure .t2 1 -weight 0 - update ; update + update + update set xv [.t2.t xview] set xd [expr {[lindex $xv 1] - [lindex $xv 0]}] - .t2.t xview moveto [expr {1.0-$xd}] + .t2.t xview moveto [expr {1.0 - $xd}] set iWidth [lindex [.t2.t bbox end-2c] 2] .t2.t xview scroll 2 units set iWidth2 [lindex [.t2.t bbox end-2c] 2] - if {($iWidth == $iWidth2) && $iWidth >= 2} { + if {($iWidth == $iWidth2) && ($iWidth >= 2)} { set result "correct" } else { set result "last character is not completely visible when it should be" } } {correct} test textDisp-29.3 {miscellaneous: lines wrap but are still too long} {textfonts} { - catch {destroy .t2} + destroy .t2 toplevel .t2 wm geometry .t2 +0+0 text .t2.t -width 20 -height 10 -font $fixedFont \ @@ -3484,13 +3497,13 @@ test textDisp-29.3 {miscellaneous: lines wrap but are still too long} {textfonts scrollbar .t2.s -orient horizontal -command ".t2.t xview" pack .t2.s -side bottom -fill x .t2.t insert end 123 - frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised + frame .t2.t.f -width 300 -height 50 -borderwidth 2 -relief raised .t2.t window create 1.1 -window .t2.t.f update .t2.t xview scroll 200 units update list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3] -} [list [list [expr {16.0/30}] 1.0] 300x50+-155+[expr {$fixedDiff + 18}] {}] +} [list [list [expr {16.0 / 30}] 1.0] 300x50+-155+[expr {$fixedDiff + 18}] {}] test textDisp-30.1 {elidden text joining multiple logical lines} { .t2.t delete 1.0 end .t2.t insert 1.0 "1111\n2222\n3333" @@ -3505,7 +3518,7 @@ test textDisp-30.2 {elidden text joining multiple logical lines} { .t2.t tag add elidden 1.2 2.2 .t2.t count -displaylines 1.0 end } {2} -catch {destroy .t2} +destroy .t2 .t configure -height 1 update @@ -3521,7 +3534,7 @@ test textDisp-31.1 {line embedded window height update} { lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res -} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 6}] [expr {$fixedHeight * 7}]] +} [list [expr {100 + ($fixedHeight * 6)}] [expr {100 + ($fixedHeight * 6)}] [expr {$fixedHeight * 7}]] test textDisp-31.2 {line update index shifting} { set res {} @@ -3538,7 +3551,7 @@ test textDisp-31.2 {line update index shifting} { lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res -} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] +} [list [expr {100 + ($fixedHeight * 6)}] [expr {100 + ($fixedHeight * 8)}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + ($fixedHeight * 6)}]] test textDisp-31.3 {line update index shifting} { # Should do exactly the same as the above, as long @@ -3554,15 +3567,19 @@ test textDisp-31.3 {line update index shifting} { .t insert 1.0 "abc\n" .t insert 1.0 "abc\n" lappend res [.t count -ypixels 1.0 end] - update ; after 1000 ; update + update + after 1000 + update lappend res [.t count -ypixels 1.0 end] .t.f configure -height 100 .t delete 1.0 3.0 lappend res [.t count -ypixels 1.0 end] - update ; after 1000 ; update + update + after 1000 + update lappend res [.t count -ypixels 1.0 end] set res -} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] +} [list [expr {100 + ($fixedHeight * 6)}] [expr {100 + ($fixedHeight * 8)}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + ($fixedHeight * 6)}]] test textDisp-31.4 {line embedded image height update} { set res {} @@ -3575,12 +3592,14 @@ test textDisp-31.4 {line embedded image height update} { lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res -} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 6}] [expr {$fixedHeight * 7}]] +} [list [expr {100 + ($fixedHeight * 6)}] [expr {100 + ($fixedHeight * 6)}] [expr {$fixedHeight * 7}]] test textDisp-31.5 {line update index shifting} { set res {} textest configure -height 100 - update ; after 1000 ; update + update + after 1000 + update lappend res [.t count -update -ypixels 1.0 end] textest configure -height 10 .t insert 1.0 "abc\n" @@ -3592,7 +3611,7 @@ test textDisp-31.5 {line update index shifting} { lappend res [.t count -ypixels 1.0 end] lappend res [.t count -update -ypixels 1.0 end] set res -} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] +} [list [expr {100 + ($fixedHeight * 6)}] [expr {100 + ($fixedHeight * 8)}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + ($fixedHeight * 6)}]] test textDisp-31.6 {line update index shifting} { # Should do exactly the same as the above, as long @@ -3600,23 +3619,29 @@ test textDisp-31.6 {line update index shifting} { # recalculation. The 'update' and 'delay' must be # long enough to ensure all asynchronous updates # have been performed. - set res {} + set res [list] textest configure -height 100 - update ; after 1000 ; update + update + after 1000 + update lappend res [.t count -update -ypixels 1.0 end] textest configure -height 10 .t insert 1.0 "abc\n" .t insert 1.0 "abc\n" lappend res [.t count -ypixels 1.0 end] - update ; after 1000 ; update + update + after 1000 + update lappend res [.t count -ypixels 1.0 end] textest configure -height 100 .t delete 1.0 3.0 lappend res [.t count -ypixels 1.0 end] - update ; after 1000 ; update + update + after 1000 + update lappend res [.t count -ypixels 1.0 end] set res -} [list [expr {100 + $fixedHeight * 6}] [expr {100 + $fixedHeight * 8}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + $fixedHeight * 6}]] +} [list [expr {100 + ($fixedHeight * 6)}] [expr {100 + ($fixedHeight * 8)}] [expr {$fixedHeight * 9}] [expr {$fixedHeight * 7}] [expr {100 + ($fixedHeight * 6)}]] test textDisp-31.7 {line update index shifting, elided} { # The 'update' and 'delay' must be long enough to ensure all @@ -3630,11 +3655,15 @@ test textDisp-31.7 {line update index shifting, elided} { .t tag configure elide -elide 1 .t tag add elide 1.3 2.1 lappend res [.t count -ypixels 1.0 end] - update ; after 1000 ; update + update + after 1000 + update lappend res [.t count -ypixels 1.0 end] .t delete 1.0 3.0 lappend res [.t count -ypixels 1.0 end] - update ; after 1000 ; update + update + after 1000 + update lappend res [.t count -ypixels 1.0 end] set res } [list [expr {$fixedHeight * 1}] [expr {$fixedHeight * 3}] [expr {$fixedHeight * 3}] [expr {$fixedHeight * 2}] [expr {$fixedHeight * 1}] [expr {$fixedHeight * 1}]] @@ -3645,7 +3674,10 @@ test textDisp-32.0 {everything elided} { .tt insert 0.0 HELLO .tt tag configure HIDE -elide 1 .tt tag add HIDE 0.0 end - update ; update ; update ; update + update + update + update + update destroy .tt } {} test textDisp-32.1 {everything elided} { @@ -3657,11 +3689,14 @@ test textDisp-32.1 {everything elided} { .tt tag configure HIDE -elide 1 update .tt tag add HIDE 0.0 end - update ; update ; update ; update + update + update + update + update destroy .tt } {} test textDisp-32.2 {elide and tags} { - pack [text .tt -height 30 -width 100 -bd 0 \ + pack [text .tt -height 30 -width 100 -borderwidth 0 \ -highlightthickness 0 -padx 0] .tt insert end \ {test text using tags 1 and 3 } \ @@ -3671,15 +3706,17 @@ test textDisp-32.2 {elide and tags} { update # indent left margin of tag 1 by 20 pixels # text should be indented - .tt tag configure testtag1 -lmargin1 20 ; update + .tt tag configure testtag1 -lmargin1 20 + update #1 - set res {} + set res [list] lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ [lindex [.tt bbox "1.0 + 0 displaychars"] 0]] # hide tag 1, remaining text should not be indented, since # the indented tag and character is hidden. - .tt tag configure testtag1 -elide 1 ; update + .tt tag configure testtag1 -elide 1 + update #2 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ @@ -3689,7 +3726,8 @@ test textDisp-32.2 {elide and tags} { .tt tag configure testtag1 -elide 0 # indent left margin of tag 2 by 20 pixels # text should not be indented, since tag1 has lmargin1 of 0. - .tt tag configure testtag2 -lmargin1 20 ; update + .tt tag configure testtag2 -lmargin1 20 + update #3 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ @@ -3697,7 +3735,8 @@ test textDisp-32.2 {elide and tags} { # hide tag 1, remaining text should now be indented, but # the bbox of 1.0 should have zero width and zero indent, # since it is elided at that position. - .tt tag configure testtag1 -elide 1 ; update + .tt tag configure testtag1 -elide 1 + update #4 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ @@ -3709,7 +3748,8 @@ test textDisp-32.2 {elide and tags} { # text should be indented, since this tag takes # precedence over testtag1, and is applied to the # start of the text. - .tt tag configure testtag3 -lmargin1 20 ; update + .tt tag configure testtag3 -lmargin1 20 + update #5 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ @@ -3717,7 +3757,8 @@ test textDisp-32.2 {elide and tags} { # hide tag 1, remaining text should still be indented, # since it still has testtag3 on it. Again the # bbox of 1.0 should have 0. - .tt tag configure testtag1 -elide 1 ; update + .tt tag configure testtag1 -elide 1 + update #6 lappend res [list [.tt index "1.0 + 0 displaychars"] \ [lindex [.tt bbox 1.0] 0] \ @@ -3752,10 +3793,12 @@ test textDisp-32.3 "NULL undisplayProc problems: #1791052" -setup { .tt insert end X .tt mark set MSGLEFT "end - 1 char" .tt mark gravity MSGLEFT left - .tt insert end ":)" emoticon + .tt insert end ":\)" emoticon .tt image create end -image $img pack .tt - update; update; update + update + update + update } -cleanup { image delete $img destroy .tt @@ -3764,7 +3807,9 @@ test textDisp-32.3 "NULL undisplayProc problems: #1791052" -setup { test textDisp-33.0 {one line longer than fits in the widget} { pack [text .tt -wrap char] .tt insert 1.0 [string repeat "more wrap + " 300] - update ; update ; update + update + update + update .tt see 1.0 lindex [.tt yview] 0 } {0.0} @@ -3772,7 +3817,9 @@ test textDisp-33.1 {one line longer than fits in the widget} { destroy .tt pack [text .tt -wrap char] .tt insert 1.0 [string repeat "more wrap + " 300] - update ; update ; update + update + update + update .tt yview "1.0 +1 displaylines" if {[lindex [.tt yview] 0] > 0.1} { set result "window should be scrolled to the top" @@ -3786,7 +3833,8 @@ test textDisp-33.2 {one line longer than fits in the widget} { .tt debug 1 set tk_textHeightCalc "" .tt insert 1.0 [string repeat "more wrap + " 1] - after 100 ; update + after 100 + update # Nothing should have been recalculated. set tk_textHeightCalc } {} @@ -3796,7 +3844,9 @@ test textDisp-33.3 {one line longer than fits in the widget} { .tt debug 1 set tk_textHeightCalc "" .tt insert 1.0 [string repeat "more wrap + " 300] - update ; .tt count -update -ypixels 1.0 end ; update + update + .tt count -update -ypixels 1.0 end + update # Each line should have been recalculated just once .tt debug 0 expr {[llength $tk_textHeightCalc] == [.tt count -displaylines 1.0 end]} @@ -3807,7 +3857,9 @@ test textDisp-33.4 {one line longer than fits in the widget} { .tt debug 1 set tk_textHeightCalc "" .tt insert 1.0 [string repeat "more wrap + " 300] - update ; update ; update + update + update + update set idx [.tt index "1.0 + 1 displaylines"] .tt yview $idx if {[lindex [.tt yview] 0] > 0.1} { @@ -3834,9 +3886,9 @@ test textDisp-33.5 {bold or italic fonts} win { for {set i 0} {$i < 12} {incr i 4} { lappend bb [lindex [.tt bbox 1.$i] 0] } - foreach {a b c} $bb {} + lassign $bb a b c unset bb - if {($b - $a) * 1.5 < ($c - $b)} { + if {(($b - $a) * 1.5) < ($c - $b)} { set result "italic font has much too much space" } else { set result "italic font measurement ok" @@ -3848,12 +3900,12 @@ test textDisp-34.1 {Text widgets multi-scrolling problem: Bug 2677890} -setup { pack [text .t1 -width 10 -yscrollcommand {.sy set}] \ [ttk::scrollbar .sy -orient vertical -command {.t1 yview}] \ -side left -fill both - bindtags .sy {}; # No clicky! + bindtags .sy ""; # No clicky! set txt "" for {set i 0} {$i < 99} {incr i} { lappend txt "$i" [list pc $i] "\n" "" } - set result {} + set result "" } -body { .t1 insert end {*}$txt update @@ -3862,7 +3914,8 @@ test textDisp-34.1 {Text widgets multi-scrolling problem: Bug 2677890} -setup { lappend result [.sy get] after 0 {lappend result [.sy get]} after 1000 {lappend result [.sy get]} - vwait result;vwait result + vwait result + vwait result return $result } -cleanup { destroy .t1 .sy diff --git a/tests/textImage.test b/tests/textImage.test index 24246cc..212defb 100644 --- a/tests/textImage.test +++ b/tests/textImage.test @@ -22,7 +22,7 @@ destroy .t test textImage-1.1 {basic argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image } -cleanup { @@ -32,7 +32,7 @@ test textImage-1.1 {basic argument checking} -setup { test textImage-1.2 {basic argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image c } -cleanup { @@ -42,7 +42,7 @@ test textImage-1.2 {basic argument checking} -setup { test textImage-1.3 {cget argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image cget } -cleanup { @@ -52,7 +52,7 @@ test textImage-1.3 {cget argument checking} -setup { test textImage-1.4 {cget argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image cget blurf -flurp } -cleanup { @@ -62,7 +62,7 @@ test textImage-1.4 {cget argument checking} -setup { test textImage-1.5 {cget argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image cget 1.1 -flurp } -cleanup { @@ -72,7 +72,7 @@ test textImage-1.5 {cget argument checking} -setup { test textImage-1.6 {configure argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image configure } -cleanup { @@ -82,7 +82,7 @@ test textImage-1.6 {configure argument checking} -setup { test textImage-1.7 {configure argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image configure blurf } -cleanup { @@ -92,7 +92,7 @@ test textImage-1.7 {configure argument checking} -setup { test textImage-1.8 {configure argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image configure 1.1 } -cleanup { @@ -102,7 +102,7 @@ test textImage-1.8 {configure argument checking} -setup { test textImage-1.9 {create argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create } -cleanup { @@ -112,7 +112,7 @@ test textImage-1.9 {create argument checking} -setup { test textImage-1.10 {create argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create blurf } -cleanup { @@ -126,7 +126,7 @@ test textImage-1.11 {basic argument checking} -setup { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create 1000.1000 -image small } -cleanup { @@ -137,14 +137,13 @@ test textImage-1.11 {basic argument checking} -setup { test textImage-1.12 {names argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image names dates places } -cleanup { destroy .t } -returnCodes error -result {wrong # args: should be ".t image names"} - test textImage-1.13 {names argument checking} -setup { destroy .t set result "" @@ -153,7 +152,7 @@ test textImage-1.13 {names argument checking} -setup { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t lappend result [.t image names] .t image create insert -image small @@ -170,7 +169,7 @@ test textImage-1.13 {names argument checking} -setup { test textImage-1.14 {basic argument checking} -setup { destroy .t } -body { - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image huh } -cleanup { @@ -184,7 +183,7 @@ test textImage-1.15 {align argument checking} -setup { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small -align wrong } -cleanup { @@ -199,7 +198,7 @@ test textImage-1.16 {configure} -setup { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small .t image configure small @@ -216,7 +215,7 @@ test textImage-1.17 {basic cget options} -setup { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small foreach i {align padx pady image name} { @@ -238,7 +237,7 @@ test textImage-1.18 {basic configure options} -setup { image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small foreach {option value} {align top padx 5 pady 7 image large name none} { @@ -258,7 +257,7 @@ test textImage-1.19 {basic image naming} -setup { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small .t image create end -image small -name small @@ -277,7 +276,7 @@ test textImage-2.1 {debug} -setup { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t debug 1 .t insert end front @@ -291,7 +290,6 @@ test textImage-2.1 {debug} -setup { image delete small } -result {} - test textImage-3.1 {image change propagation} -setup { destroy .t set result "" @@ -300,7 +298,7 @@ test textImage-3.1 {image change propagation} -setup { image create photo vary -width 5 -height 5 vary put red -to 0 0 4 4 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image vary -align top update @@ -325,7 +323,7 @@ test textImage-3.2 {delayed image management} -setup { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -name test update @@ -351,7 +349,7 @@ test textImage-4.1 {alignment checking - except baseline} -setup { image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small @@ -380,7 +378,7 @@ test textImage-4.2 {alignment checking - baseline} -setup { large put green -to 0 0 50 50 } font create test_font2 -size 5 - text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font2 -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small -align baseline @@ -391,9 +389,9 @@ test textImage-4.2 {alignment checking - baseline} -setup { font configure test_font2 -size $size array set Metrics [font metrics test_font2] update - foreach {x y w h} [.t bbox small] {} + lassign [.t bbox small] x y w h set norm [expr { - (([image height large] - $Metrics(-linespace))/2 + ((([image height large] - $Metrics(-linespace)) / 2) + $Metrics(-ascent) - [image height small] - $y) }] lappend result "$size $norm" @@ -418,7 +416,7 @@ test textImage-4.3 {alignment and padding checking} -constraints { image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } - text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 + text .t -font test_font -borderwidth 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small -padx 5 -pady 10 @@ -436,7 +434,6 @@ test textImage-4.3 {alignment and padding checking} -constraints { image delete small large } -result {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}} - test textImage-5.1 {peer widget images} -setup { destroy .t .tt } -body { diff --git a/tests/textIndex.test b/tests/textIndex.test index c949b1f..4f8f225 100644 --- a/tests/textIndex.test +++ b/tests/textIndex.test @@ -11,8 +11,8 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test -catch {destroy .t} -text .t -font {Courier -12} -width 20 -height 10 +destroy .t +text .t -font "Courier -12" -width 20 -height 10 pack append . .t {top expand fill} update .t debug on @@ -209,9 +209,9 @@ test textIndex-2.14 {TkTextMakeCharIndex: verify index is in range} { .t mark set foo 3.2 .t tag add x 2.8 2.11 .t tag add x 6.0 6.2 -set weirdTag "funny . +- 22.1\n\t{" +set weirdTag "funny . +- 22.1\n\t\{" .t tag add $weirdTag 2.1 2.6 -set weirdMark "asdf \n{-+ 66.2\t" +set weirdMark "asdf \n\{-+ 66.2\t" .t mark set $weirdMark 4.0 .t tag config y -relief raised set weirdImage "foo-1" @@ -613,7 +613,7 @@ test textIndex-14.17 {TkTextIndexBackChars: UTF} { .t get {5.3 - 3 chars} } b -proc getword index { +proc getword {index} { .t get [.t index "$index wordstart"] [.t index "$index wordend"] } test textIndex-15.1 {StartEnd} { @@ -669,7 +669,7 @@ test textIndex-16.1 {TkTextPrintIndex} { $t window create end -window [button $t.b] set result [$t index end-2c] pack $t - catch {destroy $t} + destroy $t } 0 test textIndex-16.2 {TkTextPrintIndex} { @@ -678,7 +678,7 @@ test textIndex-16.2 {TkTextPrintIndex} { $t window create end -window [button $t.b] set result [$t tag add {} end-2c] pack $t - catch {destroy $t} + destroy $t } 0 test textIndex-17.1 {Object indices} { @@ -693,7 +693,7 @@ test textIndex-17.1 {Object indices} { lappend res $idx [$t index $idx] $t yview scroll 2 pages lappend res $idx [$t index $idx] - catch {destroy $t} + destroy $t unset i unset idx list $res @@ -709,7 +709,7 @@ test textIndex-18.1 {Object indices don't cache mark names} { lappend res [.t2 index $pos] .t2 mark set $pos 1.0 lappend res [.t2 index $pos] - catch {destroy .t2} + destroy .t2 set res } {3.4 3.0 1.0} @@ -826,14 +826,14 @@ test textIndex-19.13 {Display lines} { destroy .txt .sbar } {} -proc text_test_word {startend chars start} { +proc text_test_word {startend chars a_start} { destroy .t text .t .t insert end $chars - if {[regexp {end} $start]} { - set start [.t index "${start}chars -2c"] + if {[regexp "end" $a_start]} { + set start [.t index "${a_start}chars -2c"] } else { - set start [.t index "1.0 + ${start}chars"] + set start [.t index "1.0 + ${a_start}chars"] } if {[.t compare $start >= "end-1c"]} { set start "end-2c" @@ -929,7 +929,7 @@ test textIndex-24.1 {text mark prev} { } {1.0} # cleanup -rename textimage {} -catch {destroy .t} +rename textimage "" +destroy .t cleanupTests return diff --git a/tests/textTag.test b/tests/textTag.test index fed073a..06963fb 100644 --- a/tests/textTag.test +++ b/tests/textTag.test @@ -304,7 +304,6 @@ test textTag-1.35 {configuration options} -constraints { .t tag configure x -underline [lindex [.t tag configure x -underline] 3] } -returnCodes error -result {expected boolean value but got "stupid"} - test textTag-2.1 {TkTextTagCmd - "add" option} -constraints { haveCourier12 } -body { @@ -418,7 +417,6 @@ test textTag-2.14 {tag add before -startline - Bug 1615425} haveCourier12 { set res 1 } {1} - test textTag-3.1 {TkTextTagCmd - "bind" option} -constraints { haveCourier12 } -body { @@ -500,7 +498,6 @@ test textTag-3.10 {TkTextTagCmd - "bind" option} -constraints { .t tag delete x } -returnCodes error -result {no event type or button # or keysym} - test textTag-4.1 {TkTextTagCmd - "cget" option} -constraints { haveCourier12 } -body { @@ -532,7 +529,6 @@ test textTag-4.5 {TkTextTagCmd - "cget" option} -constraints { .t tag delete x } -result {red} - test textTag-5.1 {TkTextTagCmd - "configure" option} -constraints { haveCourier12 } -body { @@ -714,7 +710,6 @@ test textTag-5.22 {TkTextTagCmd - "configure" option} -constraints { .t cget -selectborderwidth } -result {} - test textTag-6.1 {TkTextTagCmd - "delete" option} -constraints { haveCourier12 } -body { @@ -760,7 +755,6 @@ test textTag-6.5 {TkTextTagCmd - "delete" option} -constraints { .t tag delete x } -result {} - test textTag-7.1 {TkTextTagCmd - "lower" option} -constraints { haveCourier12 } -body { @@ -819,7 +813,6 @@ test textTag-7.6 {TkTextTagCmd - "lower" option} -constraints { .t tag delete {*}[.t tag names] } -result {sel b a c d} - test textTag-8.1 {TkTextTagCmd - "names" option} -constraints { haveCourier12 } -body { @@ -856,7 +849,6 @@ test textTag-8.3 {TkTextTagCmd - "names" option} -constraints { .t tag delete {*}[.t tag names] } -result {c {a b}} - test textTag-9.1 {TkTextTagCmd - "nextrange" option} -constraints { haveCourier12 } -body { @@ -1003,7 +995,6 @@ test textTag-9.14 {TkTextTagCmd - "nextrange" option} -constraints { .t tag delete x } -result {} - test textTag-10.1 {TkTextTagCmd - "prevrange" option} -constraints { haveCourier12 } -body { @@ -1156,7 +1147,6 @@ test textTag-10.14 {TkTextTagCmd - "prevrange" option} -constraints { .t tag delete x } -result {} - test textTag-11.1 {TkTextTagCmd - "raise" option} -constraints { haveCourier12 } -body { @@ -1215,7 +1205,6 @@ test textTag-11.6 {TkTextTagCmd - "raise" option} -constraints { .t tag delete {*}[.t tag names] } -result {sel b c a d} - test textTag-12.1 {TkTextTagCmd - "ranges" option} -constraints { haveCourier12 } -body { @@ -1251,7 +1240,6 @@ test textTag-12.4 {TkTextTagCmd - "ranges" option} -constraints { .t tag delete x } -result {1.0 3.0 4.0 8.0} - test textTag-13.1 {TkTextTagCmd - "remove" option} -constraints { haveCourier12 } -body { @@ -1285,7 +1273,6 @@ test textTag-13.3 {TkTextTagCmd - "remove" option} -constraints { destroy .t.e } -result {Text} - test textTag-14.1 {SortTags} -constraints haveCourier12 -setup { .t tag delete a b c d } -body { @@ -1334,17 +1321,15 @@ test textTag-14.4 {SortTags} -constraints haveCourier12 -setup { .t tag delete {*}[.t tag names] } -result {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29} - - set c [.t bbox 2.1] -set x1 [expr [lindex $c 0] + [lindex $c 2]/2] -set y1 [expr [lindex $c 1] + [lindex $c 3]/2] +set x1 [expr {[lindex $c 0] + ([lindex $c 2] / 2)}] +set y1 [expr {[lindex $c 1] + ([lindex $c 3] / 2)}] set c [.t bbox 3.2] -set x2 [expr [lindex $c 0] + [lindex $c 2]/2] -set y2 [expr [lindex $c 1] + [lindex $c 3]/2] +set x2 [expr {[lindex $c 0] + ([lindex $c 2] / 2)}] +set y2 [expr {[lindex $c 1] + ([lindex $c 3] / 2)}] set c [.t bbox 4.3] -set x3 [expr [lindex $c 0] + [lindex $c 2]/2] -set y3 [expr [lindex $c 1] + [lindex $c 3]/2] +set x3 [expr {[lindex $c 0] + ([lindex $c 2] / 2)}] +set y3 [expr {[lindex $c 1] + ([lindex $c 3] / 2)}] test textTag-15.1 {TkTextBindProc} -constraints haveCourier12 -setup { .t tag delete x y @@ -1431,7 +1416,6 @@ test textTag-15.3 {TkTextBindProc} -constraints haveCourier12 -setup { .t tag delete x y } -result {x-enter | x-down | | | x-up | x-leave y-enter} - test textTag-16.1 {TkTextPickCurrent procedure} -constraints { haveCourier12 } -setup { @@ -1587,7 +1571,6 @@ test textTag-16.7 {TkTextPickCurrent procedure} -constraints { .t tag delete a big } -result {3.1} - test textTag-17.1 {insert procedure inserts tags} -setup { .t delete 1.0 end } -body { @@ -1598,7 +1581,6 @@ test textTag-17.1 {insert procedure inserts tags} -setup { .t dump -tag 1.0 end } -result {tagon x 1.0 tagoff x 1.4 tagon y 2.0 tagoff y 2.4} - test textTag-18.1 {TkTextPickCurrent tag bindings} -setup { destroy .t event generate {} <Motion> -warp 1 -x -1 -y -1; update diff --git a/tests/textWind.test b/tests/textWind.test index c3483e6..f61c4e8 100644 --- a/tests/textWind.test +++ b/tests/textWind.test @@ -18,18 +18,17 @@ option add *Text.borderWidth 2 option add *Text.highlightThickness 2 option add *Text.font {Courier -12} - deleteWindows # Widget used in tests 1.* - 16.* -text .t -width 30 -height 6 -bd 2 -highlightthickness 2 +text .t -width 30 -height 6 -borderwidth 2 -highlightthickness 2 pack append . .t {top expand fill} update .t debug on # 15 on XP, 13 on Solaris 8 -set fixedHeight [font metrics {Courier -12} -linespace] +set fixedHeight [font metrics "Courier -12" -linespace] set fixedDiff [expr {$fixedHeight - 13}] ;# 2 on XP -set color [expr {[winfo depth .t] > 1 ? "green" : "black"}] +set color [expr {([winfo depth .t] > 1) ? "green" : "black"}] wm geometry . {} @@ -48,7 +47,7 @@ test textWind-1.1 {basic tests of options} -constraints fonts -setup { } -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" - frame .f -width 3 -height 3 -bg $color + frame .f -width 3 -height 3 -background $color .t window create 2.2 -window .f update list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] \ @@ -59,7 +58,7 @@ test textWind-1.2 {basic tests of options} -constraints fonts -setup { } -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" - frame .f -width 3 -height 3 -bg $color + frame .f -width 3 -height 3 -background $color .t window create 2.2 -window .f -align top update list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] \ @@ -78,7 +77,7 @@ test textWind-1.4 {basic tests of options} -constraints fonts -setup { } -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 2.2 -window .f -padx 5 update list [winfo geom .f] [.t window configure .f -padx] [.t bbox 2.3] @@ -88,7 +87,7 @@ test textWind-1.5 {basic tests of options} -constraints fonts -setup { } -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 2.2 -window .f -pady 4 update list [winfo geom .f] [.t window configure .f -pady] [.t bbox 2.31] @@ -98,13 +97,12 @@ test textWind-1.6 {basic tests of options} -constraints fonts -setup { } -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 2.2 -window .f -stretch 1 update list [winfo geom .f] [.t window configure .f -stretch] } -result {5x13+19+18 {-stretch {} {} 0 1}} - .t delete 1.0 end .t insert end "This is the first line" test textWind-2.1 {TkTextWindowCmd procedure} -body { @@ -125,7 +123,7 @@ test textWind-2.5 {TkTextWindowCmd procedure, "cget" option} -body { test textWind-2.6 {TkTextWindowCmd procedure, "cget" option} -setup { destroy .f } -body { - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 1.3 -window .f -padx 1 -pady 2 .t window cget .f -bogus } -cleanup { @@ -134,7 +132,7 @@ test textWind-2.6 {TkTextWindowCmd procedure, "cget" option} -setup { test textWind-2.7 {TkTextWindowCmd procedure, "cget" option} -setup { destroy .f } -body { - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 1.3 -window .f -padx 1 -pady 2 .t window cget .f -pady } -cleanup { @@ -153,13 +151,13 @@ test textWind-2.10 {TkTextWindowCmd procedure} -body { test textWind-2.11 {TkTextWindowCmd procedure} -setup { # I kept this as it "influenced" the test case in previous releases destroy .f - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 1.3 -window .f -padx 1 -pady 2 .t delete 1.0 end } -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo update .t window configure .f @@ -169,13 +167,13 @@ test textWind-2.11 {TkTextWindowCmd procedure} -setup { test textWind-2.12 {TkTextWindowCmd procedure} -setup { # I kept this as it "influenced" the test case in previous releases destroy .f - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo .t delete 1.0 end } -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo update list [.t window configure .f -padx 33] [.t window configure .f -padx] @@ -185,13 +183,13 @@ test textWind-2.12 {TkTextWindowCmd procedure} -setup { test textWind-2.13 {TkTextWindowCmd procedure} -setup { # I kept this as it "influenced" the test case in previous releases destroy .f - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo .t delete 1.0 end } -body { .t insert end "This is the first line" .t insert end "\nAnd this is a second line, which wraps around" - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 update list [.t window configure .f -padx 14 -pady 15] \ @@ -212,12 +210,12 @@ test textWind-2.15 {TkTextWindowCmd procedure} -setup { test textWind-2.16 {TkTextWindowCmd procedure, don't insert after end} -setup { # I kept this as it "influenced" the test case in previous releases destroy .f - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 .t delete 1.0 end } -body { .t insert end "Line 1\nLine 2" - frame .f -width 20 -height 10 -bg $color + frame .f -width 20 -height 10 -background $color .t window create end -window .f .t index .f } -result {2.6} @@ -229,21 +227,21 @@ test textWind-2.17 {TkTextWindowCmd procedure} -setup { test textWind-2.18 {TkTextWindowCmd procedure} -setup { # I kept this as it "influenced" the test case in previous releases destroy .f - frame .f -width 20 -height 10 -bg $color + frame .f -width 20 -height 10 -background $color .t window create end -window .f .t delete 1.0 end } -body { - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 1.0 -window .f -gorp stupid } -returnCodes error -result {unknown option "-gorp"} test textWind-2.19 {TkTextWindowCmd procedure} -setup { # I kept this as it "influenced" the test case in previous releases destroy .f - frame .f -width 20 -height 10 -bg $color + frame .f -width 20 -height 10 -background $color .t window create end -window .f .t delete 1.0 end } -body { - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color catch {.t window create 1.0 -window .f -gorp stupid} list [winfo exists .f] [.t index 1.end] [catch {.t index .f}] } -result {0 1.0 1} @@ -251,14 +249,14 @@ test textWind-2.20 {TkTextWindowCmd procedure} -setup { .t delete 1.0 end destroy .f } -body { - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 1.0 -gorp -window .f stupid } -returnCodes error -result {unknown option "-gorp"} test textWind-2.21 {TkTextWindowCmd procedure} -setup { .t delete 1.0 end destroy .f } -body { - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color catch {.t window create 1.0 -gorp -window .f stupid} list [winfo exists .f] [.t index 1.end] [catch {.t index .f}] } -result {1 1.0 1} @@ -291,11 +289,10 @@ test textWind-2.25 {TkTextWindowCmd procedure, "names" option} -setup { destroy .f .f2 .t.f .t.f2 } -result {.f .f2 .t.f .t.f2} - test textWind-3.1 {EmbWinConfigure procedure} -setup { destroy .f } -body { - frame .f -width 10 -height 6 -bg $color + frame .f -width 10 -height 6 -background $color .t window create 1.0 -window .f .t window configure 1.0 -foo bar } -cleanup { @@ -305,7 +302,7 @@ test textWind-3.2 {EmbWinConfigure procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.3 -window .f update .t window configure 1.3 -window {} @@ -318,7 +315,7 @@ test textWind-3.3 {EmbWinConfigure procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.3 -window .f update .t window configure 1.3 -window {} @@ -332,7 +329,7 @@ test textWind-3.4 {EmbWinConfigure procedure} -constraints fonts -setup { destroy .t.f } -body { .t insert 1.0 "Some sample text" - frame .t.f -width 10 -height 20 -bg $color + frame .t.f -width 10 -height 20 -background $color .t window create 1.3 -window .t.f update .t window configure 1.3 -window {} @@ -345,7 +342,7 @@ test textWind-3.5 {EmbWinConfigure procedure} -constraints fonts -setup { destroy .t.f } -body { .t insert 1.0 "Some sample text" - frame .t.f -width 10 -height 20 -bg $color + frame .t.f -width 10 -height 20 -background $color .t window create 1.3 -window .t.f update .t window configure 1.3 -window {} @@ -359,7 +356,7 @@ test textWind-3.6 {EmbWinConfigure procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.3 update .t window configure 1.3 -window .f @@ -373,7 +370,7 @@ test textWind-3.7 {EmbWinConfigure procedure} -setup { } -body { .t insert 1.0 "Some sample text" frame .f - frame .f.f -width 15 -height 20 -bg $color + frame .f.f -width 15 -height 20 -background $color pack .f.f .t window create 1.3 -window .f.f } -cleanup { @@ -383,7 +380,7 @@ test textWind-3.8 {EmbWinConfigure procedure} -setup { destroy .t2 } -body { .t insert 1.0 "Some sample text" - toplevel .t2 -width 20 -height 10 -bg $color + toplevel .t2 -width 20 -height 10 -background $color .t window create 1.3 .t window configure 1.3 -window .t2 } -cleanup { @@ -393,7 +390,7 @@ test textWind-3.9 {EmbWinConfigure procedure} -setup { destroy .t2 } -body { .t insert 1.0 "Some sample text" - toplevel .t2 -width 20 -height 10 -bg $color + toplevel .t2 -width 20 -height 10 -background $color .t window create 1.3 catch {.t window configure 1.3 -window .t2} .t window configure 1.3 -window @@ -420,9 +417,8 @@ test textWind-3.11 {EmbWinConfigure procedure} -setup { .t index .t.b } -result {1.6} - .t delete 1.0 end -frame .f -width 10 -height 20 -bg $color +frame .f -width 10 -height 20 -background $color .t window create 1.0 -window .f test textWind-4.1 {AlignParseProc and AlignPrintProc procedures} -body { .t window configure 1.0 -align baseline @@ -450,13 +446,12 @@ test textWind-4.6 {AlignParseProc and AlignPrintProc procedures} -body { .t window configure 1.0 -align } -result {-align {} {} center top} - test textWind-5.1 {EmbWinStructureProc procedure} -constraints fonts -setup { .t delete 1.0 end destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.2 -window .f update destroy .f @@ -467,7 +462,7 @@ test textWind-5.2 {EmbWinStructureProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.2 -window .f update destroy .f @@ -479,7 +474,7 @@ test textWind-5.3 {EmbWinStructureProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.2 -align bottom .t window configure 1.2 -window .f update @@ -490,7 +485,7 @@ test textWind-5.4 {EmbWinStructureProc procedure} -constraints fonts -setup { .t delete 1.0 end } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.2 -align bottom .t window configure 1.2 -window .f update @@ -503,22 +498,21 @@ test textWind-5.5 {EmbWinStructureProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - .t window create 1.2 -create {frame .f -width 10 -height 20 -bg $color} + .t window create 1.2 -create {frame .f -width 10 -height 20 -background $color} update - .t window configure 1.2 -create {frame .f -width 20 -height 10 -bg $color} + .t window configure 1.2 -create {frame .f -width 20 -height 10 -background $color} destroy .f update list [catch {.t index .f} msg] $msg [.t bbox 1.2] [.t bbox 1.3] } -result {0 1.2 {19 6 20 10} {39 5 7 13}} - test textWind-6.1 {EmbWinRequestProc procedure} -constraints fonts -setup { .t delete 1.0 end destroy .f set result {} } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.2 -window .f lappend result [.t bbox 1.2] [.t bbox 1.3] .f configure -width 25 -height 30 @@ -527,7 +521,6 @@ test textWind-6.1 {EmbWinRequestProc procedure} -constraints fonts -setup { destroy .f } -result {{19 5 10 20} {29 8 7 13} {19 5 25 30} {44 13 7 13}} - test textWind-7.1 {EmbWinLostSlaveProc procedure} -constraints { textfonts } -setup { @@ -535,7 +528,7 @@ test textWind-7.1 {EmbWinLostSlaveProc procedure} -constraints { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.2 -window .f update place .f -in .t -x 100 -y 50 @@ -543,7 +536,7 @@ test textWind-7.1 {EmbWinLostSlaveProc procedure} -constraints { list [winfo geom .f] [.t bbox 1.2] } -cleanup { destroy .f -} -result [list 10x20+105+55 [list 19 [expr {11+$fixedDiff/2}] 0 0]] +} -result [list 10x20+105+55 [list 19 [expr {11 + ($fixedDiff / 2)}] 0 0]] test textWind-7.2 {EmbWinLostSlaveProc procedure} -constraints { textfonts } -setup { @@ -551,7 +544,7 @@ test textWind-7.2 {EmbWinLostSlaveProc procedure} -constraints { destroy .t.f } -body { .t insert 1.0 "Some sample text" - frame .t.f -width 10 -height 20 -bg $color + frame .t.f -width 10 -height 20 -background $color .t window create 1.2 -window .t.f update place .t.f -x 100 -y 50 @@ -559,15 +552,14 @@ test textWind-7.2 {EmbWinLostSlaveProc procedure} -constraints { list [winfo geom .t.f] [.t bbox 1.2] } -cleanup { destroy .t.f -} -result [list 10x20+105+55 [list 19 [expr {11+$fixedDiff/2}] 0 0]] - +} -result [list 10x20+105+55 [list 19 [expr {11 + ($fixedDiff / 2)}] 0 0]] test textWind-8.1 {EmbWinDeleteProc procedure} -constraints fonts -setup { .t delete 1.0 end destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.2 -window .f bind .f <Destroy> {set x destroyed} set x XXX @@ -579,7 +571,7 @@ test textWind-8.2 {EmbWinDeleteProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 1.2 -window .f bind .f <Destroy> {set x destroyed} set x XXX @@ -587,13 +579,12 @@ test textWind-8.2 {EmbWinDeleteProc procedure} -constraints fonts -setup { .t index .f } -returnCodes error -result {bad text index ".f"} - test textWind-9.1 {EmbWinCleanupProc procedure} -setup { .t delete 1.0 end destroy .f } -body { .t insert 1.0 "Some sample text\nA second line." - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color .t window create 2.3 -window .f .t delete 1.5 2.1 .t index .f @@ -601,14 +592,13 @@ test textWind-9.1 {EmbWinCleanupProc procedure} -setup { destroy .f } -result {1.7} - test textWind-10.1 {EmbWinLayoutProc procedure} -setup { .t delete 1.0 end destroy .f } -body { .t insert 1.0 "Some sample text" .t window create 1.5 -create { - frame .f -width 10 -height 20 -bg $color + frame .f -width 10 -height 20 -background $color } update list [winfo exists .f] [winfo width .f] [winfo height .f] [.t index .f] @@ -651,13 +641,13 @@ test textWind-10.3 {EmbWinLayoutProc procedure, error in creating window} -const update list $msg [.t bbox 1.5] } -cleanup { - rename bgerror {} + rename bgerror "" } -result {{{bad window path name "gorp"}} {40 11 0 0}} .t delete 1.0 end destroy .t.f - proc bgerror args { + proc bgerror {args} { global msg - if {[lsearch -exact $msg $args] == -1} { + if {$args ni $msg} { lappend msg $args } } @@ -669,7 +659,7 @@ test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} -const destroy .t.f proc bgerror args { global msg - if {[lsearch -exact $msg $args] == -1} { + if {$args ni $msg} { lappend msg $args } } @@ -679,7 +669,7 @@ test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} -const after idle { .t window create 1.5 -create { frame .t.f - frame .t.f.f -width 10 -height 20 -bg $color + frame .t.f.f -width 10 -height 20 -background $color } } set count 0 @@ -693,7 +683,7 @@ test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} -const } -cleanup { destroy .t.f rename bgerror {} -} -result [list {{can't embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0] 1] +} -result [list {{can't embed .t.f.f relative to .t}} {{window name "f" already exists in parent}} [list 40 [expr {11 + ($fixedDiff / 2)}] 0 0] 1] test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} -constraints { textfonts } -setup { @@ -701,7 +691,7 @@ test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} -const destroy .t.f proc bgerror args { global msg - if {[lsearch -exact $msg $args] == -1} { + if {$args ni $msg} { lappend msg $args } } @@ -709,23 +699,23 @@ test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} -const .t insert 1.0 "Some sample text" .t window create 1.5 -create { frame .t.f - frame .t.f.f -width 10 -height 20 -bg $color + frame .t.f.f -width 10 -height 20 -background $color } set msg {} update idletasks lappend msg [winfo exists .t.f.f] } -cleanup { destroy .t.f - rename bgerror {} + rename bgerror "" } -result {{{can't embed .t.f.f relative to .t}} 1} -catch {destroy .t.f} +destroy .t.f test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} -constraints { textfonts } -setup { .t delete 1.0 end proc bgerror args { global msg - if {[lsearch -exact $msg $args] == -1} { + if {$args ni $msg} { lappend msg $args } } @@ -739,7 +729,7 @@ test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} -const lappend msg [.t bbox 1.5] } -cleanup { rename bgerror {} -} -result [list {{can't embed .t relative to .t}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] +} -result [list {{can't embed .t relative to .t}} [list 40 [expr {11 + ($fixedDiff / 2)}] 0 0]] test textWind-10.7 {EmbWinLayoutProc procedure, error in creating window} -constraints { textfonts } -setup { @@ -747,7 +737,7 @@ test textWind-10.7 {EmbWinLayoutProc procedure, error in creating window} -const destroy .t2 proc bgerror args { global msg - if {[lsearch -exact $msg $args] == -1} { + if {$args ni $msg} { lappend msg $args } } @@ -763,13 +753,13 @@ test textWind-10.7 {EmbWinLayoutProc procedure, error in creating window} -const lappend msg [.t bbox 1.5] } -cleanup { rename bgerror {} -} -result [list {{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}} [list 40 [expr {11+$fixedDiff/2}] 0 0]] +} -result [list {{can't embed .t2 relative to .t}} {{window name "t2" already exists in parent}} [list 40 [expr {11 + ($fixedDiff / 2)}] 0 0]] test textWind-10.8 {EmbWinLayoutProc procedure, error in creating window} -setup { .t delete 1.0 end destroy .t2 proc bgerror args { global msg - if {[lsearch -exact $msg $args] == -1} { + if {$args ni $msg} { lappend msg $args } } @@ -783,7 +773,7 @@ test textWind-10.8 {EmbWinLayoutProc procedure, error in creating window} -setup set msg {} update set i 0 - while {[llength $msg] == 1 && [incr i] < 200} { update } + while {([llength $msg] == 1) && ([incr i] < 200)} { update } return $msg } -cleanup { destroy .t2 @@ -812,7 +802,7 @@ test textWind-10.10 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain } -body { .t configure -wrap char .t insert 1.0 "Some sample text" - frame .f -width 125 -height 20 -bg $color -bd 2 -relief raised + frame .f -width 125 -height 20 -background $color -borderwidth 2 -relief raised .t window create 1.12 -window .f list [.t bbox .f] [.t bbox 1.13] } -cleanup { @@ -826,7 +816,7 @@ test textWind-10.11 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain } -body { .t configure -wrap char .t insert 1.0 "Some sample text" - frame .f -width 126 -height 20 -bg $color -bd 2 -relief raised + frame .f -width 126 -height 20 -background $color -borderwidth 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] @@ -841,7 +831,7 @@ test textWind-10.12 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain } -body { .t configure -wrap char .t insert 1.0 "Some sample text" - frame .f -width 127 -height 20 -bg $color -bd 2 -relief raised + frame .f -width 127 -height 20 -background $color -borderwidth 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] @@ -854,7 +844,7 @@ test textWind-10.13 {EmbWinLayoutProc procedure, doesn't fit on line} -setup { } -body { .t configure -wrap none .t insert 1.0 "Some sample text" - frame .f -width 130 -height 20 -bg $color -bd 2 -relief raised + frame .f -width 130 -height 20 -background $color -borderwidth 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] @@ -869,7 +859,7 @@ test textWind-10.14 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain } -body { .t configure -wrap none .t insert 1.0 "Some sample text" - frame .f -width 130 -height 220 -bg $color -bd 2 -relief raised + frame .f -width 130 -height 220 -background $color -borderwidth 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] @@ -884,7 +874,7 @@ test textWind-10.15 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain } -body { .t configure -wrap char .t insert 1.0 "Some sample text" - frame .f -width 250 -height 220 -bg $color -bd 2 -relief raised + frame .f -width 250 -height 220 -background $color -borderwidth 2 -relief raised .t window create 1.12 -window .f update list [.t bbox .f] [.t bbox 1.13] @@ -892,7 +882,6 @@ test textWind-10.15 {EmbWinLayoutProc procedure, doesn't fit on line} -constrain destroy .f } -result {{5 18 210 65} {}} - test textWind-11.1 {EmbWinDisplayProc procedure, geometry transforms} -setup { .t delete 1.0 end destroy .f @@ -902,7 +891,7 @@ test textWind-11.1 {EmbWinDisplayProc procedure, geometry transforms} -setup { .t insert 1.0 "Some sample text" pack forget .t place .t -x 30 -y 50 - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create 1.12 -window .f update winfo geom .f @@ -919,7 +908,7 @@ test textWind-11.2 {EmbWinDisplayProc procedure, geometry transforms} -setup { .t insert 1.0 "Some sample text" pack forget .t place .t -x 30 -y 50 - frame .t.f -width 30 -height 20 -bg $color + frame .t.f -width 30 -height 20 -background $color .t window create 1.12 -window .t.f update winfo geom .t.f @@ -935,7 +924,7 @@ test textWind-11.3 {EmbWinDisplayProc procedure, configuration optimization} -se pack .t } -body { .t insert 1.0 "Some sample text" - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create 1.12 -window .f update bind .f <Configure> {set x ".f configured"} @@ -957,10 +946,10 @@ test textWind-11.4 {EmbWinDisplayProc procedure, horizontal scrolling} -constrai } -body { .t insert 1.0 "xyzzy\nFirst window here: " .t configure -wrap none - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create end -window .f .t insert end " and second here: " - frame .f2 -width 40 -height 10 -bg $color + frame .f2 -width 40 -height 10 -background $color .t window create end -window .f2 .t insert end " with junk after it." .t xview moveto 0 @@ -978,10 +967,10 @@ test textWind-11.5 {EmbWinDisplayProc procedure, horizontal scrolling} -constrai } -body { .t insert 1.0 "xyzzy\nFirst window here: " .t configure -wrap none - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create end -window .f .t insert end " and second here: " - frame .f2 -width 40 -height 10 -bg $color + frame .f2 -width 40 -height 10 -background $color .t window create end -window .f2 .t insert end " with junk after it." update @@ -994,13 +983,12 @@ test textWind-11.5 {EmbWinDisplayProc procedure, horizontal scrolling} -constrai } -result {0 1 40x10+119+23 {119 23 40 10}} .t configure -wrap char - test textWind-12.1 {EmbWinUndisplayProc procedure, mapping/unmapping} -setup { .t delete 1.0 end destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create 1.2 -window .f bind .f <Map> {lappend x mapped} bind .f <Unmap> {lappend x unmapped} @@ -1023,13 +1011,12 @@ test textWind-12.1 {EmbWinUndisplayProc procedure, mapping/unmapping} -setup { destroy .f } -result {created mapped modified replaced unmapped mapped off-screen unmapped} - test textWind-13.1 {EmbWinBboxProc procedure} -setup { .t delete 1.0 end destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 1.2 -window .f -align top -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] @@ -1041,7 +1028,7 @@ test textWind-13.2 {EmbWinBboxProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 1.2 -window .f -align center -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] @@ -1053,7 +1040,7 @@ test textWind-13.3 {EmbWinBboxProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 1.2 -window .f -align baseline -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] @@ -1065,7 +1052,7 @@ test textWind-13.4 {EmbWinBboxProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 1.2 -window .f -align bottom -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] @@ -1077,7 +1064,7 @@ test textWind-13.5 {EmbWinBboxProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 1.2 -window .f -align top -padx 2 -pady 1 -stretch 1 update list [winfo geom .f] [.t bbox .f] @@ -1089,7 +1076,7 @@ test textWind-13.6 {EmbWinBboxProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 1.2 -window .f -align center -padx 2 -pady 1 -stretch 1 update list [winfo geom .f] [.t bbox .f] @@ -1101,7 +1088,7 @@ test textWind-13.7 {EmbWinBboxProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 1.2 -window .f -align baseline -padx 2 -pady 1 -stretch 1 update list [winfo geom .f] [.t bbox .f] @@ -1113,7 +1100,7 @@ test textWind-13.8 {EmbWinBboxProc procedure} -constraints fonts -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 1.2 -window .f -align bottom -padx 2 -pady 1 -stretch 1 update list [winfo geom .f] [.t bbox .f] @@ -1129,7 +1116,7 @@ test textWind-13.9 {EmbWinBboxProc procedure, spacing options} -constraints { .t configure -spacing1 5 -spacing3 2 .t delete 1.0 end .t insert 1.0 "Some sample text" - frame .f -width 5 -height 5 -bg $color + frame .f -width 5 -height 5 -background $color .t window create 1.2 -window .f -align center -padx 2 -pady 1 update list [winfo geom .f] [.t bbox .f] @@ -1137,13 +1124,12 @@ test textWind-13.9 {EmbWinBboxProc procedure, spacing options} -constraints { destroy .f } -result {5x5+21+14 {21 14 5 5}} - test textWind-14.1 {EmbWinDelayedUnmap procedure} -setup { .t delete 1.0 end destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create 1.2 -window .f update bind .f <Unmap> {lappend x unmapped} @@ -1162,7 +1148,7 @@ test textWind-14.2 {EmbWinDelayedUnmap procedure} -setup { destroy .f } -body { .t insert 1.0 "Some sample text" - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create 1.2 -window .f update bind .f <Unmap> {lappend x unmapped} @@ -1181,7 +1167,7 @@ test textWind-14.3 {EmbWinDelayedUnmap procedure} -setup { destroy .f } -body { .t insert 1.0 "Some sample text\nAnother line\n3\n4\n5\n6\n7\n8\n9" - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create 1.2 -window .f update .t yview 2.0 @@ -1196,7 +1182,7 @@ test textWind-14.4 {EmbWinDelayedUnmap procedure} -setup { destroy .t.f } -body { .t insert 1.0 "Some sample text\nAnother line\n3\n4\n5\n6\n7\n8\n9" - frame .t.f -width 30 -height 20 -bg $color + frame .t.f -width 30 -height 20 -background $color .t window create 1.2 -window .t.f update .t yview 2.0 @@ -1207,7 +1193,6 @@ test textWind-14.4 {EmbWinDelayedUnmap procedure} -setup { destroy .t.f } -result {1 0} - test textWind-15.1 {TkTextWindowIndex procedure} -setup { .t delete 1.0 end } -body { @@ -1220,7 +1205,7 @@ test textWind-15.2 {TkTextWindowIndex procedure} -constraints fonts -setup { .t configure -spacing1 0 -spacing2 0 -spacing3 0 \ -wrap none .t insert 1.0 "Some sample text" - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create 1.6 -window .f .t tag add a 1.1 .t tag add a 1.3 @@ -1229,14 +1214,13 @@ test textWind-15.2 {TkTextWindowIndex procedure} -constraints fonts -setup { destroy .f } -result {1.6 {77 8 7 13}} - test textWind-16.1 {EmbWinTextStructureProc procedure} -setup { .t delete 1.0 end destroy .f } -body { .t configure -wrap none .t insert 1.0 "Some sample text" - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create 1.6 -window .f update pack forget .t @@ -1252,12 +1236,12 @@ test textWind-16.2 {EmbWinTextStructureProc procedure} -setup { .t configure -spacing1 0 -spacing2 0 -spacing3 0 \ -wrap none .t insert 1.0 "Some sample text" - frame .f -width 30 -height 20 -bg $color + frame .f -width 30 -height 20 -background $color .t window create 1.6 -window .f update set result {} lappend result [winfo geom .f] [.t bbox .f] - frame .f2 -width 150 -height 30 -bd 2 -relief raised + frame .f2 -width 150 -height 30 -borderwidth 2 -relief raised pack .f2 -before .t update lappend result [winfo geom .f] [.t bbox .f] @@ -1282,7 +1266,7 @@ test textWind-16.4 {EmbWinTextStructureProc procedure} -setup { .t configure -spacing1 0 -spacing2 0 -spacing3 0 \ -wrap none .t insert 1.0 "Some sample text" - frame .t.f -width 30 -height 20 -bg $color + frame .t.f -width 30 -height 20 -background $color .t window create 1.6 -window .t.f update pack forget .t @@ -1292,13 +1276,12 @@ test textWind-16.4 {EmbWinTextStructureProc procedure} -setup { pack .t } -result {1 {47 5 30 20}} - test textWind-17.1 {peer widgets and embedded windows} -setup { destroy .t .tt .f } -body { pack [text .t] .t insert end "Line 1" - frame .f -width 20 -height 10 -bg blue + frame .f -width 20 -height 10 -background blue .t window create 1.3 -window .f toplevel .tt pack [.t peer create .tt.t] @@ -1312,7 +1295,7 @@ test textWind-17.2 {peer widgets and embedded windows} -setup { } -body { pack [text .t] .t insert end "Line 1\nLine 2" - frame .f -width 20 -height 10 -bg blue + frame .f -width 20 -height 10 -background blue .t window create 1.4 -window .f toplevel .tt pack [.t peer create .tt.t] @@ -1332,7 +1315,7 @@ test textWind-17.3 {peer widget and -create} -setup { toplevel .tt pack [.t peer create .tt.t] update ; update - .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} + .t window create 1.2 -create {frame %W.f -width 10 -height 20 -background blue} update destroy .t .tt } -result {} @@ -1346,7 +1329,7 @@ test textWind-17.4 {peer widget deleted one window shouldn't delete others} -set .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] - .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} + .t window create 1.2 -create {frame %W.f -width 10 -height 20 -background blue} update ; update destroy .tt lappend res [.t get 1.2] @@ -1364,7 +1347,7 @@ test textWind-17.5 {peer widget window configuration} -setup { .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] - .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} + .t window create 1.2 -create {frame %W.f -width 10 -height 20 -background blue} update ; update list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window] } -cleanup { @@ -1379,7 +1362,7 @@ test textWind-17.6 {peer widget window configuration} -setup { .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] - .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue} + .t window create 1.2 -create {frame %W.f -width 10 -height 20 -background blue} update ; update list [.t window configure 1.2 -window] \ [.tt.t window configure 1.2 -window] @@ -1395,7 +1378,7 @@ test textWind-17.7 {peer widget window configuration} -setup { .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] - .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] + .t window create 1.2 -window [frame .t.f -width 10 -height 20 -background blue] update ; update list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window] } -cleanup { @@ -1410,7 +1393,7 @@ test textWind-17.8 {peer widget window configuration} -setup { .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] - .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] + .t window create 1.2 -window [frame .t.f -width 10 -height 20 -background blue] update ; update list [.t window configure 1.2 -window] \ [.tt.t window configure 1.2 -window] @@ -1426,9 +1409,9 @@ test textWind-17.9 {peer widget window configuration} -setup { .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] - .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] + .t window create 1.2 -window [frame .t.f -width 10 -height 20 -background blue] update ; update - .tt.t window configure 1.2 -window [frame .tt.t.f -width 10 -height 20 -bg red] + .tt.t window configure 1.2 -window [frame .tt.t.f -width 10 -height 20 -background red] list [.t window configure 1.2 -window] [.tt.t window configure 1.2 -window] } -cleanup { destroy .tt .t @@ -1442,11 +1425,11 @@ test textWind-17.10 {peer widget window configuration} -setup { .t insert 1.0 "Some sample text" toplevel .tt pack [.t peer create .tt.t] - .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue] - .tt.t window create 1.2 -window [frame .tt.t.f -width 25 -height 20 -bg blue] + .t window create 1.2 -window [frame .t.f -width 10 -height 20 -background blue] + .tt.t window create 1.2 -window [frame .tt.t.f -width 25 -height 20 -background blue] update ; update .t window configure 1.2 -create \ - {destroy %W.f ; frame %W.f -width 50 -height 7 -bg red} + {destroy %W.f ; frame %W.f -width 50 -height 7 -background red} .tt.t window configure 1.2 -window {} .t window configure 1.2 -window {} set res [list [.t window configure 1.2 -window] \ diff --git a/tests/tk.test b/tests/tk.test index 748a6cf..5a565a9 100644 --- a/tests/tk.test +++ b/tests/tk.test @@ -157,7 +157,7 @@ test tk-6.5 {tk inactive} -body { update after 100 set i [tk inactive] - expr {$i == -1 || ( $i > 90 && $i < 200 )} + expr {($i == -1) || ( ($i > 90) && ($i < 200) )} } -result 1 test tk-7.1 {tk inactive in a safe interpreter} -body { diff --git a/tests/ttk/checkbutton.test b/tests/ttk/checkbutton.test index e18ff32..ec58173 100644 --- a/tests/ttk/checkbutton.test +++ b/tests/ttk/checkbutton.test @@ -3,8 +3,9 @@ # package require Tk -package require tcltest ; namespace import -force tcltest::* -loadTestedCommands +package require tcltest +namespace import -force tcltest::* +tcltest::loadTestedCommands test checkbutton-1.1 "Checkbutton check" -body { pack [ttk::checkbutton .cb -text "TCheckbutton" -variable cb] @@ -43,6 +44,6 @@ test checkbutton-1.6 "Checkbutton default variable" -body { lappend result [info exists .cb] [set .cb] [.cb state] .cb invoke lappend result [info exists .cb] [set .cb] [.cb state] -} -result [list .cb 0 alternate 1 on selected 1 off {}] +} -result [list .cb 0 alternate 1 on selected 1 off ""] tcltest::cleanupTests diff --git a/tests/ttk/combobox.test b/tests/ttk/combobox.test index 43f3cf1..28eb459 100644 --- a/tests/ttk/combobox.test +++ b/tests/ttk/combobox.test @@ -3,8 +3,9 @@ # package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* -loadTestedCommands +package require tcltest +namespace import -force tcltest::* +::tcltest::loadTestedCommands test combobox-1.0 "Combobox tests -- setup" -body { ttk::combobox .cb @@ -45,7 +46,6 @@ test combobox-2.4 "current -- value not in list" -body { test combobox-2.end "Cleanup" -body { destroy .cb } - test combobox-1890211 "ComboboxSelected event after listbox unposted" -body { # whitebox test... pack [ttk::combobox .cb -values [list a b c]] @@ -61,7 +61,7 @@ test combobox-1890211 "ComboboxSelected event after listbox unposted" -body { lappend result Select [winfo ismapped .cb.popdown] [.cb get] update set result -} -result [list Start 0 {} Post 1 {} Select 0 b Event 0 b] -cleanup { +} -result [list Start 0 "" Post 1 "" Select 0 b Event 0 b] -cleanup { destroy .cb } diff --git a/tests/ttk/entry.test b/tests/ttk/entry.test index 0c2f0be..25e8194 100644 --- a/tests/ttk/entry.test +++ b/tests/ttk/entry.test @@ -3,11 +3,12 @@ # package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands variable scrollInfo -proc scroll args { +proc scroll {args} { global scrollInfo set scrollInfo $args } @@ -17,9 +18,10 @@ proc scroll args { # variable bgerror "" proc bgerror {error} { + global errorInfo errorCode variable bgerror $error - variable bgerrorInfo $::errorInfo - variable bgerrorCode $::errorCode + variable bgerrorInfo $errorInfo + variable bgerrorCode $errorCode } # @@ -96,6 +98,7 @@ test entry-3.0 "Series 3 setup" -body { } test entry-3.1 "bbox widget command" -body { + variable bd ch .e delete 0 end .e bbox 0 } -result [list $bd $bd 0 $ch] @@ -190,7 +193,7 @@ test entry-6.1 {Update linked variable in write trace} -body { global x set x "Overridden!" } - catch {destroy .e} + destroy .e set x "" trace variable x w override ttk::entry .e -textvariable x diff --git a/tests/ttk/image.test b/tests/ttk/image.test index a55f7f8..f239b8f 100644 --- a/tests/ttk/image.test +++ b/tests/ttk/image.test @@ -1,5 +1,6 @@ package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands test image-1.1 "Bad image element" -body { diff --git a/tests/ttk/labelframe.test b/tests/ttk/labelframe.test index 28b4d2e..c095853 100644 --- a/tests/ttk/labelframe.test +++ b/tests/ttk/labelframe.test @@ -1,5 +1,6 @@ package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands test labelframe-1.0 "Setup" -body { diff --git a/tests/ttk/layout.test b/tests/ttk/layout.test index 814e1d9..227246a 100644 --- a/tests/ttk/layout.test +++ b/tests/ttk/layout.test @@ -1,5 +1,6 @@ package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands test layout-1.1 "Size computations for mixed-orientation layouts" -body { @@ -21,5 +22,4 @@ test layout-1.1 "Size computations for mixed-orientation layouts" -body { } -cleanup { destroy .b } -result [list 24 24] - tcltest::cleanupTests diff --git a/tests/ttk/notebook.test b/tests/ttk/notebook.test index cdce020..7b9a2dc 100644 --- a/tests/ttk/notebook.test +++ b/tests/ttk/notebook.test @@ -1,5 +1,6 @@ package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands test notebook-1.0 "Setup" -body { @@ -405,7 +406,7 @@ test notebook-7.8a "move tabs - current tab undisturbed - exhaustive" -body { foreach k {0 1 2 3 4} { .nb insert $j $k set current [lindex [.nb tabs] [.nb index current]] - if {$current != ".nb.f$i"} { + if {$current ne ".nb.f$i"} { error "($i,$j,$k) current = $current" } .nb insert $k $j @@ -425,7 +426,7 @@ test notebook-7.8b "insert new - current tab undisturbed - exhaustive" -body { .nb select .nb.f$i .nb insert $j [frame .nb.newf] set current [lindex [.nb tabs] [.nb index current]] - if {$current != ".nb.f$i"} { + if {$current ne ".nb.f$i"} { puts stderr "new tab at $j, current = $current, expect .nb.f$i" } destroy .nb.newf diff --git a/tests/ttk/panedwindow.test b/tests/ttk/panedwindow.test index 7fe5c87..3fbeea1 100644 --- a/tests/ttk/panedwindow.test +++ b/tests/ttk/panedwindow.test @@ -1,5 +1,6 @@ package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands proc propagate-geometry {} { update idletasks } @@ -88,7 +89,7 @@ test panedwindow-2.2 "..., cont'd" -body { set w3 [winfo width .] set rw3 [winfo reqwidth .pw] - expr {$w3 == $w2 && $rw3 < $rw2} + expr {($w3 == $w2) && ($rw3 < $rw2)} # problem: [winfo reqwidth] shrinks, but sashes haven't moved # since we haven't gotten a ConfigureNotify. # How to (a) check for this, and (b) fix it? @@ -124,10 +125,8 @@ test panedwindow-3.2 "add pane -- errors" -body { .pw add [ttk::label .pw.l] -weight -1 } -returnCodes 1 -match glob -result "-weight must be nonnegative" - test panedwindow-3.end "cleanup" -body { destroy .pw } - test panedwindow-4.1 "forget" -body { pack [ttk::panedwindow .pw -orient vertical] -expand true -fill both .pw add [label .pw.l1 -text "L1"] @@ -201,7 +200,7 @@ test panedwindow-5.1 "Propagate Map/Unmap state to children" -body { proc sashpositions {pw} { set positions [list] set npanes [llength [winfo children $pw]] - for {set i 0} {$i < $npanes - 1} {incr i} { + for {set i 0} {$i < ($npanes - 1)} {incr i} { lappend positions [$pw sashpos $i] } return $positions @@ -219,7 +218,7 @@ test paned-sashpos-setup "Setup for sash position test" -body { propagate-geometry list [winfo reqwidth .pw] [winfo reqheight .pw] -} -result [list 20 [expr {20*4 + 5*3}]] +} -result [list 20 [expr {(20 * 4) + (5 * 3)}]] test paned-sashpos-attempt-restore "Attempt to set sash positions" -body { # This is not expected to succeed, since .pw isn't large enough yet. diff --git a/tests/ttk/progressbar.test b/tests/ttk/progressbar.test index b9add86..98ce72d 100644 --- a/tests/ttk/progressbar.test +++ b/tests/ttk/progressbar.test @@ -1,8 +1,8 @@ package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force ::tcltest::* loadTestedCommands - test progressbar-1.1 "Setup" -body { ttk::progressbar .pb } -result .pb diff --git a/tests/ttk/radiobutton.test b/tests/ttk/radiobutton.test index ba02954..397602b 100644 --- a/tests/ttk/radiobutton.test +++ b/tests/ttk/radiobutton.test @@ -3,7 +3,8 @@ # package require Tk -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands test radiobutton-1.1 "Radiobutton check" -body { diff --git a/tests/ttk/scrollbar.test b/tests/ttk/scrollbar.test index 0464273..3a2e17b 100644 --- a/tests/ttk/scrollbar.test +++ b/tests/ttk/scrollbar.test @@ -1,5 +1,6 @@ package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands testConstraint coreScrollbar [expr {[tk windowingsystem] eq "aqua"}] diff --git a/tests/ttk/spinbox.test b/tests/ttk/spinbox.test index 3397e37..93290ec 100644 --- a/tests/ttk/spinbox.test +++ b/tests/ttk/spinbox.test @@ -3,7 +3,8 @@ # package require Tk -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands test spinbox-1.0 "Spinbox tests -- setup" -body { @@ -54,7 +55,6 @@ test spinbox-1.4.2 "set changes value" -setup { destroy .sb } -result 33 - test spinbox-1.6.1 "insert start" -setup { ttk::spinbox .sb -from 0 -to 100 } -body { @@ -150,7 +150,6 @@ test spinbox-1.8.4 "-validate option: " -setup { destroy .sb } -result {50} - test spinbox-2.0 "current command -- unset should be 0" -constraints nyi -setup { ttk::spinbox .sb -values [list a b c d e a] } -body { diff --git a/tests/ttk/treetags.test b/tests/ttk/treetags.test index 7f26e2f..e9ca8d1 100644 --- a/tests/ttk/treetags.test +++ b/tests/ttk/treetags.test @@ -1,6 +1,7 @@ package require Tk -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands ### treeview tag invariants: diff --git a/tests/ttk/treeview.test b/tests/ttk/treeview.test index aa7e64a..9372e3f 100644 --- a/tests/ttk/treeview.test +++ b/tests/ttk/treeview.test @@ -4,7 +4,8 @@ # package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands # consistencyCheck -- @@ -14,7 +15,7 @@ loadTestedCommands # Since [$tv children] follows ->next links and [$tv index] # follows ->prev links, this should cover all invariants. # -proc consistencyCheck {tv {item {}}} { +proc consistencyCheck {tv {item ""}} { set i 0; foreach child [$tv children $item] { assert {[$tv parent $child] == $item} "parent $child = $item" @@ -334,7 +335,6 @@ test treeview-5.13 "get, no value" -body { set result } -result {} - test treeview-6.1 "deletion - setup" -body { .tv insert {} end -id dtest foreach id [list a b c d e] { @@ -462,13 +462,15 @@ test treeview-8.5 "Selection - bad operation" -body { ### NEED: more tests for see/yview/scrolling proc scrollcallback {args} { - set ::scrolldata $args + global scrolldata + set scrolldata $args } test treeview-9.0 "scroll callback - empty tree" -body { + global scrolldata .tv configure -yscrollcommand scrollcallback .tv delete [.tv children {}] update - set ::scrolldata + set scrolldata } -result [list 0.0 1.0] ### identify tests: diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test index e58b021..1332338 100644 --- a/tests/ttk/ttk.test +++ b/tests/ttk/ttk.test @@ -1,9 +1,10 @@ package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands -proc skip args {} +proc skip {args} {} proc ok {} { return } variable widgetClasses { @@ -15,9 +16,10 @@ variable widgetClasses { } proc bgerror {error} { + global errorInfo errorCode variable bgerror $error - variable bgerrorInfo $::errorInfo - variable bgerrorCode $::errorCode + variable bgerrorInfo $errorInfo + variable bgerrorCode $errorCode } # Self-destruct tests. @@ -226,7 +228,7 @@ foreach wc $widgetClasses { .w cget $option } } -cleanup { - catch {destroy .w} + destroy .w } } @@ -245,7 +247,8 @@ test ttk-3.2 "Propagate errors from variable traces" -body { ttk::checkbutton .cb -variable A .cb invoke } -cleanup { - unset ::A ; destroy .cb + unset ::A + destroy .cb } -returnCodes error -result {can't set "A": failure} test ttk-3.3 "Constructor failure with cursor" -body { @@ -267,7 +270,7 @@ test ttk-3.4 "SF#2009213" -body { # test ttk-4.0 "Setup" -body { - catch { destroy .t } + destroy .t pack [ttk::label .t -text "Button 1"] testConstraint fontOption [expr ![catch { set prevFont [.t cget -font] }]] ok @@ -317,17 +320,28 @@ zCDoBooud2PMDIKuRqDocgtGzMwg6O4Eii5z4Kgi6DIMhqLoagQGjiqCLvPgYOgqji6CLrfi variable compoundStrings {text image center top bottom left right none} if {0} { - proc now {} { set ::now [clock clicks -milliseconds] } - proc tick {} { puts -nonewline stderr "+" ; flush stderr } + proc now {} { + global now + set now [clock milliseconds] + } + proc tick {} { + puts -nonewline stderr "+" + flush stderr + } proc tock {} { - set then $::now; set ::now [clock clicks -milliseconds] - puts stderr " [expr {$::now - $then}] ms" + global now + set then $now + set now [clock milliseconds] + puts stderr " [expr {$now - $then}] ms" } } else { - proc now {} {} ; proc tick {} {} ; proc tock {} {} + proc now {} {} + proc tick {} {} + proc tock {} {} } -now ; tick +now +tick test ttk-8.0 "Setup for 8.X" -body { ttk::button .ctb image create photo icon -data $::iconData; @@ -335,7 +349,7 @@ test ttk-8.0 "Setup for 8.X" -body { } tock -now +now test ttk-8.1 "Test -compound options" -body { # Exhaustively test each combination. # Main goal is to make sure no code paths crash. @@ -343,12 +357,13 @@ test ttk-8.1 "Test -compound options" -body { foreach text {"Hi!" ""} { foreach compound $::compoundStrings { .ctb configure -image $image -text $text -compound $compound - update; tick + update + tick } } } } -tock +tock test ttk-8.2 "Test -compound options with regular button" -body { button .rtb @@ -358,24 +373,26 @@ test ttk-8.2 "Test -compound options with regular button" -body { foreach text {"Hi!" ""} { foreach compound [lrange $::compoundStrings 2 end] { .rtb configure -image $image -text $text -compound $compound - update; tick + update + tick } } } } -tock +tock test ttk-8.3 "Rerun test 8.1" -body { foreach image {icon ""} { foreach text {"Hi!" ""} { foreach compound $::compoundStrings { .ctb configure -image $image -text $text -compound $compound - update; tick + update + tick } } } } -tock +tock test ttk-8.4 "ImageChanged" -body { ttk::button .b -image icon @@ -425,9 +442,11 @@ test ttk-9.7 "Unset textvariable, comparison" -body { # NB: this is on purpose: I believe the standard behaviour is the Wrong Thing # unset -nocomplain V1 V2 - label .l -text Foo ; ttk::label .tl -text Foo + label .l -text Foo + ttk::label .tl -text Foo - .l configure -textvariable V1 ; .tl configure -textvariable V2 + .l configure -textvariable V1 + .tl configure -textvariable V2 list [set V1] [info exists V2] } -cleanup { destroy .l .tl } -result [list Foo 0] diff --git a/tests/ttk/validate.test b/tests/ttk/validate.test index 417deac..4d9d5ca 100644 --- a/tests/ttk/validate.test +++ b/tests/ttk/validate.test @@ -22,8 +22,7 @@ test validate-0.0 "Setup" -constraints ttkEntry -body { test validate-0.1 "More setup" -body { destroy .e - catch {unset ::e} - catch {unset ::vVals} + unset -nocomplain ::e ::vVals entry .e -validate all \ -validatecommand [list doval %W %d %i %P %s %S %v %V] \ -invalidcommand bell \ @@ -209,7 +208,7 @@ test validate-2.1 "Validation script changes value" -body { # DIFFERENCE: core entry disables validation, ttk entry does not. destroy .e -catch {unset ::e ::vVals} +unset -nocomplain ::e ::vVals # See bug #1236979 diff --git a/tests/ttk/vsapi.test b/tests/ttk/vsapi.test index bb88fef..450787b 100644 --- a/tests/ttk/vsapi.test +++ b/tests/ttk/vsapi.test @@ -2,7 +2,8 @@ # package require Tk 8.5 -package require tcltest ; namespace import -force tcltest::* +package require tcltest +namespace import -force tcltest::* loadTestedCommands testConstraint xpnative \ diff --git a/tests/unixButton.test b/tests/unixButton.test index 137ef33..b69de3c 100644 --- a/tests/unixButton.test +++ b/tests/unixButton.test @@ -30,12 +30,10 @@ option add *Radiobutton.borderWidth 2 option add *Radiobutton.highlightThickness 2 option add *Radiobutton.font {Helvetica -12 bold} - -proc bogusTrace args { +proc bogusTrace {args} { error "trace aborted" } - test unixbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints { unix testImageType } -setup { @@ -44,10 +42,10 @@ test unixbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints { } -body { image create test image1 image1 changed 0 0 0 0 60 40 - label .b1 -image image1 -bd 4 -padx 0 -pady 2 - button .b2 -image image1 -bd 4 -padx 0 -pady 2 - checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1 - radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0 + label .b1 -image image1 -borderwidth 4 -padx 0 -pady 2 + button .b2 -image image1 -borderwidth 4 -padx 0 -pady 2 + checkbutton .b3 -image image1 -borderwidth 4 -padx 1 -pady 1 + radiobutton .b4 -image image1 -borderwidth 4 -padx 2 -pady 0 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ @@ -63,10 +61,10 @@ test unixbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - label .b1 -bitmap question -bd 3 -padx 0 -pady 2 - button .b2 -bitmap question -bd 3 -padx 0 -pady 2 - checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1 - radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0 + label .b1 -bitmap question -borderwidth 3 -padx 0 -pady 2 + button .b2 -bitmap question -borderwidth 3 -padx 0 -pady 2 + checkbutton .b3 -bitmap question -borderwidth 3 -padx 1 -pady 1 + radiobutton .b4 -bitmap question -borderwidth 3 -padx 2 -pady 0 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ @@ -81,11 +79,11 @@ test unixbutton-1.3 {TkpComputeButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - label .b1 -bitmap question -bd 3 -highlightthickness 4 - button .b2 -bitmap question -bd 3 -highlightthickness 0 - checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \ + label .b1 -bitmap question -borderwidth 3 -highlightthickness 4 + button .b2 -bitmap question -borderwidth 3 -highlightthickness 0 + checkbutton .b3 -bitmap question -borderwidth 3 -highlightthickness 1 \ -indicatoron 0 - radiobutton .b4 -bitmap question -bd 3 -highlightthickness 1 \ + radiobutton .b4 -bitmap question -borderwidth 3 -highlightthickness 1 \ -indicatoron false pack .b1 .b2 .b3 .b4 update @@ -143,10 +141,10 @@ test unixbutton-1.7 {TkpComputeButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10 - button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5 - checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2 - radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4 + label .b1 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 -width 10 + button .b2 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 -height 5 + checkbutton .b3 -text Xagqpim -borderwidth 2 -padx 1 -pady 1 -width 20 -height 2 + radiobutton .b4 -text Xagqpim -borderwidth 2 -padx 2 -pady 0 -width 4 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ @@ -161,13 +159,13 @@ test unixbutton-1.8 {TkpComputeButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \ + label .b1 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 \ -highlightthickness 4 - button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \ + button .b2 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 \ -highlightthickness 0 - checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 \ + checkbutton .b3 -text Xagqpim -borderwidth 2 -padx 1 -pady 1 \ -highlightthickness 1 -indicatoron no - radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0 + radiobutton .b4 -text Xagqpim -borderwidth 2 -padx 2 -pady 0 -indicatoron 0 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ @@ -208,12 +206,11 @@ test unixbutton-1.11 {TkpComputeButtonGeometry procedure} -constraints { deleteWindows } -result {27 37} - test unixbutton-2.1 {disabled coloring check, bug 669595} -constraints { unix } -setup { deleteWindows - catch {unset value} + unset -nocomplain value } -body { # this was just a visual bug, but at least this shows the visual set on 1 diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test index 8aaa3c4..cae47dc 100644 --- a/tests/unixEmbed.test +++ b/tests/unixEmbed.test @@ -22,17 +22,17 @@ dobg {wm withdraw .} # w - Name of toplevel window to create. proc eatColors {w} { - catch {destroy $w} + destroy $w toplevel $w wm geom $w +0+0 - canvas $w.c -width 400 -height 200 -bd 0 + canvas $w.c -width 400 -height 200 -borderwidth 0 pack $w.c for {set y 0} {$y < 8} {incr y} { for {set x 0} {$x < 40} {incr x} { - set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] - $w.c create rectangle [expr 10*$x] [expr 20*$y] \ - [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ - -fill $color + set color [format "#%02x%02x%02x" [expr {$x * 6}] [expr {$y * 30}] 0] + $w.c create rectangle [expr {10 * $x}] [expr {20 * $y}] \ + [expr {(10 * $x) + 10}] [expr {(20 * $y) + 20}] -outline "" \ + -fill $color } } update @@ -49,9 +49,9 @@ proc eatColors {w} { # to see if there are colormap entries free. proc colorsFree {w {red 31} {green 245} {blue 192}} { - set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]] - expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \ - && ([lindex $vals 2]/256 == $blue) + lassign [winfo rgb $w [format "#%02x%02x%02x" $red $green $blue]] v_r v_g v_b + expr {(($v_r / 256) == $red) && (($v_g / 256) == $green) \ + && (($v_b / 256) == $blue)} } test unixEmbed-1.1 {TkpUseWindow procedure, bad window identifier} -constraints { @@ -219,7 +219,6 @@ test unixEmbed-2.4 {EmbeddedEventProc procedure} -constraints { deleteWindows } -result {{{XXX .f1 {} {}}} {}} - test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} -constraints { unix testembed nonPortable } -body { @@ -243,7 +242,7 @@ test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} -constra } -body { toplevel .t1 -container 1 wm geometry .t1 +0+0 - toplevel .t2 -use [winfo id .t1] -bg red + toplevel .t2 -use [winfo id .t1] -background red update wm geometry .t2 } -cleanup { @@ -259,7 +258,7 @@ test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} -co dobg "set w1 [winfo id .f1]" dobg { eval destroy [winfo child .] - toplevel .t1 -use $w1 -bd 2 -relief raised + toplevel .t1 -use $w1 -borderwidth 2 -relief raised update wm geometry .t1 +30+40 } @@ -359,7 +358,6 @@ test unixEmbed-3.7 {ContainerEventProc procedure, destroy events} -constraints { deleteWindows } -result {dead 0} - test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} -constraints { unix } -setup { @@ -403,7 +401,6 @@ test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} -constraints { deleteWindows } -result {{{XXX .f1 XXX {}}} {}} - test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} -constraints { unix } -setup { @@ -472,7 +469,6 @@ test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} -constraints { deleteWindows } -result {{{focus in .t1}} {{focus in .t1} {focus out .t1}}} - test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} -constraints { unix } -setup { @@ -584,7 +580,6 @@ test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width bind . <KeyPress> {} } -result {{} {{key b}}} - test unixEmbed-8.1 {TkpClaimFocus procedure} -constraints unix -setup { deleteWindows } -body { @@ -594,7 +589,7 @@ test unixEmbed-8.1 {TkpClaimFocus procedure} -constraints unix -setup { dobg "set w1 [winfo id .f1]" dobg { eval destroy [winfo child .] - toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken + toplevel .t1 -use $w1 -highlightthickness 2 -borderwidth 2 -relief sunken } focus -force .f2 update @@ -621,7 +616,7 @@ test unixEmbed-8.2 {TkpClaimFocus procedure} -constraints unix -setup { child eval "set argv {-use [winfo id .f1]}" load {} Tk child child eval { - . configure -bd 2 -highlightthickness 2 -relief sunken + . configure -borderwidth 2 -highlightthickness 2 -relief sunken } focus -force .f2 update @@ -636,7 +631,6 @@ test unixEmbed-8.2 {TkpClaimFocus procedure} -constraints unix -setup { } -result {{{} .} .f1} catch {interp delete child} - test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} -constraints { unix testembed } -setup { @@ -667,7 +661,7 @@ test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} -constraint dobg "set w1 [winfo id .f1]" dobg { eval destroy [winfo child .] - toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken + toplevel .t1 -use $w1 -highlightthickness 2 -borderwidth 2 -relief sunken set x {} lappend x [testembed] destroy .t1 @@ -677,7 +671,6 @@ test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} -constraint deleteWindows } -result {{{XXX {} {} .t1}} {}} - test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -constraints { unix } -setup { diff --git a/tests/unixFont.test b/tests/unixFont.test index 27826d4..900a228 100644 --- a/tests/unixFont.test +++ b/tests/unixFont.test @@ -27,8 +27,8 @@ foreach {constraint font} { if {[tk windowingsystem] eq "x11"} { testConstraint $constraint 1 if {[llength $xlsf]} { - if {![catch {eval exec $xlsf [list *-$font-*]} res] - && ![string match *unmatched* $res]} { + if {(![catch {eval exec $xlsf [list *-$font-*]} res]) && + (![string match "*unmatched*" $res])} { # Newer Unix systems have more default fonts installed, # so we can't rely on fallbacks for fonts to need to # fall back on anything. @@ -48,10 +48,10 @@ update idletasks # Font should be fixed width and have chars missing below char 32, so can # test control char expansion and missing character code. -set courier {Courier -10} +set courier "Courier -10" set cx [font measure $courier 0] -label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font fixed +label .b.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left -text "0" -font fixed pack .b.l canvas .b.c -closeenough 0 @@ -149,47 +149,47 @@ test unixfont-5.3 {Tk_MeasureChars procedure: loop over chars} unix { .b.l config -text "0\3770\377" .b.l config -text "000000000000000" } {} -.b.l config -wrap [expr $ax*10] +.b.l config -wrap [expr {$ax * 10}] test unixfont-5.4 {Tk_MeasureChars procedure: reached right edge} unix { .b.l config -text "0000000000000" getsize -} "[expr $ax*10] [expr $ay*2]" +} "[expr {$ax * 10}] [expr {$ay * 2}]" test unixfont-5.5 {Tk_MeasureChars procedure: ran out of chars} unix { .b.l config -text "000000" getsize -} "[expr $ax*6] $ay" +} "[expr {$ax * 6}] $ay" test unixfont-5.6 {Tk_MeasureChars procedure: find last word} unix { .b.l config -text "000000 00000" getsize -} "[expr $ax*6] [expr $ay*2]" +} "[expr {$ax * 6}] [expr {$ay * 2}]" test unixfont-5.7 {Tk_MeasureChars procedure: already saw space in line} unix { .b.l config -text "000000 00000" getsize -} "[expr $ax*6] [expr $ay*2]" +} "[expr {$ax * 6}] [expr {$ay * 2}]" test unixfont-5.8 {Tk_MeasureChars procedure: internal spaces significant} unix { .b.l config -text "00 000 00000" getsize -} "[expr $ax*7] [expr $ay*2]" +} "[expr {$ax * 7}] [expr {$ay * 2}]" test unixfont-5.9 {Tk_MeasureChars procedure: TK_PARTIAL_OK} unix { .b.c dchars $t 0 end .b.c insert $t 0 "0000" - .b.c index $t @[expr int($ax*2.5)],1 + .b.c index $t @[expr { int ($ax * 2.5)}],1 } {2} test unixfont-5.10 {Tk_MeasureChars procedure: TK_AT_LEAST_ONE} unix { .b.l config -text "000000000000" getsize -} "[expr $ax*10] [expr $ay*2]" +} "[expr {$ax * 10}] [expr {$ay * 2}]" test unixfont-5.11 {Tk_MeasureChars: TK_AT_LEAST_ONE + not even one char fit!} unix { set a [.b.l cget -wrap] .b.l config -text "000000" -wrap 1 set x [getsize] .b.l config -wrap $a set x -} "$ax [expr $ay*6]" +} "$ax [expr {$ay * 6}]" test unixfont-5.12 {Tk_MeasureChars procedure: include eol spaces} unix { .b.l config -text "000 \n000" getsize -} "[expr $ax*6] [expr $ay*2]" +} "[expr {$ax * 6}] [expr {$ay * 2}]" test unixfont-6.1 {Tk_DrawChars procedure: loop test} unix { .b.l config -text "a" @@ -245,12 +245,12 @@ test unixfont-8.2 {AllocFont procedure: parse information from XLFD} unix { expr {[lindex [font actual {-family times -size 0}] 3] == 0} } {0} test unixfont-8.3 {AllocFont procedure: can't parse info from name} unix { - catch {unset fontArray} + unset -nocomplain fontArray # check that font actual returns the correct attributes. # the values of those attributes are system dependent. array set fontArray [font actual a12biluc] set result [lsort [array names fontArray]] - catch {unset fontArray} + unset -nocomplain fontArray set result } {-family -overstrike -size -slant -underline -weight} test unixfont-8.4 {AllocFont procedure: classify characters} unix { @@ -260,7 +260,7 @@ test unixfont-8.4 {AllocFont procedure: classify characters} unix { incr x [font measure $courier "\012"] ;# 2 incr x [font measure $courier "\101"] ;# 1 set x -} [expr $cx*13] +} [expr {$cx * 13}] test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} unix { font metrics $courier -fixed } {1} @@ -270,7 +270,7 @@ test unixfont-8.6 {AllocFont procedure: setup widths of special chars} unix { incr x [font measure $courier "\002"] ;# 4 incr x [font measure $courier "\012"] ;# 2 set x -} [expr $cx*10] +} [expr {$cx * 10}] test unixfont-8.7 {AllocFont procedure: XA_UNDERLINE_POSITION} unix { catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1} set x {} @@ -295,22 +295,18 @@ test unixfont-8.11 {AllocFont procedure: XA_UNDERLINE_POSITION was 0} unix { test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} unix { .b.c dchars $t 0 end .b.c insert $t 0 "0\a0" - set x {} - lappend x [.b.c index $t @[expr $ax*0],0] - lappend x [.b.c index $t @[expr $ax*1],0] - lappend x [.b.c index $t @[expr $ax*2],0] - lappend x [.b.c index $t @[expr $ax*3],0] + set x [list] + foreach i_ax {0 1 2 3} { + lappend x [.b.c index $t @[expr {$ax * $i_ax}],0] + } } {0 1 1 2} test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} unix { .b.c dchars $t 0 end .b.c insert $t 0 "0\0010" - set x {} - lappend x [.b.c index $t @[expr $ax*0],0] - lappend x [.b.c index $t @[expr $ax*1],0] - lappend x [.b.c index $t @[expr $ax*2],0] - lappend x [.b.c index $t @[expr $ax*3],0] - lappend x [.b.c index $t @[expr $ax*4],0] - lappend x [.b.c index $t @[expr $ax*5],0] + set x [list] + foreach i_ax {0 1 2 3 4 5} { + lappend x [.b.c index $t @[expr {$ax * $i_ax}],0] + } } {0 1 1 1 1 2} # cleanup diff --git a/tests/unixMenu.test b/tests/unixMenu.test index 3d655e4..1b43a9f 100644 --- a/tests/unixMenu.test +++ b/tests/unixMenu.test @@ -12,7 +12,6 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands - test unixMenu-1.1 {TkpNewMenu - normal menu} -constraints unix -setup { destroy .m1 } -body { @@ -27,13 +26,10 @@ test unixMenu-1.2 {TkpNewMenu - help menu} -constraints unix -setup { list [menu .m1.help] [. configure -menu ""] [destroy .m1] } -returnCodes ok -result {.m1.help {} {}} - test unixMenu-2.1 {TkpDestroyMenu - nothing to do} -constraints unix -body {} - test unixMenu-3.1 {TkpDestroymenuEntry - nothing to do} -constraints unix -body {} - test unixMenu-4.1 {TkpConfigureMenuEntry - non-cascade entry} -constraints { unix } -setup { @@ -54,10 +50,8 @@ test unixMenu-4.2 {TkpConfigureMenuEntry - cascade entry} -constraints { list [.m1 entryconfigure test -menu .m1.foo] [destroy .m1] } -returnCodes ok -result {{} {}} - test unixMenu-5.1 {TkpMenuNewEntry - nothing to do} -constraints unix -body {} - test unixMenu-6.1 {TkpSetWindowMenuBar - null menu} -constraints unix -setup { destroy .m1 } -body { @@ -74,10 +68,8 @@ test unixMenu-6.2 {TkpSetWindowMenuBar - menu} -constraints unix -setup { list [. configure -menu .m1] [. configure -menu ""] [destroy .m1] } -returnCodes ok -result {{} {} {}} - test unixMenu-7.1 {TkpSetMainMenubar - nothing to do} -constraints unix -body {} - test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} -constraints { unix } -setup { @@ -183,7 +175,6 @@ test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} -constraints { destroy .m1 } -returnCodes ok - test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} -constraints { unix } -setup { @@ -213,7 +204,6 @@ test unixMenu-9.3 {GetMenuAccelGeometry - null label} -constraints unix -setup { destroy .m1 } -returnCodes ok - test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} -constraints { unix } -setup { @@ -245,7 +235,6 @@ test unixMenu-10.3 {DrawMenuEntryBackground - non-active} -constraints { list [update] [destroy .m1] } -returnCodes ok -result {{} {}} - test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} -constraints { unix } -setup { @@ -288,7 +277,6 @@ test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} -constraints { list [update] [destroy .m1] } -result {{} {}} - test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} -constraints { unix } -setup { @@ -362,7 +350,6 @@ test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} -constraint list [update] [destroy .m1] } -result {{} {}} - test unixMenu-13.1 {DrawMenuSeparator - menubar case} -constraints unix -setup { destroy .m1 } -body { @@ -380,7 +367,6 @@ test unixMenu-13.2 {DrawMenuSepartor - normal menu} -constraints unix -setup { list [update] [destroy .m1] } -result {{} {}} - test unixMenu-14.1 {DrawMenuEntryLabel} -constraints unix -setup { destroy .m1 } -body { @@ -390,7 +376,6 @@ test unixMenu-14.1 {DrawMenuEntryLabel} -constraints unix -setup { list [update] [destroy .m1] } -result {{} {}} - test unixMenu-15.1 {DrawMenuUnderline - menubar} -constraints unix -setup { destroy .m1 } -body { @@ -408,7 +393,6 @@ test unixMenu-15.2 {DrawMenuUnderline - no menubar} -constraints unix -setup { list [update] [destroy .m1] } -result {{} {}} - test unixMenu-16.1 {TkpPostMenu} -constraints unix -setup { destroy .m1 } -body { @@ -418,7 +402,6 @@ test unixMenu-16.1 {TkpPostMenu} -constraints unix -setup { destroy .m1 } -returnCodes ok - test unixMenu-17.1 {GetMenuSeparatorGeometry} -constraints unix -setup { destroy .m1 } -body { @@ -428,7 +411,6 @@ test unixMenu-17.1 {GetMenuSeparatorGeometry} -constraints unix -setup { destroy .m1 } -returnCodes ok - test unixMenu-18.1 {GetTearoffEntryGeometry} -constraints { unix nonUnixUserInteraction } -setup { @@ -733,7 +715,6 @@ test unixMenu-19.24 {TkpComputeMenubarGeometry - help item only one} -constraint list [update] [. configure -menu ""] [destroy .m1] } -result {{} {} {}} - test unixMenu-20.1 {DrawTearoffEntry - menubar} -constraints unix -setup { destroy .m1 } -body { @@ -753,10 +734,8 @@ test unixMenu-20.2 {DrawTearoffEntry - non-menubar} -constraints { list [update] [destroy .m1] } -result {{} {}} - test unixMenu-21.1 {TkpInitializeMenuBindings - nothing to do} -constraints unix -body {} - test unixMenu-22.1 {SetHelpMenu - no menubars} -constraints unix -setup { destroy .m1 } -body { @@ -799,7 +778,6 @@ test unixMenu-22.4 {SetHelpMenu - multiple menubars with same help menu} -constr list [menu .m1.help] [. configure -menu ""] [destroy .m1] [destroy .t2] } -result {.m1.help {} {} {}} - test unixMenu-23.1 {TkpDrawMenuEntry - gc for active and not strict motif} -constraints { unix } -setup { @@ -1022,7 +1000,6 @@ test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} -constraints unix -setup { list [update] [destroy .m1] } -result {{} {}} - test unixMenu-24.1 {GetMenuLabelGeometry - image} -constraints { testImageType unix } -setup { @@ -1056,7 +1033,6 @@ test unixMenu-24.4 {GetMenuLabelGeometry - text} -constraints unix -setup { list [update idletasks] [destroy .m1] } -result {{} {}} - test unixMenu-25.1 {TkpComputeStandardMenuGeometry - no entries} -constraints { unix } -setup { @@ -1264,11 +1240,8 @@ test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} -constraints list [update idletasks] [destroy .m1] } -result {{} {}} - test unixMenu-26.1 {TkpMenuInit - nothing to do} -constraints unix -body {} - - # cleanup deleteWindows cleanupTests diff --git a/tests/unixSelect.test b/tests/unixSelect.test index 53ae006..bba74cf 100644 --- a/tests/unixSelect.test +++ b/tests/unixSelect.test @@ -26,7 +26,7 @@ proc handler {type offset count} { if {$numBytes <= 0} { return "" } - string range $selValue $offset [expr $numBytes+$offset] + string range $selValue $offset [expr {$numBytes + $offset}] } proc errIncrHandler {type offset count} { @@ -45,10 +45,10 @@ proc errIncrHandler {type offset count} { if {$numBytes <= 0} { return "" } - string range $selValue $offset [expr $numBytes+$offset] + string range $selValue $offset [expr {$numBytes + $offset}] } -proc errHandler args { +proc errHandler {args} { error "selection handler aborted" } @@ -60,7 +60,7 @@ proc badHandler {path type offset count} { if {$numBytes <= 0} { return "" } - string range $selValue $offset [expr $numBytes+$offset] + string range $selValue $offset [expr {$numBytes + $offset}] } proc reallyBadHandler {path type offset count} { global selValue selInfo pass @@ -76,20 +76,20 @@ proc reallyBadHandler {path type offset count} { if {$numBytes <= 0} { return "" } - string range $selValue $offset [expr $numBytes+$offset] + string range $selValue $offset [expr {$numBytes + $offset}] } # Eliminate any existing selection on the screen. This is needed in case # there is a selection in some other application, in order to prevent races # from causing false errors in the tests below. -selection clear . +selection clear -displayof . after 1500 # common setup code proc setup {{path .f1} {display {}}} { - catch {destroy $path} - if {$display == {}} { + destroy $path + if {$display eq ""} { frame $path } else { toplevel $path -screen $display diff --git a/tests/unixWm.test b/tests/unixWm.test index d579fc7..03d0f30 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -13,7 +13,7 @@ tcltest::loadTestedCommands namespace import -force ::tk::test:loadTkCommand -proc sleep ms { +proc sleep {ms} { global x after $ms {set x 1} vwait x @@ -55,8 +55,8 @@ update wm geom .t +150+150 update scan [wm geom .t] %dx%d+%d+%d width height x y -set xerr [expr 150-$x] -set yerr [expr 150-$y] +set xerr [expr {150 - $x}] +set yerr [expr {150 - $y}] foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { test unixWm-2.$i {moving window while mapped} unix { wm geom .t $geom @@ -233,12 +233,12 @@ wm overrideredirect .m 1 foreach i {{Test label} Another {Yet another} {Last label}} j {1 2 3} { label .m.$j -text $i } -wm geometry .m +[expr 100 - [winfo vrootx .]]+[expr 200 - [winfo vrooty .]] +wm geometry .m +[expr {100 - [winfo vrootx .]}]+[expr {200 - [winfo vrooty .]}] update test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} unix { list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] } {1 normal 100 200} -wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]] +wm geometry .m +[expr {150 - [winfo vrootx .]}]+[expr {210 - [winfo vrooty .]}] update test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} unix { list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] @@ -255,7 +255,7 @@ test unixWm-8.1 {icon windows} unix { destroy .icon toplevel .t -width 100 -height 30 wm geometry .t +0+0 - toplevel .icon -width 50 -height 50 -bg red + toplevel .icon -width 50 -height 50 -background red wm iconwindow .t .icon list [catch {wm withdraw .icon} msg] $msg } {1 {can't withdraw .icon: it is an icon for .t}} @@ -275,7 +275,7 @@ test unixWm-8.4 {icon windows} unix { toplevel .t -width 100 -height 30 wm geom .t +0+0 set result [wm iconwindow .t] - toplevel .icon -width 50 -height 50 -bg red + toplevel .icon -width 50 -height 50 -background red wm iconwindow .t .icon lappend result [wm iconwindow .t] [wm state .icon] wm iconwindow .t {} @@ -294,7 +294,7 @@ test unixWm-8.5 {icon windows} unix { test unixWm-8.6 {icon windows} unix { destroy .t toplevel .t -width 100 -height 30 - frame .t.icon -width 50 -height 50 -bg red + frame .t.icon -width 50 -height 50 -background red list [catch {wm iconwindow .t .t.icon} msg] $msg } {1 {can't use .t.icon as icon window: not at top level}} test unixWm-8.7 {icon windows} unix { @@ -302,8 +302,8 @@ test unixWm-8.7 {icon windows} unix { destroy .icon toplevel .t -width 100 -height 30 wm geom .t +0+0 - toplevel .icon -width 50 -height 50 -bg red - toplevel .icon2 -width 50 -height 50 -bg green + toplevel .icon -width 50 -height 50 -background red + toplevel .icon2 -width 50 -height 50 -background green wm iconwindow .t .icon set result "[wm iconwindow .t] [wm state .icon] [wm state .icon2]" wm iconwindow .t .icon2 @@ -313,7 +313,7 @@ destroy .icon2 test unixWm-8.8 {icon windows} unix { destroy .t destroy .icon - toplevel .icon -width 50 -height 50 -bg red + toplevel .icon -width 50 -height 50 -background red wm geom .icon +0+0 update set result [winfo ismapped .icon] @@ -331,7 +331,7 @@ test unixWm-8.9 {icon windows} {unix nonPortable} { destroy .t destroy .icon toplevel .t -width 100 -height 30 - toplevel .icon -width 50 -height 50 -bg red + toplevel .icon -width 50 -height 50 -background red wm geom .t +0+0 wm iconwindow .t .icon update @@ -390,7 +390,7 @@ command } test unixWm-9.3 {TkWmMapWindow procedure, iconic windows} unix { destroy .t - toplevel .t -width 100 -height 300 -bg blue + toplevel .t -width 100 -height 300 -background blue wm geom .t +0+0 wm iconify .t sleep 500 @@ -399,7 +399,7 @@ test unixWm-9.3 {TkWmMapWindow procedure, iconic windows} unix { test unixWm-9.4 {TkWmMapWindow procedure, icon windows} unix { destroy .t sleep 500 - toplevel .t -width 100 -height 50 -bg blue + toplevel .t -width 100 -height 50 -background blue wm iconwindow . .t update set result [winfo ismapped .t] @@ -423,10 +423,10 @@ test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handle test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unix testmenubar} { destroy .t destroy .f - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised wm geom .t +0+0 update - frame .f -width 400 -height 30 -bd 2 -relief raised -bg green + frame .f -width 400 -height 30 -borderwidth 2 -relief raised -background green bind .f <Destroy> {lappend result destroyed} testmenubar window .t .f update @@ -609,7 +609,7 @@ test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} unix { } {1 {wrong # args: should be "wm deiconify window"}} test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} unix { destroy .icon - toplevel .icon -width 50 -height 50 -bg red + toplevel .icon -width 50 -height 50 -background red wm iconwindow .t .icon set result [list [catch {wm deiconify .icon} msg] $msg] destroy .icon @@ -775,7 +775,7 @@ test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {un wm geometry .t2 +0+0 set result [list [testwrapper .t2]] wm group .t3 .t2 - lappend result [expr {[testwrapper .t2] == ""}] + lappend result [expr {[testwrapper .t2] eq ""}] destroy .t2 .t3 set result } {{} 0} @@ -916,7 +916,7 @@ test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} unix { } {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unix testwrapper} { destroy .icon - toplevel .icon -width 50 -height 50 -bg green + toplevel .icon -width 50 -height 50 -background green set result {} lappend result [wm iconwindow .t] wm iconwindow .t .icon @@ -943,7 +943,7 @@ test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} unix { } {1 {can't use .b as icon window: not at top level}} test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} unix { destroy .icon - toplevel .icon -width 50 -height 50 -bg green + toplevel .icon -width 50 -height 50 -background green destroy .t2 toplevel .t2 wm geom .t2 -0+0 @@ -956,8 +956,8 @@ test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} unix { test unixWm-27.6 {Tk_WmCmd procedure, "iconwindow" option, changing icons} unix { destroy .icon destroy .icon2 - toplevel .icon -width 50 -height 50 -bg green - toplevel .icon2 -width 50 -height 50 -bg red + toplevel .icon -width 50 -height 50 -background green + toplevel .icon2 -width 50 -height 50 -background red set result {} wm iconwindow .t .icon lappend result [wm state .icon] [wm state .icon2] @@ -968,7 +968,7 @@ test unixWm-27.6 {Tk_WmCmd procedure, "iconwindow" option, changing icons} unix } {icon normal withdrawn icon} test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} unix { destroy .icon - toplevel .icon -width 50 -height 50 -bg green + toplevel .icon -width 50 -height 50 -background green wm geometry .icon +0+0 update set result {} @@ -1291,7 +1291,7 @@ test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create master wrapper} wm geometry .t2 +0+0 set result [list [testwrapper .t2]] wm transient .t3 .t2 - lappend result [expr {[testwrapper .t2] == ""}] + lappend result [expr {[testwrapper .t2] eq ""}] destroy .t2 .t3 set result } {{} 0} @@ -1356,17 +1356,17 @@ test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} u } {400 150 200 300} test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable testmenubar} { destroy .t - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised wm geom .t +0+0 update set x [winfo rootx .t] set y [winfo rooty .t] - frame .t.m -bd 2 -relief raised -height 20 + frame .t.m -borderwidth 2 -relief raised -height 20 testmenubar window .t .t.m update set result {} bind .t <Configure> { - if {"%W" == ".t"} { + if {"%W" eq ".t"} { lappend result "%W: %wx%h" } } @@ -1425,10 +1425,10 @@ test unixWm-43.1 {TopLevelReqProc procedure, embedded in same process} unix { destroy .t toplevel .t -width 200 -height 200 wm geom .t +0+0 - frame .t.f -container 1 -bd 2 -relief raised + frame .t.f -container 1 -borderwidth 2 -relief raised place .t.f -x 20 -y 10 tkwait visibility .t.f - toplevel .t2 -use [winfo id .t.f] -width 30 -height 20 -bg blue + toplevel .t2 -use [winfo id .t.f] -width 30 -height 20 -background blue tkwait visibility .t2 set result {} .t2 configure -width 70 -height 120 @@ -1526,7 +1526,7 @@ test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} unix { wm overrideredirect .t 1 tkwait visibility .t list [winfo x .t] [winfo y .t] -} [list 5 [expr [winfo screenheight .t] - 70]] +} [list 5 [expr {[winfo screenheight .t] - 70}]] destroy .t toplevel .t -width 80 -height 60 @@ -1535,7 +1535,7 @@ test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} unix { wm overrideredirect .t 1 tkwait visibility .t list [winfo x .t] [winfo y .t] -} [list [expr [winfo screenwidth .t] - 110] 2] +} [list [expr {[winfo screenwidth .t] - 110}] 2] destroy .t test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix testwrapper} { @@ -1557,7 +1557,7 @@ test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} testmenubar { wm geometry .t +0+0 tkwait visibility .t .t configure -width 180 -height 50 - frame .t.m -bd 2 -relief raised -width 100 -height 50 + frame .t.m -borderwidth 2 -relief raised -width 100 -height 50 testmenubar window .t .t.m update .t configure -height 70 @@ -1640,7 +1640,7 @@ test unixWm-46.1 {WaitForEvent procedure, use of modal timeout} unix { test unixWm-47.1 {WaitRestrictProc procedure} {unix nonPortable} { destroy .t toplevel .t -width 300 -height 200 - frame .t.f -bd 2 -relief raised + frame .t.f -borderwidth 2 -relief raised place .t.f -x 20 -y 30 -width 100 -height 20 wm geometry .t +0+0 tkwait visibility .t @@ -1724,9 +1724,9 @@ test unixWm-48.13 {ParseGeometry procedure, resize causes window to move} unix { test unixWm-49.1 {Tk_GetRootCoords procedure} unix { destroy .t toplevel .t -width 300 -height 200 - frame .t.f -width 150 -height 100 -bd 2 -relief raised + frame .t.f -width 150 -height 100 -borderwidth 2 -relief raised place .t.f -x 150 -y 120 - frame .t.f.f -width 20 -height 20 -bd 2 -relief raised + frame .t.f.f -width 20 -height 20 -borderwidth 2 -relief raised place .t.f.f -x 10 -y 20 wm overrideredirect .t 1 wm geometry .t +40+50 @@ -1735,15 +1735,15 @@ test unixWm-49.1 {Tk_GetRootCoords procedure} unix { } {202 192} test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} { destroy .t - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised wm geom .t +0+0 update set x [winfo rootx .t] set y [winfo rooty .t] - frame .t.m -bd 2 -relief raised -width 100 -height 30 - frame .t.m.f -width 20 -height 10 -bd 2 -relief raised + frame .t.m -borderwidth 2 -relief raised -width 100 -height 30 + frame .t.m.f -width 20 -height 10 -borderwidth 2 -relief raised place .t.m.f -x 50 -y 5 - frame .t.f -width 20 -height 30 -bd 2 -relief raised + frame .t.f -width 20 -height 30 -borderwidth 2 -relief raised place .t.f -x 10 -y 30 testmenubar window .t .t.m update @@ -1755,10 +1755,10 @@ deleteWindows wm iconify . test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} unix { deleteWindows - toplevel .t -width 300 -height 400 -bg green + toplevel .t -width 300 -height 400 -background green wm geom .t +40+0 tkwait visibility .t - toplevel .t2 -width 100 -height 80 -bg red + toplevel .t2 -width 100 -height 80 -background red wm geom .t2 +140+200 tkwait visibility .t2 raise .t2 @@ -1775,10 +1775,10 @@ test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} uni } {{} {} .t {} .t2 .t2 {} .t} test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} unix { deleteWindows - toplevel .t -width 300 -height 400 -bg yellow + toplevel .t -width 300 -height 400 -background yellow wm geom .t +0+50 tkwait visibility .t - toplevel .t2 -width 100 -height 80 -bg blue + toplevel .t2 -width 100 -height 80 -background blue wm overrideredirect .t2 1 wm geom .t2 +100+200 tkwait visibility .t2 @@ -1799,7 +1799,7 @@ test unixWm-50.3 { Tk_CoordsToWindow procedure, finding a toplevel with embedding } -constraints tempNotWin -setup { deleteWindows - toplevel .t -width 300 -height 400 -bg blue + toplevel .t -width 300 -height 400 -background blue wm geom .t +0+50 frame .t.f -container 1 place .t.f -x 150 -y 50 @@ -1808,7 +1808,7 @@ test unixWm-50.3 { } -body { dobg " wm withdraw . - toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow + toplevel .x -width 100 -height 80 -use [winfo id .t.f] -background yellow tkwait visibility .x" set result [dobg { set x [winfo rootx .x] @@ -1826,7 +1826,7 @@ test unixWm-50.3 { test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} unix { destroy .t catch {interp delete slave} - toplevel .t -width 200 -height 200 -bg green + toplevel .t -width 200 -height 200 -background green wm geometry .t +0+0 tkwait visibility .t interp create slave @@ -1839,12 +1839,12 @@ test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} unix } {{} .} test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenubar} { deleteWindows - toplevel .t -width 300 -height 400 -bd 2 -relief raised - frame .t.f -width 150 -height 120 -bg green + toplevel .t -width 300 -height 400 -borderwidth 2 -relief raised + frame .t.f -width 150 -height 120 -background green place .t.f -x 10 -y 150 wm geom .t +0+50 - frame .t.menu -width 100 -height 30 -bd 2 -relief raised - frame .t.menu.f -width 40 -height 20 -bg purple + frame .t.menu -width 100 -height 30 -borderwidth 2 -relief raised + frame .t.menu.f -width 40 -height 20 -background purple place .t.menu.f -x 30 -y 10 testmenubar window .t .t.menu tkwait visibility .t.menu @@ -1861,12 +1861,12 @@ test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenu } {{} .t.menu .t.menu .t.menu.f .t .t .t.f} test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} unix { deleteWindows - toplevel .t -width 300 -height 400 -bg orange + toplevel .t -width 300 -height 400 -background orange wm geom .t +0+50 frame .t.f -container 1 place .t.f -x 150 -y 50 tkwait visibility .t.f - toplevel .t2 -width 100 -height 80 -bg green -use [winfo id .t.f] + toplevel .t2 -width 100 -height 80 -background green -use [winfo id .t.f] tkwait visibility .t2 update set x [winfo rootx .t] @@ -1878,11 +1878,11 @@ test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} unix { } {.t .t2 .t2 .t} test unixWm-50.7 {Tk_CoordsToWindow procedure, more basics} unix { destroy .t - toplevel .t -width 300 -height 400 -bg green + toplevel .t -width 300 -height 400 -background green wm geom .t +0+0 - frame .t.f -width 100 -height 200 -bd 2 -relief raised + frame .t.f -width 100 -height 200 -borderwidth 2 -relief raised place .t.f -x 100 -y 100 - frame .t.f.f -width 100 -height 200 -bd 2 -relief raised + frame .t.f.f -width 100 -height 200 -borderwidth 2 -relief raised place .t.f.f -x 0 -y 100 tkwait visibility .t.f.f set x [expr [winfo rootx .t] + 150] @@ -1895,11 +1895,11 @@ test unixWm-50.7 {Tk_CoordsToWindow procedure, more basics} unix { } {.t .t.f .t.f.f .t {}} test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} unix { destroy .t - toplevel .t -width 400 -height 300 -bg green + toplevel .t -width 400 -height 300 -background green wm geom .t +0+0 - frame .t.f -width 200 -height 100 -bd 2 -relief raised + frame .t.f -width 200 -height 100 -borderwidth 2 -relief raised place .t.f -x 100 -y 100 - frame .t.f.f -width 200 -height 100 -bd 2 -relief raised + frame .t.f.f -width 200 -height 100 -borderwidth 2 -relief raised place .t.f.f -x 100 -y 0 update set x [winfo rooty .t] @@ -1914,10 +1914,10 @@ test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} unix { destroy .t destroy .t2 sleep 500 ;# Give window manager time to catch up. - toplevel .t -width 200 -height 200 -bg green + toplevel .t -width 200 -height 200 -background green wm geometry .t +0+0 tkwait visibility .t - toplevel .t2 -width 200 -height 200 -bg red + toplevel .t2 -width 200 -height 200 -background red wm geometry .t2 +0+0 tkwait visibility .t2 set result [list [winfo containing 100 100]] @@ -1926,9 +1926,9 @@ test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} unix { } {.t2 .t} test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} unix { destroy .t - toplevel .t -width 200 -height 200 -bg green + toplevel .t -width 200 -height 200 -background green wm geometry .t +0+0 - frame .t.f -width 150 -height 150 -bd 2 -relief raised + frame .t.f -width 150 -height 150 -borderwidth 2 -relief raised place .t.f -x 25 -y 25 tkwait visibility .t.f set result [list [winfo containing 100 100]] @@ -1996,18 +1996,18 @@ test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} deleteWindows test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} unix { destroy .t - toplevel .t -width 200 -height 200 -bg green + toplevel .t -width 200 -height 200 -background green wm geometry .t +0+0 tkwait visibility .t destroy .t2 - toplevel .t2 -width 200 -height 200 -bg red + toplevel .t2 -width 200 -height 200 -background red wm geometry .t2 +0+0 winfo containing 100 100 } {.t} test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} unix { foreach w {.t .t2 .t3} { destroy $w - toplevel $w -width 200 -height 200 -bg green + toplevel $w -width 200 -height 200 -background green wm geometry $w +0+0 } raise .t .t2 @@ -2020,12 +2020,12 @@ test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} unix } {.t3 .t} test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix { destroy .t - toplevel .t -width 200 -height 200 -bg green + toplevel .t -width 200 -height 200 -background green wm overrideredirect .t 1 wm geometry .t +0+0 tkwait visibility .t destroy .t2 - toplevel .t2 -width 200 -height 200 -bg red + toplevel .t2 -width 200 -height 200 -background red wm overrideredirect .t2 1 wm geometry .t2 +0+0 tkwait visibility .t2 @@ -2046,7 +2046,7 @@ test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} unix { foreach w {.t .t2 .t3} { destroy $w - toplevel $w -width 200 -height 200 -bg green + toplevel $w -width 200 -height 200 -background green wm overrideredirect $w 1 wm geometry $w +0+0 tkwait visibility $w @@ -2089,16 +2089,16 @@ test unixWm-51.13 {TkWmRestackToplevel procedure, don't move window that's alrea test unixWm-52.1 {TkWmAddToColormapWindows procedure} unix { destroy .t - toplevel .t -width 200 -height 200 -colormap new -relief raised -bd 2 + toplevel .t -width 200 -height 200 -colormap new -relief raised -borderwidth 2 wm geom .t +0+0 update wm colormap .t } {} test unixWm-52.2 {TkWmAddToColormapWindows procedure} unix { destroy .t - toplevel .t -colormap new -relief raised -bd 2 + toplevel .t -colormap new -relief raised -borderwidth 2 wm geom .t +0+0 - frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -borderwidth 2 pack .t.f update wm colormap .t @@ -2107,9 +2107,9 @@ test unixWm-52.3 {TkWmAddToColormapWindows procedure} unix { destroy .t toplevel .t -colormap new wm geom .t +0+0 - frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -borderwidth 2 pack .t.f - frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 + frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -borderwidth 2 pack .t.f2 update wm colormap .t @@ -2118,11 +2118,11 @@ test unixWm-52.4 {TkWmAddToColormapWindows procedure} unix { destroy .t toplevel .t -colormap new wm geom .t +0+0 - frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -borderwidth 2 pack .t.f update wm colormapwindows .t .t.f - frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 + frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -borderwidth 2 pack .t.f2 update wm colormapwindows .t @@ -2132,9 +2132,9 @@ test unixWm-53.1 {TkWmRemoveFromColormapWindows procedure} unix { destroy .t toplevel .t -colormap new wm geom .t +0+0 - frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -borderwidth 2 pack .t.f - frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 + frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -borderwidth 2 pack .t.f2 update destroy .t.f2 @@ -2144,9 +2144,9 @@ test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} unix { destroy .t toplevel .t -colormap new wm geom .t +0+0 - frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -borderwidth 2 pack .t.f - frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 + frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -borderwidth 2 pack .t.f2 update wm colormapwindows .t .t.f2 @@ -2157,7 +2157,7 @@ test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} unix { test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} {unix nonUnixUserInteraction} { destroy .t destroy .m - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised bind .t <Expose> {set x exposed} wm geom .t +0+0 update @@ -2188,10 +2188,10 @@ test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} {unix test unixWm-55.1 {TkUnixSetMenubar procedure} {unix testmenubar} { destroy .t - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised wm geom .t +0+0 update - frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green + frame .t.f -width 400 -height 30 -borderwidth 2 -relief raised -background green testmenubar window .t .t.f update list [winfo ismapped .t.f] [winfo geometry .t.f] \ @@ -2201,12 +2201,12 @@ test unixWm-55.1 {TkUnixSetMenubar procedure} {unix testmenubar} { test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unix testmenubar} { destroy .t destroy .f - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised wm geom .t +0+0 update set x [winfo rootx .t] set y [winfo rooty .t] - frame .f -width 400 -height 30 -bd 2 -relief raised -bg green + frame .f -width 400 -height 30 -borderwidth 2 -relief raised -background green testmenubar window .t .f update testmenubar window .t {} @@ -2219,12 +2219,12 @@ test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unix testmenuba } {0 300x30+0+0 0 0 0 0} test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unix testmenubar} { destroy .t - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised wm geom .t +0+0 update set x [winfo rootx .t] set y [winfo rooty .t] - frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green + frame .t.f -width 400 -height 30 -borderwidth 2 -relief raised -background green testmenubar window .t .t.f update testmenubar window .t {} @@ -2236,8 +2236,8 @@ test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unix t } {0 0 0 0} test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unix testmenubar} { destroy .t - toplevel .t -width 300 -height 200 -bd 2 -relief raised - frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised + frame .t.f -width 400 -height 30 -borderwidth 2 -relief raised -background green testmenubar window .t .t.f wm geom .t +0+0 update @@ -2248,12 +2248,12 @@ test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unix te test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unix testmenubar} { destroy .t destroy .f - toplevel .t -width 300 -height 200 -bd 2 -relief raised - frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised + frame .t.f -width 400 -height 30 -borderwidth 2 -relief raised -background green wm geom .t +0+0 update set y [winfo rooty .t] - frame .f -width 400 -height 50 -bd 2 -relief raised -bg green + frame .f -width 400 -height 50 -borderwidth 2 -relief raised -background green testmenubar window .t .t.f update set result {} @@ -2266,8 +2266,8 @@ test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unix testmenuba } {0 1 0 1 0 0} test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unix testmenubar} { destroy .t - toplevel .t -width 300 -height 200 -bd 2 -relief raised - frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised + frame .t.f -width 400 -height 30 -borderwidth 2 -relief raised -background green testmenubar window .t .t.f wm geom .t +0+0 update @@ -2280,9 +2280,9 @@ test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unix te test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unix testmenubar} { destroy .t destroy .f - toplevel .t -width 300 -height 200 -bd 2 -relief raised - frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green - frame .f -width 400 -height 40 -bd 2 -relief raised -bg blue + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised + frame .t.f -width 400 -height 30 -borderwidth 2 -relief raised -background green + frame .f -width 400 -height 40 -borderwidth 2 -relief raised -background blue wm geom .t +0+0 update set y [winfo rooty .t] @@ -2299,11 +2299,11 @@ test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unix tes test unixWm-56.1 {MenubarDestroyProc procedure} {unix testmenubar} { destroy .t - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised wm geom .t +0+0 update set y [winfo rooty .t] - frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green + frame .t.f -width 400 -height 30 -borderwidth 2 -relief raised -background green testmenubar window .t .t.f update set result [expr [winfo rooty .t] - $y] @@ -2314,12 +2314,12 @@ test unixWm-56.1 {MenubarDestroyProc procedure} {unix testmenubar} { test unixWm-57.1 {MenubarReqProc procedure} {unix testmenubar} { destroy .t - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised wm geom .t +0+0 update set x [winfo rootx .t] set y [winfo rooty .t] - frame .t.f -width 400 -height 10 -bd 2 -relief raised -bg green + frame .t.f -width 400 -height 10 -borderwidth 2 -relief raised -background green testmenubar window .t .t.f update set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]" @@ -2329,12 +2329,12 @@ test unixWm-57.1 {MenubarReqProc procedure} {unix testmenubar} { } {0 10 0 100} test unixWm-57.2 {MenubarReqProc procedure} {unix testmenubar} { destroy .t - toplevel .t -width 300 -height 200 -bd 2 -relief raised + toplevel .t -width 300 -height 200 -borderwidth 2 -relief raised wm geom .t +0+0 update set x [winfo rootx .t] set y [winfo rooty .t] - frame .t.f -width 400 -height 20 -bd 2 -relief raised -bg green + frame .t.f -width 400 -height 20 -borderwidth 2 -relief raised -background green testmenubar window .t .t.f update set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]" diff --git a/tests/util.test b/tests/util.test index c1ec6a5..2b4595d 100644 --- a/tests/util.test +++ b/tests/util.test @@ -11,7 +11,7 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test -listbox .l -width 20 -height 5 -relief sunken -bd 2 +listbox .l -width 20 -height 5 -relief sunken -borderwidth 2 pack .l .l insert 0 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 update diff --git a/tests/visual.test b/tests/visual.test index 2f5c34a..2a53764 100644 --- a/tests/visual.test +++ b/tests/visual.test @@ -22,16 +22,16 @@ update # w - Name of toplevel window to create. proc eatColors {w} { - catch {destroy $w} + destroy $w toplevel $w wm geom $w +0+0 - canvas $w.c -width 400 -height 200 -bd 0 + canvas $w.c -width 400 -height 200 -borderwidth 0 pack $w.c for {set y 0} {$y < 8} {incr y} { for {set x 0} {$x < 40} {incr x} { - set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] - $w.c create rectangle [expr 10*$x] [expr 20*$y] \ - [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ + set color [format "#%02x%02x%02x" [expr {$x * 6}] [expr {$y * 30}] 0] + $w.c create rectangle [expr {10 * $x}] [expr {20 * $y}] \ + [expr {(10 * $x) + 10}] [expr {(20 * $y) + 20}] -outline "" \ -fill $color } } @@ -49,9 +49,8 @@ proc eatColors {w} { # to see if there are colormap entries free. proc colorsFree {w {red 31} {green 245} {blue 192}} { - set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]] - expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \ - && ([lindex $vals 2]/256 == $blue) + lassign [winfo rgb $w [format "#%02x%02x%02x" $red $green $blue]] w_red w_green w_blue + expr {(($w_red / 256) == $red) && (($w_green / 256) == $green) && (($w_blue / 256) == $blue)} } # If more than one visual type is available for the screen, pick one @@ -130,7 +129,6 @@ test visual-1.5 {Tk_GetVisual, default colormap} -setup { deleteWindows } -result $default - test visual-2.1 {Tk_GetVisual, different visual types} -constraints { nonPortable } -setup { @@ -336,7 +334,6 @@ test visual-2.17 {Tk_GetVisual, different visual types} -constraints { deleteWindows } -result {truecolor 32} - test visual-3.1 {Tk_GetVisual, parsing visual string} -setup { deleteWindows } -body { @@ -381,7 +378,6 @@ test visual-3.5 {Tk_GetVisual, parsing visual string} -setup { deleteWindows } -returnCodes error -result {expected integer but got "48x"} - test visual-4.1 {Tk_GetVisual, numerical visual id} -constraints { haveOtherVisual nonPortable } -setup { @@ -414,7 +410,6 @@ test visual-4.3 {Tk_GetVisual, numerical visual id} -setup { deleteWindows } -returnCodes error -result {couldn't find an appropriate visual} - test visual-5.1 {Tk_GetVisual, no matching visual} -constraints { !havePseudocolorVisual } -setup { @@ -426,7 +421,6 @@ test visual-5.1 {Tk_GetVisual, no matching visual} -constraints { deleteWindows } -returnCodes error -result {couldn't find an appropriate visual} - test visual-6.1 {Tk_GetVisual, no matching visual} -constraints { havePseudocolorVisual haveMultipleVisuals nonPortable } -setup { @@ -522,7 +516,6 @@ test visual-7.6 {Tk_GetColormap, copy from other window} -constraints { deleteWindows } -returnCodes error -result {can't use colormap for .t1: incompatible visuals} - test visual-8.1 {Tk_FreeColormap procedure} -setup { deleteWindows } -body { @@ -556,7 +549,6 @@ test visual-8.2 {Tk_FreeColormap procedure} -constraints haveOtherVisual -setup deleteWindows } -result {} - deleteWindows rename eatColors {} rename colorsFree {} diff --git a/tests/visual_bb.test b/tests/visual_bb.test index 2b06d05..9adb231 100644 --- a/tests/visual_bb.test +++ b/tests/visual_bb.test @@ -11,7 +11,6 @@ namespace import ::tcltest::* tcltest::configure {*}$argv tcltest::loadTestedCommands - set auto_path ". $auto_path" wm title . "Visual Tests for Tk" @@ -95,7 +94,7 @@ test 1.1 {running visual tests} -constraints userInteraction -body { # Set up for keyboard-based menu traversal bind . <Any-FocusIn> { - if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} { + if {("%d" eq "NotifyVirtual") && ("%m" eq "NotifyNormal")} { focus .menu } } diff --git a/tests/winButton.test b/tests/winButton.test index 8bf1d01..c57fc0d 100644 --- a/tests/winButton.test +++ b/tests/winButton.test @@ -14,7 +14,7 @@ tcltest::configure {*}$argv tcltest::loadTestedCommands imageInit -proc bogusTrace args { +proc bogusTrace {args} { error "trace aborted" } option clear @@ -28,11 +28,11 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints { } -body { image create test image1 image1 changed 0 0 0 0 60 40 - label .b1 -image image1 -bd 4 -padx 0 -pady 2 - button .b2 -image image1 -bd 4 -padx 0 -pady 2 - checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1 \ + label .b1 -image image1 -borderwidth 4 -padx 0 -pady 2 + button .b2 -image image1 -borderwidth 4 -padx 0 -pady 2 + checkbutton .b3 -image image1 -borderwidth 4 -padx 1 -pady 1 \ -font {{MS Sans Serif} 8} - radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0 \ + radiobutton .b4 -image image1 -borderwidth 4 -padx 2 -pady 0 \ -font {{MS Sans Serif} 8} pack .b1 .b2 .b3 .b4 update @@ -50,11 +50,11 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints { test winbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints win -setup { deleteWindows } -body { - label .b1 -bitmap question -bd 3 -padx 0 -pady 2 - button .b2 -bitmap question -bd 3 -padx 0 -pady 2 - checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1 \ + label .b1 -bitmap question -borderwidth 3 -padx 0 -pady 2 + button .b2 -bitmap question -borderwidth 3 -padx 0 -pady 2 + checkbutton .b3 -bitmap question -borderwidth 3 -padx 1 -pady 1 \ -font {{MS Sans Serif} 8} - radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0 \ + radiobutton .b4 -bitmap question -borderwidth 3 -padx 2 -pady 0 \ -font {{MS Sans Serif} 8} pack .b1 .b2 .b3 .b4 update @@ -71,11 +71,11 @@ test winbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints win -setup test winbutton-1.3 {TkpComputeButtonGeometry procedure} -constraints win -setup { deleteWindows } -body { - label .b1 -bitmap question -bd 3 -highlightthickness 4 - button .b2 -bitmap question -bd 3 -highlightthickness 0 - checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \ + label .b1 -bitmap question -borderwidth 3 -highlightthickness 4 + button .b2 -bitmap question -borderwidth 3 -highlightthickness 0 + checkbutton .b3 -bitmap question -borderwidth 3 -highlightthickness 1 \ -indicatoron 0 - radiobutton .b4 -bitmap question -bd 3 -indicatoron false + radiobutton .b4 -bitmap question -borderwidth 3 -indicatoron false pack .b1 .b2 .b3 .b4 update # with patch 463234 with native L&F enabled, this returns: @@ -93,10 +93,10 @@ test winbutton-1.4 {TkpComputeButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} - button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} - checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8} - radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -font {{MS Sans Serif} 8} + label .b1 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} + button .b2 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} + checkbutton .b3 -text Xagqpim -borderwidth 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8} + radiobutton .b4 -text Xagqpim -borderwidth 2 -padx 2 -pady 0 -font {{MS Sans Serif} 8} pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ @@ -140,10 +140,10 @@ test winbutton-1.7 {TkpComputeButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10 - button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5 - checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2 - radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4 + label .b1 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 -width 10 + button .b2 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 -height 5 + checkbutton .b3 -text Xagqpim -borderwidth 2 -padx 1 -pady 1 -width 20 -height 2 + radiobutton .b4 -text Xagqpim -borderwidth 2 -padx 2 -pady 0 -width 4 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ @@ -159,13 +159,13 @@ test winbutton-1.8 {TkpComputeButtonGeometry procedure} -constraints { } -setup { deleteWindows } -body { - label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \ + label .b1 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 \ -highlightthickness 4 - button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \ + button .b2 -text Xagqpim -borderwidth 2 -padx 0 -pady 2 \ -highlightthickness 0 - checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 \ + checkbutton .b3 -text Xagqpim -borderwidth 2 -padx 1 -pady 1 \ -highlightthickness 1 -indicatoron no - radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0 + radiobutton .b4 -text Xagqpim -borderwidth 2 -padx 2 -pady 0 -indicatoron 0 pack .b1 .b2 .b3 .b4 update list [winfo reqwidth .b1] [winfo reqheight .b1] \ diff --git a/tests/winDialog.test b/tests/winDialog.test index 8aa9ac3..51751ee 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -31,8 +31,8 @@ proc start {arg} { proc then {cmd} { set ::command $cmd - set ::dialogresult {} - set ::testfont {} + set ::dialogresult "" + set ::testfont "" afterbody vwait ::dialogresult @@ -45,25 +45,27 @@ proc afterbody {} { set ::dialogresult ">30 iterations waiting on tk_dialog" return } - after 150 {afterbody} + after 150 {afterbody } return } uplevel #0 {set dialogresult [eval $command]} } -proc Click {button} { - switch -exact -- $button { - ok { set button 1 } - cancel { set button 2 } +proc Click {a_button} { + switch -exact -- $a_button { + ok { set button 1 } + cancel { set button 2 } + default { set button 2 } } testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b } -proc GetText {id} { - switch -exact -- $id { +proc GetText {a_id} { + switch -exact -- $a_id { ok { set id 1 } cancel { set id 2 } + default { set id 2 } } return [testwinevent $::tk_dialog $id WM_GETTEXT] } @@ -107,7 +109,7 @@ test winDialog-1.3 {Tk_ChooseColorObjCmd} -constraints { test winDialog-1.4 {Tk_ChooseColorObjCmd: -title} -constraints { testwinevent } -setup { - catch {unset a x} + unset -nocomplain a x } -body { set x {} start {set clr [tk_chooseColor -initialcolor "#ff9933" -title "Hello"]} @@ -123,7 +125,7 @@ test winDialog-1.4 {Tk_ChooseColorObjCmd: -title} -constraints { test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints { testwinevent } -setup { - catch {unset a x} + unset -nocomplain a x } -body { set x {} start { @@ -142,7 +144,7 @@ test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints { test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints { testwinevent } -setup { - catch {unset a x} + unset -nocomplain a x } -body { start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]} set x {} @@ -150,7 +152,7 @@ test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints { if {[catch { array set a [testgetwindowinfo $::tk_dialog] if {[info exists a(parent)]} { - append x [expr {$a(parent) == [wm frame .]}] + append x [expr {$a(parent) eq [wm frame .]}] } } err]} {lappend x $err} Click ok @@ -163,7 +165,6 @@ test winDialog-1.7 {Tk_ChooseColorObjCmd: -parent} -constraints { tk_chooseColor -initialcolor "#ff9933" -parent .xyzzy12 } -returnCodes error -match glob -result {bad window path name*} - test winDialog-2.1 {ColorDlgHookProc} -constraints {emptyTest nt} -body {} test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints { @@ -177,7 +178,6 @@ test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints { return $x } -result {Cancel} - test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints { nt testwinevent english } -body { @@ -461,16 +461,12 @@ test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraint return $x } -result {0} - test winDialog-6.1 {MakeFilter} -constraints {emptyTest nt} -body {} - test winDialog-7.1 {Tk_MessageBoxObjCmd} -constraints {emptyTest nt} -body {} - test winDialog-8.1 {OFNHookProc} -constraints {emptyTest nt} -body {} - ## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows ## because somehow the GetOpenFileName ends up a noop in the static ## build. @@ -536,7 +532,6 @@ test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFi tk_chooseDirectory -initialdir ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} - test winDialog-10.1 {Tk_FontchooserObjCmd: no arguments} -constraints { nt testwinevent } -body { @@ -581,7 +576,7 @@ test winDialog-10.4 {Tk_FontchooserObjCmd: -title} -constraints { test winDialog-10.5 {Tk_FontchooserObjCmd: -parent} -constraints { nt testwinevent } -setup { - array set a {parent {}} + array set a {parent ""} } -body { start { tk fontchooser configure -command ApplyFont -parent . @@ -591,7 +586,7 @@ test winDialog-10.5 {Tk_FontchooserObjCmd: -parent} -constraints { array set a [testgetwindowinfo $::tk_dialog] Click cancel } - list [expr {$a(parent) == [wm frame .]}] $::testfont + list [expr {$a(parent) eq [wm frame .]}] $::testfont } -result {1 {}} test winDialog-10.6 {Tk_FontchooserObjCmd: -apply} -constraints { nt testwinevent diff --git a/tests/winFont.test b/tests/winFont.test index 8039426..228b2c3 100644 --- a/tests/winFont.test +++ b/tests/winFont.test @@ -15,7 +15,6 @@ namespace import ::tcltest::* tcltest::configure {*}$argv tcltest::loadTestedCommands - test winfont-1.1 {TkpGetNativeFont procedure: not native} -constraints { win } -body { @@ -32,7 +31,6 @@ test winfont-1.2 {TkpGetNativeFont procedure: native} -constraints win -body { set x {} } -result {} - test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} -constraints { win } -body { @@ -96,14 +94,12 @@ test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} -constraints { # No way to get it to fail! Any font name is acceptable. } -result {} - test winfont-3.1 {TkpDeleteFont procedure} -constraints win -body { catch {font delete xyz} font actual {-family xyz} set x {} } -result {} - test winfont-4.1 {TkpGetFontFamilies procedure} -constraints win -body { font families set x {} @@ -113,7 +109,7 @@ destroy .t toplevel .t wm geometry .t +0+0 update idletasks -label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font systemfixed +label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left -text "0" -font systemfixed pack .t.l canvas .t.c -closeenough 0 @@ -135,7 +131,7 @@ test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} -constraint } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -154,7 +150,7 @@ test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} -cons } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -173,7 +169,7 @@ test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} -constraints { } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -192,7 +188,7 @@ test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} -constraints { } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -228,7 +224,7 @@ test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} -constra } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -247,7 +243,7 @@ test winfont-5.7 {Tk_MeasureChars procedure: whole words} -constraints { } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -266,7 +262,7 @@ test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} -constra } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -285,7 +281,7 @@ test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} -const } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -304,7 +300,7 @@ test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} -cons } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -323,7 +319,7 @@ test winfont-5.11 {Tk_MeasureChars procedure: check for kerning} -constraints { } -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -339,11 +335,10 @@ test winfont-5.11 {Tk_MeasureChars procedure: check for kerning} -constraints { destroy .t.l } -result {1} - test winfont-6.1 {Tk_DrawChars procedure: loop test} -constraints win -setup { destroy .t.l } -body { - label .t.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left \ + label .t.l -padx 0 -pady 0 -borderwidth 0 -highlightthickness 0 -justify left \ -text "0" -font systemfixed pack .t.l update @@ -353,7 +348,6 @@ test winfont-6.1 {Tk_DrawChars procedure: loop test} -constraints win -setup { destroy .t.l } -result {} - test winfont-7.1 {AllocFont procedure: use old font} -constraints win -setup { destroy .c } -setup { diff --git a/tests/winMenu.test b/tests/winMenu.test index ce2069f..6fa115b 100644 --- a/tests/winMenu.test +++ b/tests/winMenu.test @@ -26,7 +26,6 @@ test winMenu-1.2 {GetNewID} -constraints win -setup { destroy .m1 } -result {} - # Basically impossible to test menu IDs wrapping. test winMenu-2.1 {FreeID} -constraints win -setup { @@ -36,7 +35,6 @@ test winMenu-2.1 {FreeID} -constraints win -setup { destroy .m1 } -returnCodes ok - test winMenu-3.1 {TkpNewMenu} -constraints win -setup { destroy .m1 } -body { @@ -51,7 +49,6 @@ test winMenu-3.2 {TkpNewMenu} -constraints win -setup { list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2 } -result {0 {} {} 0 {}} - test winMenu-4.1 {TkpDestroyMenu} -constraints win -setup { destroy .m1 } -body { @@ -67,7 +64,6 @@ test winMenu-4.2 {TkpDestroyMenu - help menu} -constraints win -setup { list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1] } -result {0 {} {} {}} - test winMenu-5.1 {TkpDestroyMenuEntry} -constraints win -setup { destroy .m1 } -body { @@ -78,7 +74,6 @@ test winMenu-5.1 {TkpDestroyMenuEntry} -constraints win -setup { list [catch {.m1 delete 1} msg] $msg [destroy .m1] } -result {0 {} {}} - test winMenu-6.1 {GetEntryText} -constraints win -setup { destroy .m1 } -body { @@ -303,7 +298,7 @@ test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} -constraints { test winMenu-7.14 {ReconfigureWindowsMenu - cascade} -constraints win -setup { destroy .m1 } -body { - catch {destroy .m2} + destroy .m2 menu .m1 -tearoff 0 menu .m2 .m1 add cascade -menu .m2 -label Hello @@ -421,7 +416,6 @@ test winMenu-8.6 {TkpPostMenu - update not pending} -constraints { list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } -result {0 {} {}} - test winMenu-9.1 {TkpMenuNewEntry} -constraints win -setup { destroy .m1 } -body { @@ -429,7 +423,6 @@ test winMenu-9.1 {TkpMenuNewEntry} -constraints win -setup { list [catch {.m1 add command} msg] $msg [destroy .m1] } -result {0 {} {}} - test winMenu-10.1 {TkwinMenuProc} -constraints { win userInteraction } -setup { @@ -448,7 +441,7 @@ test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} -constraints { } -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 -postcommand "set foo test" .m1 add command -label "winMenu-11.1: Hit ESCAPE." list [.m1 post 40 40] [set foo] [unset foo] [destroy .m1] @@ -458,7 +451,7 @@ test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} -constraints { } -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo menu .m1 .m1 add checkbutton -variable foo -label "winMenu-11.2: Please select this menu item." list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1] @@ -468,7 +461,7 @@ test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} -constraints { } -setup { destroy .m1 } -body { - catch {unset foo} + unset -nocomplain foo proc bgerror {args} { global foo errorInfo set foo [list $args $errorInfo] @@ -531,7 +524,6 @@ test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} -constraint list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } -result {0 {} {}} - test winMenu-12.1 {TkpSetWindowMenuBar} -constraints win -setup { destroy .m1 } -body { @@ -561,12 +553,10 @@ test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} -constraints { list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } -result {0 {} {} {}} - test winMenu-13.1 {TkpSetMainMenubar - nothing to do} -constraints { emptyTest win } -body {} - test winMenu-14.1 {GetMenuIndicatorGeometry} -constraints win -setup { destroy .m1 } -body { @@ -584,7 +574,6 @@ test winMenu-14.2 {GetMenuIndicatorGeometry} -constraints win -setup { destroy .m1 } -returnCodes ok - test winMenu-15.1 {GetMenuAccelGeometry} -constraints win -setup { destroy .m1 } -body { @@ -610,7 +599,6 @@ test winMenu-15.3 {GetMenuAccelGeometry} -constraints win -setup { destroy .m1 } -returnCodes ok - test winMenu-16.1 {GetTearoffEntryGeometry} -constraints { win userInteraction } -setup { @@ -621,7 +609,6 @@ test winMenu-16.1 {GetTearoffEntryGeometry} -constraints { list [.m1 post 40 40] [destroy .m1] } -result {{} {}} - test winMenu-17.1 {GetMenuSeparatorGeometry} -constraints win -setup { destroy .m1 } -body { @@ -656,7 +643,6 @@ test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} -constraints { list [update] [destroy .m1] } -result {{} {}} - test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} -constraints { win } -setup { @@ -721,7 +707,6 @@ test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} -constraints { list [update] [destroy .m1] } -result {{} {}} - test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} -constraints win -setup { destroy .m1 } -body { @@ -770,7 +755,6 @@ test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} -constra list [.m1 post 40 40] [destroy .m1] } -result {{} {}} - test winMenu-21.1 {DrawMenuSeparator} -constraints win -setup { destroy .m1 } -body { @@ -780,7 +764,6 @@ test winMenu-21.1 {DrawMenuSeparator} -constraints win -setup { list [update] [destroy .m1] } -result {{} {}} - test winMenu-22.1 {DrawMenuUnderline} -constraints win -setup { destroy .m1 } -body { @@ -790,17 +773,14 @@ test winMenu-22.1 {DrawMenuUnderline} -constraints win -setup { list [update] [destroy .m1] } -result {{} {}} - test winMenu-23.1 {Don't know how to test MenuKeyBindProc} -constraints { win emptyTest } -body {} - test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} -constraints { win emptyTest } -body {} - test winMenu-25.1 {DrawMenuEntryLabel - normal} -constraints win -setup { destroy .m1 } -body { @@ -830,7 +810,6 @@ test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} -constraints { list [update] [destroy .m1] } -result {{} {}} - test winMenu-26.1 {TkpComputeMenubarGeometry} -constraints win -setup { destroy .m1 } -body { @@ -839,7 +818,6 @@ test winMenu-26.1 {TkpComputeMenubarGeometry} -constraints win -setup { list [. configure -menu .m1] [. configure -menu ""] [destroy .m1] } -result {{} {} {}} - test winMenu-27.1 {DrawTearoffEntry} -constraints { win userInteraction } -setup { @@ -850,7 +828,6 @@ test winMenu-27.1 {DrawTearoffEntry} -constraints { list [.m1 post 40 40] [destroy .m1] } -result {{} {}} - test winMenu-28.1 {TkpConfigureMenuEntry - update pending} -constraints { win } -setup { @@ -871,7 +848,6 @@ test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} -constraints { list [catch {.m1 add command -label Two} msg] $msg [destroy .m1] } -result {0 {} {}} - test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} -constraints { win } -setup { @@ -1094,7 +1070,6 @@ test winMenu-29.22 {TkpDrawMenuEntry - indicator} -constraints win -setup { list [update] [destroy .m1] } -result {{} {}} - test winMenu-30.1 {GetMenuLabelGeometry - image} -constraints { testImageType win } -setup { @@ -1128,7 +1103,6 @@ test winMenu-30.4 {GetMenuLabelGeometry - text} -constraints win -setup { list [update idletasks] [destroy .m1] } -result {{} {}} - test winMenu-31.1 {DrawMenuEntryBackground} -constraints win -setup { destroy .m1 } -body { @@ -1147,7 +1121,6 @@ test winMenu-31.2 {DrawMenuEntryBackground} -constraints win -setup { list [update] [destroy .m1] } -result {{} {}} - test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} -constraints { win } -setup { @@ -1346,7 +1319,6 @@ test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} -constraints list [update idletasks] [destroy .m1] } -result {{} {}} - test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} -constraints { win } -setup { @@ -1369,7 +1341,6 @@ test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} -constraints win -setup { list [update idletasks] [destroy .m1] [destroy .t2] } -result {{} {} {}} - test winMenu-34.1 {TkpMenuInit called at boot time} -constraints { emptyTest win } -body {} diff --git a/tests/winMsgbox.test b/tests/winMsgbox.test index 0181103..5947e12 100644 --- a/tests/winMsgbox.test +++ b/tests/winMsgbox.test @@ -23,7 +23,8 @@ proc GetWindowInfo {title button} { set hwnd [testfindwindow $title "#32770"] set windowInfo [testgetwindowinfo $hwnd] array set a $windowInfo - set childinfo {} ; set childtext "" + set childinfo [list] + set childtext "" foreach child $a(children) { lappend childinfo $child [set info [testgetwindowinfo $child]] array set ca $info diff --git a/tests/winSend.test b/tests/winSend.test index 0f3baf8..21e387c 100644 --- a/tests/winSend.test +++ b/tests/winSend.test @@ -14,7 +14,7 @@ tcltest::loadTestedCommands # Compute a script that will load Tk into a child interpreter. foreach pkg [info loaded] { - if {[lindex $pkg 1] == "Tk"} { + if {[lindex $pkg 1] eq "Tk"} { set loadTk "load $pkg" break } @@ -22,12 +22,12 @@ foreach pkg [info loaded] { # Procedure to create a new application with a given name and class. -proc newApp {name {safe {}}} { +proc newApp {name {safe ""}} { global loadTk - if {[string compare $safe "-safe"] == 0} { - interp create -safe $name + if {$safe eq "-safe"} { + interp create -safe -- $name } else { - interp create $name + interp create -- $name } $name eval [list set argv [list -name $name]] catch {eval $loadTk $name} @@ -35,17 +35,17 @@ proc newApp {name {safe {}}} { set currentInterps [winfo interps] if { - [testConstraint win] && - [llength [info commands send]] && - [catch {exec [interpreter] &}] == 0 -} then { + [testConstraint win] && + [llength [info commands send]] && + (![catch {exec -- [interpreter] &}]) +} { # Wait until the child application has launched. while {[llength [winfo interps]] == [llength $currentInterps]} {} # Now find an interp to send to set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch -exact $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -123,7 +123,7 @@ test winSend-2.4 {Tk_SendObjCmd - sending to ourselves in a different interp wit test winSend-2.5 {Tk_SendObjCmd - sending to another app async} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -132,7 +132,7 @@ test winSend-2.5 {Tk_SendObjCmd - sending to another app async} winSend { test winSend-2.6 {Tk_SendObjCmd - sending to another app sync - no error} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -141,7 +141,7 @@ test winSend-2.6 {Tk_SendObjCmd - sending to another app sync - no error} winSen test winSend-2.7 {Tk_SendObjCmd - sending to another app - error} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -166,7 +166,7 @@ test winSend-4.2 {DeleteProc - normal} winSend { test winSend-5.1 {ExecuteRemoteObject - no error} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -175,7 +175,7 @@ test winSend-5.1 {ExecuteRemoteObject - no error} winSend { test winSend-5.2 {ExecuteRemoteObject - error} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -186,7 +186,7 @@ test winSend-6.1 {SendDDEServer - XTYP_CONNECT} winSend { set foo "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -197,7 +197,7 @@ test winSend-6.2 {SendDDEServer - XTYP_CONNECT_CONFIRM} winSend { set foo "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -208,7 +208,7 @@ test winSend-6.3 {SendDDEServer - XTYP_DISCONNECT} winSend { set foo "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -219,7 +219,7 @@ test winSend-6.4 {SendDDEServer - XTYP_REQUEST variable} winSend { set foo "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -227,22 +227,22 @@ test winSend-6.4 {SendDDEServer - XTYP_REQUEST variable} winSend { list [catch "send \{$interp\} \{$command\}" msg] $msg } {0 {Hello, World}} test winSend-6.5 {SendDDEServer - XTYP_REQUEST array} winSend { - catch {unset foo} + unset -nocomplain foo set foo(test) "Hello, World" set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } set command "dde request Tk [tk appname] foo(test)" - list [catch "send \{$interp\} \{$command\}" msg] $msg [catch {unset foo}] + list [catch "send \{$interp\} \{$command\}" msg] $msg [unset -nocomplain foo] } {0 {Hello, World} 0} test winSend-6.6 {SendDDEServer - XTYP_REQUEST return results} winSend { set foo 3 set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -252,7 +252,7 @@ test winSend-6.6 {SendDDEServer - XTYP_REQUEST return results} winSend { test winSend-6.7 {SendDDEServer - XTYP_EXECUTE} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -262,7 +262,7 @@ test winSend-6.7 {SendDDEServer - XTYP_EXECUTE} winSend { test winSend-6.8 {SendDDEServer - XTYP_WILDCONNECT} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -278,7 +278,7 @@ test winSend-7.1 {DDEExitProc} winSend { test winSend-8.1 {SendDdeConnect} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -319,7 +319,7 @@ test winSend-10.9 {Tk_DDEObjCmd - null topic name} winSend { test winSend-10.10 {Tk_DDEObjCmd - execute - nothing to execute} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -331,7 +331,7 @@ test winSend-10.11 {Tk_DDEObjCmd - execute - no such conversation} winSend { test winSend-10.12 {Tk_DDEObjCmd - execute - async} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -340,7 +340,7 @@ test winSend-10.12 {Tk_DDEObjCmd - execute - async} winSend { test winSend-10.13 {Tk_DDEObjCmd - execute} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -349,7 +349,7 @@ test winSend-10.13 {Tk_DDEObjCmd - execute} winSend { test winSend-10.14 {Tk_DDEObjCmd - request - nothing to request} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -358,7 +358,7 @@ test winSend-10.14 {Tk_DDEObjCmd - request - nothing to request} winSend { test winSend-10.15 {Tk_DDEObjCmd - request - invalid interp} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -367,7 +367,7 @@ test winSend-10.15 {Tk_DDEObjCmd - request - invalid interp} winSend { test winSend-10.16 {Tk_DDEObjCmd - invalid variable} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -377,7 +377,7 @@ test winSend-10.16 {Tk_DDEObjCmd - invalid variable} winSend { test winSend-10.17 {Tk_DDEObjCmd - valid variable} winSend { set newInterps [winfo interps] foreach interp $newInterps { - if {[lsearch $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { break } } @@ -394,7 +394,7 @@ test winSend-10.18 {Tk_DDEObjCmd - services} winSend { set newInterps [winfo interps] while {[llength $newInterps] != [llength $currentInterps]} { foreach interp $newInterps { - if {[lsearch -exact $currentInterps $interp] < 0} { + if {$interp ni $currentInterps} { catch {send $interp exit} set newInterps [winfo interps] break diff --git a/tests/winWm.test b/tests/winWm.test index ad4988d..491310b 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -14,7 +14,6 @@ namespace import ::tcltest::* tcltest::configure {*}$argv tcltest::loadTestedCommands - test winWm-1.1 {TkWmMapWindow} -constraints win -setup { destroy .t } -body { @@ -73,7 +72,6 @@ test winWm-1.5 {TkWmMapWindow} -constraints win -setup { wm state .t } -result {iconic} - test winWm-2.1 {TkpWmSetState} -constraints win -setup { destroy .t } -body { @@ -149,7 +147,6 @@ test winWm-2.4 {TkpWmSetState} -constraints win -setup { destroy .t } -result {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}} - test winWm-3.1 {ConfigureTopLevel: window geometry propagation} -constraints { win } -setup { @@ -173,7 +170,6 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} -constraints { destroy .t } -result 1 - test winWm-4.1 {ConfigureTopLevel: menu resizing} -constraints win -setup { destroy .t } -body { @@ -363,7 +359,6 @@ test winWm-6.8 {wm attributes -transparentcolor} -constraints win -setup { destroy .t } -returnCodes error -result {unknown color name "foo"} - test winWm-7.1 {deiconify on an unmapped toplevel will raise \ the window and set the focus} -constraints { win @@ -426,7 +421,6 @@ test winWm-7.4 {UpdateWrapper must maintain focus} -constraints win -setup { destroy .t } -result {.t .t} - test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} -constraints win -body { wm iconph . } -returnCodes error -result {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"} @@ -551,7 +545,7 @@ test winWm-9.2 "check wm forget for unmapped parent (#3205464,#2967911)" -setup pack .t.f lappend aid [after 100 { set ::winwm92 [expr { - [winfo rooty .t.f.x] == 0 ? "failed" : "ok"}]}] + ([winfo rooty .t.f.x] == 0) ? "failed" : "ok"}]}] }] }] }] diff --git a/tests/window.test b/tests/window.test index 876ba81..6adbd2d 100644 --- a/tests/window.test +++ b/tests/window.test @@ -10,7 +10,7 @@ namespace import ::tcltest::* tcltest::configure {*}$argv tcltest::loadTestedCommands testConstraint unthreaded [expr { - (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded)) + (![info exist tcl_platform(threaded)]) || (!$tcl_platform(threaded)) }] namespace import ::tk::test::loadTkCommand update @@ -52,9 +52,9 @@ test window-2.1 {Tk_DestroyWindow procedure, destroy handler deletes parent} -se } -body { toplevel .t -width 300 -height 200 wm geometry .t +0+0 - frame .t.f -width 200 -height 200 -relief raised -bd 2 + frame .t.f -width 200 -height 200 -relief raised -borderwidth 2 place .t.f -x 0 -y 0 - frame .t.f.f -width 100 -height 100 -relief raised -bd 2 + frame .t.f.f -width 100 -height 100 -relief raised -borderwidth 2 place .t.f.f -relx 1 -rely 1 -anchor se bind .t.f <Destroy> {destroy .t} update @@ -65,9 +65,9 @@ test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} -se } -body { toplevel .t -width 300 -height 200 wm geometry .t +0+0 - frame .t.f -width 200 -height 200 -relief raised -bd 2 + frame .t.f -width 200 -height 200 -relief raised -borderwidth 2 place .t.f -x 0 -y 0 - frame .t.f.f -width 100 -height 100 -relief raised -bd 2 + frame .t.f.f -width 100 -height 100 -relief raised -borderwidth 2 place .t.f.f -relx 1 -rely 1 -anchor se bind .t.f.f <Destroy> {destroy .t} update @@ -76,13 +76,13 @@ test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} -se test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} -setup { destroy .f } -body { - frame .f -width 80 -height 120 -relief raised -bd 2 + frame .f -width 80 -height 120 -relief raised -borderwidth 2 place .f -relx 0.5 -rely 0.5 -anchor center toplevel .f.t -width 300 -height 200 wm geometry .f.t +0+0 - frame .f.t.f -width 200 -height 200 -relief raised -bd 2 + frame .f.t.f -width 200 -height 200 -relief raised -borderwidth 2 place .f.t.f -x 0 -y 0 - frame .f.t.f.f -width 100 -height 100 -relief raised -bd 2 + frame .f.t.f.f -width 100 -height 100 -relief raised -borderwidth 2 place .f.t.f.f -relx 1 -rely 1 -anchor se update destroy .f @@ -267,7 +267,6 @@ test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} -constra list $error $msg } -result {0 YES} - test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints { unix testmenubar } -setup { @@ -276,7 +275,7 @@ test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -con toplevel .t -width 300 -height 200 wm geometry .t +0+0 pack [entry .t.e] - frame .t.f -bd 2 -relief raised + frame .t.f -borderwidth 2 -relief raised testmenubar window .t .t.f update # If stacking order isn't handle properly, generates an X error. @@ -293,7 +292,7 @@ test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} -con pack [entry .t.e] pack [entry .t.e2] update - frame .t.f -bd 2 -relief raised + frame .t.f -borderwidth 2 -relief raised raise .t.f .t.e testmenubar window .t .t.f update @@ -302,7 +301,6 @@ test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} -con destroy .t } -result {} - test window-4.1 {Tk_NameToWindow procedure} -constraints { testmenubar } -setup { @@ -325,7 +323,6 @@ test window-4.2 {Tk_NameToWindow procedure} -constraints { destroy .t } -returnCodes ok -result {100x50+10+10} - test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints { unix testmenubar } -setup { @@ -335,7 +332,7 @@ test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -con wm geometry .t +0+0 pack [entry .t.e] pack [entry .t.e2] - frame .t.f -bd 2 -relief raised + frame .t.f -borderwidth 2 -relief raised testmenubar window .t .t.f update lower .t.e2 .t.f diff --git a/tests/winfo.test b/tests/winfo.test index 14c2838..a43bf4a 100644 --- a/tests/winfo.test +++ b/tests/winfo.test @@ -23,13 +23,13 @@ proc eatColors {w {options ""}} { destroy $w eval toplevel $w $options wm geom $w +0+0 - canvas $w.c -width 400 -height 200 -bd 0 + canvas $w.c -width 400 -height 200 -borderwidth 0 pack $w.c for {set y 0} {$y < 8} {incr y} { for {set x 0} {$x < 40} {incr x} { - set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0] - $w.c create rectangle [expr 10*$x] [expr 20*$y] \ - [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \ + set color [format "#%02x%02x%02x" [expr {$x * 6}] [expr {$y * 30}] 0] + $w.c create rectangle [expr {10 * $x}] [expr {20 * $y}] \ + [expr {(10 * $x) + 10}] [expr {(20 * $y) + 20}] -outline "" \ -fill $color } } @@ -60,7 +60,6 @@ test winfo-1.6 {"winfo atom" command} -body { winfo atom -displayof . PRIMARY } -result 1 - test winfo-2.1 {"winfo atomname" command} -body { winfo atomname } -returnCodes error -result {wrong # args: should be "winfo atomname ?-displayof window? id"} @@ -83,7 +82,6 @@ test winfo-2.7 {"winfo atom" command} -body { winfo atomname -displayof . 2 } -result SECONDARY - test winfo-3.1 {"winfo colormapfull" command} -constraints { defaultPseudocolor8 } -body { @@ -116,8 +114,6 @@ test winfo-3.4 {"winfo colormapfull" command} -constraints { destroy .t } -result {0 1 0 0 1 0} - - test winfo-4.1 {"winfo containing" command} -body { winfo containing 22 } -returnCodes error -result {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"} @@ -135,7 +131,7 @@ test winfo-4.5 {"winfo containing" command} -body { destroy .t } -body { toplevel .t -width 550 -height 400 - frame .t.f -width 80 -height 60 -bd 2 -relief raised + frame .t.f -width 80 -height 60 -borderwidth 2 -relief raised place .t.f -x 50 -y 50 wm geom .t +0+0 update @@ -151,7 +147,7 @@ test winfo-4.6 {"winfo containing" command} -constraints { destroy .t } -body { toplevel .t -width 550 -height 400 - frame .t.f -width 80 -height 60 -bd 2 -relief raised + frame .t.f -width 80 -height 60 -borderwidth 2 -relief raised place .t.f -x 50 -y 50 wm geom .t +0+0 update @@ -164,19 +160,18 @@ test winfo-4.7 {"winfo containing" command} -setup { destroy .t } -body { toplevel .t -width 550 -height 400 - frame .t.f -width 80 -height 60 -bd 2 -relief raised + frame .t.f -width 80 -height 60 -borderwidth 2 -relief raised place .t.f -x 50 -y 50 wm geom .t +0+0 update set x [winfo containing -display .t.f [expr [winfo rootx .t]+600] \ [expr [winfo rooty .t.f]+450]] - expr {($x == ".") || ($x == "")} + expr {($x eq ".") || ($x eq "")} } -cleanup { destroy .t } -result {1} - test winfo-5.1 {"winfo interps" command} -body { winfo interps a } -returnCodes error -result {wrong # args: should be "winfo interps ?-displayof window?"} @@ -193,7 +188,6 @@ test winfo-5.5 {"winfo interps" command} -constraints unix -body { expr {[lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0} } -result {1} - test winfo-6.1 {"winfo exists" command} -body { winfo exists } -returnCodes error -result {wrong # args: should be "winfo exists window"} @@ -218,7 +212,6 @@ test winfo-6.5 {"winfo exists" command} -setup { lappend x [winfo exists .x] } -result {1 0 0} - test winfo-7.1 {"winfo pathname" command} -body { winfo pathname } -returnCodes error -result {wrong # args: should be "winfo pathname ?-displayof window? id"} @@ -252,7 +245,6 @@ test winfo-7.8 {"winfo pathname" command} -constraints { winfo pathname [testwrapper .] } -result {} - test winfo-8.1 {"winfo pointerx" command} -setup { destroy .b button .b -text "Help" @@ -281,7 +273,6 @@ test winfo-8.3 {"winfo pointerxy" command} -setup { catch [winfo pointerx .b] } -result 1 - test winfo-9.1 {"winfo viewable" command} -body { winfo viewable } -returnCodes error -result {wrong # args: should be "winfo viewable window"} @@ -300,9 +291,9 @@ test winfo-9.4 {"winfo viewable" command} -body { test winfo-9.5 {"winfo viewable" command} -setup { deleteWindows } -body { - frame .f1 -width 100 -height 100 -relief raised -bd 2 + frame .f1 -width 100 -height 100 -relief raised -borderwidth 2 place .f1 -x 0 -y 0 - frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 + frame .f1.f2 -width 50 -height 50 -relief raised -borderwidth 2 place .f1.f2 -x 0 -y 0 update list [winfo viewable .f1] [winfo viewable .f1.f2] @@ -312,8 +303,8 @@ test winfo-9.5 {"winfo viewable" command} -setup { test winfo-9.6 {"winfo viewable" command} -setup { deleteWindows } -body { - frame .f1 -width 100 -height 100 -relief raised -bd 2 - frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 + frame .f1 -width 100 -height 100 -relief raised -borderwidth 2 + frame .f1.f2 -width 50 -height 50 -relief raised -borderwidth 2 place .f1.f2 -x 0 -y 0 update list [winfo viewable .f1] [winfo viewable .f1.f2] @@ -323,9 +314,9 @@ test winfo-9.6 {"winfo viewable" command} -setup { test winfo-9.7 {"winfo viewable" command} -setup { deleteWindows } -body { - frame .f1 -width 100 -height 100 -relief raised -bd 2 + frame .f1 -width 100 -height 100 -relief raised -borderwidth 2 place .f1 -x 0 -y 0 - frame .f1.f2 -width 50 -height 50 -relief raised -bd 2 + frame .f1.f2 -width 50 -height 50 -relief raised -borderwidth 2 place .f1.f2 -x 0 -y 0 update wm iconify . @@ -335,7 +326,6 @@ test winfo-9.7 {"winfo viewable" command} -setup { deleteWindows } -result {0 0} - test winfo-10.1 {"winfo visualid" command} -body { winfo visualid } -returnCodes error -result {wrong # args: should be "winfo visualid window"} @@ -346,7 +336,6 @@ test winfo-10.3 {"winfo visualid" command} -body { expr {2 + [winfo visualid .] - [winfo visualid .]} } -result {2} - test winfo-11.1 {"winfo visualid" command} -body { winfo visualsavailable } -returnCodes error -result {wrong # args: should be "winfo visualsavailable window ?includeids?"} @@ -367,7 +356,6 @@ test winfo-11.6 {"winfo visualid" command} -body { expr $x + 2 - $x } -result {2} - test winfo-12.1 {GetDisplayOf procedure} -body { winfo atom - foo x } -returnCodes error -result {wrong # args: should be "winfo atom ?-displayof window? name"} @@ -375,7 +363,6 @@ test winfo-12.2 {GetDisplayOf procedure} -body { winfo atom -d bad_window x } -returnCodes error -result {bad window path name "bad_window"} - # Some embedding tests # test winfo-13.1 {root coordinates of embedded toplevel} -setup { @@ -383,7 +370,7 @@ test winfo-13.1 {root coordinates of embedded toplevel} -setup { } -body { frame .con -container 1 pack .con -expand yes -fill both - toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + toplevel .emb -use [winfo id .con] -borderwidth 0 -highlightthickness 0 button .emb.b pack .emb.b -expand yes -fill both update @@ -399,7 +386,7 @@ test winfo-13.2 {destroying embedded toplevel} -setup { } -body { frame .con -container 1 pack .con -expand yes -fill both - toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + toplevel .emb -use [winfo id .con] -borderwidth 0 -highlightthickness 0 button .emb.b pack .emb.b -expand yes -fill both update @@ -416,7 +403,7 @@ test winfo-13.3 {destroying container window} -setup { } -body { frame .con -container 1 pack .con -expand yes -fill both - toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + toplevel .emb -use [winfo id .con] -borderwidth 0 -highlightthickness 0 button .emb.b pack .emb.b -expand yes -fill both update @@ -433,7 +420,7 @@ test winfo-13.4 {[winfo containing] with embedded windows} -setup { } -body { frame .con -container 1 pack .con -expand yes -fill both - toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0 + toplevel .emb -use [winfo id .con] -borderwidth 0 -highlightthickness 0 button .emb.b pack .emb.b -expand yes -fill both update @@ -447,7 +434,6 @@ test winfo-13.4 {[winfo containing] with embedded windows} -setup { deleteWindows } -result 0 - test winfo-14.1 {usage} -body { winfo ismapped } -returnCodes error -result {wrong # args: should be "winfo ismapped window"} diff --git a/tests/wm.test b/tests/wm.test index 1aa0779..26b398a 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -33,13 +33,15 @@ proc stdWindow {} { # proc raiseDelay {} { - after 100; update + after 100 + update } # How to carry out a small delay while processing events proc eventDelay {{delay 200}} { - after $delay "set done 1" ; vwait done + after $delay "set done 1" + vwait done } deleteWindows @@ -304,7 +306,7 @@ test wm-attributes-1.4.0 {setting/unsetting fullscreen does not change the focus deleteWindows } -result {. . .} test wm-attributes-1.4.1 {setting fullscreen does not generate FocusIn on wrapper create} -setup { - catch {unset focusin} + unset -nocomplain focusin } -constraints win -body { focus -force . toplevel .t @@ -441,10 +443,8 @@ test wm-attributes-1.5.5 {fullscreen stackorder} -setup { deleteWindows } -result {{. .a .b .c} {. .a .b .c} {. .a .b .c}} - stdWindow - ### wm colormapwindows ### test wm-colormapwindows-1.1 {usage} -returnCodes error -body { wm colormapwindows @@ -523,7 +523,7 @@ test wm-deiconify-1.3 {usage} -returnCodes error -body { test wm-deiconify-1.4 {usage} -setup { destroy .icon } -body { - toplevel .icon -width 50 -height 50 -bg red + toplevel .icon -width 50 -height 50 -background red wm iconwindow .t .icon wm deiconify .icon } -returnCodes error -cleanup { @@ -926,7 +926,7 @@ test wm-iconwindow-1.4 {usage} -setup { test wm-iconwindow-1.5 {usage} -setup { destroy .icon .t2 } -body { - toplevel .icon -width 50 -height 50 -bg green + toplevel .icon -width 50 -height 50 -background green toplevel .t2 wm geom .t2 -0+0 wm iconwindow .t2 .icon @@ -940,7 +940,7 @@ test wm-iconwindow-2.1 {setting and reading values} -setup { set result {} } -body { lappend result [wm iconwindow .t] - toplevel .icon -width 50 -height 50 -bg green + toplevel .icon -width 50 -height 50 -background green wm iconwindow .t .icon lappend result [wm iconwindow .t] wm iconwindow .t {} @@ -1540,14 +1540,13 @@ test wm-stackorder-5.3 {An overrideredirect window\ test wm-stackorder-6.1 {An embedded toplevel does not\ appear in the stacking order} -body { toplevel .real -container 1 - toplevel .embd -bg blue -use [winfo id .real] + toplevel .embd -background blue -use [winfo id .real] update wm stackorder . } -cleanup { deleteWindows } -result {. .real} - stdWindow ### wm title ### @@ -1572,15 +1571,18 @@ test wm-title-2.1 {setting and reading values} -setup { ### wm transient ### test wm-transient-1.1 {usage} -returnCodes error -body { - catch {destroy .t} ; toplevel .t + destroy .t + toplevel .t wm transient .t 1 2 } -result {wrong # args: should be "wm transient window ?master?"} test wm-transient-1.2 {usage} -returnCodes error -body { - catch {destroy .t} ; toplevel .t + destroy .t + toplevel .t wm transient .t foo } -result {bad window path name "foo"} test wm-transient-1.3 {usage} -returnCodes error -body { - catch {destroy .t} ; toplevel .t + destroy .t + toplevel .t wm transient foo .t } -result {bad window path name "foo"} deleteWindows @@ -1593,7 +1595,7 @@ test wm-transient-1.4 {usage} -returnCodes error -body { deleteWindows } -result {can't iconify ".subject": it is a transient} test wm-transient-1.5 {usage} -returnCodes error -body { - toplevel .icon -bg blue + toplevel .icon -background blue toplevel .top wm iconwindow .top .icon toplevel .dummy @@ -1602,7 +1604,7 @@ test wm-transient-1.5 {usage} -returnCodes error -body { deleteWindows } -result {can't make ".icon" a transient: it is an icon for .top} test wm-transient-1.6 {usage} -returnCodes error -body { - toplevel .icon -bg blue + toplevel .icon -background blue toplevel .top wm iconwindow .top .icon toplevel .dummy @@ -2286,8 +2288,7 @@ test wm-forget-1.4 "pack into unmapped toplevel causes crash" -body { deleteWindows cleanupTests -catch {unset results} -catch {unset focusin} +unset -nocomplain results focusin return # Local variables: diff --git a/tests/xmfbox.test b/tests/xmfbox.test index f50329c..24799c6 100644 --- a/tests/xmfbox.test +++ b/tests/xmfbox.test @@ -16,7 +16,7 @@ tcltest::configure {*}$argv tcltest::loadTestedCommands set testPWD [pwd] -catch {unset data foo} +unset -nocomplain data foo proc cleanup {} { global testPWD @@ -26,25 +26,25 @@ proc cleanup {} { } msg0] set err1 [catch { - if [file exists ./~nosuchuser1] { + if {[file exists ./~nosuchuser1]} { file delete ./~nosuchuser1 } } msg1] set err2 [catch { - if [file exists ./~nosuchuser2] { + if {[file exists ./~nosuchuser2]} { file delete ./~nosuchuser2 } } msg2] set err3 [catch { - if [file exists ./~nosuchuser3] { + if {[file exists ./~nosuchuser3]} { file delete ./~nosuchuser3 } } msg3] set err4 [catch { - if [file exists ./~nosuchuser4] { + if {[file exists ./~nosuchuser4]} { file delete ./~nosuchuser4 } } msg4] @@ -52,7 +52,7 @@ proc cleanup {} { if {$err0 || $err1 || $err2 || $err3 || $err4} { error [list $msg0 $msg1 $msg2 $msg3 $msg4] } - catch {unset foo} + unset -nocomplain foo destroy .foo } @@ -61,7 +61,7 @@ proc cleanup {} { test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} -constraints { unix } -setup { - catch {unset foo} + unset -nocomplain foo } -body { set x [tk::MotifFDialog_Create foo open {-parent .}] } -cleanup { @@ -71,7 +71,7 @@ test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} -constraints { test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} -constraints { unix } -setup { - catch {unset foo} + unset -nocomplain foo deleteWindows } -body { toplevel .bar @@ -82,7 +82,6 @@ test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} -constraints { destroy .bar } -result {.bar.foo} - test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} -constraints { unix } -body { |