1# This file is a Tcl script to test out the "listbox" command 2# of Tk. It is organized in the standard fashion for Tcl tests. 3# 4# Copyright (c) 1993-1994 The Regents of the University of California. 5# Copyright (c) 1994-1997 Sun Microsystems, Inc. 6# Copyright (c) 1998-1999 by Scriptics Corporation. 7# All rights reserved. 8# 9# RCS: @(#) $Id$ 10 11package require tcltest 2.1 12eval tcltest::configure $argv 13tcltest::loadTestedCommands 14 15set fixed {Courier -12} 16 17proc record {name args} { 18 global log 19 lappend log [format {%s %.6g %.6g} $name {*}$args] 20} 21 22proc getsize w { 23 regexp {(^[^+-]*)} [wm geometry $w] foo x 24 return $x 25} 26 27proc resetGridInfo {} { 28 # Some window managers, such as mwm, don't reset gridding information 29 # unless the window is withdrawn and re-mapped. If this procedure 30 # isn't invoked, the window manager will stay in gridded mode, which 31 # can cause all sorts of problems. The "wm positionfrom" command is 32 # needed so that the window manager doesn't ask the user to 33 # manually position the window when it is re-mapped. 34 35 wm withdraw . 36 wm positionfrom . user 37 wm deiconify . 38} 39 40# Procedure that creates a second listbox for checking things related 41# to partially visible lines. 42 43proc mkPartial {{w .partial}} { 44 catch {destroy $w} 45 toplevel $w 46 wm geometry $w +0+0 47 listbox $w.l -width 30 -height 5 48 pack $w.l -expand 1 -fill both 49 $w.l insert end one two three four five six seven eight nine ten \ 50 eleven twelve thirteen fourteen fifteen 51 update 52 scan [wm geometry $w] "%dx%d" width height 53 wm geometry $w ${width}x[expr $height-3] 54 update 55} 56 57# Create entries in the option database to be sure that geometry options 58# like border width have predictable values. 59 60option add *Listbox.borderWidth 2 61option add *Listbox.highlightThickness 2 62option add *Listbox.font {Helvetica -12 bold} 63 64listbox .l 65pack .l 66update 67resetGridInfo 68set i 1 69 70foreach test { 71 {-activestyle under underline foo {bad activestyle "foo": must be dotbox, none, or underline}} 72 {-background #ff0000 #ff0000 non-existent 73 {unknown color name "non-existent"}} 74 {-bd 4 4 badValue {bad screen distance "badValue"}} 75 {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} 76 {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} 77 {-cursor arrow arrow badValue {bad cursor spec "badValue"}} 78 {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}} 79 {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} 80 {-fg #110022 #110022 bogus {unknown color name "bogus"}} 81 {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}} 82 {-foreground #110022 #110022 bogus {unknown color name "bogus"}} 83 {-height 30 30 20p {expected integer but got "20p"}} 84 {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}} 85 {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} 86 {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} 87 {-highlightthickness -2 0 {} {}} 88 {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} 89 {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} 90 {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} 91 {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} 92 {-selectmode string string {} {}} 93 {-setgrid false 0 lousy {expected boolean value but got "lousy"}} 94 {-state disabled disabled foo {bad state "foo": must be disabled or normal}} 95 {-takefocus "any string" "any string" {} {}} 96 {-width 45 45 3p {expected integer but got "3p"}} 97 {-xscrollcommand {Some command} {Some command} {} {}} 98 {-yscrollcommand {Another command} {Another command} {} {}} 99 {-listvar testVariable testVariable {} {}} 100} { 101 set name [lindex $test 0] 102 test listbox-1.$i {configuration options} { 103 .l configure $name [lindex $test 1] 104 list [lindex [.l configure $name] 4] [.l cget $name] 105 } [list [lindex $test 2] [lindex $test 2]] 106 incr i 107 if {[lindex $test 3] != ""} { 108 test listbox-1.$i {configuration options} { 109 list [catch {.l configure $name [lindex $test 3]} msg] $msg 110 } [list 1 [lindex $test 4]] 111 } 112 .l configure $name [lindex [.l configure $name] 3] 113 incr i 114} 115 116test listbox-2.1 {Tk_ListboxCmd procedure} { 117 list [catch {listbox} msg] $msg 118} {1 {wrong # args: should be "listbox pathName ?options?"}} 119test listbox-2.2 {Tk_ListboxCmd procedure} { 120 list [catch {listbox gorp} msg] $msg 121} {1 {bad window path name "gorp"}} 122test listbox-2.3 {Tk_ListboxCmd procedure} { 123 catch {destroy .l} 124 listbox .l 125 list [winfo exists .l] [winfo class .l] [info commands .l] 126} {1 Listbox .l} 127test listbox-2.4 {Tk_ListboxCmd procedure} { 128 catch {destroy .l} 129 list [catch {listbox .l -gorp foo} msg] $msg [winfo exists .l] \ 130 [info commands .l] 131} {1 {unknown option "-gorp"} 0 {}} 132test listbox-2.5 {Tk_ListboxCmd procedure} { 133 catch {destroy .l} 134 listbox .l 135} {.l} 136 137catch {destroy .l} 138listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2 139pack .l 140.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \ 141 el15 el16 el17 142update 143test listbox-3.1 {ListboxWidgetCmd procedure} { 144 list [catch .l msg] $msg 145} {1 {wrong # args: should be ".l option ?arg arg ...?"}} 146test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} { 147 list [catch {.l activate} msg] $msg 148} {1 {wrong # args: should be ".l activate index"}} 149test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} { 150 list [catch {.l activate a b} msg] $msg 151} {1 {wrong # args: should be ".l activate index"}} 152test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} { 153 list [catch {.l activate fooey} msg] $msg 154} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}} 155test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} { 156 .l activate 3 157 .l index active 158} 3 159test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} { 160 .l activate -1 161 .l index active 162} {0} 163test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} { 164 .l activate 30 165 .l index active 166} {17} 167test listbox-3.8 {ListboxWidgetCmd procedure, "activate" option} { 168 .l activate end 169 .l index active 170} {17} 171test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} { 172 list [catch {.l bbox} msg] $msg 173} {1 {wrong # args: should be ".l bbox index"}} 174test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} { 175 list [catch {.l bbox a b} msg] $msg 176} {1 {wrong # args: should be ".l bbox index"}} 177test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} { 178 list [catch {.l bbox fooey} msg] $msg 179} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}} 180test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option} { 181 .l yview 3 182 update 183 list [.l bbox 2] [.l bbox 8] 184} {{} {}} 185test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} { 186 # Used to generate a core dump before a bug was fixed (the last 187 # element would be on-screen if it existed, but it doesn't exist). 188 189 listbox .l2 190 pack .l2 -side top 191 tkwait visibility .l2 192 set x [.l2 bbox 0] 193 destroy .l2 194 set x 195} {} 196test listbox-3.14 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { 197 .l yview 3 198 update 199 list [.l bbox 3] [.l bbox 4] 200} {{7 7 17 14} {7 26 17 14}} 201test listbox-3.15 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { 202 .l yview 0 203 update 204 list [.l bbox -1] [.l bbox 0] 205} {{} {7 7 17 14}} 206test listbox-3.16 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { 207 .l yview end 208 update 209 list [.l bbox 17] [.l bbox end] [.l bbox 18] 210} {{7 83 24 14} {7 83 24 14} {}} 211test listbox-3.17 {ListboxWidgetCmd procedure, "bbox" option} {fonts} { 212 catch {destroy .t} 213 toplevel .t 214 wm geom .t +0+0 215 listbox .t.l -width 10 -height 5 216 .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short" 217 pack .t.l 218 update 219 .t.l xview moveto .2 220 .t.l bbox 2 221} {-72 39 393 14} 222test listbox-3.18 {ListboxWidgetCmd procedure, "bbox" option, partial last line} {fonts} { 223 mkPartial 224 list [.partial.l bbox 3] [.partial.l bbox 4] 225} {{5 56 24 14} {5 73 23 14}} 226test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} { 227 list [catch {.l cget} msg] $msg 228} {1 {wrong # args: should be ".l cget option"}} 229test listbox-3.20 {ListboxWidgetCmd procedure, "cget" option} { 230 list [catch {.l cget a b} msg] $msg 231} {1 {wrong # args: should be ".l cget option"}} 232test listbox-3.21 {ListboxWidgetCmd procedure, "cget" option} { 233 list [catch {.l cget -gorp} msg] $msg 234} {1 {unknown option "-gorp"}} 235test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} { 236 .l cget -setgrid 237} {0} 238test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} { 239 llength [.l configure] 240} {27} 241test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} { 242 list [catch {.l configure -gorp} msg] $msg 243} {1 {unknown option "-gorp"}} 244test listbox-3.25 {ListboxWidgetCmd procedure, "configure" option} { 245 .l configure -setgrid 246} {-setgrid setGrid SetGrid 0 0} 247test listbox-3.26 {ListboxWidgetCmd procedure, "configure" option} { 248 list [catch {.l configure -gorp is_messy} msg] $msg 249} {1 {unknown option "-gorp"}} 250test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} { 251 set oldbd [.l cget -bd] 252 set oldht [.l cget -highlightthickness] 253 .l configure -bd 3 -highlightthickness 0 254 set x "[.l cget -bd] [.l cget -highlightthickness]" 255 .l configure -bd $oldbd -highlightthickness $oldht 256 set x 257} {3 0} 258test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} { 259 list [catch {.l curselection a} msg] $msg 260} {1 {wrong # args: should be ".l curselection"}} 261test listbox-3.29 {ListboxWidgetCmd procedure, "curselection" option} { 262 .l selection clear 0 end 263 .l selection set 3 6 264 .l selection set 9 265 .l curselection 266} {3 4 5 6 9} 267test listbox-3.30 {ListboxWidgetCmd procedure, "delete" option} { 268 list [catch {.l delete} msg] $msg 269} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}} 270test listbox-3.31 {ListboxWidgetCmd procedure, "delete" option} { 271 list [catch {.l delete a b c} msg] $msg 272} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}} 273test listbox-3.32 {ListboxWidgetCmd procedure, "delete" option} { 274 list [catch {.l delete badIndex} msg] $msg 275} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}} 276test listbox-3.33 {ListboxWidgetCmd procedure, "delete" option} { 277 list [catch {.l delete 2 123ab} msg] $msg 278} {1 {bad listbox index "123ab": must be active, anchor, end, @x,y, or a number}} 279test listbox-3.34 {ListboxWidgetCmd procedure, "delete" option} { 280 catch {destroy .l2} 281 listbox .l2 282 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 283 .l2 delete 3 284 list [.l2 get 2] [.l2 get 3] [.l2 index end] 285} {el2 el4 7} 286test listbox-3.35 {ListboxWidgetCmd procedure, "delete" option} { 287 catch {destroy .l2} 288 listbox .l2 289 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 290 .l2 delete 2 4 291 list [.l2 get 1] [.l2 get 2] [.l2 index end] 292} {el1 el5 5} 293test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} { 294 catch {destroy .l2} 295 listbox .l2 296 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 297 .l2 delete -3 2 298 .l2 get 0 end 299} {el3 el4 el5 el6 el7} 300test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} { 301 catch {destroy .l2} 302 listbox .l2 303 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 304 .l2 delete -3 -1 305 .l2 get 0 end 306} {el0 el1 el2 el3 el4 el5 el6 el7} 307test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} { 308 catch {destroy .l2} 309 listbox .l2 310 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 311 .l2 delete 2 end 312 .l2 get 0 end 313} {el0 el1} 314test listbox-3.39 {ListboxWidgetCmd procedure, "delete" option} { 315 catch {destroy .l2} 316 listbox .l2 317 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 318 .l2 delete 5 20 319 .l2 get 0 end 320} {el0 el1 el2 el3 el4} 321test listbox-3.40 {ListboxWidgetCmd procedure, "delete" option} { 322 catch {destroy .l2} 323 listbox .l2 324 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 325 .l2 delete end 20 326 .l2 get 0 end 327} {el0 el1 el2 el3 el4 el5 el6} 328test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} { 329 catch {destroy .l2} 330 listbox .l2 331 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 332 .l2 delete 8 20 333 .l2 get 0 end 334} {el0 el1 el2 el3 el4 el5 el6 el7} 335test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} { 336 list [catch {.l get} msg] $msg 337} {1 {wrong # args: should be ".l get firstIndex ?lastIndex?"}} 338test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} { 339 list [catch {.l get a b c} msg] $msg 340} {1 {wrong # args: should be ".l get firstIndex ?lastIndex?"}} 341test listbox-3.44 {ListboxWidgetCmd procedure, "get" option} { 342 list [catch {.l get 2.4} msg] $msg 343} {1 {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number}} 344test listbox-3.45 {ListboxWidgetCmd procedure, "get" option} { 345 list [catch {.l get end bogus} msg] $msg 346} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}} 347test listbox-3.46 {ListboxWidgetCmd procedure, "get" option} { 348 catch {destroy .l2} 349 listbox .l2 350 .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7 351 list [.l2 get 0] [.l2 get 3] [.l2 get end] 352} {el0 el3 el7} 353test listbox-3.47 {ListboxWidgetCmd procedure, "get" option} { 354 catch {destroy .l2} 355 listbox .l2 356 list [.l2 get 0] [.l2 get end] 357} {{} {}} 358test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} { 359 catch {destroy .l2} 360 listbox .l2 361 .l2 insert 0 el0 el1 el2 "two words" el4 el5 el6 el7 362 .l2 get 3 end 363} {{two words} el4 el5 el6 el7} 364test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} { 365 .l get -1 366} {} 367test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} { 368 .l get -2 -1 369} {} 370test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} { 371 .l get -2 3 372} {el0 el1 el2 el3} 373test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} { 374 .l get 12 end 375} {el12 el13 el14 el15 el16 el17} 376test listbox-3.53 {ListboxWidgetCmd procedure, "get" option} { 377 .l get 12 20 378} {el12 el13 el14 el15 el16 el17} 379test listbox-3.54 {ListboxWidgetCmd procedure, "get" option} { 380 .l get end 381} {el17} 382test listbox-3.55 {ListboxWidgetCmd procedure, "get" option} { 383 .l get 30 384} {} 385test listbox-3.56 {ListboxWidgetCmd procedure, "get" option} { 386 .l get 30 35 387} {} 388test listbox-3.57 {ListboxWidgetCmd procedure, "index" option} { 389 list [catch {.l index} msg] $msg 390} {1 {wrong # args: should be ".l index index"}} 391test listbox-3.58 {ListboxWidgetCmd procedure, "index" option} { 392 list [catch {.l index a b} msg] $msg 393} {1 {wrong # args: should be ".l index index"}} 394test listbox-3.59 {ListboxWidgetCmd procedure, "index" option} { 395 list [catch {.l index @} msg] $msg 396} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}} 397test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} { 398 .l index 2 399} 2 400test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} { 401 .l index -1 402} -1 403test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} { 404 .l index end 405} 18 406test listbox-3.63 {ListboxWidgetCmd procedure, "index" option} { 407 .l index 34 408} 34 409test listbox-3.64 {ListboxWidgetCmd procedure, "insert" option} { 410 list [catch {.l insert} msg] $msg 411} {1 {wrong # args: should be ".l insert index ?element element ...?"}} 412test listbox-3.65 {ListboxWidgetCmd procedure, "insert" option} { 413 list [catch {.l insert badIndex} msg] $msg 414} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}} 415test listbox-3.66 {ListboxWidgetCmd procedure, "insert" option} { 416 catch {destroy .l2} 417 listbox .l2 418 .l2 insert end a b c d e 419 .l2 insert 3 x y z 420 .l2 get 0 end 421} {a b c x y z d e} 422test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} { 423 catch {destroy .l2} 424 listbox .l2 425 .l2 insert end a b c 426 .l2 insert -1 x 427 .l2 get 0 end 428} {x a b c} 429test listbox-3.68 {ListboxWidgetCmd procedure, "insert" option} { 430 catch {destroy .l2} 431 listbox .l2 432 .l2 insert end a b c 433 .l2 insert end x 434 .l2 get 0 end 435} {a b c x} 436test listbox-3.69 {ListboxWidgetCmd procedure, "insert" option} { 437 catch {destroy .l2} 438 listbox .l2 439 .l2 insert end a b c 440 .l2 insert 43 x 441 .l2 get 0 end 442} {a b c x} 443test listbox-3.70 {ListboxWidgetCmd procedure, "nearest" option} { 444 list [catch {.l nearest} msg] $msg 445} {1 {wrong # args: should be ".l nearest y"}} 446test listbox-3.71 {ListboxWidgetCmd procedure, "nearest" option} { 447 list [catch {.l nearest a b} msg] $msg 448} {1 {wrong # args: should be ".l nearest y"}} 449test listbox-3.72 {ListboxWidgetCmd procedure, "nearest" option} { 450 list [catch {.l nearest 20p} msg] $msg 451} {1 {expected integer but got "20p"}} 452test listbox-3.73 {ListboxWidgetCmd procedure, "nearest" option} { 453 .l yview 3 454 .l nearest 1000 455} {7} 456test listbox-3.74 {ListboxWidgetCmd procedure, "scan" option} { 457 list [catch {.l scan a b} msg] $msg 458} {1 {wrong # args: should be ".l scan mark|dragto x y"}} 459test listbox-3.75 {ListboxWidgetCmd procedure, "scan" option} { 460 list [catch {.l scan a b c d} msg] $msg 461} {1 {wrong # args: should be ".l scan mark|dragto x y"}} 462test listbox-3.76 {ListboxWidgetCmd procedure, "scan" option} { 463 list [catch {.l scan foo bogus 2} msg] $msg 464} {1 {expected integer but got "bogus"}} 465test listbox-3.77 {ListboxWidgetCmd procedure, "scan" option} { 466 list [catch {.l scan foo 2 2.3} msg] $msg 467} {1 {expected integer but got "2.3"}} 468test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} {fonts} { 469 catch {destroy .t} 470 toplevel .t 471 wm geom .t +0+0 472 listbox .t.l -width 10 -height 5 473 .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 474 pack .t.l 475 update 476 .t.l scan mark 100 140 477 .t.l scan dragto 90 137 478 update 479 list [format {%.6g %.6g} {*}[.t.l xview]] [format {%.6g %.6g} {*}[.t.l yview]] 480} {{0.249364 0.427481} {0.0714286 0.428571}} 481test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} { 482 list [catch {.l scan foo 2 4} msg] $msg 483} {1 {bad option "foo": must be mark or dragto}} 484test listbox-3.80 {ListboxWidgetCmd procedure, "see" option} { 485 list [catch {.l see} msg] $msg 486} {1 {wrong # args: should be ".l see index"}} 487test listbox-3.81 {ListboxWidgetCmd procedure, "see" option} { 488 list [catch {.l see a b} msg] $msg 489} {1 {wrong # args: should be ".l see index"}} 490test listbox-3.82 {ListboxWidgetCmd procedure, "see" option} { 491 list [catch {.l see gorp} msg] $msg 492} {1 {bad listbox index "gorp": must be active, anchor, end, @x,y, or a number}} 493test listbox-3.83 {ListboxWidgetCmd procedure, "see" option} { 494 .l yview 7 495 .l see 7 496 .l index @0,0 497} {7} 498test listbox-3.84 {ListboxWidgetCmd procedure, "see" option} { 499 .l yview 7 500 .l see 11 501 .l index @0,0 502} {7} 503test listbox-3.85 {ListboxWidgetCmd procedure, "see" option} { 504 .l yview 7 505 .l see 6 506 .l index @0,0 507} {6} 508test listbox-3.86 {ListboxWidgetCmd procedure, "see" option} { 509 .l yview 7 510 .l see 5 511 .l index @0,0 512} {3} 513test listbox-3.87 {ListboxWidgetCmd procedure, "see" option} { 514 .l yview 7 515 .l see 12 516 .l index @0,0 517} {8} 518test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} { 519 .l yview 7 520 .l see 13 521 .l index @0,0 522} {11} 523test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} { 524 .l yview 7 525 .l see -1 526 .l index @0,0 527} {0} 528test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} { 529 .l yview 7 530 .l see end 531 .l index @0,0 532} {13} 533test listbox-3.91 {ListboxWidgetCmd procedure, "see" option} { 534 .l yview 7 535 .l see 322 536 .l index @0,0 537} {13} 538test listbox-3.92 {ListboxWidgetCmd procedure, "see" option, partial last line} { 539 mkPartial 540 .partial.l see 4 541 .partial.l index @0,0 542} {1} 543test listbox-3.93 {ListboxWidgetCmd procedure, "selection" option} { 544 list [catch {.l select a} msg] $msg 545} {1 {wrong # args: should be ".l selection option index ?index?"}} 546test listbox-3.94 {ListboxWidgetCmd procedure, "selection" option} { 547 list [catch {.l select a b c d} msg] $msg 548} {1 {wrong # args: should be ".l selection option index ?index?"}} 549test listbox-3.95 {ListboxWidgetCmd procedure, "selection" option} { 550 list [catch {.l selection a bogus} msg] $msg 551} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}} 552test listbox-3.96 {ListboxWidgetCmd procedure, "selection" option} { 553 list [catch {.l selection a 0 lousy} msg] $msg 554} {1 {bad listbox index "lousy": must be active, anchor, end, @x,y, or a number}} 555test listbox-3.97 {ListboxWidgetCmd procedure, "selection" option} { 556 list [catch {.l selection anchor 0 0} msg] $msg 557} {1 {wrong # args: should be ".l selection anchor index"}} 558test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} { 559 list [.l selection anchor 5; .l index anchor] \ 560 [.l selection anchor 0; .l index anchor] 561} {5 0} 562test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} { 563 .l selection anchor -1 564 .l index anchor 565} {0} 566test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} { 567 .l selection anchor end 568 .l index anchor 569} {17} 570test listbox-3.101 {ListboxWidgetCmd procedure, "selection" option} { 571 .l selection anchor 44 572 .l index anchor 573} {17} 574test listbox-3.102 {ListboxWidgetCmd procedure, "selection" option} { 575 .l selection clear 0 end 576 .l selection set 2 8 577 .l selection clear 3 4 578 .l curselection 579} {2 5 6 7 8} 580test listbox-3.103 {ListboxWidgetCmd procedure, "selection" option} { 581 list [catch {.l selection includes 0 0} msg] $msg 582} {1 {wrong # args: should be ".l selection includes index"}} 583test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} { 584 .l selection clear 0 end 585 .l selection set 2 8 586 .l selection clear 4 587 list [.l selection includes 3] [.l selection includes 4] \ 588 [.l selection includes 5] 589} {1 0 1} 590test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} { 591 .l selection set 0 end 592 .l selection includes -1 593} {0} 594test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} { 595 .l selection clear 0 end 596 .l selection set end 597 .l selection includes end 598} {1} 599test listbox-3.107 {ListboxWidgetCmd procedure, "selection" option} { 600 .l selection set 0 end 601 .l selection includes 44 602} {0} 603test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} { 604 catch {destroy .l2} 605 listbox .l2 606 .l2 selection includes 0 607} {0} 608test listbox-3.109 {ListboxWidgetCmd procedure, "selection" option} { 609 .l selection clear 0 end 610 .l selection set 2 611 .l selection set 5 7 612 .l curselection 613} {2 5 6 7} 614test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} { 615 .l selection set 5 7 616 .l curselection 617} {2 5 6 7} 618test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} { 619 list [catch {.l selection badOption 0 0} msg] $msg 620} {1 {bad option "badOption": must be anchor, clear, includes, or set}} 621test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} { 622 list [catch {.l size a} msg] $msg 623} {1 {wrong # args: should be ".l size"}} 624test listbox-3.113 {ListboxWidgetCmd procedure, "size" option} { 625 .l size 626} {18} 627test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} { 628 catch {destroy .l2} 629 listbox .l2 630 update 631 format {%.6g %.6g} {*}[.l2 xview] 632} {0 1} 633test listbox-3.115 {ListboxWidgetCmd procedure, "xview" option} { 634 catch {destroy .l} 635 listbox .l -width 10 -height 5 -font $fixed 636 .l insert 0 a b c d e f g h i j k l m n o p q r s t 637 pack .l 638 update 639 format {%.6g %.6g} {*}[.l xview] 640} {0 1} 641catch {destroy .l} 642listbox .l -width 10 -height 5 -font $fixed 643.l insert 0 a b c d e f g h i j k l m n o p q r s t 644.l insert 1 "0123456789a123456789b123456789c123456789d123456789" 645pack .l 646update 647test listbox-3.116 {ListboxWidgetCmd procedure, "xview" option} {fonts} { 648 .l xview 4 649 format {%.6g %.6g} {*}[.l xview] 650} {0.08 0.28} 651test listbox-3.117 {ListboxWidgetCmd procedure, "xview" option} { 652 list [catch {.l xview foo} msg] $msg 653} {1 {expected integer but got "foo"}} 654test listbox-3.118 {ListboxWidgetCmd procedure, "xview" option} { 655 list [catch {.l xview zoom a b} msg] $msg 656} {1 {unknown option "zoom": must be moveto or scroll}} 657test listbox-3.119 {ListboxWidgetCmd procedure, "xview" option} {fonts} { 658 .l xview 0 659 .l xview moveto .4 660 update 661 format {%.6g %.6g} {*}[.l xview] 662} {0.4 0.6} 663test listbox-3.120 {ListboxWidgetCmd procedure, "xview" option} {fonts} { 664 .l xview 0 665 .l xview scroll 2 units 666 update 667 format {%.6g %.6g} {*}[.l xview] 668} {0.04 0.24} 669test listbox-3.121 {ListboxWidgetCmd procedure, "xview" option} {fonts} { 670 .l xview 30 671 .l xview scroll -1 pages 672 update 673 format {%.6g %.6g} {*}[.l xview] 674} {0.44 0.64} 675test listbox-3.122 {ListboxWidgetCmd procedure, "xview" option} {fonts} { 676 .l configure -width 1 677 update 678 .l xview 30 679 .l xview scroll -4 pages 680 update 681 format {%.6g %.6g} {*}[.l xview] 682} {0.52 0.54} 683test listbox-3.123 {ListboxWidgetCmd procedure, "yview" option} { 684 catch {destroy .l} 685 listbox .l 686 pack .l 687 update 688 format {%.6g %.6g} {*}[.l yview] 689} {0 1} 690test listbox-3.124 {ListboxWidgetCmd procedure, "yview" option} { 691 catch {destroy .l} 692 listbox .l 693 .l insert 0 el1 694 pack .l 695 update 696 format {%.6g %.6g} {*}[.l yview] 697} {0 1} 698catch {destroy .l} 699listbox .l -width 10 -height 5 -font $fixed 700.l insert 0 a b c d e f g h i j k l m n o p q r s t 701pack .l 702update 703test listbox-3.125 {ListboxWidgetCmd procedure, "yview" option} { 704 .l yview 4 705 update 706 format {%.6g %.6g} {*}[.l yview] 707} {0.2 0.45} 708test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last line} { 709 mkPartial 710 format {%.6g %.6g} {*}[.partial.l yview] 711} {0 0.266667} 712test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} { 713 list [catch {.l yview foo} msg] $msg 714} {1 {bad listbox index "foo": must be active, anchor, end, @x,y, or a number}} 715test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} { 716 list [catch {.l yview foo a b} msg] $msg 717} {1 {unknown option "foo": must be moveto or scroll}} 718test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} { 719 .l yview 0 720 .l yview moveto .31 721 format {%.6g %.6g} {*}[.l yview] 722} {0.3 0.55} 723test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} { 724 .l yview 2 725 .l yview scroll 2 pages 726 format {%.6g %.6g} {*}[.l yview] 727} {0.4 0.65} 728test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} { 729 .l yview 10 730 .l yview scroll -3 units 731 format {%.6g %.6g} {*}[.l yview] 732} {0.35 0.6} 733test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} { 734 .l configure -height 2 735 update 736 .l yview 15 737 .l yview scroll -4 pages 738 format {%.6g %.6g} {*}[.l yview] 739} {0.55 0.65} 740test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} { 741 list [catch {.l whoknows} msg] $msg 742} {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} 743test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} { 744 list [catch {.l c} msg] $msg 745} {1 {ambiguous option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} 746test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} { 747 list [catch {.l in} msg] $msg 748} {1 {ambiguous option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} 749test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} { 750 list [catch {.l s} msg] $msg 751} {1 {ambiguous option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} 752test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} { 753 list [catch {.l se} msg] $msg 754} {1 {ambiguous option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}} 755 756# No tests for DestroyListbox: I can't come up with anything to test 757# in this procedure. 758 759test listbox-4.1 {ConfigureListbox procedure} {fonts} { 760 catch {destroy .l} 761 listbox .l -setgrid 1 -width 25 -height 15 762 pack .l 763 update 764 set x [getsize .] 765 .l configure -setgrid 0 766 update 767 list $x [getsize .] 768} {25x15 185x263} 769resetGridInfo 770test listbox-4.2 {ConfigureListbox procedure} { 771 .l configure -highlightthickness -3 772 .l cget -highlightthickness 773} {0} 774test listbox-4.3 {ConfigureListbox procedure} { 775 .l configure -exportselection 0 776 .l delete 0 end 777 .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 778 .l selection set 3 5 779 .l configure -exportselection 1 780 selection get 781} {el3 782el4 783el5} 784test listbox-4.4 {ConfigureListbox procedure} { 785 catch {destroy .e} 786 entry .e 787 .e insert 0 abc 788 .e select from 0 789 .e select to 2 790 .l configure -exportselection 0 791 .l delete 0 end 792 .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 793 .l selection set 3 5 794 .l selection clear 3 5 795 .l configure -exportselection 1 796 list [selection own] [selection get] 797} {.e ab} 798test listbox-4.5 {-exportselection option} { 799 selection clear . 800 .l configure -exportselection 1 801 .l delete 0 end 802 .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 803 .l selection set 1 1 804 set x {} 805 lappend x [catch {selection get} msg] $msg [.l curselection] 806 .l config -exportselection 0 807 lappend x [catch {selection get} msg] $msg [.l curselection] 808 .l selection clear 0 end 809 lappend x [catch {selection get} msg] $msg [.l curselection] 810 .l selection set 1 3 811 lappend x [catch {selection get} msg] $msg [.l curselection] 812 .l config -exportselection 1 813 lappend x [catch {selection get} msg] $msg [.l curselection] 814} {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 815el2 816el3} {1 2 3}} 817test listbox-4.6 {ConfigureListbox procedure} {fonts} { 818 catch {destroy .l} 819 820 # The following code (reset geometry, withdraw, etc.) is necessary 821 # to reset the state of some window managers like olvwm under 822 # SunOS 4.1.3. 823 824 wm geom . 300x300 825 update 826 wm geom . {} 827 wm withdraw . 828 listbox .l -font $fixed -width 15 -height 20 829 pack .l 830 update 831 wm deiconify . 832 set x [getsize .] 833 .l configure -setgrid 1 834 update 835 list $x [getsize .] 836} {115x328 15x20} 837test listbox-4.7 {ConfigureListbox procedure} { 838 catch {destroy .l} 839 wm withdraw . 840 listbox .l -font $fixed -width 30 -height 20 -setgrid 1 841 wm geom . +25+25 842 pack .l 843 update 844 wm deiconify . 845 set result [getsize .] 846 wm geom . 26x15 847 update 848 lappend result [getsize .] 849 .l configure -setgrid 1 850 update 851 lappend result [getsize .] 852} {30x20 26x15 26x15} 853wm geom . {} 854catch {destroy .l} 855resetGridInfo 856test listbox-4.8 {ConfigureListbox procedure} { 857 catch {destroy .l} 858 listbox .l -width 15 -height 20 -xscrollcommand "record x" \ 859 -yscrollcommand "record y" 860 pack .l 861 update 862 .l configure -fg black 863 set log {} 864 update 865 set log 866} {{y 0 1} {x 0 1}} 867test listbox-4.9 {ConfigureListbox procedure, -listvar} { 868 catch {destroy .l} 869 set x [list a b c d] 870 listbox .l -listvar x 871 .l get 0 end 872} [list a b c d] 873test listbox-4.10 {ConfigureListbox, no listvar -> existing listvar} { 874 catch {destroy .l} 875 set x [list a b c d] 876 listbox .l 877 .l insert end 1 2 3 4 878 .l configure -listvar x 879 .l get 0 end 880} [list a b c d] 881test listbox-4.11 {ConfigureListbox procedure, listvar -> no listvar} { 882 catch {destroy .l} 883 set x [list a b c d] 884 listbox .l -listvar x 885 .l configure -listvar {} 886 .l insert end 1 2 3 4 887 list $x [.l get 0 end] 888} [list [list a b c d] [list a b c d 1 2 3 4]] 889test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} { 890 catch {destroy .l} 891 set x [list a b c d] 892 set y [list 1 2 3 4] 893 listbox .l 894 .l configure -listvar x 895 .l configure -listvar y 896 .l insert end 5 6 7 8 897 list $x $y 898} [list [list a b c d] [list 1 2 3 4 5 6 7 8]] 899test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} { 900 catch {destroy .l} 901 catch {unset x} 902 listbox .l 903 .l insert end a b c d 904 .l configure -listvar x 905 set x 906} [list a b c d] 907test listbox-4.14 {ConfigureListbox, non-existant listvar} { 908 catch {destroy .l} 909 catch {unset x} 910 listbox .l -listvar x 911 list [info exists x] $x 912} [list 1 {}] 913test listbox-4.15 {ConfigureListbox, listvar -> non-existant listvar} { 914 catch {destroy .l} 915 catch {unset y} 916 set x [list a b c d] 917 listbox .l -listvar x 918 .l configure -listvar y 919 list [info exists y] $y 920} [list 1 [list a b c d]] 921test listbox-4.16 {ConfigureListbox, listvar -> same listvar} { 922 catch {destroy .l} 923 set x [list a b c d] 924 listbox .l -listvar x 925 .l configure -listvar x 926 set x 927} [list a b c d] 928test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} { 929 catch {destroy .l} 930 listbox .l 931 .l insert end a b c d 932 .l configure -listvar {} 933 .l get 0 end 934} [list a b c d] 935test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} { 936 catch {destroy .l} 937 listbox .l 938 .l insert end a b c d 939 set x "this is a \" bad list" 940 catch {.l configure -listvar x} result 941 list [.l get 0 end] [.l cget -listvar] $result 942} [list [list a b c d] {} \ 943 "unmatched open quote in list: invalid -listvariable value"] 944test listbox-4.19 {ConfigureListbox, no listvar -> bad non-existent listvar} { 945 catch {destroy .l} 946 unset -nocomplain ::foo 947 listbox .l -listvar foo 948 .l insert end a b c d 949 catch {.l configure -listvar ::zoo::bar::foo} result 950 list [.l get 0 end] [.l cget -listvar] $foo $result 951} [list [list a b c d] foo [list a b c d] \ 952 {can't set "::zoo::bar::foo": parent namespace doesn't exist}] 953 954# No tests for DisplayListbox: I don't know how to test this procedure. 955 956test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} { 957 catch {destroy .l} 958 listbox .l -font $fixed -width 15 -height 20 959 pack .l 960 list [winfo reqwidth .l] [winfo reqheight .l] 961} {115 328} 962test listbox-5.2 {ListboxComputeGeometry procedure} {fonts} { 963 catch {destroy .l} 964 listbox .l -font $fixed -width 0 -height 10 965 pack .l 966 update 967 list [winfo reqwidth .l] [winfo reqheight .l] 968} {17 168} 969test listbox-5.3 {ListboxComputeGeometry procedure} {fonts} { 970 catch {destroy .l} 971 listbox .l -font $fixed -width 0 -height 10 -bd 3 972 .l insert 0 Short "Really much longer" Longer 973 pack .l 974 update 975 list [winfo reqwidth .l] [winfo reqheight .l] 976} {138 170} 977test listbox-5.4 {ListboxComputeGeometry procedure} {fonts} { 978 catch {destroy .l} 979 listbox .l -font $fixed -width 10 -height 0 980 pack .l 981 update 982 list [winfo reqwidth .l] [winfo reqheight .l] 983} {80 24} 984test listbox-5.5 {ListboxComputeGeometry procedure} {fonts} { 985 catch {destroy .l} 986 listbox .l -font $fixed -width 10 -height 0 -highlightthickness 0 987 .l insert 0 Short "Really much longer" Longer 988 pack .l 989 update 990 list [winfo reqwidth .l] [winfo reqheight .l] 991} {76 52} 992test listbox-5.6 {ListboxComputeGeometry procedure} { 993 # If "0" in selected font had 0 width, caused divide-by-zero error. 994 995 catch {destroy .l} 996 pack [listbox .l -font {{open look glyph}}] 997 update 998} {} 999 1000 1001catch {destroy .l} 1002listbox .l -height 2 -xscrollcommand "record x" -yscrollcommand "record y" 1003pack .l 1004update 1005test listbox-6.1 {InsertEls procedure} { 1006 .l delete 0 end 1007 .l insert end a b c d 1008 .l insert 5 x y z 1009 .l insert 2 A 1010 .l insert 0 q r s 1011 .l get 0 end 1012} {q r s a b A c d x y z} 1013test listbox-6.2 {InsertEls procedure} { 1014 .l delete 0 end 1015 .l insert 0 a b c d e f g h i j 1016 .l selection anchor 2 1017 .l insert 2 A B 1018 .l index anchor 1019} {4} 1020test listbox-6.3 {InsertEls procedure} { 1021 .l delete 0 end 1022 .l insert 0 a b c d e f g h i j 1023 .l selection anchor 2 1024 .l insert 3 A B 1025 .l index anchor 1026} {2} 1027test listbox-6.4 {InsertEls procedure} { 1028 .l delete 0 end 1029 .l insert 0 a b c d e f g h i j 1030 .l yview 3 1031 update 1032 .l insert 2 A B 1033 .l index @0,0 1034} {5} 1035test listbox-6.5 {InsertEls procedure} { 1036 .l delete 0 end 1037 .l insert 0 a b c d e f g h i j 1038 .l yview 3 1039 update 1040 .l insert 3 A B 1041 .l index @0,0 1042} {3} 1043test listbox-6.6 {InsertEls procedure} { 1044 .l delete 0 end 1045 .l insert 0 a b c d e f g h i j 1046 .l activate 5 1047 .l insert 5 A B 1048 .l index active 1049} {7} 1050test listbox-6.7 {InsertEls procedure} { 1051 .l delete 0 end 1052 .l insert 0 a b c d e f g h i j 1053 .l activate 5 1054 .l insert 6 A B 1055 .l index active 1056} {5} 1057test listbox-6.8 {InsertEls procedure} { 1058 .l delete 0 end 1059 .l insert 0 a b c 1060 .l index active 1061} {2} 1062test listbox-6.9 {InsertEls procedure} { 1063 .l delete 0 end 1064 .l insert 0 1065 .l index active 1066} {0} 1067test listbox-6.10 {InsertEls procedure} { 1068 .l delete 0 end 1069 .l insert 0 a b "two words" c d e f g h i j 1070 update 1071 set log {} 1072 .l insert 0 word 1073 update 1074 set log 1075} {{y 0 0.166667}} 1076test listbox-6.11 {InsertEls procedure} { 1077 .l delete 0 end 1078 .l insert 0 a b "two words" c d e f g h i j 1079 update 1080 set log {} 1081 .l insert 0 "much longer entry" 1082 update 1083 set log 1084} {{y 0 0.166667} {x 0 1}} 1085test listbox-6.12 {InsertEls procedure} {fonts} { 1086 catch {destroy .l2} 1087 listbox .l2 -width 0 -height 0 1088 pack .l2 -side top 1089 .l2 insert 0 a b "two words" c d 1090 set x {} 1091 lappend x [winfo reqwidth .l2] [winfo reqheight .l2] 1092 .l2 insert 0 "much longer entry" 1093 lappend x [winfo reqwidth .l2] [winfo reqheight .l2] 1094} {80 93 122 110} 1095test listbox-6.13 {InsertEls procedure, check -listvar update} { 1096 catch {destroy .l2} 1097 set x [list a b c d] 1098 listbox .l2 -listvar x 1099 .l2 insert 0 1 2 3 4 1100 set x 1101} [list 1 2 3 4 a b c d] 1102test listbox-6.14 {InsertEls procedure, check selection update} { 1103 catch {destroy .l2} 1104 listbox .l2 1105 .l2 insert 0 0 1 2 3 4 1106 .l2 selection set 2 4 1107 .l2 insert 0 a 1108 .l2 curselection 1109} [list 3 4 5] 1110test listbox-6.15 {InsertEls procedure, lost namespaced listvar} { 1111 destroy .l2 1112 namespace eval test { variable foo {a b} } 1113 listbox .l2 -listvar ::test::foo 1114 namespace delete test 1115 .l2 insert end c d 1116 .l2 delete end 1117 .l2 insert end e f 1118 catch {set ::test::foo} result 1119 list [.l2 get 0 end] [.l2 cget -listvar] $result 1120} [list [list a b c e f] ::test::foo \ 1121 {can't read "::test::foo": no such variable}] 1122 1123 1124test listbox-7.1 {DeleteEls procedure} { 1125 .l delete 0 end 1126 .l insert 0 a b c d e f g h i j 1127 .l selection set 1 6 1128 .l delete 4 3 1129 list [.l size] [selection get] 1130} {10 {b 1131c 1132d 1133e 1134f 1135g}} 1136test listbox-7.2 {DeleteEls procedure} { 1137 .l delete 0 end 1138 .l insert 0 a b c d e f g h i j 1139 .l selection set 3 6 1140 .l delete 4 4 1141 list [.l size] [.l get 4] [.l curselection] 1142} {9 f {3 4 5}} 1143test listbox-7.3 {DeleteEls procedure} { 1144 .l delete 0 end 1145 .l insert 0 a b c d e f g h i j 1146 .l delete 0 3 1147 list [.l size] [.l get 0] [.l get 1] 1148} {6 e f} 1149test listbox-7.4 {DeleteEls procedure} { 1150 .l delete 0 end 1151 .l insert 0 a b c d e f g h i j 1152 .l delete 8 1000 1153 list [.l size] [.l get 7] 1154} {8 h} 1155test listbox-7.5 {DeleteEls procedure} { 1156 .l delete 0 end 1157 .l insert 0 a b c d e f g h i j 1158 .l selection anchor 2 1159 .l delete 0 1 1160 .l index anchor 1161} {0} 1162test listbox-7.6 {DeleteEls procedure} { 1163 .l delete 0 end 1164 .l insert 0 a b c d e f g h i j 1165 .l selection anchor 2 1166 .l delete 2 1167 .l index anchor 1168} {2} 1169test listbox-7.7 {DeleteEls procedure} { 1170 .l delete 0 end 1171 .l insert 0 a b c d e f g h i j 1172 .l selection anchor 4 1173 .l delete 2 5 1174 .l index anchor 1175} {2} 1176test listbox-7.8 {DeleteEls procedure} { 1177 .l delete 0 end 1178 .l insert 0 a b c d e f g h i j 1179 .l selection anchor 3 1180 .l delete 4 5 1181 .l index anchor 1182} {3} 1183test listbox-7.9 {DeleteEls procedure} { 1184 .l delete 0 end 1185 .l insert 0 a b c d e f g h i j 1186 .l yview 3 1187 update 1188 .l delete 1 2 1189 .l index @0,0 1190} {1} 1191test listbox-7.10 {DeleteEls procedure} { 1192 .l delete 0 end 1193 .l insert 0 a b c d e f g h i j 1194 .l yview 3 1195 update 1196 .l delete 3 4 1197 .l index @0,0 1198} {3} 1199test listbox-7.11 {DeleteEls procedure} { 1200 .l delete 0 end 1201 .l insert 0 a b c d e f g h i j 1202 .l yview 3 1203 update 1204 .l delete 4 6 1205 .l index @0,0 1206} {3} 1207test listbox-7.12 {DeleteEls procedure} { 1208 .l delete 0 end 1209 .l insert 0 a b c d e f g h i j 1210 .l yview 3 1211 update 1212 .l delete 3 end 1213 .l index @0,0 1214} {1} 1215test listbox-7.13 {DeleteEls procedure, updating view with partial last line} { 1216 mkPartial 1217 .partial.l yview 8 1218 update 1219 .partial.l delete 10 13 1220 .partial.l index @0,0 1221} {7} 1222test listbox-7.14 {DeleteEls procedure} { 1223 .l delete 0 end 1224 .l insert 0 a b c d e f g h i j 1225 .l activate 6 1226 .l delete 3 4 1227 .l index active 1228} {4} 1229test listbox-7.15 {DeleteEls procedure} { 1230 .l delete 0 end 1231 .l insert 0 a b c d e f g h i j 1232 .l activate 6 1233 .l delete 5 7 1234 .l index active 1235} {5} 1236test listbox-7.16 {DeleteEls procedure} { 1237 .l delete 0 end 1238 .l insert 0 a b c d e f g h i j 1239 .l activate 6 1240 .l delete 5 end 1241 .l index active 1242} {4} 1243test listbox-7.17 {DeleteEls procedure} { 1244 .l delete 0 end 1245 .l insert 0 a b c d e f g h i j 1246 .l activate 6 1247 .l delete 0 end 1248 .l index active 1249} {0} 1250test listbox-7.18 {DeleteEls procedure} { 1251 .l delete 0 end 1252 .l insert 0 a b c "two words" d e f g h i j 1253 update 1254 set log {} 1255 .l delete 4 6 1256 update 1257 set log 1258} {{y 0 0.25}} 1259test listbox-7.19 {DeleteEls procedure} { 1260 .l delete 0 end 1261 .l insert 0 a b c "two words" d e f g h i j 1262 update 1263 set log {} 1264 .l delete 3 1265 update 1266 set log 1267} {{y 0 0.2} {x 0 1}} 1268test listbox-7.20 {DeleteEls procedure} {fonts} { 1269 catch {destroy .l2} 1270 listbox .l2 -width 0 -height 0 1271 pack .l2 -side top 1272 .l2 insert 0 a b "two words" c d e f g 1273 set x {} 1274 lappend x [winfo reqwidth .l2] [winfo reqheight .l2] 1275 .l2 delete 2 4 1276 lappend x [winfo reqwidth .l2] [winfo reqheight .l2] 1277} {80 144 17 93} 1278catch {destroy .l2} 1279test listbox-7.21 {DeleteEls procedure, check -listvar update} { 1280 catch {destroy .l2} 1281 set x [list a b c d] 1282 listbox .l2 -listvar x 1283 .l2 delete 0 1 1284 set x 1285} [list c d] 1286 1287test listbox-8.1 {ListboxEventProc procedure} {fonts} { 1288 catch {destroy .l} 1289 listbox .l -setgrid 1 1290 pack .l 1291 update 1292 set x [getsize .] 1293 destroy .l 1294 list $x [getsize .] [winfo exists .l] [info command .l] 1295} {20x10 150x178 0 {}} 1296resetGridInfo 1297test listbox-8.2 {ListboxEventProc procedure} {fonts} { 1298 catch {destroy .l} 1299 listbox .l -height 5 -width 10 1300 .l insert 0 a b c "A string that is very very long" d e f g h i j k 1301 pack .l 1302 update 1303 place .l -width 50 -height 80 1304 update 1305 list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] 1306} {{0 0.222222} {0 0.333333}} 1307test listbox-8.3 {ListboxEventProc procedure} { 1308 deleteWindows 1309 listbox .l1 -bg #543210 1310 rename .l1 .l2 1311 set x {} 1312 lappend x [winfo children .] 1313 lappend x [.l2 cget -bg] 1314 destroy .l1 1315 lappend x [info command .l*] [winfo children .] 1316} {.l1 #543210 {} {}} 1317 1318test listbox-9.1 {ListboxCmdDeletedProc procedure} { 1319 deleteWindows 1320 listbox .l1 1321 rename .l1 {} 1322 list [info command .l*] [winfo children .] 1323} {{} {}} 1324test listbox-9.2 {ListboxCmdDeletedProc procedure, disabling -setgrid} fonts { 1325 catch {destroy .top} 1326 toplevel .top 1327 wm geom .top +0+0 1328 listbox .top.l -setgrid 1 -width 20 -height 10 1329 pack .top.l 1330 update 1331 set x [wm geometry .top] 1332 rename .top.l {} 1333 update 1334 lappend x [wm geometry .top] 1335 destroy .top 1336 set x 1337} {20x10+0+0 150x178+0+0} 1338 1339catch {destroy .l} 1340listbox .l 1341pack .l 1342.l delete 0 end 1343.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 1344test listbox-10.1 {GetListboxIndex procedure} { 1345 .l activate 3 1346 list [.l activate 3; .l index active] [.l activate 6; .l index active] 1347} {3 6} 1348test listbox-10.2 {GetListboxIndex procedure} { 1349 .l selection anchor 2 1350 .l index anchor 1351} 2 1352test listbox-10.3 {GetListboxIndex procedure} { 1353 .l insert end A B C D E 1354 .l selection anchor end 1355 .l delete 12 end 1356 list [.l index anchor] [.l index end] 1357} {12 12} 1358test listbox-10.4 {GetListboxIndex procedure} { 1359 list [catch {.l index a} msg] $msg 1360} {1 {bad listbox index "a": must be active, anchor, end, @x,y, or a number}} 1361test listbox-10.5 {GetListboxIndex procedure} { 1362 .l index end 1363} {12} 1364test listbox-10.6 {GetListboxIndex procedure} { 1365 .l get end 1366} {el11} 1367test listbox-10.7 {GetListboxIndex procedure} { 1368 .l delete 0 end 1369 .l index end 1370} 0 1371.l delete 0 end 1372.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 1373update 1374test listbox-10.8 {GetListboxIndex procedure} { 1375 list [catch {.l index @} msg] $msg 1376} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}} 1377test listbox-10.9 {GetListboxIndex procedure} { 1378 list [catch {.l index @foo} msg] $msg 1379} {1 {bad listbox index "@foo": must be active, anchor, end, @x,y, or a number}} 1380test listbox-10.10 {GetListboxIndex procedure} { 1381 list [catch {.l index @1x3} msg] $msg 1382} {1 {bad listbox index "@1x3": must be active, anchor, end, @x,y, or a number}} 1383test listbox-10.11 {GetListboxIndex procedure} { 1384 list [catch {.l index @1,} msg] $msg 1385} {1 {bad listbox index "@1,": must be active, anchor, end, @x,y, or a number}} 1386test listbox-10.12 {GetListboxIndex procedure} { 1387 list [catch {.l index @1,foo} msg] $msg 1388} {1 {bad listbox index "@1,foo": must be active, anchor, end, @x,y, or a number}} 1389test listbox-10.13 {GetListboxIndex procedure} { 1390 list [catch {.l index @1,2x} msg] $msg 1391} {1 {bad listbox index "@1,2x": must be active, anchor, end, @x,y, or a number}} 1392test listbox-10.14 {GetListboxIndex procedure} {fonts} { 1393 list [.l index @5,57] [.l index @5,58] 1394} {3 3} 1395test listbox-10.15 {GetListboxIndex procedure} { 1396 list [catch {.l index 1xy} msg] $msg 1397} {1 {bad listbox index "1xy": must be active, anchor, end, @x,y, or a number}} 1398test listbox-10.16 {GetListboxIndex procedure} { 1399 .l index 3 1400} {3} 1401test listbox-10.17 {GetListboxIndex procedure} { 1402 .l index 20 1403} {20} 1404test listbox-10.18 {GetListboxIndex procedure} { 1405 .l get 20 1406} {} 1407test listbox-10.19 {GetListboxIndex procedure} { 1408 .l index -2 1409} -2 1410test listbox-10.20 {GetListboxIndex procedure} { 1411 .l delete 0 end 1412 .l index 1 1413} 1 1414 1415test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} { 1416 catch {destroy .l} 1417 listbox .l -height 5 1418 pack .l 1419 .l insert 0 a b c d e f g h i j 1420 .l yview 3 1421 update 1422 set x [.l index @0,0] 1423 .l yview -1 1424 update 1425 lappend x [.l index @0,0] 1426} {3 0} 1427test listbox-11.2 {ChangeListboxView procedure, boundary conditions for index} { 1428 catch {destroy .l} 1429 listbox .l -height 5 1430 pack .l 1431 .l insert 0 a b c d e f g h i j 1432 .l yview 3 1433 update 1434 set x [.l index @0,0] 1435 .l yview 20 1436 update 1437 lappend x [.l index @0,0] 1438} {3 5} 1439test listbox-11.3 {ChangeListboxView procedure} { 1440 catch {destroy .l} 1441 listbox .l -height 5 -yscrollcommand "record y" 1442 pack .l 1443 .l insert 0 a b c d e f g h i j 1444 update 1445 set log {} 1446 .l yview 2 1447 update 1448 list [format {%.6g %.6g} {*}[.l yview]] $log 1449} {{0.2 0.7} {{y 0.2 0.7}}} 1450test listbox-11.4 {ChangeListboxView procedure} { 1451 catch {destroy .l} 1452 listbox .l -height 5 -yscrollcommand "record y" 1453 pack .l 1454 .l insert 0 a b c d e f g h i j 1455 update 1456 set log {} 1457 .l yview 8 1458 update 1459 list [format {%.6g %.6g} {*}[.l yview]] $log 1460} {{0.5 1} {{y 0.5 1}}} 1461test listbox-11.5 {ChangeListboxView procedure} { 1462 catch {destroy .l} 1463 listbox .l -height 5 -yscrollcommand "record y" 1464 pack .l 1465 .l insert 0 a b c d e f g h i j 1466 .l yview 3 1467 update 1468 set log {} 1469 .l yview 3 1470 update 1471 list [format {%.6g %.6g} {*}[.l yview]] $log 1472} {{0.3 0.8} {}} 1473test listbox-11.6 {ChangeListboxView procedure, partial last line} { 1474 mkPartial 1475 .partial.l yview 13 1476 .partial.l index @0,0 1477} {11} 1478 1479catch {destroy .l} 1480listbox .l -font $fixed -xscrollcommand "record x" -width 10 1481.l insert 0 0123456789a123456789b123456789c123456789d123456789e123456789f123456789g123456789h123456789i123456789 1482pack .l 1483update 1484test listbox-12.1 {ChangeListboxOffset procedure} {fonts} { 1485 set log {} 1486 .l xview 99 1487 update 1488 list [format {%.6g %.6g} {*}[.l xview]] $log 1489} {{0.9 1} {{x 0.9 1}}} 1490test listbox-12.2 {ChangeListboxOffset procedure} {fonts} { 1491 set log {} 1492 .l xview moveto -.25 1493 update 1494 list [format {%.6g %.6g} {*}[.l xview]] $log 1495} {{0 0.1} {{x 0 0.1}}} 1496test listbox-12.3 {ChangeListboxOffset procedure} {fonts} { 1497 .l xview 10 1498 update 1499 set log {} 1500 .l xview 10 1501 update 1502 list [format {%.6g %.6g} {*}[.l xview]] $log 1503} {{0.1 0.2} {}} 1504 1505catch {destroy .l} 1506listbox .l -font $fixed -width 10 -height 5 1507pack .l 1508.l insert 0 a bb c d e f g h i j k l m n o p q r s 1509.l insert 0 0123456789a123456789b123456789c123456789d123456789 1510update 1511set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]] 1512set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]] 1513test listbox-13.1 {ListboxScanTo procedure} {fonts} { 1514 .l yview 0 1515 .l xview 0 1516 .l scan mark 10 20 1517 .l scan dragto [expr 10-$width] [expr 20-$height] 1518 update 1519 list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] 1520} {{0.2 0.4} {0.5 0.75}} 1521test listbox-13.2 {ListboxScanTo procedure} {fonts} { 1522 .l yview 5 1523 .l xview 10 1524 .l scan mark 10 20 1525 .l scan dragto 20 40 1526 update 1527 set x [list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]] 1528 .l scan dragto [expr 20-$width] [expr 40-$height] 1529 update 1530 lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] 1531} {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}} 1532test listbox-13.3 {ListboxScanTo procedure} {fonts} { 1533 .l yview moveto 1.0 1534 .l xview moveto 1.0 1535 .l scan mark 10 20 1536 .l scan dragto 5 10 1537 update 1538 set x [list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]] 1539 .l scan dragto [expr 5+$width] [expr 10+$height] 1540 update 1541 lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]] 1542} {{0.8 1} {0.75 1} {0.64 0.84} {0.25 0.5}} 1543 1544test listbox-14.1 {NearestListboxElement procedure, partial last line} { 1545 mkPartial 1546 .partial.l nearest [winfo height .partial.l] 1547} {4} 1548catch {destroy .l} 1549listbox .l -font $fixed -width 20 -height 10 1550.l insert 0 a b c d e f g h i j k l m n o p q r s t 1551.l yview 4 1552pack .l 1553update 1554test listbox-14.2 {NearestListboxElement procedure} {fonts} { 1555 .l index @50,0 1556} {4} 1557test listbox-14.3 {NearestListboxElement procedure} {fonts} { 1558 list [.l index @50,35] [.l index @50,36] 1559} {5 6} 1560test listbox-14.4 {NearestListboxElement procedure} {fonts} { 1561 .l index @50,200 1562} {13} 1563 1564test listbox-15.1 {ListboxSelect procedure} { 1565 .l delete 0 end 1566 .l insert 0 a b c d e f g h i j k l m n o p 1567 .l select set 2 4 1568 .l select set 7 12 1569 .l select clear 4 7 1570 .l curselection 1571} {2 3 8 9 10 11 12} 1572test listbox-15.2 {ListboxSelect procedure} { 1573 .l delete 0 end 1574 .l insert 0 a b c d e f g h i j k l m n o p 1575 catch {destroy .e} 1576 entry .e 1577 .e insert 0 "This is some text" 1578 .e select from 0 1579 .e select to 7 1580 .l selection clear 2 4 1581 set x [selection own] 1582 .l selection set 3 1583 list $x [selection own] [selection get] 1584} {.e .l d} 1585test listbox-15.3 {ListboxSelect procedure} { 1586 .l delete 0 end 1587 .l selection clear 0 end 1588 .l select set 0 end 1589 .l curselection 1590} {} 1591test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} { 1592 .l delete 0 end 1593 .l insert 0 a b c d e f 1594 .l select clear 0 end 1595 .l select set -2 -1 1596 .l curselection 1597} {} 1598test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} { 1599 .l delete 0 end 1600 .l insert 0 a b c d e f 1601 .l select clear 0 end 1602 .l select set -1 3 1603 .l curselection 1604} {0 1 2 3} 1605test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} { 1606 .l delete 0 end 1607 .l insert 0 a b c d e f 1608 .l select clear 0 end 1609 .l select set 2 4 1610 .l curselection 1611} {2 3 4} 1612test listbox-15.7 {ListboxSelect procedure, boundary conditions for indices} { 1613 .l delete 0 end 1614 .l insert 0 a b c d e f 1615 .l select clear 0 end 1616 .l select set 4 end 1617 .l curselection 1618} {4 5} 1619test listbox-15.8 {ListboxSelect procedure, boundary conditions for indices} { 1620 .l delete 0 end 1621 .l insert 0 a b c d e f 1622 .l select clear 0 end 1623 .l select set 4 30 1624 .l curselection 1625} {4 5} 1626test listbox-15.9 {ListboxSelect procedure, boundary conditions for indices} { 1627 .l delete 0 end 1628 .l insert 0 a b c d e f 1629 .l select clear 0 end 1630 .l select set end 30 1631 .l curselection 1632} {5} 1633test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} { 1634 .l delete 0 end 1635 .l insert 0 a b c d e f 1636 .l select clear 0 end 1637 .l select set 20 25 1638 .l curselection 1639} {} 1640 1641test listbox-16.1 {ListboxFetchSelection procedure} { 1642 .l delete 0 end 1643 .l insert 0 a b c "two words" e f g h i \\ k l m n o p 1644 .l selection set 2 4 1645 .l selection set 9 1646 .l selection set 11 12 1647 selection get 1648} "c\ntwo words\ne\n\\\nl\nm" 1649test listbox-16.2 {ListboxFetchSelection procedure} { 1650 .l delete 0 end 1651 .l insert 0 a b c "two words" e f g h i \\ k l m n o p 1652 .l selection set 3 1653 selection get 1654} "two words" 1655test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} { 1656 set long "This is quite a long string\n" 1657 append long $long $long $long $long 1658 append long $long $long $long $long 1659 append long $long $long 1660 .l delete 0 end 1661 .l insert 0 1$long 2$long 3$long 4$long 5$long 1662 .l selection set 0 end 1663 set sel [selection get] 1664 string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel 1665} {0} 1666catch {unset long sel} 1667 1668test listbox-17.1 {ListboxLostSelection procedure} { 1669 .l delete 0 end 1670 .l insert 0 a b c d e 1671 .l select set 0 end 1672 catch {destroy .e} 1673 entry .e 1674 .e insert 0 "This is some text" 1675 .e select from 0 1676 .e select to 5 1677 .l curselection 1678} {} 1679test listbox-17.2 {ListboxLostSelection procedure} { 1680 .l delete 0 end 1681 .l insert 0 a b c d e 1682 .l select set 0 end 1683 .l configure -exportselection 0 1684 catch {destroy .e} 1685 entry .e 1686 .e insert 0 "This is some text" 1687 .e select from 0 1688 .e select to 5 1689 .l curselection 1690} {0 1 2 3 4} 1691 1692catch {destroy .l} 1693listbox .l -font $fixed -width 10 -height 5 1694pack .l 1695update 1696test listbox-18.1 {ListboxUpdateVScrollbar procedure} { 1697 .l configure -yscrollcommand "record y" 1698 set log {} 1699 .l insert 0 a b c 1700 update 1701 .l insert end d e f g h 1702 update 1703 .l delete 0 end 1704 update 1705 set log 1706} {{y 0 1} {y 0 0.625} {y 0 1}} 1707test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} { 1708 mkPartial 1709 .partial.l configure -yscrollcommand "record y" 1710 set log {} 1711 .partial.l yview 3 1712 update 1713 set log 1714} {{y 0.2 0.466667}} 1715test listbox-18.3 {ListboxUpdateVScrollbar procedure} { 1716 proc bgerror args { 1717 global x errorInfo 1718 set x [list $args $errorInfo] 1719 } 1720 .l configure -yscrollcommand gorp 1721 .l insert 0 foo 1722 update 1723 set x 1724} {{{invalid command name "gorp"}} {invalid command name "gorp" 1725 while executing 1726"gorp 0.0 1.0" 1727 (vertical scrolling command executed by listbox)}} 1728if {[info exists bgerror]} { 1729 rename bgerror {} 1730} 1731 1732catch {destroy .l} 1733listbox .l -font $fixed -width 10 -height 5 1734pack .l 1735update 1736test listbox-19.1 {ListboxUpdateVScrollbar procedure} {fonts} { 1737 .l configure -xscrollcommand "record x" 1738 set log {} 1739 .l insert 0 abc 1740 update 1741 .l insert 0 "This is a much longer string..." 1742 update 1743 .l delete 0 end 1744 update 1745 set log 1746} {{x 0 1} {x 0 0.322581} {x 0 1}} 1747test listbox-19.2 {ListboxUpdateVScrollbar procedure} { 1748 proc bgerror args { 1749 global x errorInfo 1750 set x [list $args $errorInfo] 1751 } 1752 .l configure -xscrollcommand bogus 1753 .l insert 0 foo 1754 update 1755 set x 1756} {{{invalid command name "bogus"}} {invalid command name "bogus" 1757 while executing 1758"bogus 0.0 1.0" 1759 (horizontal scrolling command executed by listbox)}} 1760 1761set l [interp hidden] 1762deleteWindows 1763 1764test listbox-20.1 {listbox vs hidden commands} { 1765 catch {destroy .l} 1766 listbox .l 1767 interp hide {} .l 1768 destroy .l 1769 list [winfo children .] [interp hidden] 1770} [list {} $l] 1771 1772# tests for ListboxListVarProc 1773test listbox-21.1 {ListboxListVarProc} { 1774 catch {destroy .l} 1775 catch {unset x} 1776 listbox .l -listvar x 1777 set x [list a b c d] 1778 .l get 0 end 1779} [list a b c d] 1780test listbox-21.2 {ListboxListVarProc} { 1781 catch {destroy .l} 1782 set x [list a b c d] 1783 listbox .l -listvar x 1784 unset x 1785 set x 1786} [list a b c d] 1787test listbox-21.3 {ListboxListVarProc} { 1788 catch {destroy .l} 1789 set x [list a b c d] 1790 listbox .l -listvar x 1791 .l configure -listvar {} 1792 unset x 1793 info exists x 1794} 0 1795test listbox-21.4 {ListboxListVarProc} { 1796 catch {destroy .l} 1797 set x [list a b c d] 1798 listbox .l -listvar x 1799 lappend x e f g 1800 .l size 1801} 7 1802test listbox-21.5 {ListboxListVarProc, test selection after listvar mod} { 1803 catch {destroy .l} 1804 set x [list a b c d e f g] 1805 listbox .l -listvar x 1806 .l selection set end 1807 set x [list a b c d] 1808 set x [list 0 1 2 3 4 5 6] 1809 .l curselection 1810} {} 1811test listbox-21.6 {ListboxListVarProc, test selection after listvar mod} { 1812 catch {destroy .l} 1813 set x [list a b c d] 1814 listbox .l -listvar x 1815 .l selection set 3 1816 lappend x e f g 1817 .l curselection 1818} 3 1819test listbox-21.7 {ListboxListVarProc, test selection after listvar mod} { 1820 catch {destroy .l} 1821 set x [list a b c d] 1822 listbox .l -listvar x 1823 .l selection set 0 1824 set x [linsert $x 0 1 2 3 4] 1825 .l curselection 1826} 0 1827test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} { 1828 catch {destroy .l} 1829 set x [list a b c d] 1830 listbox .l -listvar x 1831 .l selection set 2 1832 set x [list a b c] 1833 .l curselection 1834} 2 1835test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} { 1836 catch {destroy .l} 1837 catch {unset x} 1838 set log {} 1839 listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x 1840 pack .l 1841 update 1842 lappend x "0000000000" 1843 update 1844 lappend x "00000000000000000000" 1845 update 1846 set log 1847} [list {x 0 1} {x 0 1} {x 0 0.5}] 1848test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} { 1849 catch {destroy .l} 1850 catch {unset x} 1851 set log {} 1852 listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x 1853 pack .l 1854 update 1855 lappend x "0000000000" 1856 update 1857 lappend x "00000000000000000000" 1858 update 1859 set x [list "0000000000"] 1860 update 1861 set log 1862} [list {x 0 1} {x 0 1} {x 0 0.5} {x 0 1}] 1863test listbox-21.11 {ListboxListVarProc, bad list} { 1864 catch {destroy .l} 1865 catch {unset x} 1866 listbox .l -listvar x 1867 set x [list a b c d] 1868 catch {set x "this is a \" bad list"} result 1869 set result 1870} {can't set "x": invalid listvar value} 1871test listbox-21.12 {ListboxListVarProc, cleanup item attributes} { 1872 catch {destroy .l} 1873 set x [list a b c d e f g] 1874 listbox .l -listvar x 1875 .l itemconfigure end -fg red 1876 set x [list a b c d] 1877 set x [list 0 1 2 3 4 5 6] 1878 .l itemcget end -fg 1879} {} 1880test listbox-21.12a {ListboxListVarProc, cleanup item attributes} { 1881 catch {destroy .l} 1882 set x [list a b c d e f g] 1883 listbox .l -listvar x 1884 .l itemconfigure end -fg red 1885 set x [list a b c d] 1886 set x [list 0 1 2 3 4 5 6] 1887 .l itemcget end -fg 1888} {} 1889test listbox-21.13 {listbox item configurations and listvar based deletions} { 1890 catch {destroy .l} 1891 catch {unset x} 1892 listbox .l -listvar x 1893 .l insert end a b c 1894 .l itemconfigure 1 -fg red 1895 set x [list b c] 1896 .l itemcget 1 -fg 1897} red 1898test listbox-21.14 {listbox item configurations and listvar based inserts} { 1899 catch {destroy .l} 1900 catch {unset x} 1901 listbox .l -listvar x 1902 .l insert end a b c 1903 .l itemconfigure 0 -fg red 1904 set x [list 1 2 3 4 a b c] 1905 .l itemcget 0 -fg 1906} red 1907test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} { 1908 catch {destroy .l} 1909 catch {unset x} 1910 set log {} 1911 listbox .l -listvar x -yscrollcommand "record y" -font fixed -height 3 1912 pack .l 1913 update 1914 lappend x a b c d e f 1915 update 1916 set log 1917} [list {y 0 1} {y 0 0.5}] 1918test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} { 1919 catch {destroy .l} 1920 catch {unset x} 1921 listbox .l -listvar x -height 3 1922 pack .l 1923 update 1924 set x [list 0 1 2 3 4 5] 1925 .l yview scroll 3 units 1926 update 1927 set result {} 1928 lappend result [format {%.6g %.6g} {*}[.l yview]] 1929 set x [lreplace $x 3 3] 1930 set x [lreplace $x 3 3] 1931 set x [lreplace $x 3 3] 1932 update 1933 lappend result [format {%.6g %.6g} {*}[.l yview]] 1934 set result 1935} [list {0.5 1} {0 1}] 1936 1937# UpdateHScrollbar 1938test listbox-22.1 {UpdateHScrollbar} { 1939 catch {destroy .l} 1940 set log {} 1941 listbox .l -font $fixed -width 10 -xscrollcommand "record x" 1942 pack .l 1943 update 1944 .l insert end "0000000000" 1945 update 1946 .l insert end "00000000000000000000" 1947 update 1948 set log 1949} [list {x 0 1} {x 0 1} {x 0 0.5}] 1950 1951# ConfigureListboxItem 1952test listbox-23.1 {ConfigureListboxItem} { 1953 catch {destroy .l} 1954 listbox .l 1955 catch {.l itemconfigure 0} result 1956 set result 1957} {item number "0" out of range} 1958test listbox-23.2 {ConfigureListboxItem} { 1959 catch {destroy .l} 1960 listbox .l 1961 .l insert end a b c d 1962 .l itemconfigure 0 1963} [list {-background background Background {} {}} \ 1964 {-bg -background} \ 1965 {-fg -foreground} \ 1966 {-foreground foreground Foreground {} {}} \ 1967 {-selectbackground selectBackground Foreground {} {}} \ 1968 {-selectforeground selectForeground Background {} {}}] 1969test listbox-23.3 {ConfigureListboxItem, itemco shortcut} { 1970 catch {destroy .l} 1971 listbox .l 1972 .l insert end a b c d 1973 .l itemco 0 -background 1974} {-background background Background {} {}} 1975test listbox-23.4 {ConfigureListboxItem, wrong num args} { 1976 catch {destroy .l} 1977 listbox .l 1978 .l insert end a 1979 catch {.l itemco} result 1980 set result 1981} {wrong # args: should be ".l itemconfigure index ?option? ?value? ?option value ...?"} 1982test listbox-23.5 {ConfigureListboxItem, multiple calls} { 1983 catch {destroy .l} 1984 listbox .l 1985 set i 0 1986 foreach color {red orange yellow green blue white violet} { 1987 .l insert end $color 1988 .l itemconfigure $i -bg $color 1989 incr i 1990 } 1991 pack .l 1992 update 1993 list [.l itemcget 0 -bg] [.l itemcget 1 -bg] [.l itemcget 2 -bg] \ 1994 [.l itemcget 3 -bg] [.l itemcget 4 -bg] [.l itemcget 5 -bg] \ 1995 [.l itemcget 6 -bg] 1996} {red orange yellow green blue white violet} 1997catch {destroy .l} 1998listbox .l 1999.l insert end a b c d 2000set i 6 2001foreach test { 2002 {-background #ff0000 #ff0000 non-existent 2003 {unknown color name "non-existent"}} 2004 {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} 2005 {-fg #110022 #110022 bogus {unknown color name "bogus"}} 2006 {-foreground #110022 #110022 bogus {unknown color name "bogus"}} 2007 {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} 2008 {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} 2009} { 2010 set name [lindex $test 0] 2011 test listbox-23.$i {configuration options} { 2012 .l itemconfigure 0 $name [lindex $test 1] 2013 list [lindex [.l itemconfigure 0 $name] 4] [.l itemcget 0 $name] 2014 } [list [lindex $test 2] [lindex $test 2]] 2015 incr i 2016 if {[lindex $test 3] != ""} { 2017 test listbox-23.$i {configuration options} { 2018 list [catch {.l configure $name [lindex $test 3]} msg] $msg 2019 } [list 1 [lindex $test 4]] 2020 } 2021 .l configure $name [lindex [.l configure $name] 3] 2022 incr i 2023} 2024 2025# ListboxWidgetObjCmd, itemcget 2026test listbox-24.1 {itemcget} { 2027 catch {destroy .l} 2028 listbox .l 2029 .l insert end a b c d 2030 .l itemcget 0 -fg 2031} {} 2032test listbox-24.2 {itemcget} { 2033 catch {destroy .l} 2034 listbox .l 2035 .l insert end a b c d 2036 .l itemconfigure 0 -fg red 2037 .l itemcget 0 -fg 2038} red 2039test listbox-24.3 {itemcget} { 2040 catch {destroy .l} 2041 listbox .l 2042 .l insert end a b c d 2043 catch {.l itemcget 0} result 2044 set result 2045} {wrong # args: should be ".l itemcget index option"} 2046test listbox-24.4 {itemcget, itemcg shortcut} { 2047 catch {destroy .l} 2048 listbox .l 2049 .l insert end a b c d 2050 catch {.l itemcg 0} result 2051 set result 2052} {wrong # args: should be ".l itemcget index option"} 2053 2054# General item configuration issues 2055test listbox-25.1 {listbox item configurations and widget based deletions} { 2056 catch {destroy .l} 2057 listbox .l 2058 .l insert end a 2059 .l itemconfigure 0 -fg red 2060 .l delete 0 end 2061 .l insert end a 2062 .l itemcget 0 -fg 2063} {} 2064test listbox-25.2 {listbox item configurations and widget based inserts} { 2065 catch {destroy .l} 2066 listbox .l 2067 .l insert end a b c 2068 .l itemconfigure 0 -fg red 2069 .l insert 0 1 2 3 4 2070 list [.l itemcget 0 -fg] [.l itemcget 4 -fg] 2071} [list {} red] 2072 2073# state issues 2074test listbox-26.1 {listbox disabled state disallows inserts} { 2075 catch {destroy .l} 2076 listbox .l 2077 .l insert end a b c 2078 .l configure -state disabled 2079 .l insert end d e f 2080 .l get 0 end 2081} [list a b c] 2082test listbox-26.2 {listbox disabled state disallows deletions} { 2083 catch {destroy .l} 2084 listbox .l 2085 .l insert end a b c 2086 .l configure -state disabled 2087 .l delete 0 end 2088 .l get 0 end 2089} [list a b c] 2090test listbox-26.3 {listbox disabled state disallows selection modification} { 2091 catch {destroy .l} 2092 listbox .l 2093 .l insert end a b c 2094 .l selection set 0 2095 .l selection set 2 2096 .l configure -state disabled 2097 .l selection clear 0 end 2098 .l selection set 1 2099 .l curselection 2100} [list 0 2] 2101test listbox-26.4 {listbox disabled state disallows anchor modification} { 2102 catch {destroy .l} 2103 listbox .l 2104 .l insert end a b c 2105 .l selection anchor 0 2106 .l configure -state disabled 2107 .l selection anchor 2 2108 .l index anchor 2109} 0 2110test listbox-26.5 {listbox disabled state disallows active modification} { 2111 catch {destroy .l} 2112 listbox .l 2113 .l insert end a b c 2114 .l activate 0 2115 .l configure -state disabled 2116 .l activate 2 2117 .l index active 2118} 0 2119 2120test listbox-27.1 {widget deletion while active} { 2121 destroy .l 2122 pack [listbox .l] 2123 update 2124 .l configure -cursor xterm -xscrollcommand { destroy .l } 2125 update idle 2126 winfo exists .l 2127} 0 2128 2129test listbox-28.1 {listbox -activestyle} { 2130 destroy .l 2131 listbox .l -activ non 2132 .l cget -activestyle 2133} none 2134test listbox-28.2-nonwin {listbox -activestyle} {nonwin} { 2135 destroy .l 2136 listbox .l 2137 .l cget -activestyle 2138} dotbox 2139test listbox-28.2-win {listbox -activestyle} {win} { 2140 destroy .l 2141 listbox .l 2142 .l cget -activestyle 2143} underline 2144test listbox-28.3 {listbox -activestyle} { 2145 destroy .l 2146 listbox .l -activestyle und 2147 .l cget -activestyle 2148} underline 2149 2150test listbox-29.1 {listbox selection behavior, -state disabled} { 2151 destroy .l 2152 listbox .l 2153 .l insert end 1 2 3 2154 .l selection set 2 2155 set out [.l selection includes 2] 2156 .l configure -state disabled 2157 # still return 1 when disabled, because 'selection get' will work, 2158 # but selection cannot be changed (new behavior since 8.4) 2159 .l selection set 3 2160 lappend out [.l selection includes 2] [.l curselection] 2161} {1 1 2} 2162 2163resetGridInfo 2164deleteWindows 2165option clear 2166 2167# cleanup 2168cleanupTests 2169return 2170