summaryrefslogtreecommitdiffstats
path: root/tests/unixWm.test
diff options
context:
space:
mode:
authorrjohnson <rjohnson>1998-04-01 09:51:44 (GMT)
committerrjohnson <rjohnson>1998-04-01 09:51:44 (GMT)
commit066ea7fd88d49cb456f74da71dbe875e4fc0aabb (patch)
tree8fb30cb152c4dc191be47fa043d2e6f5ea38c7ba /tests/unixWm.test
parent13242623d2ff3ea02ab6a62bfb48a7dbb5c27e22 (diff)
downloadtk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.zip
tk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.tar.gz
tk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.tar.bz2
Initial revision
Diffstat (limited to 'tests/unixWm.test')
-rw-r--r--tests/unixWm.test2352
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 {}