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

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

通讯编程

开发平台：

Visual C++

textTag.test：源码内容
  1. # This file is a Tcl script to test the code in the file tkTextTag.c.
  2. # This file is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 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: textTag.test,v 1.6 2002/07/13 20:28:35 dgp 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. catch {destroy .t}
  19. testConstraint courier12 [expr {[catch {
  20. text .t -font {Courier 12} -width 20 -height 10
  21. }] == 0}]
  23. pack append . .t {top expand fill}
  24. update
  25. .t debug on
  26. wm geometry . {}
  27. set bigFont {Helvetica 24}
  28.   
  29. # The statements below reset the main window;  it's needed if the window
  30. # manager is mwm, to make mwm forget about a previous minimum size setting.
  32. wm withdraw .
  33. wm minsize . 1 1
  34. wm positionfrom . user
  35. wm deiconify .
  37. entry .t.e
  38. .t.e insert 0 "Text"
  40. .t insert 1.0 "Line 1
  41. abcdefghijklm
  42. 12345
  43. Line 4
  44. bOy GIrl .#@? x_yz
  45. !@#$%
  46. Line 7"
  49. set i 1
  50. foreach test {
  51.     {-background #012345 #012345 non-existent
  52.     {unknown color name "non-existent"}}
  53.     {-bgstipple gray50 gray50 badStipple
  54.     {bitmap "badStipple" not defined}}
  55.     {-borderwidth 2 2 46q
  56.     {bad screen distance "46q"}}
  57.     {-fgstipple gray25 gray25 bogus
  58.     {bitmap "bogus" not defined}}
  59.     {-font fixed fixed {}
  60.     {font "" doesn't exist}}
  61.     {-foreground #001122 #001122 {silly color}
  62.     {unknown color name "silly color"}}
  63.     {-justify left left middle
  64.     {bad justification "middle": must be left, right, or center}}
  65.     {-lmargin1 10 10 bad
  66.     {bad screen distance "bad"}}
  67.     {-lmargin2 10 10 bad
  68.     {bad screen distance "bad"}}
  69.     {-offset 2 2 100xyz
  70.     {bad screen distance "100xyz"}}
  71.     {-overstrike on on stupid
  72.     {expected boolean value but got "stupid"}}
  73.     {-relief raised raised stupid
  74.     {bad relief type "stupid": must be flat, groove, raised, ridge, solid, or sunken}}
  75.     {-rmargin 10 10 bad
  76.     {bad screen distance "bad"}}
  77.     {-spacing1 10 10 bad
  78.     {bad screen distance "bad"}}
  79.     {-spacing2 10 10 bad
  80.     {bad screen distance "bad"}}
  81.     {-spacing3 10 10 bad
  82.     {bad screen distance "bad"}}
  83.     {-tabs {10 20 30} {10 20 30} {10 fork}
  84.     {bad tab alignment "fork": must be left, right, center, or numeric}}
  85.     {-underline no no stupid
  86.     {expected boolean value but got "stupid"}}
  87. } {
  88.     set name [lindex $test 0]
  89.     test textTag-1.$i {tag configuration options} courier12 {
  90. .t tag configure x $name [lindex $test 1]
  91. .t tag cget x $name
  92.     } [lindex $test 2]
  93.     incr i
  94.     if {[lindex $test 3] != ""} {
  95. test textTag-1.$i {configuration options} courier12 {
  96.     list [catch {.t tag configure x $name [lindex $test 3]} msg] $msg
  97. } [list 1 [lindex $test 4]]
  98.     }
  99.     .t tag configure x $name [lindex [.t tag configure x $name] 3]
  100.     incr i
  101. }
  102. test textTag-2.1 {TkTextTagCmd - "add" option} courier12 {
  103.     list [catch {.t tag} msg] $msg
  104. } {1 {wrong # args: should be ".t tag option ?arg arg ...?"}}
  105. test textTag-2.2 {TkTextTagCmd - "add" option} courier12 {
  106.     list [catch {.t tag gorp} msg] $msg
  107. } {1 {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, raise, ranges, or remove}}
  108. test textTag-2.3 {TkTextTagCmd - "add" option} courier12 {
  109.     list [catch {.t tag add foo} msg] $msg
  110. } {1 {wrong # args: should be ".t tag add tagName index1 ?index2 index1 index2 ...?"}}
  111. test textTag-2.4 {TkTextTagCmd - "add" option} courier12 {
  112.     list [catch {.t tag add x gorp} msg] $msg
  113. } {1 {bad text index "gorp"}}
  114. test textTag-2.5 {TkTextTagCmd - "add" option} courier12 {
  115.     list [catch {.t tag add x 1.2 gorp} msg] $msg
  116. } {1 {bad text index "gorp"}}
  117. test textTag-2.6 {TkTextTagCmd - "add" option} courier12 {
  118.     .t tag add sel 3.2 3.4
  119.     .t tag add sel 3.2 3.0
  120.     .t tag ranges sel
  121. } {3.2 3.4}
  122. test textTag-2.7 {TkTextTagCmd - "add" option} courier12 {
  123.     .t tag add x 1.0 1.end
  124.     .t tag ranges x
  125. } {1.0 1.6}
  126. test textTag-2.8 {TkTextTagCmd - "add" option} courier12 {
  127.     .t tag remove x 1.0 end
  128.     .t tag add x 1.2
  129.     .t tag ranges x
  130. } {1.2 1.3}
  131. test textTag-2.9 {TkTextTagCmd - "add" option} courier12 {
  132.     .t.e select from 0
  133.     .t.e select to 4
  134.     .t tag add sel 3.2 3.4
  135.     selection get
  136. } 34
  137. test textTag-2.11 {TkTextTagCmd - "add" option} courier12 {
  138.     .t.e select from 0
  139.     .t.e select to 4
  140.     .t configure -exportselection 0
  141.     .t tag add sel 3.2 3.4
  142.     selection get
  143. } Text
  144. test textTag-2.12 {TkTextTagCmd - "add" option} courier12 {
  145.     .t tag remove sel 1.0 end
  146.     .t tag add sel 1.1 1.5 2.4 3.1 4.2 4.4
  147.     .t tag ranges sel
  148. } {1.1 1.5 2.4 3.1 4.2 4.4}
  149. test textTag-2.13 {TkTextTagCmd - "add" option} courier12 {
  150.     .t tag remove sel 1.0 end
  151.     .t tag add sel 1.1 1.5 2.4
  152.     .t tag ranges sel
  153. } {1.1 1.5 2.4 2.5}
  155. catch {.t tag delete x}
  156. test textTag-3.1 {TkTextTagCmd - "bind" option} courier12 {
  157.     list [catch {.t tag bind} msg] $msg
  158. } {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}}
  159. test textTag-3.2 {TkTextTagCmd - "bind" option} courier12 {
  160.     list [catch {.t tag bind 1 2 3 4} msg] $msg
  161. } {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}}
  162. test textTag-3.3 {TkTextTagCmd - "bind" option} courier12 {
  163.     .t tag bind x <Enter> script1
  164.     .t tag bind x <Enter>
  165. } script1
  166. test textTag-3.4 {TkTextTagCmd - "bind" option} courier12 {
  167.     list [catch {.t tag bind x <Gorp> script2} msg] $msg
  168. } {1 {bad event type or keysym "Gorp"}}
  169. test textTag-3.5 {TkTextTagCmd - "bind" option} courier12 {
  170.     .t tag delete x
  171.     .t tag bind x <Enter> script1
  172.     list [catch {.t tag bind x <FocusIn> script2} msg] $msg [.t tag bind x]
  173. } {1 {requested illegal events; only key, button, motion, enter, leave, and virtual events may be used} <Enter>}
  174. test textTag-3.6 {TkTextTagCmd - "bind" option} courier12 {
  175.     .t tag delete x
  176.     .t tag bind x <Enter> script1
  177.     .t tag bind x <Leave> script2
  178.     .t tag bind x a xyzzy
  179.     list [lsort [.t tag bind x]] [.t tag bind x <Enter>] [.t tag bind x a]
  180. } {{<Enter> <Leave> a} script1 xyzzy}
  181. test textTag-3.7 {TkTextTagCmd - "bind" option} courier12 {
  182.     .t tag delete x
  183.     .t tag bind x <Enter> script1
  184.     .t tag bind x <Enter> +script2
  185.     .t tag bind x <Enter>
  186. } {script1
  187. script2}
  188. test textTag-3.7 {TkTextTagCmd - "bind" option} courier12 {
  189.     .t tag delete x
  190.     list [catch {.t tag bind x <Enter>} msg] $msg
  191. } {0 {}}
  192. test textTag-3.8 {TkTextTagCmd - "bind" option} courier12 {
  193.     .t tag delete x
  194.     list [catch {.t tag bind x <} msg] $msg
  195. } {1 {no event type or button # or keysym}}
  197. test textTag-4.1 {TkTextTagCmd - "cget" option} courier12 {
  198.     list [catch {.t tag cget a} msg] $msg
  199. } {1 {wrong # args: should be ".t tag cget tagName option"}}
  200. test textTag-4.2 {TkTextTagCmd - "cget" option} courier12 {
  201.     list [catch {.t tag cget a b c} msg] $msg
  202. } {1 {wrong # args: should be ".t tag cget tagName option"}}
  203. test textTag-4.3 {TkTextTagCmd - "cget" option} courier12 {
  204.     .t tag delete foo
  205.     list [catch {.t tag cget foo bar} msg] $msg
  206. } {1 {tag "foo" isn't defined in text widget}}
  207. test textTag-4.4 {TkTextTagCmd - "cget" option} courier12 {
  208.     list [catch {.t tag cget sel bogus} msg] $msg
  209. } {1 {unknown option "bogus"}}
  210. test textTag-4.5 {TkTextTagCmd - "cget" option} courier12 {
  211.     .t tag delete x
  212.     .t tag configure x -background red
  213.     list [catch {.t tag cget x -background} msg] $msg
  214. } {0 red}
  216. test textTag-5.1 {TkTextTagCmd - "configure" option} courier12 {
  217.     list [catch {.t tag configure} msg] $msg
  218. } {1 {wrong # args: should be ".t tag configure tagName ?option? ?value? ?option value ...?"}}
  219. test textTag-5.2 {TkTextTagCmd - "configure" option} courier12 {
  220.     list [catch {.t tag configure x -foo} msg] $msg
  221. } {1 {unknown option "-foo"}}
  222. test textTag-5.3 {TkTextTagCmd - "configure" option} courier12 {
  223.     list [catch {.t tag configure x -background red -underline} msg] $msg
  224. } {1 {value for "-underline" missing}}
  225. test textTag-5.4 {TkTextTagCmd - "configure" option} courier12 {
  226.     .t tag delete x
  227.     .t tag configure x -underline yes
  228.     .t tag configure x -underline
  229. } {-underline {} {} {} yes}
  230. test textTag-5.5 {TkTextTagCmd - "configure" option} courier12 {
  231.     .t tag delete x
  232.     .t tag configure x -overstrike on
  233.     .t tag cget x -overstrike
  234. } {on}
  235. test textTag-5.6 {TkTextTagCmd - "configure" option} courier12 {
  236.     list [catch {.t tag configure x -overstrike foo} msg] $msg
  237. } {1 {expected boolean value but got "foo"}}
  238. test textTag-5.7 {TkTextTagCmd - "configure" option} courier12 {
  239.     .t tag delete x
  240.     list [catch {.t tag configure x -underline stupid} msg] $msg
  241. } {1 {expected boolean value but got "stupid"}}
  242. test textTag-5.8 {TkTextTagCmd - "configure" option} courier12 {
  243.     .t tag delete x
  244.     .t tag configure x -justify left
  245.     .t tag configure x -justify
  246. } {-justify {} {} {} left}
  247. test textTag-5.9 {TkTextTagCmd - "configure" option} courier12 {
  248.     .t tag delete x
  249.     list [catch {.t tag configure x -justify bogus} msg] $msg
  250. } {1 {bad justification "bogus": must be left, right, or center}}
  251. test textTag-5.10 {TkTextTagCmd - "configure" option} courier12 {
  252.     .t tag delete x
  253.     list [catch {.t tag configure x -justify fill} msg] $msg
  254. } {1 {bad justification "fill": must be left, right, or center}}
  255. test textTag-5.11 {TkTextTagCmd - "configure" option} courier12 {
  256.     .t tag delete x
  257.     .t tag configure x -offset 2
  258.     .t tag configure x -offset
  259. } {-offset {} {} {} 2}
  260. test textTag-5.12 {TkTextTagCmd - "configure" option} courier12 {
  261.     .t tag delete x
  262.     list [catch {.t tag configure x -offset 1.0q} msg] $msg
  263. } {1 {bad screen distance "1.0q"}}
  264. test textTag-5.13 {TkTextTagCmd - "configure" option} courier12 {
  265.     .t tag delete x
  266.     .t tag configure x -lmargin1 2 -lmargin2 4 -rmargin 5
  267.     list [.t tag configure x -lmargin1] [.t tag configure x -lmargin2] 
  268.     [.t tag configure x -rmargin]
  269. } {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5}}
  270. test textTag-5.14 {TkTextTagCmd - "configure" option} courier12 {
  271.     .t tag delete x
  272.     list [catch {.t tag configure x -lmargin1 2.0x} msg] $msg
  273. } {1 {bad screen distance "2.0x"}}
  274. test textTag-5.15 {TkTextTagCmd - "configure" option} courier12 {
  275.     .t tag delete x
  276.     list [catch {.t tag configure x -lmargin2 gorp} msg] $msg
  277. } {1 {bad screen distance "gorp"}}
  278. test textTag-5.16 {TkTextTagCmd - "configure" option} courier12 {
  279.     .t tag delete x
  280.     list [catch {.t tag configure x -rmargin 140.1.1} msg] $msg
  281. } {1 {bad screen distance "140.1.1"}}
  282. .t tag delete x
  283. test textTag-5.17 {TkTextTagCmd - "configure" option} courier12 {
  284.     .t tag delete x
  285.     .t tag configure x -spacing1 2 -spacing2 4 -spacing3 6
  286.     list [.t tag configure x -spacing1] [.t tag configure x -spacing2] 
  287.     [.t tag configure x -spacing3]
  288. } {{-spacing1 {} {} {} 2} {-spacing2 {} {} {} 4} {-spacing3 {} {} {} 6}}
  289. test textTag-5.18 {TkTextTagCmd - "configure" option} courier12 {
  290.     .t tag delete x
  291.     list [catch {.t tag configure x -spacing1 2.0x} msg] $msg
  292. } {1 {bad screen distance "2.0x"}}
  293. test textTag-5.19 {TkTextTagCmd - "configure" option} courier12 {
  294.     .t tag delete x
  295.     list [catch {.t tag configure x -spacing1 lousy} msg] $msg
  296. } {1 {bad screen distance "lousy"}}
  297. test textTag-5.20 {TkTextTagCmd - "configure" option} courier12 {
  298.     .t tag delete x
  299.     list [catch {.t tag configure x -spacing1 4.2.3} msg] $msg
  300. } {1 {bad screen distance "4.2.3"}}
  301. test textTag-5.21 {TkTextTagCmd - "configure" option} courier12 {
  302.     .t configure -selectborderwidth 2 -selectforeground blue 
  303.     -selectbackground black
  304.     .t tag configure sel -borderwidth 4 -foreground green -background yellow
  305.     set x {}
  306.     foreach i {-selectborderwidth -selectforeground -selectbackground} {
  307. lappend x [lindex [.t configure $i] 4]
  308.     }
  309.     set x
  310. } {4 green yellow}
  311. test textTag-5.22 {TkTextTagCmd - "configure" option} courier12 {
  312.     .t configure -selectborderwidth 20
  313.     .t tag configure sel -borderwidth {}
  314.     .t cget -selectborderwidth
  315. } {}
  317. test textTag-6.1 {TkTextTagCmd - "delete" option} courier12 {
  318.     list [catch {.t tag delete} msg] $msg
  319. } {1 {wrong # args: should be ".t tag delete tagName tagName ..."}}
  320. test textTag-6.2 {TkTextTagCmd - "delete" option} courier12 {
  321.     list [catch {.t tag delete zork} msg] $msg
  322. } {0 {}}
  323. test textTag-6.3 {TkTextTagCmd - "delete" option} courier12 {
  324.     .t tag delete x
  325.     .t tag config x -background black
  326.     .t tag config y -foreground white
  327.     .t tag config z -background black
  328.     .t tag delete y z
  329.     lsort [.t tag names]
  330. } {sel x}
  331. test textTag-6.4 {TkTextTagCmd - "delete" option} courier12 {
  332.     .t tag config x -background black
  333.     .t tag config y -foreground white
  334.     .t tag config z -background black
  335.     eval .t tag delete [.t tag names]
  336.     .t tag names
  337. } {sel}
  338. test textTag-6.5 {TkTextTagCmd - "delete" option} courier12 {
  339.     .t tag bind x <Enter> foo
  340.     .t tag delete x
  341.     .t tag configure x -background black
  342.     .t tag bind x
  343. } {}
  345. proc tagsetup {} {
  346.     .t tag delete x y z a b c d
  347.     .t tag remove sel 1.0 end
  348.     foreach i {a b c d} {
  349. .t tag configure $i -background black
  350.     }
  351. }
  352. test textTag-7.1 {TkTextTagCmd - "lower" option} courier12 {
  353.     list [catch {.t tag lower} msg] $msg
  354. } {1 {wrong # args: should be ".t tag lower tagName ?belowThis?"}}
  355. test textTag-7.2 {TkTextTagCmd - "lower" option} courier12 {
  356.     list [catch {.t tag lower foo} msg] $msg
  357. } {1 {tag "foo" isn't defined in text widget}}
  358. test textTag-7.3 {TkTextTagCmd - "lower" option} courier12 {
  359.     list [catch {.t tag lower sel bar} msg] $msg
  360. } {1 {tag "bar" isn't defined in text widget}}
  361. test textTag-7.4 {TkTextTagCmd - "lower" option} courier12 {
  362.     tagsetup
  363.     .t tag lower c
  364.     .t tag names
  365. } {c sel a b d}
  366. test textTag-7.5 {TkTextTagCmd - "lower" option} courier12 {
  367.     tagsetup
  368.     .t tag lower d b
  369.     .t tag names
  370. } {sel a d b c}
  371. test textTag-7.6 {TkTextTagCmd - "lower" option} courier12 {
  372.     tagsetup
  373.     .t tag lower a c
  374.     .t tag names
  375. } {sel b a c d}
  377. test textTag-8.1 {TkTextTagCmd - "names" option} courier12 {
  378.     list [catch {.t tag names a b} msg] $msg
  379. } {1 {wrong # args: should be ".t tag names ?index?"}}
  380. test textTag-8.2 {TkTextTagCmd - "names" option} courier12 {
  381.     tagsetup
  382.     .t tag names
  383. } {sel a b c d}
  384. test textTag-8.3 {TkTextTagCmd - "names" option} courier12 {
  385.     tagsetup
  386.     .t tag add "a b" 2.1 2.6
  387.     .t tag add c 2.4 2.7
  388.     .t tag names 2.5
  389. } {c {a b}}
  391. .t tag delete x y z a b c d {a b}
  392. .t tag add x 2.3 2.5
  393. .t tag add x 2.9 3.1
  394. .t tag add x 7.2
  395. test textTag-9.1 {TkTextTagCmd - "nextrange" option} courier12 {
  396.     list [catch {.t tag nextrange x} msg] $msg
  397. } {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}}
  398. test textTag-9.2 {TkTextTagCmd - "nextrange" option} courier12 {
  399.     list [catch {.t tag nextrange x 1 2 3} msg] $msg
  400. } {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}}
  401. test textTag-9.3 {TkTextTagCmd - "nextrange" option} courier12 {
  402.     list [catch {.t tag nextrange foo 1.0} msg] $msg
  403. } {0 {}}
  404. test textTag-9.4 {TkTextTagCmd - "nextrange" option} courier12 {
  405.     list [catch {.t tag nextrange x foo} msg] $msg
  406. } {1 {bad text index "foo"}}
  407. test textTag-9.5 {TkTextTagCmd - "nextrange" option} courier12 {
  408.     list [catch {.t tag nextrange x 1.0 bar} msg] $msg
  409. } {1 {bad text index "bar"}}
  410. test textTag-9.6 {TkTextTagCmd - "nextrange" option} courier12 {
  411.     .t tag nextrange x 1.0
  412. } {2.3 2.5}
  413. test textTag-9.7 {TkTextTagCmd - "nextrange" option} courier12 {
  414.     .t tag nextrange x 2.2
  415. } {2.3 2.5}
  416. test textTag-9.8 {TkTextTagCmd - "nextrange" option} courier12 {
  417.     .t tag nextrange x 2.3
  418. } {2.3 2.5}
  419. test textTag-9.9 {TkTextTagCmd - "nextrange" option} courier12 {
  420.     .t tag nextrange x 2.4
  421. } {2.9 3.1}
  422. test textTag-9.10 {TkTextTagCmd - "nextrange" option} courier12 {
  423.     .t tag nextrange x 2.4 2.9
  424. } {}
  425. test textTag-9.11 {TkTextTagCmd - "nextrange" option} courier12 {
  426.     .t tag nextrange x 2.4 2.10
  427. } {2.9 3.1}
  428. test textTag-9.12 {TkTextTagCmd - "nextrange" option} courier12 {
  429.     .t tag nextrange x 2.4 2.11
  430. } {2.9 3.1}
  431. test textTag-9.13 {TkTextTagCmd - "nextrange" option} courier12 {
  432.     .t tag nextrange x 7.0
  433. } {7.2 7.3}
  434. test textTag-9.14 {TkTextTagCmd - "nextrange" option} courier12 {
  435.     .t tag nextrange x 7.3
  436. } {}
  438. test textTag-10.1 {TkTextTagCmd - "prevrange" option} courier12 {
  439.     list [catch {.t tag prevrange x} msg] $msg
  440. } {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}}
  441. test textTag-10.2 {TkTextTagCmd - "prevrange" option} courier12 {
  442.     list [catch {.t tag prevrange x 1 2 3} msg] $msg
  443. } {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}}
  444. test textTag-10.3 {TkTextTagCmd - "prevrange" option} courier12 {
  445.     list [catch {.t tag prevrange foo end} msg] $msg
  446. } {0 {}}
  447. test textTag-10.4 {TkTextTagCmd - "prevrange" option} courier12 {
  448.     list [catch {.t tag prevrange x foo} msg] $msg
  449. } {1 {bad text index "foo"}}
  450. test textTag-10.5 {TkTextTagCmd - "prevrange" option} courier12 {
  451.     list [catch {.t tag prevrange x end bar} msg] $msg
  452. } {1 {bad text index "bar"}}
  453. test textTag-10.6 {TkTextTagCmd - "prevrange" option} courier12 {
  454.     .t tag prevrange x end
  455. } {7.2 7.3}
  456. test textTag-10.7 {TkTextTagCmd - "prevrange" option} courier12 {
  457.     .t tag prevrange x 2.4
  458. } {2.3 2.5}
  459. test textTag-10.8 {TkTextTagCmd - "prevrange" option} courier12 {
  460.     .t tag prevrange x 2.5
  461. } {2.3 2.5}
  462. test textTag-10.9 {TkTextTagCmd - "prevrange" option} courier12 {
  463.     .t tag prevrange x 2.9
  464. } {2.3 2.5}
  465. test textTag-10.10 {TkTextTagCmd - "prevrange" option} courier12 {
  466.     .t tag prevrange x 2.9 2.6
  467. } {}
  468. test textTag-10.11 {TkTextTagCmd - "prevrange" option} courier12 {
  469.     .t tag prevrange x 2.9 2.5
  470. } {}
  471. test textTag-10.12 {TkTextTagCmd - "prevrange" option} courier12 {
  472.     .t tag prevrange x 2.9 2.3
  473. } {2.3 2.5}
  474. test textTag-10.13 {TkTextTagCmd - "prevrange" option} courier12 {
  475.     .t tag prevrange x 7.0
  476. } {2.9 3.1}
  477. test textTag-10.14 {TkTextTagCmd - "prevrange" option} courier12 {
  478.     .t tag prevrange x 2.3
  479. } {}
  481. test textTag-11.1 {TkTextTagCmd - "raise" option} courier12 {
  482.     list [catch {.t tag raise} msg] $msg
  483. } {1 {wrong # args: should be ".t tag raise tagName ?aboveThis?"}}
  484. test textTag-11.2 {TkTextTagCmd - "raise" option} courier12 {
  485.     list [catch {.t tag raise foo} msg] $msg
  486. } {1 {tag "foo" isn't defined in text widget}}
  487. test textTag-11.3 {TkTextTagCmd - "raise" option} courier12 {
  488.     list [catch {.t tag raise sel bar} msg] $msg
  489. } {1 {tag "bar" isn't defined in text widget}}
  490. test textTag-11.4 {TkTextTagCmd - "raise" option} courier12 {
  491.     tagsetup
  492.     .t tag raise c
  493.     .t tag names
  494. } {sel a b d c}
  495. test textTag-11.5 {TkTextTagCmd - "raise" option} courier12 {
  496.     tagsetup
  497.     .t tag raise d b
  498.     .t tag names
  499. } {sel a b d c}
  500. test textTag-11.6 {TkTextTagCmd - "raise" option} courier12 {
  501.     tagsetup
  502.     .t tag raise a c
  503.     .t tag names
  504. } {sel b c a d}
  506. test textTag-12.1 {TkTextTagCmd - "ranges" option} courier12 {
  507.     list [catch {.t tag ranges} msg] $msg
  508. } {1 {wrong # args: should be ".t tag ranges tagName"}}
  509. test textTag-12.2 {TkTextTagCmd - "ranges" option} courier12 {
  510.     .t tag delete x
  511.     .t tag ranges x
  512. } {}
  513. test textTag-12.3 {TkTextTagCmd - "ranges" option} courier12 {
  514.     .t tag delete x
  515.     .t tag add x 2.2
  516.     .t tag add x 2.7 4.15
  517.     .t tag add x 5.2 5.5
  518.     .t tag ranges x
  519. } {2.2 2.3 2.7 4.6 5.2 5.5}
  520. test textTag-12.4 {TkTextTagCmd - "ranges" option} courier12 {
  521.     .t tag delete x
  522.     .t tag add x 1.0 3.0
  523.     .t tag add x 4.0 end
  524.     .t tag ranges x
  525. } {1.0 3.0 4.0 8.0}
  527. test textTag-13.1 {TkTextTagCmd - "remove" option} courier12 {
  528.     list [catch {.t tag remove} msg] $msg
  529. } {1 {wrong # args: should be ".t tag remove tagName index1 ?index2 index1 index2 ...?"}}
  530. test textTag-13.2 {TkTextTagCmd - "remove" option} courier12 {
  531.     .t tag delete x
  532.     .t tag add x 2.2 2.11
  533.     .t tag remove x 2.3 2.7
  534.     .t tag ranges x
  535. } {2.2 2.3 2.7 2.11}
  536. test textTag-13.3 {TkTextTagCmd - "remove" option} courier12 {
  537.     .t configure -exportselection 1
  538.     .t tag remove sel 1.0 end
  539.     .t tag add sel 2.4 3.3
  540.     .t.e select to 4
  541.     .t tag remove sel 2.7 3.1
  542.     selection get
  543. } Text
  545. .t tag delete x a b c d
  546. test textTag-14.1 {SortTags} courier12 {
  547.     foreach i {a b c d} {
  548. .t tag add $i 2.0 2.2
  549.     }
  550.     .t tag names 2.1
  551. } {a b c d}
  552. .t tag delete a b c d
  553. test textTag-14.2 {SortTags} courier12 {
  554.     foreach i {a b c d} {
  555. .t tag configure $i -background black
  556.     }
  557.     foreach i {d c b a} {
  558. .t tag add $i 2.0 2.2
  559.     }
  560.     .t tag names 2.1
  561. } {a b c d}
  562. .t tag delete x a b c d
  563. test textTag-14.3 {SortTags} courier12 {
  564.     for {set i 0} {$i < 30} {incr i} {
  565. .t tag add x$i 2.0 2.2
  566.     }
  567.     .t tag names 2.1
  568. } {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
  569. test textTag-14.4 {SortTags} courier12 {
  570.     for {set i 0} {$i < 30} {incr i} {
  571. .t tag configure x$i -background black
  572.     }
  573.     for {set i 29} {$i >= 0} {incr i -1} {
  574. .t tag add x$i 2.0 2.2
  575.     }
  576.     .t tag names 2.1
  577. } {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
  579. foreach tag [.t tag names] {
  580.     catch {.t tag delete $tag}
  581. }
  582. set c [.t bbox 2.1]
  583. set x1 [expr [lindex $c 0] + [lindex $c 2]/2]
  584. set y1 [expr [lindex $c 1] + [lindex $c 3]/2]
  585. set c [.t bbox 3.2]
  586. set x2 [expr [lindex $c 0] + [lindex $c 2]/2]
  587. set y2 [expr [lindex $c 1] + [lindex $c 3]/2]
  588. set c [.t bbox 4.3]
  589. set x3 [expr [lindex $c 0] + [lindex $c 2]/2]
  590. set y3 [expr [lindex $c 1] + [lindex $c 3]/2]
  592. test textTag-15.1 {TkTextBindProc} courier12 {
  593.     bind .t <ButtonRelease> {lappend x up}
  594.     .t tag bind x <ButtonRelease> {lappend x x-up}
  595.     .t tag bind y <ButtonRelease> {lappend x y-up}
  596.     set x {}
  597.     .t tag add x 2.0 2.4
  598.     .t tag add y 4.3
  599.     event gen .t <Button> -x $x1 -y $y1
  600.     event gen .t <Motion> -x $x1 -y $y1
  601.     event gen .t <ButtonRelease> -x $x1 -y $y1
  602.     event gen .t <Button> -x $x1 -y $y1
  603.     event gen .t <Motion> -x $x2 -y $y2
  604.     event gen .t <ButtonRelease> -x $x2 -y $y2
  605.     event gen .t <Button> -x $x2 -y $y2
  606.     event gen .t <Motion> -x $x3 -y $y3
  607.     event gen .t <ButtonRelease> -x $x3 -y $y3
  608.     bind .t <ButtonRelease> {}
  609.     set x
  610. } {x-up up up y-up up}
  611. test textTag-15.2 {TkTextBindProc} courier12 {
  612.     catch {.t tag delete x}
  613.     catch {.t tag delete y}
  614.     .t tag bind x <Enter> {lappend x x-enter}
  615.     .t tag bind x <ButtonPress> {lappend x x-down}
  616.     .t tag bind x <ButtonRelease> {lappend x x-up}
  617.     .t tag bind x <Leave> {lappend x x-leave}
  618.     .t tag bind y <Enter> {lappend x y-enter}
  619.     .t tag bind y <ButtonPress> {lappend x y-down}
  620.     .t tag bind y <ButtonRelease> {lappend x y-up}
  621.     .t tag bind y <Leave> {lappend x y-leave}
  622.     event gen .t <Motion> -x 0 -y 0
  623.     set x {}
  624.     .t tag add x 2.0 2.4
  625.     .t tag add y 4.3
  626.     event gen .t <Motion> -x $x1 -y $y1
  627.     lappend x |
  628.     event gen .t <Button> -x $x1 -y $y1
  629.     lappend x |
  630.     event gen .t <Motion> -x $x3 -y $y3 -state 0x100
  631.     lappend x |
  632.     event gen .t <ButtonRelease> -x $x3 -y $y3
  633.     set x
  634. } {x-enter | x-down | | x-up x-leave y-enter}
  635. test textTag-15.3 {TkTextBindProc} courier12 {
  636.     catch {.t tag delete x}
  637.     catch {.t tag delete y}
  638.     .t tag bind x <Enter> {lappend x x-enter}
  639.     .t tag bind x <Any-ButtonPress-1> {lappend x x-down}
  640.     .t tag bind x <Any-ButtonRelease-1> {lappend x x-up}
  641.     .t tag bind x <Leave> {lappend x x-leave}
  642.     .t tag bind y <Enter> {lappend x y-enter}
  643.     .t tag bind y <Any-ButtonPress-1> {lappend x y-down}
  644.     .t tag bind y <Any-ButtonRelease-1> {lappend x y-up}
  645.     .t tag bind y <Leave> {lappend x y-leave}
  646.     event gen .t <Motion> -x 0 -y 0
  647.     set x {}
  648.     .t tag add x 2.0 2.4
  649.     .t tag add y 4.3
  650.     event gen .t <Motion> -x $x1 -y $y1
  651.     lappend x |
  652.     event gen .t <Button-1> -x $x1 -y $y1
  653.     lappend x |
  654.     event gen .t <Button-2> -x $x1 -y $y1 -state 0x100
  655.     lappend x |
  656.     event gen .t <Motion> -x $x3 -y $y3  -state 0x300
  657.     lappend x |
  658.     event gen .t <ButtonRelease-1> -x $x3 -y $y3 -state 0x300
  659.     lappend x |
  660.     event gen .t <ButtonRelease-2> -x $x3 -y $y3 -state 0x200
  661.     set x
  662. } {x-enter | x-down | | | x-up | x-leave y-enter}
  664. foreach tag [.t tag names] {
  665.     catch {.t tag delete $tag}
  666. }
  667. .t tag configure big -font $bigFont
  668. test textTag-16.1 {TkTextPickCurrent procedure} courier12 {
  669.     event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1
  670.     set x [.t index current]
  671.     event gen .t <Motion> -x $x2 -y $y2
  672.     lappend x [.t index current]
  673.     event gen .t <Button-1> -x $x2 -y $y2
  674.     lappend x [.t index current]
  675.     event gen .t <Motion> -x $x3 -y $y3 -state 0x100
  676.     lappend x [.t index current]
  677.     event gen .t <Button-3> -state 0x100 -x $x3 -y $y3
  678.     lappend x [.t index current]
  679.     event gen .t <ButtonRelease-3> -state 0x300 -x $x3 -y $y3
  680.     lappend x [.t index current]
  681.     event gen .t <ButtonRelease-1> -state 0x100 -x $x3 -y $y3
  682.     lappend x [.t index current]
  683. } {2.1 3.2 3.2 3.2 3.2 3.2 4.3}
  684. test textTag-16.2 {TkTextPickCurrent procedure} courier12 {
  685.     event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1
  686.     event gen .t <Motion> -x $x2 -y $y2
  687.     set x [.t index current]
  688.     .t tag add big 3.0
  689.     update
  690.     lappend x [.t index current]
  691. } {3.2 3.1}
  692. .t tag remove big 1.0 end
  693. foreach i {a b c d} {
  694.     .t tag bind $i <Enter> "lappend x enter-$i"
  695.     .t tag bind $i <Leave> "lappend x leave-$i"
  696. }
  697. test textTag-16.3 {TkTextPickCurrent procedure} courier12 {
  698.     foreach i {a b c d} {
  699. .t tag remove $i 1.0 end
  700.     }
  701.     .t tag lower b
  702.     .t tag lower a
  703.     set x {}
  704.     event gen .t <Motion> -x $x1 -y $y1
  705.     .t tag add a 2.1 3.3
  706.     .t tag add b 2.1
  707.     .t tag add c 3.2
  708.     update
  709.     lappend x |
  710.     event gen .t <Motion> -x $x2 -y $y2
  711.     lappend x |
  712.     event gen .t <Motion> -x $x3 -y $y3
  713.     set x
  714. } {enter-a enter-b | leave-b enter-c | leave-a leave-c}
  715. test textTag-16.4 {TkTextPickCurrent procedure} courier12 {
  716.     foreach i {a b c d} {
  717. .t tag remove $i 1.0 end
  718.     }
  719.     .t tag lower b
  720.     .t tag lower a
  721.     set x {}
  722.     event gen .t <Motion> -x $x1 -y $y1
  723.     .t tag add a 2.1 3.3
  724.     .t tag add b 2.1
  725.     .t tag add c 2.1
  726.     update
  727.     lappend x |
  728.     .t tag lower c
  729.     event gen .t <Motion> -x $x2 -y $y2
  730.     set x
  731. } {enter-a enter-b enter-c | leave-c leave-b}
  732. foreach i {a b c d} {
  733.     .t tag delete $i
  734. }
  735. test textTag-16.5 {TkTextPickCurrent procedure} courier12 {
  736.     foreach i {a b c d} {
  737. .t tag remove $i 1.0 end
  738.     }
  739.     event gen .t <Motion> -x $x1 -y $y1
  740.     .t tag bind a <Enter> {.t tag add big 3.0 3.2}
  741.     .t tag add a 3.2
  742.     event gen .t <Motion> -x $x2 -y $y2
  743.     .t index current
  744. } {3.2}
  745. test textTag-16.6 {TkTextPickCurrent procedure} courier12 {
  746.     foreach i {a b c d} {
  747. .t tag remove $i 1.0 end
  748.     }
  749.     event gen .t <Motion> -x $x1 -y $y1
  750.     .t tag bind a <Enter> {.t tag add big 3.0 3.2}
  751.     .t tag add a 3.2
  752.     event gen .t <Motion> -x $x2 -y $y2
  753.     update
  754.     .t index current
  755. } {3.1}
  756. test textTag-16.7 {TkTextPickCurrent procedure} courier12 {
  757.     foreach i {a b c d} {
  758. .t tag remove $i 1.0 end
  759.     }
  760.     event gen .t <Motion> -x $x1 -y $y1
  761.     .t tag bind a <Leave> {.t tag add big 3.0 3.2}
  762.     .t tag add a 2.1
  763.     event gen .t <Motion> -x $x2 -y $y2
  764.     .t index current
  765. } {3.1}
  767. catch {destroy .t}
  769. # cleanup
  770. ::tcltest::cleanupTests
  771. return