home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / entry.test < prev    next >
Encoding:
Text File  |  1995-03-22  |  33.8 KB  |  1,132 lines
  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-1995 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # @(#) entry.test 1.20 95/03/22 09:29:35
  11.  
  12. if {[lsearch [image types] test] < 0} {
  13.     puts "This application hasn't been compiled with the \"test\""
  14.     puts "image, so I can't run this test.  Are you sure you're using"
  15.     puts "tktest instead of wish?"
  16.     return
  17. }
  18.  
  19. if {[info procs test] != "test"} {
  20.     source defs
  21. }
  22.  
  23. foreach i [winfo children .] {
  24.     destroy $i
  25. }
  26. wm geometry . {}
  27. raise .
  28.  
  29. proc scroll args {
  30.     global scrollInfo
  31.     set scrollInfo $args
  32. }
  33.  
  34. # Create additional widget that's used to hold the selection at times.
  35.  
  36. entry .sel
  37. .sel insert end "This is some sample text"
  38.  
  39. # Font names
  40.  
  41. set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1
  42. set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1
  43.  
  44. entry .e -bd 2 -relief sunken
  45. pack .e
  46. update
  47. set i 1
  48. foreach test {
  49.     {-background #ff0000 #ff0000 non-existent
  50.         {unknown color name "non-existent"}}
  51.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  52.     {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
  53.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  54.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  55.     {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
  56.     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
  57.     {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
  58.         -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* bogus
  59.         {font "bogus" doesn't exist}}
  60.     {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
  61.     {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}}
  62.     {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
  63.     {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
  64.     {-highlightthickness -2 0 {} {}}
  65.     {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}}
  66.     {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}}
  67.     {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
  68.     {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
  69.     {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
  70.     {-relief groove groove 1.5 {bad relief type "1.5":  must be flat, groove, raised, ridge, or sunken}}
  71.     {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
  72.     {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  73.     {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
  74.     {-show * * {} {}}
  75.     {-state normal normal bogus {bad state value "bogus":  must be normal or disabled}}
  76.     {-takefocus "any string" "any string" {} {}}
  77.     {-textvariable i i {} {}}
  78.     {-width 402 402 3p {expected integer but got "3p"}}
  79.     {-xscrollcommand {Some command} {Some command} {} {}}
  80. } {
  81.     set name [lindex $test 0]
  82.     test entry-1.$i {configuration options} {
  83.     .e configure $name [lindex $test 1]
  84.     list [lindex [.e configure $name] 4] [.e cget $name]
  85.     } [list [lindex $test 2] [lindex $test 2]]
  86.     incr i
  87.     if {[lindex $test 3] != ""} {
  88.     test entry-1.$i {configuration options} {
  89.         list [catch {.e configure $name [lindex $test 3]} msg] $msg
  90.     } [list 1 [lindex $test 4]]
  91.     }
  92.     .e configure $name [lindex [.e configure $name] 3]
  93.     incr i
  94. }
  95.  
  96. test entry-2.1 {Tk_EntryCmd procedure} {
  97.     list [catch {entry} msg] $msg
  98. } {1 {wrong # args:  should be "entry pathName ?options?"}}
  99. test entry-2.2 {Tk_EntryCmd procedure} {
  100.     list [catch {entry gorp} msg] $msg
  101. } {1 {bad window path name "gorp"}}
  102. test entry-2.3 {Tk_EntryCmd procedure} {
  103.     catch {destroy .e}
  104.     entry .e
  105.     list [winfo exists .e] [winfo class .e] [info commands .e]
  106. } {1 Entry .e}
  107. test entry-2.4 {Tk_EntryCmd procedure} {
  108.     catch {destroy .e}
  109.     list [catch {entry .e -gorp foo} msg] $msg [winfo exists .e] \
  110.         [info commands .e]
  111. } {1 {unknown option "-gorp"} 0 {}}
  112. test entry-2.5 {Tk_EntryCmd procedure} {
  113.     catch {destroy .e}
  114.     entry .e
  115. } {.e}
  116.  
  117. catch {destroy .e}
  118. entry .e -font fixed
  119. pack .e
  120. test entry-3.1 {EntryWidgetCmd procedure} {
  121.     list [catch {.e} msg] $msg
  122. } {1 {wrong # args: should be ".e option ?arg arg ...?"}}
  123. test entry-3.2 {EntryWidgetCmd procedure, "cget" widget command} {
  124.     list [catch {.e cget} msg] $msg
  125. } {1 {wrong # args: should be ".e cget option"}}
  126. test entry-3.3 {EntryWidgetCmd procedure, "cget" widget command} {
  127.     list [catch {.e cget a b} msg] $msg
  128. } {1 {wrong # args: should be ".e cget option"}}
  129. test entry-3.4 {EntryWidgetCmd procedure, "cget" widget command} {
  130.     list [catch {.e cget -gorp} msg] $msg
  131. } {1 {unknown option "-gorp"}}
  132. test entry-3.5 {EntryWidgetCmd procedure, "cget" widget command} {
  133.     .e configure -bd 4
  134.     .e cget -bd
  135. } {4}
  136. test entry-3.6 {EntryWidgetCmd procedure, "configure" widget command} {
  137.     llength [.e configure]
  138. } {28}
  139. test entry-3.7 {EntryWidgetCmd procedure, "configure" widget command} {
  140.     list [catch {.e configure -foo} msg] $msg
  141. } {1 {unknown option "-foo"}}
  142. test entry-3.8 {EntryWidgetCmd procedure, "configure" widget command} {
  143.     .e configure -bd 4
  144.     .e configure -bg #ffffff
  145.     lindex [.e configure -bd] 4
  146. } {4}
  147. test entry-3.9 {EntryWidgetCmd procedure, "delete" widget command} {
  148.     list [catch {.e delete} msg] $msg
  149. } {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
  150. test entry-3.10 {EntryWidgetCmd procedure, "delete" widget command} {
  151.     list [catch {.e delete a b c} msg] $msg
  152. } {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
  153. test entry-3.11 {EntryWidgetCmd procedure, "delete" widget command} {
  154.     list [catch {.e delete foo} msg] $msg
  155. } {1 {bad entry index "foo"}}
  156. test entry-3.12 {EntryWidgetCmd procedure, "delete" widget command} {
  157.     list [catch {.e delete 0 bar} msg] $msg
  158. } {1 {bad entry index "bar"}}
  159. test entry-3.13 {EntryWidgetCmd procedure, "delete" widget command} {
  160.     .e delete 0 end
  161.     .e insert end "01234567890"
  162.     .e delete 2 4
  163.     .e get
  164. } {014567890}
  165. test entry-3.14 {EntryWidgetCmd procedure, "delete" widget command} {
  166.     .e delete 0 end
  167.     .e insert end "01234567890"
  168.     .e delete 6
  169.     .e get
  170. } {0123457890}
  171. test entry-3.15 {EntryWidgetCmd procedure, "delete" widget command} {
  172.     .e delete 0 end
  173.     .e insert end "01234567890"
  174.     .e delete 6 5
  175.     .e get
  176. } {01234567890}
  177. test entry-3.16 {EntryWidgetCmd procedure, "delete" widget command} {
  178.     .e delete 0 end
  179.     .e insert end "01234567890"
  180.     .e configure -state disabled
  181.     .e delete 2 8
  182.     .e configure -state normal
  183.     .e get
  184. } {01234567890}
  185. test entry-3.17 {EntryWidgetCmd procedure, "get" widget command} {
  186.     list [catch {.e get foo} msg] $msg
  187. } {1 {wrong # args: should be ".e get"}}
  188. test entry-3.18 {EntryWidgetCmd procedure, "icursor" widget command} {
  189.     list [catch {.e icursor} msg] $msg
  190. } {1 {wrong # args: should be ".e icursor pos"}}
  191. test entry-3.19 {EntryWidgetCmd procedure, "icursor" widget command} {
  192.     list [catch {.e icursor foo} msg] $msg
  193. } {1 {bad entry index "foo"}}
  194. test entry-3.20 {EntryWidgetCmd procedure, "icursor" widget command} {
  195.     .e delete 0 end
  196.     .e insert end "01234567890"
  197.     .e icursor 4
  198.     .e index insert
  199. } {4}
  200. test entry-3.21 {EntryWidgetCmd procedure, "index" widget command} {
  201.     list [catch {.e in} msg] $msg
  202. } {1 {bad option "in": must be cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}
  203. test entry-3.22 {EntryWidgetCmd procedure, "index" widget command} {
  204.     list [catch {.e index} msg] $msg
  205. } {1 {wrong # args: should be ".e index string"}}
  206. test entry-3.23 {EntryWidgetCmd procedure, "index" widget command} {
  207.     list [catch {.e index foo} msg] $msg
  208. } {1 {bad entry index "foo"}}
  209. test entry-3.24 {EntryWidgetCmd procedure, "index" widget command} {
  210.     list [catch {.e index 0} msg] $msg
  211. } {0 0}
  212. test entry-3.25 {EntryWidgetCmd procedure, "insert" widget command} {
  213.     list [catch {.e insert a} msg] $msg
  214. } {1 {wrong # args: should be ".e insert index text"}}
  215. test entry-3.26 {EntryWidgetCmd procedure, "insert" widget command} {
  216.     list [catch {.e insert a b c} msg] $msg
  217. } {1 {wrong # args: should be ".e insert index text"}}
  218. test entry-3.27 {EntryWidgetCmd procedure, "insert" widget command} {
  219.     list [catch {.e insert foo Text} msg] $msg
  220. } {1 {bad entry index "foo"}}
  221. test entry-3.28 {EntryWidgetCmd procedure, "insert" widget command} {
  222.     .e delete 0 end
  223.     .e insert end "01234567890"
  224.     .e insert 3 xxx
  225.     .e get
  226. } {012xxx34567890}
  227. test entry-3.29 {EntryWidgetCmd procedure, "insert" widget command} {
  228.     .e delete 0 end
  229.     .e insert end "01234567890"
  230.     .e configure -state disabled
  231.     .e insert 3 xxx
  232.     .e configure -state normal
  233.     .e get
  234. } {01234567890}
  235. test entry-3.30 {EntryWidgetCmd procedure, "insert" widget command} {
  236.     list [catch {.e insert a b c} msg] $msg
  237. } {1 {wrong # args: should be ".e insert index text"}}
  238. test entry-3.31 {EntryWidgetCmd procedure, "scan" widget command} {
  239.     list [catch {.e scan a} msg] $msg
  240. } {1 {wrong # args: should be ".e scan mark|dragto x"}}
  241. test entry-3.32 {EntryWidgetCmd procedure, "scan" widget command} {
  242.     list [catch {.e scan a b c} msg] $msg
  243. } {1 {wrong # args: should be ".e scan mark|dragto x"}}
  244. test entry-3.33 {EntryWidgetCmd procedure, "scan" widget command} {
  245.     list [catch {.e scan foobar 20} msg] $msg
  246. } {1 {bad scan option "foobar":  must be mark or dragto}}
  247. test entry-3.34 {EntryWidgetCmd procedure, "scan" widget command} {
  248.     list [catch {.e scan mark 20.1} msg] $msg
  249. } {1 {expected integer but got "20.1"}}
  250. if $doNonPortableTests {
  251.     # This test is non-portable because character sizes vary.
  252.  
  253.     test entry-3.35 {EntryWidgetCmd procedure, "scan" widget command} {
  254.     .e delete 0 end
  255.     update
  256.     .e insert end "This is quite a long string, in fact a "
  257.     .e insert end "very very long string"
  258.     .e scan mark 30
  259.     .e scan dragto 28
  260.     .e index @0
  261.     } {3}
  262. }
  263. test entry-3.36 {EntryWidgetCmd procedure, "select" widget command} {
  264.     list [catch {.e select} msg] $msg
  265. } {1 {wrong # args: should be ".e select option ?index?"}}
  266. test entry-3.37 {EntryWidgetCmd procedure, "select" widget command} {
  267.     list [catch {.e select foo} msg] $msg
  268. } {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}}
  269. test entry-3.38 {EntryWidgetCmd procedure, "select clear" widget command} {
  270.     list [catch {.e select clear gorp} msg] $msg
  271. } {1 {wrong # args: should be ".e selection clear"}}
  272. test entry-3.39 {EntryWidgetCmd procedure, "select clear" widget command} {
  273.     .e delete 0 end
  274.     .e insert end "0123456789"
  275.     .e select from 1
  276.     .e select to 4
  277.     update
  278.     .e select clear
  279.     list [catch {selection get} msg] $msg [selection own]
  280. } {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}
  281. test entry-3.40 {EntryWidgetCmd procedure, "selection present" widget command} {
  282.     list [catch {.e selection present foo} msg] $msg
  283. } {1 {wrong # args: should be ".e selection present"}}
  284. test entry-3.41 {EntryWidgetCmd procedure, "selection present" widget command} {
  285.     .e delete 0 end
  286.     .e insert end 0123456789
  287.     .e select from 3
  288.     .e select to 6
  289.     .e selection present
  290. } {1}
  291. test entry-3.42 {EntryWidgetCmd procedure, "selection present" widget command} {
  292.     .e delete 0 end
  293.     .e insert end 0123456789
  294.     .e select from 3
  295.     .e select to 6
  296.     .e configure -exportselection false
  297.     .e selection present
  298. } {1}
  299. .e configure -exportselection true
  300. test entry-3.43 {EntryWidgetCmd procedure, "selection present" widget command} {
  301.     .e delete 0 end
  302.     .e insert end 0123456789
  303.     .e select from 3
  304.     .e select to 6
  305.     .e delete 0 end
  306.     .e selection present
  307. } {0}
  308. test entry-3.44 {EntryWidgetCmd procedure, "selection adjust" widget command} {
  309.     list [catch {.e select adjust x} msg] $msg
  310. } {1 {bad entry index "x"}}
  311. test entry-3.45 {EntryWidgetCmd procedure, "selection adjust" widget command} {
  312.     list [catch {.e select adjust 2 3} msg] $msg
  313. } {1 {wrong # args: should be ".e selection adjust index"}}
  314. test entry-3.46 {EntryWidgetCmd procedure, "selection adjust" widget command} {
  315.     .e delete 0 end
  316.     .e insert end "0123456789"
  317.     .e select from 1
  318.     .e select to 5
  319.     update
  320.     .e select adjust 4
  321.     selection get
  322. } {123}
  323. test entry-3.47 {EntryWidgetCmd procedure, "selection adjust" widget command} {
  324.     .e delete 0 end
  325.     .e insert end "0123456789"
  326.     .e select from 1
  327.     .e select to 5
  328.     update
  329.     .e select adjust 2
  330.     selection get
  331. } {234}
  332. test entry-3.48 {EntryWidgetCmd procedure, "selection from" widget command} {
  333.     list [catch {.e select from 2 3} msg] $msg
  334. } {1 {wrong # args: should be ".e selection from index"}}
  335. test entry-3.49 {EntryWidgetCmd procedure, "selection range" widget command} {
  336.     list [catch {.e select range 2} msg] $msg
  337. } {1 {wrong # args: should be ".e selection range start end"}}
  338. test entry-3.50 {EntryWidgetCmd procedure, "selection range" widget command} {
  339.     list [catch {.e selection range 2 3 4} msg] $msg
  340. } {1 {wrong # args: should be ".e selection range start end"}}
  341. test entry-3.51 {EntryWidgetCmd procedure, "selection range" widget command} {
  342.     .e delete 0 end
  343.     .e insert end 0123456789
  344.     .e select from 1
  345.     .e select to 5
  346.     .e select range 4 4
  347.     list [catch {.e index sel.first} msg] $msg
  348. } {1 {selection isn't in entry}}
  349. test entry-3.52 {EntryWidgetCmd procedure, "selection range" widget command} {
  350.     .e delete 0 end
  351.     .e insert end 0123456789
  352.     .e select from 3
  353.     .e select to 7
  354.     .e select range 2 9
  355.     list [.e index sel.first] [.e index sel.last] [.e index anchor]
  356. } {2 9 3}
  357. .e delete 0 end
  358. .e insert end "This is quite a long text string, so long that it "
  359. .e insert end "runs off the end of the window quite a bit."
  360. test entry-3.53 {EntryWidgetCmd procedure, "selection to" widget command} {
  361.     list [catch {.e select to 2 3} msg] $msg
  362. } {1 {wrong # args: should be ".e selection to index"}}
  363. test entry-3.54 {EntryWidgetCmd procedure, "xview" widget command} {
  364.     .e xview 5
  365.     .e xview
  366. } {0.0537634 0.268817}
  367. test entry-3.55 {EntryWidgetCmd procedure, "xview" widget command} {
  368.     list [catch {.e xview gorp} msg] $msg
  369. } {1 {bad entry index "gorp"}}
  370. test entry-3.56 {EntryWidgetCmd procedure, "xview" widget command} {
  371.     .e xview 0
  372.     .e icursor 10
  373.     .e xview insert
  374.     .e xview
  375. } {0.107527 0.322581}
  376. test entry-3.57 {EntryWidgetCmd procedure, "xview" widget command} {
  377.     list [catch {.e xview moveto foo bar} msg] $msg
  378. } {1 {wrong # args: should be ".e xview moveto fraction"}}
  379. test entry-3.58 {EntryWidgetCmd procedure, "xview" widget command} {
  380.     list [catch {.e xview moveto foo} msg] $msg
  381. } {1 {expected floating-point number but got "foo"}}
  382. test entry-3.59 {EntryWidgetCmd procedure, "xview" widget command} {
  383.     .e xview moveto 0.5
  384.     .e xview
  385. } {0.494624 0.709677}
  386. test entry-3.60 {EntryWidgetCmd procedure, "xview" widget command} {
  387.     list [catch {.e xview scroll 24} msg] $msg
  388. } {1 {wrong # args: should be ".e xview scroll number units|pages"}}
  389. test entry-3.61 {EntryWidgetCmd procedure, "xview" widget command} {
  390.     list [catch {.e xview scroll gorp units} msg] $msg
  391. } {1 {expected integer but got "gorp"}}
  392. test entry-3.62 {EntryWidgetCmd procedure, "xview" widget command} {
  393.     .e xview moveto 0
  394.     .e xview scroll 1 pages
  395.     .e xview
  396. } {0.193548 0.408602}
  397. test entry-3.63 {EntryWidgetCmd procedure, "xview" widget command} {
  398.     .e xview moveto .9
  399.     update
  400.     .e xview scroll -2 p
  401.     .e xview
  402. } {0.397849 0.612903}
  403. test entry-3.64 {EntryWidgetCmd procedure, "xview" widget command} {
  404.     .e xview 30
  405.     update
  406.     .e xview scroll 2 units 
  407.     .e index @0
  408. } {32}
  409. test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
  410.     .e xview 30
  411.     update
  412.     .e xview scroll -1 units 
  413.     .e index @0
  414. } {29}
  415. test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
  416.     list [catch {.e xview scroll 23 foobars} msg] $msg
  417. } {1 {bad argument "foobars": must be units or pages}}
  418. test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} {
  419.     list [catch {.e xview eat 23 hamburgers} msg] $msg
  420. } {1 {unknown option "eat": must be moveto or scroll}}
  421. test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} {
  422.     .e xview 0
  423.     update
  424.     .e xview -4
  425.     .e index @0
  426. } {0}
  427. test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} {
  428.     .e xview 300
  429.     .e index @0
  430. } {73}
  431. test entry-3.70 {EntryWidgetCmd procedure} {
  432.     list [catch {.e gorp} msg] $msg
  433. } {1 {bad option "gorp": must be cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}
  434.  
  435. # The test below doesn't actually check anything directly, but if run
  436. # with Purify or some other memory-allocation-checking program it will
  437. # ensure that resources get properly freed.
  438.  
  439. test entry-4.1 {DestroyEntry procedure} {
  440.     catch {destroy .e}
  441.     entry .e -textvariable x -show *
  442.     pack .e
  443.     .e insert end "Sample text"
  444.     update
  445.     destroy .e
  446. } {}
  447.  
  448. frame .f -width 200 -height 50 -relief raised -bd 2
  449. pack .f -side right
  450. test entry-5.1 {ConfigureEntry procedure} {
  451.     catch {destroy .e}
  452.     set x 12345
  453.     entry .e -textvariable x
  454.     .e get
  455. } {12345}
  456. test entry-5.2 {ConfigureEntry procedure} {
  457.     catch {destroy .e}
  458.     set x 12345
  459.     entry .e -textvariable x
  460.     set y abcde
  461.     .e configure -textvariable y
  462.     set x 54321
  463.     .e get
  464. } {abcde}
  465. test entry-5.3 {ConfigureEntry procedure} {
  466.     catch {destroy .e}
  467.     catch {unset x}
  468.     entry .e
  469.     .e insert 0 "Some text"
  470.     .e configure -textvariable x
  471.     set x
  472. } {Some text}
  473. test entry-5.4 {ConfigureEntry procedure} {
  474.     catch {destroy .e}
  475.     entry .e -exportselection false
  476.     pack .e
  477.     .e insert end "0123456789"
  478.     .sel select from 0
  479.     .sel select to 10
  480.     set x {}
  481.     lappend x [selection get]
  482.     .e select from 1
  483.     .e select to 5
  484.     lappend x [selection get]
  485.     .e configure -exportselection 1
  486.     lappend x [selection get]
  487.     set x
  488. } {{This is so} {This is so} 1234}
  489. test entry-5.5 {ConfigureEntry procedure} {
  490.     catch {destroy .e}
  491.     entry .e
  492.     pack .e
  493.     .e insert end "0123456789"
  494.     .e select from 1
  495.     .e select to 5
  496.     .e configure -exportselection 0
  497.     list [catch {selection get} msg] $msg [.e index sel.first] \
  498.         [.e index sel.last]
  499. } {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5}
  500. test entry-5.6 {ConfigureEntry procedure} {
  501.     catch {destroy .e}
  502.     entry .e -font $fixed -width 4 -xscrollcommand scroll
  503.     pack .e
  504.     .e insert end "01234567890"
  505.     update
  506.     .e configure -width 5
  507.     set scrollInfo
  508. } {0 0.363636}
  509. if $doNonPortableTests {
  510.     # This test is non-portable due to variations in font sizes.
  511.  
  512.     test entry-5.7 {ConfigureEntry procedure} {
  513.     catch {destroy .e}
  514.     entry .e -width 0
  515.     pack .e
  516.     .e insert end "0123"
  517.     update
  518.     .e configure -font $big
  519.     update
  520.     winfo geom .e
  521.     } {62x37+0+0}
  522. }
  523. test entry-5.8 {ConfigureEntry procedure} {
  524.     catch {destroy .e}
  525.     entry .e -font $fixed -bd 2 -relief raised
  526.     pack .e
  527.     .e insert end "0123"
  528.     update
  529.     list [.e index @10] [.e index @11] [.e index @12] [.e index @13]
  530. } {0 0 1 1}
  531. test entry-5.9 {ConfigureEntry procedure} {
  532.     catch {destroy .e}
  533.     entry .e -font $fixed -bd 2 -relief flat
  534.     pack .e
  535.     .e insert end "0123"
  536.     update
  537.     list [.e index @10] [.e index @11] [.e index @12] [.e index @13]
  538. } {0 0 1 1}
  539.  
  540. # No tests for DisplayEntry.
  541.  
  542. test entry-6.1 {EntryComputeGeometry procedure} {
  543.     catch {destroy .e}
  544.     entry .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3
  545.     pack .e
  546.     .e insert end 012\t45
  547.     update
  548.     list [.e index @61] [.e index @62]
  549. } {3 4}
  550. test entry-6.2 {EntryComputeGeometry procedure} {
  551.     catch {destroy .e}
  552.     entry .e -font $fixed -bd 2 -relief raised -width 20 -justify center \
  553.         -highlightthickness 3
  554.     pack .e
  555.     .e insert end 012\t45
  556.     update
  557.     list [.e index @96] [.e index @97]
  558. } {3 4}
  559. test entry-6.3 {EntryComputeGeometry procedure} {
  560.     catch {destroy .e}
  561.     entry .e -font $fixed -bd 2 -relief raised -width 20 -justify right \
  562.         -highlightthickness 3
  563.     pack .e
  564.     .e insert end 012\t45
  565.     update
  566.     list [.e index @131] [.e index @132]
  567. } {3 4}
  568. test entry-6.4 {EntryComputeGeometry procedure} {
  569.     catch {destroy .e}
  570.     entry .e -font $fixed -bd 2 -relief raised -width 5
  571.     pack .e
  572.     .e insert end "01234567890"
  573.     update
  574.     .e xview 6
  575.     .e index @0
  576. } {6}
  577. test entry-6.5 {EntryComputeGeometry procedure} {
  578.     catch {destroy .e}
  579.     entry .e -font $fixed -bd 2 -relief raised -width 5
  580.     pack .e
  581.     .e insert end "01234567890"
  582.     update
  583.     .e xview 7
  584.     .e index @0
  585. } {6}
  586. test entry-6.6 {EntryComputeGeometry procedure} {
  587.     catch {destroy .e}
  588.     entry .e -font $fixed -bd 2 -relief raised -width 10
  589.     pack .e
  590.     .e insert end "01234\t67890"
  591.     update
  592.     .e xview 3
  593.     list [.e index @39] [.e index @40]
  594. } {5 6}
  595. test entry-6.7 {EntryComputeGeometry procedure} {
  596.     catch {destroy .e}
  597.     entry .e -font $big -bd 3 -relief raised -width 5
  598.     pack .e
  599.     .e insert end "01234567"
  600.     update
  601.     list [winfo reqwidth .e] [winfo reqheight .e]
  602. } {77 39}
  603. test entry-6.8 {EntryComputeGeometry procedure} {
  604.     catch {destroy .e}
  605.     entry .e -font $big -bd 3 -relief raised -width 0
  606.     pack .e
  607.     .e insert end "01234567"
  608.     update
  609.     list [winfo reqwidth .e] [winfo reqheight .e]
  610. } {116 39}
  611. test entry-6.9 {EntryComputeGeometry procedure} {
  612.     catch {destroy .e}
  613.     entry .e -font $big -bd 3 -relief raised -width 0 -highlightthickness 2
  614.     pack .e
  615.     update
  616.     list [winfo reqwidth .e] [winfo reqheight .e]
  617. } {25 39}
  618. if $doNonPortableTests {
  619.     # This test is non-portable due to variations in font sizes.
  620.  
  621.     test entry-6.10 {EntryComputeGeometry procedure} {
  622.     catch {destroy .e}
  623.     entry .e -bd 1 -relief raised -width 0 -show .
  624.     .e insert 0 12345
  625.     pack .e
  626.     update
  627.     set x [winfo reqwidth .e]
  628.     .e configure -show X
  629.     lappend x [winfo reqwidth .e]
  630.     .e configure -show ""
  631.     lappend x [winfo reqwidth .e]
  632.     } {23 48 43}
  633. }
  634.  
  635. catch {destroy .e}
  636. entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
  637. pack .e
  638. focus .e
  639. test entry-7.1 {InsertChars procedure} {
  640.     .e delete 0 end
  641.     .e insert 0 abcde
  642.     .e insert 2 XXX
  643.     update
  644.     list [.e get] $contents $scrollInfo
  645. } {abXXXcde abXXXcde {0 1}}
  646. test entry-7.2 {InsertChars procedure} {
  647.     .e delete 0 end
  648.     .e insert 0 abcde
  649.     .e insert 500 XXX
  650.     update
  651.     list [.e get] $contents $scrollInfo
  652. } {abcdeXXX abcdeXXX {0 1}}
  653. test entry-7.3 {InsertChars procedure} {
  654.     .e delete 0 end
  655.     .e insert 0 0123456789
  656.     .e select from 2
  657.     .e select to 6
  658.     .e insert 2 XXX
  659.     set x "[.e index sel.first] [.e index sel.last]"
  660.     .e select to 8
  661.     lappend x [.e index sel.first] [.e index sel.last]
  662. } {5 9 5 8}
  663. test entry-7.4 {InsertChars procedure} {
  664.     .e delete 0 end
  665.     .e insert 0 0123456789
  666.     .e select from 2
  667.     .e select to 6
  668.     .e insert 3 XXX
  669.     set x "[.e index sel.first] [.e index sel.last]"
  670.     .e select to 8
  671.     lappend x [.e index sel.first] [.e index sel.last]
  672. } {2 9 2 8}
  673. test entry-7.5 {InsertChars procedure} {
  674.     .e delete 0 end
  675.     .e insert 0 0123456789
  676.     .e select from 2
  677.     .e select to 6
  678.     .e insert 5 XXX
  679.     set x "[.e index sel.first] [.e index sel.last]"
  680.     .e select to 8
  681.     lappend x [.e index sel.first] [.e index sel.last]
  682. } {2 9 2 8}
  683. test entry-7.6 {InsertChars procedure} {
  684.     .e delete 0 end
  685.     .e insert 0 0123456789
  686.     .e select from 2
  687.     .e select to 6
  688.     .e insert 6 XXX
  689.     set x "[.e index sel.first] [.e index sel.last]"
  690.     .e select to 5
  691.     lappend x [.e index sel.first] [.e index sel.last]
  692. } {2 6 2 5}
  693. test entry-7.7 {InsertChars procedure} {
  694.     .e delete 0 end
  695.     .e insert 0 0123456789
  696.     .e icursor 4
  697.     .e insert 4 XXX
  698.     .e index insert
  699. } {7}
  700. test entry-7.8 {InsertChars procedure} {
  701.     .e delete 0 end
  702.     .e insert 0 0123456789
  703.     .e icursor 4
  704.     .e insert 5 XXX
  705.     .e index insert
  706. } {4}
  707. test entry-7.9 {InsertChars procedure} {
  708.     .e delete 0 end
  709.     .e insert 0 "This is a very long string"
  710.     update
  711.     .e xview 4
  712.     .e insert 3 XXX
  713.     .e index @0
  714. } {7}
  715. test entry-7.10 {InsertChars procedure} {
  716.     .e delete 0 end
  717.     .e insert 0 "This is a very long string"
  718.     update
  719.     .e xview 4
  720.     .e insert 4 XXX
  721.     .e index @0
  722. } {4}
  723. .e configure -width 0
  724. if $doNonPortableTests {
  725.     # This test is non-portable due to variations in font sizes.
  726.  
  727.     test entry-7.11 {InsertChars procedure} {
  728.     .e delete 0 end
  729.     .e insert 0 "xyzzy"
  730.     update
  731.     .e insert 2 00
  732.     winfo reqwidth .e
  733.     } {59}
  734. }
  735.  
  736. .e configure -width 10
  737. test entry-8.1 {DeleteChars procedure} {
  738.     .e delete 0 end
  739.     .e insert 0 abcde
  740.     .e delete 2 4
  741.     update
  742.     list [.e get] $contents $scrollInfo
  743. } {abe abe {0 1}}
  744. test entry-8.2 {DeleteChars procedure} {
  745.     .e delete 0 end
  746.     .e insert 0 abcde
  747.     .e delete -2 2
  748.     update
  749.     list [.e get] $contents $scrollInfo
  750. } {cde cde {0 1}}
  751. test entry-8.3 {DeleteChars procedure} {
  752.     .e delete 0 end
  753.     .e insert 0 abcde
  754.     .e delete 3 1000
  755.     update
  756.     list [.e get] $contents $scrollInfo
  757. } {abc abc {0 1}}
  758. test entry-8.4 {DeleteChars procedure} {
  759.     .e delete 0 end
  760.     .e insert 0 0123456789abcde
  761.     .e select from 3
  762.     .e select to 8
  763.     .e delete 1 3
  764.     update
  765.     set x "[.e index sel.first] [.e index sel.last]"
  766.     .e select to 5
  767.     lappend x [.e index sel.first] [.e index sel.last]
  768. } {1 6 1 5}
  769. test entry-8.5 {DeleteChars procedure} {
  770.     .e delete 0 end
  771.     .e insert 0 0123456789abcde
  772.     .e select from 3
  773.     .e select to 8
  774.     .e delete 1 4
  775.     update
  776.     set x "[.e index sel.first] [.e index sel.last]"
  777.     .e select to 4
  778.     lappend x [.e index sel.first] [.e index sel.last]
  779. } {1 5 1 4}
  780. test entry-8.6 {DeleteChars procedure} {
  781.     .e delete 0 end
  782.     .e insert 0 0123456789abcde
  783.     .e select from 3
  784.     .e select to 8
  785.     .e delete 1 7
  786.     update
  787.     set x "[.e index sel.first] [.e index sel.last]"
  788.     .e select to 5
  789.     lappend x [.e index sel.first] [.e index sel.last]
  790. } {1 2 1 5}
  791. test entry-8.7 {DeleteChars procedure} {
  792.     .e delete 0 end
  793.     .e insert 0 0123456789abcde
  794.     .e select from 3
  795.     .e select to 8
  796.     .e delete 1 8
  797.     list [catch {.e index sel.first} msg] $msg
  798. } {1 {selection isn't in entry}}
  799. test entry-8.8 {DeleteChars procedure} {
  800.     .e delete 0 end
  801.     .e insert 0 0123456789abcde
  802.     .e select from 3
  803.     .e select to 8
  804.     .e delete 3 7
  805.     update
  806.     set x "[.e index sel.first] [.e index sel.last]"
  807.     .e select to 8
  808.     lappend x [.e index sel.first] [.e index sel.last]
  809. } {3 4 3 8}
  810. test entry-8.9 {DeleteChars procedure} {
  811.     .e delete 0 end
  812.     .e insert 0 0123456789abcde
  813.     .e select from 3
  814.     .e select to 8
  815.     .e delete 3 8
  816.     list [catch {.e index sel.first} msg] $msg
  817. } {1 {selection isn't in entry}}
  818. test entry-8.10 {DeleteChars procedure} {
  819.     .e delete 0 end
  820.     .e insert 0 0123456789abcde
  821.     .e select from 8
  822.     .e select to 3
  823.     .e delete 5 8
  824.     update
  825.     set x "[.e index sel.first] [.e index sel.last]"
  826.     .e select to 8
  827.     lappend x [.e index sel.first] [.e index sel.last]
  828. } {3 5 5 8}
  829. test entry-8.11 {DeleteChars procedure} {
  830.     .e delete 0 end
  831.     .e insert 0 0123456789abcde
  832.     .e select from 8
  833.     .e select to 3
  834.     .e delete 8 10
  835.     update
  836.     set x "[.e index sel.first] [.e index sel.last]"
  837.     .e select to 4
  838.     lappend x [.e index sel.first] [.e index sel.last]
  839. } {3 8 4 8}
  840. test entry-8.12 {DeleteChars procedure} {
  841.     .e delete 0 end
  842.     .e insert 0 0123456789abcde
  843.     .e icursor 4
  844.     .e delete 1 4
  845.     .e index insert
  846. } {1}
  847. test entry-8.13 {DeleteChars procedure} {
  848.     .e delete 0 end
  849.     .e insert 0 0123456789abcde
  850.     .e icursor 4
  851.     .e delete 1 5
  852.     .e index insert
  853. } {1}
  854. test entry-8.14 {DeleteChars procedure} {
  855.     .e delete 0 end
  856.     .e insert 0 0123456789abcde
  857.     .e icursor 4
  858.     .e delete 4 6
  859.     .e index insert
  860. } {4}
  861. test entry-8.15 {DeleteChars procedure} {
  862.     .e delete 0 end
  863.     .e insert 0 "This is a very long string"
  864.     .e xview 4
  865.     .e delete 1 4
  866.     .e index @0
  867. } {1}
  868. test entry-8.16 {DeleteChars procedure} {
  869.     .e delete 0 end
  870.     .e insert 0 "This is a very long string"
  871.     .e xview 4
  872.     .e delete 1 5
  873.     .e index @0
  874. } {1}
  875. test entry-8.17 {DeleteChars procedure} {
  876.     .e delete 0 end
  877.     .e insert 0 "This is a very long string"
  878.     .e xview 4
  879.     .e delete 4 6
  880.     .e index @0
  881. } {4}
  882. .e configure -width 0
  883. if $doNonPortableTests {
  884.     # This test is non-portable due to variations in font sizes.
  885.  
  886.     test entry-8.18 {DeleteChars procedure} {
  887.     .e delete 0 end
  888.     .e insert 0 "xyzzy"
  889.     update
  890.     .e delete 2 4
  891.     winfo reqwidth .e
  892.     } {31}
  893. }
  894.  
  895. if $doNonPortableTests {
  896.     # This test is non-portable due to variations in font sizes.
  897.  
  898.     .e configure -width 0
  899.     test entry-9.1 {EntrySetValue procedure} {
  900.     set x abcde
  901.     set y ab
  902.     .e configure -textvariable x
  903.     update
  904.     .e configure -textvariable y
  905.     update
  906.     list [.e get] [winfo reqwidth .e]
  907.     } {ab 24}
  908. }
  909.  
  910. test entry-10.1 {EntryEventProc procedure} {
  911.     catch {destroy .e}
  912.     entry .e
  913.     .e insert 0 abcdefg
  914.     destroy .e
  915.     update
  916. } {}
  917. test entry-10.2 {EntryEventProc procedure} {
  918.     eval destroy [winfo children .]
  919.     entry .e1 -fg #112233
  920.     rename .e1 .e2
  921.     set x {}
  922.     lappend x [winfo children .]
  923.     lappend x [.e2 cget -fg]
  924.     destroy .e1
  925.     lappend x [info command .e*] [winfo children .]
  926. } {.e1 #112233 {} {}}
  927.  
  928. test entry-11.1 {EntryCmdDeletedProc procedure} {
  929.     eval destroy [winfo children .]
  930.     button .e1 -text "xyz_123"
  931.     rename .e1 {}
  932.     list [info command .e*] [winfo children .]
  933. } {{} {}}
  934.  
  935. catch {destroy .e}
  936. entry .e -font $fixed -width 5 -bd 2 -relief sunken
  937. pack .e
  938. .e insert 0 012345678901234567890
  939. .e xview 4
  940. update
  941. test entry-12.1 {GetEntryIndex procedure} {
  942.     .e index end
  943. } {21}
  944. test entry-12.2 {GetEntryIndex procedure} {
  945.     list [catch {.e index abogus} msg] $msg
  946. } {1 {bad entry index "abogus"}}
  947. test entry-12.3 {GetEntryIndex procedure} {
  948.     .e select from 1
  949.     .e select to 6
  950.     .e index anchor
  951. } {1}
  952. test entry-12.4 {GetEntryIndex procedure} {
  953.     .e select from 4
  954.     .e select to 1
  955.     .e index anchor
  956. } {4}
  957. test entry-12.5 {GetEntryIndex procedure} {
  958.     .e select from 3
  959.     .e select to 15
  960.     .e select adjust 4
  961.     .e index anchor
  962. } {15}
  963. test entry-12.6 {GetEntryIndex procedure} {
  964.     list [catch {.e index ebogus} msg] $msg
  965. } {1 {bad entry index "ebogus"}}
  966. test entry-12.7 {GetEntryIndex procedure} {
  967.     .e icursor 2
  968.     .e index insert
  969. } {2}
  970. test entry-12.8 {GetEntryIndex procedure} {
  971.     list [catch {.e index ibogus} msg] $msg
  972. } {1 {bad entry index "ibogus"}}
  973. test entry-12.9 {GetEntryIndex procedure} {
  974.     .e select from 1
  975.     .e select to 6
  976.     list [.e index sel.first] [.e index sel.last]
  977. } {1 6}
  978. selection clear .e
  979. test entry-12.10 {GetEntryIndex procedure} {
  980.     list [catch {.e index sel.first} msg] $msg
  981. } {1 {selection isn't in entry}}
  982. test entry-12.11 {GetEntryIndex procedure} {
  983.     list [catch {.e index sbogus} msg] $msg
  984. } {1 {selection isn't in entry}}
  985. test entry-12.12 {GetEntryIndex procedure} {
  986.     list [catch {.e index @xyz} msg] $msg
  987. } {1 {bad entry index "@xyz"}}
  988. test entry-12.13 {GetEntryIndex procedure} {
  989.     .e index @4
  990. } {4}
  991. test entry-12.14 {GetEntryIndex procedure} {
  992.     .e index @11
  993. } {4}
  994. test entry-12.15 {GetEntryIndex procedure} {
  995.     .e index @12
  996. } {5}
  997. test entry-12.16 {GetEntryIndex procedure} {
  998.     .e index @[expr [winfo width .e] - 6]
  999. } {8}
  1000. test entry-12.17 {GetEntryIndex procedure} {
  1001.     .e index @[expr [winfo width .e] - 5]
  1002. } {9}
  1003. test entry-12.18 {GetEntryIndex procedure} {
  1004.     .e index @1000
  1005. } {9}
  1006. test entry-12.19 {GetEntryIndex procedure} {
  1007.     list [catch {.e index 1xyz} msg] $msg
  1008. } {1 {bad entry index "1xyz"}}
  1009. test entry-12.20 {GetEntryIndex procedure} {
  1010.     .e index -10
  1011. } {0}
  1012. test entry-12.21 {GetEntryIndex procedure} {
  1013.     .e index 12
  1014. } {12}
  1015. test entry-12.22 {GetEntryIndex procedure} {
  1016.     .e index 49
  1017. } {21}
  1018. if $doNonPortableTests {
  1019.     # This test is non-portable due to variations in font sizes.
  1020.  
  1021.     test entry-12.23 {GetEntryIndex procedure} {
  1022.     catch {destroy .e}
  1023.     entry .e -show .
  1024.     .e insert 0 XXXYZZY
  1025.     pack .e
  1026.     update
  1027.     list [.e index @7] [.e index @8]
  1028.     } {0 1}
  1029. }
  1030.  
  1031. # XXX Still need to write tests for EntryScanTo and EntrySelectTo.
  1032.  
  1033. set x {}
  1034. for {set i 1} {$i <= 500} {incr i} {
  1035.     append x "This is line $i, out of 500\n"
  1036. }
  1037. test entry-13.1 {EntryFetchSelection procedure} {
  1038.     catch {destroy .e}
  1039.     entry .e
  1040.     .e insert end "This is a test string"
  1041.     .e select from 1
  1042.     .e select to 18
  1043.     selection get
  1044. } {his is a test str}
  1045. test entry-13.2 {EntryFetchSelection procedure} {
  1046.     catch {destroy .e}
  1047.     entry .e -show *
  1048.     .e insert end "This is a test string"
  1049.     .e select from 1
  1050.     .e select to 18
  1051.     selection get
  1052. } {*****************}
  1053. test entry-13.3 {EntryFetchSelection procedure} {
  1054.     catch {destroy .e}
  1055.     entry .e
  1056.     .e insert end $x
  1057.     .e select from 0
  1058.     .e select to end
  1059.     string compare [selection get] $x
  1060. } 0
  1061.  
  1062. # No tests for EntryLostSelection or EventuallyRedraw.
  1063.  
  1064. catch {destroy .e}
  1065. entry .e -width 10 -xscrollcommand scroll
  1066. pack .e
  1067. update
  1068.  
  1069. if $doNonPortableTests {
  1070.     # These tests are non-portable due to variations in font sizes.
  1071.  
  1072.     test entry-14.1 {EntryVisibleRange procedure} {
  1073.     .e delete 0 end
  1074.     .e insert 0 .............................
  1075.     .e xview
  1076.     } {0 0.793103}
  1077.     test entry-14.2 {EntryVisibleRange procedure} {
  1078.     .e configure -show X
  1079.     .e delete 0 end
  1080.     .e insert 0 .............................
  1081.     .e xview
  1082.     } {0 0.275862}
  1083. }
  1084. .e configure -show ""
  1085. test entry-14.3 {EntryVisibleRange procedure} {
  1086.     .e delete 0 end
  1087.     .e xview
  1088. } {0 1}
  1089.  
  1090. catch {destroy .e}
  1091. entry .e -width 10 -xscrollcommand scroll -font $fixed
  1092. pack .e
  1093. update
  1094. test entry-15.1 {EntryUpdateScrollbar procedure} {
  1095.     .e delete 0 end
  1096.     .e insert 0 123
  1097.     update
  1098.     set scrollInfo
  1099. } {0 1}
  1100. test entry-15.2 {EntryUpdateScrollbar procedure} {
  1101.     .e delete 0 end
  1102.     .e insert 0 0123456789abcdef
  1103.     .e xview 3
  1104.     update
  1105.     set scrollInfo
  1106. } {0.1875 0.8125}
  1107. test entry-15.3 {EntryUpdateScrollbar procedure} {
  1108.     .e delete 0 end
  1109.     .e insert 0 abcdefghijklmnopqrs
  1110.     .e xview 6
  1111.     update
  1112.     set scrollInfo
  1113. } {0.315789 0.842105}
  1114. test entry-15.4 {EntryUpdateScrollbar procedure} {
  1115.     catch {destroy .e}
  1116.     proc tkerror msg {
  1117.     global x
  1118.     set x $msg
  1119.     }
  1120.     entry .e -width 5 -xscrollcommand bogus
  1121.     pack .e
  1122.     update
  1123.     rename tkerror {}
  1124.     list $x $errorInfo
  1125. } {{invalid command name "bogus"} {invalid command name "bogus"
  1126.     while executing
  1127. "bogus 0 1"
  1128.     (horizontal scrolling command executed by entry)}}
  1129.  
  1130. # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
  1131. # and EntryTextVarProc.
  1132.