OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [tk/] [tests/] [unixWm.test] - Blame information for rev 1780

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# This file is a Tcl script to test out Tk's interactions with
2 
# the window manager, including the "wm" command.  It is organized
3 
# in the standard fashion for Tcl tests.
4 
#
5 
# Copyright (c) 1992-1994 The Regents of the University of California.
6 
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
7 
#
8 
# See the file "license.terms" for information on usage and redistribution
9 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 
#
11 
# RCS: @(#) $Id: unixWm.test,v 1.1.1.1 2002-01-16 10:26:00 markom Exp $
12 
 
13 
if {$tcl_platform(platform) != "unix"} {
14 
    return
15 
}
16 
 
17 
if {[string compare test [info procs test]] == 1} {
18 
    source defs
19 
}
20 
 
21 
proc sleep ms {
22 
    global x
23 
    after $ms {set x 1}
24 
    vwait x
25 
}
26 
 
27 
# Procedure to set up a collection of top-level windows
28 
 
29 
proc makeToplevels {} {
30 
    foreach i [winfo child .] {
31 
        destroy $i
32 
    }
33 
    foreach i {.raise1 .raise2 .raise3} {
34 
        toplevel $i
35 
        wm geom $i 150x100+0+0
36 
        update
37 
    }
38 
}
39 
 
40 
set i 1
41 
foreach geom {+20+80 +80+20 +0+0} {
42 
    catch {destroy .t}
43 
    test unixWm-1.$i {initial window position} {
44 
        toplevel .t -width 200 -height 150
45 
        wm geom .t $geom
46 
        update
47 
        wm geom .t
48 
    } 200x150$geom
49 
    incr i
50 
}
51 
 
52 
# The tests below are tricky because window managers don't all move
53 
# windows correctly.  Try one motion and compute the window manager's
54 
# error, then factor this error into the actual tests.  In other words,
55 
# this just makes sure that things are consistent between moves.
56 
 
57 
set i 1
58 
catch {destroy .t}
59 
toplevel .t -width 100 -height 150
60 
wm geom .t +200+200
61 
update
62 
wm geom .t +150+150
63 
update
64 
scan [wm geom .t] %dx%d+%d+%d width height x y
65 
set xerr [expr 150-$x]
66 
set yerr [expr 150-$y]
67 
foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
68 
    test unixWm-2.$i {moving window while mapped} {
69 
        wm geom .t $geom
70 
        update
71 
        scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
72 
        format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \
73 
                [eval expr $y$ysign$yerr]
74 
    } $geom
75 
    incr i
76 
}
77 
 
78 
set i 1
79 
foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
80 
    test unixWm-3.$i {moving window while iconified} {
81 
        wm iconify .t
82 
        sleep 200
83 
        wm geom .t $geom
84 
        update
85 
        wm deiconify .t
86 
        scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
87 
        format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \
88 
                [eval expr $y$ysign$yerr]
89 
    } $geom
90 
    incr i
91 
}
92 
 
93 
set i 1
94 
foreach geom {+20+80 +100+40 +0+0} {
95 
    test unixWm-4.$i {moving window while withdrawn} {
96 
        wm withdraw .t
97 
        sleep 200
98 
        wm geom .t $geom
99 
        update
100 
        wm deiconify .t
101 
        wm geom .t
102 
    } 100x150$geom
103 
    incr i
104 
}
105 
 
106 
test unixWm-5.1 {compounded state changes} {nonPortable} {
107 
    catch {destroy .t}
108 
    toplevel .t -width 200 -height 100
109 
    wm geometry .t +100+100
110 
    update
111 
    wm withdraw .t
112 
    wm deiconify .t
113 
    list [winfo ismapped .t] [wm state .t]
114 
} {1 normal}
115 
test unixWm-5.2 {compounded state changes} {nonPortable} {
116 
    catch {destroy .t}
117 
    toplevel .t -width 200 -height 100
118 
    wm geometry .t +100+100
119 
    update
120 
    wm withdraw .t
121 
    wm deiconify .t
122 
    wm withdraw .t
123 
    list [winfo ismapped .t] [wm state .t]
124 
} {0 withdrawn}
125 
test unixWm-5.3 {compounded state changes} {nonPortable} {
126 
    catch {destroy .t}
127 
    toplevel .t -width 200 -height 100
128 
    wm geometry .t +100+100
129 
    update
130 
    wm iconify .t
131 
    wm deiconify .t
132 
    wm iconify .t
133 
    wm deiconify .t
134 
    list [winfo ismapped .t] [wm state .t]
135 
} {1 normal}
136 
test unixWm-5.4 {compounded state changes} {nonPortable} {
137 
    catch {destroy .t}
138 
    toplevel .t -width 200 -height 100
139 
    wm geometry .t +100+100
140 
    update
141 
    wm iconify .t
142 
    wm deiconify .t
143 
    wm iconify .t
144 
    list [winfo ismapped .t] [wm state .t]
145 
} {0 iconic}
146 
test unixWm-5.5 {compounded state changes} {nonPortable} {
147 
    catch {destroy .t}
148 
    toplevel .t -width 200 -height 100
149 
    wm geometry .t +100+100
150 
    update
151 
    wm iconify .t
152 
    wm withdraw .t
153 
    list [winfo ismapped .t] [wm state .t]
154 
} {0 withdrawn}
155 
test unixWm-5.6 {compounded state changes} {nonPortable} {
156 
    catch {destroy .t}
157 
    toplevel .t -width 200 -height 100
158 
    wm geometry .t +100+100
159 
    update
160 
    wm iconify .t
161 
    wm withdraw .t
162 
    wm deiconify .t
163 
    list [winfo ismapped .t] [wm state .t]
164 
} {1 normal}
165 
test unixWm-5.7 {compounded state changes} {nonPortable} {
166 
    catch {destroy .t}
167 
    toplevel .t -width 200 -height 100
168 
    wm geometry .t +100+100
169 
    update
170 
    wm withdraw .t
171 
    wm iconify .t
172 
    list [winfo ismapped .t] [wm state .t]
173 
} {0 iconic}
174 
 
175 
catch {destroy .t}
176 
toplevel .t -width 200 -height 100
177 
wm geom .t +10+10
178 
wm minsize .t 1 1
179 
update
180 
test unixWm-6.1 {size changes} {
181 
    .t config -width 180 -height 150
182 
    update
183 
    wm geom .t
184 
} 180x150+10+10
185 
test unixWm-6.2 {size changes} {
186 
    wm geom .t 250x60
187 
    .t config -width 170 -height 140
188 
    update
189 
    wm geom .t
190 
} 250x60+10+10
191 
test unixWm-6.3 {size changes} {
192 
    wm geom .t 250x60
193 
    .t config -width 170 -height 140
194 
    wm geom .t {}
195 
    update
196 
    wm geom .t
197 
} 170x140+10+10
198 
test unixWm-6.4 {size changes} {nonPortable} {
199 
    wm minsize .t 1 1
200 
    update
201 
    puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
202 
    puts -nonewline stdout "then hit return: "
203 
    flush stdout
204 
    gets stdin
205 
    update
206 
    set width [winfo width .t]
207 
    set height [winfo height .t]
208 
    .t config -width 230 -height 110
209 
    update
210 
    incr width -[winfo width .t]
211 
    incr height -[winfo height .t]
212 
    wm geom .t {}
213 
    update
214 
    set w2 [winfo width .t]
215 
    set h2 [winfo height .t]
216 
    .t config -width 114 -height 261
217 
    update
218 
    list $width $height $w2 $h2 [wm geom .t]
219 
} {0 0 230 110 114x261+10+10}
220 
 
221 
# I don't know why the wait below is needed, but without it the test
222 
# fails under twm.
223 
sleep 200
224 
 
225 
test unixWm-6.5 {window initially iconic} {nonPortable} {
226 
    catch {destroy .t}
227 
    toplevel .t -width 100 -height 30
228 
    wm geometry .t +0+0
229 
    wm title .t 2
230 
    wm iconify .t
231 
    update idletasks
232 
    wm withdraw .t
233 
    wm deiconify .t
234 
    list [winfo ismapped .t] [wm state .t]
235 
} {1 normal}
236 
 
237 
catch {destroy .m}
238 
toplevel .m
239 
wm overrideredirect .m 1
240 
foreach i {{Test label} Another {Yet another} {Last label}} j {1 2 3} {
241 
    label .m.$j -text $i
242 
}
243 
wm geometry .m +[expr 100 - [winfo vrootx .]]+[expr 200 - [winfo vrooty .]]
244 
update
245 
test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} {
246 
    list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
247 
} {1 normal 100 200}
248 
wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]]
249 
update
250 
test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} {
251 
    list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
252 
} {1 normal 150 210}
253 
wm withdraw .m
254 
test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} {
255 
    list [winfo ismapped .m]
256 
} 0
257 
destroy .m
258 
catch {destroy .t}
259 
 
260 
test unixWm-8.1 {icon windows} {
261 
    catch {destroy .t}
262 
    catch {destroy .icon}
263 
    toplevel .t -width 100 -height 30
264 
    wm geometry .t +0+0
265 
    toplevel .icon -width 50 -height 50 -bg red
266 
    wm iconwindow .t .icon
267 
    list [catch {wm withdraw .icon} msg] $msg
268 
} {1 {can't withdraw .icon: it is an icon for .t}}
269 
test unixWm-8.2 {icon windows} {
270 
    catch {destroy .t}
271 
    toplevel .t -width 100 -height 30
272 
    list [catch {wm iconwindow} msg] $msg
273 
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
274 
test unixWm-8.3 {icon windows} {
275 
    catch {destroy .t}
276 
    toplevel .t -width 100 -height 30
277 
    list [catch {wm iconwindow .t b c} msg] $msg
278 
} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
279 
test unixWm-8.4 {icon windows} {
280 
    catch {destroy .t}
281 
    catch {destroy .icon}
282 
    toplevel .t -width 100 -height 30
283 
    wm geom .t +0+0
284 
    set result [wm iconwindow .t]
285 
    toplevel .icon -width 50 -height 50 -bg red
286 
    wm iconwindow .t .icon
287 
    lappend result [wm iconwindow .t] [wm state .icon]
288 
    wm iconwindow .t {}
289 
    lappend result [wm iconwindow .t] [wm state .icon]
290 
    update
291 
    lappend result [winfo ismapped .t] [winfo ismapped .icon]
292 
    wm iconify .t
293 
    update
294 
    lappend result [winfo ismapped .t] [winfo ismapped .icon]
295 
} {.icon icon {} withdrawn 1 0 0 0}
296 
test unixWm-8.5 {icon windows} {
297 
    catch {destroy .t}
298 
    toplevel .t -width 100 -height 30
299 
    list [catch {wm iconwindow .t .gorp} msg] $msg
300 
} {1 {bad window path name ".gorp"}}
301 
test unixWm-8.6 {icon windows} {
302 
    catch {destroy .t}
303 
    toplevel .t -width 100 -height 30
304 
    frame .t.icon -width 50 -height 50 -bg red
305 
    list [catch {wm iconwindow .t .t.icon} msg] $msg
306 
} {1 {can't use .t.icon as icon window: not at top level}}
307 
test unixWm-8.7 {icon windows} {
308 
    catch {destroy .t}
309 
    catch {destroy .icon}
310 
    toplevel .t -width 100 -height 30
311 
    wm geom .t +0+0
312 
    toplevel .icon -width 50 -height 50 -bg red
313 
    toplevel .icon2 -width 50 -height 50 -bg green
314 
    wm iconwindow .t .icon
315 
    set result "[wm iconwindow .t] [wm state .icon] [wm state .icon2]"
316 
    wm iconwindow .t .icon2
317 
    lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2]
318 
} {.icon icon normal .icon2 withdrawn icon}
319 
catch {destroy .icon2}
320 
test unixWm-8.8 {icon windows} {
321 
    catch {destroy .t}
322 
    catch {destroy .icon}
323 
    toplevel .icon -width 50 -height 50 -bg red
324 
    wm geom .icon +0+0
325 
    update
326 
    set result [winfo ismapped .icon]
327 
    toplevel .t -width 100 -height 30
328 
    wm geom .t +0+0
329 
    tkwait visibility .t        ;# Needed to keep tvtwm happy.
330 
    wm iconwindow .t .icon
331 
    sleep 500
332 
    lappend result [winfo ismapped .t] [winfo ismapped .icon]
333 
} {1 1 0}
334 
test unixWm-8.9 {icon windows} {nonPortable} {
335 
    # This test is non-portable because some window managers will
336 
    # destroy an icon window when it's associated window is destroyed.
337 
 
338 
    catch {destroy .t}
339 
    catch {destroy .icon}
340 
    toplevel .t -width 100 -height 30
341 
    toplevel .icon -width 50 -height 50 -bg red
342 
    wm geom .t +0+0
343 
    wm iconwindow .t .icon
344 
    update
345 
    set result "[wm state .icon] [winfo ismapped .t] [winfo ismapped .icon]"
346 
    destroy .t
347 
    wm geom .icon +0+0
348 
    update
349 
    lappend result [winfo ismapped .icon] [wm state .icon]
350 
    wm deiconify .icon
351 
    update
352 
    lappend result [winfo ismapped .icon] [wm state .icon]
353 
} {icon 1 0 0 withdrawn 1 normal}
354 
 
355 
if {[string compare testwrapper [info commands testwrapper]] != 0} {
356 
    puts "This application hasn't been compiled with the testwrapper command,"
357 
    puts "therefore I am skipping all of these tests."
358 
    return
359 
}
360 
 
361 
test unixWm-9.1 {TkWmMapWindow procedure, client property} {unixOnly} {
362 
    catch {destroy .t}
363 
    toplevel .t -width 100 -height 50
364 
    wm geom .t +0+0
365 
    wm client .t Test_String
366 
    update
367 
    testprop [testwrapper .t] WM_CLIENT_MACHINE
368 
} {Test_String}
369 
test unixWm-9.2 {TkWmMapWindow procedure, command property} {unixOnly} {
370 
    catch {destroy .t}
371 
    toplevel .t -width 100 -height 50
372 
    wm geom .t +0+0
373 
    wm command .t "test command"
374 
    update
375 
    testprop [testwrapper .t] WM_COMMAND
376 
} {test
377 
command
378 
}
379 
test unixWm-9.3 {TkWmMapWindow procedure, iconic windows} {
380 
    catch {destroy .t}
381 
    toplevel .t -width 100 -height 300 -bg blue
382 
    wm geom .t +0+0
383 
    wm iconify .t
384 
    sleep 500
385 
    winfo ismapped .t
386 
} {0}
387 
test unixWm-9.4 {TkWmMapWindow procedure, icon windows} {
388 
    catch {destroy .t}
389 
    sleep 500
390 
    toplevel .t -width 100 -height 50 -bg blue
391 
    wm iconwindow . .t
392 
    update
393 
    set result [winfo ismapped .t]
394 
} {0}
395 
test unixWm-9.5 {TkWmMapWindow procedure, normal windows} {
396 
    catch {destroy .t}
397 
    toplevel .t -width 200 -height 20
398 
    wm geom .t +0+0
399 
    update
400 
    winfo ismapped .t
401 
} {1}
402 
 
403 
test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handler} {
404 
    catch {destroy .t}
405 
    toplevel .t -width 100 -height 50
406 
    wm geom .t +0+0
407 
    update
408 
    .t configure -width 200 -height 100
409 
    destroy .t
410 
} {}
411 
test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unixOnly} {
412 
    catch {destroy .t}
413 
    catch {destroy .f}
414 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
415 
    wm geom .t +0+0
416 
    update
417 
    frame .f -width 400 -height 30 -bd 2 -relief raised -bg green
418 
    bind .f  {lappend result destroyed}
419 
    testmenubar window .t .f
420 
    update
421 
    set result {}
422 
    destroy .t
423 
    lappend result [winfo exists .f]
424 
} {destroyed 0}
425 
 
426 
test unixWm-11.1 {Tk_WmCmd procedure, miscellaneous errors} {
427 
    list [catch {wm} msg] $msg
428 
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
429 
test unixWm-11.2 {Tk_WmCmd procedure, miscellaneous errors} {
430 
    list [catch {wm foo} msg] $msg
431 
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
432 
test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} {
433 
    list [catch {wm foo bogus} msg] $msg
434 
} {1 {bad window path name "bogus"}}
435 
test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} {
436 
    catch {destroy .b}
437 
    button .b -text hello
438 
    list [catch {wm geometry .b} msg] $msg
439 
} {1 {window ".b" isn't a top-level window}}
440 
 
441 
catch {destroy .t}
442 
catch {destroy .icon}
443 
 
444 
toplevel .t -width 100 -height 50
445 
wm geom .t +0+0
446 
update
447 
 
448 
test unixWm-12.1 {Tk_WmCmd procedure, "aspect" option} {
449 
    list [catch {wm aspect .t 12} msg] $msg
450 
} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
451 
test unixWm-12.2 {Tk_WmCmd procedure, "aspect" option} {
452 
    list [catch {wm aspect .t 12 13 14 15 16} msg] $msg
453 
} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
454 
test unixWm-12.3 {Tk_WmCmd procedure, "aspect" option} {
455 
    set result {}
456 
    lappend result [wm aspect .t]
457 
    wm aspect .t 3 4 10 2
458 
    lappend result [wm aspect .t]
459 
    wm aspect .t {} {} {} {}
460 
    lappend result [wm aspect .t]
461 
} {{} {3 4 10 2} {}}
462 
test unixWm-12.4 {Tk_WmCmd procedure, "aspect" option} {
463 
    list [catch {wm aspect .t bad 14 15 16} msg] $msg
464 
} {1 {expected integer but got "bad"}}
465 
test unixWm-12.5 {Tk_WmCmd procedure, "aspect" option} {
466 
    list [catch {wm aspect .t 13 foo 15 16} msg] $msg
467 
} {1 {expected integer but got "foo"}}
468 
test unixWm-12.6 {Tk_WmCmd procedure, "aspect" option} {
469 
    list [catch {wm aspect .t 13 14 bar 16} msg] $msg
470 
} {1 {expected integer but got "bar"}}
471 
test unixWm-12.7 {Tk_WmCmd procedure, "aspect" option} {
472 
    list [catch {wm aspect .t 13 14 15 baz} msg] $msg
473 
} {1 {expected integer but got "baz"}}
474 
test unixWm-12.8 {Tk_WmCmd procedure, "aspect" option} {
475 
    list [catch {wm aspect .t 0 14 15 16} msg] $msg
476 
} {1 {aspect number can't be <= 0}}
477 
test unixWm-12.9 {Tk_WmCmd procedure, "aspect" option} {
478 
    list [catch {wm aspect .t 13 0 15 16} msg] $msg
479 
} {1 {aspect number can't be <= 0}}
480 
test unixWm-12.10 {Tk_WmCmd procedure, "aspect" option} {
481 
    list [catch {wm aspect .t 13 14 0 16} msg] $msg
482 
} {1 {aspect number can't be <= 0}}
483 
test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} {
484 
    list [catch {wm aspect .t 13 14 15 0} msg] $msg
485 
} {1 {aspect number can't be <= 0}}
486 
 
487 
test unixWm-13.1 {Tk_WmCmd procedure, "client" option} {
488 
    list [catch {wm client .t x y} msg] $msg
489 
} {1 {wrong # arguments: must be "wm client window ?name?"}}
490 
test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unixOnly} {
491 
    set result {}
492 
    lappend result [wm client .t]
493 
    wm client .t Test_String
494 
    lappend result [testprop [testwrapper .t] WM_CLIENT_MACHINE]
495 
    wm client .t New
496 
    lappend result [wm client .t]
497 
    wm client .t {}
498 
    lappend result [wm client .t] [testprop [testwrapper .t] WM_CLIENT_MACHINE]
499 
} {{} Test_String New {} {}}
500 
test unixWm-13.3 {Tk_WmCmd procedure, "client" option, unmapped window} {
501 
    catch {destroy .t2}
502 
    toplevel .t2
503 
    wm client .t2 Test_String
504 
    wm client .t2 {}
505 
    wm client .t2 Test_String
506 
    destroy .t2
507 
} {}
508 
 
509 
test unixWm-14.1 {Tk_WmCmd procedure, "colormapwindows" option} {
510 
    list [catch {wm colormapwindows .t 12 13} msg] $msg
511 
} {1 {wrong # arguments: must be "wm colormapwindows window ?windowList?"}}
512 
test unixWm-14.2 {Tk_WmCmd procedure, "colormapwindows" option} {
513 
    catch {destroy .t2}
514 
    toplevel .t2 -width 200 -height 200 -colormap new
515 
    wm geom .t2 +0+0
516 
    frame .t2.a -width 100 -height 30
517 
    frame .t2.b -width 100 -height 30 -colormap new
518 
    pack .t2.a .t2.b -side top
519 
    update
520 
    set x [wm colormapwindows .t2]
521 
    frame .t2.c -width 100 -height 30 -colormap new
522 
    pack .t2.c -side top
523 
    update
524 
    list $x [wm colormapwindows .t2]
525 
} {{.t2.b .t2} {.t2.b .t2.c .t2}}
526 
test unixWm-14.3 {Tk_WmCmd procedure, "colormapwindows" option} {
527 
    list [catch {wm col . "a \{"} msg] $msg
528 
} {1 {unmatched open brace in list}}
529 
test unixWm-14.4 {Tk_WmCmd procedure, "colormapwindows" option} {
530 
    list [catch {wm colormapwindows . foo} msg] $msg
531 
} {1 {bad window path name "foo"}}
532 
test unixWm-14.5 {Tk_WmCmd procedure, "colormapwindows" option} {
533 
    catch {destroy .t2}
534 
    toplevel .t2 -width 200 -height 200 -colormap new
535 
    wm geom .t2 +0+0
536 
    frame .t2.a -width 100 -height 30
537 
    frame .t2.b -width 100 -height 30
538 
    frame .t2.c -width 100 -height 30
539 
    pack .t2.a .t2.b .t2.c -side top
540 
    wm colormapwindows .t2 {.t2.c .t2 .t2.a}
541 
    wm colormapwindows .t2
542 
} {.t2.c .t2 .t2.a}
543 
test unixWm-14.6 {Tk_WmCmd procedure, "colormapwindows" option} {
544 
    catch {destroy .t2}
545 
    toplevel .t2 -width 200 -height 200
546 
    wm geom .t2 +0+0
547 
    frame .t2.a -width 100 -height 30
548 
    frame .t2.b -width 100 -height 30
549 
    frame .t2.c -width 100 -height 30
550 
    pack .t2.a .t2.b .t2.c -side top
551 
    wm colormapwindows .t2 {.t2.b .t2.a}
552 
    wm colormapwindows .t2
553 
} {.t2.b .t2.a}
554 
test unixWm-14.7 {Tk_WmCmd procedure, "colormapwindows" option} {
555 
    catch {destroy .t2}
556 
    toplevel .t2 -width 200 -height 200 -colormap new
557 
    wm geom .t2 +0+0
558 
    set x [wm colormapwindows .t2]
559 
    wm colormapwindows .t2 {}
560 
    list $x [wm colormapwindows .t2]
561 
} {{} {}}
562 
catch {destroy .t2}
563 
 
564 
test unixWm-15.1 {Tk_WmCmd procedure, "command" option} {
565 
    list [catch {wm command .t 12 13} msg] $msg
566 
} {1 {wrong # arguments: must be "wm command window ?value?"}}
567 
test unixWm-15.2 {Tk_WmCmd procedure, "command" option} {
568 
    list [catch {wm command .t 12 13} msg] $msg
569 
} {1 {wrong # arguments: must be "wm command window ?value?"}}
570 
test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unixOnly} {
571 
    set result {}
572 
    lappend result [wm command .t]
573 
    wm command .t "test command"
574 
    lappend result [testprop [testwrapper .t] WM_COMMAND]
575 
    wm command .t "new command"
576 
    lappend result [wm command .t]
577 
    wm command .t {}
578 
    lappend result [wm command .t] [testprop [testwrapper .t] WM_COMMAND]
579 
} {{} {test
580 
command
581 
} {new command} {} {}}
582 
test unixWm-15.4 {Tk_WmCmd procedure, "command" option, window not mapped} {
583 
    catch {destroy .t2}
584 
    toplevel .t2
585 
    wm geom .t2 +0+0
586 
    wm command .t2 "test command"
587 
    wm command .t2 "new command"
588 
    wm command .t2 {}
589 
    destroy .t2
590 
} {}
591 
test unixWm-15.5 {Tk_WmCmd procedure, "command" option} {
592 
    list [catch {wm command .t "a \{b"} msg] $msg
593 
} {1 {unmatched open brace in list}}
594 
 
595 
test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} {
596 
    list [catch {wm deiconify .t 12} msg] $msg
597 
} {1 {wrong # arguments: must be "wm deiconify window"}}
598 
test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} {
599 
    catch {destroy .icon}
600 
    toplevel .icon -width 50 -height 50 -bg red
601 
    wm iconwindow .t .icon
602 
    set result [list [catch {wm deiconify .icon} msg] $msg]
603 
    destroy .icon
604 
    set result
605 
} {1 {can't deiconify .icon: it is an icon for .t}}
606 
test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} {
607 
    wm iconify .t
608 
    set result {}
609 
    lappend result [winfo ismapped .t] [wm state .t]
610 
    wm deiconify .t
611 
    lappend result [winfo ismapped .t] [wm state .t]
612 
} {0 iconic 1 normal}
613 
 
614 
test unixWm-17.1 {Tk_WmCmd procedure, "focusmodel" option} {
615 
    list [catch {wm focusmodel .t 12 13} msg] $msg
616 
} {1 {wrong # arguments: must be "wm focusmodel window ?active|passive?"}}
617 
test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} {
618 
    list [catch {wm focusmodel .t bogus} msg] $msg
619 
} {1 {bad argument "bogus": must be active or passive}}
620 
test unixWm-17.3 {Tk_WmCmd procedure, "focusmodel" option} {
621 
    set result {}
622 
    lappend result [wm focusmodel .t]
623 
    wm focusmodel .t active
624 
    lappend result [wm focusmodel .t]
625 
    wm focusmodel .t passive
626 
    lappend result [wm focusmodel .t]
627 
    set result
628 
} {passive active passive}
629 
 
630 
test unixWm-18.1 {Tk_WmCmd procedure, "frame" option} {
631 
    list [catch {wm frame .t 12} msg] $msg
632 
} {1 {wrong # arguments: must be "wm frame window"}}
633 
test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} nonPortable {
634 
    expr [wm frame .t] == [winfo id .t]
635 
} {0}
636 
test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} nonPortable {
637 
    catch {destroy .t2}
638 
    toplevel .t2
639 
    wm geom .t2 +0+0
640 
    wm overrideredirect .t2 1
641 
    update
642 
    set result [expr [wm frame .t2] == [winfo id .t2]]
643 
    destroy .t2
644 
    set result
645 
} {1}
646 
 
647 
test unixWm-19.1 {Tk_WmCmd procedure, "geometry" option} {
648 
    list [catch {wm geometry .t 12 13} msg] $msg
649 
} {1 {wrong # arguments: must be "wm geometry window ?newGeometry?"}}
650 
test unixWm-19.2 {Tk_WmCmd procedure, "geometry" option} nonPortable {
651 
    wm geometry .t -1+5
652 
    update
653 
    wm geometry .t
654 
} {100x50-1+5}
655 
test unixWm-19.3 {Tk_WmCmd procedure, "geometry" option} nonPortable {
656 
    wm geometry .t +10-4
657 
    update
658 
    wm geometry .t
659 
} {100x50+10-4}
660 
test unixWm-19.4 {Tk_WmCmd procedure, "geometry" option} nonPortable {
661 
    catch {destroy .t2}
662 
    toplevel .t2
663 
    wm geom .t2 -5+10
664 
    listbox .t2.l -width 30 -height 12 -setgrid 1
665 
    pack .t2.l
666 
    update
667 
    set result [wm geometry .t2]
668 
    destroy .t2
669 
    set result
670 
} {30x12-5+10}
671 
test unixWm-19.5 {Tk_WmCmd procedure, "geometry" option} nonPortable {
672 
    wm geometry .t 150x300+5+6
673 
    update
674 
    set result {}
675 
    lappend result [wm geometry .t]
676 
    wm geometry .t {}
677 
    update
678 
    lappend result [wm geometry .t]
679 
} {150x300+5+6 100x50+5+6}
680 
test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} {
681 
    list [catch {wm geometry .t qrs} msg] $msg
682 
} {1 {bad geometry specifier "qrs"}}
683 
 
684 
test unixWm-20.1 {Tk_WmCmd procedure, "grid" option} {
685 
    list [catch {wm grid .t 12 13} msg] $msg
686 
} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
687 
test unixWm-20.2 {Tk_WmCmd procedure, "grid" option} {
688 
    list [catch {wm grid .t 12 13 14 15 16} msg] $msg
689 
} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
690 
test unixWm-20.3 {Tk_WmCmd procedure, "grid" option} {
691 
    set result {}
692 
    lappend result [wm grid .t]
693 
    wm grid .t 5 6 20 10
694 
    lappend result [wm grid .t]
695 
    wm grid .t {} {} {} {}
696 
    lappend result [wm grid .t]
697 
} {{} {5 6 20 10} {}}
698 
test unixWm-20.4 {Tk_WmCmd procedure, "grid" option} {
699 
    list [catch {wm grid .t bad 10 11 12} msg] $msg
700 
} {1 {expected integer but got "bad"}}
701 
test unixWm-20.5 {Tk_WmCmd procedure, "grid" option} {
702 
    list [catch {wm grid .t -1 11 12 13} msg] $msg
703 
} {1 {baseWidth can't be < 0}}
704 
test unixWm-20.6 {Tk_WmCmd procedure, "grid" option} {
705 
    list [catch {wm grid .t 10 foo 12 13} msg] $msg
706 
} {1 {expected integer but got "foo"}}
707 
test unixWm-20.7 {Tk_WmCmd procedure, "grid" option} {
708 
    list [catch {wm grid .t 10 -11 12 13} msg] $msg
709 
} {1 {baseHeight can't be < 0}}
710 
test unixWm-20.8 {Tk_WmCmd procedure, "grid" option} {
711 
    list [catch {wm grid .t 10 11 bar 13} msg] $msg
712 
} {1 {expected integer but got "bar"}}
713 
test unixWm-20.9 {Tk_WmCmd procedure, "grid" option} {
714 
    list [catch {wm grid .t 10 11 -2 13} msg] $msg
715 
} {1 {widthInc can't be < 0}}
716 
test unixWm-20.10 {Tk_WmCmd procedure, "grid" option} {
717 
    list [catch {wm grid .t 10 11 12 bogus} msg] $msg
718 
} {1 {expected integer but got "bogus"}}
719 
test unixWm-20.11 {Tk_WmCmd procedure, "grid" option} {
720 
    list [catch {wm grid .t 10 11 12 -1} msg] $msg
721 
} {1 {heightInc can't be < 0}}
722 
 
723 
catch {destroy .t}
724 
catch {destroy .icon}
725 
toplevel .t -width 100 -height 50
726 
wm geom .t +0+0
727 
update
728 
 
729 
test unixWm-21.1 {Tk_WmCmd procedure, "group" option} {
730 
    list [catch {wm group .t 12 13} msg] $msg
731 
} {1 {wrong # arguments: must be "wm group window ?pathName?"}}
732 
test unixWm-21.2 {Tk_WmCmd procedure, "group" option} {
733 
    list [catch {wm group .t bogus} msg] $msg
734 
} {1 {bad window path name "bogus"}}
735 
test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unixOnly} {
736 
    set result {}
737 
    lappend result [wm group .t]
738 
    wm group .t .
739 
    set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \
740 
            WM_HINTS] 0]]]
741 
    lappend result [wm group .t] $bit
742 
    wm group .t {}
743 
    set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \
744 
            WM_HINTS] 0]]]
745 
    lappend result [wm group .t] $bit
746 
} {{} . 0x40 {} 0x0}
747 
test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unixOnly} {
748 
    catch {destroy .t2}
749 
    toplevel .t2
750 
    wm geom .t2 +0+0
751 
    wm group .t .t2
752 
    set hints [testprop [testwrapper .t] WM_HINTS]
753 
    set result [expr [testwrapper .t2] - [lindex $hints 8]]
754 
    destroy .t2
755 
    set result
756 
} {0}
757 
test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unixOnly} {
758 
    catch {destroy .t2}
759 
    catch {destroy .t3}
760 
    toplevel .t2 -width 120 -height 300
761 
    wm geometry .t2 +0+0
762 
    toplevel .t3 -width 120 -height 300
763 
    wm geometry .t2 +0+0
764 
    set result [list [testwrapper .t2]]
765 
    wm group .t3 .t2
766 
    lappend result [expr {[testwrapper .t2] == ""}]
767 
    destroy .t2 .t3
768 
    set result
769 
} {{} 0}
770 
 
771 
test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} {
772 
    list [catch {wm iconbitmap .t 12 13} msg] $msg
773 
} {1 {wrong # arguments: must be "wm iconbitmap window ?bitmap?"}}
774 
test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unixOnly} {
775 
    set result {}
776 
    lappend result [wm iconbitmap .t]
777 
    wm iconbitmap .t questhead
778 
    set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \
779 
            WM_HINTS] 0]]]
780 
    lappend result [wm iconbitmap .t] $bit
781 
    wm iconbitmap .t {}
782 
    set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \
783 
            WM_HINTS] 0]]]
784 
    lappend result [wm iconbitmap .t] $bit
785 
} {{} questhead 0x4 {} 0x0}
786 
test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option} {
787 
    list [catch {wm iconbitmap .t bad-bitmap} msg] $msg
788 
} {1 {bitmap "bad-bitmap" not defined}}
789 
 
790 
test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} {
791 
    list [catch {wm iconify .t 12} msg] $msg
792 
} {1 {wrong # arguments: must be "wm iconify window"}}
793 
test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} {
794 
    catch {destroy .t2}
795 
    toplevel .t2
796 
    wm overrideredirect .t2 1
797 
    set result [list [catch {wm iconify .t2} msg] $msg]
798 
    destroy .t2
799 
    set result
800 
} {1 {can't iconify ".t2": override-redirect flag is set}}
801 
test unixWm-23.3 {Tk_WmCmd procedure, "iconify" option} {
802 
    catch {destroy .t2}
803 
    toplevel .t2
804 
    wm geom .t2 +0+0
805 
    wm transient .t2 .t
806 
    set result [list [catch {wm iconify .t2} msg] $msg]
807 
    destroy .t2
808 
    set result
809 
} {1 {can't iconify ".t2": it is a transient}}
810 
test unixWm-23.4 {Tk_WmCmd procedure, "iconify" option} {
811 
    catch {destroy .t2}
812 
    toplevel .t2
813 
    wm geom .t2 +0+0
814 
    wm iconwindow .t .t2
815 
    set result [list [catch {wm iconify .t2} msg] $msg]
816 
    destroy .t2
817 
    set result
818 
} {1 {can't iconify .t2: it is an icon for .t}}
819 
test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} {
820 
    catch {destroy .t2}
821 
    toplevel .t2
822 
    wm geom .t2 +0+0
823 
    wm iconify .t2
824 
    update
825 
    set result [winfo ismapped .t2]
826 
    destroy .t2
827 
    set result
828 
} {0}
829 
test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {
830 
    catch {destroy .t2}
831 
    toplevel .t2
832 
    wm geom .t2 -0+0
833 
    update
834 
    set result [winfo ismapped .t2]
835 
    wm iconify .t2
836 
    lappend result [winfo ismapped .t2]
837 
    destroy .t2
838 
    set result
839 
} {1 0}
840 
 
841 
test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} {
842 
    list [catch {wm iconmask .t 12 13} msg] $msg
843 
} {1 {wrong # arguments: must be "wm iconmask window ?bitmap?"}}
844 
test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unixOnly} {
845 
    set result {}
846 
    lappend result [wm iconmask .t]
847 
    wm iconmask .t questhead
848 
    set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
849 
            WM_HINTS] 0]]]
850 
    lappend result [wm iconmask .t] $bit
851 
    wm iconmask .t {}
852 
    set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
853 
            WM_HINTS] 0]]]
854 
    lappend result [wm iconmask .t] $bit
855 
} {{} questhead 0x20 {} 0x0}
856 
test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} {
857 
    list [catch {wm iconmask .t bogus} msg] $msg
858 
} {1 {bitmap "bogus" not defined}}
859 
 
860 
test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} {
861 
    list [catch {wm icon .t} msg] $msg
862 
} {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}}
863 
test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} {
864 
    list [catch {wm iconname .t 12 13} msg] $msg
865 
} {1 {wrong # arguments: must be "wm iconname window ?newName?"}}
866 
test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unixOnly} {
867 
    set result {}
868 
    lappend result [wm iconname .t]
869 
    wm iconname .t test_name
870 
    lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
871 
    wm iconname .t {}
872 
    lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
873 
} {{} test_name test_name {} {}}
874 
 
875 
test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} {
876 
    list [catch {wm iconposition .t 12} msg] $msg
877 
} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
878 
test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} {
879 
    list [catch {wm iconposition .t 12 13 14} msg] $msg
880 
} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
881 
test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unixOnly} {
882 
    set result {}
883 
    lappend result [wm iconposition .t]
884 
    wm iconposition .t 10 15
885 
    set prop [testprop [testwrapper .t] WM_HINTS]
886 
    lappend result [wm iconposition .t] [lindex $prop 5] [lindex $prop 6]
887 
    lappend result  [format 0x%x [expr 0x10 & [lindex $prop 0]]]
888 
    wm iconposition .t {} {}
889 
    set bit [format 0x%x [expr 0x10 & [lindex [testprop [testwrapper .t] \
890 
            WM_HINTS] 0]]]
891 
    lappend result [wm iconposition .t] $bit
892 
} {{} {10 15} 0xa 0xf 0x10 {} 0x0}
893 
test unixWm-26.4 {Tk_WmCmd procedure, "iconposition" option} {
894 
    list [catch {wm iconposition .t bad 13} msg] $msg
895 
} {1 {expected integer but got "bad"}}
896 
test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} {
897 
    list [catch {wm iconposition .t 13 lousy} msg] $msg
898 
} {1 {expected integer but got "lousy"}}
899 
 
900 
test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} {
901 
    list [catch {wm iconwindow .t 12 13} msg] $msg
902 
} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
903 
test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unixOnly} {
904 
    catch {destroy .icon}
905 
    toplevel .icon -width 50 -height 50 -bg green
906 
    set result {}
907 
    lappend result [wm iconwindow .t]
908 
    wm iconwindow .t .icon
909 
    set prop [testprop [testwrapper .t] WM_HINTS]
910 
    lappend result [wm iconwindow .t] [wm state .icon]
911 
    lappend result [format 0x%x [expr 0x8 & [lindex $prop 0]]]
912 
    lappend result [expr [testwrapper .icon] == [lindex $prop 4]]
913 
    wm iconwindow .t {}
914 
    set bit [format 0x%x [expr 0x8 & [lindex [testprop [testwrapper .t] \
915 
            WM_HINTS] 0]]]
916 
    lappend result [wm iconwindow .t]  [wm state .icon] $bit
917 
    destroy .icon
918 
    set result
919 
} {{} .icon icon 0x8 1 {} withdrawn 0x0}
920 
test unixWm-27.3 {Tk_WmCmd procedure, "iconwindow" option} {
921 
    list [catch {wm iconwindow .t bogus} msg] $msg
922 
} {1 {bad window path name "bogus"}}
923 
test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} {
924 
    catch {destroy .b}
925 
    button .b -text Help
926 
    set result [list [catch {wm iconwindow .t .b} msg] $msg]
927 
    destroy .b
928 
    set result
929 
} {1 {can't use .b as icon window: not at top level}}
930 
test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} {
931 
    catch {destroy .icon}
932 
    toplevel .icon -width 50 -height 50 -bg green
933 
    catch {destroy .t2}
934 
    toplevel .t2
935 
    wm geom .t2 -0+0
936 
    wm iconwindow .t2 .icon
937 
    set result [list [catch {wm iconwindow .t .icon} msg] $msg]
938 
    destroy .t2
939 
    destroy .icon
940 
    set result
941 
} {1 {.icon is already an icon for .t2}}
942 
test unixWm-27.6 {Tk_WmCmd procedure, "iconwindow" option, changing icons} {
943 
    catch {destroy .icon}
944 
    catch {destroy .icon2}
945 
    toplevel .icon -width 50 -height 50 -bg green
946 
    toplevel .icon2 -width 50 -height 50 -bg red
947 
    set result {}
948 
    wm iconwindow .t .icon
949 
    lappend result [wm state .icon] [wm state .icon2]
950 
    wm iconwindow .t .icon2
951 
    lappend result [wm state .icon] [wm state .icon2]
952 
    destroy .icon .icon2
953 
    set result
954 
} {icon normal withdrawn icon}
955 
test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} {
956 
    catch {destroy .icon}
957 
    toplevel .icon -width 50 -height 50 -bg green
958 
    wm geometry .icon +0+0
959 
    update
960 
    set result {}
961 
    lappend result [wm state .icon] [winfo viewable .icon]
962 
    wm iconwindow .t .icon
963 
    lappend result [wm state .icon] [winfo viewable .icon]
964 
    destroy .icon
965 
    set result
966 
} {normal 1 icon 0}
967 
 
968 
test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option} {
969 
    list [catch {wm maxsize} msg]  $msg
970 
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
971 
test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option} {
972 
    list [catch {wm maxsize . a} msg]  $msg
973 
} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
974 
test unixWm-28.3 {Tk_WmCmd procedure, "maxsize" option} {
975 
    list [catch {wm maxsize . a b c} msg]  $msg
976 
} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
977 
test unixWm-28.4 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
978 
    wm maxsize .t
979 
}  {1137 870}
980 
test unixWm-28.5 {Tk_WmCmd procedure, "maxsize" option} {
981 
    list [catch {wm maxsize . x 100} msg]  $msg
982 
} {1 {expected integer but got "x"}}
983 
test unixWm-28.6 {Tk_WmCmd procedure, "maxsize" option} {
984 
    list [catch {wm maxsize . 100 bogus} msg]  $msg
985 
} {1 {expected integer but got "bogus"}}
986 
test unixWm-28.7 {Tk_WmCmd procedure, "maxsize" option} {
987 
    wm maxsize .t 200 150
988 
    wm maxsize .t
989 
} {200 150}
990 
test unixWm-28.8 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
991 
    # Not portable, because some window managers let applications override
992 
    # minsize and maxsize.
993 
 
994 
    wm maxsize .t 200 150
995 
    wm geom .t 300x200
996 
    update
997 
    list [winfo width .t] [winfo height .t]
998 
} {200 150}
999 
 
1000 
catch {destroy .t}
1001 
catch {destroy .icon}
1002 
toplevel .t -width 100 -height 50
1003 
wm geom .t +0+0
1004 
update
1005 
 
1006 
test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option} {
1007 
    list [catch {wm minsize} msg]  $msg
1008 
} {1 {wrong # args: should be "wm option window ?arg ...?"}}
1009 
test unixWm-29.2 {Tk_WmCmd procedure, "minsize" option} {
1010 
    list [catch {wm minsize . a} msg]  $msg
1011 
} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
1012 
test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option} {
1013 
    list [catch {wm minsize . a b c} msg]  $msg
1014 
} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
1015 
test unixWm-29.4 {Tk_WmCmd procedure, "minsize" option} {
1016 
    wm minsize .t
1017 
}  {1 1}
1018 
test unixWm-29.5 {Tk_WmCmd procedure, "minsize" option} {
1019 
    list [catch {wm minsize . x 100} msg]  $msg
1020 
} {1 {expected integer but got "x"}}
1021 
test unixWm-29.6 {Tk_WmCmd procedure, "minsize" option} {
1022 
    list [catch {wm minsize . 100 bogus} msg]  $msg
1023 
} {1 {expected integer but got "bogus"}}
1024 
test unixWm-29.7 {Tk_WmCmd procedure, "minsize" option} {
1025 
    wm minsize .t 200 150
1026 
    wm minsize .t
1027 
} {200 150}
1028 
test unixWm-29.8 {Tk_WmCmd procedure, "minsize" option} {nonPortable} {
1029 
    # Not portable, because some window managers let applications override
1030 
    # minsize and maxsize.
1031 
 
1032 
    wm minsize .t 150 100
1033 
    wm geom .t 50x50
1034 
    update
1035 
    list [winfo width .t] [winfo height .t]
1036 
} {150 100}
1037 
 
1038 
catch {destroy .t}
1039 
catch {destroy .icon}
1040 
toplevel .t -width 100 -height 50
1041 
wm geom .t +0+0
1042 
update
1043 
 
1044 
test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} {
1045 
    list [catch {wm overrideredirect .t 1 2} msg]  $msg
1046 
} {1 {wrong # arguments: must be "wm overrideredirect window ?boolean?"}}
1047 
test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} {
1048 
    list [catch {wm overrideredirect .t boo} msg]  $msg
1049 
} {1 {expected boolean value but got "boo"}}
1050 
test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} {
1051 
    set result {}
1052 
    lappend result [wm overrideredirect .t]
1053 
    wm overrideredirect .t true
1054 
    lappend result [wm overrideredirect .t]
1055 
    wm overrideredirect .t off
1056 
    lappend result [wm overrideredirect .t]
1057 
} {0 1 0}
1058 
 
1059 
test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} {
1060 
    list [catch {wm positionfrom .t 1 2} msg]  $msg
1061 
} {1 {wrong # arguments: must be "wm positionfrom window ?user/program?"}}
1062 
test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unixOnly} {
1063 
    set result {}
1064 
    lappend result [wm positionfrom .t]
1065 
    wm positionfrom .t program
1066 
    update
1067 
    set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
1068 
            WM_NORMAL_HINTS] 0]]]
1069 
    lappend result [wm positionfrom .t] $bit
1070 
    wm positionfrom .t user
1071 
    update
1072 
    set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
1073 
            WM_NORMAL_HINTS] 0]]]
1074 
    lappend result [wm positionfrom .t] $bit
1075 
} {user program 0x4 user 0x1}
1076 
test unixWm-31.3 {Tk_WmCmd procedure, "positionfrom" option} {
1077 
    list [catch {wm positionfrom .t none} msg]  $msg
1078 
} {1 {bad argument "none": must be program or user}}
1079 
 
1080 
test unixWm-32.1 {Tk_WmCmd procedure, "protocol" option} {
1081 
    list [catch {wm protocol .t 1 2 3} msg]  $msg
1082 
} {1 {wrong # arguments: must be "wm protocol window ?name? ?command?"}}
1083 
test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} {
1084 
    wm protocol .t {foo a} {a b c}
1085 
    wm protocol .t bar {test script for bar}
1086 
    set result [wm protocol .t]
1087 
    wm protocol .t {foo a} {}
1088 
    wm protocol .t bar {}
1089 
    set result
1090 
} {bar {foo a}}
1091 
test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unixOnly} {
1092 
    set result {}
1093 
    lappend result [wm protocol .t]
1094 
    set x {}
1095 
    foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
1096 
        lappend x [winfo atomname $i]
1097 
    }
1098 
    lappend result $x
1099 
    wm protocol .t foo {test script}
1100 
    wm protocol .t bar {test script}
1101 
    set x {}
1102 
    foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
1103 
        lappend x [winfo atomname $i]
1104 
    }
1105 
    lappend result [wm protocol .t] $x
1106 
    wm protocol .t foo {}
1107 
    wm protocol .t bar {}
1108 
    set x {}
1109 
    foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
1110 
        lappend x [winfo atomname $i]
1111 
    }
1112 
    lappend result [wm protocol .t] $x
1113 
} {{} WM_DELETE_WINDOW {bar foo} {WM_DELETE_WINDOW bar foo} {} WM_DELETE_WINDOW}
1114 
test unixWm-32.4 {Tk_WmCmd procedure, "protocol" option} {
1115 
    set result {}
1116 
    wm protocol .t foo {a b c}
1117 
    wm protocol .t bar {test script for bar}
1118 
    lappend result [wm protocol .t foo] [wm protocol .t bar]
1119 
    wm protocol .t foo {}
1120 
    wm protocol .t bar {}
1121 
    lappend result [wm protocol .t foo] [wm protocol .t bar]
1122 
} {{a b c} {test script for bar} {} {}}
1123 
test unixWm-32.5 {Tk_WmCmd procedure, "protocol" option} {
1124 
    wm protocol .t foo {a b c}
1125 
    wm protocol .t foo {test script}
1126 
    set result [wm protocol .t foo]
1127 
    wm protocol .t foo {}
1128 
    set result
1129 
} {test script}
1130 
 
1131 
test unixWm-33.1 {Tk_WmCmd procedure, "resizable" option} {
1132 
    list [catch {wm resizable . a} msg]  $msg
1133 
} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
1134 
test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} {
1135 
    list [catch {wm resizable . a b c} msg]  $msg
1136 
} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
1137 
test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} {
1138 
    list [catch {wm resizable .foo a b c} msg]  $msg
1139 
} {1 {bad window path name ".foo"}}
1140 
test unixWm-33.4 {Tk_WmCmd procedure, "resizable" option} {
1141 
    list [catch {wm resizable . x 1} msg]  $msg
1142 
} {1 {expected boolean value but got "x"}}
1143 
test unixWm-33.5 {Tk_WmCmd procedure, "resizable" option} {
1144 
    list [catch {wm resizable . 0 gorp} msg]  $msg
1145 
} {1 {expected boolean value but got "gorp"}}
1146 
test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} {
1147 
    catch {destroy .t2}
1148 
    toplevel .t2 -width 200 -height 100
1149 
    wm geom .t2 +0+0
1150 
    set result ""
1151 
    lappend result [wm resizable .t2]
1152 
    wm resizable .t2 1 0
1153 
    lappend result [wm resizable .t2]
1154 
    wm resizable .t2 no off
1155 
    lappend result [wm resizable .t2]
1156 
    wm resizable .t2 false true
1157 
    lappend result [wm resizable .t2]
1158 
    destroy .t2
1159 
    set result
1160 
} {{1 1} {1 0} {0 0} {0 1}}
1161 
 
1162 
test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} {
1163 
    list [catch {wm sizefrom .t 1 2} msg]  $msg
1164 
} {1 {wrong # arguments: must be "wm sizefrom window ?user|program?"}}
1165 
test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unixOnly} {
1166 
    set result {}
1167 
    lappend result [wm sizefrom .t]
1168 
    wm sizefrom .t program
1169 
    update
1170 
    set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
1171 
            WM_NORMAL_HINTS] 0]]]
1172 
    lappend result [wm sizefrom .t] $bit
1173 
    wm sizefrom .t user
1174 
    update
1175 
    set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
1176 
            WM_NORMAL_HINTS] 0]]]
1177 
    lappend result [wm sizefrom .t] $bit
1178 
} {{} program 0x8 user 0x2}
1179 
test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} {
1180 
    list [catch {wm sizefrom .t none} msg]  $msg
1181 
} {1 {bad argument "none": must be program or user}}
1182 
 
1183 
test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {
1184 
    list [catch {wm state .t 1} msg]  $msg
1185 
} {1 {wrong # arguments: must be "wm state window"}}
1186 
test unixWm-35.2 {Tk_WmCmd procedure, "state" option} {
1187 
    set result {}
1188 
    catch {destroy .t2}
1189 
    toplevel .t2 -width 120 -height 300
1190 
    wm geometry .t2 +0+0
1191 
    lappend result [wm state .t2]
1192 
    update
1193 
    lappend result [wm state .t2]
1194 
    wm withdraw .t2
1195 
    lappend result [wm state .t2]
1196 
    wm iconify .t2
1197 
    lappend result [wm state .t2]
1198 
    wm deiconify .t2
1199 
    lappend result [wm state .t2]
1200 
    destroy .t2
1201 
    set result
1202 
} {normal normal withdrawn iconic normal}
1203 
 
1204 
test unixWm-36.1 {Tk_WmCmd procedure, "title" option} {
1205 
    list [catch {wm title .t 1 2} msg]  $msg
1206 
} {1 {wrong # arguments: must be "wm title window ?newTitle?"}}
1207 
test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} {
1208 
    set result {}
1209 
    lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
1210 
    wm title .t "Test window"
1211 
    set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
1212 
            WM_NORMAL_HINTS] 0]]]
1213 
    lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
1214 
} {t t {Test window} {Test window}}
1215 
 
1216 
test unixWm-37.1 {Tk_WmCmd procedure, "transient" option} {
1217 
    list [catch {wm transient .t 1 2} msg]  $msg
1218 
} {1 {wrong # arguments: must be "wm transient window ?master?"}}
1219 
test unixWm-37.2 {Tk_WmCmd procedure, "transient" option} {
1220 
    list [catch {wm transient .t foo} msg]  $msg
1221 
} {1 {bad window path name "foo"}}
1222 
test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} {
1223 
    set result {}
1224 
    catch {destroy .t2}
1225 
    toplevel .t2 -width 120 -height 300
1226 
    wm geometry .t2 +0+0
1227 
    update
1228 
    lappend result [wm transient .t2] \
1229 
            [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
1230 
    wm transient .t2 .t
1231 
    set transient [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
1232 
    lappend result [wm transient .t2] [expr [testwrapper .t] - $transient]
1233 
    wm transient .t2 {}
1234 
    lappend result [wm transient .t2] \
1235 
            [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
1236 
    destroy .t2
1237 
    set result
1238 
} {{} {} .t 0 {} 0x0}
1239 
test unixWm-37.4 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unixOnly} {
1240 
    catch {destroy .t2}
1241 
    catch {destroy .t3}
1242 
    toplevel .t2 -width 120 -height 300
1243 
    wm geometry .t2 +0+0
1244 
    toplevel .t3 -width 120 -height 300
1245 
    wm geometry .t2 +0+0
1246 
    set result [list [testwrapper .t2]]
1247 
    wm transient .t3 .t2
1248 
    lappend result [expr {[testwrapper .t2] == ""}]
1249 
    destroy .t2 .t3
1250 
    set result
1251 
} {{} 0}
1252 
 
1253 
test unixWm-38.1 {Tk_WmCmd procedure, "withdraw" option} {
1254 
    list [catch {wm withdraw .t 1} msg]  $msg
1255 
} {1 {wrong # arguments: must be "wm withdraw window"}}
1256 
test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} {
1257 
    catch {destroy .t2}
1258 
    toplevel .t2 -width 120 -height 300
1259 
    wm geometry .t2 +0+0
1260 
    wm iconwindow .t .t2
1261 
    set result [list [catch {wm withdraw .t2} msg]  $msg]
1262 
    destroy .t2
1263 
    set result
1264 
} {1 {can't withdraw .t2: it is an icon for .t}}
1265 
test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} {
1266 
    set result {}
1267 
    wm withdraw .t
1268 
    lappend result [wm state .t] [winfo ismapped .t]
1269 
    wm deiconify .t
1270 
    lappend result [wm state .t] [winfo ismapped .t]
1271 
} {withdrawn 0 normal 1}
1272 
 
1273 
test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} {
1274 
    list [catch {wm unknown .t} msg] $msg
1275 
} {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}}
1276 
 
1277 
catch {destroy .t}
1278 
catch {destroy .icon}
1279 
 
1280 
test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {nonPortable} {
1281 
    catch {destroy .t}
1282 
    toplevel .t
1283 
    wm geometry .t 30x10+0+0
1284 
    listbox .t.l -height 20 -width 20 -setgrid 1
1285 
    pack .t.l -fill both -expand 1
1286 
    update
1287 
    wm geometry .t
1288 
} {30x10+0+0}
1289 
test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} {
1290 
    catch {destroy .t}
1291 
    toplevel .t
1292 
    wm geometry .t 200x100+0+0
1293 
    listbox .t.l -height 20 -width 20
1294 
    pack .t.l -fill both -expand 1
1295 
    update
1296 
    .t.l configure -setgrid 1
1297 
    update
1298 
    wm geometry .t
1299 
} {20x20+0+0}
1300 
 
1301 
test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} {
1302 
    catch {destroy .t}
1303 
    toplevel .t -width 400 -height 150
1304 
    wm geometry .t +0+0
1305 
    tkwait visibility .t
1306 
    set result {}
1307 
    lappend result [winfo width .t] [winfo height .t]
1308 
    .t configure -width 200 -height 300
1309 
    sleep 500
1310 
    lappend result [winfo width .t] [winfo height .t]
1311 
} {400 150 200 300}
1312 
test unixWm-41.2 {ConfigureEvent procedure, menubars} {unixOnly} {
1313 
    catch {destroy .t}
1314 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
1315 
    wm geom .t +0+0
1316 
    update
1317 
    set x [winfo rootx .t]
1318 
    set y [winfo rooty .t]
1319 
    frame .t.m -bd 2 -relief raised -height 20
1320 
    testmenubar window .t .t.m
1321 
    update
1322 
    set result {}
1323 
    bind .t  {
1324 
        if {"%W" == ".t"} {
1325 
            lappend result "%W: %wx%h"
1326 
        }
1327 
    }
1328 
    bind .t.m  {lappend result "%W: %wx%h"}
1329 
    wm geometry .t 200x300
1330 
    update
1331 
    lappend result [expr [winfo rootx .t.m] - $x] \
1332 
            [expr [winfo rooty .t.m] - $y] \
1333 
            [winfo width .t.m] [winfo height .t.m] \
1334 
            [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] \
1335 
            [winfo width .t] [winfo height .t]
1336 
} {{.t.m: 200x20} {.t: 200x300} 0 0 200 20 0 20 200 300}
1337 
test unixWm-41.3 {ConfigureEvent procedure, synthesized Configure events} {
1338 
    catch {destroy .t}
1339 
    toplevel .t -width 400 -height 150
1340 
    wm geometry .t +0+0
1341 
    tkwait visibility .t
1342 
    set result {no event}
1343 
    bind .t  {set result "configured: %w %h"}
1344 
    wm geometry .t +10+20
1345 
    update
1346 
    set result
1347 
} {configured: 400 150}
1348 
test unixWm-41.4 {ConfigureEvent procedure, synthesized Configure events} {
1349 
    catch {destroy .t}
1350 
    toplevel .t -width 400 -height 150
1351 
    wm geometry .t +0+0
1352 
    tkwait visibility .t
1353 
    set result {no event}
1354 
    bind .t  {set result "configured: %w %h"}
1355 
    wm geometry .t 130x200
1356 
    update
1357 
    set result
1358 
} {configured: 130 200}
1359 
 
1360 
# No tests for ReparentEvent or ComputeReparentGeometry; I can't figure
1361 
# out how to exercise these procedures reliably.
1362 
 
1363 
test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} {
1364 
    catch {destroy .t}
1365 
    toplevel .t -width 400 -height 150
1366 
    wm geometry .t +0+0
1367 
    tkwait visibility .t
1368 
    set result {}
1369 
    bind .t  {set x "mapped"}
1370 
    bind .t  {set x "unmapped"}
1371 
    set x {no event}
1372 
    wm iconify .t
1373 
    lappend result $x [winfo ismapped .t]
1374 
    set x {no event}
1375 
    wm deiconify .t
1376 
    lappend result $x [winfo ismapped .t]
1377 
} {unmapped 0 mapped 1}
1378 
 
1379 
test unixWm-43.1 {TopLevelReqProc procedure, embedded in same process} {
1380 
    catch {destroy .t}
1381 
    toplevel .t -width 200 -height 200
1382 
    wm geom .t +0+0
1383 
    frame .t.f -container 1 -bd 2 -relief raised
1384 
    place .t.f -x 20 -y 10
1385 
    tkwait visibility .t.f
1386 
    toplevel .t2 -use [winfo id .t.f] -width 30 -height 20 -bg blue
1387 
    tkwait visibility .t2
1388 
    set result {}
1389 
    .t2 configure -width 70 -height 120
1390 
    update
1391 
    lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
1392 
    lappend result [winfo width .t2] [winfo height .t2]
1393 
    # destroy .t2
1394 
    set result
1395 
} {70 120 70 120}
1396 
test unixWm-43.2 {TopLevelReqProc procedure, resize causes window to move} \
1397 
        {nonPortable} {
1398 
    catch {destroy .t}
1399 
    toplevel .t -width 200 -height 200
1400 
    wm geom .t +0+0
1401 
    update
1402 
    wm geom .t -0-0
1403 
    update
1404 
    set x [winfo x .t]
1405 
    set y [winfo y .t]
1406 
    .t configure -width 300 -height 150
1407 
    update
1408 
    list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \
1409 
            [winfo width .t] [winfo height .t]
1410 
} {-100 50 300 150}
1411 
 
1412 
test unixWm-44.1 {UpdateGeometryInfo procedure, width/height computation} {
1413 
    catch {destroy .t}
1414 
    toplevel .t -width 100 -height 200
1415 
    wm geometry .t +30+40
1416 
    wm overrideredirect .t 1
1417 
    tkwait visibility .t
1418 
    .t configure  -width 180 -height 20
1419 
    update
1420 
    list [winfo width .t] [winfo height .t]
1421 
} {180 20}
1422 
test unixWm-44.2 {UpdateGeometryInfo procedure, width/height computation} {
1423 
    catch {destroy .t}
1424 
    toplevel .t -width 80 -height 60
1425 
    wm grid .t 5 4 10 12
1426 
    wm geometry .t +30+40
1427 
    wm overrideredirect .t 1
1428 
    tkwait visibility .t
1429 
    wm geometry .t 10x2
1430 
    update
1431 
    list [winfo width .t] [winfo height .t]
1432 
} {130 36}
1433 
test unixWm-44.3 {UpdateGeometryInfo procedure, width/height computation} {
1434 
    catch {destroy .t}
1435 
    toplevel .t -width 80 -height 60
1436 
    wm grid .t 5 4 10 12
1437 
    wm geometry .t +30+40
1438 
    wm overrideredirect .t 1
1439 
    tkwait visibility .t
1440 
    wm geometry .t 1x10
1441 
    update
1442 
    list [winfo width .t] [winfo height .t]
1443 
} {40 132}
1444 
test unixWm-44.4 {UpdateGeometryInfo procedure, width/height computation} {
1445 
    catch {destroy .t}
1446 
    toplevel .t -width 100 -height 200
1447 
    wm geometry .t +30+40
1448 
    wm overrideredirect .t 1
1449 
    tkwait visibility .t
1450 
    wm geometry .t 300x150
1451 
    update
1452 
    list [winfo width .t] [winfo height .t]
1453 
} {300 150}
1454 
test unixWm-44.5 {UpdateGeometryInfo procedure, negative width} {
1455 
    catch {destroy .t}
1456 
    toplevel .t -width 80 -height 60
1457 
    wm grid .t 18 7 10 12
1458 
    wm geometry .t +30+40
1459 
    wm overrideredirect .t 1
1460 
    tkwait visibility .t
1461 
    wm geometry .t 5x8
1462 
    update
1463 
    list [winfo width .t] [winfo height .t]
1464 
} {1 72}
1465 
test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} {
1466 
    catch {destroy .t}
1467 
    toplevel .t -width 80 -height 60
1468 
    wm grid .t 18 7 10 12
1469 
    wm geometry .t +30+40
1470 
    wm overrideredirect .t 1
1471 
    tkwait visibility .t
1472 
    wm geometry .t 20x1
1473 
    update
1474 
    list [winfo width .t] [winfo height .t]
1475 
} {100 1}
1476 
test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {
1477 
    catch {destroy .t}
1478 
    toplevel .t -width 80 -height 60
1479 
    wm geometry .t +5-10
1480 
    wm overrideredirect .t 1
1481 
    tkwait visibility .t
1482 
    list [winfo x .t] [winfo y .t]
1483 
} "5 [expr [winfo screenheight .t] - 70]"
1484 
test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
1485 
    catch {destroy .t}
1486 
    toplevel .t -width 80 -height 60
1487 
    wm geometry .t -30+2
1488 
    wm overrideredirect .t 1
1489 
    tkwait visibility .t
1490 
    list [winfo x .t] [winfo y .t]
1491 
} "[expr [winfo screenwidth .t] - 110] 2"
1492 
test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} {
1493 
    catch {destroy .t}
1494 
    toplevel .t -width 80 -height 60
1495 
    wm resizable .t 0 0
1496 
    wm geometry .t +0+0
1497 
    tkwait visibility .t
1498 
    .t configure  -width 180 -height 20
1499 
    update
1500 
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
1501 
    list [expr [lindex $property 5]] [expr [lindex $property 6]] \
1502 
            [expr [lindex $property 7]] [expr [lindex $property 8]]
1503 
} {180 20 180 20}
1504 
test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} {
1505 
    catch {destroy .t}
1506 
    toplevel .t -width 80 -height 60
1507 
    wm resizable .t 0 0
1508 
    wm geometry .t +0+0
1509 
    tkwait visibility .t
1510 
    .t configure -width 180 -height 50
1511 
    frame .t.m -bd 2 -relief raised -width 100 -height 50
1512 
    testmenubar window .t .t.m
1513 
    update
1514 
    .t configure -height 70
1515 
    .t.m configure -height 30
1516 
    list [update] [destroy .t]
1517 
} {{} {}}
1518 
 
1519 
test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unixOnly} {
1520 
    catch {destroy .t}
1521 
    toplevel .t -width 80 -height 60
1522 
    wm grid .t 6 10 10 5
1523 
    wm minsize .t 2 4
1524 
    wm maxsize .t 30 40
1525 
    wm geometry .t +0+0
1526 
    tkwait visibility .t
1527 
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
1528 
    list [expr [lindex $property 5]] [expr [lindex $property 6]] \
1529 
            [expr [lindex $property 7]] [expr [lindex $property 8]] \
1530 
            [expr [lindex $property 9]] [expr [lindex $property 10]]
1531 
} {40 30 320 210 10 5}
1532 
test unixWm-45.2 {UpdateSizeHints procedure} {unixOnly} {
1533 
    catch {destroy .t}
1534 
    toplevel .t -width 80 -height 60
1535 
    wm minsize .t 30 40
1536 
    wm maxsize .t 200 500
1537 
    wm geometry .t +0+0
1538 
    tkwait visibility .t
1539 
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
1540 
    list [expr [lindex $property 5]] [expr [lindex $property 6]] \
1541 
            [expr [lindex $property 7]] [expr [lindex $property 8]] \
1542 
            [expr [lindex $property 9]] [expr [lindex $property 10]]
1543 
} {30 40 200 500 1 1}
1544 
test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} {
1545 
    catch {destroy .t}
1546 
    toplevel .t -width 80 -height 60
1547 
    frame .t.menu -height 23 -width 50
1548 
    testmenubar window .t .t.menu
1549 
    wm grid .t 6 10 10 5
1550 
    wm minsize .t 2 4
1551 
    wm maxsize .t 30 40
1552 
    wm geometry .t +0+0
1553 
    tkwait visibility .t
1554 
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
1555 
    list [winfo height .t] \
1556 
            [expr [lindex $property 5]] [expr [lindex $property 6]] \
1557 
            [expr [lindex $property 7]] [expr [lindex $property 8]] \
1558 
            [expr [lindex $property 9]] [expr [lindex $property 10]]
1559 
} {60 40 53 320 233 10 5}
1560 
test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} {
1561 
    catch {destroy .t}
1562 
    toplevel .t -width 80 -height 60
1563 
    frame .t.menu -height 23 -width 50
1564 
    testmenubar window .t .t.menu
1565 
    wm resizable .t 0 0
1566 
    wm geometry .t +0+0
1567 
    tkwait visibility .t
1568 
    set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
1569 
    list [winfo height .t] \
1570 
            [expr [lindex $property 5]] [expr [lindex $property 6]] \
1571 
            [expr [lindex $property 7]] [expr [lindex $property 8]] \
1572 
            [expr [lindex $property 9]] [expr [lindex $property 10]]
1573 
} {60 80 83 80 83 1 1}
1574 
 
1575 
# I don't know how to test WaitForConfigureNotify.
1576 
 
1577 
test unixWm-46.1 {WaitForEvent procedure, use of modal timeout} {
1578 
    catch {destroy .t}
1579 
    toplevel .t -width 200 -height 200
1580 
    wm geom .t +0+0
1581 
    update
1582 
    wm iconify .t
1583 
    set x no
1584 
    after 0 {set x yes}
1585 
    wm deiconify .t
1586 
    set result $x
1587 
    update
1588 
    list $result $x
1589 
} {no yes}
1590 
 
1591 
test unixWm-47.1 {WaitRestrictProc procedure} {
1592 
    catch {destroy .t}
1593 
    toplevel .t -width 300 -height 200
1594 
    frame .t.f -bd 2 -relief raised
1595 
    place .t.f -x 20 -y 30 -width 100 -height 20
1596 
    wm geometry .t +0+0
1597 
    tkwait visibility .t
1598 
    set result {}
1599 
    bind .t.f  {lappend result {configure on .t.f}}
1600 
    bind .t  {lappend result {map on .t}}
1601 
    bind .t  {lappend result {unmap on .t}; bind .t  {}}
1602 
    bind .t
1603 
    event generate .t.f  -when tail
1604 
    event generate .t  -when tail
1605 
    event generate .t
1606 
    event generate .t  -when tail
1607 
    lappend result iconify
1608 
    wm iconify .t
1609 
    lappend result done
1610 
    update
1611 
    set result
1612 
} {iconify {unmap on .t} done {configure on .t.f} {button 3 on .t} {map on .t}}
1613 
 
1614 
# I don't know how to test WaitTimeoutProc, WaitForMapNotify, or UpdateHints.
1615 
 
1616 
catch {destroy .t}
1617 
toplevel .t -width 300 -height 200
1618 
wm geometry .t +0+0
1619 
tkwait visibility .t
1620 
 
1621 
test unixWm-48.1 {ParseGeometry procedure} {
1622 
    wm geometry .t =100x120
1623 
    update
1624 
    list [winfo width .t] [winfo height .t]
1625 
} {100 120}
1626 
test unixWm-48.2 {ParseGeometry procedure} {
1627 
    list [catch {wm geometry .t =10zx120} msg] $msg
1628 
} {1 {bad geometry specifier "=10zx120"}}
1629 
test unixWm-48.3 {ParseGeometry procedure} {
1630 
    list [catch {wm geometry .t x120} msg] $msg
1631 
} {1 {bad geometry specifier "x120"}}
1632 
test unixWm-48.4 {ParseGeometry procedure} {
1633 
    list [catch {wm geometry .t =100x120a} msg] $msg
1634 
} {1 {bad geometry specifier "=100x120a"}}
1635 
test unixWm-48.5 {ParseGeometry procedure} {
1636 
    list [catch {wm geometry .t z} msg] $msg
1637 
} {1 {bad geometry specifier "z"}}
1638 
test unixWm-48.6 {ParseGeometry procedure} {
1639 
    list [catch {wm geometry .t +20&} msg] $msg
1640 
} {1 {bad geometry specifier "+20&"}}
1641 
test unixWm-48.7 {ParseGeometry procedure} {
1642 
    list [catch {wm geometry .t +-} msg] $msg
1643 
} {1 {bad geometry specifier "+-"}}
1644 
test unixWm-48.8 {ParseGeometry procedure} {
1645 
    list [catch {wm geometry .t +20a} msg] $msg
1646 
} {1 {bad geometry specifier "+20a"}}
1647 
test unixWm-48.9 {ParseGeometry procedure} {
1648 
    list [catch {wm geometry .t +20-} msg] $msg
1649 
} {1 {bad geometry specifier "+20-"}}
1650 
test unixWm-48.10 {ParseGeometry procedure} {
1651 
    list [catch {wm geometry .t +20+10z} msg] $msg
1652 
} {1 {bad geometry specifier "+20+10z"}}
1653 
test unixWm-48.11 {ParseGeometry procedure} {
1654 
    catch {wm geometry .t +-10+20}
1655 
} {0}
1656 
test unixWm-48.12 {ParseGeometry procedure} {
1657 
    catch {wm geometry .t +30+-10}
1658 
} {0}
1659 
test unixWm-48.13 {ParseGeometry procedure, resize causes window to move} {
1660 
    catch {destroy .t}
1661 
    toplevel .t -width 200 -height 200
1662 
    wm geom .t +0+0
1663 
    update
1664 
    wm geom .t -0-0
1665 
    update
1666 
    set x [winfo x .t]
1667 
    set y [winfo y .t]
1668 
    wm geometry .t 150x300
1669 
    update
1670 
    list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \
1671 
            [winfo width .t] [winfo height .t]
1672 
} {50 -100 150 300}
1673 
 
1674 
test unixWm-49.1 {Tk_GetRootCoords procedure} {
1675 
    catch {destroy .t}
1676 
    toplevel .t -width 300 -height 200
1677 
    frame .t.f -width 150 -height 100 -bd 2 -relief raised
1678 
    place .t.f -x 150 -y 120
1679 
    frame .t.f.f -width 20 -height 20 -bd 2 -relief raised
1680 
    place .t.f.f -x 10 -y 20
1681 
    wm overrideredirect .t 1
1682 
    wm geometry .t +40+50
1683 
    tkwait visibility .t
1684 
    list [winfo rootx .t.f.f] [winfo rooty .t.f.f]
1685 
} {202 192}
1686 
test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unixOnly} {
1687 
    catch {destroy .t}
1688 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
1689 
    wm geom .t +0+0
1690 
    update
1691 
    set x [winfo rootx .t]
1692 
    set y [winfo rooty .t]
1693 
    frame .t.m -bd 2 -relief raised -width 100 -height 30
1694 
    frame .t.m.f -width 20 -height 10 -bd 2 -relief raised
1695 
    place .t.m.f -x 50 -y 5
1696 
    frame .t.f -width 20 -height 30 -bd 2 -relief raised
1697 
    place .t.f -x 10 -y 30
1698 
    testmenubar window .t .t.m
1699 
    update
1700 
    list [expr [winfo rootx .t.m.f] - $x] [expr [winfo rooty .t.m.f] - $y] \
1701 
            [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y]
1702 
} {52 7 12 62}
1703 
 
1704 
foreach w [winfo children .] {
1705 
    catch {destroy $w}
1706 
}
1707 
wm iconify .
1708 
test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} {
1709 
    eval destroy [winfo children .]
1710 
    toplevel .t -width 300 -height 400 -bg green
1711 
    wm geom .t +40+0
1712 
    tkwait visibility .t
1713 
    toplevel .t2 -width 100 -height 80 -bg red
1714 
    wm geom .t2 +140+200
1715 
    tkwait visibility .t2
1716 
    raise .t2
1717 
    set x [winfo rootx .t]
1718 
    set y [winfo rooty .t]
1719 
    list [winfo containing [expr $x - 30] [expr $y + 250]] \
1720 
            [winfo containing [expr $x - 1] [expr $y + 250]] \
1721 
            [winfo containing $x [expr $y + 250]] \
1722 
            [winfo containing [expr $x + 99] [expr $y + 250]] \
1723 
            [winfo containing [expr $x + 100] [expr $y + 250]] \
1724 
            [winfo containing [expr $x + 199] [expr $y + 250]] \
1725 
            [winfo containing [expr $x + 200] [expr $y + 250]] \
1726 
            [winfo containing [expr $x + 220] [expr $y + 250]]
1727 
} {{} {} .t {} .t2 .t2 {} .t}
1728 
test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} {
1729 
    eval destroy [winfo children .]
1730 
    toplevel .t -width 300 -height 400 -bg yellow
1731 
    wm geom .t +0+50
1732 
    tkwait visibility .t
1733 
    toplevel .t2 -width 100 -height 80 -bg blue
1734 
    wm overrideredirect .t2 1
1735 
    wm geom .t2 +100+200
1736 
    tkwait visibility .t2
1737 
    raise .t2
1738 
    set x [winfo rootx .t]
1739 
    set y [winfo rooty .t]
1740 
    set y2 [winfo rooty .t2]
1741 
    list [winfo containing [expr $x +150] 10] \
1742 
            [winfo containing [expr $x +150] [expr $y - 1]] \
1743 
            [winfo containing [expr $x +150] $y] \
1744 
            [winfo containing [expr $x +150] [expr $y2 - 1]] \
1745 
            [winfo containing [expr $x +150] $y2] \
1746 
            [winfo containing [expr $x +150] [expr $y2 + 79]] \
1747 
            [winfo containing [expr $x +150] [expr $y2 + 80]] \
1748 
            [winfo containing [expr $x +150] [expr $y + 450]]
1749 
} {{} {} .t .t .t2 .t2 .t {}}
1750 
test unixWm-50.3 {Tk_CoordsToWindow procedure, finding a toplevel with embedding} {
1751 
    eval destroy [winfo children .]
1752 
    toplevel .t -width 300 -height 400 -bg blue
1753 
    wm geom .t +0+50
1754 
    frame .t.f -container 1
1755 
    place .t.f -x 150 -y 50
1756 
    tkwait visibility .t.f
1757 
    setupbg
1758 
    dobg "
1759 
        wm withdraw .
1760 
        toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow
1761 
        tkwait visibility .x"
1762 
    set result [dobg {
1763 
        set x [winfo rootx .x]
1764 
        set y [winfo rooty .x]
1765 
        list [winfo containing [expr $x - 1] [expr $y + 50]] \
1766 
                [winfo containing $x [expr $y +50]]
1767 
    }]
1768 
    set x [winfo rootx .t]
1769 
    set y [winfo rooty .t]
1770 
    lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \
1771 
                [winfo containing [expr $x + 200] [expr $y +50]]
1772 
} {{} .x .t .t.f}
1773 
cleanupbg
1774 
test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} {
1775 
    catch {destroy .t}
1776 
    catch {interp delete slave}
1777 
    toplevel .t -width 200 -height 200 -bg green
1778 
    wm geometry .t +0+0
1779 
    tkwait visibility .t
1780 
    interp create slave
1781 
    load {} tk slave
1782 
    slave eval {wm geometry . 200x200+0+0; tkwait visibility .}
1783 
    set result [list [winfo containing 100 100] \
1784 
            [slave eval {winfo containing 100 100}]]
1785 
    interp delete slave
1786 
    set result
1787 
} {{} .}
1788 
test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unixOnly} {
1789 
    eval destroy [winfo children .]
1790 
    toplevel .t -width 300 -height 400 -bd 2 -relief raised
1791 
    frame .t.f -width 150 -height 120 -bg green
1792 
    place .t.f -x 10 -y 150
1793 
    wm geom .t +0+50
1794 
    frame .t.menu -width 100 -height 30 -bd 2 -relief raised
1795 
    frame .t.menu.f -width 40 -height 20 -bg purple
1796 
    place .t.menu.f -x 30 -y 10
1797 
    testmenubar window .t .t.menu
1798 
    tkwait visibility .t.menu
1799 
    update
1800 
    set x [winfo rootx .t]
1801 
    set y [winfo rooty .t]
1802 
    list [winfo containing $x [expr $y - 31]] \
1803 
                [winfo containing $x [expr $y - 30]] \
1804 
                [winfo containing [expr $x + 50] [expr $y - 19]] \
1805 
                [winfo containing [expr $x + 50] [expr $y - 18]] \
1806 
                [winfo containing [expr $x + 50] $y] \
1807 
                [winfo containing [expr $x + 11] [expr $y + 152]] \
1808 
                [winfo containing [expr $x + 12] [expr $y + 152]]
1809 
} {{} .t.menu .t.menu .t.menu.f .t .t .t.f}
1810 
test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} {
1811 
    eval destroy [winfo children .]
1812 
    toplevel .t -width 300 -height 400 -bg orange
1813 
    wm geom .t +0+50
1814 
    frame .t.f -container 1
1815 
    place .t.f -x 150 -y 50
1816 
    tkwait visibility .t.f
1817 
    toplevel .t2 -width 100 -height 80 -bg green -use [winfo id .t.f]
1818 
    tkwait visibility .t2
1819 
    update
1820 
    set x [winfo rootx .t]
1821 
    set y [winfo rooty .t]
1822 
    list [winfo containing [expr $x +149] [expr $y + 80]] \
1823 
            [winfo containing [expr $x +150] [expr $y +80]] \
1824 
            [winfo containing [expr $x +249] [expr $y +80]] \
1825 
            [winfo containing [expr $x +250] [expr $y +80]]
1826 
} {.t .t2 .t2 .t}
1827 
test unixWm-50.7 {Tk_CoordsToWindow procedure, more basics} {
1828 
    catch {destroy .t}
1829 
    toplevel .t -width 300 -height 400 -bg green
1830 
    wm geom .t +0+0
1831 
    frame .t.f -width 100 -height 200 -bd 2 -relief raised
1832 
    place .t.f -x 100 -y 100
1833 
    frame .t.f.f -width 100 -height 200 -bd 2 -relief raised
1834 
    place .t.f.f -x 0 -y 100
1835 
    tkwait visibility .t.f.f
1836 
    set x [expr [winfo rootx .t] + 150]
1837 
    set y [winfo rooty .t]
1838 
    list [winfo containing $x [expr $y + 50]] \
1839 
            [winfo containing $x [expr $y + 150]] \
1840 
            [winfo containing $x [expr $y + 250]] \
1841 
            [winfo containing $x [expr $y + 350]] \
1842 
            [winfo containing $x [expr $y + 450]]
1843 
} {.t .t.f .t.f.f .t {}}
1844 
test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} {
1845 
    catch {destroy .t}
1846 
    toplevel .t -width 400 -height 300 -bg green
1847 
    wm geom .t +0+0
1848 
    frame .t.f -width 200 -height 100 -bd 2 -relief raised
1849 
    place .t.f -x 100 -y 100
1850 
    frame .t.f.f -width 200 -height 100 -bd 2 -relief raised
1851 
    place .t.f.f -x 100 -y 0
1852 
    update
1853 
    set x [winfo rooty .t]
1854 
    set y [expr [winfo rooty .t] + 150]
1855 
    list [winfo containing [expr $x + 50] $y] \
1856 
            [winfo containing [expr $x + 150] $y] \
1857 
            [winfo containing [expr $x + 250] $y] \
1858 
            [winfo containing [expr $x + 350] $y] \
1859 
            [winfo containing [expr $x + 450] $y]
1860 
} {.t .t.f .t.f.f .t {}}
1861 
test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} {
1862 
    catch {destroy .t}
1863 
    catch {destroy .t2}
1864 
    sleep 500           ;# Give window manager time to catch up.
1865 
    toplevel .t -width 200 -height 200 -bg green
1866 
    wm geometry .t +0+0
1867 
    tkwait visibility .t
1868 
    toplevel .t2 -width 200 -height 200 -bg red
1869 
    wm geometry .t2 +0+0
1870 
    tkwait visibility .t2
1871 
    set result [list [winfo containing 100 100]]
1872 
    wm iconify .t2
1873 
    lappend result [winfo containing 100 100]
1874 
} {.t2 .t}
1875 
test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} {
1876 
    catch {destroy .t}
1877 
    toplevel .t -width 200 -height 200 -bg green
1878 
    wm geometry .t +0+0
1879 
    frame .t.f -width 150 -height 150 -bd 2 -relief raised
1880 
    place .t.f -x 25 -y 25
1881 
    tkwait visibility .t.f
1882 
    set result [list [winfo containing 100 100]]
1883 
    place forget .t.f
1884 
    update
1885 
    lappend result [winfo containing 100 100]
1886 
} {.t.f .t}
1887 
eval destroy [winfo children .]
1888 
wm deiconify .
1889 
 
1890 
# No tests for UpdateVRootGeometry, Tk_GetVRootGeometry,
1891 
# Tk_MoveToplevelWindow, UpdateWmProtocols, or TkWmProtocolEventProc.
1892 
 
1893 
test unixWm-51.1 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
1894 
    makeToplevels
1895 
    update
1896 
    raise .raise1
1897 
    winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
1898 
} .raise1
1899 
test unixWm-51.2 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
1900 
    makeToplevels
1901 
    update
1902 
    raise .raise2
1903 
    winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
1904 
} .raise2
1905 
test unixWm-51.3 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
1906 
    makeToplevels
1907 
    update
1908 
    raise .raise3
1909 
    raise .raise2
1910 
    raise .raise1 .raise3
1911 
    set result [winfo containing [winfo rootx .raise1] \
1912 
            [winfo rooty .raise1]]
1913 
    destroy .raise2
1914 
    sleep 500
1915 
    list $result [winfo containing [winfo rootx .raise1] \
1916 
            [winfo rooty .raise1]]
1917 
} {.raise2 .raise1}
1918 
test unixWm-51.4 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
1919 
    makeToplevels
1920 
    raise .raise2
1921 
    raise .raise1
1922 
    lower .raise3 .raise1
1923 
    set result [winfo containing 100 100]
1924 
    destroy .raise1
1925 
    sleep 500
1926 
    lappend result [winfo containing 100 100]
1927 
} {.raise1 .raise3}
1928 
test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
1929 
    makeToplevels
1930 
    update
1931 
    raise .raise2
1932 
    raise .raise1
1933 
    raise .raise3
1934 
    frame .raise1.f1
1935 
    frame .raise1.f1.f2
1936 
    lower .raise3 .raise1.f1.f2
1937 
    set result [winfo containing [winfo rootx .raise1] \
1938 
            [winfo rooty .raise1]]
1939 
    destroy .raise1
1940 
    sleep 500
1941 
    list $result [winfo containing [winfo rootx .raise2] \
1942 
            [winfo rooty .raise2]]
1943 
} {.raise1 .raise3}
1944 
foreach w [winfo children .] {
1945 
    catch {destroy $w}
1946 
}
1947 
test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} {
1948 
    catch {destroy .t}
1949 
    toplevel .t -width 200 -height 200 -bg green
1950 
    wm geometry .t +0+0
1951 
    tkwait visibility .t
1952 
    catch {destroy .t2}
1953 
    toplevel .t2 -width 200 -height 200 -bg red
1954 
    wm geometry .t2 +0+0
1955 
    winfo containing 100 100
1956 
} {.t}
1957 
test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} {
1958 
    foreach w {.t .t2 .t3} {
1959 
        catch {destroy $w}
1960 
        toplevel $w -width 200 -height 200 -bg green
1961 
        wm geometry $w +0+0
1962 
    }
1963 
    raise .t .t2
1964 
    update
1965 
    set result [list [winfo containing 100 100]]
1966 
    lower .t3
1967 
    lappend result [winfo containing 100 100]
1968 
} {.t3 .t}
1969 
test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} {
1970 
    catch {destroy .t}
1971 
    toplevel .t -width 200 -height 200 -bg green
1972 
    wm overrideredirect .t 1
1973 
    wm geometry .t +0+0
1974 
    tkwait visibility .t
1975 
    catch {destroy .t2}
1976 
    toplevel .t2 -width 200 -height 200 -bg red
1977 
    wm overrideredirect .t2 1
1978 
    wm geometry .t2 +0+0
1979 
    tkwait visibility .t2
1980 
 
1981 
    # Need to use vrootx and vrooty to make tests work correctly with
1982 
    # virtual root window measures managers: overrideredirect windows
1983 
    # come up at (0,0) in display coordinates, not virtual root
1984 
    # coordinates.
1985 
 
1986 
    set x [expr 100-[winfo vrootx .]]
1987 
    set y [expr 100-[winfo vrooty .]]
1988 
    set result [list [winfo containing $x $y]]
1989 
    raise .t
1990 
    lappend result [winfo containing $x $y]
1991 
    raise .t2
1992 
    lappend result [winfo containing $x $y]
1993 
} {.t2 .t .t2}
1994 
test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} {
1995 
    foreach w {.t .t2 .t3} {
1996 
        catch {destroy $w}
1997 
        toplevel $w -width 200 -height 200 -bg green
1998 
        wm overrideredirect $w 1
1999 
        wm geometry $w +0+0
2000 
        tkwait visibility $w
2001 
    }
2002 
    lower .t3 .t2
2003 
    update
2004 
 
2005 
    # Need to use vrootx and vrooty to make tests work correctly with
2006 
    # virtual root window measures managers: overrideredirect windows
2007 
    # come up at (0,0) in display coordinates, not virtual root
2008 
    # coordinates.
2009 
 
2010 
    set x [expr 100-[winfo vrootx .]]
2011 
    set y [expr 100-[winfo vrooty .]]
2012 
    set result [list [winfo containing $x $y]]
2013 
    lower .t2
2014 
    lappend result [winfo containing $x $y]
2015 
} {.t2 .t3}
2016 
test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
2017 
    makeToplevels
2018 
    raise .raise1
2019 
    set time [lindex [time {raise .raise1}] 0]
2020 
    expr {$time < 2000000}
2021 
} 1
2022 
test unixWm-51.11 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
2023 
    makeToplevels
2024 
    set time [lindex [time {lower .raise1}] 0]
2025 
    expr {$time < 2000000}
2026 
} 1
2027 
test unixWm-51.12 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
2028 
    makeToplevels
2029 
    set time [lindex [time {raise .raise3 .raise2}] 0]
2030 
    expr {$time < 2000000}
2031 
} 1
2032 
test unixWm-51.13 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
2033 
    makeToplevels
2034 
    set time [lindex [time {lower .raise1 .raise2}] 0]
2035 
    expr {$time < 2000000}
2036 
} 1
2037 
 
2038 
test unixWm-52.1 {TkWmAddToColormapWindows procedure} {
2039 
    catch {destroy .t}
2040 
    toplevel .t -width 200 -height 200 -colormap new -relief raised -bd 2
2041 
    wm geom .t +0+0
2042 
    update
2043 
    wm colormap .t
2044 
} {}
2045 
test unixWm-52.2 {TkWmAddToColormapWindows procedure} {
2046 
    catch {destroy .t}
2047 
    toplevel .t -colormap new -relief raised -bd 2
2048 
    wm geom .t +0+0
2049 
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
2050 
    pack .t.f
2051 
    update
2052 
    wm colormap .t
2053 
} {.t.f .t}
2054 
test unixWm-52.3 {TkWmAddToColormapWindows procedure} {
2055 
    catch {destroy .t}
2056 
    toplevel .t -colormap new
2057 
    wm geom .t +0+0
2058 
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
2059 
    pack .t.f
2060 
    frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
2061 
    pack .t.f2
2062 
    update
2063 
    wm colormap .t
2064 
} {.t.f .t.f2 .t}
2065 
test unixWm-52.4 {TkWmAddToColormapWindows procedure} {
2066 
    catch {destroy .t}
2067 
    toplevel .t -colormap new
2068 
    wm geom .t +0+0
2069 
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
2070 
    pack .t.f
2071 
    update
2072 
    wm colormapwindows .t .t.f
2073 
    frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
2074 
    pack .t.f2
2075 
    update
2076 
    wm colormapwindows .t
2077 
} {.t.f}
2078 
 
2079 
test unixWm-53.1 {TkWmRemoveFromColormapWindows procedure} {
2080 
    catch {destroy .t}
2081 
    toplevel .t -colormap new
2082 
    wm geom .t +0+0
2083 
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
2084 
    pack .t.f
2085 
    frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
2086 
    pack .t.f2
2087 
    update
2088 
    destroy .t.f2
2089 
    wm colormap .t
2090 
} {.t.f .t}
2091 
test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} {
2092 
    catch {destroy .t}
2093 
    toplevel .t -colormap new
2094 
    wm geom .t +0+0
2095 
    frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
2096 
    pack .t.f
2097 
    frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
2098 
    pack .t.f2
2099 
    update
2100 
    wm colormapwindows .t .t.f2
2101 
    destroy .t.f2
2102 
    wm colormap .t
2103 
} {}
2104 
 
2105 
test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} {
2106 
    catch {destroy .t}
2107 
    catch {destroy .m}
2108 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2109 
    bind .t  {set x exposed}
2110 
    wm geom .t +0+0
2111 
    update
2112 
    menu .m
2113 
    .m add command -label First
2114 
    .m add command -label Second
2115 
    .m add command -label Third
2116 
    .m post 30 30
2117 
    update
2118 
    set x {no event}
2119 
    destroy .m
2120 
    set x
2121 
} {no event}
2122 
test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} {
2123 
    catch {destroy .m}
2124 
    menu .m
2125 
    .m add command -label First
2126 
    .m add command -label Second
2127 
    .m add command -label Third
2128 
    .m post 30 30
2129 
    update
2130 
    set result [wm overrideredirect .m]
2131 
    destroy .m
2132 
    set result
2133 
} {1}
2134 
 
2135 
# No tests for TkGetPointerCoords, CreateWrapper, or GetMaxSize.
2136 
 
2137 
test unixWm-55.1 {TkUnixSetMenubar procedure} {unixOnly} {
2138 
    catch {destroy .t}
2139 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2140 
    wm geom .t +0+0
2141 
    update
2142 
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
2143 
    testmenubar window .t .t.f
2144 
    update
2145 
    list [winfo ismapped .t.f] [winfo geometry .t.f] \
2146 
            [expr [winfo rootx .t] - [winfo rootx .t.f]] \
2147 
            [expr [winfo rooty .t] - [winfo rooty .t.f]]
2148 
} {1 300x30+0+0 0 30}
2149 
test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unixOnly} {
2150 
    catch {destroy .t}
2151 
    catch {destroy .f}
2152 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2153 
    wm geom .t +0+0
2154 
    update
2155 
    set x [winfo rootx .t]
2156 
    set y [winfo rooty .t]
2157 
    frame .f -width 400 -height 30 -bd 2 -relief raised -bg green
2158 
    testmenubar window .t .f
2159 
    update
2160 
    testmenubar window .t {}
2161 
    update
2162 
    list [winfo ismapped .f] [winfo geometry .f] \
2163 
            [expr [winfo rootx .t] - $x] \
2164 
            [expr [winfo rooty .t] - $y] \
2165 
            [expr [winfo rootx .] - [winfo rootx .f]] \
2166 
            [expr [winfo rooty .] - [winfo rooty .f]]
2167 
} {0 300x30+0+0 0 0 0 0}
2168 
test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unixOnly} {
2169 
    catch {destroy .t}
2170 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2171 
    wm geom .t +0+0
2172 
    update
2173 
    set x [winfo rootx .t]
2174 
    set y [winfo rooty .t]
2175 
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
2176 
    testmenubar window .t .t.f
2177 
    update
2178 
    testmenubar window .t {}
2179 
    update
2180 
    set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
2181 
    .t.f configure -height 100
2182 
    update
2183 
    lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
2184 
} {0 0 0 0}
2185 
test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unixOnly} {
2186 
    catch {destroy .t}
2187 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2188 
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
2189 
    testmenubar window .t .t.f
2190 
    wm geom .t +0+0
2191 
    update
2192 
    list [winfo ismapped .t.f] [winfo geometry .t.f] \
2193 
            [expr [winfo rootx .t] - [winfo rootx .t.f]] \
2194 
            [expr [winfo rooty .t] - [winfo rooty .t.f]]
2195 
} {1 300x30+0+0 0 30}
2196 
test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unixOnly} {
2197 
    catch {destroy .t}
2198 
    catch {destroy .f}
2199 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2200 
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
2201 
    wm geom .t +0+0
2202 
    update
2203 
    set y [winfo rooty .t]
2204 
    frame .f -width 400 -height 50 -bd 2 -relief raised -bg green
2205 
    testmenubar window .t .t.f
2206 
    update
2207 
    set result {}
2208 
    lappend result [winfo ismapped .f] [winfo ismapped .t.f]
2209 
    lappend result [expr [winfo rooty .t.f] - $y]
2210 
    testmenubar window .t .f
2211 
    update
2212 
    lappend result [winfo ismapped .f] [winfo ismapped .t.f]
2213 
    lappend result [expr [winfo rooty .f] - $y]
2214 
} {0 1 0 1 0 0}
2215 
test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unixOnly} {
2216 
    catch {destroy .t}
2217 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2218 
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
2219 
    testmenubar window .t .t.f
2220 
    wm geom .t +0+0
2221 
    update
2222 
    testmenubar window .t .t.f
2223 
    update
2224 
    list [winfo ismapped .t.f] [winfo geometry .t.f] \
2225 
            [expr [winfo rootx .t] - [winfo rootx .t.f]] \
2226 
            [expr [winfo rooty .t] - [winfo rooty .t.f]]
2227 
} {1 300x30+0+0 0 30}
2228 
test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unixOnly} {
2229 
    catch {destroy .t}
2230 
    catch {destroy .f}
2231 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2232 
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
2233 
    frame .f -width 400 -height 40 -bd 2 -relief raised -bg blue
2234 
    wm geom .t +0+0
2235 
    update
2236 
    set y [winfo rooty .t]
2237 
    testmenubar window .t .t.f
2238 
    update
2239 
    set result [expr [winfo rooty .t] - $y]
2240 
    testmenubar window .t .f
2241 
    update
2242 
    lappend result [expr [winfo rooty .t] - $y]
2243 
    destroy .t.f
2244 
    update
2245 
    lappend result [expr [winfo rooty .t] - $y]
2246 
} {30 40 40}
2247 
 
2248 
test unixWm-56.1 {MenubarDestroyProc procedure} {unixOnly} {
2249 
    catch {destroy .t}
2250 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2251 
    wm geom .t +0+0
2252 
    update
2253 
    set y [winfo rooty .t]
2254 
    frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
2255 
    testmenubar window .t .t.f
2256 
    update
2257 
    set result [expr [winfo rooty .t] - $y]
2258 
    destroy .t.f
2259 
    update
2260 
    lappend result [expr [winfo rooty .t] - $y]
2261 
} {30 0}
2262 
 
2263 
test unixWm-57.1 {MenubarReqProc procedure} {unixOnly} {
2264 
    catch {destroy .t}
2265 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2266 
    wm geom .t +0+0
2267 
    update
2268 
    set x [winfo rootx .t]
2269 
    set y [winfo rooty .t]
2270 
    frame .t.f -width 400 -height 10 -bd 2 -relief raised -bg green
2271 
    testmenubar window .t .t.f
2272 
    update
2273 
    set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
2274 
    .t.f configure -height 100
2275 
    update
2276 
    lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
2277 
} {0 10 0 100}
2278 
test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} {
2279 
    catch {destroy .t}
2280 
    toplevel .t -width 300 -height 200 -bd 2 -relief raised
2281 
    wm geom .t +0+0
2282 
    update
2283 
    set x [winfo rootx .t]
2284 
    set y [winfo rooty .t]
2285 
    frame .t.f -width 400 -height 20 -bd 2 -relief raised -bg green
2286 
    testmenubar window .t .t.f
2287 
    update
2288 
    set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
2289 
    .t.f configure -height 0
2290 
    update
2291 
    lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
2292 
} {0 20 0 1}
2293 
 
2294 
# Test exit processing and cleanup:
2295 
 
2296 
test unixWm-58.1 {exit processing} {
2297 
    catch {removeFile script}
2298 
    set fd [open script w]
2299 
    puts $fd {
2300 
        update
2301 
        exit
2302 
    }
2303 
    close $fd
2304 
    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
2305 
        set error 1
2306 
    } else {
2307 
        set error 0
2308 
    }
2309 
    list $error $msg
2310 
} {0 {}}
2311 
test unixWm-58.2 {exit processing} {
2312 
    catch {removeFile script}
2313 
    set fd [open script w]
2314 
    puts $fd {
2315 
        interp create x
2316 
        x eval {set argc 2}
2317 
        x eval {set argv "-geometry 10x10+0+0"}
2318 
        x eval {load {} Tk}
2319 
        update
2320 
        exit
2321 
    }
2322 
    close $fd
2323 
    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
2324 
        set error 1
2325 
    } else {
2326 
        set error 0
2327 
    }
2328 
    list $error $msg
2329 
} {0 {}}
2330 
test unixWm-58.3 {exit processing} {
2331 
    catch {removeFile script}
2332 
    set fd [open script w]
2333 
    puts $fd {
2334 
        interp create x
2335 
        x eval {set argc 2}
2336 
        x eval {set argv "-geometry 10x10+0+0"}
2337 
        x eval {load {} Tk}
2338 
        x eval {
2339 
            button .b -text hello
2340 
            bind .b  foo
2341 
        }
2342 
        x alias foo destroy_x
2343 
        proc destroy_x {} {interp delete x}
2344 
        update
2345 
        exit
2346 
    }
2347 
    close $fd
2348 
    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
2349 
        set error 1
2350 
    } else {
2351 
        set error 0
2352 
    }
2353 
    list $error $msg
2354 
} {0 {}}
2355 
 
2356 
 
2357 
catch {destroy .t}
2358 
concat {}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.