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