tk/tests/entry.test

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