开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
entry.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：49k
源码类别：

通讯编程

开发平台：

Visual C++

entry.test：源码内容
  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 $
  11. package require tcltest 2.1
  12. namespace import -force tcltest::configure
  13. namespace import -force tcltest::testsDirectory
  14. configure -testdir [file join [pwd] [file dirname [info script]]]
  15. configure -loadfile [file join [testsDirectory] constraints.tcl]
  16. tcltest::loadTestedCommands
  18. proc scroll args {
  19.     global scrollInfo
  20.     set scrollInfo $args
  21. }
  23. # Create additional widget that's used to hold the selection at times.
  25. entry .sel
  26. .sel insert end "This is some sample text"
  28. # Font names
  30. set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1
  31. set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1
  33. # Create entries in the option database to be sure that geometry options
  34. # like border width have predictable values.
  36. option add *Entry.borderWidth 2
  37. option add *Entry.highlightThickness 2
  38. option add *Entry.font {Helvetica -12}
  40. entry .e -bd 2 -relief sunken
  41. pack .e
  42. update
  44. set i 1
  45. foreach 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. }
  102. test entry-2.1 {Tk_EntryCmd procedure} {
  103.     list [catch {entry} msg] $msg
  104. } {1 {wrong # args: should be "entry pathName ?options?"}}
  105. test entry-2.2 {Tk_EntryCmd procedure} {
  106.     list [catch {entry gorp} msg] $msg
  107. } {1 {bad window path name "gorp"}}
  108. test 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}
  113. test 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 {}}
  118. test entry-2.5 {Tk_EntryCmd procedure} {
  119.     catch {destroy .e}
  120.     entry .e
  121. } {.e}
  123. catch {destroy .e}
  124. entry .e -font $fixed
  125. pack .e
  126. update
  128. set cx [font measure $fixed a]
  129. set cy [font metrics $fixed -linespace]
  130. set ux [font measure $fixed u4e4e]
  132. test entry-3.1 {EntryWidgetCmd procedure} {
  133.     list [catch {.e} msg] $msg
  134. } {1 {wrong # args: should be ".e option ?arg arg ...?"}}
  135. test entry-3.2 {EntryWidgetCmd procedure, "bbox" widget command} {
  136.     list [catch {.e bbox} msg] $msg
  137. } {1 {wrong # args: should be ".e bbox index"}}
  138. test 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"}}
  141. test entry-3.4 {EntryWidgetCmd procedure, "bbox" widget command} {
  142.     list [catch {.e bbox bogus} msg] $msg
  143. } {1 {bad entry index "bogus"}}
  144. test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} {
  145.     .e delete 0 end
  146.     .e bbox 0
  147. } [list 5 5 0 $cy]
  148. test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} {
  149.     # Tcl_UtfAtIndex(): no utf chars
  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"]
  155. test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} {
  156.     # Tcl_UtfAtIndex(): utf at end
  157.     .e delete 0 end
  158.     .e insert 0 "abu4e4e"
  159.     .e bbox end
  160. } "[expr 5+2*$cx] 5 $ux $cy"
  161. test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} {
  162.     # Tcl_UtfAtIndex(): utf before index
  163.     .e delete 0 end
  164.     .e insert 0 "abu4e4ec"
  165.     .e bbox 3
  166. } "[expr 5+2*$cx+$ux] 5 $cx $cy"
  167. test 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"
  172. test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} {
  173.     .e delete 0 end
  174.     .e insert 0 "abcdefghiju4e4eklmnop"
  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"]
  177. test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} {
  178.     list [catch {.e cget} msg] $msg
  179. } {1 {wrong # args: should be ".e cget option"}}
  180. test 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"}}
  183. test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} {
  184.     list [catch {.e cget -gorp} msg] $msg
  185. } {1 {unknown option "-gorp"}}
  186. test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} {
  187.     .e configure -bd 4
  188.     .e cget -bd
  189. } {4}
  190. test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} {
  191.     llength [.e configure]
  192. } {36}
  193. test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} {
  194.     list [catch {.e configure -foo} msg] $msg
  195. } {1 {unknown option "-foo"}}
  196. test 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}
  201. test 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?"}}
  204. test 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?"}}
  207. test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} {
  208.     list [catch {.e delete foo} msg] $msg
  209. } {1 {bad entry index "foo"}}
  210. test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
  211.     list [catch {.e delete 0 bar} msg] $msg
  212. } {1 {bad entry index "bar"}}
  213. test 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}
  219. test 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}
  225. test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} {
  226.     # UTF
  227.     set x {}
  228.     .e delete 0 end
  229.     .e insert end "01234u4e4e67890"
  230.     .e delete 6
  231.     lappend x [.e get]
  232.     .e delete 0 end
  233.     .e insert end "012345u4e4e7890"
  234.     .e delete 6
  235.     lappend x [.e get]
  236.     .e delete 0 end
  237.     .e insert end "0123456u4e4e890"
  238.     .e delete 6
  239.     lappend x [.e get]
  240. } [list "01234u4e4e7890" "0123457890" "012345u4e4e890"]
  241. test 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}
  247. test 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}
  255. test 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}
  263. test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} {
  264.     list [catch {.e get foo} msg] $msg
  265. } {1 {wrong # args: should be ".e get"}}
  266. test entry-3.28 {EntryWidgetCmd procedure, "icursor" widget command} {
  267.     list [catch {.e icursor} msg] $msg
  268. } {1 {wrong # args: should be ".e icursor pos"}}
  269. test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} {
  270.     list [catch {.e icursor foo} msg] $msg
  271. } {1 {bad entry index "foo"}}
  272. test 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}
  278. test 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}}
  281. test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} {
  282.     list [catch {.e index} msg] $msg
  283. } {1 {wrong # args: should be ".e index string"}}
  284. test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} {
  285.     list [catch {.e index foo} msg] $msg
  286. } {1 {bad entry index "foo"}}
  287. test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} {
  288.     list [catch {.e index 0} msg] $msg
  289. } {0 0}
  290. test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} {
  291.     # UTF
  292.     .e delete 0 end
  293.     .e insert 0 abcu4e4eu0153def
  294.     list [.e index 3] [.e index 4] [.e index end]
  295. } {3 4 8}
  296. test 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"}}
  299. test 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"}}
  302. test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} {
  303.     list [catch {.e insert foo Text} msg] $msg
  304. } {1 {bad entry index "foo"}}
  305. test 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}
  311. test 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}
  319. test 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}
  327. test 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"}}
  330. test 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"}}
  333. test 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"}}
  336. test 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}}
  339. test 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.
  344. test 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}
  353. test 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?"}}
  356. test 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}}
  359. test 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"}}
  362. test 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}
  371. test 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"}}
  374. test 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}
  381. test 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
  390. test 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}
  398. test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} {
  399.     list [catch {.e select adjust x} msg] $msg
  400. } {1 {bad entry index "x"}}
  401. test 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"}}
  404. test 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}
  413. test 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}
  422. test 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"}}
  425. test 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"}}
  428. test 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"}}
  431. test 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}}
  439. test 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}
  447. test 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}
  456. test 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."
  468. test 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"}}
  471. test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
  472.     .e xview 5
  473.     .e xview
  474. } {0.0537634 0.268817}
  475. test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
  476.     list [catch {.e xview gorp} msg] $msg
  477. } {1 {bad entry index "gorp"}}
  478. test 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}
  484. test 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"}}
  487. test 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"}}
  490. test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} {
  491.     .e xview moveto 0.5
  492.     .e xview
  493. } {0.505376 0.72043}
  494. test 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"}}
  497. test 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"}}
  500. test 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}
  505. test 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}
  511. test 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}
  517. test 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}
  523. test 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}}
  526. test 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}}
  529. test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} {
  530.     .e xview 0
  531.     update
  532.     .e xview -4
  533.     .e index @0
  534. } {0}
  535. test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} {
  536.     .e xview 300
  537.     .e index @0
  538. } {73}
  539. .e insert 10 u4e4e
  540. test 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
  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}
  553. test 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}}
  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.
  561. test 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. } {}
  570. frame .f -width 200 -height 50 -relief raised -bd 2
  571. pack .f -side right
  572. test entry-5.1 {ConfigureEntry procedure, -textvariable} {
  573.     catch {destroy .e}
  574.     set x 12345
  575.     entry .e -textvariable x
  576.     .e get
  577. } {12345}
  578. test 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}
  587. test 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}
  595. test 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}
  610. test 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}
  626. test 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}
  637. test 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}
  646. test 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}
  656. test 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}
  664. test 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}
  672. test entry-5.11 {ConfigureEntry procedure} {
  673.     # If "0" in selected font had 0 width, caused divide-by-zero error.
  675.     catch {destroy .e}
  676.     pack [entry .e -font {{open look glyph}}]
  677.     .e scan dragto 30
  678.     update
  679. } {}    
  681. # No tests for DisplayEntry.
  683. test 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 012t45
  688.     update
  689.     list [.e index @61] [.e index @62]
  690. } {3 4}
  691. test 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 012t45
  697.     update
  698.     list [.e index @96] [.e index @97]
  699. } {3 4}
  700. test 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 012t45
  706.     update
  707.     list [.e index @131] [.e index @132]
  708. } {3 4}
  709. test 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}
  718. test 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}
  727. test 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 "01234t67890"
  732.     update
  733.     .e xview 3
  734.     list [.e index @39] [.e index @40]
  735. } {5 6}
  736. test 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}
  744. test 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}
  752. test 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}
  759. test 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}
  771. test 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]]]
  787. catch {destroy .e}
  788. entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
  789. pack .e
  790. focus .e
  791. test 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}}
  798. test 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}}
  805. test 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}
  815. test 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}
  825. test 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}
  835. test 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}
  845. test 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}
  852. test 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}
  859. test 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}
  867. test 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
  876. test 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}
  884. .e configure -width 10
  885. test 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}}
  892. test 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}}
  899. test 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}}
  906. test 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}
  917. test 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}
  928. test 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}
  939. test 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}}
  947. test 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}
  958. test 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}}
  966. test 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}
  977. test 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}
  988. test 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}
  995. test 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}
  1002. test 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}
  1009. test 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}
  1016. test 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}
  1023. test 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
  1031. test 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}
  1039. test 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}
  1054. catch {destroy .e}
  1055. entry .e
  1056. pack .e
  1057. .e configure -width 0
  1058. test 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}
  1067. test 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}}
  1075. test 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}
  1083. test 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}
  1091. test 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}
  1102. test 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}
  1113. test 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}
  1122. test 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}
  1132. test entry-11.1 {EntryEventProc procedure} {
  1133.     catch {destroy .e}
  1134.     entry .e
  1135.     .e insert 0 abcdefg
  1136.     destroy .e
  1137.     update
  1138. } {}
  1139. test 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 {} {}}
  1150. test entry-12.1 {EntryCmdDeletedProc procedure} {
  1151.     deleteWindows
  1152.     button .e1 -text "xyz_123"
  1153.     rename .e1 {}
  1154.     list [info command .e*] [winfo children .]
  1155. } {{} {}}
  1157. catch {destroy .e}
  1158. entry .e -font $fixed -width 5 -bd 2 -relief sunken
  1159. pack .e
  1160. .e insert 0 012345678901234567890
  1161. .e xview 4
  1162. update
  1163. test entry-13.1 {GetEntryIndex procedure} {
  1164.     .e index end
  1165. } {21}
  1166. test entry-13.2 {GetEntryIndex procedure} {
  1167.     list [catch {.e index abogus} msg] $msg
  1168. } {1 {bad entry index "abogus"}}
  1169. test entry-13.3 {GetEntryIndex procedure} {
  1170.     .e select from 1
  1171.     .e select to 6
  1172.     .e index anchor
  1173. } {1}
  1174. test entry-13.4 {GetEntryIndex procedure} {
  1175.     .e select from 4
  1176.     .e select to 1
  1177.     .e index anchor
  1178. } {4}
  1179. test 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}
  1185. test entry-13.6 {GetEntryIndex procedure} {
  1186.     list [catch {.e index ebogus} msg] $msg
  1187. } {1 {bad entry index "ebogus"}}
  1188. test entry-13.7 {GetEntryIndex procedure} {
  1189.     .e icursor 2
  1190.     .e index insert
  1191. } {2}
  1192. test entry-13.8 {GetEntryIndex procedure} {
  1193.     list [catch {.e index ibogus} msg] $msg
  1194. } {1 {bad entry index "ibogus"}}
  1195. test 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}
  1200. selection clear .e
  1201. test entry-13.10 {GetEntryIndex procedure} {unixOnly} {
  1202.     # On unix, when selection is cleared, entry widget's internal 
  1203.     # selection range is reset.
  1205.     list [catch {.e index sel.first} msg] $msg
  1206. } {1 {selection isn't in widget .e}}
  1207. test 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.
  1212.     list [catch {selection get}] [.e index sel.first]
  1213. } {1 1}
  1214. test entry-13.12 {GetEntryIndex procedure} {unixOnly} {
  1215.     list [catch {.e index sbogus} msg] $msg
  1216. } {1 {selection isn't in widget .e}}
  1217. test entry-13.13 {GetEntryIndex procedure} {macOrPc} {
  1218.     list [catch {.e index sbogus} msg] $msg
  1219. } {1 {bad entry index "sbogus"}}
  1220. test entry-13.14 {GetEntryIndex procedure} {macOrPc} {
  1221.     list [catch {selection get}] [catch {.e index sbogus}]
  1222. } {1 1}
  1223. test entry-13.15 {GetEntryIndex procedure} {
  1224.     list [catch {.e index @xyz} msg] $msg
  1225. } {1 {bad entry index "@xyz"}}
  1226. test entry-13.16 {GetEntryIndex procedure} {fonts} {
  1227.     .e index @4
  1228. } {4}
  1229. test entry-13.17 {GetEntryIndex procedure} {fonts} {
  1230.     .e index @11
  1231. } {4}
  1232. test entry-13.18 {GetEntryIndex procedure} {fonts} {
  1233.     .e index @12
  1234. } {5}
  1235. test entry-13.19 {GetEntryIndex procedure} {fonts} {
  1236.     .e index @[expr [winfo width .e] - 6]
  1237. } {8}
  1238. test entry-13.20 {GetEntryIndex procedure} {fonts} {
  1239.     .e index @[expr [winfo width .e] - 5]
  1240. } {9}
  1241. test entry-13.21 {GetEntryIndex procedure} {
  1242.     .e index @1000
  1243. } {9}
  1244. test entry-13.22 {GetEntryIndex procedure} {
  1245.     list [catch {.e index 1xyz} msg] $msg
  1246. } {1 {bad entry index "1xyz"}}
  1247. test entry-13.23 {GetEntryIndex procedure} {
  1248.     .e index -10
  1249. } {0}
  1250. test entry-13.24 {GetEntryIndex procedure} {
  1251.     .e index 12
  1252. } {12}
  1253. test entry-13.25 {GetEntryIndex procedure} {
  1254.     .e index 49
  1255. } {21}
  1256. test 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}
  1265. # XXX Still need to write tests for EntryScanTo and EntrySelectTo.
  1267. set x {}
  1268. for {set i 1} {$i <= 500} {incr i} {
  1269.     append x "This is line $i, out of 500n"
  1270. }
  1271. test 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}
  1279. test 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. } {*****************}
  1287. test 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
  1296. test 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}
  1309. # No tests for EventuallyRedraw.
  1311. catch {destroy .e}
  1312. entry .e -width 10 -xscrollcommand scroll
  1313. pack .e
  1314. update
  1316. test entry-16.1 {EntryVisibleRange procedure} {fonts} {
  1317.     .e delete 0 end
  1318.     .e insert 0 .............................
  1319.     .e xview
  1320. } {0 0.827586}
  1321. test 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}
  1327. test 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 ""
  1334. test entry-15.4 {EntryVisibleRange procedure} {
  1335.     .e delete 0 end
  1336.     .e xview
  1337. } {0 1}
  1339. catch {destroy .e}
  1340. entry .e -width 10 -xscrollcommand scroll -font $fixed
  1341. pack .e
  1342. update
  1343. test entry-17.1 {EntryUpdateScrollbar procedure} {
  1344.     .e delete 0 end
  1345.     .e insert 0 123
  1346.     update
  1347.     set scrollInfo
  1348. } {0 1}
  1349. test 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}
  1356. test 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}
  1363. test 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)}}
  1379. set l [interp hidden]
  1380. deleteWindows
  1382. test 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]    
  1390. ##
  1391. ## Entry widget VALIDATION tests
  1392. ##
  1394. destroy .e
  1395. catch {unset ::e}
  1396. catch {unset ::vVals}
  1397. entry .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
  1402. pack .e
  1403. proc 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. }
  1408. # The validation tests build each one upon the previous, so cascading
  1409. # failures aren't good
  1410. #
  1411. test entry-19.1 {entry widget validation} {
  1412.     .e insert 0 a
  1413.     set ::vVals
  1414. } {.e 1 0 a {} a all key}
  1415. test entry-19.2 {entry widget validation} {
  1416.     .e insert 1 b
  1417.     set ::vVals
  1418. } {.e 1 1 ab a b all key}
  1419. test entry-19.3 {entry widget validation} {
  1420.     .e insert end c
  1421.     set ::vVals
  1422. } {.e 1 2 abc ab c all key}
  1423. test 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}
  1427. test entry-19.5 {entry widget validation} {
  1428.     .e delete 2
  1429.     set ::vVals
  1430. } {.e 0 2 a13bc a123bc 2 all key}
  1431. test 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}
  1436. test entry-19.7 {entry widget validation} {
  1437.     set ::vVals {}
  1438.     .e configure -validate focus
  1439.     .e insert end d
  1440.     set ::vVals
  1441. } {}
  1442. test 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}
  1448. test 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
  1455. test 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}
  1461. test 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
  1468. test 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}
  1474. test 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
  1482. test entry-19.14 {entry widget validation} {
  1483.     focus -force .e
  1484.     # update necessary to process FocusIn event
  1485.     update
  1486.     set ::vVals
  1487. } {}
  1488. test 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}
  1494. test entry-19.16 {entry widget validation} {
  1495.     list [.e validate] $::vVals
  1496. } {1 {.e -1 -1 abcd abcd {} all forced}}
  1497. test 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}}
  1502. proc 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. }
  1507. test 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}}
  1513. proc 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. }
  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
  1521. test 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}}
  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.
  1532. test 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}}
  1538. destroy .e
  1539. catch {unset ::e ::vVals}
  1541. ##
  1542. ## End validation tests
  1543. ##
  1545. test 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
  1554. test 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
  1562. test 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
  1569. test 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
  1577. test 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
  1583. test 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
  1591. test 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
  1602. test 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}
  1616. test 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}]
  1628. destroy .e
  1630. # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
  1631. # and EntryTextVarProc.
  1633. option clear
  1635. # cleanup
  1636. ::tcltest::cleanupTests
  1637. return