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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [listbox.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 the "listbox" command
2
# of Tk.  It is organized in the standard fashion for Tcl tests.
3
#
4
# Copyright (c) 1993-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: listbox.test,v 1.1.1.1 2002-01-16 10:25:59 markom Exp $
11
 
12
if {[string compare test [info procs test]] == 1} then \
13
  {source defs}
14
 
15
foreach i [winfo children .] {
16
    destroy $i
17
}
18
wm geometry . {}
19
raise .
20
set fixed {Courier -12}
21
 
22
proc record args {
23
    global log
24
    lappend log $args
25
}
26
 
27
proc getsize w {
28
    regexp {(^[^+-]*)} [wm geometry $w] foo x
29
    return $x
30
}
31
 
32
proc resetGridInfo {} {
33
    # Some window managers, such as mwm, don't reset gridding information
34
    # unless the window is withdrawn and re-mapped.  If this procedure
35
    # isn't invoked, the window manager will stay in gridded mode, which
36
    # can cause all sorts of problems.  The "wm positionfrom" command is
37
    # needed so that the window manager doesn't ask the user to
38
    # manually position the window when it is re-mapped.
39
 
40
    wm withdraw .
41
    wm positionfrom . user
42
    wm deiconify .
43
}
44
 
45
# Procedure that creates a second listbox for checking things related
46
# to partially visible lines.
47
 
48
proc mkPartial {{w .partial}} {
49
    catch {destroy $w}
50
    toplevel $w
51
    wm geometry $w +0+0
52
    listbox $w.l -width 30 -height 5
53
    pack $w.l -expand 1 -fill both
54
    $w.l insert end one two three four five six seven eight nine ten \
55
            eleven twelve thirteen fourteen fifteen
56
    update
57
    scan [wm geometry $w] "%dx%d" width height
58
    wm geometry $w ${width}x[expr $height-3]
59
    update
60
}
61
 
62
# Create entries in the option database to be sure that geometry options
63
# like border width have predictable values.
64
 
65
option add *Listbox.borderWidth 2
66
option add *Listbox.highlightThickness 2
67
option add *Listbox.font {Helvetica -12 bold}
68
 
69
listbox .l
70
pack .l
71
update
72
resetGridInfo
73
set i 1
74
 
75
foreach test {
76
    {-background #ff0000 #ff0000 non-existent
77
            {unknown color name "non-existent"}}
78
    {-bd 4 4 badValue {bad screen distance "badValue"}}
79
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
80
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
81
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
82
    {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
83
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
84
    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
85
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
86
    {-height 30 30 20p {expected integer but got "20p"}}
87
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
88
    {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
89
    {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
90
    {-highlightthickness -2 0 {} {}}
91
    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
92
    {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
93
    {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
94
    {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
95
    {-selectmode string string {} {}}
96
    {-setgrid false 0 lousy {expected boolean value but got "lousy"}}
97
    {-takefocus "any string" "any string" {} {}}
98
    {-width 45 45 3p {expected integer but got "3p"}}
99
    {-xscrollcommand {Some command} {Some command} {} {}}
100
    {-yscrollcommand {Another command} {Another command} {} {}}
101
} {
102
    set name [lindex $test 0]
103
    test listbox-1.$i {configuration options} {
104
        .l configure $name [lindex $test 1]
105
        list [lindex [.l configure $name] 4] [.l cget $name]
106
    } [list [lindex $test 2] [lindex $test 2]]
107
    incr i
108
    if {[lindex $test 3] != ""} {
109
        test listbox-1.$i {configuration options} {
110
            list [catch {.l configure $name [lindex $test 3]} msg] $msg
111
        } [list 1 [lindex $test 4]]
112
    }
113
    .l configure $name [lindex [.l configure $name] 3]
114
    incr i
115
}
116
 
117
test listbox-2.1 {Tk_ListboxCmd procedure} {
118
    list [catch {listbox} msg] $msg
119
} {1 {wrong # args: should be "listbox pathName ?options?"}}
120
test listbox-2.2 {Tk_ListboxCmd procedure} {
121
    list [catch {listbox gorp} msg] $msg
122
} {1 {bad window path name "gorp"}}
123
test listbox-2.3 {Tk_ListboxCmd procedure} {
124
    catch {destroy .l}
125
    listbox .l
126
    list [winfo exists .l] [winfo class .l] [info commands .l]
127
} {1 Listbox .l}
128
test listbox-2.4 {Tk_ListboxCmd procedure} {
129
    catch {destroy .l}
130
    list [catch {listbox .l -gorp foo} msg] $msg [winfo exists .l] \
131
            [info commands .l]
132
} {1 {unknown option "-gorp"} 0 {}}
133
test listbox-2.5 {Tk_ListboxCmd procedure} {
134
    catch {destroy .l}
135
    listbox .l
136
} {.l}
137
 
138
catch {destroy .l}
139
listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2
140
pack .l
141
.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \
142
        el15 el16 el17
143
update
144
test listbox-3.1 {ListboxWidgetCmd procedure} {
145
    list [catch .l msg] $msg
146
} {1 {wrong # args: should be ".l option ?arg arg ...?"}}
147
test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} {
148
    list [catch {.l activate} msg] $msg
149
} {1 {wrong # args: should be ".l activate index"}}
150
test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} {
151
    list [catch {.l activate a b} msg] $msg
152
} {1 {wrong # args: should be ".l activate index"}}
153
test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} {
154
    list [catch {.l activate fooey} msg] $msg
155
} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}}
156
test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} {
157
    .l activate 3
158
    .l index active
159
} 3
160
test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} {
161
    .l activate -1
162
    .l index active
163
} {0}
164
test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} {
165
    .l activate 30
166
    .l index active
167
} {17}
168
test listbox-3.8 {ListboxWidgetCmd procedure, "activate" option} {
169
    .l activate end
170
    .l index active
171
} {17}
172
test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} {
173
    list [catch {.l bbox} msg] $msg
174
} {1 {wrong # args: should be ".l bbox index"}}
175
test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} {
176
    list [catch {.l bbox a b} msg] $msg
177
} {1 {wrong # args: should be ".l bbox index"}}
178
test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} {
179
    list [catch {.l bbox fooey} msg] $msg
180
} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}}
181
test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option} {
182
    .l yview 3
183
    update
184
    list [.l bbox 2] [.l bbox 8]
185
} {{} {}}
186
test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} {
187
    # Used to generate a core dump before a bug was fixed (the last
188
    # element would be on-screen if it existed, but it doesn't exist).
189
 
190
    listbox .l2
191
    pack .l2 -side top
192
    tkwait visibility .l2
193
    set x [.l2 bbox 0]
194
    destroy .l2
195
    set x
196
} {}
197
test listbox-3.14 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
198
    .l yview 3
199
    update
200
    list [.l bbox 3] [.l bbox 4]
201
} {{7 7 17 14} {7 26 17 14}}
202
test listbox-3.15 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
203
    .l yview 0
204
    update
205
    list [.l bbox -1] [.l bbox 0]
206
} {{} {7 7 17 14}}
207
test listbox-3.16 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
208
    .l yview end
209
    update
210
    list [.l bbox 17] [.l bbox end] [.l bbox 18]
211
} {{7 83 24 14} {7 83 24 14} {}}
212
test listbox-3.17 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
213
    catch {destroy .t}
214
    toplevel .t
215
    wm geom .t +0+0
216
    listbox .t.l -width 10 -height 5
217
    .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short"
218
    pack .t.l
219
    update
220
    .t.l xview moveto .2
221
    .t.l bbox 2
222
} {-72 39 393 14}
223
test listbox-3.18 {ListboxWidgetCmd procedure, "bbox" option, partial last line} {fonts} {
224
    mkPartial
225
    list [.partial.l bbox 3] [.partial.l bbox 4]
226
} {{5 56 24 14} {5 73 23 14}}
227
test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} {
228
    list [catch {.l cget} msg] $msg
229
} {1 {wrong # args: should be ".l cget option"}}
230
test listbox-3.20 {ListboxWidgetCmd procedure, "cget" option} {
231
    list [catch {.l cget a b} msg] $msg
232
} {1 {wrong # args: should be ".l cget option"}}
233
test listbox-3.21 {ListboxWidgetCmd procedure, "cget" option} {
234
    list [catch {.l cget -gorp} msg] $msg
235
} {1 {unknown option "-gorp"}}
236
test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} {
237
    .l cget -setgrid
238
} {0}
239
test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} {
240
    llength [.l configure]
241
} {23}
242
test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} {
243
    list [catch {.l configure -gorp} msg] $msg
244
} {1 {unknown option "-gorp"}}
245
test listbox-3.25 {ListboxWidgetCmd procedure, "configure" option} {
246
    .l configure -setgrid
247
} {-setgrid setGrid SetGrid 0 0}
248
test listbox-3.26 {ListboxWidgetCmd procedure, "configure" option} {
249
    list [catch {.l configure -gorp is_messy} msg] $msg
250
} {1 {unknown option "-gorp"}}
251
test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} {
252
    set oldbd [.l cget -bd]
253
    set oldht [.l cget -highlightthickness]
254
    .l configure -bd 3 -highlightthickness 0
255
    set x "[.l cget -bd] [.l cget -highlightthickness]"
256
    .l configure -bd $oldbd -highlightthickness $oldht
257
    set x
258
} {3 0}
259
test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} {
260
    list [catch {.l curselection a} msg] $msg
261
} {1 {wrong # args: should be ".l curselection"}}
262
test listbox-3.29 {ListboxWidgetCmd procedure, "curselection" option} {
263
    .l selection clear 0 end
264
    .l selection set 3 6
265
    .l selection set 9
266
    .l curselection
267
} {3 4 5 6 9}
268
test listbox-3.30 {ListboxWidgetCmd procedure, "delete" option} {
269
    list [catch {.l delete} msg] $msg
270
} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
271
test listbox-3.31 {ListboxWidgetCmd procedure, "delete" option} {
272
    list [catch {.l delete a b c} msg] $msg
273
} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
274
test listbox-3.32 {ListboxWidgetCmd procedure, "delete" option} {
275
    list [catch {.l delete badIndex} msg] $msg
276
} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}}
277
test listbox-3.33 {ListboxWidgetCmd procedure, "delete" option} {
278
    list [catch {.l delete 2 123ab} msg] $msg
279
} {1 {bad listbox index "123ab": must be active, anchor, end, @x,y, or a number}}
280
test listbox-3.34 {ListboxWidgetCmd procedure, "delete" option} {
281
    catch {destroy .l2}
282
    listbox .l2
283
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
284
    .l2 delete 3
285
    list [.l2 get 2] [.l2 get 3] [.l2 index end]
286
} {el2 el4 7}
287
test listbox-3.35 {ListboxWidgetCmd procedure, "delete" option} {
288
    catch {destroy .l2}
289
    listbox .l2
290
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
291
    .l2 delete 2 4
292
    list [.l2 get 1] [.l2 get 2] [.l2 index end]
293
} {el1 el5 5}
294
test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} {
295
    catch {destroy .l2}
296
    listbox .l2
297
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
298
    .l2 delete -3 2
299
    .l2 get 0 end
300
} {el3 el4 el5 el6 el7}
301
test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} {
302
    catch {destroy .l2}
303
    listbox .l2
304
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
305
    .l2 delete -3 -1
306
    .l2 get 0 end
307
} {el0 el1 el2 el3 el4 el5 el6 el7}
308
test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} {
309
    catch {destroy .l2}
310
    listbox .l2
311
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
312
    .l2 delete 2 end
313
    .l2 get 0 end
314
} {el0 el1}
315
test listbox-3.39 {ListboxWidgetCmd procedure, "delete" option} {
316
    catch {destroy .l2}
317
    listbox .l2
318
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
319
    .l2 delete 5 20
320
    .l2 get 0 end
321
} {el0 el1 el2 el3 el4}
322
test listbox-3.40 {ListboxWidgetCmd procedure, "delete" option} {
323
    catch {destroy .l2}
324
    listbox .l2
325
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
326
    .l2 delete end 20
327
    .l2 get 0 end
328
} {el0 el1 el2 el3 el4 el5 el6}
329
test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} {
330
    catch {destroy .l2}
331
    listbox .l2
332
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
333
    .l2 delete 8 20
334
    .l2 get 0 end
335
} {el0 el1 el2 el3 el4 el5 el6 el7}
336
test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} {
337
    list [catch {.l get} msg] $msg
338
} {1 {wrong # args: should be ".l get first ?last?"}}
339
test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} {
340
    list [catch {.l get a b c} msg] $msg
341
} {1 {wrong # args: should be ".l get first ?last?"}}
342
test listbox-3.44 {ListboxWidgetCmd procedure, "get" option} {
343
    list [catch {.l get 2.4} msg] $msg
344
} {1 {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number}}
345
test listbox-3.45 {ListboxWidgetCmd procedure, "get" option} {
346
    list [catch {.l get end bogus} msg] $msg
347
} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}}
348
test listbox-3.46 {ListboxWidgetCmd procedure, "get" option} {
349
    catch {destroy .l2}
350
    listbox .l2
351
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
352
    list [.l2 get 0] [.l2 get 3] [.l2 get end]
353
} {el0 el3 el7}
354
test listbox-3.47 {ListboxWidgetCmd procedure, "get" option} {
355
    catch {destroy .l2}
356
    listbox .l2
357
    list [.l2 get 0] [.l2 get end]
358
} {{} {}}
359
test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} {
360
    catch {destroy .l2}
361
    listbox .l2
362
    .l2 insert 0 el0 el1 el2 "two words" el4 el5 el6 el7
363
    .l2 get 3 end
364
} {{two words} el4 el5 el6 el7}
365
test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} {
366
    .l get -1
367
} {}
368
test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} {
369
    .l get -2 -1
370
} {}
371
test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} {
372
    .l get -2 3
373
} {el0 el1 el2 el3}
374
test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} {
375
    .l get 12 end
376
} {el12 el13 el14 el15 el16 el17}
377
test listbox-3.53 {ListboxWidgetCmd procedure, "get" option} {
378
    .l get 12 20
379
} {el12 el13 el14 el15 el16 el17}
380
test listbox-3.54 {ListboxWidgetCmd procedure, "get" option} {
381
    .l get end
382
} {el17}
383
test listbox-3.55 {ListboxWidgetCmd procedure, "get" option} {
384
    .l get 30
385
} {}
386
test listbox-3.56 {ListboxWidgetCmd procedure, "get" option} {
387
    .l get 30 35
388
} {}
389
test listbox-3.57 {ListboxWidgetCmd procedure, "index" option} {
390
    list [catch {.l index} msg] $msg
391
} {1 {wrong # args: should be ".l index index"}}
392
test listbox-3.58 {ListboxWidgetCmd procedure, "index" option} {
393
    list [catch {.l index a b} msg] $msg
394
} {1 {wrong # args: should be ".l index index"}}
395
test listbox-3.59 {ListboxWidgetCmd procedure, "index" option} {
396
    list [catch {.l index @} msg] $msg
397
} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}}
398
test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} {
399
    .l index 2
400
} 2
401
test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} {
402
    .l index -1
403
} -1
404
test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} {
405
    .l index end
406
} 18
407
test listbox-3.63 {ListboxWidgetCmd procedure, "index" option} {
408
    .l index 34
409
} 34
410
test listbox-3.64 {ListboxWidgetCmd procedure, "insert" option} {
411
    list [catch {.l insert} msg] $msg
412
} {1 {wrong # args: should be ".l insert index ?element element ...?"}}
413
test listbox-3.65 {ListboxWidgetCmd procedure, "insert" option} {
414
    list [catch {.l insert badIndex} msg] $msg
415
} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}}
416
test listbox-3.66 {ListboxWidgetCmd procedure, "insert" option} {
417
    catch {destroy .l2}
418
    listbox .l2
419
    .l2 insert end a b c d e
420
    .l2 insert 3 x y z
421
    .l2 get 0 end
422
} {a b c x y z d e}
423
test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} {
424
    catch {destroy .l2}
425
    listbox .l2
426
    .l2 insert end a b c
427
    .l2 insert -1 x
428
    .l2 get 0 end
429
} {x a b c}
430
test listbox-3.68 {ListboxWidgetCmd procedure, "insert" option} {
431
    catch {destroy .l2}
432
    listbox .l2
433
    .l2 insert end a b c
434
    .l2 insert end x
435
    .l2 get 0 end
436
} {a b c x}
437
test listbox-3.69 {ListboxWidgetCmd procedure, "insert" option} {
438
    catch {destroy .l2}
439
    listbox .l2
440
    .l2 insert end a b c
441
    .l2 insert 43 x
442
    .l2 get 0 end
443
} {a b c x}
444
test listbox-3.70 {ListboxWidgetCmd procedure, "nearest" option} {
445
    list [catch {.l nearest} msg] $msg
446
} {1 {wrong # args: should be ".l nearest y"}}
447
test listbox-3.71 {ListboxWidgetCmd procedure, "nearest" option} {
448
    list [catch {.l nearest a b} msg] $msg
449
} {1 {wrong # args: should be ".l nearest y"}}
450
test listbox-3.72 {ListboxWidgetCmd procedure, "nearest" option} {
451
    list [catch {.l nearest 20p} msg] $msg
452
} {1 {expected integer but got "20p"}}
453
test listbox-3.73 {ListboxWidgetCmd procedure, "nearest" option} {
454
    .l yview 3
455
    .l nearest 1000
456
} {7}
457
test listbox-3.74 {ListboxWidgetCmd procedure, "scan" option} {
458
    list [catch {.l scan a b} msg] $msg
459
} {1 {wrong # args: should be ".l scan mark|dragto x y"}}
460
test listbox-3.75 {ListboxWidgetCmd procedure, "scan" option} {
461
    list [catch {.l scan a b c d} msg] $msg
462
} {1 {wrong # args: should be ".l scan mark|dragto x y"}}
463
test listbox-3.76 {ListboxWidgetCmd procedure, "scan" option} {
464
    list [catch {.l scan foo bogus 2} msg] $msg
465
} {1 {expected integer but got "bogus"}}
466
test listbox-3.77 {ListboxWidgetCmd procedure, "scan" option} {
467
    list [catch {.l scan foo 2 2.3} msg] $msg
468
} {1 {expected integer but got "2.3"}}
469
test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} {fonts} {
470
    catch {destroy .t}
471
    toplevel .t
472
    wm geom .t +0+0
473
    listbox .t.l -width 10 -height 5
474
    .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short" a b c d e f g h i j
475
    pack .t.l
476
    update
477
    .t.l scan mark 100 140
478
    .t.l scan dragto 90 137
479
    update
480
    list [.t.l xview] [.t.l yview]
481
} {{0.249364 0.427481} {0.0714286 0.428571}}
482
test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} {
483
    list [catch {.l scan foo 2 4} msg] $msg
484
} {1 {bad scan option "foo": must be mark or dragto}}
485
test listbox-3.80 {ListboxWidgetCmd procedure, "see" option} {
486
    list [catch {.l see} msg] $msg
487
} {1 {wrong # args: should be ".l see index"}}
488
test listbox-3.81 {ListboxWidgetCmd procedure, "see" option} {
489
    list [catch {.l see a b} msg] $msg
490
} {1 {wrong # args: should be ".l see index"}}
491
test listbox-3.82 {ListboxWidgetCmd procedure, "see" option} {
492
    list [catch {.l see gorp} msg] $msg
493
} {1 {bad listbox index "gorp": must be active, anchor, end, @x,y, or a number}}
494
test listbox-3.83 {ListboxWidgetCmd procedure, "see" option} {
495
    .l yview 7
496
    .l see 7
497
    .l index @0,0
498
} {7}
499
test listbox-3.84 {ListboxWidgetCmd procedure, "see" option} {
500
    .l yview 7
501
    .l see 11
502
    .l index @0,0
503
} {7}
504
test listbox-3.85 {ListboxWidgetCmd procedure, "see" option} {
505
    .l yview 7
506
    .l see 6
507
    .l index @0,0
508
} {6}
509
test listbox-3.86 {ListboxWidgetCmd procedure, "see" option} {
510
    .l yview 7
511
    .l see 5
512
    .l index @0,0
513
} {3}
514
test listbox-3.87 {ListboxWidgetCmd procedure, "see" option} {
515
    .l yview 7
516
    .l see 12
517
    .l index @0,0
518
} {8}
519
test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} {
520
    .l yview 7
521
    .l see 13
522
    .l index @0,0
523
} {11}
524
test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} {
525
    .l yview 7
526
    .l see -1
527
    .l index @0,0
528
} {0}
529
test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} {
530
    .l yview 7
531
    .l see end
532
    .l index @0,0
533
} {13}
534
test listbox-3.91 {ListboxWidgetCmd procedure, "see" option} {
535
    .l yview 7
536
    .l see 322
537
    .l index @0,0
538
} {13}
539
test listbox-3.92 {ListboxWidgetCmd procedure, "see" option, partial last line} {
540
    mkPartial
541
    .partial.l see 4
542
    .partial.l index @0,0
543
} {1}
544
test listbox-3.93 {ListboxWidgetCmd procedure, "selection" option} {
545
    list [catch {.l select a} msg] $msg
546
} {1 {wrong # args: should be ".l selection option index ?index?"}}
547
test listbox-3.94 {ListboxWidgetCmd procedure, "selection" option} {
548
    list [catch {.l select a b c d} msg] $msg
549
} {1 {wrong # args: should be ".l selection option index ?index?"}}
550
test listbox-3.95 {ListboxWidgetCmd procedure, "selection" option} {
551
    list [catch {.l selection a bogus} msg] $msg
552
} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}}
553
test listbox-3.96 {ListboxWidgetCmd procedure, "selection" option} {
554
    list [catch {.l selection a 0 lousy} msg] $msg
555
} {1 {bad listbox index "lousy": must be active, anchor, end, @x,y, or a number}}
556
test listbox-3.97 {ListboxWidgetCmd procedure, "selection" option} {
557
    list [catch {.l selection anchor 0 0} msg] $msg
558
} {1 {wrong # args: should be ".l selection anchor index"}}
559
test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} {
560
    list [.l selection anchor 5; .l index anchor] \
561
            [.l selection anchor 0; .l index anchor]
562
} {5 0}
563
test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} {
564
    .l selection anchor -1
565
    .l index anchor
566
} {0}
567
test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} {
568
    .l selection anchor end
569
    .l index anchor
570
} {17}
571
test listbox-3.101 {ListboxWidgetCmd procedure, "selection" option} {
572
    .l selection anchor 44
573
    .l index anchor
574
} {17}
575
test listbox-3.102 {ListboxWidgetCmd procedure, "selection" option} {
576
    .l selection clear 0 end
577
    .l selection set 2 8
578
    .l selection clear 3 4
579
    .l curselection
580
} {2 5 6 7 8}
581
test listbox-3.103 {ListboxWidgetCmd procedure, "selection" option} {
582
    list [catch {.l selection includes 0 0} msg] $msg
583
} {1 {wrong # args: should be ".l selection includes index"}}
584
test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} {
585
    .l selection clear 0 end
586
    .l selection set 2 8
587
    .l selection clear 4
588
    list [.l selection includes 3] [.l selection includes 4] \
589
            [.l selection includes 5]
590
} {1 0 1}
591
test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} {
592
    .l selection set 0 end
593
    .l selection includes -1
594
} {0}
595
test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} {
596
    .l selection clear 0 end
597
    .l selection set end
598
    .l selection includes end
599
} {1}
600
test listbox-3.107 {ListboxWidgetCmd procedure, "selection" option} {
601
    .l selection set 0 end
602
    .l selection includes 44
603
} {0}
604
test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} {
605
    catch {destroy .l2}
606
    listbox .l2
607
    .l2 selection includes 0
608
} {0}
609
test listbox-3.109 {ListboxWidgetCmd procedure, "selection" option} {
610
    .l selection clear 0 end
611
    .l selection set 2
612
    .l selection set 5 7
613
    .l curselection
614
} {2 5 6 7}
615
test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} {
616
    .l selection set 5 7
617
    .l curselection
618
} {2 5 6 7}
619
test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} {
620
    list [catch {.l selection badOption 0 0} msg] $msg
621
} {1 {bad selection option "badOption": must be anchor, clear, includes, or set}}
622
test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} {
623
    list [catch {.l size a} msg] $msg
624
} {1 {wrong # args: should be ".l size"}}
625
test listbox-3.113 {ListboxWidgetCmd procedure, "size" option} {
626
    .l size
627
} {18}
628
test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} {
629
    catch {destroy .l2}
630
    listbox .l2
631
    update
632
    .l2 xview
633
} {0 1}
634
test listbox-3.115 {ListboxWidgetCmd procedure, "xview" option} {
635
    catch {destroy .l}
636
    listbox .l -width 10 -height 5 -font $fixed
637
    .l insert 0 a b c d e f g h i j k l m n o p q r s t
638
    pack .l
639
    update
640
    .l xview
641
} {0 1}
642
catch {destroy .l}
643
listbox .l -width 10 -height 5 -font $fixed
644
.l insert 0 a b c d e f g h i j k l m n o p q r s t
645
.l insert 1 "0123456789a123456789b123456789c123456789d123456789"
646
pack .l
647
update
648
test listbox-3.116 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
649
    .l xview 4
650
    .l xview
651
} {0.08 0.28}
652
test listbox-3.117 {ListboxWidgetCmd procedure, "xview" option} {
653
    list [catch {.l xview foo} msg] $msg
654
} {1 {expected integer but got "foo"}}
655
test listbox-3.118 {ListboxWidgetCmd procedure, "xview" option} {
656
    list [catch {.l xview zoom a b} msg] $msg
657
} {1 {unknown option "zoom": must be moveto or scroll}}
658
test listbox-3.119 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
659
    .l xview 0
660
    .l xview moveto .4
661
    update
662
    .l xview
663
} {0.4 0.6}
664
test listbox-3.120 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
665
    .l xview 0
666
    .l xview scroll 2 units
667
    update
668
    .l xview
669
} {0.04 0.24}
670
test listbox-3.121 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
671
    .l xview 30
672
    .l xview scroll -1 pages
673
    update
674
    .l xview
675
} {0.44 0.64}
676
test listbox-3.122 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
677
    .l configure -width 1
678
    update
679
    .l xview 30
680
    .l xview scroll -4 pages
681
    update
682
    .l xview
683
} {0.52 0.54}
684
test listbox-3.123 {ListboxWidgetCmd procedure, "yview" option} {
685
    catch {destroy .l}
686
    listbox .l
687
    pack  .l
688
    update
689
    .l yview
690
} {0 1}
691
test listbox-3.124 {ListboxWidgetCmd procedure, "yview" option} {
692
    catch {destroy .l}
693
    listbox .l
694
    .l insert 0 el1
695
    pack  .l
696
    update
697
    .l yview
698
} {0 1}
699
catch {destroy .l}
700
listbox .l -width 10 -height 5 -font $fixed
701
.l insert 0 a b c d e f g h i j k l m n o p q r s t
702
pack .l
703
update
704
test listbox-3.125 {ListboxWidgetCmd procedure, "yview" option} {
705
    .l yview 4
706
    update
707
    .l yview
708
} {0.2 0.45}
709
test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last line} {
710
    mkPartial
711
    .partial.l yview
712
} {0 0.266667}
713
test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} {
714
    list [catch {.l yview foo} msg] $msg
715
} {1 {bad listbox index "foo": must be active, anchor, end, @x,y, or a number}}
716
test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} {
717
    list [catch {.l yview foo a b} msg] $msg
718
} {1 {unknown option "foo": must be moveto or scroll}}
719
test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} {
720
    .l yview 0
721
    .l yview moveto .31
722
    .l yview
723
} {0.3 0.55}
724
test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} {
725
    .l yview 2
726
    .l yview scroll 2 pages
727
    .l yview
728
} {0.4 0.65}
729
test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} {
730
    .l yview 10
731
    .l yview scroll -3 units
732
    .l yview
733
} {0.35 0.6}
734
test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} {
735
    .l configure -height 2
736
    update
737
    .l yview 15
738
    .l yview scroll -4 pages
739
    .l yview
740
} {0.55 0.65}
741
test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} {
742
    list [catch {.l whoknows} msg] $msg
743
} {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
744
test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} {
745
    list [catch {.l c} msg] $msg
746
} {1 {bad option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
747
test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} {
748
    list [catch {.l in} msg] $msg
749
} {1 {bad option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
750
test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} {
751
    list [catch {.l s} msg] $msg
752
} {1 {bad option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
753
test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} {
754
    list [catch {.l se} msg] $msg
755
} {1 {bad option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
756
 
757
# No tests for DestroyListbox:  I can't come up with anything to test
758
# in this procedure.
759
 
760
test listbox-4.1 {ConfigureListbox procedure} {fonts} {
761
    catch {destroy .l}
762
    listbox .l -setgrid 1 -width 25 -height 15
763
    pack .l
764
    update
765
    set x [getsize .]
766
    .l configure -setgrid 0
767
    update
768
    list $x [getsize .]
769
} {25x15 185x263}
770
resetGridInfo
771
test listbox-4.2 {ConfigureListbox procedure} {
772
    .l configure -highlightthickness -3
773
    .l cget -highlightthickness
774
} {0}
775
test listbox-4.3 {ConfigureListbox procedure} {
776
    .l configure -exportselection 0
777
    .l delete 0 end
778
    .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
779
    .l selection set 3 5
780
    .l configure -exportselection 1
781
    selection get
782
} {el3
783
el4
784
el5}
785
test listbox-4.4 {ConfigureListbox procedure} {
786
    catch {destroy .e}
787
    entry .e
788
    .e insert 0 abc
789
    .e select from 0
790
    .e select to 2
791
    .l configure -exportselection 0
792
    .l delete 0 end
793
    .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
794
    .l selection set 3 5
795
    .l selection clear 3 5
796
    .l configure -exportselection 1
797
    list [selection own] [selection get]
798
} {.e ab}
799
test listbox-4.5 {-exportselection option} {
800
    selection clear .
801
    .l configure -exportselection 1
802
    .l delete 0 end
803
    .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
804
    .l selection set 1 1
805
    set x {}
806
    lappend x [catch {selection get} msg] $msg [.l curselection]
807
    .l config -exportselection 0
808
    lappend x [catch {selection get} msg] $msg [.l curselection]
809
    .l selection clear 0 end
810
    lappend x [catch {selection get} msg] $msg [.l curselection]
811
    .l selection set 1 3
812
    lappend x [catch {selection get} msg] $msg [.l curselection]
813
    .l config -exportselection 1
814
    lappend x [catch {selection get} msg] $msg [.l curselection]
815
} {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1
816
el2
817
el3} {1 2 3}}
818
test listbox-4.6 {ConfigureListbox procedure} {fonts} {
819
    catch {destroy .l}
820
 
821
    # The following code (reset geometry, withdraw, etc.) is necessary
822
    # to reset the state of some window managers like olvwm under
823
    # SunOS 4.1.3.
824
 
825
    wm geom . 300x300
826
    update
827
    wm geom . {}
828
    wm withdraw .
829
    listbox .l -font $fixed -width 15 -height 20
830
    pack .l
831
    update
832
    wm deiconify .
833
    set x [getsize .]
834
    .l configure -setgrid 1
835
    update
836
    list $x [getsize .]
837
} {115x328 15x20}
838
test listbox-4.7 {ConfigureListbox procedure} {
839
    catch {destroy .l}
840
    wm withdraw .
841
    listbox .l -font $fixed -width 30 -height 20 -setgrid 1
842
    wm geom . +0+0
843
    pack .l
844
    update
845
    wm deiconify .
846
    set result [getsize .]
847
    wm geom . 26x15
848
    update
849
    lappend result [getsize .]
850
    .l configure -setgrid 1
851
    update
852
    lappend result [getsize .]
853
} {30x20 26x15 26x15}
854
wm geom . {}
855
catch {destroy .l}
856
resetGridInfo
857
test listbox-4.8 {ConfigureListbox procedure} {
858
    catch {destroy .l}
859
    listbox .l -width 15 -height 20 -xscrollcommand "record x" \
860
            -yscrollcommand "record y"
861
    pack .l
862
    update
863
    .l configure -fg black
864
    set log {}
865
    update
866
    set log
867
} {{y 0 1} {x 0 1}}
868
 
869
# No tests for DisplayListbox:  I don't know how to test this procedure.
870
 
871
test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} {
872
    catch {destroy .l}
873
    listbox .l -font $fixed -width 15 -height 20
874
    pack .l
875
    list [winfo reqwidth .l] [winfo reqheight .l]
876
} {115 328}
877
test listbox-5.2 {ListboxComputeGeometry procedure} {fonts} {
878
    catch {destroy .l}
879
    listbox .l -font $fixed -width 0 -height 10
880
    pack .l
881
    update
882
    list [winfo reqwidth .l] [winfo reqheight .l]
883
} {17 168}
884
test listbox-5.3 {ListboxComputeGeometry procedure} {fonts} {
885
    catch {destroy .l}
886
    listbox .l -font $fixed -width 0 -height 10 -bd 3
887
    .l insert 0 Short "Really much longer" Longer
888
    pack .l
889
    update
890
    list [winfo reqwidth .l] [winfo reqheight .l]
891
} {138 170}
892
test listbox-5.4 {ListboxComputeGeometry procedure} {fonts} {
893
    catch {destroy .l}
894
    listbox .l -font $fixed -width 10 -height 0
895
    pack .l
896
    update
897
    list [winfo reqwidth .l] [winfo reqheight .l]
898
} {80 24}
899
test listbox-5.5 {ListboxComputeGeometry procedure} {fonts} {
900
    catch {destroy .l}
901
    listbox .l -font $fixed -width 10 -height 0 -highlightthickness 0
902
    .l insert 0 Short "Really much longer" Longer
903
    pack .l
904
    update
905
    list [winfo reqwidth .l] [winfo reqheight .l]
906
} {76 52}
907
test listbox-5.6 {ListboxComputeGeometry procedure} {
908
    # If "0" in selected font had 0 width, caused divide-by-zero error.
909
 
910
    catch {destroy .l}
911
    pack [listbox .l -font {{open look glyph}}]
912
    update
913
} {}
914
 
915
 
916
catch {destroy .l}
917
listbox .l -height 2 -xscrollcommand "record x" -yscrollcommand "record y"
918
pack .l
919
update
920
test listbox-6.1 {InsertEls procedure} {
921
    .l delete 0 end
922
    .l insert end a b c d
923
    .l insert 5 x y z
924
    .l insert 2 A
925
    .l insert 0 q r s
926
    .l get 0 end
927
} {q r s a b A c d x y z}
928
test listbox-6.2 {InsertEls procedure} {
929
    .l delete 0 end
930
    .l insert 0 a b c d e f g h i j
931
    .l selection anchor 2
932
    .l insert 2 A B
933
    .l index anchor
934
} {4}
935
test listbox-6.3 {InsertEls procedure} {
936
    .l delete 0 end
937
    .l insert 0 a b c d e f g h i j
938
    .l selection anchor 2
939
    .l insert 3 A B
940
    .l index anchor
941
} {2}
942
test listbox-6.4 {InsertEls procedure} {
943
    .l delete 0 end
944
    .l insert 0 a b c d e f g h i j
945
    .l yview 3
946
    update
947
    .l insert 2 A B
948
    .l index @0,0
949
} {5}
950
test listbox-6.5 {InsertEls procedure} {
951
    .l delete 0 end
952
    .l insert 0 a b c d e f g h i j
953
    .l yview 3
954
    update
955
    .l insert 3 A B
956
    .l index @0,0
957
} {3}
958
test listbox-6.6 {InsertEls procedure} {
959
    .l delete 0 end
960
    .l insert 0 a b c d e f g h i j
961
    .l activate 5
962
    .l insert 5 A B
963
    .l index active
964
} {7}
965
test listbox-6.7 {InsertEls procedure} {
966
    .l delete 0 end
967
    .l insert 0 a b c d e f g h i j
968
    .l activate 5
969
    .l insert 6 A B
970
    .l index active
971
} {5}
972
test listbox-6.8 {InsertEls procedure} {
973
    .l delete 0 end
974
    .l insert 0 a b c
975
    .l index active
976
} {2}
977
test listbox-6.9 {InsertEls procedure} {
978
    .l delete 0 end
979
    .l insert 0
980
    .l index active
981
} {0}
982
test listbox-6.10 {InsertEls procedure} {
983
    .l delete 0 end
984
    .l insert 0 a b "two words"  c d e f g h i j
985
    update
986
    set log {}
987
    .l insert 0 word
988
    update
989
    set log
990
} {{y 0 0.166667}}
991
test listbox-6.11 {InsertEls procedure} {
992
    .l delete 0 end
993
    .l insert 0 a b "two words"  c d e f g h i j
994
    update
995
    set log {}
996
    .l insert 0 "much longer entry"
997
    update
998
    set log
999
} {{y 0 0.166667} {x 0 1}}
1000
test listbox-6.12 {InsertEls procedure} {fonts} {
1001
    catch {destroy .l2}
1002
    listbox .l2 -width 0 -height 0
1003
    pack .l2 -side top
1004
    .l2 insert 0 a b "two words"  c d
1005
    set x {}
1006
    lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
1007
    .l2 insert 0 "much longer entry"
1008
    lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
1009
} {80 93 122 110}
1010
 
1011
test listbox-7.1 {DeleteEls procedure} {
1012
    .l delete 0 end
1013
    .l insert 0 a b c d e f g h i j
1014
    .l selection set 1 6
1015
    .l delete 4 3
1016
    list [.l size] [selection get]
1017
} {10 {b
1018
c
1019
d
1020
e
1021
f
1022
g}}
1023
test listbox-7.2 {DeleteEls procedure} {
1024
    .l delete 0 end
1025
    .l insert 0 a b c d e f g h i j
1026
    .l selection set 3 6
1027
    .l delete 4 4
1028
    list [.l size] [.l get 4] [.l curselection]
1029
} {9 f {3 4 5}}
1030
test listbox-7.3 {DeleteEls procedure} {
1031
    .l delete 0 end
1032
    .l insert 0 a b c d e f g h i j
1033
    .l delete 0 3
1034
    list [.l size] [.l get 0] [.l get 1]
1035
} {6 e f}
1036
test listbox-7.4 {DeleteEls procedure} {
1037
    .l delete 0 end
1038
    .l insert 0 a b c d e f g h i j
1039
    .l delete 8 1000
1040
    list [.l size] [.l get 7]
1041
} {8 h}
1042
test listbox-7.5 {DeleteEls procedure} {
1043
    .l delete 0 end
1044
    .l insert 0 a b c d e f g h i j
1045
    .l selection anchor 2
1046
    .l delete 0 1
1047
    .l index anchor
1048
} {0}
1049
test listbox-7.6 {DeleteEls procedure} {
1050
    .l delete 0 end
1051
    .l insert 0 a b c d e f g h i j
1052
    .l selection anchor 2
1053
    .l delete 2
1054
    .l index anchor
1055
} {2}
1056
test listbox-7.7 {DeleteEls procedure} {
1057
    .l delete 0 end
1058
    .l insert 0 a b c d e f g h i j
1059
    .l selection anchor 4
1060
    .l delete 2 5
1061
    .l index anchor
1062
} {2}
1063
test listbox-7.8 {DeleteEls procedure} {
1064
    .l delete 0 end
1065
    .l insert 0 a b c d e f g h i j
1066
    .l selection anchor 3
1067
    .l delete 4 5
1068
    .l index anchor
1069
} {3}
1070
test listbox-7.9 {DeleteEls procedure} {
1071
    .l delete 0 end
1072
    .l insert 0 a b c d e f g h i j
1073
    .l yview 3
1074
    update
1075
    .l delete 1 2
1076
    .l index @0,0
1077
} {1}
1078
test listbox-7.10 {DeleteEls procedure} {
1079
    .l delete 0 end
1080
    .l insert 0 a b c d e f g h i j
1081
    .l yview 3
1082
    update
1083
    .l delete 3 4
1084
    .l index @0,0
1085
} {3}
1086
test listbox-7.11 {DeleteEls procedure} {
1087
    .l delete 0 end
1088
    .l insert 0 a b c d e f g h i j
1089
    .l yview 3
1090
    update
1091
    .l delete 4 6
1092
    .l index @0,0
1093
} {3}
1094
test listbox-7.12 {DeleteEls procedure} {
1095
    .l delete 0 end
1096
    .l insert 0 a b c d e f g h i j
1097
    .l yview 3
1098
    update
1099
    .l delete 3 end
1100
    .l index @0,0
1101
} {1}
1102
test listbox-7.13 {DeleteEls procedure, updating view with partial last line} {
1103
    mkPartial
1104
    .partial.l yview 8
1105
    update
1106
    .partial.l delete 10 13
1107
    .partial.l index @0,0
1108
} {7}
1109
test listbox-7.14 {DeleteEls procedure} {
1110
    .l delete 0 end
1111
    .l insert 0 a b c d e f g h i j
1112
    .l activate 6
1113
    .l delete 3 4
1114
    .l index active
1115
} {4}
1116
test listbox-7.15 {DeleteEls procedure} {
1117
    .l delete 0 end
1118
    .l insert 0 a b c d e f g h i j
1119
    .l activate 6
1120
    .l delete 5 7
1121
    .l index active
1122
} {5}
1123
test listbox-7.16 {DeleteEls procedure} {
1124
    .l delete 0 end
1125
    .l insert 0 a b c d e f g h i j
1126
    .l activate 6
1127
    .l delete 5 end
1128
    .l index active
1129
} {4}
1130
test listbox-7.17 {DeleteEls procedure} {
1131
    .l delete 0 end
1132
    .l insert 0 a b c d e f g h i j
1133
    .l activate 6
1134
    .l delete 0 end
1135
    .l index active
1136
} {0}
1137
test listbox-7.18 {DeleteEls procedure} {
1138
    .l delete 0 end
1139
    .l insert 0 a b c "two words" d e f g h i j
1140
    update
1141
    set log {}
1142
    .l delete 4 6
1143
    update
1144
    set log
1145
} {{y 0 0.25}}
1146
test listbox-7.19 {DeleteEls procedure} {
1147
    .l delete 0 end
1148
    .l insert 0 a b c "two words" d e f g h i j
1149
    update
1150
    set log {}
1151
    .l delete 3
1152
    update
1153
    set log
1154
} {{y 0 0.2} {x 0 1}}
1155
test listbox-7.20 {DeleteEls procedure} {fonts} {
1156
    catch {destroy .l2}
1157
    listbox .l2 -width 0 -height 0
1158
    pack .l2 -side top
1159
    .l2 insert 0 a b "two words" c d e f g
1160
    set x {}
1161
    lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
1162
    .l2 delete 2 4
1163
    lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
1164
} {80 144 17 93}
1165
catch {destroy .l2}
1166
 
1167
test listbox-8.1 {ListboxEventProc procedure} {fonts} {
1168
    catch {destroy .l}
1169
    listbox .l -setgrid 1
1170
    pack .l
1171
    update
1172
    set x [getsize .]
1173
    destroy .l
1174
    list $x [getsize .] [winfo exists .l] [info command .l]
1175
} {20x10 150x178 0 {}}
1176
resetGridInfo
1177
test listbox-8.2 {ListboxEventProc procedure} {fonts} {
1178
    catch {destroy .l}
1179
    listbox .l -height 5 -width 10
1180
    .l insert 0 a b c "A string that is very very long" d e f g h i j k
1181
    pack .l
1182
    update
1183
    place .l -width 50 -height 80
1184
    update
1185
    list [.l xview] [.l yview]
1186
} {{0 0.222222} {0 0.333333}}
1187
test listbox-8.3 {ListboxEventProc procedure} {
1188
    eval destroy [winfo children .]
1189
    listbox .l1 -bg #543210
1190
    rename .l1 .l2
1191
    set x {}
1192
    lappend x [winfo children .]
1193
    lappend x [.l2 cget -bg]
1194
    destroy .l1
1195
    lappend x [info command .l*] [winfo children .]
1196
} {.l1 #543210 {} {}}
1197
 
1198
test listbox-9.1 {ListboxCmdDeletedProc procedure} {
1199
    eval destroy [winfo children .]
1200
    listbox .l1
1201
    rename .l1 {}
1202
    list [info command .l*] [winfo children .]
1203
} {{} {}}
1204
test listbox-9.2 {ListboxCmdDeletedProc procedure, disabling -setgrid} fonts {
1205
    catch {destroy .top}
1206
    toplevel .top
1207
    wm geom .top +0+0
1208
    listbox .top.l -setgrid 1 -width 20 -height 10
1209
    pack .top.l
1210
    update
1211
    set x [wm geometry .top]
1212
    rename .top.l {}
1213
    update
1214
    lappend x [wm geometry .top]
1215
    destroy .top
1216
    set x
1217
} {20x10+0+0 150x178+0+0}
1218
 
1219
catch {destroy .l}
1220
listbox .l
1221
pack .l
1222
.l delete 0 end
1223
.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
1224
test listbox-10.1 {GetListboxIndex procedure} {
1225
    .l activate 3
1226
    list [.l activate 3; .l index active] [.l activate 6; .l index active]
1227
} {3 6}
1228
test listbox-10.2 {GetListboxIndex procedure} {
1229
    .l selection anchor 2
1230
    .l index anchor
1231
} 2
1232
test listbox-10.3 {GetListboxIndex procedure} {
1233
    .l insert end A B C D E
1234
    .l selection anchor end
1235
    .l delete 12 end
1236
    list [.l index anchor] [.l index end]
1237
} {12 12}
1238
test listbox-10.4 {GetListboxIndex procedure} {
1239
    list [catch {.l index a} msg] $msg
1240
} {1 {bad listbox index "a": must be active, anchor, end, @x,y, or a number}}
1241
test listbox-10.5 {GetListboxIndex procedure} {
1242
    .l index end
1243
} {12}
1244
test listbox-10.6 {GetListboxIndex procedure} {
1245
    .l get end
1246
} {el11}
1247
test listbox-10.7 {GetListboxIndex procedure} {
1248
    .l delete 0 end
1249
    .l index end
1250
} 0
1251
.l delete 0 end
1252
.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
1253
update
1254
test listbox-10.8 {GetListboxIndex procedure} {
1255
    list [catch {.l index @} msg] $msg
1256
} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}}
1257
test listbox-10.9 {GetListboxIndex procedure} {
1258
    list [catch {.l index @foo} msg] $msg
1259
} {1 {bad listbox index "@foo": must be active, anchor, end, @x,y, or a number}}
1260
test listbox-10.10 {GetListboxIndex procedure} {
1261
    list [catch {.l index @1x3} msg] $msg
1262
} {1 {bad listbox index "@1x3": must be active, anchor, end, @x,y, or a number}}
1263
test listbox-10.11 {GetListboxIndex procedure} {
1264
    list [catch {.l index @1,} msg] $msg
1265
} {1 {bad listbox index "@1,": must be active, anchor, end, @x,y, or a number}}
1266
test listbox-10.12 {GetListboxIndex procedure} {
1267
    list [catch {.l index @1,foo} msg] $msg
1268
} {1 {bad listbox index "@1,foo": must be active, anchor, end, @x,y, or a number}}
1269
test listbox-10.13 {GetListboxIndex procedure} {
1270
    list [catch {.l index @1,2x} msg] $msg
1271
} {1 {bad listbox index "@1,2x": must be active, anchor, end, @x,y, or a number}}
1272
test listbox-10.14 {GetListboxIndex procedure} {fonts} {
1273
    list [.l index @5,57] [.l index @5,58]
1274
} {3 3}
1275
test listbox-10.15 {GetListboxIndex procedure} {
1276
    list [catch {.l index 1xy} msg] $msg
1277
} {1 {bad listbox index "1xy": must be active, anchor, end, @x,y, or a number}}
1278
test listbox-10.16 {GetListboxIndex procedure} {
1279
    .l index 3
1280
} {3}
1281
test listbox-10.17 {GetListboxIndex procedure} {
1282
    .l index 20
1283
} {20}
1284
test listbox-10.18 {GetListboxIndex procedure} {
1285
    .l get 20
1286
} {}
1287
test listbox-10.19 {GetListboxIndex procedure} {
1288
    .l index -2
1289
} -2
1290
test listbox-10.20 {GetListboxIndex procedure} {
1291
    .l delete 0 end
1292
    .l index 1
1293
} 1
1294
 
1295
test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} {
1296
    catch {destroy .l}
1297
    listbox .l -height 5
1298
    pack .l
1299
    .l insert 0 a b c d e f g h i j
1300
    .l yview 3
1301
    update
1302
    set x [.l index @0,0]
1303
    .l yview -1
1304
    update
1305
    lappend x [.l index @0,0]
1306
} {3 0}
1307
test listbox-11.2 {ChangeListboxView procedure, boundary conditions for index} {
1308
    catch {destroy .l}
1309
    listbox .l -height 5
1310
    pack .l
1311
    .l insert 0 a b c d e f g h i j
1312
    .l yview 3
1313
    update
1314
    set x [.l index @0,0]
1315
    .l yview 20
1316
    update
1317
    lappend x [.l index @0,0]
1318
} {3 5}
1319
test listbox-11.3 {ChangeListboxView procedure} {
1320
    catch {destroy .l}
1321
    listbox .l -height 5 -yscrollcommand "record y"
1322
    pack .l
1323
    .l insert 0 a b c d e f g h i j
1324
    update
1325
    set log {}
1326
    .l yview 2
1327
    update
1328
    list [.l yview] $log
1329
}  {{0.2 0.7} {{y 0.2 0.7}}}
1330
test listbox-11.4 {ChangeListboxView procedure} {
1331
    catch {destroy .l}
1332
    listbox .l -height 5 -yscrollcommand "record y"
1333
    pack .l
1334
    .l insert 0 a b c d e f g h i j
1335
    update
1336
    set log {}
1337
    .l yview 8
1338
    update
1339
    list [.l yview] $log
1340
}  {{0.5 1} {{y 0.5 1}}}
1341
test listbox-11.5 {ChangeListboxView procedure} {
1342
    catch {destroy .l}
1343
    listbox .l -height 5 -yscrollcommand "record y"
1344
    pack .l
1345
    .l insert 0 a b c d e f g h i j
1346
    .l yview 3
1347
    update
1348
    set log {}
1349
    .l yview 3
1350
    update
1351
    list [.l yview] $log
1352
}  {{0.3 0.8} {}}
1353
test listbox-11.6 {ChangeListboxView procedure, partial last line} {
1354
    mkPartial
1355
    .partial.l yview 13
1356
    .partial.l index @0,0
1357
} {11}
1358
 
1359
catch {destroy .l}
1360
listbox .l -font $fixed -xscrollcommand "record x" -width 10
1361
.l insert 0 0123456789a123456789b123456789c123456789d123456789e123456789f123456789g123456789h123456789i123456789
1362
pack .l
1363
update
1364
test listbox-12.1 {ChangeListboxOffset procedure} {fonts} {
1365
    set log {}
1366
    .l xview 99
1367
    update
1368
    list [.l xview] $log
1369
} {{0.9 1} {{x 0.9 1}}}
1370
test listbox-12.2 {ChangeListboxOffset procedure} {fonts} {
1371
    set log {}
1372
    .l xview moveto -.25
1373
    update
1374
    list [.l xview] $log
1375
} {{0 0.1} {{x 0 0.1}}}
1376
test listbox-12.3 {ChangeListboxOffset procedure} {fonts} {
1377
    .l xview 10
1378
    update
1379
    set log {}
1380
    .l xview 10
1381
    update
1382
    list [.l xview] $log
1383
} {{0.1 0.2} {}}
1384
 
1385
catch {destroy .l}
1386
listbox .l -font $fixed -width 10 -height 5
1387
pack .l
1388
.l insert 0 a bb c d e f g h i j k l m n o p q r s
1389
.l insert 0 0123456789a123456789b123456789c123456789d123456789
1390
update
1391
set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]]
1392
set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]]
1393
test listbox-13.1 {ListboxScanTo procedure} {fonts} {
1394
    .l yview 0
1395
    .l xview 0
1396
    .l scan mark 10 20
1397
    .l scan dragto [expr 10-$width] [expr 20-$height]
1398
    update
1399
    list [.l xview] [.l yview]
1400
} {{0.2 0.4} {0.5 0.75}}
1401
test listbox-13.2 {ListboxScanTo procedure} {fonts} {
1402
    .l yview 5
1403
    .l xview 10
1404
    .l scan mark 10 20
1405
    .l scan dragto 20 40
1406
    update
1407
    set x [list [.l xview] [.l yview]]
1408
    .l scan dragto [expr 20-$width] [expr 40-$height]
1409
    update
1410
    lappend x [.l xview] [.l yview]
1411
} {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}}
1412
test listbox-13.3 {ListboxScanTo procedure} {fonts} {
1413
    .l yview moveto 1.0
1414
    .l xview moveto 1.0
1415
    .l scan mark 10 20
1416
    .l scan dragto 5 10
1417
    update
1418
    set x [list [.l xview] [.l yview]]
1419
    .l scan dragto [expr 5+$width] [expr 10+$height]
1420
    update
1421
    lappend x [.l xview] [.l yview]
1422
} {{0.8 1} {0.75 1} {0.62 0.82} {0.25 0.5}}
1423
 
1424
test listbox-14.1 {NearestListboxElement procedure, partial last line} {
1425
    mkPartial
1426
    .partial.l nearest [winfo height .partial.l]
1427
} {4}
1428
catch {destroy .l}
1429
listbox .l -font $fixed -width 20 -height 10
1430
.l insert 0 a b c d e f g h i j k l m n o p q r s t
1431
.l yview 4
1432
pack .l
1433
update
1434
test listbox-14.2 {NearestListboxElement procedure} {fonts} {
1435
    .l index @50,0
1436
} {4}
1437
test listbox-14.3 {NearestListboxElement procedure} {fonts} {
1438
    list [.l index @50,35] [.l index @50,36]
1439
} {5 6}
1440
test listbox-14.4 {NearestListboxElement procedure} {fonts} {
1441
    .l index @50,200
1442
} {13}
1443
 
1444
test listbox-15.1 {ListboxSelect procedure} {
1445
    .l delete 0 end
1446
    .l insert 0 a b c d e f g h i j k l m n o p
1447
    .l select set 2 4
1448
    .l select set 7 12
1449
    .l select clear 4 7
1450
    .l curselection
1451
} {2 3 8 9 10 11 12}
1452
test listbox-15.2 {ListboxSelect procedure} {
1453
    .l delete 0 end
1454
    .l insert 0 a b c d e f g h i j k l m n o p
1455
    catch {destroy .e}
1456
    entry .e
1457
    .e insert 0 "This is some text"
1458
    .e select from 0
1459
    .e select to 7
1460
    .l selection clear 2 4
1461
    set x [selection own]
1462
    .l selection set 3
1463
    list $x [selection own] [selection get]
1464
} {.e .l d}
1465
test listbox-15.3 {ListboxSelect procedure} {
1466
    .l delete 0 end
1467
    .l selection clear 0 end
1468
    .l select set 0 end
1469
    .l curselection
1470
} {}
1471
test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} {
1472
    .l delete 0 end
1473
    .l insert 0 a b c d e f
1474
    .l select clear 0 end
1475
    .l select set -2 -1
1476
    .l curselection
1477
} {}
1478
test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} {
1479
    .l delete 0 end
1480
    .l insert 0 a b c d e f
1481
    .l select clear 0 end
1482
    .l select set -1 3
1483
    .l curselection
1484
} {0 1 2 3}
1485
test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} {
1486
    .l delete 0 end
1487
    .l insert 0 a b c d e f
1488
    .l select clear 0 end
1489
    .l select set 2 4
1490
    .l curselection
1491
} {2 3 4}
1492
test listbox-15.7 {ListboxSelect procedure, boundary conditions for indices} {
1493
    .l delete 0 end
1494
    .l insert 0 a b c d e f
1495
    .l select clear 0 end
1496
    .l select set 4 end
1497
    .l curselection
1498
} {4 5}
1499
test listbox-15.8 {ListboxSelect procedure, boundary conditions for indices} {
1500
    .l delete 0 end
1501
    .l insert 0 a b c d e f
1502
    .l select clear 0 end
1503
    .l select set 4 30
1504
    .l curselection
1505
} {4 5}
1506
test listbox-15.9 {ListboxSelect procedure, boundary conditions for indices} {
1507
    .l delete 0 end
1508
    .l insert 0 a b c d e f
1509
    .l select clear 0 end
1510
    .l select set end 30
1511
    .l curselection
1512
} {5}
1513
test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} {
1514
    .l delete 0 end
1515
    .l insert 0 a b c d e f
1516
    .l select clear 0 end
1517
    .l select set 20 25
1518
    .l curselection
1519
} {}
1520
 
1521
test listbox-16.1 {ListboxFetchSelection procedure} {
1522
    .l delete 0 end
1523
    .l insert 0 a b c "two words" e f g h i \\ k l m n o p
1524
    .l selection set 2 4
1525
    .l selection set 9
1526
    .l selection set 11 12
1527
    selection get
1528
} "c\ntwo words\ne\n\\\nl\nm"
1529
test listbox-16.2 {ListboxFetchSelection procedure} {
1530
    .l delete 0 end
1531
    .l insert 0 a b c "two words" e f g h i \\ k l m n o p
1532
    .l selection set 3
1533
    selection get
1534
} "two words"
1535
test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} {
1536
    set long "This is quite a long string\n"
1537
    append long $long $long $long $long
1538
    append long $long $long $long $long
1539
    append long $long $long
1540
    .l delete 0 end
1541
    .l insert 0 1$long 2$long 3$long 4$long 5$long
1542
    .l selection set 0 end
1543
    set sel [selection get]
1544
    string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel
1545
} {0}
1546
catch {unset long sel}
1547
 
1548
test listbox-17.1 {ListboxLostSelection procedure} {
1549
    .l delete 0 end
1550
    .l insert 0 a b c d e
1551
    .l select set 0 end
1552
    catch {destroy .e}
1553
    entry .e
1554
    .e insert 0 "This is some text"
1555
    .e select from 0
1556
    .e select to 5
1557
    .l curselection
1558
} {}
1559
test listbox-17.2 {ListboxLostSelection procedure} {
1560
    .l delete 0 end
1561
    .l insert 0 a b c d e
1562
    .l select set 0 end
1563
    .l configure -exportselection 0
1564
    catch {destroy .e}
1565
    entry .e
1566
    .e insert 0 "This is some text"
1567
    .e select from 0
1568
    .e select to 5
1569
    .l curselection
1570
} {0 1 2 3 4}
1571
 
1572
catch {destroy .l}
1573
listbox .l -font $fixed -width 10 -height 5
1574
pack .l
1575
update
1576
test listbox-18.1 {ListboxUpdateVScrollbar procedure} {
1577
    .l configure -yscrollcommand "record y"
1578
    set log {}
1579
    .l insert 0 a b c
1580
    update
1581
    .l insert end d e f g h
1582
    update
1583
    .l delete 0 end
1584
    update
1585
    set log
1586
} {{y 0 1} {y 0 0.625} {y 0 1}}
1587
test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} {
1588
    mkPartial
1589
    .partial.l configure -yscrollcommand "record y"
1590
    set log {}
1591
    .partial.l yview 3
1592
    update
1593
    set log
1594
} {{y 0.2 0.466667}}
1595
test listbox-18.3 {ListboxUpdateVScrollbar procedure} {
1596
    proc bgerror args {
1597
        global x errorInfo
1598
        set x [list $args $errorInfo]
1599
    }
1600
    .l configure -yscrollcommand gorp
1601
    .l insert 0 foo
1602
    update
1603
    set x
1604
} {{{invalid command name "gorp"}} {invalid command name "gorp"
1605
    while executing
1606
"gorp 0 1"
1607
    (vertical scrolling command executed by listbox)}}
1608
if {[info exists bgerror]} {
1609
    rename bgerror {}
1610
}
1611
 
1612
catch {destroy .l}
1613
listbox .l -font $fixed -width 10 -height 5
1614
pack .l
1615
update
1616
test listbox-19.1 {ListboxUpdateVScrollbar procedure} {fonts} {
1617
    .l configure -xscrollcommand "record x"
1618
    set log {}
1619
    .l insert 0 abc
1620
    update
1621
    .l insert 0 "This is a much longer string..."
1622
    update
1623
    .l delete 0 end
1624
    update
1625
    set log
1626
} {{x 0 1} {x 0 0.322581} {x 0 1}}
1627
test listbox-19.2 {ListboxUpdateVScrollbar procedure} {
1628
    proc bgerror args {
1629
        global x errorInfo
1630
        set x [list $args $errorInfo]
1631
    }
1632
    .l configure -xscrollcommand bogus
1633
    .l insert 0 foo
1634
    update
1635
    set x
1636
} {{{invalid command name "bogus"}} {invalid command name "bogus"
1637
    while executing
1638
"bogus 0 1"
1639
    (horizontal scrolling command executed by listbox)}}
1640
 
1641
set l [interp hidden]
1642
eval destroy [winfo children .]
1643
 
1644
test listbox-20.1 {listbox vs hidden commands} {
1645
    catch {destroy .l}
1646
    listbox .l
1647
    interp hide {} .l
1648
    destroy .l
1649
    list [winfo children .] [interp hidden]
1650
} [list {} $l]
1651
 
1652
resetGridInfo
1653
catch {destroy .l2}
1654
catch {destroy .t}
1655
catch {destroy .e}
1656
catch {destroy .partial}
1657
option clear
1658
 

powered by: WebSVN 2.1.0

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