diff options
Diffstat (limited to 'tests/listbox.test')
| -rw-r--r-- | tests/listbox.test | 1658 |
1 files changed, 1658 insertions, 0 deletions
diff --git a/tests/listbox.test b/tests/listbox.test new file mode 100644 index 0000000..cb1a4e3 --- /dev/null +++ b/tests/listbox.test @@ -0,0 +1,1658 @@ +# 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}} +test listbox-3.66 {ListboxWidgetCmd procedure, "insert" option} { + catch {destroy .l2} + listbox .l2 + .l2 insert end a b c d e + .l2 insert 3 x y z + .l2 get 0 end +} {a b c x y z d e} +test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} { + catch {destroy .l2} + listbox .l2 + .l2 insert end a b c + .l2 insert -1 x + .l2 get 0 end +} {x a b c} +test listbox-3.68 {ListboxWidgetCmd procedure, "insert" option} { + catch {destroy .l2} + listbox .l2 + .l2 insert end a b c + .l2 insert end x + .l2 get 0 end +} {a b c x} +test listbox-3.69 {ListboxWidgetCmd procedure, "insert" option} { + catch {destroy .l2} + listbox .l2 + .l2 insert end a b c + .l2 insert 43 x + .l2 get 0 end +} {a b c x} +test listbox-3.70 {ListboxWidgetCmd procedure, "nearest" option} { + list [catch {.l nearest} msg] $msg +} {1 {wrong # args: should be ".l nearest y"}} +test listbox-3.71 {ListboxWidgetCmd procedure, "nearest" option} { + list [catch {.l nearest a b} msg] $msg +} {1 {wrong # args: should be ".l nearest y"}} +test listbox-3.72 {ListboxWidgetCmd procedure, "nearest" option} { + list [catch {.l nearest 20p} msg] $msg +} {1 {expected integer but got "20p"}} +test listbox-3.73 {ListboxWidgetCmd procedure, "nearest" option} { + .l yview 3 + .l nearest 1000 +} {7} +test listbox-3.74 {ListboxWidgetCmd procedure, "scan" option} { + list [catch {.l scan a b} msg] $msg +} {1 {wrong # args: should be ".l scan mark|dragto x y"}} +test listbox-3.75 {ListboxWidgetCmd procedure, "scan" option} { + list [catch {.l scan a b c d} msg] $msg +} {1 {wrong # args: should be ".l scan mark|dragto x y"}} +test listbox-3.76 {ListboxWidgetCmd procedure, "scan" option} { + list [catch {.l scan foo bogus 2} msg] $msg +} {1 {expected integer but got "bogus"}} +test listbox-3.77 {ListboxWidgetCmd procedure, "scan" option} { + list [catch {.l scan foo 2 2.3} msg] $msg +} {1 {expected integer but got "2.3"}} +test listbox-3.78 {ListboxWidgetCmd procedure, "scan" 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" a b c d e f g h i j + pack .t.l + update + .t.l scan mark 100 140 + .t.l scan dragto 90 137 + update + list [.t.l xview] [.t.l yview] +} {{0.249364 0.427481} {0.0714286 0.428571}} +test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} { + list [catch {.l scan foo 2 4} msg] $msg +} {1 {bad scan option "foo": must be mark or dragto}} +test listbox-3.80 {ListboxWidgetCmd procedure, "see" option} { + list [catch {.l see} msg] $msg +} {1 {wrong # args: should be ".l see index"}} +test listbox-3.81 {ListboxWidgetCmd procedure, "see" option} { + list [catch {.l see a b} msg] $msg +} {1 {wrong # args: should be ".l see index"}} +test listbox-3.82 {ListboxWidgetCmd procedure, "see" option} { + list [catch {.l see gorp} msg] $msg +} {1 {bad listbox index "gorp": must be active, anchor, end, @x,y, or a number}} +test listbox-3.83 {ListboxWidgetCmd procedure, "see" option} { + .l yview 7 + .l see 7 + .l index @0,0 +} {7} +test listbox-3.84 {ListboxWidgetCmd procedure, "see" option} { + .l yview 7 + .l see 11 + .l index @0,0 +} {7} +test listbox-3.85 {ListboxWidgetCmd procedure, "see" option} { + .l yview 7 + .l see 6 + .l index @0,0 +} {6} +test listbox-3.86 {ListboxWidgetCmd procedure, "see" option} { + .l yview 7 + .l see 5 + .l index @0,0 +} {3} +test listbox-3.87 {ListboxWidgetCmd procedure, "see" option} { + .l yview 7 + .l see 12 + .l index @0,0 +} {8} +test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} { + .l yview 7 + .l see 13 + .l index @0,0 +} {11} +test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} { + .l yview 7 + .l see -1 + .l index @0,0 +} {0} +test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} { + .l yview 7 + .l see end + .l index @0,0 +} {13} +test listbox-3.91 {ListboxWidgetCmd procedure, "see" option} { + .l yview 7 + .l see 322 + .l index @0,0 +} {13} +test listbox-3.92 {ListboxWidgetCmd procedure, "see" option, partial last line} { + mkPartial + .partial.l see 4 + .partial.l index @0,0 +} {1} +test listbox-3.93 {ListboxWidgetCmd procedure, "selection" option} { + list [catch {.l select a} msg] $msg +} {1 {wrong # args: should be ".l selection option index ?index?"}} +test listbox-3.94 {ListboxWidgetCmd procedure, "selection" option} { + list [catch {.l select a b c d} msg] $msg +} {1 {wrong # args: should be ".l selection option index ?index?"}} +test listbox-3.95 {ListboxWidgetCmd procedure, "selection" option} { + list [catch {.l selection a bogus} msg] $msg +} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}} +test listbox-3.96 {ListboxWidgetCmd procedure, "selection" option} { + list [catch {.l selection a 0 lousy} msg] $msg +} {1 {bad listbox index "lousy": must be active, anchor, end, @x,y, or a number}} +test listbox-3.97 {ListboxWidgetCmd procedure, "selection" option} { + list [catch {.l selection anchor 0 0} msg] $msg +} {1 {wrong # args: should be ".l selection anchor index"}} +test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} { + list [.l selection anchor 5; .l index anchor] \ + [.l selection anchor 0; .l index anchor] +} {5 0} +test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} { + .l selection anchor -1 + .l index anchor +} {0} +test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} { + .l selection anchor end + .l index anchor +} {17} +test listbox-3.101 {ListboxWidgetCmd procedure, "selection" option} { + .l selection anchor 44 + .l index anchor +} {17} +test listbox-3.102 {ListboxWidgetCmd procedure, "selection" option} { + .l selection clear 0 end + .l selection set 2 8 + .l selection clear 3 4 + .l curselection +} {2 5 6 7 8} +test listbox-3.103 {ListboxWidgetCmd procedure, "selection" option} { + list [catch {.l selection includes 0 0} msg] $msg +} {1 {wrong # args: should be ".l selection includes index"}} +test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} { + .l selection clear 0 end + .l selection set 2 8 + .l selection clear 4 + list [.l selection includes 3] [.l selection includes 4] \ + [.l selection includes 5] +} {1 0 1} +test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} { + .l selection set 0 end + .l selection includes -1 +} {0} +test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} { + .l selection clear 0 end + .l selection set end + .l selection includes end +} {1} +test listbox-3.107 {ListboxWidgetCmd procedure, "selection" option} { + .l selection set 0 end + .l selection includes 44 +} {0} +test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} { + catch {destroy .l2} + listbox .l2 + .l2 selection includes 0 +} {0} +test listbox-3.109 {ListboxWidgetCmd procedure, "selection" option} { + .l selection clear 0 end + .l selection set 2 + .l selection set 5 7 + .l curselection +} {2 5 6 7} +test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} { + .l selection set 5 7 + .l curselection +} {2 5 6 7} +test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} { + list [catch {.l selection badOption 0 0} msg] $msg +} {1 {bad selection option "badOption": must be anchor, clear, includes, or set}} +test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} { + list [catch {.l size a} msg] $msg +} {1 {wrong # args: should be ".l size"}} +test listbox-3.113 {ListboxWidgetCmd procedure, "size" option} { + .l size +} {18} +test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} { + catch {destroy .l2} + listbox .l2 + update + .l2 xview +} {0 1} +test listbox-3.115 {ListboxWidgetCmd procedure, "xview" option} { + catch {destroy .l} + listbox .l -width 10 -height 5 -font $fixed + .l insert 0 a b c d e f g h i j k l m n o p q r s t + pack .l + update + .l xview +} {0 1} +catch {destroy .l} +listbox .l -width 10 -height 5 -font $fixed +.l insert 0 a b c d e f g h i j k l m n o p q r s t +.l insert 1 "0123456789a123456789b123456789c123456789d123456789" +pack .l +update +test listbox-3.116 {ListboxWidgetCmd procedure, "xview" option} {fonts} { + .l xview 4 + .l xview +} {0.08 0.28} +test listbox-3.117 {ListboxWidgetCmd procedure, "xview" option} { + list [catch {.l xview foo} msg] $msg +} {1 {expected integer but got "foo"}} +test listbox-3.118 {ListboxWidgetCmd procedure, "xview" option} { + list [catch {.l xview zoom a b} msg] $msg +} {1 {unknown option "zoom": must be moveto or scroll}} +test listbox-3.119 {ListboxWidgetCmd procedure, "xview" option} {fonts} { + .l xview 0 + .l xview moveto .4 + update + .l xview +} {0.4 0.6} +test listbox-3.120 {ListboxWidgetCmd procedure, "xview" option} {fonts} { + .l xview 0 + .l xview scroll 2 units + update + .l xview +} {0.04 0.24} +test listbox-3.121 {ListboxWidgetCmd procedure, "xview" option} {fonts} { + .l xview 30 + .l xview scroll -1 pages + update + .l xview +} {0.44 0.64} +test listbox-3.122 {ListboxWidgetCmd procedure, "xview" option} {fonts} { + .l configure -width 1 + update + .l xview 30 + .l xview scroll -4 pages + update + .l xview +} {0.52 0.54} +test listbox-3.123 {ListboxWidgetCmd procedure, "yview" option} { + catch {destroy .l} + listbox .l + pack .l + update + .l yview +} {0 1} +test listbox-3.124 {ListboxWidgetCmd procedure, "yview" option} { + catch {destroy .l} + listbox .l + .l insert 0 el1 + pack .l + update + .l yview +} {0 1} +catch {destroy .l} +listbox .l -width 10 -height 5 -font $fixed +.l insert 0 a b c d e f g h i j k l m n o p q r s t +pack .l +update +test listbox-3.125 {ListboxWidgetCmd procedure, "yview" option} { + .l yview 4 + update + .l yview +} {0.2 0.45} +test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last line} { + mkPartial + .partial.l yview +} {0 0.266667} +test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} { + list [catch {.l yview foo} msg] $msg +} {1 {bad listbox index "foo": must be active, anchor, end, @x,y, or a number}} +test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} { + list [catch {.l yview foo a b} msg] $msg +} {1 {unknown option "foo": must be moveto or scroll}} +test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} { + .l yview 0 + .l yview moveto .31 + .l yview +} {0.3 0.55} +test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} { + .l yview 2 + .l yview scroll 2 pages + .l yview +} {0.4 0.65} +test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} { + .l yview 10 + .l yview scroll -3 units + .l yview +} {0.35 0.6} +test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} { + .l configure -height 2 + update + .l yview 15 + .l yview scroll -4 pages + .l yview +} {0.55 0.65} +test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} { + list [catch {.l whoknows} msg] $msg +} {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}} +test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} { + list [catch {.l c} msg] $msg +} {1 {bad option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}} +test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} { + list [catch {.l in} msg] $msg +} {1 {bad option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}} +test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} { + list [catch {.l s} msg] $msg +} {1 {bad option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}} +test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} { + list [catch {.l se} msg] $msg +} {1 {bad option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}} + +# No tests for DestroyListbox: I can't come up with anything to test +# in this procedure. + +test listbox-4.1 {ConfigureListbox procedure} {fonts} { + catch {destroy .l} + listbox .l -setgrid 1 -width 25 -height 15 + pack .l + update + set x [getsize .] + .l configure -setgrid 0 + update + list $x [getsize .] +} {25x15 185x263} +resetGridInfo +test listbox-4.2 {ConfigureListbox procedure} { + .l configure -highlightthickness -3 + .l cget -highlightthickness +} {0} +test listbox-4.3 {ConfigureListbox procedure} { + .l configure -exportselection 0 + .l delete 0 end + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 + .l selection set 3 5 + .l configure -exportselection 1 + selection get +} {el3 +el4 +el5} +test listbox-4.4 {ConfigureListbox procedure} { + catch {destroy .e} + entry .e + .e insert 0 abc + .e select from 0 + .e select to 2 + .l configure -exportselection 0 + .l delete 0 end + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 + .l selection set 3 5 + .l selection clear 3 5 + .l configure -exportselection 1 + list [selection own] [selection get] +} {.e ab} +test listbox-4.5 {-exportselection option} { + selection clear . + .l configure -exportselection 1 + .l delete 0 end + .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 + .l selection set 1 1 + set x {} + lappend x [catch {selection get} msg] $msg [.l curselection] + .l config -exportselection 0 + lappend x [catch {selection get} msg] $msg [.l curselection] + .l selection clear 0 end + lappend x [catch {selection get} msg] $msg [.l curselection] + .l selection set 1 3 + lappend x [catch {selection get} msg] $msg [.l curselection] + .l config -exportselection 1 + lappend x [catch {selection get} msg] $msg [.l curselection] +} {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1 +el2 +el3} {1 2 3}} +test listbox-4.6 {ConfigureListbox procedure} {fonts} { + catch {destroy .l} + + # The following code (reset geometry, withdraw, etc.) is necessary + # to reset the state of some window managers like olvwm under + # SunOS 4.1.3. + + wm geom . 300x300 + update + wm geom . {} + wm withdraw . + listbox .l -font $fixed -width 15 -height 20 + pack .l + update + wm deiconify . + set x [getsize .] + .l configure -setgrid 1 + update + list $x [getsize .] +} {115x328 15x20} +test listbox-4.7 {ConfigureListbox procedure} { + catch {destroy .l} + wm withdraw . + listbox .l -font $fixed -width 30 -height 20 -setgrid 1 + wm geom . +0+0 + pack .l + update + wm deiconify . + set result [getsize .] + wm geom . 26x15 + update + lappend result [getsize .] + .l configure -setgrid 1 + update + lappend result [getsize .] +} {30x20 26x15 26x15} +wm geom . {} +catch {destroy .l} +resetGridInfo +test listbox-4.8 {ConfigureListbox procedure} { + catch {destroy .l} + listbox .l -width 15 -height 20 -xscrollcommand "record x" \ + -yscrollcommand "record y" + pack .l + update + .l configure -fg black + set log {} + update + set log +} {{y 0 1} {x 0 1}} + +# No tests for DisplayListbox: I don't know how to test this procedure. + +test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} { + catch {destroy .l} + listbox .l -font $fixed -width 15 -height 20 + pack .l + list [winfo reqwidth .l] [winfo reqheight .l] +} {115 328} +test listbox-5.2 {ListboxComputeGeometry procedure} {fonts} { + catch {destroy .l} + listbox .l -font $fixed -width 0 -height 10 + pack .l + update + list [winfo reqwidth .l] [winfo reqheight .l] +} {17 168} +test listbox-5.3 {ListboxComputeGeometry procedure} {fonts} { + catch {destroy .l} + listbox .l -font $fixed -width 0 -height 10 -bd 3 + .l insert 0 Short "Really much longer" Longer + pack .l + update + list [winfo reqwidth .l] [winfo reqheight .l] +} {138 170} +test listbox-5.4 {ListboxComputeGeometry procedure} {fonts} { + catch {destroy .l} + listbox .l -font $fixed -width 10 -height 0 + pack .l + update + list [winfo reqwidth .l] [winfo reqheight .l] +} {80 24} +test listbox-5.5 {ListboxComputeGeometry procedure} {fonts} { + catch {destroy .l} + listbox .l -font $fixed -width 10 -height 0 -highlightthickness 0 + .l insert 0 Short "Really much longer" Longer + pack .l + update + list [winfo reqwidth .l] [winfo reqheight .l] +} {76 52} +test listbox-5.6 {ListboxComputeGeometry procedure} { + # If "0" in selected font had 0 width, caused divide-by-zero error. + + catch {destroy .l} + pack [listbox .l -font {{open look glyph}}] + update +} {} + + +catch {destroy .l} +listbox .l -height 2 -xscrollcommand "record x" -yscrollcommand "record y" +pack .l +update +test listbox-6.1 {InsertEls procedure} { + .l delete 0 end + .l insert end a b c d + .l insert 5 x y z + .l insert 2 A + .l insert 0 q r s + .l get 0 end +} {q r s a b A c d x y z} +test listbox-6.2 {InsertEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l selection anchor 2 + .l insert 2 A B + .l index anchor +} {4} +test listbox-6.3 {InsertEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l selection anchor 2 + .l insert 3 A B + .l index anchor +} {2} +test listbox-6.4 {InsertEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l yview 3 + update + .l insert 2 A B + .l index @0,0 +} {5} +test listbox-6.5 {InsertEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l yview 3 + update + .l insert 3 A B + .l index @0,0 +} {3} +test listbox-6.6 {InsertEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l activate 5 + .l insert 5 A B + .l index active +} {7} +test listbox-6.7 {InsertEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l activate 5 + .l insert 6 A B + .l index active +} {5} +test listbox-6.8 {InsertEls procedure} { + .l delete 0 end + .l insert 0 a b c + .l index active +} {2} +test listbox-6.9 {InsertEls procedure} { + .l delete 0 end + .l insert 0 + .l index active +} {0} +test listbox-6.10 {InsertEls procedure} { + .l delete 0 end + .l insert 0 a b "two words" c d e f g h i j + update + set log {} + .l insert 0 word + update + set log +} {{y 0 0.166667}} +test listbox-6.11 {InsertEls procedure} { + .l delete 0 end + .l insert 0 a b "two words" c d e f g h i j + update + set log {} + .l insert 0 "much longer entry" + update + set log +} {{y 0 0.166667} {x 0 1}} +test listbox-6.12 {InsertEls procedure} {fonts} { + catch {destroy .l2} + listbox .l2 -width 0 -height 0 + pack .l2 -side top + .l2 insert 0 a b "two words" c d + set x {} + lappend x [winfo reqwidth .l2] [winfo reqheight .l2] + .l2 insert 0 "much longer entry" + lappend x [winfo reqwidth .l2] [winfo reqheight .l2] +} {80 93 122 110} + +test listbox-7.1 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l selection set 1 6 + .l delete 4 3 + list [.l size] [selection get] +} {10 {b +c +d +e +f +g}} +test listbox-7.2 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l selection set 3 6 + .l delete 4 4 + list [.l size] [.l get 4] [.l curselection] +} {9 f {3 4 5}} +test listbox-7.3 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l delete 0 3 + list [.l size] [.l get 0] [.l get 1] +} {6 e f} +test listbox-7.4 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l delete 8 1000 + list [.l size] [.l get 7] +} {8 h} +test listbox-7.5 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l selection anchor 2 + .l delete 0 1 + .l index anchor +} {0} +test listbox-7.6 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l selection anchor 2 + .l delete 2 + .l index anchor +} {2} +test listbox-7.7 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l selection anchor 4 + .l delete 2 5 + .l index anchor +} {2} +test listbox-7.8 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l selection anchor 3 + .l delete 4 5 + .l index anchor +} {3} +test listbox-7.9 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l yview 3 + update + .l delete 1 2 + .l index @0,0 +} {1} +test listbox-7.10 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l yview 3 + update + .l delete 3 4 + .l index @0,0 +} {3} +test listbox-7.11 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l yview 3 + update + .l delete 4 6 + .l index @0,0 +} {3} +test listbox-7.12 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l yview 3 + update + .l delete 3 end + .l index @0,0 +} {1} +test listbox-7.13 {DeleteEls procedure, updating view with partial last line} { + mkPartial + .partial.l yview 8 + update + .partial.l delete 10 13 + .partial.l index @0,0 +} {7} +test listbox-7.14 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l activate 6 + .l delete 3 4 + .l index active +} {4} +test listbox-7.15 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l activate 6 + .l delete 5 7 + .l index active +} {5} +test listbox-7.16 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l activate 6 + .l delete 5 end + .l index active +} {4} +test listbox-7.17 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j + .l activate 6 + .l delete 0 end + .l index active +} {0} +test listbox-7.18 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c "two words" d e f g h i j + update + set log {} + .l delete 4 6 + update + set log +} {{y 0 0.25}} +test listbox-7.19 {DeleteEls procedure} { + .l delete 0 end + .l insert 0 a b c "two words" d e f g h i j + update + set log {} + .l delete 3 + update + set log +} {{y 0 0.2} {x 0 1}} +test listbox-7.20 {DeleteEls procedure} {fonts} { + catch {destroy .l2} + listbox .l2 -width 0 -height 0 + pack .l2 -side top + .l2 insert 0 a b "two words" c d e f g + set x {} + lappend x [winfo reqwidth .l2] [winfo reqheight .l2] + .l2 delete 2 4 + lappend x [winfo reqwidth .l2] [winfo reqheight .l2] +} {80 144 17 93} +catch {destroy .l2} + +test listbox-8.1 {ListboxEventProc procedure} {fonts} { + catch {destroy .l} + listbox .l -setgrid 1 + pack .l + update + set x [getsize .] + destroy .l + list $x [getsize .] [winfo exists .l] [info command .l] +} {20x10 150x178 0 {}} +resetGridInfo +test listbox-8.2 {ListboxEventProc procedure} {fonts} { + catch {destroy .l} + listbox .l -height 5 -width 10 + .l insert 0 a b c "A string that is very very long" d e f g h i j k + pack .l + update + place .l -width 50 -height 80 + update + list [.l xview] [.l yview] +} {{0 0.222222} {0 0.333333}} +test listbox-8.3 {ListboxEventProc procedure} { + eval destroy [winfo children .] + listbox .l1 -bg #543210 + rename .l1 .l2 + set x {} + lappend x [winfo children .] + lappend x [.l2 cget -bg] + destroy .l1 + lappend x [info command .l*] [winfo children .] +} {.l1 #543210 {} {}} + +test listbox-9.1 {ListboxCmdDeletedProc procedure} { + eval destroy [winfo children .] + listbox .l1 + rename .l1 {} + list [info command .l*] [winfo children .] +} {{} {}} +test listbox-9.2 {ListboxCmdDeletedProc procedure, disabling -setgrid} fonts { + catch {destroy .top} + toplevel .top + wm geom .top +0+0 + listbox .top.l -setgrid 1 -width 20 -height 10 + pack .top.l + update + set x [wm geometry .top] + rename .top.l {} + update + lappend x [wm geometry .top] + destroy .top + set x +} {20x10+0+0 150x178+0+0} + +catch {destroy .l} +listbox .l +pack .l +.l delete 0 end +.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 +test listbox-10.1 {GetListboxIndex procedure} { + .l activate 3 + list [.l activate 3; .l index active] [.l activate 6; .l index active] +} {3 6} +test listbox-10.2 {GetListboxIndex procedure} { + .l selection anchor 2 + .l index anchor +} 2 +test listbox-10.3 {GetListboxIndex procedure} { + .l insert end A B C D E + .l selection anchor end + .l delete 12 end + list [.l index anchor] [.l index end] +} {12 12} +test listbox-10.4 {GetListboxIndex procedure} { + list [catch {.l index a} msg] $msg +} {1 {bad listbox index "a": must be active, anchor, end, @x,y, or a number}} +test listbox-10.5 {GetListboxIndex procedure} { + .l index end +} {12} +test listbox-10.6 {GetListboxIndex procedure} { + .l get end +} {el11} +test listbox-10.7 {GetListboxIndex procedure} { + .l delete 0 end + .l index end +} 0 +.l delete 0 end +.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 +update +test listbox-10.8 {GetListboxIndex procedure} { + list [catch {.l index @} msg] $msg +} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}} +test listbox-10.9 {GetListboxIndex procedure} { + list [catch {.l index @foo} msg] $msg +} {1 {bad listbox index "@foo": must be active, anchor, end, @x,y, or a number}} +test listbox-10.10 {GetListboxIndex procedure} { + list [catch {.l index @1x3} msg] $msg +} {1 {bad listbox index "@1x3": must be active, anchor, end, @x,y, or a number}} +test listbox-10.11 {GetListboxIndex procedure} { + list [catch {.l index @1,} msg] $msg +} {1 {bad listbox index "@1,": must be active, anchor, end, @x,y, or a number}} +test listbox-10.12 {GetListboxIndex procedure} { + list [catch {.l index @1,foo} msg] $msg +} {1 {bad listbox index "@1,foo": must be active, anchor, end, @x,y, or a number}} +test listbox-10.13 {GetListboxIndex procedure} { + list [catch {.l index @1,2x} msg] $msg +} {1 {bad listbox index "@1,2x": must be active, anchor, end, @x,y, or a number}} +test listbox-10.14 {GetListboxIndex procedure} {fonts} { + list [.l index @5,57] [.l index @5,58] +} {3 3} +test listbox-10.15 {GetListboxIndex procedure} { + list [catch {.l index 1xy} msg] $msg +} {1 {bad listbox index "1xy": must be active, anchor, end, @x,y, or a number}} +test listbox-10.16 {GetListboxIndex procedure} { + .l index 3 +} {3} +test listbox-10.17 {GetListboxIndex procedure} { + .l index 20 +} {20} +test listbox-10.18 {GetListboxIndex procedure} { + .l get 20 +} {} +test listbox-10.19 {GetListboxIndex procedure} { + .l index -2 +} -2 +test listbox-10.20 {GetListboxIndex procedure} { + .l delete 0 end + .l index 1 +} 1 + +test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} { + catch {destroy .l} + listbox .l -height 5 + pack .l + .l insert 0 a b c d e f g h i j + .l yview 3 + update + set x [.l index @0,0] + .l yview -1 + update + lappend x [.l index @0,0] +} {3 0} +test listbox-11.2 {ChangeListboxView procedure, boundary conditions for index} { + catch {destroy .l} + listbox .l -height 5 + pack .l + .l insert 0 a b c d e f g h i j + .l yview 3 + update + set x [.l index @0,0] + .l yview 20 + update + lappend x [.l index @0,0] +} {3 5} +test listbox-11.3 {ChangeListboxView procedure} { + catch {destroy .l} + listbox .l -height 5 -yscrollcommand "record y" + pack .l + .l insert 0 a b c d e f g h i j + update + set log {} + .l yview 2 + update + list [.l yview] $log +} {{0.2 0.7} {{y 0.2 0.7}}} +test listbox-11.4 {ChangeListboxView procedure} { + catch {destroy .l} + listbox .l -height 5 -yscrollcommand "record y" + pack .l + .l insert 0 a b c d e f g h i j + update + set log {} + .l yview 8 + update + list [.l yview] $log +} {{0.5 1} {{y 0.5 1}}} +test listbox-11.5 {ChangeListboxView procedure} { + catch {destroy .l} + listbox .l -height 5 -yscrollcommand "record y" + pack .l + .l insert 0 a b c d e f g h i j + .l yview 3 + update + set log {} + .l yview 3 + update + list [.l yview] $log +} {{0.3 0.8} {}} +test listbox-11.6 {ChangeListboxView procedure, partial last line} { + mkPartial + .partial.l yview 13 + .partial.l index @0,0 +} {11} + +catch {destroy .l} +listbox .l -font $fixed -xscrollcommand "record x" -width 10 +.l insert 0 0123456789a123456789b123456789c123456789d123456789e123456789f123456789g123456789h123456789i123456789 +pack .l +update +test listbox-12.1 {ChangeListboxOffset procedure} {fonts} { + set log {} + .l xview 99 + update + list [.l xview] $log +} {{0.9 1} {{x 0.9 1}}} +test listbox-12.2 {ChangeListboxOffset procedure} {fonts} { + set log {} + .l xview moveto -.25 + update + list [.l xview] $log +} {{0 0.1} {{x 0 0.1}}} +test listbox-12.3 {ChangeListboxOffset procedure} {fonts} { + .l xview 10 + update + set log {} + .l xview 10 + update + list [.l xview] $log +} {{0.1 0.2} {}} + +catch {destroy .l} +listbox .l -font $fixed -width 10 -height 5 +pack .l +.l insert 0 a bb c d e f g h i j k l m n o p q r s +.l insert 0 0123456789a123456789b123456789c123456789d123456789 +update +set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]] +set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]] +test listbox-13.1 {ListboxScanTo procedure} {fonts} { + .l yview 0 + .l xview 0 + .l scan mark 10 20 + .l scan dragto [expr 10-$width] [expr 20-$height] + update + list [.l xview] [.l yview] +} {{0.2 0.4} {0.5 0.75}} +test listbox-13.2 {ListboxScanTo procedure} {fonts} { + .l yview 5 + .l xview 10 + .l scan mark 10 20 + .l scan dragto 20 40 + update + set x [list [.l xview] [.l yview]] + .l scan dragto [expr 20-$width] [expr 40-$height] + update + lappend x [.l xview] [.l yview] +} {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}} +test listbox-13.3 {ListboxScanTo procedure} {fonts} { + .l yview moveto 1.0 + .l xview moveto 1.0 + .l scan mark 10 20 + .l scan dragto 5 10 + update + set x [list [.l xview] [.l yview]] + .l scan dragto [expr 5+$width] [expr 10+$height] + update + lappend x [.l xview] [.l yview] +} {{0.8 1} {0.75 1} {0.62 0.82} {0.25 0.5}} + +test listbox-14.1 {NearestListboxElement procedure, partial last line} { + mkPartial + .partial.l nearest [winfo height .partial.l] +} {4} +catch {destroy .l} +listbox .l -font $fixed -width 20 -height 10 +.l insert 0 a b c d e f g h i j k l m n o p q r s t +.l yview 4 +pack .l +update +test listbox-14.2 {NearestListboxElement procedure} {fonts} { + .l index @50,0 +} {4} +test listbox-14.3 {NearestListboxElement procedure} {fonts} { + list [.l index @50,35] [.l index @50,36] +} {5 6} +test listbox-14.4 {NearestListboxElement procedure} {fonts} { + .l index @50,200 +} {13} + +test listbox-15.1 {ListboxSelect procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j k l m n o p + .l select set 2 4 + .l select set 7 12 + .l select clear 4 7 + .l curselection +} {2 3 8 9 10 11 12} +test listbox-15.2 {ListboxSelect procedure} { + .l delete 0 end + .l insert 0 a b c d e f g h i j k l m n o p + catch {destroy .e} + entry .e + .e insert 0 "This is some text" + .e select from 0 + .e select to 7 + .l selection clear 2 4 + set x [selection own] + .l selection set 3 + list $x [selection own] [selection get] +} {.e .l d} +test listbox-15.3 {ListboxSelect procedure} { + .l delete 0 end + .l selection clear 0 end + .l select set 0 end + .l curselection +} {} +test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} { + .l delete 0 end + .l insert 0 a b c d e f + .l select clear 0 end + .l select set -2 -1 + .l curselection +} {} +test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} { + .l delete 0 end + .l insert 0 a b c d e f + .l select clear 0 end + .l select set -1 3 + .l curselection +} {0 1 2 3} +test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} { + .l delete 0 end + .l insert 0 a b c d e f + .l select clear 0 end + .l select set 2 4 + .l curselection +} {2 3 4} +test listbox-15.7 {ListboxSelect procedure, boundary conditions for indices} { + .l delete 0 end + .l insert 0 a b c d e f + .l select clear 0 end + .l select set 4 end + .l curselection +} {4 5} +test listbox-15.8 {ListboxSelect procedure, boundary conditions for indices} { + .l delete 0 end + .l insert 0 a b c d e f + .l select clear 0 end + .l select set 4 30 + .l curselection +} {4 5} +test listbox-15.9 {ListboxSelect procedure, boundary conditions for indices} { + .l delete 0 end + .l insert 0 a b c d e f + .l select clear 0 end + .l select set end 30 + .l curselection +} {5} +test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} { + .l delete 0 end + .l insert 0 a b c d e f + .l select clear 0 end + .l select set 20 25 + .l curselection +} {} + +test listbox-16.1 {ListboxFetchSelection procedure} { + .l delete 0 end + .l insert 0 a b c "two words" e f g h i \\ k l m n o p + .l selection set 2 4 + .l selection set 9 + .l selection set 11 12 + selection get +} "c\ntwo words\ne\n\\\nl\nm" +test listbox-16.2 {ListboxFetchSelection procedure} { + .l delete 0 end + .l insert 0 a b c "two words" e f g h i \\ k l m n o p + .l selection set 3 + selection get +} "two words" +test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} { + set long "This is quite a long string\n" + append long $long $long $long $long + append long $long $long $long $long + append long $long $long + .l delete 0 end + .l insert 0 1$long 2$long 3$long 4$long 5$long + .l selection set 0 end + set sel [selection get] + string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel +} {0} +catch {unset long sel} + +test listbox-17.1 {ListboxLostSelection procedure} { + .l delete 0 end + .l insert 0 a b c d e + .l select set 0 end + catch {destroy .e} + entry .e + .e insert 0 "This is some text" + .e select from 0 + .e select to 5 + .l curselection +} {} +test listbox-17.2 {ListboxLostSelection procedure} { + .l delete 0 end + .l insert 0 a b c d e + .l select set 0 end + .l configure -exportselection 0 + catch {destroy .e} + entry .e + .e insert 0 "This is some text" + .e select from 0 + .e select to 5 + .l curselection +} {0 1 2 3 4} + +catch {destroy .l} +listbox .l -font $fixed -width 10 -height 5 +pack .l +update +test listbox-18.1 {ListboxUpdateVScrollbar procedure} { + .l configure -yscrollcommand "record y" + set log {} + .l insert 0 a b c + update + .l insert end d e f g h + update + .l delete 0 end + update + set log +} {{y 0 1} {y 0 0.625} {y 0 1}} +test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} { + mkPartial + .partial.l configure -yscrollcommand "record y" + set log {} + .partial.l yview 3 + update + set log +} {{y 0.2 0.466667}} +test listbox-18.3 {ListboxUpdateVScrollbar procedure} { + proc bgerror args { + global x errorInfo + set x [list $args $errorInfo] + } + .l configure -yscrollcommand gorp + .l insert 0 foo + update + set x +} {{{invalid command name "gorp"}} {invalid command name "gorp" + while executing +"gorp 0 1" + (vertical scrolling command executed by listbox)}} +if {[info exists bgerror]} { + rename bgerror {} +} + +catch {destroy .l} +listbox .l -font $fixed -width 10 -height 5 +pack .l +update +test listbox-19.1 {ListboxUpdateVScrollbar procedure} {fonts} { + .l configure -xscrollcommand "record x" + set log {} + .l insert 0 abc + update + .l insert 0 "This is a much longer string..." + update + .l delete 0 end + update + set log +} {{x 0 1} {x 0 0.322581} {x 0 1}} +test listbox-19.2 {ListboxUpdateVScrollbar procedure} { + proc bgerror args { + global x errorInfo + set x [list $args $errorInfo] + } + .l configure -xscrollcommand bogus + .l insert 0 foo + update + set x +} {{{invalid command name "bogus"}} {invalid command name "bogus" + while executing +"bogus 0 1" + (horizontal scrolling command executed by listbox)}} + +set l [interp hidden] +eval destroy [winfo children .] + +test listbox-20.1 {listbox vs hidden commands} { + catch {destroy .l} + listbox .l + interp hide {} .l + destroy .l + list [winfo children .] [interp hidden] +} [list {} $l] + +resetGridInfo +catch {destroy .l2} +catch {destroy .t} +catch {destroy .e} +catch {destroy .partial} +option clear + |