bind.test

linux系统下的音频通信

# 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.39 97/07/01 18:01:05

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
}
setup

foreach i [bind Test] {
    bind Test $i {}
}
foreach i [bind all] {
    bind all $i {}
}

test bind-1.1 {bind command} {
    list [catch {bind} msg] $msg
} {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
test bind-1.2 {bind command} {
    list [catch {bind a b c d} msg] $msg
} {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
test bind-1.3 {bind command} {
    list [catch {bind .gorp} msg] $msg
} {1 {bad window path name ".gorp"}}
test bind-1.4 {bind command} {
    list [catch {bind foo} msg] $msg
} {0 {}}
test bind-1.5 {bind command} {
    list [catch {bind .b <gorp-> {}} msg] $msg
} {0 {}}
test bind-1.6 {bind command} {
    catch {destroy .b.f}
    frame .b.f
    bind .b.f <Enter> {test script}
    set result [bind .b.f <Enter>]
    bind .b.f <Enter> {}
    list $result [bind .b.f <Enter>]
} {{test script} {}}
test bind-1.7 {bind command} {
    catch {destroy .b.f}
    frame .b.f
    bind .b.f <Enter> {test script}
    bind .b.f <Enter> {+more text}
    bind .b.f <Enter>
} {test script
more text}
test bind-1.8 {bind command} {
    list [catch {bind .b <gorp-> {test script}} msg] $msg [bind .b]
} {1 {bad event type or keysym "gorp"} {}}
test bind-1.9 {bind command} {
    list [catch {bind .b <gorp->} msg] $msg
} {0 {}}
test bind-1.10 {bind command} {
    catch {destroy .b.f}
    frame .b.f
    bind .b.f <Enter> {script 1}
    bind .b.f <Leave> {script 2}
    bind .b.f a {script for a}
    bind .b.f b {script for b}
    lsort [bind .b.f]
} {<Enter> <Leave> a b}

test bind-2.1 {bindtags command} {
    list [catch {bindtags} msg] $msg
} {1 {wrong # args: should be "bindtags window ?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
} {}


if {[string compare testcbind [info commands testcbind]] != 0} {
    puts "This application hasn't been compiled with the testcbind command,"
    puts "therefore I am skipping all of these tests."
    return
}

test bind-6.1 {Tk_DeleteBindTable procedure} {
    catch {destroy .b.c}
    canvas .b.c
    .b.c bind foo <1> {string 1}
    .b.c create rectangle 0 0 100 100
    .b.c bind 1 <2> {string 2}
    destroy .b.c
} {}
test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} {
    catch {interp delete foo}
    interp create foo
    foo eval {
	load {} Tk
	load {} Tktest
	wm geometry . +0+0
	frame .t -width 50 -height 50
	bindtags .t {a b c d}
	pack .t
	update
	set x {}
	testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1"
	bind b <1> "lappend x b1"
	testcbind c <1> "lappend x c1" "lappend x bye.c1"
	testcbind c <2> "lappend x all2" "lappend x bye.all2"
	event gen .t <1>
    }
    set x [foo eval set x]
    interp delete foo
    set x
} {a1 bye.all2 bye.a1 b1 bye.c1}

test bind-7.1 {Tk_CreateBinding procedure: error} {
    catch {destroy .b.c}
    canvas .b.c
    list [catch {.b.c bind foo <} msg] $msg
} {1 {no event type or button # or keysym}}
test bind-7.2 {Tk_CreateBinding procedure: replace existing C binding} {
    catch {destroy .b.f}
    frame .b.f
    testcbind .b.f <1> "xyz" "lappend x bye.1"
    set x {}
    bind .b.f <1> "abc"
    destroy .b.f
    set x
} {bye.1}
test bind-7.3 {Tk_CreateBinding procedure: append} {
    catch {destroy .b.c}
    canvas .b.c
    .b.c bind foo <1> "button 1"
    .b.c bind foo <1> "+more button 1"
    .b.c bind foo <1>
} {button 1
more button 1}
test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} {
    catch {destroy .b.c}
    canvas .b.c
    .b.c bind foo <1> "+button 1"
    .b.c bind foo <1>
} {button 1}

test bind-8.1 {TkCreateBindingProcedure: error} {
    list [catch {testcbind . <xyz> "xyz"} msg] $msg
} {1 {bad event type or keysym "xyz"}}
test bind-8.2 {TkCreateBindingProcedure: new binding} {
    catch {destroy .b.f}
    frame .b.f
    testcbind .b.f <1> "lappend x 1" "lappend x bye.1"
    set x {}
    event gen .b.f <1>
    destroy .b.f
    set x
} {bye.1}
test bind-8.3 {TkCreateBindingProcedure: replace existing} {
    catch {destroy .b.f}
    frame .b.f
    pack .b.f
    set x {}
    testcbind .b.f <1> "lappend x old1" "lappend x bye.old1"
    testcbind .b.f <1> "lappend x new1" "lappend x bye.new1"
    set x
} {bye.old1}
test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} {
    catch {destroy .b.f}
    frame .b.f
    pack .b.f
    update
    testcbind .b.f <1> "lappend x .b.f; testcbind Frame <1> {lappend x Frame}"
    testcbind Frame <1> "lappend x never"
    set x {}
    event gen .b.f <1>
    bind .b.f <1> {}
    set x
} {.b.f Frame}

test bind-9.1 {Tk_DeleteBinding procedure} {
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    list [catch {bind .b.f <} msg] $msg
} {0 {}}
test bind-9.2 {Tk_DeleteBinding procedure} {
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    foreach i {a b c d} {
	bind .b.f $i "binding for $i"
    }
    set result {}
    foreach i {b d a c} {
	bind .b.f $i {}
	lappend result [lsort [bind .b.f]]
    }
    set result
} {{a c d} {a c} c {}}
test bind-9.3 {Tk_DeleteBinding procedure} {
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} {
	bind .b.f $i "binding for $i"
    }
    set result {}
    foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} {
	bind .b.f $i {}
	lappend result [lsort [bind .b.f]]
    }
    set result
} {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}}
test bind-9.4 {Tk_DeleteBinding procedure: pending bindings delete later} {
    catch {destroy .b.f}
    frame .b.f
    pack .b.f
    update
    bindtags .b.f {a b c}
    testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1}
    bind b <1> {lappend x b1}
    testcbind c <1> {lappend x c1} {lappend x bye.c1}
    testcbind c <2> {lappend x c2} {lappend x bye.c2}
    set x {}
    event gen .b.f <1>
    bind a <1> {}
    bind b <1> {}
    set x
} {a1 bye.c2 b1 bye.c1 bye.a1}

test bind-10.1 {Tk_GetBinding procedure} {
    catch {destroy .b.c}
    canvas .b.c
    list [catch {.b.c bind foo <} msg] $msg
} {1 {no event type or button # or keysym}}
test bind-10.2 {Tk_GetBinding procedure} {
    catch {destroy .b.c}
    canvas .b.c
    .b.c bind foo a Test
    .b.c bind foo a
} {Test}
test bind-10.3 {Tk_GetBinding procedure: C binding} {
    catch {destroy .b.f}
    frame .b.f
    testcbind .b.f <1> "foo"
    list [bind .b.f] [bind .b.f <1>]
} {<Button-1> {}}

test bind-11.1 {Tk_GetAllBindings procedure} {
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" {
	bind .b.f $i Test
    }
    lsort [bind .b.f]
} {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~}
test bind-11.2 {Tk_GetAllBindings procedure} {
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" {
	bind .b.f $i Test
    }
    lsort [bind .b.f]
} {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>}
test bind-11.3 {Tk_GetAllBindings procedure} {
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    foreach i "<Double-Triple-1> abcd a<Leave>b" {
	bind .b.f $i Test
    }
    lsort [bind .b.f]
} {<Triple-Button-1> a<Leave>b abcd}


test bind-12.1 {Tk_DeleteAllBindings procedure} {
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    destroy .b.f
} {}
test bind-12.2 {Tk_DeleteAllBindings procedure} {
    catch {destroy .b.f}
    frame .b.f -class Test -width 150 -height 100
    foreach i "a b c <Meta-1> <Alt-a> <Control-a>" {
	bind .b.f $i x
    }
    destroy .b.f
} {}
test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} {
    catch {destroy .b.f}