diff options
author | fvogel <fvogelnew1@free.fr> | 2020-12-30 15:25:02 (GMT) |
---|---|---|
committer | fvogel <fvogelnew1@free.fr> | 2020-12-30 15:25:02 (GMT) |
commit | 887fa7cbc4d5fe7ff42a931604b4319278d858d8 (patch) | |
tree | cb4e9adbe4574736d4578faf3e01a79d57a5ad26 /tests/bind.test | |
parent | dc614c2d613778504f17fbbbe15c95ceb93300f2 (diff) | |
parent | 4997c607cfcc3ed8f9b75c64b3a467027791b315 (diff) | |
download | tk-887fa7cbc4d5fe7ff42a931604b4319278d858d8.zip tk-887fa7cbc4d5fe7ff42a931604b4319278d858d8.tar.gz tk-887fa7cbc4d5fe7ff42a931604b4319278d858d8.tar.bz2 |
merge trunk
Diffstat (limited to 'tests/bind.test')
-rw-r--r-- | tests/bind.test | 1269 |
1 files changed, 794 insertions, 475 deletions
diff --git a/tests/bind.test b/tests/bind.test index f113e9b..ede1108 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -2,9 +2,9 @@ # commands plus the procedures in tkBind.c. It is organized in the # standard fashion for Tcl tests. # -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994-1995 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1995 Sun Microsystems, Inc. +# Copyright © 1998-1999 Scriptics Corporation. # All rights reserved. package require tcltest 2.2 @@ -13,6 +13,10 @@ eval tcltest::configure $argv tcltest::loadTestedCommands tk useinputmethods 0 +testConstraint nodeprecated [expr {"nodeprecated" ni [tk::pkgconfig list]}] +testConstraint needsTcl87 [package vsatisfies [package provide Tcl] 8.7] + + toplevel .t -width 100 -height 50 wm geom .t +0+0 update idletasks @@ -297,9 +301,9 @@ test bind-5.1 {Tk_CreateBindingTable procedure} -body { test bind-6.1 {Tk_DeleteBindTable procedure} -body { canvas .t.c - .t.c bind foo <1> {string 1} + .t.c bind foo <Button-1> {string 1} .t.c create rectangle 0 0 100 100 - .t.c bind 1 <2> {string 2} + .t.c bind 1 <Button-2> {string 2} destroy .t.c } -cleanup { destroy .t.c @@ -312,17 +316,17 @@ test bind-7.1 {Tk_CreateBinding procedure: bad binding} -body { } -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> + .t.c bind foo <Button-1> "button 1" + .t.c bind foo <Button-1> "+more button 1" + .t.c bind foo <Button-1> } -cleanup { destroy .t.c } -result {button 1 more button 1} 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> + .t.c bind foo <Button-1> "+button 1" + .t.c bind foo <Button-1> } -cleanup { destroy .t.c } -result {button 1} @@ -356,10 +360,10 @@ 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>} { + foreach i {<Button-1> <Meta-Button-1> <Control-Button-1> <Double-Alt-Button-1>} { bind .t.f $i "binding for $i" } - foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} { + foreach i {<Control-Button-1> <Double-Alt-Button-1> <Button-1> <Meta-Button-1>} { bind .t.f $i {} lappend result [lsort [bind .t.f]] } @@ -384,16 +388,16 @@ test bind-10.2 {Tk_GetBinding procedure} -body { test bind-11.1 {Tk_GetAllBindings procedure} -body { frame .t.f - foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" { + foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <Key-<> <Meta-a> <Â>" { bind .t.f $i Test } 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 \{ ~} +} -result "! <<Paste>> <Key-<> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-space> <Key-Â> <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>" { + foreach i "<Double-Button-1> <Triple-Button-1> <Meta-Control-a> <Double-Alt-Enter> <Button-1>" { bind .t.f $i Test } lsort [bind .t.f] @@ -402,7 +406,7 @@ test bind-11.2 {Tk_GetAllBindings procedure} -body { } -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" { + foreach i "<Double-Triple-Button-1> abcd a<Leave>b" { bind .t.f $i Test } lsort [bind .t.f] @@ -417,7 +421,7 @@ test bind-12.1 {Tk_DeleteAllBindings procedure} -body { } -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>" { + foreach i "a b c <Meta-Button-1> <Alt-a> <Control-a>" { bind .t.f $i x } destroy .t.f @@ -430,23 +434,23 @@ test bind-13.1 {Tk_BindEvent procedure} -setup { update set x {} } -body { - bind Test <KeyPress> {lappend x "%W %K Test KeyPress"} - bind all <KeyPress> {lappend x "%W %K all KeyPress"} + bind Test <Key> {lappend x "%W %K Test Key"} + bind all <Key> {lappend x "%W %K all Key"} 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> + event generate .t.f <:> + event generate .t.f <+> + event generate .t.f <_> return $x } -cleanup { destroy .t.f - bind all <KeyPress> {} - bind Test <KeyPress> {} + bind all <Key> {} + bind Test <Key> {} 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 _}} +} -result {{.t.f : .t.f :} {.t.f : Test :} {.t.f : all Key} {.t.f + Test Key} {.t.f + all Key} {.t.f _ Test Key} {.t.f _ all _}} test bind-13.2 {Tk_BindEvent procedure} -setup { frame .t.f -class Test -width 150 -height 100 @@ -455,17 +459,17 @@ test bind-13.2 {Tk_BindEvent procedure} -setup { update set x {} } -body { - bind Test <KeyPress> {lappend x "%W %K Test press any"; break} - bind all <KeyPress> {continue; lappend x "%W %K all press any"} + bind Test <Key> {lappend x "%W %K Test press any"; break} + bind all <Key> {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> + event generate .t.f <:> 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}} + bind all <Key> {} + bind Test <Key> {} +} -result {{.t.f : .t.f pressed colon} {.t.f : Test press any}} test bind-13.3 {Tk_BindEvent procedure} -setup { proc bgerror args {} @@ -475,23 +479,23 @@ test bind-13.3 {Tk_BindEvent procedure} -setup { update set x {} } -body { - bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test} + bind Test <Key> {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> + event generate .t.f <:> update list $x $errorInfo } -cleanup { destroy .t.f - bind Test <KeyPress> {} + bind Test <Key> {} rename bgerror {} -} -result {{{.t.f colon .t.f pressed colon} {.t.f colon Test press any}} {Test +} -result {{{.t.f : .t.f pressed colon} {.t.f : Test press any}} {Test while executing "error Test" (command bound to event)}} test bind-13.4 {Tk_BindEvent procedure} -setup { proc foo {} { set x 44 - event generate .t.f <Key-colon> + event generate .t.f <:> } frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -506,7 +510,7 @@ test bind-13.4 {Tk_BindEvent procedure} -setup { } -cleanup { destroy .t.f bind Test : {} -} -result {{.t.f colon .t.f} {.t.f colon Test}} +} -result {{.t.f : .t.f} {.t.f : Test}} test bind-13.5 {Tk_BindEvent procedure} -body { bind all <Destroy> {lappend x "%W destroyed"} @@ -534,7 +538,7 @@ test bind-13.7 {Tk_BindEvent procedure} -setup { 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> + event generate .t.f <:> return $x } -cleanup { bind Test : {} @@ -551,7 +555,7 @@ test bind-13.8 {Tk_BindEvent procedure} -setup { 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> + event generate .t.f <:> return $x } -cleanup { bind Test : {} @@ -566,14 +570,14 @@ test bind-13.9 {Tk_BindEvent procedure} -setup { 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)"} + bind .t.f <Button-1> {lappend x "%W z (.t.f <Button-1> binding)"} + bind .t.f <Button> {lappend x "%W z (.t.f <Button> 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)}} +} -result {{.t.f z (.t.f <Button-1> binding)} {.t.f z (.t.f <Button> binding)}} test bind-13.10 {Tk_BindEvent procedure: ignore NotifyInferior} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -616,9 +620,9 @@ test bind-13.12 {Tk_BindEvent procedure: collapse repeating modifiers} -setup { } -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 <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 <Shift_L> -serial 102 -when tail event generate .t.f <KeyRelease-Shift_L> -serial 103 -when tail update } -cleanup { @@ -633,12 +637,12 @@ test bind-13.13 {Tk_BindEvent procedure: valid key detail} -setup { } -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 + event generate .t.f <Key> -keysym : + event generate .t.f <KeyRelease> -keysym : return $x } -cleanup { destroy .t.f -} -result {Keycolon Releasecolon} +} -result {Key: Release:} test bind-13.14 {Tk_BindEvent procedure: invalid key detail} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -936,12 +940,12 @@ test bind-13.33 {Tk_BindEvent procedure: many C bindings cause realloc} -setup { } -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" + bind $p <Button-1> "lappend x $p" } - event generate .t.f <1> + event generate .t.f <Button-1> return $x } -cleanup { - foreach p [bindtags .t.f] {bind $p <1> {}} + foreach p [bindtags .t.f] {bind $p <Button-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 { @@ -966,12 +970,12 @@ test bind-13.35 {Tk_BindEvent procedure: execute binding} -setup { update set x {} } -body { - bind .t.f <1> {lappend x 1} - event generate .t.f <1> + bind .t.f <Button-1> {lappend x 1} + event generate .t.f <Button-1> return $x } -cleanup { destroy .t.f -} -result {1} +} -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 @@ -979,13 +983,13 @@ test bind-13.38 {Tk_BindEvent procedure: binding gets to run} -setup { update set x {} } -body { - bind Test <1> {lappend x Test} - bind .t.f <1> {lappend x .t.f} - event generate .t.f <1> + bind Test <Button-1> {lappend x Test} + bind .t.f <Button-1> {lappend x .t.f} + event generate .t.f <Button-1> return $x } -cleanup { destroy .t.f - bind Test <1> {} + bind Test <Button-1> {} } -result {.t.f Test} test bind-13.41 {Tk_BindEvent procedure: continue in script} -setup { frame .t.f -class Test -width 150 -height 100 @@ -1054,7 +1058,7 @@ test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1072,7 +1076,7 @@ test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1087,14 +1091,14 @@ test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> @@ -1103,7 +1107,7 @@ test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1119,41 +1123,41 @@ test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> - event generate .t.f <Key-a> + event generate .t.f <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} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> - event generate .t.f <Key-Shift_L> + event generate .t.f <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} +} -result 1 test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1162,13 +1166,13 @@ test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} -setup { } -body { bind .t.f ab {set x 1} set x 0 - event generate .t.f <Key-a> - event generate .t.f <Key-c> - event generate .t.f <Key-b> + event generate .t.f <a> + event generate .t.f <c> + event generate .t.f <b> return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.9 {MatchPatterns procedure, modifier checks} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1177,11 +1181,11 @@ test bind-15.9 {MatchPatterns procedure, modifier checks} -setup { } -body { bind .t.f <M1-M2-Key> {set x 1} set x 0 - event generate .t.f <Key-a> -state 0x18 + event generate .t.f <a> -state 0x18 return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.10 {MatchPatterns procedure, modifier checks} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1190,11 +1194,11 @@ test bind-15.10 {MatchPatterns procedure, modifier checks} -setup { } -body { bind .t.f <M1-M2-Key> {set x 1} set x 0 - event generate .t.f <Key-a> -state 0xfc + event generate .t.f <a> -state 0xfc return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.11 {MatchPatterns procedure, modifier checks} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1203,11 +1207,11 @@ test bind-15.11 {MatchPatterns procedure, modifier checks} -setup { } -body { bind .t.f <M1-M2-Key> {set x 1} set x 0 - event generate .t.f <Key-a> -state 0x8 + event generate .t.f <a> -state 0x8 return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} -constraints { nonPortable } -setup { @@ -1220,13 +1224,13 @@ test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} # differently on some platforms. bind .t.f aB {set x 1} set x 0 - event generate .t.f <Key-a> - event generate .t.f <Key-Shift_L> - event generate .t.f <Key-b> -state 1 + event generate .t.f <a> + event generate .t.f <Shift_L> + event generate .t.f <b> -state 1 return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.13 {MatchPatterns procedure, checking detail} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1235,19 +1239,19 @@ test bind-15.13 {MatchPatterns procedure, checking detail} -setup { } -body { bind .t.f ab {set x 1} set x 0 - event generate .t.f <Key-a> - event generate .t.f <Key-c> + event generate .t.f <a> + event generate .t.f <c> return $x } -cleanup { destroy .t.f -} -result {0} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1257,14 +1261,14 @@ test bind-15.14 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1274,14 +1278,14 @@ test bind-15.15 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1291,14 +1295,14 @@ test bind-15.16 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1308,14 +1312,14 @@ test bind-15.17 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1325,14 +1329,14 @@ test bind-15.18 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1342,14 +1346,14 @@ test bind-15.19 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1359,14 +1363,14 @@ test bind-15.20 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-2> event generate .t.f <ButtonRelease-2> @@ -1376,14 +1380,14 @@ test bind-15.21 {MatchPatterns procedure, checking "nearby"} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> -time -100 event generate .t.f <Button-1> -time 200 @@ -1391,14 +1395,14 @@ test bind-15.22 {MatchPatterns procedure, time wrap-around} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -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} + bind .t.f <Double-Button-1> {set x 1} set x 0 event generate .t.f <Button-1> -time -100 event generate .t.f <Button-1> -time 500 @@ -1406,7 +1410,7 @@ test bind-15.23 {MatchPatterns procedure, time wrap-around} -setup { return $x } -cleanup { destroy .t.f -} -result {0} +} -result 0 test bind-15.24 {MatchPatterns procedure, virtual event} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1472,35 +1476,35 @@ test bind-15.27 {MatchPatterns procedure, conflict resolution} -setup { focus -force .t.f update } -body { - bind .t.f <KeyPress> {set x 0} + bind .t.f <Key> {set x 0} bind .t.f 1 {set x 1} set x none event generate .t.f <Key-1> return $x } -cleanup { destroy .t.f -} -result {1} +} -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 <Key> {set x 0} bind .t.f 1 {set x 1} set x none event generate .t.f <Key-2> return $x } -cleanup { destroy .t.f -} -result {0} +} -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 <Key> {lappend x 0} bind .t.f 1 {lappend x 1} bind .t.f 21 {lappend x 2} set x none @@ -1517,15 +1521,15 @@ test bind-15.30 {MatchPatterns procedure, conflict resolution} -setup { focus -force .t.f update } -body { - bind .t.f <ButtonPress> {set x 0} - bind .t.f <1> {set x 1} + bind .t.f <Button> {set x 0} + bind .t.f <Button-1> {set x 1} set x none event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.31 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1535,11 +1539,11 @@ test bind-15.31 {MatchPatterns procedure, conflict resolution} -setup { } -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 + event generate .t.f <a> -state 0x18 return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.32 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1549,11 +1553,11 @@ test bind-15.32 {MatchPatterns procedure, conflict resolution} -setup { 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 + event generate .t.f <a> -state 0x18 return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1561,9 +1565,9 @@ test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup { 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)} + bind .t.f <Button-1> {lappend x single} + bind Test <Button-1> {lappend x single(Test)} + bind Test <Double-Button-1> {lappend x double(Test)} event generate .t.f <Button-1> event generate .t.f <Button-1> event generate .t.f <Button-1> @@ -1571,8 +1575,8 @@ test bind-15.33 {MatchPatterns procedure, conflict resolution} -setup { set x } -cleanup { destroy .t.f - bind Test <1> {} - bind Test <Double-1> {} + bind Test <Button-1> {} + bind Test <Double-Button-1> {} } -result {single single(Test) single double(Test) single double(Test)} @@ -1601,7 +1605,7 @@ test bind-16.2 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {1234} +} -result 1234 test bind-16.3 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1628,7 +1632,7 @@ test bind-16.4 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {3} +} -result 3 test bind-16.5 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1641,7 +1645,7 @@ test bind-16.5 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {47} +} -result 47 test bind-16.6 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1745,7 +1749,7 @@ test bind-16.13 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.14 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1784,7 +1788,7 @@ test bind-16.16 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {146} +} -result 146 test bind-16.17 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1850,7 +1854,7 @@ test bind-16.21 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.22 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1863,7 +1867,7 @@ test bind-16.22 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.23 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1876,7 +1880,7 @@ test bind-16.23 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.24 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1909,14 +1913,14 @@ test bind-16.26 {ExpandPercents procedure} -setup { focus -force .t.f update } -body { - bind .t.f <1> {set x "%s"} + bind .t.f <Button-1> {set x "%s"} set x none event generate .t.f <Button-1> -state 1402 event generate .t.f <ButtonRelease-1> set x } -cleanup { destroy .t.f -} -result {1402} +} -result 1402 test bind-16.27 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1929,7 +1933,7 @@ test bind-16.27 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {1023} +} -result 1023 test bind-16.28 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -1982,7 +1986,7 @@ test bind-16.31 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {4294} +} -result 4294 test bind-16.32 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2033,22 +2037,22 @@ test bind-16.35 {ExpandPercents procedure} -constraints { 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> + event generate .t.f <a> + event generate .t.f <A> -state 1 + event generate .t.f <Tab> + event generate .t.f <Return> + event generate .t.f <F1> + event generate .t.f <Shift_L> + event generate .t.f <space> + event generate .t.f <dollar> -state 1 + event generate .t.f <braceleft> -state 1 + event generate .t.f <Multi_key> + event generate .t.f <e> + event generate .t.f <apostrophe> set x } -cleanup { destroy .t.f -} -result {a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9} +} -result {a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} é} test bind-16.36 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2061,7 +2065,7 @@ test bind-16.36 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {24} +} -result 24 test bind-16.37 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2074,7 +2078,7 @@ test bind-16.37 {ExpandPercents procedure} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-16.38 {ExpandPercents procedure} -constraints { nonPortable } -setup { @@ -2085,14 +2089,14 @@ test bind-16.38 {ExpandPercents procedure} -constraints { 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 + event generate .t.f <a> + event generate .t.f <A> -state 1 + event generate .t.f <Tab> + event generate .t.f <F1> + event generate .t.f <Shift_L> + event generate .t.f <space> + event generate .t.f <dollar> -state 1 + event generate .t.f <braceleft> -state 1 set x } -cleanup { destroy .t.f @@ -2105,11 +2109,11 @@ test bind-16.39 {ExpandPercents procedure} -setup { } -body { bind .t.f <Key> {set x "%N"} set x none - event generate .t.f <Key-space> + event generate .t.f <space> set x } -cleanup { destroy .t.f -} -result {32} +} -result 32 test bind-16.40 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2118,7 +2122,7 @@ test bind-16.40 {ExpandPercents procedure} -setup { } -body { bind .t.f <Key> {set x "%S"} set x none - event generate .t.f <Key-space> -subwindow .t + event generate .t.f <space> -subwindow .t set x } -cleanup { destroy .t.f @@ -2135,7 +2139,7 @@ test bind-16.41 {ExpandPercents procedure} -setup { set x } -cleanup { destroy .t.f -} -result {2} +} -result 2 test bind-16.42 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2191,7 +2195,7 @@ test bind-16.45 {ExpandPercents procedure} -setup { bind Entry <Key> {set y "%M"} bind all <Key> {set z "%M"} set x none; set y none; set z none - event gen .t.e <Key-a> + event gen .t.e <a> list $x $y $z } -cleanup { destroy .t.e @@ -2212,7 +2216,7 @@ test bind-16.46 {ExpandPercents procedure} -setup { bind Entry <Key> {set y "%M"} bind .t.e <Key> {set x "%M"} set x none; set y none; set z none - event gen .t.e <Key-a> + event gen .t.e <a> list $x $y $z } -cleanup { destroy .t.e @@ -2220,6 +2224,19 @@ test bind-16.46 {ExpandPercents procedure} -setup { bind all <Key> $savedBind(All) unset savedBind } -result {0 1 2} +test bind-16.47 {ExpandPercents procedure} -constraints {aquaOrWin32 needsTcl87} -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 generate .t.f <Key> -keysym € + set x +} -cleanup { + destroy .t.f +} -result € test bind-17.1 {event command} -body { event @@ -2236,7 +2253,7 @@ test bind-17.4 {event command: add 1} -body { event info <<Paste>> } -cleanup { event delete <<Paste>> <Control-v> -} -result {<Control-Key-v>} +} -result <Control-Key-v> test bind-17.5 {event command: add 2} -body { event delete <<Paste>> event add <<Paste>> <Control-v> <Button-2> @@ -2246,13 +2263,13 @@ test bind-17.5 {event command: add 2} -body { } -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> + event add <<Paste>> <Control-v> <Button-2> abc <xyz> <Button-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>} + catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <Button-1>} lsort [event info <<Paste>>] } -cleanup { event delete <<Paste>> @@ -2263,12 +2280,12 @@ test bind-17.8 {event command: delete} -body { } -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> + event add <<Paste>> <Button-3> <Button-1> <Button-2> t + event delete <<Paste>> <Button-1> <Button-2> lsort [event info <<Paste>>] } -cleanup { event delete <<Paste>> - event delete <<Paste>> <3> t + event delete <<Paste>> <Button-3> t } -result {<Button-3> t} test bind-17.10 {event command: delete all} -body { event add <<Paste>> a b @@ -2316,12 +2333,12 @@ test bind-17.16 {event command: generate} -setup { update set x {} } -body { - bind .t.f <1> "lappend x 1" - event generate .t.f <1> + bind .t.f <Button-1> "lappend x 1" + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-17.17 {event command: generate} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2349,7 +2366,7 @@ test bind-18.3 {CreateVirtualEvent procedure: new physical} -body { event info <<xyz>> } -cleanup { event delete <<xyz>> -} -result {<Control-Key-v>} +} -result <Control-Key-v> test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} -body { event delete <<xyz>> event add <<xyz>> <Control-v> @@ -2357,7 +2374,7 @@ test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} -body { event info <<xyz>> } -cleanup { event delete <<xyz>> -} -result {<Control-Key-v>} +} -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> @@ -2406,7 +2423,7 @@ test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} -setup { event add <<xyz>> <Control-v> event delete <<xyz>> <Button-1> event info <<xyz>> -} -result {<Control-Key-v>} +} -result <Control-Key-v> test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} -body { event add <<xyz>> <Control-v> event delete <<xyz>> <xyz> @@ -2463,7 +2480,7 @@ test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} -setup { set x } -cleanup { destroy .t.f -} -result {101} +} -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 @@ -2684,11 +2701,11 @@ test bind-20.2 {GetVirtualEvent procedure: non-existent event} -body { test bind-20.3 {GetVirtualEvent procedure: owns 1} -setup { event delete <<xyz>> } -body { - event add <<xyz>> <Control-Key-v> + event add <<xyz>> <Control-v> event info <<xyz>> } -cleanup { event delete <<xyz>> -} -result {<Control-Key-v>} +} -result <Control-Key-v> test bind-20.4 {GetVirtualEvent procedure: owns many} -setup { event delete <<xyz>> } -body { @@ -2709,13 +2726,13 @@ test bind-21.2 {GetAllVirtualEvents procedure: 1 event} -body { event info } -cleanup { event delete <<xyz>> -} -result {<<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> + event add <<def>> <F6> lsort [event info] } -cleanup { event delete <<xyz>> @@ -2784,7 +2801,7 @@ test bind-22.10 {HandleEventGenerate} -setup { set x {} } -body { bind .t.f <Key> {set x "%s %K"} - event generate .t.f <Control-Key-space> + event generate .t.f <Control-space> set x } -cleanup { destroy .t.f @@ -2801,7 +2818,7 @@ test bind-22.11 {HandleEventGenerate} -setup { set x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.12 {HandleEventGenerate} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2814,7 +2831,7 @@ test bind-22.12 {HandleEventGenerate} -setup { set x } -cleanup { destroy .t.f -} -result {4} +} -result 4 test bind-22.13 {HandleEventGenerate} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2828,7 +2845,7 @@ test bind-22.13 {HandleEventGenerate} -setup { set x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.14 {HandleEventGenerate} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -2984,7 +3001,7 @@ test bind-22.25 {HandleEventGenerate: options <Configure> -borderwidth 2i} -setu expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.26 {HandleEventGenerate: options <Key> -borderwidth 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3078,7 +3095,7 @@ test bind-22.32 {HandleEventGenerate: options <Expose> -count 20} -setup { return $x } -cleanup { destroy .t.f -} -result {20} +} -result 20 test bind-22.33 {HandleEventGenerate: options <Key> -count 20} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3186,7 +3203,7 @@ test bind-22.39 {HandleEventGenerate: options <Enter> -focus 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.40 {HandleEventGenerate: options <Key> -focus 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3226,7 +3243,7 @@ test bind-22.42 {HandleEventGenerate: options <Expose> -height 2i} -setup { expr {$x eq [winfo pixels .t.f 2i]} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.43 {HandleEventGenerate: options <Configure> -height 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3240,7 +3257,7 @@ test bind-22.43 {HandleEventGenerate: options <Configure> -height 2i} -setup { expr {$x eq [winfo pixels .t.f 2i]} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.44 {HandleEventGenerate: options <Key> -height 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3280,7 +3297,7 @@ test bind-22.46 {HandleEventGenerate: options <Key> -keycode 20} -setup { return $x } -cleanup { destroy .t.f -} -result {20} +} -result 20 test bind-22.47 {HandleEventGenerate: options <Button> -keycode 20} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3413,7 +3430,7 @@ test bind-22.56 {HandleEventGenerate: options <Map> -override 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.57 {HandleEventGenerate: options <Reparent> -override 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3427,7 +3444,7 @@ test bind-22.57 {HandleEventGenerate: options <Reparent> -override 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.58 {HandleEventGenerate: options <Configure> -override 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3441,7 +3458,7 @@ test bind-22.58 {HandleEventGenerate: options <Configure> -override 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.59 {HandleEventGenerate: options <Key> -override 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3521,7 +3538,7 @@ test bind-22.64 {HandleEventGenerate: options <Key> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.65 {HandleEventGenerate: options <Key> -root xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3548,7 +3565,7 @@ test bind-22.66 {HandleEventGenerate: options <Key> -root [winfo id .t]} -setup expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.67 {HandleEventGenerate: options <Button> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3562,7 +3579,7 @@ test bind-22.67 {HandleEventGenerate: options <Button> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.68 {HandleEventGenerate: options <ButtonRelease> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3576,7 +3593,7 @@ test bind-22.68 {HandleEventGenerate: options <ButtonRelease> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.69 {HandleEventGenerate: options <Motion> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3590,7 +3607,7 @@ test bind-22.69 {HandleEventGenerate: options <Motion> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.70 {HandleEventGenerate: options <<Paste>> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3604,7 +3621,7 @@ test bind-22.70 {HandleEventGenerate: options <<Paste>> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.71 {HandleEventGenerate: options <Enter> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3618,7 +3635,7 @@ test bind-22.71 {HandleEventGenerate: options <Enter> -root .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.72 {HandleEventGenerate: options <Configure> -root .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3658,7 +3675,7 @@ test bind-22.74 {HandleEventGenerate: options <Key> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.75 {HandleEventGenerate: options <Button> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3672,7 +3689,7 @@ test bind-22.75 {HandleEventGenerate: options <Button> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.76 {HandleEventGenerate: options <ButtonRelease> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3686,7 +3703,7 @@ test bind-22.76 {HandleEventGenerate: options <ButtonRelease> -rootx 2i} -setup expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.77 {HandleEventGenerate: options <Motion> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3700,7 +3717,7 @@ test bind-22.77 {HandleEventGenerate: options <Motion> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.78 {HandleEventGenerate: options <<Paste>> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3714,7 +3731,7 @@ test bind-22.78 {HandleEventGenerate: options <<Paste>> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.79 {HandleEventGenerate: options <Enter> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3728,7 +3745,7 @@ test bind-22.79 {HandleEventGenerate: options <Enter> -rootx 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.80 {HandleEventGenerate: options <Configure> -rootx 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3768,7 +3785,7 @@ test bind-22.82 {HandleEventGenerate: options <Key> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.83 {HandleEventGenerate: options <Button> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3782,7 +3799,7 @@ test bind-22.83 {HandleEventGenerate: options <Button> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.84 {HandleEventGenerate: options <ButtonRelease> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3796,7 +3813,7 @@ test bind-22.84 {HandleEventGenerate: options <ButtonRelease> -rooty 2i} -setup expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.85 {HandleEventGenerate: options <Motion> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3810,7 +3827,7 @@ test bind-22.85 {HandleEventGenerate: options <Motion> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.86 {HandleEventGenerate: options <<Paste>> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3824,7 +3841,7 @@ test bind-22.86 {HandleEventGenerate: options <<Paste>> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.87 {HandleEventGenerate: options <Enter> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3838,7 +3855,7 @@ test bind-22.87 {HandleEventGenerate: options <Enter> -rooty 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.88 {HandleEventGenerate: options <Configure> -rooty 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3878,7 +3895,7 @@ test bind-22.90 {HandleEventGenerate: options <Key> -sendevent 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.91 {HandleEventGenerate: options <Key> -sendevent yes} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3892,7 +3909,7 @@ test bind-22.91 {HandleEventGenerate: options <Key> -sendevent yes} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.92 {HandleEventGenerate: options <Key> -sendevent 43} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3906,7 +3923,7 @@ test bind-22.92 {HandleEventGenerate: options <Key> -sendevent 43} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.93 {HandleEventGenerate: options <Key> -serial xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3933,7 +3950,7 @@ test bind-22.94 {HandleEventGenerate: options <Key> -serial 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.95 {HandleEventGenerate: options <Key> -state xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3960,7 +3977,7 @@ test bind-22.96 {HandleEventGenerate: options <Key> -state 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.97 {HandleEventGenerate: options <Button> -state 1025} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3974,7 +3991,7 @@ test bind-22.97 {HandleEventGenerate: options <Button> -state 1025} -setup { return $x } -cleanup { destroy .t.f -} -result {1025} +} -result 1025 test bind-22.98 {HandleEventGenerate: options <ButtonRelease> -state 1025} -setup { frame .t.f -class Test -width 150 -height 100 @@ -3988,7 +4005,7 @@ test bind-22.98 {HandleEventGenerate: options <ButtonRelease> -state 1025} -setu return $x } -cleanup { destroy .t.f -} -result {1025} +} -result 1025 test bind-22.99 {HandleEventGenerate: options <Motion> -state 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4002,7 +4019,7 @@ test bind-22.99 {HandleEventGenerate: options <Motion> -state 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.100 {HandleEventGenerate: options <<Paste>> -state 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4016,7 +4033,7 @@ test bind-22.100 {HandleEventGenerate: options <<Paste>> -state 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.101 {HandleEventGenerate: options <Enter> -state 1} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4030,7 +4047,7 @@ test bind-22.101 {HandleEventGenerate: options <Enter> -state 1} -setup { return $x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.102 {HandleEventGenerate: options <Visibility> -state xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4097,7 +4114,7 @@ test bind-22.106 {HandleEventGenerate: options <Key> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.107 {HandleEventGenerate: options <Key> -subwindow xyz} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4124,7 +4141,7 @@ test bind-22.108 {HandleEventGenerate: options <Key> -subwindow [winfo id .t]} - expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.109 {HandleEventGenerate: options <Button> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4138,7 +4155,7 @@ test bind-22.109 {HandleEventGenerate: options <Button> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.110 {HandleEventGenerate: options <ButtonRelease> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4152,7 +4169,7 @@ test bind-22.110 {HandleEventGenerate: options <ButtonRelease> -subwindow .t} -s expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.111 {HandleEventGenerate: options <Motion> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4166,7 +4183,7 @@ test bind-22.111 {HandleEventGenerate: options <Motion> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.112 {HandleEventGenerate: options <<Paste>> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4180,7 +4197,7 @@ test bind-22.112 {HandleEventGenerate: options <<Paste>> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.113 {HandleEventGenerate: options <Enter> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4194,7 +4211,7 @@ test bind-22.113 {HandleEventGenerate: options <Enter> -subwindow .t} -setup { expr {[winfo id .t] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.114 {HandleEventGenerate: options <Configure> -subwindow .t} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4234,7 +4251,7 @@ test bind-22.116 {HandleEventGenerate: options <Key> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.117 {HandleEventGenerate: options <Button> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4248,7 +4265,7 @@ test bind-22.117 {HandleEventGenerate: options <Button> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.118 {HandleEventGenerate: options <ButtonRelease> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4262,7 +4279,7 @@ test bind-22.118 {HandleEventGenerate: options <ButtonRelease> -time 100} -setup return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.119 {HandleEventGenerate: options <Motion> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4276,7 +4293,7 @@ test bind-22.119 {HandleEventGenerate: options <Motion> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.120 {HandleEventGenerate: options <<Paste>> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4290,7 +4307,7 @@ test bind-22.120 {HandleEventGenerate: options <<Paste>> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.121 {HandleEventGenerate: options <Enter> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4304,7 +4321,7 @@ test bind-22.121 {HandleEventGenerate: options <Enter> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.122 {HandleEventGenerate: options <Property> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4318,7 +4335,7 @@ test bind-22.122 {HandleEventGenerate: options <Property> -time 100} -setup { return $x } -cleanup { destroy .t.f -} -result {100} +} -result 100 test bind-22.123 {HandleEventGenerate: options <Configure> -time 100} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4358,7 +4375,7 @@ test bind-22.125 {HandleEventGenerate: options <Expose> -width 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.126 {HandleEventGenerate: options <Configure> -width 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4372,7 +4389,7 @@ test bind-22.126 {HandleEventGenerate: options <Configure> -width 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.127 {HandleEventGenerate: options <Key> -width 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4563,7 +4580,7 @@ test bind-22.140 {HandleEventGenerate: options <Key> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.141 {HandleEventGenerate: options <Button> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4577,7 +4594,7 @@ test bind-22.141 {HandleEventGenerate: options <Button> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.142 {HandleEventGenerate: options <ButtonRelease> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4591,7 +4608,7 @@ test bind-22.142 {HandleEventGenerate: options <ButtonRelease> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.143 {HandleEventGenerate: options <Motion> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4605,7 +4622,7 @@ test bind-22.143 {HandleEventGenerate: options <Motion> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.144 {HandleEventGenerate: options <<Paste>> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4619,7 +4636,7 @@ test bind-22.144 {HandleEventGenerate: options <<Paste>> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.145 {HandleEventGenerate: options <Enter> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4633,7 +4650,7 @@ test bind-22.145 {HandleEventGenerate: options <Enter> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.146 {HandleEventGenerate: options <Expose> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4647,7 +4664,7 @@ test bind-22.146 {HandleEventGenerate: options <Expose> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.147 {HandleEventGenerate: options <Configure> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4661,7 +4678,7 @@ test bind-22.147 {HandleEventGenerate: options <Configure> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.148 {HandleEventGenerate: options <Gravity> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4675,7 +4692,7 @@ test bind-22.148 {HandleEventGenerate: options <Gravity> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.149 {HandleEventGenerate: options <Reparent> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4689,7 +4706,7 @@ test bind-22.149 {HandleEventGenerate: options <Reparent> -x 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.150 {HandleEventGenerate: options <Map> -x 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4729,7 +4746,7 @@ test bind-22.152 {HandleEventGenerate: options <Key> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.153 {HandleEventGenerate: options <Button> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4743,7 +4760,7 @@ test bind-22.153 {HandleEventGenerate: options <Button> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.154 {HandleEventGenerate: options <ButtonRelease> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4757,7 +4774,7 @@ test bind-22.154 {HandleEventGenerate: options <ButtonRelease> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.155 {HandleEventGenerate: options <Motion> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4771,7 +4788,7 @@ test bind-22.155 {HandleEventGenerate: options <Motion> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.156 {HandleEventGenerate: options <<Paste>> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4785,7 +4802,7 @@ test bind-22.156 {HandleEventGenerate: options <<Paste>> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.157 {HandleEventGenerate: options <Enter> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4799,7 +4816,7 @@ test bind-22.157 {HandleEventGenerate: options <Enter> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.158 {HandleEventGenerate: options <Expose> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4813,7 +4830,7 @@ test bind-22.158 {HandleEventGenerate: options <Expose> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.159 {HandleEventGenerate: options <Configure> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4827,7 +4844,7 @@ test bind-22.159 {HandleEventGenerate: options <Configure> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.160 {HandleEventGenerate: options <Gravity> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4841,7 +4858,7 @@ test bind-22.160 {HandleEventGenerate: options <Gravity> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.161 {HandleEventGenerate: options <Reparent> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4855,7 +4872,7 @@ test bind-22.161 {HandleEventGenerate: options <Reparent> -y 2i} -setup { expr {[winfo pixels .t.f 2i] eq $x} } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-22.162 {HandleEventGenerate: options <Map> -y 2i} -setup { frame .t.f -class Test -width 150 -height 100 @@ -4928,10 +4945,10 @@ test bind-24.5 {FindSequence procedure, multiple bindings} -setup { 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} + bind .t.f <Button-1> {lappend x single} + bind .t.f <Double-Button-1> {lappend x double} + bind .t.f <Triple-Button-1> {lappend x triple} + bind .t.f <Quadruple-Button-1> {lappend x quadruple} set x press event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> @@ -5086,7 +5103,7 @@ test bind-25.2 {ParseEventDescription procedure: misinterpreted modifier} -setup button .b } -body { bind .b <Control-M> a - bind .b <M-M> b + bind .b <Meta-M> b lsort [bind .b] } -cleanup { destroy .b @@ -5106,7 +5123,7 @@ test bind-25.4 {ParseEventDescription} -setup { bind .t.f } -cleanup { destroy .t.f -} -result {<<Shift-Paste>>} +} -result <<Shift-Paste>> # Assorted error cases in event sequence parsing test bind-25.5 {ParseEventDescription procedure error cases} -body { @@ -5190,7 +5207,7 @@ test bind-25.21 {modifier names} -setup { 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 <Meta-a> foo bind .t.f } -cleanup { destroy .t.f @@ -5439,6 +5456,42 @@ test bind-25.49 {modifier names} -setup { destroy .t.f } -result <Extended-Key-Return> +test bind-25.50 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button6-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B6-Key-a> + +test bind-25.51 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button7-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B7-Key-a> + +test bind-25.52 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button8-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B8-Key-a> + +test bind-25.53 {modifier names} -setup { + frame .t.f -class Test -width 150 -height 100 +} -body { + bind .t.f <Button9-a> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result <B9-Key-a> + test bind-26.1 {event names} -setup { @@ -5499,20 +5552,6 @@ test bind-26.5 {event names: Button} -setup { 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 @@ -5597,20 +5636,6 @@ test bind-26.12 {event names: Key} -setup { 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 @@ -5772,8 +5797,8 @@ 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 {bad button number "6"} + bind .t <Button-10> foo +} -returnCodes error -result {bad button number "10"} test bind-27.3 {button names} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -5844,6 +5869,62 @@ test bind-27.7 {button names} -setup { } -cleanup { destroy .t.f } -result {<Button-5> {button 5}} +test bind-27.8 {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-6> {lappend x "button 6"} + set x [bind .t.f] + event generate .t.f <Button-6> + event generate .t.f <ButtonRelease-6> + set x +} -cleanup { + destroy .t.f +} -result {<Button-6> {button 6}} +test bind-27.9 {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-7> {lappend x "button 7"} + set x [bind .t.f] + event generate .t.f <Button-7> + event generate .t.f <ButtonRelease-7> + set x +} -cleanup { + destroy .t.f +} -result {<Button-7> {button 7}} +test bind-27.10 {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-8> {lappend x "button 8"} + set x [bind .t.f] + event generate .t.f <Button-8> + event generate .t.f <ButtonRelease-8> + set x +} -cleanup { + destroy .t.f +} -result {<Button-8> {button 8}} +test bind-27.11 {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-9> {lappend x "button 9"} + set x [bind .t.f] + event generate .t.f <Button-9> + event generate .t.f <ButtonRelease-9> + set x +} -cleanup { + destroy .t.f +} -result {<Button-9> {button 9}} test bind-28.1 {keysym names} -body { bind .t <Expose-a> foo @@ -5852,7 +5933,7 @@ 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 + bind .t <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 @@ -5868,10 +5949,10 @@ test bind-28.5 {keysym names} -setup { 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}" + bind .t.f <:> "lappend x \"keysym received\"" + bind .t.f <_> "lappend x {bad binding match}" set x [lsort [bind .t.f]] - event generate .t.f <Key-colon> ;# -state 0 + event generate .t.f <:> ;# -state 0 set x } -cleanup { destroy .t.f @@ -5882,10 +5963,10 @@ test bind-28.6 {keysym names} -setup { 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}" + bind .t.f <Return> "lappend x \"keysym Return\"" + bind .t.f <x> "lappend x {bad binding match}" set x [lsort [bind .t.f]] - event generate .t.f <Key-Return> -state 0 + event generate .t.f <Return> -state 0 set x } -cleanup { destroy .t.f @@ -5896,10 +5977,10 @@ test bind-28.7 {keysym names} -setup { 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}" + bind .t.f <X> "lappend x \"keysym X\"" + bind .t.f <x> "lappend x {bad binding match}" set x [lsort [bind .t.f]] - event generate .t.f <Key-X> -state 1 + event generate .t.f <X> -state 1 set x } -cleanup { destroy .t.f @@ -5910,42 +5991,63 @@ test bind-28.8 {keysym names} -setup { 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}" + bind .t.f <X> "lappend x \"keysym X\"" + bind .t.f <x> "lappend x {bad binding match}" set x [lsort [bind .t.f]] - event generate .t.f <Key-X> -state 1 + event generate .t.f <X> -state 1 set x } -cleanup { destroy .t.f } -result {X x {keysym X}} -test bind-28.9 {keysym names, Eth -> ETH} -body { +test bind-28.9 {keysym names, Ð} -body { frame .t.f -class Test -width 150 -height 100 - bind .t.f <Eth> foo + bind .t.f <Ð> foo bind .t.f } -cleanup { destroy .t.f -} -result {<Key-ETH>} -test bind-28.10 {keysym names, Ooblique -> Oslash} -body { +} -result <Key-Ð> +test bind-28.10 {keysym names, Ø} -constraints nodeprecated -body { frame .t.f -class Test -width 150 -height 100 - bind .t.f <Ooblique> foo + bind .t.f <Ø> foo bind .t.f } -cleanup { destroy .t.f -} -result {<Key-Oslash>} +} -result <Key-Ø> test bind-28.11 {keysym names, gcedilla} -body { frame .t.f -class Test -width 150 -height 100 bind .t.f <gcedilla> foo bind .t.f } -cleanup { destroy .t.f -} -result {<Key-gcedilla>} +} -result <Key-gcedilla> test bind-28.12 {keysym names, Greek_IOTAdiaeresis -> Greek_IOTAdieresis} -body { frame .t.f -class Test -width 150 -height 100 bind .t.f <Greek_IOTAdiaeresis> foo bind .t.f } -cleanup { destroy .t.f -} -result {<Key-Greek_IOTAdieresis>} +} -result <Key-Greek_IOTAdieresis> +test bind-28.13 {keysym names, Unicode} -body { + frame .t.f -class Test -width 150 -height 100 + bind .t.f <€> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result "<Key-€>" +test bind-28.14 {keysym names, Emoji} -body { + frame .t.f -class Test -width 150 -height 100 + bind .t.f <\U1F44D> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result "<Key-\U1F44D>" +test bind-28.15 {keysym names, Emoji} -constraints needsTcl87 -body { + frame .t.f -class Test -width 150 -height 100 + bind .t.f <👍> foo + bind .t.f +} -cleanup { + destroy .t.f +} -result "<Key-👍>" test bind-29.1 {Tcl_BackgroundError procedure} -setup { @@ -6026,7 +6128,7 @@ test bind-30.2 {MouseWheel events} -setup { set x } -cleanup { destroy .t.f -} -result {120} +} -result 120 test bind-30.3 {MouseWheel events} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f @@ -6157,7 +6259,7 @@ test bind-32.2 {detection of double click should not fail} -setup { update set x {} } -body { - event generate .t.f <ButtonPress-1> + event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> # Simulate a lot of intervening exposure events. The old implementation # that used an event ring overflowed, and the double click was not detected. @@ -6165,7 +6267,7 @@ test bind-32.2 {detection of double click should not fail} -setup { for {set i 0} {$i < 1000} {incr i} { event generate .t.f <Expose> } - event generate .t.f <ButtonPress-1> + event generate .t.f <Button-1> event generate .t.f <ButtonRelease-1> set x } -cleanup { @@ -6177,10 +6279,10 @@ test bind-32.3 {should trigger best match of modifier states} -setup { update set x {} } -body { - bind .t.f <Alt-Control-Key-A> { lappend x "Alt-Control" } - bind .t.f <Shift-Control-Key-A> { lappend x "Shift-Control" } - bind .t.f <Shift-Key-A> { lappend x "Shift" } - event generate .t.f <Alt-Control-Key-A> + bind .t.f <Alt-Control-A> { lappend x "Alt-Control" } + bind .t.f <Shift-Control-A> { lappend x "Shift-Control" } + bind .t.f <Shift-A> { lappend x "Shift" } + event generate .t.f <Alt-Control-A> set x } -cleanup { destroy .t.f @@ -6191,10 +6293,10 @@ test bind-32.4 {should not trigger Double-1} -setup { update set x {} } -body { - bind .t.f <Double-1> { set x "Double" } - event generate .t.f <1> -time current + bind .t.f <Double-Button-1> { set x "Double" } + event generate .t.f <Button-1> -time current after 1000 - event generate .t.f <1> -time current + event generate .t.f <Button-1> -time current set x } -cleanup { destroy .t.f @@ -6205,10 +6307,10 @@ test bind-32.5 {should trigger Quadruple-1} -setup { update set x {} } -body { - bind .t.f <Quadruple-1> { set x "Quadruple" } - bind .t.f <Triple-1> { set x "Triple" } - bind .t.f <Double-1> { set x "Double" } - bind .t.f <1> { set x "Single" } + bind .t.f <Quadruple-Button-1> { set x "Quadruple" } + bind .t.f <Triple-Button-1> { set x "Triple" } + bind .t.f <Double-Button-1> { set x "Double" } + bind .t.f <Button-1> { set x "Single" } # Old implementation triggered "Double", but new implementation # triggers "Quadruple", the latter behavior conforms to other toolkits. event generate .t.f <Button-1> -time 0 @@ -6238,10 +6340,10 @@ test bind-32.7 {test sequences} -setup { update set x {} } -body { - bind .t.f <Double-1> { lappend x "Double" } - bind .t.f <1><1><a> { lappend x "11" } - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Double-Button-1> { lappend x "Double" } + bind .t.f <Button-1><Button-1><a> { lappend x "11" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { @@ -6253,12 +6355,12 @@ test bind-32.8 {test sequences} -setup { update set x {} } -body { - bind .t.f <a><1><Double-1><1><a> { lappend x "Double" } + bind .t.f <a><Button-1><Double-Button-1><Button-1><a> { lappend x "Double" } event generate .t.f <a> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { @@ -6270,8 +6372,8 @@ test bind-32.9 {trigger events for modifier keys} -setup { update set x {} } -body { - bind .t.f <Any-Key> { set x "Key" } - event generate .t.f <KeyPress> -keysym Caps_Lock + bind .t.f <Key> { set x "Key" } + event generate .t.f <Key> -keysym Caps_Lock set x } -cleanup { destroy .t.f @@ -6280,14 +6382,14 @@ test bind-32.10 {reset key state when destroying window} -setup { set x {} } -body { pack [frame .t.f]; update; focus -force .t.f - bind .t.f <Key-A> { set x "A" } - event generate .t.f <KeyPress-A> - event generate .t.f <KeyPress-A> + bind .t.f <A> { set x "A" } + event generate .t.f <A> + event generate .t.f <A> destroy .t.f; update pack [frame .t.f]; update; focus -force .t.f - bind .t.f <Key-A> { set x "A" } - bind .t.f <Double-Key-A> { set x "AA" } - event generate .t.f <KeyPress-A> + bind .t.f <A> { set x "A" } + bind .t.f <Double-A> { set x "AA" } + event generate .t.f <A> destroy .t.f set x } -result {A} @@ -6301,7 +6403,7 @@ test bind-32.11 {match detailed virtual} -setup { bind Test <<TestControlButton1>> { set x "Control-Button-1" } bind Test <Button-1> { set x "Button-1" } bind .t.f <Button-1> { set x "Button-1" } - event generate .t.f <Control-ButtonPress-1> + event generate .t.f <Control-Button-1> set x } -cleanup { destroy .t.f @@ -6317,25 +6419,25 @@ test bind-32.12 {don't detect repetition when window has changed} -setup { } -body { bind .t.f <Button-1> { set x "1" } bind .t.f <Double-Button-1> { set x "11" } - event generate .t.f <ButtonPress-1> - event generate .t.g <ButtonPress-1> - event generate .t.f <ButtonPress-1> + event generate .t.f <Button-1> + event generate .t.g <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f destroy .t.g -} -result {1} +} -result 1 test bind-32.13 {don't detect repetition when window has changed} -setup { pack [frame .t.f] pack [frame .t.g] update set x {} } -body { - bind .t.f <Key-A> { set x "A" } - bind .t.f <Double-Key-A> { set x "AA" } - focus -force .t.f; event generate .t.f <KeyPress-A> - focus -force .t.g; event generate .t.g <KeyPress-A> - focus -force .t.f; event generate .t.f <KeyPress-A> + bind .t.f <A> { set x "A" } + bind .t.f <Double-A> { set x "AA" } + focus -force .t.f; event generate .t.f <A> + focus -force .t.g; event generate .t.g <A> + focus -force .t.f; event generate .t.f <A> set x } -cleanup { destroy .t.f @@ -6347,31 +6449,31 @@ test bind-32.14 {don't detect repetition when window has changed} -setup { update set x {} } -body { - bind .t.f <ButtonPress-1> { set x "1" } - bind .t.f <Double-ButtonPress-1> { set x "11" } - focus -force .t.f; event generate .t.f <ButtonPress-1> - focus -force .t.g; event generate .t.g <ButtonPress-1> - focus -force .t.f; event generate .t.f <ButtonPress-1> + bind .t.f <Button-1> { set x "1" } + bind .t.f <Double-Button-1> { set x "11" } + focus -force .t.f; event generate .t.f <Button-1> + focus -force .t.g; event generate .t.g <Button-1> + focus -force .t.f; event generate .t.f <Button-1> set x } -cleanup { destroy .t.f destroy .t.g -} -result {1} +} -result 1 test bind-32.15 {reset button state when destroying window} -setup { set x {} } -body { pack [frame .t.f]; update; focus -force .t.f - bind .t.f <ButtonPress-1> { set x "1" } - event generate .t.f <ButtonPress-1> - event generate .t.f <ButtonPress-1> + bind .t.f <Button-1> { set x "1" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> destroy .t.f; update pack [frame .t.f]; update; focus -force .t.f - bind .t.f <ButtonPress-1> { set x "1" } - bind .t.f <Double-ButtonPress-1> { set x "11" } - event generate .t.f <ButtonPress-1> + bind .t.f <Button-1> { set x "1" } + bind .t.f <Double-Button-1> { set x "11" } + event generate .t.f <Button-1> destroy .t.f set x -} -result {1} +} -result 1 test bind-33.1 {prefer longest match} -setup { pack [frame .t.f] @@ -6379,141 +6481,133 @@ test bind-33.1 {prefer longest match} -setup { update set x {} } -body { - bind .t.f <a><1><1> { lappend x "a11" } - bind .t.f <Double-1> { lappend x "Double" } + bind .t.f <a><Button-1><Button-1> { lappend x "a11" } + bind .t.f <Double-Button-1> { lappend x "Double" } event generate .t.f <a> - event generate .t.f <1> - event generate .t.f <1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f } -result {a11} -test bind-33.2 {should prefer most specific event} -setup { +test bind-33.2 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <Double-1> { lappend x "Double" } - bind .t.f <1><1> { lappend x "11" } - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Double-Button-1> { lappend x "Double" } + bind .t.f <Button-1><Button-1> { lappend x "11" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f - # This test case shows that old implementation has an issue, because - # it is expected that <Double-1> is matching, this binding - # is more specific. But new implementation will be conform to old, - # and so "11" is the expected result. -} -result {11} -test bind-33.3 {should prefer most specific event} -setup { +} -result {Double} +test bind-33.3 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <a><Double-1><a> { lappend x "Double" } - bind .t.f <a><1><1><a> { lappend x "11" } + bind .t.f <a><Double-Button-1><a> { lappend x "Double" } + bind .t.f <a><Button-1><Button-1><a> { lappend x "11" } event generate .t.f <a> - event generate .t.f <1> - event generate .t.f <1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { destroy .t.f - # Also this test case shows that old implementation has an issue, it is - # expected that <a><Double-1><a> is matching, because <Double-1> is more - # specific than <1><1>. But new implementation will be conform to old, - # and so "11" is the expected result. -} -result {11} +} -result {Double} test bind-33.4 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <1><1> { lappend x "11" } - bind .t.f <Double-1> { lappend x "Double" } - event generate .t.f <1> -time 0 - event generate .t.f <1> -time 1000 + bind .t.f <Button-1><Button-1> { lappend x "11" } + bind .t.f <Double-Button-1> { lappend x "Double" } + event generate .t.f <Button-1> -time 0 + event generate .t.f <Button-1> -time 1000 set x } -cleanup { destroy .t.f -} -result {11} +} -result 11 test bind-33.5 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <1><1> { lappend x "11" } - bind .t.f <Double-ButtonPress> { lappend x "Double" } - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button-1><Button-1> { lappend x "11" } + bind .t.f <Double-Button> { lappend x "Double" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f -} -result {11} +} -result 11 test bind-33.6 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <a><1><1><1><1><a> { lappend x "1111" } - bind .t.f <a><ButtonPress><Double-ButtonPress><ButtonPress><a> { lappend x "Any-Double-Any" } + bind .t.f <a><Button-1><Button-1><Button-1><Button-1><a> { lappend x "1111" } + bind .t.f <a><Button><Double-Button><Button><a> { lappend x "Any-Double-Any" } event generate .t.f <a> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { destroy .t.f -} -result {1111} +} -result 1111 test bind-33.7 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <ButtonPress-1><a> { lappend x "1" } - bind .t.f <ButtonPress><a> { lappend x "Any" } - event generate .t.f <1> + bind .t.f <Button-1><a> { lappend x "1" } + bind .t.f <Button><a> { lappend x "Any" } + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-33.8 {prefer most specific event} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <Double-ButtonPress-1><a> { lappend x "1" } - bind .t.f <ButtonPress><ButtonPress><a> { lappend x "Any" } - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Double-Button-1><a> { lappend x "1" } + bind .t.f <Button><Button><a> { lappend x "Any" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> event generate .t.f <a> set x } -cleanup { destroy .t.f -} -result {1} +} -result 1 test bind-33.9 {prefer last in case of homogeneous equal patterns} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <1><2><2><Double-1> { lappend x "first" } - bind .t.f <1><Double-2><1><1> { lappend x "last" } - event generate .t.f <1> - event generate .t.f <2> - event generate .t.f <2> - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button-1><Button-2><Button-2><Double-Button-1> { lappend x "first" } + bind .t.f <Button-1><Double-Button-2><Button-1><Button-1> { lappend x "last" } + event generate .t.f <Button-1> + event generate .t.f <Button-2> + event generate .t.f <Button-2> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f @@ -6524,13 +6618,13 @@ test bind-33.10 {prefer last in case of homogeneous equal patterns} -setup { update set x {} } -body { - bind .t.f <1><Double-2><1><1> { lappend x "first" } - bind .t.f <1><2><2><Double-1> { lappend x "last" } - event generate .t.f <1> - event generate .t.f <2> - event generate .t.f <2> - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button-1><Double-Button-2><Button-1><Button-1> { lappend x "first" } + bind .t.f <Button-1><Button-2><Button-2><Double-Button-1> { lappend x "last" } + event generate .t.f <Button-1> + event generate .t.f <Button-2> + event generate .t.f <Button-2> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f @@ -6541,35 +6635,31 @@ test bind-33.11 {should prefer most specific} -setup { update set x {} } -body { - bind .t.f <2><Double-1><Double-2><Double-1><2><2> { lappend x "first" } - bind .t.f <2><1><1><2><2><Double-1><Double-2> { lappend x "last" } - event generate .t.f <2> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <2> - event generate .t.f <2> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <2> - event generate .t.f <2> + bind .t.f <Button-2><Double-Button-1><Double-Button-2><Double-Button-1><Button-2><Button-2> { lappend x "first" } + bind .t.f <Button-2><Button-1><Button-1><Button-2><Button-2><Double-Button-1><Double-Button-2> { lappend x "last" } + event generate .t.f <Button-2> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-2> + event generate .t.f <Button-2> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-2> + event generate .t.f <Button-2> set x } -cleanup { destroy .t.f - # This test case shows that old implementation has an issue, because - # it is expected that first one is matching, this binding - # is more specific. But new implementation will be conform to old, - # and so "last" is the expected result. -} -result {last} +} -result {first} test bind-33.12 {prefer last in case of homogeneous equal patterns} -setup { pack [frame .t.f] focus -force .t.f update set x {} } -body { - bind .t.f <Control-1><1> { lappend x "first" } - bind .t.f <1><Control-1> { lappend x "last" } - event generate .t.f <Control-1> - event generate .t.f <Control-1> + bind .t.f <Control-Button-1><Button-1> { lappend x "first" } + bind .t.f <Button-1><Control-Button-1> { lappend x "last" } + event generate .t.f <Control-Button-1> + event generate .t.f <Control-Button-1> set x } -cleanup { destroy .t.f @@ -6580,10 +6670,10 @@ test bind-33.13 {prefer last in case of homogeneous equal patterns} -setup { update set x {} } -body { - bind .t.f <1><Control-1> { lappend x "first" } - bind .t.f <Control-1><1> { lappend x "last" } - event generate .t.f <Control-1> - event generate .t.f <Control-1> + bind .t.f <Button-1><Control-1> { lappend x "first" } + bind .t.f <Control-1><Button-1> { lappend x "last" } + event generate .t.f <Control-Button-1> + event generate .t.f <Control-Button-1> set x } -cleanup { destroy .t.f @@ -6597,12 +6687,12 @@ test bind-33.14 {prefer last in case of homogeneous equal patterns} -setup { update set x {} } -body { - bind .t.f <1><ButtonPress><1><ButtonPress> { lappend x "first" } - bind .t.f <ButtonPress><1><ButtonPress><1> { lappend x "last" } - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button-1><Button><Button-1><Button> { lappend x "first" } + bind .t.f <Button><Button-1><Button><Button-1> { lappend x "last" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f @@ -6613,12 +6703,12 @@ test bind-33.15 {prefer last in case of homogeneous equal patterns} -setup { update set x {} } -body { - bind .t.f <ButtonPress><1><ButtonPress><1> { lappend x "first" } - bind .t.f <1><ButtonPress><1><ButtonPress> { lappend x "last" } - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> - event generate .t.f <1> + bind .t.f <Button><Button-1><Button><Button-1> { lappend x "first" } + bind .t.f <Button-1><Button><Button-1><Button> { lappend x "last" } + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> + event generate .t.f <Button-1> set x } -cleanup { destroy .t.f @@ -6626,6 +6716,104 @@ test bind-33.15 {prefer last in case of homogeneous equal patterns} -setup { # because both bindings are homogeneous equal, so the most recently defined # must be preferred. } -result {last} +test bind-33.16 {simulate use of the keyboard to trigger a pattern sequence with modifier - bug [16ef161925]} -setup { + pack [frame .t.f] + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" } + event generate .t.f <Escape> + event generate .t.f <Control_L> + event generate .t.f <Control_L> + event generate .t.f <Control_L> + event generate .t.f <Control-c> + set x +} -cleanup { + destroy .t.f +} -result {Esc_Control-c} +test bind-33.17 {simulate use of the keyboard to trigger a pattern sequence with modifier - bug [16ef161925]} -setup { + pack [frame .t.f] + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" } + bind .t.f <Escape><Control_L><Control-c> { lappend x "Esc_Ctrl_L_Control-c" } + event generate .t.f <Escape> + event generate .t.f <Control_L> + event generate .t.f <Control_L> + event generate .t.f <Control_L> + event generate .t.f <Control-c> + set x +} -cleanup { + destroy .t.f +} -result {Esc_Ctrl_L_Control-c} +test bind-33.18 {simulate use of the keyboard to trigger a pattern sequence with modifier - bug [16ef161925]} -setup { + pack [frame .t.f] + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" } + bind .t.f <Escape><Control_L><Control-c> { lappend x "Esc_Ctrl_L_Control-c" } + bind .t.f <Escape><Control_L><Control_L><Control-c> { lappend x "Esc_Ctrl_L(2)_Control-c" } + event generate .t.f <Escape> + event generate .t.f <Control_L> + event generate .t.f <Control_L> + event generate .t.f <Control_L> + event generate .t.f <Control-c> + set x +} -cleanup { + destroy .t.f +} -result {Esc_Ctrl_L(2)_Control-c} +test bind-33.19 {simulate use of the keyboard to trigger a pattern sequence with modifier - bug [16ef161925]} -setup { + pack [frame .t.f] + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Escape><Control-c> { lappend x "Esc_Control-c" } + bind .t.f <Escape><Key><Key><Control-c> { lappend x "Esc_Key(2)_Control-c" } + event generate .t.f <Escape> + event generate .t.f <Alt_L> + event generate .t.f <Control_L> + event generate .t.f <Control-c> + set x +} -cleanup { + destroy .t.f +} -result {Esc_Key(2)_Control-c} +test bind-33.20 {simulate use of the keyboard to trigger a pattern sequence with mixed Key and Button types - bug [16ef161925]} -setup { + pack [frame .t.f] + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key-1><Button-1> { lappend x "1_Button1" } + event generate .t.f <Key-1> + event generate .t.f <KeyRelease-1> + event generate .t.f <Button-1> + set x +} -cleanup { + destroy .t.f +} -result {1_Button1} +test bind-33.21 {simulate use of the keyboard to trigger a pattern sequence with mixed Key and Button types - bug [16ef161925]} -setup { + pack [frame .t.f] + focus -force .t.f + update + set x {} +} -body { + bind .t.f <Key-1><Button-1> { lappend x "1_Button1" } + bind .t.f <Key-1><Button-1><Key-2> { lappend x "1_Button1_2" } + event generate .t.f <Key-1> + event generate .t.f <KeyRelease-1> + event generate .t.f <Button-1> + event generate .t.f <Key-2> + event generate .t.f <KeyRelease-2> + set x +} -cleanup { + destroy .t.f +} -result {1_Button1 1_Button1_2} test bind-34.1 {-warp works relatively to a window} -setup { toplevel .top @@ -6633,7 +6821,7 @@ test bind-34.1 {-warp works relatively to a window} -setup { update } -body { # In order to avoid platform-dependent coordinate results due to - # decorations and borders, this test warps the pointer twice + # decorations and borders, this test warps the pointer twice # relatively to a window that moved in the meantime, and checks # how much the pointer moved wm geometry .top +200+200 @@ -6655,7 +6843,7 @@ test bind-34.1 {-warp works relatively to a window} -setup { set res } -cleanup { destroy .top -} -result {1} +} -result 1 test bind-34.2 {-warp works relatively to the screen} -setup { } -body { # Contrary to bind-34.1, we're directly checking screen coordinates @@ -6699,7 +6887,138 @@ test bind-34.3 {-warp works with null or negative coordinates} -setup { } -cleanup { } -result {ok ok ok ok} -test bind-35.1 {pointer warp with grab on master, bug [e3888d5820]} -setup { +set keyInfo {} +set numericKeysym {} +proc testKey {window event type mods} { + global keyInfo numericKeysym + set keyInfo {} + set numericKeysym {} + bind $window <Key> { + set keyInfo [format "%K,0x%%X,0x%%X,%A" %N %k] + set numericKeysym %N + } + focus -force $window + update + event generate $window $event + if {$keyInfo == {}} { + vwait keyInfo + } + set save $keyInfo + set keyInfo {} + set injectcmd [list injectkeyevent $type $numericKeysym] + foreach {option} $mods { + lappend injectcmd $option + } + eval $injectcmd + if {$keyInfo == {}} { + vwait keyInfo + } + if {$save != $keyInfo} { + return "[format "0x%x" $numericKeysym] ($mods): $save != $keyInfo" + } + return pass +} +proc testKeyWithMods {window keysym type} { + set result [testKey $window "<$keysym>" $type {}] + if {$result != {pass}} { + return $result + } + set result [testKey $window "<Shift-$keysym>" $type {-shift}] + if {$result != {pass}} { + return $result + } + set result [testKey $window "<Option-$keysym>" $type {-option}] + if {$result != {pass}} { + return $result + } + set result [testKey $window "<Shift-Option-$keysym>" $type {-shift -option}] + if {$result != {pass}} { + return $result + } + return pass +} +test bind-35.0 {Generated and real key events agree} -constraints {aqua} -body { + foreach k {o O F2 Home Right Greek_sigma Greek_ALPHA} { + set result [testKeyWithMods . $k press] + if {$result != "pass"} { + return $result + } + } + return pass +} -cleanup { +} -result pass + +test bind-35.1 {Key events agree for entry widgets} -constraints {aqua} -setup { + toplevel .new + entry .new.e + pack .new.e +} -body { + foreach k {o O F2 Home Right Greek_sigma Greek_ALPHA Menu} { + set result [testKeyWithMods .new.e $k press] + if {$result != "pass"} { + return $result + } + } + return pass +} -cleanup { + destroy .new.e + destroy .new +} -result pass + +test bind-35.2 {Can bind to function keys} -constraints {aqua} -body { + global keyInfo numericKeysym + bind . <Key> {} + bind . <Key> { + lappend keyInfo %K + set numericKeysym %N + } + set keyInfo {} + set numericKeysym {} + focus -force . + event generate . <F2> + injectkeyevent press $numericKeysym -function + vwait keyInfo + return $keyInfo +} -cleanup { +} -result {F2 F2} + +test bind-35.3 {Events agree for modifier keys} -constraints {aqua} -setup { +} -body { + global keyInfo numericalKeysym + set result {} + bind . <Key> { + set keyInfo [format "%K,0x%%X,0x%%X,%A" %N %k] + set numericalKeysym [format "0x%x" %N] + } + foreach event { + {<Control_L> -control} + {<Control_R> -control} + {<Alt_L> -option} + {<Alt_R> -option} + {<Meta_L> -command} + {<Meta_R> -command} + {<Shift_L> -shift} + {<Shift_R> -shift} + } { + set keyInfo {} + event generate . [lindex $event 0] + if {$keyInfo == {}} { + vwait keyInfo + } + set save $keyInfo + injectkeyevent flagschanged $numericKeysym [lindex $event 1] + if {$keyInfo == {}} { + vwait keyInfo + } + if {$save != $keyInfo} { + return "$save != $keyInfo" + } + } + return pass +} -cleanup { +} -result pass + +test bind-36.1 {pointer warp with grab on toplevel, bug [e3888d5820]} -setup { event generate {} <Motion> -warp 1 -x 50 -y 50 toplevel .top grab release .top @@ -6728,7 +7047,7 @@ test bind-35.1 {pointer warp with grab on master, bug [e3888d5820]} -setup { } -cleanup { destroy .top unset x1 y1 x2 y2 -} -result {1} +} -result 1 # cleanup cleanupTests |