675 lines
20 KiB
Plaintext
675 lines
20 KiB
Plaintext
# 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 {}
|