diff options
author | rjohnson <rjohnson> | 1998-04-01 09:51:44 (GMT) |
---|---|---|
committer | rjohnson <rjohnson> | 1998-04-01 09:51:44 (GMT) |
commit | 066ea7fd88d49cb456f74da71dbe875e4fc0aabb (patch) | |
tree | 8fb30cb152c4dc191be47fa043d2e6f5ea38c7ba /tests/bind.test | |
parent | 13242623d2ff3ea02ab6a62bfb48a7dbb5c27e22 (diff) | |
download | tk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.zip tk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.tar.gz tk-066ea7fd88d49cb456f74da71dbe875e4fc0aabb.tar.bz2 |
Initial revision
Diffstat (limited to 'tests/bind.test')
-rw-r--r-- | tests/bind.test | 2530 |
1 files changed, 2530 insertions, 0 deletions
diff --git a/tests/bind.test b/tests/bind.test new file mode 100644 index 0000000..18de465 --- /dev/null +++ b/tests/bind.test @@ -0,0 +1,2530 @@ +# This file is a Tcl script to test out Tk's "bind" and "bindtags" +# commands plus the procedures in tkBind.c. It is organized in the +# standard fashion for Tcl tests. +# +# Copyright (c) 1994 The Regents of the University of California. +# Copyright (c) 1994-1995 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) bind.test 1.39 97/07/01 18:01:05 + +if {[string compare test [info procs test]] != 0} { + source defs +} + +catch {destroy .b} +toplevel .b -width 100 -height 50 +wm geom .b +0+0 +update idletasks + +proc setup {} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + pack .b.f + focus -force .b.f + foreach p [event info] {event delete $p} + update +} +setup + +foreach i [bind Test] { + bind Test $i {} +} +foreach i [bind all] { + bind all $i {} +} + +test bind-1.1 {bind command} { + list [catch {bind} msg] $msg +} {1 {wrong # args: should be "bind window ?pattern? ?command?"}} +test bind-1.2 {bind command} { + list [catch {bind a b c d} msg] $msg +} {1 {wrong # args: should be "bind window ?pattern? ?command?"}} +test bind-1.3 {bind command} { + list [catch {bind .gorp} msg] $msg +} {1 {bad window path name ".gorp"}} +test bind-1.4 {bind command} { + list [catch {bind foo} msg] $msg +} {0 {}} +test bind-1.5 {bind command} { + list [catch {bind .b <gorp-> {}} msg] $msg +} {0 {}} +test bind-1.6 {bind command} { + catch {destroy .b.f} + frame .b.f + bind .b.f <Enter> {test script} + set result [bind .b.f <Enter>] + bind .b.f <Enter> {} + list $result [bind .b.f <Enter>] +} {{test script} {}} +test bind-1.7 {bind command} { + catch {destroy .b.f} + frame .b.f + bind .b.f <Enter> {test script} + bind .b.f <Enter> {+more text} + bind .b.f <Enter> +} {test script +more text} +test bind-1.8 {bind command} { + list [catch {bind .b <gorp-> {test script}} msg] $msg [bind .b] +} {1 {bad event type or keysym "gorp"} {}} +test bind-1.9 {bind command} { + list [catch {bind .b <gorp->} msg] $msg +} {0 {}} +test bind-1.10 {bind command} { + catch {destroy .b.f} + frame .b.f + bind .b.f <Enter> {script 1} + bind .b.f <Leave> {script 2} + bind .b.f a {script for a} + bind .b.f b {script for b} + lsort [bind .b.f] +} {<Enter> <Leave> a b} + +test bind-2.1 {bindtags command} { + list [catch {bindtags} msg] $msg +} {1 {wrong # args: should be "bindtags window ?tags?"}} +test bind-2.2 {bindtags command} { + list [catch {bindtags a b c} msg] $msg +} {1 {wrong # args: should be "bindtags window ?tags?"}} +test bind-2.3 {bindtags command} { + list [catch {bindtags .foo} msg] $msg +} {1 {bad window path name ".foo"}} +test bind-2.4 {bindtags command} { + bindtags .b +} {.b Toplevel all} +test bind-2.5 {bindtags command} { + catch {destroy .b.f} + frame .b.f + bindtags .b.f +} {.b.f Frame .b all} +test bind-2.6 {bindtags command} { + catch {destroy .b.f} + frame .b.f + bindtags .b.f {{x y z} b c d} + bindtags .b.f +} {{x y z} b c d} +test bind-2.7 {bindtags command} { + catch {destroy .b.f} + frame .b.f + bindtags .b.f {x y z} + bindtags .b.f {} + bindtags .b.f +} {.b.f Frame .b all} +test bind-2.8 {bindtags command} { + catch {destroy .b.f} + frame .b.f + bindtags .b.f {x y z} + bindtags .b.f {a b c d} + bindtags .b.f +} {a b c d} +test bind-2.9 {bindtags command} { + catch {destroy .b.f} + frame .b.f + bindtags .b.f {a b c} + list [catch {bindtags .b.f "\{"} msg] $msg [bindtags .b.f] +} {1 {unmatched open brace in list} {.b.f Frame .b all}} +test bind-2.10 {bindtags command} { + catch {destroy .b.f} + frame .b.f + bindtags .b.f {a b c} + list [catch {bindtags .b.f "a .gorp b"} msg] $msg [bindtags .b.f] +} {0 {} {a .gorp b}} +test bind-3.1 {TkFreeBindingTags procedure} { + catch {destroy .b.f} + frame .b.f + bindtags .b.f "a b c d" + destroy .b.f +} {} +test bind-3.2 {TkFreeBindingTags procedure} { + catch {destroy .b.f} + frame .b.f + catch {bindtags .b.f "a .gorp b .b.f"} + destroy .b.f +} {} + +bind all <Enter> {lappend x "%W enter all"} +bind Test <Enter> {lappend x "%W enter frame"} +bind Toplevel <Enter> {lappend x "%W enter toplevel"} +bind xyz <Enter> {lappend x "%W enter xyz"} +bind {a b} <Enter> {lappend x "%W enter {a b}"} +bind .b <Enter> {lappend x "%W enter .b"} +test bind-4.1 {TkBindEventProc procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + pack .b.f + update + bind .b.f <Enter> {lappend x "%W enter .b.f"} + set x {} + event gen .b.f <Enter> + set x +} {{.b.f enter .b.f} {.b.f enter frame} {.b.f enter .b} {.b.f enter all}} +test bind-4.2 {TkBindEventProc procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + pack .b.f + update + bind .b.f <Enter> {lappend x "%W enter .b.f"} + bindtags .b.f {.b.f {a b} xyz} + set x {} + event gen .b.f <Enter> + set x +} {{.b.f enter .b.f} {.b.f enter {a b}} {.b.f enter xyz}} +test bind-4.3 {TkBindEventProc procedure} { + set x {} + event gen .b <Enter> + set x +} {{.b enter .b} {.b enter toplevel} {.b enter all}} +test bind-4.4 {TkBindEventProc procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + pack .b.f + update + bindtags .b.f {.b.f .b.f2 .b.f3} + frame .b.f3 -width 50 -height 50 + pack .b.f3 + bind .b.f <Enter> {lappend x "%W enter .b.f"} + bind .b.f3 <Enter> {lappend x "%W enter .b.f3"} + set x {} + event gen .b.f <Enter> + destroy .b.f3 + set x +} {{.b.f enter .b.f} {.b.f enter .b.f3}} +test bind-4.5 {TkBindEventProc procedure} { + # This tests memory allocation for objPtr; it won't serve any useful + # purpose unless run with some sort of allocation checker turned on. + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + pack .b.f + update + 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} + event gen .b.f <Enter> +} {} +bind all <Enter> {} +bind Test <Enter> {} +bind Toplevel <Enter> {} +bind xyz <Enter> {} +bind {a b} <Enter> {} +bind .b <Enter> {} + +test bind-5.1 {Tk_CreateBindingTable procedure} { + catch {destroy .b.c} + canvas .b.c + .b.c bind foo +} {} + + +test bind-6.1 {Tk_DeleteBindTable procedure} { + catch {destroy .b.c} + canvas .b.c + .b.c bind foo <1> {string 1} + .b.c create rectangle 0 0 100 100 + .b.c bind 1 <2> {string 2} + destroy .b.c +} {} +test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} { + catch {interp delete foo} + interp create foo + foo eval { + load {} Tk + load {} Tktest + wm geometry . +0+0 + frame .t -width 50 -height 50 + bindtags .t {a b c d} + pack .t + update + set x {} + testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1" + bind b <1> "lappend x b1" + testcbind c <1> "lappend x c1" "lappend x bye.c1" + testcbind c <2> "lappend x all2" "lappend x bye.all2" + event gen .t <1> + } + set x [foo eval set x] + interp delete foo + set x +} {a1 bye.all2 bye.a1 b1 bye.c1} + +test bind-7.1 {Tk_CreateBinding procedure: error} { + catch {destroy .b.c} + canvas .b.c + list [catch {.b.c bind foo <} msg] $msg +} {1 {no event type or button # or keysym}} +test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} { + catch {destroy .b.f} + frame .b.f + testcbind .b.f <1> "xyz" "lappend x bye.1" + set x {} + bind .b.f <1> "abc" + destroy .b.f + set x +} {bye.1} +test bind-7.3 {Tk_CreateBinding procedure: append} { + catch {destroy .b.c} + canvas .b.c + .b.c bind foo <1> "button 1" + .b.c bind foo <1> "+more button 1" + .b.c bind foo <1> +} {button 1 +more button 1} +test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} { + catch {destroy .b.c} + canvas .b.c + .b.c bind foo <1> "+button 1" + .b.c bind foo <1> +} {button 1} + +test bind-8.1 {TkCreateBindingProcedure: error} { + list [catch {testcbind . <xyz> "xyz"} msg] $msg +} {1 {bad event type or keysym "xyz"}} +test bind-8.2 {TkCreateBindingProcedure: new binding} { + catch {destroy .b.f} + frame .b.f + testcbind .b.f <1> "lappend x 1" "lappend x bye.1" + set x {} + event gen .b.f <1> + destroy .b.f + set x +} {bye.1} +test bind-8.3 {TkCreateBindingProcedure: replace existing} { + catch {destroy .b.f} + frame .b.f + pack .b.f + set x {} + testcbind .b.f <1> "lappend x old1" "lappend x bye.old1" + testcbind .b.f <1> "lappend x new1" "lappend x bye.new1" + set x +} {bye.old1} +test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} { + catch {destroy .b.f} + frame .b.f + pack .b.f + update + testcbind .b.f <1> "lappend x .b.f; testcbind Frame <1> {lappend x Frame}" + testcbind Frame <1> "lappend x never" + set x {} + event gen .b.f <1> + bind .b.f <1> {} + set x +} {.b.f Frame} + +test bind-9.1 {Tk_DeleteBinding procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + list [catch {bind .b.f <} msg] $msg +} {0 {}} +test bind-9.2 {Tk_DeleteBinding procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + foreach i {a b c d} { + bind .b.f $i "binding for $i" + } + set result {} + foreach i {b d a c} { + bind .b.f $i {} + lappend result [lsort [bind .b.f]] + } + set result +} {{a c d} {a c} c {}} +test bind-9.3 {Tk_DeleteBinding procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} { + bind .b.f $i "binding for $i" + } + set result {} + foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} { + bind .b.f $i {} + lappend result [lsort [bind .b.f]] + } + set result +} {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}} +test bind-9.4 {Tk_DeleteBinding procedure: pending bindings delete later} { + catch {destroy .b.f} + frame .b.f + pack .b.f + update + bindtags .b.f {a b c} + testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1} + bind b <1> {lappend x b1} + testcbind c <1> {lappend x c1} {lappend x bye.c1} + testcbind c <2> {lappend x c2} {lappend x bye.c2} + set x {} + event gen .b.f <1> + bind a <1> {} + bind b <1> {} + set x +} {a1 bye.c2 b1 bye.c1 bye.a1} + +test bind-10.1 {Tk_GetBinding procedure} { + catch {destroy .b.c} + canvas .b.c + list [catch {.b.c bind foo <} msg] $msg +} {1 {no event type or button # or keysym}} +test bind-10.2 {Tk_GetBinding procedure} { + catch {destroy .b.c} + canvas .b.c + .b.c bind foo a Test + .b.c bind foo a +} {Test} +test bind-10.3 {Tk_GetBinding procedure: C binding} { + catch {destroy .b.f} + frame .b.f + testcbind .b.f <1> "foo" + list [bind .b.f] [bind .b.f <1>] +} {<Button-1> {}} + +test bind-11.1 {Tk_GetAllBindings procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" { + bind .b.f $i Test + } + lsort [bind .b.f] +} {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~} +test bind-11.2 {Tk_GetAllBindings procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" { + bind .b.f $i Test + } + lsort [bind .b.f] +} {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>} +test bind-11.3 {Tk_GetAllBindings procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + foreach i "<Double-Triple-1> abcd a<Leave>b" { + bind .b.f $i Test + } + lsort [bind .b.f] +} {<Triple-Button-1> a<Leave>b abcd} + + +test bind-12.1 {Tk_DeleteAllBindings procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + destroy .b.f +} {} +test bind-12.2 {Tk_DeleteAllBindings procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + foreach i "a b c <Meta-1> <Alt-a> <Control-a>" { + bind .b.f $i x + } + destroy .b.f +} {} +test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} { + catch {destroy .b.f} + frame .b.f + pack .b.f + update + testcbind .b.f <1> {lappend x before; event gen .b.f <2>; lappend x after} {lappend x bye.f1} + testcbind .b.f <2> {destroy .b.f} {lappend x bye.f2} + bind .b.f <Destroy> {lappend x fDestroy} + testcbind .b.f <3> {foo} {lappend x bye.f3} + set x {} + event gen .b.f <1> + set x +} {before fDestroy bye.f3 bye.f2 after bye.f1} + +bind Test <KeyPress> {lappend x "%W %K Test press any"} +bind all <KeyPress> {lappend x "%W %K all press any"} +bind Test a {lappend x "%W %K Test press a"} +bind all x {lappend x "%W %K all press x"} + +test bind-13.1 {Tk_BindEvent procedure} { + setup + bind .b.f a {lappend x "%W %K .b.f press a"} + set x {} + event gen .b.f <Key-a> + event gen .b.f <Key-b> + event gen .b.f <Key-x> + set x +} {{.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}} + +bind Test <KeyPress> {lappend x "%W %K Test press any"; break} +bind all <KeyPress> {continue; lappend x "%W %K all press any"} + +test bind-13.2 {Tk_BindEvent procedure} { + setup + bind .b.f b {lappend x "%W %K .b.f press a"} + set x {} + event gen .b.f <Key-b> + set x +} {{.b.f b .b.f press a} {.b.f b Test press any}} +if {[info procs bgerror] == "bgerror"} { + rename bgerror {} +} +proc bgerror args {} +bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test} +test bind-13.3 {Tk_BindEvent procedure} { + setup + bind .b.f b {lappend x "%W %K .b.f press a"} + set x {} + event gen .b.f <Key-b> + update + list $x $errorInfo +} {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test + while executing +"error Test" + (command bound to event)}} +rename bgerror {} +test bind-13.4 {Tk_BindEvent procedure} { + proc foo {} { + set x 44 + event gen .b.f <Key-a> + } + setup + bind .b.f a {lappend x "%W %K .b.f press a"} + set x {} + foo + set x +} {{.b.f a .b.f press a} {.b.f a Test press a}} +test bind-13.5 {Tk_BindEvent procedure} { + bind all <Destroy> {lappend x "%W destroyed"} + set x {} + list [catch {frame .b.g -gorp foo} msg] $msg $x +} {1 {unknown option "-gorp"} {{.b.g destroyed}}} +foreach i [bind all] { + bind all $i {} +} +foreach i [bind Test] { + bind Test $i {} +} +test bind-13.6 {Tk_BindEvent procedure} { + setup + bind .b.f z {lappend x "%W z (.b.f binding)"} + bind Test z {lappend x "%W z (.b.f binding)"} + bind all z {bind .b.f z {}; lappend x "%W z (.b.f binding)"} + set x {} + event gen .b.f <Key-z> + bind Test z {} + bind all z {} + set x +} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}} +test bind-13.7 {Tk_BindEvent procedure} { + setup + bind .b.f z {lappend x "%W z (.b.f binding)"} + bind Test z {lappend x "%W z (.b.f binding)"} + bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"} + set x {} + event gen .b.f <Key-z> + bind Test z {} + bind all z {} + set x +} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}} +test bind-13.8 {Tk_BindEvent procedure} { + setup + bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"} + bind .b.f <ButtonPress> {lappend x "%W z (.b.f <ButtonPress> binding)"} + set x {} + event gen .b.f <Button-1> + event gen .b.f <Button-2> + set x +} {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f <ButtonPress> binding)}} +test bind-13.9 {Tk_BindEvent procedure: ignore NotifyInferior} { + setup + bind .b.f <Enter> "lappend x Enter%#" + bind .b.f <Leave> "lappend x Leave%#" + set x {} + event gen .b.f <Enter> -serial 100 -detail NotifyAncestor + event gen .b.f <Enter> -serial 101 -detail NotifyInferior + event gen .b.f <Leave> -serial 102 -detail NotifyAncestor + event gen .b.f <Leave> -serial 103 -detail NotifyInferior + set x +} {Enter100 Leave102} +test bind-13.10 {Tk_BindEvent procedure: collapse Motions} { + setup + bind .b.f <Motion> "lappend x Motion%#(%x,%y)" + set x {} + event gen .b.f <Motion> -serial 100 -x 100 -y 200 -when tail + update + event gen .b.f <Motion> -serial 101 -x 200 -y 300 -when tail + event gen .b.f <Motion> -serial 102 -x 300 -y 400 -when tail + update + set x +} {Motion100(100,200) Motion102(300,400)} +test bind-13.11 {Tk_BindEvent procedure: collapse repeating modifiers} { + setup + bind .b.f <Key> "lappend x %K%#" + bind .b.f <KeyRelease> "lappend x %K%#" + event gen .b.f <Key-Shift_L> -serial 100 -when tail + event gen .b.f <KeyRelease-Shift_L> -serial 101 -when tail + event gen .b.f <Key-Shift_L> -serial 102 -when tail + event gen .b.f <KeyRelease-Shift_L> -serial 103 -when tail + update +} {} +test bind-13.12 {Tk_BindEvent procedure: valid key detail} { + setup + bind .b.f <Key> "lappend x Key%K" + bind .b.f <KeyRelease> "lappend x Release%K" + set x {} + event gen .b.f <Key> -keysym a + event gen .b.f <KeyRelease> -keysym a + set x +} {Keya Releasea} +test bind-13.13 {Tk_BindEvent procedure: invalid key detail} { + setup + bind .b.f <Key> "lappend x Key%K" + bind .b.f <KeyRelease> "lappend x Release%K" + set x {} + event gen .b.f <Key> -keycode 0 + event gen .b.f <KeyRelease> -keycode 0 + set x +} {Key?? Release??} +test bind-13.14 {Tk_BindEvent procedure: button detail} { + setup + bind .b.f <Button> "lappend x Button%b" + bind .b.f <ButtonRelease> "lappend x Release%b" + set x {} + event gen .b.f <Button> -button 1 + event gen .b.f <ButtonRelease> -button 3 + set x +} {Button1 Release3} +test bind-13.15 {Tk_BindEvent procedure: virtual detail} { + setup + bind .b.f <<Paste>> "lappend x Paste" + set x {} + event gen .b.f <<Paste>> + set x +} {Paste} +test bind-13.16 {Tk_BindEvent procedure: virtual event in event stream} { + setup + bind .b.f <<Paste>> "lappend x Paste" + set x {} + event gen .b.f <<Paste>> + set x +} {Paste} +test bind-13.17 {Tk_BindEvent procedure: match detail physical} { + setup + bind .b.f <Button-2> {set x Button-2} + event add <<Paste>> <Button-2> + bind .b.f <<Paste>> {set x Paste} + set x {} + event gen .b.f <Button-2> + set x +} {Button-2} +test bind-13.18 {Tk_BindEvent procedure: no match detail physical} { + setup + event add <<Paste>> <Button-2> + bind .b.f <<Paste>> {set x Paste} + set x {} + event gen .b.f <Button-2> + set x +} {Paste} +test bind-13.19 {Tk_BindEvent procedure: match detail virtual} { + setup + event add <<Paste>> <Button-2> + bind .b.f <<Paste>> "lappend x Paste" + set x {} + event gen .b.f <Button-2> + set x +} {Paste} +test bind-13.20 {Tk_BindEvent procedure: no match detail virtual} { + setup + event add <<Paste>> <Button-2> + bind .b.f <<Paste>> "lappend x Paste" + set x {} + event gen .b.f <Button> + set x +} {} +test bind-13.21 {Tk_BindEvent procedure: match no-detail physical} { + setup + bind .b.f <Button> {set x Button} + event add <<Paste>> <Button> + bind .b.f <<Paste>> {set x Paste} + set x {} + event gen .b.f <Button-2> + set x +} {Button} +test bind-13.22 {Tk_BindEvent procedure: no match no-detail physical} { + setup + event add <<Paste>> <Button> + bind .b.f <<Paste>> {set x Paste} + set x {} + event gen .b.f <Button-2> + set x +} {Paste} +test bind-13.23 {Tk_BindEvent procedure: match no-detail virtual} { + setup + event add <<Paste>> <Button> + bind .b.f <<Paste>> "lappend x Paste" + set x {} + event gen .b.f <Button-2> + set x +} {Paste} +test bind-13.24 {Tk_BindEvent procedure: no match no-detail virtual} { + setup + event add <<Paste>> <Key> + bind .b.f <<Paste>> "lappend x Paste" + set x {} + event gen .b.f <Button> + set x +} {} +test bind-13.25 {Tk_BindEvent procedure: precedence} { + setup + event add <<Paste>> <Button-2> + event add <<Copy>> <Button> + bind .b.f <Button-2> "lappend x Button-2" + bind .b.f <<Paste>> "lappend x Paste" + bind .b.f <Button> "lappend x Button" + bind .b.f <<Copy>> "lappend x Copy" + + set x {} + event gen .b.f <Button-2> + bind .b.f <Button-2> {} + event gen .b.f <Button-2> + bind .b.f <<Paste>> {} + event gen .b.f <Button-2> + bind .b.f <Button> {} + event gen .b.f <Button-2> + bind .b.f <<Copy>> {} + event gen .b.f <Button-2> + set x +} {Button-2 Paste Button Copy} +test bind-13.26 {Tk_BindEvent procedure: no detail virtual pattern list} { + setup + bind .b.f <Button-2> {set x Button-2} + set x {} + event gen .b.f <Button-2> + set x +} {Button-2} +test bind-13.27 {Tk_BindEvent procedure: detail virtual pattern list} { + setup + event add <<Paste>> <Button-2> + bind .b.f <<Paste>> {set x Paste} + set x {} + event gen .b.f <Button-2> + set x +} {Paste} +test bind-13.28 {Tk_BindEvent procedure: no no-detail virtual pattern list} { + setup + bind .b.f <Button> {set x Button} + set x {} + event gen .b.f <Button-2> + set x +} {Button} +test bind-13.29 {Tk_BindEvent procedure: no-detail virtual pattern list} { + setup + event add <<Paste>> <Button> + bind .b.f <<Paste>> {set x Paste} + set x {} + event gen .b.f <Button-2> + set x +} {Paste} +test bind-13.30 {Tk_BindEvent procedure: no match} { + setup + event gen .b.f <Button-2> +} {} +test bind-13.31 {Tk_BindEvent procedure: match} { + setup + bind .b.f <Button-2> {set x Button-2} + set x {} + event gen .b.f <Button-2> + set x +} {Button-2} +test bind-13.32 {Tk_BindEvent procedure: many C bindings cause realloc} { + setup + bindtags .b.f {a b c d e f g h i j k l m n o p} + foreach p [bindtags .b.f] { + testcbind $p <1> "lappend x $p" + } + set x {} + event gen .b.f <1> + foreach p [bindtags .b.f] { + bind $p <1> {} + } + set x +} {a b c d e f g h i j k l m n o p} +test bind-13.33 {Tk_BindEvent procedure: multiple tags} { + setup + bind .b.f <Button-2> {lappend x .b.f} + bind Test <Button-2> {lappend x Button} + set x {} + event gen .b.f <Button-2> + bind Test <Button-2> {} + set x +} {.b.f Button} +test bind-13.34 {Tk_BindEvent procedure: execute C binding} { + setup + testcbind .b.f <1> {lappend x 1} + set x {} + event gen .b.f <1> + set x +} {1} +test bind-13.35 {Tk_BindEvent procedure: pending list marked deleted} { + setup + testcbind Test <1> {lappend x Test} {lappend x Deleted} + bind .b.f <1> {lappend x .b.f; destroy .b.f} + set x {} + event gen .b.f <1> + set y [list $x [bind Test]] + bind Test <1> {} + set y +} {.b.f <Button-1>} +test bind-13.36 {Tk_BindEvent procedure: C binding marked deleted} { + setup + testcbind Test <1> {lappend x Test} {lappend x Deleted} + bind .b.f <1> {lappend x .b.f; bind Test <1> {}; lappend x after} + set x {} + event gen .b.f <1> + set x +} {.b.f after Deleted} +test bind-13.37 {Tk_BindEvent procedure: C binding gets to run} { + setup + testcbind Test <1> {lappend x Test} + bind .b.f <1> {lappend x .b.f} + set x {} + event gen .b.f <1> + bind Test <1> {} + set x +} {.b.f Test} +test bind-13.38 {Tk_BindEvent procedure: C binding deleted, refcount == 0} { + setup + testcbind .b.f <1> {lappend x hi; bind .b.f <1> {}} {lappend x bye} + set x {} + event gen .b.f <1> + set x +} {hi bye} +test bind-13.39 {Tk_BindEvent procedure: C binding deleted, refcount != 0} { + setup + testcbind .b.f <1> { + lappend x before$n + if {$n==0} { + bind .b.f <1> {} + } else { + set n [expr $n-1] + event gen .b.f <1> + } + lappend x after$n + } {lappend x Deleted} + set n 3 + set x {} + event gen .b.f <1> + set x +} {before3 before2 before1 before0 after0 after0 after0 after0 Deleted} +test bind-13.40 {Tk_BindEvent procedure: continue in script} { + setup + bind .b.f <Button-2> {lappend x b1; continue; lappend x b2} + bind Test <Button-2> {lappend x B1; continue; lappend x B2} + set x {} + event gen .b.f <Button-2> + bind Test <Button-2> {} + set x +} {b1 B1} +test bind-13.41 {Tk_BindEvent procedure: continue in script} { + setup + testcbind .b.f <Button-2> {lappend x b1; continue; lappend x b2} + testcbind Test <Button-2> {lappend x B1; continue; lappend x B2} + set x {} + event gen .b.f <Button-2> + bind Test <Button-2> {} + set x +} {b1 B1} +test bind-13.42 {Tk_BindEvent procedure: break in script} { + setup + bind .b.f <Button-2> {lappend x b1; break; lappend x b2} + bind Test <Button-2> {lappend x B1; break; lappend x B2} + set x {} + event gen .b.f <Button-2> + bind Test <Button-2> {} + set x +} {b1} +test bind-13.43 {Tk_BindEvent procedure: break in script} { + setup + testcbind .b.f <Button-2> {lappend x b1; break; lappend x b2} + testcbind Test <Button-2> {lappend x B1; break; lappend x B2} + set x {} + event gen .b.f <Button-2> + bind Test <Button-2> {} + set x +} {b1} + +proc bgerror msg { + global x + lappend x $msg +} +test bind-13.44 {Tk_BindEvent procedure: error in script} { + setup + bind .b.f <Button-2> {lappend x b1; blap} + bind Test <Button-2> {lappend x B1} + set x {} + event gen .b.f <Button-2> + update + bind Test <Button-2> {} + set x +} {b1 {invalid command name "blap"}} +test bind-13.45 {Tk_BindEvent procedure: error in script} { + setup + testcbind .b.f <Button-2> {lappend x b1; blap} + testcbind Test <Button-2> {lappend x B1} + set x {} + event gen .b.f <Button-2> + update + bind Test <Button-2> {} + set x +} {b1 {invalid command name "blap"}} + +test bind-14.1 {TkBindDeadWindow: no C bindings pending} { + setup + bind .b.f <1> x + testcbind .b.f <2> y + destroy .b.f +} {} +test bind-14.2 {TkBindDeadWindow: is called after <Destroy>} { + setup + testcbind .b.f <Destroy> "lappend x .b.f" + testcbind Test <Destroy> "lappend x Test" + set x {} + destroy .b.f + bind Test <Destroy> {} + set x +} {.b.f Test} +test bind-14.3 {TkBindDeadWindow: pending C bindings} { + setup + bindtags .b.f {a b c d} + testcbind a <1> "lappend x a1" "lappend x bye.a1" + testcbind b <1> "destroy .b.f; lappend x b1" "lappend x bye.b1" + testcbind c <1> "lappend x c1" "lappend x bye.c1" + testcbind d <1> "lappend x d1" "lappend x bye.d1" + bind a <2> "event gen .b.f <1>" + testcbind b <2> "lappend x b2" "lappend x bye.b2" + testcbind c <2> "lappend x c2" "lappend x bye.d2" + bind d <2> "lappend x d2" + testcbind a <3> "event gen .b.f <2>" + set x {} + event gen .b.f <3> + set y $x + foreach tag {a b c d} { + foreach event {<1> <2> <3>} { + bind $tag $event {} + } + } + set y +} {a1 b1 d2} + +test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} { + setup + bind .b.f ab {set x 1} + set x 0 + event gen .b.f <Key-a> + event gen .b.f <KeyRelease-a> + event gen .b.f <Key-b> + event gen .b.f <KeyRelease-b> + set x +} 1 +test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} { + setup + bind .b.f ab {set x 1} + set x 0 + event gen .b.f <Key-a> + event gen .b.f <Enter> + event gen .b.f <KeyRelease-a> + event gen .b.f <Leave> + event gen .b.f <Key-b> + event gen .b.f <KeyRelease-b> + set x +} 1 +test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} { + setup + bind .b.f ab {set x 1} + set x 0 + event gen .b.f <Key-a> + event gen .b.f <Button-1> + event gen .b.f <Key-b> + set x +} 0 +test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-1> + event gen .b.f <ButtonRelease-1> + event gen .b.f <Button-1> + event gen .b.f <ButtonRelease-1> + set x +} 1 +test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} { + setup + bind .b.f <Double-ButtonRelease> {set x 1} + set x 0 + event gen .b.f <Button-1> + event gen .b.f <ButtonRelease-1> + event gen .b.f <Button-2> + event gen .b.f <ButtonRelease-2> + set x +} 1 +test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-1> + event gen .b.f <Key-a> + event gen .b.f <ButtonRelease-1> + event gen .b.f <Button-1> + event gen .b.f <ButtonRelease-1> + set x +} 0 +test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-1> + event gen .b.f <Key-Shift_L> + event gen .b.f <ButtonRelease-1> + event gen .b.f <Button-1> + event gen .b.f <ButtonRelease-1> + set x +} 1 +test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} { + setup + bind .b.f ab {set x 1} + set x 0 + event gen .b.f <Key-a> + event gen .b.f <Key-c> + event gen .b.f <Key-b> + set x +} 0 +test bind-15.9 {MatchPatterns procedure, modifier checks} { + setup + bind .b.f <M1-M2-Key> {set x 1} + set x 0 + event gen .b.f <Key-a> -state 0x18 + set x +} 1 +test bind-15.10 {MatchPatterns procedure, modifier checks} { + setup + bind .b.f <M1-M2-Key> {set x 1} + set x 0 + event gen .b.f <Key-a> -state 0xfc + set x +} 1 +test bind-15.11 {MatchPatterns procedure, modifier checks} { + setup + bind .b.f <M1-M2-Key> {set x 1} + set x 0 + event gen .b.f <Key-a> -state 0x8 + set x +} 0 +test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} {nonPortable} { + # This test is non-portable because the Shift_L keysym may behave + # differently on some platforms. + setup + bind .b.f aB {set x 1} + set x 0 + event gen .b.f <Key-a> + event gen .b.f <Key-Shift_L> + event gen .b.f <Key-b> -state 1 + set x +} 1 +test bind-15.13 {MatchPatterns procedure, checking detail} { + setup + bind .b.f ab {set x 1} + set x 0 + event gen .b.f <Key-a> + event gen .b.f <Key-c> + set x +} 0 +test bind-15.14 {MatchPatterns procedure, checking "nearby"} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-2> + event gen .b.f <Button-1> -x 30 -y 40 + event gen .b.f <Button-1> -x 31 -y 39 + set x +} 1 +test bind-15.15 {MatchPatterns procedure, checking "nearby"} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-2> + event gen .b.f <Button-1> -x 30 -y 40 + event gen .b.f <Button-1> -x 29 -y 41 + set x +} 1 +test bind-15.16 {MatchPatterns procedure, checking "nearby"} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-2> + event gen .b.f <Button-1> -x 30 -y 40 + event gen .b.f <Button-1> -x 40 -y 40 + set x +} 0 +test bind-15.17 {MatchPatterns procedure, checking "nearby"} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-2> + event gen .b.f <Button-1> -x 30 -y 40 + event gen .b.f <Button-1> -x 20 -y 40 + set x +} 0 +test bind-15.18 {MatchPatterns procedure, checking "nearby"} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-2> + event gen .b.f <Button-1> -x 30 -y 40 + event gen .b.f <Button-1> -x 30 -y 30 + set x +} 0 +test bind-15.19 {MatchPatterns procedure, checking "nearby"} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-2> + event gen .b.f <Button-1> -x 30 -y 40 + event gen .b.f <Button-1> -x 30 -y 50 + set x +} 0 +test bind-15.20 {MatchPatterns procedure, checking "nearby"} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-2> + event gen .b.f <Button-1> -time 300 + event gen .b.f <Button-1> -time 700 + set x +} 1 +test bind-15.21 {MatchPatterns procedure, checking "nearby"} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-2> + event gen .b.f <Button-1> -time 300 + event gen .b.f <Button-1> -time 900 + set x +} 0 +test bind-15.22 {MatchPatterns procedure, time wrap-around} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-1> -time [expr -100] + event gen .b.f <Button-1> -time 200 + set x +} 1 +test bind-15.23 {MatchPatterns procedure, time wrap-around} { + setup + bind .b.f <Double-1> {set x 1} + set x 0 + event gen .b.f <Button-1> -time -100 + event gen .b.f <Button-1> -time 500 + set x +} 0 +test bind-15.24 {MatchPatterns procedure, virtual event} { + setup + event add <<Paste>> <Button-1> + bind .b.f <<Paste>> {lappend x paste} + set x {} + event gen .b.f <Button-1> + set x +} {paste} +test bind-15.25 {MatchPatterns procedure, reject a virtual event} { + setup + event add <<Paste>> <Shift-Button-1> + bind .b.f <<Paste>> {lappend x paste} + set x {} + event gen .b.f <Button-1> + set x +} {} +test bind-15.26 {MatchPatterns procedure, reject a virtual event} { + setup + event add <<V1>> <Button> + event add <<V2>> <Button-1> + event add <<V3>> <Shift-Button-1> + bind .b.f <<V2>> "lappend x V2%#" + set x {} + event gen .b.f <Button> -serial 101 + event gen .b.f <Button-1> -serial 102 + event gen .b.f <Shift-Button-1> -serial 103 + bind .b.f <Shift-Button-1> "lappend x Shift-Button-1" + event gen .b.f <Button> -serial 104 + event gen .b.f <Button-1> -serial 105 + event gen .b.f <Shift-Button-1> -serial 106 + set x +} {V2102 V2103 V2105 Shift-Button-1} +test bind-15.27 {MatchPatterns procedure, conflict resolution} { + setup + bind .b.f <KeyPress> {set x 0} + bind .b.f a {set x 1} + set x none + event gen .b.f <Key-a> + set x +} 1 +test bind-15.28 {MatchPatterns procedure, conflict resolution} { + setup + bind .b.f <KeyPress> {set x 0} + bind .b.f a {set x 1} + set x none + event gen .b.f <Key-b> + set x +} 0 +test bind-15.29 {MatchPatterns procedure, conflict resolution} { + setup + bind .b.f <KeyPress> {lappend x 0} + bind .b.f a {lappend x 1} + bind .b.f ba {lappend x 2} + set x none + event gen .b.f <Key-b> + event gen .b.f <KeyRelease-b> + event gen .b.f <Key-a> + set x +} {none 0 2} +test bind-15.30 {MatchPatterns procedure, conflict resolution} { + setup + bind .b.f <ButtonPress> {set x 0} + bind .b.f <1> {set x 1} + set x none + event gen .b.f <Button-1> + set x +} 1 +test bind-15.31 {MatchPatterns procedure, conflict resolution} { + setup + bind .b.f <M1-Key> {set x 0} + bind .b.f <M2-Key> {set x 1} + set x none + event gen .b.f <Key-a> -state 0x18 + set x +} 1 +test bind-15.32 {MatchPatterns procedure, conflict resolution} { + setup + bind .b.f <M2-Key> {set x 0} + bind .b.f <M1-Key> {set x 1} + set x none + event gen .b.f <Key-a> -state 0x18 + set x +} 1 +test bind-15.33 {MatchPatterns procedure, conflict resolution} { + setup + bind .b.f <1> {lappend x single} + bind Test <1> {lappend x single(Test)} + bind Test <Double-1> {lappend x double(Test)} + set x {} + event gen .b.f <Button-1> + event gen .b.f <Button-1> + event gen .b.f <Button-1> + set x +} {single single(Test) single double(Test) single double(Test)} +foreach i [bind Test] { + bind Test $i {} +} +test bind-16.1 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x abcd} + set x none + event gen .b.f <Enter> + set x +} abcd +test bind-16.2 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x %#} + set x none + event gen .b.f <Enter> -serial 1234 + set x +} 1234 +test bind-16.3 {ExpandPercents procedure} { + setup + bind .b.f <Configure> {set x %a} + set x none + event gen .b.f <Configure> -above .b -window .b.f + set x +} [winfo id .b] +test bind-16.4 {ExpandPercents procedure} { + setup + bind .b.f <Button> {set x %b} + set x none + event gen .b.f <Button-3> + set x +} 3 +test bind-16.5 {ExpandPercents procedure} { + setup + bind .b.f <Expose> {set x %c} + set x none + event gen .b.f <Expose> -count 47 + set x +} 47 +test bind-16.6 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x %d} + set x none + event gen .b.f <Enter> -detail NotifyAncestor + set x +} NotifyAncestor +test bind-16.7 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x %d} + set x none + event gen .b.f <Enter> -detail NotifyVirtual + set x +} NotifyVirtual +test bind-16.8 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x %d} + set x none + event gen .b.f <Enter> -detail NotifyNonlinear + set x +} NotifyNonlinear +test bind-16.9 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x %d} + set x none + event gen .b.f <Enter> -detail NotifyNonlinearVirtual + set x +} NotifyNonlinearVirtual +test bind-16.10 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x %d} + set x none + event gen .b.f <Enter> -detail NotifyPointer + set x +} NotifyPointer +test bind-16.11 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x %d} + set x none + event gen .b.f <Enter> -detail NotifyPointerRoot + set x +} NotifyPointerRoot +test bind-16.12 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x %d} + set x none + event gen .b.f <Enter> -detail NotifyDetailNone + set x +} NotifyDetailNone +test bind-16.13 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x %f} + set x none + event gen .b.f <Enter> -focus 1 + set x +} 1 +test bind-16.14 {ExpandPercents procedure} { + setup + bind .b.f <Expose> {set x "%x %y %w %h"} + set x none + event gen .b.f <Expose> -x 24 -y 18 -width 147 -height 61 + set x +} {24 18 147 61} +test bind-16.15 {ExpandPercents procedure} { + setup + bind .b.f <Configure> {set x "%x %y %w %h"} + set x none + event gen .b.f <Configure> -x 24 -y 18 -width 147 -height 61 -window .b.f + set x +} {24 18 147 61} +test bind-16.16 {ExpandPercents procedure} { + setup + bind .b.f <Key> {set x "%k"} + set x none + event gen .b.f <Key> -keycode 146 + set x +} 146 +test bind-16.17 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x "%m"} + set x none + event gen .b.f <Enter> -mode NotifyNormal + set x +} NotifyNormal +test bind-16.18 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x "%m"} + set x none + event gen .b.f <Enter> -mode NotifyGrab + set x +} NotifyGrab +test bind-16.19 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x "%m"} + set x none + event gen .b.f <Enter> -mode NotifyUngrab + set x +} NotifyUngrab +test bind-16.20 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x "%m"} + set x none + event gen .b.f <Enter> -mode NotifyWhileGrabbed + set x +} NotifyWhileGrabbed +test bind-16.21 {ExpandPercents procedure} { + setup + bind .b.f <Map> {set x "%o"} + set x none + event gen .b.f <Map> -override 1 -window .b.f + set x +} 1 +test bind-16.22 {ExpandPercents procedure} { + setup + bind .b.f <Reparent> {set x "%o"} + set x none + event gen .b.f <Reparent> -override true -window .b.f + set x +} 1 +test bind-16.23 {ExpandPercents procedure} { + setup + bind .b.f <Configure> {set x "%o"} + set x none + event gen .b.f <Configure> -override 1 -window .b.f + set x +} 1 +test bind-16.24 {ExpandPercents procedure} { + setup + bind .b.f <Circulate> {set x "%p"} + set x none + event gen .b.f <Circulate> -place PlaceOnTop -window .b.f + set x +} PlaceOnTop +test bind-16.25 {ExpandPercents procedure} { + setup + bind .b.f <Circulate> {set x "%p"} + set x none + event gen .b.f <Circulate> -place PlaceOnBottom -window .b.f + set x +} PlaceOnBottom +test bind-16.26 {ExpandPercents procedure} { + setup + bind .b.f <1> {set x "%s"} + set x none + event gen .b.f <Button-1> -state 122 + set x +} 122 +test bind-16.27 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x "%s"} + set x none + event gen .b.f <Enter> -state 0x3ff + set x +} 1023 +test bind-16.28 {ExpandPercents procedure} { + setup + bind .b.f <Visibility> {set x "%s"} + set x none + event gen .b.f <Visibility> -state VisibilityPartiallyObscured + set x +} VisibilityPartiallyObscured +test bind-16.29 {ExpandPercents procedure} { + setup + bind .b.f <Visibility> {set x "%s"} + set x none + event gen .b.f <Visibility> -state VisibilityUnobscured + set x +} VisibilityUnobscured +test bind-16.30 {ExpandPercents procedure} { + setup + bind .b.f <Visibility> {set x "%s"} + set x none + event gen .b.f <Visibility> -state VisibilityFullyObscured + set x +} VisibilityFullyObscured +test bind-16.31 {ExpandPercents procedure} { + setup + bind .b.f <Button> {set x "%t"} + set x none + event gen .b.f <Button> -time 4294 + set x +} 4294 +test bind-16.32 {ExpandPercents procedure} { + setup + bind .b.f <Button> {set x "%x %y"} + set x none + event gen .b.f <Button> -x 881 -y 432 + set x +} {881 432} +test bind-16.33 {ExpandPercents procedure} { + setup + bind .b.f <Reparent> {set x "%x %y"} + set x none + event gen .b.f <Reparent> -x 882 -y 431 -window .b.f + set x +} {882 431} +test bind-16.34 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x "%x %y"} + set x none + event gen .b.f <Enter> -x 781 -y 632 + set x +} {781 632} +test bind-16.35 {ExpandPercents procedure} {nonPortable} { + setup + bind .b.f <Key> {lappend x "%A"} + set x {} + event gen .b.f <Key-a> + event gen .b.f <Key-A> -state 1 + event gen .b.f <Key-Tab> + event gen .b.f <Key-Return> + event gen .b.f <Key-F1> + event gen .b.f <Key-Shift_L> + event gen .b.f <Key-space> + event gen .b.f <Key-dollar> -state 1 + event gen .b.f <Key-braceleft> -state 1 + set x +} "a A { } {\r} {{}} {{}} { } {\$} \\\{" +test bind-16.36 {ExpandPercents procedure} { + setup + bind .b.f <Configure> {set x "%B"} + set x none + event gen .b.f <Configure> -borderwidth 24 -window .b.f + set x +} 24 +test bind-16.37 {ExpandPercents procedure} { + setup + bind .b.f <Enter> {set x "%E"} + set x none + event gen .b.f <Enter> -sendevent 1 + set x +} 1 +test bind-16.38 {ExpandPercents procedure} {nonPortable} { + setup + bind .b.f <Key> {lappend x %K} + set x {} + event gen .b.f <Key-a> + event gen .b.f <Key-A> -state 1 + event gen .b.f <Key-Tab> + event gen .b.f <Key-F1> + event gen .b.f <Key-Shift_L> + event gen .b.f <Key-space> + event gen .b.f <Key-dollar> -state 1 + event gen .b.f <Key-braceleft> -state 1 + set x +} {a A Tab F1 Shift_L space dollar braceleft} +test bind-16.39 {ExpandPercents procedure} { + setup + bind .b.f <Key> {set x "%N"} + set x none + event gen .b.f <Key-a> + set x +} 97 +test bind-16.40 {ExpandPercents procedure} { + setup + bind .b.f <Key> {set x "%S"} + set x none + event gen .b.f <Key-a> -subwindow .b + set x +} [winfo id .b] +test bind-16.41 {ExpandPercents procedure} { + setup + bind .b.f <Key> {set x "%T"} + set x none + event gen .b.f <Key> + set x +} 2 +test bind-16.42 {ExpandPercents procedure} { + setup + bind .b.f <Key> {set x "%W"} + set x none + event gen .b.f <Key> + set x +} .b.f +test bind-16.43 {ExpandPercents procedure} { + setup + bind .b.f <Button> {set x "%X %Y"} + set x none + event gen .b.f <Button> -rootx 422 -rooty 13 + set x +} {422 13} + + +test bind-17.1 {event command} { + list [catch {event} msg] $msg +} {1 {wrong # args: should be "event option ?arg1?"}} +test bind-17.2 {event command} { + list [catch {event {}} msg] $msg +} {1 {bad option "": should be add, delete, generate, info}} +test bind-17.3 {event command: add} { + list [catch {event add} msg] $msg +} {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}} +test bind-17.4 {event command: add 1} { + setup + event add <<Paste>> <Control-v> + event info <<Paste>> +} {<Control-Key-v>} +test bind-17.5 {event command: add 2} { + setup + event add <<Paste>> <Control-v> <Button-2> + lsort [event info <<Paste>>] +} {<Button-2> <Control-Key-v>} +test bind-17.6 {event command: add with error} { + setup + list [catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>} \ + msg] $msg [lsort [event info <<Paste>>]] +} {1 {bad event type or keysym "xyz"} {<Button-2> <Control-Key-v> abc}} +test bind-17.7 {event command: delete} { + list [catch {event delete} msg] $msg +} {1 {wrong # args: should be "event delete virtual ?sequence sequence ...?"}} +test bind-17.8 {event command: delete many} { + setup + event add <<Paste>> <3> <1> <2> t + event delete <<Paste>> <1> <2> + lsort [event info <<Paste>>] +} {<Button-3> t} +test bind-17.9 {event command: delete all} { + setup + event add <<Paste>> a b + event delete <<Paste>> + event info <<Paste>> +} {} +test bind-17.10 {event command: delete 1} { + setup + event add <<Paste>> a b c + event delete <<Paste>> b + lsort [event info <<Paste>>] +} {a c} +test bind-17.11 {event command: info name} { + setup + event add <<Paste>> a b c + lsort [event info <<Paste>>] +} {a b c} +test bind-17.12 {event command: info all} { + setup + event add <<Paste>> a + event add <<Alive>> b + lsort [event info] +} {<<Alive>> <<Paste>>} +test bind-17.13 {event command: info error} { + list [catch {event info <<Paste>> <Control-v>} msg] $msg +} {1 {wrong # args: should be "event info ?virtual?"}} +test bind-17.14 {event command: generate} { + list [catch {event generate} msg] $msg +} {1 {wrong # args: should be "event generate window event ?options?"}} +test bind-17.15 {event command: generate} { + setup + bind .b.f <1> "lappend x 1" + set x {} + event generate .b.f <1> + set x +} {1} +test bind-17.16 {event command: generate} { + list [catch {event generate .b.f <xyz>} msg] $msg +} {1 {bad event type or keysym "xyz"}} +test bind-17.17 {event command} { + list [catch {event foo} msg] $msg +} {1 {bad option "foo": should be add, delete, generate, info}} + + +test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} { + list [catch {event add asd <Ctrl-v>} msg] $msg +} {1 {virtual event "asd" is badly formed}} +test bind-18.2 {CreateVirtualEvent procedure: FindSequence} { + list [catch {event add <<asd>> <Ctrl-v>} msg] $msg +} {1 {bad event type or keysym "Ctrl"}} +test bind-18.3 {CreateVirtualEvent procedure: new physical} { + setup + event add <<xyz>> <Control-v> + event info <<xyz>> +} {<Control-Key-v>} +test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} { + setup + event add <<xyz>> <Control-v> + event add <<xyz>> <Control-v> + event info <<xyz>> +} {<Control-Key-v>} +test bind-18.5 {CreateVirtualEvent procedure: existing physical} { + setup + event add <<xyz>> <Control-v> + event add <<abc>> <Control-v> + list [lsort [event info]] [event info <<xyz>>] [event info <<abc>>] +} {{<<abc>> <<xyz>>} <Control-Key-v> <Control-Key-v>} +test bind-18.6 {CreateVirtualEvent procedure: new virtual} { + setup + event add <<xyz>> <Control-v> + list [event info] [event info <<xyz>>] +} {<<xyz>> <Control-Key-v>} +test bind-18.7 {CreateVirtualEvent procedure: existing virtual} { + setup + event add <<xyz>> <Control-v> + event add <<xyz>> <Button-2> + list [event info] [lsort [event info <<xyz>>]] +} {<<xyz>> {<Button-2> <Control-Key-v>}} + + +test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} { + list [catch {event add xyz {}} msg] $msg +} {1 {virtual event "xyz" is badly formed}} +test bind-19.2 {DeleteVirtualEvent procedure: non-existent virtual} { + setup + event delete <<xyz>> + event info +} {} +test bind-19.3 {DeleteVirtualEvent procedure: delete 1} { + setup + event add <<xyz>> <Control-v> + event delete <<xyz>> <Control-v> + event info <<xyz>> +} {} +test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} { + setup + event add <<xyz>> <Control-v> + event delete <<xyz>> <Button-1> + event info <<xyz>> +} {<Control-Key-v>} +test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} { + setup + event add <<xyz>> <Control-v> + list [catch {event delete <<xyz>> <xyz>} msg] $msg +} {1 {bad event type or keysym "xyz"}} +test bind-19.6 {DeleteVirtualEvent procedure: delete 1, badly formed} { + setup + event add <<xyz>> <Control-v> + list [catch {event delete <<xyz>> <<Paste>>} msg] $msg +} {1 {virtual event not allowed in definition of another virtual event}} +test bind-19.7 {DeleteVirtualEvent procedure: owns 1, delete all} { + setup + event add <<xyz>> <Control-v> + event delete <<xyz>> + event info +} {} +test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} { + setup + event add <<xyz>> <Control-v> + event delete <<xyz>> <Control-v> + event info +} {} +test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} { + setup + event add <<xyz>> <Control-v> <Control-w> <Control-x> + event delete <<xyz>> + event info +} {} +test bind-19.10 {DeleteVirtualEvent procedure: owns many, delete 1} { + setup + event add <<xyz>> <Control-v> <Control-w> <Control-x> + event delete <<xyz>> <Control-w> + lsort [event info <<xyz>>] +} {<Control-Key-v> <Control-Key-x>} +test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} { + setup + event add <<xyz>> <Button-2> + bind .b.f <<xyz>> {lappend x %#} + set x {} + event gen .b.f <Button-2> -serial 101 + event delete <<xyz>> + event gen .b.f <Button-2> -serial 102 + set x +} {101} +test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} { + setup + event add <<abc>> <Control-Button-2> + event add <<xyz>> <Button-2> + bind .b.f <<xyz>> {lappend x xyz} + bind .b.f <<abc>> {lappend x abc} + set x {} + event gen .b.f <Button-2> + event gen .b.f <Control-Button-2> + event delete <<xyz>> + event gen .b.f <Button-2> + event gen .b.f <Control-Button-2> + list $x [event info <<abc>>] +} {{xyz abc abc} <Control-Button-2>} +test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} { + setup + event add <<def>> <Shift-Button-2> + event add <<xyz>> <Button-2> + event add <<abc>> <Control-Button-2> + bind .b.f <<xyz>> {lappend x xyz} + bind .b.f <<abc>> {lappend x abc} + bind .b.f <<def>> {lappend x def} + set x {} + event gen .b.f <Button-2> + event gen .b.f <Control-Button-2> + event gen .b.f <Shift-Button-2> + event delete <<xyz>> + event gen .b.f <Button-2> + event gen .b.f <Control-Button-2> + event gen .b.f <Shift-Button-2> + list $x [event info <<def>>] [event info <<xyz>>] [event info <<abc>>] +} {{xyz abc def abc def} <Shift-Button-2> {} <Control-Button-2>} +test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} { + setup + event add <<xyz>> <Button-2> + event add <<abc>> <Control-Button-2> + event add <<def>> <Shift-Button-2> + bind .b.f <<xyz>> {lappend x xyz} + bind .b.f <<abc>> {lappend x abc} + bind .b.f <<def>> {lappend x def} + set x {} + event gen .b.f <Button-2> + event gen .b.f <Control-Button-2> + event gen .b.f <Shift-Button-2> + event delete <<xyz>> + event gen .b.f <Button-2> + event gen .b.f <Control-Button-2> + event gen .b.f <Shift-Button-2> + list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] +} {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>} +test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} { + setup + pack [frame .b.g -class Test -width 150 -height 100] + pack [frame .b.h -class Test -width 150 -height 100] + update + event add <<xyz>> <Button-2> + event add <<abc>> <Button-2> + event add <<def>> <Button-2> + bind .b.f <<xyz>> {lappend x xyz} + bind .b.g <<abc>> {lappend x abc} + bind .b.h <<def>> {lappend x def} + set x {} + event gen .b.f <Button-2> + event gen .b.g <Button-2> + event gen .b.h <Button-2> + event delete <<xyz>> + event gen .b.f <Button-2> + event gen .b.g <Button-2> + event gen .b.h <Button-2> + destroy .b.g + destroy .b.h + list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] +} {{xyz abc def abc def} {} <Button-2> <Button-2>} +test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} { + setup + pack [frame .b.g -class Test -width 150 -height 100] + pack [frame .b.h -class Test -width 150 -height 100] + update + event add <<xyz>> <Button-2> + event add <<abc>> <Button-2> + event add <<def>> <Button-2> + bind .b.f <<xyz>> {lappend x xyz} + bind .b.g <<abc>> {lappend x abc} + bind .b.h <<def>> {lappend x def} + set x {} + event gen .b.f <Button-2> + event gen .b.g <Button-2> + event gen .b.h <Button-2> + event delete <<abc>> + event gen .b.f <Button-2> + event gen .b.g <Button-2> + event gen .b.h <Button-2> + destroy .b.g + destroy .b.h + list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] +} {{xyz abc def xyz def} <Button-2> {} <Button-2>} +test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} { + setup + pack [frame .b.g -class Test -width 150 -height 100] + pack [frame .b.h -class Test -width 150 -height 100] + update + event add <<xyz>> <Button-2> + event add <<abc>> <Button-2> + event add <<def>> <Button-2> + bind .b.f <<xyz>> {lappend x xyz} + bind .b.g <<abc>> {lappend x abc} + bind .b.h <<def>> {lappend x def} + set x {} + event gen .b.f <Button-2> + event gen .b.g <Button-2> + event gen .b.h <Button-2> + event delete <<def>> + event gen .b.f <Button-2> + event gen .b.g <Button-2> + event gen .b.h <Button-2> + destroy .b.g + destroy .b.h + list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] +} {{xyz abc def xyz abc} <Button-2> <Button-2> {}} + + +test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} { + list [catch {event info asd} msg] $msg +} {1 {virtual event "asd" is badly formed}} +test bind-20.2 {GetVirtualEvent procedure: non-existent event} { + event info <<asd>> +} {} +test bind-20.3 {GetVirtualEvent procedure: owns 1} { + setup + event add <<xyz>> <Control-Key-v> + event info <<xyz>> +} {<Control-Key-v>} +test bind-20.4 {GetVirtualEvent procedure: owns many} { + setup + event add <<xyz>> <Control-v> <Button-2> spack + event info <<xyz>> +} {<Control-Key-v> <Button-2> spack} + + +test bind-21.1 {GetAllVirtualEvents procedure: no events} { + setup + event info +} {} +test bind-21.2 {GetAllVirtualEvents procedure: 1 event} { + setup + event add <<xyz>> <Control-v> + event info +} {<<xyz>>} +test bind-21.3 {GetAllVirtualEvents procedure: many events} { + setup + event add <<xyz>> <Control-v> + event add <<xyz>> <Button-2> + event add <<abc>> <Control-v> + event add <<def>> <Key-F6> + lsort [event info] +} {<<abc>> <<def>> <<xyz>>} + +test bind-22.1 {HandleEventGenerate} { + list [catch {event gen .xyz <Control-v>} msg] $msg +} {1 {bad window path name ".xyz"}} +test bind-22.2 {HandleEventGenerate} { + list [catch {event gen zzz <Control-v>} msg] $msg +} {1 {bad window name/identifier "zzz"}} +test bind-22.3 {HandleEventGenerate} { + list [catch {event gen 47 <Control-v>} msg] $msg +} {1 {window id "47" doesn't exist in this application}} +test bind-22.4 {HandleEventGenerate} { + setup + bind .b.f <Button> {set x "%s %b"} + set x {} + event gen [winfo id .b.f] <Control-Button-1> + set x +} {4 1} +test bind-22.5 {HandleEventGenerate} { + list [catch {event gen . <xyz>} msg] $msg +} {1 {bad event type or keysym "xyz"}} +test bind-22.6 {HandleEventGenerate} { + list [catch {event gen . <Double-Button-1>} msg] $msg +} {1 {Double or Triple modifier not allowed}} +test bind-22.7 {HandleEventGenerate} { + list [catch {event gen . xyz} msg] $msg +} {1 {only one event specification allowed}} +test bind-22.8 {HandleEventGenerate} { + list [catch {event gen . <Button> -button} msg] $msg +} {1 {value for "-button" missing}} +test bind-22.9 {HandleEventGenerate} { + setup + bind .b.f <Button> {set x "%s %b"} + set x {} + event gen .b.f <Control-Button-1> + set x +} {4 1} +test bind-22.10 {HandleEventGenerate} { + setup + bind .b.f <Key> {set x "%s %K"} + set x {} + event gen .b.f <Control-Key-1> + set x +} {4 1} +test bind-22.11 {HandleEventGenerate} { + setup + bind .b.f <<Paste>> {set x "%s"} + set x {} + event gen .b.f <<Paste>> -state 1 + set x +} {1} +test bind-22.12 {HandleEventGenerate} { + setup + bind .b.f <Motion> {set x "%s"} + set x {} + event gen .b.f <Control-Motion> + set x +} {4} +test bind-22.13 {HandleEventGenerate} { + setup + bind .b.f <Button> {lappend x %#} + set x {} + event gen .b.f <Button> -when now -serial 100 + set x +} {100} +test bind-22.14 {HandleEventGenerate} { + setup + bind .b.f <Button> {lappend x %#} + set x {} + event gen .b.f <Button> -when head -serial 100 + event gen .b.f <Button> -when head -serial 101 + event gen .b.f <Button> -when head -serial 102 + lappend x foo + update + set x +} {foo 102 101 100} +test bind-22.15 {HandleEventGenerate} { + setup + bind .b.f <Button> {lappend x %#} + set x {} + event gen .b.f <Button> -when head -serial 99 + event gen .b.f <Button> -when mark -serial 100 + event gen .b.f <Button> -when mark -serial 101 + event gen .b.f <Button> -when mark -serial 102 + lappend x foo + update + set x +} {foo 100 101 102 99} +test bind-22.16 {HandleEventGenerate} { + setup + bind .b.f <Button> {lappend x %#} + set x {} + event gen .b.f <Button> -when head -serial 99 + event gen .b.f <Button> -when tail -serial 100 + event gen .b.f <Button> -when tail -serial 101 + event gen .b.f <Button> -when tail -serial 102 + lappend x foo + update + set x +} {foo 99 100 101 102} +test bind-22.17 {HandleEventGenerate} { + list [catch {event gen . <Button> -when xyz} msg] $msg +} {1 {bad position "xyz": should be now, head, mark, tail}} +set i 14 +foreach check { + {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}} + {<Configure> %a {-above .b} {[winfo id .b]}} + {<Configure> %a {-above xyz} {{1 {expected integer but got "xyz"}}}} + {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}} + {<Key> %b {-above .} {{1 {bad option to <Key> event: "-above"}}}} + + {<Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}} + {<Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}} + {<Key> %k {-borderwidth 2i} {{1 {bad option to <Key> event: "-borderwidth"}}}} + + {<Button> %b {-button xyz} {{1 {expected integer but got "xyz"}}}} + {<Button> %b {-button 1} 1} + {<Key> %k {-button 1} {{1 {bad option to <Key> event: "-button"}}}} + + {<Expose> %c {-count xyz} {{1 {expected integer but got "xyz"}}}} + {<Expose> %c {-count 20} 20} + {<Key> %b {-count 20} {{1 {bad option to <Key> event: "-count"}}}} + + {<Enter> %d {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, NotifyDetailNone}}}} + {<FocusIn> %d {-detail NotifyVirtual} {{}}} + {<Enter> %d {-detail NotifyVirtual} NotifyVirtual} + {<Key> %k {-detail NotifyVirtual} {{1 {bad option to <Key> event: "-detail"}}}} + + {<Enter> %f {-focus xyz} {{1 {expected boolean value but got "xyz"}}}} + {<Enter> %f {-focus 1} 1} + {<Key> %k {-focus 1} {{1 {bad option to <Key> event: "-focus"}}}} + + {<Expose> %h {-height xyz} {{1 {bad screen distance "xyz"}}}} + {<Expose> %h {-height 2i} {[winfo pixels .b.f 2i]}} + {<Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}} + {<Key> %k {-height 2i} {{1 {bad option to <Key> event: "-height"}}}} + + {<Key> %k {-keycode xyz} {{1 {expected integer but got "xyz"}}}} + {<Key> %k {-keycode 20} 20} + {<Button> %b {-keycode 20} {{1 {bad option to <Button> event: "-keycode"}}}} + + {<Key> %K {-keysym xyz} {{1 {unknown keysym "xyz"}}}} + {<Key> %K {-keysym a} a} + {<Button> %b {-keysym a} {{1 {bad option to <Button> event: "-keysym"}}}} + + {<Enter> %m {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, NotifyWhileGrabbed}}}} + {<Enter> %m {-mode NotifyNormal} NotifyNormal} + {<FocusIn> %m {-mode NotifyNormal} {{}}} + {<Key> %k {-mode NotifyNormal} {{1 {bad option to <Key> event: "-mode"}}}} + + {<Map> %o {-override xyz} {{1 {expected boolean value but got "xyz"}}}} + {<Map> %o {-override 1} 1} + {<Reparent> %o {-override 1} 1} + {<Configure> %o {-override 1} 1} + {<Key> %k {-override 1} {{1 {bad option to <Key> event: "-override"}}}} + + {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, PlaceOnBottom}}}} + {<Circulate> %p {-place PlaceOnTop} PlaceOnTop} + {<Key> %k {-place PlaceOnTop} {{1 {bad option to <Key> event: "-place"}}}} + + {<Key> %R {-root .xyz} {{1 {bad window path name ".xyz"}}}} + {<Key> %R {-root .b} {[winfo id .b]}} + {<Key> %R {-root xyz} {{1 {expected integer but got "xyz"}}}} + {<Key> %R {-root [winfo id .b]} {[winfo id .b]}} + {<Button> %R {-root .b} {[winfo id .b]}} + {<Motion> %R {-root .b} {[winfo id .b]}} + {<<Paste>> %R {-root .b} {[winfo id .b]}} + {<Enter> %R {-root .b} {[winfo id .b]}} + {<Configure> %R {-root .b} {{1 {bad option to <Configure> event: "-root"}}}} + + {<Key> %X {-rootx xyz} {{1 {bad screen distance "xyz"}}}} + {<Key> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} + {<Button> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} + {<Motion> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} + {<<Paste>> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} + {<Enter> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} + {<Configure> %X {-rootx 2i} {{1 {bad option to <Configure> event: "-rootx"}}}} + + {<Key> %Y {-rooty xyz} {{1 {bad screen distance "xyz"}}}} + {<Key> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} + {<Button> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} + {<Motion> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} + {<<Paste>> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} + {<Enter> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} + {<Configure> %Y {-rooty 2i} {{1 {bad option to <Configure> event: "-rooty"}}}} + + {<Key> %E {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}} + {<Key> %E {-sendevent 1} 1} + {<Key> %E {-sendevent yes} 1} + {<Key> %E {-sendevent 43} 43} + + {<Key> %# {-serial xyz} {{1 {expected integer but got "xyz"}}}} + {<Key> %# {-serial 100} 100} + + {<Key> %s {-state xyz} {{1 {expected integer but got "xyz"}}}} + {<Key> %s {-state 1} 1} + {<Button> %s {-state 1} 1} + {<Motion> %s {-state 1} 1} + {<<Paste>> %s {-state 1} 1} + {<Enter> %s {-state 1} 1} + {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, VisibilityFullyObscured}}}} + {<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured} + {<Configure> %s {-state xyz} {{1 {bad option to <Configure> event: "-state"}}}} + + {<Key> %S {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}} + {<Key> %S {-subwindow .b} {[winfo id .b]}} + {<Key> %S {-subwindow xyz} {{1 {expected integer but got "xyz"}}}} + {<Key> %S {-subwindow [winfo id .b]} {[winfo id .b]}} + {<Button> %S {-subwindow .b} {[winfo id .b]}} + {<Motion> %S {-subwindow .b} {[winfo id .b]}} + {<<Paste>> %S {-subwindow .b} {[winfo id .b]}} + {<Enter> %S {-subwindow .b} {[winfo id .b]}} + {<Configure> %S {-subwindow .b} {{1 {bad option to <Configure> event: "-subwindow"}}}} + + {<Key> %t {-time xyz} {{1 {expected integer but got "xyz"}}}} + {<Key> %t {-time 100} 100} + {<Button> %t {-time 100} 100} + {<Motion> %t {-time 100} 100} + {<<Paste>> %t {-time 100} 100} + {<Enter> %t {-time 100} 100} + {<Property> %t {-time 100} 100} + {<Configure> %t {-time 100} {{1 {bad option to <Configure> event: "-time"}}}} + + {<Expose> %w {-width xyz} {{1 {bad screen distance "xyz"}}}} + {<Expose> %w {-width 2i} {[winfo pixels .b.f 2i]}} + {<Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}} + {<Key> %k {-width 2i} {{1 {bad option to <Key> event: "-width"}}}} + + {<Unmap> %W {-window .xyz} {{1 {bad window path name ".xyz"}}}} + {<Unmap> %W {-window .b.f} .b.f} + {<Unmap> %W {-window xyz} {{1 {expected integer but got "xyz"}}}} + {<Unmap> %W {-window [winfo id .b.f]} .b.f} + {<Unmap> %W {-window .b.f} .b.f} + {<Map> %W {-window .b.f} .b.f} + {<Reparent> %W {-window .b.f} .b.f} + {<Configure> %W {-window .b.f} .b.f} + {<Gravity> %W {-window .b.f} .b.f} + {<Circulate> %W {-window .b.f} .b.f} + {<Key> %W {-window .b.f} {{1 {bad option to <Key> event: "-window"}}}} + + {<Key> %x {-x xyz} {{1 {bad screen distance "xyz"}}}} + {<Key> %x {-x 2i} {[winfo pixels .b.f 2i]}} + {<Button> %x {-x 2i} {[winfo pixels .b.f 2i]}} + {<Motion> %x {-x 2i} {[winfo pixels .b.f 2i]}} + {<<Paste>> %x {-x 2i} {[winfo pixels .b.f 2i]}} + {<Enter> %x {-x 2i} {[winfo pixels .b.f 2i]}} + {<Expose> %x {-x 2i} {[winfo pixels .b.f 2i]}} + {<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}} + {<Gravity> %x {-x 2i} {[winfo pixels .b.f 2i]}} + {<Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}} + {<Map> %x {-x 2i} {{1 {bad option to <Map> event: "-x"}}}} + + {<Key> %y {-y xyz} {{1 {bad screen distance "xyz"}}}} + {<Key> %y {-y 2i} {[winfo pixels .b.f 2i]}} + {<Button> %y {-y 2i} {[winfo pixels .b.f 2i]}} + {<Motion> %y {-y 2i} {[winfo pixels .b.f 2i]}} + {<<Paste>> %y {-y 2i} {[winfo pixels .b.f 2i]}} + {<Enter> %y {-y 2i} {[winfo pixels .b.f 2i]}} + {<Expose> %y {-y 2i} {[winfo pixels .b.f 2i]}} + {<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}} + {<Gravity> %y {-y 2i} {[winfo pixels .b.f 2i]}} + {<Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}} + {<Map> %y {-y 2i} {{1 {bad option to <Map> event: "-y"}}}} + + {<Key> %k {-xyz 1} {{1 {bad option to <Key> event: "-xyz"}}}} +} { + set event [lindex $check 0] + test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" { + setup + bind .b.f $event "lappend x [lindex $check 1]" + set x {} + if [catch {eval event gen .b.f $event [lindex $check 2]} msg] { + set x [list 1 $msg] + } + set x + } [eval set x [lindex $check 3]] + incr i +} +test bind-23.1 {GetVirtualEventUid procedure} { + list [catch {event info <<asd} msg] $msg +} {1 {virtual event "<<asd" is badly formed}} +test bind-23.2 {GetVirtualEventUid procedure} { + list [catch {event info <<>>} msg] $msg +} {1 {virtual event "<<>>" is badly formed}} +test bind-23.3 {GetVirtualEventUid procedure} { + list [catch {event info <<asd>} msg] $msg +} {1 {virtual event "<<asd>" is badly formed}} +test bind-23.4 {GetVirtualEventUid procedure} { + event info <<asd>> +} {} + + +test bind-24.1 {FindSequence procedure: no event} { + list [catch {bind .b {} test} msg] $msg +} {1 {no events specified in binding}} +test bind-24.2 {FindSequence procedure: bad event} { + list [catch {bind .b <xyz> test} msg] $msg +} {1 {bad event type or keysym "xyz"}} +test bind-24.3 {FindSequence procedure: virtual allowed} { + bind .b.f <<Paste>> test +} {} +test bind-24.4 {FindSequence procedure: virtual not allowed} { + list [catch {event add <<Paste>> <<Alive>>} msg] $msg +} {1 {virtual event not allowed in definition of another virtual event}} +test bind-24.5 {FindSequence procedure, multiple bindings} { + setup + bind .b.f <1> {lappend x single} + bind .b.f <Double-1> {lappend x double} + bind .b.f <Triple-1> {lappend x triple} + set x press + event gen .b.f <Button-1> + lappend x press + event gen .b.f <Button-1> + lappend x press + event gen .b.f <Button-1> + lappend x press + event gen .b.f <Button-1> + set x +} {press single press double press triple press triple} +test bind-24.6 {FindSequence procedure: virtual composed} { + list [catch {bind .b <Control-b><<Paste>> "puts hi"} msg] $msg +} {1 {virtual events may not be composed}} +test bind-24.7 {FindSequence procedure: new pattern sequence} { + setup + bind .b.f <Button-1><Button-2> {lappend x 1-2} + set x {} + event gen .b.f <Button-1> + event gen .b.f <Button-2> + set x +} {1-2} +test bind-24.8 {FindSequence procedure: similar pattern sequence} { + setup + bind .b.f <Button-1><Button-2> {lappend x 1-2} + bind .b.f <Button-2> {lappend x 2} + set x {} + event gen .b.f <Button-3> + event gen .b.f <Button-2> + event gen .b.f <Button-1> + event gen .b.f <Button-2> + set x +} {2 1-2} +test bind-24.9 {FindSequence procedure: similar pattern sequence} { + setup + bind .b.f <Button-1><Button-2> {lappend x 1-2} + bind .b.f <Button-2><Button-2> {lappend x 2-2} + set x {} + event gen .b.f <Button-3> + event gen .b.f <Button-2> + event gen .b.f <Button-2> + event gen .b.f <Button-1> + event gen .b.f <Button-2> + set x +} {2-2 1-2} +test bind-24.10 {FindSequence procedure: similar pattern sequence} { + setup + bind .b.f <Button-2><Button-2> {lappend x 2-2} + bind .b.f <Double-Button-2> {lappend x d-2} + set x {} + event gen .b.f <Button-3> + event gen .b.f <Button-2> + event gen .b.f <Button-2> + event gen .b.f <Button-1> + event gen .b.f <Button-2> -x 100 + event gen .b.f <Button-2> -x 200 + set x +} {d-2 2-2} +test bind-24.11 {FindSequence procedure: new sequence, don't create} { + setup + bind .b.f <Button-2> +} {} +test bind-24.12 {FindSequence procedure: not new sequence, don't create} { + setup + bind .b.f <Control-Button-2> "foo" + bind .b.f <Button-2> +} {} + + +test bind-25.1 {ParseEventDescription procedure} { + list [catch {bind .b \x7 test} msg] $msg +} {1 {bad ASCII character 0x7}} +test bind-25.2 {ParseEventDescription procedure} { + list [catch {bind .b "\x7f" test} msg] $msg +} {1 {bad ASCII character 0x7f}} +test bind-25.3 {ParseEventDescription procedure} { + list [catch {bind .b "\x4" test} msg] $msg +} {1 {bad ASCII character 0x4}} +test bind-25.4 {ParseEventDescription procedure} { + setup + bind .b.f a test + bind .b.f a +} {test} +test bind-25.5 {ParseEventDescription procedure: virtual} { + list [catch {bind .b <<>> foo} msg] $msg +} {1 {virtual event "<<>>" is badly formed}} +test bind-25.6 {ParseEventDescription procedure: virtual} { + list [catch {bind .b <<Paste foo} msg] $msg +} {1 {missing ">" in virtual binding}} +test bind-25.7 {ParseEventDescription procedure: virtual} { + list [catch {bind .b <<Paste> foo} msg] $msg +} {1 {missing ">" in virtual binding}} +test bind-25.8 {ParseEventDescription procedure: correctly terminate virtual} { + list [catch {bind .b <<Paste>>h foo} msg] $msg +} {1 {virtual events may not be composed}} +test bind-25.9 {ParseEventDescription procedure} { + list [catch {bind .b <> test} msg] $msg +} {1 {no event type or button # or keysym}} +test bind-25.10 {ParseEventDescription procedure: misinterpreted modifier} { + button .x + bind .x <Control-M> a + bind .x <M-M> b + set x [lsort [bind .x]] + destroy .x + set x +} {<Control-Key-M> <Meta-Key-M>} +test bind-25.11 {ParseEventDescription procedure} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + bind .b.f <a---> {nothing} + bind .b.f +} a +test bind-25.12 {ParseEventDescription procedure} { + list [catch {bind .b <a-- test} msg] $msg +} {1 {missing ">" in binding}} +test bind-25.13 {ParseEventDescription procedure} { + list [catch {bind .b <a-b> test} msg] $msg +} {1 {extra characters after detail in binding}} +test bind-25.14 {ParseEventDescription} { + setup + list [catch {bind .b <<abc {puts hi}} msg] $msg +} {1 {missing ">" in virtual binding}} +test bind-25.15 {ParseEventDescription} { + setup + list [catch {bind .b <<abc> {puts hi}} msg] $msg +} {1 {missing ">" in virtual binding}} +test bind-25.16 {ParseEventDescription} { + setup + bind .b <<Shift-Paste>> {puts hi} + bind .b +} {<<Shift-Paste>>} +test bind-25.17 {ParseEventDescription} { + setup + list [catch {event add <<xyz>> <<abc>>} msg] $msg +} {1 {virtual event not allowed in definition of another virtual event}} +set i 1 +foreach check { + {{<Control- a>} <Control-Key-a>} + {<Shift-a> <Shift-Key-a>} + {<Lock-a> <Lock-Key-a>} + {<Meta---a> <Meta-Key-a>} + {<M-a> <Meta-Key-a>} + {<Alt-a> <Alt-Key-a>} + {<B1-a> <B1-Key-a>} + {<B2-a> <B2-Key-a>} + {<B3-a> <B3-Key-a>} + {<B4-a> <B4-Key-a>} + {<B5-a> <B5-Key-a>} + {<Button1-a> <B1-Key-a>} + {<Button2-a> <B2-Key-a>} + {<Button3-a> <B3-Key-a>} + {<Button4-a> <B4-Key-a>} + {<Button5-a> <B5-Key-a>} + {<M1-a> <Mod1-Key-a>} + {<M2-a> <Mod2-Key-a>} + {<M3-a> <Mod3-Key-a>} + {<M4-a> <Mod4-Key-a>} + {<M5-a> <Mod5-Key-a>} + {<Mod1-a> <Mod1-Key-a>} + {<Mod2-a> <Mod2-Key-a>} + {<Mod3-a> <Mod3-Key-a>} + {<Mod4-a> <Mod4-Key-a>} + {<Mod5-a> <Mod5-Key-a>} + {<Double-a> <Double-Key-a>} + {<Triple-a> <Triple-Key-a>} + {{<Double 1>} <Double-Button-1>} + {<Triple-1> <Triple-Button-1>} + {{<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>} +} { + test bind-25.$i {modifier names} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + bind .b.f [lindex $check 0] foo + bind .b.f + } [lindex $check 1] + bind .b.f [lindex $check 1] {} + incr i +} + +foreach event [bind Test] { + bind Test $event {} +} +foreach event [bind all] { + bind all $event {} +} +test bind-26.1 {event names} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + bind .b.f <FocusIn> {nothing} + bind .b.f +} <FocusIn> +test bind-26.2 {event names} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + bind .b.f <FocusOut> {nothing} + bind .b.f +} <FocusOut> +test bind-26.3 {event names} { + setup + bind .b.f <Destroy> {lappend x "destroyed"} + set x [bind .b.f] + destroy .b.f + set x +} {<Destroy> destroyed} +set i 4 +foreach check { + {Motion Motion} + {Button Button} + {ButtonPress Button} + {ButtonRelease ButtonRelease} + {Colormap Colormap} + {Enter Enter} + {Leave Leave} + {Expose Expose} + {Key Key} + {KeyPress Key} + {KeyRelease KeyRelease} + {Property Property} + {Visibility Visibility} + {Activate Activate} + {Deactivate Deactivate} +} { + set event [lindex $check 0] + test bind-26.$i {event names} { + setup + bind .b.f <$event> "set x {event $event}" + set x xyzzy + event gen .b.f <$event> + list $x [bind .b.f] + } [list "event $event" <[lindex $check 1]>] + incr i +} +foreach check { + {Circulate Circulate} + {Configure Configure} + {Gravity Gravity} + {Map Map} + {Reparent Reparent} + {Unmap Unmap} +} { + set event [lindex $check 0] + test bind-26.$i {event names} { + setup + bind .b.f <$event> "set x {event $event}" + set x xyzzy + event gen .b.f <$event> -window .b.f + list $x [bind .b.f] + } [list "event $event" <[lindex $check 1]>] + incr i +} + + +test bind-27.1 {button names} { + list [catch {bind .b <Expose-1> foo} msg] $msg +} {1 {specified button "1" for non-button event}} +test bind-27.2 {button names} { + list [catch {bind .b <Button-6> foo} msg] $msg +} {1 {specified keysym "6" for non-key event}} +set i 3 +foreach button {1 2 3 4 5} { + test bind-27.$i {button names} { + setup + bind .b.f <Button-$button> "lappend x \"button $button\"" + set x [bind .b.f] + event gen .b.f <Button-$button> + set x + } [list <Button-$button> "button $button"] + incr i +} + +test bind-28.1 {keysym names} { + list [catch {bind .b <Expose-a> foo} msg] $msg +} {1 {specified keysym "a" for non-key event}} +test bind-28.2 {keysym names} { + list [catch {bind .b <Gorp> foo} msg] $msg +} {1 {bad event type or keysym "Gorp"}} +test bind-28.3 {keysym names} { + list [catch {bind .b <Key-Stupid> foo} msg] $msg +} {1 {bad event type or keysym "Stupid"}} +test bind-28.4 {keysym names} { + catch {destroy .b.f} + frame .b.f -class Test -width 150 -height 100 + bind .b.f <a> foo + bind .b.f +} a +set i 5 +foreach check { + {a 0 a} + {space 0 <Key-space>} + {Return 0 <Key-Return>} + {X 1 X} +} { + set keysym [lindex $check 0] + test bind-28.$i {keysym names} { + setup + bind .b.f <Key-$keysym> "lappend x \"keysym $keysym\"" + bind .b.f <Key-x> "lappend x {bad binding match}" + set x [lsort [bind .b.f]] + event gen .b.f <Key-$keysym> -state [lindex $check 1] + set x + } [concat [lsort "x [lindex $check 2]"] "{keysym $keysym}"] + incr i +} + +test bind-29.1 {dummy test to help ensure proper numbering} {} {} +setup +bind .b.f <KeyPress> {set x %K} +set i 2 +foreach check { + {a 0 a} + {x 1 X} + {x 2 X} + {space 0 space} + {F1 1 F1} +} { + test bind-29.$i {GetKeySym procedure} {nonPortable} { + set x nothing + event gen .b.f <KeyPress> -keysym [lindex $check 0] \ + -state [lindex $check 1] + set x + } [lindex $check 2] + incr i +} + + +proc bgerror msg { + global x errorInfo + set x [list $msg $errorInfo] +} +test bind-30.1 {Tk_BackgroundError procedure} { + setup + bind .b.f <Button> {error "This is a test"} + set x none + event gen .b.f <Button> + update + set x +} {{This is a test} {This is a test + while executing +"error "This is a test"" + (command bound to event)}} +test bind-30.2 {Tk_BackgroundError procedure} { + proc do {} { + event gen .b.f <Button> + } + setup + bind .b.f <Button> {error Message2} + set x none + do + update + set x +} {Message2 {Message2 + while executing +"error Message2" + (command bound to event)}} +rename bgerror {} + + +destroy .b |