URL https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [unixWm.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

# This file is a Tcl script to test out Tk's interactions with
# the window manager, including the "wm" command.  It is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: unixWm.test,v 1.1.1.1 2002-01-16 10:26:00 markom Exp $
 
if {$tcl_platform(platform) != "unix"} {
    return
}
 
if {[string compare test [info procs test]] == 1} {
    source defs
}
 
proc sleep ms {
    global x
    after $ms {set x 1}
    vwait x
}
 
# Procedure to set up a collection of top-level windows
 
proc makeToplevels {} {
    foreach i [winfo child .] {
        destroy $i
    }
    foreach i {.raise1 .raise2 .raise3} {
        toplevel $i
        wm geom $i 150x100+0+0
        update
    }
}
 
set i 1
foreach geom {+20+80 +80+20 +0+0} {
    catch {destroy .t}
    test unixWm-1.$i {initial window position} {
        toplevel .t -width 200 -height 150
        wm geom .t $geom
        update
        wm geom .t
    } 200x150$geom
    incr i
}
 
# The tests below are tricky because window managers don't all move
# windows correctly.  Try one motion and compute the window manager's
# error, then factor this error into the actual tests.  In other words,
# this just makes sure that things are consistent between moves.
 
set i 1
catch {destroy .t}
toplevel .t -width 100 -height 150
wm geom .t +200+200
update
wm geom .t +150+150
update
scan [wm geom .t] %dx%d+%d+%d width height x y
set xerr [expr 150-$x]
set yerr [expr 150-$y]
foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
    test unixWm-2.$i {moving window while mapped} {
        wm geom .t $geom
        update
        scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
        format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \
                [eval expr $y$ysign$yerr]
    } $geom
    incr i
}
 
set i 1
foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
    test unixWm-3.$i {moving window while iconified} {
        wm iconify .t
        sleep 200
        wm geom .t $geom
        update
        wm deiconify .t
        scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
        format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \
                [eval expr $y$ysign$yerr]
    } $geom
    incr i
}
 
set i 1
foreach geom {+20+80 +100+40 +0+0} {
    test unixWm-4.$i {moving window while withdrawn} {
        wm withdraw .t
        sleep 200
        wm geom .t $geom
        update
        wm deiconify .t
        wm geom .t
    } 100x150$geom
    incr i
}
 
test unixWm-5.1 {compounded state changes} {nonPortable} {
    catch {destroy .t}
    toplevel .t -width 200 -height 100
    wm geometry .t +100+100
    update
    wm withdraw .t
    wm deiconify .t
    list [winfo ismapped .t] [wm state .t]
} {1 normal}
test unixWm-5.2 {compounded state changes} {nonPortable} {
    catch {destroy .t}
    toplevel .t -width 200 -height 100
    wm geometry .t +100+100
    update
    wm withdraw .t
    wm deiconify .t
    wm withdraw .t
    list [winfo ismapped .t] [wm state .t]
} {0 withdrawn}
test unixWm-5.3 {compounded state changes} {nonPortable} {
    catch {destroy .t}
    toplevel .t -width 200 -height 100
    wm geometry .t +100+100
    update
    wm iconify .t
    wm deiconify .t
    wm iconify .t
    wm deiconify .t
    list [winfo ismapped .t] [wm state .t]
} {1 normal}
test unixWm-5.4 {compounded state changes} {nonPortable} {
    catch {destroy .t}
    toplevel .t -width 200 -height 100
    wm geometry .t +100+100
    update
    wm iconify .t
    wm deiconify .t
    wm iconify .t
    list [winfo ismapped .t] [wm state .t]
} {0 iconic}
test unixWm-5.5 {compounded state changes} {nonPortable} {
    catch {destroy .t}
    toplevel .t -width 200 -height 100
    wm geometry .t +100+100
    update
    wm iconify .t
    wm withdraw .t
    list [winfo ismapped .t] [wm state .t]
} {0 withdrawn}
test unixWm-5.6 {compounded state changes} {nonPortable} {
    catch {destroy .t}
    toplevel .t -width 200 -height 100
    wm geometry .t +100+100
    update
    wm iconify .t
    wm withdraw .t
    wm deiconify .t
    list [winfo ismapped .t] [wm state .t]
} {1 normal}
test unixWm-5.7 {compounded state changes} {nonPortable} {
    catch {destroy .t}
    toplevel .t -width 200 -height 100
    wm geometry .t +100+100
    update
    wm withdraw .t
    wm iconify .t
    list [winfo ismapped .t] [wm state .t]
} {0 iconic}
 
catch {destroy .t}
toplevel .t -width 200 -height 100
wm geom .t +10+10
wm minsize .t 1 1
update
test unixWm-6.1 {size changes} {
    .t config -width 180 -height 150
    update
    wm geom .t
} 180x150+10+10
test unixWm-6.2 {size changes} {
    wm geom .t 250x60
    .t config -width 170 -height 140
    update
    wm geom .t
} 250x60+10+10
test unixWm-6.3 {size changes} {
    wm geom .t 250x60
    .t config -width 170 -height 140
    wm geom .t {}
    update
    wm geom .t
} 170x140+10+10
test unixWm-6.4 {size changes} {nonPortable} {
    wm minsize .t 1 1
    update
    puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
    puts -nonewline stdout "then hit return: "
    flush stdout
    gets stdin
    update
    set width [winfo width .t]
    set height [winfo height .t]
    .t config -width 230 -height 110
    update
    incr width -[winfo width .t]
    incr height -[winfo height .t]
    wm geom .t {}
    update
    set w2 [winfo width .t]
    set h2 [winfo height .t]
    .t config -width 114 -height 261
    update
    list $width $height $w2 $h2 [wm geom .t]
} {0 0 230 110 114x261+10+10}
 
# I don't know why the wait below is needed, but without it the test
# fails under twm.
sleep 200
 
test unixWm-6.5 {window initially iconic} {nonPortable} {
    catch {destroy .t}
    toplevel .t -width 100 -height 30
    wm geometry .t +0+0
    wm title .t 2
    wm iconify .t
    update idletasks
    wm withdraw .t
    wm deiconify .t
    list [winfo ismapped .t] [wm state .t]
} {1 normal}
 
catch {destroy .m}
toplevel .m
wm overrideredirect .m 1
foreach i {{Test label} Another {Yet another} {Last label}} j {1 2 3} {
    label .m.$j -text $i
}
wm geometry .m +[expr 100 - [winfo vrootx .]]+[expr 200 - [winfo vrooty .]]
update
test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} {
    list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
} {1 normal 100 200}
wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]]
update
test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} {
    list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
} {1 normal 150 210}
wm withdraw .m
test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} {
    list [winfo ismapped .m]
} 0
destroy .m
catch {destroy .t}
 
test unixWm-8.1 {icon windows} {
    catch {destroy .t}
    catch {destroy .icon}
    toplevel .t -width 100 -height 30
    wm geometry .t +0+0
    toplevel .icon -width 50 -height 50 -bg red
    wm iconwindow .t .icon
    list [catch {wm withdraw .icon} msg] $msg
} {1 {can't withdraw .icon: it is an icon for .t}}
test unixWm-8.2 {icon windows} {
    catch {destroy .t}
    toplevel .t -width 100 -height 30
    list [catch {wm iconwindow} msg] $msg
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
test unixWm-8.3 {icon windows} {
    catch {destroy .t}
    toplevel .t -width 100 -height 30
    list [catch {wm iconwindow .t b c} msg] $msg
} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
test unixWm-8.4 {icon windows} {
    catch {destroy .t}
    catch {destroy .icon}
    toplevel .t -width 100 -height 30
    wm geom .t +0+0
    set result [wm iconwindow .t]
    toplevel .icon -width 50 -height 50 -bg red
    wm iconwindow .t .icon
    lappend result [wm iconwindow .t] [wm state .icon]
    wm iconwindow .t {}
    lappend result [wm iconwindow .t] [wm state .icon]
    update
    lappend result [winfo ismapped .t] [winfo ismapped .icon]
    wm iconify .t
    update
    lappend result [winfo ismapped .t] [winfo ismapped .icon]
} {.icon icon {} withdrawn 1 0 0 0}
test unixWm-8.5 {icon windows} {
    catch {destroy .t}
    toplevel .t -width 100 -height 30
    list [catch {wm iconwindow .t .gorp} msg] $msg
} {1 {bad window path name ".gorp"}}
test unixWm-8.6 {icon windows} {
    catch {destroy .t}
    toplevel .t -width 100 -height 30
    frame .t.icon -width 50 -height 50 -bg red
    list [catch {wm iconwindow .t .t.icon} msg] $msg
} {1 {can't use .t.icon as icon window: not at top level}}
test unixWm-8.7 {icon windows} {
    catch {destroy .t}
    catch {destroy .icon}
    toplevel .t -width 100 -height 30
    wm geom .t +0+0
    toplevel .icon -width 50 -height 50 -bg red
    toplevel .icon2 -width 50 -height 50 -bg green
    wm iconwindow .t .icon
    set result "[wm iconwindow .t] [wm state .icon] [wm state .icon2]"
    wm iconwindow .t .icon2
    lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2]
} {.icon icon normal .icon2 withdrawn icon}
catch {destroy .icon2}
test unixWm-8.8 {icon windows} {
    catch {destroy .t}
    catch {destroy .icon}
    toplevel .icon -width 50 -height 50 -bg red
    wm geom .icon +0+0
    update
    set result [winfo ismapped .icon]
    toplevel .t -width 100 -height 30
    wm geom .t +0+0
    tkwait visibility .t        ;# Needed to keep tvtwm happy.
    wm iconwindow .t .icon
    sleep 500
    lappend result [winfo ismapped .t] [winfo ismapped .icon]
} {1 1 0}
test unixWm-8.9 {icon windows} {nonPortable} {
    # This test is non-portable because some window managers will
    # destroy an icon window when it's associated window is destroyed.
 
    catch {destroy .t}
    catch {destroy .icon}
    toplevel .t -width 100 -height 30
    toplevel .icon -width 50 -height 50 -bg red
    wm geom .t +0+0
    wm iconwindow .t .icon
    update
    set result "[wm state .icon] [winfo ismapped .t] [winfo ismapped .icon]"
    destroy .t
    wm geom .icon +0+0
    update
    lappend result [winfo ismapped .icon] [wm state .icon]
    wm deiconify .icon
    update
    lappend result [winfo ismapped .icon] [wm state .icon]
} {icon 1 0 0 withdrawn 1 normal}
 
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."
    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
    wm iconify .t2
    update
    set result [winfo ismapped .t2]
    destroy .t2
    set result
} {0}
test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 -0+0
    update
    set result [winfo ismapped .t2]
    wm iconify .t2
    lappend result [winfo ismapped .t2]
    destroy .t2
    set result
} {1 0}
 
test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} {
    list [catch {wm iconmask .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm iconmask window ?bitmap?"}}
test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unixOnly} {
    set result {}
    lappend result [wm iconmask .t]
    wm iconmask .t questhead
    set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
            WM_HINTS] 0]]]
    lappend result [wm iconmask .t] $bit
    wm iconmask .t {}
    set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
            WM_HINTS] 0]]]
    lappend result [wm iconmask .t] $bit
} {{} questhead 0x20 {} 0x0}
test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} {
    list [catch {wm iconmask .t bogus} msg] $msg
} {1 {bitmap "bogus" not defined}}
 
test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} {
    list [catch {wm icon .t} msg] $msg
} {1 {unknown or ambiguous option "icon": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}}
test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} {
    list [catch {wm iconname .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm iconname window ?newName?"}}
test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unixOnly} {
    set result {}
    lappend result [wm iconname .t]
    wm iconname .t test_name
    lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
    wm iconname .t {}
    lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
} {{} test_name test_name {} {}}
 
test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} {
    list [catch {wm iconposition .t 12} msg] $msg
} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} {
    list [catch {wm iconposition .t 12 13 14} msg] $msg
} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unixOnly} {
    set result {}
    lappend result [wm iconposition .t]
    wm iconposition .t 10 15
    set prop [testprop [testwrapper .t] WM_HINTS]
    lappend result [wm iconposition .t] [lindex $prop 5] [lindex $prop 6]
    lappend result  [format 0x%x [expr 0x10 & [lindex $prop 0]]]
    wm iconposition .t {} {}
    set bit [format 0x%x [expr 0x10 & [lindex [testprop [testwrapper .t] \
            WM_HINTS] 0]]]
    lappend result [wm iconposition .t] $bit
} {{} {10 15} 0xa 0xf 0x10 {} 0x0}
test unixWm-26.4 {Tk_WmCmd procedure, "iconposition" option} {
    list [catch {wm iconposition .t bad 13} msg] $msg
} {1 {expected integer but got "bad"}}
test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} {
    list [catch {wm iconposition .t 13 lousy} msg] $msg
} {1 {expected integer but got "lousy"}}
 
test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} {
    list [catch {wm iconwindow .t 12 13} msg] $msg
} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unixOnly} {
    catch {destroy .icon}
    toplevel .icon -width 50 -height 50 -bg green
    set result {}
    lappend result [wm iconwindow .t]
    wm iconwindow .t .icon
    set prop [testprop [testwrapper .t] WM_HINTS]
    lappend result [wm iconwindow .t] [wm state .icon]
    lappend result [format 0x%x [expr 0x8 & [lindex $prop 0]]]
    lappend result [expr [testwrapper .icon] == [lindex $prop 4]]
    wm iconwindow .t {}
    set bit [format 0x%x [expr 0x8 & [lindex [testprop [testwrapper .t] \
            WM_HINTS] 0]]]
    lappend result [wm iconwindow .t]  [wm state .icon] $bit
    destroy .icon
    set result
} {{} .icon icon 0x8 1 {} withdrawn 0x0}
test unixWm-27.3 {Tk_WmCmd procedure, "iconwindow" option} {
    list [catch {wm iconwindow .t bogus} msg] $msg
} {1 {bad window path name "bogus"}}
test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} {
    catch {destroy .b}
    button .b -text Help
    set result [list [catch {wm iconwindow .t .b} msg] $msg]
    destroy .b
    set result
} {1 {can't use .b as icon window: not at top level}}
test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} {
    catch {destroy .icon}
    toplevel .icon -width 50 -height 50 -bg green
    catch {destroy .t2}
    toplevel .t2
    wm geom .t2 -0+0
    wm iconwindow .t2 .icon
    set result [list [catch {wm iconwindow .t .icon} msg] $msg]
    destroy .t2
    destroy .icon
    set result
} {1 {.icon is already an icon for .t2}}
test unixWm-27.6 {Tk_WmCmd procedure, "iconwindow" option, changing icons} {
    catch {destroy .icon}
    catch {destroy .icon2}
    toplevel .icon -width 50 -height 50 -bg green
    toplevel .icon2 -width 50 -height 50 -bg red
    set result {}
    wm iconwindow .t .icon
    lappend result [wm state .icon] [wm state .icon2]
    wm iconwindow .t .icon2
    lappend result [wm state .icon] [wm state .icon2]
    destroy .icon .icon2
    set result
} {icon normal withdrawn icon}
test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} {
    catch {destroy .icon}
    toplevel .icon -width 50 -height 50 -bg green
    wm geometry .icon +0+0
    update
    set result {}
    lappend result [wm state .icon] [winfo viewable .icon]
    wm iconwindow .t .icon
    lappend result [wm state .icon] [winfo viewable .icon]
    destroy .icon
    set result
} {normal 1 icon 0}
 
test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize} msg]  $msg
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize . a} msg]  $msg
} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
test unixWm-28.3 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize . a b c} msg]  $msg
} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
test unixWm-28.4 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
    wm maxsize .t
}  {1137 870}
test unixWm-28.5 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize . x 100} msg]  $msg
} {1 {expected integer but got "x"}}
test unixWm-28.6 {Tk_WmCmd procedure, "maxsize" option} {
    list [catch {wm maxsize . 100 bogus} msg]  $msg
} {1 {expected integer but got "bogus"}}
test unixWm-28.7 {Tk_WmCmd procedure, "maxsize" option} {
    wm maxsize .t 200 150
    wm maxsize .t
} {200 150}
test unixWm-28.8 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
    # Not portable, because some window managers let applications override
    # minsize and maxsize.
 
    wm maxsize .t 200 150
    wm geom .t 300x200
    update
    list [winfo width .t] [winfo height .t]
} {200 150}
 
catch {destroy .t}
catch {destroy .icon}
toplevel .t -width 100 -height 50
wm geom .t +0+0
update
 
test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize} msg]  $msg
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
test unixWm-29.2 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize . a} msg]  $msg
} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize . a b c} msg]  $msg
} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
test unixWm-29.4 {Tk_WmCmd procedure, "minsize" option} {
    wm minsize .t
}  {1 1}
test unixWm-29.5 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize . x 100} msg]  $msg
} {1 {expected integer but got "x"}}
test unixWm-29.6 {Tk_WmCmd procedure, "minsize" option} {
    list [catch {wm minsize . 100 bogus} msg]  $msg
} {1 {expected integer but got "bogus"}}
test unixWm-29.7 {Tk_WmCmd procedure, "minsize" option} {
    wm minsize .t 200 150
    wm minsize .t
} {200 150}
test unixWm-29.8 {Tk_WmCmd procedure, "minsize" option} {nonPortable} {
    # Not portable, because some window managers let applications override
    # minsize and maxsize.
 
    wm minsize .t 150 100
    wm geom .t 50x50
    update
    list [winfo width .t] [winfo height .t]
} {150 100}
 
catch {destroy .t}
catch {destroy .icon}
toplevel .t -width 100 -height 50
wm geom .t +0+0
update
 
test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} {
    list [catch {wm overrideredirect .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm overrideredirect window ?boolean?"}}
test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} {
    list [catch {wm overrideredirect .t boo} msg]  $msg
} {1 {expected boolean value but got "boo"}}
test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} {
    set result {}
    lappend result [wm overrideredirect .t]
    wm overrideredirect .t true
    lappend result [wm overrideredirect .t]
    wm overrideredirect .t off
    lappend result [wm overrideredirect .t]
} {0 1 0}
 
test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} {
    list [catch {wm positionfrom .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm positionfrom window ?user/program?"}}
test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unixOnly} {
    set result {}
    lappend result [wm positionfrom .t]
    wm positionfrom .t program
    update
    set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
            WM_NORMAL_HINTS] 0]]]
    lappend result [wm positionfrom .t] $bit
    wm positionfrom .t user
    update
    set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
            WM_NORMAL_HINTS] 0]]]
    lappend result [wm positionfrom .t] $bit
} {user program 0x4 user 0x1}
test unixWm-31.3 {Tk_WmCmd procedure, "positionfrom" option} {
    list [catch {wm positionfrom .t none} msg]  $msg
} {1 {bad argument "none": must be program or user}}
 
test unixWm-32.1 {Tk_WmCmd procedure, "protocol" option} {
    list [catch {wm protocol .t 1 2 3} msg]  $msg
} {1 {wrong # arguments: must be "wm protocol window ?name? ?command?"}}
test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} {
    wm protocol .t {foo a} {a b c}
    wm protocol .t bar {test script for bar}
    set result [wm protocol .t]
    wm protocol .t {foo a} {}
    wm protocol .t bar {}
    set result
} {bar {foo a}}
test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unixOnly} {
    set result {}
    lappend result [wm protocol .t]
    set x {}
    foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
        lappend x [winfo atomname $i]
    }
    lappend result $x
    wm protocol .t foo {test script}
    wm protocol .t bar {test script}
    set x {}
    foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
        lappend x [winfo atomname $i]
    }
    lappend result [wm protocol .t] $x
    wm protocol .t foo {}
    wm protocol .t bar {}
    set x {}
    foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
        lappend x [winfo atomname $i]
    }
    lappend result [wm protocol .t] $x
} {{} WM_DELETE_WINDOW {bar foo} {WM_DELETE_WINDOW bar foo} {} WM_DELETE_WINDOW}
test unixWm-32.4 {Tk_WmCmd procedure, "protocol" option} {
    set result {}
    wm protocol .t foo {a b c}
    wm protocol .t bar {test script for bar}
    lappend result [wm protocol .t foo] [wm protocol .t bar]
    wm protocol .t foo {}
    wm protocol .t bar {}
    lappend result [wm protocol .t foo] [wm protocol .t bar]
} {{a b c} {test script for bar} {} {}}
test unixWm-32.5 {Tk_WmCmd procedure, "protocol" option} {
    wm protocol .t foo {a b c}
    wm protocol .t foo {test script}
    set result [wm protocol .t foo]
    wm protocol .t foo {}
    set result
} {test script}
 
test unixWm-33.1 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable . a} msg]  $msg
} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable . a b c} msg]  $msg
} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable .foo a b c} msg]  $msg
} {1 {bad window path name ".foo"}}
test unixWm-33.4 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable . x 1} msg]  $msg
} {1 {expected boolean value but got "x"}}
test unixWm-33.5 {Tk_WmCmd procedure, "resizable" option} {
    list [catch {wm resizable . 0 gorp} msg]  $msg
} {1 {expected boolean value but got "gorp"}}
test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} {
    catch {destroy .t2}
    toplevel .t2 -width 200 -height 100
    wm geom .t2 +0+0
    set result ""
    lappend result [wm resizable .t2]
    wm resizable .t2 1 0
    lappend result [wm resizable .t2]
    wm resizable .t2 no off
    lappend result [wm resizable .t2]
    wm resizable .t2 false true
    lappend result [wm resizable .t2]
    destroy .t2
    set result
} {{1 1} {1 0} {0 0} {0 1}}
 
test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} {
    list [catch {wm sizefrom .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm sizefrom window ?user|program?"}}
test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unixOnly} {
    set result {}
    lappend result [wm sizefrom .t]
    wm sizefrom .t program
    update
    set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
            WM_NORMAL_HINTS] 0]]]
    lappend result [wm sizefrom .t] $bit
    wm sizefrom .t user
    update
    set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
            WM_NORMAL_HINTS] 0]]]
    lappend result [wm sizefrom .t] $bit
} {{} program 0x8 user 0x2}
test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} {
    list [catch {wm sizefrom .t none} msg]  $msg
} {1 {bad argument "none": must be program or user}}
 
test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {
    list [catch {wm state .t 1} msg]  $msg
} {1 {wrong # arguments: must be "wm state window"}}
test unixWm-35.2 {Tk_WmCmd procedure, "state" option} {
    set result {}
    catch {destroy .t2}
    toplevel .t2 -width 120 -height 300
    wm geometry .t2 +0+0
    lappend result [wm state .t2]
    update
    lappend result [wm state .t2]
    wm withdraw .t2
    lappend result [wm state .t2]
    wm iconify .t2
    lappend result [wm state .t2]
    wm deiconify .t2
    lappend result [wm state .t2]
    destroy .t2
    set result
} {normal normal withdrawn iconic normal}
 
test unixWm-36.1 {Tk_WmCmd procedure, "title" option} {
    list [catch {wm title .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm title window ?newTitle?"}}
test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} {
    set result {}
    lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
    wm title .t "Test window"
    set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
            WM_NORMAL_HINTS] 0]]]
    lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
} {t t {Test window} {Test window}}
 
test unixWm-37.1 {Tk_WmCmd procedure, "transient" option} {
    list [catch {wm transient .t 1 2} msg]  $msg
} {1 {wrong # arguments: must be "wm transient window ?master?"}}
test unixWm-37.2 {Tk_WmCmd procedure, "transient" option} {
    list [catch {wm transient .t foo} msg]  $msg
} {1 {bad window path name "foo"}}
test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} {
    set result {}
    catch {destroy .t2}
    toplevel .t2 -width 120 -height 300
    wm geometry .t2 +0+0
    update
    lappend result [wm transient .t2] \
            [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
    wm transient .t2 .t
    set transient [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
    lappend result [wm transient .t2] [expr [testwrapper .t] - $transient]
    wm transient .t2 {}
    lappend result [wm transient .t2] \
            [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
    destroy .t2
    set result
} {{} {} .t 0 {} 0x0}
test unixWm-37.4 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unixOnly} {
    catch {destroy .t2}
    catch {destroy .t3}
    toplevel .t2 -width 120 -height 300
    wm geometry .t2 +0+0
    toplevel .t3 -width 120 -height 300
    wm geometry .t2 +0+0
    set result [list [testwrapper .t2]]
    wm transient .t3 .t2
    lappend result [expr {[testwrapper .t2] == ""}]
    destroy .t2 .t3
    set result
} {{} 0}
 
test unixWm-38.1 {Tk_WmCmd procedure, "withdraw" option} {
    list [catch {wm withdraw .t 1} msg]  $msg
} {1 {wrong # arguments: must be "wm withdraw window"}}
test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} {
    catch {destroy .t2}
    toplevel .t2 -width 120 -height 300
    wm geometry .t2 +0+0
    wm iconwindow .t .t2
    set result [list [catch {wm withdraw .t2} msg]  $msg]
    destroy .t2
    set result
} {1 {can't withdraw .t2: it is an icon for .t}}
test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} {
    set result {}
    wm withdraw .t
    lappend result [wm state .t] [winfo ismapped .t]
    wm deiconify .t
    lappend result [wm state .t] [winfo ismapped .t]
} {withdrawn 0 normal 1}
 
test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} {
    list [catch {wm unknown .t} msg] $msg
} {1 {unknown or ambiguous option "unknown": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}}
 
catch {destroy .t}
catch {destroy .icon}
 
test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {nonPortable} {
    catch {destroy .t}
    toplevel .t
    wm geometry .t 30x10+0+0
    listbox .t.l -height 20 -width 20 -setgrid 1
    pack .t.l -fill both -expand 1
    update
    wm geometry .t
} {30x10+0+0}
test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} {
    catch {destroy .t}
    toplevel .t
    wm geometry .t 200x100+0+0
    listbox .t.l -height 20 -width 20
    pack .t.l -fill both -expand 1
    update
    .t.l configure -setgrid 1
    update
    wm geometry .t
} {20x20+0+0}
 
test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} {
    catch {destroy .t}
    toplevel .t -width 400 -height 150
    wm geometry .t +0+0
    tkwait visibility .t
    set result {}
    lappend result [winfo width .t] [winfo height .t]
    .t configure -width 200 -height 300
    sleep 500
    lappend result [winfo width .t] [winfo height .t]
} {400 150 200 300}
test unixWm-41.2 {ConfigureEvent procedure, menubars} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    frame .t.m -bd 2 -relief raised -height 20
    testmenubar window .t .t.m
    update
    set result {}
    bind .t  {
        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}
test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm geometry .t +5-10
    wm overrideredirect .t 1
    tkwait visibility .t
    list [winfo x .t] [winfo y .t]
} "5 [expr [winfo screenheight .t] - 70]"
test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm geometry .t -30+2
    wm overrideredirect .t 1
    tkwait visibility .t
    list [winfo x .t] [winfo y .t]
} "[expr [winfo screenwidth .t] - 110] 2"
test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm resizable .t 0 0
    wm geometry .t +0+0
    tkwait visibility .t
    .t configure  -width 180 -height 20
    update
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
    list [expr [lindex $property 5]] [expr [lindex $property 6]] \
            [expr [lindex $property 7]] [expr [lindex $property 8]]
} {180 20 180 20}
test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm resizable .t 0 0
    wm geometry .t +0+0
    tkwait visibility .t
    .t configure -width 180 -height 50
    frame .t.m -bd 2 -relief raised -width 100 -height 50
    testmenubar window .t .t.m
    update
    .t configure -height 70
    .t.m configure -height 30
    list [update] [destroy .t]
} {{} {}}
 
test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm grid .t 6 10 10 5
    wm minsize .t 2 4
    wm maxsize .t 30 40
    wm geometry .t +0+0
    tkwait visibility .t
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
    list [expr [lindex $property 5]] [expr [lindex $property 6]] \
            [expr [lindex $property 7]] [expr [lindex $property 8]] \
            [expr [lindex $property 9]] [expr [lindex $property 10]]
} {40 30 320 210 10 5}
test unixWm-45.2 {UpdateSizeHints procedure} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    wm minsize .t 30 40
    wm maxsize .t 200 500
    wm geometry .t +0+0
    tkwait visibility .t
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
    list [expr [lindex $property 5]] [expr [lindex $property 6]] \
            [expr [lindex $property 7]] [expr [lindex $property 8]] \
            [expr [lindex $property 9]] [expr [lindex $property 10]]
} {30 40 200 500 1 1}
test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    frame .t.menu -height 23 -width 50
    testmenubar window .t .t.menu
    wm grid .t 6 10 10 5
    wm minsize .t 2 4
    wm maxsize .t 30 40
    wm geometry .t +0+0
    tkwait visibility .t
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
    list [winfo height .t] \
            [expr [lindex $property 5]] [expr [lindex $property 6]] \
            [expr [lindex $property 7]] [expr [lindex $property 8]] \
            [expr [lindex $property 9]] [expr [lindex $property 10]]
} {60 40 53 320 233 10 5}
test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} {
    catch {destroy .t}
    toplevel .t -width 80 -height 60
    frame .t.menu -height 23 -width 50
    testmenubar window .t .t.menu
    wm resizable .t 0 0
    wm geometry .t +0+0
    tkwait visibility .t
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
    list [winfo height .t] \
            [expr [lindex $property 5]] [expr [lindex $property 6]] \
            [expr [lindex $property 7]] [expr [lindex $property 8]] \
            [expr [lindex $property 9]] [expr [lindex $property 10]]
} {60 80 83 80 83 1 1}
 
# I don't know how to test WaitForConfigureNotify.
 
test unixWm-46.1 {WaitForEvent procedure, use of modal timeout} {
    catch {destroy .t}
    toplevel .t -width 200 -height 200
    wm geom .t +0+0
    update
    wm iconify .t
    set x no
    after 0 {set x yes}
    wm deiconify .t
    set result $x
    update
    list $result $x
} {no yes}
 
test unixWm-47.1 {WaitRestrictProc procedure} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200
    frame .t.f -bd 2 -relief raised
    place .t.f -x 20 -y 30 -width 100 -height 20
    wm geometry .t +0+0
    tkwait visibility .t
    set result {}
    bind .t.f  {lappend result {configure on .t.f}}
    bind .t  {lappend result {map on .t}}
    bind .t  {lappend result {unmap on .t}; bind .t  {}}
    bind .t  {lappend result {button %b on .t}}
    event generate .t.f  -when tail
    event generate .t  -when tail
    event generate .t  -button 3 -when tail
    event generate .t  -when tail
    lappend result iconify
    wm iconify .t
    lappend result done
    update
    set result
} {iconify {unmap on .t} done {configure on .t.f} {button 3 on .t} {map on .t}}
 
# I don't know how to test WaitTimeoutProc, WaitForMapNotify, or UpdateHints.
 
catch {destroy .t}
toplevel .t -width 300 -height 200
wm geometry .t +0+0
tkwait visibility .t
 
test unixWm-48.1 {ParseGeometry procedure} {
    wm geometry .t =100x120
    update
    list [winfo width .t] [winfo height .t]
} {100 120}
test unixWm-48.2 {ParseGeometry procedure} {
    list [catch {wm geometry .t =10zx120} msg] $msg
} {1 {bad geometry specifier "=10zx120"}}
test unixWm-48.3 {ParseGeometry procedure} {
    list [catch {wm geometry .t x120} msg] $msg
} {1 {bad geometry specifier "x120"}}
test unixWm-48.4 {ParseGeometry procedure} {
    list [catch {wm geometry .t =100x120a} msg] $msg
} {1 {bad geometry specifier "=100x120a"}}
test unixWm-48.5 {ParseGeometry procedure} {
    list [catch {wm geometry .t z} msg] $msg
} {1 {bad geometry specifier "z"}}
test unixWm-48.6 {ParseGeometry procedure} {
    list [catch {wm geometry .t +20&} msg] $msg
} {1 {bad geometry specifier "+20&"}}
test unixWm-48.7 {ParseGeometry procedure} {
    list [catch {wm geometry .t +-} msg] $msg
} {1 {bad geometry specifier "+-"}}
test unixWm-48.8 {ParseGeometry procedure} {
    list [catch {wm geometry .t +20a} msg] $msg
} {1 {bad geometry specifier "+20a"}}
test unixWm-48.9 {ParseGeometry procedure} {
    list [catch {wm geometry .t +20-} msg] $msg
} {1 {bad geometry specifier "+20-"}}
test unixWm-48.10 {ParseGeometry procedure} {
    list [catch {wm geometry .t +20+10z} msg] $msg
} {1 {bad geometry specifier "+20+10z"}}
test unixWm-48.11 {ParseGeometry procedure} {
    catch {wm geometry .t +-10+20}
} {0}
test unixWm-48.12 {ParseGeometry procedure} {
    catch {wm geometry .t +30+-10}
} {0}
test unixWm-48.13 {ParseGeometry procedure, resize causes window to move} {
    catch {destroy .t}
    toplevel .t -width 200 -height 200
    wm geom .t +0+0
    update
    wm geom .t -0-0
    update
    set x [winfo x .t]
    set y [winfo y .t]
    wm geometry .t 150x300
    update
    list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \
            [winfo width .t] [winfo height .t]
} {50 -100 150 300}
 
test unixWm-49.1 {Tk_GetRootCoords procedure} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200
    frame .t.f -width 150 -height 100 -bd 2 -relief raised
    place .t.f -x 150 -y 120
    frame .t.f.f -width 20 -height 20 -bd 2 -relief raised
    place .t.f.f -x 10 -y 20
    wm overrideredirect .t 1
    wm geometry .t +40+50
    tkwait visibility .t
    list [winfo rootx .t.f.f] [winfo rooty .t.f.f]
} {202 192}
test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    frame .t.m -bd 2 -relief raised -width 100 -height 30
    frame .t.m.f -width 20 -height 10 -bd 2 -relief raised
    place .t.m.f -x 50 -y 5
    frame .t.f -width 20 -height 30 -bd 2 -relief raised
    place .t.f -x 10 -y 30
    testmenubar window .t .t.m
    update
    list [expr [winfo rootx .t.m.f] - $x] [expr [winfo rooty .t.m.f] - $y] \
            [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y]
} {52 7 12 62}
 
foreach w [winfo children .] {
    catch {destroy $w}
}
wm iconify .
test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} {
    eval destroy [winfo children .]
    toplevel .t -width 300 -height 400 -bg green
    wm geom .t +40+0
    tkwait visibility .t
    toplevel .t2 -width 100 -height 80 -bg red
    wm geom .t2 +140+200
    tkwait visibility .t2
    raise .t2
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    list [winfo containing [expr $x - 30] [expr $y + 250]] \
            [winfo containing [expr $x - 1] [expr $y + 250]] \
            [winfo containing $x [expr $y + 250]] \
            [winfo containing [expr $x + 99] [expr $y + 250]] \
            [winfo containing [expr $x + 100] [expr $y + 250]] \
            [winfo containing [expr $x + 199] [expr $y + 250]] \
            [winfo containing [expr $x + 200] [expr $y + 250]] \
            [winfo containing [expr $x + 220] [expr $y + 250]]
} {{} {} .t {} .t2 .t2 {} .t}
test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} {
    eval destroy [winfo children .]
    toplevel .t -width 300 -height 400 -bg yellow
    wm geom .t +0+50
    tkwait visibility .t
    toplevel .t2 -width 100 -height 80 -bg blue
    wm overrideredirect .t2 1
    wm geom .t2 +100+200
    tkwait visibility .t2
    raise .t2
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    set y2 [winfo rooty .t2]
    list [winfo containing [expr $x +150] 10] \
            [winfo containing [expr $x +150] [expr $y - 1]] \
            [winfo containing [expr $x +150] $y] \
            [winfo containing [expr $x +150] [expr $y2 - 1]] \
            [winfo containing [expr $x +150] $y2] \
            [winfo containing [expr $x +150] [expr $y2 + 79]] \
            [winfo containing [expr $x +150] [expr $y2 + 80]] \
            [winfo containing [expr $x +150] [expr $y + 450]]
} {{} {} .t .t .t2 .t2 .t {}}
test unixWm-50.3 {Tk_CoordsToWindow procedure, finding a toplevel with embedding} {
    eval destroy [winfo children .]
    toplevel .t -width 300 -height 400 -bg blue
    wm geom .t +0+50
    frame .t.f -container 1
    place .t.f -x 150 -y 50
    tkwait visibility .t.f
    setupbg
    dobg "
        wm withdraw .
        toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow
        tkwait visibility .x"
    set result [dobg {
        set x [winfo rootx .x]
        set y [winfo rooty .x]
        list [winfo containing [expr $x - 1] [expr $y + 50]] \
                [winfo containing $x [expr $y +50]]
    }]
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \
                [winfo containing [expr $x + 200] [expr $y +50]]
} {{} .x .t .t.f}
cleanupbg
test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} {
    catch {destroy .t}
    catch {interp delete slave}
    toplevel .t -width 200 -height 200 -bg green
    wm geometry .t +0+0
    tkwait visibility .t
    interp create slave
    load {} tk slave
    slave eval {wm geometry . 200x200+0+0; tkwait visibility .}
    set result [list [winfo containing 100 100] \
            [slave eval {winfo containing 100 100}]]
    interp delete slave
    set result
} {{} .}
test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unixOnly} {
    eval destroy [winfo children .]
    toplevel .t -width 300 -height 400 -bd 2 -relief raised
    frame .t.f -width 150 -height 120 -bg green
    place .t.f -x 10 -y 150
    wm geom .t +0+50
    frame .t.menu -width 100 -height 30 -bd 2 -relief raised
    frame .t.menu.f -width 40 -height 20 -bg purple
    place .t.menu.f -x 30 -y 10
    testmenubar window .t .t.menu
    tkwait visibility .t.menu
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    list [winfo containing $x [expr $y - 31]] \
                [winfo containing $x [expr $y - 30]] \
                [winfo containing [expr $x + 50] [expr $y - 19]] \
                [winfo containing [expr $x + 50] [expr $y - 18]] \
                [winfo containing [expr $x + 50] $y] \
                [winfo containing [expr $x + 11] [expr $y + 152]] \
                [winfo containing [expr $x + 12] [expr $y + 152]]
} {{} .t.menu .t.menu .t.menu.f .t .t .t.f}
test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} {
    eval destroy [winfo children .]
    toplevel .t -width 300 -height 400 -bg orange
    wm geom .t +0+50
    frame .t.f -container 1
    place .t.f -x 150 -y 50
    tkwait visibility .t.f
    toplevel .t2 -width 100 -height 80 -bg green -use [winfo id .t.f]
    tkwait visibility .t2
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    list [winfo containing [expr $x +149] [expr $y + 80]] \
            [winfo containing [expr $x +150] [expr $y +80]] \
            [winfo containing [expr $x +249] [expr $y +80]] \
            [winfo containing [expr $x +250] [expr $y +80]]
} {.t .t2 .t2 .t}
test unixWm-50.7 {Tk_CoordsToWindow procedure, more basics} {
    catch {destroy .t}
    toplevel .t -width 300 -height 400 -bg green
    wm geom .t +0+0
    frame .t.f -width 100 -height 200 -bd 2 -relief raised
    place .t.f -x 100 -y 100
    frame .t.f.f -width 100 -height 200 -bd 2 -relief raised
    place .t.f.f -x 0 -y 100
    tkwait visibility .t.f.f
    set x [expr [winfo rootx .t] + 150]
    set y [winfo rooty .t]
    list [winfo containing $x [expr $y + 50]] \
            [winfo containing $x [expr $y + 150]] \
            [winfo containing $x [expr $y + 250]] \
            [winfo containing $x [expr $y + 350]] \
            [winfo containing $x [expr $y + 450]]
} {.t .t.f .t.f.f .t {}}
test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} {
    catch {destroy .t}
    toplevel .t -width 400 -height 300 -bg green
    wm geom .t +0+0
    frame .t.f -width 200 -height 100 -bd 2 -relief raised
    place .t.f -x 100 -y 100
    frame .t.f.f -width 200 -height 100 -bd 2 -relief raised
    place .t.f.f -x 100 -y 0
    update
    set x [winfo rooty .t]
    set y [expr [winfo rooty .t] + 150]
    list [winfo containing [expr $x + 50] $y] \
            [winfo containing [expr $x + 150] $y] \
            [winfo containing [expr $x + 250] $y] \
            [winfo containing [expr $x + 350] $y] \
            [winfo containing [expr $x + 450] $y]
} {.t .t.f .t.f.f .t {}}
test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} {
    catch {destroy .t}
    catch {destroy .t2}
    sleep 500           ;# Give window manager time to catch up.
    toplevel .t -width 200 -height 200 -bg green
    wm geometry .t +0+0
    tkwait visibility .t
    toplevel .t2 -width 200 -height 200 -bg red
    wm geometry .t2 +0+0
    tkwait visibility .t2
    set result [list [winfo containing 100 100]]
    wm iconify .t2
    lappend result [winfo containing 100 100]
} {.t2 .t}
test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} {
    catch {destroy .t}
    toplevel .t -width 200 -height 200 -bg green
    wm geometry .t +0+0
    frame .t.f -width 150 -height 150 -bd 2 -relief raised
    place .t.f -x 25 -y 25
    tkwait visibility .t.f
    set result [list [winfo containing 100 100]]
    place forget .t.f
    update
    lappend result [winfo containing 100 100]
} {.t.f .t}
eval destroy [winfo children .]
wm deiconify .
 
# No tests for UpdateVRootGeometry, Tk_GetVRootGeometry,
# Tk_MoveToplevelWindow, UpdateWmProtocols, or TkWmProtocolEventProc.
 
test unixWm-51.1 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
    makeToplevels
    update
    raise .raise1
    winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
} .raise1
test unixWm-51.2 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
    makeToplevels
    update
    raise .raise2
    winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
} .raise2
test unixWm-51.3 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
    makeToplevels
    update
    raise .raise3
    raise .raise2
    raise .raise1 .raise3
    set result [winfo containing [winfo rootx .raise1] \
            [winfo rooty .raise1]]
    destroy .raise2
    sleep 500
    list $result [winfo containing [winfo rootx .raise1] \
            [winfo rooty .raise1]]
} {.raise2 .raise1}
test unixWm-51.4 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
    makeToplevels
    raise .raise2
    raise .raise1
    lower .raise3 .raise1
    set result [winfo containing 100 100]
    destroy .raise1
    sleep 500
    lappend result [winfo containing 100 100]
} {.raise1 .raise3}
test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
    makeToplevels
    update
    raise .raise2
    raise .raise1
    raise .raise3
    frame .raise1.f1
    frame .raise1.f1.f2
    lower .raise3 .raise1.f1.f2
    set result [winfo containing [winfo rootx .raise1] \
            [winfo rooty .raise1]]
    destroy .raise1
    sleep 500
    list $result [winfo containing [winfo rootx .raise2] \
            [winfo rooty .raise2]]
} {.raise1 .raise3}
foreach w [winfo children .] {
    catch {destroy $w}
}
test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} {
    catch {destroy .t}
    toplevel .t -width 200 -height 200 -bg green
    wm geometry .t +0+0
    tkwait visibility .t
    catch {destroy .t2}
    toplevel .t2 -width 200 -height 200 -bg red
    wm geometry .t2 +0+0
    winfo containing 100 100
} {.t}
test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} {
    foreach w {.t .t2 .t3} {
        catch {destroy $w}
        toplevel $w -width 200 -height 200 -bg green
        wm geometry $w +0+0
    }
    raise .t .t2
    update
    set result [list [winfo containing 100 100]]
    lower .t3
    lappend result [winfo containing 100 100]
} {.t3 .t}
test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} {
    catch {destroy .t}
    toplevel .t -width 200 -height 200 -bg green
    wm overrideredirect .t 1
    wm geometry .t +0+0
    tkwait visibility .t
    catch {destroy .t2}
    toplevel .t2 -width 200 -height 200 -bg red
    wm overrideredirect .t2 1
    wm geometry .t2 +0+0
    tkwait visibility .t2
 
    # Need to use vrootx and vrooty to make tests work correctly with
    # virtual root window measures managers: overrideredirect windows
    # come up at (0,0) in display coordinates, not virtual root
    # coordinates.
 
    set x [expr 100-[winfo vrootx .]]
    set y [expr 100-[winfo vrooty .]]
    set result [list [winfo containing $x $y]]
    raise .t
    lappend result [winfo containing $x $y]
    raise .t2
    lappend result [winfo containing $x $y]
} {.t2 .t .t2}
test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} {
    foreach w {.t .t2 .t3} {
        catch {destroy $w}
        toplevel $w -width 200 -height 200 -bg green
        wm overrideredirect $w 1
        wm geometry $w +0+0
        tkwait visibility $w
    }
    lower .t3 .t2
    update
 
    # Need to use vrootx and vrooty to make tests work correctly with
    # virtual root window measures managers: overrideredirect windows
    # come up at (0,0) in display coordinates, not virtual root
    # coordinates.
 
    set x [expr 100-[winfo vrootx .]]
    set y [expr 100-[winfo vrooty .]]
    set result [list [winfo containing $x $y]]
    lower .t2
    lappend result [winfo containing $x $y]
} {.t2 .t3}
test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
    makeToplevels
    raise .raise1
    set time [lindex [time {raise .raise1}] 0]
    expr {$time < 2000000}
} 1
test unixWm-51.11 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
    makeToplevels
    set time [lindex [time {lower .raise1}] 0]
    expr {$time < 2000000}
} 1
test unixWm-51.12 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
    makeToplevels
    set time [lindex [time {raise .raise3 .raise2}] 0]
    expr {$time < 2000000}
} 1
test unixWm-51.13 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
    makeToplevels
    set time [lindex [time {lower .raise1 .raise2}] 0]
    expr {$time < 2000000}
} 1
 
test unixWm-52.1 {TkWmAddToColormapWindows procedure} {
    catch {destroy .t}
    toplevel .t -width 200 -height 200 -colormap new -relief raised -bd 2
    wm geom .t +0+0
    update
    wm colormap .t
} {}
test unixWm-52.2 {TkWmAddToColormapWindows procedure} {
    catch {destroy .t}
    toplevel .t -colormap new -relief raised -bd 2
    wm geom .t +0+0
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
    pack .t.f
    update
    wm colormap .t
} {.t.f .t}
test unixWm-52.3 {TkWmAddToColormapWindows procedure} {
    catch {destroy .t}
    toplevel .t -colormap new
    wm geom .t +0+0
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
    pack .t.f
    frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
    pack .t.f2
    update
    wm colormap .t
} {.t.f .t.f2 .t}
test unixWm-52.4 {TkWmAddToColormapWindows procedure} {
    catch {destroy .t}
    toplevel .t -colormap new
    wm geom .t +0+0
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
    pack .t.f
    update
    wm colormapwindows .t .t.f
    frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
    pack .t.f2
    update
    wm colormapwindows .t
} {.t.f}
 
test unixWm-53.1 {TkWmRemoveFromColormapWindows procedure} {
    catch {destroy .t}
    toplevel .t -colormap new
    wm geom .t +0+0
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
    pack .t.f
    frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
    pack .t.f2
    update
    destroy .t.f2
    wm colormap .t
} {.t.f .t}
test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} {
    catch {destroy .t}
    toplevel .t -colormap new
    wm geom .t +0+0
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
    pack .t.f
    frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
    pack .t.f2
    update
    wm colormapwindows .t .t.f2
    destroy .t.f2
    wm colormap .t
} {}
 
test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} {
    catch {destroy .t}
    catch {destroy .m}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    bind .t  {set x exposed}
    wm geom .t +0+0
    update
    menu .m
    .m add command -label First
    .m add command -label Second
    .m add command -label Third
    .m post 30 30
    update
    set x {no event}
    destroy .m
    set x
} {no event}
test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} {
    catch {destroy .m}
    menu .m
    .m add command -label First
    .m add command -label Second
    .m add command -label Third
    .m post 30 30
    update
    set result [wm overrideredirect .m]
    destroy .m
    set result
} {1}
 
# No tests for TkGetPointerCoords, CreateWrapper, or GetMaxSize.
 
test unixWm-55.1 {TkUnixSetMenubar procedure} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
    testmenubar window .t .t.f
    update
    list [winfo ismapped .t.f] [winfo geometry .t.f] \
            [expr [winfo rootx .t] - [winfo rootx .t.f]] \
            [expr [winfo rooty .t] - [winfo rooty .t.f]]
} {1 300x30+0+0 0 30}
test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unixOnly} {
    catch {destroy .t}
    catch {destroy .f}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    frame .f -width 400 -height 30 -bd 2 -relief raised -bg green
    testmenubar window .t .f
    update
    testmenubar window .t {}
    update
    list [winfo ismapped .f] [winfo geometry .f] \
            [expr [winfo rootx .t] - $x] \
            [expr [winfo rooty .t] - $y] \
            [expr [winfo rootx .] - [winfo rootx .f]] \
            [expr [winfo rooty .] - [winfo rooty .f]]
} {0 300x30+0+0 0 0 0 0}
test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
    testmenubar window .t .t.f
    update
    testmenubar window .t {}
    update
    set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
    .t.f configure -height 100
    update
    lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
} {0 0 0 0}
test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
    testmenubar window .t .t.f
    wm geom .t +0+0
    update
    list [winfo ismapped .t.f] [winfo geometry .t.f] \
            [expr [winfo rootx .t] - [winfo rootx .t.f]] \
            [expr [winfo rooty .t] - [winfo rooty .t.f]]
} {1 300x30+0+0 0 30}
test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unixOnly} {
    catch {destroy .t}
    catch {destroy .f}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
    wm geom .t +0+0
    update
    set y [winfo rooty .t]
    frame .f -width 400 -height 50 -bd 2 -relief raised -bg green
    testmenubar window .t .t.f
    update
    set result {}
    lappend result [winfo ismapped .f] [winfo ismapped .t.f]
    lappend result [expr [winfo rooty .t.f] - $y]
    testmenubar window .t .f
    update
    lappend result [winfo ismapped .f] [winfo ismapped .t.f]
    lappend result [expr [winfo rooty .f] - $y]
} {0 1 0 1 0 0}
test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
    testmenubar window .t .t.f
    wm geom .t +0+0
    update
    testmenubar window .t .t.f
    update
    list [winfo ismapped .t.f] [winfo geometry .t.f] \
            [expr [winfo rootx .t] - [winfo rootx .t.f]] \
            [expr [winfo rooty .t] - [winfo rooty .t.f]]
} {1 300x30+0+0 0 30}
test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unixOnly} {
    catch {destroy .t}
    catch {destroy .f}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
    frame .f -width 400 -height 40 -bd 2 -relief raised -bg blue
    wm geom .t +0+0
    update
    set y [winfo rooty .t]
    testmenubar window .t .t.f
    update
    set result [expr [winfo rooty .t] - $y]
    testmenubar window .t .f
    update
    lappend result [expr [winfo rooty .t] - $y]
    destroy .t.f
    update
    lappend result [expr [winfo rooty .t] - $y]
} {30 40 40}
 
test unixWm-56.1 {MenubarDestroyProc procedure} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set y [winfo rooty .t]
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
    testmenubar window .t .t.f
    update
    set result [expr [winfo rooty .t] - $y]
    destroy .t.f
    update
    lappend result [expr [winfo rooty .t] - $y]
} {30 0}
 
test unixWm-57.1 {MenubarReqProc procedure} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    frame .t.f -width 400 -height 10 -bd 2 -relief raised -bg green
    testmenubar window .t .t.f
    update
    set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
    .t.f configure -height 100
    update
    lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
} {0 10 0 100}
test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} {
    catch {destroy .t}
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
    wm geom .t +0+0
    update
    set x [winfo rootx .t]
    set y [winfo rooty .t]
    frame .t.f -width 400 -height 20 -bd 2 -relief raised -bg green
    testmenubar window .t .t.f
    update
    set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
    .t.f configure -height 0
    update
    lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
} {0 20 0 1}
 
# Test exit processing and cleanup:
 
test unixWm-58.1 {exit processing} {
    catch {removeFile script}
    set fd [open script w]
    puts $fd {
        update
        exit
    }
    close $fd
    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
        set error 1
    } else {
        set error 0
    }
    list $error $msg
} {0 {}}
test unixWm-58.2 {exit processing} {
    catch {removeFile script}
    set fd [open script w]
    puts $fd {
        interp create x
        x eval {set argc 2}
        x eval {set argv "-geometry 10x10+0+0"}
        x eval {load {} Tk}
        update
        exit
    }
    close $fd
    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
        set error 1
    } else {
        set error 0
    }
    list $error $msg
} {0 {}}
test unixWm-58.3 {exit processing} {
    catch {removeFile script}
    set fd [open script w]
    puts $fd {
        interp create x
        x eval {set argc 2}
        x eval {set argv "-geometry 10x10+0+0"}
        x eval {load {} Tk}
        x eval {
            button .b -text hello
            bind .b  foo
        }
        x alias foo destroy_x
        proc destroy_x {} {interp delete x}
        update
        exit
    }
    close $fd
    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
        set error 1
    } else {
        set error 0
    }
    list $error $msg
} {0 {}}
 
 
catch {destroy .t}
concat {}
Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [unixWm.test] - Blame information for rev 1765
