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

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

通讯编程

开发平台：

Visual C++

text.test：源码内容
  1. # This file is a Tcl script to test the code in the file tkText.c.
  2. # This file is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1992-1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  6. # Copyright (c) 1998-1999 by Scriptics Corporation.
  7. # All rights reserved.
  8. #
  9. # RCS: @(#) $Id: text.test,v 1.19.2.2 2007/12/13 00:31:34 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. # Create entries in the option database to be sure that geometry options
  19. # like border width have predictable values.
  21. option add *Text.borderWidth 2
  22. option add *Text.highlightThickness 2
  23. option add *Text.font {Courier -12}
  25. text .t -width 20 -height 10
  26. pack append . .t {top expand fill}
  27. update
  28. .t debug on
  29. wm geometry . {}
  31. # The statements below reset the main window;  it's needed if the window
  32. # manager is mwm to make mwm forget about a previous minimum size setting.
  34. wm withdraw .
  35. wm minsize . 1 1
  36. wm positionfrom . user
  37. wm deiconify .
  39. entry .t.e
  40. .t.e insert end abcdefg
  41. .t.e select from 0
  43. .t insert 1.0 "Line 1
  44. abcdefghijklm
  45. 12345
  46. Line 4
  47. bOy GIrl .#@? x_yz
  48. !@#$%
  49. Line 7"
  51. catch {destroy .t2}
  52. text .t2
  53. set i 0
  54. foreach test {
  55.     {-autoseparators yes 1 nah}
  56.     {-background #ff00ff #ff00ff <gorp>}
  57.     {-bd 4 4 foo}
  58.     {-bg blue blue #xx}
  59.     {-borderwidth 7 7 ++}
  60.     {-cursor watch watch lousy}
  61.     {-exportselection no 0 maybe}
  62.     {-fg red red stupid}
  63.     {-font fixed fixed {}}
  64.     {-foreground #012 #012 bogus}
  65.     {-height 5 5 bad}
  66.     {-highlightbackground #123 #123 bogus}
  67.     {-highlightcolor #234 #234 bogus}
  68.     {-highlightthickness -2 0 bad}
  69.     {-insertbackground green green <bogus>}
  70.     {-insertborderwidth 45 45 bogus}
  71.     {-insertofftime 100 100 2.4}
  72.     {-insertontime 47 47 e1}
  73.     {-insertwidth 2.3 2 47d}
  74.     {-maxundo 5 5 noway}
  75.     {-padx 3.4 3 2.4.}
  76.     {-pady 82 82 bogus}
  77.     {-relief raised raised bumpy}
  78.     {-selectbackground #ffff01234567 #ffff01234567 bogus}
  79.     {-selectborderwidth 21 21 3x}
  80.     {-selectforeground yellow yellow #12345}
  81.     {-spacing1 20 20 1.3x}
  82.     {-spacing1 -5 0 bogus}
  83.     {-spacing2 5 5 bogus}
  84.     {-spacing2 -1 0 bogus}
  85.     {-spacing3 20 20 bogus}
  86.     {-spacing3 -10 0 bogus}
  87.     {-state d disabled foo}
  88.     {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
  89.     {-undo 1 1 eh}
  90.     {-width 73 73 2.4}
  91.     {-wrap w word bad_wrap}
  92. } {
  93.     test text-1.[incr i] {text options} {
  94. set result {}
  95. lappend result [catch {.t2 configure [lindex $test 0] [lindex $test 3]}]
  96. .t2 configure [lindex $test 0] [lindex $test 1]
  97. lappend result [.t2 cget [lindex $test 0]]
  98.     } [list 1 [lindex $test 2]]
  99. }
  100. test text-1.[incr i] {text options} {
  101.     .t2 configure -takefocus "any old thing"
  102.     .t2 cget -takefocus
  103. } {any old thing}
  104. test text-1.[incr i] {text options} {
  105.     .t2 configure -xscrollcommand "x scroll command"
  106.     .t2 configure -xscrollcommand
  107. } {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}}
  108. test text-1.[incr i] {text options} {
  109.     .t2 configure -yscrollcommand "test command"
  110.     .t2 configure -yscrollcommand
  111. } {-yscrollcommand yScrollCommand ScrollCommand {} {test command}}
  112. test text-1.[incr i] {text options} {
  113.     set result {}
  114.     foreach i [.t2 configure] {
  115. lappend result [lindex $i 4]
  116.     }
  117.     set result
  118. } {1 blue {} {} 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 5 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 1 73 word {x scroll command} {test command}}
  120. test text-2.1 {Tk_TextCmd procedure} {
  121.     list [catch {text} msg] $msg
  122. } {1 {wrong # args: should be "text pathName ?options?"}}
  123. test text-2.2 {Tk_TextCmd procedure} {
  124.     list [catch {text foobar} msg] $msg
  125. } {1 {bad window path name "foobar"}}
  126. test text-2.3 {Tk_TextCmd procedure} {
  127.     catch {destroy .t2}
  128.     list [catch {text .t2 -gorp nofun} msg] $msg [winfo exists .t2]
  129. } {1 {unknown option "-gorp"} 0}
  130. test text-2.4 {Tk_TextCmd procedure} {
  131.     catch {destroy .t2}
  132.     list [catch {text .t2 -bd 2 -fg red} msg] $msg 
  133. [lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4]
  134. } {0 .t2 2 red}
  135. if {$tcl_platform(platform) == "macintosh"} {
  136.     set relief solid
  137. } elseif {$tcl_platform(platform) == "windows"} {
  138.     set relief flat
  139. } else {
  140.     set relief raised
  141. }
  142. test text-2.5 {Tk_TextCmd procedure} {
  143.     catch {destroy .t2}
  144.     text .t2
  145.     .t2 tag cget sel -relief 
  146. } $relief
  147. test text-2.6 {Tk_TextCmd procedure} {
  148.     catch {destroy .t2}
  149.     list [text .t2] [winfo class .t2]
  150. } {.t2 Text}
  152. test text-3.1 {TextWidgetCmd procedure, basics} {
  153.     list [catch {.t} msg] $msg
  154. } {1 {wrong # args: should be ".t option ?arg arg ...?"}}
  155. test text-3.2 {TextWidgetCmd procedure} {
  156.     list [catch {.t gorp 1.0 z 1.2} msg] $msg
  157. } {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
  159. test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
  160.     list [catch {.t bbox} msg] $msg
  161. } {1 {wrong # args: should be ".t bbox index"}}
  162. test text-4.2 {TextWidgetCmd procedure, "bbox" option} {
  163.     list [catch {.t bbox a b} msg] $msg
  164. } {1 {wrong # args: should be ".t bbox index"}}
  165. test text-4.3 {TextWidgetCmd procedure, "bbox" option} {
  166.     list [catch {.t bbox bad_mark} msg] $msg
  167. } {1 {bad text index "bad_mark"}}
  169. test text-5.1 {TextWidgetCmd procedure, "cget" option} {
  170.     list [catch {.t cget} msg] $msg
  171. } {1 {wrong # args: should be ".t cget option"}}
  172. test text-5.2 {TextWidgetCmd procedure, "cget" option} {
  173.     list [catch {.t cget a b} msg] $msg
  174. } {1 {wrong # args: should be ".t cget option"}}
  175. test text-5.3 {TextWidgetCmd procedure, "cget" option} {
  176.     list [catch {.t cget -gorp} msg] $msg
  177. } {1 {unknown option "-gorp"}}
  178. test text-5.4 {TextWidgetCmd procedure, "cget" option} {
  179.     .t configure -bd 17
  180.     .t cget -bd
  181. } {17}
  182. .t configure -bd [lindex [.t configure -bd] 3]
  184. test text-6.1 {TextWidgetCmd procedure, "compare" option} {
  185.     list [catch {.t compare a b} msg] $msg
  186. } {1 {wrong # args: should be ".t compare index1 op index2"}}
  187. test text-6.2 {TextWidgetCmd procedure, "compare" option} {
  188.     list [catch {.t compare a b c d} msg] $msg
  189. } {1 {wrong # args: should be ".t compare index1 op index2"}}
  190. test text-6.3 {TextWidgetCmd procedure, "compare" option} {
  191.     list [catch {.t compare @x == 1.0} msg] $msg
  192. } {1 {bad text index "@x"}}
  193. test text-6.4 {TextWidgetCmd procedure, "compare" option} {
  194.     list [catch {.t compare 1.0 < @y} msg] $msg
  195. } {1 {bad text index "@y"}}
  196. test text-6.5 {TextWidgetCmd procedure, "compare" option} {
  197.     list [.t compare 1.1 < 1.0] [.t compare 1.1 < 1.1] [.t compare 1.1 < 1.2]
  198. } {0 0 1}
  199. test text-6.6 {TextWidgetCmd procedure, "compare" option} {
  200.     list [.t compare 1.1 <= 1.0] [.t compare 1.1 <= 1.1] [.t compare 1.1 <= 1.2]
  201. } {0 1 1}
  202. test text-6.7 {TextWidgetCmd procedure, "compare" option} {
  203.     list [.t compare 1.1 == 1.0] [.t compare 1.1 == 1.1] [.t compare 1.1 == 1.2]
  204. } {0 1 0}
  205. test text-6.8 {TextWidgetCmd procedure, "compare" option} {
  206.     list [.t compare 1.1 >= 1.0] [.t compare 1.1 >= 1.1] [.t compare 1.1 >= 1.2]
  207. } {1 1 0}
  208. test text-6.9 {TextWidgetCmd procedure, "compare" option} {
  209.     list [.t compare 1.1 > 1.0] [.t compare 1.1 > 1.1] [.t compare 1.1 > 1.2]
  210. } {1 0 0}
  211. test text-6.10 {TextWidgetCmd procedure, "compare" option} {
  212.     list [.t com 1.1 != 1.0] [.t compare 1.1 != 1.1] [.t compare 1.1 != 1.2]
  213. } {1 0 1}
  214. test text-6.11 {TextWidgetCmd procedure, "compare" option} {
  215.     list [catch {.t compare 1.0 <x 1.2} msg] $msg
  216. } {1 {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=}}
  217. test text-6.12 {TextWidgetCmd procedure, "compare" option} {
  218.     list [catch {.t compare 1.0 >> 1.2} msg] $msg
  219. } {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}}
  220. test text-6.13 {TextWidgetCmd procedure, "compare" option} {
  221.     list [catch {.t compare 1.0 z 1.2} msg] $msg
  222. } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}}
  223. test text-6.14 {TextWidgetCmd procedure, "compare" option} {
  224.     list [catch {.t co 1.0 z 1.2} msg] $msg
  225. } {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
  227. # "configure" option is already covered above
  229. test text-7.1 {TextWidgetCmd procedure, "debug" option} {
  230.     list [catch {.t debug 0 1} msg] $msg
  231. } {1 {wrong # args: should be ".t debug boolean"}}
  232. test text-7.2 {TextWidgetCmd procedure, "debug" option} {
  233.     list [catch {.t de 0 1} msg] $msg
  234. } {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
  235. test text-7.3 {TextWidgetCmd procedure, "debug" option} {
  236.     .t debug true
  237.     .t deb
  238. } 1
  239. test text-7.4 {TextWidgetCmd procedure, "debug" option} {
  240.     .t debug false
  241.     .t debug
  242. } 0
  243. .t debug
  245. test text-8.1 {TextWidgetCmd procedure, "delete" option} {
  246.     list [catch {.t delete} msg] $msg
  247. } {1 {wrong # args: should be ".t delete index1 ?index2 ...?"}}
  248. test text-8.2 {TextWidgetCmd procedure, "delete" option} {
  249.     list [catch {.t delete a b c} msg] $msg
  250. } {1 {bad text index "a"}}
  251. test text-8.3 {TextWidgetCmd procedure, "delete" option} {
  252.     list [catch {.t delete @x 2.2} msg] $msg
  253. } {1 {bad text index "@x"}}
  254. test text-8.4 {TextWidgetCmd procedure, "delete" option} {
  255.     list [catch {.t delete 2.3 @y} msg] $msg
  256. } {1 {bad text index "@y"}}
  257. test text-8.5 {TextWidgetCmd procedure, "delete" option} {
  258.     .t configure -state disabled
  259.     .t delete 2.3
  260.     .t g 2.0 2.end
  261. } abcdefghijklm
  262. .t configure -state normal
  263. test text-8.6 {TextWidgetCmd procedure, "delete" option} {
  264.     .t delete 2.3
  265.     .t get 2.0 2.end
  266. } abcefghijklm
  267. test text-8.7 {TextWidgetCmd procedure, "delete" option} {
  268.     .t delete 2.1 2.3
  269.     .t get 2.0 2.end
  270. } aefghijklm
  271. test text-8.8 {TextWidgetCmd procedure, "delete" option} {
  272.     # All indices are checked before we actually delete anything
  273.     list [catch {.t delete 2.1 2.3 foo} msg] $msg 
  274.     [.t get 2.0 2.end]
  275. } {1 {bad text index "foo"} aefghijklm}
  276. set prevtext [.t get 1.0 end-1c]
  277. test text-8.9 {TextWidgetCmd procedure, "delete" option} {
  278.     # auto-forward one byte if the last "pair" is just one
  279.     .t delete 1.0 end; .t insert 1.0 "foonabcdefghijklm"
  280.     .t delete 2.1 2.3 2.3
  281.     .t get 1.0 end-1c
  282. } foonaefghijklm
  283. test text-8.10 {TextWidgetCmd procedure, "delete" option} {
  284.     # all indices will be ordered before deletion
  285.     .t delete 1.0 end; .t insert 1.0 "foonabcdefghijklm"
  286.     .t delete 2.0 2.3 2.7 2.9 2.4
  287.     .t get 1.0 end-1c
  288. } foondfgjklm
  289. test text-8.11 {TextWidgetCmd procedure, "delete" option} {
  290.     # and check again with even pairs
  291.     .t delete 1.0 end; .t insert 1.0 "foonabcdefghijklm"
  292.     .t delete 2.0 2.2 2.7 2.9 2.4 2.5
  293.     .t get 1.0 end-1c
  294. } fooncdfgjklm
  295. test text-8.12 {TextWidgetCmd procedure, "delete" option} {
  296.     # we should get the longest range on equal start indices
  297.     .t delete 1.0 end; .t insert 1.0 "foonabcdefghijklm"
  298.     .t delete 2.0 2.2 2.0 2.5 2.0 2.3 2.8 2.7
  299.     .t get 1.0 end-1c
  300. } foonfghijklm
  301. test text-8.13 {TextWidgetCmd procedure, "delete" option} {
  302.     # we should get the longest range on equal start indices
  303.     .t delete 1.0 end; .t insert 1.0 "foonabcdefghijklm"
  304.     .t delete 2.0 2.2 1.2 2.6 2.0 2.5
  305.     .t get 1.0 end-1c
  306. } foghijklm
  307. test text-8.14 {TextWidgetCmd procedure, "delete" option} {
  308.     # we should get the longest range on equal start indices
  309.     .t delete 1.0 end; .t insert 1.0 "foonabcdefghijklm"
  310.     .t delete 2.0 2.2 2.0 2.5 1.1 2.3 2.8 2.7
  311.     .t get 1.0 end-1c
  312. } ffghijklm
  313. test text-8.15 {TextWidgetCmd procedure, "delete" option} {
  314.     # we should get the watch for overlapping ranges - they should
  315.     # essentially be merged into one span.
  316.     .t delete 1.0 end; .t insert 1.0 "foonabcdefghijklm"
  317.     .t delete 2.0 2.6 2.2 2.8
  318.     .t get 1.0 end-1c
  319. } foonijklm
  320. test text-8.16 {TextWidgetCmd procedure, "delete" option} {
  321.     # we should get the watch for overlapping ranges - they should
  322.     # essentially be merged into one span.
  323.     .t delete 1.0 end; .t insert 1.0 "foonabcdefghijklm"
  324.     .t delete 2.0 2.6 2.2 2.4
  325.     .t get 1.0 end-1c
  326. } foonghijklm
  328. .t delete 1.0 end; .t insert 1.0 $prevtext
  330. test text-9.1 {TextWidgetCmd procedure, "get" option} {
  331.     list [catch {.t get} msg] $msg
  332. } {1 {wrong # args: should be ".t get index1 ?index2 ...?"}}
  333. test text-9.2 {TextWidgetCmd procedure, "get" option} {
  334.     list [catch {.t get a b c} msg] $msg
  335. } {1 {bad text index "a"}}
  336. test text-9.3 {TextWidgetCmd procedure, "get" option} {
  337.     list [catch {.t get @q 3.1} msg] $msg
  338. } {1 {bad text index "@q"}}
  339. test text-9.4 {TextWidgetCmd procedure, "get" option} {
  340.     list [catch {.t get 3.1 @r} msg] $msg
  341. } {1 {bad text index "@r"}}
  342. test text-9.5 {TextWidgetCmd procedure, "get" option} {
  343.     .t get 5.7 5.3
  344. } {}
  345. test text-9.6 {TextWidgetCmd procedure, "get" option} {
  346.     .t get 5.3 5.5
  347. } { G}
  348. test text-9.7 {TextWidgetCmd procedure, "get" option} {
  349.     .t get 5.3 end
  350. } { GIrl .#@? x_yz
  351. !@#$%
  352. Line 7
  353. }
  354. .t mark set a 5.3
  355. .t mark set b 5.3
  356. .t mark set c 5.5
  357. test text-9.8 {TextWidgetCmd procedure, "get" option} {
  358.     .t get 5.2 5.7
  359. } {y GIr}
  360. test text-9.9 {TextWidgetCmd procedure, "get" option} {
  361.     .t get 5.2
  362. } {y}
  363. test text-9.10 {TextWidgetCmd procedure, "get" option} {
  364.     .t get 5.2 5.4
  365. } {y }
  366. test text-9.11 {TextWidgetCmd procedure, "get" option} {
  367.     .t get 5.2 5.4 5.4
  368. } {{y } G}
  369. test text-9.12 {TextWidgetCmd procedure, "get" option} {
  370.     .t get 5.2 5.4 5.4 5.5
  371. } {{y } G}
  372. test text-9.13 {TextWidgetCmd procedure, "get" option} {
  373.     .t get 5.2 5.4 5.5 "5.5+5c"
  374. } {{y } {Irl .}}
  375. test text-9.14 {TextWidgetCmd procedure, "get" option} {
  376.     .t get 5.2 5.4 5.4 5.5 end-3c
  377. } {{y } G { }}
  378. test text-9.15 {TextWidgetCmd procedure, "get" option} {
  379.     .t get 5.2 5.4 5.4 5.5 end-3c end
  380. } {{y } G { 7
  381. }}
  382. test text-9.17 {TextWidgetCmd procedure, "get" option} {
  383.     list [catch {.t get 5.2 5.4 5.5 foo} msg] $msg
  384. } {1 {bad text index "foo"}}
  386. test text-10.1 {TextWidgetCmd procedure, "index" option} {
  387.     list [catch {.t index} msg] $msg
  388. } {1 {wrong # args: should be ".t index index"}}
  389. test text-10.2 {TextWidgetCmd procedure, "index" option} {
  390.     list [catch {.t ind a b} msg] $msg
  391. } {1 {wrong # args: should be ".t index index"}}
  392. test text-10.3 {TextWidgetCmd procedure, "index" option} {
  393.     list [catch {.t in a b} msg] $msg
  394. } {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
  395. test text-10.4 {TextWidgetCmd procedure, "index" option} {
  396.     list [catch {.t index @xyz} msg] $msg
  397. } {1 {bad text index "@xyz"}}
  398. test text-10.5 {TextWidgetCmd procedure, "index" option} {
  399.     .t index 1.2
  400. } 1.2
  402. test text-11.1 {TextWidgetCmd procedure, "insert" option} {
  403.     list [catch {.t insert 1.2} msg] $msg
  404. } {1 {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"}}
  405. test text-11.2 {TextWidgetCmd procedure, "insert" option} {
  406.     .t config -state disabled
  407.     .t insert 1.2 xyzzy
  408.     .t get 1.0 1.end
  409. } {Line 1}
  410. .t config -state normal
  411. test text-11.3 {TextWidgetCmd procedure, "insert" option} {
  412.     .t insert 1.2 xyzzy
  413.     .t get 1.0 1.end
  414. } {Lixyzzyne 1}
  415. test text-11.4 {TextWidgetCmd procedure, "insert" option} {
  416.     .t delete 1.0 end
  417.     .t insert 1.0 "Sample text" x
  418.     .t tag ranges x
  419. } {1.0 1.11}
  420. test text-11.5 {TextWidgetCmd procedure, "insert" option} {
  421.     .t delete 1.0 end
  422.     .t insert 1.0 "Sample text" x
  423.     .t insert 1.2 "XYZ" y
  424.     list [.t tag ranges x] [.t tag ranges y]
  425. } {{1.0 1.2 1.5 1.14} {1.2 1.5}}
  426. test text-11.6 {TextWidgetCmd procedure, "insert" option} {
  427.     .t delete 1.0 end
  428.     .t insert 1.0 "Sample text" {x y z}
  429.     list [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
  430. } {{1.0 1.11} {1.0 1.11} {1.0 1.11}}
  431. test text-11.7 {TextWidgetCmd procedure, "insert" option} {
  432.     .t delete 1.0 end
  433.     .t insert 1.0 "Sample text" {x y z}
  434.     .t insert 1.3 "A" {a b z}
  435.     list [.t tag ranges a] [.t tag ranges b] [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
  436. } {{1.3 1.4} {1.3 1.4} {1.0 1.3 1.4 1.12} {1.0 1.3 1.4 1.12} {1.0 1.12}}
  437. test text-11.8 {TextWidgetCmd procedure, "insert" option} {
  438.     .t delete 1.0 end
  439.     list [catch {.t insert 1.0 "Sample text" "a {b"} msg] $msg
  440. } {1 {unmatched open brace in list}}
  441. test text-11.9 {TextWidgetCmd procedure, "insert" option} {
  442.     .t delete 1.0 end
  443.     .t insert 1.0 "First" bold " " {} second "x y z" " third"
  444.     list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges x] 
  445.     [.t tag ranges y] [.t tag ranges z]
  446. } {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}}
  447. test text-11.10 {TextWidgetCmd procedure, "insert" option} {
  448.     .t delete 1.0 end
  449.     .t insert 1.0 "First" bold " second" silly
  450.     list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly]
  451. } {{First second} {1.0 1.5} {1.5 1.12}}
  453. # Edit, mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere.
  455. test text-12.1 {ConfigureText procedure} {
  456.     list [catch {.t2 configure -state foobar} msg] $msg
  457. } {1 {bad state value "foobar": must be normal or disabled}}
  458. test text-12.2 {ConfigureText procedure} {
  459.     .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1
  460.     list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
  461. } {0 1 1}
  462. test text-12.3 {ConfigureText procedure} {
  463.     .t2 configure -spacing1 1 -spacing2 -1 -spacing3 1
  464.     list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
  465. } {1 0 1}
  466. test text-12.4 {ConfigureText procedure} {
  467.     .t2 configure -spacing1 1 -spacing2 1 -spacing3 -3
  468.     list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
  469. } {1 1 0}
  470. test text-12.5 {ConfigureText procedure} {
  471.     set x [list [catch {.t2 configure -tabs {30 foo}} msg] $msg $errorInfo]
  472.     .t2 configure -tabs {10 20 30}
  473.     set x
  474. } {1 {bad tab alignment "foo": must be left, right, center, or numeric} {bad tab alignment "foo": must be left, right, center, or numeric
  475.     (while processing -tabs option)
  476.     invoked from within
  477. ".t2 configure -tabs {30 foo}"}}
  478. test text-12.6 {ConfigureText procedure} {
  479.     .t2 configure -tabs {10 20 30}
  480.     .t2 configure -tabs {}
  481.     .t2 cget -tabs
  482. } {}
  483. test text-12.7 {ConfigureText procedure} {
  484.     list [catch {.t2 configure -wrap bogus} msg] $msg
  485. } {1 {bad wrap mode "bogus": must be char, none, or word}}
  486. test text-12.8 {ConfigureText procedure} {
  487.     .t2 configure -selectborderwidth 17 -selectforeground #332211 
  488.     -selectbackground #abc
  489.     list [lindex [.t2 tag config sel -borderwidth] 4] 
  490. [lindex [.t2 tag config sel -foreground] 4] 
  491. [lindex [.t2 tag config sel -background] 4]
  492. } {17 #332211 #abc}
  493. test text-12.9 {ConfigureText procedure} {
  494.     .t2 configure -selectborderwidth {}
  495.     .t2 tag cget sel -borderwidth
  496. } {}
  497. test text-12.10 {ConfigureText procedure} {
  498.     list [catch {.t2 configure -selectborderwidth foo} msg] $msg
  499. } {1 {bad screen distance "foo"}}
  500. test text-12.11 {ConfigureText procedure} {
  501.     catch {destroy .t2}
  502.     .t.e select to 2
  503.     text .t2 -exportselection 1
  504.     selection get
  505. } {ab}
  506. test text-12.12 {ConfigureText procedure} {
  507.     catch {destroy .t2}
  508.     .t.e select to 2
  509.     text .t2 -exportselection 0
  510.     .t2 insert insert 1234657890
  511.     .t2 tag add sel 1.0 1.4
  512.     selection get
  513. } {ab}
  514. test text-12.13 {ConfigureText procedure} {
  515.     catch {destroy .t2}
  516.     .t.e select to 1
  517.     text .t2 -exportselection 1
  518.     .t2 insert insert 1234657890
  519.     .t2 tag add sel 1.0 1.4
  520.     selection get
  521. } {1234}
  522. test text-12.14 {ConfigureText procedure} {
  523.     catch {destroy .t2}
  524.     .t.e select to 1
  525.     text .t2 -exportselection 0
  526.     .t2 insert insert 1234657890
  527.     .t2 tag add sel 1.0 1.4
  528.     .t2 configure -exportselection 1
  529.     selection get
  530. } {1234}
  531. test text-12.15 {ConfigureText procedure} {
  532.     catch {destroy .t2}
  533.     text .t2 -exportselection 1
  534.     .t2 insert insert 1234657890
  535.     .t2 tag add sel 1.0 1.4
  536.     set result [selection get]
  537.     .t2 configure -exportselection 0
  538.     lappend result [catch {selection get} msg] $msg
  539. } {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
  540. test text-12.16 {ConfigureText procedure} {fonts} {
  541.     # This test is non-portable because the window size will vary depending
  542.     # on the font size, which can vary.
  544.     catch {destroy .t2}
  545.     toplevel .t2
  546.     text .t2.t -width 20 -height 10
  547.     pack append .t2 .t2.t top
  548.     wm geometry .t2 +0+0
  549.     update
  550.     wm geometry .t2
  551. } {150x140+0+0}
  552. test text-12.17 {ConfigureText procedure} {
  553.     # This test was failing Windows because the title bar on .t2
  554.     # was a certain minimum size and it was interfering with the size
  555.     # requested by the -setgrid.  The "overrideredirect" gets rid of the
  556.     # titlebar so the toplevel can shrink to the appropriate size.
  558.     catch {destroy .t2}
  559.     toplevel .t2
  560.     wm overrideredirect .t2 1
  561.     text .t2.t -width 20 -height 10 -setgrid 1
  562.     pack append .t2 .t2.t top
  563.     wm geometry .t2 +0+0
  564.     update
  565.     wm geometry .t2
  566. } {20x10+0+0}
  567. test text-12.18 {ConfigureText procedure} {
  568.     # This test was failing on Windows because the title bar on .t2
  569.     # was a certain minimum size and it was interfering with the size
  570.     # requested by the -setgrid.  The "overrideredirect" gets rid of the
  571.     # titlebar so the toplevel can shrink to the appropriate size.
  573.     catch {destroy .t2}
  574.     toplevel .t2
  575.     wm overrideredirect .t2 1
  576.     text .t2.t -width 20 -height 10 -setgrid 1
  577.     pack append .t2 .t2.t top
  578.     wm geometry .t2 +0+0
  579.     update
  580.     set result [wm geometry .t2]
  581.     wm geometry .t2 15x8
  582.     update
  583.     lappend result [wm geometry .t2]
  584.     .t2.t configure -wrap word
  585.     update
  586.     lappend result [wm geometry .t2]
  587. } {20x10+0+0 15x8+0+0 15x8+0+0}
  589. test text-13.1 {TextWorldChanged procedure, spacing options} fonts {
  590.     catch {destroy .t2}
  591.     text .t2 -width 20 -height 10
  592.     set result [winfo reqheight .t2]
  593.     .t2 configure -spacing1 2
  594.     lappend result [winfo reqheight .t2]
  595.     .t2  configure -spacing3 1
  596.     lappend result [winfo reqheight .t2]
  597.     .t2 configure -spacing1 0
  598.     lappend result [winfo reqheight .t2]
  599. } {140 160 170 150}
  601. test text-14.1 {TextEventProc procedure} {
  602.     text .tx1 -bg #543210
  603.     rename .tx1 .tx2
  604.     set x {}
  605.     lappend x [winfo exists .tx1]
  606.     lappend x [.tx2 cget -bg]
  607.     destroy .tx1
  608.     lappend x [info command .tx*] [winfo exists .tx1] [winfo exists .tx2]
  609. } {1 #543210 {} 0 0}
  611. test text-15.1 {TextCmdDeletedProc procedure} {
  612.     text .tx1
  613.     rename .tx1 {}
  614.     list [info command .tx*] [winfo exists .tx1]
  615. } {{} 0}
  616. test text-15.2 {TextCmdDeletedProc procedure, disabling -setgrid} fonts {
  617.     catch {destroy .top}
  618.     toplevel .top
  619.     wm geom .top +0+0
  620.     text .top.t -setgrid 1 -width 20 -height 10
  621.     pack .top.t
  622.     update
  623.     set x [wm geometry .top]
  624.     rename .top.t {}
  625.     update
  626.     lappend x [wm geometry .top]
  627.     destroy .top
  628.     set x
  629. } {20x10+0+0 150x140+0+0}
  631. test text-16.1 {InsertChars procedure} {
  632.     catch {destroy .t2}
  633.     text .t2
  634.     .t2 insert 2.0 abcdn
  635.     .t2 get 1.0 end
  636. } {abcd
  638. }
  639. test text-16.2 {InsertChars procedure} {
  640.     catch {destroy .t2}
  641.     text .t2
  642.     .t2 insert 1.0 abcdn
  643.     .t2 insert end 123n
  644.     .t2 get 1.0 end
  645. } {abcd
  646. 123
  648. }
  649. test text-16.3 {InsertChars procedure} {
  650.     catch {destroy .t2}
  651.     text .t2
  652.     .t2 insert 1.0 abcdn
  653.     .t2 insert 10.0 123
  654.     .t2 get 1.0 end
  655. } {abcd
  656. 123
  657. }
  658. test text-16.4 {InsertChars procedure, inserting on top visible line} {
  659.     catch {destroy .t2}
  660.     text .t2 -width 20 -height 4 -wrap word
  661.     pack .t2
  662.     .t2 insert insert "Now is the time for all great men to come to the "
  663.     .t2 insert insert "aid of their party.n"
  664.     .t2 insert insert "Now is the time for all great men.n"
  665.     .t2 see end
  666.     update
  667.     .t2 insert 1.0 "Shortn"
  668.     .t2 index @0,0
  669. } {2.56}
  670. test text-16.5 {InsertChars procedure, inserting on top visible line} {
  671.     catch {destroy .t2}
  672.     text .t2 -width 20 -height 4 -wrap word
  673.     pack .t2
  674.     .t2 insert insert "Now is the time for all great men to come to the "
  675.     .t2 insert insert "aid of their party.n"
  676.     .t2 insert insert "Now is the time for all great men.n"
  677.     .t2 see end
  678.     update
  679.     .t2 insert 1.55 "Shortn"
  680.     .t2 index @0,0
  681. } {2.0}
  682. test text-16.6 {InsertChars procedure, inserting on top visible line} {
  683.     catch {destroy .t2}
  684.     text .t2 -width 20 -height 4 -wrap word
  685.     pack .t2
  686.     .t2 insert insert "Now is the time for all great men to come to the "
  687.     .t2 insert insert "aid of their party.n"
  688.     .t2 insert insert "Now is the time for all great men.n"
  689.     .t2 see end
  690.     update
  691.     .t2 insert 1.56 "Shortn"
  692.     .t2 index @0,0
  693. } {1.56}
  694. test text-16.7 {InsertChars procedure, inserting on top visible line} {
  695.     catch {destroy .t2}
  696.     text .t2 -width 20 -height 4 -wrap word
  697.     pack .t2
  698.     .t2 insert insert "Now is the time for all great men to come to the "
  699.     .t2 insert insert "aid of their party.n"
  700.     .t2 insert insert "Now is the time for all great men.n"
  701.     .t2 see end
  702.     update
  703.     .t2 insert 1.57 "Shortn"
  704.     .t2 index @0,0
  705. } {1.56}
  706. catch {destroy .t2}
  708. proc setup {} {
  709.     .t delete 1.0 end
  710.     .t insert 1.0 "Line 1
  711. abcde
  712. 12345
  713. Line 4"
  714. }
  716. .t delete 1.0 end
  717. test text-17.1 {DeleteChars procedure} {
  718.     .t get 1.0 end
  719. } {
  720. }
  721. test text-17.2 {DeleteChars procedure} {
  722.     list [catch {.t delete foobar} msg] $msg
  723. } {1 {bad text index "foobar"}}
  724. test text-17.3 {DeleteChars procedure} {
  725.     list [catch {.t delete 1.0 lousy} msg] $msg
  726. } {1 {bad text index "lousy"}}
  727. test text-17.4 {DeleteChars procedure} {
  728.     setup
  729.     .t delete 2.1
  730.     .t get 1.0 end
  731. } {Line 1
  732. acde
  733. 12345
  734. Line 4
  735. }
  736. test text-17.5 {DeleteChars procedure} {
  737.     setup
  738.     .t delete 2.3
  739.     .t get 1.0 end
  740. } {Line 1
  741. abce
  742. 12345
  743. Line 4
  744. }
  745. test text-17.6 {DeleteChars procedure} {
  746.     setup
  747.     .t delete 2.end
  748.     .t get 1.0 end
  749. } {Line 1
  750. abcde12345
  751. Line 4
  752. }
  753. test text-17.7 {DeleteChars procedure} {
  754.     setup
  755.     .t tag add sel 4.2 end
  756.     .t delete 4.2 end
  757.     list [.t tag ranges sel] [.t get 1.0 end]
  758. } {{} {Line 1
  759. abcde
  760. 12345
  761. Li
  762. }}
  763. test text-17.8 {DeleteChars procedure} {
  764.     setup
  765.     .t tag add sel 1.0 end
  766.     .t delete 4.0 end
  767.     list [.t tag ranges sel] [.t get 1.0 end]
  768. } {{1.0 3.5} {Line 1
  769. abcde
  770. 12345
  771. }}
  772. test text-17.9 {DeleteChars procedure} {
  773.     setup
  774.     .t delete 2.2 2.2
  775.     .t get 1.0 end
  776. } {Line 1
  777. abcde
  778. 12345
  779. Line 4
  780. }
  781. test text-17.10 {DeleteChars procedure} {
  782.     setup
  783.     .t delete 2.3 2.1
  784.     .t get 1.0 end
  785. } {Line 1
  786. abcde
  787. 12345
  788. Line 4
  789. }
  790. test text-17.11 {DeleteChars procedure} {
  791.     catch {destroy .t2}
  792.     toplevel .t2
  793.     text .t2.t -width 20 -height 5
  794.     pack append .t2 .t2.t top
  795.     wm geometry .t2 +0+0
  796.     .t2.t insert 1.0 "abcn123nxnynznqnrns"
  797.     update
  798.     .t2.t delete 1.0 3.0
  799.     list [.t2.t index @0,0] [.t2.t get @0,0]
  800. } {1.0 x}
  801. test text-17.12 {DeleteChars procedure} {
  802.     catch {destroy .t2}
  803.     toplevel .t2
  804.     text .t2.t -width 20 -height 5
  805.     pack append .t2 .t2.t top
  806.     wm geometry .t2 +0+0
  807.     .t2.t insert 1.0 "abcn123nxnynznqnrns"
  808.     .t2.t yview 3.0
  809.     update
  810.     .t2.t delete 2.0 4.0
  811.     list [.t2.t index @0,0] [.t2.t get @0,0]
  812. } {2.0 y}
  813. catch {destroy .t2}
  814. toplevel .t2
  815. text .t2.t -width 1 -height 10 -wrap char
  816. frame .t2.f -width 200 -height 20 -relief raised -bd 2
  817. pack .t2.f .t2.t -side left
  818. wm geometry .t2 +0+0
  819. update
  820. test text-17.13 {DeleteChars procedure, updates affecting topIndex} {
  821.     .t2.t delete 1.0 end
  822.     .t2.t insert end "abcden12345nqrstuv"
  823.     .t2.t yview 2.1
  824.     .t2.t delete 1.4 2.3
  825.     .t2.t index @0,0
  826. } {1.2}
  827. test text-17.14 {DeleteChars procedure, updates affecting topIndex} {
  828.     .t2.t delete 1.0 end
  829.     .t2.t insert end "abcden12345nqrstuv"
  830.     .t2.t yview 2.1
  831.     .t2.t delete 2.3 2.4
  832.     .t2.t index @0,0
  833. } {2.0}
  834. test text-17.15 {DeleteChars procedure, updates affecting topIndex} {
  835.     .t2.t delete 1.0 end
  836.     .t2.t insert end "abcden12345nqrstuv"
  837.     .t2.t yview 1.3
  838.     .t2.t delete 1.0 1.2
  839.     .t2.t index @0,0
  840. } {1.1}
  841. test text-17.16 {DeleteChars procedure, updates affecting topIndex} {
  842.     catch {destroy .t2}
  843.     toplevel .t2
  844.     text .t2.t -width 6 -height 10 -wrap word
  845.     frame .t2.f -width 200 -height 20 -relief raised -bd 2
  846.     pack .t2.f .t2.t -side left
  847.     wm geometry .t2 +0+0
  848.     update
  849.     .t2.t insert end "abc defn01 2345 678 9101112nLine 3nLine 4nLine 5n6n7n8n"
  850.     .t2.t yview 2.4
  851.     .t2.t delete 2.5
  852.     set x [.t2.t index @0,0]
  853.     .t2.t delete 2.5
  854.     list $x [.t2.t index @0,0]
  855. } {2.3 2.0}
  857. .t delete 1.0 end
  858. foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} {
  859.     .t insert end $i.0$i.1$i.2$i.3$i.4n
  860. }
  861. test text-18.1 {TextFetchSelection procedure} {
  862.     .t tag add sel 1.3 3.4
  863.     selection get
  864. } {a.1a.2a.3a.4
  865. b.0b.1b.2b.3b.4
  866. c.0c}
  867. test text-18.2 {TextFetchSelection procedure} {
  868.     .t tag add x 1.2
  869.     .t tag add x 1.4
  870.     .t tag add x 2.0
  871.     .t tag add x 2.3
  872.     .t tag remove sel 1.0 end
  873.     .t tag add sel 1.0 3.4
  874.     selection get
  875. } {a.0a.1a.2a.3a.4
  876. b.0b.1b.2b.3b.4
  877. c.0c}
  878. test text-18.3 {TextFetchSelection procedure} {
  879.     .t tag remove sel 1.0 end
  880.     .t tag add sel 13.3
  881.     selection get
  882. } {m}
  883. test text-18.4 {TextFetchSelection procedure} {
  884.     .t tag remove x 1.0 end
  885.     .t tag add sel 1.0 3.4
  886.     .t tag remove sel 1.0 end
  887.     .t tag add sel 1.2 1.5
  888.     .t tag add sel 2.4 3.1
  889.     .t tag add sel 10.0 10.end
  890.     .t tag add sel 13.3
  891.     selection get
  892. } {0a..1b.2b.3b.4
  893. cj.0j.1j.2j.3j.4m}
  894. set x ""
  895. for {set i 1} {$i < 200} {incr i} {
  896.     append x "This is line $i, padded to just about 53 characters.n"
  897. }
  898. test text-18.5 {TextFetchSelection procedure, long selections} {
  899.     .t delete 1.0 end
  900.     .t insert end $x
  901.     .t tag add sel 1.0 end
  902.     selection get
  903. } $xn
  905. test text-19.1 {TkTextLostSelection procedure} {unixOnly} {
  906.     catch {destroy .t2}
  907.     text .t2
  908.     .t2 insert 1.0 "abcndefnghijkn1234"
  909.     .t2 tag add sel 1.2 3.3
  910.     .t.e select to 1
  911.     .t2 tag ranges sel
  912. } {}
  913. test text-19.2 {TkTextLostSelection procedure} {macOrPc} {
  914.     catch {destroy .t2}
  915.     text .t2
  916.     .t2 insert 1.0 "abcndefnghijkn1234"
  917.     .t2 tag add sel 1.2 3.3
  918.     .t.e select to 1
  919.     .t2 tag ranges sel
  920. } {1.2 3.3}
  921. catch {destroy .t2}
  922. test text-19.3 {TkTextLostSelection procedure} {
  923.     catch {destroy .t2}
  924.     text .t2
  925.     .t2 insert 1.0 "abcdefnghijkn1234"
  926.     .t2 tag add sel 1.0 1.3
  927.     set x [selection get]
  928.     selection clear
  929.     lappend x [catch {selection get} msg] $msg
  930.     .t2 tag add sel 1.0 1.3
  931.     lappend x [selection get]
  932. } {abc 1 {PRIMARY selection doesn't exist or form "STRING" not defined} abc}
  934. .t delete 1.0 end
  935. .t insert end "xxyz xyz x. thenfoo -forward bar xxxxx BaR foonxyz xxyzx"
  936. test text-20.1 {TextSearchCmd procedure, argument parsing} {
  937.     list [catch {.t search -} msg] $msg
  938. } {1 {bad switch "-": must be --, -backward, -count, -elide, -exact, -forward, -nocase, or -regexp}}
  939. test text-20.2 {TextSearchCmd procedure, -backwards option} {
  940.     .t search -backwards xyz 1.4
  941. } {1.1}
  942. test text-20.3 {TextSearchCmd procedure, -forwards option} {
  943.     .t search -forwards xyz 1.4
  944. } {1.5}
  945. test text-20.4 {TextSearchCmd procedure, -exact option} {
  946.     .t search -f -exact x. 1.0
  947. } {1.9}
  948. test text-20.5 {TextSearchCmd procedure, -regexp option} {
  949.     .t search -b -regexp x.z 1.4
  950. } {1.1}
  951. test text-20.6 {TextSearchCmd procedure, -count option} {
  952.     set length unmodified
  953.     list [.t search -count length x. 1.4] $length
  954. } {1.9 2}
  955. test text-20.7 {TextSearchCmd procedure, -count option} {
  956.     list [catch {.t search -count} msg] $msg
  957. } {1 {no value given for "-count" option}}
  958. test text-20.8 {TextSearchCmd procedure, -nocase option} {
  959.     list [.t search -nocase BaR 1.1] [.t search BaR 1.1]
  960. } {2.13 2.23}
  961. test text-20.9 {TextSearchCmd procedure, -nocase option} {
  962.     .t search -n BaR 1.1
  963. } {2.13}
  964. test text-20.10 {TextSearchCmd procedure, -- option} {
  965.     .t search -- -forward 1.0
  966. } {2.4}
  967. test text-20.11 {TextSearchCmd procedure, argument parsing} {
  968.     list [catch {.t search abc} msg] $msg
  969. } {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}}
  970. test text-20.12 {TextSearchCmd procedure, argument parsing} {
  971.     list [catch {.t search abc d e f} msg] $msg
  972. } {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?"}}
  973. test text-20.13 {TextSearchCmd procedure, check index} {
  974.     list [catch {.t search abc gorp} msg] $msg
  975. } {1 {bad text index "gorp"}}
  976. test text-20.14 {TextSearchCmd procedure, startIndex == "end"} {
  977.     .t search non-existent end
  978. } {}
  979. test text-20.15 {TextSearchCmd procedure, startIndex == "end"} {
  980.     .t search non-existent end
  981. } {}
  982. test text-20.16 {TextSearchCmd procedure, bad stopIndex} {
  983.     list [catch {.t search abc 1.0 lousy} msg] $msg
  984. } {1 {bad text index "lousy"}}
  985. test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
  986.     list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
  987. } {2.13 {}}
  988. test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
  989.     list [catch {.t search -regexp a( 1.0} msg] $msg
  990. } {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
  991. test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
  992.     .t search -backwards BaR end 1.0
  993. } {2.23}
  994. test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
  995.     .t search -backwards n end 1.0
  996. } {3.9}
  997. test text-20.21 {TextSearchCmd procedure, skip dummy last line} {
  998.     .t search n end
  999. } {1.15}
  1000. test text-20.22 {TextSearchCmd procedure, skip dummy last line} {
  1001.     .t search -back n 1.0
  1002. } {3.9}
  1003. test text-20.23 {TextSearchCmd procedure, extract line contents} {
  1004.     .t tag add foo 1.2
  1005.     .t tag add x 1.3
  1006.     .t mark set silly 1.2
  1007.     .t search xyz 3.6
  1008. } {1.1}
  1009. test text-20.24 {TextSearchCmd procedure, stripping newlines} {
  1010.     .t search then 1.0
  1011. } {1.12}
  1012. test text-20.25 {TextSearchCmd procedure, stripping newlines} {
  1013.     .t search -regexp then 1.0
  1014. } {}
  1015. test text-20.26 {TextSearchCmd procedure, stripping newlines} {
  1016.     .t search -regexp {the$} 1.0
  1017. } {1.12}
  1018. test text-20.27 {TextSearchCmd procedure, stripping newlines} {
  1019.     .t search -regexp n 1.0
  1020. } {}
  1021. test text-20.28 {TextSearchCmd procedure, line case conversion} {
  1022.     list [.t search -nocase bar 2.18] [.t search bar 2.18]
  1023. } {2.23 2.13}
  1024. test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} {
  1025.     .t search -backwards xyz 1.6
  1026. } {1.5}
  1027. test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} {
  1028.     .t search -backwards xyz 1.5
  1029. } {1.1}
  1030. test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} {
  1031.     .t search xyz 1.5
  1032. } {1.5}
  1033. test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} {
  1034.     .t search xyz 1.6
  1035. } {3.0}
  1036. test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} {
  1037.     .t search {} 1.end
  1038. } {1.15}
  1039. test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} {
  1040.     .t search f 1.end
  1041. } {2.0}
  1042. test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} {
  1043.     .t search {} end
  1044. } {1.0}
  1045. test text-20.36 {TextSearchCmd procedure, regexp finds empty lines} {
  1046.     # Test for fix of bug #1643
  1047.     .t insert end "n"
  1048.     tk::TextSetCursor .t 4.0
  1049.     .t search -forward -regexp {^$} insert end
  1050. } {4.0}
  1051.     
  1052. catch {destroy .t2}
  1053. toplevel .t2
  1054. wm geometry .t2 +0+0
  1055. text .t2.t -width 30 -height 10
  1056. pack .t2.t
  1057. .t2.t insert 1.0 "This is a linenand this is another"
  1058. .t2.t insert end "nand this is yet another"
  1059. frame .t2.f -width 20 -height 20 -bd 2 -relief raised
  1060. .t2.t window create 2.5 -window .t2.f
  1061. test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} {
  1062.     .t2.t search his 2.6
  1063. } {2.6}
  1064. test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} {
  1065.     .t2.t search this 2.6
  1066. } {3.4}
  1067. test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} {
  1068.     .t2.t search is 2.6
  1069. } {2.7}
  1070. test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} {
  1071.     .t2.t search his 2.7
  1072. } {3.5}
  1073. test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} {
  1074.     .t2.t search -backwards "his is another" 2.6
  1075. } {2.6}
  1076. test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} {
  1077.     .t2.t search -backwards "his is" 2.6
  1078. } {1.1}
  1079. destroy .t2
  1080. test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} {
  1081.     .t search -backwards forw 2.5
  1082. } {2.5}
  1083. test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} {
  1084.     .t search forw 2.5
  1085. } {2.5}
  1086. test text-20.44 {TextSearchCmd procedure, firstChar and lastChar} {
  1087.     catch {destroy .t2}
  1088.     text .t2
  1089.     list [.t2 search a 1.0] [.t2 search -backward a 1.0]
  1090. } {{} {}}
  1091. test text-20.45 {TextSearchCmd procedure, regexp match length} {
  1092.     set length unchanged
  1093.     list [.t search -regexp -count length x(.)(.*)z 1.1] $length
  1094. } {1.1 7}
  1095. test text-20.46 {TextSearchCmd procedure, regexp match length} {
  1096.     set length unchanged
  1097.     list [.t search -regexp -backward -count length fo* 2.5] $length
  1098. } {2.0 3}
  1099. test text-20.47 {TextSearchCmd procedure, checking stopIndex} {
  1100.     list [.t search bar 2.1 2.13] [.t search bar 2.1 2.14] 
  1101.     [.t search bar 2.12 2.14] [.t search bar 2.14 2.14]
  1102. } {{} 2.13 2.13 {}}
  1103. test text-20.48 {TextSearchCmd procedure, checking stopIndex} {
  1104.     list [.t search -backwards bar 2.20 2.13] 
  1105.     [.t search -backwards bar 2.20 2.14] 
  1106.     [.t search -backwards bar 2.14 2.13] 
  1107.     [.t search -backwards bar 2.13 2.13]
  1108. } {2.13 {} 2.13 {}}
  1109. test text-20.49 {TextSearchCmd procedure, embedded windows and index/count} {
  1110.     frame .t.f1 -width 20 -height 20 -relief raised -bd 2
  1111.     frame .t.f2 -width 20 -height 20 -relief raised -bd 2
  1112.     frame .t.f3 -width 20 -height 20 -relief raised -bd 2
  1113.     frame .t.f4 -width 20 -height 20 -relief raised -bd 2
  1114.     .t window create 2.10 -window .t.f3
  1115.     .t window create 2.8 -window .t.f2
  1116.     .t window create 2.8 -window .t.f1
  1117.     .t window create 2.1 -window .t.f4
  1118.     set result ""
  1119.     lappend result [.t search -count x forward 1.0] $x
  1120.     lappend result [.t search -count x wa 1.0] $x
  1121.     .t delete 2.1
  1122.     .t delete 2.8 2.10
  1123.     .t delete 2.10
  1124.     set result
  1125. } {2.6 10 2.11 2}
  1126. test text-20.50 {TextSearchCmd procedure, error setting variable} {
  1127.     catch {unset a}
  1128.     set a 44
  1129.     list [catch {.t search -count a(2) xyz 1.0} msg] $msg
  1130. } {1 {can't set "a(2)": variable isn't array}}
  1131. test text-20.51 {TextSearchCmd procedure, wrap-around} {
  1132.     .t search -backwards xyz 1.1
  1133. } {3.5}
  1134. test text-20.52 {TextSearchCmd procedure, wrap-around} {
  1135.     .t search -backwards xyz 1.1 1.0
  1136. } {}
  1137. test text-20.53 {TextSearchCmd procedure, wrap-around} {
  1138.     .t search xyz 3.6
  1139. } {1.1}
  1140. test text-20.54 {TextSearchCmd procedure, wrap-around} {
  1141.     .t search xyz 3.6 end
  1142. } {}
  1143. test text-20.55 {TextSearchCmd procedure, no match} {
  1144.     .t search non_existent 3.5
  1145. } {}
  1146. test text-20.56 {TextSearchCmd procedure, no match} {
  1147.     .t search -regexp non_existent 3.5
  1148. } {}
  1149. test text-20.57 {TextSearchCmd procedure, special cases} {
  1150.     .t search -back x 1.1
  1151. } {1.0}
  1152. test text-20.58 {TextSearchCmd procedure, special cases} {
  1153.     .t search -back x 1.0
  1154. } {3.8}
  1155. test text-20.59 {TextSearchCmd procedure, special cases} {
  1156.     .t search n {end-2c}
  1157. } {3.9}
  1158. test text-20.60 {TextSearchCmd procedure, special cases} {
  1159.     .t search n end
  1160. } {1.15}
  1161. test text-20.61 {TextSearchCmd procedure, special cases} {
  1162.     .t search x 1.0
  1163. } {1.0}
  1164. test text-20.62 {TextSearchCmd, freeing copy of pattern} {
  1165.     # This test doesn't return a result, but it will generate
  1166.     # a core leak if the pattern copy isn't properly freed.
  1168.     set p abcdefg1234567890
  1169.     set p $p$p$p$p$p$p$p$p
  1170.     set p $p$p$p$p$p
  1171.     .t search -nocase $p 1.0
  1172. } {}
  1173. test text-20.63 {TextSearchCmd, unicode} {
  1174.     .t delete 1.0 end
  1175.     .t insert end "foou30c9u30cabar"
  1176.     .t search u30c9u30ca 1.0
  1177. } 1.3
  1178. test text-20.64 {TextSearchCmd, unicode} {
  1179.     .t delete 1.0 end
  1180.     .t insert end "foou30c9u30cabar"
  1181.     list [.t search -count n u30c9u30ca 1.0] $n
  1182. } {1.3 2}
  1183. test text-20.65 {TextSearchCmd, unicode with non-text segments} {
  1184.     .t delete 1.0 end
  1185.     button .b1 -text baz
  1186.     .t insert end "foou30c9"
  1187.     .t window create end -window .b1
  1188.     .t insert end "u30cabar"
  1189.     set result [list [.t search -count n u30c9u30ca 1.0] $n]
  1190.     destroy .b1
  1191.     set result
  1192. } {1.3 3}
  1194. test text-20.66 {TextSearchCmd, hidden text does not affect match index} {
  1195.     deleteWindows
  1196.     pack [text .t2]
  1197.     .t2 insert end "12345H7890"
  1198.     .t2 search 7 1.0
  1199. } 1.6
  1200. test text-20.67 {TextSearchCmd, hidden text does not affect match index} {
  1201.     deleteWindows
  1202.     pack [text .t2]
  1203.     .t2 insert end "12345H7890"
  1204.     .t2 tag configure hidden -elide true
  1205.     .t2 tag add hidden 1.5
  1206.     .t2 search 7 1.0
  1207. } 1.6
  1208. test text-20.68 {TextSearchCmd, hidden text does not affect match index} {
  1209.     deleteWindows
  1210.     pack [text .t2]
  1211.     .t2 insert end "foobarnbarbaznbazboo"
  1212.     .t2 search boo 1.0
  1213. } 3.3
  1214. test text-20.69 {TextSearchCmd, hidden text does not affect match index} {
  1215.     deleteWindows
  1216.     pack [text .t2]
  1217.     .t2 insert end "foobarnbarbaznbazboo"
  1218.     .t2 tag configure hidden -elide true
  1219.     .t2 tag add hidden 2.0 3.0
  1220.     .t2 search boo 1.0
  1221. } 3.3
  1223. test text-20.70 {TextSearchCmd, -regexp -nocase searches} {
  1224.     catch {destroy .t}
  1225.     pack [text .t]
  1226.     .t insert end "word1 word2"
  1227.     set res [.t search -nocase -regexp {mword.} 1.0 end]
  1228.     destroy .t
  1229.     set res
  1230. } 1.0
  1231. test text-20.71 {TextSearchCmd, -regexp -nocase searches} {
  1232.     catch {destroy .t}
  1233.     pack [text .t]
  1234.     .t insert end "word1 word2"
  1235.     set res [.t search -nocase -regexp {word.M} 1.0 end]
  1236.     destroy .t
  1237.     set res
  1238. } 1.0
  1239. test text-20.72 {TextSearchCmd, -regexp -nocase searches} {
  1240.     catch {destroy .t}
  1241.     pack [text .t]
  1242.     .t insert end "word1 word2"
  1243.     set res [.t search -nocase -regexp {word.W} 1.0 end]
  1244.     destroy .t
  1245.     set res
  1246. } 1.0
  1247.     
  1248. deleteWindows
  1249. text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
  1250. pack .t2
  1251. .t2 insert end "1t2t3t4t55.5"
  1252. test text-21.1 {TkTextGetTabs procedure} {
  1253.     list [catch {.t2 configure -tabs "{{}"} msg] $msg
  1254. } {1 {unmatched open brace in list}}
  1255. test text-21.2 {TkTextGetTabs procedure} {
  1256.     list [catch {.t2 configure -tabs xyz} msg] $msg
  1257. } {1 {bad screen distance "xyz"}}
  1258. test text-21.3 {TkTextGetTabs procedure} {
  1259.     .t2 configure -tabs {100 200}
  1260.     update idletasks
  1261.     list [lindex [.t2 bbox 1.2] 0] [lindex [.t2 bbox 1.4] 0]
  1262. } {100 200}
  1263. test text-21.4 {TkTextGetTabs procedure} {
  1264.     .t2 configure -tabs {100 right 200 left 300 center 400 numeric}
  1265.     update idletasks
  1266.     list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] 
  1267.     [lindex [.t2 bbox 1.4] 0] 
  1268.     [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] 
  1269.     [lindex [.t2 bbox 1.10] 0]
  1270. } {100 200 300 400}
  1271. test text-21.5 {TkTextGetTabs procedure} {
  1272.     .t2 configure -tabs {105 r 205 l 305 c 405 n}
  1273.     update idletasks
  1274.     list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] 
  1275.     [lindex [.t2 bbox 1.4] 0] 
  1276.     [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] 
  1277.     [lindex [.t2 bbox 1.10] 0]
  1278. } {105 205 305 405}
  1279. test text-21.6 {TkTextGetTabs procedure} {
  1280.     list [catch {.t2 configure -tabs {100 left 200 lork}} msg] $msg
  1281. } {1 {bad tab alignment "lork": must be left, right, center, or numeric}}
  1282. test text-21.7 {TkTextGetTabs procedure} {
  1283.     list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg
  1284. } {1 {bad screen distance "!44"}}
  1286. deleteWindows
  1287. text .t
  1288. pack .t
  1289. .t insert 1.0 "One Line"
  1290. .t mark set insert 1.0
  1292. test text-22.1 {TextDumpCmd procedure, bad args} {
  1293.     list [catch {.t dump} msg] $msg
  1294. } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
  1295. test text-22.2 {TextDumpCmd procedure, bad args} {
  1296.     list [catch {.t dump -all} msg] $msg
  1297. } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
  1298. test text-22.3 {TextDumpCmd procedure, bad args} {
  1299.     list [catch {.t dump -command} msg] $msg
  1300. } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
  1301. test text-22.4 {TextDumpCmd procedure, bad args} {
  1302.     list [catch {.t dump -bogus} msg] $msg
  1303. } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
  1304. test text-22.5 {TextDumpCmd procedure, bad args} {
  1305.     list [catch {.t dump bogus} msg] $msg
  1306. } {1 {bad text index "bogus"}}
  1307. test text-22.6 {TextDumpCmd procedure, one index} {
  1308.     .t dump -text 1.2
  1309. } {text e 1.2}
  1310. test text-22.7 {TextDumpCmd procedure, two indices} {
  1311.     .t dump -text 1.0 1.end
  1312. } {text {One Line} 1.0}
  1313. test text-22.8 {TextDumpCmd procedure, "end" index} {
  1314.     .t dump -text 1.end end
  1315. } {text {
  1316. } 1.8}
  1317. test text-22.9 {TextDumpCmd procedure, same indices} {
  1318.     .t dump 1.5 1.5
  1319. } {}
  1320. test text-22.10 {TextDumpCmd procedure, negative range} {
  1321.     .t dump 1.5 1.0
  1322. } {}
  1324. .t delete 1.0 end
  1325. .t insert end "Line OnenLine TwonLine ThreenLine Four"
  1326. .t mark set insert 1.0
  1327. .t mark set current 1.0
  1329. test text-22.11 {TextDumpCmd procedure, stop at begin-line} {
  1330.     .t dump -text 1.0 2.0
  1331. } {text {Line One
  1332. } 1.0}
  1333. test text-22.12 {TextDumpCmd procedure, span multiple lines} {
  1334.     .t dump -text 1.5 3.end
  1335. } {text {One
  1336. } 1.5 text {Line Two
  1337. } 2.0 text {Line Three} 3.0}
  1339. .t tag add x 2.0 2.end
  1340. .t tag add y 1.0 end
  1341. .t mark set m 2.4
  1342. .t mark set n 4.0
  1343. .t mark set END end
  1344. test text-22.13 {TextDumpCmd procedure, tags only} {
  1345.     .t dump -tag 2.1 2.8
  1346. } {}
  1347. test text-22.14 {TextDumpCmd procedure, tags only} {
  1348.     .t dump -tag 2.0 2.8
  1349. } {tagon x 2.0}
  1350. test text-22.15 {TextDumpCmd procedure, tags only} {
  1351.     .t dump -tag 1.0 4.end
  1352. } {tagon y 1.0 tagon x 2.0 tagoff x 2.8}
  1353. test text-22.16 {TextDumpCmd procedure, tags only} {
  1354.     .t dump -tag 1.0 end
  1355. } {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0}
  1357. .t mark set insert 1.0
  1358. .t mark set current 1.0
  1359. test text-22.17 {TextDumpCmd procedure, marks only} {
  1360.     .t dump -mark 1.1 1.8
  1361. } {}
  1362. test text-22.18 {TextDumpCmd procedure, marks only} {
  1363.     .t dump -mark 2.0 2.8
  1364. } {mark m 2.4}
  1365. test text-22.19 {TextDumpCmd procedure, marks only} {
  1366.     .t dump -mark 1.1 4.end
  1367. } {mark m 2.4 mark n 4.0}
  1368. test text-22.20 {TextDumpCmd procedure, marks only} {
  1369.     .t dump -mark 1.0 end
  1370. } {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0}
  1372. button .hello -text Hello
  1373. .t window create 3.end -window .hello
  1374. for {set i 0} {$i < 100} {incr i} {
  1375.     .t insert end "-n"
  1376. }
  1377. .t window create 100.0 -create { }
  1378. test text-22.21 {TextDumpCmd procedure, windows only} {
  1379.     .t dump -window 1.0 5.0
  1380. } {window .hello 3.10}
  1381. test text-22.22 {TextDumpCmd procedure, windows only} {
  1382.     .t dump -window 5.0 end
  1383. } {window {} 100.0}
  1385. .t delete 1.0 end
  1386. eval {.t mark unset} [.t mark names]
  1387. .t insert end "Line OnenLine TwonLine ThreenLine Four"
  1388. .t mark set insert 1.0
  1389. .t mark set current 1.0
  1390. .t tag add x 2.0 2.end
  1391. .t mark set m 2.4
  1392. proc Append {varName key value index} {
  1393.     upvar #0 $varName x
  1394.     lappend x $key $index $value
  1395. }
  1396. test text-22.23 {TextDumpCmd procedure, command script} {
  1397.     set x {}
  1398.     .t dump -command {Append x} -all 1.0 end
  1399.     set x
  1400. } {mark 1.0 current mark 1.0 insert text 1.0 {Line One
  1401. } tagon 2.0 x text 2.0 Line mark 2.4 m text 2.4 { Two} tagoff 2.8 x text 2.8 {
  1402. } text 3.0 {Line Three
  1403. } text 4.0 {Line Four
  1404. }}
  1405. test text-22.24 {TextDumpCmd procedure, command script} {
  1406.     set x {}
  1407.     .t dump -mark -command {Append x} 1.0 end
  1408.     set x
  1409. } {mark 1.0 current mark 1.0 insert mark 2.4 m}
  1410. catch {unset x}
  1411. test text-22.25 {TextDumpCmd procedure, unicode characters} {
  1412.     catch {destroy .t}
  1413.     text .t
  1414.     .t delete 1.0 end
  1415.     .t insert 1.0 xb1xb1xb1
  1416.     .t dump -all 1.0 2.0
  1417. } "text xb1xb1xb1 1.0 mark insert 1.3 mark current 1.3 text {n} 1.3"
  1418. test text-22.26 {TextDumpCmd procedure, unicode characters} {
  1419.     catch {destroy .t}
  1420.     text .t
  1421.     .t delete 1.0 end
  1422.     .t insert 1.0 abcxb1xb1xb1
  1423.     .t dump -all 1.0 2.0
  1424. } "text abcxb1xb1xb1 1.0 mark insert 1.6 mark current 1.6 text {n} 1.6"
  1426. set l [interp hidden]
  1427. deleteWindows
  1429. test text-23.1 {text widget vs hidden commands} {
  1430.     catch {destroy .t}
  1431.     text .t
  1432.     interp hide {} .t
  1433.     destroy .t
  1434.     list [winfo children .] [interp hidden]
  1435. } [list {} $l]
  1437. test text-24.1 {bug fix - 1642} {
  1438.     catch {destroy .t}
  1439.     text .t
  1440.     pack .t
  1441.     .t insert end "line 1n"
  1442.     .t insert end "line 2n"
  1443.     .t insert end "line 3n"
  1444.     .t insert end "line 4n"
  1445.     .t insert end "line 5n"
  1446.     tk::TextSetCursor .t 3.0
  1447.     .t search -backward -regexp "$" insert 1.0
  1448. } {2.6}
  1450. test text-25.1 {TextEditCmd procedure, argument parsing} {
  1451.     list [catch {.t edit} msg] $msg
  1452. } {1 {wrong # args: should be ".t edit option ?arg arg ...?"}}
  1454. test text-25.2 {TextEditCmd procedure, argument parsing} {
  1455.     list [catch {.t edit gorp} msg] $msg
  1456. } {1 {bad edit option "gorp": must be modified, redo, reset, separator or undo}}
  1458. test text-25.3 {TextEditUndo procedure, undoing changes} {
  1459.     catch {destroy .t}
  1460.     text .t -undo 1
  1461.     pack .t
  1462.     .t insert end "line 1n"
  1463.     .t delete 1.4 1.6
  1464.     .t insert end "should be gone after undon"
  1465.     .t edit undo
  1466.     .t get 1.0 end
  1467. } "linenn"
  1469. test text-25.4 {TextEditRedo procedure, redoing changes} {
  1470.     catch {destroy .t}
  1471.     text .t -undo 1
  1472.     pack .t
  1473.     .t insert end "line 1n"
  1474.     .t delete 1.4 1.6
  1475.     .t insert end "should be back after redon"
  1476.     .t edit undo
  1477.     .t edit redo
  1478.     .t get 1.0 end
  1479. } "linenshould be back after redonn"
  1481. test text-25.5 {TextEditUndo procedure, resetting stack} {
  1482.     catch {destroy .t}
  1483.     text .t -undo 1
  1484.     pack .t
  1485.     .t insert end "line 1n"
  1486.     .t delete 1.4 1.6
  1487.     .t insert end "should be back after redon"
  1488.     .t edit reset
  1489.     catch {.t edit undo} msg
  1490.     set msg
  1491. } "nothing to undo"
  1493. test text-25.6 {TextEditCmd procedure, insert separator} {
  1494.     catch {destroy .t}
  1495.     text .t -undo 1
  1496.     pack .t
  1497.     .t insert end "line 1n"
  1498.     .t edit separator
  1499.     .t insert end "line 2n"
  1500.     .t edit undo
  1501.     .t get 1.0 end
  1502. } "line 1nn"
  1504. test text-25.7 {-autoseparators configuration option} {
  1505.     catch {destroy .t}
  1506.     text .t -undo 1 -autoseparators 0
  1507.     pack .t
  1508.     .t insert end "line 1n"
  1509.     .t delete 1.4 1.6
  1510.     .t insert end "line 2n"
  1511.     .t edit undo
  1512.     .t get 1.0 end
  1513. } "n"
  1515. test text-25.8 {TextEditCmd procedure, modified flag} {
  1516.     catch {destroy .t}
  1517.     text .t
  1518.     pack .t
  1519.     .t insert end "line 1n"
  1520.     .t edit modified
  1521. } {1}
  1523. test text-25.9 {TextEditCmd procedure, reset modified flag} {
  1524.     catch {destroy .t}
  1525.     text .t
  1526.     pack .t
  1527.     .t insert end "line 1n"
  1528.     .t edit modified 0
  1529.     .t edit modified
  1530. } {0}
  1532. test text-25.10 {TextEditCmd procedure, set modified flag} {
  1533.     catch {destroy .t}
  1534.     text .t
  1535.     pack .t
  1536.     .t edit modified 1
  1537.     .t edit modified
  1538. } {1}
  1539. test text-25.10.1 {TextEditCmd procedure, set modified flag repeat} {
  1540.     catch {destroy .t}
  1541.     text .t
  1542.     pack .t
  1543.     set ::retval {}
  1544.     bind .t <<Modified>> "lappend ::retval modified"
  1545.     # Shouldn't require [update idle] to trigger event [Bug 1809538]
  1546.     lappend ::retval [.t edit modified]
  1547.     .t edit modified 1
  1548.     update idletasks
  1549.     lappend ::retval [.t edit modified]
  1550.     .t edit modified 1 ; # binding should only fire once [Bug 1799782]
  1551.     update idletasks
  1552.     lappend ::retval [.t edit modified]
  1553. } {0 modified 1 1}
  1555. test text-25.11 {<<Modified>> virtual event} {
  1556.     set ::retval unmodified
  1557.     catch {destroy .t}
  1558.     text .t -undo 1
  1559.     pack .t
  1560.     bind .t <<Modified>> "set ::retval modified"
  1561.     update idletasks
  1562.     .t insert end "nothing specialn"
  1563.     set ::retval
  1564. } {modified}
  1565. test text-25.11.1 {<<Modified>> virtual event - insert before Modified} {
  1566.     set ::retval {}
  1567.     destroy .t
  1568.     pack [text .t -undo 1]
  1569.     bind .t <<Modified>> { set ::retval [.t get 1.0 end-1c] }
  1570.     update idletasks
  1571.     .t insert end "nothing special"
  1572.     set ::retval
  1573. } {nothing special}
  1574. test text-25.11.2 {<<Modified>> virtual event - delete before Modified} {
  1575.     # Bug 1737288, make sure we delete chars before triggering <<Modified>>
  1576.     set ::retval {}
  1577.     destroy .t
  1578.     pack [text .t -undo 1]
  1579.     bind .t <<Modified>> { set ::retval [.t get 1.0 end-1c] }
  1580.     .t insert end "nothing special"
  1581.     .t edit modified 0
  1582.     .t delete 1.0 1.2
  1583.     set ::retval
  1584. } {thing special}
  1586. test text-25.12 {<<Selection>> virtual event} {
  1587.     set ::retval no_selection
  1588.     catch {destroy .t}
  1589.     text .t -undo 1
  1590.     pack .t
  1591.     bind .t <<Selection>> "set ::retval selection_changed"
  1592.     update idletasks
  1593.     .t insert end "nothing specialn"
  1594.     .t tag add sel 1.0 1.1
  1595.     set ::retval
  1596. } {selection_changed}
  1598. test text-25.13 {-maxundo configuration option} {
  1599.     catch {destroy .t}
  1600.     text .t -undo 1  -autoseparators 1 -maxundo 2
  1601.     pack .t
  1602.     .t insert end "line 1n"
  1603.     .t delete 1.4 1.6
  1604.     .t insert end "line 2n"
  1605.     catch {.t edit undo}
  1606.     catch {.t edit undo}
  1607.     catch {.t edit undo}
  1608.     .t get 1.0 end
  1609. } "line 1nn"
  1611. test text-25.14 {undo with space-based path} {
  1612.     set t {.t e x t}
  1613.     destroy $t
  1614.     text $t -undo 1
  1615.     $t insert end "line 1n"
  1616.     $t delete 1.4 1.6
  1617.     $t insert end "line 2n"
  1618.     $t edit undo
  1619.     $t edit undo
  1620.     $t get 1.0 end
  1621. } "line 1nn"
  1623. test text-26.1 {bug fix - 624372, ControlUtfProc long lines} {
  1624.     destroy .t
  1625.     pack [text .t -wrap none]
  1626.     .t insert end [string repeat "1" 500]
  1627. } {}
  1629. deleteWindows
  1630. option clear
  1632. # cleanup
  1633. ::tcltest::cleanupTests
  1634. return