archie/tk3.6/tests/wm.test

# 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-1993 The Regents of the University of California.
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
# CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
# $Header: /user6/ouster/wish/tests/RCS/wm.test,v 1.12 93/07/10 14:54:01 ouster Exp $ (Berkeley)

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} {
    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} {
    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} {
    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} {
    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} {
    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} {
    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}
if $atBerkeley {
    test wm-5.7 {compounded state changes} {
	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
if $atBerkeley {
    test wm-6.4 {size changes} {
	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} {
    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}
concat {}