diff options
author | stanton <stanton> | 1999-04-16 01:51:06 (GMT) |
---|---|---|
committer | stanton <stanton> | 1999-04-16 01:51:06 (GMT) |
commit | 03656f44f81469f459031fa3a4a7b09c8bc77712 (patch) | |
tree | 31378e81bd58f8c726fc552d6b30cbf3ca07497b /tests/entry.test | |
parent | 404fc236f34304df53b7e44bc7971d786b87d453 (diff) | |
download | tk-03656f44f81469f459031fa3a4a7b09c8bc77712.zip tk-03656f44f81469f459031fa3a4a7b09c8bc77712.tar.gz tk-03656f44f81469f459031fa3a4a7b09c8bc77712.tar.bz2 |
* Merged 8.1 branch into the main trunk
Diffstat (limited to 'tests/entry.test')
-rw-r--r-- | tests/entry.test | 329 |
1 files changed, 219 insertions, 110 deletions
diff --git a/tests/entry.test b/tests/entry.test index 551404c..107df62 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -3,23 +3,23 @@ # # 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. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: entry.test,v 1.2 1998/09/14 18:23:45 stanton Exp $ +# RCS: @(#) $Id: entry.test,v 1.3 1999/04/16 01:51:37 stanton 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 } -if {[info procs test] != "test"} { - source defs -} - foreach i [winfo children .] { destroy $i } @@ -51,6 +51,7 @@ 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 @@ -74,25 +75,25 @@ foreach test { {-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}} + {-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 normal normal bogus {bad state value "bogus": must be normal or disabled}} + {-state normal normal bogus {bad state "bogus": must be disabled or normal}} {-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} { + 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.2 {configuration options} { + test entry-1.$i {configuration options} { list [catch {.e configure $name [lindex $test 3]} msg] $msg } [list 1 [lindex $test 4]] } @@ -128,6 +129,7 @@ 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 @@ -145,66 +147,106 @@ 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} { +test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} { + # Tcl_UtfAtIndex(): no utf chars + .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} { + .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.8 {EntryWidgetCmd procedure, "cget" widget command} { +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.9 {EntryWidgetCmd procedure, "cget" widget command} { +test entry-3.13 {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} { +test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} { .e configure -bd 4 .e cget -bd } {4} -test entry-3.11 {EntryWidgetCmd procedure, "configure" widget command} { +test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} { llength [.e configure] } {28} -test entry-3.12 {EntryWidgetCmd procedure, "configure" widget command} { +test entry-3.16 {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} { +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.14 {EntryWidgetCmd procedure, "delete" widget command} { +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.15 {EntryWidgetCmd procedure, "delete" widget command} { +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.16 {EntryWidgetCmd procedure, "delete" widget command} { +test entry-3.20 {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} { +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.18 {EntryWidgetCmd procedure, "delete" widget command} { +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.19 {EntryWidgetCmd procedure, "delete" widget command} { +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.20 {EntryWidgetCmd procedure, "delete" widget command} { +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.21 {EntryWidgetCmd procedure, "delete" widget command} { +test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} { .e delete 0 end .e insert end "01234567890" .e configure -state disabled @@ -212,49 +254,55 @@ test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} { .e configure -state normal .e get } {01234567890} -test entry-3.22 {EntryWidgetCmd procedure, "get" widget command} { +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.23 {EntryWidgetCmd procedure, "icursor" widget command} { +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.24 {EntryWidgetCmd procedure, "icursor" widget command} { +test entry-3.29 {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} { +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.26 {EntryWidgetCmd procedure, "index" widget command} { +test entry-3.31 {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} { +} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, 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.28 {EntryWidgetCmd procedure, "index" widget command} { +test entry-3.33 {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} { +test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} { list [catch {.e index 0} msg] $msg } {0 0} -test entry-3.30 {EntryWidgetCmd procedure, "insert" widget command} { +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.31 {EntryWidgetCmd procedure, "insert" widget command} { +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.32 {EntryWidgetCmd procedure, "insert" widget command} { +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.33 {EntryWidgetCmd procedure, "insert" widget command} { +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.34 {EntryWidgetCmd procedure, "insert" widget command} { +test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} { .e delete 0 end .e insert end "01234567890" .e configure -state disabled @@ -262,24 +310,24 @@ test entry-3.34 {EntryWidgetCmd procedure, "insert" widget command} { .e configure -state normal .e get } {01234567890} -test entry-3.35 {EntryWidgetCmd procedure, "insert" widget command} { +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.36 {EntryWidgetCmd procedure, "scan" widget command} { +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.37 {EntryWidgetCmd procedure, "scan" widget command} { +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.38 {EntryWidgetCmd procedure, "scan" widget command} { +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.39 {EntryWidgetCmd procedure, "scan" widget command} { +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.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} { +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 " @@ -288,16 +336,16 @@ test entry-3.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} { .e scan dragto 28 .e index @0 } {2} -test entry-3.41 {EntryWidgetCmd procedure, "select" widget command} { +test entry-3.47 {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} { +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.43 {EntryWidgetCmd procedure, "select clear" widget command} { +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.44 {EntryWidgetCmd procedure, "select clear" widget command} { +test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} { .e delete 0 end .e insert end "0123456789" .e select from 1 @@ -306,17 +354,17 @@ test entry-3.44 {EntryWidgetCmd procedure, "select clear" widget command} { .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} { +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.46 {EntryWidgetCmd procedure, "selection present" widget command} { +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.47 {EntryWidgetCmd procedure, "selection present" widget command} { +test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 @@ -325,7 +373,7 @@ test entry-3.47 {EntryWidgetCmd procedure, "selection present" widget command} { .e selection present } {1} .e configure -exportselection true -test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} { +test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 @@ -333,13 +381,13 @@ test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} { .e delete 0 end .e selection present } {0} -test entry-3.49 {EntryWidgetCmd procedure, "selection adjust" widget command} { +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.50 {EntryWidgetCmd procedure, "selection adjust" widget command} { +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.51 {EntryWidgetCmd procedure, "selection adjust" widget command} { +test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e delete 0 end .e insert end "0123456789" .e select from 1 @@ -348,7 +396,7 @@ test entry-3.51 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e select adjust 4 selection get } {123} -test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} { +test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e delete 0 end .e insert end "0123456789" .e select from 1 @@ -357,16 +405,16 @@ test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} { .e select adjust 2 selection get } {234} -test entry-3.53 {EntryWidgetCmd procedure, "selection from" widget command} { +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.54 {EntryWidgetCmd procedure, "selection range" widget command} { +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.55 {EntryWidgetCmd procedure, "selection range" widget command} { +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.56 {EntryWidgetCmd procedure, "selection range" widget command} { +test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 1 @@ -374,7 +422,7 @@ test entry-3.56 {EntryWidgetCmd procedure, "selection range" widget command} { .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} { +test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} { .e delete 0 end .e insert end 0123456789 .e select from 3 @@ -385,78 +433,92 @@ test entry-3.57 {EntryWidgetCmd procedure, "selection range" widget command} { .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} { +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.59 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 5 .e xview } {0.0537634 0.268817} -test entry-3.60 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.66 {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} { +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.62 {EntryWidgetCmd procedure, "xview" widget command} { +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.63 {EntryWidgetCmd procedure, "xview" widget command} { +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.64 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.70 {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} { +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.66 {EntryWidgetCmd procedure, "xview" widget command} { +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.67 {EntryWidgetCmd procedure, "xview" widget command} { +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.68 {EntryWidgetCmd procedure, "xview" widget command} { +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.69 {EntryWidgetCmd procedure, "xview" widget command} { +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.70 {EntryWidgetCmd procedure, "xview" widget command} { +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.71 {EntryWidgetCmd procedure, "xview" widget command} { +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.72 {EntryWidgetCmd procedure, "xview" widget command} { +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.73 {EntryWidgetCmd procedure, "xview" widget command} { +test entry-3.79 {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} { +test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} { .e xview 300 .e index @0 } {73} -test entry-3.75 {EntryWidgetCmd procedure} { +.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.319149} {0.117021 0.351064} {0.117021 0.351064} + + set x {} + .e xview moveto .1 + lappend x [.e xview] + .e xview moveto .11 + lappend x [.e xview] + .e xview moveto .12 + lappend x [.e xview] +} {{0.0957447 0.308511} {0.106383 0.319149} {0.117021 0.329787}} +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, or xview}} @@ -662,7 +724,7 @@ test entry-6.9 {EntryComputeGeometry procedure} {fonts} { update list [winfo reqwidth .e] [winfo reqheight .e] } {25 39} -test entry-6.10 {EntryComputeGeometry procedure} {fonts} { +test entry-6.10 {EntryComputeGeometry procedure} {unixOnly fonts} { catch {destroy .e} entry .e -bd 1 -relief raised -width 0 -show . .e insert 0 12345 @@ -674,6 +736,21 @@ test entry-6.10 {EntryComputeGeometry procedure} {fonts} { .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 @@ -1089,52 +1166,62 @@ test entry-13.9 {GetEntryIndex procedure} { 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} { +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.12 {GetEntryIndex procedure} {pc} { - list [catch {.e index sbogus} msg] $msg -} {1 {bad entry index "sbogus"}} -test entry-13.13 {GetEntryIndex procedure} {!pc} { +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.14 {GetEntryIndex procedure} { +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.15 {GetEntryIndex procedure} {fonts} { +test entry-13.16 {GetEntryIndex procedure} {fonts} { .e index @4 } {4} -test entry-13.16 {GetEntryIndex procedure} {fonts} { +test entry-13.17 {GetEntryIndex procedure} {fonts} { .e index @11 } {4} -test entry-13.17 {GetEntryIndex procedure} {fonts} { +test entry-13.18 {GetEntryIndex procedure} {fonts} { .e index @12 } {5} -test entry-13.18 {GetEntryIndex procedure} {fonts} { +test entry-13.19 {GetEntryIndex procedure} {fonts} { .e index @[expr [winfo width .e] - 6] } {8} -test entry-13.19 {GetEntryIndex procedure} {fonts} { +test entry-13.20 {GetEntryIndex procedure} {fonts} { .e index @[expr [winfo width .e] - 5] } {9} -test entry-13.20 {GetEntryIndex procedure} { +test entry-13.21 {GetEntryIndex procedure} { .e index @1000 } {9} -test entry-13.21 {GetEntryIndex procedure} { +test entry-13.22 {GetEntryIndex procedure} { list [catch {.e index 1xyz} msg] $msg } {1 {bad entry index "1xyz"}} -test entry-13.22 {GetEntryIndex procedure} { +test entry-13.23 {GetEntryIndex procedure} { .e index -10 } {0} -test entry-13.23 {GetEntryIndex procedure} { +test entry-13.24 {GetEntryIndex procedure} { .e index 12 } {12} -test entry-13.24 {GetEntryIndex procedure} { +test entry-13.25 {GetEntryIndex procedure} { .e index 49 } {21} -test entry-13.25 {GetEntryIndex procedure} {fonts} { +test entry-13.26 {GetEntryIndex procedure} {fonts} { catch {destroy .e} entry .e -show . .e insert 0 XXXYZZY @@ -1199,14 +1286,20 @@ test entry-16.1 {EntryVisibleRange procedure} {fonts} { .e insert 0 ............................. .e xview } {0 0.827586} -test entry-16.2 {EntryVisibleRange procedure} {fonts} { +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-16.3 {EntryVisibleRange procedure} { +test entry-15.4 {EntryVisibleRange procedure} { .e delete 0 end .e xview } {0 1} @@ -1265,5 +1358,21 @@ test entry-18.1 {Entry widget vs hiding} { # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc, # and EntryTextVarProc. - option clear + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + |