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