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