diff options
Diffstat (limited to 'tests/unixWm.test')
| -rw-r--r-- | tests/unixWm.test | 2352 |
1 files changed, 2352 insertions, 0 deletions
diff --git a/tests/unixWm.test b/tests/unixWm.test new file mode 100644 index 0000000..b165826 --- /dev/null +++ b/tests/unixWm.test @@ -0,0 +1,2352 @@ +# This file is a Tcl script to test out Tk's interactions with +# the window manager, including the "wm" command. It is organized +# in the standard fashion for Tcl tests. +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) unixWm.test 1.46 97/10/27 16:15:36 + +if {$tcl_platform(platform) != "unix"} { + return +} + +if {[string compare test [info procs test]] == 1} { + source defs +} + +proc sleep ms { + global x + after $ms {set x 1} + vwait x +} + +# Procedure to set up a collection of top-level windows + +proc makeToplevels {} { + foreach i [winfo child .] { + destroy $i + } + foreach i {.raise1 .raise2 .raise3} { + toplevel $i + wm geom $i 150x100+0+0 + update + } +} + +set i 1 +foreach geom {+20+80 +80+20 +0+0} { + catch {destroy .t} + test unixWm-1.$i {initial window position} { + toplevel .t -width 200 -height 150 + wm geom .t $geom + update + wm geom .t + } 200x150$geom + incr i +} + +# The tests below are tricky because window managers don't all move +# windows correctly. Try one motion and compute the window manager's +# error, then factor this error into the actual tests. In other words, +# this just makes sure that things are consistent between moves. + +set i 1 +catch {destroy .t} +toplevel .t -width 100 -height 150 +wm geom .t +200+200 +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] +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} { + wm geom .t $geom + update + scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y + format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \ + [eval expr $y$ysign$yerr] + } $geom + incr i +} + +set i 1 +foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { + test unixWm-3.$i {moving window while iconified} { + wm iconify .t + sleep 200 + wm geom .t $geom + update + wm deiconify .t + scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y + format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \ + [eval expr $y$ysign$yerr] + } $geom + incr i +} + +set i 1 +foreach geom {+20+80 +100+40 +0+0} { + test unixWm-4.$i {moving window while withdrawn} { + wm withdraw .t + sleep 200 + wm geom .t $geom + update + wm deiconify .t + wm geom .t + } 100x150$geom + incr i +} + +test unixWm-5.1 {compounded state changes} {nonPortable} { + catch {destroy .t} + toplevel .t -width 200 -height 100 + wm geometry .t +100+100 + update + wm withdraw .t + wm deiconify .t + list [winfo ismapped .t] [wm state .t] +} {1 normal} +test unixWm-5.2 {compounded state changes} {nonPortable} { + catch {destroy .t} + toplevel .t -width 200 -height 100 + wm geometry .t +100+100 + update + wm withdraw .t + wm deiconify .t + wm withdraw .t + list [winfo ismapped .t] [wm state .t] +} {0 withdrawn} +test unixWm-5.3 {compounded state changes} {nonPortable} { + catch {destroy .t} + toplevel .t -width 200 -height 100 + wm geometry .t +100+100 + update + wm iconify .t + wm deiconify .t + wm iconify .t + wm deiconify .t + list [winfo ismapped .t] [wm state .t] +} {1 normal} +test unixWm-5.4 {compounded state changes} {nonPortable} { + catch {destroy .t} + toplevel .t -width 200 -height 100 + wm geometry .t +100+100 + update + wm iconify .t + wm deiconify .t + wm iconify .t + list [winfo ismapped .t] [wm state .t] +} {0 iconic} +test unixWm-5.5 {compounded state changes} {nonPortable} { + catch {destroy .t} + toplevel .t -width 200 -height 100 + wm geometry .t +100+100 + update + wm iconify .t + wm withdraw .t + list [winfo ismapped .t] [wm state .t] +} {0 withdrawn} +test unixWm-5.6 {compounded state changes} {nonPortable} { + catch {destroy .t} + toplevel .t -width 200 -height 100 + wm geometry .t +100+100 + update + wm iconify .t + wm withdraw .t + wm deiconify .t + list [winfo ismapped .t] [wm state .t] +} {1 normal} +test unixWm-5.7 {compounded state changes} {nonPortable} { + catch {destroy .t} + toplevel .t -width 200 -height 100 + wm geometry .t +100+100 + update + wm withdraw .t + wm iconify .t + list [winfo ismapped .t] [wm state .t] +} {0 iconic} + +catch {destroy .t} +toplevel .t -width 200 -height 100 +wm geom .t +10+10 +wm minsize .t 1 1 +update +test unixWm-6.1 {size changes} { + .t config -width 180 -height 150 + update + wm geom .t +} 180x150+10+10 +test unixWm-6.2 {size changes} { + wm geom .t 250x60 + .t config -width 170 -height 140 + update + wm geom .t +} 250x60+10+10 +test unixWm-6.3 {size changes} { + wm geom .t 250x60 + .t config -width 170 -height 140 + wm geom .t {} + update + wm geom .t +} 170x140+10+10 +test unixWm-6.4 {size changes} {nonPortable} { + wm minsize .t 1 1 + update + puts stdout "Please resize window \"t\" with the mouse (but don't move it!)," + puts -nonewline stdout "then hit return: " + flush stdout + gets stdin + update + set width [winfo width .t] + set height [winfo height .t] + .t config -width 230 -height 110 + update + incr width -[winfo width .t] + incr height -[winfo height .t] + wm geom .t {} + update + set w2 [winfo width .t] + set h2 [winfo height .t] + .t config -width 114 -height 261 + update + list $width $height $w2 $h2 [wm geom .t] +} {0 0 230 110 114x261+10+10} + +# I don't know why the wait below is needed, but without it the test +# fails under twm. +sleep 200 + +test unixWm-6.5 {window initially iconic} {nonPortable} { + catch {destroy .t} + toplevel .t -width 100 -height 30 + wm geometry .t +0+0 + wm title .t 2 + wm iconify .t + update idletasks + wm withdraw .t + wm deiconify .t + list [winfo ismapped .t] [wm state .t] +} {1 normal} + +catch {destroy .m} +toplevel .m +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 .]] +update +test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} { + 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 .]] +update +test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} { + list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] +} {1 normal 150 210} +wm withdraw .m +test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} { + list [winfo ismapped .m] +} 0 +destroy .m +catch {destroy .t} + +test unixWm-8.1 {icon windows} { + catch {destroy .t} + catch {destroy .icon} + toplevel .t -width 100 -height 30 + wm geometry .t +0+0 + toplevel .icon -width 50 -height 50 -bg red + wm iconwindow .t .icon + list [catch {wm withdraw .icon} msg] $msg +} {1 {can't withdraw .icon: it is an icon for .t}} +test unixWm-8.2 {icon windows} { + catch {destroy .t} + toplevel .t -width 100 -height 30 + list [catch {wm iconwindow} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} +test unixWm-8.3 {icon windows} { + catch {destroy .t} + toplevel .t -width 100 -height 30 + list [catch {wm iconwindow .t b c} msg] $msg +} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}} +test unixWm-8.4 {icon windows} { + catch {destroy .t} + catch {destroy .icon} + toplevel .t -width 100 -height 30 + wm geom .t +0+0 + set result [wm iconwindow .t] + toplevel .icon -width 50 -height 50 -bg red + wm iconwindow .t .icon + lappend result [wm iconwindow .t] [wm state .icon] + wm iconwindow .t {} + lappend result [wm iconwindow .t] [wm state .icon] + update + lappend result [winfo ismapped .t] [winfo ismapped .icon] + wm iconify .t + update + lappend result [winfo ismapped .t] [winfo ismapped .icon] +} {.icon icon {} withdrawn 1 0 0 0} +test unixWm-8.5 {icon windows} { + catch {destroy .t} + toplevel .t -width 100 -height 30 + list [catch {wm iconwindow .t .gorp} msg] $msg +} {1 {bad window path name ".gorp"}} +test unixWm-8.6 {icon windows} { + catch {destroy .t} + toplevel .t -width 100 -height 30 + frame .t.icon -width 50 -height 50 -bg 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} { + catch {destroy .t} + catch {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 + wm iconwindow .t .icon + set result "[wm iconwindow .t] [wm state .icon] [wm state .icon2]" + wm iconwindow .t .icon2 + lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2] +} {.icon icon normal .icon2 withdrawn icon} +catch {destroy .icon2} +test unixWm-8.8 {icon windows} { + catch {destroy .t} + catch {destroy .icon} + toplevel .icon -width 50 -height 50 -bg red + wm geom .icon +0+0 + update + set result [winfo ismapped .icon] + toplevel .t -width 100 -height 30 + wm geom .t +0+0 + tkwait visibility .t ;# Needed to keep tvtwm happy. + wm iconwindow .t .icon + sleep 500 + lappend result [winfo ismapped .t] [winfo ismapped .icon] +} {1 1 0} +test unixWm-8.9 {icon windows} {nonPortable} { + # This test is non-portable because some window managers will + # destroy an icon window when it's associated window is destroyed. + + catch {destroy .t} + catch {destroy .icon} + toplevel .t -width 100 -height 30 + toplevel .icon -width 50 -height 50 -bg red + wm geom .t +0+0 + wm iconwindow .t .icon + update + set result "[wm state .icon] [winfo ismapped .t] [winfo ismapped .icon]" + destroy .t + wm geom .icon +0+0 + update + lappend result [winfo ismapped .icon] [wm state .icon] + wm deiconify .icon + update + lappend result [winfo ismapped .icon] [wm state .icon] +} {icon 1 0 0 withdrawn 1 normal} + +test unixWm-9.1 {TkWmMapWindow procedure, client property} {unixOnly} { + catch {destroy .t} + toplevel .t -width 100 -height 50 + wm geom .t +0+0 + wm client .t Test_String + update + testprop [testwrapper .t] WM_CLIENT_MACHINE +} {Test_String} +test unixWm-9.2 {TkWmMapWindow procedure, command property} {unixOnly} { + catch {destroy .t} + toplevel .t -width 100 -height 50 + wm geom .t +0+0 + wm command .t "test command" + update + testprop [testwrapper .t] WM_COMMAND +} {test +command +} +test unixWm-9.3 {TkWmMapWindow procedure, iconic windows} { + catch {destroy .t} + toplevel .t -width 100 -height 300 -bg blue + wm geom .t +0+0 + wm iconify .t + sleep 500 + winfo ismapped .t +} {0} +test unixWm-9.4 {TkWmMapWindow procedure, icon windows} { + catch {destroy .t} + sleep 500 + toplevel .t -width 100 -height 50 -bg blue + wm iconwindow . .t + update + set result [winfo ismapped .t] +} {0} +test unixWm-9.5 {TkWmMapWindow procedure, normal windows} { + catch {destroy .t} + toplevel .t -width 200 -height 20 + wm geom .t +0+0 + update + winfo ismapped .t +} {1} + +test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handler} { + catch {destroy .t} + toplevel .t -width 100 -height 50 + wm geom .t +0+0 + update + .t configure -width 200 -height 100 + destroy .t +} {} +test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unixOnly} { + catch {destroy .t} + catch {destroy .f} + toplevel .t -width 300 -height 200 -bd 2 -relief raised + wm geom .t +0+0 + update + frame .f -width 400 -height 30 -bd 2 -relief raised -bg green + bind .f <Destroy> {lappend result destroyed} + testmenubar window .t .f + update + set result {} + destroy .t + lappend result [winfo exists .f] +} {destroyed 0} + +test unixWm-11.1 {Tk_WmCmd procedure, miscellaneous errors} { + list [catch {wm} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} +test unixWm-11.2 {Tk_WmCmd procedure, miscellaneous errors} { + list [catch {wm foo} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} +test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} { + list [catch {wm foo bogus} msg] $msg +} {1 {bad window path name "bogus"}} +test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} { + catch {destroy .b} + button .b -text hello + list [catch {wm geometry .b} msg] $msg +} {1 {window ".b" isn't a top-level window}} + +catch {destroy .t} +catch {destroy .icon} + +toplevel .t -width 100 -height 50 +wm geom .t +0+0 +update + +test unixWm-12.1 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t 12} msg] $msg +} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} +test unixWm-12.2 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t 12 13 14 15 16} msg] $msg +} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} +test unixWm-12.3 {Tk_WmCmd procedure, "aspect" option} { + set result {} + lappend result [wm aspect .t] + wm aspect .t 3 4 10 2 + lappend result [wm aspect .t] + wm aspect .t {} {} {} {} + lappend result [wm aspect .t] +} {{} {3 4 10 2} {}} +test unixWm-12.4 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t bad 14 15 16} msg] $msg +} {1 {expected integer but got "bad"}} +test unixWm-12.5 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t 13 foo 15 16} msg] $msg +} {1 {expected integer but got "foo"}} +test unixWm-12.6 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t 13 14 bar 16} msg] $msg +} {1 {expected integer but got "bar"}} +test unixWm-12.7 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t 13 14 15 baz} msg] $msg +} {1 {expected integer but got "baz"}} +test unixWm-12.8 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t 0 14 15 16} msg] $msg +} {1 {aspect number can't be <= 0}} +test unixWm-12.9 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t 13 0 15 16} msg] $msg +} {1 {aspect number can't be <= 0}} +test unixWm-12.10 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t 13 14 0 16} msg] $msg +} {1 {aspect number can't be <= 0}} +test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} { + list [catch {wm aspect .t 13 14 15 0} msg] $msg +} {1 {aspect number can't be <= 0}} + +test unixWm-13.1 {Tk_WmCmd procedure, "client" option} { + list [catch {wm client .t x y} msg] $msg +} {1 {wrong # arguments: must be "wm client window ?name?"}} +test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unixOnly} { + set result {} + lappend result [wm client .t] + wm client .t Test_String + lappend result [testprop [testwrapper .t] WM_CLIENT_MACHINE] + wm client .t New + lappend result [wm client .t] + wm client .t {} + lappend result [wm client .t] [testprop [testwrapper .t] WM_CLIENT_MACHINE] +} {{} Test_String New {} {}} +test unixWm-13.3 {Tk_WmCmd procedure, "client" option, unmapped window} { + catch {destroy .t2} + toplevel .t2 + wm client .t2 Test_String + wm client .t2 {} + wm client .t2 Test_String + destroy .t2 +} {} + +test unixWm-14.1 {Tk_WmCmd procedure, "colormapwindows" option} { + list [catch {wm colormapwindows .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm colormapwindows window ?windowList?"}} +test unixWm-14.2 {Tk_WmCmd procedure, "colormapwindows" option} { + catch {destroy .t2} + toplevel .t2 -width 200 -height 200 -colormap new + wm geom .t2 +0+0 + frame .t2.a -width 100 -height 30 + frame .t2.b -width 100 -height 30 -colormap new + pack .t2.a .t2.b -side top + update + set x [wm colormapwindows .t2] + frame .t2.c -width 100 -height 30 -colormap new + pack .t2.c -side top + update + list $x [wm colormapwindows .t2] +} {{.t2.b .t2} {.t2.b .t2.c .t2}} +test unixWm-14.3 {Tk_WmCmd procedure, "colormapwindows" option} { + list [catch {wm col . "a \{"} msg] $msg +} {1 {unmatched open brace in list}} +test unixWm-14.4 {Tk_WmCmd procedure, "colormapwindows" option} { + list [catch {wm colormapwindows . foo} msg] $msg +} {1 {bad window path name "foo"}} +test unixWm-14.5 {Tk_WmCmd procedure, "colormapwindows" option} { + catch {destroy .t2} + toplevel .t2 -width 200 -height 200 -colormap new + wm geom .t2 +0+0 + frame .t2.a -width 100 -height 30 + frame .t2.b -width 100 -height 30 + frame .t2.c -width 100 -height 30 + pack .t2.a .t2.b .t2.c -side top + wm colormapwindows .t2 {.t2.c .t2 .t2.a} + wm colormapwindows .t2 +} {.t2.c .t2 .t2.a} +test unixWm-14.6 {Tk_WmCmd procedure, "colormapwindows" option} { + catch {destroy .t2} + toplevel .t2 -width 200 -height 200 + wm geom .t2 +0+0 + frame .t2.a -width 100 -height 30 + frame .t2.b -width 100 -height 30 + frame .t2.c -width 100 -height 30 + pack .t2.a .t2.b .t2.c -side top + wm colormapwindows .t2 {.t2.b .t2.a} + wm colormapwindows .t2 +} {.t2.b .t2.a} +test unixWm-14.7 {Tk_WmCmd procedure, "colormapwindows" option} { + catch {destroy .t2} + toplevel .t2 -width 200 -height 200 -colormap new + wm geom .t2 +0+0 + set x [wm colormapwindows .t2] + wm colormapwindows .t2 {} + list $x [wm colormapwindows .t2] +} {{} {}} +catch {destroy .t2} + +test unixWm-15.1 {Tk_WmCmd procedure, "command" option} { + list [catch {wm command .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm command window ?value?"}} +test unixWm-15.2 {Tk_WmCmd procedure, "command" option} { + list [catch {wm command .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm command window ?value?"}} +test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unixOnly} { + set result {} + lappend result [wm command .t] + wm command .t "test command" + lappend result [testprop [testwrapper .t] WM_COMMAND] + wm command .t "new command" + lappend result [wm command .t] + wm command .t {} + lappend result [wm command .t] [testprop [testwrapper .t] WM_COMMAND] +} {{} {test +command +} {new command} {} {}} +test unixWm-15.4 {Tk_WmCmd procedure, "command" option, window not mapped} { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 +0+0 + wm command .t2 "test command" + wm command .t2 "new command" + wm command .t2 {} + destroy .t2 +} {} +test unixWm-15.5 {Tk_WmCmd procedure, "command" option} { + list [catch {wm command .t "a \{b"} msg] $msg +} {1 {unmatched open brace in list}} + +test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} { + list [catch {wm deiconify .t 12} msg] $msg +} {1 {wrong # arguments: must be "wm deiconify window"}} +test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} { + catch {destroy .icon} + toplevel .icon -width 50 -height 50 -bg red + wm iconwindow .t .icon + set result [list [catch {wm deiconify .icon} msg] $msg] + destroy .icon + set result +} {1 {can't deiconify .icon: it is an icon for .t}} +test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} { + wm iconify .t + set result {} + lappend result [winfo ismapped .t] [wm state .t] + wm deiconify .t + lappend result [winfo ismapped .t] [wm state .t] +} {0 iconic 1 normal} + +test unixWm-17.1 {Tk_WmCmd procedure, "focusmodel" option} { + list [catch {wm focusmodel .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm focusmodel window ?active|passive?"}} +test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} { + list [catch {wm focusmodel .t bogus} msg] $msg +} {1 {bad argument "bogus": must be active or passive}} +test unixWm-17.3 {Tk_WmCmd procedure, "focusmodel" option} { + set result {} + lappend result [wm focusmodel .t] + wm focusmodel .t active + lappend result [wm focusmodel .t] + wm focusmodel .t passive + lappend result [wm focusmodel .t] + set result +} {passive active passive} + +test unixWm-18.1 {Tk_WmCmd procedure, "frame" option} { + list [catch {wm frame .t 12} msg] $msg +} {1 {wrong # arguments: must be "wm frame window"}} +test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} nonPortable { + expr [wm frame .t] == [winfo id .t] +} {0} +test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} nonPortable { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 +0+0 + wm overrideredirect .t2 1 + update + set result [expr [wm frame .t2] == [winfo id .t2]] + destroy .t2 + set result +} {1} + +test unixWm-19.1 {Tk_WmCmd procedure, "geometry" option} { + list [catch {wm geometry .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm geometry window ?newGeometry?"}} +test unixWm-19.2 {Tk_WmCmd procedure, "geometry" option} nonPortable { + wm geometry .t -1+5 + update + wm geometry .t +} {100x50-1+5} +test unixWm-19.3 {Tk_WmCmd procedure, "geometry" option} nonPortable { + wm geometry .t +10-4 + update + wm geometry .t +} {100x50+10-4} +test unixWm-19.4 {Tk_WmCmd procedure, "geometry" option} nonPortable { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 -5+10 + listbox .t2.l -width 30 -height 12 -setgrid 1 + pack .t2.l + update + set result [wm geometry .t2] + destroy .t2 + set result +} {30x12-5+10} +test unixWm-19.5 {Tk_WmCmd procedure, "geometry" option} nonPortable { + wm geometry .t 150x300+5+6 + update + set result {} + lappend result [wm geometry .t] + wm geometry .t {} + update + lappend result [wm geometry .t] +} {150x300+5+6 100x50+5+6} +test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} { + list [catch {wm geometry .t qrs} msg] $msg +} {1 {bad geometry specifier "qrs"}} + +test unixWm-20.1 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} +test unixWm-20.2 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t 12 13 14 15 16} msg] $msg +} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} +test unixWm-20.3 {Tk_WmCmd procedure, "grid" option} { + set result {} + lappend result [wm grid .t] + wm grid .t 5 6 20 10 + lappend result [wm grid .t] + wm grid .t {} {} {} {} + lappend result [wm grid .t] +} {{} {5 6 20 10} {}} +test unixWm-20.4 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t bad 10 11 12} msg] $msg +} {1 {expected integer but got "bad"}} +test unixWm-20.5 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t -1 11 12 13} msg] $msg +} {1 {baseWidth can't be < 0}} +test unixWm-20.6 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t 10 foo 12 13} msg] $msg +} {1 {expected integer but got "foo"}} +test unixWm-20.7 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t 10 -11 12 13} msg] $msg +} {1 {baseHeight can't be < 0}} +test unixWm-20.8 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t 10 11 bar 13} msg] $msg +} {1 {expected integer but got "bar"}} +test unixWm-20.9 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t 10 11 -2 13} msg] $msg +} {1 {widthInc can't be < 0}} +test unixWm-20.10 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t 10 11 12 bogus} msg] $msg +} {1 {expected integer but got "bogus"}} +test unixWm-20.11 {Tk_WmCmd procedure, "grid" option} { + list [catch {wm grid .t 10 11 12 -1} msg] $msg +} {1 {heightInc can't be < 0}} + +catch {destroy .t} +catch {destroy .icon} +toplevel .t -width 100 -height 50 +wm geom .t +0+0 +update + +test unixWm-21.1 {Tk_WmCmd procedure, "group" option} { + list [catch {wm group .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm group window ?pathName?"}} +test unixWm-21.2 {Tk_WmCmd procedure, "group" option} { + list [catch {wm group .t bogus} msg] $msg +} {1 {bad window path name "bogus"}} +test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unixOnly} { + set result {} + lappend result [wm group .t] + wm group .t . + set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \ + WM_HINTS] 0]]] + lappend result [wm group .t] $bit + wm group .t {} + set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \ + WM_HINTS] 0]]] + lappend result [wm group .t] $bit +} {{} . 0x40 {} 0x0} +test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unixOnly} { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 +0+0 + wm group .t .t2 + set hints [testprop [testwrapper .t] WM_HINTS] + set result [expr [testwrapper .t2] - [lindex $hints 8]] + destroy .t2 + set result +} {0} +test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unixOnly} { + catch {destroy .t2} + catch {destroy .t3} + toplevel .t2 -width 120 -height 300 + wm geometry .t2 +0+0 + toplevel .t3 -width 120 -height 300 + wm geometry .t2 +0+0 + set result [list [testwrapper .t2]] + wm group .t3 .t2 + lappend result [expr {[testwrapper .t2] == ""}] + destroy .t2 .t3 + set result +} {{} 0} + +test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} { + list [catch {wm iconbitmap .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm iconbitmap window ?bitmap?"}} +test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unixOnly} { + set result {} + lappend result [wm iconbitmap .t] + wm iconbitmap .t questhead + set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \ + WM_HINTS] 0]]] + lappend result [wm iconbitmap .t] $bit + wm iconbitmap .t {} + set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \ + WM_HINTS] 0]]] + lappend result [wm iconbitmap .t] $bit +} {{} questhead 0x4 {} 0x0} +test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option} { + list [catch {wm iconbitmap .t bad-bitmap} msg] $msg +} {1 {bitmap "bad-bitmap" not defined}} + +test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} { + list [catch {wm iconify .t 12} msg] $msg +} {1 {wrong # arguments: must be "wm iconify window"}} +test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} { + catch {destroy .t2} + toplevel .t2 + wm overrideredirect .t2 1 + set result [list [catch {wm iconify .t2} msg] $msg] + destroy .t2 + set result +} {1 {can't iconify ".t2": override-redirect flag is set}} +test unixWm-23.3 {Tk_WmCmd procedure, "iconify" option} { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 +0+0 + wm transient .t2 .t + set result [list [catch {wm iconify .t2} msg] $msg] + destroy .t2 + set result +} {1 {can't iconify ".t2": it is a transient}} +test unixWm-23.4 {Tk_WmCmd procedure, "iconify" option} { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 +0+0 + wm iconwindow .t .t2 + set result [list [catch {wm iconify .t2} msg] $msg] + destroy .t2 + set result +} {1 {can't iconify .t2: it is an icon for .t}} +test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 +0+0 + wm iconify .t2 + update + set result [winfo ismapped .t2] + destroy .t2 + set result +} {0} +test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} { + catch {destroy .t2} + toplevel .t2 + wm geom .t2 -0+0 + update + set result [winfo ismapped .t2] + wm iconify .t2 + lappend result [winfo ismapped .t2] + destroy .t2 + set result +} {1 0} + +test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} { + list [catch {wm iconmask .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm iconmask window ?bitmap?"}} +test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unixOnly} { + set result {} + lappend result [wm iconmask .t] + wm iconmask .t questhead + set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \ + WM_HINTS] 0]]] + lappend result [wm iconmask .t] $bit + wm iconmask .t {} + set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \ + WM_HINTS] 0]]] + lappend result [wm iconmask .t] $bit +} {{} questhead 0x20 {} 0x0} +test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} { + list [catch {wm iconmask .t bogus} msg] $msg +} {1 {bitmap "bogus" not defined}} + +test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} { + list [catch {wm icon .t} msg] $msg +} {1 {unknown or ambiguous option "icon": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}} +test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} { + list [catch {wm iconname .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm iconname window ?newName?"}} +test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unixOnly} { + set result {} + lappend result [wm iconname .t] + wm iconname .t test_name + lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME] + wm iconname .t {} + lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME] +} {{} test_name test_name {} {}} + +test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} { + list [catch {wm iconposition .t 12} msg] $msg +} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}} +test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} { + list [catch {wm iconposition .t 12 13 14} msg] $msg +} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}} +test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unixOnly} { + set result {} + lappend result [wm iconposition .t] + wm iconposition .t 10 15 + set prop [testprop [testwrapper .t] WM_HINTS] + lappend result [wm iconposition .t] [lindex $prop 5] [lindex $prop 6] + lappend result [format 0x%x [expr 0x10 & [lindex $prop 0]]] + wm iconposition .t {} {} + set bit [format 0x%x [expr 0x10 & [lindex [testprop [testwrapper .t] \ + WM_HINTS] 0]]] + lappend result [wm iconposition .t] $bit +} {{} {10 15} 0xa 0xf 0x10 {} 0x0} +test unixWm-26.4 {Tk_WmCmd procedure, "iconposition" option} { + list [catch {wm iconposition .t bad 13} msg] $msg +} {1 {expected integer but got "bad"}} +test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} { + list [catch {wm iconposition .t 13 lousy} msg] $msg +} {1 {expected integer but got "lousy"}} + +test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} { + list [catch {wm iconwindow .t 12 13} msg] $msg +} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}} +test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unixOnly} { + catch {destroy .icon} + toplevel .icon -width 50 -height 50 -bg green + set result {} + lappend result [wm iconwindow .t] + wm iconwindow .t .icon + set prop [testprop [testwrapper .t] WM_HINTS] + lappend result [wm iconwindow .t] [wm state .icon] + lappend result [format 0x%x [expr 0x8 & [lindex $prop 0]]] + lappend result [expr [testwrapper .icon] == [lindex $prop 4]] + wm iconwindow .t {} + set bit [format 0x%x [expr 0x8 & [lindex [testprop [testwrapper .t] \ + WM_HINTS] 0]]] + lappend result [wm iconwindow .t] [wm state .icon] $bit + destroy .icon + set result +} {{} .icon icon 0x8 1 {} withdrawn 0x0} +test unixWm-27.3 {Tk_WmCmd procedure, "iconwindow" option} { + list [catch {wm iconwindow .t bogus} msg] $msg +} {1 {bad window path name "bogus"}} +test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} { + catch {destroy .b} + button .b -text Help + set result [list [catch {wm iconwindow .t .b} msg] $msg] + destroy .b + set result +} {1 {can't use .b as icon window: not at top level}} +test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} { + catch {destroy .icon} + toplevel .icon -width 50 -height 50 -bg green + catch {destroy .t2} + toplevel .t2 + wm geom .t2 -0+0 + wm iconwindow .t2 .icon + set result [list [catch {wm iconwindow .t .icon} msg] $msg] + destroy .t2 + destroy .icon + set result +} {1 {.icon is already an icon for .t2}} +test unixWm-27.6 {Tk_WmCmd procedure, "iconwindow" option, changing icons} { + catch {destroy .icon} + catch {destroy .icon2} + toplevel .icon -width 50 -height 50 -bg green + toplevel .icon2 -width 50 -height 50 -bg red + set result {} + wm iconwindow .t .icon + lappend result [wm state .icon] [wm state .icon2] + wm iconwindow .t .icon2 + lappend result [wm state .icon] [wm state .icon2] + destroy .icon .icon2 + set result +} {icon normal withdrawn icon} +test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} { + catch {destroy .icon} + toplevel .icon -width 50 -height 50 -bg green + wm geometry .icon +0+0 + update + set result {} + lappend result [wm state .icon] [winfo viewable .icon] + wm iconwindow .t .icon + lappend result [wm state .icon] [winfo viewable .icon] + destroy .icon + set result +} {normal 1 icon 0} + +test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option} { + list [catch {wm maxsize} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} +test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option} { + list [catch {wm maxsize . a} msg] $msg +} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}} +test unixWm-28.3 {Tk_WmCmd procedure, "maxsize" option} { + list [catch {wm maxsize . a b c} msg] $msg +} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}} +test unixWm-28.4 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} { + wm maxsize .t +} {1137 870} +test unixWm-28.5 {Tk_WmCmd procedure, "maxsize" option} { + list [catch {wm maxsize . x 100} msg] $msg +} {1 {expected integer but got "x"}} +test unixWm-28.6 {Tk_WmCmd procedure, "maxsize" option} { + list [catch {wm maxsize . 100 bogus} msg] $msg +} {1 {expected integer but got "bogus"}} +test unixWm-28.7 {Tk_WmCmd procedure, "maxsize" option} { + wm maxsize .t 200 150 + wm maxsize .t +} {200 150} +test unixWm-28.8 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} { + # Not portable, because some window managers let applications override + # minsize and maxsize. + + wm maxsize .t 200 150 + wm geom .t 300x200 + update + list [winfo width .t] [winfo height .t] +} {200 150} + +catch {destroy .t} +catch {destroy .icon} +toplevel .t -width 100 -height 50 +wm geom .t +0+0 +update + +test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option} { + list [catch {wm minsize} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} +test unixWm-29.2 {Tk_WmCmd procedure, "minsize" option} { + list [catch {wm minsize . a} msg] $msg +} {1 {wrong # arguments: must be "wm minsize window ?width height?"}} +test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option} { + list [catch {wm minsize . a b c} msg] $msg +} {1 {wrong # arguments: must be "wm minsize window ?width height?"}} +test unixWm-29.4 {Tk_WmCmd procedure, "minsize" option} { + wm minsize .t +} {1 1} +test unixWm-29.5 {Tk_WmCmd procedure, "minsize" option} { + list [catch {wm minsize . x 100} msg] $msg +} {1 {expected integer but got "x"}} +test unixWm-29.6 {Tk_WmCmd procedure, "minsize" option} { + list [catch {wm minsize . 100 bogus} msg] $msg +} {1 {expected integer but got "bogus"}} +test unixWm-29.7 {Tk_WmCmd procedure, "minsize" option} { + wm minsize .t 200 150 + wm minsize .t +} {200 150} +test unixWm-29.8 {Tk_WmCmd procedure, "minsize" option} {nonPortable} { + # Not portable, because some window managers let applications override + # minsize and maxsize. + + wm minsize .t 150 100 + wm geom .t 50x50 + update + list [winfo width .t] [winfo height .t] +} {150 100} + +catch {destroy .t} +catch {destroy .icon} +toplevel .t -width 100 -height 50 +wm geom .t +0+0 +update + +test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} { + list [catch {wm overrideredirect .t 1 2} msg] $msg +} {1 {wrong # arguments: must be "wm overrideredirect window ?boolean?"}} +test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} { + list [catch {wm overrideredirect .t boo} msg] $msg +} {1 {expected boolean value but got "boo"}} +test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} { + set result {} + lappend result [wm overrideredirect .t] + wm overrideredirect .t true + lappend result [wm overrideredirect .t] + wm overrideredirect .t off + lappend result [wm overrideredirect .t] +} {0 1 0} + +test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} { + list [catch {wm positionfrom .t 1 2} msg] $msg +} {1 {wrong # arguments: must be "wm positionfrom window ?user/program?"}} +test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unixOnly} { + set result {} + lappend result [wm positionfrom .t] + wm positionfrom .t program + update + set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \ + WM_NORMAL_HINTS] 0]]] + lappend result [wm positionfrom .t] $bit + wm positionfrom .t user + update + set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \ + WM_NORMAL_HINTS] 0]]] + lappend result [wm positionfrom .t] $bit +} {user program 0x4 user 0x1} +test unixWm-31.3 {Tk_WmCmd procedure, "positionfrom" option} { + list [catch {wm positionfrom .t none} msg] $msg +} {1 {bad argument "none": must be program or user}} + +test unixWm-32.1 {Tk_WmCmd procedure, "protocol" option} { + list [catch {wm protocol .t 1 2 3} msg] $msg +} {1 {wrong # arguments: must be "wm protocol window ?name? ?command?"}} +test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} { + wm protocol .t {foo a} {a b c} + wm protocol .t bar {test script for bar} + set result [wm protocol .t] + wm protocol .t {foo a} {} + wm protocol .t bar {} + set result +} {bar {foo a}} +test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unixOnly} { + set result {} + lappend result [wm protocol .t] + set x {} + foreach i [testprop [testwrapper .t] WM_PROTOCOLS] { + lappend x [winfo atomname $i] + } + lappend result $x + wm protocol .t foo {test script} + wm protocol .t bar {test script} + set x {} + foreach i [testprop [testwrapper .t] WM_PROTOCOLS] { + lappend x [winfo atomname $i] + } + lappend result [wm protocol .t] $x + wm protocol .t foo {} + wm protocol .t bar {} + set x {} + foreach i [testprop [testwrapper .t] WM_PROTOCOLS] { + lappend x [winfo atomname $i] + } + lappend result [wm protocol .t] $x +} {{} WM_DELETE_WINDOW {bar foo} {WM_DELETE_WINDOW bar foo} {} WM_DELETE_WINDOW} +test unixWm-32.4 {Tk_WmCmd procedure, "protocol" option} { + set result {} + wm protocol .t foo {a b c} + wm protocol .t bar {test script for bar} + lappend result [wm protocol .t foo] [wm protocol .t bar] + wm protocol .t foo {} + wm protocol .t bar {} + lappend result [wm protocol .t foo] [wm protocol .t bar] +} {{a b c} {test script for bar} {} {}} +test unixWm-32.5 {Tk_WmCmd procedure, "protocol" option} { + wm protocol .t foo {a b c} + wm protocol .t foo {test script} + set result [wm protocol .t foo] + wm protocol .t foo {} + set result +} {test script} + +test unixWm-33.1 {Tk_WmCmd procedure, "resizable" option} { + list [catch {wm resizable . a} msg] $msg +} {1 {wrong # arguments: must be "wm resizable window ?width height?"}} +test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} { + list [catch {wm resizable . a b c} msg] $msg +} {1 {wrong # arguments: must be "wm resizable window ?width height?"}} +test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} { + list [catch {wm resizable .foo a b c} msg] $msg +} {1 {bad window path name ".foo"}} +test unixWm-33.4 {Tk_WmCmd procedure, "resizable" option} { + list [catch {wm resizable . x 1} msg] $msg +} {1 {expected boolean value but got "x"}} +test unixWm-33.5 {Tk_WmCmd procedure, "resizable" option} { + list [catch {wm resizable . 0 gorp} msg] $msg +} {1 {expected boolean value but got "gorp"}} +test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} { + catch {destroy .t2} + toplevel .t2 -width 200 -height 100 + wm geom .t2 +0+0 + set result "" + lappend result [wm resizable .t2] + wm resizable .t2 1 0 + lappend result [wm resizable .t2] + wm resizable .t2 no off + lappend result [wm resizable .t2] + wm resizable .t2 false true + lappend result [wm resizable .t2] + destroy .t2 + set result +} {{1 1} {1 0} {0 0} {0 1}} + +test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} { + list [catch {wm sizefrom .t 1 2} msg] $msg +} {1 {wrong # arguments: must be "wm sizefrom window ?user|program?"}} +test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unixOnly} { + set result {} + lappend result [wm sizefrom .t] + wm sizefrom .t program + update + set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \ + WM_NORMAL_HINTS] 0]]] + lappend result [wm sizefrom .t] $bit + wm sizefrom .t user + update + set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \ + WM_NORMAL_HINTS] 0]]] + lappend result [wm sizefrom .t] $bit +} {{} program 0x8 user 0x2} +test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} { + list [catch {wm sizefrom .t none} msg] $msg +} {1 {bad argument "none": must be program or user}} + +test unixWm-35.1 {Tk_WmCmd procedure, "state" option} { + list [catch {wm state .t 1} msg] $msg +} {1 {wrong # arguments: must be "wm state window"}} +test unixWm-35.2 {Tk_WmCmd procedure, "state" option} { + set result {} + catch {destroy .t2} + toplevel .t2 -width 120 -height 300 + wm geometry .t2 +0+0 + lappend result [wm state .t2] + update + lappend result [wm state .t2] + wm withdraw .t2 + lappend result [wm state .t2] + wm iconify .t2 + lappend result [wm state .t2] + wm deiconify .t2 + lappend result [wm state .t2] + destroy .t2 + set result +} {normal normal withdrawn iconic normal} + +test unixWm-36.1 {Tk_WmCmd procedure, "title" option} { + list [catch {wm title .t 1 2} msg] $msg +} {1 {wrong # arguments: must be "wm title window ?newTitle?"}} +test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} { + set result {} + lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME] + wm title .t "Test window" + set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \ + WM_NORMAL_HINTS] 0]]] + lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME] +} {t t {Test window} {Test window}} + +test unixWm-37.1 {Tk_WmCmd procedure, "transient" option} { + list [catch {wm transient .t 1 2} msg] $msg +} {1 {wrong # arguments: must be "wm transient window ?master?"}} +test unixWm-37.2 {Tk_WmCmd procedure, "transient" option} { + list [catch {wm transient .t foo} msg] $msg +} {1 {bad window path name "foo"}} +test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} { + set result {} + catch {destroy .t2} + toplevel .t2 -width 120 -height 300 + wm geometry .t2 +0+0 + update + lappend result [wm transient .t2] \ + [testprop [testwrapper .t2] WM_TRANSIENT_FOR] + wm transient .t2 .t + set transient [testprop [testwrapper .t2] WM_TRANSIENT_FOR] + lappend result [wm transient .t2] [expr [testwrapper .t] - $transient] + wm transient .t2 {} + lappend result [wm transient .t2] \ + [testprop [testwrapper .t2] WM_TRANSIENT_FOR] + destroy .t2 + set result +} {{} {} .t 0 {} 0x0} +test unixWm-37.4 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unixOnly} { + catch {destroy .t2} + catch {destroy .t3} + toplevel .t2 -width 120 -height 300 + wm geometry .t2 +0+0 + toplevel .t3 -width 120 -height 300 + wm geometry .t2 +0+0 + set result [list [testwrapper .t2]] + wm transient .t3 .t2 + lappend result [expr {[testwrapper .t2] == ""}] + destroy .t2 .t3 + set result +} {{} 0} + +test unixWm-38.1 {Tk_WmCmd procedure, "withdraw" option} { + list [catch {wm withdraw .t 1} msg] $msg +} {1 {wrong # arguments: must be "wm withdraw window"}} +test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} { + catch {destroy .t2} + toplevel .t2 -width 120 -height 300 + wm geometry .t2 +0+0 + wm iconwindow .t .t2 + set result [list [catch {wm withdraw .t2} msg] $msg] + destroy .t2 + set result +} {1 {can't withdraw .t2: it is an icon for .t}} +test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} { + set result {} + wm withdraw .t + lappend result [wm state .t] [winfo ismapped .t] + wm deiconify .t + lappend result [wm state .t] [winfo ismapped .t] +} {withdrawn 0 normal 1} + +test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} { + list [catch {wm unknown .t} msg] $msg +} {1 {unknown or ambiguous option "unknown": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}} + +catch {destroy .t} +catch {destroy .icon} + +test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {nonPortable} { + catch {destroy .t} + toplevel .t + wm geometry .t 30x10+0+0 + listbox .t.l -height 20 -width 20 -setgrid 1 + pack .t.l -fill both -expand 1 + update + wm geometry .t +} {30x10+0+0} +test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} { + catch {destroy .t} + toplevel .t + wm geometry .t 200x100+0+0 + listbox .t.l -height 20 -width 20 + pack .t.l -fill both -expand 1 + update + .t.l configure -setgrid 1 + update + wm geometry .t +} {20x20+0+0} + +test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} { + catch {destroy .t} + toplevel .t -width 400 -height 150 + wm geometry .t +0+0 + tkwait visibility .t + set result {} + lappend result [winfo width .t] [winfo height .t] + .t configure -width 200 -height 300 + sleep 500 + lappend result [winfo width .t] [winfo height .t] +} {400 150 200 300} +test unixWm-41.2 {ConfigureEvent procedure, menubars} {unixOnly} { + catch {destroy .t} + toplevel .t -width 300 -height 200 -bd 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 + testmenubar window .t .t.m + update + set result {} + bind .t <Configure> { + if {"%W" == ".t"} { + lappend result "%W: %wx%h" + } + } + bind .t.m <Configure> {lappend result "%W: %wx%h"} + wm geometry .t 200x300 + update + lappend result [expr [winfo rootx .t.m] - $x] \ + [expr [winfo rooty .t.m] - $y] \ + [winfo width .t.m] [winfo height .t.m] \ + [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] \ + [winfo width .t] [winfo height .t] +} {{.t.m: 200x20} {.t: 200x300} 0 0 200 20 0 20 200 300} +test unixWm-41.3 {ConfigureEvent procedure, synthesized Configure events} { + catch {destroy .t} + toplevel .t -width 400 -height 150 + wm geometry .t +0+0 + tkwait visibility .t + set result {no event} + bind .t <Configure> {set result "configured: %w %h"} + wm geometry .t +10+20 + update + set result +} {configured: 400 150} +test unixWm-41.4 {ConfigureEvent procedure, synthesized Configure events} { + catch {destroy .t} + toplevel .t -width 400 -height 150 + wm geometry .t +0+0 + tkwait visibility .t + set result {no event} + bind .t <Configure> {set result "configured: %w %h"} + wm geometry .t 130x200 + update + set result +} {configured: 130 200} + +# No tests for ReparentEvent or ComputeReparentGeometry; I can't figure +# out how to exercise these procedures reliably. + +test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} { + catch {destroy .t} + toplevel .t -width 400 -height 150 + wm geometry .t +0+0 + tkwait visibility .t + set result {} + bind .t <Map> {set x "mapped"} + bind .t <Unmap> {set x "unmapped"} + set x {no event} + wm iconify .t + lappend result $x [winfo ismapped .t] + set x {no event} + wm deiconify .t + lappend result $x [winfo ismapped .t] +} {unmapped 0 mapped 1} + +test unixWm-43.1 {TopLevelReqProc procedure, embedded in same process} { + catch {destroy .t} + toplevel .t -width 200 -height 200 + wm geom .t +0+0 + frame .t.f -container 1 -bd 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 + tkwait visibility .t2 + set result {} + .t2 configure -width 70 -height 120 + update + lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f] + lappend result [winfo width .t2] [winfo height .t2] + # destroy .t2 + set result +} {70 120 70 120} +test unixWm-43.2 {TopLevelReqProc procedure, resize causes window to move} \ + {nonPortable} { + catch {destroy .t} + toplevel .t -width 200 -height 200 + wm geom .t +0+0 + update + wm geom .t -0-0 + update + set x [winfo x .t] + set y [winfo y .t] + .t configure -width 300 -height 150 + update + list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \ + [winfo width .t] [winfo height .t] +} {-100 50 300 150} + +test unixWm-44.1 {UpdateGeometryInfo procedure, width/height computation} { + catch {destroy .t} + toplevel .t -width 100 -height 200 + wm geometry .t +30+40 + wm overrideredirect .t 1 + tkwait visibility .t + .t configure -width 180 -height 20 + update + list [winfo width .t] [winfo height .t] +} {180 20} +test unixWm-44.2 {UpdateGeometryInfo procedure, width/height computation} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm grid .t 5 4 10 12 + wm geometry .t +30+40 + wm overrideredirect .t 1 + tkwait visibility .t + wm geometry .t 10x2 + update + list [winfo width .t] [winfo height .t] +} {130 36} +test unixWm-44.3 {UpdateGeometryInfo procedure, width/height computation} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm grid .t 5 4 10 12 + wm geometry .t +30+40 + wm overrideredirect .t 1 + tkwait visibility .t + wm geometry .t 1x10 + update + list [winfo width .t] [winfo height .t] +} {40 132} +test unixWm-44.4 {UpdateGeometryInfo procedure, width/height computation} { + catch {destroy .t} + toplevel .t -width 100 -height 200 + wm geometry .t +30+40 + wm overrideredirect .t 1 + tkwait visibility .t + wm geometry .t 300x150 + update + list [winfo width .t] [winfo height .t] +} {300 150} +test unixWm-44.5 {UpdateGeometryInfo procedure, negative width} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm grid .t 18 7 10 12 + wm geometry .t +30+40 + wm overrideredirect .t 1 + tkwait visibility .t + wm geometry .t 5x8 + update + list [winfo width .t] [winfo height .t] +} {1 72} +test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm grid .t 18 7 10 12 + wm geometry .t +30+40 + wm overrideredirect .t 1 + tkwait visibility .t + wm geometry .t 20x1 + update + list [winfo width .t] [winfo height .t] +} {100 1} +test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm geometry .t +5-10 + wm overrideredirect .t 1 + tkwait visibility .t + list [winfo x .t] [winfo y .t] +} "5 [expr [winfo screenheight .t] - 70]" +test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm geometry .t -30+2 + wm overrideredirect .t 1 + tkwait visibility .t + list [winfo x .t] [winfo y .t] +} "[expr [winfo screenwidth .t] - 110] 2" +test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm resizable .t 0 0 + wm geometry .t +0+0 + tkwait visibility .t + .t configure -width 180 -height 20 + update + set property [testprop [testwrapper .t] WM_NORMAL_HINTS] + list [expr [lindex $property 5]] [expr [lindex $property 6]] \ + [expr [lindex $property 7]] [expr [lindex $property 8]] +} {180 20 180 20} +test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm resizable .t 0 0 + 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 + testmenubar window .t .t.m + update + .t configure -height 70 + .t.m configure -height 30 + list [update] [destroy .t] +} {{} {}} + +test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unixOnly} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm grid .t 6 10 10 5 + wm minsize .t 2 4 + wm maxsize .t 30 40 + wm geometry .t +0+0 + tkwait visibility .t + set property [testprop [testwrapper .t] WM_NORMAL_HINTS] + list [expr [lindex $property 5]] [expr [lindex $property 6]] \ + [expr [lindex $property 7]] [expr [lindex $property 8]] \ + [expr [lindex $property 9]] [expr [lindex $property 10]] +} {40 30 320 210 10 5} +test unixWm-45.2 {UpdateSizeHints procedure} {unixOnly} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + wm minsize .t 30 40 + wm maxsize .t 200 500 + wm geometry .t +0+0 + tkwait visibility .t + set property [testprop [testwrapper .t] WM_NORMAL_HINTS] + list [expr [lindex $property 5]] [expr [lindex $property 6]] \ + [expr [lindex $property 7]] [expr [lindex $property 8]] \ + [expr [lindex $property 9]] [expr [lindex $property 10]] +} {30 40 200 500 1 1} +test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + frame .t.menu -height 23 -width 50 + testmenubar window .t .t.menu + wm grid .t 6 10 10 5 + wm minsize .t 2 4 + wm maxsize .t 30 40 + wm geometry .t +0+0 + tkwait visibility .t + set property [testprop [testwrapper .t] WM_NORMAL_HINTS] + list [winfo height .t] \ + [expr [lindex $property 5]] [expr [lindex $property 6]] \ + [expr [lindex $property 7]] [expr [lindex $property 8]] \ + [expr [lindex $property 9]] [expr [lindex $property 10]] +} {60 40 53 320 233 10 5} +test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} { + catch {destroy .t} + toplevel .t -width 80 -height 60 + frame .t.menu -height 23 -width 50 + testmenubar window .t .t.menu + wm resizable .t 0 0 + wm geometry .t +0+0 + tkwait visibility .t + set property [testprop [testwrapper .t] WM_NORMAL_HINTS] + list [winfo height .t] \ + [expr [lindex $property 5]] [expr [lindex $property 6]] \ + [expr [lindex $property 7]] [expr [lindex $property 8]] \ + [expr [lindex $property 9]] [expr [lindex $property 10]] +} {60 80 83 80 83 1 1} + +# I don't know how to test WaitForConfigureNotify. + +test unixWm-46.1 {WaitForEvent procedure, use of modal timeout} { + catch {destroy .t} + toplevel .t -width 200 -height 200 + wm geom .t +0+0 + update + wm iconify .t + set x no + after 0 {set x yes} + wm deiconify .t + set result $x + update + list $result $x +} {no yes} + +test unixWm-47.1 {WaitRestrictProc procedure} { + catch {destroy .t} + toplevel .t -width 300 -height 200 + frame .t.f -bd 2 -relief raised + place .t.f -x 20 -y 30 -width 100 -height 20 + wm geometry .t +0+0 + tkwait visibility .t + set result {} + bind .t.f <Configure> {lappend result {configure on .t.f}} + bind .t <Map> {lappend result {map on .t}} + bind .t <Unmap> {lappend result {unmap on .t}; bind .t <Unmap> {}} + bind .t <Button> {lappend result {button %b on .t}} + event generate .t.f <Configure> -when tail + event generate .t <Configure> -when tail + event generate .t <Button> -button 3 -when tail + event generate .t <Map> -when tail + lappend result iconify + wm iconify .t + lappend result done + update + set result +} {iconify {unmap on .t} done {configure on .t.f} {button 3 on .t} {map on .t}} + +# I don't know how to test WaitTimeoutProc, WaitForMapNotify, or UpdateHints. + +catch {destroy .t} +toplevel .t -width 300 -height 200 +wm geometry .t +0+0 +tkwait visibility .t + +test unixWm-48.1 {ParseGeometry procedure} { + wm geometry .t =100x120 + update + list [winfo width .t] [winfo height .t] +} {100 120} +test unixWm-48.2 {ParseGeometry procedure} { + list [catch {wm geometry .t =10zx120} msg] $msg +} {1 {bad geometry specifier "=10zx120"}} +test unixWm-48.3 {ParseGeometry procedure} { + list [catch {wm geometry .t x120} msg] $msg +} {1 {bad geometry specifier "x120"}} +test unixWm-48.4 {ParseGeometry procedure} { + list [catch {wm geometry .t =100x120a} msg] $msg +} {1 {bad geometry specifier "=100x120a"}} +test unixWm-48.5 {ParseGeometry procedure} { + list [catch {wm geometry .t z} msg] $msg +} {1 {bad geometry specifier "z"}} +test unixWm-48.6 {ParseGeometry procedure} { + list [catch {wm geometry .t +20&} msg] $msg +} {1 {bad geometry specifier "+20&"}} +test unixWm-48.7 {ParseGeometry procedure} { + list [catch {wm geometry .t +-} msg] $msg +} {1 {bad geometry specifier "+-"}} +test unixWm-48.8 {ParseGeometry procedure} { + list [catch {wm geometry .t +20a} msg] $msg +} {1 {bad geometry specifier "+20a"}} +test unixWm-48.9 {ParseGeometry procedure} { + list [catch {wm geometry .t +20-} msg] $msg +} {1 {bad geometry specifier "+20-"}} +test unixWm-48.10 {ParseGeometry procedure} { + list [catch {wm geometry .t +20+10z} msg] $msg +} {1 {bad geometry specifier "+20+10z"}} +test unixWm-48.11 {ParseGeometry procedure} { + catch {wm geometry .t +-10+20} +} {0} +test unixWm-48.12 {ParseGeometry procedure} { + catch {wm geometry .t +30+-10} +} {0} +test unixWm-48.13 {ParseGeometry procedure, resize causes window to move} { + catch {destroy .t} + toplevel .t -width 200 -height 200 + wm geom .t +0+0 + update + wm geom .t -0-0 + update + set x [winfo x .t] + set y [winfo y .t] + wm geometry .t 150x300 + update + list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \ + [winfo width .t] [winfo height .t] +} {50 -100 150 300} + +test unixWm-49.1 {Tk_GetRootCoords procedure} { + catch {destroy .t} + toplevel .t -width 300 -height 200 + frame .t.f -width 150 -height 100 -bd 2 -relief raised + place .t.f -x 150 -y 120 + frame .t.f.f -width 20 -height 20 -bd 2 -relief raised + place .t.f.f -x 10 -y 20 + wm overrideredirect .t 1 + wm geometry .t +40+50 + tkwait visibility .t + list [winfo rootx .t.f.f] [winfo rooty .t.f.f] +} {202 192} +test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unixOnly} { + catch {destroy .t} + toplevel .t -width 300 -height 200 -bd 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 + place .t.m.f -x 50 -y 5 + frame .t.f -width 20 -height 30 -bd 2 -relief raised + place .t.f -x 10 -y 30 + testmenubar window .t .t.m + update + list [expr [winfo rootx .t.m.f] - $x] [expr [winfo rooty .t.m.f] - $y] \ + [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y] +} {52 7 12 62} + +foreach w [winfo children .] { + catch {destroy $w} +} +wm iconify . +test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} { + eval destroy [winfo children .] + toplevel .t -width 300 -height 400 -bg green + wm geom .t +40+0 + tkwait visibility .t + toplevel .t2 -width 100 -height 80 -bg red + wm geom .t2 +140+200 + tkwait visibility .t2 + raise .t2 + set x [winfo rootx .t] + set y [winfo rooty .t] + list [winfo containing [expr $x - 30] [expr $y + 250]] \ + [winfo containing [expr $x - 1] [expr $y + 250]] \ + [winfo containing $x [expr $y + 250]] \ + [winfo containing [expr $x + 99] [expr $y + 250]] \ + [winfo containing [expr $x + 100] [expr $y + 250]] \ + [winfo containing [expr $x + 199] [expr $y + 250]] \ + [winfo containing [expr $x + 200] [expr $y + 250]] \ + [winfo containing [expr $x + 220] [expr $y + 250]] +} {{} {} .t {} .t2 .t2 {} .t} +test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} { + eval destroy [winfo children .] + toplevel .t -width 300 -height 400 -bg yellow + wm geom .t +0+50 + tkwait visibility .t + toplevel .t2 -width 100 -height 80 -bg blue + wm overrideredirect .t2 1 + wm geom .t2 +100+200 + tkwait visibility .t2 + raise .t2 + set x [winfo rootx .t] + set y [winfo rooty .t] + set y2 [winfo rooty .t2] + list [winfo containing [expr $x +150] 10] \ + [winfo containing [expr $x +150] [expr $y - 1]] \ + [winfo containing [expr $x +150] $y] \ + [winfo containing [expr $x +150] [expr $y2 - 1]] \ + [winfo containing [expr $x +150] $y2] \ + [winfo containing [expr $x +150] [expr $y2 + 79]] \ + [winfo containing [expr $x +150] [expr $y2 + 80]] \ + [winfo containing [expr $x +150] [expr $y + 450]] +} {{} {} .t .t .t2 .t2 .t {}} +test unixWm-50.3 {Tk_CoordsToWindow procedure, finding a toplevel with embedding} { + eval destroy [winfo children .] + toplevel .t -width 300 -height 400 -bg blue + wm geom .t +0+50 + frame .t.f -container 1 + place .t.f -x 150 -y 50 + tkwait visibility .t.f + setupbg + dobg " + wm withdraw . + toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow + tkwait visibility .x" + set result [dobg { + set x [winfo rootx .x] + set y [winfo rooty .x] + list [winfo containing [expr $x - 1] [expr $y + 50]] \ + [winfo containing $x [expr $y +50]] + }] + set x [winfo rootx .t] + set y [winfo rooty .t] + lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \ + [winfo containing [expr $x + 200] [expr $y +50]] +} {{} .x .t .t.f} +cleanupbg +test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} { + catch {destroy .t} + catch {interp delete slave} + toplevel .t -width 200 -height 200 -bg green + wm geometry .t +0+0 + tkwait visibility .t + interp create slave + load {} tk slave + slave eval {wm geometry . 200x200+0+0; tkwait visibility .} + set result [list [winfo containing 100 100] \ + [slave eval {winfo containing 100 100}]] + interp delete slave + set result +} {{} .} +test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unixOnly} { + eval destroy [winfo children .] + toplevel .t -width 300 -height 400 -bd 2 -relief raised + frame .t.f -width 150 -height 120 -bg 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 + place .t.menu.f -x 30 -y 10 + testmenubar window .t .t.menu + tkwait visibility .t.menu + update + set x [winfo rootx .t] + set y [winfo rooty .t] + list [winfo containing $x [expr $y - 31]] \ + [winfo containing $x [expr $y - 30]] \ + [winfo containing [expr $x + 50] [expr $y - 19]] \ + [winfo containing [expr $x + 50] [expr $y - 18]] \ + [winfo containing [expr $x + 50] $y] \ + [winfo containing [expr $x + 11] [expr $y + 152]] \ + [winfo containing [expr $x + 12] [expr $y + 152]] +} {{} .t.menu .t.menu .t.menu.f .t .t .t.f} +test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} { + eval destroy [winfo children .] + toplevel .t -width 300 -height 400 -bg 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] + tkwait visibility .t2 + update + set x [winfo rootx .t] + set y [winfo rooty .t] + list [winfo containing [expr $x +149] [expr $y + 80]] \ + [winfo containing [expr $x +150] [expr $y +80]] \ + [winfo containing [expr $x +249] [expr $y +80]] \ + [winfo containing [expr $x +250] [expr $y +80]] +} {.t .t2 .t2 .t} +test unixWm-50.7 {Tk_CoordsToWindow procedure, more basics} { + catch {destroy .t} + toplevel .t -width 300 -height 400 -bg green + wm geom .t +0+0 + frame .t.f -width 100 -height 200 -bd 2 -relief raised + place .t.f -x 100 -y 100 + frame .t.f.f -width 100 -height 200 -bd 2 -relief raised + place .t.f.f -x 0 -y 100 + tkwait visibility .t.f.f + set x [expr [winfo rootx .t] + 150] + set y [winfo rooty .t] + list [winfo containing $x [expr $y + 50]] \ + [winfo containing $x [expr $y + 150]] \ + [winfo containing $x [expr $y + 250]] \ + [winfo containing $x [expr $y + 350]] \ + [winfo containing $x [expr $y + 450]] +} {.t .t.f .t.f.f .t {}} +test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} { + catch {destroy .t} + toplevel .t -width 400 -height 300 -bg green + wm geom .t +0+0 + frame .t.f -width 200 -height 100 -bd 2 -relief raised + place .t.f -x 100 -y 100 + frame .t.f.f -width 200 -height 100 -bd 2 -relief raised + place .t.f.f -x 100 -y 0 + update + set x [winfo rooty .t] + set y [expr [winfo rooty .t] + 150] + list [winfo containing [expr $x + 50] $y] \ + [winfo containing [expr $x + 150] $y] \ + [winfo containing [expr $x + 250] $y] \ + [winfo containing [expr $x + 350] $y] \ + [winfo containing [expr $x + 450] $y] +} {.t .t.f .t.f.f .t {}} +test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} { + catch {destroy .t} + catch {destroy .t2} + sleep 500 ;# Give window manager time to catch up. + toplevel .t -width 200 -height 200 -bg green + wm geometry .t +0+0 + tkwait visibility .t + toplevel .t2 -width 200 -height 200 -bg red + wm geometry .t2 +0+0 + tkwait visibility .t2 + set result [list [winfo containing 100 100]] + wm iconify .t2 + lappend result [winfo containing 100 100] +} {.t2 .t} +test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} { + catch {destroy .t} + toplevel .t -width 200 -height 200 -bg green + wm geometry .t +0+0 + frame .t.f -width 150 -height 150 -bd 2 -relief raised + place .t.f -x 25 -y 25 + tkwait visibility .t.f + set result [list [winfo containing 100 100]] + place forget .t.f + update + lappend result [winfo containing 100 100] +} {.t.f .t} +eval destroy [winfo children .] +wm deiconify . + +# No tests for UpdateVRootGeometry, Tk_GetVRootGeometry, +# Tk_MoveToplevelWindow, UpdateWmProtocols, or TkWmProtocolEventProc. + +test unixWm-51.1 {TkWmRestackToplevel procedure, basic tests} {nonPortable} { + makeToplevels + update + raise .raise1 + winfo containing [winfo rootx .raise1] [winfo rooty .raise1] +} .raise1 +test unixWm-51.2 {TkWmRestackToplevel procedure, basic tests} {nonPortable} { + makeToplevels + update + raise .raise2 + winfo containing [winfo rootx .raise1] [winfo rooty .raise1] +} .raise2 +test unixWm-51.3 {TkWmRestackToplevel procedure, basic tests} {nonPortable} { + makeToplevels + update + raise .raise3 + raise .raise2 + raise .raise1 .raise3 + set result [winfo containing [winfo rootx .raise1] \ + [winfo rooty .raise1]] + destroy .raise2 + sleep 500 + list $result [winfo containing [winfo rootx .raise1] \ + [winfo rooty .raise1]] +} {.raise2 .raise1} +test unixWm-51.4 {TkWmRestackToplevel procedure, basic tests} {nonPortable} { + makeToplevels + raise .raise2 + raise .raise1 + lower .raise3 .raise1 + set result [winfo containing 100 100] + destroy .raise1 + sleep 500 + lappend result [winfo containing 100 100] +} {.raise1 .raise3} +test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {nonPortable} { + makeToplevels + update + raise .raise2 + raise .raise1 + raise .raise3 + frame .raise1.f1 + frame .raise1.f1.f2 + lower .raise3 .raise1.f1.f2 + set result [winfo containing [winfo rootx .raise1] \ + [winfo rooty .raise1]] + destroy .raise1 + sleep 500 + list $result [winfo containing [winfo rootx .raise2] \ + [winfo rooty .raise2]] +} {.raise1 .raise3} +foreach w [winfo children .] { + catch {destroy $w} +} +test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} { + catch {destroy .t} + toplevel .t -width 200 -height 200 -bg green + wm geometry .t +0+0 + tkwait visibility .t + catch {destroy .t2} + toplevel .t2 -width 200 -height 200 -bg red + wm geometry .t2 +0+0 + winfo containing 100 100 +} {.t} +test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} { + foreach w {.t .t2 .t3} { + catch {destroy $w} + toplevel $w -width 200 -height 200 -bg green + wm geometry $w +0+0 + } + raise .t .t2 + update + set result [list [winfo containing 100 100]] + lower .t3 + lappend result [winfo containing 100 100] +} {.t3 .t} +test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} { + catch {destroy .t} + toplevel .t -width 200 -height 200 -bg green + wm overrideredirect .t 1 + wm geometry .t +0+0 + tkwait visibility .t + catch {destroy .t2} + toplevel .t2 -width 200 -height 200 -bg red + wm overrideredirect .t2 1 + wm geometry .t2 +0+0 + tkwait visibility .t2 + + # Need to use vrootx and vrooty to make tests work correctly with + # virtual root window measures managers: overrideredirect windows + # come up at (0,0) in display coordinates, not virtual root + # coordinates. + + set x [expr 100-[winfo vrootx .]] + set y [expr 100-[winfo vrooty .]] + set result [list [winfo containing $x $y]] + raise .t + lappend result [winfo containing $x $y] + raise .t2 + lappend result [winfo containing $x $y] +} {.t2 .t .t2} +test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} { + foreach w {.t .t2 .t3} { + catch {destroy $w} + toplevel $w -width 200 -height 200 -bg green + wm overrideredirect $w 1 + wm geometry $w +0+0 + tkwait visibility $w + } + lower .t3 .t2 + update + + # Need to use vrootx and vrooty to make tests work correctly with + # virtual root window measures managers: overrideredirect windows + # come up at (0,0) in display coordinates, not virtual root + # coordinates. + + set x [expr 100-[winfo vrootx .]] + set y [expr 100-[winfo vrooty .]] + set result [list [winfo containing $x $y]] + lower .t2 + lappend result [winfo containing $x $y] +} {.t2 .t3} +test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} { + makeToplevels + raise .raise1 + set time [lindex [time {raise .raise1}] 0] + expr {$time < 2000000} +} 1 +test unixWm-51.11 {TkWmRestackToplevel procedure, don't move window that's already in the right place} { + makeToplevels + set time [lindex [time {lower .raise1}] 0] + expr {$time < 2000000} +} 1 +test unixWm-51.12 {TkWmRestackToplevel procedure, don't move window that's already in the right place} { + makeToplevels + set time [lindex [time {raise .raise3 .raise2}] 0] + expr {$time < 2000000} +} 1 +test unixWm-51.13 {TkWmRestackToplevel procedure, don't move window that's already in the right place} { + makeToplevels + set time [lindex [time {lower .raise1 .raise2}] 0] + expr {$time < 2000000} +} 1 + +test unixWm-52.1 {TkWmAddToColormapWindows procedure} { + catch {destroy .t} + toplevel .t -width 200 -height 200 -colormap new -relief raised -bd 2 + wm geom .t +0+0 + update + wm colormap .t +} {} +test unixWm-52.2 {TkWmAddToColormapWindows procedure} { + catch {destroy .t} + toplevel .t -colormap new -relief raised -bd 2 + wm geom .t +0+0 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + pack .t.f + update + wm colormap .t +} {.t.f .t} +test unixWm-52.3 {TkWmAddToColormapWindows procedure} { + catch {destroy .t} + toplevel .t -colormap new + wm geom .t +0+0 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + pack .t.f + frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 + pack .t.f2 + update + wm colormap .t +} {.t.f .t.f2 .t} +test unixWm-52.4 {TkWmAddToColormapWindows procedure} { + catch {destroy .t} + toplevel .t -colormap new + wm geom .t +0+0 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + pack .t.f + update + wm colormapwindows .t .t.f + frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 + pack .t.f2 + update + wm colormapwindows .t +} {.t.f} + +test unixWm-53.1 {TkWmRemoveFromColormapWindows procedure} { + catch {destroy .t} + toplevel .t -colormap new + wm geom .t +0+0 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + pack .t.f + frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 + pack .t.f2 + update + destroy .t.f2 + wm colormap .t +} {.t.f .t} +test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} { + catch {destroy .t} + toplevel .t -colormap new + wm geom .t +0+0 + frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2 + pack .t.f + frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2 + pack .t.f2 + update + wm colormapwindows .t .t.f2 + destroy .t.f2 + wm colormap .t +} {} + +test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} { + catch {destroy .t} + catch {destroy .m} + toplevel .t -width 300 -height 200 -bd 2 -relief raised + bind .t <Expose> {set x exposed} + wm geom .t +0+0 + update + menu .m + .m add command -label First + .m add command -label Second + .m add command -label Third + .m post 30 30 + update + set x {no event} + destroy .m + set x +} {no event} +test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} { + catch {destroy .m} + menu .m + .m add command -label First + .m add command -label Second + .m add command -label Third + .m post 30 30 + update + set result [wm overrideredirect .m] + destroy .m + set result +} {1} + +# No tests for TkGetPointerCoords, CreateWrapper, or GetMaxSize. + +test unixWm-55.1 {TkUnixSetMenubar procedure} {unixOnly} { + catch {destroy .t} + toplevel .t -width 300 -height 200 -bd 2 -relief raised + wm geom .t +0+0 + update + frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green + testmenubar window .t .t.f + update + list [winfo ismapped .t.f] [winfo geometry .t.f] \ + [expr [winfo rootx .t] - [winfo rootx .t.f]] \ + [expr [winfo rooty .t] - [winfo rooty .t.f]] +} {1 300x30+0+0 0 30} +test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unixOnly} { + catch {destroy .t} + catch {destroy .f} + toplevel .t -width 300 -height 200 -bd 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 + testmenubar window .t .f + update + testmenubar window .t {} + update + list [winfo ismapped .f] [winfo geometry .f] \ + [expr [winfo rootx .t] - $x] \ + [expr [winfo rooty .t] - $y] \ + [expr [winfo rootx .] - [winfo rootx .f]] \ + [expr [winfo rooty .] - [winfo rooty .f]] +} {0 300x30+0+0 0 0 0 0} +test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unixOnly} { + catch {destroy .t} + toplevel .t -width 300 -height 200 -bd 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 + testmenubar window .t .t.f + update + testmenubar window .t {} + update + set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]" + .t.f configure -height 100 + update + lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] +} {0 0 0 0} +test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unixOnly} { + catch {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 + testmenubar window .t .t.f + wm geom .t +0+0 + update + list [winfo ismapped .t.f] [winfo geometry .t.f] \ + [expr [winfo rootx .t] - [winfo rootx .t.f]] \ + [expr [winfo rooty .t] - [winfo rooty .t.f]] +} {1 300x30+0+0 0 30} +test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unixOnly} { + catch {destroy .t} + catch {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 + wm geom .t +0+0 + update + set y [winfo rooty .t] + frame .f -width 400 -height 50 -bd 2 -relief raised -bg green + testmenubar window .t .t.f + update + set result {} + lappend result [winfo ismapped .f] [winfo ismapped .t.f] + lappend result [expr [winfo rooty .t.f] - $y] + testmenubar window .t .f + update + lappend result [winfo ismapped .f] [winfo ismapped .t.f] + lappend result [expr [winfo rooty .f] - $y] +} {0 1 0 1 0 0} +test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unixOnly} { + catch {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 + testmenubar window .t .t.f + wm geom .t +0+0 + update + testmenubar window .t .t.f + update + list [winfo ismapped .t.f] [winfo geometry .t.f] \ + [expr [winfo rootx .t] - [winfo rootx .t.f]] \ + [expr [winfo rooty .t] - [winfo rooty .t.f]] +} {1 300x30+0+0 0 30} +test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unixOnly} { + catch {destroy .t} + catch {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 + wm geom .t +0+0 + update + set y [winfo rooty .t] + testmenubar window .t .t.f + update + set result [expr [winfo rooty .t] - $y] + testmenubar window .t .f + update + lappend result [expr [winfo rooty .t] - $y] + destroy .t.f + update + lappend result [expr [winfo rooty .t] - $y] +} {30 40 40} + +test unixWm-56.1 {MenubarDestroyProc procedure} {unixOnly} { + catch {destroy .t} + toplevel .t -width 300 -height 200 -bd 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 + testmenubar window .t .t.f + update + set result [expr [winfo rooty .t] - $y] + destroy .t.f + update + lappend result [expr [winfo rooty .t] - $y] +} {30 0} + +test unixWm-57.1 {MenubarReqProc procedure} {unixOnly} { + catch {destroy .t} + toplevel .t -width 300 -height 200 -bd 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 + testmenubar window .t .t.f + update + set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]" + .t.f configure -height 100 + update + lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] +} {0 10 0 100} +test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} { + catch {destroy .t} + toplevel .t -width 300 -height 200 -bd 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 + testmenubar window .t .t.f + update + set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]" + .t.f configure -height 0 + update + lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] +} {0 20 0 1} + +# Test exit processing and cleanup: + +test unixWm-58.1 {exit processing} { + catch {removeFile script} + set fd [open script w] + puts $fd { + update + exit + } + close $fd + if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + list $error $msg +} {0 {}} +test unixWm-58.2 {exit processing} { + catch {removeFile script} + set fd [open script w] + puts $fd { + interp create x + x eval {set argc 2} + x eval {set argv "-geometry 10x10+0+0"} + x eval {load {} Tk} + update + exit + } + close $fd + if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + list $error $msg +} {0 {}} +test unixWm-58.3 {exit processing} { + catch {removeFile script} + set fd [open script w] + puts $fd { + interp create x + x eval {set argc 2} + x eval {set argv "-geometry 10x10+0+0"} + x eval {load {} Tk} + x eval { + button .b -text hello + bind .b <Destroy> foo + } + x alias foo destroy_x + proc destroy_x {} {interp delete x} + update + exit + } + close $fd + if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + list $error $msg +} {0 {}} + + +catch {destroy .t} +concat {} |