diff options
Diffstat (limited to 'tk/tests/wm.test')
| -rw-r--r-- | tk/tests/wm.test | 674 |
1 files changed, 674 insertions, 0 deletions
diff --git a/tk/tests/wm.test b/tk/tests/wm.test new file mode 100644 index 00000000000..e6963548346 --- /dev/null +++ b/tk/tests/wm.test @@ -0,0 +1,674 @@ +# 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-1995 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) wm.test 1.31 96/03/01 11:36:58 + +if {[string compare test [info procs test]] == 1} { + source defs +} + +proc sleep ms { + global x + after $ms {set x 1} + tkwait variable x +} + +set i 1 +foreach geom {+20+80 +80+20 +0+0} { + catch {destroy .t} + test wm-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 wm-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 [expr $x$xsign$xerr] $ysign \ + [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 wm-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 [expr $x$xsign$xerr] $ysign \ + [expr $y$ysign$yerr] + } $geom + incr i +} + +set i 1 +foreach geom {+20+80 +100+40 +0+0} { + test wm-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 wm-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 wm-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 wm-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 wm-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 wm-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 wm-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 wm-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 wm-6.1 {size changes} { + .t config -width 180 -height 150 + update + wm geom .t +} 180x150+10+10 +test wm-6.2 {size changes} { + wm geom .t 250x60 + .t config -width 170 -height 140 + update + wm geom .t +} 250x60+10+10 +test wm-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 wm-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} + +test wm-7.1 {window initially withdrawn} { + catch {destroy .t} + toplevel .t -width 100 -height 30 + wm geometry .t +0+0 + wm withdraw .t + sleep 200 + set result [winfo ismapped .t] + wm deiconify .t + list $result [winfo ismapped .t] +} {0 1} +test wm-7.2 {window initially withdrawn} { + catch {destroy .t} + toplevel .t -width 100 -height 30 + wm geometry .t +0+0 + wm withdraw .t + wm deiconify .t + sleep 200 + winfo ismapped .t +} 1 + +test wm-8.1 {window initially iconic} { + catch {destroy .t} + toplevel .t -width 100 -height 30 + wm geometry .t +0+0 + wm title .t 1 + wm iconify .t + update idletasks + list [winfo ismapped .t] [wm state .t] +} {0 iconic} + +# I don't know why the wait below is needed, but without it the test +# fails under twm. +sleep 200 + +test wm-8.2 {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} +menu .m +foreach i {{Test label} Another {Yet another} {Last label}} { + .m add command -label $i +} +.m post 100 200 +test wm-9.1 {override_redirect and Tk_MoveTopLevelWindow} { + list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] +} {1 normal 100 200} +.m post 150 210 +test wm-9.2 {override_redirect and Tk_MoveTopLevelWindow} { + list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] +} {1 normal 150 210} +.m unpost +test wm-9.3 {override_redirect and Tk_MoveTopLevelWindow} { + list [winfo ismapped .m] +} 0 +destroy .m +catch {destroy .t} + +test wm-10.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 iconify .icon} msg] $msg +} {1 {can't iconify .icon: it is an icon for .icon}} +test wm-10.2 {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 deiconify .icon} msg] $msg +} {1 {can't deiconify .icon: it is an icon for .icon}} +test wm-10.3 {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 wm-10.4 {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 wm-10.5 {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 wm-10.6 {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 wm-10.7 {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 wm-10.8 {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 wm-10.9 {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 wm-10.10 {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 + wm iconwindow .t .icon + after 500 {set x 1} + tkwait variable x + lappend result [winfo ismapped .t] [winfo ismapped .icon] +} {1 1 0} +test wm-10.11 {icon windows} {nonPortable} { + # This test is non-portable because some window managers will + # destroy an icon window when it's associated window is destroyed. + + catch {destroy .t} + catch {destroy .icon} + toplevel .t -width 100 -height 30 + toplevel .icon -width 50 -height 50 -bg red + wm geom .t +0+0 + wm iconwindow .t .icon + update + set result "[wm state .icon] [winfo ismapped .t] [winfo ismapped .icon]" + destroy .t + wm geom .icon +0+0 + update + lappend result [winfo ismapped .icon] [wm state .icon] + wm deiconify .icon + update + lappend result [winfo ismapped .icon] [wm state .icon] +} {icon 1 0 0 withdrawn 1 normal} + +test wm-11.1 {colormapwindows} { + catch {destroy .t} + toplevel .t -width 200 -height 200 -colormap new + wm geom .t +0+0 + frame .t.a -width 100 -height 30 + frame .t.b -width 100 -height 30 -colormap new + pack .t.a .t.b -side top + update + set x [wm colormapwindows .t] + frame .t.c -width 100 -height 30 -colormap new + pack .t.c -side top + update + list $x [wm colormapwindows .t] +} {{.t.b .t} {.t.b .t.c .t}} +test wm-11.2 {colormapwindows} { + list [catch {wm colormapwindows . 1 2} msg] $msg +} {1 {wrong # arguments: must be "wm colormapwindows window ?windowList?"}} +test wm-11.3 {colormapwindows} { + list [catch {wm col . "a \{"} msg] $msg +} {1 {unmatched open brace in list}} +test wm-11.4 {colormapwindows} { + list [catch {wm colormapwindows . foo} msg] $msg +} {1 {bad window path name "foo"}} +test wm-11.5 {colormapwindows} { + catch {destroy .t} + toplevel .t -width 200 -height 200 -colormap new + wm geom .t +0+0 + frame .t.a -width 100 -height 30 + frame .t.b -width 100 -height 30 + frame .t.c -width 100 -height 30 + pack .t.a .t.b .t.c -side top + wm colormapwindows .t {.t.c .t .t.a} + wm colormapwindows .t +} {.t.c .t .t.a} +test wm-11.6 {colormapwindows} { + catch {destroy .t} + toplevel .t -width 200 -height 200 + wm geom .t +0+0 + frame .t.a -width 100 -height 30 + frame .t.b -width 100 -height 30 + frame .t.c -width 100 -height 30 + pack .t.a .t.b .t.c -side top + wm colormapwindows .t {.t.b .t.a} + wm colormapwindows .t +} {.t.b .t.a} +test wm-11.7 {colormapwindows} { + catch {destroy .t} + toplevel .t -width 200 -height 200 -colormap new + wm geom .t +0+0 + set x [wm colormapwindows .t] + wm colormapwindows .t {} + list $x [wm colormapwindows .t] +} {{} {}} + +catch {destroy .t} +catch {destroy .icon} + +toplevel .t -width 100 -height 50 +wm geom .t +0+0 +update +test wm-12.1 {Tk_WmCmd procedure, "maxsize" option} { + list [catch {wm maxsize} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} +test wm-12.2 {Tk_WmCmd procedure, "maxsize" option} { + list [catch {wm maxsize . a} msg] $msg +} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}} +test wm-12.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 wm-12.4 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} { + wm maxsize .t +} {1137 870} +test wm-12.5 {Tk_WmCmd procedure, "maxsize" option} { + list [catch {wm maxsize . x 100} msg] $msg +} {1 {expected integer but got "x"}} +test wm-12.6 {Tk_WmCmd procedure, "maxsize" option} { + list [catch {wm maxsize . 100 bogus} msg] $msg +} {1 {expected integer but got "bogus"}} +test wm-12.7 {Tk_WmCmd procedure, "maxsize" option} { + wm maxsize .t 200 150 + wm maxsize .t +} {200 150} +test wm-12.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} +destroy .t + +toplevel .t -width 300 -height 200 +wm geom .t +0+0 +update +test wm-13.1 {Tk_WmCmd procedure, "minsize" option} { + list [catch {wm minsize} msg] $msg +} {1 {wrong # args: should be "wm option window ?arg ...?"}} +test wm-13.2 {Tk_WmCmd procedure, "minsize" option} { + list [catch {wm minsize . a} msg] $msg +} {1 {wrong # arguments: must be "wm minsize window ?width height?"}} +test wm-13.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 wm-13.4 {Tk_WmCmd procedure, "minsize" option} { + wm minsize .t +} {1 1} +test wm-13.5 {Tk_WmCmd procedure, "minsize" option} { + list [catch {wm minsize . x 100} msg] $msg +} {1 {expected integer but got "x"}} +test wm-13.6 {Tk_WmCmd procedure, "minsize" option} { + list [catch {wm minsize . 100 bogus} msg] $msg +} {1 {expected integer but got "bogus"}} +test wm-13.7 {Tk_WmCmd procedure, "minsize" option} { + wm minsize .t 200 150 + wm minsize .t +} {200 150} +test wm-13.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} +test wm-13.9 {Tk_WmCmd procedure, "resizable" option} { + list [catch {wm resizable . a} msg] $msg +} {1 {wrong # arguments: must be "wm resizable window ?width height?"}} +test wm-13.10 {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 wm-13.11 {Tk_WmCmd procedure, "resizable" option} { + list [catch {wm resizable .foo a b c} msg] $msg +} {1 {bad window path name ".foo"}} +test wm-13.12 {Tk_WmCmd procedure, "resizable" option} { + list [catch {wm resizable . x 1} msg] $msg +} {1 {expected boolean value but got "x"}} +test wm-13.13 {Tk_WmCmd procedure, "resizable" option} { + list [catch {wm resizable . 0 gorp} msg] $msg +} {1 {expected boolean value but got "gorp"}} +test wm-13.14 {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] +} {{1 1} {1 0} {0 0} {0 1}} +destroy .t2 + +test wm-14.1 {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 wm-15.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 wm-15.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 wm-16.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 wm-17.1 {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 wm-18.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 wm-18.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 wm-18.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 wm-18.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 wm-19.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 wm-19.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 +} {} + +catch {destroy .t} +concat {} |