← Back to branch summary

~ubuntu-branches/ubuntu/dapper/tk8.0/dapper-updates

« back to all changes in this revision

Viewing changes to tests/raise.test

  • Committer: Bazaar Package Importer
  • Author(s): Mike Markley
  • Date: 2001-07-24 21:57:40 UTC
  • Revision ID: james.westby@ubuntu.com-20010724215740-r70t25rtmbqjil2h
Tags: upstream-8.0.5
Import upstream version 8.0.5

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/raise.test
 
1
# This file is a Tcl script to test out Tk's "raise" and
 
2
# "lower" commands, plus associated code to manage window
 
3
# stacking order.  It is organized in the standard fashion
 
4
# for Tcl tests.
 
5
#
 
6
# Copyright (c) 1993-1994 The Regents of the University of California.
 
7
# Copyright (c) 1994 Sun Microsystems, Inc.
 
8
#
 
9
# See the file "license.terms" for information on usage and redistribution
 
10
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
11
#
 
12
# RCS: @(#) $Id: raise.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
 
13
 
 
14
if {[info commands testmakeexist] == {}} {
 
15
    puts "This application hasn't been compiled with the \"testmakeexist\""
 
16
    puts "command, so I can't run this test.  Are you sure you're using"
 
17
    puts "tktest instead of wish?"
 
18
    return
 
19
}
 
20
 
 
21
if {[string compare test [info procs test]] == 1} then \
 
22
  {source defs}
 
23
 
 
24
# Procedure to create a bunch of overlapping windows, which should
 
25
# make it easy to detect differences in order.
 
26
 
 
27
proc raise_setup {} {
 
28
    foreach i [winfo child .raise] {
 
29
        destroy $i
 
30
    }
 
31
    foreach i {a b c d e} {
 
32
        label .raise.$i -text $i -relief raised -bd 2
 
33
    }
 
34
    place .raise.a -x 20 -y 60 -width 60 -height 80
 
35
    place .raise.b -x 60 -y 60 -width 60 -height 80
 
36
    place .raise.c -x 100 -y 60 -width 60 -height 80
 
37
    place .raise.d -x 40 -y 20 -width 100 -height 60
 
38
    place .raise.e -x 40 -y 120 -width 100 -height 60
 
39
}
 
40
 
 
41
# Procedure to return information about which windows are on top
 
42
# of which other windows.
 
43
 
 
44
proc raise_getOrder {} {
 
45
    set x [winfo rootx .raise]
 
46
    set y [winfo rooty .raise]
 
47
    list [winfo name [winfo containing [expr $x+50] [expr $y+70]]] \
 
48
            [winfo name [winfo containing [expr $x+90] [expr $y+70]]] \
 
49
            [winfo name [winfo containing [expr $x+130] [expr $y+70]]] \
 
50
            [winfo name [winfo containing [expr $x+70] [expr $y+100]]] \
 
51
            [winfo name [winfo containing [expr $x+110] [expr $y+100]]] \
 
52
            [winfo name [winfo containing [expr $x+50] [expr $y+130]]] \
 
53
            [winfo name [winfo containing [expr $x+90] [expr $y+130]]] \
 
54
            [winfo name [winfo containing [expr $x+130] [expr $y+130]]]
 
55
}
 
56
 
 
57
# Procedure to set up a collection of top-level windows
 
58
 
 
59
proc raise_makeToplevels {} {
 
60
    foreach i [winfo child .] {
 
61
        destroy $i
 
62
    }
 
63
    foreach i {.raise1 .raise2 .raise3} {
 
64
        toplevel $i
 
65
        wm geom $i 150x100+0+0
 
66
        update
 
67
    }
 
68
}
 
69
 
 
70
foreach i [winfo child .] {
 
71
    destroy $i
 
72
}
 
73
toplevel .raise
 
74
wm geom .raise 250x200+0+0
 
75
 
 
76
test raise-1.1 {preserve creation order} {
 
77
    raise_setup
 
78
    update
 
79
    raise_getOrder
 
80
} {d d d b c e e e}
 
81
test raise-1.2 {preserve creation order} {
 
82
    raise_setup
 
83
    testmakeexist .raise.a
 
84
    update
 
85
    raise_getOrder
 
86
} {d d d b c e e e}
 
87
test raise-1.3 {preserve creation order} {
 
88
    raise_setup
 
89
    testmakeexist .raise.c
 
90
    update
 
91
    raise_getOrder
 
92
} {d d d b c e e e}
 
93
test raise-1.4 {preserve creation order} {
 
94
    raise_setup
 
95
    testmakeexist .raise.e
 
96
    update
 
97
    raise_getOrder
 
98
} {d d d b c e e e}
 
99
test raise-1.5 {preserve creation order} {
 
100
    raise_setup
 
101
    testmakeexist .raise.d .raise.c .raise.b
 
102
    update
 
103
    raise_getOrder
 
104
} {d d d b c e e e}
 
105
 
 
106
test raise-2.1 {raise internal windows before creation} {
 
107
    raise_setup
 
108
    raise .raise.a
 
109
    update
 
110
    raise_getOrder
 
111
} {a d d a c a e e}
 
112
test raise-2.2 {raise internal windows before creation} {
 
113
    raise_setup
 
114
    raise .raise.c
 
115
    update
 
116
    raise_getOrder
 
117
} {d d c b c e e c}
 
118
test raise-2.3 {raise internal windows before creation} {
 
119
    raise_setup
 
120
    raise .raise.e
 
121
    update
 
122
    raise_getOrder
 
123
} {d d d b c e e e}
 
124
test raise-2.4 {raise internal windows before creation} {
 
125
    raise_setup
 
126
    raise .raise.e .raise.a
 
127
    update
 
128
    raise_getOrder
 
129
} {d d d b c e b c}
 
130
test raise-2.5 {raise internal windows before creation} {
 
131
    raise_setup
 
132
    raise .raise.a .raise.d
 
133
    update
 
134
    raise_getOrder
 
135
} {a d d a c e e e}
 
136
 
 
137
test raise-3.1 {raise internal windows after creation} {
 
138
    raise_setup
 
139
    update
 
140
    raise .raise.a .raise.d
 
141
    raise_getOrder
 
142
} {a d d a c e e e}
 
143
test raise-3.2 {raise internal windows after creation} {
 
144
    raise_setup
 
145
    testmakeexist .raise.a .raise.b
 
146
    raise .raise.a .raise.b
 
147
    update
 
148
    raise_getOrder
 
149
} {d d d a c e e e}
 
150
test raise-3.3 {raise internal windows after creation} {
 
151
    raise_setup
 
152
    testmakeexist .raise.a .raise.d
 
153
    raise .raise.a .raise.b
 
154
    update
 
155
    raise_getOrder
 
156
} {d d d a c e e e}
 
157
test raise-3.4 {raise internal windows after creation} {
 
158
    raise_setup
 
159
    testmakeexist .raise.a .raise.c .raise.d
 
160
    raise .raise.a .raise.b
 
161
    update
 
162
    raise_getOrder
 
163
} {d d d a c e e e}
 
164
 
 
165
test raise-4.1 {raise relative to nephews} {
 
166
    raise_setup
 
167
    update
 
168
    frame .raise.d.child
 
169
    raise .raise.a .raise.d.child
 
170
    raise_getOrder
 
171
} {a d d a c e e e}
 
172
test raise-4.2 {raise relative to nephews} {
 
173
    raise_setup
 
174
    update
 
175
    frame .raise2
 
176
    list [catch {raise .raise.a .raise2} msg] $msg
 
177
} {1 {can't raise ".raise.a" above ".raise2"}}
 
178
catch {destroy .raise2}
 
179
 
 
180
test raise-5.1 {lower internal windows} {
 
181
    raise_setup
 
182
    update
 
183
    lower .raise.d
 
184
    raise_getOrder
 
185
} {a b c b c e e e}
 
186
test raise-5.2 {lower internal windows} {
 
187
    raise_setup
 
188
    update
 
189
    lower .raise.d .raise.b
 
190
    raise_getOrder
 
191
} {d b c b c e e e}
 
192
test raise-5.3 {lower internal windows} {
 
193
    raise_setup
 
194
    update
 
195
    lower .raise.a .raise.e
 
196
    raise_getOrder
 
197
} {a d d a c e e e}
 
198
test raise-5.4 {lower internal windows} {
 
199
    raise_setup
 
200
    update
 
201
    frame .raise2
 
202
    list [catch {lower .raise.a .raise2} msg] $msg
 
203
} {1 {can't lower ".raise.a" below ".raise2"}}
 
204
catch {destroy .raise2}
 
205
 
 
206
test raise-6.1 {raise/lower toplevel windows} {nonPortable} {
 
207
    raise_makeToplevels
 
208
    update
 
209
    raise .raise1
 
210
    winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
 
211
} .raise1
 
212
test raise-6.2 {raise/lower toplevel windows} {nonPortable} {
 
213
    raise_makeToplevels
 
214
    update
 
215
    raise .raise2
 
216
    winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
 
217
} .raise2
 
218
test raise-6.3 {raise/lower toplevel windows} {nonPortable} {
 
219
    raise_makeToplevels
 
220
    update
 
221
    raise .raise3
 
222
    raise .raise2
 
223
    raise .raise1 .raise3
 
224
    set result [winfo containing [winfo rootx .raise1] \
 
225
            [winfo rooty .raise1]]
 
226
    destroy .raise2
 
227
    update
 
228
    after 500
 
229
    list $result [winfo containing [winfo rootx .raise1] \
 
230
            [winfo rooty .raise1]]
 
231
} {.raise2 .raise1}
 
232
test raise-6.4 {raise/lower toplevel windows} {nonPortable} {
 
233
    raise_makeToplevels
 
234
    update
 
235
    raise .raise2
 
236
    raise .raise1
 
237
    lower .raise3 .raise1
 
238
    set result [winfo containing [winfo rootx .raise1] \
 
239
            [winfo rooty .raise1]]
 
240
    wm geometry .raise2 +30+30
 
241
    wm geometry .raise1 +60+60
 
242
    destroy .raise1
 
243
    update
 
244
    after 500
 
245
    list $result [winfo containing [winfo rootx .raise2] \
 
246
            [winfo rooty .raise2]]
 
247
} {.raise1 .raise3}
 
248
test raise-6.5 {raise/lower toplevel windows} {nonPortable} {
 
249
    raise_makeToplevels
 
250
    raise .raise1
 
251
    set time [lindex [time {raise .raise1}] 0]
 
252
    expr {$time < 2000000}
 
253
} 1
 
254
test raise-6.6 {raise/lower toplevel windows} {nonPortable} {
 
255
    raise_makeToplevels
 
256
    update
 
257
    raise .raise2
 
258
    raise .raise1
 
259
    raise .raise3
 
260
    frame .raise1.f1
 
261
    frame .raise1.f1.f2
 
262
    lower .raise3 .raise1.f1.f2
 
263
    set result [winfo containing [winfo rootx .raise1] \
 
264
            [winfo rooty .raise1]]
 
265
    destroy .raise1
 
266
    update
 
267
    after 500
 
268
    list $result [winfo containing [winfo rootx .raise2] \
 
269
            [winfo rooty .raise2]]
 
270
} {.raise1 .raise3}
 
271
 
 
272
test raise-7.1 {errors in raise/lower commands} {
 
273
    list [catch {raise} msg] $msg
 
274
} {1 {wrong # args: should be "raise window ?aboveThis?"}}
 
275
test raise-7.2 {errors in raise/lower commands} {
 
276
    list [catch {raise a b c} msg] $msg
 
277
} {1 {wrong # args: should be "raise window ?aboveThis?"}}
 
278
test raise-7.3 {errors in raise/lower commands} {
 
279
    list [catch {raise badName} msg] $msg
 
280
} {1 {bad window path name "badName"}}
 
281
test raise-7.4 {errors in raise/lower commands} {
 
282
    list [catch {raise . badName2} msg] $msg
 
283
} {1 {bad window path name "badName2"}}
 
284
test raise-7.5 {errors in raise/lower commands} {
 
285
    list [catch {lower} msg] $msg
 
286
} {1 {wrong # args: should be "lower window ?belowThis?"}}
 
287
test raise-7.6 {errors in raise/lower commands} {
 
288
    list [catch {lower a b c} msg] $msg
 
289
} {1 {wrong # args: should be "lower window ?belowThis?"}}
 
290
test raise-7.7 {errors in raise/lower commands} {
 
291
    list [catch {lower badName3} msg] $msg
 
292
} {1 {bad window path name "badName3"}}
 
293
test raise-7.8 {errors in raise/lower commands} {
 
294
    list [catch {lower . badName4} msg] $msg
 
295
} {1 {bad window path name "badName4"}}
 
296
 
 
297
foreach i [winfo child .] {
 
298
    destroy $i
 
299
}