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