diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/bind.test | 8252 |
1 files changed, 5959 insertions, 2293 deletions
diff --git a/tests/bind.test b/tests/bind.test index 77b8373..9f0f941 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -7,2743 +7,6401 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: bind.test,v 1.20 2008/07/23 23:24:26 nijtmans Exp $ +# RCS: @(#) $Id: bind.test,v 1.21 2008/07/25 13:40:15 aniap Exp $ 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 +toplevel .t -width 100 -height 50 +wm geom .t +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 +foreach p [event info] {event delete $p} +foreach event [bind Test] { + bind Test $event {} } -setup - -foreach i [bind Test] { - bind Test $i {} +foreach event [bind all] { + bind all $event {} } -foreach i [bind all] { - bind all $i {} + + +proc unsetBindings {} { + bind all <Enter> {} + bind Test <Enter> {} + bind Toplevel <Enter> {} + bind xyz <Enter> {} + bind {a b} <Enter> {} + bind .t <Enter> {} } -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 + +test bind-1.1 {bind command} -body { + bind +} -returnCodes error -result {wrong # args: should be "bind window ?pattern? ?command?"} +test bind-1.2 {bind command} -body { + bind a b c d +} -returnCodes error -result {wrong # args: should be "bind window ?pattern? ?command?"} +test bind-1.3 {bind command} -body { + bind .gorp +} -returnCodes error -result {bad window path name ".gorp"} +test bind-1.4 {bind command} -body { + bind foo +} -returnCodes ok -result {} +test bind-1.5 {bind command} -body { + bind .t <gorp-> {} +} -returnCodes ok -result {} +test bind-1.6 {bind command} -body { + frame .t.f + bind .t.f <Enter> {test script} + set result [bind .t.f <Enter>] + bind .t.f <Enter> {} + list $result [bind .t.f <Enter>] +} -cleanup { + destroy .t.f +} -result {{test script} {}} +test bind-1.7 {bind command} -body { + frame .t.f + bind .t.f <Enter> {test script} + bind .t.f <Enter> {+more text} + bind .t.f <Enter> +} -cleanup { + destroy .t.f +} -result {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} { +test bind-1.8 {bind command} -body { + bind .t <gorp-> {test script} +} -returnCodes error -result {bad event type or keysym "gorp"} +test bind-1.9 {bind command} -body { + catch {bind .t <gorp-> {test script}} + bind .t +} -result {} +test bind-1.10 {bind command} -body { + bind .t <gorp-> +} -returnCodes ok -result {} +test bind-1.11 {bind command} -body { + frame .t.f + bind .t.f <Enter> {script 1} + bind .t.f <Leave> {script 2} + bind .t.f a {script for a} + bind .t.f b {script for b} + lsort [bind .t.f] +} -cleanup { + destroy .t.f +} -result {<Enter> <Leave> a b} + +test bind-2.1 {bindtags command} -body { + bindtags +} -returnCodes error -result {wrong # args: should be "bindtags window ?taglist?"} +test bind-2.2 {bindtags command} -body { + bindtags a b c +} -returnCodes error -result {wrong # args: should be "bindtags window ?taglist?"} +test bind-2.3 {bindtags command} -body { + bindtags .foo +} -returnCodes error -result {bad window path name ".foo"} +test bind-2.4 {bindtags command} -body { + bindtags .t +} -result {.t Toplevel all} +test bind-2.5 {bindtags command} -body { + frame .t.f + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {.t.f Frame .t all} +test bind-2.6 {bindtags command} -body { + frame .t.f + bindtags .t.f {{x y z} b c d} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {{x y z} b c d} +test bind-2.7 {bindtags command} -body { + frame .t.f + bindtags .t.f {x y z} + bindtags .t.f {} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {.t.f Frame .t all} +test bind-2.8 {bindtags command} -body { + frame .t.f + bindtags .t.f {x y z} + bindtags .t.f {a b c d} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {a b c d} +test bind-2.9 {bindtags command} -body { + frame .t.f + bindtags .t.f {a b c} + bindtags .t.f "\{" +} -cleanup { + destroy .t.f +} -returnCodes error -result {unmatched open brace in list} +test bind-2.10 {bindtags command} -body { + frame .t.f + bindtags .t.f {a b c} + catch {bindtags .t.f "\{"} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {.t.f Frame .t all} +test bind-2.11 {bindtags command} -body { + frame .t.f + bindtags .t.f {a b c} + bindtags .t.f "a .gorp b" +} -cleanup { + destroy .t.f +} -returnCodes ok +test bind-2.12 {bindtags command} -body { + frame .t.f + bindtags .t.f {a b c} + catch {bindtags .t.f "a .gorp b"} + bindtags .t.f +} -cleanup { + destroy .t.f +} -result {a .gorp b} + + +test bind-3.1 {TkFreeBindingTags procedure} -body { + frame .t.f + bindtags .t.f "a b c d" + destroy .t.f +} -cleanup { + destroy .t.f +} -result {} +test bind-3.2 {TkFreeBindingTags procedure} -body { + frame .t.f + catch {bindtags .t.f "a .gorp b .t.f"} + destroy .t.f +} -cleanup { + destroy .t.f +} -result {} + + +test bind-4.1 {TkBindEventProc procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + update + set x {} +} -body { + 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 .t <Enter> {lappend x "%W enter .t"} + bind .t.f <Enter> {lappend x "%W enter .t.f"} + + event gen .t.f <Enter> + return $x +} -cleanup { + destroy .t.f + unsetBindings +} -result {{.t.f enter .t.f} {.t.f enter frame} {.t.f enter .t} {.t.f enter all}} +test bind-4.2 {TkBindEventProc procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + update + set x {} +} -body { + 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 .t <Enter> {lappend x "%W enter .t"} + bind .t.f <Enter> {lappend x "%W enter .t.f"} + + bindtags .t.f {.t.f {a b} xyz} + event gen .t.f <Enter> + return $x +} -cleanup { + destroy .t.f + unsetBindings +} -result {{.t.f enter .t.f} {.t.f enter {a b}} {.t.f enter xyz}} +test bind-4.3 {TkBindEventProc procedure} -body { + set x {} + 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 .t <Enter> {lappend x "%W enter .t"} + + event gen .t <Enter> + return $x +} -cleanup { + unsetBindings +} -result {{.t enter .t} {.t enter toplevel} {.t enter all}} +test bind-4.4 {TkBindEventProc procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + frame .t.f3 -width 50 -height 50 + pack .t.f3 + update + set x {} +} -body { + 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 .t <Enter> {lappend x "%W enter .t"} + + bindtags .t.f {.t.f .t.f2 .t.f3} + bind .t.f <Enter> {lappend x "%W enter .t.f"} + bind .t.f3 <Enter> {lappend x "%W enter .t.f3"} + event gen .t.f <Enter> + return $x +} -cleanup { + destroy .t.f .t.f3 + unsetBindings +} -result {{.t.f enter .t.f} {.t.f enter .t.f3}} +test bind-4.5 {TkBindEventProc procedure} -setup { # 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 { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + update +} -body { + 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 .t <Enter> {lappend x "%W enter .t"} + bindtags .t.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 .t.f <Enter> +} -cleanup { + destroy .t.f + unsetBindings +} -result {} + + +test bind-5.1 {Tk_CreateBindingTable procedure} -body { + canvas .t.c + .t.c bind foo +} -cleanup { + destroy .t.c +} -result {} + + +test bind-6.1 {Tk_DeleteBindTable procedure} -body { + canvas .t.c + .t.c bind foo <1> {string 1} + .t.c create rectangle 0 0 100 100 + .t.c bind 1 <2> {string 2} + destroy .t.c +} -cleanup { + destroy .t.c +} -result {} +test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} -constraints { + testcbind +} -body { 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> + load {} Tk + tk useinputmethods 0 + load {} Tktest + wm geometry . +0+0 + frame .g -width 50 -height 50 + bindtags .g {a b c d} + pack .g + 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 .g <1> } set x [foo eval set x] + return $x +} -cleanup { 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 + bind a <1> {} + bind b <1> {} + bind c <1> {} + bind c <2> {} + destroy .g +} -result {a1 bye.all2 bye.a1 b1 bye.c1} + +test bind-7.1 {Tk_CreateBinding procedure: bad binding} -body { + canvas .t.c + .t.c bind foo < +} -cleanup { + destroy .t.c +} -returnCodes error -result {no event type or button # or keysym} +test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} -constraints { + testcbind +} -body { + frame .t.f + set x {} + testcbind .t.f <1> "xyz" "lappend x bye.1" + bind .t.f <1> "abc" + return $x +} -cleanup { + destroy .t.f +} -result {bye.1} +test bind-7.3 {Tk_CreateBinding procedure: append} -body { + canvas .t.c + .t.c bind foo <1> "button 1" + .t.c bind foo <1> "+more button 1" + .t.c bind foo <1> +} -cleanup { + destroy .t.c +} -result {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" +test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} -body { + canvas .t.c + .t.c bind foo <1> "+button 1" + .t.c bind foo <1> +} -cleanup { + destroy .t.c +} -result {button 1} + +test bind-8.1 {TkCreateBindingProcedure: error} -constraints { + testcbind +} -body { + testcbind . <xyz> "xyz" +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-8.2 {TkCreateBindingProcedure: new binding} -constraints { + testcbind +} -setup { + frame .t.f set x {} - event gen .b.f <1> - bind .b.f <1> {} - set x -} {.b.f Frame} +} -body { + testcbind .t.f <1> "lappend x 1" "lappend x bye.1" + event gen .t.f <1> + destroy .t.f + return $x +} -result {bye.1} +test bind-8.3 {TkCreateBindingProcedure: replace existing} -constraints { + testcbind +} -setup { + frame .t.f + pack .t.f + set x {} +} -body { + testcbind .t.f <1> "lappend x old1" "lappend x bye.old1" + testcbind .t.f <1> "lappend x new1" "lappend x bye.new1" + return $x +} -cleanup { + destroy .t.f +} -result {bye.old1} +test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} -constraints { + testcbind +} -setup { + frame .t.f + pack .t.f + update + set x {} +} -body { + testcbind .t.f <1> "lappend x .t.f; testcbind Frame <1> {lappend x Frame}" + testcbind Frame <1> "lappend x never" + event gen .t.f <1> + bind .t.f <1> {} + return $x +} -cleanup { + destroy .t.f + bind Frame <1> {} +} -result {.t.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 +test bind-9.1 {Tk_DeleteBinding procedure} -body { + frame .t.f -class Test -width 150 -height 100 + bind .t.f < +} -cleanup { + destroy .t.f +} -returnCodes ok +test bind-9.2 {Tk_DeleteBinding procedure} -setup { + set result {} +} -body { + frame .t.f -class Test -width 150 -height 100 foreach i {a b c d} { - bind .b.f $i "binding for $i" + bind .t.f $i "binding for $i" } - set result {} foreach i {b d a c} { - bind .b.f $i {} - lappend result [lsort [bind .b.f]] + bind .t.f $i {} + lappend result [lsort [bind .t.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 + return $result +} -cleanup { + destroy .t.f +} -result {{a c d} {a c} c {}} +test bind-9.3 {Tk_DeleteBinding procedure} -setup { + set result {} +} -body { + frame .t.f -class Test -width 150 -height 100 foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} { - bind .b.f $i "binding for $i" + bind .t.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]] + bind .t.f $i {} + lappend result [lsort [bind .t.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} + return $result +} -cleanup { + destroy .t.f +} -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} -constraints { + testcbind +} -setup { + frame .t.f + pack .t.f + update + set x {} +} -body { + bindtags .t.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> + event gen .t.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 + return $x +} -cleanup { + destroy .t.f + bind c <1> {} + bind c <2> {} +} -result {a1 bye.c2 b1 bye.c1 bye.a1} + +test bind-10.1 {Tk_GetBinding procedure} -body { + canvas .t.c + .t.c bind foo < +} -cleanup { + destroy .t.c +} -returnCodes error -result {no event type or button # or keysym} +test bind-10.2 {Tk_GetBinding procedure} -body { + canvas .t.c + .t.c bind foo a Test + .t.c bind foo a +} -cleanup { + destroy .t.c +} -result {Test} +test bind-10.3 {Tk_GetBinding procedure: C binding} -constraints { + testcbind +} -body { + frame .t.f + testcbind .t.f <1> "foo" + list [bind .t.f] [bind .t.f <1>] +} -cleanup { + destroy .t.f +} -result {<Button-1> {}} + + +test bind-11.1 {Tk_GetAllBindings procedure} -body { + frame .t.f foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" { - bind .b.f $i Test + bind .t.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 + lsort [bind .t.f] +} -cleanup { + destroy .t.f +} -result {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~} +test bind-11.2 {Tk_GetAllBindings procedure} -body { + frame .t.f foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" { - bind .b.f $i Test + bind .t.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 + lsort [bind .t.f] +} -cleanup { + destroy .t.f +} -result {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>} +test bind-11.3 {Tk_GetAllBindings procedure} -body { + frame .t.f foreach i "<Double-Triple-1> abcd a<Leave>b" { - bind .b.f $i Test + bind .t.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 + lsort [bind .t.f] +} -cleanup { + destroy .t.f +} -result {<Triple-Button-1> a<Leave>b abcd} + + +test bind-12.1 {Tk_DeleteAllBindings procedure} -body { + frame .t.f -class Test -width 150 -height 100 + destroy .t.f +} -result {} +test bind-12.2 {Tk_DeleteAllBindings procedure} -body { + frame .t.f -class Test -width 150 -height 100 foreach i "a b c <Meta-1> <Alt-a> <Control-a>" { - bind .b.f $i x + bind .t.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 + destroy .t.f +} -result {} +test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} -constraints { + testcbind +} -setup { + frame .t.f + pack .t.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"} +} -body { + testcbind .t.f <1> {lappend x before; event gen .t.f <2>; lappend x after} {lappend x bye.f1} + testcbind .t.f <2> {destroy .t.f} {lappend x bye.f2} + bind .t.f <Destroy> {lappend x fDestroy} + testcbind .t.f <3> {foo} {lappend x bye.f3} + event gen .t.f <1> + return $x +} -cleanup { + destroy .t.f +} -result {before fDestroy bye.f3 bye.f2 after bye.f1} -test bind-13.1 {Tk_BindEvent procedure} { - setup - bind .b.f a {lappend x "%W %K .b.f press a"} +test bind-13.1 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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"} +} -body { + 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"} + bind .t.f a {lappend x "%W %K .t.f press a"} + + event gen .t.f <Key-a> + event gen .t.f <Key-b> + event gen .t.f <Key-x> + return $x +} -cleanup { + destroy .t.f + bind all <KeyPress> {} + bind Test <KeyPress> {} + bind all x {} + bind Test a {} +} -result {{.t.f a .t.f press a} {.t.f a Test press a} {.t.f a all press any} {.t.f b Test press any} {.t.f b all press any} {.t.f x Test press any} {.t.f x all press x}} -test bind-13.2 {Tk_BindEvent procedure} { - setup - bind .b.f b {lappend x "%W %K .b.f press a"} +test bind-13.2 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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"} +} -body { + bind Test <KeyPress> {lappend x "%W %K Test press any"; break} + bind all <KeyPress> {continue; lappend x "%W %K all press any"} + bind .t.f b {lappend x "%W %K .t.f press a"} + + event gen .t.f <Key-b> + return $x +} -cleanup { + destroy .t.f + bind all <KeyPress> {} + bind Test <KeyPress> {} +} -result {{.t.f b .t.f press a} {.t.f b Test press any}} + +test bind-13.3 {Tk_BindEvent procedure} -setup { + proc bgerror args {} + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Key-b> +} -body { + bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test} + bind .t.f b {lappend x "%W %K .t.f press a"} + event gen .t.f <Key-b> update list $x $errorInfo -} {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test +} -cleanup { + destroy .t.f + bind Test <KeyPress> {} + rename bgerror {} +} -result {{{.t.f b .t.f press a} {.t.f b Test press any}} {Test while executing "error Test" (command bound to event)}} -rename bgerror {} -test bind-13.4 {Tk_BindEvent procedure} { +test bind-13.4 {Tk_BindEvent procedure} -setup { proc foo {} { - set x 44 - event gen .b.f <Key-a> + set x 44 + event gen .t.f <Key-a> } - setup - bind .b.f a {lappend x "%W %K .b.f press a"} + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} +} -body { + bind Test a {lappend x "%W %K Test press a"} + bind .t.f a {lappend x "%W %K .t.f press a"} foo - set x -} {{.b.f a .b.f press a} {.b.f a Test press a}} -test bind-13.5 {Tk_BindEvent procedure} { + return $x +} -cleanup { + destroy .t.f + bind Test a {} +} -result {{.t.f a .t.f press a} {.t.f a Test press a}} + +test bind-13.5 {Tk_BindEvent procedure} -body { 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)"} + frame .t.g -gorp foo +} -cleanup { + bind all <Destroy> {} +} -returnCodes error -result {unknown option "-gorp"} +test bind-13.6 {Tk_BindEvent procedure} -body { + bind all <Destroy> {lappend x "%W destroyed"} + set x {} + catch {frame .t.g -gorp foo} + return $x +} -cleanup { + bind all <Destroy> {} +} -result {{.t.g destroyed}} + +test bind-13.7 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Key-z> +} -body { + bind .t.f z {lappend x "%W z (.t.f binding)"} + bind Test z {lappend x "%W z (.t.f binding)"} + bind all z {bind .t.f z {}; lappend x "%W z (.t.f binding)"} + event gen .t.f <Key-z> + return $x +} -cleanup { 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)"} + destroy .t.f +} -result {{.t.f z (.t.f binding)} {.t.f z (.t.f binding)} {.t.f z (.t.f binding)}} +test bind-13.8 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Key-z> +} -body { + bind .t.f z {lappend x "%W z (.t.f binding)"} + bind Test z {lappend x "%W z (.t.f binding)"} + bind all z {destroy .t.f; lappend x "%W z (.t.f binding)"} + event gen .t.f <Key-z> + return $x +} -cleanup { bind Test z {} bind all z {} + destroy .t.f +} -result {{.t.f z (.t.f binding)} {.t.f z (.t.f binding)} {.t.f z (.t.f binding)}} + +test bind-13.9 {Tk_BindEvent procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <1> {lappend x "%W z (.t.f <1> binding)"} + bind .t.f <ButtonPress> {lappend x "%W z (.t.f <ButtonPress> binding)"} + event gen .t.f <Button-1> + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f +} -result {{.t.f z (.t.f <1> binding)} {.t.f z (.t.f <ButtonPress> binding)}} +test bind-13.10 {Tk_BindEvent procedure: ignore NotifyInferior} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x Enter%#" + bind .t.f <Leave> "lappend x Leave%#" + event gen .t.f <Enter> -serial 100 -detail NotifyAncestor + event gen .t.f <Enter> -serial 101 -detail NotifyInferior + event gen .t.f <Leave> -serial 102 -detail NotifyAncestor + event gen .t.f <Leave> -serial 103 -detail NotifyInferior + return $x +} -cleanup { + destroy .t.f +} -result {Enter100 Leave102} +test bind-13.11 {Tk_BindEvent procedure: collapse Motions} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x Motion%#(%x,%y)" + event gen .t.f <Motion> -serial 100 -x 100 -y 200 -when tail + update + event gen .t.f <Motion> -serial 101 -x 200 -y 300 -when tail + event gen .t.f <Motion> -serial 102 -x 300 -y 400 -when tail + update + return $x +} -cleanup { + destroy .t.f +} -result {Motion100(100,200) Motion102(300,400)} +test bind-13.12 {Tk_BindEvent procedure: collapse repeating modifiers} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> "lappend x %K%#" + bind .t.f <KeyRelease> "lappend x %K%#" + event gen .t.f <Key-Shift_L> -serial 100 -when tail + event gen .t.f <KeyRelease-Shift_L> -serial 101 -when tail + event gen .t.f <Key-Shift_L> -serial 102 -when tail + event gen .t.f <KeyRelease-Shift_L> -serial 103 -when tail + update +} -cleanup { + destroy .t.f +} -result {} +test bind-13.13 {Tk_BindEvent procedure: valid key detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x Key%K" + bind .t.f <KeyRelease> "lappend x Release%K" + event gen .t.f <Key> -keysym a + event gen .t.f <KeyRelease> -keysym a + return $x +} -cleanup { + destroy .t.f +} -result {Keya Releasea} +test bind-13.14 {Tk_BindEvent procedure: invalid key detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x Key%K" + bind .t.f <KeyRelease> "lappend x Release%K" + event gen .t.f <Key> -keycode 0 + event gen .t.f <KeyRelease> -keycode 0 + return $x +} -cleanup { + destroy .t.f +} -result {Key?? Release??} +test bind-13.15 {Tk_BindEvent procedure: button detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x Button%b" + bind .t.f <ButtonRelease> "lappend x Release%b" + event gen .t.f <Button> -button 1 + event gen .t.f <ButtonRelease> -button 3 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} +} -cleanup { + destroy .t.f +} -result {Button1 Release3} +test bind-13.16 {Tk_BindEvent procedure: virtual detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x Paste" + event gen .t.f <<Paste>> + return $x +} -cleanup { + destroy .t.f +} -result {Paste} +test bind-13.17 {Tk_BindEvent procedure: virtual event in event stream} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x Paste" + event gen .t.f <<Paste>> + return $x +} -cleanup { + destroy .t.f +} -result {Paste} +test bind-13.18 {Tk_BindEvent procedure: match detail physical} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-2> {set x Button-2} event add <<Paste>> <Button-2> - bind .b.f <<Paste>> {set x Paste} + bind .t.f <<Paste>> {set x Paste} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {Button-2} + +test bind-13.19 {Tk_BindEvent procedure: no match detail physical} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Button-2} -test bind-13.18 {Tk_BindEvent procedure: no match detail physical} { - setup +} -body { event add <<Paste>> <Button-2> - bind .b.f <<Paste>> {set x Paste} + bind .t.f <<Paste>> {set x Paste} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {Paste} +test bind-13.20 {Tk_BindEvent procedure: match detail virtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.19 {Tk_BindEvent procedure: match detail virtual} { - setup +} -body { event add <<Paste>> <Button-2> - bind .b.f <<Paste>> "lappend x Paste" + bind .t.f <<Paste>> "lappend x Paste" + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {Paste} +test bind-13.21 {Tk_BindEvent procedure: no match detail virtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.20 {Tk_BindEvent procedure: no match detail virtual} { - setup +} -body { event add <<Paste>> <Button-2> - bind .b.f <<Paste>> "lappend x Paste" + bind .t.f <<Paste>> "lappend x Paste" + event gen .t.f <Button> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {} +test bind-13.22 {Tk_BindEvent procedure: match no-detail physical} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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} +} -body { + bind .t.f <Button> {set x Button} event add <<Paste>> <Button> - bind .b.f <<Paste>> {set x Paste} + bind .t.f <<Paste>> {set x Paste} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button> +} -result {Button} +test bind-13.23 {Tk_BindEvent procedure: no match no-detail physical} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Button} -test bind-13.22 {Tk_BindEvent procedure: no match no-detail physical} { - setup +} -body { event add <<Paste>> <Button> - bind .b.f <<Paste>> {set x Paste} + bind .t.f <<Paste>> {set x Paste} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button> +} -result {Paste} +test bind-13.24 {Tk_BindEvent procedure: match no-detail virtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.23 {Tk_BindEvent procedure: match no-detail virtual} { - setup +} -body { event add <<Paste>> <Button> - bind .b.f <<Paste>> "lappend x Paste" + bind .t.f <<Paste>> "lappend x Paste" + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button> +} -result {Paste} +test bind-13.25 {Tk_BindEvent procedure: no match no-detail virtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Paste} -test bind-13.24 {Tk_BindEvent procedure: no match no-detail virtual} { - setup +} -body { event add <<Paste>> <Key> - bind .b.f <<Paste>> "lappend x Paste" + bind .t.f <<Paste>> "lappend x Paste" + event gen .t.f <Button> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Key> +} -result {} +test bind-13.26 {Tk_BindEvent procedure: precedence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button> - set x -} {} -test bind-13.25 {Tk_BindEvent procedure: precedence} { - setup +} -body { 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 + bind .t.f <Button-2> "lappend x Button-2" + bind .t.f <<Paste>> "lappend x Paste" + bind .t.f <Button> "lappend x Button" + bind .t.f <<Copy>> "lappend x Copy" + + event gen .t.f <Button-2> + bind .t.f <Button-2> {} + event gen .t.f <Button-2> + bind .t.f <<Paste>> {} + event gen .t.f <Button-2> + bind .t.f <Button> {} + event gen .t.f <Button-2> + bind .t.f <<Copy>> {} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> + event delete <<Copy>> <Button> +} -result {Button-2 Paste Button Copy} +test bind-13.27 {Tk_BindEvent procedure: no detail virtual pattern list} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-2> {set x Button-2} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f +} -result {Button-2} +test bind-13.28 {Tk_BindEvent procedure: detail virtual pattern list} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { event add <<Paste>> <Button-2> - bind .b.f <<Paste>> {set x Paste} + bind .t.f <<Paste>> {set x Paste} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-2> +} -result {Paste} +test bind-13.29 {Tk_BindEvent procedure: no no-detail virtual pattern list} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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} +} -body { + bind .t.f <Button> {set x Button} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f +} -result {Button} +test bind-13.30 {Tk_BindEvent procedure: no-detail virtual pattern list} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> - set x -} {Button} -test bind-13.29 {Tk_BindEvent procedure: no-detail virtual pattern list} { - setup +} -body { 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" - } + bind .t.f <<Paste>> {set x Paste} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button> +} -result {Paste} +test bind-13.31 {Tk_BindEvent procedure: no match} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + event gen .t.f <Button-2> +} -cleanup { + destroy .t.f +} -result {} +test bind-13.32 {Tk_BindEvent procedure: match} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-2> {set x Button-2} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f +} -result {Button-2} +test bind-13.33 {Tk_BindEvent procedure: many C bindings cause realloc} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <1> - foreach p [bindtags .b.f] { - bind $p <1> {} +} -body { + bindtags .t.f {a b c d e f g h i j k l m n o p} + foreach p [bindtags .t.f] { + testcbind $p <1> "lappend x $p" } - 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} + event gen .t.f <1> + return $x +} -cleanup { + foreach p [bindtags .t.f] {bind $p <1> {}} + destroy .t.f +} -result {a b c d e f g h i j k l m n o p} +test bind-13.34 {Tk_BindEvent procedure: multiple tags} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> +} -body { + bind .t.f <Button-2> {lappend x .t.f} + bind Test <Button-2> {lappend x Button} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f 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} +} -result {.t.f Button} +test bind-13.35 {Tk_BindEvent procedure: execute C binding} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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} +} -body { + testcbind .t.f <1> {lappend x 1} + event gen .t.f <1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-13.36 {Tk_BindEvent procedure: pending list marked deleted} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <1> +} -body { + testcbind Test <1> {lappend x Test} {lappend x Deleted} + bind .t.f <1> {lappend x .t.f; destroy .t.f} + event gen .t.f <1> set y [list $x [bind Test]] + return $y +} -cleanup { + destroy .t.f bind Test <1> {} - set y -} {.b.f <Button-1>} -test bind-13.36 {Tk_BindEvent procedure: C binding marked deleted} testcbind { - setup +} -result {.t.f <Button-1>} +test bind-13.37 {Tk_BindEvent procedure: C binding marked deleted} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { testcbind Test <1> {lappend x Test} {lappend x Deleted} - bind .b.f <1> {lappend x .b.f; bind Test <1> {}; lappend x after} + bind .t.f <1> {lappend x .t.f; bind Test <1> {}; lappend x after} + event gen .t.f <1> + return $x +} -cleanup { + destroy .t.f + bind Test <1> {} +} -result {.t.f after Deleted} +test bind-13.38 {Tk_BindEvent procedure: C binding gets to run} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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 +} -body { testcbind Test <1> {lappend x Test} - bind .b.f <1> {lappend x .b.f} - set x {} - event gen .b.f <1> + bind .t.f <1> {lappend x .t.f} + event gen .t.f <1> + return $x +} -cleanup { + destroy .t.f 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 +} -result {.t.f Test} +test bind-13.39 {Tk_BindEvent procedure: C binding deleted, refcount == 0} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + testcbind .t.f <1> {lappend x hi; bind .t.f <1> {}} {lappend x bye} + event gen .t.f <1> + return $x +} -cleanup { + destroy .t.f +} -result {hi bye} +test bind-13.40 {Tk_BindEvent procedure: C binding deleted, refcount != 0} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + testcbind .t.f <1> { + lappend x before$n + if {$n==0} { + bind .t.f <1> {} + } else { + set n [expr $n-1] + event gen .t.f <1> + } + lappend x after$n } {lappend x Deleted} set n 3 + event gen .t.f <1> + return $x +} -cleanup { + destroy .t.f +} -result {before3 before2 before1 before0 after0 after0 after0 after0 Deleted} +test bind-13.41 {Tk_BindEvent procedure: continue in script} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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} +} -body { + bind .t.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> + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f 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} +} -result {b1 B1} +test bind-13.42 {Tk_BindEvent procedure: continue in script} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> +} -body { + testcbind .t.f <Button-2> {lappend x b1; continue; lappend x b2} + testcbind Test <Button-2> {lappend x B1; continue; lappend x B2} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f 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} +} -result {b1 B1} +test bind-13.43 {Tk_BindEvent procedure: break in script} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> +} -body { + bind .t.f <Button-2> {lappend x b1; break; lappend x b2} + bind Test <Button-2> {lappend x B1; break; lappend x B2} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f 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} +} -result {b1} +test bind-13.44 {Tk_BindEvent procedure: break in script} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> +} -body { + testcbind .t.f <Button-2> {lappend x b1; break; lappend x b2} + testcbind Test <Button-2> {lappend x B1; break; lappend x B2} + event gen .t.f <Button-2> + return $x +} -cleanup { + destroy .t.f bind Test <Button-2> {} - set x -} {b1} +} -result {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} + +test bind-13.45 {Tk_BindEvent procedure: error in script} -setup { + proc bgerror msg { + global x + lappend x $msg + } + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> +} -body { + bind .t.f <Button-2> {lappend x b1; blap} + bind Test <Button-2> {lappend x B1} + event gen .t.f <Button-2> update + return $x +} -cleanup { + destroy .t.f 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} + proc bgerror args {} +} -result {b1 {invalid command name "blap"}} +test bind-13.46 {Tk_BindEvent procedure: error in script} -constraints { + testcbind +} -setup { + proc bgerror msg { + global x + lappend x $msg + } + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-2> +} -body { + testcbind .t.f <Button-2> {lappend x b1; blap} + testcbind Test <Button-2> {lappend x B1} + event gen .t.f <Button-2> update + return $x +} -cleanup { + destroy .t.f 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" + proc bgerror args {} +} -result {b1 {invalid command name "blap"}} + +test bind-14.1 {TkBindDeadWindow: no C bindings pending} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <1> x + testcbind .t.f <2> y + destroy .t.f +} -cleanup { + destroy .t.f +} -result {} +test bind-14.2 {TkBindDeadWindow: is called after <Destroy>} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + testcbind .t.f <Destroy> "lappend x .t.f" testcbind Test <Destroy> "lappend x Test" set x {} - destroy .b.f + destroy .t.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} +} -result {.t.f Test} +test bind-14.3 {TkBindDeadWindow: pending C bindings} -constraints { + testcbind +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bindtags .t.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 b <1> "destroy .t.f; lappend x b1" "lappend x bye.t1" 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" + bind a <2> "event gen .t.f <1>" + testcbind b <2> "lappend x b2" "lappend x bye.t2" 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 + testcbind a <3> "event gen .t.f <2>" + event gen .t.f <3> + return $x +} -cleanup { + destroy .t.f foreach tag {a b c d} { - foreach event {<1> <2> <3>} { - bind $tag $event {} - } + foreach event {<1> <2> <3>} { + bind $tag $event {} + } } - set y -} {a1 b1 d2} +} -result {a1 b1 d2} -test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} { - setup - bind .b.f ab {set x 1} +test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Key-a> + event gen .t.f <KeyRelease-a> + event gen .t.f <Key-b> + event gen .t.f <KeyRelease-b> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Key-a> + event gen .t.f <Enter> + event gen .t.f <KeyRelease-a> + event gen .t.f <Leave> + event gen .t.f <Key-b> + event gen .t.f <KeyRelease-b> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Key-a> + event gen .t.f <Button-1> + event gen .t.f <Key-b> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-1> + event gen .t.f <Key-a> + event gen .t.f <ButtonRelease-1> + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-1> + event gen .t.f <Key-Shift_L> + event gen .t.f <ButtonRelease-1> + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Key-a> + event gen .t.f <Key-c> + event gen .t.f <Key-b> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.9 {MatchPatterns procedure, modifier checks} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Key-a> -state 0x18 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.10 {MatchPatterns procedure, modifier checks} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Key-a> -state 0xfc + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.11 {MatchPatterns procedure, modifier checks} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} { + event gen .t.f <Key-a> -state 0x8 + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} -constraints { + nonPortable +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { # This test is non-portable because the Shift_L keysym may behave # differently on some platforms. - setup - bind .b.f aB {set x 1} + bind .t.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} + event gen .t.f <Key-a> + event gen .t.f <Key-Shift_L> + event gen .t.f <Key-b> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.13 {MatchPatterns procedure, checking detail} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Key-a> + event gen .t.f <Key-c> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.14 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> -x 30 -y 40 + event gen .t.f <Button-1> -x 31 -y 39 + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.15 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> -x 30 -y 40 + event gen .t.f <Button-1> -x 29 -y 41 + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.16 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> -x 30 -y 40 + event gen .t.f <Button-1> -x 40 -y 40 + event gen .t.f <ButtonRelease-2> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.17 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> -x 30 -y 40 + event gen .t.f <Button-1> -x 20 -y 40 + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.18 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> -x 30 -y 40 + event gen .t.f <Button-1> -x 30 -y 30 + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.19 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> -x 30 -y 40 + event gen .t.f <Button-1> -x 30 -y 50 + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.20 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> -time 300 + event gen .t.f <Button-1> -time 700 + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.21 {MatchPatterns procedure, checking "nearby"} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> -time 300 + event gen .t.f <Button-1> -time 900 + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.22 {MatchPatterns procedure, time wrap-around} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-1> -time [expr -100] + event gen .t.f <Button-1> -time 200 + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.23 {MatchPatterns procedure, time wrap-around} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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} + event gen .t.f <Button-1> -time -100 + event gen .t.f <Button-1> -time 500 + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {0} + +test bind-15.24 {MatchPatterns procedure, virtual event} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> +} -body { + event add <<Paste>> <Button-1> + bind .t.f <<Paste>> {lappend x paste} + event gen .t.f <Button-1> + event gen .t.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} +} -cleanup { + destroy .t.f + event delete <<Paste>> <Button-1> +} -result {paste} +test bind-15.25 {MatchPatterns procedure, reject a virtual event} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> +} -body { + event add <<Paste>> <Shift-Button-1> + bind .t.f <<Paste>> {lappend x paste} + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> set x -} {} -test bind-15.26 {MatchPatterns procedure, reject a virtual event} { - setup +} -cleanup { + destroy .t.f + event delete <<Paste>> <Shift-Button-1> +} -result {} +test bind-15.26 {MatchPatterns procedure, reject a virtual event} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { 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> + bind .t.f <<V2>> "lappend x V2%#" + event gen .t.f <Button> -serial 101 + event gen .t.f <Button-1> -serial 102 + event gen .t.f <Shift-Button-1> -serial 103 + event gen .t.f <ButtonRelease-1> + bind .t.f <Shift-Button-1> "lappend x Shift-Button-1" + event gen .t.f <Button> -serial 104 + event gen .t.f <Button-1> -serial 105 + event gen .t.f <Shift-Button-1> -serial 106 + event gen .t.f <ButtonRelease-1> 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} +} -cleanup { + destroy .t.f + event delete <<V1>> <Button> + event delete <<V2>> <Button-1> + event delete <<V3>> <Shift-Button-1> +} -result {V2102 V2103 V2105 Shift-Button-1} +test bind-15.27 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyPress> {set x 0} + bind .t.f a {set x 1} 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} + event gen .t.f <Key-a> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.28 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyPress> {set x 0} + bind .t.f a {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} + event gen .t.f <Key-b> + return $x +} -cleanup { + destroy .t.f +} -result {0} +test bind-15.29 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyPress> {lappend x 0} + bind .t.f a {lappend x 1} + bind .t.f ba {lappend x 2} set x none - event gen .b.f <Key-a> -state 0x18 + event gen .t.f <Key-b> + event gen .t.f <KeyRelease-b> + event gen .t.f <Key-a> 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} +} -cleanup { + destroy .t.f +} -result {none 0 2} +test bind-15.30 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <ButtonPress> {set x 0} + bind .t.f <1> {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} + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.31 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <M1-Key> {set x 0} + bind .t.f <M2-Key> {set x 1} + event gen .t.f <Key-a> -state 0x18 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.32 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <M2-Key> {set x 0} + bind .t.f <M1-Key> {set x 1} + set x none + event gen .t.f <Key-a> -state 0x18 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.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> + event gen .t.f <Button-1> + event gen .t.f <Button-1> + event gen .t.f <Button-1> + event gen .t.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} +} -cleanup { + destroy .t.f + bind Test <1> {} + bind Test <Double-1> {} +} -result {single single(Test) single double(Test) single double(Test)} + + +test bind-16.1 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x abcd} set x none - event gen .b.f <Enter> + event gen .t.f <Enter> set x -} abcd -test bind-16.2 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %#} +} -cleanup { + destroy .t.f +} -result {abcd} +test bind-16.2 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %#} set x none - event gen .b.f <Enter> -serial 1234 + event gen .t.f <Enter> -serial 1234 set x -} 1234 -test bind-16.3 {ExpandPercents procedure} { - setup - bind .b.f <Configure> {set x %a} +} -cleanup { + destroy .t.f +} -result {1234} +test bind-16.3 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Configure> {set x %a} set x none - event gen .b.f <Configure> -above .b -window .b.f + event gen .t.f <Configure> -above .t -window .t.f set x -} [winfo id .b] -test bind-16.4 {ExpandPercents procedure} { - setup - bind .b.f <Button> {set x %b} +} -cleanup { + destroy .t.f +} -result [winfo id .t] +test bind-16.4 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {set x %b} set x none - event gen .b.f <Button-3> - event gen .b.f <ButtonRelease-3> + event gen .t.f <Button-3> + event gen .t.f <ButtonRelease-3> set x -} 3 -test bind-16.5 {ExpandPercents procedure} { - setup - bind .b.f <Expose> {set x %c} +} -cleanup { + destroy .t.f +} -result {3} +test bind-16.5 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Expose> {set x %c} set x none - event gen .b.f <Expose> -count 47 + event gen .t.f <Expose> -count 47 set x -} 47 -test bind-16.6 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {47} +test bind-16.6 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyAncestor + event gen .t.f <Enter> -detail NotifyAncestor set x -} NotifyAncestor -test bind-16.7 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyAncestor} +test bind-16.7 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyVirtual + event gen .t.f <Enter> -detail NotifyVirtual set x -} NotifyVirtual -test bind-16.8 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyVirtual} +test bind-16.8 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyNonlinear + event gen .t.f <Enter> -detail NotifyNonlinear set x -} NotifyNonlinear -test bind-16.9 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyNonlinear} +test bind-16.9 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyNonlinearVirtual + event gen .t.f <Enter> -detail NotifyNonlinearVirtual set x -} NotifyNonlinearVirtual -test bind-16.10 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyNonlinearVirtual} +test bind-16.10 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyPointer + event gen .t.f <Enter> -detail NotifyPointer set x -} NotifyPointer -test bind-16.11 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyPointer} +test bind-16.11 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyPointerRoot + event gen .t.f <Enter> -detail NotifyPointerRoot set x -} NotifyPointerRoot -test bind-16.12 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %d} +} -cleanup { + destroy .t.f +} -result {NotifyPointerRoot} +test bind-16.12 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x %d} set x none - event gen .b.f <Enter> -detail NotifyDetailNone + event gen .t.f <Enter> -detail NotifyDetailNone set x -} NotifyDetailNone -test bind-16.13 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x %f} +} -cleanup { + destroy .t.f +} -result {NotifyDetailNone} +test bind-16.13 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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"} + event gen .t.f <Enter> -focus 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.14 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Expose> {set x "%x %y %w %h"} set x none - event gen .b.f <Expose> -x 24 -y 18 -width 147 -height 61 + event gen .t.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"} +} -cleanup { + destroy .t.f +} -result {24 18 147 61} +test bind-16.15 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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 + event gen .t.f <Configure> -x 24 -y 18 -width 147 -height 61 -window .t.f set x -} {24 18 147 61} -test bind-16.16 {ExpandPercents procedure} { - setup - bind .b.f <Key> {set x "%k"} +} -cleanup { + destroy .t.f +} -result {24 18 147 61} +test bind-16.16 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> {set x "%k"} set x none - event gen .b.f <Key> -keycode 146 + event gen .t.f <Key> -keycode 146 set x -} 146 -test bind-16.17 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%m"} +} -cleanup { + destroy .t.f +} -result {146} +test bind-16.17 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%m"} set x none - event gen .b.f <Enter> -mode NotifyNormal + event gen .t.f <Enter> -mode NotifyNormal set x -} NotifyNormal -test bind-16.18 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%m"} +} -cleanup { + destroy .t.f +} -result {NotifyNormal} +test bind-16.18 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%m"} set x none - event gen .b.f <Enter> -mode NotifyGrab + event gen .t.f <Enter> -mode NotifyGrab set x -} NotifyGrab -test bind-16.19 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%m"} +} -cleanup { + destroy .t.f +} -result {NotifyGrab} +test bind-16.19 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%m"} set x none - event gen .b.f <Enter> -mode NotifyUngrab + event gen .t.f <Enter> -mode NotifyUngrab set x -} NotifyUngrab -test bind-16.20 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%m"} +} -cleanup { + destroy .t.f +} -result {NotifyUngrab} +test bind-16.20 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> {set x "%m"} set x none - event gen .b.f <Enter> -mode NotifyWhileGrabbed + event gen .t.f <Enter> -mode NotifyWhileGrabbed set x -} NotifyWhileGrabbed -test bind-16.21 {ExpandPercents procedure} { - setup - bind .b.f <Map> {set x "%o"} +} -cleanup { + destroy .t.f +} -result {NotifyWhileGrabbed} +test bind-16.21 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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"} + event gen .t.f <Map> -override 1 -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.22 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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"} + event gen .t.f <Reparent> -override true -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.23 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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"} + event gen .t.f <Configure> -override 1 -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.24 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Circulate> {set x "%p"} set x none - event gen .b.f <Circulate> -place PlaceOnTop -window .b.f + event gen .t.f <Circulate> -place PlaceOnTop -window .t.f set x -} PlaceOnTop -test bind-16.25 {ExpandPercents procedure} { - setup - bind .b.f <Circulate> {set x "%p"} +} -cleanup { + destroy .t.f +} -result {PlaceOnTop} +test bind-16.25 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Circulate> {set x "%p"} set x none - event gen .b.f <Circulate> -place PlaceOnBottom -window .b.f + event gen .t.f <Circulate> -place PlaceOnBottom -window .t.f set x -} PlaceOnBottom -test bind-16.26 {ExpandPercents procedure} { - setup - bind .b.f <1> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {PlaceOnBottom} +test bind-16.26 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <1> {set x "%s"} set x none - event gen .b.f <Button-1> -state 1402 - event gen .b.f <ButtonRelease-1> + event gen .t.f <Button-1> -state 1402 + event gen .t.f <ButtonRelease-1> set x -} 1402 -test bind-16.27 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {1402} +test bind-16.27 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> {set x "%s"} set x none - event gen .b.f <Enter> -state 0x3ff + event gen .t.f <Enter> -state 0x3ff set x -} 1023 -test bind-16.28 {ExpandPercents procedure} { - setup - bind .b.f <Visibility> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {1023} +test bind-16.28 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Visibility> {set x "%s"} set x none - event gen .b.f <Visibility> -state VisibilityPartiallyObscured + event gen .t.f <Visibility> -state VisibilityPartiallyObscured set x -} VisibilityPartiallyObscured -test bind-16.29 {ExpandPercents procedure} { - setup - bind .b.f <Visibility> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {VisibilityPartiallyObscured} +test bind-16.29 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Visibility> {set x "%s"} set x none - event gen .b.f <Visibility> -state VisibilityUnobscured + event gen .t.f <Visibility> -state VisibilityUnobscured set x -} VisibilityUnobscured -test bind-16.30 {ExpandPercents procedure} { - setup - bind .b.f <Visibility> {set x "%s"} +} -cleanup { + destroy .t.f +} -result {VisibilityUnobscured} +test bind-16.30 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Visibility> {set x "%s"} set x none - event gen .b.f <Visibility> -state VisibilityFullyObscured + event gen .t.f <Visibility> -state VisibilityFullyObscured set x -} VisibilityFullyObscured -test bind-16.31 {ExpandPercents procedure} { - setup - bind .b.f <Button> {set x "%t"} +} -cleanup { + destroy .t.f +} -result {VisibilityFullyObscured} +test bind-16.31 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {set x "%t"} set x none - event gen .b.f <Button> -time 4294 - event gen .b.f <ButtonRelease> + event gen .t.f <Button> -time 4294 + event gen .t.f <ButtonRelease> set x -} 4294 -test bind-16.32 {ExpandPercents procedure} { - setup - bind .b.f <Button> {set x "%x %y"} +} -cleanup { + destroy .t.f +} -result {4294} +test bind-16.32 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {set x "%x %y"} set x none - event gen .b.f <Button> -x 881 -y 432 - event gen .b.f <ButtonRelease> + event gen .t.f <Button> -x 881 -y 432 + event gen .t.f <ButtonRelease> set x -} {881 432} -test bind-16.33 {ExpandPercents procedure} { - setup - bind .b.f <Reparent> {set x "%x %y"} +} -cleanup { + destroy .t.f +} -result {881 432} +test bind-16.33 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Reparent> {set x "%x %y"} set x none - event gen .b.f <Reparent> -x 882 -y 431 -window .b.f + event gen .t.f <Reparent> -x 882 -y 431 -window .t.f set x -} {882 431} -test bind-16.34 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%x %y"} +} -cleanup { + destroy .t.f +} -result {882 431} +test bind-16.34 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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"} + event gen .t.f <Enter> -x 781 -y 632 + set x +} -cleanup { + destroy .t.f +} -result {781 632} +test bind-16.35 {ExpandPercents procedure} -constraints { + nonPortable +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> {lappend x "%A"} + event gen .t.f <Key-a> + event gen .t.f <Key-A> -state 1 + event gen .t.f <Key-Tab> + event gen .t.f <Key-Return> + event gen .t.f <Key-F1> + event gen .t.f <Key-Shift_L> + event gen .t.f <Key-space> + event gen .t.f <Key-dollar> -state 1 + event gen .t.f <Key-braceleft> -state 1 + event gen .t.f <Key-Multi_key> + event gen .t.f <Key-e> + event gen .t.f <Key-apostrophe> + set x +} -cleanup { + destroy .t.f +} -result {a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9} +test bind-16.36 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Configure> {set x "%B"} set x none - event gen .b.f <Configure> -borderwidth 24 -window .b.f + event gen .t.f <Configure> -borderwidth 24 -window .t.f set x -} 24 -test bind-16.37 {ExpandPercents procedure} { - setup - bind .b.f <Enter> {set x "%E"} +} -cleanup { + destroy .t.f +} -result {24} +test bind-16.37 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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"} + event gen .t.f <Enter> -sendevent 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} +test bind-16.38 {ExpandPercents procedure} -constraints { + nonPortable +} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> {lappend x %K} + event gen .t.f <Key-a> + event gen .t.f <Key-A> -state 1 + event gen .t.f <Key-Tab> + event gen .t.f <Key-F1> + event gen .t.f <Key-Shift_L> + event gen .t.f <Key-space> + event gen .t.f <Key-dollar> -state 1 + event gen .t.f <Key-braceleft> -state 1 + set x +} -cleanup { + destroy .t.f +} -result {a A Tab F1 Shift_L space dollar braceleft} +test bind-16.39 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> {set x "%N"} set x none - event gen .b.f <Key-a> + event gen .t.f <Key-a> set x -} 97 -test bind-16.40 {ExpandPercents procedure} { - setup - bind .b.f <Key> {set x "%S"} +} -cleanup { + destroy .t.f +} -result {97} +test bind-16.40 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> {set x "%S"} set x none - event gen .b.f <Key-a> -subwindow .b + event gen .t.f <Key-a> -subwindow .t set x -} [winfo id .b] -test bind-16.41 {ExpandPercents procedure} { - setup - bind .b.f <Key> {set x "%T"} +} -cleanup { + destroy .t.f +} -result [winfo id .t] +test bind-16.41 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> {set x "%T"} set x none - event gen .b.f <Key> + event gen .t.f <Key> set x -} 2 -test bind-16.42 {ExpandPercents procedure} { - setup - bind .b.f <Key> {set x "%W"} +} -cleanup { + destroy .t.f +} -result {2} +test bind-16.42 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> {set x "%W"} set x none - event gen .b.f <Key> + event gen .t.f <Key> set x -} .b.f -test bind-16.43 {ExpandPercents procedure} { - setup - bind .b.f <Button> {set x "%X %Y"} +} -cleanup { + destroy .t.f +} -result {.t.f} +test bind-16.43 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {set x "%X %Y"} set x none - event gen .b.f <Button> -rootx 422 -rooty 13 - event gen .b.f <ButtonRelease> + event gen .t.f <Button> -rootx 422 -rooty 13 + event gen .t.f <ButtonRelease> set x -} {422 13} -test bind-16.44 {ExpandPercents procedure} { - setup - bind .b.f <Gravity> {set x "%R %S"} +} -cleanup { + destroy .t.f +} -result {422 13} +test bind-16.44 {ExpandPercents procedure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.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 gen .t.f <Gravity> + set x +} -cleanup { + destroy .t.f +} -result {?? ??} + + +test bind-17.1 {event command} -body { + event +} -returnCodes error -result {wrong # args: should be "event option ?arg?"} +test bind-17.2 {event command} -body { + event xyz +} -returnCodes error -result {bad option "xyz": must be add, delete, generate, or info} +test bind-17.3 {event command: add} -body { + event add +} -returnCodes error -result {wrong # args: should be "event add virtual sequence ?sequence ...?"} +test bind-17.4 {event command: add 1} -body { + event delete <<Paste>> event add <<Paste>> <Control-v> event info <<Paste>> -} {<Control-Key-v>} -test bind-17.5 {event command: add 2} { - setup +} -cleanup { + event delete <<Paste>> <Control-v> +} -result {<Control-Key-v>} +test bind-17.5 {event command: add 2} -body { + event delete <<Paste>> 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 ...?"}} -test bind-17.8 {event command: delete many} { - setup +} -cleanup { + event delete <<Paste>> <Control-v> <Button-2> +} -result {<Button-2> <Control-Key-v>} + +test bind-17.6 {event command: add with error} -body { + event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1> +} -cleanup { + event delete <<Paste>> +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-17.7 {event command: add with error} -body { + event delete <<Paste>> + catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>} + lsort [event info <<Paste>>] +} -cleanup { + event delete <<Paste>> +} -result {<Button-2> <Control-Key-v> abc} + +test bind-17.8 {event command: delete} -body { + event delete +} -returnCodes error -result {wrong # args: should be "event delete virtual ?sequence ...?"} +test bind-17.9 {event command: delete many} -body { + event delete <<Paste>> 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 +} -cleanup { + event delete <<Paste>> <3> t +} -result {<Button-3> t} +test bind-17.10 {event command: delete all} -body { event add <<Paste>> a b event delete <<Paste>> event info <<Paste>> -} {} -test bind-17.10 {event command: delete 1} { - setup +} -cleanup { + event delete <<Paste>> a b +} -result {} +test bind-17.11 {event command: delete 1} -body { + event delete <<Paste>> 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 +} -cleanup { + event delete <<Paste>> +} -result {a c} +test bind-17.12 {event command: info name} -body { + event delete <<Paste>> event add <<Paste>> a b c lsort [event info <<Paste>>] -} {a b c} -test bind-17.12 {event command: info all} { - setup +} -cleanup { + event delete <<Paste>> +} -result {a b c} +test bind-17.13 {event command: info all} -body { + foreach p [event info] {event delete $p} 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 ?-option value ...?"}} -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 +} -cleanup { + event delete <<Paste>> + event delete <<Alive>> +} -result {<<Alive>> <<Paste>>} + +test bind-17.14 {event command: info error} -body { + event info <<Paste>> <Control-v> +} -returnCodes error -result {wrong # args: should be "event info ?virtual?"} +test bind-17.15 {event command: generate} -body { + event generate +} -returnCodes error -result {wrong # args: should be "event generate window event ?-option value ...?"} + +test bind-17.16 {event command: generate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <1> "lappend x 1" + event generate .t.f <1> + set x +} -cleanup { + destroy .t.f +} -result {1} +test bind-17.17 {event command: generate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + event generate .t.f <xyz> +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-17.18 {event command} -body { + event foo +} -returnCodes error -result {bad option "foo": must be add, delete, generate, or info} + + +test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} -body { + event add asd <Ctrl-v> +} -returnCodes error -result {virtual event "asd" is badly formed} +test bind-18.2 {CreateVirtualEvent procedure: FindSequence} -body { + event add <<asd>> <Ctrl-v> +} -returnCodes error -result {bad event type or keysym "Ctrl"} +test bind-18.3 {CreateVirtualEvent procedure: new physical} -body { + event delete <<xyz>> event add <<xyz>> <Control-v> event info <<xyz>> -} {<Control-Key-v>} -test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} { - setup +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v>} +test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} -body { + event delete <<xyz>> 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 +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v>} +test bind-18.5 {CreateVirtualEvent procedure: existing physical} -body { + foreach p [event info] {event delete $p} 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 +} -cleanup { + event delete <<xyz>> + event delete <<abc>> +} -result {{<<abc>> <<xyz>>} <Control-Key-v> <Control-Key-v>} +test bind-18.6 {CreateVirtualEvent procedure: new virtual} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> list [event info] [event info <<xyz>>] -} {<<xyz>> <Control-Key-v>} -test bind-18.7 {CreateVirtualEvent procedure: existing virtual} { - setup +} -cleanup { + event delete <<abc>> +} -result {<<xyz>> <Control-Key-v>} +test bind-18.7 {CreateVirtualEvent procedure: existing virtual} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event add <<xyz>> <Button-2> list [event info] [lsort [event info <<xyz>>]] -} {<<xyz>> {<Button-2> <Control-Key-v>}} +} -cleanup { + event delete <<xyz>> +} -result {<<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 +test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} -body { + event add xyz {} +} -returnCodes error -result {virtual event "xyz" is badly formed} +test bind-19.2 {DeleteVirtualEvent procedure: non-existent virtual} -setup { + foreach p [event info] {event delete $p} +} -body { event delete <<xyz>> event info -} {} -test bind-19.3 {DeleteVirtualEvent procedure: delete 1} { - setup +} -result {} +test bind-19.3 {DeleteVirtualEvent procedure: delete 1} -setup { + event delete <<xyz>> +} -body { event add <<xyz>> <Control-v> event delete <<xyz>> <Control-v> event info <<xyz>> -} {} -test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} { - setup +} -result {} +test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} -setup { + event delete <<xyz>> +} -body { 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 +} -result {<Control-Key-v>} +test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} -body { 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 delete <<xyz>> <xyz> +} -cleanup { + event delete <<xyz>> +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-19.6 {DeleteVirtualEvent procedure: delete 1, badly formed} -body { 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 delete <<xyz>> <<Paste>> +} -cleanup { + event delete <<xyz>> +} -returnCodes error -result {virtual event not allowed in definition of another virtual event} +test bind-19.7 {DeleteVirtualEvent procedure: owns 1, delete all} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event delete <<xyz>> event info -} {} -test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} { - setup +} -result {} +test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event delete <<xyz>> <Control-v> event info -} {} -test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} { - setup +} -result {} +test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} -body { + foreach p [event info] {event delete $p} 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 +} -result {} +test bind-19.10 {DeleteVirtualEvent procedure: owns many, delete 1} -body { + event delete <<xyz>> 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 %#} +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v> <Control-Key-x>} +test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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> +} -body { + event add <<xyz>> <Button-2> + bind .t.f <<xyz>> {lappend x %#} + event gen .t.f <Button-2> -serial 101 + event gen .t.f <ButtonRelease-2> + event delete <<xyz>> + event gen .t.f <Button-2> -serial 102 + event gen .t.f <ButtonRelease-2> set x -} {101} -test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} { - setup +} -cleanup { + destroy .t.f +} -result {101} +test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} + event delete <<xyz>> + event delete <<abc>> +} -body { 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> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.f <<abc>> {lappend x abc} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Control-Button-2> + event gen .t.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> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Control-Button-2> + event gen .t.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 +} -cleanup { + destroy .t.f + event delete <<abc>> +} -result {{xyz abc abc} <Control-Button-2>} +test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { 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> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.f <<abc>> {lappend x abc} + bind .t.f <<def>> {lappend x def} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Control-Button-2> + event gen .t.f <Control-ButtonRelease-2> + event gen .t.f <Shift-Button-2> + event gen .t.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> + event gen .t.f <Button-2> + event gen .t.f <Control-Button-2> + event gen .t.f <Shift-Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Control-ButtonRelease-2> + event gen .t.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 +} -cleanup { + destroy .t.f + event delete <<abc>> + event delete <<def>> +} -result {{xyz abc def abc def} <Shift-Button-2> {} <Control-Button-2>} +test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { 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> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.f <<abc>> {lappend x abc} + bind .t.f <<def>> {lappend x def} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Control-Button-2> + event gen .t.f <Control-ButtonRelease-2> + event gen .t.f <Shift-Button-2> + event gen .t.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> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Control-Button-2> + event gen .t.f <Control-ButtonRelease-2> + event gen .t.f <Shift-Button-2> + event gen .t.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] +} -cleanup { + destroy .t.f + event delete <<def>> + event delete <<abc>> +} -result {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>} +test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} -setup { + pack [frame .t.f -class Test -width 150 -height 100] + pack [frame .t.g -class Test -width 150 -height 100] + pack [frame .t.h -class Test -width 150 -height 100] + focus -force .t.f update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { 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> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.g <<abc>> {lappend x abc} + bind .t.h <<def>> {lappend x def} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.g <Button-2> + event gen .t.g <ButtonRelease-2> + event gen .t.h <Button-2> + event gen .t.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 + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.g <Button-2> + event gen .t.g <ButtonRelease-2> + event gen .t.h <Button-2> + event gen .t.h <ButtonRelease-2> 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] +} -cleanup { + destroy .t.f .t.g .t.h + event delete <<def>> + event delete <<abc>> +} -result {{xyz abc def abc def} {} <Button-2> <Button-2>} +test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} -setup { + pack [frame .t.f -class Test -width 150 -height 100] + pack [frame .t.g -class Test -width 150 -height 100] + pack [frame .t.h -class Test -width 150 -height 100] + focus -force .t.f update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { 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> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.g <<abc>> {lappend x abc} + bind .t.h <<def>> {lappend x def} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.g <Button-2> + event gen .t.g <ButtonRelease-2> + event gen .t.h <Button-2> + event gen .t.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 + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.g <Button-2> + event gen .t.g <ButtonRelease-2> + event gen .t.h <Button-2> + event gen .t.h <ButtonRelease-2> 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] +} -cleanup { + destroy .t.f .t.g .t.h + event delete <<def>> + event delete <<xyz>> +} -result {{xyz abc def xyz def} <Button-2> {} <Button-2>} +test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} -setup { + pack [frame .t.f -class Test -width 150 -height 100] + pack [frame .t.g -class Test -width 150 -height 100] + pack [frame .t.h -class Test -width 150 -height 100] + focus -force .t.f update + set x {} + event delete <<def>> + event delete <<xyz>> + event delete <<abc>> +} -body { 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> + bind .t.f <<xyz>> {lappend x xyz} + bind .t.g <<abc>> {lappend x abc} + bind .t.h <<def>> {lappend x def} + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.g <Button-2> + event gen .t.g <ButtonRelease-2> + event gen .t.h <Button-2> + event gen .t.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 + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.g <Button-2> + event gen .t.g <ButtonRelease-2> + event gen .t.h <Button-2> + event gen .t.h <ButtonRelease-2> list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>] -} {{xyz abc def xyz abc} <Button-2> <Button-2> {}} +} -cleanup { + destroy .t.f .t.g .t.h + event delete <<xyz>> + event delete <<abc>> +} -result {{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} { +test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} -body { + event info asd +} -returnCodes error -result {virtual event "asd" is badly formed} +test bind-20.2 {GetVirtualEvent procedure: non-existent event} -body { + event delete <<asd>> event info <<asd>> -} {} -test bind-20.3 {GetVirtualEvent procedure: owns 1} { - setup +} -result {} +test bind-20.3 {GetVirtualEvent procedure: owns 1} -setup { + event delete <<xyz>> +} -body { event add <<xyz>> <Control-Key-v> event info <<xyz>> -} {<Control-Key-v>} -test bind-20.4 {GetVirtualEvent procedure: owns many} { - setup +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v>} +test bind-20.4 {GetVirtualEvent procedure: owns many} -setup { + event delete <<xyz>> +} -body { event add <<xyz>> <Control-v> <Button-2> spack event info <<xyz>> -} {<Control-Key-v> <Button-2> spack} +} -cleanup { + event delete <<xyz>> +} -result {<Control-Key-v> <Button-2> spack} -test bind-21.1 {GetAllVirtualEvents procedure: no events} { - setup +test bind-21.1 {GetAllVirtualEvents procedure: no events} -body { + foreach p [event info] {event delete $p} event info -} {} -test bind-21.2 {GetAllVirtualEvents procedure: 1 event} { - setup +} -result {} +test bind-21.2 {GetAllVirtualEvents procedure: 1 event} -body { + foreach p [event info] {event delete $p} event add <<xyz>> <Control-v> event info -} {<<xyz>>} -test bind-21.3 {GetAllVirtualEvents procedure: many events} { - setup +} -cleanup { + event delete <<xyz>> +} -result {<<xyz>>} +test bind-21.3 {GetAllVirtualEvents procedure: many events} -body { + foreach p [event info] {event delete $p} 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-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 - 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 +} -cleanup { + event delete <<xyz>> + event delete <<abc>> + event delete <<def>> +} -result {<<abc>> <<def>> <<xyz>>} + +test bind-22.1 {HandleEventGenerate} -setup { + destroy .xyz +} -body { + event gen .xyz <Control-v> +} -returnCodes error -result {bad window path name ".xyz"} +test bind-22.2 {HandleEventGenerate} -body { + event gen zzz <Control-v> +} -returnCodes error -result {bad window name/identifier "zzz"} +test bind-22.3 {HandleEventGenerate} -body { + event gen 47 <Control-v> +} -returnCodes error -result {bad window name/identifier "47"} +test bind-22.4 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> {set x "%s %b"} + event gen [winfo id .t.f] <Control-Button-1> -state 260 + set x +} -cleanup { + destroy .t.f +} -result {260 1} +test bind-22.5 {HandleEventGenerate} -body { + event gen . <xyz> +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-22.6 {HandleEventGenerate} -body { + event gen . <Double-Button-1> +} -returnCodes error -result {Double or Triple modifier not allowed} +test bind-22.7 {HandleEventGenerate} -body { + event gen . xyz +} -returnCodes error -result {only one event specification allowed} +test bind-22.8 {HandleEventGenerate} -body { + event gen . <Button> -button +} -returnCodes error -result {value for "-button" missing} +test bind-22.9 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> {set x "%s %b"} + event gen .t.f <ButtonRelease-1> + event gen .t.f <ButtonRelease-2> + event gen .t.f <ButtonRelease-3> + event gen .t.f <Control-Button-1> + event gen .t.f <Control-ButtonRelease-1> + set x +} -cleanup { + destroy .t.f +} -result {4 1} +test bind-22.10 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> {set x "%s %K"} + event gen .t.f <Control-Key-1> + set x +} -cleanup { + destroy .t.f +} -result {4 1} +test bind-22.11 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> {set x "%s"} + event gen .t.f <<Paste>> -state 1 + set x +} -cleanup { + destroy .t.f +} -result {1} +test bind-22.12 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> {set x "%s"} + event gen .t.f <Control-Motion> + set x +} -cleanup { + destroy .t.f +} -result {4} +test bind-22.13 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> {lappend x %#} + event gen .t.f <Button> -when now -serial 100 + event gen .t.f <ButtonRelease> -when now + set x +} -cleanup { + destroy .t.f +} -result {100} +test bind-22.14 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> {lappend x %#} + event gen .t.f <Button> -when head -serial 100 + event gen .t.f <Button> -when head -serial 101 + event gen .t.f <Button> -when head -serial 102 + event gen .t.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 %#} +} -cleanup { + destroy .t.f +} -result {foo 102 101 100} +test bind-22.15 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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 +} -body { + bind .t.f <Button> {lappend x %#} + event gen .t.f <Button> -when head -serial 99 + event gen .t.f <Button> -when mark -serial 100 + event gen .t.f <Button> -when mark -serial 101 + event gen .t.f <Button> -when mark -serial 102 + event gen .t.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 %#} +} -cleanup { + destroy .t.f +} -result {foo 100 101 102 99} +test bind-22.16 {HandleEventGenerate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update 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 +} -body { + bind .t.f <Button> {lappend x %#} + event gen .t.f <Button> -when head -serial 99 + event gen .t.f <Button> -when tail -serial 100 + event gen .t.f <Button> -when tail -serial 101 + event gen .t.f <Button> -when tail -serial 102 + event gen .t.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} { +} -cleanup { + destroy .t.f +} -result {foo 99 100 101 102} +test bind-22.17 {HandleEventGenerate} -body { + event gen . <Button> -when xyz +} -returnCodes error -result {bad -when value "xyz": must be now, head, mark, or tail} +test bind-22.18 {HandleEventGenerate} -body { # 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] -} + event gen . <a> -root 98765 +} -returnCodes error -result {bad window name/identifier "98765"} + +# previously -run with foreach +test bind-22.19 {HandleEventGenerate: options <Configure> -above .xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %a" + event gen .t.f <Configure> -above .xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window path name ".xyz"} +test bind-22.20 {HandleEventGenerate: options <Configure> -above .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %a" + event gen .t.f <Configure> -above .t + return $x +} -cleanup { + destroy .t.f +} -result [winfo id .t] +test bind-22.21 {HandleEventGenerate: options <Configure> -above xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %a" + event gen .t.f <Configure> -above xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window name/identifier "xyz"} +test bind-22.22 {HandleEventGenerate: options <Configure> -above [winfo id .t]} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %a" + event gen .t.f <Configure> -above [winfo id .t] + return $x +} -cleanup { + destroy .t.f +} -result [winfo id .t] + +test bind-22.23 {HandleEventGenerate: options <Key> -above .} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %b" + event gen .t.f <Key> -above . + return $x +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-above" option} + +test bind-22.24 {HandleEventGenerate: options <Configure> -borderwidth xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %B" + event gen .t.f <Configure> -borderwidth xyz + return $x +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.25 {HandleEventGenerate: options <Configure> -borderwidth 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %B" + event gen .t.f <Configure> -borderwidth 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.26 {HandleEventGenerate: options <Key> -borderwidth 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -borderwidth 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-borderwidth" option} + +test bind-22.27 {HandleEventGenerate: options <Button> -button xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %b" + event gen .t.f <Button> -button xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.28 {HandleEventGenerate: options <Button> -button 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %b" + event gen .t.f <Button> -button 1 + return $x +} -cleanup { + destroy .t.f +} -result 1 + +test bind-22.29 {HandleEventGenerate: options <ButtonRelease> -button 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %b" + event gen .t.f <ButtonRelease> -button 1 + return $x +} -cleanup { + destroy .t.f +} -result 1 + +test bind-22.30 {HandleEventGenerate: options <Key> -button 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -button 1 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-button" option} + +test bind-22.31 {HandleEventGenerate: options <Expose> -count xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %c" + event gen .t.f <Expose> -count xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.32 {HandleEventGenerate: options <Expose> -count 20} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %c" + event gen .t.f <Expose> -count 20 + return $x +} -cleanup { + destroy .t.f +} -result {20} + +test bind-22.33 {HandleEventGenerate: options <Key> -count 20} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %b" + event gen .t.f <Key> -count 20 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-count" option} + +test bind-22.34 {HandleEventGenerate: options <Enter> -detail xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %d" + event gen .t.f <Enter> -detail xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone} + +test bind-22.35 {HandleEventGenerate: options <FocusIn> -detail NotifyVirtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <FocusIn> "lappend x %d" + event gen .t.f <FocusIn> -detail NotifyVirtual + return $x +} -cleanup { + destroy .t.f +} -result {} + +test bind-22.36 {HandleEventGenerate: options <Enter> -detail NotifyVirtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %d" + event gen .t.f <Enter> -detail NotifyVirtual + return $x +} -cleanup { + destroy .t.f +} -result {NotifyVirtual} + +test bind-22.37 {HandleEventGenerate: options <Key> -detail NotifyVirtual} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -detail NotifyVirtual +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-detail" option} + +test bind-22.38 {HandleEventGenerate: options <Enter> -focus xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %f" + event gen .t.f <Enter> -focus xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected boolean value but got "xyz"} + +test bind-22.39 {HandleEventGenerate: options <Enter> -focus 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %f" + event gen .t.f <Enter> -focus 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.40 {HandleEventGenerate: options <Key> -focus 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -focus 1 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-focus" option} + +test bind-22.41 {HandleEventGenerate: options <Expose> -height xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %h" + event gen .t.f <Expose> -height xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.42 {HandleEventGenerate: options <Expose> -height 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %h" + event gen .t.f <Expose> -height 2i + expr {$x eq [winfo pixels .t.f 2i]} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.43 {HandleEventGenerate: options <Configure> -height 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %h" + event gen .t.f <Configure> -height 2i + expr {$x eq [winfo pixels .t.f 2i]} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.44 {HandleEventGenerate: options <Key> -height 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -height 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-height" option} + +test bind-22.45 {HandleEventGenerate: options <Key> -keycode xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -keycode xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.46 {HandleEventGenerate: options <Key> -keycode 20} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -keycode 20 + return $x +} -cleanup { + destroy .t.f +} -result {20} + +test bind-22.47 {HandleEventGenerate: options <Button> -keycode 20} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %b" + event gen .t.f <Button> -keycode 20 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Button> event doesn't accept "-keycode" option} + +test bind-22.48 {HandleEventGenerate: options <Key> -keysym xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %K" + event gen .t.f <Key> -keysym xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {unknown keysym "xyz"} + +test bind-22.49 {HandleEventGenerate: options <Key> -keysym a} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %K" + event gen .t.f <Key> -keysym a + return $x +} -cleanup { + destroy .t.f +} -result {a} + +test bind-22.50 {HandleEventGenerate: options <Button> -keysym a} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %b" + event gen .t.f <Button> -keysym a +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Button> event doesn't accept "-keysym" option} + +test bind-22.51 {HandleEventGenerate: options <Enter> -mode xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %m" + event gen .t.f <Enter> -mode xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed} + +test bind-22.52 {HandleEventGenerate: options <Enter> -mode NotifyNormal} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %m" + event gen .t.f <Enter> -mode NotifyNormal + return $x +} -cleanup { + destroy .t.f +} -result {NotifyNormal} + +test bind-22.53 {HandleEventGenerate: options <FocusIn> -mode NotifyNormal} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <FocusIn> "lappend x %m" + event gen .t.f <FocusIn> -mode NotifyNormal + return $x +} -cleanup { + destroy .t.f +} -result {} + +test bind-22.54 {HandleEventGenerate: options <Key> -mode NotifyNormal} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -mode NotifyNormal +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-mode" option} +test bind-22.55 {HandleEventGenerate: options <Map> -override xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %o" + event gen .t.f <Map> -override xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected boolean value but got "xyz"} + +test bind-22.56 {HandleEventGenerate: options <Map> -override 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %o" + event gen .t.f <Map> -override 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.57 {HandleEventGenerate: options <Reparent> -override 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Reparent> "lappend x %o" + event gen .t.f <Reparent> -override 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.58 {HandleEventGenerate: options <Configure> -override 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %o" + event gen .t.f <Configure> -override 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.59 {HandleEventGenerate: options <Key> -override 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -override 1 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-override" option} + +test bind-22.60 {HandleEventGenerate: options <Circulate> -place xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Circulate> "lappend x %p" + event gen .t.f <Circulate> -place xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom} + +test bind-22.61 {HandleEventGenerate: options <Circulate> -place PlaceOnTop} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Circulate> "lappend x %p" + event gen .t.f <Circulate> -place PlaceOnTop + return $x +} -cleanup { + destroy .t.f +} -result {PlaceOnTop} + +test bind-22.62 {HandleEventGenerate: options <Key> -place PlaceOnTop} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -place PlaceOnTop +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-place" option} + +test bind-22.63 {HandleEventGenerate: options <Key> -root .xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %R" + event gen .t.f <Key> -root .xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window path name ".xyz"} + +test bind-22.64 {HandleEventGenerate: options <Key> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %R" + event gen .t.f <Key> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.65 {HandleEventGenerate: options <Key> -root xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %R" + event gen .t.f <Key> -root xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window name/identifier "xyz"} + +test bind-22.66 {HandleEventGenerate: options <Key> -root [winfo id .t]} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %R" + event gen .t.f <Key> -root [winfo id .t] + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.67 {HandleEventGenerate: options <Button> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %R" + event gen .t.f <Button> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.68 {HandleEventGenerate: options <ButtonRelease> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %R" + event gen .t.f <ButtonRelease> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.69 {HandleEventGenerate: options <Motion> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %R" + event gen .t.f <Motion> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.70 {HandleEventGenerate: options <<Paste>> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %R" + event gen .t.f <<Paste>> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.71 {HandleEventGenerate: options <Enter> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %R" + event gen .t.f <Enter> -root .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.72 {HandleEventGenerate: options <Configure> -root .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %R" + event gen .t.f <Configure> -root .t +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-root" option} + +test bind-22.73 {HandleEventGenerate: options <Key> -rootx xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %X" + event gen .t.f <Key> -rootx xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.74 {HandleEventGenerate: options <Key> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %X" + event gen .t.f <Key> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.75 {HandleEventGenerate: options <Button> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %X" + event gen .t.f <Button> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.76 {HandleEventGenerate: options <ButtonRelease> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %X" + event gen .t.f <ButtonRelease> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.77 {HandleEventGenerate: options <Motion> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %X" + event gen .t.f <Motion> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.78 {HandleEventGenerate: options <<Paste>> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %X" + event gen .t.f <<Paste>> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.79 {HandleEventGenerate: options <Enter> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %X" + event gen .t.f <Enter> -rootx 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.80 {HandleEventGenerate: options <Configure> -rootx 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %X" + event gen .t.f <Configure> -rootx 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-rootx" option} + +test bind-22.81 {HandleEventGenerate: options <Key> -rooty xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %Y" + event gen .t.f <Key> -rooty xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.82 {HandleEventGenerate: options <Key> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %Y" + event gen .t.f <Key> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.83 {HandleEventGenerate: options <Button> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %Y" + event gen .t.f <Button> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.84 {HandleEventGenerate: options <ButtonRelease> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %Y" + event gen .t.f <ButtonRelease> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.85 {HandleEventGenerate: options <Motion> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %Y" + event gen .t.f <Motion> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.86 {HandleEventGenerate: options <<Paste>> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %Y" + event gen .t.f <<Paste>> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.87 {HandleEventGenerate: options <Enter> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %Y" + event gen .t.f <Enter> -rooty 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.88 {HandleEventGenerate: options <Configure> -rooty 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %Y" + event gen .t.f <Configure> -rooty 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-rooty" option} + +test bind-22.89 {HandleEventGenerate: options <Key> -sendevent xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %E" + event gen .t.f <Key> -sendevent xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected boolean value but got "xyz"} + +test bind-22.90 {HandleEventGenerate: options <Key> -sendevent 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %E" + event gen .t.f <Key> -sendevent 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.91 {HandleEventGenerate: options <Key> -sendevent yes} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %E" + event gen .t.f <Key> -sendevent yes + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.92 {HandleEventGenerate: options <Key> -sendevent 43} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %E" + event gen .t.f <Key> -sendevent 43 + return $x +} -cleanup { + destroy .t.f +} -result {43} + +test bind-22.93 {HandleEventGenerate: options <Key> -serial xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %#" + event gen .t.f <Key> -serial xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.94 {HandleEventGenerate: options <Key> -serial 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %#" + event gen .t.f <Key> -serial 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.95 {HandleEventGenerate: options <Key> -state xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %s" + event gen .t.f <Key> -state xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.96 {HandleEventGenerate: options <Key> -state 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %s" + event gen .t.f <Key> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.97 {HandleEventGenerate: options <Button> -state 1025} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %s" + event gen .t.f <Button> -state 1025 + return $x +} -cleanup { + destroy .t.f +} -result {1025} + +test bind-22.98 {HandleEventGenerate: options <ButtonRelease> -state 1025} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %s" + event gen .t.f <ButtonRelease> -state 1025 + return $x +} -cleanup { + destroy .t.f +} -result {1025} + +test bind-22.99 {HandleEventGenerate: options <Motion> -state 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %s" + event gen .t.f <Motion> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.100 {HandleEventGenerate: options <<Paste>> -state 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %s" + event gen .t.f <<Paste>> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.101 {HandleEventGenerate: options <Enter> -state 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %s" + event gen .t.f <Enter> -state 1 + return $x +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.102 {HandleEventGenerate: options <Visibility> -state xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Visibility> "lappend x %s" + event gen .t.f <Visibility> -state xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured} + +test bind-22.103 {HandleEventGenerate: options <Visibility> -state VisibilityUnobscured} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Visibility> "lappend x %s" + event gen .t.f <Visibility> -state VisibilityUnobscured + return $x +} -cleanup { + destroy .t.f +} -result {VisibilityUnobscured} + +test bind-22.104 {HandleEventGenerate: options <Configure> -state xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %s" + event gen .t.f <Configure> -state xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-state" option} + +test bind-22.105 {HandleEventGenerate: options <Key> -subwindow .xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %S" + event gen .t.f <Key> -subwindow .xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window path name ".xyz"} + +test bind-22.106 {HandleEventGenerate: options <Key> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %S" + event gen .t.f <Key> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.107 {HandleEventGenerate: options <Key> -subwindow xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %S" + event gen .t.f <Key> -subwindow xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window name/identifier "xyz"} + +test bind-22.108 {HandleEventGenerate: options <Key> -subwindow [winfo id .t]} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %S" + event gen .t.f <Key> -subwindow [winfo id .t] + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.109 {HandleEventGenerate: options <Button> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %S" + event gen .t.f <Button> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.110 {HandleEventGenerate: options <ButtonRelease> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %S" + event gen .t.f <ButtonRelease> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.111 {HandleEventGenerate: options <Motion> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %S" + event gen .t.f <Motion> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.112 {HandleEventGenerate: options <<Paste>> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %S" + event gen .t.f <<Paste>> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.113 {HandleEventGenerate: options <Enter> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %S" + event gen .t.f <Enter> -subwindow .t + expr {[winfo id .t] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.114 {HandleEventGenerate: options <Configure> -subwindow .t} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %S" + event gen .t.f <Configure> -subwindow .t +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-subwindow" option} + +test bind-22.115 {HandleEventGenerate: options <Key> -time xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %t" + event gen .t.f <Key> -time xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {expected integer but got "xyz"} + +test bind-22.116 {HandleEventGenerate: options <Key> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %t" + event gen .t.f <Key> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.117 {HandleEventGenerate: options <Button> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %t" + event gen .t.f <Button> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.118 {HandleEventGenerate: options <ButtonRelease> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %t" + event gen .t.f <ButtonRelease> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.119 {HandleEventGenerate: options <Motion> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %t" + event gen .t.f <Motion> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.120 {HandleEventGenerate: options <<Paste>> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %t" + event gen .t.f <<Paste>> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.121 {HandleEventGenerate: options <Enter> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %t" + event gen .t.f <Enter> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.122 {HandleEventGenerate: options <Property> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Property> "lappend x %t" + event gen .t.f <Property> -time 100 + return $x +} -cleanup { + destroy .t.f +} -result {100} + +test bind-22.123 {HandleEventGenerate: options <Configure> -time 100} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %t" + event gen .t.f <Configure> -time 100 +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Configure> event doesn't accept "-time" option} + +test bind-22.124 {HandleEventGenerate: options <Expose> -width xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %w" + event gen .t.f <Expose> -width xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.125 {HandleEventGenerate: options <Expose> -width 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %w" + event gen .t.f <Expose> -width 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.126 {HandleEventGenerate: options <Configure> -width 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %w" + event gen .t.f <Configure> -width 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.127 {HandleEventGenerate: options <Key> -width 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -width 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-width" option} + +test bind-22.128 {HandleEventGenerate: options <Unmap> -window .xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event gen .t.f <Unmap> -window .xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window path name ".xyz"} + +test bind-22.129 {HandleEventGenerate: options <Unmap> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event gen .t.f <Unmap> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.130 {HandleEventGenerate: options <Unmap> -window xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event gen .t.f <Unmap> -window xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad window name/identifier "xyz"} + +test bind-22.131 {HandleEventGenerate: options <Unmap> -window [winfo id .t.f]} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event gen .t.f <Unmap> -window [winfo id .t.f] + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.132 {HandleEventGenerate: options <Unmap> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Unmap> "lappend x %W" + event gen .t.f <Unmap> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.133 {HandleEventGenerate: options <Map> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %W" + event gen .t.f <Map> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.134 {HandleEventGenerate: options <Reparent> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Reparent> "lappend x %W" + event gen .t.f <Reparent> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.135 {HandleEventGenerate: options <Configure> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %W" + event gen .t.f <Configure> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.136 {HandleEventGenerate: options <Gravity> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Gravity> "lappend x %W" + event gen .t.f <Gravity> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.137 {HandleEventGenerate: options <Circulate> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Circulate> "lappend x %W" + event gen .t.f <Circulate> -window .t.f + return $x +} -cleanup { + destroy .t.f +} -result {.t.f} + +test bind-22.138 {HandleEventGenerate: options <Key> -window .t.f} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %W" + event gen .t.f <Key> -window .t.f +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Key> event doesn't accept "-window" option} + +test bind-22.139 {HandleEventGenerate: options <Key> -x xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %x" + event gen .t.f <Key> -x xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.140 {HandleEventGenerate: options <Key> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %x" + event gen .t.f <Key> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.141 {HandleEventGenerate: options <Button> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %x" + event gen .t.f <Button> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.142 {HandleEventGenerate: options <ButtonRelease> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %x" + event gen .t.f <ButtonRelease> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.143 {HandleEventGenerate: options <Motion> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %x" + event gen .t.f <Motion> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.144 {HandleEventGenerate: options <<Paste>> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %x" + event gen .t.f <<Paste>> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.145 {HandleEventGenerate: options <Enter> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %x" + event gen .t.f <Enter> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.146 {HandleEventGenerate: options <Expose> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %x" + event gen .t.f <Expose> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.147 {HandleEventGenerate: options <Configure> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %x" + event gen .t.f <Configure> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.148 {HandleEventGenerate: options <Gravity> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Gravity> "lappend x %x" + event gen .t.f <Gravity> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.149 {HandleEventGenerate: options <Reparent> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Reparent> "lappend x %x" + event gen .t.f <Reparent> -x 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.150 {HandleEventGenerate: options <Map> -x 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %x" + event gen .t.f <Map> -x 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Map> event doesn't accept "-x" option} + +test bind-22.151 {HandleEventGenerate: options <Key> -y xyz} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %y" + event gen .t.f <Key> -y xyz +} -cleanup { + destroy .t.f +} -returnCodes error -result {bad screen distance "xyz"} + +test bind-22.152 {HandleEventGenerate: options <Key> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %y" + event gen .t.f <Key> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.153 {HandleEventGenerate: options <Button> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button> "lappend x %y" + event gen .t.f <Button> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.154 {HandleEventGenerate: options <ButtonRelease> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <ButtonRelease> "lappend x %y" + event gen .t.f <ButtonRelease> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.155 {HandleEventGenerate: options <Motion> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Motion> "lappend x %y" + event gen .t.f <Motion> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.156 {HandleEventGenerate: options <<Paste>> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> "lappend x %y" + event gen .t.f <<Paste>> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.157 {HandleEventGenerate: options <Enter> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Enter> "lappend x %y" + event gen .t.f <Enter> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.158 {HandleEventGenerate: options <Expose> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Expose> "lappend x %y" + event gen .t.f <Expose> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.159 {HandleEventGenerate: options <Configure> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Configure> "lappend x %y" + event gen .t.f <Configure> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.160 {HandleEventGenerate: options <Gravity> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Gravity> "lappend x %y" + event gen .t.f <Gravity> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.161 {HandleEventGenerate: options <Reparent> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Reparent> "lappend x %y" + event gen .t.f <Reparent> -y 2i + expr {[winfo pixels .t.f 2i] eq $x} +} -cleanup { + destroy .t.f +} -result {1} + +test bind-22.162 {HandleEventGenerate: options <Map> -y 2i} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Map> "lappend x %y" + event gen .t.f <Map> -y 2i +} -cleanup { + destroy .t.f +} -returnCodes error -result {<Map> event doesn't accept "-y" option} + +test bind-22.163 {HandleEventGenerate: options <Key> -xyz 1} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key> "lappend x %k" + event gen .t.f <Key> -xyz 1 +} -cleanup { + destroy .t.f +} -returnCodes error -result {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} # 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} { + +test bind-23.1 {GetVirtualEventUid procedure} -body { + event info <<asd +} -returnCodes error -result {virtual event "<<asd" is badly formed} +test bind-23.2 {GetVirtualEventUid procedure} -body { + event info <<>> +} -returnCodes error -result {virtual event "<<>>" is badly formed} +test bind-23.3 {GetVirtualEventUid procedure} -body { + event info <<asd> +} -returnCodes error -result {virtual event "<<asd>" is badly formed} +test bind-23.4 {GetVirtualEventUid procedure} -setup { + event delete <<asd>> +} -body { 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} +} -result {} + + +test bind-24.1 {FindSequence procedure: no event} -body { + bind .t {} test +} -returnCodes error -result {no events specified in binding} +test bind-24.2 {FindSequence procedure: bad event} -body { + bind .t <xyz> test +} -returnCodes error -result {bad event type or keysym "xyz"} +test bind-24.3 {FindSequence procedure: virtual allowed} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <<Paste>> test +} -cleanup { + destroy .t.f +} -result {} +test bind-24.4 {FindSequence procedure: virtual not allowed} -body { + event add <<Paste>> <<Alive>> +} -returnCodes error -result {virtual event not allowed in definition of another virtual event} +test bind-24.5 {FindSequence procedure, multiple bindings} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <1> {lappend x single} + bind .t.f <Double-1> {lappend x double} + bind .t.f <Triple-1> {lappend x triple} + bind .t.f <Quadruple-1> {lappend x quadruple} set x press - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> lappend x press - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> lappend x press - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> lappend x press - event gen .b.f <Button-1> - event gen .b.f <ButtonRelease-1> + event gen .t.f <Button-1> + event gen .t.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 {}} + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + set x +} -cleanup { + destroy .t.f +} -result {press single press double press triple press quadruple press quadruple} +test bind-24.6 {FindSequence procedure: virtual composed} -body { + bind .t <Control-b><<Paste>> "puts hi" +} -returnCodes error -result {virtual events may not be composed} +test bind-24.7 {FindSequence procedure: new pattern sequence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-1><Button-2> {lappend x 1-2} + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {1-2} +test bind-24.8 {FindSequence procedure: similar pattern sequence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-1><Button-2> {lappend x 1-2} + bind .t.f <Button-2> {lappend x 2} + event gen .t.f <Button-3> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {2 1-2} +test bind-24.9 {FindSequence procedure: similar pattern sequence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-1><Button-2> {lappend x 1-2} + bind .t.f <Button-2><Button-2> {lappend x 2-2} + event gen .t.f <Button-3> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {2-2 1-2} +test bind-24.10 {FindSequence procedure: similar pattern sequence} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Button-2><Button-2> {lappend x 2-2} + bind .t.f <Double-Button-2> {lappend x d-2} + event gen .t.f <Button-3> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + event gen .t.f <Button-2> -x 100 + event gen .t.f <ButtonRelease-2> + event gen .t.f <Button-2> -x 200 + event gen .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {d-2 2-2} +test bind-24.11 {FindSequence procedure: new sequence, don't create} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-2> +} -cleanup { + destroy .t.f +} -result {} +test bind-24.12 {FindSequence procedure: not new sequence, don't create} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Control-Button-2> "foo" + bind .t.f <Button-2> +} -cleanup { + destroy .t.f +} -result {} +test bind-24.13 {FindSequence procedure: no binding} -body { + frame .t.f -class Test -width 150 -height 100 + bind .t.f <a> +} -cleanup { + destroy .t.f +} -returnCodes ok +test bind-24.14 {FindSequence procedure: no binding} -body { + canvas .t.c + set i [.t.c create rect 10 10 100 100] + .t.c bind $i <a> +} -cleanup { + destroy .t.c +} -returnCodes ok test bind-25.1 {ParseEventDescription procedure} -setup { - setup + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update } -body { - bind .b.f a test - bind .b.f a + bind .t.f a test + bind .t.f a +} -cleanup { + destroy .t.f } -result test test bind-25.2 {ParseEventDescription procedure: misinterpreted modifier} -setup { - button .x + button .b } -body { - bind .x <Control-M> a - bind .x <M-M> b - lsort [bind .x] + bind .b <Control-M> a + bind .b <M-M> b + lsort [bind .b] } -cleanup { - destroy .x + destroy .b } -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 + frame .t.f -class Test -width 150 -height 100 } -body { - bind .b.f <a---> {nothing} - bind .b.f + bind .t.f <a---> {nothing} + bind .t.f +} -cleanup { + destroy .t.f } -result a -test bind-25.4 {ParseEventDescription} -setup { - setup -} -body { - bind .b <<Shift-Paste>> {puts hi} - bind .b +test bind-25.4 {ParseEventDescription} -body { + bind .t <<Shift-Paste>> {puts hi} + bind .t } -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 { +# previously -run with foreach +test bind-25.5 {ParseEventDescription procedure error cases} -body { + bind .t \x7 {puts hi} +} -returnCodes error -result {bad ASCII character 0x7} +test bind-25.6 {ParseEventDescription procedure error cases} -body { + bind .t \x7f {puts hi} +} -returnCodes error -result {bad ASCII character 0x7f} +test bind-25.7 {ParseEventDescription procedure error cases} -body { + bind .t \x4 {puts hi} +} -returnCodes error -result {bad ASCII character 0x4} +test bind-25.8 {ParseEventDescription procedure error cases} -body { + bind .t <<>> {puts hi} +} -returnCodes error -result {virtual event "<<>>" is badly formed} +test bind-25.9 {ParseEventDescription procedure error cases} -body { + bind .t <<Paste {puts hi} +} -returnCodes error -result {missing ">" in virtual binding} +test bind-25.10 {ParseEventDescription procedure error cases} -body { + bind .t <<Paste> {puts hi} +} -returnCodes error -result {missing ">" in virtual binding} +test bind-25.11 {ParseEventDescription procedure error cases} -body { + bind .t <<Paste>>h {puts hi} +} -returnCodes error -result {virtual events may not be composed} +test bind-25.12 {ParseEventDescription procedure error cases} -body { + bind .t <> {puts hi} +} -returnCodes error -result {no event type or button # or keysym} +test bind-25.13 {ParseEventDescription procedure error cases} -body { + bind .t <a-- {puts hi} +} -returnCodes error -result {missing ">" in binding} +test bind-25.14 {ParseEventDescription procedure error cases} -body { + bind .t <a-b> {puts hi} +} -returnCodes error -result {extra characters after detail in binding} +test bind-25.15 {ParseEventDescription procedure error cases} -body { + bind .t <<abc {puts hi} +} -returnCodes error -result {missing ">" in virtual binding} +test bind-25.16 {ParseEventDescription procedure error cases} -body { + bind .t <<abc> {puts hi} +} -returnCodes error -result {missing ">" in virtual binding} +test bind-25.17 {ParseEventDescription} -body { event add <<xyz>> <<abc>> -} -result {virtual event not allowed in definition of another virtual event} +} -returnCodes error -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}" +test bind-25.18 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f {<Control- a>} foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Control-Key-a> + +test bind-25.19 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Shift-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Shift-Key-a> + +test bind-25.20 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Lock-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Lock-Key-a> + +test bind-25.21 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Meta---a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Meta-Key-a> + +test bind-25.22 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Meta-Key-a> + +test bind-25.23 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Alt-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Alt-Key-a> + +test bind-25.24 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B1-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B1-Key-a> + +test bind-25.25 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B2-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B2-Key-a> + +test bind-25.26 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B3-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B3-Key-a> + +test bind-25.27 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B4-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B4-Key-a> + +test bind-25.28 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <B5-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B5-Key-a> + +test bind-25.29 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button1-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B1-Key-a> + +test bind-25.30 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button2-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B2-Key-a> + +test bind-25.31 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button3-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B3-Key-a> + +test bind-25.32 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button4-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B4-Key-a> + +test bind-25.33 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button5-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B5-Key-a> + +test bind-25.34 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M1-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod1-Key-a> + +test bind-25.35 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M2-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod2-Key-a> + +test bind-25.36 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M3-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod3-Key-a> + +test bind-25.37 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M4-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod4-Key-a> + +test bind-25.38 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <M5-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod5-Key-a> + +test bind-25.39 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod1-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod1-Key-a> + +test bind-25.40 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod2-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod2-Key-a> + +test bind-25.41 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod3-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod3-Key-a> + +test bind-25.42 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod4-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod4-Key-a> + +test bind-25.43 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Mod5-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Mod5-Key-a> + +test bind-25.44 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Double-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Double-Key-a> + +test bind-25.45 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Triple-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Triple-Key-a> + +test bind-25.46 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f {<Double 1>} foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Double-Button-1> + +test bind-25.47 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Triple-1> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Triple-Button-1> + +test bind-25.48 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f {<M1-M2 M3-M4 B1-Control-a>} foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a> + +test bind-25.49 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Extended-Return> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <Extended-Key-Return> + + + +test bind-26.1 {event names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <FocusIn> {nothing} + bind .t.f +} -cleanup { + destroy .t.f +} -result <FocusIn> +test bind-26.2 {event names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <FocusOut> {nothing} + bind .t.f +} -cleanup { + destroy .t.f +} -result <FocusOut> +test bind-26.3 {event names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Destroy> {lappend x "destroyed"} + set x [bind .t.f] + destroy .t.f + set x +} -cleanup { + destroy .t.f +} -result {<Destroy> destroyed} + +# previously -run with foreach +test bind-26.4 {event names: Motion} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Motion> "set x {event Motion}" set x xyzzy - event gen .b.f <$event> - list $x [bind .b.f] - } [list "event $event" <$canonicalEvent>] -} + event gen .t.f <Motion> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Motion} <Motion>} + +test bind-26.5 {event names: Button} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> "set x {event Button}" + set x xyzzy + event gen .t.f <Button> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Button} <Button>} + +test bind-26.6 {event names: ButtonPress} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <ButtonPress> "set x {event ButtonPress}" + set x xyzzy + event gen .t.f <ButtonPress> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event ButtonPress} <Button>} + +test bind-26.7 {event names: ButtonRelease} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <ButtonRelease> "set x {event ButtonRelease}" + set x xyzzy + event gen .t.f <ButtonRelease> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event ButtonRelease} <ButtonRelease>} + +test bind-26.8 {event names: Colormap} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Colormap> "set x {event Colormap}" + set x xyzzy + event gen .t.f <Colormap> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Colormap} <Colormap>} + +test bind-26.9 {event names: Enter} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Enter> "set x {event Enter}" + set x xyzzy + event gen .t.f <Enter> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Enter} <Enter>} + +test bind-26.10 {event names: Leave} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Leave> "set x {event Leave}" + set x xyzzy + event gen .t.f <Leave> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Leave} <Leave>} + +test bind-26.11 {event names: Expose} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Expose> "set x {event Expose}" + set x xyzzy + event gen .t.f <Expose> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Expose} <Expose>} + +test bind-26.12 {event names: Key} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key> "set x {event Key}" + set x xyzzy + event gen .t.f <Key> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Key} <Key>} + +test bind-26.13 {event names: KeyPress} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyPress> "set x {event KeyPress}" + set x xyzzy + event gen .t.f <KeyPress> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event KeyPress} <Key>} + +test bind-26.14 {event names: KeyRelease} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <KeyRelease> "set x {event KeyRelease}" + set x xyzzy + event gen .t.f <KeyRelease> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event KeyRelease} <KeyRelease>} + +test bind-26.15 {event names: Property} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Property> "set x {event Property}" + set x xyzzy + event gen .t.f <Property> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Property} <Property>} + +test bind-26.16 {event names: Visibility} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Visibility> "set x {event Visibility}" + set x xyzzy + event gen .t.f <Visibility> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Visibility} <Visibility>} + +test bind-26.17 {event names: Activate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Activate> "set x {event Activate}" + set x xyzzy + event gen .t.f <Activate> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Activate} <Activate>} + +test bind-26.18 {event names: Deactivate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Deactivate> "set x {event Deactivate}" + set x xyzzy + event gen .t.f <Deactivate> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Deactivate} <Deactivate>} + + # 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}" +package require tcltest 2.1 +eval tcltest::configure $argv +tcltest::loadTestedCommands +tk useinputmethods 0 + +toplevel .t -width 100 -height 50 +wm geom .t +0+0 +update idletasks +test bind-26.19 {event names: Circulate} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Circulate> "set x {event Circulate}" set x xyzzy - event gen .b.f <$event> -window .b.f - list $x [bind .b.f] - } [list "event $event" <$canonicalEvent>] -} + event gen .t.f <Circulate> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Circulate} <Circulate>} -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-26.20 {event names: Configure} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Configure> "set x {event Configure}" + set x xyzzy + event gen .t.f <Configure> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Configure} <Configure>} -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 +test bind-26.21 {event names: Gravity} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Gravity> "set x {event Gravity}" + set x xyzzy + event gen .t.f <Gravity> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Gravity} <Gravity>} + +test bind-26.22 {event names: Map} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Map> "set x {event Map}" + set x xyzzy + event gen .t.f <Map> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Map} <Map>} + +test bind-26.23 {event names: Reparent} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Reparent> "set x {event Reparent}" + set x xyzzy + event gen .t.f <Reparent> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Reparent} <Reparent>} + +test bind-26.24 {event names: Unmap} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Unmap> "set x {event Unmap}" + set x xyzzy + event gen .t.f <Unmap> + list $x [bind .t.f] +} -cleanup { + destroy .t.f +} -result {{event Unmap} <Unmap>} + + +test bind-27.1 {button names} -body { + bind .t <Expose-1> foo +} -returnCodes error -result {specified button "1" for non-button event} +test bind-27.2 {button names} -body { + bind .t <Button-6> foo +} -returnCodes error -result {specified keysym "6" for non-key event} +test bind-27.3 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-1> {lappend x "button 1"} + set x [bind .t.f] + event gen .t.f <Button-1> + event gen .t.f <ButtonRelease-1> + set x +} -cleanup { + destroy .t.f +} -result {<Button-1> {button 1}} +test bind-27.4 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-2> {lappend x "button 2"} + set x [bind .t.f] + event gen .t.f <Button-2> + event gen .t.f <ButtonRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {<Button-2> {button 2}} +test bind-27.5 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-3> {lappend x "button 3"} + set x [bind .t.f] + event gen .t.f <Button-3> + event gen .t.f <ButtonRelease-3> + set x +} -cleanup { + destroy .t.f +} -result {<Button-3> {button 3}} +test bind-27.6 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-4> {lappend x "button 4"} + set x [bind .t.f] + event gen .t.f <Button-4> + event gen .t.f <ButtonRelease-4> + set x +} -cleanup { + destroy .t.f +} -result {<Button-4> {button 4}} +test bind-27.7 {button names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button-5> {lappend x "button 5"} + set x [bind .t.f] + event gen .t.f <Button-5> + event gen .t.f <ButtonRelease-5> + set x +} -cleanup { + destroy .t.f +} -result {<Button-5> {button 5}} + +test bind-28.1 {keysym names} -body { + bind .t <Expose-a> foo +} -returnCodes error -result {specified keysym "a" for non-key event} +test bind-28.2 {keysym names} -body { + bind .t <Gorp> foo +} -returnCodes error -result {bad event type or keysym "Gorp"} +test bind-28.3 {keysym names} -body { + bind .t <Key-Stupid> foo +} -returnCodes error -result {bad event type or keysym "Stupid"} +test bind-28.4 {keysym names} -body { + frame .t.f -class Test -width 150 -height 100 + bind .t.f <a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result {a} + + +test bind-28.5 {keysym names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key-a> "lappend x \"keysym a\"" + bind .t.f <Key-x> "lappend x {bad binding match}" + set x [lsort [bind .t.f]] + event gen .t.f <Key-a> -state 0 set x - } $result -} +} -cleanup { + destroy .t.f +} -result {a x {keysym a}} +test bind-28.6 {keysym names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key-Return> "lappend x \"keysym Return\"" + bind .t.f <Key-x> "lappend x {bad binding match}" + set x [lsort [bind .t.f]] + event gen .t.f <Key-Return> -state 0 + set x +} -cleanup { + destroy .t.f +} -result {<Key-Return> x {keysym Return}} +test bind-28.7 {keysym names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key-X> "lappend x \"keysym X\"" + bind .t.f <Key-x> "lappend x {bad binding match}" + set x [lsort [bind .t.f]] + event gen .t.f <Key-X> -state 1 + set x +} -cleanup { + destroy .t.f +} -result {X x {keysym X}} +test bind-28.8 {keysym names} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Key-X> "lappend x \"keysym X\"" + bind .t.f <Key-x> "lappend x {bad binding match}" + set x [lsort [bind .t.f]] + event gen .t.f <Key-X> -state 1 + set x +} -cleanup { + destroy .t.f +} -result {X x {keysym X}} -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"} +# test bind-29.1 {dummy test to help ensure proper numbering} -body {} + +#test bind-29.2-6 {GetKeySym procedure} -setup { ;#nonP +# frame .t.f -class Test -width 150 -height 100 +# pack .t.f +# focus -force .t.f +# update +#} -body { +# set x nothing +# event gen .t.f <KeyPress> -keysym a -state 0 +# set x +#} -cleanup { +# destroy .t.f +#} -result {a} + +test bind-29.1 {Tk_BackgroundError procedure} -setup { + proc bgerror msg { + global x errorInfo + set x [list $msg $errorInfo] + } + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {error "This is a test"} set x none - event gen .b.f <Button> - event gen .b.f <ButtonRelease> + event gen .t.f <Button> + event gen .t.f <ButtonRelease> update set x -} {{This is a test} {This is a test +} -cleanup { + destroy .t.f + rename bgerror {} +} -result {{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} { + +test bind-29.2 {Tk_BackgroundError procedure} -setup { proc do {} { - event gen .b.f <Button> - event gen .b.f <ButtonRelease> + event gen .t.f <Button> + event gen .t.f <ButtonRelease> } - setup - bind .b.f <Button> {error Message2} + proc bgerror msg { + global x errorInfo + set x [list $msg $errorInfo] + } + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { + bind .t.f <Button> {error Message2} set x none do update set x -} {Message2 {Message2 +} -cleanup { + destroy .t.f + rename bgerror {} + rename do {} +} -result {Message2 {Message2 while executing "error Message2" (command bound to event)}} -rename bgerror {} -test bind-31.1 {MouseWheel events} { - setup + +test bind-30.1 {MouseWheel events} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <MouseWheel> {set x Wheel} - event gen .b.f <MouseWheel> +} -body { + bind .t.f <MouseWheel> {set x Wheel} + event gen .t.f <MouseWheel> set x -} {Wheel} -test bind-31.2 {MouseWheel events} { - setup +} -cleanup { + destroy .t.f +} -result {Wheel} +test bind-30.2 {MouseWheel events} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <MouseWheel> {set x %D} - event gen .b.f <MouseWheel> -delta 120 +} -body { + bind .t.f <MouseWheel> {set x %D} + event gen .t.f <MouseWheel> -delta 120 set x -} {120} -test bind-31.3 {MouseWheel events} { - setup +} -cleanup { + destroy .t.f +} -result {120} +test bind-30.3 {MouseWheel events} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <MouseWheel> {set x "%D %x %y"} - event gen .b.f <MouseWheel> -delta 240 -x 10 -y 30 +} -body { + bind .t.f <MouseWheel> {set x "%D %x %y"} + event gen .t.f <MouseWheel> -delta 240 -x 10 -y 30 set x -} {240 10 30} +} -cleanup { + destroy .t.f +} -result {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 +test bind-31.1 {virtual event user_data field - bad generation} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update +} -body { +# Check no confusion, since Focus events use %d for something else + event gen .t.f <FocusIn> -data foo +} -cleanup { + destroy .t.f +} -returnCodes error -result {<FocusIn> event doesn't accept "-data" option} +test bind-31.2 {virtual event user_data field - NULL, synch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event gen .t.f <<TestUserData>> set x -} {TestUserData >{}<} -test bind-32.3 {virtual event user_data field - shared, synch} { - setup +} -cleanup { + destroy .t.f +} -result {TestUserData >{}<} +test bind-31.3 {virtual event user_data field - shared, synch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -data "foo bar" +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event gen .t.f <<TestUserData>> -data "foo bar" set x -} {TestUserData >foo bar<} -test bind-32.4 {virtual event user_data field - unshared, synch} { - setup +} -cleanup { + destroy .t.f +} -result {TestUserData >foo bar<} +test bind-31.4 {virtual event user_data field - unshared, synch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -data [string index abc 1] +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event gen .t.f <<TestUserData>> -data [string index abc 1] set x -} {TestUserData >b<} +} -cleanup { + destroy .t.f +} -result {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 +test bind-31.5 {virtual event user_data field - NULL, asynch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -when head +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event gen .t.f <<TestUserData>> -when head list $x [update] $x -} {{} {} {TestUserData >{}<}} -test bind-32.6 {virtual event user_data field - shared, asynch} { - setup +} -cleanup { + destroy .t.f +} -result {{} {} {TestUserData >{}<}} +test bind-31.6 {virtual event user_data field - shared, asynch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -data "foo bar" -when head +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event gen .t.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 +} -cleanup { + destroy .t.f +} -result {{} {} {TestUserData >foo bar<}} +test bind-31.7 {virtual event user_data field - unshared, asynch} -setup { + frame .t.f -class Test -width 150 -height 100 + pack .t.f + focus -force .t.f + update set x {} - bind .b.f <<TestUserData>> {set x "TestUserData >%d<"} - event gen .b.f <<TestUserData>> -data [string index abc 1] -when head +} -body { + bind .t.f <<TestUserData>> {set x "TestUserData >%d<"} + event gen .t.f <<TestUserData>> -data [string index abc 1] -when head list $x [update] $x -} {{} {} {TestUserData >b<}} +} -cleanup { + destroy .t.f +} -result {{} {} {TestUserData >b<}} + -destroy .b +destroy .t # cleanup cleanupTests @@ -2752,3 +6410,11 @@ return # Local Variables: # mode: tcl # End: + + + + + + + + |