listbox.test

linux系统下的音频通信

# This file is a Tcl script to test out the "listbox" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 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: @(#) listbox.test 1.45 97/10/29 13:05:46

if {[string compare test [info procs test]] == 1} then \
  {source defs}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
set fixed {Courier -12}

proc record args {
    global log
    lappend log $args
}

proc getsize w {
    regexp {(^[^+-]*)} [wm geometry $w] foo x
    return $x
}

proc resetGridInfo {} {
    # Some window managers, such as mwm, don't reset gridding information
    # unless the window is withdrawn and re-mapped.  If this procedure
    # isn't invoked, the window manager will stay in gridded mode, which
    # can cause all sorts of problems.  The "wm positionfrom" command is
    # needed so that the window manager doesn't ask the user to
    # manually position the window when it is re-mapped.

    wm withdraw .
    wm positionfrom . user
    wm deiconify .
}

# Procedure that creates a second listbox for checking things related
# to partially visible lines.

proc mkPartial {{w .partial}} {
    catch {destroy $w}
    toplevel $w
    wm geometry $w +0+0
    listbox $w.l -width 30 -height 5
    pack $w.l -expand 1 -fill both
    $w.l insert end one two three four five six seven eight nine ten \
	    eleven twelve thirteen fourteen fifteen
    update
    scan [wm geometry $w] "%dx%d" width height
    wm geometry $w ${width}x[expr $height-3]
    update
}

# Create entries in the option database to be sure that geometry options
# like border width have predictable values.

option add *Listbox.borderWidth 2
option add *Listbox.highlightThickness 2
option add *Listbox.font {Helvetica -12 bold}

listbox .l
pack .l
update
resetGridInfo
set i 1

foreach test {
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bd 4 4 badValue {bad screen distance "badValue"}}
    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
    {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
    {-height 30 30 20p {expected integer but got "20p"}}
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
    {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
    {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
    {-highlightthickness -2 0 {} {}}
    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
    {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
    {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
    {-selectmode string string {} {}}
    {-setgrid false 0 lousy {expected boolean value but got "lousy"}}
    {-takefocus "any string" "any string" {} {}}
    {-width 45 45 3p {expected integer but got "3p"}}
    {-xscrollcommand {Some command} {Some command} {} {}}
    {-yscrollcommand {Another command} {Another command} {} {}}
} {
    set name [lindex $test 0]
    test listbox-1.$i {configuration options} {
	.l configure $name [lindex $test 1]
	list [lindex [.l configure $name] 4] [.l cget $name]
    } [list [lindex $test 2] [lindex $test 2]]
    incr i
    if {[lindex $test 3] != ""} {
	test listbox-1.$i {configuration options} {
	    list [catch {.l configure $name [lindex $test 3]} msg] $msg
	} [list 1 [lindex $test 4]]
    }
    .l configure $name [lindex [.l configure $name] 3]
    incr i
}

test listbox-2.1 {Tk_ListboxCmd procedure} {
    list [catch {listbox} msg] $msg
} {1 {wrong # args: should be "listbox pathName ?options?"}}
test listbox-2.2 {Tk_ListboxCmd procedure} {
    list [catch {listbox gorp} msg] $msg
} {1 {bad window path name "gorp"}}
test listbox-2.3 {Tk_ListboxCmd procedure} {
    catch {destroy .l}
    listbox .l
    list [winfo exists .l] [winfo class .l] [info commands .l]
} {1 Listbox .l}
test listbox-2.4 {Tk_ListboxCmd procedure} {
    catch {destroy .l}
    list [catch {listbox .l -gorp foo} msg] $msg [winfo exists .l] \
	    [info commands .l]
} {1 {unknown option "-gorp"} 0 {}}
test listbox-2.5 {Tk_ListboxCmd procedure} {
    catch {destroy .l}
    listbox .l
} {.l}

catch {destroy .l}
listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2
pack .l
.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \
	el15 el16 el17
update
test listbox-3.1 {ListboxWidgetCmd procedure} {
    list [catch .l msg] $msg
} {1 {wrong # args: should be ".l option ?arg arg ...?"}}
test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} {
    list [catch {.l activate} msg] $msg
} {1 {wrong # args: should be ".l activate index"}}
test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} {
    list [catch {.l activate a b} msg] $msg
} {1 {wrong # args: should be ".l activate index"}}
test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} {
    list [catch {.l activate fooey} msg] $msg
} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}}
test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} {
    .l activate 3
    .l index active
} 3
test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} {
    .l activate -1
    .l index active
} {0}
test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} {
    .l activate 30
    .l index active
} {17}
test listbox-3.8 {ListboxWidgetCmd procedure, "activate" option} {
    .l activate end
    .l index active
} {17}
test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} {
    list [catch {.l bbox} msg] $msg
} {1 {wrong # args: should be ".l bbox index"}}
test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} {
    list [catch {.l bbox a b} msg] $msg
} {1 {wrong # args: should be ".l bbox index"}}
test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} {
    list [catch {.l bbox fooey} msg] $msg
} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}}
test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option} {
    .l yview 3
    update
    list [.l bbox 2] [.l bbox 8]
} {{} {}}
test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} {
    # Used to generate a core dump before a bug was fixed (the last
    # element would be on-screen if it existed, but it doesn't exist).

    listbox .l2
    pack .l2 -side top
    tkwait visibility .l2
    set x [.l2 bbox 0]
    destroy .l2
    set x
} {}
test listbox-3.14 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
    .l yview 3
    update
    list [.l bbox 3] [.l bbox 4]
} {{7 7 17 14} {7 26 17 14}}
test listbox-3.15 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
    .l yview 0
    update
    list [.l bbox -1] [.l bbox 0]
} {{} {7 7 17 14}}
test listbox-3.16 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
    .l yview end
    update
    list [.l bbox 17] [.l bbox end] [.l bbox 18]
} {{7 83 24 14} {7 83 24 14} {}}
test listbox-3.17 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
    catch {destroy .t}
    toplevel .t
    wm geom .t +0+0
    listbox .t.l -width 10 -height 5
    .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short"
    pack .t.l
    update
    .t.l xview moveto .2
    .t.l bbox 2
} {-72 39 393 14}
test listbox-3.18 {ListboxWidgetCmd procedure, "bbox" option, partial last line} {fonts} {
    mkPartial
    list [.partial.l bbox 3] [.partial.l bbox 4]
} {{5 56 24 14} {5 73 23 14}}
test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} {
    list [catch {.l cget} msg] $msg
} {1 {wrong # args: should be ".l cget option"}}
test listbox-3.20 {ListboxWidgetCmd procedure, "cget" option} {
    list [catch {.l cget a b} msg] $msg
} {1 {wrong # args: should be ".l cget option"}}
test listbox-3.21 {ListboxWidgetCmd procedure, "cget" option} {
    list [catch {.l cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} {
    .l cget -setgrid
} {0}
test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} {
    llength [.l configure]
} {23}
test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} {
    list [catch {.l configure -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test listbox-3.25 {ListboxWidgetCmd procedure, "configure" option} {
    .l configure -setgrid
} {-setgrid setGrid SetGrid 0 0}
test listbox-3.26 {ListboxWidgetCmd procedure, "configure" option} {
    list [catch {.l configure -gorp is_messy} msg] $msg
} {1 {unknown option "-gorp"}}
test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} {
    set oldbd [.l cget -bd]
    set oldht [.l cget -highlightthickness]
    .l configure -bd 3 -highlightthickness 0
    set x "[.l cget -bd] [.l cget -highlightthickness]"
    .l configure -bd $oldbd -highlightthickness $oldht
    set x
} {3 0}
test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} {
    list [catch {.l curselection a} msg] $msg
} {1 {wrong # args: should be ".l curselection"}}
test listbox-3.29 {ListboxWidgetCmd procedure, "curselection" option} {
    .l selection clear 0 end
    .l selection set 3 6
    .l selection set 9
    .l curselection
} {3 4 5 6 9}
test listbox-3.30 {ListboxWidgetCmd procedure, "delete" option} {
    list [catch {.l delete} msg] $msg
} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
test listbox-3.31 {ListboxWidgetCmd procedure, "delete" option} {
    list [catch {.l delete a b c} msg] $msg
} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
test listbox-3.32 {ListboxWidgetCmd procedure, "delete" option} {
    list [catch {.l delete badIndex} msg] $msg
} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}}
test listbox-3.33 {ListboxWidgetCmd procedure, "delete" option} {
    list [catch {.l delete 2 123ab} msg] $msg
} {1 {bad listbox index "123ab": must be active, anchor, end, @x,y, or a number}}
test listbox-3.34 {ListboxWidgetCmd procedure, "delete" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
    .l2 delete 3
    list [.l2 get 2] [.l2 get 3] [.l2 index end]
} {el2 el4 7}
test listbox-3.35 {ListboxWidgetCmd procedure, "delete" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
    .l2 delete 2 4
    list [.l2 get 1] [.l2 get 2] [.l2 index end]
} {el1 el5 5}
test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
    .l2 delete -3 2
    .l2 get 0 end
} {el3 el4 el5 el6 el7}
test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
    .l2 delete -3 -1
    .l2 get 0 end
} {el0 el1 el2 el3 el4 el5 el6 el7}
test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
    .l2 delete 2 end
    .l2 get 0 end
} {el0 el1}
test listbox-3.39 {ListboxWidgetCmd procedure, "delete" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
    .l2 delete 5 20
    .l2 get 0 end
} {el0 el1 el2 el3 el4}
test listbox-3.40 {ListboxWidgetCmd procedure, "delete" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
    .l2 delete end 20
    .l2 get 0 end
} {el0 el1 el2 el3 el4 el5 el6}
test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
    .l2 delete 8 20
    .l2 get 0 end
} {el0 el1 el2 el3 el4 el5 el6 el7}
test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} {
    list [catch {.l get} msg] $msg
} {1 {wrong # args: should be ".l get first ?last?"}}
test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} {
    list [catch {.l get a b c} msg] $msg
} {1 {wrong # args: should be ".l get first ?last?"}}
test listbox-3.44 {ListboxWidgetCmd procedure, "get" option} {
    list [catch {.l get 2.4} msg] $msg
} {1 {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number}}
test listbox-3.45 {ListboxWidgetCmd procedure, "get" option} {
    list [catch {.l get end bogus} msg] $msg
} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}}
test listbox-3.46 {ListboxWidgetCmd procedure, "get" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
    list [.l2 get 0] [.l2 get 3] [.l2 get end]
} {el0 el3 el7}
test listbox-3.47 {ListboxWidgetCmd procedure, "get" option} {
    catch {destroy .l2}
    listbox .l2
    list [.l2 get 0] [.l2 get end]
} {{} {}}
test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} {
    catch {destroy .l2}
    listbox .l2
    .l2 insert 0 el0 el1 el2 "two words" el4 el5 el6 el7
    .l2 get 3 end
} {{two words} el4 el5 el6 el7}
test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} {
    .l get -1
} {}
test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} {
    .l get -2 -1
} {}
test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} {
    .l get -2 3
} {el0 el1 el2 el3}
test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} {
    .l get 12 end
} {el12 el13 el14 el15 el16 el17}
test listbox-3.53 {ListboxWidgetCmd procedure, "get" option} {
    .l get 12 20
} {el12 el13 el14 el15 el16 el17}
test listbox-3.54 {ListboxWidgetCmd procedure, "get" option} {
    .l get end
} {el17}
test listbox-3.55 {ListboxWidgetCmd procedure, "get" option} {
    .l get 30
} {}
test listbox-3.56 {ListboxWidgetCmd procedure, "get" option} {
    .l get 30 35
} {}
test listbox-3.57 {ListboxWidgetCmd procedure, "index" option} {
    list [catch {.l index} msg] $msg
} {1 {wrong # args: should be ".l index index"}}
test listbox-3.58 {ListboxWidgetCmd procedure, "index" option} {
    list [catch {.l index a b} msg] $msg
} {1 {wrong # args: should be ".l index index"}}
test listbox-3.59 {ListboxWidgetCmd procedure, "index" option} {
    list [catch {.l index @} msg] $msg
} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}}
test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} {
    .l index 2
} 2
test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} {
    .l index -1
} -1
test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} {
    .l index end
} 18
test listbox-3.63 {ListboxWidgetCmd procedure, "index" option} {
    .l index 34
} 34
test listbox-3.64 {ListboxWidgetCmd procedure, "insert" option} {
    list [catch {.l insert} msg] $msg
} {1 {wrong # args: should be ".l insert index ?element element ...?"}}
test listbox-3.65 {ListboxWidgetCmd procedure, "insert" option} {
    list [catch {.l insert badIndex} msg] $msg
} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}}