archie/tk4.2/tests/bind.test
2024-05-27 16:40:40 +02:00

2262 lines
68 KiB
Plaintext

# This file is a Tcl script to test out Tk's "bind" and "bindtags"
# commands plus the procedures in tkBind.c. It is organized in the
# standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) bind.test 1.26 96/10/10 11:41:19
if {[string compare test [info procs test]] != 0} {
source defs
}
catch {destroy .b}
toplevel .b -width 100 -height 50
wm geom .b +0+0
update idletasks
proc setup {} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
pack .b.f
focus -force .b.f
foreach p [event info] {event delete $p}
update
}
foreach i [bind Test] {
bind Test $i {}
}
foreach i [bind all] {
bind all $i {}
}
test bind-1.1 {bind command} {
list [catch {bind} msg] $msg
} {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
test bind-1.2 {bind command} {
list [catch {bind a b c d} msg] $msg
} {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
test bind-1.3 {bind command} {
list [catch {bind .gorp} msg] $msg
} {1 {bad window path name ".gorp"}}
test bind-1.4 {bind command} {
list [catch {bind foo} msg] $msg
} {0 {}}
test bind-1.5 {bind command} {
list [catch {bind .b <gorp-> {}} msg] $msg
} {0 {}}
test bind-1.6 {bind command} {
catch {destroy .b.f}
frame .b.f
bind .b.f <Enter> {test script}
set result [bind .b.f <Enter>]
bind .b.f <Enter> {}
list $result [bind .b.f <Enter>]
} {{test script} {}}
test bind-1.7 {bind command} {
catch {destroy .b.f}
frame .b.f
bind .b.f <Enter> {test script}
bind .b.f <Enter> {+more text}
bind .b.f <Enter>
} {test script
more text}
test bind-1.8 {bind command} {
list [catch {bind .b <gorp-> {test script}} msg] $msg [bind .b]
} {1 {bad event type or keysym "gorp"} {}}
test bind-1.9 {bind command} {
list [catch {bind .b <gorp->} msg] $msg
} {0 {}}
test bind-1.10 {bind command} {
catch {destroy .b.f}
frame .b.f
bind .b.f <Enter> {script 1}
bind .b.f <Leave> {script 2}
bind .b.f a {script for a}
bind .b.f b {script for b}
lsort [bind .b.f]
} {<Enter> <Leave> a b}
test bind-2.1 {bindtags command} {
list [catch {bindtags} msg] $msg
} {1 {wrong # args: should be "bindtags window ?tags?"}}
test bind-2.2 {bindtags command} {
list [catch {bindtags a b c} msg] $msg
} {1 {wrong # args: should be "bindtags window ?tags?"}}
test bind-2.3 {bindtags command} {
list [catch {bindtags .foo} msg] $msg
} {1 {bad window path name ".foo"}}
test bind-2.4 {bindtags command} {
bindtags .b
} {.b Toplevel all}
test bind-2.5 {bindtags command} {
catch {destroy .b.f}
frame .b.f
bindtags .b.f
} {.b.f Frame .b all}
test bind-2.6 {bindtags command} {
catch {destroy .b.f}
frame .b.f
bindtags .b.f {{x y z} b c d}
bindtags .b.f
} {{x y z} b c d}
test bind-2.7 {bindtags command} {
catch {destroy .b.f}
frame .b.f
bindtags .b.f {x y z}
bindtags .b.f {}
bindtags .b.f
} {.b.f Frame .b all}
test bind-2.8 {bindtags command} {
catch {destroy .b.f}
frame .b.f
bindtags .b.f {x y z}
bindtags .b.f {a b c d}
bindtags .b.f
} {a b c d}
test bind-2.9 {bindtags command} {
catch {destroy .b.f}
frame .b.f
bindtags .b.f {a b c}
list [catch {bindtags .b.f "\{"} msg] $msg [bindtags .b.f]
} {1 {unmatched open brace in list} {.b.f Frame .b all}}
test bind-2.10 {bindtags command} {
catch {destroy .b.f}
frame .b.f
bindtags .b.f {a b c}
list [catch {bindtags .b.f "a .gorp b"} msg] $msg [bindtags .b.f]
} {0 {} {a .gorp b}}
test bind-3.1 {TkFreeBindingTags procedure} {
catch {destroy .b.f}
frame .b.f
bindtags .b.f "a b c d"
destroy .b.f
} {}
test bind-3.2 {TkFreeBindingTags procedure} {
catch {destroy .b.f}
frame .b.f
catch {bindtags .b.f "a .gorp b .b.f"}
destroy .b.f
} {}
bind all <Enter> {lappend x "%W enter all"}
bind Test <Enter> {lappend x "%W enter frame"}
bind Toplevel <Enter> {lappend x "%W enter toplevel"}
bind xyz <Enter> {lappend x "%W enter xyz"}
bind {a b} <Enter> {lappend x "%W enter {a b}"}
bind .b <Enter> {lappend x "%W enter .b"}
test bind-4.1 {TkBindEventProc procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
pack .b.f
update
bind .b.f <Enter> {lappend x "%W enter .b.f"}
set x {}
event gen .b.f <Enter>
set x
} {{.b.f enter .b.f} {.b.f enter frame} {.b.f enter .b} {.b.f enter all}}
test bind-4.2 {TkBindEventProc procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
pack .b.f
update
bind .b.f <Enter> {lappend x "%W enter .b.f"}
bindtags .b.f {.b.f {a b} xyz}
set x {}
event gen .b.f <Enter>
set x
} {{.b.f enter .b.f} {.b.f enter {a b}} {.b.f enter xyz}}
test bind-4.3 {TkBindEventProc procedure} {
set x {}
event gen .b <Enter>
set x
} {{.b enter .b} {.b enter toplevel} {.b enter all}}
test bind-4.4 {TkBindEventProc procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
pack .b.f
update
bindtags .b.f {.b.f .b.f2 .b.f3}
frame .b.f3 -width 50 -height 50
pack .b.f3
bind .b.f <Enter> {lappend x "%W enter .b.f"}
bind .b.f3 <Enter> {lappend x "%W enter .b.f3"}
set x {}
event gen .b.f <Enter>
destroy .b.f3
set x
} {{.b.f enter .b.f} {.b.f enter .b.f3}}
test bind-4.5 {TkBindEventProc procedure} {
# This tests memory allocation for objPtr; it won't serve any useful
# purpose unless run with some sort of allocation checker turned on.
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
pack .b.f
update
bindtags .b.f {a b c d e f g h i j k l m n o p q r s t u v w x y z}
event gen .b.f <Enter>
} {}
bind all <Enter> {}
bind Test <Enter> {}
bind Toplevel <Enter> {}
bind xyz <Enter> {}
bind {a b} <Enter> {}
bind .b <Enter> {}
test bind-5.1 {Tk_CreateBindingTable procedure} {
catch {destroy .b.c}
canvas .b.c
.b.c bind foo
} {}
test bind-6.1 {Tk_DeleteBindTable procedure} {
catch {destroy .b.c}
canvas .b.c
.b.c bind foo <1> {string 1}
.b.c create rectangle 0 0 100 100
.b.c bind 1 <2> {string 2}
destroy .b.c
} {}
test bind-7.1 {Tk_CreateBinding procedure} {
catch {destroy .b.c}
canvas .b.c
list [catch {.b.c bind foo <} msg] $msg
} {1 {no event type or button # or keysym}}
test bind-7.2 {Tk_CreateBinding procedure} {
catch {destroy .b.c}
canvas .b.c
.b.c bind foo <1> "button 1"
.b.c bind foo <1> "+more button 1"
.b.c bind foo <1>
} {button 1
more button 1}
test bind-7.3 {Tk_CreateBinding procedure} {
catch {destroy .b.c}
canvas .b.c
.b.c bind foo <1> "+button 1"
.b.c bind foo <1>
} {button 1}
test bind-8.1 {Tk_DeleteBinding procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
list [catch {bind .b.f <} msg] $msg
} {0 {}}
test bind-8.2 {Tk_DeleteBinding procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
foreach i {a b c d} {
bind .b.f $i "binding for $i"
}
set result {}
foreach i {b d a c} {
bind .b.f $i {}
lappend result [lsort [bind .b.f]]
}
set result
} {{a c d} {a c} c {}}
test bind-8.3 {Tk_DeleteBinding procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} {
bind .b.f $i "binding for $i"
}
set result {}
foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} {
bind .b.f $i {}
lappend result [lsort [bind .b.f]]
}
set result
} {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}}
test bind-9.1 {Tk_GetBinding procedure} {
catch {destroy .b.c}
canvas .b.c
list [catch {.b.c bind foo <} msg] $msg
} {1 {no event type or button # or keysym}}
test bind-9.2 {Tk_GetBinding procedure} {
catch {destroy .b.c}
canvas .b.c
.b.c bind foo a Test
.b.c bind foo a
} {Test}
test bind-10.1 {Tk_GetAllBindings procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" {
bind .b.f $i Test
}
lsort [bind .b.f]
} {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~}
test bind-10.2 {Tk_GetAllBindings procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" {
bind .b.f $i Test
}
lsort [bind .b.f]
} {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>}
test bind-10.3 {Tk_GetAllBindings procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
foreach i "<Double-Triple-1> abcd a<Leave>b" {
bind .b.f $i Test
}
lsort [bind .b.f]
} {<Triple-Button-1> a<Leave>b abcd}
test bind-11.1 {Tk_DeleteAllBindings procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
destroy .b.f
} {}
test bind-11.2 {Tk_DeleteAllBindings procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
foreach i "a b c <Meta-1> <Alt-a> <Control-a>" {
bind .b.f $i x
}
destroy .b.f
} {}
bind Test <KeyPress> {lappend x "%W %K Test press any"}
bind all <KeyPress> {lappend x "%W %K all press any"}
bind Test a {lappend x "%W %K Test press a"}
bind all x {lappend x "%W %K all press x"}
test bind-12.1 {Tk_BindEvent procedure} {
setup
bind .b.f a {lappend x "%W %K .b.f press a"}
set x {}
event gen .b.f <Key-a>
event gen .b.f <Key-b>
event gen .b.f <Key-x>
set x
} {{.b.f a .b.f press a} {.b.f a Test press a} {.b.f a all press any} {.b.f b Test press any} {.b.f b all press any} {.b.f x Test press any} {.b.f x all press x}}
bind Test <KeyPress> {lappend x "%W %K Test press any"; break}
bind all <KeyPress> {continue; lappend x "%W %K all press any"}
test bind-12.2 {Tk_BindEvent procedure} {
setup
bind .b.f b {lappend x "%W %K .b.f press a"}
set x {}
event gen .b.f <Key-b>
set x
} {{.b.f b .b.f press a} {.b.f b Test press any}}
if {[info procs bgerror] == "bgerror"} {
rename bgerror {}
}
proc bgerror args {}
bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test}
test bind-12.3 {Tk_BindEvent procedure} {
setup
bind .b.f b {lappend x "%W %K .b.f press a"}
set x {}
event gen .b.f <Key-b>
update
list $x $errorInfo
} {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test
while executing
"error Test"
(command bound to event)}}
rename bgerror {}
test bind-12.4 {Tk_BindEvent procedure} {
proc foo {} {
set x 44
event gen .b.f <Key-a>
}
setup
bind .b.f a {lappend x "%W %K .b.f press a"}
set x {}
foo
set x
} {{.b.f a .b.f press a} {.b.f a Test press a}}
test bind-12.5 {Tk_BindEvent procedure} {
bind all <Destroy> {lappend x "%W destroyed"}
set x {}
list [catch {frame .b.g -gorp foo} msg] $msg $x
} {1 {unknown option "-gorp"} {{.b.g destroyed}}}
foreach i [bind all] {
bind all $i {}
}
foreach i [bind Test] {
bind Test $i {}
}
test bind-12.6 {Tk_BindEvent procedure} {
setup
bind .b.f z {lappend x "%W z (.b.f binding)"}
bind Test z {lappend x "%W z (.b.f binding)"}
bind all z {bind .b.f z {}; lappend x "%W z (.b.f binding)"}
set x {}
event gen .b.f <Key-z>
set x
} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
test bind-12.7 {Tk_BindEvent procedure} {
setup
bind .b.f z {lappend x "%W z (.b.f binding)"}
bind Test z {lappend x "%W z (.b.f binding)"}
bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"}
set x {}
event gen .b.f <Key-z>
set x
} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
test bind-12.8 {Tk_BindEvent procedure} {
setup
bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"}
bind .b.f <ButtonPress> {lappend x "%W z (.b.f <ButtonPress> binding)"}
set x {}
event gen .b.f <Button-1>
event gen .b.f <Button-2>
set x
} {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f <ButtonPress> binding)}}
test bind-12.9 {Tk_BindEvent procedure: ignore NotifyInferior} {
setup
bind .b.f <Enter> "lappend x Enter%#"
bind .b.f <Leave> "lappend x Leave%#"
set x {}
event gen .b.f <Enter> -serial 100 -detail NotifyAncestor
event gen .b.f <Enter> -serial 101 -detail NotifyInferior
event gen .b.f <Leave> -serial 102 -detail NotifyAncestor
event gen .b.f <Leave> -serial 103 -detail NotifyInferior
set x
} {Enter100 Leave102}
test bind-12.10 {Tk_BindEvent procedure: collapse Motions} {
setup
bind .b.f <Motion> "lappend x Motion%#(%x,%y)"
set x {}
event gen .b.f <Motion> -serial 100 -x 100 -y 200 -when tail
update
event gen .b.f <Motion> -serial 101 -x 200 -y 300 -when tail
event gen .b.f <Motion> -serial 102 -x 300 -y 400 -when tail
update
set x
} {Motion100(100,200) Motion102(300,400)}
test bind-12.11 {Tk_BindEvent procedure: collapse repeating modifiers} {
setup
bind .b.f <Key> "lappend x %K%#"
bind .b.f <KeyRelease> "lappend x %K%#"
event gen .b.f <Key-Shift_L> -serial 100 -when tail
event gen .b.f <KeyRelease-Shift_L> -serial 101 -when tail
event gen .b.f <Key-Shift_L> -serial 102 -when tail
event gen .b.f <KeyRelease-Shift_L> -serial 103 -when tail
update
} {}
test bind-12.12 {Tk_BindEvent procedure: valid key detail} {
setup
bind .b.f <Key> "lappend x Key%K"
bind .b.f <KeyRelease> "lappend x Release%K"
set x {}
event gen .b.f <Key> -keysym a
event gen .b.f <KeyRelease> -keysym a
set x
} {Keya Releasea}
test bind-12.13 {Tk_BindEvent procedure: invalid key detail} {
setup
bind .b.f <Key> "lappend x Key%K"
bind .b.f <KeyRelease> "lappend x Release%K"
set x {}
event gen .b.f <Key> -keycode 0
event gen .b.f <KeyRelease> -keycode 0
set x
} {Key?? Release??}
test bind-12.14 {Tk_BindEvent procedure: button detail} {
setup
bind .b.f <Button> "lappend x Button%b"
bind .b.f <ButtonRelease> "lappend x Release%b"
set x {}
event gen .b.f <Button> -button 1
event gen .b.f <ButtonRelease> -button 3
set x
} {Button1 Release3}
test bind-12.15 {Tk_BindEvent procedure: virtual detail} {
setup
bind .b.f <<Paste>> "lappend x Paste"
set x {}
event gen .b.f <<Paste>>
set x
} {Paste}
test bind-12.16 {Tk_BindEvent procedure: virtual event in event stream} {
setup
bind .b.f <<Paste>> "lappend x Paste"
set x {}
event gen .b.f <<Paste>>
set x
} {Paste}
test bind-12.17 {Tk_BindEvent procedure: match detail physical} {
setup
bind .b.f <Button-2> {set x Button-2}
event add <<Paste>> <Button-2>
bind .b.f <<Paste>> {set x Paste}
set x {}
event gen .b.f <Button-2>
set x
} {Button-2}
test bind-12.18 {Tk_BindEvent procedure: no match detail physical} {
setup
event add <<Paste>> <Button-2>
bind .b.f <<Paste>> {set x Paste}
set x {}
event gen .b.f <Button-2>
set x
} {Paste}
test bind-12.19 {Tk_BindEvent procedure: match detail virtual} {
setup
event add <<Paste>> <Button-2>
bind .b.f <<Paste>> "lappend x Paste"
set x {}
event gen .b.f <Button-2>
set x
} {Paste}
test bind-12.20 {Tk_BindEvent procedure: no match detail virtual} {
setup
event add <<Paste>> <Button-2>
bind .b.f <<Paste>> "lappend x Paste"
set x {}
event gen .b.f <Button>
set x
} {}
test bind-12.20a {Tk_BindEvent procedure: match no-detail physical} {
setup
bind .b.f <Button> {set x Button}
event add <<Paste>> <Button>
bind .b.f <<Paste>> {set x Paste}
set x {}
event gen .b.f <Button-2>
set x
} {Button}
test bind-12.20b {Tk_BindEvent procedure: no match no-detail physical} {
setup
event add <<Paste>> <Button>
bind .b.f <<Paste>> {set x Paste}
set x {}
event gen .b.f <Button-2>
set x
} {Paste}
test bind-12.20c {Tk_BindEvent procedure: match no-detail virtual} {
setup
event add <<Paste>> <Button>
bind .b.f <<Paste>> "lappend x Paste"
set x {}
event gen .b.f <Button-2>
set x
} {Paste}
test bind-12.20d {Tk_BindEvent procedure: no match no-detail virtual} {
setup
event add <<Paste>> <Key>
bind .b.f <<Paste>> "lappend x Paste"
set x {}
event gen .b.f <Button>
set x
} {}
test bind-12.20e {Tk_BindEvent procedure: precedence} {
setup
event add <<Paste>> <Button-2>
event add <<Copy>> <Button>
bind .b.f <Button-2> "lappend x Button-2"
bind .b.f <<Paste>> "lappend x Paste"
bind .b.f <Button> "lappend x Button"
bind .b.f <<Copy>> "lappend x Copy"
set x {}
event gen .b.f <Button-2>
bind .b.f <Button-2> {}
event gen .b.f <Button-2>
bind .b.f <<Paste>> {}
event gen .b.f <Button-2>
bind .b.f <Button> {}
event gen .b.f <Button-2>
bind .b.f <<Copy>> {}
event gen .b.f <Button-2>
set x
} {Button-2 Paste Button Copy}
test bind-12.21 {Tk_BindEvent procedure: no detail virtual pattern list} {
setup
bind .b.f <Button-2> {set x Button-2}
set x {}
event gen .b.f <Button-2>
set x
} {Button-2}
test bind-12.22 {Tk_BindEvent procedure: detail virtual pattern list} {
setup
event add <<Paste>> <Button-2>
bind .b.f <<Paste>> {set x Paste}
set x {}
event gen .b.f <Button-2>
set x
} {Paste}
test bind-12.24 {Tk_BindEvent procedure: no no-detail virtual pattern list} {
setup
bind .b.f <Button> {set x Button}
set x {}
event gen .b.f <Button-2>
set x
} {Button}
test bind-12.25 {Tk_BindEvent procedure: no-detail virtual pattern list} {
setup
event add <<Paste>> <Button>
bind .b.f <<Paste>> {set x Paste}
set x {}
event gen .b.f <Button-2>
set x
} {Paste}
test bind-12.26 {Tk_BindEvent procedure: no match} {
setup
event gen .b.f <Button-2>
} {}
test bind-12.27 {Tk_BindEvent procedure: match} {
setup
bind .b.f <Button-2> {set x Button-2}
set x {}
event gen .b.f <Button-2>
set x
} {Button-2}
test bind-12.28 {Tk_BindEvent procedure: other tags} {
setup
bind .b.f <Button-2> {lappend x .b.f}
bind Test <Button-2> {lappend x Button}
set x {}
event gen .b.f <Button-2>
bind Test <Button-2> {}
set x
} {.b.f Button}
test bind-12.29 {Tk_BindEvent procedure: continue in script} {
setup
bind .b.f <Button-2> {lappend x b1; continue; lappend x b2}
bind Test <Button-2> {lappend x B1; continue; lappend x B2}
set x {}
event gen .b.f <Button-2>
bind Test <Button-2> {}
set x
} {b1 B1}
test bind-12.30 {Tk_BindEvent procedure: break in script} {
setup
bind .b.f <Button-2> {lappend x b1; break; lappend x b2}
bind Test <Button-2> {lappend x B1; break; lappend x B2}
set x {}
event gen .b.f <Button-2>
bind Test <Button-2> {}
set x
} {b1}
proc bgerror msg {
global x
lappend x $msg
}
test bind-12.31 {Tk_BindEvent procedure: error in script} {
setup
bind .b.f <Button-2> {lappend x b1; blap}
bind Test <Button-2> {lappend x B1}
set x {}
event gen .b.f <Button-2>
update
bind Test <Button-2> {}
set x
} {b1 {invalid command name "blap"}}
test bind-13.1 {MatchPatterns procedure, ignoring type mismatches} {
setup
bind .b.f ab {set x 1}
set x 0
event gen .b.f <Key-a>
event gen .b.f <KeyRelease-a>
event gen .b.f <Key-b>
event gen .b.f <KeyRelease-b>
set x
} 1
test bind-13.2 {MatchPatterns procedure, ignoring type mismatches} {
setup
bind .b.f ab {set x 1}
set x 0
event gen .b.f <Key-a>
event gen .b.f <Enter>
event gen .b.f <KeyRelease-a>
event gen .b.f <Leave>
event gen .b.f <Key-b>
event gen .b.f <KeyRelease-b>
set x
} 1
test bind-13.3 {MatchPatterns procedure, ignoring type mismatches} {
setup
bind .b.f ab {set x 1}
set x 0
event gen .b.f <Key-a>
event gen .b.f <Button-1>
event gen .b.f <Key-b>
set x
} 0
test bind-13.4 {MatchPatterns procedure, ignoring type mismatches} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1>
event gen .b.f <ButtonRelease-1>
event gen .b.f <Button-1>
event gen .b.f <ButtonRelease-1>
set x
} 1
test bind-13.5 {MatchPatterns procedure, ignoring type mismatches} {
setup
bind .b.f <Double-ButtonRelease> {set x 1}
set x 0
event gen .b.f <Button-1>
event gen .b.f <ButtonRelease-1>
event gen .b.f <Button-2>
event gen .b.f <ButtonRelease-2>
set x
} 1
test bind-13.6 {MatchPatterns procedure, ignoring type mismatches} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1>
event gen .b.f <Key-a>
event gen .b.f <ButtonRelease-1>
event gen .b.f <Button-1>
event gen .b.f <ButtonRelease-1>
set x
} 0
test bind-13.7 {MatchPatterns procedure, ignoring type mismatches} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1>
event gen .b.f <Key-Shift_L>
event gen .b.f <ButtonRelease-1>
event gen .b.f <Button-1>
event gen .b.f <ButtonRelease-1>
set x
} 1
test bind-13.8 {MatchPatterns procedure, ignoring type mismatches} {
setup
bind .b.f ab {set x 1}
set x 0
event gen .b.f <Key-a>
event gen .b.f <Key-c>
event gen .b.f <Key-b>
set x
} 0
test bind-13.9 {MatchPatterns procedure, modifier checks} {
setup
bind .b.f <M1-M2-Key> {set x 1}
set x 0
event gen .b.f <Key-a> -state 0x18
set x
} 1
test bind-13.10 {MatchPatterns procedure, modifier checks} {
setup
bind .b.f <M1-M2-Key> {set x 1}
set x 0
event gen .b.f <Key-a> -state 0xfc
set x
} 1
test bind-13.11 {MatchPatterns procedure, modifier checks} {
setup
bind .b.f <M1-M2-Key> {set x 1}
set x 0
event gen .b.f <Key-a> -state 0x8
set x
} 0
test bind-13.12 {MatchPatterns procedure, ignore modifier presses and releases} {nonPortable} {
# This test is non-portable because the Shift_L keysym may behave
# differently on some platforms.
setup
bind .b.f aB {set x 1}
set x 0
event gen .b.f <Key-a>
event gen .b.f <Key-Shift_L>
event gen .b.f <Key-b> -state 1
set x
} 1
test bind-13.13 {MatchPatterns procedure, checking detail} {
setup
bind .b.f ab {set x 1}
set x 0
event gen .b.f <Key-a>
event gen .b.f <Key-c>
set x
} 0
test bind-13.14 {MatchPatterns procedure, checking "nearby"} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -x 30 -y 40
event gen .b.f <Button-1> -x 31 -y 39
set x
} 1
test bind-13.15 {MatchPatterns procedure, checking "nearby"} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -x 30 -y 40
event gen .b.f <Button-1> -x 29 -y 41
set x
} 1
test bind-13.16 {MatchPatterns procedure, checking "nearby"} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -x 30 -y 40
event gen .b.f <Button-1> -x 40 -y 40
set x
} 0
test bind-13.17 {MatchPatterns procedure, checking "nearby"} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -x 30 -y 40
event gen .b.f <Button-1> -x 20 -y 40
set x
} 0
test bind-13.18 {MatchPatterns procedure, checking "nearby"} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -x 30 -y 40
event gen .b.f <Button-1> -x 30 -y 30
set x
} 0
test bind-13.19 {MatchPatterns procedure, checking "nearby"} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -x 30 -y 40
event gen .b.f <Button-1> -x 30 -y 50
set x
} 0
test bind-13.20 {MatchPatterns procedure, checking "nearby"} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -time 300
event gen .b.f <Button-1> -time 700
set x
} 1
test bind-13.21 {MatchPatterns procedure, checking "nearby"} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -time 300
event gen .b.f <Button-1> -time 900
set x
} 0
test bind-13.22 {MatchPatterns procedure, time wrap-around} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -time [expr -100]
event gen .b.f <Button-1> -time 200
set x
} 1
test bind-13.23 {MatchPatterns procedure, time wrap-around} {
setup
bind .b.f <Double-1> {set x 1}
set x 0
event gen .b.f <Button-1> -time -100
event gen .b.f <Button-1> -time 500
set x
} 0
test bind-13.24 {MatchPatterns procedure, virtual event} {
setup
event add <<Paste>> <Button-1>
bind .b.f <<Paste>> {lappend x paste}
set x {}
event gen .b.f <Button-1>
set x
} {paste}
test bind-13.25 {MatchPatterns procedure, reject a virtual event} {
setup
event add <<Paste>> <Shift-Button-1>
bind .b.f <<Paste>> {lappend x paste}
set x {}
event gen .b.f <Button-1>
set x
} {}
test bind-13.26 {MatchPatterns procedure, reject a virtual event} {
setup
event add <<V1>> <Button>
event add <<V2>> <Button-1>
event add <<V3>> <Shift-Button-1>
bind .b.f <<V2>> "lappend x V2%#"
set x {}
event gen .b.f <Button> -serial 101
event gen .b.f <Button-1> -serial 102
event gen .b.f <Shift-Button-1> -serial 103
bind .b.f <Shift-Button-1> "lappend x Shift-Button-1"
event gen .b.f <Button> -serial 104
event gen .b.f <Button-1> -serial 105
event gen .b.f <Shift-Button-1> -serial 106
set x
} {V2102 V2103 V2105 Shift-Button-1}
test bind-13.27 {MatchPatterns procedure, conflict resolution} {
setup
bind .b.f <KeyPress> {set x 0}
bind .b.f a {set x 1}
set x none
event gen .b.f <Key-a>
set x
} 1
test bind-13.28 {MatchPatterns procedure, conflict resolution} {
setup
bind .b.f <KeyPress> {set x 0}
bind .b.f a {set x 1}
set x none
event gen .b.f <Key-b>
set x
} 0
test bind-13.29 {MatchPatterns procedure, conflict resolution} {
setup
bind .b.f <KeyPress> {lappend x 0}
bind .b.f a {lappend x 1}
bind .b.f ba {lappend x 2}
set x none
event gen .b.f <Key-b>
event gen .b.f <KeyRelease-b>
event gen .b.f <Key-a>
set x
} {none 0 2}
test bind-13.30 {MatchPatterns procedure, conflict resolution} {
setup
bind .b.f <ButtonPress> {set x 0}
bind .b.f <1> {set x 1}
set x none
event gen .b.f <Button-1>
set x
} 1
test bind-13.31 {MatchPatterns procedure, conflict resolution} {
setup
bind .b.f <M1-Key> {set x 0}
bind .b.f <M2-Key> {set x 1}
set x none
event gen .b.f <Key-a> -state 0x18
set x
} 1
test bind-13.32 {MatchPatterns procedure, conflict resolution} {
setup
bind .b.f <M2-Key> {set x 0}
bind .b.f <M1-Key> {set x 1}
set x none
event gen .b.f <Key-a> -state 0x18
set x
} 1
test bind-13.33 {MatchPatterns procedure, conflict resolution} {
setup
bind .b.f <1> {lappend x single}
bind Test <1> {lappend x single(Test)}
bind Test <Double-1> {lappend x double(Test)}
set x {}
event gen .b.f <Button-1>
event gen .b.f <Button-1>
event gen .b.f <Button-1>
set x
} {single single(Test) single double(Test) single double(Test)}
foreach i [bind Test] {
bind Test $i {}
}
test bind-14.1 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x abcd}
set x none
event gen .b.f <Enter>
set x
} abcd
test bind-14.2 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x %#}
set x none
event gen .b.f <Enter> -serial 1234
set x
} 1234
test bind-14.3 {ExpandPercents procedure} {
setup
bind .b.f <Configure> {set x %a}
set x none
event gen .b.f <Configure> -above .b -window .b.f
set x
} [winfo id .b]
test bind-14.4 {ExpandPercents procedure} {
setup
bind .b.f <Button> {set x %b}
set x none
event gen .b.f <Button-3>
set x
} 3
test bind-14.5 {ExpandPercents procedure} {
setup
bind .b.f <Expose> {set x %c}
set x none
event gen .b.f <Expose> -count 47
set x
} 47
test bind-14.6 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x %d}
set x none
event gen .b.f <Enter> -detail NotifyAncestor
set x
} NotifyAncestor
test bind-14.7 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x %d}
set x none
event gen .b.f <Enter> -detail NotifyVirtual
set x
} NotifyVirtual
test bind-14.8 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x %d}
set x none
event gen .b.f <Enter> -detail NotifyNonlinear
set x
} NotifyNonlinear
test bind-14.9 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x %d}
set x none
event gen .b.f <Enter> -detail NotifyNonlinearVirtual
set x
} NotifyNonlinearVirtual
test bind-14.10 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x %d}
set x none
event gen .b.f <Enter> -detail NotifyPointer
set x
} NotifyPointer
test bind-14.11 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x %d}
set x none
event gen .b.f <Enter> -detail NotifyPointerRoot
set x
} NotifyPointerRoot
test bind-14.12 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x %d}
set x none
event gen .b.f <Enter> -detail NotifyDetailNone
set x
} NotifyDetailNone
test bind-14.13 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x %f}
set x none
event gen .b.f <Enter> -focus 1
set x
} 1
test bind-14.14 {ExpandPercents procedure} {
setup
bind .b.f <Expose> {set x "%x %y %w %h"}
set x none
event gen .b.f <Expose> -x 24 -y 18 -width 147 -height 61
set x
} {24 18 147 61}
test bind-14.15 {ExpandPercents procedure} {
setup
bind .b.f <Configure> {set x "%x %y %w %h"}
set x none
event gen .b.f <Configure> -x 24 -y 18 -width 147 -height 61 -window .b.f
set x
} {24 18 147 61}
test bind-14.16 {ExpandPercents procedure} {
setup
bind .b.f <Key> {set x "%k"}
set x none
event gen .b.f <Key> -keycode 146
set x
} 146
test bind-14.17 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x "%m"}
set x none
event gen .b.f <Enter> -mode NotifyNormal
set x
} NotifyNormal
test bind-14.18 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x "%m"}
set x none
event gen .b.f <Enter> -mode NotifyGrab
set x
} NotifyGrab
test bind-14.19 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x "%m"}
set x none
event gen .b.f <Enter> -mode NotifyUngrab
set x
} NotifyUngrab
test bind-14.20 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x "%m"}
set x none
event gen .b.f <Enter> -mode NotifyWhileGrabbed
set x
} NotifyWhileGrabbed
test bind-14.21 {ExpandPercents procedure} {
setup
bind .b.f <Map> {set x "%o"}
set x none
event gen .b.f <Map> -override 1 -window .b.f
set x
} 1
test bind-14.22 {ExpandPercents procedure} {
setup
bind .b.f <Reparent> {set x "%o"}
set x none
event gen .b.f <Reparent> -override true -window .b.f
set x
} 1
test bind-14.23 {ExpandPercents procedure} {
setup
bind .b.f <Configure> {set x "%o"}
set x none
event gen .b.f <Configure> -override 1 -window .b.f
set x
} 1
test bind-14.24 {ExpandPercents procedure} {
setup
bind .b.f <Circulate> {set x "%p"}
set x none
event gen .b.f <Circulate> -place PlaceOnTop -window .b.f
set x
} PlaceOnTop
test bind-14.25 {ExpandPercents procedure} {
setup
bind .b.f <Circulate> {set x "%p"}
set x none
event gen .b.f <Circulate> -place PlaceOnBottom -window .b.f
set x
} PlaceOnBottom
test bind-14.27 {ExpandPercents procedure} {
setup
bind .b.f <1> {set x "%s"}
set x none
event gen .b.f <Button-1> -state 122
set x
} 122
test bind-14.28 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x "%s"}
set x none
event gen .b.f <Enter> -state 0x3ff
set x
} 1023
test bind-14.29 {ExpandPercents procedure} {
setup
bind .b.f <Visibility> {set x "%s"}
set x none
event gen .b.f <Visibility> -state VisibilityPartiallyObscured
set x
} VisibilityPartiallyObscured
test bind-14.30 {ExpandPercents procedure} {
setup
bind .b.f <Visibility> {set x "%s"}
set x none
event gen .b.f <Visibility> -state VisibilityUnobscured
set x
} VisibilityUnobscured
test bind-14.31 {ExpandPercents procedure} {
setup
bind .b.f <Visibility> {set x "%s"}
set x none
event gen .b.f <Visibility> -state VisibilityFullyObscured
set x
} VisibilityFullyObscured
test bind-14.32 {ExpandPercents procedure} {
setup
bind .b.f <Button> {set x "%t"}
set x none
event gen .b.f <Button> -time 4294
set x
} 4294
test bind-14.33 {ExpandPercents procedure} {
setup
bind .b.f <Button> {set x "%x %y"}
set x none
event gen .b.f <Button> -x 881 -y 432
set x
} {881 432}
test bind-14.34 {ExpandPercents procedure} {
setup
bind .b.f <Reparent> {set x "%x %y"}
set x none
event gen .b.f <Reparent> -x 882 -y 431 -window .b.f
set x
} {882 431}
test bind-14.35 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x "%x %y"}
set x none
event gen .b.f <Enter> -x 781 -y 632
set x
} {781 632}
test bind-14.36 {ExpandPercents procedure} {nonPortable} {
setup
bind .b.f <Key> {lappend x "%A"}
set x {}
event gen .b.f <Key-a>
event gen .b.f <Key-A> -state 1
event gen .b.f <Key-Tab>
event gen .b.f <Key-Return>
event gen .b.f <Key-F1>
event gen .b.f <Key-Shift_L>
event gen .b.f <Key-space>
event gen .b.f <Key-dollar> -state 1
event gen .b.f <Key-braceleft> -state 1
set x
} "a A { } {\r} {{}} {{}} { } {\$} \\\{"
test bind-14.37 {ExpandPercents procedure} {
setup
bind .b.f <Configure> {set x "%B"}
set x none
event gen .b.f <Configure> -borderwidth 24 -window .b.f
set x
} 24
test bind-14.38 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x "%E"}
set x none
event gen .b.f <Enter> -sendevent 1
set x
} 1
test bind-14.39 {ExpandPercents procedure} {nonPortable} {
setup
bind .b.f <Key> {lappend x %K}
set x {}
event gen .b.f <Key-a>
event gen .b.f <Key-A> -state 1
event gen .b.f <Key-Tab>
event gen .b.f <Key-F1>
event gen .b.f <Key-Shift_L>
event gen .b.f <Key-space>
event gen .b.f <Key-dollar> -state 1
event gen .b.f <Key-braceleft> -state 1
set x
} {a A Tab F1 Shift_L space dollar braceleft}
test bind-14.40 {ExpandPercents procedure} {
setup
bind .b.f <Key> {set x "%N"}
set x none
event gen .b.f <Key-a>
set x
} 97
test bind-14.41 {ExpandPercents procedure} {
setup
bind .b.f <Key> {set x "%S"}
set x none
event gen .b.f <Key-a> -subwindow .b
set x
} [winfo id .b]
test bind-14.42 {ExpandPercents procedure} {
setup
bind .b.f <Key> {set x "%T"}
set x none
event gen .b.f <Key>
set x
} 2
test bind-14.43 {ExpandPercents procedure} {
setup
bind .b.f <Key> {set x "%W"}
set x none
event gen .b.f <Key>
set x
} .b.f
test bind-14.44 {ExpandPercents procedure} {
setup
bind .b.f <Button> {set x "%X %Y"}
set x none
event gen .b.f <Button> -rootx 422 -rooty 13
set x
} {422 13}
test bind-15.1 {event command} {
list [catch {event} msg] $msg
} {1 {wrong # args: should be "event option ?arg1?"}}
test bind-15.2 {event command} {
list [catch {event {}} msg] $msg
} {1 {bad option "": should be add, delete, generate, info}}
test bind-15.3 {event command: add} {
list [catch {event add} msg] $msg
} {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}}
test bind-15.4 {event command: add 1} {
setup
event add <<Paste>> <Control-v>
event info <<Paste>>
} {<Control-Key-v>}
test bind-15.5 {event command: add 2} {
setup
event add <<Paste>> <Control-v> <Button-2>
lsort [event info <<Paste>>]
} {<Button-2> <Control-Key-v>}
test bind-15.6 {event command: add with error} {
setup
list [catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>} \
msg] $msg [lsort [event info <<Paste>>]]
} {1 {bad event type or keysym "xyz"} {<Button-2> <Control-Key-v> abc}}
test bind-15.7 {event command: delete} {
list [catch {event delete} msg] $msg
} {1 {wrong # args: should be "event delete virtual ?sequence sequence ...?"}}
test bind-15.8 {event command: delete many} {
setup
event add <<Paste>> <3> <1> <2> t
event delete <<Paste>> <1> <2>
lsort [event info <<Paste>>]
} {<Button-3> t}
test bind-15.9 {event command: delete all} {
setup
event add <<Paste>> a b
event delete <<Paste>>
event info <<Paste>>
} {}
test bind-15.10 {event command: delete 1} {
setup
event add <<Paste>> a b c
event delete <<Paste>> b
lsort [event info <<Paste>>]
} {a c}
test bind-15.11 {event command: info name} {
setup
event add <<Paste>> a b c
lsort [event info <<Paste>>]
} {a b c}
test bind-15.12 {event command: info all} {
setup
event add <<Paste>> a
event add <<Alive>> b
lsort [event info]
} {<<Alive>> <<Paste>>}
test bind-15.13 {event command: info error} {
list [catch {event info <<Paste>> <Control-v>} msg] $msg
} {1 {wrong # args: should be "event info ?virtual?"}}
test bind-15.14 {event command: generate} {
list [catch {event generate} msg] $msg
} {1 {wrong # args: should be "event generate window event ?options?"}}
test bind-15.15 {event command: generate} {
setup
bind .b.f <1> "lappend x 1"
set x {}
event generate .b.f <1>
set x
} {1}
test bind-15.16 {event command: generate} {
list [catch {event generate .b.f <xyz>} msg] $msg
} {1 {bad event type or keysym "xyz"}}
test bind-15.17 {event command} {
list [catch {event foo} msg] $msg
} {1 {bad option "foo": should be add, delete, generate, info}}
test bind-16.1 {CreateVirtualEvent procedure: GetVirtualEventUid} {
list [catch {event add asd <Ctrl-v>} msg] $msg
} {1 {virtual event "asd" is badly formed}}
test bind-16.2 {CreateVirtualEvent procedure: FindSequence} {
list [catch {event add <<asd>> <Ctrl-v>} msg] $msg
} {1 {bad event type or keysym "Ctrl"}}
test bind-16.3 {CreateVirtualEvent procedure: new physical} {
setup
event add <<xyz>> <Control-v>
event info <<xyz>>
} {<Control-Key-v>}
test bind-16.4 {CreateVirtualEvent procedure: duplicate physical} {
setup
event add <<xyz>> <Control-v>
event add <<xyz>> <Control-v>
event info <<xyz>>
} {<Control-Key-v>}
test bind-16.5 {CreateVirtualEvent procedure: existing physical} {
setup
event add <<xyz>> <Control-v>
event add <<abc>> <Control-v>
list [lsort [event info]] [event info <<xyz>>] [event info <<abc>>]
} {{<<abc>> <<xyz>>} <Control-Key-v> <Control-Key-v>}
test bind-16.6 {CreateVirtualEvent procedure: new virtual} {
setup
event add <<xyz>> <Control-v>
list [event info] [event info <<xyz>>]
} {<<xyz>> <Control-Key-v>}
test bind-16.7 {CreateVirtualEvent procedure: existing virtual} {
setup
event add <<xyz>> <Control-v>
event add <<xyz>> <Button-2>
list [event info] [lsort [event info <<xyz>>]]
} {<<xyz>> {<Button-2> <Control-Key-v>}}
test bind-17.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} {
list [catch {event add xyz {}} msg] $msg
} {1 {virtual event "xyz" is badly formed}}
test bind-17.2 {DeleteVirtualEvent procedure: non-existent virtual} {
setup
event delete <<xyz>>
event info
} {}
test bind-17.3 {DeleteVirtualEvent procedure: delete 1} {
setup
event add <<xyz>> <Control-v>
event delete <<xyz>> <Control-v>
event info <<xyz>>
} {}
test bind-17.4 {DeleteVirtualEvent procedure: delete 1, not owned} {
setup
event add <<xyz>> <Control-v>
event delete <<xyz>> <Button-1>
event info <<xyz>>
} {<Control-Key-v>}
test bind-17.5 {DeleteVirtualEvent procedure: delete 1, badly formed} {
setup
event add <<xyz>> <Control-v>
list [catch {event delete <<xyz>> <xyz>} msg] $msg
} {1 {bad event type or keysym "xyz"}}
test bind-17.6 {DeleteVirtualEvent procedure: delete 1, badly formed} {
setup
event add <<xyz>> <Control-v>
list [catch {event delete <<xyz>> <<Paste>>} msg] $msg
} {1 {virtual event not allowed in definition of another virtual event}}
test bind-17.7 {DeleteVirtualEvent procedure: owns 1, delete all} {
setup
event add <<xyz>> <Control-v>
event delete <<xyz>>
event info
} {}
test bind-17.8 {DeleteVirtualEvent procedure: owns 1, delete 1} {
setup
event add <<xyz>> <Control-v>
event delete <<xyz>> <Control-v>
event info
} {}
test bind-17.9 {DeleteVirtualEvent procedure: owns many, delete all} {
setup
event add <<xyz>> <Control-v> <Control-w> <Control-x>
event delete <<xyz>>
event info
} {}
test bind-17.10 {DeleteVirtualEvent procedure: owns many, delete 1} {
setup
event add <<xyz>> <Control-v> <Control-w> <Control-x>
event delete <<xyz>> <Control-w>
lsort [event info <<xyz>>]
} {<Control-Key-v> <Control-Key-x>}
test bind-17.11 {DeleteVirtualEvent procedure: owned by 1, only} {
setup
event add <<xyz>> <Button-2>
bind .b.f <<xyz>> {lappend x %#}
set x {}
event gen .b.f <Button-2> -serial 101
event delete <<xyz>>
event gen .b.f <Button-2> -serial 102
set x
} {101}
test bind-17.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} {
setup
event add <<abc>> <Control-Button-2>
event add <<xyz>> <Button-2>
bind .b.f <<xyz>> {lappend x xyz}
bind .b.f <<abc>> {lappend x abc}
set x {}
event gen .b.f <Button-2>
event gen .b.f <Control-Button-2>
event delete <<xyz>>
event gen .b.f <Button-2>
event gen .b.f <Control-Button-2>
list $x [event info <<abc>>]
} {{xyz abc abc} <Control-Button-2>}
test bind-17.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} {
setup
event add <<def>> <Shift-Button-2>
event add <<xyz>> <Button-2>
event add <<abc>> <Control-Button-2>
bind .b.f <<xyz>> {lappend x xyz}
bind .b.f <<abc>> {lappend x abc}
bind .b.f <<def>> {lappend x def}
set x {}
event gen .b.f <Button-2>
event gen .b.f <Control-Button-2>
event gen .b.f <Shift-Button-2>
event delete <<xyz>>
event gen .b.f <Button-2>
event gen .b.f <Control-Button-2>
event gen .b.f <Shift-Button-2>
list $x [event info <<def>>] [event info <<xyz>>] [event info <<abc>>]
} {{xyz abc def abc def} <Shift-Button-2> {} <Control-Button-2>}
test bind-17.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} {
setup
event add <<xyz>> <Button-2>
event add <<abc>> <Control-Button-2>
event add <<def>> <Shift-Button-2>
bind .b.f <<xyz>> {lappend x xyz}
bind .b.f <<abc>> {lappend x abc}
bind .b.f <<def>> {lappend x def}
set x {}
event gen .b.f <Button-2>
event gen .b.f <Control-Button-2>
event gen .b.f <Shift-Button-2>
event delete <<xyz>>
event gen .b.f <Button-2>
event gen .b.f <Control-Button-2>
event gen .b.f <Shift-Button-2>
list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
} {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>}
test bind-17.15 {DeleteVirtualEvent procedure: owned by many, first} {
setup
pack [frame .b.g -class Test -width 150 -height 100]
pack [frame .b.h -class Test -width 150 -height 100]
update
event add <<xyz>> <Button-2>
event add <<abc>> <Button-2>
event add <<def>> <Button-2>
bind .b.f <<xyz>> {lappend x xyz}
bind .b.g <<abc>> {lappend x abc}
bind .b.h <<def>> {lappend x def}
set x {}
event gen .b.f <Button-2>
event gen .b.g <Button-2>
event gen .b.h <Button-2>
event delete <<xyz>>
event gen .b.f <Button-2>
event gen .b.g <Button-2>
event gen .b.h <Button-2>
destroy .b.g
destroy .b.h
list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
} {{xyz abc def abc def} {} <Button-2> <Button-2>}
test bind-17.16 {DeleteVirtualEvent procedure: owned by many, middle} {
setup
pack [frame .b.g -class Test -width 150 -height 100]
pack [frame .b.h -class Test -width 150 -height 100]
update
event add <<xyz>> <Button-2>
event add <<abc>> <Button-2>
event add <<def>> <Button-2>
bind .b.f <<xyz>> {lappend x xyz}
bind .b.g <<abc>> {lappend x abc}
bind .b.h <<def>> {lappend x def}
set x {}
event gen .b.f <Button-2>
event gen .b.g <Button-2>
event gen .b.h <Button-2>
event delete <<abc>>
event gen .b.f <Button-2>
event gen .b.g <Button-2>
event gen .b.h <Button-2>
destroy .b.g
destroy .b.h
list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
} {{xyz abc def xyz def} <Button-2> {} <Button-2>}
test bind-17.17 {DeleteVirtualEvent procedure: owned by many, last} {
setup
pack [frame .b.g -class Test -width 150 -height 100]
pack [frame .b.h -class Test -width 150 -height 100]
update
event add <<xyz>> <Button-2>
event add <<abc>> <Button-2>
event add <<def>> <Button-2>
bind .b.f <<xyz>> {lappend x xyz}
bind .b.g <<abc>> {lappend x abc}
bind .b.h <<def>> {lappend x def}
set x {}
event gen .b.f <Button-2>
event gen .b.g <Button-2>
event gen .b.h <Button-2>
event delete <<def>>
event gen .b.f <Button-2>
event gen .b.g <Button-2>
event gen .b.h <Button-2>
destroy .b.g
destroy .b.h
list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
} {{xyz abc def xyz abc} <Button-2> <Button-2> {}}
test bind-18.1 {GetVirtualEvent procedure: GetVirtualEventUid} {
list [catch {event info asd} msg] $msg
} {1 {virtual event "asd" is badly formed}}
test bind-18.2 {GetVirtualEvent procedure: non-existent event} {
event info <<asd>>
} {}
test bind-18.3 {GetVirtualEvent procedure: owns 1} {
setup
event add <<xyz>> <Control-Key-v>
event info <<xyz>>
} {<Control-Key-v>}
test bind-18.4 {GetVirtualEvent procedure: owns many} {
setup
event add <<xyz>> <Control-v> <Button-2> spack
event info <<xyz>>
} {<Control-Key-v> <Button-2> spack}
test bind-19.1 {GetAllVirtualEvents procedure: no events} {
setup
event info
} {}
test bind-19.2 {GetAllVirtualEvents procedure: 1 event} {
setup
event add <<xyz>> <Control-v>
event info
} {<<xyz>>}
test bind-19.3 {GetAllVirtualEvents procedure: many events} {
setup
event add <<xyz>> <Control-v>
event add <<xyz>> <Button-2>
event add <<abc>> <Control-v>
event add <<def>> <Key-F6>
lsort [event info]
} {<<abc>> <<def>> <<xyz>>}
test bind-20.1 {HandleEventGenerate} {
list [catch {event gen xyz <Control-v>} msg] $msg
} {1 {bad window path name "xyz"}}
test bind-20.2 {HandleEventGenerate} {
list [catch {event gen . <xyz>} msg] $msg
} {1 {bad event type or keysym "xyz"}}
test bind-20.3 {HandleEventGenerate} {
list [catch {event gen . <Double-Button-1>} msg] $msg
} {1 {Double or Triple modifier not allowed}}
test bind-20.4 {HandleEventGenerate} {
list [catch {event gen . xyz} msg] $msg
} {1 {only one event specification allowed}}
test bind-20.5 {HandleEventGenerate} {
list [catch {event gen . <Button> -button} msg] $msg
} {1 {value for "-button" missing}}
test bind-20.6 {HandleEventGenerate} {
setup
bind .b.f <Button> {set x "%s %b"}
set x {}
event gen .b.f <Control-Button-1>
set x
} {4 1}
test bind-20.7 {HandleEventGenerate} {
setup
bind .b.f <Key> {set x "%s %K"}
set x {}
event gen .b.f <Control-Key-1>
set x
} {4 1}
test bind-20.8 {HandleEventGenerate} {
setup
bind .b.f <<Paste>> {set x "%s"}
set x {}
event gen .b.f <<Paste>> -state 1
set x
} {1}
test bind-20.9 {HandleEventGenerate} {
setup
bind .b.f <Motion> {set x "%s"}
set x {}
event gen .b.f <Control-Motion>
set x
} {4}
test bind-20.9 {HandleEventGenerate} {
setup
bind .b.f <Button> {lappend x %#}
set x {}
event gen .b.f <Button> -when now -serial 100
set x
} {100}
test bind-20.10 {HandleEventGenerate} {
setup
bind .b.f <Button> {lappend x %#}
set x {}
event gen .b.f <Button> -when head -serial 100
event gen .b.f <Button> -when head -serial 101
event gen .b.f <Button> -when head -serial 102
lappend x foo
update
set x
} {foo 102 101 100}
test bind-20.11 {HandleEventGenerate} {
setup
bind .b.f <Button> {lappend x %#}
set x {}
event gen .b.f <Button> -when head -serial 99
event gen .b.f <Button> -when mark -serial 100
event gen .b.f <Button> -when mark -serial 101
event gen .b.f <Button> -when mark -serial 102
lappend x foo
update
set x
} {foo 100 101 102 99}
test bind-20.12 {HandleEventGenerate} {
setup
bind .b.f <Button> {lappend x %#}
set x {}
event gen .b.f <Button> -when head -serial 99
event gen .b.f <Button> -when tail -serial 100
event gen .b.f <Button> -when tail -serial 101
event gen .b.f <Button> -when tail -serial 102
lappend x foo
update
set x
} {foo 99 100 101 102}
test bind-20.13 {HandleEventGenerate} {
list [catch {event gen . <Button> -when xyz} msg] $msg
} {1 {bad position "xyz": should be now, head, mark, tail}}
set i 14
foreach check {
{<Configure> %a {-above .xyz} {1 {bad window path name ".xyz"}}}
{<Configure> %a {-above .b} [winfo id .b]}
{<Configure> %a {-above xyz} {1 {expected integer but got "xyz"}}}
{<Configure> %a {-above [winfo id .b]} [winfo id .b]}
{<Key> %b {-above .} {1 {bad option to <Key> event: "-above"}}}
{<Configure> %B {-borderwidth xyz} {1 {bad screen distance "xyz"}}}
{<Configure> %B {-borderwidth 2i} [winfo pixels .b.f 2i]}
{<Key> %k {-borderwidth 2i} {1 {bad option to <Key> event: "-borderwidth"}}}
{<Button> %b {-button xyz} {1 {expected integer but got "xyz"}}}
{<Button> %b {-button 1} 1}
{<Key> %k {-button 1} {1 {bad option to <Key> event: "-button"}}}
{<Expose> %c {-count xyz} {1 {expected integer but got "xyz"}}}
{<Expose> %c {-count 20} 20}
{<Key> %b {-count 20} {1 {bad option to <Key> event: "-count"}}}
{<Enter> %d {-detail xyz} {1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, NotifyDetailNone}}}
{<FocusIn> %d {-detail NotifyVirtual} {}}
{<Enter> %d {-detail NotifyVirtual} NotifyVirtual}
{<Key> %k {-detail NotifyVirtual} {1 {bad option to <Key> event: "-detail"}}}
{<Enter> %f {-focus xyz} {1 {expected boolean value but got "xyz"}}}
{<Enter> %f {-focus 1} 1}
{<Key> %k {-focus 1} {1 {bad option to <Key> event: "-focus"}}}
{<Expose> %h {-height xyz} {1 {bad screen distance "xyz"}}}
{<Expose> %h {-height 2i} [winfo pixels .b.f 2i]}
{<Configure> %h {-height 2i} [winfo pixels .b.f 2i]}
{<Key> %k {-height 2i} {1 {bad option to <Key> event: "-height"}}}
{<Key> %k {-keycode xyz} {1 {expected integer but got "xyz"}}}
{<Key> %k {-keycode 20} 20}
{<Button> %b {-keycode 20} {1 {bad option to <Button> event: "-keycode"}}}
{<Key> %K {-keysym xyz} {1 {unknown keysym "xyz"}}}
{<Key> %K {-keysym a} a}
{<Button> %b {-keysym a} {1 {bad option to <Button> event: "-keysym"}}}
{<Enter> %m {-mode xyz} {1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, NotifyWhileGrabbed}}}
{<Enter> %m {-mode NotifyNormal} NotifyNormal}
{<FocusIn> %m {-mode NotifyNormal} {}}
{<Key> %k {-mode NotifyNormal} {1 {bad option to <Key> event: "-mode"}}}
{<Map> %o {-override xyz} {1 {expected boolean value but got "xyz"}}}
{<Map> %o {-override 1} 1}
{<Reparent> %o {-override 1} 1}
{<Configure> %o {-override 1} 1}
{<Key> %k {-override 1} {1 {bad option to <Key> event: "-override"}}}
{<Circulate> %p {-place xyz} {1 {bad -place value "xyz": must be PlaceOnTop, PlaceOnBottom}}}
{<Circulate> %p {-place PlaceOnTop} PlaceOnTop}
{<Key> %k {-place PlaceOnTop} {1 {bad option to <Key> event: "-place"}}}
{<Key> %R {-root .xyz} {1 {bad window path name ".xyz"}}}
{<Key> %R {-root .b} [expr [winfo id .b]]}
{<Key> %R {-root xyz} {1 {expected integer but got "xyz"}}}
{<Key> %R {-root [winfo id .b]} [expr [winfo id .b]]}
{<Button> %R {-root .b} [expr [winfo id .b]]}
{<Motion> %R {-root .b} [expr [winfo id .b]]}
{<<Paste>> %R {-root .b} [expr [winfo id .b]]}
{<Enter> %R {-root .b} [expr [winfo id .b]]}
{<Configure> %R {-root .b} {1 {bad option to <Configure> event: "-root"}}}
{<Key> %X {-rootx xyz} {1 {bad screen distance "xyz"}}}
{<Key> %X {-rootx 2i} [winfo pixels .b.f 2i]}
{<Button> %X {-rootx 2i} [winfo pixels .b.f 2i]}
{<Motion> %X {-rootx 2i} [winfo pixels .b.f 2i]}
{<<Paste>> %X {-rootx 2i} [winfo pixels .b.f 2i]}
{<Enter> %X {-rootx 2i} [winfo pixels .b.f 2i]}
{<Configure> %X {-rootx 2i} {1 {bad option to <Configure> event: "-rootx"}}}
{<Key> %Y {-rooty xyz} {1 {bad screen distance "xyz"}}}
{<Key> %Y {-rooty 2i} [winfo pixels .b.f 2i]}
{<Button> %Y {-rooty 2i} [winfo pixels .b.f 2i]}
{<Motion> %Y {-rooty 2i} [winfo pixels .b.f 2i]}
{<<Paste>> %Y {-rooty 2i} [winfo pixels .b.f 2i]}
{<Enter> %Y {-rooty 2i} [winfo pixels .b.f 2i]}
{<Configure> %Y {-rooty 2i} {1 {bad option to <Configure> event: "-rooty"}}}
{<Key> %E {-sendevent xyz} {1 {expected boolean value but got "xyz"}}}
{<Key> %E {-sendevent 1} 1}
{<Key> %# {-serial xyz} {1 {expected integer but got "xyz"}}}
{<Key> %# {-serial 100} 100}
{<Key> %s {-state xyz} {1 {expected integer but got "xyz"}}}
{<Key> %s {-state 1} 1}
{<Button> %s {-state 1} 1}
{<Motion> %s {-state 1} 1}
{<<Paste>> %s {-state 1} 1}
{<Enter> %s {-state 1} 1}
{<Visibility> %s {-state xyz} {1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, VisibilityFullyObscured}}}
{<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured}
{<Configure> %s {-state xyz} {1 {bad option to <Configure> event: "-state"}}}
{<Key> %S {-subwindow .xyz} {1 {bad window path name ".xyz"}}}
{<Key> %S {-subwindow .b} [winfo id .b]}
{<Key> %S {-subwindow xyz} {1 {expected integer but got "xyz"}}}
{<Key> %S {-subwindow [winfo id .b]} [winfo id .b]}
{<Button> %S {-subwindow .b} [winfo id .b]}
{<Motion> %S {-subwindow .b} [winfo id .b]}
{<<Paste>> %S {-subwindow .b} [winfo id .b]}
{<Enter> %S {-subwindow .b} [winfo id .b]}
{<Configure> %S {-subwindow .b} {1 {bad option to <Configure> event: "-subwindow"}}}
{<Key> %t {-time xyz} {1 {expected integer but got "xyz"}}}
{<Key> %t {-time 100} 100}
{<Button> %t {-time 100} 100}
{<Motion> %t {-time 100} 100}
{<<Paste>> %t {-time 100} 100}
{<Enter> %t {-time 100} 100}
{<Property> %t {-time 100} 100}
{<Configure> %t {-time 100} {1 {bad option to <Configure> event: "-time"}}}
{<Expose> %w {-width xyz} {1 {bad screen distance "xyz"}}}
{<Expose> %w {-width 2i} [winfo pixels .b.f 2i]}
{<Configure> %w {-width 2i} [winfo pixels .b.f 2i]}
{<Key> %k {-width 2i} {1 {bad option to <Key> event: "-width"}}}
{<Unmap> %W {-window .xyz} {1 {bad window path name ".xyz"}}}
{<Unmap> %W {-window .b.f} .b.f}
{<Unmap> %W {-window xyz} {1 {expected integer but got "xyz"}}}
{<Unmap> %W {-window [winfo id .b.f]} .b.f}
{<Unmap> %W {-window .b.f} .b.f}
{<Map> %W {-window .b.f} .b.f}
{<Reparent> %W {-window .b.f} .b.f}
{<Configure> %W {-window .b.f} .b.f}
{<Gravity> %W {-window .b.f} .b.f}
{<Circulate> %W {-window .b.f} .b.f}
{<Key> %W {-window .b.f} {1 {bad option to <Key> event: "-window"}}}
{<Key> %x {-x xyz} {1 {bad screen distance "xyz"}}}
{<Key> %x {-x 2i} [winfo pixels .b.f 2i]}
{<Button> %x {-x 2i} [winfo pixels .b.f 2i]}
{<Motion> %x {-x 2i} [winfo pixels .b.f 2i]}
{<<Paste>> %x {-x 2i} [winfo pixels .b.f 2i]}
{<Enter> %x {-x 2i} [winfo pixels .b.f 2i]}
{<Expose> %x {-x 2i} [winfo pixels .b.f 2i]}
{<Configure> %x {-x 2i} [winfo pixels .b.f 2i]}
{<Gravity> %x {-x 2i} [winfo pixels .b.f 2i]}
{<Reparent> %x {-x 2i} [winfo pixels .b.f 2i]}
{<Map> %x {-x 2i} {1 {bad option to <Map> event: "-x"}}}
{<Key> %y {-y xyz} {1 {bad screen distance "xyz"}}}
{<Key> %y {-y 2i} [winfo pixels .b.f 2i]}
{<Button> %y {-y 2i} [winfo pixels .b.f 2i]}
{<Motion> %y {-y 2i} [winfo pixels .b.f 2i]}
{<<Paste>> %y {-y 2i} [winfo pixels .b.f 2i]}
{<Enter> %y {-y 2i} [winfo pixels .b.f 2i]}
{<Expose> %y {-y 2i} [winfo pixels .b.f 2i]}
{<Configure> %y {-y 2i} [winfo pixels .b.f 2i]}
{<Gravity> %y {-y 2i} [winfo pixels .b.f 2i]}
{<Reparent> %y {-y 2i} [winfo pixels .b.f 2i]}
{<Map> %y {-y 2i} {1 {bad option to <Map> event: "-y"}}}
{<Key> %k {-xyz 1} {1 {bad option to <Key> event: "-xyz"}}}
} {
set event [lindex $check 0]
test bind-20.$i "HandleEventGenerate: options $event [lindex $check 2]" {
setup
bind .b.f $event "lappend x [lindex $check 1]"
set x {}
if [catch {eval event gen .b.f $event [lindex $check 2]} msg] {
set x [list 1 $msg]
}
set x
} [eval set x [lrange $check 3 end]]
incr i
}
test bind-21.1 {GetVirtualEventUid procedure} {
list [catch {event info <<asd} msg] $msg
} {1 {virtual event "<<asd" is badly formed}}
test bind-21.2 {GetVirtualEventUid procedure} {
list [catch {event info <<>>} msg] $msg
} {1 {virtual event "<<>>" is badly formed}}
test bind-21.3 {GetVirtualEventUid procedure} {
list [catch {event info <<asd>} msg] $msg
} {1 {virtual event "<<asd>" is badly formed}}
test bind-21.4 {GetVirtualEventUid procedure} {
event info <<asd>>
} {}
test bind-22.1 {FindSequence procedure: no event} {
list [catch {bind .b {} test} msg] $msg
} {1 {no events specified in binding}}
test bind-22.2 {FindSequence procedure: bad event} {
list [catch {bind .b <xyz> test} msg] $msg
} {1 {bad event type or keysym "xyz"}}
test bind-22.3 {FindSequence procedure: virtual allowed} {
bind .b.f <<Paste>> test
} {}
test bind-22.4 {FindSequence procedure: virtual not allowed} {
list [catch {event add <<Paste>> <<Alive>>} msg] $msg
} {1 {virtual event not allowed in definition of another virtual event}}
test bind-22.5 {FindSequence procedure, multiple bindings} {
setup
bind .b.f <1> {lappend x single}
bind .b.f <Double-1> {lappend x double}
bind .b.f <Triple-1> {lappend x triple}
set x press
event gen .b.f <Button-1>
lappend x press
event gen .b.f <Button-1>
lappend x press
event gen .b.f <Button-1>
lappend x press
event gen .b.f <Button-1>
set x
} {press single press double press triple press triple}
test bind-22.6 {FindSequence procedure: virtual composed} {
list [catch {bind .b <Control-b><<Paste>> "puts hi"} msg] $msg
} {1 {virtual events may not be composed}}
test bind-22.7 {FindSequence procedure: new pattern sequence} {
setup
bind .b.f <Button-1><Button-2> {lappend x 1-2}
set x {}
event gen .b.f <Button-1>
event gen .b.f <Button-2>
set x
} {1-2}
test bind-22.8 {FindSequence procedure: similar pattern sequence} {
setup
bind .b.f <Button-1><Button-2> {lappend x 1-2}
bind .b.f <Button-2> {lappend x 2}
set x {}
event gen .b.f <Button-2>
event gen .b.f <Button-1>
event gen .b.f <Button-2>
set x
} {2 1-2}
test bind-22.9 {FindSequence procedure: similar pattern sequence} {
setup
bind .b.f <Button-1><Button-2> {lappend x 1-2}
bind .b.f <Button-2><Button-2> {lappend x 2-2}
set x {}
event gen .b.f <Button-2>
event gen .b.f <Button-2>
event gen .b.f <Button-1>
event gen .b.f <Button-2>
set x
} {2-2 1-2}
test bind-22.10 {FindSequence procedure: similar pattern sequence} {
setup
bind .b.f <Button-2><Button-2> {lappend x 2-2}
bind .b.f <Double-Button-2> {lappend x d-2}
set x {}
event gen .b.f <Button-2>
event gen .b.f <Button-2>
event gen .b.f <Button-1>
event gen .b.f <Button-2> -x 100
event gen .b.f <Button-2> -x 200
set x
} {d-2 2-2}
test bind-22.11 {FindSequence procedure: new sequence, don't create} {
setup
bind .b.f <Button-2>
} {}
test bind-22.12 {FindSequence procedure: not new sequence, don't create} {
setup
bind .b.f <Control-Button-2> "foo"
bind .b.f <Button-2>
} {}
test bind-23.1 {ParseEventDescription procedure} {
list [catch {bind .b \x7 test} msg] $msg
} {1 {bad ASCII character 0x7}}
test bind-23.2 {ParseEventDescription procedure} {
list [catch {bind .b "\x7f" test} msg] $msg
} {1 {bad ASCII character 0x7f}}
test bind-23.3 {ParseEventDescription procedure} {
list [catch {bind .b "\x4" test} msg] $msg
} {1 {bad ASCII character 0x4}}
test bind-23.4 {ParseEventDescription procedure} {
setup
bind .b.f a test
bind .b.f a
} {test}
test bind-23.5 {ParseEventDescription procedure: virtual} {
list [catch {bind .b <<>> foo} msg] $msg
} {1 {virtual event "<<>>" is badly formed}}
test bind-23.6 {ParseEventDescription procedure: virtual} {
list [catch {bind .b <<Paste foo} msg] $msg
} {1 {missing ">" in virtual binding}}
test bind-23.7 {ParseEventDescription procedure: virtual} {
list [catch {bind .b <<Paste> foo} msg] $msg
} {1 {missing ">" in virtual binding}}
test bind-23.8 {ParseEventDescription procedure: correctly terminate virtual} {
list [catch {bind .b <<Paste>>h foo} msg] $msg
} {1 {virtual events may not be composed}}
test bind-23.9 {ParseEventDescription procedure} {
list [catch {bind .b <> test} msg] $msg
} {1 {no event type or button # or keysym}}
test bind-23.10 {ParseEventDescription procedure} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
bind .b.f <a---> {nothing}
bind .b.f
} a
test bind-23.11 {ParseEventDescription procedure} {
list [catch {bind .b <a-- test} msg] $msg
} {1 {missing ">" in binding}}
test bind-23.11a {ParseEventDescription procedure} {
list [catch {bind .b <a-b> test} msg] $msg
} {1 {extra characters after detail in binding}}
test bind-23.12 {ParseEventDescription} {
setup
list [catch {bind .b <<abc {puts hi}} msg] $msg
} {1 {missing ">" in virtual binding}}
test bind-23.13 {ParseEventDescription} {
setup
list [catch {bind .b <<abc> {puts hi}} msg] $msg
} {1 {missing ">" in virtual binding}}
test bind-23.14 {ParseEventDescription} {
setup
bind .b <<Shift-Paste>> {puts hi}
bind .b
} {<<Shift-Paste>>}
test bind-23.15 {ParseEventDescription} {
setup
list [catch {event add <<xyz>> <<abc>>} msg] $msg
} {1 {virtual event not allowed in definition of another virtual event}}
set i 1
foreach check {
{{<Control- a>} <Control-Key-a>}
{<Shift-a> <Shift-Key-a>}
{<Lock-a> <Lock-Key-a>}
{<Meta---a> <Meta-Key-a>}
{<M-a> <Meta-Key-a>}
{<Alt-a> <Alt-Key-a>}
{<B1-a> <B1-Key-a>}
{<B2-a> <B2-Key-a>}
{<B3-a> <B3-Key-a>}
{<B4-a> <B4-Key-a>}
{<B5-a> <B5-Key-a>}
{<Button1-a> <B1-Key-a>}
{<Button2-a> <B2-Key-a>}
{<Button3-a> <B3-Key-a>}
{<Button4-a> <B4-Key-a>}
{<Button5-a> <B5-Key-a>}
{<M1-a> <Mod1-Key-a>}
{<M2-a> <Mod2-Key-a>}
{<M3-a> <Mod3-Key-a>}
{<M4-a> <Mod4-Key-a>}
{<M5-a> <Mod5-Key-a>}
{<Mod1-a> <Mod1-Key-a>}
{<Mod2-a> <Mod2-Key-a>}
{<Mod3-a> <Mod3-Key-a>}
{<Mod4-a> <Mod4-Key-a>}
{<Mod5-a> <Mod5-Key-a>}
{<Double-a> <Double-Key-a>}
{<Triple-a> <Triple-Key-a>}
{{<Double 1>} <Double-Button-1>}
{<Triple-1> <Triple-Button-1>}
{{<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>}
} {
test bind-24.$i {modifier names} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
bind .b.f [lindex $check 0] foo
bind .b.f
} [lindex $check 1]
bind .b.f [lindex $check 1] {}
incr i
}
foreach event [bind Test] {
bind Test $event {}
}
foreach event [bind all] {
bind all $event {}
}
test bind-25.1 {event names} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
bind .b.f <FocusIn> {nothing}
bind .b.f
} <FocusIn>
test bind-25.2 {event names} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
bind .b.f <FocusOut> {nothing}
bind .b.f
} <FocusOut>
test bind-25.3 {event names} {
setup
bind .b.f <Destroy> {lappend x "destroyed"}
set x [bind .b.f]
destroy .b.f
set x
} {<Destroy> destroyed}
set i 4
foreach check {
{Motion Motion}
{Button Button}
{ButtonPress Button}
{ButtonRelease ButtonRelease}
{Colormap Colormap}
{Enter Enter}
{Leave Leave}
{Expose Expose}
{Key Key}
{KeyPress Key}
{KeyRelease KeyRelease}
{Property Property}
{Visibility Visibility}
{Activate Activate}
{Deactivate Deactivate}
} {
set event [lindex $check 0]
test bind-25.$i {event names} {
setup
bind .b.f <$event> "set x {event $event}"
set x xyzzy
event gen .b.f <$event>
list $x [bind .b.f]
} [list "event $event" <[lindex $check 1]>]
incr i
}
foreach check {
{Circulate Circulate}
{Configure Configure}
{Gravity Gravity}
{Map Map}
{Reparent Reparent}
{Unmap Unmap}
} {
set event [lindex $check 0]
test bind-25.$i {event names} {
setup
bind .b.f <$event> "set x {event $event}"
set x xyzzy
event gen .b.f <$event> -window .b.f
list $x [bind .b.f]
} [list "event $event" <[lindex $check 1]>]
incr i
}
test bind-26.1 {button names} {
list [catch {bind .b <Expose-1> foo} msg] $msg
} {1 {specified button "1" for non-button event}}
test bind-26.2 {button names} {
list [catch {bind .b <Button-6> foo} msg] $msg
} {1 {specified keysym "6" for non-key event}}
set i 3
foreach button {1 2 3 4 5} {
test bind-26.$i {button names} {
setup
bind .b.f <Button-$button> "lappend x \"button $button\""
set x [bind .b.f]
event gen .b.f <Button-$button>
set x
} [list <Button-$button> "button $button"]
incr i
}
test bind-27.1 {keysym names} {
list [catch {bind .b <Expose-a> foo} msg] $msg
} {1 {specified keysym "a" for non-key event}}
test bind-27.2 {keysym names} {
list [catch {bind .b <Gorp> foo} msg] $msg
} {1 {bad event type or keysym "Gorp"}}
test bind-27.3 {keysym names} {
list [catch {bind .b <Key-Stupid> foo} msg] $msg
} {1 {bad event type or keysym "Stupid"}}
test bind-27.4 {keysym names} {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
bind .b.f <a> foo
bind .b.f
} a
set i 5
foreach check {
{a 0 a}
{space 0 <Key-space>}
{Return 0 <Key-Return>}
{X 1 X}
} {
set keysym [lindex $check 0]
test bind-27.$i {keysym names} {
setup
bind .b.f <Key-$keysym> "lappend x \"keysym $keysym\""
bind .b.f <Key-x> "lappend x {bad binding match}"
set x [lsort [bind .b.f]]
event gen .b.f <Key-$keysym> -state [lindex $check 1]
set x
} [concat [lsort "x [lindex $check 2]"] "{keysym $keysym}"]
incr i
}
test bind-28.1 {dummy test to help ensure proper numbering} {} {}
setup
bind .b.f <KeyPress> {set x %K}
set i 2
foreach check {
{a 0 a}
{x 1 X}
{x 2 X}
{space 0 space}
{F1 1 F1}
} {
test bind-28.$i {GetKeySym procedure} {nonPortable} {
set x nothing
event gen .b.f <KeyPress> -keysym [lindex $check 0] \
-state [lindex $check 1]
set x
} [lindex $check 2]
incr i
}
proc bgerror msg {
global x errorInfo
set x [list $msg $errorInfo]
}
test bind-29.1 {Tk_BackgroundError procedure} {
setup
bind .b.f <Button> {error "This is a test"}
set x none
event gen .b.f <Button>
update
set x
} {{This is a test} {This is a test
while executing
"error "This is a test""
(command bound to event)}}
test bind-29.2 {Tk_BackgroundError procedure} {
proc do {} {
event gen .b.f <Button>
}
setup
bind .b.f <Button> {error Message2}
set x none
do
update
set x
} {Message2 {Message2
while executing
"error Message2"
(command bound to event)}}
rename bgerror {}