1# This file tests  is a Tcl script to test the procedures in the file
2# tkWinWm.c.  It is organized in the standard fashion for Tcl tests.
3#
4# This file contains a collection of tests for one or more of the Tcl
5# built-in commands.  Sourcing this file into Tcl runs the tests and
6# generates output for errors.  No output means no errors were found.
7#
8# Copyright (c) 1996 by Sun Microsystems, Inc.
9# Copyright (c) 1998-1999 by Scriptics Corporation.
10# All rights reserved.
11#
12# RCS: @(#) $Id$
13
14package require tcltest 2.1
15eval tcltest::configure $argv
16tcltest::loadTestedCommands
17
18# Measure the height of a single menu line
19
20toplevel .t
21frame .t.f -width 100 -height 50
22pack .t.f
23menu .t.m
24.t.m add command -label "thisisreallylong"
25.t configure -menu .t.m
26wm geometry .t -0-0
27update
28set menuheight [winfo y .t]
29.t.m add command -label "thisisreallylong"
30wm geometry .t -0-0
31update
32set menuheight [expr {$menuheight - [winfo y .t]}]
33destroy .t
34
35test winWm-1.1 {TkWmMapWindow} win {
36    toplevel .t
37    wm override .t 1
38    wm geometry .t +0+0
39    update
40    set result [list [winfo rootx .t] [winfo rooty .t]]
41    destroy .t
42    set result
43} {0 0}
44test winWm-1.2 {TkWmMapWindow} win {
45    toplevel .t
46    wm transient .t .
47    update
48    wm iconify .
49    update
50    wm deiconify .
51    update
52    catch {wm iconify .t} msg
53    destroy .t
54    set msg
55} {can't iconify ".t": it is a transient}
56test winWm-1.3 {TkWmMapWindow} win {
57    toplevel .t
58    update
59    toplevel .t2
60    update
61    set result [expr {[winfo x .t] != [winfo x .t2]}]
62    destroy .t .t2
63    set result
64} 1
65test winWm-1.4 {TkWmMapWindow} win {
66    toplevel .t
67    wm geometry .t +10+10
68    update
69    toplevel .t2
70    wm geometry .t2 +40+10
71    update
72    set result [list [winfo x .t] [winfo x .t2]]
73    destroy .t .t2
74    set result
75} {10 40}
76test winWm-1.5 {TkWmMapWindow} win {
77    toplevel .t
78    wm iconify .t
79    update
80    set result [wm state .t]
81    destroy .t
82    set result
83} iconic
84
85test winWm-2.1 {TkpWmSetState} win {
86    toplevel .t
87    wm geometry .t 150x50+10+10
88    update
89    set result [wm state .t]
90    wm iconify .t
91    update
92    lappend result [wm state .t]
93    wm deiconify .t
94    update
95    lappend result [wm state .t]
96    destroy .t
97    set result
98} {normal iconic normal}
99test winWm-2.2 {TkpWmSetState} win {
100    toplevel .t
101    wm geometry .t 150x50+10+10
102    update
103    set result [wm state .t]
104    wm withdraw .t
105    update
106    lappend result [wm state .t]
107    wm iconify .t
108    update
109    lappend result [wm state .t]
110    wm deiconify .t
111    update 
112    lappend result [wm state .t]
113    destroy .t
114    set result
115} {normal withdrawn iconic normal}
116test winWm-2.3 {TkpWmSetState} win {
117    toplevel .t
118    wm geometry .t 150x50+10+10
119    update
120    set result [wm state .t]
121    wm state .t withdrawn
122    update
123    lappend result [wm state .t]
124    wm state .t iconic
125    update
126    lappend result [wm state .t]
127    wm state .t normal
128    update 
129    lappend result [wm state .t]
130    destroy .t
131    set result
132} {normal withdrawn iconic normal}
133test winWm-2.4 {TkpWmSetState} win {
134    set result {}
135    toplevel .t
136    wm geometry .t 150x50+10+10
137    update
138    lappend result [list [wm state .t] [wm geometry .t]]
139    wm iconify .t
140    update
141    lappend result [list [wm state .t] [wm geometry .t]]
142    wm geometry .t 200x50+10+10
143    update
144    lappend result [list [wm state .t] [wm geometry .t]]
145    wm deiconify .t
146    update
147    lappend result [list [wm state .t] [wm geometry .t]]
148    destroy .t
149    set result
150} {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}}
151
152test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win {
153    toplevel .t
154    wm geometry .t +0+0
155    button .t.b
156    pack .t.b
157    update
158    set x [winfo x .t.b]
159    destroy .t
160    toplevel .t
161    wm geometry .t +0+0
162    button .t.b
163    update
164    pack .t.b
165    update
166    set x [expr {$x == [winfo x .t.b]}]
167    destroy .t
168    set x
169} 1
170
171test winWm-4.1 {ConfigureTopLevel: menu resizing} win {
172    set result {}
173    toplevel .t
174    frame .t.f -width 150 -height 50 -background red
175    pack .t.f
176    wm geometry .t -0-0
177    update
178    set y [winfo y .t]
179    menu .t.m
180    .t.m add command -label foo
181    .t configure -menu .t.m
182    update
183    set result [expr {$y - [winfo y .t]}]
184    destroy .t
185    set result
186} [expr {$menuheight + 1}]
187
188# This test works on 8.0p2 but has not worked on anything since 8.2.
189# It would be very strange to have a windows application increase the size
190# of the clientarea when a menu wraps so I believe this test to be wrong.
191# Original result was {50 50 50} new result may depend on the default menu
192# font
193test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
194    set result {}
195    toplevel .t
196    frame .t.f -width 150 -height 50 -background red
197    pack .t.f
198    update
199    set result [winfo height .t]
200    menu .t.m
201    .t.m add command -label foo
202    .t configure -menu .t.m
203    update
204    lappend result [winfo height .t]
205    .t.m add command -label "thisisreallylong"
206    .t.m add command -label "thisisreallylong"
207    update
208    lappend result [winfo height .t]
209    destroy .t
210    
211    set result
212} {50 50 31}
213test winWm-5.2 {UpdateGeometryInfo: menu resizing} win {
214    set result {}
215    toplevel .t
216    frame .t.f -width 150 -height 50 -background red
217    pack .t.f
218    wm geometry .t -0-0
219    update
220    set y [winfo rooty .t]
221    lappend result [winfo height .t]
222    menu .t.m
223    .t configure -menu .t.m
224    .t.m add command -label foo
225    .t.m add command -label "thisisreallylong"
226    .t.m add command -label "thisisreallylong"
227    update
228    lappend result [winfo height .t]
229    lappend result [expr {$y - [winfo rooty .t]}]
230    destroy .t
231    set result
232} {50 50 0}
233
234test winWm-6.1 {wm attributes} win {
235    destroy .t
236    toplevel .t
237    wm attributes .t
238} {-alpha 1.0 -transparentcolor {} -disabled 0 -fullscreen 0 -toolwindow 0 -topmost 0}
239test winWm-6.2 {wm attributes} win {
240    destroy .t
241    toplevel .t
242    wm attributes .t -disabled
243} {0}
244test winWm-6.3 {wm attributes} win {
245    # This isn't quite the correct error message yet, but it works.
246    destroy .t
247    toplevel .t
248    list [catch {wm attributes .t -foo} msg] $msg
249} {1 {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}}
250
251test winWm-6.4 {wm attributes -alpha} win {
252    # Expect this to return all 1.0 {} on pre-2K/XP
253    destroy .t
254    toplevel .t
255    set res [wm attributes .t -alpha]
256    # we don't return on set yet
257    lappend res [wm attributes .t -alpha 0.5]
258    lappend res [wm attributes .t -alpha]
259    lappend res [wm attributes .t -alpha -100]
260    lappend res [wm attributes .t -alpha]
261    lappend res [wm attributes .t -alpha 100]
262    lappend res [wm attributes .t -alpha]
263    set res
264} {1.0 {} 0.5 {} 0.0 {} 1.0}
265
266test winWm-6.5 {wm attributes -alpha} win {
267    destroy .t
268    toplevel .t
269    list [catch {wm attributes .t -alpha foo} msg] $msg
270} {1 {expected floating-point number but got "foo"}}
271
272test winWm-6.6 {wm attributes -alpha} win {
273    # This test is just to show off -alpha
274    destroy .t
275    toplevel .t
276    wm attributes .t -alpha 0.2
277    pack [label .t.l -text "Alpha Toplevel" -font "Helvetica 18 bold"]
278    tk::PlaceWindow .t center
279    update
280    if {$::tcl_platform(osVersion) >= 5.0} {
281	for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} {
282	    wm attributes .t -alpha $i
283	    update idle
284	    after 20
285	}
286	for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} {
287	    wm attributes .t -alpha $i
288	    update idle
289	    after 20
290	}
291    }
292} {}
293
294test winWm-6.7 {wm attributes -transparentcolor} win {
295    # Expect this to return all "" on pre-2K/XP
296    destroy .t
297    toplevel .t
298    set res {}
299    lappend res [wm attributes .t -transparentcolor]
300    # we don't return on set yet
301    lappend res [wm attributes .t -trans black]
302    lappend res [wm attributes .t -trans]
303    lappend res [wm attributes .t -trans "#FFFFFF"]
304    lappend res [wm attributes .t -trans]
305    destroy .t
306    set res
307} [list {} {} black {} "#FFFFFF"]
308
309test winWm-6.8 {wm attributes -transparentcolor} win {
310    destroy .t
311    toplevel .t
312    list [catch {wm attributes .t -tr foo} msg] $msg
313} {1 {unknown color name "foo"}}
314
315test winWm-7.1 {deiconify on an unmapped toplevel\
316        will raise the window and set the focus} win {
317    destroy .t
318    toplevel .t
319    lower .t
320    focus -force .
321    wm deiconify .t
322    update
323    list [wm stackorder .t isabove .] [focus]
324} {1 .t}
325
326test winWm-7.2 {deiconify on an already mapped toplevel\
327        will raise the window and set the focus} win {
328    destroy .t
329    toplevel .t
330    lower .t
331    update
332    focus -force .
333    wm deiconify .t
334    update
335    list [wm stackorder .t isabove .] [focus]
336} {1 .t}
337
338test winWm-7.3 {UpdateWrapper must maintain Z order} win {
339    destroy .t
340    toplevel .t
341    lower .t
342    update
343    set res [wm stackorder .t isbelow .]
344    wm resizable .t 0 0
345    update
346    list $res [wm stackorder .t isbelow .]
347} {1 1}
348
349test winWm-7.4 {UpdateWrapper must maintain focus} win {
350    destroy .t
351    toplevel .t
352    focus -force .t
353    update
354    set res [focus]
355    wm resizable .t 0 0
356    update
357    list $res [focus]
358} {.t .t}
359
360test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} win {
361    list [catch {wm iconph .} msg] $msg
362} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}}
363test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} win {
364    destroy .t
365    toplevel .t
366    image create photo blank16 -width 16 -height 16
367    image create photo blank32 -width 32 -height 32
368    # This should just make blank icons for the window
369    wm iconphoto .t blank16 blank32
370    image delete blank16 blank32
371} {}
372
373test winWm-9.0 "Bug #2799589 - delayed activation of destroyed window" -constraints win -setup {
374    proc winwm90click {w} {
375        if {![winfo ismapped $w]} { update }
376        event generate $w <Enter>
377        focus -force $w
378        event generate $w <ButtonPress-1> -x 5 -y 5
379        event generate $w <ButtonRelease-1> -x 5 -y 5
380    }
381    proc winwm90proc3 {} {
382        global winwm90done winwm90check
383        set w .sd
384        toplevel $w
385        pack [button $w.b -text "OK" -command {set winwm90check 1}]
386        bind $w.b <Map> {after idle {winwm90click %W}}
387        update idletasks
388        tkwait visibility $w
389        grab $w
390        tkwait variable winwm90check
391        grab release $w
392        destroy $w
393        after idle {set winwm90done ok}
394    }
395    proc winwm90proc2 {w} { winwm90proc3; destroy $w }
396    proc winwm90proc1 {w} {
397        toplevel $w
398        pack [button $w.b -text "Do dialog" -command [list winwm90proc2 $w]]
399        bind $w.b <Map> {bind %W <Map> {}; after idle {winwm90click %W}}
400    }
401    destroy .t
402    global winwm90done
403    set winwm90done wait
404    toplevel .t
405} -body {    
406    pack [button .t.b -text "Show" -command {winwm90proc1 .tx}]
407    bind .t.b <Map> {bind %W <Map> {}; after idle {winwm90click %W}}
408    after 5000 {set winwm90done timeout}
409    vwait winwm90done
410    set winwm90done
411} -cleanup {
412    foreach cmd {proc1 proc2 proc3 click} {
413        rename winwm90$cmd {}
414    }
415    destroy .tx .t .sd
416} -result {ok}
417
418test winWm-9.1 "delayed activation of grabbed destroyed window" -constraints win -setup {
419    proc winwm91click {w} {
420        if {![winfo ismapped $w]} { update }
421        event generate $w <Enter>
422        focus -force $w
423        event generate $w <ButtonPress-1> -x 5 -y 5
424        event generate $w <ButtonRelease-1> -x 5 -y 5
425    }
426    proc winwm91proc3 {} {
427        global winwm91done winwm91check
428        set w .sd
429        toplevel $w
430        pack [button $w.b -text "OK" -command {set winwm91check 1}]
431        bind $w.b <Map> {after idle {winwm91click %W}}
432        update idletasks
433        tkwait visibility $w
434        grab $w
435        tkwait variable winwm91check
436        #skip the release:  #grab release $w
437        destroy $w
438        after idle {set winwm91done ok}
439    }
440    proc winwm91proc2 {w} { winwm91proc3; destroy $w }
441    proc winwm91proc1 {w} {
442        toplevel $w
443        pack [button $w.b -text "Do dialog" -command [list winwm91proc2 $w]]
444        bind $w.b <Map> {bind %W <Map> {}; after idle {winwm91click %W}}
445    }
446    destroy .t
447    global winwm91done
448    set winwm91done wait
449    toplevel .t
450} -body {    
451    pack [button .t.b -text "Show" -command {winwm91proc1 .tx}]
452    bind .t.b <Map> {bind %W <Map> {}; after idle {winwm91click %W}}
453    after 5000 {set winwm91done timeout}
454    vwait winwm91done
455    set winwm91done
456} -cleanup {
457    foreach cmd {proc1 proc2 proc3 click} {
458        rename winwm91$cmd {}
459    }
460    destroy .tx .t .sd
461} -result {ok}
462
463destroy .t
464
465# cleanup
466cleanupTests
467return
468
469# Local variables:
470# mode: tcl
471# End:
472