summaryrefslogtreecommitdiffstats
path: root/tests/bind.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/bind.test')
-rw-r--r--tests/bind.test7994
1 files changed, 5652 insertions, 2342 deletions
diff --git a/tests/bind.test b/tests/bind.test
index 7e0257c..a4d8d6b 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -7,2743 +7,6053 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: bind.test,v 1.19 2007/05/16 15:23:44 dgp Exp $
+# RCS: @(#) $Id: bind.test,v 1.28 2010/06/19 16:18:41 jenglish Exp $
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
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 generate .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 generate .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 generate .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 generate .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 {
- catch {interp delete foo}
- interp create foo
- foo eval {
- load {} Tk
- tk useinputmethods 0
- load {} Tktest
- wm geometry . +0+0
- frame .t -width 50 -height 50
- bindtags .t {a b c d}
- pack .t
- update
- set x {}
- testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1"
- bind b <1> "lappend x b1"
- testcbind c <1> "lappend x c1" "lappend x bye.c1"
- testcbind c <2> "lappend x all2" "lappend x bye.all2"
- event gen .t <1>
- }
- set x [foo eval set x]
- interp delete foo
- set x
-} {a1 bye.all2 bye.a1 b1 bye.c1}
-
-test bind-7.1 {Tk_CreateBinding procedure: bad binding} {
- catch {destroy .b.c}
- canvas .b.c
- list [catch {.b.c bind foo <} msg] $msg
-} {1 {no event type or button # or keysym}}
-test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} testcbind {
- catch {destroy .b.f}
- frame .b.f
- testcbind .b.f <1> "xyz" "lappend x bye.1"
- set x {}
- bind .b.f <1> "abc"
- destroy .b.f
- set x
-} {bye.1}
-test bind-7.3 {Tk_CreateBinding procedure: append} {
- catch {destroy .b.c}
- canvas .b.c
- .b.c bind foo <1> "button 1"
- .b.c bind foo <1> "+more button 1"
- .b.c bind foo <1>
-} {button 1
+ 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 generate .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-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.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"
- set x {}
- event gen .b.f <1>
- bind .b.f <1> {}
- set x
-} {.b.f Frame}
-
-test bind-9.1 {Tk_DeleteBinding procedure} {
- catch {destroy .b.f}
- frame .b.f -class Test -width 150 -height 100
- list [catch {bind .b.f <} msg] $msg
-} {0 {}}
-test bind-9.2 {Tk_DeleteBinding procedure} {
- catch {destroy .b.f}
- frame .b.f -class Test -width 150 -height 100
+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 {Tk_CreateBinding: error} -body {
+ bind . <xyz> "xyz"
+} -returnCodes error -result {bad event type or keysym "xyz"}
+
+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}
- testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1}
- bind b <1> {lappend x b1}
- testcbind c <1> {lappend x c1} {lappend x bye.c1}
- testcbind c <2> {lappend x c2} {lappend x bye.c2}
- set x {}
- event gen .b.f <1>
- bind a <1> {}
- bind b <1> {}
- set x
-} {a1 bye.c2 b1 bye.c1 bye.a1}
-
-test bind-10.1 {Tk_GetBinding procedure} {
- catch {destroy .b.c}
- canvas .b.c
- list [catch {.b.c bind foo <} msg] $msg
-} {1 {no event type or button # or keysym}}
-test bind-10.2 {Tk_GetBinding procedure} {
- catch {destroy .b.c}
- canvas .b.c
- .b.c bind foo a Test
- .b.c bind foo a
-} {Test}
-test bind-10.3 {Tk_GetBinding procedure: C binding} testcbind {
- catch {destroy .b.f}
- frame .b.f
- testcbind .b.f <1> "foo"
- list [bind .b.f] [bind .b.f <1>]
-} {<Button-1> {}}
-
-test bind-11.1 {Tk_GetAllBindings procedure} {
- catch {destroy .b.f}
- frame .b.f -class Test -width 150 -height 100
+ 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-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-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-13.1 {Tk_BindEvent procedure} -setup {
+ frame .t.f -class Test -width 150 -height 100
+ pack .t.f
+ focus -force .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 {
+ bind Test <KeyPress> {lappend x "%W %K Test KeyPress"}
+ bind all <KeyPress> {lappend x "%W %K all KeyPress"}
+ bind Test : {lappend x "%W %K Test :"}
+ bind all _ {lappend x "%W %K all _"}
+ bind .t.f : {lappend x "%W %K .t.f :"}
+
+ event generate .t.f <Key-colon>
+ event generate .t.f <Key-plus>
+ event generate .t.f <Key-underscore>
+ return $x
+} -cleanup {
+ destroy .t.f
+ bind all <KeyPress> {}
+ bind Test <KeyPress> {}
+ bind all _ {}
+ bind Test : {}
+} -result {{.t.f colon .t.f :} {.t.f colon Test :} {.t.f colon all KeyPress} {.t.f plus Test KeyPress} {.t.f plus all KeyPress} {.t.f underscore Test KeyPress} {.t.f underscore all _}}
-test bind-13.1 {Tk_BindEvent procedure} {
- setup
- bind .b.f a {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-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"; break}
+ bind all <KeyPress> {continue; lappend x "%W %K all press any"}
+ bind .t.f : {lappend x "%W %K .t.f pressed colon"}
+
+ event generate .t.f <Key-colon>
+ return $x
+} -cleanup {
+ destroy .t.f
+ bind all <KeyPress> {}
+ bind Test <KeyPress> {}
+} -result {{.t.f colon .t.f pressed colon} {.t.f colon Test press any}}
-test bind-13.2 {Tk_BindEvent procedure} {
- setup
- bind .b.f b {lappend x "%W %K .b.f press a"}
- set x {}
- event gen .b.f <Key-b>
- set x
-} {{.b.f b .b.f press a} {.b.f b Test press any}}
-if {[info procs bgerror] == "bgerror"} {
- rename bgerror {}
-}
-proc bgerror args {}
-bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test}
-test bind-13.3 {Tk_BindEvent procedure} {
- setup
- bind .b.f b {lappend x "%W %K .b.f press a"}
+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 : {lappend x "%W %K .t.f pressed colon"}
+ event generate .t.f <Key-colon>
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 colon .t.f pressed colon} {.t.f colon 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 generate .t.f <Key-colon>
}
- 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 : {lappend x "%W %K Test"}
+ bind .t.f : {lappend x "%W %K .t.f"}
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 : {}
+} -result {{.t.f colon .t.f} {.t.f colon Test}}
+
+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)"}
- set x {}
- event gen .b.f <Key-z>
- bind Test z {}
- bind all z {}
- set x
-} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
-test bind-13.7 {Tk_BindEvent procedure} {
- setup
- bind .b.f z {lappend x "%W z (.b.f binding)"}
- bind Test z {lappend x "%W z (.b.f binding)"}
- bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"}
- set x {}
- event gen .b.f <Key-z>
- bind Test z {}
- bind all z {}
- set x
-} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
-test bind-13.8 {Tk_BindEvent procedure} {
- setup
- bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"}
- bind .b.f <ButtonPress> {lappend x "%W z (.b.f <ButtonPress> binding)"}
- set x {}
- event gen .b.f <Button-1>
- event gen .b.f <Button-2>
- set x
-} {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f <ButtonPress> binding)}}
-test bind-13.9 {Tk_BindEvent procedure: ignore NotifyInferior} {
- setup
- bind .b.f <Enter> "lappend x Enter%#"
- bind .b.f <Leave> "lappend x Leave%#"
- set x {}
- event gen .b.f <Enter> -serial 100 -detail NotifyAncestor
- event gen .b.f <Enter> -serial 101 -detail NotifyInferior
- event gen .b.f <Leave> -serial 102 -detail NotifyAncestor
- event gen .b.f <Leave> -serial 103 -detail NotifyInferior
- set x
-} {Enter100 Leave102}
-test bind-13.10 {Tk_BindEvent procedure: collapse Motions} {
- setup
- bind .b.f <Motion> "lappend x Motion%#(%x,%y)"
- set x {}
- event gen .b.f <Motion> -serial 100 -x 100 -y 200 -when tail
- update
- event gen .b.f <Motion> -serial 101 -x 200 -y 300 -when tail
- event gen .b.f <Motion> -serial 102 -x 300 -y 400 -when tail
- update
- set x
-} {Motion100(100,200) Motion102(300,400)}
-test bind-13.11 {Tk_BindEvent procedure: collapse repeating modifiers} {
- setup
- bind .b.f <Key> "lappend x %K%#"
- bind .b.f <KeyRelease> "lappend x %K%#"
- event gen .b.f <Key-Shift_L> -serial 100 -when tail
- event gen .b.f <KeyRelease-Shift_L> -serial 101 -when tail
- event gen .b.f <Key-Shift_L> -serial 102 -when tail
- event gen .b.f <KeyRelease-Shift_L> -serial 103 -when tail
- update
-} {}
-test bind-13.12 {Tk_BindEvent procedure: valid key detail} {
- setup
- bind .b.f <Key> "lappend x Key%K"
- bind .b.f <KeyRelease> "lappend x Release%K"
- set x {}
- event gen .b.f <Key> -keysym a
- event gen .b.f <KeyRelease> -keysym a
- set x
-} {Keya Releasea}
-test bind-13.13 {Tk_BindEvent procedure: invalid key detail} {
- setup
- bind .b.f <Key> "lappend x Key%K"
- bind .b.f <KeyRelease> "lappend x Release%K"
- set x {}
- event gen .b.f <Key> -keycode 0
- event gen .b.f <KeyRelease> -keycode 0
- set x
-} {Key?? Release??}
-test bind-13.14 {Tk_BindEvent procedure: button detail} {
- setup
- bind .b.f <Button> "lappend x Button%b"
- bind .b.f <ButtonRelease> "lappend x Release%b"
- set x {}
- event gen .b.f <Button> -button 1
- event gen .b.f <ButtonRelease> -button 3
- set x
-} {Button1 Release3}
-test bind-13.15 {Tk_BindEvent procedure: virtual detail} {
- setup
- bind .b.f <<Paste>> "lappend x Paste"
- set x {}
- event gen .b.f <<Paste>>
- set x
-} {Paste}
-test bind-13.16 {Tk_BindEvent procedure: virtual event in event stream} {
- setup
- bind .b.f <<Paste>> "lappend x Paste"
- set x {}
- event gen .b.f <<Paste>>
- set x
-} {Paste}
-test bind-13.17 {Tk_BindEvent procedure: match detail physical} {
- setup
- bind .b.f <Button-2> {set x Button-2}
- event add <<Paste>> <Button-2>
- bind .b.f <<Paste>> {set x Paste}
+ 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 {}
+} -body {
+ bind .t.f : {lappend x "%W (.t.f binding)"}
+ bind Test : {lappend x "%W (Test binding)"}
+ bind all : {bind .t.f : {}; lappend x "%W (all binding)"}
+ event generate .t.f <Key-colon>
+ return $x
+} -cleanup {
+ bind Test : {}
+ bind all : {}
+ destroy .t.f
+} -result {{.t.f (.t.f binding)} {.t.f (Test binding)} {.t.f (all 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 {}
+} -body {
+ bind .t.f : {lappend x "%W (.t.f binding)"}
+ bind Test : {lappend x "%W (Test binding)"}
+ bind all : {destroy .t.f; lappend x "%W (all binding)"}
+ event generate .t.f <Key-colon>
+ return $x
+} -cleanup {
+ bind Test : {}
+ bind all : {}
+ destroy .t.f
+} -result {{.t.f (.t.f binding)} {.t.f (Test binding)} {.t.f (all 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 generate .t.f <Button-1>
+ event generate .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 generate .t.f <Enter> -serial 100 -detail NotifyAncestor
+ event generate .t.f <Enter> -serial 101 -detail NotifyInferior
+ event generate .t.f <Leave> -serial 102 -detail NotifyAncestor
+ event generate .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 generate .t.f <Motion> -serial 100 -x 100 -y 200 -when tail
+ update
+ event generate .t.f <Motion> -serial 101 -x 200 -y 300 -when tail
+ event generate .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 generate .t.f <Key-Shift_L> -serial 100 -when tail
+ event generate .t.f <KeyRelease-Shift_L> -serial 101 -when tail
+ event generate .t.f <Key-Shift_L> -serial 102 -when tail
+ event generate .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 {}
- event gen .b.f <Button-2>
+} -body {
+ bind .t.f <Key> "lappend x Key%K"
+ bind .t.f <KeyRelease> "lappend x Release%K"
+ event generate .t.f <Key> -keysym colon
+ event generate .t.f <KeyRelease> -keysym colon
+ return $x
+} -cleanup {
+ destroy .t.f
+} -result {Keycolon Releasecolon}
+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 generate .t.f <Key> -keycode 0
+ event generate .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 generate .t.f <Button> -button 1
+ event generate .t.f <ButtonRelease> -button 3
set x
-} {Button-2}
-test bind-13.18 {Tk_BindEvent procedure: no match detail physical} {
- setup
+} -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 generate .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 generate .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 generate .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
-} {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>> {set x Paste}
+ event generate .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.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 generate .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>
- set x
-} {}
-test bind-13.21 {Tk_BindEvent procedure: match no-detail physical} {
- setup
- bind .b.f <Button> {set x Button}
+} -body {
+ event add <<Paste>> <Button-2>
+ bind .t.f <<Paste>> "lappend x Paste"
+ event generate .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 {}
+} -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 generate .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 generate .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 generate .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 generate .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 generate .t.f <Button-2>
+ bind .t.f <Button-2> {}
+ event generate .t.f <Button-2>
+ bind .t.f <<Paste>> {}
+ event generate .t.f <Button-2>
+ bind .t.f <Button> {}
+ event generate .t.f <Button-2>
+ bind .t.f <<Copy>> {}
+ event generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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} -setup {
+ # this test might not be useful anymore [#3009998]
+ 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] {
+ bind $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 generate .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 generate .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 binding} -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 {
+ bind .t.f <1> {lappend x 1}
+ event generate .t.f <1>
+ return $x
+} -cleanup {
+ destroy .t.f
+} -result {1}
+test bind-13.38 {Tk_BindEvent procedure: binding gets to run} -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 y [list $x [bind Test]]
- bind Test <1> {}
- set y
-} {.b.f <Button-1>}
-test bind-13.36 {Tk_BindEvent procedure: C binding marked deleted} testcbind {
- setup
- testcbind Test <1> {lappend x Test} {lappend x Deleted}
- bind .b.f <1> {lappend x .b.f; bind Test <1> {}; lappend x after}
- set x {}
- event gen .b.f <1>
- set x
-} {.b.f after Deleted}
-test bind-13.37 {Tk_BindEvent procedure: C binding gets to run} testcbind {
- setup
- testcbind Test <1> {lappend x Test}
- bind .b.f <1> {lappend x .b.f}
- set x {}
- event gen .b.f <1>
+} -body {
+ bind Test <1> {lappend x Test}
+ bind .t.f <1> {lappend x .t.f}
+ event generate .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
- } {lappend x Deleted}
- set n 3
- set x {}
- event gen .b.f <1>
- set x
-} {before3 before2 before1 before0 after0 after0 after0 after0 Deleted}
-test bind-13.40 {Tk_BindEvent procedure: continue in script} {
- setup
- bind .b.f <Button-2> {lappend x b1; continue; lappend x b2}
- bind Test <Button-2> {lappend x B1; continue; lappend x B2}
+} -result {.t.f Test}
+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 <Button-2>
+} -body {
+ bind .t.f <Button-2> {lappend x b1; continue; lappend x b2}
+ bind Test <Button-2> {lappend x B1; continue; lappend x B2}
+ event generate .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.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>
- 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}
+} -body {
+ bind .t.f <Button-2> {lappend x b1; break; lappend x b2}
bind Test <Button-2> {lappend x B1; break; lappend x B2}
- set x {}
- event gen .b.f <Button-2>
+ event generate .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.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>
- bind Test <Button-2> {}
- set x
-} {b1}
-
-proc bgerror msg {
- global x
- lappend x $msg
-}
-test bind-13.44 {Tk_BindEvent procedure: error in script} {
- setup
- bind .b.f <Button-2> {lappend x b1; blap}
+} -body {
+ bind .t.f <Button-2> {lappend x b1; blap}
bind Test <Button-2> {lappend x B1}
- set x {}
- event gen .b.f <Button-2>
+ event generate .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}
- set x {}
- event gen .b.f <Button-2>
+ proc bgerror args {}
+} -result {b1 {invalid command name "blap"}}
+
+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
- bind Test <Button-2> {}
- set x
-} {b1 {invalid command name "blap"}}
-
-test bind-14.1 {TkBindDeadWindow: no C bindings pending} testcbind {
- setup
- bind .b.f <1> x
- testcbind .b.f <2> y
- destroy .b.f
-} {}
-test bind-14.2 {TkBindDeadWindow: is called after <Destroy>} testcbind {
- setup
- testcbind .b.f <Destroy> "lappend x .b.f"
- testcbind Test <Destroy> "lappend x Test"
- set x {}
- destroy .b.f
- bind Test <Destroy> {}
- set x
-} {.b.f Test}
-test bind-14.3 {TkBindDeadWindow: pending C bindings} testcbind {
- setup
- bindtags .b.f {a b c d}
- testcbind a <1> "lappend x a1" "lappend x bye.a1"
- testcbind b <1> "destroy .b.f; lappend x b1" "lappend x bye.b1"
- testcbind c <1> "lappend x c1" "lappend x bye.c1"
- testcbind d <1> "lappend x d1" "lappend x bye.d1"
- bind a <2> "event gen .b.f <1>"
- testcbind b <2> "lappend x b2" "lappend x bye.b2"
- testcbind c <2> "lappend x c2" "lappend x bye.d2"
- bind d <2> "lappend x d2"
- testcbind a <3> "event gen .b.f <2>"
- set x {}
- event gen .b.f <3>
- set y $x
- foreach tag {a b c d} {
- foreach event {<1> <2> <3>} {
- bind $tag $event {}
- }
- }
- set y
-} {a1 b1 d2}
-
-test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} {
- setup
- bind .b.f ab {set x 1}
+} -body {
+ bind .t.f 12 {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 generate .t.f <Key-1>
+ event generate .t.f <KeyRelease-1>
+ event generate .t.f <Key-2>
+ event generate .t.f <KeyRelease-2>
+ 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 12 {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 generate .t.f <Key-1>
+ event generate .t.f <Enter>
+ event generate .t.f <KeyRelease-1>
+ event generate .t.f <Leave>
+ event generate .t.f <Key-2>
+ event generate .t.f <KeyRelease-2>
+ 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 12 {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 generate .t.f <Key-1>
+ event generate .t.f <Button-1>
+ event generate .t.f <Key-2>
+ 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 generate .t.f <Button-1>
+ event generate .t.f <ButtonRelease-1>
+ event generate .t.f <Button-1>
+ event generate .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 generate .t.f <Button-1>
+ event generate .t.f <ButtonRelease-1>
+ event generate .t.f <Button-2>
+ event generate .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 generate .t.f <Button-1>
+ event generate .t.f <Key-a>
+ event generate .t.f <ButtonRelease-1>
+ event generate .t.f <Button-1>
+ event generate .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 generate .t.f <Button-1>
+ event generate .t.f <Key-Shift_L>
+ event generate .t.f <ButtonRelease-1>
+ event generate .t.f <Button-1>
+ event generate .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 generate .t.f <Key-a>
+ event generate .t.f <Key-c>
+ event generate .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 generate .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 generate .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 generate .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 generate .t.f <Key-a>
+ event generate .t.f <Key-Shift_L>
+ event generate .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 generate .t.f <Key-a>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1> -x 30 -y 40
+ event generate .t.f <Button-1> -x 31 -y 39
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1> -x 30 -y 40
+ event generate .t.f <Button-1> -x 29 -y 41
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1> -x 30 -y 40
+ event generate .t.f <Button-1> -x 40 -y 40
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1> -x 30 -y 40
+ event generate .t.f <Button-1> -x 20 -y 40
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1> -x 30 -y 40
+ event generate .t.f <Button-1> -x 30 -y 30
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1> -x 30 -y 40
+ event generate .t.f <Button-1> -x 30 -y 50
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1> -time 300
+ event generate .t.f <Button-1> -time 700
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1> -time 300
+ event generate .t.f <Button-1> -time 900
+ event generate .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 generate .t.f <Button-1> -time [expr -100]
+ event generate .t.f <Button-1> -time 200
+ event generate .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 generate .t.f <Button-1> -time -100
+ event generate .t.f <Button-1> -time 500
+ event generate .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 generate .t.f <Button-1>
+ event generate .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 generate .t.f <Button-1>
+ event generate .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 generate .t.f <Button> -serial 101
+ event generate .t.f <Button-1> -serial 102
+ event generate .t.f <Shift-Button-1> -serial 103
+ event generate .t.f <ButtonRelease-1>
+ bind .t.f <Shift-Button-1> "lappend x Shift-Button-1"
+ event generate .t.f <Button> -serial 104
+ event generate .t.f <Button-1> -serial 105
+ event generate .t.f <Shift-Button-1> -serial 106
+ event generate .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 1 {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 generate .t.f <Key-1>
+ 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 1 {set x 1}
set x none
- event gen .b.f <Button-1>
- event gen .b.f <ButtonRelease-1>
- set x
-} 1
-test bind-15.31 {MatchPatterns procedure, conflict resolution} {
- setup
- bind .b.f <M1-Key> {set x 0}
- bind .b.f <M2-Key> {set x 1}
+ event generate .t.f <Key-2>
+ 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 1 {lappend x 1}
+ bind .t.f 21 {lappend x 2}
set x none
- event gen .b.f <Key-a> -state 0x18
+ event generate .t.f <Key-2>
+ event generate .t.f <KeyRelease-2>
+ event generate .t.f <Key-1>
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 generate .t.f <Button-1>
+ event generate .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 generate .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 generate .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 generate .t.f <Button-1>
+ event generate .t.f <Button-1>
+ event generate .t.f <Button-1>
+ event generate .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 generate .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 generate .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 generate .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 generate .t.f <Button-3>
+ event generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .t.f <Button-1> -state 1402
+ event generate .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 generate .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 generate .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 generate .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 generate .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 generate .t.f <Button> -time 4294
+ event generate .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 generate .t.f <Button> -x 881 -y 432
+ event generate .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 generate .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 generate .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 generate .t.f <Key-a>
+ event generate .t.f <Key-A> -state 1
+ event generate .t.f <Key-Tab>
+ event generate .t.f <Key-Return>
+ event generate .t.f <Key-F1>
+ event generate .t.f <Key-Shift_L>
+ event generate .t.f <Key-space>
+ event generate .t.f <Key-dollar> -state 1
+ event generate .t.f <Key-braceleft> -state 1
+ event generate .t.f <Key-Multi_key>
+ event generate .t.f <Key-e>
+ event generate .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 generate .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 generate .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 generate .t.f <Key-a>
+ event generate .t.f <Key-A> -state 1
+ event generate .t.f <Key-Tab>
+ event generate .t.f <Key-F1>
+ event generate .t.f <Key-Shift_L>
+ event generate .t.f <Key-space>
+ event generate .t.f <Key-dollar> -state 1
+ event generate .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 generate .t.f <Key-space>
set x
-} 97
-test bind-16.40 {ExpandPercents procedure} {
- setup
- bind .b.f <Key> {set x "%S"}
+} -cleanup {
+ destroy .t.f
+} -result {32}
+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 generate .t.f <Key-space> -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 generate .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 generate .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 generate .t.f <Button> -rootx 422 -rooty 13
+ event generate .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 generate .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 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 ?options?"}}
-test bind-17.15 {event command: generate} {
- setup
- bind .b.f <1> "lappend x 1"
- set x {}
- event generate .b.f <1>
- set x
-} {1}
-test bind-17.16 {event command: generate} {
- list [catch {event generate .b.f <xyz>} msg] $msg
-} {1 {bad event type or keysym "xyz"}}
-test bind-17.17 {event command} {
- list [catch {event foo} msg] $msg
-} {1 {bad option "foo": must be add, delete, generate, or info}}
-
-test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} {
- list [catch {event add asd <Ctrl-v>} msg] $msg
-} {1 {virtual event "asd" is badly formed}}
-test bind-18.2 {CreateVirtualEvent procedure: FindSequence} {
- list [catch {event add <<asd>> <Ctrl-v>} msg] $msg
-} {1 {bad event type or keysym "Ctrl"}}
-test bind-18.3 {CreateVirtualEvent procedure: new physical} {
- setup
+} -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 generate .t.f <Button-2> -serial 101
+ event generate .t.f <ButtonRelease-2>
+ event delete <<xyz>>
+ event generate .t.f <Button-2> -serial 102
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Control-Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Control-Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Control-Button-2>
+ event generate .t.f <Control-ButtonRelease-2>
+ event generate .t.f <Shift-Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <Control-Button-2>
+ event generate .t.f <Shift-Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Control-ButtonRelease-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Control-Button-2>
+ event generate .t.f <Control-ButtonRelease-2>
+ event generate .t.f <Shift-Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Control-Button-2>
+ event generate .t.f <Control-ButtonRelease-2>
+ event generate .t.f <Shift-Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.g <Button-2>
+ event generate .t.g <ButtonRelease-2>
+ event generate .t.h <Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.g <Button-2>
+ event generate .t.g <ButtonRelease-2>
+ event generate .t.h <Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.g <Button-2>
+ event generate .t.g <ButtonRelease-2>
+ event generate .t.h <Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.g <Button-2>
+ event generate .t.g <ButtonRelease-2>
+ event generate .t.h <Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.g <Button-2>
+ event generate .t.g <ButtonRelease-2>
+ event generate .t.h <Button-2>
+ event generate .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 generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.g <Button-2>
+ event generate .t.g <ButtonRelease-2>
+ event generate .t.h <Button-2>
+ event generate .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 generate .xyz <Control-v>
+} -returnCodes error -result {bad window path name ".xyz"}
+test bind-22.2 {HandleEventGenerate} -body {
+ event generate zzz <Control-v>
+} -returnCodes error -result {bad window name/identifier "zzz"}
+test bind-22.3 {HandleEventGenerate} -body {
+ event generate 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 generate [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 generate . <xyz>
+} -returnCodes error -result {bad event type or keysym "xyz"}
+test bind-22.6 {HandleEventGenerate} -body {
+ event generate . <Double-Button-1>
+} -returnCodes error -result {Double or Triple modifier not allowed}
+test bind-22.7 {HandleEventGenerate} -body {
+ event generate . xyz
+} -returnCodes error -result {only one event specification allowed}
+test bind-22.8 {HandleEventGenerate} -body {
+ event generate . <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 generate .t.f <ButtonRelease-1>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <ButtonRelease-3>
+ event generate .t.f <Control-Button-1>
+ event generate .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 generate .t.f <Control-Key-space>
+ set x
+} -cleanup {
+ destroy .t.f
+} -result {4 space}
+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 generate .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 generate .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 generate .t.f <Button> -when now -serial 100
+ event generate .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 generate .t.f <Button> -when head -serial 100
+ event generate .t.f <Button> -when head -serial 101
+ event generate .t.f <Button> -when head -serial 102
+ event generate .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 generate .t.f <Button> -when head -serial 99
+ event generate .t.f <Button> -when mark -serial 100
+ event generate .t.f <Button> -when mark -serial 101
+ event generate .t.f <Button> -when mark -serial 102
+ event generate .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 generate .t.f <Button> -when head -serial 99
+ event generate .t.f <Button> -when tail -serial 100
+ event generate .t.f <Button> -when tail -serial 101
+ event generate .t.f <Button> -when tail -serial 102
+ event generate .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 generate . <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 generate . <a> -root 98765
+} -returnCodes error -result {bad window name/identifier "98765"}
+
+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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 FocusIn %d"
+ event generate .t.f <FocusIn> -detail NotifyVirtual
+ return $x
+} -cleanup {
+ destroy .t.f
+} -result {FocusIn NotifyVirtual}
+
+test bind-22.35.1 {HandleEventGenerate: options <FocusOut> -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 <FocusOut> "lappend x FocusOut %d"
+ event generate .t.f <FocusOut> -detail NotifyVirtual
+ return $x
+} -cleanup {
+ destroy .t.f
+} -result {FocusOut NotifyVirtual}
+
+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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .t.f <Key> -keysym xyz
+} -cleanup {
+ destroy .t.f
+} -returnCodes error -result {unknown keysym "xyz"}
+
+test bind-22.49 {HandleEventGenerate: options <Key> -keysym space} -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 generate .t.f <Key> -keysym space
+ return $x
+} -cleanup {
+ destroy .t.f
+} -result {space}
+
+test bind-22.50 {HandleEventGenerate: options <Button> -keysym space} -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 generate .t.f <Button> -keysym space
+} -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 generate .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 generate .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 generate .t.f <FocusIn> -mode NotifyNormal
+ return $x
+} -cleanup {
+ destroy .t.f
+} -result {NotifyNormal}
+
+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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .t.f <Button-1>
+ event generate .t.f <ButtonRelease-1>
lappend x press
- event gen .b.f <Button-1>
- event gen .b.f <ButtonRelease-1>
+ event generate .t.f <Button-1>
+ event generate .t.f <ButtonRelease-1>
lappend x press
- event gen .b.f <Button-1>
- event gen .b.f <ButtonRelease-1>
+ event generate .t.f <Button-1>
+ event generate .t.f <ButtonRelease-1>
lappend x press
- event gen .b.f <Button-1>
- event gen .b.f <ButtonRelease-1>
+ event generate .t.f <Button-1>
+ event generate .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 generate .t.f <Button-1>
+ event generate .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 generate .t.f <Button-1>
+ event generate .t.f <ButtonRelease-1>
+ event generate .t.f <Button-2>
+ event generate .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 generate .t.f <Button-3>
+ event generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1>
+ event generate .t.f <ButtonRelease-1>
+ event generate .t.f <Button-2>
+ event generate .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 generate .t.f <Button-3>
+ event generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1>
+ event generate .t.f <ButtonRelease-1>
+ event generate .t.f <Button-2>
+ event generate .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 generate .t.f <Button-3>
+ event generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-2>
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-1>
+ event generate .t.f <ButtonRelease-1>
+ event generate .t.f <Button-2> -x 100
+ event generate .t.f <ButtonRelease-2>
+ event generate .t.f <Button-2> -x 200
+ event generate .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 {
+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}
+
+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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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}"
+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 generate .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 generate .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
- set x
- } $result
-}
+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 generate .t.f <Gravity>
+ list $x [bind .t.f]
+} -cleanup {
+ destroy .t.f
+} -result {{event Gravity} <Gravity>}
-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-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 generate .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 generate .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 generate .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 generate .t.f <Button-1>
+ event generate .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 generate .t.f <Button-2>
+ event generate .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 generate .t.f <Button-3>
+ event generate .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 generate .t.f <Button-4>
+ event generate .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 generate .t.f <Button-5>
+ event generate .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-colon> "lappend x \"keysym received\""
+ bind .t.f <Key-underscore> "lappend x {bad binding match}"
+ set x [lsort [bind .t.f]]
+ event generate .t.f <Key-colon> ;# -state 0
+ set x
+} -cleanup {
+ destroy .t.f
+} -result {: _ {keysym received}}
+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 generate .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 generate .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 generate .t.f <Key-X> -state 1
+ set x
+} -cleanup {
+ destroy .t.f
+} -result {X x {keysym X}}
+
+
+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 generate .t.f <Button>
+ event generate .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 generate .t.f <Button>
+ event generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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 generate .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
# cleanup
cleanupTests
generated by cgit v0.12 at 2024-11-08 02:26:32 (GMT)