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