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 /tests | |
parent | 41f5d19540b0b3f053da352e1569c9a4ed019dd5 (diff) | |
download | tk-contrib_patrick_fradin_code_cleanup.zip tk-contrib_patrick_fradin_code_cleanup.tar.gz tk-contrib_patrick_fradin_code_cleanup.tar.bz2 |
Contribution by Patrick Fradin <patrick.fradin@planar.com>contrib_patrick_fradin_code_cleanup
Quoting his mail:
<pre>
==========================================================
Hi Jeff,
I spent some of my time to contribute to the TclTk community ! I'm in
late for Christmas gift but like we said in French : "Mieux vaut tard
que jamais". ;-)
I've use TclDevKit 5.3.0 tclchecker to analyse TclTk code in Tcl and
Tk library directories (library, tools and tests) to correct a lot of
warnings and few errors. (encapsulate some expr, use 'chan xxx'
instead of fconfigure, fileevent...)
I've made some improvements too :
Examples :
- Use 'lassign' instead of many 'lindex' of 'foreach/break' loop.
- Use 'in' or 'ni' operators instead of 'lsearch -exact' or to
factorise some eq/ne && / || tests.
- Use 'eq' or 'ne' to tests strings instead of '==' or '!='.
- Use 'unset -nocomplain' to avoid 'catch {unset...}'.
- Remove some useless catch around 'destroy' calls.
- Use expand {*} instead of 'eval'. Don't touch a lot of code because
I don't know all structs and lists. I think it could be a greater
improvement to reduce 'eval' calls.
Due to previous experience, I dot not change any indentation ! ;-)
==========================================================
</pre>
Diffstat (limited to 'tests')
109 files changed, 2475 insertions, 2941 deletions
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 { |