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

Subversion Repositories or1k_old

[/] [or1k_old/] [trunk/] [insight/] [tk/] [tests/] [winfo.test] - Blame information for rev 578

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# This file is a Tcl script to test out the "winfo" command.  It is
2
# organized in the standard fashion for Tcl tests.
3
#
4
# Copyright (c) 1994 The Regents of the University of California.
5
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
6
#
7
# See the file "license.terms" for information on usage and redistribution
8
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9
#
10
# RCS: @(#) $Id: winfo.test,v 1.1.1.1 2002-01-16 10:26:00 markom Exp $
11
 
12
if {[info procs test] != "test"} {
13
    source defs
14
}
15
 
16
foreach i [winfo children .] {
17
    catch {destroy $i}
18
}
19
wm geometry . {}
20
raise .
21
 
22
# eatColors --
23
# Creates a toplevel window and allocates enough colors in it to
24
# use up all the slots in the colormap.
25
#
26
# Arguments:
27
# w -           Name of toplevel window to create.
28
# options -     Options for w, such as "-colormap new".
29
 
30
proc eatColors {w {options ""}} {
31
    catch {destroy $w}
32
    eval toplevel $w $options
33
    wm geom $w +0+0
34
    canvas $w.c -width 400 -height 200 -bd 0
35
    pack $w.c
36
    for {set y 0} {$y < 8} {incr y} {
37
        for {set x 0} {$x < 40} {incr x} {
38
            set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
39
            $w.c create rectangle [expr 10*$x] [expr 20*$y] \
40
                    [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
41
                    -fill $color
42
        }
43
    }
44
    update
45
}
46
 
47
# XXX - This test file is woefully incomplete.  At present, only a
48
# few of the winfo options are tested.
49
 
50
test winfo-1.1 {"winfo atom" command} {
51
    list [catch {winfo atom} msg] $msg
52
} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
53
test winfo-1.2 {"winfo atom" command} {
54
    list [catch {winfo atom a b} msg] $msg
55
} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
56
test winfo-1.3 {"winfo atom" command} {
57
    list [catch {winfo atom a b c d} msg] $msg
58
} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
59
test winfo-1.4 {"winfo atom" command} {
60
    list [catch {winfo atom -displayof geek foo} msg] $msg
61
} {1 {bad window path name "geek"}}
62
test winfo-1.5 {"winfo atom" command} {
63
    winfo atom PRIMARY
64
} 1
65
test winfo-1.6 {"winfo atom" command} {
66
    winfo atom -displayof . PRIMARY
67
} 1
68
 
69
test winfo-2.1 {"winfo atomname" command} {
70
    list [catch {winfo atomname} msg] $msg
71
} {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
72
test winfo-2.2 {"winfo atomname" command} {
73
    list [catch {winfo atomname a b} msg] $msg
74
} {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
75
test winfo-2.3 {"winfo atomname" command} {
76
    list [catch {winfo atomname a b c d} msg] $msg
77
} {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
78
test winfo-2.4 {"winfo atomname" command} {
79
    list [catch {winfo atomname -displayof geek foo} msg] $msg
80
} {1 {bad window path name "geek"}}
81
test winfo-2.5 {"winfo atomname" command} {
82
    list [catch {winfo atomname 44215} msg] $msg
83
} {1 {no atom exists with id "44215"}}
84
test winfo-2.6 {"winfo atomname" command} {
85
    winfo atomname 2
86
} SECONDARY
87
test winfo-2.7 {"winfo atom" command} {
88
    winfo atomname -displayof . 2
89
} SECONDARY
90
 
91
if {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")} {
92
    test winfo-3.1 {"winfo colormapfull" command} {
93
        list [catch {winfo colormapfull} msg] $msg
94
    } {1 {wrong # args: should be "winfo colormapfull window"}}
95
    test winfo-3.2 {"winfo colormapfull" command} {
96
        list [catch {winfo colormapfull a b} msg] $msg
97
    } {1 {wrong # args: should be "winfo colormapfull window"}}
98
    test winfo-3.3 {"winfo colormapfull" command} {
99
        list [catch {winfo colormapfull foo} msg] $msg
100
    } {1 {bad window path name "foo"}}
101
    test winfo-3.4 {"winfo colormapfull" command} {macOrUnix} {
102
        eatColors .t {-colormap new}
103
        set result [list [winfo colormapfull .] [winfo colormapfull .t]]
104
        .t.c delete 34
105
        lappend result [winfo colormapfull .t]
106
        .t.c create rectangle 30 30 80 80 -fill #441739
107
        lappend result [winfo colormapfull .t]
108
        .t.c create rectangle 40 40 90 90 -fill #ffeedd
109
        lappend result [winfo colormapfull .t]
110
        destroy .t.c
111
        lappend result [winfo colormapfull .t]
112
    } {0 1 0 0 1 0}
113
    catch {destroy .t}
114
}
115
 
116
catch {destroy .t}
117
toplevel .t -width 550 -height 400
118
frame .t.f -width 80 -height 60 -bd 2 -relief raised
119
place .t.f -x 50 -y 50
120
wm geom .t +0+0
121
update
122
test winfo-4.1 {"winfo containing" command} {
123
    list [catch {winfo containing 22} msg] $msg
124
} {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
125
test winfo-4.2 {"winfo containing" command} {
126
    list [catch {winfo containing a b c} msg] $msg
127
} {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
128
test winfo-4.3 {"winfo containing" command} {
129
    list [catch {winfo containing a b c d e} msg] $msg
130
} {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
131
test winfo-4.4 {"winfo containing" command} {
132
    list [catch {winfo containing -displayof geek 25 30} msg] $msg
133
} {1 {bad window path name "geek"}}
134
test winfo-4.5 {"winfo containing" command} {
135
    winfo containing [winfo rootx .t.f] [winfo rooty .t.f]
136
} .t.f
137
test winfo-4.6 {"winfo containing" command} {nonPortable} {
138
    winfo containing [expr [winfo rootx .t.f]-1] [expr [winfo rooty .t.f]-1]
139
} .t
140
test winfo-4.7 {"winfo containing" command} {
141
    set x [winfo containing -display .t.f [expr [winfo rootx .t]+600] \
142
            [expr [winfo rooty .t.f]+450]]
143
    expr {($x == ".") || ($x == "")}
144
} {1}
145
destroy .t
146
 
147
test winfo-5.1 {"winfo interps" command} {
148
    list [catch {winfo interps a} msg] $msg
149
} {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
150
test winfo-5.2 {"winfo interps" command} {
151
    list [catch {winfo interps a b c} msg] $msg
152
} {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
153
test winfo-5.3 {"winfo interps" command} {
154
    list [catch {winfo interps -displayof geek} msg] $msg
155
} {1 {bad window path name "geek"}}
156
test winfo-5.4 {"winfo interps" command} {unixOnly} {
157
    expr [lsearch -exact [winfo interps] [tk appname]] >= 0
158
} {1}
159
test winfo-5.5 {"winfo interps" command} {unixOnly} {
160
    expr [lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0
161
} {1}
162
 
163
test winfo-6.1 {"winfo exists" command} {
164
    list [catch {winfo exists} msg] $msg
165
} {1 {wrong # args: should be "winfo exists window"}}
166
test winfo-6.2 {"winfo exists" command} {
167
    list [catch {winfo exists a b} msg] $msg
168
} {1 {wrong # args: should be "winfo exists window"}}
169
test winfo-6.3 {"winfo exists" command} {
170
    winfo exists gorp
171
} {0}
172
test winfo-6.4 {"winfo exists" command} {
173
    winfo exists .
174
} {1}
175
test winfo-6.5 {"winfo exists" command} {
176
    button .b -text "Test button"
177
    set x [winfo exists .b]
178
    pack .b
179
    update
180
    bind .b  {lappend x [winfo exists .x]}
181
    destroy .b
182
    lappend x [winfo exists .x]
183
} {1 0 0}
184
 
185
catch {destroy .b}
186
button .b -text "Help"
187
update
188
test winfo-7.1 {"winfo pathname" command} {
189
    list [catch {winfo pathname} msg] $msg
190
} {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
191
test winfo-7.2 {"winfo pathname" command} {
192
    list [catch {winfo pathname a b} msg] $msg
193
} {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
194
test winfo-7.3 {"winfo pathname" command} {
195
    list [catch {winfo pathname a b c d} msg] $msg
196
} {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
197
test winfo-7.4 {"winfo pathname" command} {
198
    list [catch {winfo pathname -displayof geek 25} msg] $msg
199
} {1 {bad window path name "geek"}}
200
test winfo-7.5 {"winfo pathname" command} {
201
    list [catch {winfo pathname xyz} msg] $msg
202
} {1 {expected integer but got "xyz"}}
203
test winfo-7.6 {"winfo pathname" command} {
204
    list [catch {winfo pathname 224} msg] $msg
205
} {1 {window id "224" doesn't exist in this application}}
206
test winfo-7.7 {"winfo pathname" command} {
207
    winfo pathname -displayof .b [winfo id .]
208
} {.}
209
 
210
if {[string compare testwrapper [info commands testwrapper]] == 0} {
211
    puts "This application hasn't been compiled with the testwrapper command,"
212
    puts "therefore I am skipping all of these tests."
213
 
214
    test winfo-7.8 {"winfo pathname" command} {unixOnly} {
215
        winfo pathname [testwrapper .]
216
    } {}
217
}
218
 
219
test winfo-8.1 {"winfo pointerx" command} {
220
    catch [winfo pointerx .b]
221
} 1
222
test winfo-8.2 {"winfo pointery" command} {
223
    catch [winfo pointery .b]
224
} 1
225
test winfo-8.3 {"winfo pointerxy" command} {
226
    catch [winfo pointerxy .b]
227
} 1
228
 
229
test winfo-9.1 {"winfo viewable" command} {
230
    list [catch {winfo viewable} msg] $msg
231
} {1 {wrong # args: should be "winfo viewable window"}}
232
test winfo-9.2 {"winfo viewable" command} {
233
    list [catch {winfo viewable foo} msg] $msg
234
} {1 {bad window path name "foo"}}
235
test winfo-9.3 {"winfo viewable" command} {
236
    winfo viewable .
237
} {1}
238
test winfo-9.4 {"winfo viewable" command} {
239
    wm iconify .
240
    winfo viewable .
241
} {0}
242
wm deiconify .
243
test winfo-9.5 {"winfo viewable" command} {
244
    frame .f1 -width 100 -height 100 -relief raised -bd 2
245
    place .f1 -x 0 -y 0
246
    frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
247
    place .f1.f2 -x 0 -y 0
248
    update
249
    list [winfo viewable .f1] [winfo viewable .f1.f2]
250
} {1 1}
251
test winfo-9.6 {"winfo viewable" command} {
252
    eval destroy [winfo child .]
253
    frame .f1 -width 100 -height 100 -relief raised -bd 2
254
    frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
255
    place .f1.f2 -x 0 -y 0
256
    update
257
    list [winfo viewable .f1] [winfo viewable .f1.f2]
258
} {0 0}
259
test winfo-9.7 {"winfo viewable" command} {
260
    eval destroy [winfo child .]
261
    frame .f1 -width 100 -height 100 -relief raised -bd 2
262
    place .f1 -x 0 -y 0
263
    frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
264
    place .f1.f2 -x 0 -y 0
265
    update
266
    wm iconify .
267
    list [winfo viewable .f1] [winfo viewable .f1.f2]
268
} {0 0}
269
wm deiconify .
270
eval destroy [winfo child .]
271
 
272
test winfo-10.1 {"winfo visualid" command} {
273
    list [catch {winfo visualid} msg] $msg
274
} {1 {wrong # args: should be "winfo visualid window"}}
275
test winfo-10.2 {"winfo visualid" command} {
276
    list [catch {winfo visualid gorp} msg] $msg
277
} {1 {bad window path name "gorp"}}
278
test winfo-10.3 {"winfo visualid" command} {
279
    expr 2+[winfo visualid .]-[winfo visualid .]
280
} {2}
281
 
282
test winfo-11.1 {"winfo visualid" command} {
283
    list [catch {winfo visualsavailable} msg] $msg
284
} {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}}
285
test winfo-11.2 {"winfo visualid" command} {
286
    list [catch {winfo visualsavailable gorp} msg] $msg
287
} {1 {bad window path name "gorp"}}
288
test winfo-11.3 {"winfo visualid" command} {
289
    list [catch {winfo visualsavailable . includeids foo} msg] $msg
290
} {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}}
291
test winfo-11.4 {"winfo visualid" command} {
292
    llength [lindex [winfo visualsa .] 0]
293
} {2}
294
test winfo-11.5 {"winfo visualid" command} {
295
    llength [lindex [winfo visualsa . includeids] 0]
296
} {3}
297
test winfo-11.6 {"winfo visualid" command} {
298
    set x [lindex [lindex [winfo visualsa . includeids] 0] 2]
299
    expr $x + 2 - $x
300
} {2}
301
 
302
test winfo-12.1 {GetDisplayOf procedure} {
303
    list [catch {winfo atom - foo x} msg] $msg
304
} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
305
test winfo-12.2 {GetDisplayOf procedure} {
306
    list [catch {winfo atom -d bad_window x} msg] $msg
307
} {1 {bad window path name "bad_window"}}
308
 
309
# Some embedding tests
310
#
311
 
312
proc MakeEmbed {} {
313
    frame .con -container 1
314
    pack .con -expand yes -fill both
315
    toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0
316
    button .emb.b
317
    pack .emb.b -expand yes -fill both
318
    update
319
}
320
test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} {
321
    MakeEmbed
322
    set z [expr [winfo rootx .emb] == [winfo rootx .con] && \
323
                [winfo rooty .emb] == [winfo rooty .con]]
324
    destroy .emb
325
    destroy .con
326
    set z
327
} {1}
328
test winfo-13.2 {destroying embedded toplevel} {macOrUnix} {
329
    catch {destroy .emb}
330
    update
331
    expr [winfo exists .emb.b] || [winfo exists .con]
332
} 0
333
 
334
foreach i [winfo children .] {
335
    destroy $i
336
}
337
 
338
test winfo-13.3 {destroying container window} {macOrUnix} {
339
    MakeEmbed
340
    destroy .con
341
    update
342
    set z [expr [winfo exists .emb.b] || [winfo exists .emb]]
343
    catch {destroy .emb}
344
    catch {destroy .con}
345
    set z
346
} 0
347
 
348
foreach i [winfo children .] {
349
    destroy $i
350
}
351
 
352
test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} {
353
    MakeEmbed
354
    button .b
355
    pack .b -expand yes -fill both
356
    update
357
 
358
    set z [string compare \
359
        [winfo containing [winfo rootx .emb.b] [winfo rooty .emb.b]] .emb.b]
360
    catch {destroy .con}
361
    catch {destroy .emb}
362
    set z
363
} 0
364
 
365
foreach i [winfo children .] {
366
    catch {destroy $i}
367
}

powered by: WebSVN 2.1.0

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