# 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. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: unixWm.test,v 1.13 2001/03/28 17:27:10 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {$tcl_platform(platform) != "unix"} { puts "skipping: Unix only tests..." ::tcltest::cleanupTests return } 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 userInteraction} { 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-59.1 {test for memory leaks} { wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" set x 1 } 1 test unixWm-59.2 {test for memory leaks} { wm group .t . wm group .t . wm group .t . wm group .t . wm group .t . wm group .t . wm group .t . wm group .t . wm group .t . wm group .t . set x 1 } 1 if {[string compare testwrapper [info commands testwrapper]] != 0} { puts "This application hasn't been compiled with the testwrapper command," puts "therefore I am skipping all of these tests." ::tcltest::cleanupTests return } 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 {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 update 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 update 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 {bad argument "1": must be normal, iconic or withdrawn}} test unixWm-35.2 {Tk_WmCmd procedure, "state" option} { list [catch {wm state .t iconic 1} msg] $msg } {1 {wrong # arguments: must be "wm state window ?state?"}} test unixWm-35.3 {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-35.4 {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 state .t2 withdrawn lappend result [wm state .t2] wm state .t2 iconic lappend result [wm state .t2] wm state .t2 normal 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} {nonPortable} { 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 { if {"%W" == ".t"} { lappend result "%W: %wx%h" } } bind .t.m {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 {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 {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 {set x "mapped"} bind .t {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} catch {destroy .t} toplevel .t -width 80 -height 60 test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} { wm geometry .t +5-10 wm overrideredirect .t 1 tkwait visibility .t list [winfo x .t] [winfo y .t] } [list 5 [expr [winfo screenheight .t] - 70]] catch {destroy .t} toplevel .t -width 80 -height 60 test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} { wm geometry .t -30+2 wm overrideredirect .t 1 tkwait visibility .t list [winfo x .t] [winfo y .t] } [list [expr [winfo screenwidth .t] - 110] 2] catch {destroy .t} 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} {nonPortable} { 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 {lappend result {configure on .t.f}} bind .t {lappend result {map on .t}} bind .t {lappend result {unmap on .t}; bind .t {}} bind .t