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: winWm.test,v 1.9.2.4 2006/12/01 19:47:42 hobbs Exp $
13
14package require tcltest 2.1
15namespace import -force tcltest::configure
16namespace import -force tcltest::testsDirectory
17configure -testdir [file join [pwd] [file dirname [info script]]]
18configure -loadfile [file join [testsDirectory] constraints.tcl]
19tcltest::loadTestedCommands
20
21# Measure the height of a single menu line
22
23toplevel .t
24frame .t.f -width 100 -height 50
25pack .t.f
26menu .t.m
27.t.m add command -label "thisisreallylong"
28.t conf -menu .t.m
29wm geom .t -0-0
30update
31set menuheight [winfo y .t]
32.t.m add command -label "thisisreallylong"
33wm geom .t -0-0
34update
35set menuheight [expr $menuheight - [winfo y .t]]
36destroy .t
37
38test winWm-1.1 {TkWmMapWindow} {pcOnly} {
39    toplevel .t
40    wm override .t 1
41    wm geometry .t +0+0
42    update
43    set result [list [winfo rootx .t] [winfo rooty .t]]
44    destroy .t
45    set result
46} {0 0}
47test winWm-1.2 {TkWmMapWindow} {pcOnly} {
48    toplevel .t
49    wm transient .t .
50    update
51    wm iconify .
52    update
53    wm deiconify .
54    update
55    catch {wm iconify .t} msg
56    destroy .t
57    set msg
58} {can't iconify ".t": it is a transient}
59test winWm-1.3 {TkWmMapWindow} {pcOnly} {
60    toplevel .t
61    update
62    toplevel .t2
63    update
64    set result [expr [winfo x .t] != [winfo x .t2]]
65    destroy .t .t2
66    set result
67} 1
68test winWm-1.4 {TkWmMapWindow} {pcOnly} {
69    toplevel .t
70    wm geometry .t +10+10
71    update
72    toplevel .t2
73    wm geometry .t2 +40+10
74    update
75    set result [list [winfo x .t] [winfo x .t2]]
76    destroy .t .t2
77    set result
78} {10 40}
79test winWm-1.5 {TkWmMapWindow} {pcOnly} {
80    toplevel .t
81    wm iconify .t
82    update
83    set result [wm state .t]
84    destroy .t
85    set result
86} iconic
87
88test winWm-2.1 {TkpWmSetState} {pcOnly} {
89    toplevel .t
90    wm geometry .t 150x50+10+10
91    update
92    set result [wm state .t]
93    wm iconify .t
94    update
95    lappend result [wm state .t]
96    wm deiconify .t
97    update
98    lappend result [wm state .t]
99    destroy .t
100    set result
101} {normal iconic normal}
102test winWm-2.2 {TkpWmSetState} {pcOnly} {
103    toplevel .t
104    wm geometry .t 150x50+10+10
105    update
106    set result [wm state .t]
107    wm withdraw .t
108    update
109    lappend result [wm state .t]
110    wm iconify .t
111    update
112    lappend result [wm state .t]
113    wm deiconify .t
114    update 
115    lappend result [wm state .t]
116    destroy .t
117    set result
118} {normal withdrawn iconic normal}
119test winWm-2.2 {TkpWmSetState} {pcOnly} {
120    toplevel .t
121    wm geometry .t 150x50+10+10
122    update
123    set result [wm state .t]
124    wm state .t withdrawn
125    update
126    lappend result [wm state .t]
127    wm state .t iconic
128    update
129    lappend result [wm state .t]
130    wm state .t normal
131    update 
132    lappend result [wm state .t]
133    destroy .t
134    set result
135} {normal withdrawn iconic normal}
136test winWm-2.4 {TkpWmSetState} {pcOnly} {
137    set result {}
138    toplevel .t
139    wm geometry .t 150x50+10+10
140    update
141    lappend result [list [wm state .t] [wm geometry .t]]
142    wm iconify .t
143    update
144    lappend result [list [wm state .t] [wm geometry .t]]
145    wm geometry .t 200x50+10+10
146    update
147    lappend result [list [wm state .t] [wm geometry .t]]
148    wm deiconify .t
149    update
150    lappend result [list [wm state .t] [wm geometry .t]]
151    destroy .t
152    set result
153} {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}}
154
155test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {pcOnly} {
156    toplevel .t
157    wm geometry .t +0+0
158    button .t.b
159    pack .t.b
160    update
161    set x [winfo x .t.b]
162    destroy .t
163    toplevel .t
164    wm geometry .t +0+0
165    button .t.b
166    update
167    pack .t.b
168    update
169    set x [expr $x == [winfo x .t.b]]
170    destroy .t
171    set x
172} 1
173
174test winWm-4.1 {ConfigureTopLevel: menu resizing} {pcOnly} {
175    set result {}
176    toplevel .t
177    frame .t.f -width 150 -height 50 -bg red
178    pack .t.f
179    wm geometry .t -0-0
180    update
181    set y [winfo y .t]
182    menu .t.m
183    .t.m add command -label foo
184    .t conf -menu .t.m
185    update
186    set result [expr $y - [winfo y .t]]
187    destroy .t
188    set result
189} [expr $menuheight + 1]
190
191test winWm-5.1 {UpdateGeometryInfo: menu resizing} {pcOnly} {
192    set result {}
193    toplevel .t
194    frame .t.f -width 150 -height 50 -bg 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 conf -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    set result
209} {50 50 50}
210test winWm-5.2 {UpdateGeometryInfo: menu resizing} {pcOnly} {
211    set result {}
212    toplevel .t
213    frame .t.f -width 150 -height 50 -bg red
214    pack .t.f
215    wm geom .t -0-0
216    update
217    set y [winfo rooty .t]
218    lappend result [winfo height .t]
219    menu .t.m
220    .t conf -menu .t.m
221    .t.m add command -label foo
222    .t.m add command -label "thisisreallylong"
223    .t.m add command -label "thisisreallylong"
224    update
225    lappend result [winfo height .t]
226    lappend result [expr $y - [winfo rooty .t]]
227    destroy .t
228    set result
229} {50 50 0}
230
231test winWm-6.1 {wm attributes} win {
232    destroy .t
233    toplevel .t
234    wm attributes .t
235} {-alpha 1.0 -transparentcolor {} -disabled 0 -toolwindow 0 -topmost 0}
236test winWm-6.2 {wm attributes} win {
237    destroy .t
238    toplevel .t
239    wm attributes .t -disabled
240} {0}
241test winWm-6.3 {wm attributes} win {
242    # This isn't quite the correct error message yet, but it works.
243    destroy .t
244    toplevel .t
245    list [catch {wm attributes .t -foo} msg] $msg
246} {1 {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}}
247
248test winWm-6.4 {wm attributes -alpha} win {
249    # Expect this to return all 1.0 {} on pre-2K/XP
250    destroy .t
251    toplevel .t
252    set res [wm attributes .t -alpha]
253    # we don't return on set yet
254    lappend res [wm attributes .t -alpha 0.5]
255    lappend res [wm attributes .t -alpha]
256    lappend res [wm attributes .t -alpha -100]
257    lappend res [wm attributes .t -alpha]
258    lappend res [wm attributes .t -alpha 100]
259    lappend res [wm attributes .t -alpha]
260    set res
261} {1.0 {} 0.5 {} 0.0 {} 1.0}
262
263test winWm-6.5 {wm attributes -alpha} win {
264    destroy .t
265    toplevel .t
266    list [catch {wm attributes .t -alpha foo} msg] $msg
267} {1 {expected floating-point number but got "foo"}}
268
269test winWm-6.6 {wm attributes -alpha} win {
270    # This test is just to show off -alpha
271    destroy .t
272    toplevel .t
273    wm attributes .t -alpha 0.2
274    pack [label .t.l -text "Alpha Toplevel" -font "Helvetica 18 bold"]
275    tk::PlaceWindow .t center
276    update
277    if {$::tcl_platform(osVersion) >= 5.0} {
278	for {set i 0.2} {$i < 0.99} {set i [expr {$i+0.02}]} {
279	    wm attributes .t -alpha $i
280	    update idle
281	    after 20
282	}
283	for {set i 0.99} {$i > 0.2} {set i [expr {$i-0.02}]} {
284	    wm attributes .t -alpha $i
285	    update idle
286	    after 20
287	}
288    }
289} {}
290
291test winWm-6.7 {wm attributes -transparentcolor} win {
292    # Expect this to return all "" on pre-2K/XP
293    destroy .t
294    toplevel .t
295    set res {}
296    lappend res [wm attributes .t -transparentcolor]
297    # we don't return on set yet
298    lappend res [wm attributes .t -trans black]
299    lappend res [wm attributes .t -trans]
300    lappend res [wm attributes .t -trans "#FFFFFF"]
301    lappend res [wm attributes .t -trans]
302    destroy .t
303    set res
304} [list {} {} black {} "#FFFFFF"]
305
306test winWm-6.8 {wm attributes -transparentcolor} win {
307    destroy .t
308    toplevel .t
309    list [catch {wm attributes .t -tr foo} msg] $msg
310} {1 {unknown color name "foo"}}
311
312test winWm-7.1 {deiconify on an unmapped toplevel
313        will raise the window and set the focus} {pcOnly} {
314    destroy .t
315    toplevel .t
316    lower .t
317    focus -force .
318    wm deiconify .t
319    update
320    list [wm stackorder .t isabove .] [focus]
321} {1 .t}
322
323test winWm-7.2 {deiconify on an already mapped toplevel
324        will raise the window and set the focus} {pcOnly} {
325    destroy .t
326    toplevel .t
327    lower .t
328    update
329    focus -force .
330    wm deiconify .t
331    update
332    list [wm stackorder .t isabove .] [focus]
333} {1 .t}
334
335test winWm-7.3 {UpdateWrapper must maintain Z order} win {
336    destroy .t
337    toplevel .t
338    lower .t
339    update
340    set res [wm stackorder .t isbelow .]
341    wm resizable .t 0 0
342    update
343    list $res [wm stackorder .t isbelow .]
344} {1 1}
345
346test winWm-7.4 {UpdateWrapper must maintain focus} win {
347    destroy .t
348    toplevel .t
349    focus -force .t
350    update
351    set res [focus]
352    wm resizable .t 0 0
353    update
354    list $res [focus]
355} {.t .t}
356
357test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} win {
358    list [catch {wm iconph .} msg] $msg
359} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}}
360test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} win {
361    destroy .t
362    toplevel .t
363    image create photo blank16 -width 16 -height 16
364    image create photo blank32 -width 32 -height 32
365    # This should just make blank icons for the window
366    wm iconphoto .t blank16 blank32
367    image delete blank16 blank32
368} {}
369
370destroy .t
371
372# cleanup
373::tcltest::cleanupTests
374return
375