# This file is a Tcl script to test entry widgets in Tk. It is # organized in the standard fashion for Tcl tests. # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: entry.test,v 1.8 2000/05/14 20:45:38 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } if {[lsearch [image types] test] < 0} { puts "This application hasn't been compiled with the \"test\"" puts "image, so I can't run this test. Are you sure you're using" puts "tktest instead of wish?" ::tcltest::cleanupTests return } foreach i [winfo children .] { destroy $i } wm geometry . {} raise . proc scroll args { global scrollInfo set scrollInfo $args } # Create additional widget that's used to hold the selection at times. entry .sel .sel insert end "This is some sample text" # Font names set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1 set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1 # Create entries in the option database to be sure that geometry options # like border width have predictable values. option add *Entry.borderWidth 2 option add *Entry.highlightThickness 2 option add *Entry.font {Helvetica -12} entry .e -bd 2 -relief sunken pack .e update set i 1 foreach test { {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-bd 4 4 badValue {bad screen distance "badValue"}} {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} {-cursor arrow arrow badValue {bad cursor spec "badValue"}} {-disabledbackground green green non-existent {unknown color name "non-existent"}} {-disabledforeground blue blue non-existent {unknown color name "non-existent"}} {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}} {-fg #110022 #110022 bogus {unknown color name "bogus"}} {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* {} {font "" doesn't exist}} {-foreground #110022 #110022 bogus {unknown color name "bogus"}} {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}} {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}} {-highlightthickness 6 6 bogus {bad screen distance "bogus"}} {-highlightthickness -2 0 {} {}} {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}} {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}} {-insertofftime 100 100 3.2 {expected integer but got "3.2"}} {-insertontime 100 100 3.2 {expected integer but got "3.2"}} {-justify right right bogus {bad justification "bogus": must be left, right, or center}} {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}} {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}} {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}} {-show * * {} {}} {-state n normal bogus {bad state "bogus": must be disabled, normal, or readonly}} {-takefocus "any string" "any string" {} {}} {-textvariable i i {} {}} {-width 402 402 3p {expected integer but got "3p"}} {-xscrollcommand {Some command} {Some command} {} {}} } { set name [lindex $test 0] test entry-1.$i {configuration options} { .e configure $name [lindex $test 1] list [lindex [.e configure $name] 4] [.e cget $name] } [list [lindex $test 2] [lindex $test 2]] incr i if {[lindex $test 3] != ""} { test entry-1.$i {configuration options} { list [catch {.e configure $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } .e configure $name [lindex [.e configure $name] 3] incr i } test entry-2.1 {Tk_EntryCmd procedure} { list [catch {entry} msg] $msg } {1 {wrong # args: should be "entry pathName ?options?"}} test entry-2.2 {Tk_EntryCmd procedure} { list [catch {entry gorp} msg] $msg } {1 {bad window path name "gorp"}} test entry-2.3 {Tk_EntryCmd procedure} { catch {destroy .e} entry .e list [winfo exists .e] [winfo class .e] [info commands .e] } {1 Entry .e} test entry-2.4 {Tk_EntryCmd procedure} { catch {destroy .e} list [catch {entry .e -gorp foo} msg] $msg [winfo exists .e] \ [info commands .e] } {1 {unknown option "-gorp"} 0 {}} test entry-2.5 {Tk_EntryCmd procedure} { catch {destroy .e} entry .e } {.e} catch {destroy .e} entry .e -font $fixed pack .e update set cx [font measure $fixed a] set cy [font metrics $fixed -linespace] set ux [font measure $fixed \u4e4e] test entry-3.1 {EntryWidgetCmd procedure} { list [catch {.e} msg] $msg } {1 {wrong # args: should be ".e option ?arg arg ...?"}} test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} { list [catch {.e bbox} msg] $msg } {1 {wrong # args: should be ".e bbox index"}} test entry-3.3 {EntryWidgetCmd procedure, "bbox" widget command} { list [catch {.e bbox a b} msg] $msg } {1 {wrong # args: should be ".e bbox index"}} test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} { list [catch {.e bbox bogus} msg] $msg } {1 {bad entry index "bogus"}} test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} { .e delete 0 end .e bbox 0 } [list 5 5 0 $cy] test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} { # Tcl_UtfAtIndex(): no utf chars .e delete 0 end .e insert 0 "abc" list [.e bbox 3] [.e bbox end] } [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"] test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} { # Tcl_UtfAtIndex(): utf at end .e delete 0 end .e insert 0 "ab\u4e4e" .e bbox end } "[expr 5+2*$cx] 5 $ux $cy" test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} { # Tcl_UtfAtIndex(): utf before index .e delete 0 end .e insert 0 "ab\u4e4ec" .e bbox 3 } "[expr 5+2*$cx+$ux] 5 $cx $cy" test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} { # Tcl_UtfAtIndex(): no chars .e delete 0 end .e bbox end } "5 5 0 $cy" test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} { .e delete 0 end .e insert 0 "abcdefghij\u4e4eklmnop" list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end] } [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"] test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} { list [catch {.e cget} msg] $msg } {1 {wrong # args: should be ".e cget option"}} test entry-3.12 {EntryWidgetCmd procedure, "cget" widget command} { list [catch {.e cget a b} msg] $msg } {1 {wrong # args: should be ".e cget option"}} test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} { list [catch {.e cget -gorp} msg] $msg } {1 {unknown option "-gorp"}} test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} { .e configure -bd 4 .e cget -bd } {4} test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} { llength [.e configure] } {35} test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} { list [catch {.e configure -foo} msg] $msg } {1 {unknown option "-foo"}} test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} { .e configure -bd 4 .e configure -bg #ffffff lindex [.e configure -bd] 4 } {4} test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} { list [catch {.e delete} msg] $msg } {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} { list [catch {.e delete a b c} msg] $msg } {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} { list [catch {.e delete foo} msg] $msg } {1 {bad entry index "foo"}} test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} { list [catch {.e delete 0 bar} msg] $msg } {1 {bad entry index "bar"}} test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} { .e delete 0 end .e insert end "01234567890" .e delete 2 4 .e get } {014567890} test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} { .e delete 0 end .e insert end "01234567890" .e delete 6 .e get } {0123457890} test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} { # UTF set x {} .e delete 0 end .e insert end "01234\u4e4e67890" .e delete 6 lappend x [.e get] .e delete 0 end .e insert end "012345\u4e4e7890" .e delete 6 lappend x [.e get] .e delete 0 end .e insert end "0123456\u4e4e890" .e delete 6 lappend x [.e get] } [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"] test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} { .e delete 0 end .e insert end "01234567890" .e delete 6 5 .e get } {01234567890} test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} { .e delete 0 end .e insert end "01234567890" .e configure -state disabled .e delete 2 8 .e configure -state normal .e get } {01234567890} test entry-3.27 {EntryWidgetCmd procedure, "delete" widget command} { .e delete 0 end .e insert end "01234567890" .e configure -state readonly .e delete 2 8 .e configure -state normal .e get } {01234567890} test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} { list [catch {.e get foo} msg] $msg } {1 {wrong # args: should be ".e get"}} test entry-3.28 {EntryWidgetCmd procedure, "icursor" widget command} { list [catch {.e icursor} msg] $msg } {1 {wrong # args: should be ".e icursor pos"}} test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} { list [catch {.e icursor foo} msg] $msg } {1 {bad entry index "foo"}} test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} { .e delete 0 end .e insert end "01234567890" .e icursor 4 .e index insert } {4} test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e in} msg] $msg } {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}} test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e index} msg] $msg } {1 {wrong # args: should be ".e index string"}} test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e index foo} msg] $msg } {1 {bad entry index "foo"}} test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e index 0} msg] $msg } {0 0} test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} { # UTF .e delete 0 end .e insert 0 abc\u4e4e\u0153def list [.e index 3] [.e index 4] [.e index end] } {3 4 8} test entry-3.36 {EntryWidgetCmd procedure, "insert" widget command} { list [catch {.e insert a} msg] $msg } {1 {wrong # args: should be ".e insert index text"}} test entry-3.37 {EntryWidgetCmd procedure, "insert" widget command} { list [catch {.e insert a b c} msg] $msg } {1 {wrong # args: should be ".e insert index text"}} test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} { list [catch {.e insert foo Text} msg] $msg } {1 {bad entry index "foo"}} test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} { .e delete 0 end .e insert end "01234567890" .e insert 3 xxx .e get } {012xxx34567890} test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} { .e delete 0 end .e insert end "01234567890" .e configure -state disabled .e insert 3 xxx .e configure -state normal .e get } {01234567890} test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} { .e delete 0 end .e insert end "01234567890" .e configure -state readonly .e insert 3 xxx .e configure -state normal .e get } {01234567890} test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} { list [catch {.e insert a b c} msg] $msg } {1 {wrong # args: should be ".e insert index text"}} test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} { list [catch {.e scan a} msg] $msg } {1 {wrong # args: should be ".e scan mark|dragto x"}} test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} { list [catch {.e scan a b c} msg] $msg } {1 {wrong # args: should be ".e scan mark|dragto x"}} test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} { list [catch {.e scan foobar 20} msg] $msg } {1 {bad scan option "foobar": must be mark or dragto}} test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} { list [catch {.e scan mark 20.1} msg] $msg } {1 {expected integer but got "20.1"}} # This test is non-portable because character sizes vary. test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} {fonts} { .e delete 0 end update .e insert end "This is quite a long string, in fact a " .e insert end "very very long string" .e scan mark 30 .e scan dragto 28 .e index @0 } {2} test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} { list [catch {.e select} msg] $msg } {1 {wrong # args: should be ".e selection option ?index?"}} test entry-3.48 {EntryWidgetCmd procedure, "select" widget command} { list [catch {.e select foo} msg] $msg } {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}} test entry-3.49 {EntryWidgetCmd procedure, "select clear" widget command} { list [catch {.e select clear gorp} msg] $msg } {1 {wrong # args: should be ".e selection clear"}} test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} { .e delete 0 end .e insert end "0123456789" .e select from 1 .e select to 4 update .e select clear list [catch {selection get} msg] $msg [selection own] } {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e} test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} { list [catch {.e selection present foo} msg] $msg } {1 {wrong # args: should be ".e selection present"}} test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 .e select to 6 .e selection present } {1} test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 .e select to 6 .e configure -exportselection false .e selection present } {1} .e configure -exportselection true test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 .e select to 6 .e delete 0 end .e selection present } {0} test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} { list [catch {.e select adjust x} msg] $msg } {1 {bad entry index "x"}} test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} { list [catch {.e select adjust 2 3} msg] $msg } {1 {wrong # args: should be ".e selection adjust index"}} test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e delete 0 end .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 4 selection get } {123} test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e delete 0 end .e insert end "0123456789" .e select from 1 .e select to 5 update .e select adjust 2 selection get } {234} test entry-3.59 {EntryWidgetCmd procedure, "selection from" widget command} { list [catch {.e select from 2 3} msg] $msg } {1 {wrong # args: should be ".e selection from index"}} test entry-3.60 {EntryWidgetCmd procedure, "selection range" widget command} { list [catch {.e select range 2} msg] $msg } {1 {wrong # args: should be ".e selection range start end"}} test entry-3.61 {EntryWidgetCmd procedure, "selection range" widget command} { list [catch {.e selection range 2 3 4} msg] $msg } {1 {wrong # args: should be ".e selection range start end"}} test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 1 .e select to 5 .e select range 4 4 list [catch {.e index sel.first} msg] $msg } {1 {selection isn't in entry}} test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 .e select to 7 .e select range 2 9 list [.e index sel.first] [.e index sel.last] [.e index anchor] } {2 9 3} test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} { .e delete 0 end .e insert end 0123456789 .e selection range 0 end .e configure -state disabled .e selection range 2 4 .e configure -state normal list [.e index sel.first] [.e index sel.last] } {0 10} test entry-3.64 {EntryWidgetCmd procedure, "selection" widget command} { .e delete 0 end .e insert end 0123456789 .e selection range 0 end .e configure -state readonly .e selection range 2 4 .e configure -state normal list [.e index sel.first] [.e index sel.last] } {2 4} .e delete 0 end .e insert end "This is quite a long text string, so long that it " .e insert end "runs off the end of the window quite a bit." test entry-3.64 {EntryWidgetCmd procedure, "selection to" widget command} { list [catch {.e select to 2 3} msg] $msg } {1 {wrong # args: should be ".e selection to index"}} test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 5 .e xview } {0.0537634 0.268817} test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} { list [catch {.e xview gorp} msg] $msg } {1 {bad entry index "gorp"}} test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 0 .e icursor 10 .e xview insert .e xview } {0.107527 0.322581} test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} { list [catch {.e xview moveto foo bar} msg] $msg } {1 {wrong # args: should be ".e xview moveto fraction"}} test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} { list [catch {.e xview moveto foo} msg] $msg } {1 {expected floating-point number but got "foo"}} test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} { .e xview moveto 0.5 .e xview } {0.505376 0.72043} test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} { list [catch {.e xview scroll 24} msg] $msg } {1 {wrong # args: should be ".e xview scroll number units|pages"}} test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} { list [catch {.e xview scroll gorp units} msg] $msg } {1 {expected integer but got "gorp"}} test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} { .e xview moveto 0 .e xview scroll 1 pages .e xview } {0.193548 0.408602} test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} { .e xview moveto .9 update .e xview scroll -2 p .e xview } {0.397849 0.612903} test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 30 update .e xview scroll 2 units .e index @0 } {32} test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 30 update .e xview scroll -1 units .e index @0 } {29} test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} { list [catch {.e xview scroll 23 foobars} msg] $msg } {1 {bad argument "foobars": must be units or pages}} test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} { list [catch {.e xview eat 23 hamburgers} msg] $msg } {1 {unknown option "eat": must be moveto or scroll}} test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 0 update .e xview -4 .e index @0 } {0} test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 300 .e index @0 } {73} .e insert 10 \u4e4e test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} { # UTF # If Tcl_NumUtfChars wasn't used, wrong answer would be: # 0.106383 0.117021 0.117021 set x {} .e xview moveto .1 lappend x [lindex [.e xview] 0] .e xview moveto .11 lappend x [lindex [.e xview] 0] .e xview moveto .12 lappend x [lindex [.e xview] 0] } {0.0957447 0.106383 0.117021} test entry-3.82 {EntryWidgetCmd procedure} { list [catch {.e gorp} msg] $msg } {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, validate, or xview}} # The test below doesn't actually check anything directly, but if run # with Purify or some other memory-allocation-checking program it will # ensure that resources get properly freed. test entry-4.1 {DestroyEntry procedure} { catch {destroy .e} entry .e -textvariable x -show * pack .e .e insert end "Sample text" update destroy .e } {} frame .f -width 200 -height 50 -relief raised -bd 2 pack .f -side right test entry-5.1 {ConfigureEntry procedure, -textvariable} { catch {destroy .e} set x 12345 entry .e -textvariable x .e get } {12345} test entry-5.2 {ConfigureEntry procedure, -textvariable} { catch {destroy .e} set x 12345 entry .e -textvariable x set y abcde .e configure -textvariable y set x 54321 .e get } {abcde} test entry-5.3 {ConfigureEntry procedure, -textvariable} { catch {destroy .e} catch {unset x} entry .e .e insert 0 "Some text" .e configure -textvariable x set x } {Some text} test entry-5.4 {ConfigureEntry procedure, -textvariable} { proc override args { global x set x 12345 } catch {destroy .e} catch {unset x} trace variable x w override entry .e .e insert 0 "Some text" .e configure -textvariable x set result [list $x [.e get]] unset x; rename override {} set result } {12345 12345} test entry-5.5 {ConfigureEntry procedure} { catch {destroy .e} entry .e -exportselection false pack .e .e insert end "0123456789" .sel select from 0 .sel select to 10 set x {} lappend x [selection get] .e select from 1 .e select to 5 lappend x [selection get] .e configure -exportselection 1 lappend x [selection get] set x } {{This is so} {This is so} 1234} test entry-5.6 {ConfigureEntry procedure} { catch {destroy .e} entry .e pack .e .e insert end "0123456789" .e select from 1 .e select to 5 .e configure -exportselection 0 list [catch {selection get} msg] $msg [.e index sel.first] \ [.e index sel.last] } {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5} test entry-5.7 {ConfigureEntry procedure} { catch {destroy .e} entry .e -font $fixed -width 4 -xscrollcommand scroll pack .e .e insert end "01234567890" update .e configure -width 5 set scrollInfo } {0 0.363636} test entry-5.8 {ConfigureEntry procedure} {fonts} { catch {destroy .e} entry .e -width 0 pack .e .e insert end "0123" update .e configure -font $big update winfo geom .e } {62x37+0+0} test entry-5.9 {ConfigureEntry procedure} {fonts} { catch {destroy .e} entry .e -font $fixed -bd 2 -relief raised pack .e .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] } {0 0 1 1} test entry-5.10 {ConfigureEntry procedure} {fonts} { catch {destroy .e} entry .e -font $fixed -bd 2 -relief flat pack .e .e insert end "0123" update list [.e index @10] [.e index @11] [.e index @12] [.e index @13] } {0 0 1 1} test entry-5.11 {ConfigureEntry procedure} { # If "0" in selected font had 0 width, caused divide-by-zero error. catch {destroy .e} pack [entry .e -font {{open look glyph}}] .e scan dragto 30 update } {} # No tests for DisplayEntry. test entry-6.1 {EntryComputeGeometry procedure} {fonts} { catch {destroy .e} entry .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3 pack .e .e insert end 012\t45 update list [.e index @61] [.e index @62] } {3 4} test entry-6.2 {EntryComputeGeometry procedure} {fonts} { catch {destroy .e} entry .e -font $fixed -bd 2 -relief raised -width 20 -justify center \ -highlightthickness 3 pack .e .e insert end 012\t45 update list [.e index @96] [.e index @97] } {3 4} test entry-6.3 {EntryComputeGeometry procedure} {fonts} { catch {destroy .e} entry .e -font $fixed -bd 2 -relief raised -width 20 -justify right \ -highlightthickness 3 pack .e .e insert end 012\t45 update list [.e index @131] [.e index @132] } {3 4} test entry-6.4 {EntryComputeGeometry procedure} { catch {destroy .e} entry .e -font $fixed -bd 2 -relief raised -width 5 pack .e .e insert end "01234567890" update .e xview 6 .e index @0 } {6} test entry-6.5 {EntryComputeGeometry procedure} { catch {destroy .e} entry .e -font $fixed -bd 2 -relief raised -width 5 pack .e .e insert end "01234567890" update .e xview 7 .e index @0 } {6} test entry-6.6 {EntryComputeGeometry procedure} {fonts} { catch {destroy .e} entry .e -font $fixed -bd 2 -relief raised -width 10 pack .e .e insert end "01234\t67890" update .e xview 3 list [.e index @39] [.e index @40] } {5 6} test entry-6.7 {EntryComputeGeometry procedure} {fonts} { catch {destroy .e} entry .e -font $big -bd 3 -relief raised -width 5 pack .e .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] } {77 39} test entry-6.8 {EntryComputeGeometry procedure} {fonts} { catch {destroy .e} entry .e -font $big -bd 3 -relief raised -width 0 pack .e .e insert end "01234567" update list [winfo reqwidth .e] [winfo reqheight .e] } {116 39} test entry-6.9 {EntryComputeGeometry procedure} {fonts} { catch {destroy .e} entry .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2 pack .e update list [winfo reqwidth .e] [winfo reqheight .e] } {25 39} test entry-6.10 {EntryComputeGeometry procedure} {unixOnly fonts} { catch {destroy .e} entry .e -bd 1 -relief raised -width 0 -show . .e insert 0 12345 pack .e update set x [winfo reqwidth .e] .e configure -show X lappend x [winfo reqwidth .e] .e configure -show "" lappend x [winfo reqwidth .e] } {23 53 43} test entry-6.11 {EntryComputeGeometry procedure} {pcOnly} { catch {destroy .e} entry .e -bd 1 -relief raised -width 0 -show . -font {helvetica 12} .e insert 0 12345 pack .e update set x [winfo reqwidth .e] .e configure -show X lappend x [winfo reqwidth .e] .e configure -show "" lappend x [winfo reqwidth .e] } [list \ [expr 8+5*[font measure {helvetica 12} .]] \ [expr 8+5*[font measure {helvetica 12} X]] \ [expr 8+[font measure {helvetica 12} 12345]]] catch {destroy .e} entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll pack .e focus .e test entry-7.1 {InsertChars procedure} { .e delete 0 end .e insert 0 abcde .e insert 2 XXX update list [.e get] $contents $scrollInfo } {abXXXcde abXXXcde {0 1}} test entry-7.2 {InsertChars procedure} { .e delete 0 end .e insert 0 abcde .e insert 500 XXX update list [.e get] $contents $scrollInfo } {abcdeXXX abcdeXXX {0 1}} test entry-7.3 {InsertChars procedure} { .e delete 0 end .e insert 0 0123456789 .e select from 2 .e select to 6 .e insert 2 XXX set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] } {5 9 5 8} test entry-7.4 {InsertChars procedure} { .e delete 0 end .e insert 0 0123456789 .e select from 2 .e select to 6 .e insert 3 XXX set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] } {2 9 2 8} test entry-7.5 {InsertChars procedure} { .e delete 0 end .e insert 0 0123456789 .e select from 2 .e select to 6 .e insert 5 XXX set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] } {2 9 2 8} test entry-7.6 {InsertChars procedure} { .e delete 0 end .e insert 0 0123456789 .e select from 2 .e select to 6 .e insert 6 XXX set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] } {2 6 2 5} test entry-7.7 {InsertChars procedure} { .e delete 0 end .e insert 0 0123456789 .e icursor 4 .e insert 4 XXX .e index insert } {7} test entry-7.8 {InsertChars procedure} { .e delete 0 end .e insert 0 0123456789 .e icursor 4 .e insert 5 XXX .e index insert } {4} test entry-7.9 {InsertChars procedure} { .e delete 0 end .e insert 0 "This is a very long string" update .e xview 4 .e insert 3 XXX .e index @0 } {7} test entry-7.10 {InsertChars procedure} { .e delete 0 end .e insert 0 "This is a very long string" update .e xview 4 .e insert 4 XXX .e index @0 } {4} .e configure -width 0 test entry-7.11 {InsertChars procedure} {fonts} { .e delete 0 end .e insert 0 "xyzzy" update .e insert 2 00 winfo reqwidth .e } {59} .e configure -width 10 test entry-8.1 {DeleteChars procedure} { .e delete 0 end .e insert 0 abcde .e delete 2 4 update list [.e get] $contents $scrollInfo } {abe abe {0 1}} test entry-8.2 {DeleteChars procedure} { .e delete 0 end .e insert 0 abcde .e delete -2 2 update list [.e get] $contents $scrollInfo } {cde cde {0 1}} test entry-8.3 {DeleteChars procedure} { .e delete 0 end .e insert 0 abcde .e delete 3 1000 update list [.e get] $contents $scrollInfo } {abc abc {0 1}} test entry-8.4 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 1 3 update set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] } {1 6 1 5} test entry-8.5 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 1 4 update set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] } {1 5 1 4} test entry-8.6 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 1 7 update set x "[.e index sel.first] [.e index sel.last]" .e select to 5 lappend x [.e index sel.first] [.e index sel.last] } {1 2 1 5} test entry-8.7 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 1 8 list [catch {.e index sel.first} msg] $msg } {1 {selection isn't in entry}} test entry-8.8 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 3 7 update set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] } {3 4 3 8} test entry-8.9 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e select from 3 .e select to 8 .e delete 3 8 list [catch {.e index sel.first} msg] $msg } {1 {selection isn't in entry}} test entry-8.10 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e select from 8 .e select to 3 .e delete 5 8 update set x "[.e index sel.first] [.e index sel.last]" .e select to 8 lappend x [.e index sel.first] [.e index sel.last] } {3 5 5 8} test entry-8.11 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e select from 8 .e select to 3 .e delete 8 10 update set x "[.e index sel.first] [.e index sel.last]" .e select to 4 lappend x [.e index sel.first] [.e index sel.last] } {3 8 4 8} test entry-8.12 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e icursor 4 .e delete 1 4 .e index insert } {1} test entry-8.13 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e icursor 4 .e delete 1 5 .e index insert } {1} test entry-8.14 {DeleteChars procedure} { .e delete 0 end .e insert 0 0123456789abcde .e icursor 4 .e delete 4 6 .e index insert } {4} test entry-8.15 {DeleteChars procedure} { .e delete 0 end .e insert 0 "This is a very long string" .e xview 4 .e delete 1 4 .e index @0 } {1} test entry-8.16 {DeleteChars procedure} { .e delete 0 end .e insert 0 "This is a very long string" .e xview 4 .e delete 1 5 .e index @0 } {1} test entry-8.17 {DeleteChars procedure} { .e delete 0 end .e insert 0 "This is a very long string" .e xview 4 .e delete 4 6 .e index @0 } {4} .e configure -width 0 test entry-8.18 {DeleteChars procedure} {fonts} { .e delete 0 end .e insert 0 "xyzzy" update .e delete 2 4 winfo reqwidth .e } {31} test entry-9.1 {EntryValueChanged procedure} { catch {destroy .e} proc override args { global x set x 12345 } catch {unset x} trace variable x w override entry .e -textvariable x .e insert 0 foo set result [list $x [.e get]] unset x; rename override {} set result } {12345 12345} catch {destroy .e} entry .e pack .e .e configure -width 0 test entry-10.1 {EntrySetValue procedure} {fonts} { set x abcde set y ab .e configure -textvariable x update .e configure -textvariable y update list [.e get] [winfo reqwidth .e] } {ab 24} test entry-10.2 {EntrySetValue procedure, updating selection} { catch {destroy .e} entry .e -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "a" list [catch {.e index sel.first} msg] $msg } {1 {selection isn't in entry}} test entry-10.3 {EntrySetValue procedure, updating selection} { catch {destroy .e} entry .e -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefg" list [.e index sel.first] [.e index sel.last] } {4 7} test entry-10.4 {EntrySetValue procedure, updating selection} { catch {destroy .e} entry .e -textvariable x .e insert 0 "abcdefghjklmnopqrstu" .e selection range 4 10 set x "abcdefghijklmn" list [.e index sel.first] [.e index sel.last] } {4 10} test entry-10.5 {EntrySetValue procedure, updating display position} { catch {destroy .e} entry .e -width 10 -font $fixed -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 update set x "abcdefg" update .e index @0 } {0} test entry-10.6 {EntrySetValue procedure, updating display position} { catch {destroy .e} entry .e -width 10 -font $fixed -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e xview 10 update set x "1234567890123456789012" update .e index @0 } {10} test entry-10.7 {EntrySetValue procedure, updating insertion cursor} { catch {destroy .e} entry .e -width 10 -font $fixed -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123" .e index insert } {3} test entry-10.8 {EntrySetValue procedure, updating insertion cursor} { catch {destroy .e} entry .e -width 10 -font $fixed -textvariable x pack .e .e insert 0 "abcdefghjklmnopqrstuvwxyz" .e icursor 5 set x "123456" .e index insert } {5} test entry-11.1 {EntryEventProc procedure} { catch {destroy .e} entry .e .e insert 0 abcdefg destroy .e update } {} test entry-11.2 {EntryEventProc procedure} { eval destroy [winfo children .] entry .e1 -fg #112233 rename .e1 .e2 set x {} lappend x [winfo children .] lappend x [.e2 cget -fg] destroy .e1 lappend x [info command .e*] [winfo children .] } {.e1 #112233 {} {}} test entry-12.1 {EntryCmdDeletedProc procedure} { eval destroy [winfo children .] button .e1 -text "xyz_123" rename .e1 {} list [info command .e*] [winfo children .] } {{} {}} catch {destroy .e} entry .e -font $fixed -width 5 -bd 2 -relief sunken pack .e .e insert 0 012345678901234567890 .e xview 4 update test entry-13.1 {GetEntryIndex procedure} { .e index end } {21} test entry-13.2 {GetEntryIndex procedure} { list [catch {.e index abogus} msg] $msg } {1 {bad entry index "abogus"}} test entry-13.3 {GetEntryIndex procedure} { .e select from 1 .e select to 6 .e index anchor } {1} test entry-13.4 {GetEntryIndex procedure} { .e select from 4 .e select to 1 .e index anchor } {4} test entry-13.5 {GetEntryIndex procedure} { .e select from 3 .e select to 15 .e select adjust 4 .e index anchor } {15} test entry-13.6 {GetEntryIndex procedure} { list [catch {.e index ebogus} msg] $msg } {1 {bad entry index "ebogus"}} test entry-13.7 {GetEntryIndex procedure} { .e icursor 2 .e index insert } {2} test entry-13.8 {GetEntryIndex procedure} { list [catch {.e index ibogus} msg] $msg } {1 {bad entry index "ibogus"}} test entry-13.9 {GetEntryIndex procedure} { .e select from 1 .e select to 6 list [.e index sel.first] [.e index sel.last] } {1 6} selection clear .e test entry-13.10 {GetEntryIndex procedure} {unixOnly} { # On unix, when selection is cleared, entry widget's internal # selection range is reset. list [catch {.e index sel.first} msg] $msg } {1 {selection isn't in entry}} test entry-13.11 {GetEntryIndex procedure} {macOrPc} { # On mac and pc, when selection is cleared, entry widget remembers # last selected range. When selection ownership is restored to # entry, the old range will be rehighlighted. list [catch {selection get}] [.e index sel.first] } {1 1} test entry-13.12 {GetEntryIndex procedure} {unixOnly} { list [catch {.e index sbogus} msg] $msg } {1 {selection isn't in entry}} test entry-13.13 {GetEntryIndex procedure} {macOrPc} { list [catch {.e index sbogus} msg] $msg } {1 {bad entry index "sbogus"}} test entry-13.14 {GetEntryIndex procedure} {macOrPc} { list [catch {selection get}] [catch {.e index sbogus}] } {1 1} test entry-13.15 {GetEntryIndex procedure} { list [catch {.e index @xyz} msg] $msg } {1 {bad entry index "@xyz"}} test entry-13.16 {GetEntryIndex procedure} {fonts} { .e index @4 } {4} test entry-13.17 {GetEntryIndex procedure} {fonts} { .e index @11 } {4} test entry-13.18 {GetEntryIndex procedure} {fonts} { .e index @12 } {5} test entry-13.19 {GetEntryIndex procedure} {fonts} { .e index @[expr [winfo width .e] - 6] } {8} test entry-13.20 {GetEntryIndex procedure} {fonts} { .e index @[expr [winfo width .e] - 5] } {9} test entry-13.21 {GetEntryIndex procedure} { .e index @1000 } {9} test entry-13.22 {GetEntryIndex procedure} { list [catch {.e index 1xyz} msg] $msg } {1 {bad entry index "1xyz"}} test entry-13.23 {GetEntryIndex procedure} { .e index -10 } {0} test entry-13.24 {GetEntryIndex procedure} { .e index 12 } {12} test entry-13.25 {GetEntryIndex procedure} { .e index 49 } {21} test entry-13.26 {GetEntryIndex procedure} {fonts} { catch {destroy .e} entry .e -show . .e insert 0 XXXYZZY pack .e update list [.e index @7] [.e index @8] } {0 1} # XXX Still need to write tests for EntryScanTo and EntrySelectTo. set x {} for {set i 1} {$i <= 500} {incr i} { append x "This is line $i, out of 500\n" } test entry-14.1 {EntryFetchSelection procedure} { catch {destroy .e} entry .e .e insert end "This is a test string" .e select from 1 .e select to 18 selection get } {his is a test str} test entry-14.2 {EntryFetchSelection procedure} { catch {destroy .e} entry .e -show * .e insert end "This is a test string" .e select from 1 .e select to 18 selection get } {*****************} test entry-14.3 {EntryFetchSelection procedure} { catch {destroy .e} entry .e .e insert end $x .e select from 0 .e select to end string compare [selection get] $x } 0 test entry-15.1 {EntryLostSelection} { catch {destroy .e} entry .e .e insert 0 "Text" .e select from 0 .e select to 4 set result [selection get] selection clear .e select from 0 .e select to 4 lappend result [selection get] } {Text Text} # No tests for EventuallyRedraw. catch {destroy .e} entry .e -width 10 -xscrollcommand scroll pack .e update test entry-16.1 {EntryVisibleRange procedure} {fonts} { .e delete 0 end .e insert 0 ............................. .e xview } {0 0.827586} test entry-15.2 {EntryVisibleRange procedure} {unixOnly fonts} { .e configure -show X .e delete 0 end .e insert 0 ............................. .e xview } {0 0.275862} test entry-15.3 {EntryVisibleRange procedure} {pcOnly} { .e configure -show . .e delete 0 end .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX .e xview } {0 0.827586} .e configure -show "" test entry-15.4 {EntryVisibleRange procedure} { .e delete 0 end .e xview } {0 1} catch {destroy .e} entry .e -width 10 -xscrollcommand scroll -font $fixed pack .e update test entry-17.1 {EntryUpdateScrollbar procedure} { .e delete 0 end .e insert 0 123 update set scrollInfo } {0 1} test entry-17.2 {EntryUpdateScrollbar procedure} { .e delete 0 end .e insert 0 0123456789abcdef .e xview 3 update set scrollInfo } {0.1875 0.8125} test entry-17.3 {EntryUpdateScrollbar procedure} { .e delete 0 end .e insert 0 abcdefghijklmnopqrs .e xview 6 update set scrollInfo } {0.315789 0.842105} test entry-17.4 {EntryUpdateScrollbar procedure} { destroy .e proc bgerror msg { global x set x $msg } entry .e -width 5 -xscrollcommand thisisnotacommand pack .e update rename bgerror {} list $x $errorInfo } {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand" while executing "thisisnotacommand 0 1" (horizontal scrolling command executed by entry)}} set l [interp hidden] eval destroy [winfo children .] test entry-18.1 {Entry widget vs hiding} { destroy .e entry .e interp hide {} .e destroy .e list [winfo children .] [interp hidden] } [list {} $l] ## ## Entry widget VALIDATION tests ## destroy .e catch {unset ::e} catch {unset ::vVals} entry .e -validate all \ -validatecommand [list doval %W %d %i %P %s %S %v %V] \ -invalidcommand bell \ -textvariable ::e \ -background red -foreground white pack .e proc doval {W d i P s S v V} { set ::vVals [list $W $d $i $P $s $S $v $V] return 1 } # The validation tests build each one upon the previous, so cascading # failures aren't good # test entry-19.1 {entry widget validation} { .e insert 0 a set ::vVals } {.e 1 0 a {} a all key} test entry-19.2 {entry widget validation} { .e insert 1 b set ::vVals } {.e 1 1 ab a b all key} test entry-19.3 {entry widget validation} { .e insert end c set ::vVals } {.e 1 2 abc ab c all key} test entry-19.4 {entry widget validation} { .e insert 1 123 list $::vVals $::e } {{.e 1 1 a123bc abc 123 all key} a123bc} test entry-19.5 {entry widget validation} { .e delete 2 set ::vVals } {.e 0 2 a13bc a123bc 2 all key} test entry-19.6 {entry widget validation} { .e configure -validate key .e delete 1 3 set ::vVals } {.e 0 1 abc a13bc 13 key key} test entry-19.7 {entry widget validation} { set ::vVals {} .e configure -validate focus .e insert end d set ::vVals } {} test entry-19.8 {entry widget validation} { focus -force .e # update necessary to process FocusIn event update set ::vVals } {.e -1 -1 abcd abcd {} focus focusin} test entry-19.9 {entry widget validation} { focus -force . # update necessary to process FocusOut event update set ::vVals } {.e -1 -1 abcd abcd {} focus focusout} .e configure -validate all test entry-19.10 {entry widget validation} { focus -force .e # update necessary to process FocusIn event update set ::vVals } {.e -1 -1 abcd abcd {} all focusin} test entry-19.11 {entry widget validation} { focus -force . # update necessary to process FocusOut event update set ::vVals } {.e -1 -1 abcd abcd {} all focusout} .e configure -validate focusin test entry-19.12 {entry widget validation} { focus -force .e # update necessary to process FocusIn event update set ::vVals } {.e -1 -1 abcd abcd {} focusin focusin} test entry-19.13 {entry widget validation} { set ::vVals {} focus -force . # update necessary to process FocusOut event update set ::vVals } {} .e configure -validate focuso test entry-19.14 {entry widget validation} { focus -force .e # update necessary to process FocusIn event update set ::vVals } {} test entry-19.15 {entry widget validation} { focus -force . # update necessary to process FocusOut event update set ::vVals } {.e -1 -1 abcd abcd {} focusout focusout} test entry-19.16 {entry widget validation} { list [.e validate] $::vVals } {1 {.e -1 -1 abcd abcd {} all forced}} test entry-19.17 {entry widget validation} { set ::e newdata list [.e cget -validate] $::vVals } {focusout {.e -1 -1 newdata abcd {} focusout forced}} proc doval {W d i P s S v V} { set ::vVals [list $W $d $i $P $s $S $v $V] return 0 } .e configure -validate all test entry-19.18 {entry widget validation} { set ::e nextdata list [.e cget -validate] $::vVals } {none {.e -1 -1 nextdata newdata {} all forced}} proc doval {W d i P s S v V} { set ::vVals [list $W $d $i $P $s $S $v $V] set ::e mydata return 1 } .e configure -validate all ## This sets validate to none because it shows that we prevent a possible ## loop condition in the validation, when the entry textvar is also set test entry-19.19 {entry widget validation} { .e validate list [.e cget -validate] [.e get] $::vVals } {none mydata {.e -1 -1 nextdata nextdata {} all forced}} .e configure -validate all ## This leaves validate alone because we trigger validation through the ## textvar (a write trace), and the write during validation triggers ## nothing (by definition of avoiding loops on var traces). This is ## one of those "dangerous" conditions where the user will have a ## different value in the entry widget shown as is in the textvar. test entry-19.20 {entry widget validation} { set ::e testdata list [.e cget -validate] [.e get] $::e $::vVals } {all testdata mydata {.e -1 -1 testdata mydata {} all forced}} destroy .e catch {unset ::e ::vVals} ## ## End validation tests ## # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, # and EntryTextVarProc. option clear # cleanup ::tcltest::cleanupTests return