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 $ 10 11package require tcltest 2.1 12namespace import -force tcltest::configure 13namespace import -force tcltest::testsDirectory 14configure -testdir [file join [pwd] [file dirname [info script]]] 15configure -loadfile [file join [testsDirectory] constraints.tcl] 16tcltest::loadTestedCommands 17 18catch {destroy .t} 19testConstraint courier12 [expr {[catch { 20 text .t -font {Courier 12} -width 20 -height 10 21 }] == 0}] 22 23pack append . .t {top expand fill} 24update 25.t debug on 26wm geometry . {} 27set 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. 31 32wm withdraw . 33wm minsize . 1 1 34wm positionfrom . user 35wm deiconify . 36 37entry .t.e 38.t.e insert 0 "Text" 39 40.t insert 1.0 "Line 1 41abcdefghijklm 4212345 43Line 4 44bOy GIrl .#@? x_yz 45!@#$% 46Line 7" 47 48 49set i 1 50foreach 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} 102test 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 ...?"}} 105test 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}} 108test 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 ...?"}} 111test textTag-2.4 {TkTextTagCmd - "add" option} courier12 { 112 list [catch {.t tag add x gorp} msg] $msg 113} {1 {bad text index "gorp"}} 114test 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"}} 117test 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} 122test 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} 126test 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} 131test 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 137test 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 144test 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} 149test 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} 154 155catch {.t tag delete x} 156test 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?"}} 159test 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?"}} 162test textTag-3.3 {TkTextTagCmd - "bind" option} courier12 { 163 .t tag bind x <Enter> script1 164 .t tag bind x <Enter> 165} script1 166test 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"}} 169test 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>} 174test 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} 181test 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 187script2} 188test textTag-3.7 {TkTextTagCmd - "bind" option} courier12 { 189 .t tag delete x 190 list [catch {.t tag bind x <Enter>} msg] $msg 191} {0 {}} 192test 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}} 196 197test 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"}} 200test 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"}} 203test 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}} 207test textTag-4.4 {TkTextTagCmd - "cget" option} courier12 { 208 list [catch {.t tag cget sel bogus} msg] $msg 209} {1 {unknown option "bogus"}} 210test 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} 215 216test 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 ...?"}} 219test textTag-5.2 {TkTextTagCmd - "configure" option} courier12 { 220 list [catch {.t tag configure x -foo} msg] $msg 221} {1 {unknown option "-foo"}} 222test 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}} 225test 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} 230test 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} 235test 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"}} 238test 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"}} 242test 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} 247test 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}} 251test 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}} 255test 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} 260test 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"}} 264test 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}} 270test 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"}} 274test 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"}} 278test 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 283test 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}} 289test 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"}} 293test 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"}} 297test 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"}} 301test 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} 311test textTag-5.22 {TkTextTagCmd - "configure" option} courier12 { 312 .t configure -selectborderwidth 20 313 .t tag configure sel -borderwidth {} 314 .t cget -selectborderwidth 315} {} 316 317test 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 ..."}} 320test textTag-6.2 {TkTextTagCmd - "delete" option} courier12 { 321 list [catch {.t tag delete zork} msg] $msg 322} {0 {}} 323test 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} 331test 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} 338test 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} {} 344 345proc 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} 352test 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?"}} 355test 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}} 358test 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}} 361test textTag-7.4 {TkTextTagCmd - "lower" option} courier12 { 362 tagsetup 363 .t tag lower c 364 .t tag names 365} {c sel a b d} 366test 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} 371test 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} 376 377test 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?"}} 380test textTag-8.2 {TkTextTagCmd - "names" option} courier12 { 381 tagsetup 382 .t tag names 383} {sel a b c d} 384test 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}} 390 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 395test 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?"}} 398test 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?"}} 401test textTag-9.3 {TkTextTagCmd - "nextrange" option} courier12 { 402 list [catch {.t tag nextrange foo 1.0} msg] $msg 403} {0 {}} 404test textTag-9.4 {TkTextTagCmd - "nextrange" option} courier12 { 405 list [catch {.t tag nextrange x foo} msg] $msg 406} {1 {bad text index "foo"}} 407test 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"}} 410test textTag-9.6 {TkTextTagCmd - "nextrange" option} courier12 { 411 .t tag nextrange x 1.0 412} {2.3 2.5} 413test textTag-9.7 {TkTextTagCmd - "nextrange" option} courier12 { 414 .t tag nextrange x 2.2 415} {2.3 2.5} 416test textTag-9.8 {TkTextTagCmd - "nextrange" option} courier12 { 417 .t tag nextrange x 2.3 418} {2.3 2.5} 419test textTag-9.9 {TkTextTagCmd - "nextrange" option} courier12 { 420 .t tag nextrange x 2.4 421} {2.9 3.1} 422test textTag-9.10 {TkTextTagCmd - "nextrange" option} courier12 { 423 .t tag nextrange x 2.4 2.9 424} {} 425test textTag-9.11 {TkTextTagCmd - "nextrange" option} courier12 { 426 .t tag nextrange x 2.4 2.10 427} {2.9 3.1} 428test textTag-9.12 {TkTextTagCmd - "nextrange" option} courier12 { 429 .t tag nextrange x 2.4 2.11 430} {2.9 3.1} 431test textTag-9.13 {TkTextTagCmd - "nextrange" option} courier12 { 432 .t tag nextrange x 7.0 433} {7.2 7.3} 434test textTag-9.14 {TkTextTagCmd - "nextrange" option} courier12 { 435 .t tag nextrange x 7.3 436} {} 437 438test 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?"}} 441test 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?"}} 444test textTag-10.3 {TkTextTagCmd - "prevrange" option} courier12 { 445 list [catch {.t tag prevrange foo end} msg] $msg 446} {0 {}} 447test textTag-10.4 {TkTextTagCmd - "prevrange" option} courier12 { 448 list [catch {.t tag prevrange x foo} msg] $msg 449} {1 {bad text index "foo"}} 450test textTag-10.5 {TkTextTagCmd - "prevrange" option} courier12 { 451 list [catch {.t tag prevrange x end bar} msg] $msg 452} {1 {bad text index "bar"}} 453test textTag-10.6 {TkTextTagCmd - "prevrange" option} courier12 { 454 .t tag prevrange x end 455} {7.2 7.3} 456test textTag-10.7 {TkTextTagCmd - "prevrange" option} courier12 { 457 .t tag prevrange x 2.4 458} {2.3 2.5} 459test textTag-10.8 {TkTextTagCmd - "prevrange" option} courier12 { 460 .t tag prevrange x 2.5 461} {2.3 2.5} 462test textTag-10.9 {TkTextTagCmd - "prevrange" option} courier12 { 463 .t tag prevrange x 2.9 464} {2.3 2.5} 465test textTag-10.10 {TkTextTagCmd - "prevrange" option} courier12 { 466 .t tag prevrange x 2.9 2.6 467} {} 468test textTag-10.11 {TkTextTagCmd - "prevrange" option} courier12 { 469 .t tag prevrange x 2.9 2.5 470} {} 471test textTag-10.12 {TkTextTagCmd - "prevrange" option} courier12 { 472 .t tag prevrange x 2.9 2.3 473} {2.3 2.5} 474test textTag-10.13 {TkTextTagCmd - "prevrange" option} courier12 { 475 .t tag prevrange x 7.0 476} {2.9 3.1} 477test textTag-10.14 {TkTextTagCmd - "prevrange" option} courier12 { 478 .t tag prevrange x 2.3 479} {} 480 481test 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?"}} 484test 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}} 487test 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}} 490test textTag-11.4 {TkTextTagCmd - "raise" option} courier12 { 491 tagsetup 492 .t tag raise c 493 .t tag names 494} {sel a b d c} 495test 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} 500test 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} 505 506test 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"}} 509test textTag-12.2 {TkTextTagCmd - "ranges" option} courier12 { 510 .t tag delete x 511 .t tag ranges x 512} {} 513test 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} 520test 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} 526 527test 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 ...?"}} 530test 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} 536test 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 544 545.t tag delete x a b c d 546test 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 553test 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 563test 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} 569test 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} 578 579foreach tag [.t tag names] { 580 catch {.t tag delete $tag} 581} 582set c [.t bbox 2.1] 583set x1 [expr [lindex $c 0] + [lindex $c 2]/2] 584set y1 [expr [lindex $c 1] + [lindex $c 3]/2] 585set c [.t bbox 3.2] 586set x2 [expr [lindex $c 0] + [lindex $c 2]/2] 587set y2 [expr [lindex $c 1] + [lindex $c 3]/2] 588set c [.t bbox 4.3] 589set x3 [expr [lindex $c 0] + [lindex $c 2]/2] 590set y3 [expr [lindex $c 1] + [lindex $c 3]/2] 591 592test 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} 611test 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} 635test 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} 663 664foreach tag [.t tag names] { 665 catch {.t tag delete $tag} 666} 667.t tag configure big -font $bigFont 668test 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} 684test 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 693foreach 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} 697test 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} 715test 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} 732foreach i {a b c d} { 733 .t tag delete $i 734} 735test 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} 745test 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} 756test 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} 766 767catch {destroy .t} 768 769# cleanup 770::tcltest::cleanupTests 771return 772 773 774 775 776 777 778 779 780 781 782 783 784 785