util/src/TclTk/tk8.6.12/tests/listbox.test

   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 package require tcltest 2.2
  10 eval tcltest::configure $argv
  11 tcltest::loadTestedCommands
  12 namespace import -force tcltest::test
  13
  14 set fixed {Courier -12}
  15
  16 proc record {name args} {
  17     global log
  18     lappend log [format {%s %.6g %.6g} $name {*}$args]
  19 }
  20
  21 proc getsize w {
  22     regexp {(^[^+-]*)} [wm geometry $w] foo x
  23     return $x
  24 }
  25
  26 proc resetGridInfo {} {
  27     # Some window managers, such as mwm, don't reset gridding information
  28     # unless the window is withdrawn and re-mapped.  If this procedure
  29     # isn't invoked, the window manager will stay in gridded mode, which
  30     # can cause all sorts of problems.  The "wm positionfrom" command is
  31     # needed so that the window manager doesn't ask the user to
  32     # manually position the window when it is re-mapped.
  33
  34     wm withdraw .
  35     wm positionfrom . user
  36     wm deiconify .
  37 }
  38
  39 # Procedure that creates a second listbox for checking things related
  40 # to partially visible lines.
  41
  42 proc mkPartial {{w .partial}} {
  43     destroy $w
  44     toplevel $w
  45     wm geometry $w +0+0
  46     listbox $w.l -width 30 -height 5
  47     pack $w.l -expand 1 -fill both
  48     $w.l insert end one two three four five six seven eight nine ten \
  49             eleven twelve thirteen fourteen fifteen
  50     update
  51     scan [wm geometry $w] "%dx%d" width height
  52     wm geometry $w ${width}x[expr $height-3]
  53     update
  54 }
  55
  56 # Create entries in the option database to be sure that geometry options
  57 # like border width have predictable values.
  58
  59 option add *Listbox.borderWidth 2
  60 option add *Listbox.selectBorderWidth 1
  61 option add *Listbox.highlightThickness 2
  62 option add *Listbox.font {Helvetica -12 bold}
  63
  64 # Listbox used in 3.* configuration options tests
  65 listbox .l
  66 pack .l
  67 update
  68 resetGridInfo
  69 test listbox-1.1 {configuration options} -body {
  70     .l configure -activestyle under
  71     list [lindex [.l configure -activestyle] 4] [.l cget -activestyle]
  72 } -cleanup {
  73     .l configure -activestyle [lindex [.l configure -activestyle] 3]
  74 } -result {underline underline}
  75 test listbox-1.2 {configuration options} -body {
  76     .l configure -activestyle foo
  77 } -returnCodes error -result {bad activestyle "foo": must be dotbox, none, or underline}
  78 test listbox-1.3 {configuration options} -body {
  79     .l configure -background #ff0000
  80     list [lindex [.l configure -background] 4] [.l cget -background]
  81 } -cleanup {
  82     .l configure -background [lindex [.l configure -background] 3]
  83 } -result {{#ff0000} #ff0000}
  84 test listbox-1.4 {configuration options} -body {
  85     .l configure -background non-existent
  86 } -returnCodes error -result {unknown color name "non-existent"}
  87 test listbox-1.5 {configuration options} -body {
  88     .l configure -bd 4
  89     list [lindex [.l configure -bd] 4] [.l cget -bd]
  90 } -cleanup {
  91     .l configure -bd [lindex [.l configure -bd] 3]
  92 } -result {4 4}
  93 test listbox-1.6 {configuration options} -body {
  94     .l configure -bd badValue
  95 } -returnCodes error -result {bad screen distance "badValue"}
  96 test listbox-1.7 {configuration options} -body {
  97     .l configure -bg #ff0000
  98     list [lindex [.l configure -bg] 4] [.l cget -bg]
  99 } -cleanup {
 100     .l configure -bg [lindex [.l configure -bg] 3]
 101 } -result {{#ff0000} #ff0000}
 102 test listbox-1.8 {configuration options} -body {
 103     .l configure -bg non-existent
 104 } -returnCodes error -result {unknown color name "non-existent"}
 105 test listbox-1.9 {configuration options} -body {
 106     .l configure -borderwidth 1.3
 107     list [lindex [.l configure -borderwidth] 4] [.l cget -borderwidth]
 108 } -cleanup {
 109     .l configure -borderwidth [lindex [.l configure -borderwidth] 3]
 110 } -result {1 1}
 111 test listbox-1.10 {configuration options} -body {
 112     .l configure -borderwidth badValue
 113 } -returnCodes error -result {bad screen distance "badValue"}
 114 test listbox-1.11 {configuration options} -body {
 115     .l configure -cursor arrow
 116     list [lindex [.l configure -cursor] 4] [.l cget -cursor]
 117 } -cleanup {
 118     .l configure -cursor [lindex [.l configure -cursor] 3]
 119 } -result {arrow arrow}
 120 test listbox-1.12 {configuration options} -body {
 121     .l configure -cursor badValue
 122 } -returnCodes error -result {bad cursor spec "badValue"}
 123 test listbox-1.13 {configuration options} -body {
 124     .l configure -disabledforeground #110022
 125     list [lindex [.l configure -disabledforeground] 4] [.l cget -disabledforeground]
 126 } -cleanup {
 127     .l configure -disabledforeground [lindex [.l configure -disabledforeground] 3]
 128 } -result {{#110022} #110022}
 129 test listbox-1.14 {configuration options} -body {
 130     .l configure -disabledforeground bogus
 131 } -returnCodes error -result {unknown color name "bogus"}
 132 test listbox-1.15 {configuration options} -body {
 133     .l configure -exportselection yes
 134     list [lindex [.l configure -exportselection] 4] [.l cget -exportselection]
 135 } -cleanup {
 136     .l configure -exportselection [lindex [.l configure -exportselection] 3]
 137 } -result {1 1}
 138 test listbox-1.16 {configuration options} -body {
 139     .l configure -exportselection xyzzy
 140 } -returnCodes error -result {expected boolean value but got "xyzzy"}
 141 test listbox-1.17 {configuration options} -body {
 142     .l configure -fg #110022
 143     list [lindex [.l configure -fg] 4] [.l cget -fg]
 144 } -cleanup {
 145     .l configure -fg [lindex [.l configure -fg] 3]
 146 } -result {{#110022} #110022}
 147 test listbox-1.18 {configuration options} -body {
 148     .l configure -fg bogus
 149 } -returnCodes error -result {unknown color name "bogus"}
 150 test listbox-1.19 {configuration options} -body {
 151     .l configure -font {Helvetica 12}
 152     list [lindex [.l configure -font] 4] [.l cget -font]
 153 } -cleanup {
 154     .l configure -font [lindex [.l configure -font] 3]
 155 } -result {{Helvetica 12} {Helvetica 12}}
 156 test listbox-1.21 {configuration options} -body {
 157     .l configure -foreground #110022
 158     list [lindex [.l configure -foreground] 4] [.l cget -foreground]
 159 } -cleanup {
 160     .l configure -foreground [lindex [.l configure -foreground] 3]
 161 } -result {{#110022} #110022}
 162 test listbox-1.22 {configuration options} -body {
 163     .l configure -foreground bogus
 164 } -returnCodes error -result {unknown color name "bogus"}
 165 test listbox-1.23 {configuration options} -body {
 166     .l configure -height 30
 167     list [lindex [.l configure -height] 4] [.l cget -height]
 168 } -cleanup {
 169     .l configure -height [lindex [.l configure -height] 3]
 170 } -result {30 30}
 171 test listbox-1.24 {configuration options} -body {
 172     .l configure -height 20p
 173 } -returnCodes error -result {expected integer but got "20p"}
 174 test listbox-1.25 {configuration options} -body {
 175     .l configure -highlightbackground #112233
 176     list [lindex [.l configure -highlightbackground] 4] [.l cget -highlightbackground]
 177 } -cleanup {
 178     .l configure -highlightbackground [lindex [.l configure -highlightbackground] 3]
 179 } -result {{#112233} #112233}
 180 test listbox-1.26 {configuration options} -body {
 181     .l configure -highlightbackground ugly
 182 } -returnCodes error -result {unknown color name "ugly"}
 183 test listbox-1.27 {configuration options} -body {
 184     .l configure -highlightcolor #123456
 185     list [lindex [.l configure -highlightcolor] 4] [.l cget -highlightcolor]
 186 } -cleanup {
 187     .l configure -highlightcolor [lindex [.l configure -highlightcolor] 3]
 188 } -result {{#123456} #123456}
 189 test listbox-1.28 {configuration options} -body {
 190     .l configure -highlightcolor bogus
 191 } -returnCodes error -result {unknown color name "bogus"}
 192 test listbox-1.29 {configuration options} -body {
 193     .l configure -highlightthickness 6
 194     list [lindex [.l configure -highlightthickness] 4] [.l cget -highlightthickness]
 195 } -cleanup {
 196     .l configure -highlightthickness [lindex [.l configure -highlightthickness] 3]
 197 } -result {6 6}
 198 test listbox-1.30 {configuration options} -body {
 199     .l configure -highlightthickness bogus
 200 } -returnCodes error -result {bad screen distance "bogus"}
 201 test listbox-1.31 {configuration options} -body {
 202     .l configure -highlightthickness -2
 203     list [lindex [.l configure -highlightthickness] 4] [.l cget -highlightthickness]
 204 } -cleanup {
 205     .l configure -highlightthickness [lindex [.l configure -highlightthickness] 3]
 206 } -result {0 0}
 207 test listbox-1.32.1 {configuration options} -setup {
 208     set res {}
 209 } -body {
 210     .l configure -justify left
 211     set res [list [lindex [.l configure -justify] 4] [.l cget -justify]]
 212     .l configure -justify center
 213     lappend res [lindex [.l configure -justify] 4] [.l cget -justify]
 214     .l configure -justify right
 215     lappend res [lindex [.l configure -justify] 4] [.l cget -justify]
 216 } -cleanup {
 217     .l configure -justify [lindex [.l configure -justify] 3]
 218 } -result {left left center center right right}
 219 test listbox-1.32.2 {configuration options} -body {
 220     .l configure -justify bogus
 221 } -returnCodes error -result {bad justification "bogus": must be left, right, or center}
 222 test listbox-1.33 {configuration options} -body {
 223     .l configure -relief groove
 224     list [lindex [.l configure -relief] 4] [.l cget -relief]
 225 } -cleanup {
 226     .l configure -relief [lindex [.l configure -relief] 3]
 227 } -result {groove groove}
 228 test listbox-1.34 {configuration options} -body {
 229     .l configure -relief 1.5
 230 } -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}
 231 test listbox-1.35 {configuration options} -body {
 232     .l configure -selectbackground #110022
 233     list [lindex [.l configure -selectbackground] 4] [.l cget -selectbackground]
 234 } -cleanup {
 235     .l configure -selectbackground [lindex [.l configure -selectbackground] 3]
 236 } -result {{#110022} #110022}
 237 test listbox-1.36 {configuration options} -body {
 238     .l configure -selectbackground bogus
 239 } -returnCodes error -result {unknown color name "bogus"}
 240 test listbox-1.37 {configuration options} -body {
 241     .l configure -selectborderwidth 1.3
 242     list [lindex [.l configure -selectborderwidth] 4] [.l cget -selectborderwidth]
 243 } -cleanup {
 244     .l configure -selectborderwidth [lindex [.l configure -selectborderwidth] 3]
 245 } -result {1 1}
 246 test listbox-1.38 {configuration options} -body {
 247     .l configure -selectborderwidth badValue
 248 } -returnCodes error -result {bad screen distance "badValue"}
 249 test listbox-1.39 {configuration options} -body {
 250     .l configure -selectforeground #654321
 251     list [lindex [.l configure -selectforeground] 4] [.l cget -selectforeground]
 252 } -cleanup {
 253     .l configure -selectforeground [lindex [.l configure -selectforeground] 3]
 254 } -result {{#654321} #654321}
 255 test listbox-1.40 {configuration options} -body {
 256     .l configure -selectforeground bogus
 257 } -returnCodes error -result {unknown color name "bogus"}
 258 test listbox-1.41 {configuration options} -body {
 259     .l configure -selectmode string
 260     list [lindex [.l configure -selectmode] 4] [.l cget -selectmode]
 261 } -cleanup {
 262     .l configure -selectmode [lindex [.l configure -selectmode] 3]
 263 } -result {string string}
 264 test listbox-1.43 {configuration options} -body {
 265     .l configure -setgrid false
 266     list [lindex [.l configure -setgrid] 4] [.l cget -setgrid]
 267 } -cleanup {
 268     .l configure -setgrid [lindex [.l configure -setgrid] 3]
 269 } -result {0 0}
 270 test listbox-1.44 {configuration options} -body {
 271     .l configure -setgrid lousy
 272 } -returnCodes error -result {expected boolean value but got "lousy"}
 273 test listbox-1.45 {configuration options} -body {
 274     .l configure -state disabled
 275     list [lindex [.l configure -state] 4] [.l cget -state]
 276 } -cleanup {
 277     .l configure -state [lindex [.l configure -state] 3]
 278 } -result {disabled disabled}
 279 test listbox-1.46 {configuration options} -body {
 280     .l configure -state foo
 281 } -returnCodes error -result {bad state "foo": must be disabled or normal}
 282 test listbox-1.47 {configuration options} -body {
 283     .l configure -takefocus {any string}
 284     list [lindex [.l configure -takefocus] 4] [.l cget -takefocus]
 285 } -cleanup {
 286     .l configure -takefocus [lindex [.l configure -takefocus] 3]
 287 } -result {{any string} {any string}}
 288 test listbox-1.49 {configuration options} -body {
 289     .l configure -width 45
 290     list [lindex [.l configure -width] 4] [.l cget -width]
 291 } -cleanup {
 292     .l configure -width [lindex [.l configure -width] 3]
 293 } -result {45 45}
 294 test listbox-1.50 {configuration options} -body {
 295     .l configure -width 3p
 296 } -returnCodes error -result {expected integer but got "3p"}
 297 test listbox-1.51 {configuration options} -body {
 298     .l configure -xscrollcommand {Some command}
 299     list [lindex [.l configure -xscrollcommand] 4] [.l cget -xscrollcommand]
 300 } -cleanup {
 301     .l configure -xscrollcommand [lindex [.l configure -xscrollcommand] 3]
 302 } -result {{Some command} {Some command}}
 303 test listbox-1.53 {configuration options} -body {
 304     .l configure -yscrollcommand {Another command}
 305     list [lindex [.l configure -yscrollcommand] 4] [.l cget -yscrollcommand]
 306 } -cleanup {
 307     .l configure -yscrollcommand [lindex [.l configure -yscrollcommand] 3]
 308 } -result {{Another command} {Another command}}
 309 test listbox-1.55 {configuration options} -body {
 310     .l configure -listvar testVariable
 311     list [lindex [.l configure -listvar] 4] [.l cget -listvar]
 312 } -cleanup {
 313     .l configure -listvar [lindex [.l configure -listvar] 3]
 314 } -result {testVariable testVariable}
 315
 316
 317 test listbox-2.1 {Tk_ListboxCmd procedure} -body {
 318     listbox
 319 } -returnCodes error -result {wrong # args: should be "listbox pathName ?-option value ...?"}
 320 test listbox-2.2 {Tk_ListboxCmd procedure} -body {
 321     listbox gorp
 322 } -returnCodes error -result {bad window path name "gorp"}
 323 test listbox-2.3 {Tk_ListboxCmd procedure} -setup {
 324     destroy .l
 325 } -body {
 326     listbox .l
 327     list [winfo exists .l] [winfo class .l] [info commands .l]
 328 } -result {1 Listbox .l}
 329 test listbox-2.4 {Tk_ListboxCmd procedure} -setup {
 330     destroy .l
 331 } -body {
 332     listbox .l -gorp foo
 333 } -cleanup {
 334     destroy .l
 335 } -returnCodes error -result {unknown option "-gorp"}
 336 test listbox-2.4.1 {Tk_ListboxCmd procedure} -setup {
 337     destroy .l
 338 } -body {
 339     catch {listbox .l -gorp foo}
 340     list [winfo exists .l] [info commands .l]
 341 } -cleanup {
 342     destroy .l
 343 } -result {0 {}}
 344 test listbox-2.5 {Tk_ListboxCmd procedure} -setup {
 345     destroy .l
 346 } -body {
 347     listbox .l
 348 } -cleanup {
 349     destroy .l
 350 } -result {.l}
 351
 352
 353 # Listbox used in 3.1 -3.115 tests
 354 destroy .l
 355 listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2
 356 pack .l
 357 .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \
 358         el15 el16 el17
 359 update
 360 test listbox-3.1 {ListboxWidgetCmd procedure} -body {
 361     .l
 362 } -returnCodes error -result {wrong # args: should be ".l option ?arg ...?"}
 363 test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} -body {
 364     .l activate
 365 } -returnCodes error -result {wrong # args: should be ".l activate index"}
 366 test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} -body {
 367     .l activate a b
 368 } -returnCodes error -result {wrong # args: should be ".l activate index"}
 369 test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} -body {
 370     .l activate fooey
 371 } -returnCodes error -result {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}
 372 test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} -body {
 373     .l activate 3
 374     .l index active
 375 } -result 3
 376 test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} -body {
 377     .l activate -1
 378     .l index active
 379 } -result 0
 380 test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} -body {
 381     .l activate 30
 382     .l index active
 383 } -result 17
 384 test listbox-3.8 {ListboxWidgetCmd procedure, "activate" option} -body {
 385     .l activate end
 386     .l index active
 387 } -result 17
 388 test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} -body {
 389     .l bbox
 390 } -returnCodes error -result {wrong # args: should be ".l bbox index"}
 391 test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} -body {
 392     .l bbox a b
 393 } -returnCodes error -result {wrong # args: should be ".l bbox index"}
 394 test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} -body {
 395     .l bbox fooey
 396 } -returnCodes error -result {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}
 397 test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option} -body {
 398     .l yview 3
 399     update
 400     list [.l bbox 2] [.l bbox 8]
 401 } -result {{} {}}
 402 test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} -cleanup {
 403     destroy .l2
 404 } -body {
 405     # Used to generate a core dump before a bug was fixed (the last
 406     # element would be on-screen if it existed, but it doesn't exist).
 407
 408     listbox .l2
 409     pack .l2 -side top
 410     tkwait visibility .l2
 411     set x [.l2 bbox 0]
 412     destroy .l2
 413     set x
 414 } -cleanup {
 415     destroy .l2
 416 } -result {}
 417 test listbox-3.14 {ListboxWidgetCmd procedure, "bbox" option} -constraints {
 418         fonts
 419 } -body {
 420     .l yview 3
 421     update
 422     list [.l bbox 3] [.l bbox 4]
 423 } -result {{7 7 17 14} {7 26 17 14}}
 424 test listbox-3.15 {ListboxWidgetCmd procedure, "bbox" option} -constraints {
 425         fonts
 426 } -body {
 427     .l yview 0
 428     update
 429     list [.l bbox -1] [.l bbox 0]
 430 } -result {{} {7 7 17 14}}
 431 test listbox-3.16 {ListboxWidgetCmd procedure, "bbox" option} -constraints {
 432         fonts
 433 } -body {
 434     .l yview end
 435     update
 436     list [.l bbox 17] [.l bbox end] [.l bbox 18]
 437 } -result {{7 83 24 14} {7 83 24 14} {}}
 438 test listbox-3.17 {ListboxWidgetCmd procedure, "bbox" option} -constraints {
 439         fonts
 440 } -setup {
 441     destroy .t
 442 } -body {
 443     toplevel .t
 444     wm geom .t +0+0
 445     listbox .t.l -width 10 -height 5
 446     .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short"
 447     pack .t.l
 448     update
 449     .t.l xview moveto .2
 450     .t.l bbox 2
 451 } -cleanup {
 452     destroy .t
 453 } -result {-72 39 393 14}
 454 test listbox-3.18 {ListboxWidgetCmd procedure, "bbox" option, partial last line} -constraints {
 455         fonts
 456 } -body {
 457     mkPartial
 458     list [.partial.l bbox 3] [.partial.l bbox 4]
 459 } -result {{5 56 24 14} {5 73 23 14}}
 460 test listbox-3.18a {ListboxWidgetCmd procedure, "bbox" option, justified} -constraints {
 461         fonts
 462 } -setup {
 463     destroy .top.l .top
 464     unset -nocomplain res
 465 } -body {
 466     toplevel .top
 467     listbox .top.l -justify left
 468     .top.l insert end Item1 LongerItem2 MuchLongerItem3
 469     pack .top.l
 470     update
 471     lappend res [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2]
 472     .top.l configure -justify center
 473     lappend res [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2]
 474     .top.l configure -justify right
 475     lappend res [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2]
 476 } -cleanup {
 477     destroy .top.l .top
 478     unset -nocomplain res
 479 } -result [list \
 480     {5 5 34 14} {5 22 74 14} {5 39 106 14}     \
 481     {58 5 34 14} {38 22 74 14} {22 39 106 14}  \
 482     {111 5 34 14} {71 22 74 14} {39 39 106 14} \
 483 ]
 484 test listbox-3.18b {ListboxWidgetCmd procedure, "bbox" option, justified, non-default borderwidth} -setup {
 485     destroy .top.l .top
 486     unset -nocomplain lres res
 487 } -body {
 488     # This test checks whether all "x" values from bbox for different size
 489     # items with different justification settings are all positive or zero
 490     # This checks a bit the calculation of this x value with non-default
 491     # borders widths of the listbox
 492     toplevel .top
 493     listbox .top.l -justify left -borderwidth 17 -highlightthickness 19 -selectborderwidth 22
 494     .top.l insert end Item1 LongerItem2 MuchLongerItem3
 495     .top.l selection set 1
 496     pack .top.l
 497     update
 498     lappend lres [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2]
 499     .top.l configure -justify center
 500     lappend lres [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2]
 501     .top.l configure -justify right
 502     lappend lres [.top.l bbox 0] [.top.l bbox 1] [.top.l bbox 2]
 503     set res 1
 504     for {set i 0} {$i < [llength $lres]} {incr i 4} {
 505         set res [expr {$res * [expr {[lindex $lres $i] >= 0}] }]
 506     }
 507     set res
 508 } -cleanup {
 509     destroy .top.l .top
 510     unset -nocomplain lres res
 511 } -result 1
 512 test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} -body {
 513     .l cget
 514 } -returnCodes error -result {wrong # args: should be ".l cget option"}
 515 test listbox-3.20 {ListboxWidgetCmd procedure, "cget" option} -body {
 516     .l cget a b
 517 } -returnCodes error -result {wrong # args: should be ".l cget option"}
 518 test listbox-3.21 {ListboxWidgetCmd procedure, "cget" option} -body {
 519     .l cget -gorp
 520 } -returnCodes error -result {unknown option "-gorp"}
 521 test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} -body {
 522     .l cget -setgrid
 523 } -result 0
 524 test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} -body {
 525     llength [.l configure]
 526 } -result 28
 527 test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} -body {
 528     .l configure -gorp
 529 } -returnCodes error -result {unknown option "-gorp"}
 530 test listbox-3.25 {ListboxWidgetCmd procedure, "configure" option} -body {
 531     .l configure -setgrid
 532 } -result {-setgrid setGrid SetGrid 0 0}
 533 test listbox-3.26 {ListboxWidgetCmd procedure, "configure" option} -body {
 534     .l configure -gorp is_messy
 535 } -returnCodes error -result {unknown option "-gorp"}
 536 test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} -body {
 537     set oldbd [.l cget -bd]
 538     set oldht [.l cget -highlightthickness]
 539     .l configure -bd 3 -highlightthickness 0
 540     set x "[.l cget -bd] [.l cget -highlightthickness]"
 541     .l configure -bd $oldbd -highlightthickness $oldht
 542     set x
 543 } -result {3 0}
 544 test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} -body {
 545     .l curselection a
 546 } -returnCodes error -result {wrong # args: should be ".l curselection"}
 547 test listbox-3.29 {ListboxWidgetCmd procedure, "curselection" option} -body {
 548     .l selection clear 0 end
 549     .l selection set 3 6
 550     .l selection set 9
 551     .l curselection
 552 } -result {3 4 5 6 9}
 553 test listbox-3.30 {ListboxWidgetCmd procedure, "delete" option} -body {
 554     .l delete
 555 } -returnCodes error -result {wrong # args: should be ".l delete firstIndex ?lastIndex?"}
 556 test listbox-3.31 {ListboxWidgetCmd procedure, "delete" option} -body {
 557     .l delete a b c
 558 } -returnCodes error -result {wrong # args: should be ".l delete firstIndex ?lastIndex?"}
 559 test listbox-3.32 {ListboxWidgetCmd procedure, "delete" option} -body {
 560     .l delete badIndex
 561 } -returnCodes error -result {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}
 562 test listbox-3.33 {ListboxWidgetCmd procedure, "delete" option} -body {
 563     .l delete 2 123ab
 564 } -returnCodes error -result {bad listbox index "123ab": must be active, anchor, end, @x,y, or a number}
 565 test listbox-3.34 {ListboxWidgetCmd procedure, "delete" option} -setup {
 566     destroy .l2
 567 } -body {
 568     listbox .l2
 569     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
 570     .l2 delete 3
 571     list [.l2 get 2] [.l2 get 3] [.l2 index end]
 572 } -cleanup {
 573     destroy .l2
 574 } -result {el2 el4 7}
 575 test listbox-3.35 {ListboxWidgetCmd procedure, "delete" option} -setup {
 576     destroy .l2
 577 } -body {
 578     listbox .l2
 579     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
 580     .l2 delete 2 4
 581     list [.l2 get 1] [.l2 get 2] [.l2 index end]
 582 } -cleanup {
 583     destroy .l2
 584 } -result {el1 el5 5}
 585 test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} -setup {
 586     destroy .l2
 587 } -body {
 588     listbox .l2
 589     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
 590     .l2 delete -1 2
 591     .l2 get 0 end
 592 } -cleanup {
 593     destroy .l2
 594 } -result {el3 el4 el5 el6 el7}
 595 test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} -setup {
 596     destroy .l2
 597 } -body {
 598     listbox .l2
 599     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
 600     .l2 delete -1 -1
 601     .l2 get 0 end
 602 } -cleanup {
 603     destroy .l2
 604 } -result {el0 el1 el2 el3 el4 el5 el6 el7}
 605 test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} -setup {
 606     destroy .l2
 607 } -body {
 608     listbox .l2
 609     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
 610     .l2 delete 2 end
 611     .l2 get 0 end
 612 } -cleanup {
 613     destroy .l2
 614 } -result {el0 el1}
 615 test listbox-3.39 {ListboxWidgetCmd procedure, "delete" option} -setup {
 616     destroy .l2
 617 } -body {
 618     listbox .l2
 619     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
 620     .l2 delete 5 20
 621     .l2 get 0 end
 622 } -cleanup {
 623     destroy .l2
 624 } -result {el0 el1 el2 el3 el4}
 625 test listbox-3.40 {ListboxWidgetCmd procedure, "delete" option} -setup {
 626     destroy .l2
 627 } -body {
 628     listbox .l2
 629     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
 630     .l2 delete end 20
 631     .l2 get 0 end
 632 } -cleanup {
 633     destroy .l2
 634 } -result {el0 el1 el2 el3 el4 el5 el6}
 635 test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} -setup {
 636     destroy .l2
 637 } -body {
 638     listbox .l2
 639     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
 640     .l2 delete 8 20
 641     .l2 get 0 end
 642 } -cleanup {
 643     destroy .l2
 644 } -result {el0 el1 el2 el3 el4 el5 el6 el7}
 645 test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} -body {
 646     .l get
 647 } -returnCodes error -result {wrong # args: should be ".l get firstIndex ?lastIndex?"}
 648 test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} -body {
 649     .l get a b c
 650 } -returnCodes error -result {wrong # args: should be ".l get firstIndex ?lastIndex?"}
 651 test listbox-3.44 {ListboxWidgetCmd procedure, "get" option} -body {
 652     .l get 2.4
 653 } -returnCodes error -result {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number}
 654 test listbox-3.45 {ListboxWidgetCmd procedure, "get" option} -body {
 655     .l get end bogus
 656 } -returnCodes error -result {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}
 657 test listbox-3.46 {ListboxWidgetCmd procedure, "get" option} -setup {
 658     destroy .l2
 659 } -body {
 660     listbox .l2
 661     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
 662     list [.l2 get 0] [.l2 get 3] [.l2 get end]
 663 } -cleanup {
 664     destroy .l2
 665 } -result {el0 el3 el7}
 666 test listbox-3.47 {ListboxWidgetCmd procedure, "get" option} -setup {
 667     destroy .l2
 668 } -body {
 669     listbox .l2
 670     list [.l2 get 0] [.l2 get end]
 671 } -cleanup {
 672     destroy .l2
 673 } -result {{} {}}
 674 test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} -setup {
 675     destroy .l2
 676 } -body {
 677     listbox .l2
 678     .l2 insert 0 el0 el1 el2 "two words" el4 el5 el6 el7
 679     .l2 get 3 end
 680 } -cleanup {
 681     destroy .l2
 682 } -result {{two words} el4 el5 el6 el7}
 683 test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} -body {
 684     .l get -1
 685 } -result {}
 686 test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} -body {
 687     .l get -1 -1
 688 } -result {}
 689 test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} -body {
 690     .l get -1 3
 691 } -result {el0 el1 el2 el3}
 692 test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} -body {
 693     .l get 12 end
 694 } -result {el12 el13 el14 el15 el16 el17}
 695 test listbox-3.53 {ListboxWidgetCmd procedure, "get" option} -body {
 696     .l get 12 20
 697 } -result {el12 el13 el14 el15 el16 el17}
 698 test listbox-3.54 {ListboxWidgetCmd procedure, "get" option} -body {
 699     .l get end
 700 } -result {el17}
 701 test listbox-3.55 {ListboxWidgetCmd procedure, "get" option} -body {
 702     .l get 30
 703 } -result {}
 704 test listbox-3.56 {ListboxWidgetCmd procedure, "get" option} -body {
 705     .l get 30 35
 706 } -result {}
 707 test listbox-3.57 {ListboxWidgetCmd procedure, "index" option} -body {
 708     .l index
 709 } -returnCodes error -result {wrong # args: should be ".l index index"}
 710 test listbox-3.58 {ListboxWidgetCmd procedure, "index" option} -body {
 711     .l index a b
 712 } -returnCodes error -result {wrong # args: should be ".l index index"}
 713 test listbox-3.59 {ListboxWidgetCmd procedure, "index" option} -body {
 714     .l index @
 715 } -returnCodes error -result {bad listbox index "@": must be active, anchor, end, @x,y, or a number}
 716 test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} -body {
 717     .l index 2
 718 } -result 2
 719 test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} -body {
 720     .l index -1
 721 } -result {-1}
 722 test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} -body {
 723     .l index end
 724 } -result 18
 725 test listbox-3.63 {ListboxWidgetCmd procedure, "index" option} -body {
 726     .l index 34
 727 } -result 34
 728 test listbox-3.64 {ListboxWidgetCmd procedure, "insert" option} -body {
 729     .l insert
 730 } -returnCodes error -result {wrong # args: should be ".l insert index ?element ...?"}
 731 test listbox-3.65 {ListboxWidgetCmd procedure, "insert" option} -body {
 732     .l insert badIndex
 733 } -returnCodes error -result {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}
 734 test listbox-3.66 {ListboxWidgetCmd procedure, "insert" option} -setup {
 735     destroy .l2
 736 } -body {
 737     listbox .l2
 738     .l2 insert end a b c d e
 739     .l2 insert 3 x y z
 740     .l2 get 0 end
 741 } -cleanup {
 742     destroy .l2
 743 } -result {a b c x y z d e}
 744 test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} -setup {
 745     destroy .l2
 746 } -body {
 747     listbox .l2
 748     .l2 insert end a b c
 749     .l2 insert -1 x
 750     .l2 get 0 end
 751 } -cleanup {
 752     destroy .l2
 753 } -result {x a b c}
 754 test listbox-3.68 {ListboxWidgetCmd procedure, "insert" option} -setup {
 755     destroy .l2
 756 } -body {
 757     listbox .l2
 758     .l2 insert end a b c
 759     .l2 insert end x
 760     .l2 get 0 end
 761 } -cleanup {
 762     destroy .l2
 763 } -result {a b c x}
 764 test listbox-3.69 {ListboxWidgetCmd procedure, "insert" option} -setup {
 765     destroy .l2
 766 } -body {
 767     listbox .l2
 768     .l2 insert end a b c
 769     .l2 insert 43 x
 770     .l2 get 0 end
 771 } -cleanup {
 772     destroy .l2
 773 } -result {a b c x}
 774 test listbox-3.70 {ListboxWidgetCmd procedure, "nearest" option} -body {
 775     .l nearest
 776 } -returnCodes error -result {wrong # args: should be ".l nearest y"}
 777 test listbox-3.71 {ListboxWidgetCmd procedure, "nearest" option} -body {
 778     .l nearest a b
 779 } -returnCodes error -result {wrong # args: should be ".l nearest y"}
 780 test listbox-3.72 {ListboxWidgetCmd procedure, "nearest" option} -body {
 781     .l nearest 20p
 782 } -returnCodes error -result {expected integer but got "20p"}
 783 test listbox-3.73 {ListboxWidgetCmd procedure, "nearest" option} -body {
 784     .l yview 3
 785     .l nearest 1000
 786 } -result 7
 787 test listbox-3.74 {ListboxWidgetCmd procedure, "scan" option} -body {
 788     .l scan a b
 789 } -returnCodes error -result {wrong # args: should be ".l scan mark|dragto x y"}
 790 test listbox-3.75 {ListboxWidgetCmd procedure, "scan" option} -body {
 791     .l scan a b c d
 792 } -returnCodes error -result {wrong # args: should be ".l scan mark|dragto x y"}
 793 test listbox-3.76 {ListboxWidgetCmd procedure, "scan" option} -body {
 794     .l scan foo bogus 2
 795 } -returnCodes error -result {expected integer but got "bogus"}
 796 test listbox-3.77 {ListboxWidgetCmd procedure, "scan" option} -body {
 797     .l scan foo 2 2.3
 798 } -returnCodes error -result {expected integer but got "2.3"}
 799 test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} -constraints {
 800         fonts
 801 } -setup {
 802     destroy .t
 803 } -body {
 804     toplevel .t
 805     wm geom .t +0+0
 806     listbox .t.l -width 10 -height 5
 807     .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
 808     pack .t.l
 809     update
 810     .t.l scan mark 100 140
 811     .t.l scan dragto 90 137
 812     update
 813     list [format {%.6g %.6g} {*}[.t.l xview]] [format {%.6g %.6g} {*}[.t.l yview]]
 814 } -cleanup {
 815     destroy .t
 816 } -result {{0.249364 0.427481} {0.0714286 0.428571}}
 817 test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} -body {
 818     .l scan foo 2 4
 819 } -returnCodes error -result {bad option "foo": must be mark or dragto}
 820 test listbox-3.80 {ListboxWidgetCmd procedure, "see" option} -body {
 821     .l see
 822 } -returnCodes error -result {wrong # args: should be ".l see index"}
 823 test listbox-3.81 {ListboxWidgetCmd procedure, "see" option} -body {
 824     .l see a b
 825 } -returnCodes error -result {wrong # args: should be ".l see index"}
 826 test listbox-3.82 {ListboxWidgetCmd procedure, "see" option} -body {
 827     .l see gorp
 828 } -returnCodes error -result {bad listbox index "gorp": must be active, anchor, end, @x,y, or a number}
 829 test listbox-3.83 {ListboxWidgetCmd procedure, "see" option} -body {
 830     .l yview 7
 831     .l see 7
 832     .l index @0,0
 833 } -result 7
 834 test listbox-3.84 {ListboxWidgetCmd procedure, "see" option} -body {
 835     .l yview 7
 836     .l see 11
 837     .l index @0,0
 838 } -result 7
 839 test listbox-3.85 {ListboxWidgetCmd procedure, "see" option} -body {
 840     .l yview 7
 841     .l see 6
 842     .l index @0,0
 843 } -result 6
 844 test listbox-3.86 {ListboxWidgetCmd procedure, "see" option} -body {
 845     .l yview 7
 846     .l see 5
 847     .l index @0,0
 848 } -result 3
 849 test listbox-3.87 {ListboxWidgetCmd procedure, "see" option} -body {
 850     .l yview 7
 851     .l see 12
 852     .l index @0,0
 853 } -result 8
 854 test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} -body {
 855     .l yview 7
 856     .l see 13
 857     .l index @0,0
 858 } -result 11
 859 test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} -body {
 860     .l yview 7
 861     .l see -1
 862     .l index @0,0
 863 } -result 0
 864 test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} -body {
 865     .l yview 7
 866     .l see end
 867     .l index @0,0
 868 } -result 13
 869 test listbox-3.91 {ListboxWidgetCmd procedure, "see" option} -body {
 870     .l yview 7
 871     .l see 322
 872     .l index @0,0
 873 } -result 13
 874 test listbox-3.92 {ListboxWidgetCmd procedure, "see" option, partial last line} -body {
 875     mkPartial
 876     .partial.l see 4
 877     .partial.l index @0,0
 878 } -result 1
 879 test listbox-3.93 {ListboxWidgetCmd procedure, "selection" option} -body {
 880     .l select a
 881 } -returnCodes error -result {wrong # args: should be ".l selection option index ?index?"}
 882 test listbox-3.94 {ListboxWidgetCmd procedure, "selection" option} -body {
 883     .l select a b c d
 884 } -returnCodes error -result {wrong # args: should be ".l selection option index ?index?"}
 885 test listbox-3.95 {ListboxWidgetCmd procedure, "selection" option} -body {
 886     .l selection a bogus
 887 } -returnCodes error -result {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}
 888 test listbox-3.96 {ListboxWidgetCmd procedure, "selection" option} -body {
 889     .l selection a 0 lousy
 890 } -returnCodes error -result {bad listbox index "lousy": must be active, anchor, end, @x,y, or a number}
 891 test listbox-3.97 {ListboxWidgetCmd procedure, "selection" option} -body {
 892     .l selection anchor 0 0
 893 } -returnCodes error -result {wrong # args: should be ".l selection anchor index"}
 894 test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} -body {
 895     list [.l selection anchor 5; .l index anchor] \
 896             [.l selection anchor 0; .l index anchor]
 897 } -result {5 0}
 898 test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} -body {
 899     .l selection anchor -1
 900     .l index anchor
 901 } -result 0
 902 test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} -body {
 903     .l selection anchor end
 904     .l index anchor
 905 } -result 17
 906 test listbox-3.101 {ListboxWidgetCmd procedure, "selection" option} -body {
 907     .l selection anchor 44
 908     .l index anchor
 909 } -result 17
 910 test listbox-3.102 {ListboxWidgetCmd procedure, "selection" option} -body {
 911     .l selection clear 0 end
 912     .l selection set 2 8
 913     .l selection clear 3 4
 914     .l curselection
 915 } -result {2 5 6 7 8}
 916 test listbox-3.103 {ListboxWidgetCmd procedure, "selection" option} -body {
 917     .l selection includes 0 0
 918 } -returnCodes error -result {wrong # args: should be ".l selection includes index"}
 919 test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} -body {
 920     .l selection clear 0 end
 921     .l selection set 2 8
 922     .l selection clear 4
 923     list [.l selection includes 3] [.l selection includes 4] \
 924             [.l selection includes 5]
 925 } -result {1 0 1}
 926 test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} -body {
 927     .l selection set 0 end
 928     .l selection includes -1
 929 } -result 0
 930 test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} -body {
 931     .l selection clear 0 end
 932     .l selection set end
 933     .l selection includes end
 934 } -result 1
 935 test listbox-3.107 {ListboxWidgetCmd procedure, "selection" option} -body {
 936     .l selection set 0 end
 937     .l selection includes 44
 938 } -result 0
 939 test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} -setup {
 940     destroy .l2
 941 } -body {
 942     listbox .l2
 943     .l2 selection includes 0
 944 } -cleanup {
 945     destroy .l2
 946 } -result 0
 947 test listbox-3.109 {ListboxWidgetCmd procedure, "selection" option} -body {
 948     .l selection clear 0 end
 949     .l selection set 2
 950     .l selection set 5 7
 951     .l curselection
 952 } -result {2 5 6 7}
 953 test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} -body {
 954     .l selection clear 0 end
 955     .l selection set 2
 956     .l selection set 5 7
 957     .l selection set 5 7
 958     .l curselection
 959 } -result {2 5 6 7}
 960 test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} -body {
 961     .l selection badOption 0 0
 962 } -returnCodes error -result {bad option "badOption": must be anchor, clear, includes, or set}
 963 test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} -body {
 964     .l size a
 965 } -returnCodes error -result {wrong # args: should be ".l size"}
 966 test listbox-3.113 {ListboxWidgetCmd procedure, "size" option} -body {
 967     .l size
 968 } -result 18
 969 test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} -setup {
 970     destroy .l2
 971 } -body {
 972     listbox .l2
 973     update
 974     format {%.6g %.6g} {*}[.l2 xview]
 975 } -cleanup {
 976     destroy .l2
 977 } -result {0 1}
 978 test listbox-3.115 {ListboxWidgetCmd procedure, "xview" option} -setup {
 979     destroy .l2
 980 } -body {
 981     listbox .l2 -width 10 -height 5 -font $fixed
 982     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
 983     pack .l2
 984     update
 985     format {%.6g %.6g} {*}[.l2 xview]
 986 } -cleanup {
 987     destroy .l2
 988 } -result {0 1}
 989
 990 test listbox-3.116 {ListboxWidgetCmd procedure, "xview" option} -constraints {
 991         fonts
 992 } -setup {
 993     destroy .l2
 994     listbox .l2 -width 10 -height 5 -font $fixed
 995     pack .l2
 996     update
 997 } -body {
 998     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
 999     .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789"
1000     .l2 xview 4
1001     format {%.6g %.6g} {*}[.l2 xview]
1002 } -cleanup {
1003     destroy .l2
1004 } -result {0.08 0.28}
1005 test listbox-3.117 {ListboxWidgetCmd procedure, "xview" option} -body {
1006     .l xview foo
1007 } -returnCodes error -result {expected integer but got "foo"}
1008 test listbox-3.118 {ListboxWidgetCmd procedure, "xview" option} -body {
1009     .l xview zoom a b
1010 } -returnCodes error -result {unknown option "zoom": must be moveto or scroll}
1011 test listbox-3.119 {ListboxWidgetCmd procedure, "xview" option} -constraints {
1012         fonts
1013 } -setup {
1014     destroy .l2
1015     listbox .l2 -width 10 -height 5 -font $fixed
1016     pack .l2
1017     update
1018 } -body {
1019     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
1020     .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789"
1021     .l xview 0
1022     .l2 xview moveto .4
1023     update
1024     format {%.6g %.6g} {*}[.l2 xview]
1025 } -cleanup {
1026     destroy .l2
1027 } -result {0.4 0.6}
1028 test listbox-3.120 {ListboxWidgetCmd procedure, "xview" option} -constraints {
1029         fonts
1030 } -setup {
1031     destroy .l2
1032     listbox .l2 -width 10 -height 5 -font $fixed
1033     pack .l2
1034     update
1035 } -body {
1036     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
1037     .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789"
1038     .l2 xview 0
1039     .l2 xview scroll 2 units
1040     update
1041     format {%.6g %.6g} {*}[.l2 xview]
1042 } -cleanup {
1043     destroy .l2
1044 } -result {0.04 0.24}
1045 test listbox-3.121 {ListboxWidgetCmd procedure, "xview" option} -constraints {
1046         fonts
1047 } -setup {
1048     destroy .l2
1049     listbox .l2 -width 10 -height 5 -font $fixed
1050     pack .l2
1051     update
1052 } -body {
1053     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
1054     .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789"
1055     .l2 xview 30
1056     .l2 xview scroll -1 pages
1057     update
1058     format {%.6g %.6g} {*}[.l2 xview]
1059 } -cleanup {
1060     destroy .l2
1061 } -result {0.44 0.64}
1062 test listbox-3.122 {ListboxWidgetCmd procedure, "xview" option} -constraints {
1063         fonts
1064 } -setup {
1065     destroy .l2
1066     listbox .l2 -width 10 -height 5 -font $fixed
1067     pack .l2
1068     update
1069 } -body {
1070     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
1071     .l2 insert 1 "0123456789a123456789b123456789c123456789d123456789"
1072     .l2 configure -width 1
1073     update
1074     .l2 xview 30
1075     .l2 xview scroll -4 pages
1076     update
1077     format {%.6g %.6g} {*}[.l2 xview]
1078 } -cleanup {
1079     destroy .l2
1080 } -result {0.52 0.54}
1081 test listbox-3.123 {ListboxWidgetCmd procedure, "yview" option} -setup {
1082     destroy .l2
1083 } -body {
1084     listbox .l2
1085     pack  .l2
1086     update
1087     format {%.6g %.6g} {*}[.l2 yview]
1088 } -cleanup {
1089     destroy .l2
1090 } -result {0 1}
1091 test listbox-3.124 {ListboxWidgetCmd procedure, "yview" option} -setup {
1092     destroy .l2
1093 } -body {
1094     listbox .l2
1095     .l2 insert 0 el1
1096     pack  .l2
1097     update
1098     format {%.6g %.6g} {*}[.l2 yview]
1099 } -cleanup {
1100     destroy .l2
1101 } -result {0 1}
1102
1103 test listbox-3.125 {ListboxWidgetCmd procedure, "yview" option} -setup {
1104     destroy .l2
1105     listbox .l2 -width 10 -height 5 -font $fixed
1106     pack .l2
1107     update
1108 } -body {
1109     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
1110     .l2 yview 4
1111     update
1112     format {%.6g %.6g} {*}[.l2 yview]
1113 } -cleanup {
1114     destroy .l2
1115 } -result {0.2 0.45}
1116 test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last line} -setup {
1117     destroy .l
1118     listbox .l -width 10 -height 5 -font $fixed
1119     pack .l
1120     update
1121 } -body {
1122     .l insert 0 a b c d e f g h i j k l m n o p q r s t
1123     mkPartial
1124     format {%.6g %.6g} {*}[.partial.l yview]
1125 } -cleanup {
1126     destroy .l
1127 } -result {0 0.266667}
1128
1129 # Listbox used in 3.127 -3.137 tests
1130 destroy .l
1131 listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2
1132 pack .l
1133 .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \
1134         el15 el16 el17
1135 update
1136 test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} -body {
1137     .l yview foo
1138 } -returnCodes error -result {bad listbox index "foo": must be active, anchor, end, @x,y, or a number}
1139 test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} -body {
1140     .l yview foo a b
1141 } -returnCodes error -result {unknown option "foo": must be moveto or scroll}
1142 test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} -setup {
1143     destroy .l2
1144     listbox .l2 -width 10 -height 5 -font $fixed
1145     pack .l2
1146     update
1147 } -body {
1148     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
1149     .l2 yview 0
1150     .l2 yview moveto .31
1151     format {%.6g %.6g} {*}[.l2 yview]
1152 } -cleanup {
1153     destroy .l2
1154 } -result {0.3 0.55}
1155 test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} -setup {
1156     destroy .l2
1157     listbox .l2 -width 10 -height 5 -font $fixed
1158     pack .l2
1159     update
1160 } -body {
1161     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
1162     .l2 yview 2
1163     .l2 yview scroll 2 pages
1164     format {%.6g %.6g} {*}[.l2 yview]
1165 } -cleanup {
1166     destroy .l2
1167 } -result {0.4 0.65}
1168 test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} -setup {
1169     destroy .l2
1170     listbox .l2 -width 10 -height 5 -font $fixed
1171     pack .l2
1172     update
1173 } -body {
1174     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
1175     .l2 yview 10
1176     .l2 yview scroll -3 units
1177     format {%.6g %.6g} {*}[.l2 yview]
1178 } -cleanup {
1179     destroy .l2
1180 } -result {0.35 0.6}
1181 test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} -setup {
1182     destroy .l2
1183     listbox .l2 -width 10 -height 5 -font $fixed
1184     pack .l2
1185     update
1186 } -body {
1187     .l2 insert 0 a b c d e f g h i j k l m n o p q r s t
1188     .l2 configure -height 2
1189     update
1190     .l2 yview 15
1191     .l2 yview scroll -4 pages
1192     format {%.6g %.6g} {*}[.l2 yview]
1193 } -cleanup {
1194     destroy .l2
1195 } -result {0.55 0.65}
1196 test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} -body {
1197     .l whoknows
1198 } -returnCodes error -result {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}
1199 test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} -body {
1200     .l c
1201 } -returnCodes error -result {ambiguous option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}
1202 test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} -body {
1203     .l in
1204 } -returnCodes error -result {ambiguous option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}
1205 test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} -body {
1206     .l s
1207 } -returnCodes error -result {ambiguous option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}
1208 test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} -body {
1209     .l se
1210 } -returnCodes error -result {ambiguous option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, itemcget, itemconfigure, nearest, scan, see, selection, size, xview, or yview}
1211
1212 # No tests for DestroyListbox:  I can't come up with anything to test
1213 # in this procedure.
1214
1215
1216 test listbox-4.1 {ConfigureListbox procedure} -constraints {
1217         fonts
1218 } -setup {
1219     deleteWindows
1220     destroy .l
1221     listbox .l -setgrid 1 -width 25 -height 15
1222     pack .l
1223     update
1224 } -body {
1225     update
1226     set x [getsize .]
1227     .l configure -setgrid 0
1228     update
1229     list $x [getsize .]
1230 } -cleanup {
1231     deleteWindows
1232 } -result {25x15 185x263}
1233 resetGridInfo
1234 test listbox-4.2 {ConfigureListbox procedure} -setup {
1235     deleteWindows
1236     destroy .l
1237     listbox .l -setgrid 1 -width 25 -height 15
1238     pack .l
1239     update
1240 } -body {
1241     .l configure -highlightthickness -3
1242     .l cget -highlightthickness
1243 } -cleanup {
1244     deleteWindows
1245 } -result 0
1246 test listbox-4.3 {ConfigureListbox procedure} -setup {
1247     deleteWindows
1248     destroy .l
1249     listbox .l -setgrid 1 -width 25 -height 15
1250     pack .l
1251     update
1252 } -body {
1253     .l configure -exportselection 0
1254     .l delete 0 end
1255     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
1256     .l selection set 3 5
1257     .l configure -exportselection 1
1258     selection get
1259 } -cleanup {
1260     deleteWindows
1261 } -result {el3
1262 el4
1263 el5}
1264 test listbox-4.4 {ConfigureListbox procedure} -setup {
1265     deleteWindows
1266     listbox .l -setgrid 1 -width 25 -height 15
1267     pack .l
1268     update
1269 } -body {
1270     entry .e
1271     .e insert 0 abc
1272     .e select from 0
1273     .e select to 2
1274     .l configure -exportselection 0
1275     .l delete 0 end
1276     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
1277     .l selection set 3 5
1278     .l selection clear 3 5
1279     .l configure -exportselection 1
1280     list [selection own] [selection get]
1281 } -cleanup {
1282     deleteWindows
1283 } -result {.e ab}
1284 test listbox-4.5 {-exportselection option} -setup {
1285     deleteWindows
1286     listbox .l -setgrid 1 -width 25 -height 15
1287     pack .l
1288     update
1289 } -body {
1290     selection clear .
1291     .l configure -exportselection 1
1292     .l delete 0 end
1293     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
1294     .l selection set 1 1
1295     set x {}
1296     lappend x [catch {selection get} msg] $msg [.l curselection]
1297     .l config -exportselection 0
1298     lappend x [catch {selection get} msg] $msg [.l curselection]
1299     .l selection clear 0 end
1300     lappend x [catch {selection get} msg] $msg [.l curselection]
1301     .l selection set 1 3
1302     lappend x [catch {selection get} msg] $msg [.l curselection]
1303     .l config -exportselection 1
1304     lappend x [catch {selection get} msg] $msg [.l curselection]
1305 } -cleanup {
1306     deleteWindows
1307 } -result {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
1308 el2
1309 el3} {1 2 3}}
1310 test listbox-4.6 {ConfigureListbox procedure} -constraints {
1311         fonts
1312 } -setup {
1313     deleteWindows
1314 } -body {
1315
1316     # The following code (reset geometry, withdraw, etc.) is necessary
1317     # to reset the state of some window managers like olvwm under
1318     # SunOS 4.1.3.
1319
1320     wm geom . 300x300
1321     update
1322     wm geom . {}
1323     wm withdraw .
1324     listbox .l2 -font $fixed -width 15 -height 20
1325     pack .l2
1326     update
1327     wm deiconify .
1328     set x [getsize .]
1329     .l2 configure -setgrid 1
1330     update
1331     list $x [getsize .]
1332 } -cleanup {
1333     deleteWindows
1334 } -result {115x328 15x20}
1335 test listbox-4.7 {ConfigureListbox procedure} -setup {
1336     deleteWindows
1337 } -body {
1338     wm withdraw .
1339     listbox .l2 -font $fixed -width 30 -height 20 -setgrid 1
1340     wm geom . +25+25
1341     pack .l2
1342     update
1343     wm deiconify .
1344     set result [getsize .]
1345     wm geom . 26x15
1346     update
1347     lappend result [getsize .]
1348     .l2 configure -setgrid 1
1349     update
1350     lappend result [getsize .]
1351 } -cleanup {
1352     deleteWindows
1353     wm geom . {}
1354 } -result {30x20 26x15 26x15}
1355
1356 resetGridInfo
1357 test listbox-4.8 {ConfigureListbox procedure} -setup {
1358     destroy .l2
1359 } -body {
1360     listbox .l2 -width 15 -height 20 -xscrollcommand "record x" \
1361             -yscrollcommand "record y"
1362     pack .l2
1363     update
1364     .l2 configure -fg black
1365     set log {}
1366     update
1367     set log
1368 } -cleanup {
1369     destroy .l2
1370 } -result {{y 0 1} {x 0 1}}
1371 test listbox-4.9 {ConfigureListbox procedure, -listvar} -setup {
1372     destroy .l2
1373 } -body {
1374     set x [list a b c d]
1375     listbox .l2 -listvar x
1376     .l2 get 0 end
1377 } -cleanup {
1378     destroy .l2
1379 } -result [list a b c d]
1380 test listbox-4.10 {ConfigureListbox, no listvar -> existing listvar} -setup {
1381     destroy .l2
1382 } -body {
1383     set x [list a b c d]
1384     listbox .l2
1385     .l2 insert end 1 2 3 4
1386     .l2 configure -listvar x
1387     .l2 get 0 end
1388 } -cleanup {
1389     destroy .l2
1390 } -result [list a b c d]
1391 test listbox-4.11 {ConfigureListbox procedure, listvar -> no listvar} -setup {
1392     destroy .l2
1393 } -body {
1394     set x [list a b c d]
1395     listbox .l2 -listvar x
1396     .l2 configure -listvar {}
1397     .l2 insert end 1 2 3 4
1398     list $x [.l2 get 0 end]
1399 } -cleanup {
1400     destroy .l2
1401 } -result [list [list a b c d] [list a b c d 1 2 3 4]]
1402 test listbox-4.12 {ConfigureListbox procedure, listvar -> different listvar} -setup {
1403     destroy .l2
1404 } -body {
1405     set x [list a b c d]
1406     set y [list 1 2 3 4]
1407     listbox .l2
1408     .l2 configure -listvar x
1409     .l2 configure -listvar y
1410     .l2 insert end 5 6 7 8
1411     list $x $y
1412 } -cleanup {
1413     destroy .l2
1414 } -result [list [list a b c d] [list 1 2 3 4 5 6 7 8]]
1415 test listbox-4.13 {ConfigureListbox, no listvar -> non-existant listvar} -setup {
1416     destroy .l2
1417 } -body {
1418     catch {unset x}
1419     listbox .l2
1420     .l2 insert end a b c d
1421     .l2 configure -listvar x
1422     set x
1423 } -cleanup {
1424     destroy .l2
1425 } -result [list a b c d]
1426 test listbox-4.14 {ConfigureListbox, non-existant listvar} -setup {
1427     destroy .l2
1428 } -body {
1429     catch {unset x}
1430     listbox .l2 -listvar x
1431     list [info exists x] $x
1432 } -cleanup {
1433     destroy .l2
1434 } -result [list 1 {}]
1435 test listbox-4.15 {ConfigureListbox, listvar -> non-existant listvar} -setup {
1436     destroy .l2
1437 } -body {
1438     catch {unset y}
1439     set x [list a b c d]
1440     listbox .l2 -listvar x
1441     .l2 configure -listvar y
1442     list [info exists y] $y
1443 } -cleanup {
1444     destroy .l2
1445 } -result [list 1 [list a b c d]]
1446 test listbox-4.16 {ConfigureListbox, listvar -> same listvar} -setup {
1447     destroy .l2
1448 } -body {
1449     set x [list a b c d]
1450     listbox .l2 -listvar x
1451     .l2 configure -listvar x
1452     set x
1453 } -cleanup {
1454     destroy .l2
1455 } -result [list a b c d]
1456 test listbox-4.17 {ConfigureListbox, no listvar -> no listvar} -setup {
1457     destroy .l2
1458 } -body {
1459     listbox .l2
1460     .l2 insert end a b c d
1461     .l2 configure -listvar {}
1462     .l2 get 0 end
1463 } -cleanup {
1464     destroy .l2
1465 } -result [list a b c d]
1466 test listbox-4.18 {ConfigureListbox, no listvar -> bad listvar} -setup {
1467     destroy .l2
1468 } -body {
1469     listbox .l2
1470     .l2 insert end a b c d
1471     set x "this is a \" bad list"
1472     catch {.l2 configure -listvar x} result
1473     list [.l2 get 0 end] [.l2 cget -listvar] $result
1474 } -cleanup {
1475     destroy .l2
1476 } -result [list [list a b c d] {} \
1477         "unmatched open quote in list: invalid -listvariable value"]
1478 test listbox-4.19 {ConfigureListbox, no listvar -> bad non-existent listvar} -setup {
1479     destroy .l2
1480 } -body {
1481     unset -nocomplain ::foo
1482     listbox .l2 -listvar foo
1483     .l2 insert end a b c d
1484     catch {.l2 configure -listvar ::zoo::bar::foo} result
1485     list [.l2 get 0 end] [.l2 cget -listvar] $foo $result
1486 } -cleanup {
1487     destroy .l2
1488 } -result [list [list a b c d] foo [list a b c d] \
1489         {can't set "::zoo::bar::foo": parent namespace doesn't exist}]
1490
1491
1492 # No tests for DisplayListbox:  I don't know how to test this procedure.
1493
1494 test listbox-5.1 {ListboxComputeGeometry procedure} -constraints {
1495         fonts
1496 } -setup {
1497     destroy .l
1498 } -body {
1499     listbox .l -font $fixed -width 15 -height 20
1500     pack .l
1501     list [winfo reqwidth .l] [winfo reqheight .l]
1502 } -result {115 328}
1503 test listbox-5.2 {ListboxComputeGeometry procedure} -constraints {
1504         fonts
1505 } -setup {
1506     destroy .l
1507 } -body {
1508     listbox .l -font $fixed -width 0 -height 10
1509     pack .l
1510     update
1511     list [winfo reqwidth .l] [winfo reqheight .l]
1512 } -result {17 168}
1513 test listbox-5.3 {ListboxComputeGeometry procedure} -constraints {
1514         fonts
1515 } -setup {
1516     destroy .l
1517 } -body {
1518     listbox .l -font $fixed -width 0 -height 10 -bd 3
1519     .l insert 0 Short "Really much longer" Longer
1520     pack .l
1521     update
1522     list [winfo reqwidth .l] [winfo reqheight .l]
1523 } -result {138 170}
1524 test listbox-5.4 {ListboxComputeGeometry procedure} -constraints {
1525         fonts
1526 } -setup {
1527     destroy .l
1528 } -body {
1529     listbox .l -font $fixed -width 10 -height 0
1530     pack .l
1531     update
1532     list [winfo reqwidth .l] [winfo reqheight .l]
1533 } -result {80 24}
1534 test listbox-5.5 {ListboxComputeGeometry procedure} -constraints {
1535         fonts
1536 } -setup {
1537     destroy .l
1538 } -body {
1539     listbox .l -font $fixed -width 10 -height 0 -highlightthickness 0
1540     .l insert 0 Short "Really much longer" Longer
1541     pack .l
1542     update
1543     list [winfo reqwidth .l] [winfo reqheight .l]
1544 } -result {76 52}
1545 test listbox-5.6 {ListboxComputeGeometry procedure} -setup {
1546     destroy .l
1547 } -body {
1548     # If "0" in selected font had 0 width, caused divide-by-zero error.
1549
1550     pack [listbox .l -font {{open look glyph}}]
1551     update
1552 } -cleanup {
1553     destroy .l
1554 } -result {}
1555
1556
1557 # Listbox used in 6.*, 7.* tests
1558 destroy .l
1559 listbox .l -height 2 -xscrollcommand "record x" -yscrollcommand "record y"
1560 pack .l
1561 update
1562 test listbox-6.1 {InsertEls procedure} -body {
1563     .l delete 0 end
1564     .l insert end a b c d
1565     .l insert 5 x y z
1566     .l insert 2 A
1567     .l insert 0 q r s
1568     .l get 0 end
1569 } -result {q r s a b A c d x y z}
1570 test listbox-6.2 {InsertEls procedure} -body {
1571     .l delete 0 end
1572     .l insert 0 a b c d e f g h i j
1573     .l selection anchor 2
1574     .l insert 2 A B
1575     .l index anchor
1576 } -result 4
1577 test listbox-6.3 {InsertEls procedure} -body {
1578     .l delete 0 end
1579     .l insert 0 a b c d e f g h i j
1580     .l selection anchor 2
1581     .l insert 3 A B
1582     .l index anchor
1583 } -result 2
1584 test listbox-6.4 {InsertEls procedure} -body {
1585     .l delete 0 end
1586     .l insert 0 a b c d e f g h i j
1587     .l yview 3
1588     update
1589     .l insert 2 A B
1590     .l index @0,0
1591 } -result 5
1592 test listbox-6.5 {InsertEls procedure} -body {
1593     .l delete 0 end
1594     .l insert 0 a b c d e f g h i j
1595     .l yview 3
1596     update
1597     .l insert 3 A B
1598     .l index @0,0
1599 } -result 3
1600 test listbox-6.6 {InsertEls procedure} -body {
1601     .l delete 0 end
1602     .l insert 0 a b c d e f g h i j
1603     .l activate 5
1604     .l insert 5 A B
1605     .l index active
1606 } -result 7
1607 test listbox-6.7 {InsertEls procedure} -body {
1608     .l delete 0 end
1609     .l insert 0 a b c d e f g h i j
1610     .l activate 5
1611     .l insert 6 A B
1612     .l index active
1613 } -result 5
1614 test listbox-6.8 {InsertEls procedure} -body {
1615     .l delete 0 end
1616     .l insert 0 a b c
1617     .l index active
1618 } -result 2
1619 test listbox-6.9 {InsertEls procedure} -body {
1620     .l delete 0 end
1621     .l insert 0
1622     .l index active
1623 } -result 0
1624 test listbox-6.10 {InsertEls procedure} -body {
1625     .l delete 0 end
1626     .l insert 0 a b "two words"  c d e f g h i j
1627     update
1628     set log {}
1629     .l insert 0 word
1630     update
1631     set log
1632 } -result {{y 0 0.166667}}
1633 test listbox-6.11 {InsertEls procedure} -body {
1634     .l delete 0 end
1635     .l insert 0 a b "two words"  c d e f g h i j
1636     update
1637     set log {}
1638     .l insert 0 "much longer entry"
1639     update
1640     set log
1641 } -result {{y 0 0.166667} {x 0 1}}
1642 test listbox-6.12 {InsertEls procedure} -constraints {
1643         fonts
1644 } -setup {
1645     destroy .l2
1646 } -body {
1647     listbox .l2 -width 0 -height 0
1648     pack .l2 -side top
1649     .l2 insert 0 a b "two words"  c d
1650     set x {}
1651     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
1652     .l2 insert 0 "much longer entry"
1653     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
1654 } -cleanup {
1655     destroy .l2
1656 } -result {80 93 122 110}
1657 test listbox-6.13 {InsertEls procedure, check -listvar update} -setup {
1658     destroy .l2
1659 } -body {
1660     set x [list a b c d]
1661     listbox .l2 -listvar x
1662     .l2 insert 0 1 2 3 4
1663     set x
1664 } -cleanup {
1665     destroy .l2
1666 } -result [list 1 2 3 4 a b c d]
1667 test listbox-6.14 {InsertEls procedure, check selection update} -setup {
1668     destroy .l2
1669 } -body {
1670     listbox .l2
1671     .l2 insert 0 0 1 2 3 4
1672     .l2 selection set 2 4
1673     .l2 insert 0 a
1674     .l2 curselection
1675 } -cleanup {
1676     destroy .l2
1677 } -result [list 3 4 5]
1678 test listbox-6.15 {InsertEls procedure, lost namespaced listvar} -body {
1679     destroy .l2
1680     namespace eval test { variable foo {a b} }
1681     listbox .l2 -listvar ::test::foo
1682     namespace delete test
1683     .l2 insert end c d
1684     .l2 delete end
1685     .l2 insert end e f
1686     catch {set ::test::foo} result
1687     list [.l2 get 0 end] [.l2 cget -listvar] $result
1688 } -cleanup {
1689     destroy .l2
1690 } -result [list [list a b c e f] ::test::foo \
1691         {can't read "::test::foo": no such variable}]
1692
1693
1694 test listbox-7.1 {DeleteEls procedure} -body {
1695     .l delete 0 end
1696     .l insert 0 a b c d e f g h i j
1697     .l selection set 1 6
1698     .l delete 4 3
1699     list [.l size] [selection get]
1700 } -result {10 {b
1701 c
1702 d
1703 e
1704 f
1705 g}}
1706 test listbox-7.2 {DeleteEls procedure} -body {
1707     .l delete 0 end
1708     .l insert 0 a b c d e f g h i j
1709     .l selection set 3 6
1710     .l delete 4 4
1711     list [.l size] [.l get 4] [.l curselection]
1712 } -result {9 f {3 4 5}}
1713 test listbox-7.3 {DeleteEls procedure} -body {
1714     .l delete 0 end
1715     .l insert 0 a b c d e f g h i j
1716     .l delete 0 3
1717     list [.l size] [.l get 0] [.l get 1]
1718 } -result {6 e f}
1719 test listbox-7.4 {DeleteEls procedure} -body {
1720     .l delete 0 end
1721     .l insert 0 a b c d e f g h i j
1722     .l delete 8 1000
1723     list [.l size] [.l get 7]
1724 } -result {8 h}
1725 test listbox-7.5 {DeleteEls procedure} -body {
1726     .l delete 0 end
1727     .l insert 0 a b c d e f g h i j
1728     .l selection anchor 2
1729     .l delete 0 1
1730     .l index anchor
1731 } -result 0
1732 test listbox-7.6 {DeleteEls procedure} -body {
1733     .l delete 0 end
1734     .l insert 0 a b c d e f g h i j
1735     .l selection anchor 2
1736     .l delete 2
1737     .l index anchor
1738 } -result 2
1739 test listbox-7.7 {DeleteEls procedure} -body {
1740     .l delete 0 end
1741     .l insert 0 a b c d e f g h i j
1742     .l selection anchor 4
1743     .l delete 2 5
1744     .l index anchor
1745 } -result 2
1746 test listbox-7.8 {DeleteEls procedure} -body {
1747     .l delete 0 end
1748     .l insert 0 a b c d e f g h i j
1749     .l selection anchor 3
1750     .l delete 4 5
1751     .l index anchor
1752 } -result 3
1753 test listbox-7.9 {DeleteEls procedure} -body {
1754     .l delete 0 end
1755     .l insert 0 a b c d e f g h i j
1756     .l yview 3
1757     update
1758     .l delete 1 2
1759     .l index @0,0
1760 } -result 1
1761 test listbox-7.10 {DeleteEls procedure} -body {
1762     .l delete 0 end
1763     .l insert 0 a b c d e f g h i j
1764     .l yview 3
1765     update
1766     .l delete 3 4
1767     .l index @0,0
1768 } -result 3
1769 test listbox-7.11 {DeleteEls procedure} -body {
1770     .l delete 0 end
1771     .l insert 0 a b c d e f g h i j
1772     .l yview 3
1773     update
1774     .l delete 4 6
1775     .l index @0,0
1776 } -result 3
1777 test listbox-7.12 {DeleteEls procedure} -body {
1778     .l delete 0 end
1779     .l insert 0 a b c d e f g h i j
1780     .l yview 3
1781     update
1782     .l delete 3 end
1783     .l index @0,0
1784 } -result 1
1785 test listbox-7.13 {DeleteEls procedure, updating view with partial last line} -body {
1786     mkPartial
1787     .partial.l yview 8
1788     update
1789     .partial.l delete 10 13
1790     .partial.l index @0,0
1791 } -result 7
1792 test listbox-7.14 {DeleteEls procedure} -body {
1793     .l delete 0 end
1794     .l insert 0 a b c d e f g h i j
1795     .l activate 6
1796     .l delete 3 4
1797     .l index active
1798 } -result 4
1799 test listbox-7.15 {DeleteEls procedure} -body {
1800     .l delete 0 end
1801     .l insert 0 a b c d e f g h i j
1802     .l activate 6
1803     .l delete 5 7
1804     .l index active
1805 } -result 5
1806 test listbox-7.16 {DeleteEls procedure} -body {
1807     .l delete 0 end
1808     .l insert 0 a b c d e f g h i j
1809     .l activate 6
1810     .l delete 5 end
1811     .l index active
1812 } -result 4
1813 test listbox-7.17 {DeleteEls procedure} -body {
1814     .l delete 0 end
1815     .l insert 0 a b c d e f g h i j
1816     .l activate 6
1817     .l delete 0 end
1818     .l index active
1819 } -result 0
1820 test listbox-7.18 {DeleteEls procedure} -body {
1821     .l delete 0 end
1822     .l insert 0 a b c "two words" d e f g h i j
1823     update
1824     set log {}
1825     .l delete 4 6
1826     update
1827     set log
1828 } -result {{y 0 0.25}}
1829 test listbox-7.19 {DeleteEls procedure} -body {
1830     .l delete 0 end
1831     .l insert 0 a b c "two words" d e f g h i j
1832     update
1833     set log {}
1834     .l delete 3
1835     update
1836     set log
1837 } -result {{y 0 0.2} {x 0 1}}
1838 test listbox-7.20 {DeleteEls procedure} -constraints {
1839         fonts
1840 } -setup {
1841     destroy .l2
1842 } -body {
1843     listbox .l2 -width 0 -height 0
1844     pack .l2 -side top
1845     .l2 insert 0 a b "two words" c d e f g
1846     set x {}
1847     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
1848     .l2 delete 2 4
1849     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
1850 } -result {80 144 17 93}
1851 test listbox-7.21 {DeleteEls procedure, check -listvar update} -setup {
1852     destroy .l2
1853 } -body {
1854     set x [list a b c d]
1855     listbox .l2 -listvar x
1856     .l2 delete 0 1
1857     set x
1858 } -result [list c d]
1859
1860
1861 test listbox-8.1 {ListboxEventProc procedure} -constraints {
1862         fonts
1863 } -setup {
1864     destroy .l
1865 } -body {
1866     listbox .l -setgrid 1
1867     pack .l
1868     update
1869     set x [getsize .]
1870     destroy .l
1871     list $x [getsize .] [winfo exists .l] [info command .l]
1872 } -cleanup {
1873     destroy .l
1874 } -result {20x10 150x178 0 {}}
1875 resetGridInfo
1876 test listbox-8.2 {ListboxEventProc procedure} -constraints {
1877         fonts
1878 } -setup {
1879     destroy .l
1880 } -body {
1881     listbox .l -height 5 -width 10
1882     .l insert 0 a b c "A string that is very very long" d e f g h i j k
1883     pack .l
1884     update
1885     place .l -width 50 -height 80
1886     update
1887     list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]
1888 } -cleanup {
1889     destroy .l
1890 } -result {{0 0.222222} {0 0.333333}}
1891 test listbox-8.3 {ListboxEventProc procedure} -setup {
1892     deleteWindows
1893 } -body {
1894     listbox .l1 -bg #543210
1895     rename .l1 .l2
1896     set x {}
1897     lappend x [winfo children .]
1898     lappend x [.l2 cget -bg]
1899     destroy .l1
1900     lappend x [info command .l*] [winfo children .]
1901 } -cleanup {
1902     deleteWindows
1903 } -result {.l1 #543210 {} {}}
1904
1905
1906 test listbox-9.1 {ListboxCmdDeletedProc procedure} -setup {
1907     deleteWindows
1908 } -body {
1909     listbox .l1
1910     rename .l1 {}
1911     list [info command .l*] [winfo children .]
1912 } -cleanup {
1913     deleteWindows
1914 } -result {{} {}}
1915 test listbox-9.2 {ListboxCmdDeletedProc procedure, disabling -setgrid} -constraints {
1916         fonts
1917 } -setup {
1918     destroy .top
1919 } -body {
1920     toplevel .top
1921     wm geom .top +0+0
1922     listbox .top.l -setgrid 1 -width 20 -height 10
1923     pack .top.l
1924     update
1925     set x [getsize .top]
1926     rename .top.l {}
1927     update
1928     lappend x [getsize .top]
1929 } -cleanup {
1930     destroy .top
1931 } -result {20x10 150x178}
1932
1933
1934 # Listbox used in 10.* tests
1935 destroy .l
1936 test listbox-10.1 {GetListboxIndex procedure} -setup {
1937     destroy .l
1938 } -body {
1939     pack [listbox .l]
1940     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
1941     .l activate 3
1942     update
1943     list [.l activate 3; .l index active] [.l activate 6; .l index active]
1944 } -cleanup {
1945     destroy .l
1946 } -result {3 6}
1947 test listbox-10.2 {GetListboxIndex procedure} -setup {
1948     destroy .l
1949 } -body {
1950     pack [listbox .l]
1951     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
1952     .l selection anchor 2
1953     update
1954     .l index anchor
1955 } -cleanup {
1956     destroy .l
1957 } -result 2
1958 test listbox-10.3 {GetListboxIndex procedure} -setup {
1959     destroy .l
1960 } -body {
1961     pack [listbox .l]
1962     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
1963     .l insert end A B C D E
1964     .l selection anchor end
1965     update
1966     .l delete 12 end
1967     list [.l index anchor] [.l index end]
1968 } -cleanup {
1969     destroy .l
1970 } -result {12 12}
1971 test listbox-10.4 {GetListboxIndex procedure} -setup {
1972     destroy .l
1973 } -body {
1974     pack [listbox .l]
1975     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
1976     update
1977     .l index a
1978 } -cleanup {
1979     destroy .l
1980 } -returnCodes error -result {bad listbox index "a": must be active, anchor, end, @x,y, or a number}
1981 test listbox-10.5 {GetListboxIndex procedure} -setup {
1982     destroy .l
1983 } -body {
1984     pack [listbox .l]
1985     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
1986     update
1987     .l index end
1988 } -cleanup {
1989     destroy .l
1990 } -result 12
1991 test listbox-10.6 {GetListboxIndex procedure} -setup {
1992     destroy .l
1993 } -body {
1994     pack [listbox .l]
1995     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
1996     update
1997     .l get end
1998 } -cleanup {
1999     destroy .l
2000 } -result {el11}
2001 test listbox-10.7 {GetListboxIndex procedure} -setup {
2002     destroy .l
2003 } -body {
2004     pack [listbox .l]
2005     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2006     .l delete 0 end
2007     update
2008     .l index end
2009 } -cleanup {
2010     destroy .l
2011 } -result 0
2012 test listbox-10.8 {GetListboxIndex procedure} -setup {
2013     destroy .l
2014 } -body {
2015     pack [listbox .l]
2016     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2017     update
2018     .l index @
2019 } -cleanup {
2020     destroy .l
2021 } -returnCodes error -result {bad listbox index "@": must be active, anchor, end, @x,y, or a number}
2022 test listbox-10.9 {GetListboxIndex procedure} -setup {
2023     destroy .l
2024 } -body {
2025     pack [listbox .l]
2026     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2027     update
2028     .l index @foo
2029 } -cleanup {
2030     destroy .l
2031 } -returnCodes error -result {bad listbox index "@foo": must be active, anchor, end, @x,y, or a number}
2032 test listbox-10.10 {GetListboxIndex procedure} -setup {
2033     destroy .l
2034 } -body {
2035     pack [listbox .l]
2036     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2037     update
2038     .l index @1x3
2039 } -cleanup {
2040     destroy .l
2041 } -returnCodes error -result {bad listbox index "@1x3": must be active, anchor, end, @x,y, or a number}
2042 test listbox-10.11 {GetListboxIndex procedure} -setup {
2043     destroy .l
2044 } -body {
2045     pack [listbox .l]
2046     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2047     update
2048     .l index @1,
2049 } -cleanup {
2050     destroy .l
2051 } -returnCodes error -result {bad listbox index "@1,": must be active, anchor, end, @x,y, or a number}
2052 test listbox-10.12 {GetListboxIndex procedure} -setup {
2053     destroy .l
2054 } -body {
2055     pack [listbox .l]
2056     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2057     update
2058     .l index @1,foo
2059 } -cleanup {
2060     destroy .l
2061 } -returnCodes error -result {bad listbox index "@1,foo": must be active, anchor, end, @x,y, or a number}
2062 test listbox-10.13 {GetListboxIndex procedure} -setup {
2063     destroy .l
2064 } -body {
2065     pack [listbox .l]
2066     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2067     update
2068     .l index @1,2x
2069 } -cleanup {
2070     destroy .l
2071 } -returnCodes error -result {bad listbox index "@1,2x": must be active, anchor, end, @x,y, or a number}
2072 test listbox-10.14 {GetListboxIndex procedure} -constraints {
2073     fonts
2074 } -setup {
2075     destroy .l
2076 } -body {
2077     pack [listbox .l]
2078     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2079     update
2080     list [.l index @5,57] [.l index @5,58]
2081 } -cleanup {
2082     .l delete 0 end
2083 } -cleanup {
2084     destroy .l
2085 } -result {3 3}
2086 test listbox-10.15 {GetListboxIndex procedure} -setup {
2087     destroy .l
2088 } -body {
2089     pack [listbox .l]
2090     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2091     update
2092     .l index 1xy
2093 } -cleanup {
2094     destroy .l
2095 } -returnCodes error -result {bad listbox index "1xy": must be active, anchor, end, @x,y, or a number}
2096 test listbox-10.16 {GetListboxIndex procedure} -setup {
2097     destroy .l
2098 } -body {
2099     pack [listbox .l]
2100     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2101     update
2102     .l index 3
2103 } -cleanup {
2104     destroy .l
2105 } -result 3
2106 test listbox-10.17 {GetListboxIndex procedure} -setup {
2107     destroy .l
2108 } -body {
2109     pack [listbox .l]
2110     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2111     update
2112     .l index 20
2113 } -cleanup {
2114     destroy .l
2115 } -result 20
2116 test listbox-10.18 {GetListboxIndex procedure} -setup {
2117     destroy .l
2118 } -body {
2119     pack [listbox .l]
2120     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2121     update
2122     .l get 20
2123 } -cleanup {
2124     destroy .l
2125 } -result {}
2126 test listbox-10.19 {GetListboxIndex procedure} -setup {
2127     destroy .l
2128 } -body {
2129     pack [listbox .l]
2130     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2131     update
2132     .l index -1
2133 } -cleanup {
2134     destroy .l
2135 } -result  -1
2136 test listbox-10.20 {GetListboxIndex procedure} -setup {
2137     destroy .l
2138 } -body {
2139     pack [listbox .l]
2140     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
2141     .l delete 0 end
2142     update
2143     .l index 1
2144 } -cleanup {
2145     destroy .l
2146 } -result 1
2147
2148
2149 test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} -setup {
2150     destroy .l
2151 } -body {
2152     listbox .l -height 5
2153     pack .l
2154     .l insert 0 a b c d e f g h i j
2155     .l yview 3
2156     update
2157     set x [.l index @0,0]
2158     .l yview -1
2159     update
2160     lappend x [.l index @0,0]
2161 } -cleanup {
2162     destroy .l
2163 } -result {3 0}
2164 test listbox-11.2 {ChangeListboxView procedure, boundary conditions for index} -setup {
2165     destroy .l
2166 } -body {
2167     listbox .l -height 5
2168     pack .l
2169     .l insert 0 a b c d e f g h i j
2170     .l yview 3
2171     update
2172     set x [.l index @0,0]
2173     .l yview 20
2174     update
2175     lappend x [.l index @0,0]
2176 } -cleanup {
2177     destroy .l
2178 } -result {3 5}
2179 test listbox-11.3 {ChangeListboxView procedure} -setup {
2180     destroy .l
2181 } -body {
2182     listbox .l -height 5 -yscrollcommand "record y"
2183     pack .l
2184     .l insert 0 a b c d e f g h i j
2185     update
2186     set log {}
2187     .l yview 2
2188     update
2189     list [format {%.6g %.6g} {*}[.l yview]] $log
2190 } -cleanup {
2191     destroy .l
2192 } -result {{0.2 0.7} {{y 0.2 0.7}}}
2193 test listbox-11.4 {ChangeListboxView procedure} -setup {
2194     destroy .l
2195 } -body {
2196     listbox .l -height 5 -yscrollcommand "record y"
2197     pack .l
2198     .l insert 0 a b c d e f g h i j
2199     update
2200     set log {}
2201     .l yview 8
2202     update
2203     list [format {%.6g %.6g} {*}[.l yview]] $log
2204 } -cleanup {
2205     destroy .l
2206 } -result {{0.5 1} {{y 0.5 1}}}
2207 test listbox-11.5 {ChangeListboxView procedure} -setup {
2208     destroy .l
2209 } -body {
2210     listbox .l -height 5 -yscrollcommand "record y"
2211     pack .l
2212     update
2213     .l insert 0 a b c d e f g h i j
2214     .l yview 3
2215     update
2216     set log {}
2217     .l yview 3
2218     update
2219     list [format {%.6g %.6g} {*}[.l yview]] $log
2220 } -cleanup {
2221     destroy .l
2222 } -result {{0.3 0.8} {}}
2223 test listbox-11.6 {ChangeListboxView procedure, partial last line} -body {
2224     mkPartial
2225     .partial.l yview 13
2226     .partial.l index @0,0
2227 } -cleanup {
2228     destroy .l
2229 } -result 11
2230
2231
2232 # Listbox used in 12.* tests
2233 destroy .l
2234 listbox .l -font $fixed -xscrollcommand "record x" -width 10
2235 .l insert 0 0123456789a123456789b123456789c123456789d123456789e123456789f123456789g123456789h123456789i123456789
2236 pack .l
2237 update
2238 test listbox-12.1 {ChangeListboxOffset procedure} -constraints {
2239         fonts
2240 } -body {
2241     set log {}
2242     .l xview 99
2243     update
2244     list [format {%.6g %.6g} {*}[.l xview]] $log
2245 } -result {{0.9 1} {{x 0.9 1}}}
2246 test listbox-12.2 {ChangeListboxOffset procedure} -constraints {
2247         fonts
2248 } -body {
2249     set log {}
2250     .l xview 99
2251     .l xview moveto -.25
2252     update
2253     list [format {%.6g %.6g} {*}[.l xview]] $log
2254 } -result {{0 0.1} {{x 0 0.1}}}
2255 test listbox-12.3 {ChangeListboxOffset procedure} -constraints {
2256         fonts
2257 } -body {
2258     .l xview 10
2259     update
2260     set log {}
2261     .l xview 10
2262     update
2263     list [format {%.6g %.6g} {*}[.l xview]] $log
2264 } -result {{0.1 0.2} {}}
2265
2266
2267 # Listbox used in 13.* tests
2268 destroy .l
2269 listbox .l -font $fixed -width 10 -height 5
2270 pack .l
2271 .l insert 0 a bb c d e f g h i j k l m n o p q r s
2272 .l insert 0 0123456789a123456789b123456789c123456789d123456789
2273 update
2274 set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]]
2275 set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]]
2276 test listbox-13.1 {ListboxScanTo procedure} -constraints {
2277         fonts
2278 } -body {
2279     .l yview 0
2280     .l xview 0
2281     .l scan mark 10 20
2282     .l scan dragto [expr 10-$width] [expr 20-$height]
2283     update
2284     list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]
2285 } -result {{0.2 0.4} {0.5 0.75}}
2286 test listbox-13.2 {ListboxScanTo procedure} -constraints {
2287         fonts
2288 } -body {
2289     .l yview 5
2290     .l xview 10
2291     .l scan mark 10 20
2292     .l scan dragto 20 40
2293     update
2294     set x [list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]]
2295     .l scan dragto [expr 20-$width] [expr 40-$height]
2296     update
2297     lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]
2298 } -result {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}}
2299 test listbox-13.3 {ListboxScanTo procedure} -constraints {
2300         fonts
2301 } -body {
2302     .l yview moveto 1.0
2303     .l xview moveto 1.0
2304     .l scan mark 10 20
2305     .l scan dragto 5 10
2306     update
2307     set x [list [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]]
2308     .l scan dragto [expr 5+$width] [expr 10+$height]
2309     update
2310     lappend x [format {%.6g %.6g} {*}[.l xview]] [format {%.6g %.6g} {*}[.l yview]]
2311 } -result {{0.8 1} {0.75 1} {0.6 0.8} {0.25 0.5}}
2312
2313
2314 test listbox-14.1 {NearestListboxElement procedure, partial last line} -body {
2315     mkPartial
2316     .partial.l nearest [winfo height .partial.l]
2317 } -result 4
2318 # Listbox used in 14.* tests
2319 destroy .l
2320 listbox .l -font $fixed -width 20 -height 10
2321 .l insert 0 a b c d e f g h i j k l m n o p q r s t
2322 .l yview 4
2323 pack .l
2324 update
2325 test listbox-14.2 {NearestListboxElement procedure} -constraints {
2326         fonts
2327 } -body {
2328     .l index @50,0
2329 } -result 4
2330 test listbox-14.3 {NearestListboxElement procedure} -constraints {
2331         fonts
2332 } -body {
2333     list [.l index @50,35] [.l index @50,36]
2334 } -result {5 6}
2335 test listbox-14.4 {NearestListboxElement procedure} -constraints {
2336         fonts
2337 } -body {
2338     .l index @50,200
2339 } -result 13
2340
2341
2342 # Listbox used in 15.* 16.* and 17.* tests
2343 destroy .l
2344 listbox .l -font $fixed -width 20 -height 10
2345 pack .l
2346 update
2347 test listbox-15.1 {ListboxSelect procedure} -body {
2348     .l delete 0 end
2349     .l insert 0 a b c d e f g h i j k l m n o p
2350     .l select set 2 4
2351     .l select set 7 12
2352     .l select clear 4 7
2353     .l curselection
2354 } -result {2 3 8 9 10 11 12}
2355 test listbox-15.2 {ListboxSelect procedure} -setup {
2356     destroy .e
2357 } -body {
2358     .l delete 0 end
2359     .l insert 0 a b c d e f g h i j k l m n o p
2360     entry .e
2361     .e insert 0 "This is some text"
2362     .e select from 0
2363     .e select to 7
2364     .l selection clear 2 4
2365     set x [selection own]
2366     .l selection set 3
2367     list $x [selection own] [selection get]
2368 } -cleanup {
2369     destroy .e
2370 } -result {.e .l d}
2371 test listbox-15.3 {ListboxSelect procedure} -body {
2372     .l delete 0 end
2373     .l selection clear 0 end
2374     .l select set 0 end
2375     .l curselection
2376 } -result {}
2377 test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} -body {
2378     .l delete 0 end
2379     .l insert 0 a b c d e f
2380     .l select clear 0 end
2381     .l select set -1 -1
2382     .l curselection
2383 } -result {}
2384 test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} -body {
2385     .l delete 0 end
2386     .l insert 0 a b c d e f
2387     .l select clear 0 end
2388     .l select set -1 3
2389     .l curselection
2390 } -result {0 1 2 3}
2391 test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} -body {
2392     .l delete 0 end
2393     .l insert 0 a b c d e f
2394     .l select clear 0 end
2395     .l select set 2 4
2396     .l curselection
2397 } -result {2 3 4}
2398 test listbox-15.7 {ListboxSelect procedure, boundary conditions for indices} -body {
2399     .l delete 0 end
2400     .l insert 0 a b c d e f
2401     .l select clear 0 end
2402     .l select set 4 end
2403     .l curselection
2404 } -result {4 5}
2405 test listbox-15.8 {ListboxSelect procedure, boundary conditions for indices} -body {
2406     .l delete 0 end
2407     .l insert 0 a b c d e f
2408     .l select clear 0 end
2409     .l select set 4 30
2410     .l curselection
2411 } -result {4 5}
2412 test listbox-15.9 {ListboxSelect procedure, boundary conditions for indices} -body {
2413     .l delete 0 end
2414     .l insert 0 a b c d e f
2415     .l select clear 0 end
2416     .l select set end 30
2417     .l curselection
2418 } -result 5
2419 test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} -body {
2420     .l delete 0 end
2421     .l insert 0 a b c d e f
2422     .l select clear 0 end
2423     .l select set 20 25
2424     .l curselection
2425 } -result {}
2426
2427
2428 test listbox-16.1 {ListboxFetchSelection procedure} -body {
2429     .l delete 0 end
2430     .l insert 0 a b c "two words" e f g h i \\ k l m n o p
2431     .l selection set 2 4
2432     .l selection set 9
2433     .l selection set 11 12
2434     selection get
2435 } -result "c\ntwo words\ne\n\\\nl\nm"
2436 test listbox-16.2 {ListboxFetchSelection procedure} -body {
2437     .l delete 0 end
2438     .l insert 0 a b c "two words" e f g h i \\ k l m n o p
2439     .l selection set 3
2440     selection get
2441 } -result "two words"
2442 test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} -body {
2443     set long "This is quite a long string\n"
2444     append long $long $long $long $long
2445     append long $long $long $long $long
2446     append long $long $long
2447     .l delete 0 end
2448     .l insert 0 1$long 2$long 3$long 4$long 5$long
2449     .l selection set 0 end
2450     set sel [selection get]
2451     string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel
2452 } -cleanup {
2453     catch {unset long sel}
2454 } -result 0
2455
2456
2457 test listbox-17.1 {ListboxLostSelection procedure} -setup {
2458     destroy .e
2459 } -body {
2460     .l delete 0 end
2461     .l insert 0 a b c d e
2462     .l select set 0 end
2463     entry .e
2464     .e insert 0 "This is some text"
2465     .e select from 0
2466     .e select to 5
2467     .l curselection
2468 } -cleanup {
2469     destroy .e
2470 } -result {}
2471 test listbox-17.2 {ListboxLostSelection procedure} -setup {
2472     destroy .e
2473 } -body {
2474     .l delete 0 end
2475     .l insert 0 a b c d e
2476     .l select set 0 end
2477     .l configure -exportselection 0
2478     entry .e
2479     .e insert 0 "This is some text"
2480     .e select from 0
2481     .e select to 5
2482     .l curselection
2483 } -cleanup {
2484     destroy .e
2485 } -result {0 1 2 3 4}
2486
2487
2488 # Listbox used in 18.* tests
2489 destroy .l
2490 listbox .l -font $fixed -width 10 -height 5
2491 pack .l
2492 update
2493 test listbox-18.1 {ListboxUpdateVScrollbar procedure} -body {
2494     .l configure -yscrollcommand "record y"
2495     set log {}
2496     .l insert 0 a b c
2497     update
2498     .l insert end d e f g h
2499     update
2500     .l delete 0 end
2501     update
2502     set log
2503 } -result {{y 0 1} {y 0 0.625} {y 0 1}}
2504 test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} -body {
2505     mkPartial
2506     .partial.l configure -yscrollcommand "record y"
2507     set log {}
2508     .partial.l yview 3
2509     update
2510     set log
2511 } -result {{y 0.2 0.466667}}
2512 test listbox-18.3 {ListboxUpdateVScrollbar procedure} -body {
2513     proc bgerror args {
2514             global x errorInfo
2515             set x [list $args $errorInfo]
2516     }
2517     .l configure -yscrollcommand gorp
2518     .l insert 0 foo
2519     update
2520     set x
2521 } -cleanup {
2522     rename bgerror {}
2523 } -result {{{invalid command name "gorp"}} {invalid command name "gorp"
2524     while executing
2525 "gorp 0.0 1.0"
2526     (vertical scrolling command executed by listbox)}}
2527
2528
2529 # Listbox used in 19.* tests
2530 destroy .l
2531 listbox .l -font $fixed -width 10 -height 5
2532 pack .l
2533 update
2534 test listbox-19.1 {ListboxUpdateVScrollbar procedure} -constraints {
2535         fonts
2536 } -body {
2537     .l configure -xscrollcommand "record x"
2538     set log {}
2539     .l insert 0 abc
2540     update
2541     .l insert 0 "This is a much longer string..."
2542     update
2543     .l delete 0 end
2544     update
2545     set log
2546 } -result {{x 0 1} {x 0 0.322581} {x 0 1}}
2547 test listbox-19.2 {ListboxUpdateVScrollbar procedure} -body {
2548     proc bgerror args {
2549             global x errorInfo
2550             set x [list $args $errorInfo]
2551     }
2552     .l configure -xscrollcommand bogus
2553     .l insert 0 foo
2554     update
2555     set x
2556 } -result {{{invalid command name "bogus"}} {invalid command name "bogus"
2557     while executing
2558 "bogus 0.0 1.0"
2559     (horizontal scrolling command executed by listbox)}}
2560
2561
2562 test listbox-20.1 {listbox vs hidden commands} -setup {
2563     deleteWindows
2564 } -body {
2565     set l [interp hidden]
2566     listbox .l
2567     interp hide {} .l
2568     destroy .l
2569     set res1 [list [winfo children .] [interp hidden]]
2570     set res2 [list {} $l]
2571     expr {$res1 eq $res2}
2572 } -result 1
2573
2574
2575 # tests for ListboxListVarProc
2576 test listbox-21.1 {ListboxListVarProc} -setup {
2577     destroy .l
2578 } -body {
2579     catch {unset x}
2580     listbox .l -listvar x
2581     set x [list a b c d]
2582     .l get 0 end
2583 } -cleanup {
2584     destroy .l
2585 } -result [list a b c d]
2586 test listbox-21.2 {ListboxListVarProc} -setup {
2587     destroy .l
2588 } -body {
2589     set x [list a b c d]
2590     listbox .l -listvar x
2591     unset x
2592     set x
2593 } -cleanup {
2594     destroy .l
2595 } -result [list a b c d]
2596 test listbox-21.3 {ListboxListVarProc} -setup {
2597     destroy .l
2598 } -body {
2599     set x [list a b c d]
2600     listbox .l -listvar x
2601     .l configure -listvar {}
2602     unset x
2603     info exists x
2604 } -cleanup {
2605     destroy .l
2606 } -result 0
2607 test listbox-21.4 {ListboxListVarProc} -setup {
2608     destroy .l
2609 } -body {
2610     set x [list a b c d]
2611     listbox .l -listvar x
2612     lappend x e f g
2613     .l size
2614 } -cleanup {
2615     destroy .l
2616 } -result 7
2617 test listbox-21.5 {ListboxListVarProc, test selection after listvar mod} -setup {
2618     destroy .l
2619 } -body {
2620     set x [list a b c d e f g]
2621     listbox .l -listvar x
2622     .l selection set end
2623     set x [list a b c d]
2624     set x [list 0 1 2 3 4 5 6]
2625     .l curselection
2626 } -cleanup {
2627     destroy .l
2628 } -result {}
2629 test listbox-21.6 {ListboxListVarProc, test selection after listvar mod} -setup {
2630     destroy .l
2631 } -body {
2632     set x [list a b c d]
2633     listbox .l -listvar x
2634     .l selection set 3
2635     lappend x e f g
2636     .l curselection
2637 } -cleanup {
2638     destroy .l
2639 } -result 3
2640 test listbox-21.7 {ListboxListVarProc, test selection after listvar mod} -setup {
2641     destroy .l
2642 } -body {
2643     set x [list a b c d]
2644     listbox .l -listvar x
2645     .l selection set 0
2646     set x [linsert $x 0 1 2 3 4]
2647     .l curselection
2648 } -cleanup {
2649     destroy .l
2650 } -result 0
2651 test listbox-21.8 {ListboxListVarProc, test selection after listvar mod} -setup {
2652     destroy .l
2653 } -body {
2654     set x [list a b c d]
2655     listbox .l -listvar x
2656     .l selection set 2
2657     set x [list a b c]
2658     .l curselection
2659 } -cleanup {
2660     destroy .l
2661 } -result 2
2662 test listbox-21.9 {ListboxListVarProc, test hscrollbar after listvar mod} -setup {
2663     destroy .l
2664 } -body {
2665     set x {}
2666     listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x
2667     pack .l
2668     update idletasks
2669     set log {}
2670     lappend x "0000000000"
2671     update idletasks
2672     lappend x "00000000000000000000"
2673     update idletasks
2674     set log
2675 } -cleanup {
2676     destroy .l
2677 } -result [list {x 0 1} {x 0 0.5}]
2678 test listbox-21.10 {ListboxListVarProc, test hscrollbar after listvar mod} -setup {
2679     destroy .l
2680 } -body {
2681     catch {unset x}
2682     listbox .l -font $fixed -width 10 -xscrollcommand "record x" -listvar x
2683     pack .l
2684     update idletasks
2685     set log {}
2686     lappend x "0000000000"
2687     update idletasks
2688     lappend x "00000000000000000000"
2689     update idletasks
2690     set x [list "0000000000"]
2691     update idletasks
2692     set log
2693 } -cleanup {
2694     destroy .l
2695 } -result [list {x 0 1} {x 0 0.5} {x 0 1}]
2696 test listbox-21.11 {ListboxListVarProc, bad list} -setup {
2697     destroy .l
2698 } -body {
2699     catch {unset x}
2700     listbox .l -listvar x
2701     set x [list a b c d]
2702     catch {set x "this is a \" bad list"} result
2703     set result
2704 } -cleanup {
2705     destroy .l
2706 } -result {can't set "x": invalid listvar value}
2707 test listbox-21.12 {ListboxListVarProc, cleanup item attributes} -setup {
2708     destroy .l
2709 } -body {
2710     set x [list a b c d e f g]
2711     listbox .l -listvar x
2712     .l itemconfigure end -fg red
2713     set x [list a b c d]
2714     set x [list 0 1 2 3 4 5 6]
2715     .l itemcget end -fg
2716 } -cleanup {
2717     destroy .l
2718 } -result {}
2719 test listbox-21.12a {ListboxListVarProc, cleanup item attributes} -setup {
2720     destroy .l
2721 } -body {
2722     set x [list a b c d e f g]
2723     listbox .l -listvar x
2724     .l itemconfigure end -fg red
2725     set x [list a b c d]
2726     set x [list 0 1 2 3 4 5 6]
2727     .l itemcget end -fg
2728 } -cleanup {
2729     destroy .l
2730 } -result {}
2731 test listbox-21.13 {listbox item configurations and listvar based deletions} -setup {
2732     destroy .l
2733 } -body {
2734     catch {unset x}
2735     listbox .l -listvar x
2736     .l insert end a b c
2737     .l itemconfigure 1 -fg red
2738     set x [list b c]
2739     .l itemcget 1 -fg
2740 } -cleanup {
2741     destroy .l
2742 } -result red
2743 test listbox-21.14 {listbox item configurations and listvar based inserts} -setup {
2744     destroy .l
2745 } -body {
2746     catch {unset x}
2747     listbox .l -listvar x
2748     .l insert end a b c
2749     .l itemconfigure 0 -fg red
2750     set x [list 1 2 3 4 a b c]
2751     .l itemcget 0 -fg
2752 } -cleanup {
2753     destroy .l
2754 } -result red
2755 test listbox-21.15 {ListboxListVarProc, update vertical scrollbar} -setup {
2756     destroy .l
2757 } -body {
2758     catch {unset x}
2759     listbox .l -font $fixed -height 3 -yscrollcommand "record y" -listvar x
2760     update
2761     set log {}
2762     pack .l
2763     set timeout [after 500 {lappend log timeout3}]
2764     vwait log
2765     update
2766     lappend x a b c d e f
2767     vwait log
2768     set log
2769 } -cleanup {
2770     destroy .l
2771     after cancel $timeout
2772 } -result [list {y 0 1} {y 0 0.5}]
2773 test listbox-21.16 {ListboxListVarProc, update vertical scrollbar} -setup {
2774     destroy .l
2775 } -body {
2776     catch {unset x}
2777     listbox .l -listvar x -height 3
2778     pack .l
2779     set x [list 0 1 2 3 4 5]
2780     .l yview scroll 3 units
2781     update
2782     set result {}
2783     lappend result [format {%.6g %.6g} {*}[.l yview]]
2784     set x [lreplace $x 3 3]
2785     set x [lreplace $x 3 3]
2786     set x [lreplace $x 3 3]
2787     update
2788     lappend result [format {%.6g %.6g} {*}[.l yview]]
2789     set result
2790 } -cleanup {
2791     destroy .l
2792 } -result [list {0.5 1} {0 1}]
2793
2794
2795 # UpdateHScrollbar
2796 test listbox-22.1 {UpdateHScrollbar} -setup {
2797     destroy .l
2798 } -body {
2799     listbox .l -font $fixed -width 10 -xscrollcommand "record x"
2800     pack .l
2801     update idletasks
2802     set log {}
2803     set timeout [after 500 {lappend log timeout4}]
2804     .l insert end "0000000000"
2805     vwait log
2806     .l insert end "00000000000000000000"
2807     vwait log
2808     set log
2809 } -cleanup {
2810     destroy .l
2811     after cancel $timeout
2812 } -result [list {x 0 1} {x 0 0.5}]
2813
2814
2815 # ConfigureListboxItem
2816 test listbox-23.1 {ConfigureListboxItem} -setup {
2817     destroy .l
2818 } -body {
2819     listbox .l
2820     catch {.l itemconfigure 0} result
2821     set result
2822 } -cleanup {
2823     destroy .l
2824 } -result {item number "0" out of range}
2825 test listbox-23.2 {ConfigureListboxItem} -setup {
2826     destroy .l
2827 } -body {
2828     listbox .l
2829     .l insert end a b c d
2830     .l itemconfigure 0
2831 } -cleanup {
2832     destroy .l
2833 } -result [list {-background background Background {} {}} \
2834         {-bg -background} \
2835         {-fg -foreground} \
2836         {-foreground foreground Foreground {} {}} \
2837         {-selectbackground selectBackground Foreground {} {}} \
2838         {-selectforeground selectForeground Background {} {}}]
2839 test listbox-23.3 {ConfigureListboxItem, itemco shortcut} -setup {
2840     destroy .l
2841 } -body {
2842     listbox .l
2843     .l insert end a b c d
2844     .l itemco 0 -background
2845 } -cleanup {
2846     destroy .l
2847 } -result {-background background Background {} {}}
2848 test listbox-23.4 {ConfigureListboxItem, wrong num args} -setup {
2849     destroy .l
2850 } -body {
2851     listbox .l
2852     .l insert end a
2853     catch {.l itemco} result
2854     set result
2855 } -cleanup {
2856     destroy .l
2857 } -result {wrong # args: should be ".l itemconfigure index ?-option? ?value? ?-option value ...?"}
2858 test listbox-23.5 {ConfigureListboxItem, multiple calls} -setup {
2859     destroy .l
2860 } -body {
2861     listbox .l
2862     set i 0
2863     foreach color {red orange yellow green blue white violet} {
2864         .l insert end $color
2865         .l itemconfigure $i -bg $color
2866         incr i
2867     }
2868     pack .l
2869     update
2870     list [.l itemcget 0 -bg] [.l itemcget 1 -bg] [.l itemcget 2 -bg] \
2871             [.l itemcget 3 -bg] [.l itemcget 4 -bg] [.l itemcget 5 -bg] \
2872             [.l itemcget 6 -bg]
2873 } -cleanup {
2874     destroy .l
2875 } -result {red orange yellow green blue white violet}
2876
2877 # Listbox used in 23.6 -23.17 tests
2878 destroy .l
2879 listbox .l
2880 .l insert end a b c d
2881 test listbox-23.6 {configuration options} -body {
2882     .l itemconfigure 0 -background #ff0000
2883     list [lindex [.l itemconfigure 0 -background] 4] [.l itemcget 0 -background]
2884 } -cleanup {
2885     .l configure -background #ffffff
2886 } -result {{#ff0000} #ff0000}
2887 test listbox-23.7 {configuration options} -body {
2888     .l configure -background non-existent
2889 } -returnCodes error -result {unknown color name "non-existent"}
2890 test listbox-23.8 {configuration options} -body {
2891     .l itemconfigure 0 -bg #ff0000
2892     list [lindex [.l itemconfigure 0 -bg] 4] [.l itemcget 0 -bg]
2893 } -cleanup {
2894     .l configure -bg #ffffff
2895 } -result {{#ff0000} #ff0000}
2896 test listbox-23.9 {configuration options} -body {
2897     .l configure -bg non-existent
2898 } -returnCodes error -result {unknown color name "non-existent"}
2899 test listbox-23.10 {configuration options} -body {
2900     .l itemconfigure 0 -fg #110022
2901     list [lindex [.l itemconfigure 0 -fg] 4] [.l itemcget 0 -fg]
2902 } -cleanup {
2903     .l configure -fg #000000
2904 } -result {{#110022} #110022}
2905 test listbox-23.11 {configuration options} -body {
2906     .l configure -fg bogus
2907 } -returnCodes error -result {unknown color name "bogus"}
2908 test listbox-23.12 {configuration options} -body {
2909     .l itemconfigure 0 -foreground #110022
2910     list [lindex [.l itemconfigure 0 -foreground] 4] [.l itemcget 0 -foreground]
2911 } -cleanup {
2912     .l configure -foreground #000000
2913 } -result {{#110022} #110022}
2914 test listbox-23.13 {configuration options} -body {
2915     .l configure -foreground bogus
2916 } -returnCodes error -result {unknown color name "bogus"}
2917 test listbox-23.14 {configuration options} -body {
2918     .l itemconfigure 0 -selectbackground #110022
2919     list [lindex [.l itemconfigure 0 -selectbackground] 4] [.l itemcget 0 -selectbackground]
2920 } -cleanup {
2921     .l configure -selectbackground #c3c3c3
2922 } -result {{#110022} #110022}
2923 test listbox-23.15 {configuration options} -body {
2924     .l configure -selectbackground bogus
2925 } -returnCodes error -result {unknown color name "bogus"}
2926 test listbox-23.16 {configuration options} -body {
2927     .l itemconfigure 0 -selectforeground #654321
2928     list [lindex [.l itemconfigure 0 -selectforeground] 4] [.l itemcget 0 -selectforeground]
2929 } -cleanup {
2930     .l configure -selectforeground #000000
2931 } -result {{#654321} #654321}
2932 test listbox-23.17 {configuration options} -body {
2933     .l configure -selectforeground bogus
2934 } -returnCodes error -result {unknown color name "bogus"}
2935
2936
2937 # ListboxWidgetObjCmd, itemcget
2938 test listbox-24.1 {itemcget} -setup {
2939     destroy .l
2940 } -body {
2941     listbox .l
2942     .l insert end a b c d
2943     .l itemcget 0 -fg
2944 } -cleanup {
2945     destroy .l
2946 } -result {}
2947 test listbox-24.2 {itemcget} -setup {
2948     destroy .l
2949 } -body {
2950     listbox .l
2951     .l insert end a b c d
2952     .l itemconfigure 0 -fg red
2953     .l itemcget 0 -fg
2954 } -cleanup {
2955     destroy .l
2956 } -result red
2957 test listbox-24.3 {itemcget} -setup {
2958     destroy .l
2959 } -body {
2960     listbox .l
2961     .l insert end a b c d
2962     catch {.l itemcget 0} result
2963     set result
2964 } -cleanup {
2965     destroy .l
2966 } -result {wrong # args: should be ".l itemcget index option"}
2967 test listbox-24.4 {itemcget, itemcg shortcut} -setup {
2968     destroy .l
2969 } -body {
2970     listbox .l
2971     .l insert end a b c d
2972     catch {.l itemcg 0} result
2973     set result
2974 } -cleanup {
2975     destroy .l
2976 } -result {wrong # args: should be ".l itemcget index option"}
2977
2978
2979 # General item configuration issues
2980 test listbox-25.1 {listbox item configurations and widget based deletions} -setup {
2981     destroy .l
2982 } -body {
2983     listbox .l
2984     .l insert end a
2985     .l itemconfigure 0 -fg red
2986     .l delete 0 end
2987     .l insert end a
2988     .l itemcget 0 -fg
2989 } -cleanup {
2990     destroy .l
2991 } -result {}
2992 test listbox-25.2 {listbox item configurations and widget based inserts} -setup {
2993     destroy .l
2994 } -body {
2995     listbox .l
2996     .l insert end a b c
2997     .l itemconfigure 0 -fg red
2998     .l insert 0 1 2 3 4
2999     list [.l itemcget 0 -fg] [.l itemcget 4 -fg]
3000 } -cleanup {
3001     destroy .l
3002 } -result {{} red}
3003
3004
3005 # state issues
3006 test listbox-26.1 {listbox disabled state disallows inserts} -setup {
3007     destroy .l
3008 } -body {
3009     listbox .l
3010     .l insert end a b c
3011     .l configure -state disabled
3012     .l insert end d e f
3013     .l get 0 end
3014 } -cleanup {
3015     destroy .l
3016 } -result [list a b c]
3017 test listbox-26.2 {listbox disabled state disallows deletions} -setup {
3018     destroy .l
3019 } -body {
3020     listbox .l
3021     .l insert end a b c
3022     .l configure -state disabled
3023     .l delete 0 end
3024     .l get 0 end
3025 } -cleanup {
3026     destroy .l
3027 } -result [list a b c]
3028 test listbox-26.3 {listbox disabled state disallows selection modification} -setup {
3029     destroy .l
3030 } -body {
3031     listbox .l
3032     .l insert end a b c
3033     .l selection set 0
3034     .l selection set 2
3035     .l configure -state disabled
3036     .l selection clear 0 end
3037     .l selection set 1
3038     .l curselection
3039 } -cleanup {
3040     destroy .l
3041 } -result [list 0 2]
3042 test listbox-26.4 {listbox disabled state disallows anchor modification} -setup {
3043     destroy .l
3044 } -body {
3045     listbox .l
3046     .l insert end a b c
3047     .l selection anchor 0
3048     .l configure -state disabled
3049     .l selection anchor 2
3050     .l index anchor
3051 } -cleanup {
3052     destroy .l
3053 } -result 0
3054 test listbox-26.5 {listbox disabled state disallows active modification} -setup {
3055     destroy .l
3056 } -body {
3057     listbox .l
3058     .l insert end a b c
3059     .l activate 0
3060     .l configure -state disabled
3061     .l activate 2
3062     .l index active
3063 } -cleanup {
3064     destroy .l
3065 } -result 0
3066
3067
3068 test listbox-27.1 {widget deletion while active} -setup {
3069     destroy .l
3070 } -body {
3071     pack [listbox .l]
3072     update
3073     .l configure -cursor xterm -xscrollcommand { destroy .l }
3074     update idle
3075     winfo exists .l
3076 } -cleanup {
3077     destroy .l
3078 } -result 0
3079
3080
3081 test listbox-28.1 {listbox -activestyle} -setup {
3082     destroy .l
3083 } -body {
3084     listbox .l -activ non
3085     .l cget -activestyle
3086 } -cleanup {
3087     destroy .l
3088 } -result none
3089 test listbox-28.2 {listbox -activestyle} -constraints {
3090         nonwin
3091 } -setup {
3092     destroy .l
3093 } -body {
3094     listbox .l
3095     .l cget -activestyle
3096 } -cleanup {
3097     destroy .l
3098 } -result dotbox
3099 test listbox-28.3 {listbox -activestyle} -constraints {
3100         win
3101 } -setup {
3102     destroy .l
3103 } -body {
3104     listbox .l
3105     .l cget -activestyle
3106 } -cleanup {
3107     destroy .l
3108 } -result underline
3109 test listbox-28.4 {listbox -activestyle} -setup {
3110     destroy .l
3111 } -body {
3112     listbox .l -activestyle und
3113     .l cget -activestyle
3114 } -cleanup {
3115     destroy .l
3116 } -result underline
3117
3118
3119 test listbox-29.1 {listbox selection behavior, -state disabled}  -setup {
3120     destroy .l
3121 } -body {
3122     listbox .l
3123     .l insert end 1 2 3
3124     .l selection set 2
3125     set out [.l selection includes 2]
3126     .l configure -state disabled
3127     # still return 1 when disabled, because 'selection get' will work,
3128     # but selection cannot be changed (new behavior since 8.4)
3129     .l selection set 3
3130     lappend out [.l selection includes 2] [.l curselection]
3131 } -cleanup {
3132     destroy .l
3133 } -result {1 1 2}
3134
3135 test listbox-30.1 {Bug 3607326} -setup {
3136     destroy .l
3137     unset -nocomplain a
3138 } -body {
3139     array set a {}
3140     listbox .l -listvariable a
3141 } -cleanup {
3142     destroy .l
3143     unset -nocomplain a
3144 } -result * -match glob -returnCodes error
3145
3146 test listbox-31.1 {<<ListboxSelect>> event} -setup {
3147     destroy .l
3148     unset -nocomplain res
3149 } -body {
3150     pack [listbox .l -state normal]
3151     update
3152     bind .l <<ListboxSelect>> {lappend res [%W curselection]}
3153     .l insert end a b c
3154     focus -force .l
3155     event generate .l <1> -x 5 -y 5  ; # <<ListboxSelect>> fires
3156     .l configure -state disabled
3157     focus -force .l
3158     event generate .l <Control-Home> ; # <<ListboxSelect>> does NOT fire
3159     .l configure -state normal
3160     focus -force .l
3161     event generate .l <Control-End>  ; # <<ListboxSelect>> fires
3162     .l selection clear 0 end         ; # <<ListboxSelect>> does NOT fire
3163     .l selection set 1 1             ; # <<ListboxSelect>> does NOT fire
3164     lappend res [.l curselection]
3165 } -cleanup {
3166     destroy .l
3167     unset -nocomplain res
3168 } -result {0 2 1}
3169
3170 test listbox-31.2 {<<ListboxSelect>> event on lost selection} -setup {
3171     destroy .l
3172 } -body {
3173     pack [listbox .l -exportselection true]
3174     update
3175     bind .l <<ListboxSelect>> {lappend res [list [selection own] [%W curselection]]}
3176     .l insert end a b c
3177     focus -force .l
3178     event generate .l <1> -x 5 -y 5  ; # <<ListboxSelect>> fires
3179     selection clear                  ; # <<ListboxSelect>> fires again
3180     update
3181     set res
3182 } -cleanup {
3183     destroy .l
3184 } -result {{.l 0} {{} {}}}
3185
3186 test listbox-32.1 {Bug [5d991b822e]} {
3187     # Want this not to segfault, or write to variable with empty name
3188     set var INIT
3189     listbox .b -listvariable var
3190     trace add variable var unset {apply {args {
3191         .b configure -listvariable {}
3192     }}}
3193     pack .b
3194     bind .b <Configure> {unset var}
3195     update
3196     destroy .b
3197     info exists {}
3198 } 0
3199 test listbox-32.2 {Bug [5d991b822e]} {
3200     # Want this not to leak traces
3201     set var INIT
3202     listbox .b -listvariable var
3203     trace add variable var unset {apply {args {
3204         .b configure -listvariable new
3205     }}}
3206     pack .b
3207     bind .b <Configure> {unset -nocomplain var}
3208     update
3209     destroy .b
3210     unset new
3211 } {}
3212
3213 resetGridInfo
3214 deleteWindows
3215 option clear
3216
3217 # cleanup
3218 cleanupTests
3219 return