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 "lappend x Button%b"
587
bind .b.f "lappend x Release%b"
588
set x {}
589
event gen .b.f -button 1
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 {set x Button}
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 "lappend x Button"
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 {set x Button}
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 -serial 101
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 -serial 104
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 {set x %b}
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 {set x "%t"}
1435
set x none
1436
event gen .b.f -time 4294
1437
set x
1438
} 4294
1439
test bind-16.32 {ExpandPercents procedure} {
1440
setup
1441
bind .b.f {set x "%x %y"}
1442
set x none
1443
event gen .b.f -x 881 -y 432
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 {set x "%X %Y"}
1534
set x none
1535
event gen .b.f -rootx 422 -rooty 13
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 {set x "%s %b"}
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 . -button} msg] $msg
1901
} {1 {value for "-button" missing}}
1902
test bind-22.9 {HandleEventGenerate} {
1903
setup
1904
bind .b.f {set x "%s %b"}
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 {lappend x %#}
1933
set x {}
1934
event gen .b.f -when now -serial 100
1935
set x
1936
} {100}
1937
test bind-22.14 {HandleEventGenerate} {
1938
setup
1939
bind .b.f {lappend x %#}
1940
set x {}
1941
event gen .b.f -when head -serial 100
1942
event gen .b.f -when head -serial 101
1943
event gen .b.f -when head -serial 102
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 {lappend x %#}
1951
set x {}
1952
event gen .b.f -when head -serial 99
1953
event gen .b.f -when mark -serial 100
1954
event gen .b.f -when mark -serial 101
1955
event gen .b.f -when mark -serial 102
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 {lappend x %#}
1963
set x {}
1964
event gen .b.f -when head -serial 99
1965
event gen .b.f -when tail -serial 100
1966
event gen .b.f -when tail -serial 101
1967
event gen .b.f -when tail -serial 102
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 . -when xyz} msg] $msg
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
{ %b {-button xyz} {{1 {expected integer but got "xyz"}}}}
1988
{ %b {-button 1} 1}
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
{ %b {-keycode 20} {{1 {bad option to event: "-keycode"}}}}
2012
2013
{ %K {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
2014
{ %K {-keysym a} a}
2015
{ %b {-keysym a} {{1 {bad option to event: "-keysym"}}}}
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
{ %R {-root .b} {[winfo id .b]}}
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
{ %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
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
{ %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
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
{ %s {-state 1} 1}
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
{ %S {-subwindow .b} {[winfo id .b]}}
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
{ %t {-time 100} 100}
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
{ %x {-x 2i} {[winfo pixels .b.f 2i]}}
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
{ %y {-y 2i} {[winfo pixels .b.f 2i]}}
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 {error "This is a test"}
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 {error Message2}
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
