1# This file is a Tcl script to test spinbox widgets in Tk. It is 2# organized in the standard fashion for Tcl tests. 3# 4# Copyright (c) 1998-2000 by Scriptics Corporation. 5# All rights reserved. 6# 7# RCS: @(#) $Id$ 8 9package require tcltest 2.1 10eval tcltest::configure $argv 11tcltest::loadTestedCommands 12 13proc scroll args { 14 global scrollInfo 15 set scrollInfo $args 16} 17 18# Create additional widget that's used to hold the selection at times. 19 20spinbox .sel 21.sel insert end "This is some sample text" 22 23# Font names 24 25set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1 26set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1 27 28# Create entries in the option database to be sure that geometry options 29# like border width have predictable values. 30 31option add *Spinbox.borderWidth 2 32option add *Spinbox.highlightThickness 2 33option add *Spinbox.font {Helvetica -12} 34 35spinbox .e -bd 2 -relief sunken 36pack .e 37update 38 39set i 1 40foreach test { 41 {-activebackground #ff0000 #ff0000 non-existent 42 {unknown color name "non-existent"}} 43 {-background #ff0000 #ff0000 non-existent 44 {unknown color name "non-existent"}} 45 {-bd 4 4 badValue {bad screen distance "badValue"}} 46 {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} 47 {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} 48 {-buttonbackground #ff0000 #ff0000 non-existent 49 {unknown color name "non-existent"}} 50 {-buttoncursor arrow arrow badValue {bad cursor spec "badValue"}} 51 {-command {a command} {a command} {} {}} 52 {-cursor arrow arrow badValue {bad cursor spec "badValue"}} 53 {-disabledbackground green green non-existent 54 {unknown color name "non-existent"}} 55 {-disabledforeground #110022 #110022 bogus {unknown color name "bogus"}} 56 {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} 57 {-fg #110022 #110022 bogus {unknown color name "bogus"}} 58 {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 59 -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {} 60 {font "" doesn't exist}} 61 {-foreground #110022 #110022 bogus {unknown color name "bogus"}} 62 {-format %0.5f %0.5f %d {bad spinbox format specifier "%d"}} 63 {-from -10 -10.0 bogus {expected floating-point number but got "bogus"}} 64 {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}} 65 {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} 66 {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} 67 {-highlightthickness -2 0 {} {}} 68 {-increment 1.0 1.0 bogus {expected floating-point number but got "bogus"}} 69 {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}} 70 {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}} 71 {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} 72 {-insertontime 100 100 3.2 {expected integer but got "3.2"}} 73 {-invalidcommand "a command" "a command" {} {}} 74 {-invcmd "a command" "a command" {} {}} 75 {-justify right right bogus {bad justification "bogus": must be left, right, or center}} 76 {-readonlybackground green green non-existent 77 {unknown color name "non-existent"}} 78 {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} 79 {-repeatdelay 500 500 3p {expected integer but got "3p"}} 80 {-repeatinterval -500 -500 3p {expected integer but got "3p"}} 81 {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} 82 {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} 83 {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} 84 {-state n normal bogus {bad state "bogus": must be disabled, normal, or readonly}} 85 {-takefocus "any string" "any string" {} {}} 86 {-textvariable i i {} {}} 87 {-to 14.9 14.9 bogus {expected floating-point number but got "bogus"}} 88 {-validate "key" "key" "bogus" {bad validate "bogus": must be all, key, focus, focusin, focusout, or none}} 89 {-validatecommand "a command" "a command" {} {}} 90 {-values {mon tue wed thur} {mon tue wed thur} {bad {}list} {list element in braces followed by "list" instead of space}} 91 {-vcmd "a command" "a command" {} {}} 92 {-width 402 402 3p {expected integer but got "3p"}} 93 {-wrap yes 1 xyzzy {expected boolean value but got "xyzzy"}} 94 {-xscrollcommand {Some command} {Some command} {} {}} 95} { 96 set name [lindex $test 0] 97 test spinbox-1.$i {configuration options} { 98 .e configure $name [lindex $test 1] 99 list [lindex [.e configure $name] 4] [.e cget $name] 100 } [list [lindex $test 2] [lindex $test 2]] 101 incr i 102 if {[lindex $test 3] != ""} { 103 test spinbox-1.$i {configuration options} { 104 list [catch {.e configure $name [lindex $test 3]} msg] $msg 105 } [list 1 [lindex $test 4]] 106 } 107 .e configure $name [lindex [.e configure $name] 3] 108 incr i 109} 110 111test spinbox-2.1 {Tk_SpinboxCmd procedure} { 112 list [catch {spinbox} msg] $msg 113} {1 {wrong # args: should be "spinbox pathName ?options?"}} 114test spinbox-2.2 {Tk_SpinboxCmd procedure} { 115 list [catch {spinbox gorp} msg] $msg 116} {1 {bad window path name "gorp"}} 117test spinbox-2.3 {Tk_SpinboxCmd procedure} { 118 catch {destroy .e} 119 spinbox .e 120 list [winfo exists .e] [winfo class .e] [info commands .e] 121} {1 Spinbox .e} 122test spinbox-2.4 {Tk_SpinboxCmd procedure} { 123 catch {destroy .e} 124 list [catch {spinbox .e -gorp foo} msg] $msg [winfo exists .e] \ 125 [info commands .e] 126} {1 {unknown option "-gorp"} 0 {}} 127test spinbox-2.5 {Tk_SpinboxCmd procedure} { 128 catch {destroy .e} 129 spinbox .e 130} {.e} 131 132catch {destroy .e} 133spinbox .e -font $fixed 134pack .e 135update 136 137set cx [font measure $fixed a] 138set cy [font metrics $fixed -linespace] 139set ux [font measure $fixed \u4e4e] 140 141test spinbox-3.1 {SpinboxWidgetCmd procedure} { 142 list [catch {.e} msg] $msg 143} {1 {wrong # args: should be ".e option ?arg arg ...?"}} 144test spinbox-3.2 {SpinboxWidgetCmd procedure, "bbox" widget command} { 145 list [catch {.e bbox} msg] $msg 146} {1 {wrong # args: should be ".e bbox index"}} 147test spinbox-3.3 {SpinboxWidgetCmd procedure, "bbox" widget command} { 148 list [catch {.e bbox a b} msg] $msg 149} {1 {wrong # args: should be ".e bbox index"}} 150test spinbox-3.4 {SpinboxWidgetCmd procedure, "bbox" widget command} { 151 list [catch {.e bbox bogus} msg] $msg 152} {1 {bad spinbox index "bogus"}} 153test spinbox-3.5 {SpinboxWidgetCmd procedure, "bbox" widget command} { 154 .e delete 0 end 155 .e bbox 0 156} [list 5 5 0 $cy] 157test spinbox-3.6 {SpinboxWidgetCmd procedure, "bbox" widget command} { 158 # Tcl_UtfAtIndex(): no utf chars 159 160 .e delete 0 end 161 .e insert 0 "abc" 162 list [.e bbox 3] [.e bbox end] 163} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"] 164test spinbox-3.7 {SpinboxWidgetCmd procedure, "bbox" widget command} { 165 # Tcl_UtfAtIndex(): utf at end 166 .e delete 0 end 167 .e insert 0 "ab\u4e4e" 168 .e bbox end 169} "[expr 5+2*$cx] 5 $ux $cy" 170test spinbox-3.8 {SpinboxWidgetCmd procedure, "bbox" widget command} { 171 # Tcl_UtfAtIndex(): utf before index 172 .e delete 0 end 173 .e insert 0 "ab\u4e4ec" 174 .e bbox 3 175} "[expr 5+2*$cx+$ux] 5 $cx $cy" 176test spinbox-3.9 {SpinboxWidgetCmd procedure, "bbox" widget command} { 177 # Tcl_UtfAtIndex(): no chars 178 .e delete 0 end 179 .e bbox end 180} "5 5 0 $cy" 181test spinbox-3.10 {SpinboxWidgetCmd procedure, "bbox" widget command} { 182 .e delete 0 end 183 .e insert 0 "abcdefghij\u4e4eklmnop" 184 list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end] 185} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"] 186test spinbox-3.11 {SpinboxWidgetCmd procedure, "cget" widget command} { 187 list [catch {.e cget} msg] $msg 188} {1 {wrong # args: should be ".e cget option"}} 189test spinbox-3.12 {SpinboxWidgetCmd procedure, "cget" widget command} { 190 list [catch {.e cget a b} msg] $msg 191} {1 {wrong # args: should be ".e cget option"}} 192test spinbox-3.13 {SpinboxWidgetCmd procedure, "cget" widget command} { 193 list [catch {.e cget -gorp} msg] $msg 194} {1 {unknown option "-gorp"}} 195test spinbox-3.14 {SpinboxWidgetCmd procedure, "cget" widget command} { 196 .e configure -bd 4 197 .e cget -bd 198} {4} 199test spinbox-3.15 {SpinboxWidgetCmd procedure, "configure" widget command} { 200 llength [.e configure] 201} {49} 202test spinbox-3.16 {SpinboxWidgetCmd procedure, "configure" widget command} { 203 list [catch {.e configure -foo} msg] $msg 204} {1 {unknown option "-foo"}} 205test spinbox-3.17 {SpinboxWidgetCmd procedure, "configure" widget command} { 206 .e configure -bd 4 207 .e configure -bg #ffffff 208 lindex [.e configure -bd] 4 209} {4} 210test spinbox-3.18 {SpinboxWidgetCmd procedure, "delete" widget command} { 211 list [catch {.e delete} msg] $msg 212} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} 213test spinbox-3.19 {SpinboxWidgetCmd procedure, "delete" widget command} { 214 list [catch {.e delete a b c} msg] $msg 215} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} 216test spinbox-3.20 {SpinboxWidgetCmd procedure, "delete" widget command} { 217 list [catch {.e delete foo} msg] $msg 218} {1 {bad spinbox index "foo"}} 219test spinbox-3.21 {SpinboxWidgetCmd procedure, "delete" widget command} { 220 list [catch {.e delete 0 bar} msg] $msg 221} {1 {bad spinbox index "bar"}} 222test spinbox-3.22 {SpinboxWidgetCmd procedure, "delete" widget command} { 223 .e delete 0 end 224 .e insert end "01234567890" 225 .e delete 2 4 226 .e get 227} {014567890} 228test spinbox-3.23 {SpinboxWidgetCmd procedure, "delete" widget command} { 229 .e delete 0 end 230 .e insert end "01234567890" 231 .e delete 6 232 .e get 233} {0123457890} 234test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} { 235 # UTF 236 set x {} 237 .e delete 0 end 238 .e insert end "01234\u4e4e67890" 239 .e delete 6 240 lappend x [.e get] 241 .e delete 0 end 242 .e insert end "012345\u4e4e7890" 243 .e delete 6 244 lappend x [.e get] 245 .e delete 0 end 246 .e insert end "0123456\u4e4e890" 247 .e delete 6 248 lappend x [.e get] 249} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] 250test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} { 251 .e delete 0 end 252 .e insert end "01234567890" 253 .e delete 6 5 254 .e get 255} {01234567890} 256test spinbox-3.26 {SpinboxWidgetCmd procedure, "delete" widget command} { 257 .e delete 0 end 258 .e insert end "01234567890" 259 .e configure -state disabled 260 .e delete 2 8 261 .e configure -state normal 262 .e get 263} {01234567890} 264test spinbox-3.27 {SpinboxWidgetCmd procedure, "get" widget command} { 265 list [catch {.e get foo} msg] $msg 266} {1 {wrong # args: should be ".e get"}} 267test spinbox-3.28 {SpinboxWidgetCmd procedure, "icursor" widget command} { 268 list [catch {.e icursor} msg] $msg 269} {1 {wrong # args: should be ".e icursor pos"}} 270test spinbox-3.29 {SpinboxWidgetCmd procedure, "icursor" widget command} { 271 list [catch {.e icursor foo} msg] $msg 272} {1 {bad spinbox index "foo"}} 273test spinbox-3.30 {SpinboxWidgetCmd procedure, "icursor" widget command} { 274 .e delete 0 end 275 .e insert end "01234567890" 276 .e icursor 4 277 .e index insert 278} {4} 279test spinbox-3.31 {SpinboxWidgetCmd procedure, "index" widget command} { 280 list [catch {.e in} msg] $msg 281} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}} 282test spinbox-3.32 {SpinboxWidgetCmd procedure, "index" widget command} { 283 list [catch {.e index} msg] $msg 284} {1 {wrong # args: should be ".e index string"}} 285test spinbox-3.33 {SpinboxWidgetCmd procedure, "index" widget command} { 286 list [catch {.e index foo} msg] $msg 287} {1 {bad spinbox index "foo"}} 288test spinbox-3.34 {SpinboxWidgetCmd procedure, "index" widget command} { 289 list [catch {.e index 0} msg] $msg 290} {0 0} 291test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} { 292 # UTF 293 .e delete 0 end 294 .e insert 0 abc\u4e4e\u0153def 295 list [.e index 3] [.e index 4] [.e index end] 296} {3 4 8} 297test spinbox-3.36 {SpinboxWidgetCmd procedure, "insert" widget command} { 298 list [catch {.e insert a} msg] $msg 299} {1 {wrong # args: should be ".e insert index text"}} 300test spinbox-3.37 {SpinboxWidgetCmd procedure, "insert" widget command} { 301 list [catch {.e insert a b c} msg] $msg 302} {1 {wrong # args: should be ".e insert index text"}} 303test spinbox-3.38 {SpinboxWidgetCmd procedure, "insert" widget command} { 304 list [catch {.e insert foo Text} msg] $msg 305} {1 {bad spinbox index "foo"}} 306test spinbox-3.39 {SpinboxWidgetCmd procedure, "insert" widget command} { 307 .e delete 0 end 308 .e insert end "01234567890" 309 .e insert 3 xxx 310 .e get 311} {012xxx34567890} 312test spinbox-3.40 {SpinboxWidgetCmd procedure, "insert" widget command} { 313 .e delete 0 end 314 .e insert end "01234567890" 315 .e configure -state disabled 316 .e insert 3 xxx 317 .e configure -state normal 318 .e get 319} {01234567890} 320test spinbox-3.41 {SpinboxWidgetCmd procedure, "insert" widget command} { 321 list [catch {.e insert a b c} msg] $msg 322} {1 {wrong # args: should be ".e insert index text"}} 323test spinbox-3.42 {SpinboxWidgetCmd procedure, "scan" widget command} { 324 list [catch {.e scan a} msg] $msg 325} {1 {wrong # args: should be ".e scan mark|dragto x"}} 326test spinbox-3.43 {SpinboxWidgetCmd procedure, "scan" widget command} { 327 list [catch {.e scan a b c} msg] $msg 328} {1 {wrong # args: should be ".e scan mark|dragto x"}} 329test spinbox-3.44 {SpinboxWidgetCmd procedure, "scan" widget command} { 330 list [catch {.e scan foobar 20} msg] $msg 331} {1 {bad scan option "foobar": must be mark or dragto}} 332test spinbox-3.45 {SpinboxWidgetCmd procedure, "scan" widget command} { 333 list [catch {.e scan mark 20.1} msg] $msg 334} {1 {expected integer but got "20.1"}} 335# This test is non-portable because character sizes vary. 336 337test spinbox-3.46 {SpinboxWidgetCmd procedure, "scan" widget command} {fonts} { 338 .e delete 0 end 339 update 340 .e insert end "This is quite a long string, in fact a " 341 .e insert end "very very long string" 342 .e scan mark 30 343 .e scan dragto 28 344 .e index @0 345} {2} 346test spinbox-3.47 {SpinboxWidgetCmd procedure, "select" widget command} { 347 list [catch {.e select} msg] $msg 348} {1 {wrong # args: should be ".e selection option ?index?"}} 349test spinbox-3.48 {SpinboxWidgetCmd procedure, "select" widget command} { 350 list [catch {.e select foo} msg] $msg 351} {1 {bad selection option "foo": must be adjust, clear, element, from, present, range, or to}} 352test spinbox-3.49 {SpinboxWidgetCmd procedure, "select clear" widget command} { 353 list [catch {.e select clear gorp} msg] $msg 354} {1 {wrong # args: should be ".e selection clear"}} 355test spinbox-3.50 {SpinboxWidgetCmd procedure, "select clear" widget command} { 356 .e delete 0 end 357 .e insert end "0123456789" 358 .e select from 1 359 .e select to 4 360 update 361 .e select clear 362 list [catch {selection get} msg] $msg [selection own] 363} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e} 364test spinbox-3.51 {SpinboxWidgetCmd procedure, "selection present" widget command} { 365 list [catch {.e selection present foo} msg] $msg 366} {1 {wrong # args: should be ".e selection present"}} 367test spinbox-3.52 {SpinboxWidgetCmd procedure, "selection present" widget command} { 368 .e delete 0 end 369 .e insert end 0123456789 370 .e select from 3 371 .e select to 6 372 .e selection present 373} {1} 374test spinbox-3.53 {SpinboxWidgetCmd procedure, "selection present" widget command} { 375 .e delete 0 end 376 .e insert end 0123456789 377 .e select from 3 378 .e select to 6 379 .e configure -exportselection false 380 .e selection present 381} {1} 382.e configure -exportselection true 383test spinbox-3.54 {SpinboxWidgetCmd procedure, "selection present" widget command} { 384 .e delete 0 end 385 .e insert end 0123456789 386 .e select from 3 387 .e select to 6 388 .e delete 0 end 389 .e selection present 390} {0} 391test spinbox-3.55 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { 392 list [catch {.e select adjust x} msg] $msg 393} {1 {bad spinbox index "x"}} 394test spinbox-3.56 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { 395 list [catch {.e select adjust 2 3} msg] $msg 396} {1 {wrong # args: should be ".e selection adjust index"}} 397test spinbox-3.57 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { 398 .e delete 0 end 399 .e insert end "0123456789" 400 .e select from 1 401 .e select to 5 402 update 403 .e select adjust 4 404 selection get 405} {123} 406test spinbox-3.58 {SpinboxWidgetCmd procedure, "selection adjust" widget command} { 407 .e delete 0 end 408 .e insert end "0123456789" 409 .e select from 1 410 .e select to 5 411 update 412 .e select adjust 2 413 selection get 414} {234} 415test spinbox-3.59 {SpinboxWidgetCmd procedure, "selection from" widget command} { 416 list [catch {.e select from 2 3} msg] $msg 417} {1 {wrong # args: should be ".e selection from index"}} 418test spinbox-3.60 {SpinboxWidgetCmd procedure, "selection range" widget command} { 419 list [catch {.e select range 2} msg] $msg 420} {1 {wrong # args: should be ".e selection range start end"}} 421test spinbox-3.61 {SpinboxWidgetCmd procedure, "selection range" widget command} { 422 list [catch {.e selection range 2 3 4} msg] $msg 423} {1 {wrong # args: should be ".e selection range start end"}} 424test spinbox-3.62 {SpinboxWidgetCmd procedure, "selection range" widget command} { 425 .e delete 0 end 426 .e insert end 0123456789 427 .e select from 1 428 .e select to 5 429 .e select range 4 4 430 list [catch {.e index sel.first} msg] $msg 431} {1 {selection isn't in widget .e}} 432test spinbox-3.63 {SpinboxWidgetCmd procedure, "selection range" widget command} { 433 .e delete 0 end 434 .e insert end 0123456789 435 .e select from 3 436 .e select to 7 437 .e select range 2 9 438 list [.e index sel.first] [.e index sel.last] [.e index anchor] 439} {2 9 3} 440.e delete 0 end 441.e insert end "This is quite a long text string, so long that it " 442.e insert end "runs off the end of the window quite a bit." 443test spinbox-3.64 {SpinboxWidgetCmd procedure, "selection to" widget command} { 444 list [catch {.e select to 2 3} msg] $msg 445} {1 {wrong # args: should be ".e selection to index"}} 446test spinbox-3.65 {SpinboxWidgetCmd procedure, "xview" widget command} { 447 .e xview 5 448 format {%.6f %.6f} {*}[.e xview] 449} {0.053763 0.268817} 450test spinbox-3.66 {SpinboxWidgetCmd procedure, "xview" widget command} { 451 list [catch {.e xview gorp} msg] $msg 452} {1 {bad spinbox index "gorp"}} 453test spinbox-3.67 {SpinboxWidgetCmd procedure, "xview" widget command} { 454 .e xview 0 455 .e icursor 10 456 .e xview insert 457 format {%.6f %.6f} {*}[.e xview] 458} {0.107527 0.322581} 459test spinbox-3.68 {SpinboxWidgetCmd procedure, "xview" widget command} { 460 list [catch {.e xview moveto foo bar} msg] $msg 461} {1 {wrong # args: should be ".e xview moveto fraction"}} 462test spinbox-3.69 {SpinboxWidgetCmd procedure, "xview" widget command} { 463 list [catch {.e xview moveto foo} msg] $msg 464} {1 {expected floating-point number but got "foo"}} 465test spinbox-3.70 {SpinboxWidgetCmd procedure, "xview" widget command} { 466 .e xview moveto 0.5 467 format {%.6f %.6f} {*}[.e xview] 468} {0.505376 0.72043} 469test spinbox-3.71 {SpinboxWidgetCmd procedure, "xview" widget command} { 470 list [catch {.e xview scroll 24} msg] $msg 471} {1 {wrong # args: should be ".e xview scroll number units|pages"}} 472test spinbox-3.72 {SpinboxWidgetCmd procedure, "xview" widget command} { 473 list [catch {.e xview scroll gorp units} msg] $msg 474} {1 {expected integer but got "gorp"}} 475test spinbox-3.73 {SpinboxWidgetCmd procedure, "xview" widget command} { 476 .e xview moveto 0 477 .e xview scroll 1 pages 478 format {%.6f %.6f} {*}[.e xview] 479} {0.193548 0.408602} 480test spinbox-3.74 {SpinboxWidgetCmd procedure, "xview" widget command} { 481 .e xview moveto .9 482 update 483 .e xview scroll -2 p 484 format {%.6f %.6f} {*}[.e xview] 485} {0.397849 0.612903} 486test spinbox-3.75 {SpinboxWidgetCmd procedure, "xview" widget command} { 487 .e xview 30 488 update 489 .e xview scroll 2 units 490 .e index @0 491} {32} 492test spinbox-3.76 {SpinboxWidgetCmd procedure, "xview" widget command} { 493 .e xview 30 494 update 495 .e xview scroll -1 units 496 .e index @0 497} {29} 498test spinbox-3.77 {SpinboxWidgetCmd procedure, "xview" widget command} { 499 list [catch {.e xview scroll 23 foobars} msg] $msg 500} {1 {bad argument "foobars": must be units or pages}} 501test spinbox-3.78 {SpinboxWidgetCmd procedure, "xview" widget command} { 502 list [catch {.e xview eat 23 hamburgers} msg] $msg 503} {1 {unknown option "eat": must be moveto or scroll}} 504test spinbox-3.79 {SpinboxWidgetCmd procedure, "xview" widget command} { 505 .e xview 0 506 update 507 .e xview -4 508 .e index @0 509} {0} 510test spinbox-3.80 {SpinboxWidgetCmd procedure, "xview" widget command} { 511 .e xview 300 512 .e index @0 513} {73} 514.e insert 10 \u4e4e 515test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} { 516 # UTF 517 # If Tcl_NumUtfChars wasn't used, wrong answer would be: 518 # 0.106383 0.117021 0.117021 519 520 set x {} 521 .e xview moveto .1 522 lappend x [format {%.6f} [lindex [.e xview] 0]] 523 .e xview moveto .11 524 lappend x [format {%.6f} [lindex [.e xview] 0]] 525 .e xview moveto .12 526 lappend x [format {%.6f} [lindex [.e xview] 0]] 527} {0.095745 0.106383 0.117021} 528test spinbox-3.82 {SpinboxWidgetCmd procedure} { 529 list [catch {.e gorp} msg] $msg 530} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, identify, index, insert, invoke, scan, selection, set, validate, or xview}} 531 532frame .f -width 200 -height 50 -relief raised -bd 2 533pack .f -side right 534test spinbox-5.1 {ConfigureSpinbox procedure, -textvariable} { 535 catch {destroy .e} 536 set x 12345 537 spinbox .e -textvariable x 538 .e get 539} {12345} 540test spinbox-5.2 {ConfigureSpinbox procedure, -textvariable} { 541 catch {destroy .e} 542 set x 12345 543 spinbox .e -textvariable x 544 set y abcde 545 .e configure -textvariable y 546 set x 54321 547 .e get 548} {abcde} 549test spinbox-5.3 {ConfigureSpinbox procedure, -textvariable} { 550 catch {destroy .e} 551 catch {unset x} 552 spinbox .e 553 .e insert 0 "Some text" 554 .e configure -textvariable x 555 set x 556} {Some text} 557test spinbox-5.4 {ConfigureSpinbox procedure, -textvariable} { 558 proc override args { 559 global x 560 set x 12345 561 } 562 catch {destroy .e} 563 catch {unset x} 564 trace variable x w override 565 spinbox .e 566 .e insert 0 "Some text" 567 .e configure -textvariable x 568 set result [list $x [.e get]] 569 unset x; rename override {} 570 set result 571} {12345 12345} 572test spinbox-5.5 {ConfigureSpinbox procedure} { 573 catch {destroy .e} 574 spinbox .e -exportselection false 575 pack .e 576 .e insert end "0123456789" 577 .sel select from 0 578 .sel select to 10 579 set x {} 580 lappend x [selection get] 581 .e select from 1 582 .e select to 5 583 lappend x [selection get] 584 .e configure -exportselection 1 585 lappend x [selection get] 586 set x 587} {{This is so} {This is so} 1234} 588test spinbox-5.6 {ConfigureSpinbox procedure} { 589 catch {destroy .e} 590 spinbox .e 591 pack .e 592 .e insert end "0123456789" 593 .e select from 1 594 .e select to 5 595 .e configure -exportselection 0 596 list [catch {selection get} msg] $msg [.e index sel.first] \ 597 [.e index sel.last] 598} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5} 599test spinbox-5.7 {ConfigureSpinbox procedure} { 600 catch {destroy .e} 601 spinbox .e -font $fixed -width 4 -xscrollcommand scroll 602 pack .e 603 .e insert end "01234567890" 604 update 605 .e configure -width 5 606 format {%.6f %.6f} {*}$scrollInfo 607} {0.000000 0.363636} 608test spinbox-5.8 {ConfigureSpinbox procedure} {fonts} { 609 catch {destroy .e} 610 spinbox .e -width 0 611 pack .e 612 .e insert end "0123" 613 update 614 .e configure -font $big 615 update 616 winfo geom .e 617} {79x37+0+0} 618test spinbox-5.9 {ConfigureSpinbox procedure} {fonts} { 619 catch {destroy .e} 620 spinbox .e -font $fixed -bd 2 -relief raised 621 pack .e 622 .e insert end "0123" 623 update 624 list [.e index @10] [.e index @11] [.e index @12] [.e index @13] 625} {0 0 1 1} 626test spinbox-5.10 {ConfigureSpinbox procedure} {fonts} { 627 catch {destroy .e} 628 spinbox .e -font $fixed -bd 2 -relief flat 629 pack .e 630 .e insert end "0123" 631 update 632 list [.e index @10] [.e index @11] [.e index @12] [.e index @13] 633} {0 0 1 1} 634test spinbox-5.11 {ConfigureSpinbox procedure} { 635 # If "0" in selected font had 0 width, caused divide-by-zero error. 636 637 catch {destroy .e} 638 pack [spinbox .e -font {{open look glyph}}] 639 .e scan dragto 30 640 update 641} {} 642 643# No tests for DisplaySpinbox. 644 645test spinbox-6.1 {SpinboxComputeGeometry procedure} {fonts} { 646 catch {destroy .e} 647 spinbox .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3 648 pack .e 649 .e insert end 012\t45 650 update 651 list [.e index @61] [.e index @62] 652} {3 4} 653test spinbox-6.2 {SpinboxComputeGeometry procedure} {fonts} { 654 catch {destroy .e} 655 spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify center \ 656 -highlightthickness 3 657 pack .e 658 .e insert end 012\t45 659 update 660 list [.e index @96] [.e index @97] 661} {3 4} 662test spinbox-6.3 {SpinboxComputeGeometry procedure} {fonts} { 663 catch {destroy .e} 664 spinbox .e -font $fixed -bd 2 -relief raised -width 20 -justify right \ 665 -highlightthickness 3 666 pack .e 667 .e insert end 012\t45 668 update 669 list [.e index @131] [.e index @132] 670} {3 4} 671test spinbox-6.4 {SpinboxComputeGeometry procedure} { 672 catch {destroy .e} 673 spinbox .e -font $fixed -bd 2 -relief raised -width 5 674 pack .e 675 .e insert end "01234567890" 676 update 677 .e xview 6 678 .e index @0 679} {6} 680test spinbox-6.5 {SpinboxComputeGeometry procedure} { 681 catch {destroy .e} 682 spinbox .e -font $fixed -bd 2 -relief raised -width 5 683 pack .e 684 .e insert end "01234567890" 685 update 686 .e xview 7 687 .e index @0 688} {6} 689test spinbox-6.6 {SpinboxComputeGeometry procedure} {fonts} { 690 catch {destroy .e} 691 spinbox .e -font $fixed -bd 2 -relief raised -width 10 692 pack .e 693 .e insert end "01234\t67890" 694 update 695 .e xview 3 696 list [.e index @39] [.e index @40] 697} {5 6} 698test spinbox-6.7 {SpinboxComputeGeometry procedure} {fonts} { 699 catch {destroy .e} 700 spinbox .e -font $big -bd 3 -relief raised -width 5 701 pack .e 702 .e insert end "01234567" 703 update 704 list [winfo reqwidth .e] [winfo reqheight .e] 705} {94 39} 706test spinbox-6.8 {SpinboxComputeGeometry procedure} {fonts} { 707 catch {destroy .e} 708 spinbox .e -font $big -bd 3 -relief raised -width 0 709 pack .e 710 .e insert end "01234567" 711 update 712 list [winfo reqwidth .e] [winfo reqheight .e] 713} {133 39} 714test spinbox-6.9 {SpinboxComputeGeometry procedure} {fonts} { 715 catch {destroy .e} 716 spinbox .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2 717 pack .e 718 update 719 list [winfo reqwidth .e] [winfo reqheight .e] 720} {42 39} 721 722catch {destroy .e} 723spinbox .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll 724pack .e 725focus .e 726test spinbox-7.1 {InsertChars procedure} { 727 .e delete 0 end 728 .e insert 0 abcde 729 .e insert 2 XXX 730 update 731 list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] 732} {abXXXcde abXXXcde {0.000000 1.000000}} 733test spinbox-7.2 {InsertChars procedure} { 734 .e delete 0 end 735 .e insert 0 abcde 736 .e insert 500 XXX 737 update 738 list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] 739} {abcdeXXX abcdeXXX {0.000000 1.000000}} 740test spinbox-7.3 {InsertChars procedure} { 741 .e delete 0 end 742 .e insert 0 0123456789 743 .e select from 2 744 .e select to 6 745 .e insert 2 XXX 746 set x "[.e index sel.first] [.e index sel.last]" 747 .e select to 8 748 lappend x [.e index sel.first] [.e index sel.last] 749} {5 9 5 8} 750test spinbox-7.4 {InsertChars procedure} { 751 .e delete 0 end 752 .e insert 0 0123456789 753 .e select from 2 754 .e select to 6 755 .e insert 3 XXX 756 set x "[.e index sel.first] [.e index sel.last]" 757 .e select to 8 758 lappend x [.e index sel.first] [.e index sel.last] 759} {2 9 2 8} 760test spinbox-7.5 {InsertChars procedure} { 761 .e delete 0 end 762 .e insert 0 0123456789 763 .e select from 2 764 .e select to 6 765 .e insert 5 XXX 766 set x "[.e index sel.first] [.e index sel.last]" 767 .e select to 8 768 lappend x [.e index sel.first] [.e index sel.last] 769} {2 9 2 8} 770test spinbox-7.6 {InsertChars procedure} { 771 .e delete 0 end 772 .e insert 0 0123456789 773 .e select from 2 774 .e select to 6 775 .e insert 6 XXX 776 set x "[.e index sel.first] [.e index sel.last]" 777 .e select to 5 778 lappend x [.e index sel.first] [.e index sel.last] 779} {2 6 2 5} 780test spinbox-7.7 {InsertChars procedure} { 781 .e delete 0 end 782 .e insert 0 0123456789 783 .e icursor 4 784 .e insert 4 XXX 785 .e index insert 786} {7} 787test spinbox-7.8 {InsertChars procedure} { 788 .e delete 0 end 789 .e insert 0 0123456789 790 .e icursor 4 791 .e insert 5 XXX 792 .e index insert 793} {4} 794test spinbox-7.9 {InsertChars procedure} { 795 .e delete 0 end 796 .e insert 0 "This is a very long string" 797 update 798 .e xview 4 799 .e insert 3 XXX 800 .e index @0 801} {7} 802test spinbox-7.10 {InsertChars procedure} { 803 .e delete 0 end 804 .e insert 0 "This is a very long string" 805 update 806 .e xview 4 807 .e insert 4 XXX 808 .e index @0 809} {4} 810.e configure -width 0 811test spinbox-7.11 {InsertChars procedure} {fonts} { 812 .e delete 0 end 813 .e insert 0 "xyzzy" 814 update 815 .e insert 2 00 816 winfo reqwidth .e 817} {70} 818 819.e configure -width 10 820test spinbox-8.1 {DeleteChars procedure} { 821 .e delete 0 end 822 .e insert 0 abcde 823 .e delete 2 4 824 update 825 list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] 826} {abe abe {0.000000 1.000000}} 827test spinbox-8.2 {DeleteChars procedure} { 828 .e delete 0 end 829 .e insert 0 abcde 830 .e delete -2 2 831 update 832 list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] 833} {cde cde {0.000000 1.000000}} 834test spinbox-8.3 {DeleteChars procedure} { 835 .e delete 0 end 836 .e insert 0 abcde 837 .e delete 3 1000 838 update 839 list [.e get] $contents [format {%.6f %.6f} {*}$scrollInfo] 840} {abc abc {0.000000 1.000000}} 841test spinbox-8.4 {DeleteChars procedure} { 842 .e delete 0 end 843 .e insert 0 0123456789abcde 844 .e select from 3 845 .e select to 8 846 .e delete 1 3 847 update 848 set x "[.e index sel.first] [.e index sel.last]" 849 .e select to 5 850 lappend x [.e index sel.first] [.e index sel.last] 851} {1 6 1 5} 852test spinbox-8.5 {DeleteChars procedure} { 853 .e delete 0 end 854 .e insert 0 0123456789abcde 855 .e select from 3 856 .e select to 8 857 .e delete 1 4 858 update 859 set x "[.e index sel.first] [.e index sel.last]" 860 .e select to 4 861 lappend x [.e index sel.first] [.e index sel.last] 862} {1 5 1 4} 863test spinbox-8.6 {DeleteChars procedure} { 864 .e delete 0 end 865 .e insert 0 0123456789abcde 866 .e select from 3 867 .e select to 8 868 .e delete 1 7 869 update 870 set x "[.e index sel.first] [.e index sel.last]" 871 .e select to 5 872 lappend x [.e index sel.first] [.e index sel.last] 873} {1 2 1 5} 874test spinbox-8.7 {DeleteChars procedure} { 875 .e delete 0 end 876 .e insert 0 0123456789abcde 877 .e select from 3 878 .e select to 8 879 .e delete 1 8 880 list [catch {.e index sel.first} msg] $msg 881} {1 {selection isn't in widget .e}} 882test spinbox-8.8 {DeleteChars procedure} { 883 .e delete 0 end 884 .e insert 0 0123456789abcde 885 .e select from 3 886 .e select to 8 887 .e delete 3 7 888 update 889 set x "[.e index sel.first] [.e index sel.last]" 890 .e select to 8 891 lappend x [.e index sel.first] [.e index sel.last] 892} {3 4 3 8} 893test spinbox-8.9 {DeleteChars procedure} { 894 .e delete 0 end 895 .e insert 0 0123456789abcde 896 .e select from 3 897 .e select to 8 898 .e delete 3 8 899 list [catch {.e index sel.first} msg] $msg 900} {1 {selection isn't in widget .e}} 901test spinbox-8.10 {DeleteChars procedure} { 902 .e delete 0 end 903 .e insert 0 0123456789abcde 904 .e select from 8 905 .e select to 3 906 .e delete 5 8 907 update 908 set x "[.e index sel.first] [.e index sel.last]" 909 .e select to 8 910 lappend x [.e index sel.first] [.e index sel.last] 911} {3 5 5 8} 912test spinbox-8.11 {DeleteChars procedure} { 913 .e delete 0 end 914 .e insert 0 0123456789abcde 915 .e select from 8 916 .e select to 3 917 .e delete 8 10 918 update 919 set x "[.e index sel.first] [.e index sel.last]" 920 .e select to 4 921 lappend x [.e index sel.first] [.e index sel.last] 922} {3 8 4 8} 923test spinbox-8.12 {DeleteChars procedure} { 924 .e delete 0 end 925 .e insert 0 0123456789abcde 926 .e icursor 4 927 .e delete 1 4 928 .e index insert 929} {1} 930test spinbox-8.13 {DeleteChars procedure} { 931 .e delete 0 end 932 .e insert 0 0123456789abcde 933 .e icursor 4 934 .e delete 1 5 935 .e index insert 936} {1} 937test spinbox-8.14 {DeleteChars procedure} { 938 .e delete 0 end 939 .e insert 0 0123456789abcde 940 .e icursor 4 941 .e delete 4 6 942 .e index insert 943} {4} 944test spinbox-8.15 {DeleteChars procedure} { 945 .e delete 0 end 946 .e insert 0 "This is a very long string" 947 .e xview 4 948 .e delete 1 4 949 .e index @0 950} {1} 951test spinbox-8.16 {DeleteChars procedure} { 952 .e delete 0 end 953 .e insert 0 "This is a very long string" 954 .e xview 4 955 .e delete 1 5 956 .e index @0 957} {1} 958test spinbox-8.17 {DeleteChars procedure} { 959 .e delete 0 end 960 .e insert 0 "This is a very long string" 961 .e xview 4 962 .e delete 4 6 963 .e index @0 964} {4} 965.e configure -width 0 966test spinbox-8.18 {DeleteChars procedure} {fonts} { 967 .e delete 0 end 968 .e insert 0 "xyzzy" 969 update 970 .e delete 2 4 971 winfo reqwidth .e 972} {42} 973 974test spinbox-9.1 {SpinboxValueChanged procedure} { 975 catch {destroy .e} 976 proc override args { 977 global x 978 set x 12345 979 } 980 catch {unset x} 981 trace variable x w override 982 spinbox .e -textvariable x 983 .e insert 0 foo 984 set result [list $x [.e get]] 985 unset x; rename override {} 986 set result 987} {12345 12345} 988 989catch {destroy .e} 990spinbox .e 991pack .e 992.e configure -width 0 993test spinbox-10.1 {SpinboxSetValue procedure} {fonts} { 994 set x abcde 995 set y ab 996 .e configure -textvariable x 997 update 998 .e configure -textvariable y 999 update 1000 list [.e get] [winfo reqwidth .e] 1001} {ab 35} 1002test spinbox-10.2 {SpinboxSetValue procedure, updating selection} { 1003 catch {destroy .e} 1004 spinbox .e -textvariable x 1005 .e insert 0 "abcdefghjklmnopqrstu" 1006 .e selection range 4 10 1007 set x "a" 1008 list [catch {.e index sel.first} msg] $msg 1009} {1 {selection isn't in widget .e}} 1010test spinbox-10.3 {SpinboxSetValue procedure, updating selection} { 1011 catch {destroy .e} 1012 spinbox .e -textvariable x 1013 .e insert 0 "abcdefghjklmnopqrstu" 1014 .e selection range 4 10 1015 set x "abcdefg" 1016 list [.e index sel.first] [.e index sel.last] 1017} {4 7} 1018test spinbox-10.4 {SpinboxSetValue procedure, updating selection} { 1019 catch {destroy .e} 1020 spinbox .e -textvariable x 1021 .e insert 0 "abcdefghjklmnopqrstu" 1022 .e selection range 4 10 1023 set x "abcdefghijklmn" 1024 list [.e index sel.first] [.e index sel.last] 1025} {4 10} 1026test spinbox-10.5 {SpinboxSetValue procedure, updating display position} { 1027 catch {destroy .e} 1028 spinbox .e -width 10 -font $fixed -textvariable x 1029 pack .e 1030 .e insert 0 "abcdefghjklmnopqrstuvwxyz" 1031 .e xview 10 1032 update 1033 set x "abcdefg" 1034 update 1035 .e index @0 1036} {0} 1037test spinbox-10.6 {SpinboxSetValue procedure, updating display position} { 1038 catch {destroy .e} 1039 spinbox .e -width 10 -font $fixed -textvariable x 1040 pack .e 1041 .e insert 0 "abcdefghjklmnopqrstuvwxyz" 1042 .e xview 10 1043 update 1044 set x "1234567890123456789012" 1045 update 1046 .e index @0 1047} {10} 1048test spinbox-10.7 {SpinboxSetValue procedure, updating insertion cursor} { 1049 catch {destroy .e} 1050 spinbox .e -width 10 -font $fixed -textvariable x 1051 pack .e 1052 .e insert 0 "abcdefghjklmnopqrstuvwxyz" 1053 .e icursor 5 1054 set x "123" 1055 .e index insert 1056} {3} 1057test spinbox-10.8 {SpinboxSetValue procedure, updating insertion cursor} { 1058 catch {destroy .e} 1059 spinbox .e -width 10 -font $fixed -textvariable x 1060 pack .e 1061 .e insert 0 "abcdefghjklmnopqrstuvwxyz" 1062 .e icursor 5 1063 set x "123456" 1064 .e index insert 1065} {5} 1066 1067test spinbox-11.1 {SpinboxEventProc procedure} { 1068 catch {destroy .e} 1069 spinbox .e 1070 .e insert 0 abcdefg 1071 destroy .e 1072 update 1073} {} 1074test spinbox-11.2 {SpinboxEventProc procedure} { 1075 deleteWindows 1076 spinbox .e1 -fg #112233 1077 rename .e1 .e2 1078 set x {} 1079 lappend x [winfo children .] 1080 lappend x [.e2 cget -fg] 1081 destroy .e1 1082 lappend x [info command .e*] [winfo children .] 1083} {.e1 #112233 {} {}} 1084 1085test spinbox-12.1 {SpinboxCmdDeletedProc procedure} { 1086 deleteWindows 1087 button .e1 -text "xyz_123" 1088 rename .e1 {} 1089 list [info command .e*] [winfo children .] 1090} {{} {}} 1091 1092catch {destroy .e} 1093spinbox .e -font $fixed -width 5 -bd 2 -relief sunken 1094pack .e 1095.e insert 0 012345678901234567890 1096.e xview 4 1097update 1098test spinbox-13.1 {GetSpinboxIndex procedure} { 1099 .e index end 1100} {21} 1101test spinbox-13.2 {GetSpinboxIndex procedure} { 1102 list [catch {.e index abogus} msg] $msg 1103} {1 {bad spinbox index "abogus"}} 1104test spinbox-13.3 {GetSpinboxIndex procedure} { 1105 .e select from 1 1106 .e select to 6 1107 .e index anchor 1108} {1} 1109test spinbox-13.4 {GetSpinboxIndex procedure} { 1110 .e select from 4 1111 .e select to 1 1112 .e index anchor 1113} {4} 1114test spinbox-13.5 {GetSpinboxIndex procedure} { 1115 .e select from 3 1116 .e select to 15 1117 .e select adjust 4 1118 .e index anchor 1119} {15} 1120test spinbox-13.6 {GetSpinboxIndex procedure} { 1121 list [catch {.e index ebogus} msg] $msg 1122} {1 {bad spinbox index "ebogus"}} 1123test spinbox-13.7 {GetSpinboxIndex procedure} { 1124 .e icursor 2 1125 .e index insert 1126} {2} 1127test spinbox-13.8 {GetSpinboxIndex procedure} { 1128 list [catch {.e index ibogus} msg] $msg 1129} {1 {bad spinbox index "ibogus"}} 1130test spinbox-13.9 {GetSpinboxIndex procedure} { 1131 .e select from 1 1132 .e select to 6 1133 list [.e index sel.first] [.e index sel.last] 1134} {1 6} 1135selection clear .e 1136test spinbox-13.10 {GetSpinboxIndex procedure} unix { 1137 # On unix, when selection is cleared, spinbox widget's internal 1138 # selection range is reset. 1139 1140 list [catch {.e index sel.first} msg] $msg 1141} {1 {selection isn't in widget .e}} 1142test spinbox-13.11 {GetSpinboxIndex procedure} win { 1143 # On mac and pc, when selection is cleared, spinbox widget remembers 1144 # last selected range. When selection ownership is restored to 1145 # spinbox, the old range will be rehighlighted. 1146 1147 list [catch {selection get}] [.e index sel.first] 1148} {1 1} 1149test spinbox-13.12 {GetSpinboxIndex procedure} unix { 1150 list [catch {.e index sbogus} msg] $msg 1151} {1 {selection isn't in widget .e}} 1152test spinbox-13.13 {GetSpinboxIndex procedure} win { 1153 list [catch {.e index sbogus} msg] $msg 1154} {1 {bad spinbox index "sbogus"}} 1155test spinbox-13.14 {GetSpinboxIndex procedure} win { 1156 list [catch {selection get}] [catch {.e index sbogus}] 1157} {1 1} 1158test spinbox-13.15 {GetSpinboxIndex procedure} { 1159 list [catch {.e index @xyz} msg] $msg 1160} {1 {bad spinbox index "@xyz"}} 1161test spinbox-13.16 {GetSpinboxIndex procedure} {fonts} { 1162 .e index @4 1163} {4} 1164test spinbox-13.17 {GetSpinboxIndex procedure} {fonts} { 1165 .e index @11 1166} {4} 1167test spinbox-13.18 {GetSpinboxIndex procedure} {fonts} { 1168 .e index @12 1169} {5} 1170test spinbox-13.19 {GetSpinboxIndex procedure} {fonts} { 1171 # 11 is the minimum button width 1172 .e index @[expr [winfo width .e] - 6 - 11] 1173} {8} 1174test spinbox-13.20 {GetSpinboxIndex procedure} {fonts} { 1175 .e index @[expr [winfo width .e] - 5] 1176} {9} 1177test spinbox-13.21 {GetSpinboxIndex procedure} { 1178 .e index @1000 1179} {9} 1180test spinbox-13.22 {GetSpinboxIndex procedure} { 1181 list [catch {.e index 1xyz} msg] $msg 1182} {1 {bad spinbox index "1xyz"}} 1183test spinbox-13.23 {GetSpinboxIndex procedure} { 1184 .e index -10 1185} {0} 1186test spinbox-13.24 {GetSpinboxIndex procedure} { 1187 .e index 12 1188} {12} 1189test spinbox-13.25 {GetSpinboxIndex procedure} { 1190 .e index 49 1191} {21} 1192 1193# XXX Still need to write tests for SpinboxScanTo and SpinboxSelectTo. 1194 1195set x {} 1196for {set i 1} {$i <= 500} {incr i} { 1197 append x "This is line $i, out of 500\n" 1198} 1199test spinbox-14.1 {SpinboxFetchSelection procedure} { 1200 catch {destroy .e} 1201 spinbox .e 1202 .e insert end "This is a test string" 1203 .e select from 1 1204 .e select to 18 1205 selection get 1206} {his is a test str} 1207test spinbox-14.3 {SpinboxFetchSelection procedure} { 1208 catch {destroy .e} 1209 spinbox .e 1210 .e insert end $x 1211 .e select from 0 1212 .e select to end 1213 string compare [selection get] $x 1214} 0 1215 1216test spinbox-15.1 {SpinboxLostSelection} { 1217 catch {destroy .e} 1218 spinbox .e 1219 .e insert 0 "Text" 1220 .e select from 0 1221 .e select to 4 1222 set result [selection get] 1223 selection clear 1224 .e select from 0 1225 .e select to 4 1226 lappend result [selection get] 1227} {Text Text} 1228 1229# No tests for EventuallyRedraw. 1230 1231catch {destroy .e} 1232spinbox .e -width 10 -xscrollcommand scroll 1233pack .e 1234update 1235 1236test spinbox-16.1 {SpinboxVisibleRange procedure} {fonts} { 1237 .e delete 0 end 1238 .e insert 0 ............................. 1239 format {%.6f %.6f} {*}[.e xview] 1240} {0.000000 0.827586} 1241test spinbox-16.2 {SpinboxVisibleRange procedure} { 1242 .e delete 0 end 1243 format {%.6f %.6f} {*}[.e xview] 1244} {0.000000 1.000000} 1245 1246catch {destroy .e} 1247spinbox .e -width 10 -xscrollcommand scroll -font $fixed 1248pack .e 1249update 1250test spinbox-17.1 {SpinboxUpdateScrollbar procedure} { 1251 .e delete 0 end 1252 .e insert 0 123 1253 update 1254 format {%.6f %.6f} {*}$scrollInfo 1255} {0.000000 1.000000} 1256test spinbox-17.2 {SpinboxUpdateScrollbar procedure} { 1257 .e delete 0 end 1258 .e insert 0 0123456789abcdef 1259 .e xview 3 1260 update 1261 format {%.6f %.6f} {*}$scrollInfo 1262} {0.187500 0.812500} 1263test spinbox-17.3 {SpinboxUpdateScrollbar procedure} { 1264 .e delete 0 end 1265 .e insert 0 abcdefghijklmnopqrs 1266 .e xview 6 1267 update 1268 format {%.6f %.6f} {*}$scrollInfo 1269} {0.315789 0.842105} 1270test spinbox-17.4 {SpinboxUpdateScrollbar procedure} { 1271 destroy .e 1272 set x "Background error did not happen" 1273 proc bgerror msg { 1274 global x 1275 set x $msg 1276 } 1277 spinbox .e -width 5 -xscrollcommand thisisnotacommand 1278 pack .e 1279 update 1280 rename bgerror {} 1281 list $x $errorInfo 1282} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" 1283 while executing 1284"thisisnotacommand 0.0 1.0" 1285 (horizontal scrolling command executed by .e)}} 1286 1287set l [interp hidden] 1288deleteWindows 1289 1290test spinbox-18.1 {Spinbox widget vs hiding} { 1291 destroy .e 1292 spinbox .e 1293 interp hide {} .e 1294 destroy .e 1295 list [winfo children .] [interp hidden] 1296} [list {} $l] 1297 1298## 1299## Spinbox widget VALIDATION tests 1300## 1301 1302destroy .e 1303catch {unset ::e} 1304catch {unset ::vVals} 1305spinbox .e -validate all \ 1306 -validatecommand [list doval %W %d %i %P %s %S %v %V] \ 1307 -invalidcommand bell \ 1308 -textvariable ::e \ 1309 -background red -foreground white 1310pack .e 1311proc doval {W d i P s S v V} { 1312 set ::vVals [list $W $d $i $P $s $S $v $V] 1313 return 1 1314} 1315 1316# The validation tests build each one upon the previous, so cascading 1317# failures aren't good 1318# 1319test spinbox-19.1 {spinbox widget validation} { 1320 .e insert 0 a 1321 set ::vVals 1322} {.e 1 0 a {} a all key} 1323test spinbox-19.2 {spinbox widget validation} { 1324 .e insert 1 b 1325 set ::vVals 1326} {.e 1 1 ab a b all key} 1327test spinbox-19.3 {spinbox widget validation} { 1328 .e insert end c 1329 set ::vVals 1330} {.e 1 2 abc ab c all key} 1331test spinbox-19.4 {spinbox widget validation} { 1332 .e insert 1 123 1333 list $::vVals $::e 1334} {{.e 1 1 a123bc abc 123 all key} a123bc} 1335test spinbox-19.5 {spinbox widget validation} { 1336 .e delete 2 1337 set ::vVals 1338} {.e 0 2 a13bc a123bc 2 all key} 1339test spinbox-19.6 {spinbox widget validation} { 1340 .e configure -validate key 1341 .e delete 1 3 1342 set ::vVals 1343} {.e 0 1 abc a13bc 13 key key} 1344test spinbox-19.7 {spinbox widget validation} { 1345 set ::vVals {} 1346 .e configure -validate focus 1347 .e insert end d 1348 set ::vVals 1349} {} 1350test spinbox-19.8 {spinbox widget validation} { 1351 focus -force .e 1352 # update necessary to process FocusIn event 1353 update 1354 set ::vVals 1355} {.e -1 -1 abcd abcd {} focus focusin} 1356test spinbox-19.9 {spinbox widget validation} { 1357 focus -force . 1358 # update necessary to process FocusOut event 1359 update 1360 set ::vVals 1361} {.e -1 -1 abcd abcd {} focus focusout} 1362.e configure -validate all 1363test spinbox-19.10 {spinbox widget validation} { 1364 focus -force .e 1365 # update necessary to process FocusIn event 1366 update 1367 set ::vVals 1368} {.e -1 -1 abcd abcd {} all focusin} 1369test spinbox-19.11 {spinbox widget validation} { 1370 focus -force . 1371 # update necessary to process FocusOut event 1372 update 1373 set ::vVals 1374} {.e -1 -1 abcd abcd {} all focusout} 1375.e configure -validate focusin 1376test spinbox-19.12 {spinbox widget validation} { 1377 focus -force .e 1378 # update necessary to process FocusIn event 1379 update 1380 set ::vVals 1381} {.e -1 -1 abcd abcd {} focusin focusin} 1382test spinbox-19.13 {spinbox widget validation} { 1383 set ::vVals {} 1384 focus -force . 1385 # update necessary to process FocusOut event 1386 update 1387 set ::vVals 1388} {} 1389.e configure -validate focuso 1390test spinbox-19.14 {spinbox widget validation} { 1391 focus -force .e 1392 # update necessary to process FocusIn event 1393 update 1394 set ::vVals 1395} {} 1396test spinbox-19.15 {spinbox widget validation} { 1397 focus -force . 1398 # update necessary to process FocusOut event 1399 update 1400 set ::vVals 1401} {.e -1 -1 abcd abcd {} focusout focusout} 1402test spinbox-19.16 {spinbox widget validation} { 1403 list [.e validate] $::vVals 1404} {1 {.e -1 -1 abcd abcd {} all forced}} 1405test spinbox-19.17 {spinbox widget validation} { 1406 set ::e newdata 1407 list [.e cget -validate] $::vVals 1408} {focusout {.e -1 -1 newdata abcd {} focusout forced}} 1409 1410proc doval {W d i P s S v V} { 1411 set ::vVals [list $W $d $i $P $s $S $v $V] 1412 return 0 1413} 1414.e configure -validate all 1415 1416test spinbox-19.18 {spinbox widget validation} { 1417 set ::e nextdata 1418 list [.e cget -validate] $::vVals 1419} {none {.e -1 -1 nextdata newdata {} all forced}} 1420 1421proc doval {W d i P s S v V} { 1422 set ::vVals [list $W $d $i $P $s $S $v $V] 1423 set ::e mydata 1424 return 1 1425} 1426.e configure -validate all 1427 1428## This sets validate to none because it shows that we prevent a possible 1429## loop condition in the validation, when the spinbox textvar is also set 1430test spinbox-19.19 {spinbox widget validation} { 1431 .e validate 1432 list [.e cget -validate] [.e get] $::vVals 1433} {none mydata {.e -1 -1 nextdata nextdata {} all forced}} 1434 1435.e configure -validate all 1436 1437## This leaves validate alone because we trigger validation through the 1438## textvar (a write trace), and the write during validation triggers 1439## nothing (by definition of avoiding loops on var traces). This is 1440## one of those "dangerous" conditions where the user will have a 1441## different value in the spinbox widget shown as is in the textvar. 1442test spinbox-19.20 {spinbox widget validation} { 1443 set ::e testdata 1444 list [.e cget -validate] [.e get] $::e $::vVals 1445} {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} 1446 1447# A format specifier is allowed to be of the form %[-+ 0]{0,1}\d.?\d?f 1448# 1449destroy .e 1450spinbox .e 1451test spinbox-20.1 {spinbox config, -format specifier} { 1452 list [catch {.e config -format %2f} msg] $msg 1453} {0 {}} 1454test spinbox-20.2 {spinbox config, -format specifier} { 1455 list [catch {.e config -format %2.2f} msg] $msg 1456} {0 {}} 1457test spinbox-20.3 {spinbox config, -format specifier} { 1458 list [catch {.e config -format %.2f} msg] $msg 1459} {0 {}} 1460test spinbox-20.4 {spinbox config, -format specifier} { 1461 list [catch {.e config -format %2.f} msg] $msg 1462} {0 {}} 1463test spinbox-20.5 {spinbox config, -format specifier} { 1464 list [catch {.e config -format %2e-1f} msg] $msg 1465} {1 {bad spinbox format specifier "%2e-1f"}} 1466test spinbox-20.6 {spinbox config, -format specifier} { 1467 list [catch {.e config -format 2.2} msg] $msg 1468} {1 {bad spinbox format specifier "2.2"}} 1469test spinbox-20.7 {spinbox config, -format specifier} { 1470 list [catch {.e config -format %2.-2f} msg] $msg 1471} {1 {bad spinbox format specifier "%2.-2f"}} 1472test spinbox-20.8 {spinbox config, -format specifier} { 1473 list [catch {.e config -format %-2.02f} msg] $msg 1474} {0 {}} 1475test spinbox-20.9 {spinbox config, -format specifier} { 1476 list [catch {.e config -format "% 2.02f"} msg] $msg 1477} {0 {}} 1478test spinbox-20.10 {spinbox config, -format specifier} { 1479 list [catch {.e config -format "% -2.200f"} msg] $msg 1480} {0 {}} 1481test spinbox-20.11 {spinbox config, -format specifier} { 1482 list [catch {.e config -format "%09.200f"} msg] $msg 1483} {0 {}} 1484test spinbox-20.12 {spinbox config, -format specifier does something} { 1485 set out {} 1486 .e config -format "%02.f" 1487 .e config -values {} -from 0 -to 10 -increment 1 1488 lappend out [.e set 0]; # set currently doesn't force format 1489 .e invoke buttonup 1490 lappend out [.e set]; # but after invoke it should be formatted 1491 lappend out [.e set 3]; # set currently doesn't force format 1492 .e config -format "%03.f" 1493 lappend out [.e set]; # changing -format should cause formatting 1494} {0 01 3 003} 1495 1496test spinbox-21.1 {spinbox button, out of range checking} { 1497 destroy .e 1498 spinbox .e -from -10 -to 20 -increment 2 1499 set out {} 1500 lappend out [.e get]; # -10 1501 .e delete 0 end 1502 .e insert 0 25; # set outside of range 1503 .e invoke buttondown; # should constrain 1504 lappend out [.e get]; # 20 1505 .e delete 0 end 1506 .e insert 0 25; # set outside of range 1507 .e invoke buttonup; # should constrain 1508 lappend out [.e get]; # 20 1509 .e delete 0 end 1510 .e insert 0 -100; # set outside of range 1511 .e invoke buttonup; # should constrain 1512 lappend out [.e get]; # -10 1513 .e delete 0 end 1514 .e insert 0 -100; # set outside of range 1515 .e invoke buttondown; # should constrain 1516 lappend out [.e get]; # -10 1517 .e delete 0 end 1518 .e insert 0 bogus; # set to a bogus value 1519 .e invoke buttondown; # should use fromValue 1520 lappend out [.e get]; # -10 1521 .e delete 0 end 1522 .e insert 0 19; # set just inside of range 1523 .e invoke buttonup; # no wrap 1524 lappend out [.e get]; # 20 1525 .e invoke buttonup; # no wrap 1526 lappend out [.e get]; # 20 1527 .e invoke buttondown 1528 lappend out [.e get]; # 18 1529 .e delete 0 end 1530 .e insert 0 -9; # set just inside of range 1531 .e invoke buttondown; # no wrap 1532 lappend out [.e get]; # -10 1533 .e invoke buttondown; # no wrap 1534 lappend out [.e get]; # -10 1535 .e invoke buttonup; # no wrap 1536 lappend out [.e get]; # -8 1537 1538 .e configure -wrap 1 1539 .e delete 0 end 1540 .e insert 0 19; # set just inside of range 1541 .e invoke buttonup; # wrap 1542 lappend out [.e get]; # -10 1543 .e invoke buttonup 1544 lappend out [.e get]; # -8 1545 .e invoke buttondown 1546 lappend out [.e get]; # -10 1547 .e delete 0 end 1548 .e insert 0 -9; # set just inside of range 1549 .e invoke buttondown; # wrap 1550 lappend out [.e get]; # 20 1551 .e invoke buttondown 1552 lappend out [.e get]; # 18 1553 .e invoke buttonup; # no wrap 1554 lappend out [.e get]; # 20 1555 1556} {-10 20 20 -10 -10 -10 20 20 18 -10 -10 -8 -10 -8 -10 20 18 20} 1557 1558test spinbox-22.1 {spinbox config, -from changes SF bug 559078} { 1559 set val 5 1560 destroy .s 1561 spinbox .s -from 1 -to 10 -textvariable val 1562 set val 1563} {5} 1564test spinbox-22.2 {spinbox config, -from changes SF bug 559078} { 1565 .s configure -from 3 -to 10 1566 set val 1567} {5} 1568test spinbox-22.3 {spinbox config, -from changes SF bug 559078} { 1569 .s configure -from 6 -to 10 1570 set val 1571} {6} 1572 1573test entry-23.1 {selection present while disabled, bug 637828} { 1574 destroy .e 1575 entry .e 1576 .e insert end 0123456789 1577 .e select from 3 1578 .e select to 6 1579 set out [.e selection present] 1580 .e configure -state disabled 1581 # still return 1 when disabled, because 'selection get' will work, 1582 # but selection cannot be changed (new behavior since 8.4) 1583 .e select to 9 1584 lappend out [.e selection present] [selection get] 1585} {1 1 345} 1586 1587destroy .e 1588catch {unset ::e ::vVals} 1589 1590## 1591## End validation tests 1592## 1593 1594# XXX Still need to write tests for SpinboxBlinkProc, SpinboxFocusProc, 1595# and SpinboxTextVarProc. 1596 1597option clear 1598 1599# cleanup 1600cleanupTests 1601return 1602