diff options
Diffstat (limited to 'tests/entry.test')
| -rw-r--r-- | tests/entry.test | 1269 |
1 files changed, 1269 insertions, 0 deletions
diff --git a/tests/entry.test b/tests/entry.test new file mode 100644 index 0000000..950d278 --- /dev/null +++ b/tests/entry.test @@ -0,0 +1,1269 @@ +# 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. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) entry.test 1.49 97/11/07 09:34:31 + +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?" + return +} + +if {[info procs test] != "test"} { + source defs +} + +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"}} + {-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 type "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 normal normal bogus {bad state value "bogus": must be normal or disabled}} + {-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.1 {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.2 {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] + +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} {fonts} { + .e delete 0 end + .e insert 0 "abcdefghijklmnop" + list [.e bbox 0] [.e bbox 1] [.e bbox end] +} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+15*$cx] 5 $cx $cy"] +test entry-3.7 {EntryWidgetCmd procedure, "cget" widget command} { + list [catch {.e cget} msg] $msg +} {1 {wrong # args: should be ".e cget option"}} +test entry-3.8 {EntryWidgetCmd procedure, "cget" widget command} { + list [catch {.e cget a b} msg] $msg +} {1 {wrong # args: should be ".e cget option"}} +test entry-3.9 {EntryWidgetCmd procedure, "cget" widget command} { + list [catch {.e cget -gorp} msg] $msg +} {1 {unknown option "-gorp"}} +test entry-3.10 {EntryWidgetCmd procedure, "cget" widget command} { + .e configure -bd 4 + .e cget -bd +} {4} +test entry-3.11 {EntryWidgetCmd procedure, "configure" widget command} { + llength [.e configure] +} {28} +test entry-3.12 {EntryWidgetCmd procedure, "configure" widget command} { + list [catch {.e configure -foo} msg] $msg +} {1 {unknown option "-foo"}} +test entry-3.13 {EntryWidgetCmd procedure, "configure" widget command} { + .e configure -bd 4 + .e configure -bg #ffffff + lindex [.e configure -bd] 4 +} {4} +test entry-3.14 {EntryWidgetCmd procedure, "delete" widget command} { + list [catch {.e delete} msg] $msg +} {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}} +test entry-3.15 {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.16 {EntryWidgetCmd procedure, "delete" widget command} { + list [catch {.e delete foo} msg] $msg +} {1 {bad entry index "foo"}} +test entry-3.17 {EntryWidgetCmd procedure, "delete" widget command} { + list [catch {.e delete 0 bar} msg] $msg +} {1 {bad entry index "bar"}} +test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e delete 2 4 + .e get +} {014567890} +test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e delete 6 + .e get +} {0123457890} +test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e delete 6 5 + .e get +} {01234567890} +test entry-3.21 {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.22 {EntryWidgetCmd procedure, "get" widget command} { + list [catch {.e get foo} msg] $msg +} {1 {wrong # args: should be ".e get"}} +test entry-3.23 {EntryWidgetCmd procedure, "icursor" widget command} { + list [catch {.e icursor} msg] $msg +} {1 {wrong # args: should be ".e icursor pos"}} +test entry-3.24 {EntryWidgetCmd procedure, "icursor" widget command} { + list [catch {.e icursor foo} msg] $msg +} {1 {bad entry index "foo"}} +test entry-3.25 {EntryWidgetCmd procedure, "icursor" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e icursor 4 + .e index insert +} {4} +test entry-3.26 {EntryWidgetCmd procedure, "index" widget command} { + list [catch {.e in} msg] $msg +} {1 {bad option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}} +test entry-3.27 {EntryWidgetCmd procedure, "index" widget command} { + list [catch {.e index} msg] $msg +} {1 {wrong # args: should be ".e index string"}} +test entry-3.28 {EntryWidgetCmd procedure, "index" widget command} { + list [catch {.e index foo} msg] $msg +} {1 {bad entry index "foo"}} +test entry-3.29 {EntryWidgetCmd procedure, "index" widget command} { + list [catch {.e index 0} msg] $msg +} {0 0} +test entry-3.30 {EntryWidgetCmd procedure, "insert" widget command} { + list [catch {.e insert a} msg] $msg +} {1 {wrong # args: should be ".e insert index text"}} +test entry-3.31 {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.32 {EntryWidgetCmd procedure, "insert" widget command} { + list [catch {.e insert foo Text} msg] $msg +} {1 {bad entry index "foo"}} +test entry-3.33 {EntryWidgetCmd procedure, "insert" widget command} { + .e delete 0 end + .e insert end "01234567890" + .e insert 3 xxx + .e get +} {012xxx34567890} +test entry-3.34 {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.35 {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.36 {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.37 {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.38 {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.39 {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.40 {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.41 {EntryWidgetCmd procedure, "select" widget command} { + list [catch {.e select} msg] $msg +} {1 {wrong # args: should be ".e select option ?index?"}} +test entry-3.42 {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.43 {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.44 {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.45 {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.46 {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.47 {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.48 {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.49 {EntryWidgetCmd procedure, "selection adjust" widget command} { + list [catch {.e select adjust x} msg] $msg +} {1 {bad entry index "x"}} +test entry-3.50 {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.51 {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.52 {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.53 {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.54 {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.55 {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.56 {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.57 {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} +.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.58 {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.59 {EntryWidgetCmd procedure, "xview" widget command} { + .e xview 5 + .e xview +} {0.0537634 0.268817} +test entry-3.60 {EntryWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview gorp} msg] $msg +} {1 {bad entry index "gorp"}} +test entry-3.61 {EntryWidgetCmd procedure, "xview" widget command} { + .e xview 0 + .e icursor 10 + .e xview insert + .e xview +} {0.107527 0.322581} +test entry-3.62 {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.63 {EntryWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview moveto foo} msg] $msg +} {1 {expected floating-point number but got "foo"}} +test entry-3.64 {EntryWidgetCmd procedure, "xview" widget command} { + .e xview moveto 0.5 + .e xview +} {0.505376 0.72043} +test entry-3.65 {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.66 {EntryWidgetCmd procedure, "xview" widget command} { + list [catch {.e xview scroll gorp units} msg] $msg +} {1 {expected integer but got "gorp"}} +test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} { + .e xview moveto 0 + .e xview scroll 1 pages + .e xview +} {0.193548 0.408602} +test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} { + .e xview moveto .9 + update + .e xview scroll -2 p + .e xview +} {0.397849 0.612903} +test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} { + .e xview 30 + update + .e xview scroll 2 units + .e index @0 +} {32} +test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} { + .e xview 30 + update + .e xview scroll -1 units + .e index @0 +} {29} +test entry-3.71 {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.72 {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.73 {EntryWidgetCmd procedure, "xview" widget command} { + .e xview 0 + update + .e xview -4 + .e index @0 +} {0} +test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} { + .e xview 300 + .e index @0 +} {73} +test entry-3.75 {EntryWidgetCmd procedure} { + list [catch {.e gorp} msg] $msg +} {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, 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} {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} + +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} {pc} { + .e index sel.first +} {1} +test entry-13.11 {GetEntryIndex procedure} {!pc} { + list [catch {.e index sel.first} msg] $msg +} {1 {selection isn't in entry}} +test entry-13.12 {GetEntryIndex procedure} {pc} { + list [catch {.e index sbogus} msg] $msg +} {1 {bad entry index "sbogus"}} +test entry-13.13 {GetEntryIndex procedure} {!pc} { + list [catch {.e index sbogus} msg] $msg +} {1 {selection isn't in entry}} +test entry-13.14 {GetEntryIndex procedure} { + list [catch {.e index @xyz} msg] $msg +} {1 {bad entry index "@xyz"}} +test entry-13.15 {GetEntryIndex procedure} {fonts} { + .e index @4 +} {4} +test entry-13.16 {GetEntryIndex procedure} {fonts} { + .e index @11 +} {4} +test entry-13.17 {GetEntryIndex procedure} {fonts} { + .e index @12 +} {5} +test entry-13.18 {GetEntryIndex procedure} {fonts} { + .e index @[expr [winfo width .e] - 6] +} {8} +test entry-13.19 {GetEntryIndex procedure} {fonts} { + .e index @[expr [winfo width .e] - 5] +} {9} +test entry-13.20 {GetEntryIndex procedure} { + .e index @1000 +} {9} +test entry-13.21 {GetEntryIndex procedure} { + list [catch {.e index 1xyz} msg] $msg +} {1 {bad entry index "1xyz"}} +test entry-13.22 {GetEntryIndex procedure} { + .e index -10 +} {0} +test entry-13.23 {GetEntryIndex procedure} { + .e index 12 +} {12} +test entry-13.24 {GetEntryIndex procedure} { + .e index 49 +} {21} +test entry-13.25 {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-16.2 {EntryVisibleRange procedure} {fonts} { + .e configure -show X + .e delete 0 end + .e insert 0 ............................. + .e xview +} {0 0.275862} +.e configure -show "" +test entry-16.3 {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} { + catch {destroy .e} + proc bgerror msg { + global x + set x $msg + } + entry .e -width 5 -xscrollcommand bogus + pack .e + update + rename bgerror {} + list $x $errorInfo +} {{invalid command name "bogus"} {invalid command name "bogus" + while executing +"bogus 0 1" + (horizontal scrolling command executed by entry)}} + +set l [interp hidden] +eval destroy [winfo children .] + +test entry-18.1 {Entry widget vs hiding} { + catch {destroy .e} + entry .e + interp hide {} .e + destroy .e + list [winfo children .] [interp hidden] +} [list {} $l] + +# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, +# and EntryTextVarProc. + + +option clear |