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