1# This file is a Tcl script to test out the procedures in the file 
2# tkMacEmbed.c.  It is organized in the standard fashion for Tcl
3# tests.
4#
5# Copyright (c) 1997 Sun Microsystems, Inc.
6# Copyright (c) 1998-1999 by Scriptics Corporation.
7# All rights reserved.
8#
9# RCS: @(#) $Id: macEmbed.test,v 1.8 2002/07/14 05:48:46 dgp Exp $
10
11package require tcltest 2.1
12namespace import -force tcltest::configure
13namespace import -force tcltest::testsDirectory
14configure -testdir [file join [pwd] [file dirname [info script]]]
15configure -loadfile [file join [testsDirectory] constraints.tcl]
16tcltest::loadTestedCommands
17
18test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} {
19    catch {destroy .t}
20    list [catch {toplevel .t -use xyz} msg] $msg
21} {1 {expected integer but got "xyz"}}
22test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {macOnly} {
23    catch {destroy .t}
24    list [catch {toplevel .t -use 47} msg] $msg
25} {1 {The window ID 47 does not correspond to a valid Tk Window.}}
26
27test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {testembed macOnly} {
28    deleteWindows
29    frame .f1 -container 1 -width 200 -height 50
30    frame .f2 -container 1 -width 200 -height 50
31    pack .f1 .f2
32    set w [winfo id .f1]
33	toplevel .t -use $w
34	list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w]
35} {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0}
36test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {testembed macOnly} {
37    deleteWindows
38    frame .f1 -container 1 -width 200 -height 50
39    frame .f2 -container 1 -width 200 -height 50
40    pack .f1 .f2
41    set w1 [winfo id .f1]
42    set w2 [winfo id .f2]
43	toplevel .t1 -use $w1
44	toplevel .t2 -use $w2
45	testembed
46} {{XXX .f2 XXX .t2} {XXX .f1 XXX .t1}}
47
48# Can't think of any way to test the procedures TkpMakeWindow,
49# TkpMakeContainer, or EmbedErrorProc.
50
51test macEmbed-2.1 {EmbeddedEventProc procedure} {testembed macOnly} {
52    deleteWindows
53    frame .f1 -container 1 -width 200 -height 50
54    pack .f1
55    set w1 [winfo id .f1]
56	toplevel .t1 -use $w1
57	testembed
58    destroy .t1
59    update
60	testembed
61} {}
62test macEmbed-2.2 {EmbeddedEventProc procedure} {testembed macOnly} {
63    deleteWindows
64    frame .f1 -container 1 -width 200 -height 50
65    pack .f1
66    toplevel .t1 -use [winfo id .f1]
67    update
68    destroy .f1
69    testembed
70} {}
71test macEmbed-2.3 {EmbeddedEventProc procedure} {testembed macOnly} {
72    deleteWindows
73    frame .f1 -container 1 -width 200 -height 50
74    pack .f1
75    toplevel .t1 -use [winfo id .f1]
76    update
77    destroy .t1
78    update
79    list [testembed] [winfo children .]
80} {{} {}}
81
82test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {testembed macOnly} {
83    deleteWindows
84    frame .f1 -container 1 -width 200 -height 50
85    pack .f1
86    set w1 [winfo id .f1]
87    set x [testembed]
88	toplevel .t1 -use $w1
89	wm withdraw .t1
90    list $x [testembed]
91} {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
92test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
93	{macOnly} {
94    deleteWindows
95    frame .f1 -container 1 -width 200 -height 50
96    pack .f1
97    set w1 [winfo id .f1]
98	toplevel .t1 -use $w1 -bd 2 -relief raised
99	update
100	wm geometry .t1 +30+40
101    update
102	wm geometry .t1
103} {200x200+0+0}
104test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
105	{macOnly} {
106    deleteWindows
107    frame .f1 -container 1 -width 200 -height 50
108    pack .f1
109    set w1 [winfo id .f1]
110	toplevel .t1 -use $w1
111	update
112	wm geometry .t1 300x100+30+40
113    update
114	wm geometry .t1
115} {300x100+0+0}
116test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
117    deleteWindows
118    toplevel .t1 -container 1 -width 200 -height 50
119    set w1 [winfo id .t1]
120	toplevel .t2 -use $w1
121    update
122	.t1 configure -width 300 -height 80
123    update
124    list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
125} {300 80 300x80+0+0}
126test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
127    deleteWindows
128    frame .f1 -container 1 -width 200 -height 50
129    pack .f1
130    set w1 [winfo id .f1]
131	toplevel .t1 -use $w1
132	set x unmapped
133	bind .t1 <Map> {set x mapped}
134    update
135	after 100
136	update
137	set x
138} {mapped}
139test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
140    deleteWindows
141    frame .f1 -container 1 -width 200 -height 50
142    pack .f1
143    set w1 [winfo id .f1]
144    bind .f1 <Destroy> {set x dead}
145    set x alive
146	toplevel .t1 -use $w1
147    update
148	destroy .t1
149    update
150    list $x [winfo exists .f1]
151} {dead 0}
152
153test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
154    deleteWindows
155    frame .f1 -container 1 -width 200 -height 50
156    pack .f1
157    set w1 [winfo id .f1]
158	toplevel .t1 -use $w1
159    update
160	.t1 configure -width 180 -height 100
161    update
162	winfo geometry .t1
163} {180x100+0+0}
164test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {testembed macOnly} {
165    deleteWindows
166    frame .f1 -container 1 -width 200 -height 50
167    pack .f1
168    set w1 [winfo id .f1]
169	toplevel .t1 -use $w1
170    update
171    set x [testembed]
172    destroy .f1
173    list $x [testembed]
174} {{{XXX .f1 XXX .t1}} {}}
175
176# Can't think up any tests for TkpGetOtherWindow procedure.
177
178test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
179    catch {interp delete child}
180    deleteWindows
181    frame .f1 -container 1 -width 200 -height 50
182    frame .f2 -width 200 -height 50
183    pack .f1 .f2
184    interp create child
185    child eval "set argv {-use [winfo id .f1]}"
186    load {} Tk child
187    child eval {
188	. configure -bd 2 -highlightthickness 2 -relief sunken
189    }
190    focus -force .f2
191    update
192    list [child eval {
193	focus .
194	set x [list [focus]]
195	update
196	lappend x [focus]
197    }] [focus]
198} {{{} .} .f1}
199catch {interp delete child}
200
201test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {testembed macOnly} {
202    deleteWindows
203    frame .f1 -container 1 -width 200 -height 50
204    frame .f2 -container 1 -width 200 -height 50
205    frame .f3 -container 1 -width 200 -height 50
206    frame .f4 -container 1 -width 200 -height 50
207    pack .f1 .f2 .f3 .f4
208    set x {}
209    lappend x [testembed]
210    foreach w {.f3 .f4 .f1 .f2} {
211	destroy $w
212	lappend x [testembed]
213    }
214    set x
215} {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
216test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {testembed macOnly} {
217    deleteWindows
218    frame .f1 -container 1 -width 200 -height 50
219    pack .f1
220    set w1 [winfo id .f1]
221	toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
222	set x {}
223	lappend x [testembed]
224	destroy .t1
225	update
226	lappend x [testembed]
227} {{{XXX .f1 XXX .t1}} {}}
228
229test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
230    deleteWindows
231    frame .f1 -container 1 -width 200 -height 50
232    pack .f1
233    toplevel .t1 -use [winfo id .f1] -width 150 -height 80
234    update
235    wm geometry .t1 +40+50
236    update
237    wm geometry .t1
238} {150x80+0+0}
239test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
240    deleteWindows
241    frame .f1 -container 1 -width 200 -height 50
242    pack .f1
243    toplevel .t1 -use [winfo id .f1] -width 150 -height 80
244    update
245    wm geometry .t1 70x300+10+20
246    update
247    wm geometry .t1
248} {70x300+0+0}
249
250
251
252deleteWindows
253
254# cleanup
255::tcltest::cleanupTests
256return
257
258
259
260
261
262
263
264
265
266
267
268
269
270