OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [tk/] [tests/] [raise.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# 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.1.1.1 2002-01-16 10:25:59 markom 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 
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.