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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [bind.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 "bind" and "bindtags"
2
# commands plus the procedures in tkBind.c.  It is organized in the
3
# standard fashion for Tcl tests.
4
#
5
# Copyright (c) 1994 The Regents of the University of California.
6
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
7
# Copyright (c) 1998 by Scriptics Corporation.
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: bind.test,v 1.1.1.1 2002-01-16 10:25:58 markom Exp $
13
 
14
if {[string compare test [info procs test]] != 0} {
15
    source defs
16
}
17
 
18
catch {destroy .b}
19
toplevel .b -width 100 -height 50
20
wm geom .b +0+0
21
update idletasks
22
 
23
proc setup {} {
24
    catch {destroy .b.f}
25
    frame .b.f -class Test -width 150 -height 100
26
    pack .b.f
27
    focus -force .b.f
28
    foreach p [event info] {event delete $p}
29
    update
30
}
31
setup
32
 
33
foreach i [bind Test] {
34
    bind Test $i {}
35
}
36
foreach i [bind all] {
37
    bind all $i {}
38
}
39
 
40
test bind-1.1 {bind command} {
41
    list [catch {bind} msg] $msg
42
} {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
43
test bind-1.2 {bind command} {
44
    list [catch {bind a b c d} msg] $msg
45
} {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
46
test bind-1.3 {bind command} {
47
    list [catch {bind .gorp} msg] $msg
48
} {1 {bad window path name ".gorp"}}
49
test bind-1.4 {bind command} {
50
    list [catch {bind foo} msg] $msg
51
} {0 {}}
52
test bind-1.5 {bind command} {
53
    list [catch {bind .b  {}} msg] $msg
54
} {0 {}}
55
test bind-1.6 {bind command} {
56
    catch {destroy .b.f}
57
    frame .b.f
58
    bind .b.f  {test script}
59
    set result [bind .b.f ]
60
    bind .b.f  {}
61
    list $result [bind .b.f ]
62
} {{test script} {}}
63
test bind-1.7 {bind command} {
64
    catch {destroy .b.f}
65
    frame .b.f
66
    bind .b.f  {test script}
67
    bind .b.f  {+more text}
68
    bind .b.f 
69
} {test script
70
more text}
71
test bind-1.8 {bind command} {
72
    list [catch {bind .b  {test script}} msg] $msg [bind .b]
73
} {1 {bad event type or keysym "gorp"} {}}
74
test bind-1.9 {bind command} {
75
    list [catch {bind .b } msg] $msg
76
} {0 {}}
77
test bind-1.10 {bind command} {
78
    catch {destroy .b.f}
79
    frame .b.f
80
    bind .b.f  {script 1}
81
    bind .b.f  {script 2}
82
    bind .b.f a {script for a}
83
    bind .b.f b {script for b}
84
    lsort [bind .b.f]
85
} {  a b}
86
 
87
test bind-2.1 {bindtags command} {
88
    list [catch {bindtags} msg] $msg
89
} {1 {wrong # args: should be "bindtags window ?tags?"}}
90
test bind-2.2 {bindtags command} {
91
    list [catch {bindtags a b c} msg] $msg
92
} {1 {wrong # args: should be "bindtags window ?tags?"}}
93
test bind-2.3 {bindtags command} {
94
    list [catch {bindtags .foo} msg] $msg
95
} {1 {bad window path name ".foo"}}
96
test bind-2.4 {bindtags command} {
97
    bindtags .b
98
} {.b Toplevel all}
99
test bind-2.5 {bindtags command} {
100
    catch {destroy .b.f}
101
    frame .b.f
102
    bindtags .b.f
103
} {.b.f Frame .b all}
104
test bind-2.6 {bindtags command} {
105
    catch {destroy .b.f}
106
    frame .b.f
107
    bindtags .b.f {{x y z} b c d}
108
    bindtags .b.f
109
} {{x y z} b c d}
110
test bind-2.7 {bindtags command} {
111
    catch {destroy .b.f}
112
    frame .b.f
113
    bindtags .b.f {x y z}
114
    bindtags .b.f {}
115
    bindtags .b.f
116
} {.b.f Frame .b all}
117
test bind-2.8 {bindtags command} {
118
    catch {destroy .b.f}
119
    frame .b.f
120
    bindtags .b.f {x y z}
121
    bindtags .b.f {a b c d}
122
    bindtags .b.f
123
} {a b c d}
124
test bind-2.9 {bindtags command} {
125
    catch {destroy .b.f}
126
    frame .b.f
127
    bindtags .b.f {a b c}
128
    list [catch {bindtags .b.f "\{"} msg] $msg [bindtags .b.f]
129
} {1 {unmatched open brace in list} {.b.f Frame .b all}}
130
test bind-2.10 {bindtags command} {
131
    catch {destroy .b.f}
132
    frame .b.f
133
    bindtags .b.f {a b c}
134
    list [catch {bindtags .b.f "a .gorp b"} msg] $msg [bindtags .b.f]
135
} {0 {} {a .gorp b}}
136
test bind-3.1 {TkFreeBindingTags procedure} {
137
    catch {destroy .b.f}
138
    frame .b.f
139
    bindtags .b.f "a b c d"
140
    destroy .b.f
141
} {}
142
test bind-3.2 {TkFreeBindingTags procedure} {
143
    catch {destroy .b.f}
144
    frame .b.f
145
    catch {bindtags .b.f "a .gorp b .b.f"}
146
    destroy .b.f
147
} {}
148
 
149
bind all  {lappend x "%W enter all"}
150
bind Test  {lappend x "%W enter frame"}
151
bind Toplevel  {lappend x "%W enter toplevel"}
152
bind xyz  {lappend x "%W enter xyz"}
153
bind {a b}  {lappend x "%W enter {a b}"}
154
bind .b   {lappend x "%W enter .b"}
155
test bind-4.1 {TkBindEventProc procedure} {
156
    catch {destroy .b.f}
157
    frame .b.f -class Test -width 150 -height 100
158
    pack .b.f
159
    update
160
    bind .b.f  {lappend x "%W enter .b.f"}
161
    set x {}
162
    event gen .b.f 
163
    set x
164
} {{.b.f enter .b.f} {.b.f enter frame} {.b.f enter .b} {.b.f enter all}}
165
test bind-4.2 {TkBindEventProc procedure} {
166
    catch {destroy .b.f}
167
    frame .b.f -class Test -width 150 -height 100
168
    pack .b.f
169
    update
170
    bind .b.f  {lappend x "%W enter .b.f"}
171
    bindtags .b.f {.b.f {a b} xyz}
172
    set x {}
173
    event gen .b.f 
174
    set x
175
} {{.b.f enter .b.f} {.b.f enter {a b}} {.b.f enter xyz}}
176
test bind-4.3 {TkBindEventProc procedure} {
177
    set x {}
178
    event gen .b 
179
    set x
180
} {{.b enter .b} {.b enter toplevel} {.b enter all}}
181
test bind-4.4 {TkBindEventProc procedure} {
182
    catch {destroy .b.f}
183
    frame .b.f -class Test -width 150 -height 100
184
    pack .b.f
185
    update
186
    bindtags .b.f {.b.f .b.f2 .b.f3}
187
    frame .b.f3 -width 50 -height 50
188
    pack .b.f3
189
    bind .b.f  {lappend x "%W enter .b.f"}
190
    bind .b.f3  {lappend x "%W enter .b.f3"}
191
    set x {}
192
    event gen .b.f 
193
    destroy .b.f3
194
    set x
195
} {{.b.f enter .b.f} {.b.f enter .b.f3}}
196
test bind-4.5 {TkBindEventProc procedure} {
197
    # This tests memory allocation for objPtr;  it won't serve any useful
198
    # purpose unless run with some sort of allocation checker turned on.
199
    catch {destroy .b.f}
200
    frame .b.f -class Test -width 150 -height 100
201
    pack .b.f
202
    update
203
    bindtags .b.f {a b c d e f g h i j k l m n o p q r s t u v w x y z}
204
    event gen .b.f 
205
} {}
206
bind all  {}
207
bind Test  {}
208
bind Toplevel  {}
209
bind xyz  {}
210
bind {a b}  {}
211
bind .b  {}
212
 
213
test bind-5.1 {Tk_CreateBindingTable procedure} {
214
    catch {destroy .b.c}
215
    canvas .b.c
216
    .b.c bind foo
217
} {}
218
 
219
 
220
if {[string compare testcbind [info commands testcbind]] != 0} {
221
    puts "This application hasn't been compiled with the testcbind command,"
222
    puts "therefore I am skipping all of these tests."
223
    return
224
}
225
 
226
test bind-6.1 {Tk_DeleteBindTable procedure} {
227
    catch {destroy .b.c}
228
    canvas .b.c
229
    .b.c bind foo <1> {string 1}
230
    .b.c create rectangle 0 0 100 100
231
    .b.c bind 1 <2> {string 2}
232
    destroy .b.c
233
} {}
234
test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} {
235
    catch {interp delete foo}
236
    interp create foo
237
    foo eval {
238
        load {} Tk
239
        load {} Tktest
240
        wm geometry . +0+0
241
        frame .t -width 50 -height 50
242
        bindtags .t {a b c d}
243
        pack .t
244
        update
245
        set x {}
246
        testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1"
247
        bind b <1> "lappend x b1"
248
        testcbind c <1> "lappend x c1" "lappend x bye.c1"
249
        testcbind c <2> "lappend x all2" "lappend x bye.all2"
250
        event gen .t <1>
251
    }
252
    set x [foo eval set x]
253
    interp delete foo
254
    set x
255
} {a1 bye.all2 bye.a1 b1 bye.c1}
256
 
257
test bind-7.1 {Tk_CreateBinding procedure: error} {
258
    catch {destroy .b.c}
259
    canvas .b.c
260
    list [catch {.b.c bind foo <} msg] $msg
261
} {1 {no event type or button # or keysym}}
262
test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} {
263
    catch {destroy .b.f}
264
    frame .b.f
265
    testcbind .b.f <1> "xyz" "lappend x bye.1"
266
    set x {}
267
    bind .b.f <1> "abc"
268
    destroy .b.f
269
    set x
270
} {bye.1}
271
test bind-7.3 {Tk_CreateBinding procedure: append} {
272
    catch {destroy .b.c}
273
    canvas .b.c
274
    .b.c bind foo <1> "button 1"
275
    .b.c bind foo <1> "+more button 1"
276
    .b.c bind foo <1>
277
} {button 1
278
more button 1}
279
test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} {
280
    catch {destroy .b.c}
281
    canvas .b.c
282
    .b.c bind foo <1> "+button 1"
283
    .b.c bind foo <1>
284
} {button 1}
285
 
286
test bind-8.1 {TkCreateBindingProcedure: error} {
287
    list [catch {testcbind .  "xyz"} msg] $msg
288
} {1 {bad event type or keysym "xyz"}}
289
test bind-8.2 {TkCreateBindingProcedure: new binding} {
290
    catch {destroy .b.f}
291
    frame .b.f
292
    testcbind .b.f <1> "lappend x 1" "lappend x bye.1"
293
    set x {}
294
    event gen .b.f <1>
295
    destroy .b.f
296
    set x
297
} {bye.1}
298
test bind-8.3 {TkCreateBindingProcedure: replace existing} {
299
    catch {destroy .b.f}
300
    frame .b.f
301
    pack .b.f
302
    set x {}
303
    testcbind .b.f <1> "lappend x old1" "lappend x bye.old1"
304
    testcbind .b.f <1> "lappend x new1" "lappend x bye.new1"
305
    set x
306
} {bye.old1}
307
test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} {
308
    catch {destroy .b.f}
309
    frame .b.f
310
    pack .b.f
311
    update
312
    testcbind .b.f <1> "lappend x .b.f; testcbind Frame <1> {lappend x Frame}"
313
    testcbind Frame <1> "lappend x never"
314
    set x {}
315
    event gen .b.f <1>
316
    bind .b.f <1> {}
317
    set x
318
} {.b.f Frame}
319
 
320
test bind-9.1 {Tk_DeleteBinding procedure} {
321
    catch {destroy .b.f}
322
    frame .b.f -class Test -width 150 -height 100
323
    list [catch {bind .b.f <} msg] $msg
324
} {0 {}}
325
test bind-9.2 {Tk_DeleteBinding procedure} {
326
    catch {destroy .b.f}
327
    frame .b.f -class Test -width 150 -height 100
328
    foreach i {a b c d} {
329
        bind .b.f $i "binding for $i"
330
    }
331
    set result {}
332
    foreach i {b d a c} {
333
        bind .b.f $i {}
334
        lappend result [lsort [bind .b.f]]
335
    }
336
    set result
337
} {{a c d} {a c} c {}}
338
test bind-9.3 {Tk_DeleteBinding procedure} {
339
    catch {destroy .b.f}
340
    frame .b.f -class Test -width 150 -height 100
341
    foreach i {<1>   } {
342
        bind .b.f $i "binding for $i"
343
    }
344
    set result {}
345
    foreach i {  <1> } {
346
        bind .b.f $i {}
347
        lappend result [lsort [bind .b.f]]
348
    }
349
    set result
350
} {{  } { }  {}}
351
test bind-9.4 {Tk_DeleteBinding procedure: pending bindings delete later} {
352
    catch {destroy .b.f}
353
    frame .b.f
354
    pack .b.f
355
    update
356
    bindtags .b.f {a b c}
357
    testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1}
358
    bind b <1> {lappend x b1}
359
    testcbind c <1> {lappend x c1} {lappend x bye.c1}
360
    testcbind c <2> {lappend x c2} {lappend x bye.c2}
361
    set x {}
362
    event gen .b.f <1>
363
    bind a <1> {}
364
    bind b <1> {}
365
    set x
366
} {a1 bye.c2 b1 bye.c1 bye.a1}
367
 
368
test bind-10.1 {Tk_GetBinding procedure} {
369
    catch {destroy .b.c}
370
    canvas .b.c
371
    list [catch {.b.c bind foo <} msg] $msg
372
} {1 {no event type or button # or keysym}}
373
test bind-10.2 {Tk_GetBinding procedure} {
374
    catch {destroy .b.c}
375
    canvas .b.c
376
    .b.c bind foo a Test
377
    .b.c bind foo a
378
} {Test}
379
test bind-10.3 {Tk_GetBinding procedure: C binding} {
380
    catch {destroy .b.f}
381
    frame .b.f
382
    testcbind .b.f <1> "foo"
383
    list [bind .b.f] [bind .b.f <1>]
384
} { {}}
385
 
386
test bind-11.1 {Tk_GetAllBindings procedure} {
387
    catch {destroy .b.f}
388
    frame .b.f -class Test -width 150 -height 100
389
    foreach i "! a \\\{ ~   <>     " {
390
        bind .b.f $i Test
391
    }
392
    lsort [bind .b.f]
393
} {! <>        a \{ ~}
394
test bind-11.2 {Tk_GetAllBindings procedure} {
395
    catch {destroy .b.f}
396
    frame .b.f -class Test -width 150 -height 100
397
    foreach i "    <1>" {
398
        bind .b.f $i Test
399
    }
400
    lsort [bind .b.f]
401
} {    }
402
test bind-11.3 {Tk_GetAllBindings procedure} {
403
    catch {destroy .b.f}
404
    frame .b.f -class Test -width 150 -height 100
405
    foreach i " abcd ab" {
406
        bind .b.f $i Test
407
    }
408
    lsort [bind .b.f]
409
} { ab abcd}
410
 
411
 
412
test bind-12.1 {Tk_DeleteAllBindings procedure} {
413
    catch {destroy .b.f}
414
    frame .b.f -class Test -width 150 -height 100
415
    destroy .b.f
416
} {}
417
test bind-12.2 {Tk_DeleteAllBindings procedure} {
418
    catch {destroy .b.f}
419
    frame .b.f -class Test -width 150 -height 100
420
    foreach i "a b c   " {
421
        bind .b.f $i x
422
    }
423
    destroy .b.f
424
} {}
425
test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} {
426
    catch {destroy .b.f}
427
    frame .b.f
428
    pack .b.f
429
    update
430
    testcbind .b.f <1> {lappend x before; event gen .b.f <2>; lappend x after} {lappend x bye.f1}
431
    testcbind .b.f <2> {destroy .b.f} {lappend x bye.f2}
432
    bind .b.f  {lappend x fDestroy}
433
    testcbind .b.f <3> {foo} {lappend x bye.f3}
434
    set x {}
435
    event gen .b.f <1>
436
    set x
437
} {before fDestroy bye.f3 bye.f2 after bye.f1}
438
 
439
bind Test  {lappend x "%W %K Test press any"}
440
bind all  {lappend x "%W %K all press any"}
441
bind Test a {lappend x "%W %K Test press a"}
442
bind all x {lappend x "%W %K all press x"}
443
 
444
test bind-13.1 {Tk_BindEvent procedure} {
445
    setup
446
    bind .b.f a {lappend x "%W %K .b.f press a"}
447
    set x {}
448
    event gen .b.f 
449
    event gen .b.f 
450
    event gen .b.f 
451
    set x
452
} {{.b.f a .b.f press a} {.b.f a Test press a} {.b.f a all press any} {.b.f b Test press any} {.b.f b all press any} {.b.f x Test press any} {.b.f x all press x}}
453
 
454
bind Test  {lappend x "%W %K Test press any"; break}
455
bind all  {continue; lappend x "%W %K all press any"}
456
 
457
test bind-13.2 {Tk_BindEvent procedure} {
458
    setup
459
    bind .b.f b {lappend x "%W %K .b.f press a"}
460
    set x {}
461
    event gen .b.f 
462
    set x
463
} {{.b.f b .b.f press a} {.b.f b Test press any}}
464
if {[info procs bgerror] == "bgerror"} {
465
    rename bgerror {}
466
}
467
proc bgerror args {}
468
bind Test  {lappend x "%W %K Test press any"; error Test}
469
test bind-13.3 {Tk_BindEvent procedure} {
470
    setup
471
    bind .b.f b {lappend x "%W %K .b.f press a"}
472
    set x {}
473
    event gen .b.f 
474
    update
475
    list $x $errorInfo
476
} {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test
477
    while executing
478
"error Test"
479
    (command bound to event)}}
480
rename bgerror {}
481
test bind-13.4 {Tk_BindEvent procedure} {
482
    proc foo {} {
483
        set x 44
484
        event gen .b.f 
485
    }
486
    setup
487
    bind .b.f a {lappend x "%W %K .b.f press a"}
488
    set x {}
489
    foo
490
    set x
491
} {{.b.f a .b.f press a} {.b.f a Test press a}}
492
test bind-13.5 {Tk_BindEvent procedure} {
493
    bind all  {lappend x "%W destroyed"}
494
    set x {}
495
    list [catch {frame .b.g -gorp foo} msg] $msg $x
496
} {1 {unknown option "-gorp"} {{.b.g destroyed}}}
497
foreach i [bind all] {
498
    bind all $i {}
499
}
500
foreach i [bind Test] {
501
    bind Test $i {}
502
}
503
test bind-13.6 {Tk_BindEvent procedure} {
504
    setup
505
    bind .b.f z {lappend x "%W z (.b.f binding)"}
506
    bind Test z {lappend x "%W z (.b.f binding)"}
507
    bind all z {bind .b.f z {}; lappend x "%W z (.b.f binding)"}
508
    set x {}
509
    event gen .b.f 
510
    bind Test z {}
511
    bind all z {}
512
    set x
513
} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
514
test bind-13.7 {Tk_BindEvent procedure} {
515
    setup
516
    bind .b.f z {lappend x "%W z (.b.f binding)"}
517
    bind Test z {lappend x "%W z (.b.f binding)"}
518
    bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"}
519
    set x {}
520
    event gen .b.f 
521
    bind Test z {}
522
    bind all z {}
523
    set x
524
} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
525
test bind-13.8 {Tk_BindEvent procedure} {
526
    setup
527
    bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"}
528
    bind .b.f  {lappend x "%W z (.b.f  binding)"}
529
    set x {}
530
    event gen .b.f 
531
    event gen .b.f 
532
    set x
533
} {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f  binding)}}
534
test bind-13.9 {Tk_BindEvent procedure: ignore NotifyInferior} {
535
    setup
536
    bind .b.f  "lappend x Enter%#"
537
    bind .b.f  "lappend x Leave%#"
538
    set x {}
539
    event gen .b.f  -serial 100 -detail NotifyAncestor
540
    event gen .b.f  -serial 101 -detail NotifyInferior
541
    event gen .b.f  -serial 102 -detail NotifyAncestor
542
    event gen .b.f  -serial 103 -detail NotifyInferior
543
    set x
544
} {Enter100 Leave102}
545
test bind-13.10 {Tk_BindEvent procedure: collapse Motions} {
546
    setup
547
    bind .b.f  "lappend x Motion%#(%x,%y)"
548
    set x {}
549
    event gen .b.f  -serial 100 -x 100 -y 200 -when tail
550
    update
551
    event gen .b.f  -serial 101 -x 200 -y 300 -when tail
552
    event gen .b.f  -serial 102 -x 300 -y 400 -when tail
553
    update
554
    set x
555
} {Motion100(100,200) Motion102(300,400)}
556
test bind-13.11 {Tk_BindEvent procedure: collapse repeating modifiers} {
557
    setup
558
    bind .b.f  "lappend x %K%#"
559
    bind .b.f  "lappend x %K%#"
560
    event gen .b.f  -serial 100 -when tail
561
    event gen .b.f  -serial 101 -when tail
562
    event gen .b.f  -serial 102 -when tail
563
    event gen .b.f  -serial 103 -when tail
564
    update
565
} {}
566
test bind-13.12 {Tk_BindEvent procedure: valid key detail} {
567
    setup
568
    bind .b.f  "lappend x Key%K"
569
    bind .b.f  "lappend x Release%K"
570
    set x {}
571
    event gen .b.f  -keysym a
572
    event gen .b.f  -keysym a
573
    set x
574
} {Keya Releasea}
575
test bind-13.13 {Tk_BindEvent procedure: invalid key detail} {
576
    setup
577
    bind .b.f  "lappend x Key%K"
578
    bind .b.f  "lappend x Release%K"
579
    set x {}
580
    event gen .b.f  -keycode 0
581
    event gen .b.f  -keycode 0
582
    set x
583
} {Key?? Release??}
584
test bind-13.14 {Tk_BindEvent procedure: button detail} {
585
    setup
586
    bind .b.f 
587
    bind .b.f  "lappend x Release%b"
588
    set x {}
589
    event gen .b.f 
590
    event gen .b.f  -button 3
591
    set x
592
} {Button1 Release3}
593
test bind-13.15 {Tk_BindEvent procedure: virtual detail} {
594
    setup
595
    bind .b.f <> "lappend x Paste"
596
    set x {}
597
    event gen .b.f <>
598
    set x
599
} {Paste}
600
test bind-13.16 {Tk_BindEvent procedure: virtual event in event stream} {
601
    setup
602
    bind .b.f <> "lappend x Paste"
603
    set x {}
604
    event gen .b.f <>
605
    set x
606
} {Paste}
607
test bind-13.17 {Tk_BindEvent procedure: match detail physical} {
608
    setup
609
    bind .b.f  {set x Button-2}
610
    event add <> 
611
    bind .b.f <> {set x Paste}
612
    set x {}
613
    event gen .b.f 
614
    set x
615
} {Button-2}
616
test bind-13.18 {Tk_BindEvent procedure: no match detail physical} {
617
    setup
618
    event add <> 
619
    bind .b.f <> {set x Paste}
620
    set x {}
621
    event gen .b.f 
622
    set x
623
} {Paste}
624
test bind-13.19 {Tk_BindEvent procedure: match detail virtual} {
625
    setup
626
    event add <> 
627
    bind .b.f <> "lappend x Paste"
628
    set x {}
629
    event gen .b.f 
630
    set x
631
} {Paste}
632
test bind-13.20 {Tk_BindEvent procedure: no match detail virtual} {
633
    setup
634
    event add <> 
635
    bind .b.f <> "lappend x Paste"
636
    set x {}
637
    event gen .b.f 
638
    set x
639
} {}
640
test bind-13.21 {Tk_BindEvent procedure: match no-detail physical} {
641
    setup
642
    bind .b.f 
643
    event add <> 
644
    bind .b.f <> {set x Paste}
645
    set x {}
646
    event gen .b.f 
647
    set x
648
} {Button}
649
test bind-13.22 {Tk_BindEvent procedure: no match no-detail physical} {
650
    setup
651
    event add <> 
652
    bind .b.f <> {set x Paste}
653
    set x {}
654
    event gen .b.f 
655
    set x
656
} {Paste}
657
test bind-13.23 {Tk_BindEvent procedure: match no-detail virtual} {
658
    setup
659
    event add <> 
660
    bind .b.f <> "lappend x Paste"
661
    set x {}
662
    event gen .b.f 
663
    set x
664
} {Paste}
665
test bind-13.24 {Tk_BindEvent procedure: no match no-detail virtual} {
666
    setup
667
    event add <> 
668
    bind .b.f <> "lappend x Paste"
669
    set x {}
670
    event gen .b.f 
671
    set x
672
} {}
673
test bind-13.25 {Tk_BindEvent procedure: precedence} {
674
    setup
675
    event add <> 
676
    event add <> 
677
    bind .b.f  "lappend x Button-2"
678
    bind .b.f <> "lappend x Paste"
679
    bind .b.f 
680
    bind .b.f <> "lappend x Copy"
681
 
682
    set x {}
683
    event gen .b.f 
684
    bind .b.f  {}
685
    event gen .b.f 
686
    bind .b.f <> {}
687
    event gen .b.f 
688
    bind .b.f 
689
    event gen .b.f 
690
    bind .b.f <> {}
691
    event gen .b.f 
692
    set x
693
} {Button-2 Paste Button Copy}
694
test bind-13.26 {Tk_BindEvent procedure: no detail virtual pattern list} {
695
    setup
696
    bind .b.f  {set x Button-2}
697
    set x {}
698
    event gen .b.f 
699
    set x
700
} {Button-2}
701
test bind-13.27 {Tk_BindEvent procedure: detail virtual pattern list} {
702
    setup
703
    event add <> 
704
    bind .b.f <> {set x Paste}
705
    set x {}
706
    event gen .b.f 
707
    set x
708
} {Paste}
709
test bind-13.28 {Tk_BindEvent procedure: no no-detail virtual pattern list} {
710
    setup
711
    bind .b.f 
712
    set x {}
713
    event gen .b.f 
714
    set x
715
} {Button}
716
test bind-13.29 {Tk_BindEvent procedure: no-detail virtual pattern list} {
717
    setup
718
    event add <> 
719
    bind .b.f <> {set x Paste}
720
    set x {}
721
    event gen .b.f 
722
    set x
723
} {Paste}
724
test bind-13.30 {Tk_BindEvent procedure: no match} {
725
    setup
726
    event gen .b.f 
727
} {}
728
test bind-13.31 {Tk_BindEvent procedure: match} {
729
    setup
730
    bind .b.f  {set x Button-2}
731
    set x {}
732
    event gen .b.f 
733
    set x
734
} {Button-2}
735
test bind-13.32 {Tk_BindEvent procedure: many C bindings cause realloc} {
736
    setup
737
    bindtags .b.f {a b c d e f g h i j k l m n o p}
738
    foreach p [bindtags .b.f] {
739
        testcbind $p <1> "lappend x $p"
740
    }
741
    set x {}
742
    event gen .b.f <1>
743
    foreach p [bindtags .b.f] {
744
        bind $p <1> {}
745
    }
746
    set x
747
} {a b c d e f g h i j k l m n o p}
748
test bind-13.33 {Tk_BindEvent procedure: multiple tags} {
749
    setup
750
    bind .b.f  {lappend x .b.f}
751
    bind Test  {lappend x Button}
752
    set x {}
753
    event gen .b.f 
754
    bind Test  {}
755
    set x
756
} {.b.f Button}
757
test bind-13.34 {Tk_BindEvent procedure: execute C binding} {
758
    setup
759
    testcbind .b.f <1> {lappend x 1}
760
    set x {}
761
    event gen .b.f <1>
762
    set x
763
} {1}
764
test bind-13.35 {Tk_BindEvent procedure: pending list marked deleted} {
765
    setup
766
    testcbind Test <1> {lappend x Test} {lappend x Deleted}
767
    bind .b.f <1> {lappend x .b.f; destroy .b.f}
768
    set x {}
769
    event gen .b.f <1>
770
    set y [list $x [bind Test]]
771
    bind Test <1> {}
772
    set y
773
} {.b.f }
774
test bind-13.36 {Tk_BindEvent procedure: C binding marked deleted} {
775
    setup
776
    testcbind Test <1> {lappend x Test} {lappend x Deleted}
777
    bind .b.f <1> {lappend x .b.f; bind Test <1> {}; lappend x after}
778
    set x {}
779
    event gen .b.f <1>
780
    set x
781
} {.b.f after Deleted}
782
test bind-13.37 {Tk_BindEvent procedure: C binding gets to run} {
783
    setup
784
    testcbind Test <1> {lappend x Test}
785
    bind .b.f <1> {lappend x .b.f}
786
    set x {}
787
    event gen .b.f <1>
788
    bind Test <1> {}
789
    set x
790
} {.b.f Test}
791
test bind-13.38 {Tk_BindEvent procedure: C binding deleted, refcount == 0} {
792
    setup
793
    testcbind .b.f <1> {lappend x hi; bind .b.f <1> {}} {lappend x bye}
794
    set x {}
795
    event gen .b.f <1>
796
    set x
797
} {hi bye}
798
test bind-13.39 {Tk_BindEvent procedure: C binding deleted, refcount != 0} {
799
    setup
800
    testcbind .b.f <1> {
801
        lappend x before$n
802
        if {$n==0} {
803
            bind .b.f <1> {}
804
        } else {
805
            set n [expr $n-1]
806
            event gen .b.f <1>
807
        }
808
        lappend x after$n
809
    } {lappend x Deleted}
810
    set n 3
811
    set x {}
812
    event gen .b.f <1>
813
    set x
814
} {before3 before2 before1 before0 after0 after0 after0 after0 Deleted}
815
test bind-13.40 {Tk_BindEvent procedure: continue in script} {
816
    setup
817
    bind .b.f  {lappend x b1; continue; lappend x b2}
818
    bind Test  {lappend x B1; continue; lappend x B2}
819
    set x {}
820
    event gen .b.f 
821
    bind Test  {}
822
    set x
823
} {b1 B1}
824
test bind-13.41 {Tk_BindEvent procedure: continue in script} {
825
    setup
826
    testcbind .b.f  {lappend x b1; continue; lappend x b2}
827
    testcbind Test  {lappend x B1; continue; lappend x B2}
828
    set x {}
829
    event gen .b.f 
830
    bind Test  {}
831
    set x
832
} {b1 B1}
833
test bind-13.42 {Tk_BindEvent procedure: break in script} {
834
    setup
835
    bind .b.f  {lappend x b1; break; lappend x b2}
836
    bind Test  {lappend x B1; break; lappend x B2}
837
    set x {}
838
    event gen .b.f 
839
    bind Test  {}
840
    set x
841
} {b1}
842
test bind-13.43 {Tk_BindEvent procedure: break in script} {
843
    setup
844
    testcbind .b.f  {lappend x b1; break; lappend x b2}
845
    testcbind Test  {lappend x B1; break; lappend x B2}
846
    set x {}
847
    event gen .b.f 
848
    bind Test  {}
849
    set x
850
} {b1}
851
 
852
proc bgerror msg {
853
    global x
854
    lappend x $msg
855
}
856
test bind-13.44 {Tk_BindEvent procedure: error in script} {
857
    setup
858
    bind .b.f  {lappend x b1; blap}
859
    bind Test  {lappend x B1}
860
    set x {}
861
    event gen .b.f 
862
    update
863
    bind Test  {}
864
    set x
865
} {b1 {invalid command name "blap"}}
866
test bind-13.45 {Tk_BindEvent procedure: error in script} {
867
    setup
868
    testcbind .b.f  {lappend x b1; blap}
869
    testcbind Test  {lappend x B1}
870
    set x {}
871
    event gen .b.f 
872
    update
873
    bind Test  {}
874
    set x
875
} {b1 {invalid command name "blap"}}
876
 
877
test bind-14.1 {TkBindDeadWindow: no C bindings pending} {
878
    setup
879
    bind .b.f <1> x
880
    testcbind .b.f <2> y
881
    destroy .b.f
882
} {}
883
test bind-14.2 {TkBindDeadWindow: is called after } {
884
    setup
885
    testcbind .b.f  "lappend x .b.f"
886
    testcbind Test  "lappend x Test"
887
    set x {}
888
    destroy .b.f
889
    bind Test  {}
890
    set x
891
} {.b.f Test}
892
test bind-14.3 {TkBindDeadWindow: pending C bindings} {
893
    setup
894
    bindtags .b.f {a b c d}
895
    testcbind a <1> "lappend x a1" "lappend x bye.a1"
896
    testcbind b <1> "destroy .b.f; lappend x b1" "lappend x bye.b1"
897
    testcbind c <1> "lappend x c1" "lappend x bye.c1"
898
    testcbind d <1> "lappend x d1" "lappend x bye.d1"
899
    bind a <2> "event gen .b.f <1>"
900
    testcbind b <2> "lappend x b2" "lappend x bye.b2"
901
    testcbind c <2> "lappend x c2" "lappend x bye.d2"
902
    bind d <2> "lappend x d2"
903
    testcbind a <3> "event gen .b.f <2>"
904
    set x {}
905
    event gen .b.f <3>
906
    set y $x
907
    foreach tag {a b c d} {
908
        foreach event {<1> <2> <3>} {
909
            bind $tag $event {}
910
        }
911
    }
912
    set y
913
} {a1 b1 d2}
914
 
915
test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} {
916
    setup
917
    bind .b.f ab {set x 1}
918
    set x 0
919
    event gen .b.f 
920
    event gen .b.f 
921
    event gen .b.f 
922
    event gen .b.f 
923
    set x
924
} 1
925
test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} {
926
    setup
927
    bind .b.f ab {set x 1}
928
    set x 0
929
    event gen .b.f 
930
    event gen .b.f 
931
    event gen .b.f 
932
    event gen .b.f 
933
    event gen .b.f 
934
    event gen .b.f 
935
    set x
936
} 1
937
test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} {
938
    setup
939
    bind .b.f ab {set x 1}
940
    set x 0
941
    event gen .b.f 
942
    event gen .b.f 
943
    event gen .b.f 
944
    set x
945
} 0
946
test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} {
947
    setup
948
    bind .b.f  {set x 1}
949
    set x 0
950
    event gen .b.f 
951
    event gen .b.f 
952
    event gen .b.f 
953
    event gen .b.f 
954
    set x
955
} 1
956
test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} {
957
    setup
958
    bind .b.f  {set x 1}
959
    set x 0
960
    event gen .b.f 
961
    event gen .b.f 
962
    event gen .b.f 
963
    event gen .b.f 
964
    set x
965
} 1
966
test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} {
967
    setup
968
    bind .b.f  {set x 1}
969
    set x 0
970
    event gen .b.f 
971
    event gen .b.f 
972
    event gen .b.f 
973
    event gen .b.f 
974
    event gen .b.f 
975
    set x
976
} 0
977
test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} {
978
    setup
979
    bind .b.f  {set x 1}
980
    set x 0
981
    event gen .b.f 
982
    event gen .b.f 
983
    event gen .b.f 
984
    event gen .b.f 
985
    event gen .b.f 
986
    set x
987
} 1
988
test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} {
989
    setup
990
    bind .b.f ab {set x 1}
991
    set x 0
992
    event gen .b.f 
993
    event gen .b.f 
994
    event gen .b.f 
995
    set x
996
} 0
997
test bind-15.9 {MatchPatterns procedure, modifier checks} {
998
    setup
999
    bind .b.f  {set x 1}
1000
    set x 0
1001
    event gen .b.f  -state 0x18
1002
    set x
1003
} 1
1004
test bind-15.10 {MatchPatterns procedure, modifier checks} {
1005
    setup
1006
    bind .b.f  {set x 1}
1007
    set x 0
1008
    event gen .b.f  -state 0xfc
1009
    set x
1010
} 1
1011
test bind-15.11 {MatchPatterns procedure, modifier checks} {
1012
    setup
1013
    bind .b.f  {set x 1}
1014
    set x 0
1015
    event gen .b.f  -state 0x8
1016
    set x
1017
} 0
1018
test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} {nonPortable} {
1019
    # This test is non-portable because the Shift_L keysym may behave
1020
    # differently on some platforms.
1021
    setup
1022
    bind .b.f aB {set x 1}
1023
    set x 0
1024
    event gen .b.f 
1025
    event gen .b.f 
1026
    event gen .b.f  -state 1
1027
    set x
1028
} 1
1029
test bind-15.13 {MatchPatterns procedure, checking detail} {
1030
    setup
1031
    bind .b.f ab {set x 1}
1032
    set x 0
1033
    event gen .b.f 
1034
    event gen .b.f 
1035
    set x
1036
} 0
1037
test bind-15.14 {MatchPatterns procedure, checking "nearby"} {
1038
    setup
1039
    bind .b.f  {set x 1}
1040
    set x 0
1041
    event gen .b.f 
1042
    event gen .b.f  -x 30 -y 40
1043
    event gen .b.f  -x 31 -y 39
1044
    set x
1045
} 1
1046
test bind-15.15 {MatchPatterns procedure, checking "nearby"} {
1047
    setup
1048
    bind .b.f  {set x 1}
1049
    set x 0
1050
    event gen .b.f 
1051
    event gen .b.f  -x 30 -y 40
1052
    event gen .b.f  -x 29 -y 41
1053
    set x
1054
} 1
1055
test bind-15.16 {MatchPatterns procedure, checking "nearby"} {
1056
    setup
1057
    bind .b.f  {set x 1}
1058
    set x 0
1059
    event gen .b.f 
1060
    event gen .b.f  -x 30 -y 40
1061
    event gen .b.f  -x 40 -y 40
1062
    set x
1063
} 0
1064
test bind-15.17 {MatchPatterns procedure, checking "nearby"} {
1065
    setup
1066
    bind .b.f  {set x 1}
1067
    set x 0
1068
    event gen .b.f 
1069
    event gen .b.f  -x 30 -y 40
1070
    event gen .b.f  -x 20 -y 40
1071
    set x
1072
} 0
1073
test bind-15.18 {MatchPatterns procedure, checking "nearby"} {
1074
    setup
1075
    bind .b.f  {set x 1}
1076
    set x 0
1077
    event gen .b.f 
1078
    event gen .b.f  -x 30 -y 40
1079
    event gen .b.f  -x 30 -y 30
1080
    set x
1081
} 0
1082
test bind-15.19 {MatchPatterns procedure, checking "nearby"} {
1083
    setup
1084
    bind .b.f  {set x 1}
1085
    set x 0
1086
    event gen .b.f 
1087
    event gen .b.f  -x 30 -y 40
1088
    event gen .b.f  -x 30 -y 50
1089
    set x
1090
} 0
1091
test bind-15.20 {MatchPatterns procedure, checking "nearby"} {
1092
    setup
1093
    bind .b.f  {set x 1}
1094
    set x 0
1095
    event gen .b.f 
1096
    event gen .b.f  -time 300
1097
    event gen .b.f  -time 700
1098
    set x
1099
} 1
1100
test bind-15.21 {MatchPatterns procedure, checking "nearby"} {
1101
    setup
1102
    bind .b.f  {set x 1}
1103
    set x 0
1104
    event gen .b.f 
1105
    event gen .b.f  -time 300
1106
    event gen .b.f  -time 900
1107
    set x
1108
} 0
1109
test bind-15.22 {MatchPatterns procedure, time wrap-around} {
1110
    setup
1111
    bind .b.f  {set x 1}
1112
    set x 0
1113
    event gen .b.f  -time [expr -100]
1114
    event gen .b.f  -time 200
1115
    set x
1116
} 1
1117
test bind-15.23 {MatchPatterns procedure, time wrap-around} {
1118
    setup
1119
    bind .b.f  {set x 1}
1120
    set x 0
1121
    event gen .b.f  -time -100
1122
    event gen .b.f  -time 500
1123
    set x
1124
} 0
1125
test bind-15.24 {MatchPatterns procedure, virtual event} {
1126
    setup
1127
    event add <> 
1128
    bind .b.f <> {lappend x paste}
1129
    set x {}
1130
    event gen .b.f 
1131
    set x
1132
} {paste}
1133
test bind-15.25 {MatchPatterns procedure, reject a  virtual event} {
1134
    setup
1135
    event add <> 
1136
    bind .b.f <> {lappend x paste}
1137
    set x {}
1138
    event gen .b.f 
1139
    set x
1140
} {}
1141
test bind-15.26 {MatchPatterns procedure, reject a virtual event} {
1142
    setup
1143
    event add <> 
1144
    event add <> 
1145
    event add <> 
1146
    bind .b.f <> "lappend x V2%#"
1147
    set x {}
1148
    event gen .b.f 
1149
    event gen .b.f  -serial 102
1150
    event gen .b.f  -serial 103
1151
    bind .b.f  "lappend x Shift-Button-1"
1152
    event gen .b.f 
1153
    event gen .b.f  -serial 105
1154
    event gen .b.f  -serial 106
1155
    set x
1156
} {V2102 V2103 V2105 Shift-Button-1}
1157
test bind-15.27 {MatchPatterns procedure, conflict resolution} {
1158
    setup
1159
    bind .b.f  {set x 0}
1160
    bind .b.f a {set x 1}
1161
    set x none
1162
    event gen .b.f 
1163
    set x
1164
} 1
1165
test bind-15.28 {MatchPatterns procedure, conflict resolution} {
1166
    setup
1167
    bind .b.f  {set x 0}
1168
    bind .b.f a {set x 1}
1169
    set x none
1170
    event gen .b.f 
1171
    set x
1172
} 0
1173
test bind-15.29 {MatchPatterns procedure, conflict resolution} {
1174
    setup
1175
    bind .b.f  {lappend x 0}
1176
    bind .b.f a {lappend x 1}
1177
    bind .b.f ba {lappend x 2}
1178
    set x none
1179
    event gen .b.f 
1180
    event gen .b.f 
1181
    event gen .b.f 
1182
    set x
1183
} {none 0 2}
1184
test bind-15.30 {MatchPatterns procedure, conflict resolution} {
1185
    setup
1186
    bind .b.f  {set x 0}
1187
    bind .b.f <1> {set x 1}
1188
    set x none
1189
    event gen .b.f 
1190
    set x
1191
} 1
1192
test bind-15.31 {MatchPatterns procedure, conflict resolution} {
1193
    setup
1194
    bind .b.f  {set x 0}
1195
    bind .b.f  {set x 1}
1196
    set x none
1197
    event gen .b.f  -state 0x18
1198
    set x
1199
} 1
1200
test bind-15.32 {MatchPatterns procedure, conflict resolution} {
1201
    setup
1202
    bind .b.f  {set x 0}
1203
    bind .b.f  {set x 1}
1204
    set x none
1205
    event gen .b.f  -state 0x18
1206
    set x
1207
} 1
1208
test bind-15.33 {MatchPatterns procedure, conflict resolution} {
1209
    setup
1210
    bind .b.f <1> {lappend x single}
1211
    bind Test <1> {lappend x single(Test)}
1212
    bind Test  {lappend x double(Test)}
1213
    set x {}
1214
    event gen .b.f 
1215
    event gen .b.f 
1216
    event gen .b.f 
1217
    set x
1218
} {single single(Test) single double(Test) single double(Test)}
1219
foreach i [bind Test] {
1220
    bind Test $i {}
1221
}
1222
test bind-16.1 {ExpandPercents procedure} {
1223
    setup
1224
    bind .b.f  {set x abcd}
1225
    set x none
1226
    event gen .b.f 
1227
    set x
1228
} abcd
1229
test bind-16.2 {ExpandPercents procedure} {
1230
    setup
1231
    bind .b.f  {set x %#}
1232
    set x none
1233
    event gen .b.f  -serial 1234
1234
    set x
1235
} 1234
1236
test bind-16.3 {ExpandPercents procedure} {
1237
    setup
1238
    bind .b.f  {set x %a}
1239
    set x none
1240
    event gen .b.f  -above .b -window .b.f
1241
    set x
1242
} [winfo id .b]
1243
test bind-16.4 {ExpandPercents procedure} {
1244
    setup
1245
    bind .b.f 
1246
    set x none
1247
    event gen .b.f 
1248
    set x
1249
} 3
1250
test bind-16.5 {ExpandPercents procedure} {
1251
    setup
1252
    bind .b.f  {set x %c}
1253
    set x none
1254
    event gen .b.f  -count 47
1255
    set x
1256
} 47
1257
test bind-16.6 {ExpandPercents procedure} {
1258
    setup
1259
    bind .b.f  {set x %d}
1260
    set x none
1261
    event gen .b.f  -detail NotifyAncestor
1262
    set x
1263
} NotifyAncestor
1264
test bind-16.7 {ExpandPercents procedure} {
1265
    setup
1266
    bind .b.f  {set x %d}
1267
    set x none
1268
    event gen .b.f  -detail NotifyVirtual
1269
    set x
1270
} NotifyVirtual
1271
test bind-16.8 {ExpandPercents procedure} {
1272
    setup
1273
    bind .b.f  {set x %d}
1274
    set x none
1275
    event gen .b.f  -detail NotifyNonlinear
1276
    set x
1277
} NotifyNonlinear
1278
test bind-16.9 {ExpandPercents procedure} {
1279
    setup
1280
    bind .b.f  {set x %d}
1281
    set x none
1282
    event gen .b.f  -detail NotifyNonlinearVirtual
1283
    set x
1284
} NotifyNonlinearVirtual
1285
test bind-16.10 {ExpandPercents procedure} {
1286
    setup
1287
    bind .b.f  {set x %d}
1288
    set x none
1289
    event gen .b.f  -detail NotifyPointer
1290
    set x
1291
} NotifyPointer
1292
test bind-16.11 {ExpandPercents procedure} {
1293
    setup
1294
    bind .b.f  {set x %d}
1295
    set x none
1296
    event gen .b.f  -detail NotifyPointerRoot
1297
    set x
1298
} NotifyPointerRoot
1299
test bind-16.12 {ExpandPercents procedure} {
1300
    setup
1301
    bind .b.f  {set x %d}
1302
    set x none
1303
    event gen .b.f  -detail NotifyDetailNone
1304
    set x
1305
} NotifyDetailNone
1306
test bind-16.13 {ExpandPercents procedure} {
1307
    setup
1308
    bind .b.f  {set x %f}
1309
    set x none
1310
    event gen .b.f  -focus 1
1311
    set x
1312
} 1
1313
test bind-16.14 {ExpandPercents procedure} {
1314
    setup
1315
    bind .b.f  {set x "%x %y %w %h"}
1316
    set x none
1317
    event gen .b.f  -x 24 -y 18 -width 147 -height 61
1318
    set x
1319
} {24 18 147 61}
1320
test bind-16.15 {ExpandPercents procedure} {
1321
    setup
1322
    bind .b.f  {set x "%x %y %w %h"}
1323
    set x none
1324
    event gen .b.f  -x 24 -y 18 -width 147 -height 61 -window .b.f
1325
    set x
1326
} {24 18 147 61}
1327
test bind-16.16 {ExpandPercents procedure} {
1328
    setup
1329
    bind .b.f  {set x "%k"}
1330
    set x none
1331
    event gen .b.f  -keycode 146
1332
    set x
1333
} 146
1334
test bind-16.17 {ExpandPercents procedure} {
1335
    setup
1336
    bind .b.f  {set x "%m"}
1337
    set x none
1338
    event gen .b.f  -mode NotifyNormal
1339
    set x
1340
} NotifyNormal
1341
test bind-16.18 {ExpandPercents procedure} {
1342
    setup
1343
    bind .b.f  {set x "%m"}
1344
    set x none
1345
    event gen .b.f  -mode NotifyGrab
1346
    set x
1347
} NotifyGrab
1348
test bind-16.19 {ExpandPercents procedure} {
1349
    setup
1350
    bind .b.f  {set x "%m"}
1351
    set x none
1352
    event gen .b.f  -mode NotifyUngrab
1353
    set x
1354
} NotifyUngrab
1355
test bind-16.20 {ExpandPercents procedure} {
1356
    setup
1357
    bind .b.f  {set x "%m"}
1358
    set x none
1359
    event gen .b.f  -mode NotifyWhileGrabbed
1360
    set x
1361
} NotifyWhileGrabbed
1362
test bind-16.21 {ExpandPercents procedure} {
1363
    setup
1364
    bind .b.f  {set x "%o"}
1365
    set x none
1366
    event gen .b.f  -override 1 -window .b.f
1367
    set x
1368
} 1
1369
test bind-16.22 {ExpandPercents procedure} {
1370
    setup
1371
    bind .b.f  {set x "%o"}
1372
    set x none
1373
    event gen .b.f  -override true -window .b.f
1374
    set x
1375
} 1
1376
test bind-16.23 {ExpandPercents procedure} {
1377
    setup
1378
    bind .b.f  {set x "%o"}
1379
    set x none
1380
    event gen .b.f  -override 1 -window .b.f
1381
    set x
1382
} 1
1383
test bind-16.24 {ExpandPercents procedure} {
1384
    setup
1385
    bind .b.f  {set x "%p"}
1386
    set x none
1387
    event gen .b.f  -place PlaceOnTop -window .b.f
1388
    set x
1389
} PlaceOnTop
1390
test bind-16.25 {ExpandPercents procedure} {
1391
    setup
1392
    bind .b.f  {set x "%p"}
1393
    set x none
1394
    event gen .b.f  -place PlaceOnBottom -window .b.f
1395
    set x
1396
} PlaceOnBottom
1397
test bind-16.26 {ExpandPercents procedure} {
1398
    setup
1399
    bind .b.f <1> {set x "%s"}
1400
    set x none
1401
    event gen .b.f  -state 122
1402
    set x
1403
} 122
1404
test bind-16.27 {ExpandPercents procedure} {
1405
    setup
1406
    bind .b.f  {set x "%s"}
1407
    set x none
1408
    event gen .b.f  -state 0x3ff
1409
    set x
1410
} 1023
1411
test bind-16.28 {ExpandPercents procedure} {
1412
    setup
1413
    bind .b.f  {set x "%s"}
1414
    set x none
1415
    event gen .b.f  -state VisibilityPartiallyObscured
1416
    set x
1417
} VisibilityPartiallyObscured
1418
test bind-16.29 {ExpandPercents procedure} {
1419
    setup
1420
    bind .b.f  {set x "%s"}
1421
    set x none
1422
    event gen .b.f  -state VisibilityUnobscured
1423
    set x
1424
} VisibilityUnobscured
1425
test bind-16.30 {ExpandPercents procedure} {
1426
    setup
1427
    bind .b.f  {set x "%s"}
1428
    set x none
1429
    event gen .b.f  -state VisibilityFullyObscured
1430
    set x
1431
} VisibilityFullyObscured
1432
test bind-16.31 {ExpandPercents procedure} {
1433
    setup
1434
    bind .b.f 
1435
    set x none
1436
    event gen .b.f 
1437
    set x
1438
} 4294
1439
test bind-16.32 {ExpandPercents procedure} {
1440
    setup
1441
    bind .b.f 
1442
    set x none
1443
    event gen .b.f 
1444
    set x
1445
} {881 432}
1446
test bind-16.33 {ExpandPercents procedure} {
1447
    setup
1448
    bind .b.f  {set x "%x %y"}
1449
    set x none
1450
    event gen .b.f  -x 882 -y 431 -window .b.f
1451
    set x
1452
} {882 431}
1453
test bind-16.34 {ExpandPercents procedure} {
1454
    setup
1455
    bind .b.f  {set x "%x %y"}
1456
    set x none
1457
    event gen .b.f  -x 781 -y 632
1458
    set x
1459
} {781 632}
1460
test bind-16.35 {ExpandPercents procedure} {nonPortable} {
1461
    setup
1462
    bind .b.f  {lappend x "%A"}
1463
    set x {}
1464
    event gen .b.f 
1465
    event gen .b.f  -state 1
1466
    event gen .b.f 
1467
    event gen .b.f 
1468
    event gen .b.f 
1469
    event gen .b.f 
1470
    event gen .b.f 
1471
    event gen .b.f  -state 1
1472
    event gen .b.f  -state 1
1473
    set x
1474
} "a A {        } {\r} {{}} {{}} { } {\$} \\\{"
1475
test bind-16.36 {ExpandPercents procedure} {
1476
    setup
1477
    bind .b.f  {set x "%B"}
1478
    set x none
1479
    event gen .b.f  -borderwidth 24 -window .b.f
1480
    set x
1481
} 24
1482
test bind-16.37 {ExpandPercents procedure} {
1483
    setup
1484
    bind .b.f  {set x "%E"}
1485
    set x none
1486
    event gen .b.f  -sendevent 1
1487
    set x
1488
} 1
1489
test bind-16.38 {ExpandPercents procedure} {nonPortable} {
1490
    setup
1491
    bind .b.f  {lappend x %K}
1492
    set x {}
1493
    event gen .b.f 
1494
    event gen .b.f  -state 1
1495
    event gen .b.f 
1496
    event gen .b.f 
1497
    event gen .b.f 
1498
    event gen .b.f 
1499
    event gen .b.f  -state 1
1500
    event gen .b.f  -state 1
1501
    set x
1502
} {a A Tab F1 Shift_L space dollar braceleft}
1503
test bind-16.39 {ExpandPercents procedure} {
1504
    setup
1505
    bind .b.f  {set x "%N"}
1506
    set x none
1507
    event gen .b.f 
1508
    set x
1509
} 97
1510
test bind-16.40 {ExpandPercents procedure} {
1511
    setup
1512
    bind .b.f  {set x "%S"}
1513
    set x none
1514
    event gen .b.f  -subwindow .b
1515
    set x
1516
} [winfo id .b]
1517
test bind-16.41 {ExpandPercents procedure} {
1518
    setup
1519
    bind .b.f  {set x "%T"}
1520
    set x none
1521
    event gen .b.f 
1522
    set x
1523
} 2
1524
test bind-16.42 {ExpandPercents procedure} {
1525
    setup
1526
    bind .b.f  {set x "%W"}
1527
    set x none
1528
    event gen .b.f 
1529
    set x
1530
} .b.f
1531
test bind-16.43 {ExpandPercents procedure} {
1532
    setup
1533
    bind .b.f 
1534
    set x none
1535
    event gen .b.f 
1536
    set x
1537
} {422 13}
1538
 
1539
 
1540
test bind-17.1 {event command} {
1541
    list [catch {event} msg] $msg
1542
} {1 {wrong # args: should be "event option ?arg1?"}}
1543
test bind-17.2 {event command} {
1544
    list [catch {event {}} msg] $msg
1545
} {1 {bad option "": should be add, delete, generate, info}}
1546
test bind-17.3 {event command: add} {
1547
    list [catch {event add} msg] $msg
1548
} {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}}
1549
test bind-17.4 {event command: add 1} {
1550
    setup
1551
    event add <> 
1552
    event info <>
1553
} {}
1554
test bind-17.5 {event command: add 2} {
1555
    setup
1556
    event add <>  
1557
    lsort [event info <>]
1558
} { }
1559
test bind-17.6 {event command: add with error} {
1560
    setup
1561
    list [catch {event add <>   abc  <1>} \
1562
            msg] $msg [lsort [event info <>]]
1563
} {1 {bad event type or keysym "xyz"} {  abc}}
1564
test bind-17.7 {event command: delete} {
1565
    list [catch {event delete} msg] $msg
1566
} {1 {wrong # args: should be "event delete virtual ?sequence sequence ...?"}}
1567
test bind-17.8 {event command: delete many} {
1568
    setup
1569
    event add <> <3> <1> <2> t
1570
    event delete <> <1> <2>
1571
    lsort [event info <>]
1572
} { t}
1573
test bind-17.9 {event command: delete all} {
1574
    setup
1575
    event add <> a b
1576
    event delete <>
1577
    event info <>
1578
} {}
1579
test bind-17.10 {event command: delete 1} {
1580
    setup
1581
    event add <> a b c
1582
    event delete <> b
1583
    lsort [event info <>]
1584
} {a c}
1585
test bind-17.11 {event command: info name} {
1586
    setup
1587
    event add <> a b c
1588
    lsort [event info <>]
1589
} {a b c}
1590
test bind-17.12 {event command: info all} {
1591
    setup
1592
    event add <> a
1593
    event add <> b
1594
    lsort [event info]
1595
} {<> <>}
1596
test bind-17.13 {event command: info error} {
1597
    list [catch {event info <> } msg] $msg
1598
} {1 {wrong # args: should be "event info ?virtual?"}}
1599
test bind-17.14 {event command: generate} {
1600
    list [catch {event generate} msg] $msg
1601
} {1 {wrong # args: should be "event generate window event ?options?"}}
1602
test bind-17.15 {event command: generate} {
1603
    setup
1604
    bind .b.f <1> "lappend x 1"
1605
    set x {}
1606
    event generate .b.f <1>
1607
    set x
1608
} {1}
1609
test bind-17.16 {event command: generate} {
1610
    list [catch {event generate .b.f } msg] $msg
1611
} {1 {bad event type or keysym "xyz"}}
1612
test bind-17.17 {event command} {
1613
    list [catch {event foo} msg] $msg
1614
} {1 {bad option "foo": should be add, delete, generate, info}}
1615
 
1616
 
1617
test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} {
1618
    list [catch {event add asd } msg] $msg
1619
} {1 {virtual event "asd" is badly formed}}
1620
test bind-18.2 {CreateVirtualEvent procedure: FindSequence} {
1621
    list [catch {event add <> } msg] $msg
1622
} {1 {bad event type or keysym "Ctrl"}}
1623
test bind-18.3 {CreateVirtualEvent procedure: new physical} {
1624
    setup
1625
    event add <> 
1626
    event info <>
1627
} {}
1628
test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} {
1629
    setup
1630
    event add <> 
1631
    event add <> 
1632
    event info <>
1633
} {}
1634
test bind-18.5 {CreateVirtualEvent procedure: existing physical} {
1635
    setup
1636
    event add <> 
1637
    event add <> 
1638
    list [lsort [event info]] [event info <>] [event info <>]
1639
} {{<> <>}  }
1640
test bind-18.6 {CreateVirtualEvent procedure: new virtual} {
1641
    setup
1642
    event add <> 
1643
    list [event info] [event info <>]
1644
} {<> }
1645
test bind-18.7 {CreateVirtualEvent procedure: existing virtual} {
1646
    setup
1647
    event add <> 
1648
    event add <> 
1649
    list [event info] [lsort [event info <>]]
1650
} {<> { }}
1651
 
1652
 
1653
test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} {
1654
    list [catch {event add xyz {}} msg] $msg
1655
} {1 {virtual event "xyz" is badly formed}}
1656
test bind-19.2 {DeleteVirtualEvent procedure: non-existent virtual} {
1657
    setup
1658
    event delete <>
1659
    event info
1660
} {}
1661
test bind-19.3 {DeleteVirtualEvent procedure: delete 1} {
1662
    setup
1663
    event add <> 
1664
    event delete <> 
1665
    event info <>
1666
} {}
1667
test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} {
1668
    setup
1669
    event add <> 
1670
    event delete <> 
1671
    event info <>
1672
} {}
1673
test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} {
1674
    setup
1675
    event add <> 
1676
    list [catch {event delete <> } msg] $msg
1677
} {1 {bad event type or keysym "xyz"}}
1678
test bind-19.6 {DeleteVirtualEvent procedure: delete 1, badly formed} {
1679
    setup
1680
    event add <> 
1681
    list [catch {event delete <> <>} msg] $msg
1682
} {1 {virtual event not allowed in definition of another virtual event}}
1683
test bind-19.7 {DeleteVirtualEvent procedure: owns 1, delete all} {
1684
    setup
1685
    event add <> 
1686
    event delete <>
1687
    event info
1688
} {}
1689
test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} {
1690
    setup
1691
    event add <> 
1692
    event delete <> 
1693
    event info
1694
} {}
1695
test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} {
1696
    setup
1697
    event add <>   
1698
    event delete <>
1699
    event info
1700
} {}
1701
test bind-19.10 {DeleteVirtualEvent procedure: owns many, delete 1} {
1702
    setup
1703
    event add <>   
1704
    event delete <> 
1705
    lsort [event info <>]
1706
} { }
1707
test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} {
1708
    setup
1709
    event add <> 
1710
    bind .b.f <> {lappend x %#}
1711
    set x {}
1712
    event gen .b.f  -serial 101
1713
    event delete <>
1714
    event gen .b.f  -serial 102
1715
    set x
1716
} {101}
1717
test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} {
1718
    setup
1719
    event add <> 
1720
    event add <> 
1721
    bind .b.f <> {lappend x xyz}
1722
    bind .b.f <> {lappend x abc}
1723
    set x {}
1724
    event gen .b.f 
1725
    event gen .b.f 
1726
    event delete <>
1727
    event gen .b.f 
1728
    event gen .b.f 
1729
    list $x [event info <>]
1730
} {{xyz abc abc} }
1731
test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} {
1732
    setup
1733
    event add <> 
1734
    event add <> 
1735
    event add <> 
1736
    bind .b.f <> {lappend x xyz}
1737
    bind .b.f <> {lappend x abc}
1738
    bind .b.f <> {lappend x def}
1739
    set x {}
1740
    event gen .b.f 
1741
    event gen .b.f 
1742
    event gen .b.f 
1743
    event delete <>
1744
    event gen .b.f 
1745
    event gen .b.f 
1746
    event gen .b.f 
1747
    list $x [event info <>] [event info <>] [event info <>]
1748
} {{xyz abc def abc def}  {} }
1749
test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} {
1750
    setup
1751
    event add <> 
1752
    event add <> 
1753
    event add <> 
1754
    bind .b.f <> {lappend x xyz}
1755
    bind .b.f <> {lappend x abc}
1756
    bind .b.f <> {lappend x def}
1757
    set x {}
1758
    event gen .b.f 
1759
    event gen .b.f 
1760
    event gen .b.f 
1761
    event delete <>
1762
    event gen .b.f 
1763
    event gen .b.f 
1764
    event gen .b.f 
1765
    list $x [event info <>] [event info <>] [event info <>]
1766
} {{xyz abc def abc def} {}  }
1767
test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} {
1768
    setup
1769
    pack [frame .b.g -class Test -width 150 -height 100]
1770
    pack [frame .b.h -class Test -width 150 -height 100]
1771
    update
1772
    event add <> 
1773
    event add <> 
1774
    event add <> 
1775
    bind .b.f <> {lappend x xyz}
1776
    bind .b.g <> {lappend x abc}
1777
    bind .b.h <> {lappend x def}
1778
    set x {}
1779
    event gen .b.f 
1780
    event gen .b.g 
1781
    event gen .b.h 
1782
    event delete <>
1783
    event gen .b.f 
1784
    event gen .b.g 
1785
    event gen .b.h 
1786
    destroy .b.g
1787
    destroy .b.h
1788
    list $x [event info <>] [event info <>] [event info <>]
1789
} {{xyz abc def abc def} {}  }
1790
test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} {
1791
    setup
1792
    pack [frame .b.g -class Test -width 150 -height 100]
1793
    pack [frame .b.h -class Test -width 150 -height 100]
1794
    update
1795
    event add <> 
1796
    event add <> 
1797
    event add <> 
1798
    bind .b.f <> {lappend x xyz}
1799
    bind .b.g <> {lappend x abc}
1800
    bind .b.h <> {lappend x def}
1801
    set x {}
1802
    event gen .b.f 
1803
    event gen .b.g 
1804
    event gen .b.h 
1805
    event delete <>
1806
    event gen .b.f 
1807
    event gen .b.g 
1808
    event gen .b.h 
1809
    destroy .b.g
1810
    destroy .b.h
1811
    list $x [event info <>] [event info <>] [event info <>]
1812
} {{xyz abc def xyz def}  {} }
1813
test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} {
1814
    setup
1815
    pack [frame .b.g -class Test -width 150 -height 100]
1816
    pack [frame .b.h -class Test -width 150 -height 100]
1817
    update
1818
    event add <> 
1819
    event add <> 
1820
    event add <> 
1821
    bind .b.f <> {lappend x xyz}
1822
    bind .b.g <> {lappend x abc}
1823
    bind .b.h <> {lappend x def}
1824
    set x {}
1825
    event gen .b.f 
1826
    event gen .b.g 
1827
    event gen .b.h 
1828
    event delete <>
1829
    event gen .b.f 
1830
    event gen .b.g 
1831
    event gen .b.h 
1832
    destroy .b.g
1833
    destroy .b.h
1834
    list $x [event info <>] [event info <>] [event info <>]
1835
} {{xyz abc def xyz abc}   {}}
1836
 
1837
 
1838
test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} {
1839
    list [catch {event info asd} msg] $msg
1840
} {1 {virtual event "asd" is badly formed}}
1841
test bind-20.2 {GetVirtualEvent procedure: non-existent event} {
1842
    event info <>
1843
} {}
1844
test bind-20.3 {GetVirtualEvent procedure: owns 1} {
1845
    setup
1846
    event add <> 
1847
    event info <>
1848
} {}
1849
test bind-20.4 {GetVirtualEvent procedure: owns many} {
1850
    setup
1851
    event add <>   spack
1852
    event info <>
1853
} {  spack}
1854
 
1855
 
1856
test bind-21.1 {GetAllVirtualEvents procedure: no events} {
1857
    setup
1858
    event info
1859
} {}
1860
test bind-21.2 {GetAllVirtualEvents procedure: 1 event} {
1861
    setup
1862
    event add <> 
1863
    event info
1864
} {<>}
1865
test bind-21.3 {GetAllVirtualEvents procedure: many events} {
1866
    setup
1867
    event add <> 
1868
    event add <> 
1869
    event add <> 
1870
    event add <> 
1871
    lsort [event info]
1872
} {<> <> <>}
1873
 
1874
test bind-22.1 {HandleEventGenerate} {
1875
    list [catch {event gen .xyz } msg] $msg
1876
} {1 {bad window path name ".xyz"}}
1877
test bind-22.2 {HandleEventGenerate} {
1878
    list [catch {event gen zzz } msg] $msg
1879
} {1 {bad window name/identifier "zzz"}}
1880
test bind-22.3 {HandleEventGenerate} {
1881
    list [catch {event gen 47 } msg] $msg
1882
} {1 {window id "47" doesn't exist in this application}}
1883
test bind-22.4 {HandleEventGenerate} {
1884
    setup
1885
    bind .b.f 
1886
    set x {}
1887
    event gen [winfo id .b.f] 
1888
    set x
1889
} {4 1}
1890
test bind-22.5 {HandleEventGenerate} {
1891
    list [catch {event gen . } msg] $msg
1892
} {1 {bad event type or keysym "xyz"}}
1893
test bind-22.6 {HandleEventGenerate} {
1894
    list [catch {event gen . } msg] $msg
1895
} {1 {Double or Triple modifier not allowed}}
1896
test bind-22.7 {HandleEventGenerate} {
1897
    list [catch {event gen . xyz} msg] $msg
1898
} {1 {only one event specification allowed}}
1899
test bind-22.8 {HandleEventGenerate} {
1900
    list [catch {event gen . 
1901
} {1 {value for "-button" missing}}
1902
test bind-22.9 {HandleEventGenerate} {
1903
    setup
1904
    bind .b.f 
1905
    set x {}
1906
    event gen .b.f 
1907
    set x
1908
} {4 1}
1909
test bind-22.10 {HandleEventGenerate} {
1910
    setup
1911
    bind .b.f  {set x "%s %K"}
1912
    set x {}
1913
    event gen .b.f 
1914
    set x
1915
} {4 1}
1916
test bind-22.11 {HandleEventGenerate} {
1917
    setup
1918
    bind .b.f <> {set x "%s"}
1919
    set x {}
1920
    event gen .b.f <> -state 1
1921
    set x
1922
} {1}
1923
test bind-22.12 {HandleEventGenerate} {
1924
    setup
1925
    bind .b.f  {set x "%s"}
1926
    set x {}
1927
    event gen .b.f 
1928
    set x
1929
} {4}
1930
test bind-22.13 {HandleEventGenerate} {
1931
    setup
1932
    bind .b.f 
1933
    set x {}
1934
    event gen .b.f 
1935
    set x
1936
} {100}
1937
test bind-22.14 {HandleEventGenerate} {
1938
    setup
1939
    bind .b.f 
1940
    set x {}
1941
    event gen .b.f 
1942
    event gen .b.f 
1943
    event gen .b.f 
1944
    lappend x foo
1945
    update
1946
    set x
1947
} {foo 102 101 100}
1948
test bind-22.15 {HandleEventGenerate} {
1949
    setup
1950
    bind .b.f 
1951
    set x {}
1952
    event gen .b.f 
1953
    event gen .b.f 
1954
    event gen .b.f 
1955
    event gen .b.f 
1956
    lappend x foo
1957
    update
1958
    set x
1959
} {foo 100 101 102 99}
1960
test bind-22.16 {HandleEventGenerate} {
1961
    setup
1962
    bind .b.f 
1963
    set x {}
1964
    event gen .b.f 
1965
    event gen .b.f 
1966
    event gen .b.f 
1967
    event gen .b.f 
1968
    lappend x foo
1969
    update
1970
    set x
1971
} {foo 99 100 101 102}
1972
test bind-22.17 {HandleEventGenerate} {
1973
    list [catch {event gen . 
1974
} {1 {bad position "xyz": should be now, head, mark, tail}}
1975
set i 14
1976
foreach check {
1977
    { %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
1978
    { %a {-above .b} {[winfo id .b]}}
1979
    { %a {-above xyz} {{1 {expected integer but got "xyz"}}}}
1980
    { %a {-above [winfo id .b]} {[winfo id .b]}}
1981
    { %b    {-above .} {{1 {bad option to  event: "-above"}}}}
1982
 
1983
    { %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}}
1984
    { %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}}
1985
    { %k            {-borderwidth 2i} {{1 {bad option to  event: "-borderwidth"}}}}
1986
 
1987
    {
1988
    {
1989
    { %k            {-button 1} {{1 {bad option to  event: "-button"}}}}
1990
 
1991
    { %c    {-count xyz} {{1 {expected integer but got "xyz"}}}}
1992
    { %c    {-count 20} 20}
1993
    { %b            {-count 20} {{1 {bad option to  event: "-count"}}}}
1994
 
1995
    { %d            {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, NotifyDetailNone}}}}
1996
    { %d   {-detail NotifyVirtual} {{}}}
1997
    { %d            {-detail NotifyVirtual} NotifyVirtual}
1998
    { %k            {-detail NotifyVirtual} {{1 {bad option to  event: "-detail"}}}}
1999
 
2000
    { %f            {-focus xyz} {{1 {expected boolean value but got "xyz"}}}}
2001
    { %f            {-focus 1} 1}
2002
    { %k            {-focus 1} {{1 {bad option to  event: "-focus"}}}}
2003
 
2004
    { %h    {-height xyz} {{1 {bad screen distance "xyz"}}}}
2005
    { %h    {-height 2i} {[winfo pixels .b.f 2i]}}
2006
    { %h {-height 2i} {[winfo pixels .b.f 2i]}}
2007
    { %k            {-height 2i} {{1 {bad option to  event: "-height"}}}}
2008
 
2009
    { %k            {-keycode xyz} {{1 {expected integer but got "xyz"}}}}
2010
    { %k            {-keycode 20} 20}
2011
    {
2012
 
2013
    { %K            {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
2014
    { %K            {-keysym a} a}
2015
    {
2016
 
2017
    { %m            {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, NotifyWhileGrabbed}}}}
2018
    { %m            {-mode NotifyNormal} NotifyNormal}
2019
    { %m   {-mode NotifyNormal} {{}}}
2020
    { %k            {-mode NotifyNormal} {{1 {bad option to  event: "-mode"}}}}
2021
 
2022
    { %o            {-override xyz} {{1 {expected boolean value but got "xyz"}}}}
2023
    { %o            {-override 1} 1}
2024
    { %o  {-override 1} 1}
2025
    { %o {-override 1} 1}
2026
    { %k            {-override 1} {{1 {bad option to  event: "-override"}}}}
2027
 
2028
    { %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, PlaceOnBottom}}}}
2029
    { %p {-place PlaceOnTop} PlaceOnTop}
2030
    { %k            {-place PlaceOnTop} {{1 {bad option to  event: "-place"}}}}
2031
 
2032
    { %R            {-root .xyz} {{1 {bad window path name ".xyz"}}}}
2033
    { %R            {-root .b} {[winfo id .b]}}
2034
    { %R            {-root xyz} {{1 {expected integer but got "xyz"}}}}
2035
    { %R            {-root [winfo id .b]} {[winfo id .b]}}
2036
    {
2037
    { %R    {-root .b} {[winfo id .b]}}
2038
    {<> %R   {-root .b} {[winfo id .b]}}
2039
    { %R            {-root .b} {[winfo id .b]}}
2040
    { %R {-root .b} {{1 {bad option to  event: "-root"}}}}
2041
 
2042
    { %X            {-rootx xyz} {{1 {bad screen distance "xyz"}}}}
2043
    { %X            {-rootx 2i} {[winfo pixels .b.f 2i]}}
2044
    {
2045
    { %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
2046
    {<> %X   {-rootx 2i} {[winfo pixels .b.f 2i]}}
2047
    { %X            {-rootx 2i} {[winfo pixels .b.f 2i]}}
2048
    { %X {-rootx 2i} {{1 {bad option to  event: "-rootx"}}}}
2049
 
2050
    { %Y            {-rooty xyz} {{1 {bad screen distance "xyz"}}}}
2051
    { %Y            {-rooty 2i} {[winfo pixels .b.f 2i]}}
2052
    {
2053
    { %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
2054
    {<> %Y   {-rooty 2i} {[winfo pixels .b.f 2i]}}
2055
    { %Y            {-rooty 2i} {[winfo pixels .b.f 2i]}}
2056
    { %Y {-rooty 2i} {{1 {bad option to  event: "-rooty"}}}}
2057
 
2058
    { %E            {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}}
2059
    { %E            {-sendevent 1} 1}
2060
    { %E            {-sendevent yes} 1}
2061
    { %E            {-sendevent 43} 43}
2062
 
2063
    { %#            {-serial xyz} {{1 {expected integer but got "xyz"}}}}
2064
    { %#            {-serial 100} 100}
2065
 
2066
    { %s            {-state xyz} {{1 {expected integer but got "xyz"}}}}
2067
    { %s            {-state 1} 1}
2068
    {
2069
    { %s    {-state 1} 1}
2070
    {<> %s   {-state 1} 1}
2071
    { %s            {-state 1} 1}
2072
    { %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, VisibilityFullyObscured}}}}
2073
    { %s {-state VisibilityUnobscured} VisibilityUnobscured}
2074
    { %s {-state xyz} {{1 {bad option to  event: "-state"}}}}
2075
 
2076
    { %S            {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}}
2077
    { %S            {-subwindow .b} {[winfo id .b]}}
2078
    { %S            {-subwindow xyz} {{1 {expected integer but got "xyz"}}}}
2079
    { %S            {-subwindow [winfo id .b]} {[winfo id .b]}}
2080
    {
2081
    { %S    {-subwindow .b} {[winfo id .b]}}
2082
    {<> %S   {-subwindow .b} {[winfo id .b]}}
2083
    { %S            {-subwindow .b} {[winfo id .b]}}
2084
    { %S {-subwindow .b} {{1 {bad option to  event: "-subwindow"}}}}
2085
 
2086
    { %t            {-time xyz} {{1 {expected integer but got "xyz"}}}}
2087
    { %t            {-time 100} 100}
2088
    {
2089
    { %t    {-time 100} 100}
2090
    {<> %t   {-time 100} 100}
2091
    { %t            {-time 100} 100}
2092
    { %t  {-time 100} 100}
2093
    { %t {-time 100} {{1 {bad option to  event: "-time"}}}}
2094
 
2095
    { %w    {-width xyz} {{1 {bad screen distance "xyz"}}}}
2096
    { %w    {-width 2i} {[winfo pixels .b.f 2i]}}
2097
    { %w {-width 2i} {[winfo pixels .b.f 2i]}}
2098
    { %k            {-width 2i} {{1 {bad option to  event: "-width"}}}}
2099
 
2100
    { %W    {-window .xyz} {{1 {bad window path name ".xyz"}}}}
2101
    { %W    {-window .b.f} .b.f}
2102
    { %W    {-window xyz} {{1 {expected integer but got "xyz"}}}}
2103
    { %W    {-window [winfo id .b.f]} .b.f}
2104
    { %W            {-window .b.f} .b.f}
2105
    { %W            {-window .b.f} .b.f}
2106
    { %W  {-window .b.f} .b.f}
2107
    { %W {-window .b.f} .b.f}
2108
    { %W   {-window .b.f} .b.f}
2109
    { %W {-window .b.f} .b.f}
2110
    { %W            {-window .b.f} {{1 {bad option to  event: "-window"}}}}
2111
 
2112
    { %x            {-x xyz} {{1 {bad screen distance "xyz"}}}}
2113
    { %x            {-x 2i} {[winfo pixels .b.f 2i]}}
2114
    {
2115
    { %x    {-x 2i} {[winfo pixels .b.f 2i]}}
2116
    {<> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
2117
    { %x            {-x 2i} {[winfo pixels .b.f 2i]}}
2118
    { %x    {-x 2i} {[winfo pixels .b.f 2i]}}
2119
    { %x {-x 2i} {[winfo pixels .b.f 2i]}}
2120
    { %x   {-x 2i} {[winfo pixels .b.f 2i]}}
2121
    { %x  {-x 2i} {[winfo pixels .b.f 2i]}}
2122
    { %x            {-x 2i} {{1 {bad option to  event: "-x"}}}}
2123
 
2124
    { %y            {-y xyz} {{1 {bad screen distance "xyz"}}}}
2125
    { %y            {-y 2i} {[winfo pixels .b.f 2i]}}
2126
    {
2127
    { %y    {-y 2i} {[winfo pixels .b.f 2i]}}
2128
    {<> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
2129
    { %y            {-y 2i} {[winfo pixels .b.f 2i]}}
2130
    { %y    {-y 2i} {[winfo pixels .b.f 2i]}}
2131
    { %y {-y 2i} {[winfo pixels .b.f 2i]}}
2132
    { %y   {-y 2i} {[winfo pixels .b.f 2i]}}
2133
    { %y  {-y 2i} {[winfo pixels .b.f 2i]}}
2134
    { %y            {-y 2i} {{1 {bad option to  event: "-y"}}}}
2135
 
2136
    { %k            {-xyz 1} {{1 {bad option to  event: "-xyz"}}}}
2137
} {
2138
    set event [lindex $check 0]
2139
    test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" {
2140
        setup
2141
        bind .b.f $event "lappend x [lindex $check 1]"
2142
        set x {}
2143
        if [catch {eval event gen .b.f $event [lindex $check 2]} msg] {
2144
            set x [list 1 $msg]
2145
        }
2146
        set x
2147
    } [eval set x [lindex $check 3]]
2148
    incr i
2149
}
2150
test bind-23.1 {GetVirtualEventUid procedure} {
2151
    list [catch {event info <
2152
} {1 {virtual event "<
2153
test bind-23.2 {GetVirtualEventUid procedure} {
2154
    list [catch {event info <<>>} msg] $msg
2155
} {1 {virtual event "<<>>" is badly formed}}
2156
test bind-23.3 {GetVirtualEventUid procedure} {
2157
    list [catch {event info <} msg] $msg
2158
} {1 {virtual event "<" is badly formed}}
2159
test bind-23.4 {GetVirtualEventUid procedure} {
2160
    event info <>
2161
} {}
2162
 
2163
 
2164
test bind-24.1 {FindSequence procedure: no event} {
2165
    list [catch {bind .b {} test} msg] $msg
2166
} {1 {no events specified in binding}}
2167
test bind-24.2 {FindSequence procedure: bad event} {
2168
    list [catch {bind .b  test} msg] $msg
2169
} {1 {bad event type or keysym "xyz"}}
2170
test bind-24.3 {FindSequence procedure: virtual allowed} {
2171
    bind .b.f <> test
2172
} {}
2173
test bind-24.4 {FindSequence procedure: virtual not allowed} {
2174
   list [catch {event add <> <>} msg] $msg
2175
} {1 {virtual event not allowed in definition of another virtual event}}
2176
test bind-24.5 {FindSequence procedure, multiple bindings} {
2177
    setup
2178
    bind .b.f <1> {lappend x single}
2179
    bind .b.f  {lappend x double}
2180
    bind .b.f  {lappend x triple}
2181
    set x press
2182
    event gen .b.f 
2183
    lappend x press
2184
    event gen .b.f 
2185
    lappend x press
2186
    event gen .b.f 
2187
    lappend x press
2188
    event gen .b.f 
2189
    set x
2190
} {press single press double press triple press triple}
2191
test bind-24.6 {FindSequence procedure: virtual composed} {
2192
    list [catch {bind .b <> "puts hi"} msg] $msg
2193
} {1 {virtual events may not be composed}}
2194
test bind-24.7 {FindSequence procedure: new pattern sequence} {
2195
    setup
2196
    bind .b.f  {lappend x 1-2}
2197
    set x {}
2198
    event gen .b.f 
2199
    event gen .b.f 
2200
    set x
2201
} {1-2}
2202
test bind-24.8 {FindSequence procedure: similar pattern sequence} {
2203
    setup
2204
    bind .b.f  {lappend x 1-2}
2205
    bind .b.f  {lappend x 2}
2206
    set x {}
2207
    event gen .b.f 
2208
    event gen .b.f 
2209
    event gen .b.f 
2210
    event gen .b.f 
2211
    set x
2212
} {2 1-2}
2213
test bind-24.9 {FindSequence procedure: similar pattern sequence} {
2214
    setup
2215
    bind .b.f  {lappend x 1-2}
2216
    bind .b.f  {lappend x 2-2}
2217
    set x {}
2218
    event gen .b.f 
2219
    event gen .b.f 
2220
    event gen .b.f 
2221
    event gen .b.f 
2222
    event gen .b.f 
2223
    set x
2224
} {2-2 1-2}
2225
test bind-24.10 {FindSequence procedure: similar pattern sequence} {
2226
    setup
2227
    bind .b.f  {lappend x 2-2}
2228
    bind .b.f  {lappend x d-2}
2229
    set x {}
2230
    event gen .b.f 
2231
    event gen .b.f 
2232
    event gen .b.f 
2233
    event gen .b.f 
2234
    event gen .b.f  -x 100
2235
    event gen .b.f  -x 200
2236
    set x
2237
} {d-2 2-2}
2238
test bind-24.11 {FindSequence procedure: new sequence, don't create} {
2239
    setup
2240
    bind .b.f 
2241
} {}
2242
test bind-24.12 {FindSequence procedure: not new sequence, don't create} {
2243
    setup
2244
    bind .b.f  "foo"
2245
    bind .b.f 
2246
} {}
2247
 
2248
 
2249
test bind-25.1 {ParseEventDescription procedure} {
2250
    list [catch {bind .b \x7 test} msg] $msg
2251
} {1 {bad ASCII character 0x7}}
2252
test bind-25.2 {ParseEventDescription procedure} {
2253
    list [catch {bind .b "\x7f" test} msg] $msg
2254
} {1 {bad ASCII character 0x7f}}
2255
test bind-25.3 {ParseEventDescription procedure} {
2256
    list [catch {bind .b "\x4" test} msg] $msg
2257
} {1 {bad ASCII character 0x4}}
2258
test bind-25.4 {ParseEventDescription procedure} {
2259
    setup
2260
    bind .b.f a test
2261
    bind .b.f a
2262
} {test}
2263
test bind-25.5 {ParseEventDescription procedure: virtual} {
2264
    list [catch {bind .b <<>> foo} msg] $msg
2265
} {1 {virtual event "<<>>" is badly formed}}
2266
test bind-25.6 {ParseEventDescription procedure: virtual} {
2267
    list [catch {bind .b <
2268
} {1 {missing ">" in virtual binding}}
2269
test bind-25.7 {ParseEventDescription procedure: virtual} {
2270
    list [catch {bind .b < foo} msg] $msg
2271
} {1 {missing ">" in virtual binding}}
2272
test bind-25.8 {ParseEventDescription procedure: correctly terminate virtual} {
2273
    list [catch {bind .b <>h foo} msg] $msg
2274
} {1 {virtual events may not be composed}}
2275
test bind-25.9 {ParseEventDescription procedure} {
2276
    list [catch {bind .b <> test} msg] $msg
2277
} {1 {no event type or button # or keysym}}
2278
test bind-25.10 {ParseEventDescription procedure: misinterpreted modifier} {
2279
    button .x
2280
    bind .x  a
2281
    bind .x  b
2282
    set x [lsort [bind .x]]
2283
    destroy .x
2284
    set x
2285
} { }
2286
test bind-25.11 {ParseEventDescription procedure} {
2287
    catch {destroy .b.f}
2288
    frame .b.f -class Test -width 150 -height 100
2289
    bind .b.f  {nothing}
2290
    bind .b.f
2291
} a
2292
test bind-25.12 {ParseEventDescription procedure} {
2293
    list [catch {bind .b 
2294
} {1 {missing ">" in binding}}
2295
test bind-25.13 {ParseEventDescription procedure} {
2296
    list [catch {bind .b  test} msg] $msg
2297
} {1 {extra characters after detail in binding}}
2298
test bind-25.14 {ParseEventDescription} {
2299
    setup
2300
    list [catch {bind .b <
2301
} {1 {missing ">" in virtual binding}}
2302
test bind-25.15 {ParseEventDescription} {
2303
    setup
2304
    list [catch {bind .b < {puts hi}} msg] $msg
2305
} {1 {missing ">" in virtual binding}}
2306
test bind-25.16 {ParseEventDescription} {
2307
    setup
2308
    bind .b <> {puts hi}
2309
    bind .b
2310
} {<>}
2311
test bind-25.17 {ParseEventDescription} {
2312
    setup
2313
    list [catch {event add <> <>} msg] $msg
2314
} {1 {virtual event not allowed in definition of another virtual event}}
2315
set i 1
2316
foreach check {
2317
    {{} }
2318
    { }
2319
    { }
2320
    { }
2321
    { }
2322
    { }
2323
    { }
2324
    { }
2325
    { }
2326
    { }
2327
    { }
2328
    { }
2329
    { }
2330
    { }
2331
    { }
2332
    { }
2333
    { }
2334
    { }
2335
    { }
2336
    { }
2337
    { }
2338
    { }
2339
    { }
2340
    { }
2341
    { }
2342
    { }
2343
    { }
2344
    { }
2345
    {{} }
2346
    { }
2347
    {{} }
2348
} {
2349
    test bind-25.$i {modifier names} {
2350
        catch {destroy .b.f}
2351
        frame .b.f -class Test -width 150 -height 100
2352
        bind .b.f [lindex $check 0] foo
2353
        bind .b.f
2354
    } [lindex $check 1]
2355
    bind .b.f [lindex $check 1] {}
2356
    incr i
2357
}
2358
 
2359
foreach event [bind Test] {
2360
    bind Test $event {}
2361
}
2362
foreach event [bind all] {
2363
    bind all $event {}
2364
}
2365
test bind-26.1 {event names} {
2366
    catch {destroy .b.f}
2367
    frame .b.f -class Test -width 150 -height 100
2368
    bind .b.f  {nothing}
2369
    bind .b.f
2370
} 
2371
test bind-26.2 {event names} {
2372
    catch {destroy .b.f}
2373
    frame .b.f -class Test -width 150 -height 100
2374
    bind .b.f  {nothing}
2375
    bind .b.f
2376
} 
2377
test bind-26.3 {event names} {
2378
    setup
2379
    bind .b.f  {lappend x "destroyed"}
2380
    set x [bind .b.f]
2381
    destroy .b.f
2382
    set x
2383
} { destroyed}
2384
set i 4
2385
foreach check {
2386
    {Motion Motion}
2387
    {Button Button}
2388
    {ButtonPress Button}
2389
    {ButtonRelease ButtonRelease}
2390
    {Colormap Colormap}
2391
    {Enter Enter}
2392
    {Leave Leave}
2393
    {Expose Expose}
2394
    {Key Key}
2395
    {KeyPress Key}
2396
    {KeyRelease KeyRelease}
2397
    {Property Property}
2398
    {Visibility Visibility}
2399
    {Activate Activate}
2400
    {Deactivate Deactivate}
2401
} {
2402
    set event [lindex $check 0]
2403
    test bind-26.$i {event names} {
2404
        setup
2405
        bind .b.f <$event> "set x {event $event}"
2406
        set x xyzzy
2407
        event gen .b.f <$event>
2408
        list $x [bind .b.f]
2409
    } [list "event $event" <[lindex $check 1]>]
2410
    incr i
2411
}
2412
foreach check {
2413
    {Circulate Circulate}
2414
    {Configure Configure}
2415
    {Gravity Gravity}
2416
    {Map Map}
2417
    {Reparent Reparent}
2418
    {Unmap Unmap}
2419
} {
2420
    set event [lindex $check 0]
2421
    test bind-26.$i {event names} {
2422
        setup
2423
        bind .b.f <$event> "set x {event $event}"
2424
        set x xyzzy
2425
        event gen .b.f <$event> -window .b.f
2426
        list $x [bind .b.f]
2427
    } [list "event $event" <[lindex $check 1]>]
2428
    incr i
2429
}
2430
 
2431
 
2432
test bind-27.1 {button names} {
2433
    list [catch {bind .b  foo} msg] $msg
2434
} {1 {specified button "1" for non-button event}}
2435
test bind-27.2 {button names} {
2436
    list [catch {bind .b  foo} msg] $msg
2437
} {1 {specified keysym "6" for non-key event}}
2438
set i 3
2439
foreach button {1 2 3 4 5} {
2440
    test bind-27.$i {button names} {
2441
        setup
2442
        bind .b.f  "lappend x \"button $button\""
2443
        set x [bind .b.f]
2444
        event gen .b.f 
2445
        set x
2446
    } [list  "button $button"]
2447
    incr i
2448
}
2449
 
2450
test bind-28.1 {keysym names} {
2451
    list [catch {bind .b  foo} msg] $msg
2452
} {1 {specified keysym "a" for non-key event}}
2453
test bind-28.2 {keysym names} {
2454
    list [catch {bind .b  foo} msg] $msg
2455
} {1 {bad event type or keysym "Gorp"}}
2456
test bind-28.3 {keysym names} {
2457
    list [catch {bind .b  foo} msg] $msg
2458
} {1 {bad event type or keysym "Stupid"}}
2459
test bind-28.4 {keysym names} {
2460
    catch {destroy .b.f}
2461
    frame .b.f -class Test -width 150 -height 100
2462
    bind .b.f  foo
2463
    bind .b.f
2464
} a
2465
set i 5
2466
foreach check {
2467
    {a 0 a}
2468
    {space 0 }
2469
    {Return 0 }
2470
    {X 1 X}
2471
} {
2472
    set keysym [lindex $check 0]
2473
    test bind-28.$i {keysym names} {
2474
        setup
2475
        bind .b.f  "lappend x \"keysym $keysym\""
2476
        bind .b.f  "lappend x {bad binding match}"
2477
        set x [lsort [bind .b.f]]
2478
        event gen .b.f  -state [lindex $check 1]
2479
        set x
2480
    } [concat [lsort "x [lindex $check 2]"] "{keysym $keysym}"]
2481
    incr i
2482
}
2483
 
2484
test bind-29.1 {dummy test to help ensure proper numbering} {} {}
2485
setup
2486
bind .b.f  {set x %K}
2487
set i 2
2488
foreach check {
2489
    {a 0 a}
2490
    {x 1 X}
2491
    {x 2 X}
2492
    {space 0 space}
2493
    {F1 1 F1}
2494
} {
2495
    test bind-29.$i {GetKeySym procedure} {nonPortable} {
2496
        set x nothing
2497
        event gen .b.f  -keysym [lindex $check 0] \
2498
                -state [lindex $check 1]
2499
        set x
2500
    } [lindex $check 2]
2501
    incr i
2502
}
2503
 
2504
 
2505
proc bgerror msg {
2506
    global x errorInfo
2507
    set x [list $msg $errorInfo]
2508
}
2509
test bind-30.1 {Tk_BackgroundError procedure} {
2510
    setup
2511
    bind .b.f 
2512
    set x none
2513
    event gen .b.f 
2514
    update
2515
    set x
2516
} {{This is a test} {This is a test
2517
    while executing
2518
"error "This is a test""
2519
    (command bound to event)}}
2520
test bind-30.2 {Tk_BackgroundError procedure} {
2521
    proc do {} {
2522
        event gen .b.f 
2523
    }
2524
    setup
2525
    bind .b.f 
2526
    set x none
2527
    do
2528
    update
2529
    set x
2530
} {Message2 {Message2
2531
    while executing
2532
"error Message2"
2533
    (command bound to event)}}
2534
rename bgerror {}
2535
 
2536
test bind-31.1 {MouseWheel events} {
2537
    setup
2538
    set x {}
2539
    bind .b.f  {set x Wheel}
2540
    event gen .b.f 
2541
    set x
2542
} {Wheel}
2543
test bind-31.2 {MouseWheel events} {
2544
    setup
2545
    set x {}
2546
    bind .b.f  {set x %D}
2547
    event gen .b.f  -delta 120
2548
    set x
2549
} {120}
2550
test bind-31.2 {MouseWheel events} {
2551
    setup
2552
    set x {}
2553
    bind .b.f  {set x "%D %x %y"}
2554
    event gen .b.f  -delta 240 -x 10 -y 30
2555
    set x
2556
} {240 10 30}
2557
 
2558
 
2559
destroy .b

powered by: WebSVN 2.1.0

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