# 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 © 1992-1994 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # All rights reserved. package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force ::tk::test:loadTkCommand testConstraint failsOnUbuntu [expr {![info exists ::env(CI)] || ![string match Linux $::tcl_platform(os)]}] testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] # Starting with macOS Ventura it became necessary to wait for windows to be restacked # or to be raised after creation. if {[tk windowingsystem] eq "aqua"} { proc restackDelay {} { after 100; } } else { proc restackDelay {} {} } proc sleep ms { global x after $ms {set x 1} vwait x } # Procedure to set up a collection of top-level windows proc makeToplevels {} { deleteWindows foreach i {.raise1 .raise2 .raise3} { toplevel $i wm geom $i 150x100+0+0 update } } # On macOS windows are not allowed to overlap the menubar at the top of the # screen or the dock. So tests which move a window and then check whether it # got moved to the requested location should use a y coordinate larger than the # height of the menubar (normally 23 pixels) and an x coordinate larger than the # width of the dock, if it happens to be on the left. if {[tk windowingsystem] eq "aqua"} { set mb [expr [menubarheight] + 1] set X 100 set Y0 $mb set Y2 [expr $mb + 2] set Y5 [expr $mb + 5] } else { set X 20 set Y0 0 set Y2 2 set Y5 5 } set i 1 foreach geom "+$X+80 +80+$Y0 +$X+$Y0" { destroy .t test unixWm-1.$i {initial window position} unix { 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 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+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { test unixWm-2.$i {moving window while mapped} unix { 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+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { test unixWm-3.$i {moving window while iconified} unix { wm iconify .t update idletasks wm geom .t $geom update idletasks wm deiconify .t update idletasks 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 "+$X+80 +$X+40 +$X+$Y0" { test unixWm-4.$i {moving window while withdrawn} unix { wm withdraw .t update idletasks wm geom .t $geom update idletasks wm deiconify .t update idletasks wm geom .t } 100x150$geom incr i } test unixWm-5.1 {compounded state changes} {unix nonPortable} { 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} {unix nonPortable} { 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} {unix nonPortable} { 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} {unix nonPortable} { 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} {unix nonPortable} { 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} {unix nonPortable} { 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} {unix nonPortable} { 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} destroy .t toplevel .t -width 200 -height 100 wm geom .t +100+$Y0 wm minsize .t 1 1 update test unixWm-6.1 {size changes} unix { .t config -width 180 -height 150 update wm geom .t } 180x150+100+$Y0 test unixWm-6.2 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 update wm geom .t } 250x60+100+$Y0 test unixWm-6.3 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 wm geom .t {} update wm geom .t } 170x140+100+$Y0 test unixWm-6.4 {size changes} {unix 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} {unix nonPortable} { 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} 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} unix { list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] } {1 normal 100 200} wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]] update test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} unix { 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} unix { list [winfo ismapped .m] } 0 destroy .m destroy .t test unixWm-8.1 {icon windows} unix { destroy .t 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} unix { 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} unix { destroy .t toplevel .t -width 100 -height 30 list [catch {wm iconwindow .t b c} msg] $msg } {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} test unixWm-8.4 {icon windows} {unix failsOnUbuntu failsOnXQuarz} { destroy .t destroy .icon toplevel .t -width 100 -height 30 wm geom .t +0+0 update idletasks 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 idletasks lappend result [winfo ismapped .t] [winfo ismapped .icon] } {.icon icon {} withdrawn 1 0 0 0} test unixWm-8.5 {icon windows} unix { 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} unix { 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} unix { destroy .t 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} destroy .icon2 test unixWm-8.8 {icon windows} unix { destroy .t 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 lappend result [winfo ismapped .t] [winfo ismapped .icon] } {1 1 0} test unixWm-8.9 {icon windows} {unix nonPortable} { # This test is non-portable because some window managers will # destroy an icon window when it's associated window is destroyed. destroy .t 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-8.10.1 {test for memory leaks} unix { 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-8.10.2 {test for memory leaks} unix { 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 test unixWm-9.1 {TkWmMapWindow procedure, client property} {unix testwrapper} { 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} {unix testwrapper} { 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} unix { destroy .t toplevel .t -width 100 -height 300 -bg blue wm geom .t +0+0 wm iconify .t winfo ismapped .t } 0 test unixWm-9.4 {TkWmMapWindow procedure, icon windows} unix { destroy .t toplevel .t -width 100 -height 50 -bg blue tkwait visibility .t wm iconwindow . .t update set result [winfo ismapped .t] } 0 test unixWm-9.5 {TkWmMapWindow procedure, normal windows} unix { 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} unix { 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} {unix testmenubar} { destroy .t 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} unix { list [catch {wm} msg] $msg } {1 {wrong # args: should be "wm option window ?arg ...?"}} test unixWm-11.2 {Tk_WmCmd procedure, miscellaneous errors} unix { list [catch {wm aspect} msg] $msg } {1 {wrong # args: should be "wm option window ?arg ...?"}} test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} unix { list [catch {wm iconify bogus} msg] $msg } {1 {bad window path name "bogus"}} test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} unix { destroy .b button .b -text hello list [catch {wm geometry .b} msg] $msg } {1 {window ".b" isn't a top-level window}} destroy .t destroy .icon toplevel .t -width 100 -height 50 wm geom .t +0+0 update test unixWm-12.1 {Tk_WmCmd procedure, "aspect" option} unix { list [catch {wm aspect .t 12} msg] $msg } {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} test unixWm-12.2 {Tk_WmCmd procedure, "aspect" option} unix { list [catch {wm aspect .t 12 13 14 15 16} msg] $msg } {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} test unixWm-12.3 {Tk_WmCmd procedure, "aspect" option} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { list [catch {wm client .t x y} msg] $msg } {1 {wrong # args: should be "wm client window ?name?"}} test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unix testwrapper} { 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} unix { 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} unix { list [catch {wm colormapwindows .t 12 13} msg] $msg } {1 {wrong # args: should be "wm colormapwindows window ?windowList?"}} test unixWm-14.2 {Tk_WmCmd procedure, "colormapwindows" option} unix { 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} unix { list [catch {wm col . "a \{"} msg] $msg } {1 {unmatched open brace in list}} test unixWm-14.4 {Tk_WmCmd procedure, "colormapwindows" option} unix { list [catch {wm colormapwindows . foo} msg] $msg } {1 {bad window path name "foo"}} test unixWm-14.5 {Tk_WmCmd procedure, "colormapwindows" option} unix { 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} unix { 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} unix { 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] } {{} {}} destroy .t2 test unixWm-15.1 {Tk_WmCmd procedure, "command" option} unix { list [catch {wm command .t 12 13} msg] $msg } {1 {wrong # args: should be "wm command window ?value?"}} test unixWm-15.2 {Tk_WmCmd procedure, "command" option} unix { list [catch {wm command .t 12 13} msg] $msg } {1 {wrong # args: should be "wm command window ?value?"}} test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unix testwrapper} { 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} unix { 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} unix { list [catch {wm command .t "a \{b"} msg] $msg } {1 {unmatched open brace in list}} test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} unix { list [catch {wm deiconify .t 12} msg] $msg } {1 {wrong # args: should be "wm deiconify window"}} test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} unix { destroy .icon toplevel .icon -width 50 -height 50 -bg red 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} {unix failsOnUbuntu failsOnXQuarz} { 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} unix { list [catch {wm focusmodel .t 12 13} msg] $msg } {1 {wrong # args: should be "wm focusmodel window ?active|passive?"}} test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} unix { 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} unix { 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} unix { list [catch {wm frame .t 12} msg] $msg } {1 {wrong # args: should be "wm frame window"}} test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} {unix nonPortable} { expr [wm frame .t] == [winfo id .t] } 0 test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} {unix nonPortable} { 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} unix { list [catch {wm geometry .t 12 13} msg] $msg } {1 {wrong # args: should be "wm geometry window ?newGeometry?"}} test unixWm-19.2 {Tk_WmCmd procedure, "geometry" option} {unix nonPortable} { wm geometry .t -1+5 update wm geometry .t } {100x50-1+5} test unixWm-19.3 {Tk_WmCmd procedure, "geometry" option} {unix nonPortable} { wm geometry .t +10-4 update wm geometry .t } {100x50+10-4} test unixWm-19.4 {Tk_WmCmd procedure, "geometry" option} {unix nonPortable} { 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} {unix 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} unix { list [catch {wm geometry .t qrs} msg] $msg } {1 {bad geometry specifier "qrs"}} test unixWm-20.1 {Tk_WmCmd procedure, "grid" option} unix { list [catch {wm grid .t 12 13} msg] $msg } {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} test unixWm-20.2 {Tk_WmCmd procedure, "grid" option} unix { list [catch {wm grid .t 12 13 14 15 16} msg] $msg } {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} test unixWm-20.3 {Tk_WmCmd procedure, "grid" option} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { list [catch {wm grid .t 10 11 12 -1} msg] $msg } {1 {heightInc can't be <= 0}} destroy .t destroy .icon toplevel .t -width 100 -height 50 wm geom .t +0+0 update test unixWm-21.1 {Tk_WmCmd procedure, "group" option} unix { list [catch {wm group .t 12 13} msg] $msg } {1 {wrong # args: should be "wm group window ?pathName?"}} test unixWm-21.2 {Tk_WmCmd procedure, "group" option} unix { list [catch {wm group .t bogus} msg] $msg } {1 {bad window path name "bogus"}} test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unix testwrapper} { 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} {unix testwrapper} { 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} {unix testwrapper} { destroy .t2 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} unix { list [catch {wm iconbitmap .t 12 13} msg] $msg } {1 {wrong # args: should be "wm iconbitmap window ?bitmap?"}} test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unix testwrapper} { 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} if {[tk windowingsystem] eq "aqua"} { set result_22_3 {0 {}} } else { set result_22_3 {1 {bitmap "bad-bitmap" not defined}} } test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option for unix only} \ unix { list [catch {wm iconbitmap .t bad-bitmap} msg] $msg } $result_22_3 test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} unix { list [catch {wm iconify .t 12} msg] $msg } {1 {wrong # args: should be "wm iconify window"}} test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} unix { 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} unix { 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} unix { 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} {unix failsOnUbuntu failsOnXQuarz} { destroy .t2 toplevel .t2 wm geom .t2 +0+0 update idletasks wm iconify .t2 update idletasks set result [winfo ismapped .t2] destroy .t2 set result } 0 test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {unix failsOnUbuntu failsOnXQuarz} { destroy .t2 toplevel .t2 wm geom .t2 -0+0 update idletasks set result [winfo ismapped .t2] wm iconify .t2 update idletasks lappend result [winfo ismapped .t2] destroy .t2 set result } {1 0} test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} unix { list [catch {wm iconmask .t 12 13} msg] $msg } {1 {wrong # args: should be "wm iconmask window ?bitmap?"}} test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unix testwrapper} { 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} unix { list [catch {wm iconmask .t bogus} msg] $msg } {1 {bitmap "bogus" not defined}} test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} unix { list [catch {wm icon .t} msg] $msg } {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} unix { list [catch {wm iconname .t 12 13} msg] $msg } {1 {wrong # args: should be "wm iconname window ?newName?"}} test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unix testwrapper} { 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} unix { list [catch {wm iconposition .t 12} msg] $msg } {1 {wrong # args: should be "wm iconposition window ?x y?"}} test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} unix { list [catch {wm iconposition .t 12 13 14} msg] $msg } {1 {wrong # args: should be "wm iconposition window ?x y?"}} test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unix testwrapper} { 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} unix { list [catch {wm iconposition .t bad 13} msg] $msg } {1 {expected integer but got "bad"}} test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} unix { list [catch {wm iconposition .t 13 lousy} msg] $msg } {1 {expected integer but got "lousy"}} test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} unix { list [catch {wm iconwindow .t 12 13} msg] $msg } {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unix testwrapper} { destroy .icon toplevel .icon -width 50 -height 50 -bg green 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} unix { list [catch {wm iconwindow .t bogus} msg] $msg } {1 {bad window path name "bogus"}} test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} unix { 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} unix { destroy .icon toplevel .icon -width 50 -height 50 -bg green 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} unix { destroy .icon 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} unix { 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} destroy .t destroy .icon toplevel .t -width 100 -height 50 wm geom .t +0+0 update test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option, setting the maxsize should update WM_NORMAL_HINTS} {testwrapper} { destroy .t toplevel .t wm maxsize .t 300 300 update set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] format {%d %d} [lindex $hints 7] [lindex $hints 8] } {300 300} test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option, setting the maxsize to a value smaller than the current size should set the maxsize in WM_NORMAL_HINTS} {testwrapper} { destroy .t toplevel .t wm geom .t 400x400 wm maxsize .t 300 300 update set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] format {%d %d} [lindex $hints 7] [lindex $hints 8] } {300 300} test unixWm-28.3 {Tk_WmCmd procedure, "maxsize" option, setting the maxsize to a value smaller than the current size should set the maxsize in WM_NORMAL_HINTS even if the interactive resizable flag is set to 0} {testwrapper} { destroy .t toplevel .t wm geom .t 400x400 wm resizable .t 0 0 wm maxsize .t 300 300 update set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] format {%d %d} [lindex $hints 7] [lindex $hints 8] } {300 300} test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option, setting the minsize should update WM_NORMAL_HINTS} {testwrapper} { destroy .t toplevel .t wm minsize .t 300 300 update set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] format {%d %d} [lindex $hints 5] [lindex $hints 6] } {300 300} test unixWm-29.2 {Tk_WmCmd procedure, "minsize" option, setting the minsize to a value larger than the current size should set the maxsize in WM_NORMAL_HINTS} {testwrapper} { destroy .t toplevel .t wm geom .t 200x200 wm minsize .t 300 300 update set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] format {%d %d} [lindex $hints 5] [lindex $hints 6] } {300 300} test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option, setting the minsize to a value larger than the current size should set the minsize in WM_NORMAL_HINTS even if the interactive resizable flag is set to 0} {testwrapper} { destroy .t toplevel .t wm geom .t 200x200 wm resizable .t 0 0 wm minsize .t 300 300 update set hints [testprop [testwrapper .t] WM_NORMAL_HINTS] format {%d %d} [lindex $hints 5] [lindex $hints 6] } {300 300} destroy .t .icon toplevel .t -width 100 -height 50 wm geom .t +0+0 update test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} unix { list [catch {wm overrideredirect .t 1 2} msg] $msg } {1 {wrong # args: should be "wm overrideredirect window ?boolean?"}} test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} unix { list [catch {wm overrideredirect .t boo} msg] $msg } {1 {expected boolean value but got "boo"}} test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} unix { 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} unix { list [catch {wm positionfrom .t 1 2} msg] $msg } {1 {wrong # args: should be "wm positionfrom window ?user/program?"}} test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unix testwrapper} { 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} unix { 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} unix { list [catch {wm protocol .t 1 2 3} msg] $msg } {1 {wrong # args: should be "wm protocol window ?name? ?command?"}} test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} unix { 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} {unix testwrapper} { 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} unix { 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} unix { 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} unix { list [catch {wm resizable . a} msg] $msg } {1 {wrong # args: should be "wm resizable window ?width height?"}} test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} unix { list [catch {wm resizable . a b c} msg] $msg } {1 {wrong # args: should be "wm resizable window ?width height?"}} test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} unix { 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} unix { list [catch {wm resizable . x 1} msg] $msg } {1 {expected boolean value but got "x"}} test unixWm-33.5 {Tk_WmCmd procedure, "resizable" option} unix { list [catch {wm resizable . 0 gorp} msg] $msg } {1 {expected boolean value but got "gorp"}} test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} unix { 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} unix { list [catch {wm sizefrom .t 1 2} msg] $msg } {1 {wrong # args: should be "wm sizefrom window ?user|program?"}} test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unix testwrapper} { 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} unix { list [catch {wm sizefrom .t none} msg] $msg } {1 {bad argument "none": must be program or user}} if {[tk windowingsystem] eq "aqua"} { set result_35_1 {1 {bad argument "1": must be iconic, normal, withdrawn, or zoomed}} } else { set result_35_1 {1 {bad argument "1": must be iconic, normal, or withdrawn}} } test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {unix notAqua} { list [catch {wm state .t 1} msg] $msg } $result_35_1 test unixWm-35.2 {Tk_WmCmd procedure, "state" option} unix { list [catch {wm state .t iconic 1} msg] $msg } {1 {wrong # args: should be "wm state window ?state?"}} test unixWm-35.3 {Tk_WmCmd procedure, "state" option} unix { set result {} 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} unix { set result {} 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} unix { list [catch {wm title .t 1 2} msg] $msg } {1 {wrong # args: should be "wm title window ?newTitle?"}} test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unix testwrapper} { 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.3 {Tk_WmCmd procedure, "transient" option} {unix testwrapper} { set result {} 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 {} {}} test unixWm-37.4 {TkWmDeadWindow, destroy on toplevel should clear transient} {unix testwrapper} { destroy .t2 toplevel .t2 destroy .t3 toplevel .t3 wm transient .t2 .t3 update destroy .t3 update list [wm transient .t2] [testprop [testwrapper .t2] WM_TRANSIENT_FOR] } {{} {}} test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create toplevel wrapper} {unix testwrapper} { destroy .t2 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} unix { list [catch {wm withdraw .t 1} msg] $msg } {1 {wrong # args: should be "wm withdraw window"}} test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} unix { 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} unix { 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} unix { list [catch {wm unknown .t} msg] $msg } {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} destroy .t .icon test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {unix nonPortable} { 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} unix { destroy .t toplevel .t wm geometry .t 200x100+100+$Y0 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+100+$Y0" test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} unix { destroy .t toplevel .t -width 400 -height 150 tkwait visibility .t wm geometry .t +0+0 update idletasks set result {} lappend result [winfo width .t] [winfo height .t] .t configure -width 200 -height 300 update idletasks lappend result [winfo width .t] [winfo height .t] } {400 150 200 300} test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable testmenubar} { destroy .t toplevel .t -width 300 -height 200 -bd 2 -relief raised 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} unix { 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} unix { 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} {unix failsOnUbuntu failsOnXQuarz} { 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 update idletasks lappend result $x [winfo ismapped .t] set x {no event} wm deiconify .t update idletasks lappend result $x [winfo ismapped .t] } {unmapped 0 mapped 1} test unixWm-43.1 {TopLevelReqProc procedure, embedded in same process} unix { destroy .t toplevel .t -width 200 -height 200 wm geom .t +0+0 frame .t.f -container 1 -bd 2 -relief raised 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} \ {unix nonPortable} { 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} unix { 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} unix { 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} unix { 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} unix { 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} unix { 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} destroy .t toplevel .t -width 80 -height 60 test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} unix { 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} destroy .t toplevel .t -width 80 -height 60 test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {unix failsOnXQuarz} { tkwait visibility .t wm overrideredirect .t 1 update wm geometry .t +5-10 update list [winfo x .t] [winfo y .t] } [list 5 [expr [winfo screenheight .t] - 70]] destroy .t toplevel .t -width 80 -height 60 test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {unix failsOnXQuarz} { tkwait visibility .t wm overrideredirect .t 1 update wm geometry .t -30+$Y2 update list [winfo x .t] [winfo y .t] } [list [expr [winfo screenwidth .t] - 110] $Y2] destroy .t test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix testwrapper} { 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} testmenubar { 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} {unix testwrapper} { 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} {unix testwrapper failsOnUbuntu failsOnXQuarz} { 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} {testmenubar testwrapper} { 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} {testmenubar testwrapper failsOnUbuntu failsOnXQuarz} { 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} unix { 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} {unix nonPortable} { 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