# 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. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands tk useinputmethods 0 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 ?taglist?"}} test bind-2.2 {bindtags command} { list [catch {bindtags a b c} msg] $msg } {1 {wrong # args: should be "bindtags window ?taglist?"}} 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} testcbind { catch {interp delete foo} interp create foo foo eval { load {} Tk tk useinputmethods 0 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: bad binding} { 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} testcbind { 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} testcbind { list [catch {testcbind . <xyz> "xyz"} msg] $msg } {1 {bad event type or keysym "xyz"}} test bind-8.2 {TkCreateBindingProcedure: new binding} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { 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} testcbind { setup bind .b.f <1> x testcbind .b.f <2> y destroy .b.f } {} test bind-14.2 {TkBindDeadWindow: is called after <Destroy>} testcbind { 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} testcbind { 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 <ButtonRelease-2> event gen .b.f <Button-1> -x 30 -y 40 event gen .b.f <Button-1> -x 31 -y 39 event gen .b.f <ButtonRelease-1> 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 <ButtonRelease-2> event gen .b.f <Button-1> -x 30 -y 40 event gen .b.f <Button-1> -x 29 -y 41 event gen .b.f <ButtonRelease-1> 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 <ButtonRelease-2> event gen .b.f <Button-1> -x 30 -y 40 event gen .b.f <Button-1> -x 40 -y 40 event gen .b.f <ButtonRelease-2> 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 <ButtonRelease-2> event gen .b.f <Button-1> -x 30 -y 40 event gen .b.f <Button-1> -x 20 -y 40 event gen .b.f <ButtonRelease-1> 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 <ButtonRelease-2> event gen .b.f <Button-1> -x 30 -y 40 event gen .b.f <Button-1> -x 30 -y 30 event gen .b.f <ButtonRelease-1> 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 <ButtonRelease-2> event gen .b.f <Button-1> -x 30 -y 40 event gen .b.f <Button-1> -x 30 -y 50 event gen .b.f <ButtonRelease-1> 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 <ButtonRelease-2> event gen .b.f <Button-1> -time 300 event gen .b.f <Button-1> -time 700 event gen .b.f <ButtonRelease-1> 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 <ButtonRelease-2> event gen .b.f <Button-1> -time 300 event gen .b.f <Button-1> -time 900 event gen .b.f <ButtonRelease-1> 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 event gen .b.f <ButtonRelease-1> 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 event gen .b.f <ButtonRelease-1> 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> event gen .b.f <ButtonRelease-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> event gen .b.f <ButtonRelease-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 event gen .b.f <ButtonRelease-1> 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 event gen .b.f <ButtonRelease-1> 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> event gen .b.f <ButtonRelease-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> event gen .b.f <ButtonRelease-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> event gen .b.f <ButtonRelease-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 1402 event gen .b.f <ButtonRelease-1> set x } 1402 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 event gen .b.f <ButtonRelease> 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 event gen .b.f <ButtonRelease> 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 event gen .b.f <Key-Multi_key> event gen .b.f <Key-e> event gen .b.f <Key-apostrophe> set x } "a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9" 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 event gen .b.f <ButtonRelease> set x } {422 13} test bind-16.44 {ExpandPercents procedure} { setup bind .b.f <Gravity> {set x "%R %S"} set x none event gen .b.f <Gravity> set x } {?? ??} test bind-17.1 {event command} { list [catch {event} msg] $msg } {1 {wrong # args: should be "event option ?arg?"}} test bind-17.2 {event command} { list [catch {event xyz} msg] $msg } {1 {bad option "xyz": must be add, delete, generate, or 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": must be add, delete, generate, or 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 gen .b.f <ButtonRelease-2> event delete <<xyz>> event gen .b.f <Button-2> -serial 102 event gen .b.f <ButtonRelease-2> 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 <ButtonRelease-2> event gen .b.f <Control-Button-2> event gen .b.f <Control-ButtonRelease-2> event delete <<xyz>> event gen .b.f <Button-2> event gen .b.f <ButtonRelease-2> event gen .b.f <Control-Button-2> event gen .b.f <Control-ButtonRelease-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 <ButtonRelease-2> event gen .b.f <Control-Button-2> event gen .b.f <Control-ButtonRelease-2> event gen .b.f <Shift-Button-2> event gen .b.f <Shift-ButtonRelease-2> event delete <<xyz>> event gen .b.f <Button-2> event gen .b.f <Control-Button-2> event gen .b.f <Shift-Button-2> event gen .b.f <ButtonRelease-2> event gen .b.f <Control-ButtonRelease-2> event gen .b.f <Shift-ButtonRelease-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 <ButtonRelease-2> event gen .b.f <Control-Button-2> event gen .b.f <Control-ButtonRelease-2> event gen .b.f <Shift-Button-2> event gen .b.f <Shift-ButtonRelease-2> event delete <<xyz>> event gen .b.f <Button-2> event gen .b.f <ButtonRelease-2> event gen .b.f <Control-Button-2> event gen .b.f <Control-ButtonRelease-2> event gen .b.f <Shift-Button-2> event gen .b.f <Shift-ButtonRelease-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.f <ButtonRelease-2> event gen .b.g <Button-2> event gen .b.g <ButtonRelease-2> event gen .b.h <Button-2> event gen .b.h <ButtonRelease-2> event delete <<xyz>> event gen .b.f <Button-2> event gen .b.f <ButtonRelease-2> event gen .b.g <Button-2> event gen .b.g <ButtonRelease-2> event gen .b.h <Button-2> event gen .b.h <ButtonRelease-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.f <ButtonRelease-2> event gen .b.g <Button-2> event gen .b.g <ButtonRelease-2> event gen .b.h <Button-2> event gen .b.h <ButtonRelease-2> event delete <<abc>> event gen .b.f <Button-2> event gen .b.f <ButtonRelease-2> event gen .b.g <Button-2> event gen .b.g <ButtonRelease-2> event gen .b.h <Button-2> event gen .b.h <ButtonRelease-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.f <ButtonRelease-2> event gen .b.g <Button-2> event gen .b.g <ButtonRelease-2> event gen .b.h <Button-2> event gen .b.h <ButtonRelease-2> event delete <<def>> event gen .b.f <Button-2> event gen .b.f <ButtonRelease-2> event gen .b.g <Button-2> event gen .b.g <ButtonRelease-2> event gen .b.h <Button-2> event gen .b.h <ButtonRelease-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 {bad window name/identifier "47"}} 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> -state 260 set x } {260 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 <ButtonRelease-1> event gen .b.f <ButtonRelease-2> event gen .b.f <ButtonRelease-3> event gen .b.f <Control-Button-1> event gen .b.f <Control-ButtonRelease-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-space> set x } {4 space} 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 event gen .b.f <ButtonRelease> -when now 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 event gen .b.f <ButtonRelease> -when tail 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 event gen .b.f <ButtonRelease> -when tail 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 event gen .b.f <ButtonRelease> -when tail 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 -when value "xyz": must be now, head, mark, or tail}} test bind-22.18 {HandleEventGenerate} { # Bug 411307 list [catch {event gen . <a> -root 98765} msg] $msg } {1 {bad window name/identifier "98765"}} foreach check { {bind-22.19 <Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}} {bind-22.20 <Configure> %a {-above .b} {[winfo id .b]}} {bind-22.21 <Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}} {bind-22.22 <Configure> %a {-above [winfo id .b]} {[winfo id .b]}} {bind-22.23 <Key> %b {-above .} {{1 {<Key> event doesn't accept "-above" option}}}} {bind-22.24 <Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}} {bind-22.25 <Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}} {bind-22.26 <Key> %k {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}} {bind-22.27 <Button> %b {-button xyz} {{1 {expected integer but got "xyz"}}}} {bind-22.28 <Button> %b {-button 1} 1} {bind-22.29 <ButtonRelease> %b {-button 1} 1} {bind-22.30 <Key> %k {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}} {bind-22.31 <Expose> %c {-count xyz} {{1 {expected integer but got "xyz"}}}} {bind-22.32 <Expose> %c {-count 20} 20} {bind-22.33 <Key> %b {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}} {bind-22.34 <Enter> %d {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}} {bind-22.35 <FocusIn> %d {-detail NotifyVirtual} {{}}} {bind-22.36 <Enter> %d {-detail NotifyVirtual} NotifyVirtual} {bind-22.37 <Key> %k {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}} {bind-22.38 <Enter> %f {-focus xyz} {{1 {expected boolean value but got "xyz"}}}} {bind-22.39 <Enter> %f {-focus 1} 1} {bind-22.40 <Key> %k {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}} {bind-22.41 <Expose> %h {-height xyz} {{1 {bad screen distance "xyz"}}}} {bind-22.42 <Expose> %h {-height 2i} {[winfo pixels .b.f 2i]}} {bind-22.43 <Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}} {bind-22.44 <Key> %k {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}} {bind-22.45 <Key> %k {-keycode xyz} {{1 {expected integer but got "xyz"}}}} {bind-22.46 <Key> %k {-keycode 20} 20} {bind-22.47 <Button> %b {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}} {bind-22.48 <Key> %K {-keysym xyz} {{1 {unknown keysym "xyz"}}}} {bind-22.49 <Key> %K {-keysym a} a} {bind-22.50 <Button> %b {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}} {bind-22.51 <Enter> %m {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}} {bind-22.52 <Enter> %m {-mode NotifyNormal} NotifyNormal} {bind-22.53 <FocusIn> %m {-mode NotifyNormal} {{}}} {bind-22.54 <Key> %k {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}} {bind-22.55 <Map> %o {-override xyz} {{1 {expected boolean value but got "xyz"}}}} {bind-22.56 <Map> %o {-override 1} 1} {bind-22.57 <Reparent> %o {-override 1} 1} {bind-22.58 <Configure> %o {-override 1} 1} {bind-22.59 <Key> %k {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}} {bind-22.60 <Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}} {bind-22.61 <Circulate> %p {-place PlaceOnTop} PlaceOnTop} {bind-22.62 <Key> %k {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}} {bind-22.63 <Key> %R {-root .xyz} {{1 {bad window path name ".xyz"}}}} {bind-22.64 <Key> %R {-root .b} {[winfo id .b]}} {bind-22.65 <Key> %R {-root xyz} {{1 {bad window name/identifier "xyz"}}}} {bind-22.66 <Key> %R {-root [winfo id .b]} {[winfo id .b]}} {bind-22.67 <Button> %R {-root .b} {[winfo id .b]}} {bind-22.68 <ButtonRelease> %R {-root .b} {[winfo id .b]}} {bind-22.69 <Motion> %R {-root .b} {[winfo id .b]}} {bind-22.70 <<Paste>> %R {-root .b} {[winfo id .b]}} {bind-22.71 <Enter> %R {-root .b} {[winfo id .b]}} {bind-22.72 <Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}} {bind-22.73 <Key> %X {-rootx xyz} {{1 {bad screen distance "xyz"}}}} {bind-22.74 <Key> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} {bind-22.75 <Button> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} {bind-22.76 <ButtonRelease> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} {bind-22.77 <Motion> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} {bind-22.78 <<Paste>> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} {bind-22.79 <Enter> %X {-rootx 2i} {[winfo pixels .b.f 2i]}} {bind-22.80 <Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}} {bind-22.81 <Key> %Y {-rooty xyz} {{1 {bad screen distance "xyz"}}}} {bind-22.82 <Key> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} {bind-22.83 <Button> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} {bind-22.84 <ButtonRelease> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} {bind-22.85 <Motion> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} {bind-22.86 <<Paste>> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} {bind-22.87 <Enter> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}} {bind-22.88 <Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}} {bind-22.89 <Key> %E {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}} {bind-22.90 <Key> %E {-sendevent 1} 1} {bind-22.91 <Key> %E {-sendevent yes} 1} {bind-22.92 <Key> %E {-sendevent 43} 43} {bind-22.93 <Key> %# {-serial xyz} {{1 {expected integer but got "xyz"}}}} {bind-22.94 <Key> %# {-serial 100} 100} {bind-22.95 <Key> %s {-state xyz} {{1 {expected integer but got "xyz"}}}} {bind-22.96 <Key> %s {-state 1} 1} {bind-22.97 <Button> %s {-state 1025} 1025} {bind-22.98 <ButtonRelease> %s {-state 1025} 1025} {bind-22.99 <Motion> %s {-state 1} 1} {bind-22.100 <<Paste>> %s {-state 1} 1} {bind-22.101 <Enter> %s {-state 1} 1} {bind-22.102 <Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}} {bind-22.103 <Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured} {bind-22.104 <Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}} {bind-22.105 <Key> %S {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}} {bind-22.106 <Key> %S {-subwindow .b} {[winfo id .b]}} {bind-22.107 <Key> %S {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}} {bind-22.108 <Key> %S {-subwindow [winfo id .b]} {[winfo id .b]}} {bind-22.109 <Button> %S {-subwindow .b} {[winfo id .b]}} {bind-22.110 <ButtonRelease> %S {-subwindow .b} {[winfo id .b]}} {bind-22.111 <Motion> %S {-subwindow .b} {[winfo id .b]}} {bind-22.112 <<Paste>> %S {-subwindow .b} {[winfo id .b]}} {bind-22.113 <Enter> %S {-subwindow .b} {[winfo id .b]}} {bind-22.114 <Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}} {bind-22.115 <Key> %t {-time xyz} {{1 {expected integer but got "xyz"}}}} {bind-22.116 <Key> %t {-time 100} 100} {bind-22.117 <Button> %t {-time 100} 100} {bind-22.118 <ButtonRelease> %t {-time 100} 100} {bind-22.119 <Motion> %t {-time 100} 100} {bind-22.120 <<Paste>> %t {-time 100} 100} {bind-22.121 <Enter> %t {-time 100} 100} {bind-22.122 <Property> %t {-time 100} 100} {bind-22.123 <Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}} {bind-22.124 <Expose> %w {-width xyz} {{1 {bad screen distance "xyz"}}}} {bind-22.125 <Expose> %w {-width 2i} {[winfo pixels .b.f 2i]}} {bind-22.126 <Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}} {bind-22.127 <Key> %k {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}} {bind-22.128 <Unmap> %W {-window .xyz} {{1 {bad window path name ".xyz"}}}} {bind-22.129 <Unmap> %W {-window .b.f} .b.f} {bind-22.130 <Unmap> %W {-window xyz} {{1 {bad window name/identifier "xyz"}}}} {bind-22.131 <Unmap> %W {-window [winfo id .b.f]} .b.f} {bind-22.132 <Unmap> %W {-window .b.f} .b.f} {bind-22.133 <Map> %W {-window .b.f} .b.f} {bind-22.134 <Reparent> %W {-window .b.f} .b.f} {bind-22.135 <Configure> %W {-window .b.f} .b.f} {bind-22.136 <Gravity> %W {-window .b.f} .b.f} {bind-22.137 <Circulate> %W {-window .b.f} .b.f} {bind-22.138 <Key> %W {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}} {bind-22.139 <Key> %x {-x xyz} {{1 {bad screen distance "xyz"}}}} {bind-22.140 <Key> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.141 <Button> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.142 <ButtonRelease> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.143 <Motion> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.144 <<Paste>> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.145 <Enter> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.146 <Expose> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.147 <Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.148 <Gravity> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.149 <Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}} {bind-22.150 <Map> %x {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}} {bind-22.151 <Key> %y {-y xyz} {{1 {bad screen distance "xyz"}}}} {bind-22.152 <Key> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.153 <Button> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.154 <ButtonRelease> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.155 <Motion> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.156 <<Paste>> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.157 <Enter> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.158 <Expose> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.159 <Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.160 <Gravity> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.161 <Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}} {bind-22.162 <Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}} {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}}}} } { lassign $check name event substitution generator result test $name "HandleEventGenerate: options $event $generator" { setup bind .b.f $event "lappend x $substitution" set x {} if [catch {eval event gen .b.f $event $generator} msg] { set x [list 1 $msg] } set x } [eval set x $result] } # Note that the -data option is tested in bind-32.* because it has # more demanding requirements in memory handling 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} bind .b.f <Quadruple-1> {lappend x quadruple} set x press event gen .b.f <Button-1> event gen .b.f <ButtonRelease-1> lappend x press event gen .b.f <Button-1> event gen .b.f <ButtonRelease-1> lappend x press event gen .b.f <Button-1> event gen .b.f <ButtonRelease-1> lappend x press event gen .b.f <Button-1> event gen .b.f <ButtonRelease-1> lappend x press event gen .b.f <Button-1> event gen .b.f <ButtonRelease-1> set x } {press single press double press triple press quadruple press quadruple} 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 <ButtonRelease-1> event gen .b.f <Button-2> event gen .b.f <ButtonRelease-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 <ButtonRelease-2> 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 } {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 <ButtonRelease-2> event gen .b.f <Button-2> event gen .b.f <ButtonRelease-2> 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 } {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 <ButtonRelease-2> event gen .b.f <Button-2> event gen .b.f <ButtonRelease-2> event gen .b.f <Button-1> event gen .b.f <ButtonRelease-1> event gen .b.f <Button-2> -x 100 event gen .b.f <ButtonRelease-2> event gen .b.f <Button-2> -x 200 event gen .b.f <ButtonRelease-2> 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-24.13 {FindSequence procedure: no binding} { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 list [catch {bind .b.f <a>} msg] $msg } {0 {}} test bind-24.14 {FindSequence procedure: no binding} { catch {destroy .b.f} canvas .b.f set i [.b.f create rect 10 10 100 100] list [catch {.b.f bind $i <a>} msg] $msg } {0 {}} test bind-25.1 {ParseEventDescription procedure} -setup { setup } -body { bind .b.f a test bind .b.f a } -result test test bind-25.2 {ParseEventDescription procedure: misinterpreted modifier} -setup { button .x } -body { bind .x <Control-M> a bind .x <M-M> b lsort [bind .x] } -cleanup { destroy .x } -result {<Control-Key-M> <Meta-Key-M>} test bind-25.3 {ParseEventDescription procedure} -setup { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 } -body { bind .b.f <a---> {nothing} bind .b.f } -result a test bind-25.4 {ParseEventDescription} -setup { setup } -body { bind .b <<Shift-Paste>> {puts hi} bind .b } -result {<<Shift-Paste>>} # Assorted error cases in event sequence parsing foreach {testname testinfo} { bind-25.5 {\x7 {bad ASCII character 0x7}} bind-25.6 {\x7f {bad ASCII character 0x7f}} bind-25.7 {\x4 {bad ASCII character 0x4}} bind-25.8 {<<>> {virtual event "<<>>" is badly formed}} bind-25.9 {<<Paste {missing ">" in virtual binding}} bind-25.10 {<<Paste> {missing ">" in virtual binding}} bind-25.11 {<<Paste>>h {virtual events may not be composed}} bind-25.12 {<> "no event type or button # or keysym"} bind-25.13 {<a-- {missing ">" in binding}} bind-25.14 {<a-b> {extra characters after detail in binding}} bind-25.15 {<<abc {missing ">" in virtual binding}} bind-25.16 {<<abc> {missing ">" in virtual binding}} } { lassign $testinfo sequence errorMessage test $testname {ParseEventDescription procedure error cases} \ -setup { setup } \ -body [list bind .b $sequence {puts hi}] \ -returnCodes error -result $errorMessage } test bind-25.17 {ParseEventDescription} -setup { setup } -returnCodes error -body { event add <<xyz>> <<abc>> } -result {virtual event not allowed in definition of another virtual event} # Modifier canonicalization tests foreach {name check} { bind-25.18 {{<Control- a>} <Control-Key-a>} bind-25.19 {<Shift-a> <Shift-Key-a>} bind-25.20 {<Lock-a> <Lock-Key-a>} bind-25.21 {<Meta---a> <Meta-Key-a>} bind-25.22 {<M-a> <Meta-Key-a>} bind-25.23 {<Alt-a> <Alt-Key-a>} bind-25.24 {<B1-a> <B1-Key-a>} bind-25.25 {<B2-a> <B2-Key-a>} bind-25.26 {<B3-a> <B3-Key-a>} bind-25.27 {<B4-a> <B4-Key-a>} bind-25.28 {<B5-a> <B5-Key-a>} bind-25.29 {<Button1-a> <B1-Key-a>} bind-25.30 {<Button2-a> <B2-Key-a>} bind-25.31 {<Button3-a> <B3-Key-a>} bind-25.32 {<Button4-a> <B4-Key-a>} bind-25.33 {<Button5-a> <B5-Key-a>} bind-25.34 {<M1-a> <Mod1-Key-a>} bind-25.35 {<M2-a> <Mod2-Key-a>} bind-25.36 {<M3-a> <Mod3-Key-a>} bind-25.37 {<M4-a> <Mod4-Key-a>} bind-25.38 {<M5-a> <Mod5-Key-a>} bind-25.39 {<Mod1-a> <Mod1-Key-a>} bind-25.40 {<Mod2-a> <Mod2-Key-a>} bind-25.41 {<Mod3-a> <Mod3-Key-a>} bind-25.42 {<Mod4-a> <Mod4-Key-a>} bind-25.43 {<Mod5-a> <Mod5-Key-a>} bind-25.44 {<Double-a> <Double-Key-a>} bind-25.45 {<Triple-a> <Triple-Key-a>} bind-25.46 {{<Double 1>} <Double-Button-1>} bind-25.47 {<Triple-1> <Triple-Button-1>} bind-25.48 {{<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>} bind-25.49 {<Extended-Return> <Extended-Key-Return>} } { lassign $check shortBind longBind test $name {modifier names} -setup { catch {destroy .b.f} frame .b.f -class Test -width 150 -height 100 } -body { bind .b.f $shortBind foo bind .b.f } -result $longBind -cleanup { bind .b.f [lindex $check 1] {} } } 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} foreach check { {bind-26.4 Motion Motion} {bind-26.5 Button Button} {bind-26.6 ButtonPress Button} {bind-26.7 ButtonRelease ButtonRelease} {bind-26.8 Colormap Colormap} {bind-26.9 Enter Enter} {bind-26.10 Leave Leave} {bind-26.11 Expose Expose} {bind-26.12 Key Key} {bind-26.13 KeyPress Key} {bind-26.14 KeyRelease KeyRelease} {bind-26.15 Property Property} {bind-26.16 Visibility Visibility} {bind-26.17 Activate Activate} {bind-26.18 Deactivate Deactivate} } { lassign $check name event canonicalEvent test $name "event names: $event" { 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" <$canonicalEvent>] } # These events require an extra argument to [event generate] foreach check { {bind-26.19 Circulate Circulate} {bind-26.20 Configure Configure} {bind-26.21 Gravity Gravity} {bind-26.22 Map Map} {bind-26.23 Reparent Reparent} {bind-26.24 Unmap Unmap} } { lassign $check name event canonicalEvent test $name "event names: $event" { 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" <$canonicalEvent>] } 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}} test bind-27.3 {button names} { setup bind .b.f <Button-1> {lappend x "button 1"} set x [bind .b.f] event gen .b.f <Button-1> event gen .b.f <ButtonRelease-1> set x } {<Button-1> {button 1}} test bind-27.4 {button names} { setup bind .b.f <Button-2> {lappend x "button 2"} set x [bind .b.f] event gen .b.f <Button-2> event gen .b.f <ButtonRelease-2> set x } {<Button-2> {button 2}} test bind-27.5 {button names} { setup bind .b.f <Button-3> {lappend x "button 3"} set x [bind .b.f] event gen .b.f <Button-3> event gen .b.f <ButtonRelease-3> set x } {<Button-3> {button 3}} test bind-27.6 {button names} { setup bind .b.f <Button-4> {lappend x "button 4"} set x [bind .b.f] event gen .b.f <Button-4> event gen .b.f <ButtonRelease-4> set x } {<Button-4> {button 4}} test bind-27.7 {button names} { setup bind .b.f <Button-5> {lappend x "button 5"} set x [bind .b.f] event gen .b.f <Button-5> event gen .b.f <ButtonRelease-5> set x } {<Button-5> {button 5}} 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 foreach check { {bind-28.5 a 0 a} {bind-28.6 space 0 <Key-space>} {bind-28.7 Return 0 <Key-Return>} {bind-28.8 X 1 X} } { lassign $check name keysym state result test $name {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 $state set x } [concat [lsort "x $result"] "{keysym $keysym}"] } test bind-29.1 {dummy test to help ensure proper numbering} {} {} setup bind .b.f <KeyPress> {set x %K} foreach check { {bind-29.2 a 0 a} {bind-29.3 x 1 X} {bind-29.4 x 2 X} {bind-29.5 space 0 space} {bind-29.6 F1 1 F1} } { lassign $check name keysym state result test $name {GetKeySym procedure} nonPortable { set x nothing event gen .b.f <KeyPress> -keysym $keysym -state $state set x } $result } 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> event gen .b.f <ButtonRelease> 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> event gen .b.f <ButtonRelease> } 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 {} test bind-31.1 {MouseWheel events} { setup set x {} bind .b.f <MouseWheel> {set x Wheel} event gen .b.f <MouseWheel> set x } {Wheel} test bind-31.2 {MouseWheel events} { setup set x {} bind .b.f <MouseWheel> {set x %D} event gen .b.f <MouseWheel> -delta 120 set x } {120} test bind-31.3 {MouseWheel events} { setup set x {} bind .b.f <MouseWheel> {set x "%D %x %y"} event gen .b.f <MouseWheel> -delta 240 -x 10 -y 30 set x } {240 10 30} test bind-32.1 {virtual event user_data field - bad generation} { setup # Check no confusion, since Focus events use %d for something else list [catch {event gen .b.f <FocusIn> -data foo} msg] $msg } {1 {<FocusIn> event doesn't accept "-data" option}} test bind-32.2 {virtual event user_data field - NULL, synch} { setup set x {} bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} event gen .b.f <<TestUserData>> set x } {TestUserData >{}<} test bind-32.3 {virtual event user_data field - shared, synch} { setup set x {} bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} event gen .b.f <<TestUserData>> -data "foo bar" set x } {TestUserData >foo bar<} test bind-32.4 {virtual event user_data field - unshared, synch} { setup set x {} bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} event gen .b.f <<TestUserData>> -data [string index abc 1] set x } {TestUserData >b<} # Note that asynch event handling can only really catch any potential # extra errors when used in combination with a tool like Purify or # Valgrind. Such testing is rarely done, but at least any problem with # reference handling will eventually show up with these tests... test bind-32.5 {virtual event user_data field - NULL, asynch} { setup set x {} bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} event gen .b.f <<TestUserData>> -when head list $x [update] $x } {{} {} {TestUserData >{}<}} test bind-32.6 {virtual event user_data field - shared, asynch} { setup set x {} bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} event gen .b.f <<TestUserData>> -data "foo bar" -when head list $x [update] $x } {{} {} {TestUserData >foo bar<}} test bind-32.7 {virtual event user_data field - unshared, asynch} { setup set x {} bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} event gen .b.f <<TestUserData>> -data [string index abc 1] -when head list $x [update] $x } {{} {} {TestUserData >b<}} destroy .b # cleanup cleanupTests return # Local Variables: # mode: tcl # End: