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 $ 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 18# Create entries in the option database to be sure that geometry options 19# like border width have predictable values. 20 21option add *Text.borderWidth 2 22option add *Text.highlightThickness 2 23option add *Text.font {Courier -12} 24 25text .t -width 20 -height 10 26pack append . .t {top expand fill} 27update 28.t debug on 29wm geometry . {} 30 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. 33 34wm withdraw . 35wm minsize . 1 1 36wm positionfrom . user 37wm deiconify . 38 39entry .t.e 40.t.e insert end abcdefg 41.t.e select from 0 42 43.t insert 1.0 "Line 1 44abcdefghijklm 4512345 46Line 4 47bOy GIrl .#@? x_yz 48!@#$% 49Line 7" 50 51catch {destroy .t2} 52text .t2 53set i 0 54foreach 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} 100test text-1.[incr i] {text options} { 101 .t2 configure -takefocus "any old thing" 102 .t2 cget -takefocus 103} {any old thing} 104test text-1.[incr i] {text options} { 105 .t2 configure -xscrollcommand "x scroll command" 106 .t2 configure -xscrollcommand 107} {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}} 108test text-1.[incr i] {text options} { 109 .t2 configure -yscrollcommand "test command" 110 .t2 configure -yscrollcommand 111} {-yscrollcommand yScrollCommand ScrollCommand {} {test command}} 112test 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}} 119 120test text-2.1 {Tk_TextCmd procedure} { 121 list [catch {text} msg] $msg 122} {1 {wrong # args: should be "text pathName ?options?"}} 123test text-2.2 {Tk_TextCmd procedure} { 124 list [catch {text foobar} msg] $msg 125} {1 {bad window path name "foobar"}} 126test 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} 130test 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} 135if {$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} 142test text-2.5 {Tk_TextCmd procedure} { 143 catch {destroy .t2} 144 text .t2 145 .t2 tag cget sel -relief 146} $relief 147test text-2.6 {Tk_TextCmd procedure} { 148 catch {destroy .t2} 149 list [text .t2] [winfo class .t2] 150} {.t2 Text} 151 152test text-3.1 {TextWidgetCmd procedure, basics} { 153 list [catch {.t} msg] $msg 154} {1 {wrong # args: should be ".t option ?arg arg ...?"}} 155test 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}} 158 159test text-4.1 {TextWidgetCmd procedure, "bbox" option} { 160 list [catch {.t bbox} msg] $msg 161} {1 {wrong # args: should be ".t bbox index"}} 162test 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"}} 165test text-4.3 {TextWidgetCmd procedure, "bbox" option} { 166 list [catch {.t bbox bad_mark} msg] $msg 167} {1 {bad text index "bad_mark"}} 168 169test text-5.1 {TextWidgetCmd procedure, "cget" option} { 170 list [catch {.t cget} msg] $msg 171} {1 {wrong # args: should be ".t cget option"}} 172test 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"}} 175test text-5.3 {TextWidgetCmd procedure, "cget" option} { 176 list [catch {.t cget -gorp} msg] $msg 177} {1 {unknown option "-gorp"}} 178test 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] 183 184test 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"}} 187test 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"}} 190test text-6.3 {TextWidgetCmd procedure, "compare" option} { 191 list [catch {.t compare @x == 1.0} msg] $msg 192} {1 {bad text index "@x"}} 193test text-6.4 {TextWidgetCmd procedure, "compare" option} { 194 list [catch {.t compare 1.0 < @y} msg] $msg 195} {1 {bad text index "@y"}} 196test 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} 199test 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} 202test 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} 205test 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} 208test 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} 211test 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} 214test 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 !=}} 217test 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 !=}} 220test 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 !=}} 223test 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}} 226 227# "configure" option is already covered above 228 229test 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"}} 232test 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}} 235test text-7.3 {TextWidgetCmd procedure, "debug" option} { 236 .t debug true 237 .t deb 238} 1 239test text-7.4 {TextWidgetCmd procedure, "debug" option} { 240 .t debug false 241 .t debug 242} 0 243.t debug 244 245test text-8.1 {TextWidgetCmd procedure, "delete" option} { 246 list [catch {.t delete} msg] $msg 247} {1 {wrong # args: should be ".t delete index1 ?index2 ...?"}} 248test text-8.2 {TextWidgetCmd procedure, "delete" option} { 249 list [catch {.t delete a b c} msg] $msg 250} {1 {bad text index "a"}} 251test text-8.3 {TextWidgetCmd procedure, "delete" option} { 252 list [catch {.t delete @x 2.2} msg] $msg 253} {1 {bad text index "@x"}} 254test text-8.4 {TextWidgetCmd procedure, "delete" option} { 255 list [catch {.t delete 2.3 @y} msg] $msg 256} {1 {bad text index "@y"}} 257test 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 263test text-8.6 {TextWidgetCmd procedure, "delete" option} { 264 .t delete 2.3 265 .t get 2.0 2.end 266} abcefghijklm 267test text-8.7 {TextWidgetCmd procedure, "delete" option} { 268 .t delete 2.1 2.3 269 .t get 2.0 2.end 270} aefghijklm 271test 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} 276set prevtext [.t get 1.0 end-1c] 277test 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 "foo\nabcdefghijklm" 280 .t delete 2.1 2.3 2.3 281 .t get 1.0 end-1c 282} foo\naefghijklm 283test 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 "foo\nabcdefghijklm" 286 .t delete 2.0 2.3 2.7 2.9 2.4 287 .t get 1.0 end-1c 288} foo\ndfgjklm 289test text-8.11 {TextWidgetCmd procedure, "delete" option} { 290 # and check again with even pairs 291 .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm" 292 .t delete 2.0 2.2 2.7 2.9 2.4 2.5 293 .t get 1.0 end-1c 294} foo\ncdfgjklm 295test 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 "foo\nabcdefghijklm" 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} foo\nfghijklm 301test 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 "foo\nabcdefghijklm" 304 .t delete 2.0 2.2 1.2 2.6 2.0 2.5 305 .t get 1.0 end-1c 306} foghijklm 307test 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 "foo\nabcdefghijklm" 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 313test 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 "foo\nabcdefghijklm" 317 .t delete 2.0 2.6 2.2 2.8 318 .t get 1.0 end-1c 319} foo\nijklm 320test 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 "foo\nabcdefghijklm" 324 .t delete 2.0 2.6 2.2 2.4 325 .t get 1.0 end-1c 326} foo\nghijklm 327 328.t delete 1.0 end; .t insert 1.0 $prevtext 329 330test text-9.1 {TextWidgetCmd procedure, "get" option} { 331 list [catch {.t get} msg] $msg 332} {1 {wrong # args: should be ".t get index1 ?index2 ...?"}} 333test text-9.2 {TextWidgetCmd procedure, "get" option} { 334 list [catch {.t get a b c} msg] $msg 335} {1 {bad text index "a"}} 336test text-9.3 {TextWidgetCmd procedure, "get" option} { 337 list [catch {.t get @q 3.1} msg] $msg 338} {1 {bad text index "@q"}} 339test text-9.4 {TextWidgetCmd procedure, "get" option} { 340 list [catch {.t get 3.1 @r} msg] $msg 341} {1 {bad text index "@r"}} 342test text-9.5 {TextWidgetCmd procedure, "get" option} { 343 .t get 5.7 5.3 344} {} 345test text-9.6 {TextWidgetCmd procedure, "get" option} { 346 .t get 5.3 5.5 347} { G} 348test text-9.7 {TextWidgetCmd procedure, "get" option} { 349 .t get 5.3 end 350} { GIrl .#@? x_yz 351!@#$% 352Line 7 353} 354.t mark set a 5.3 355.t mark set b 5.3 356.t mark set c 5.5 357test text-9.8 {TextWidgetCmd procedure, "get" option} { 358 .t get 5.2 5.7 359} {y GIr} 360test text-9.9 {TextWidgetCmd procedure, "get" option} { 361 .t get 5.2 362} {y} 363test text-9.10 {TextWidgetCmd procedure, "get" option} { 364 .t get 5.2 5.4 365} {y } 366test text-9.11 {TextWidgetCmd procedure, "get" option} { 367 .t get 5.2 5.4 5.4 368} {{y } G} 369test text-9.12 {TextWidgetCmd procedure, "get" option} { 370 .t get 5.2 5.4 5.4 5.5 371} {{y } G} 372test text-9.13 {TextWidgetCmd procedure, "get" option} { 373 .t get 5.2 5.4 5.5 "5.5+5c" 374} {{y } {Irl .}} 375test text-9.14 {TextWidgetCmd procedure, "get" option} { 376 .t get 5.2 5.4 5.4 5.5 end-3c 377} {{y } G { }} 378test 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}} 382test 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"}} 385 386test text-10.1 {TextWidgetCmd procedure, "index" option} { 387 list [catch {.t index} msg] $msg 388} {1 {wrong # args: should be ".t index index"}} 389test 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"}} 392test 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}} 395test text-10.4 {TextWidgetCmd procedure, "index" option} { 396 list [catch {.t index @xyz} msg] $msg 397} {1 {bad text index "@xyz"}} 398test text-10.5 {TextWidgetCmd procedure, "index" option} { 399 .t index 1.2 400} 1.2 401 402test 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 ...?"}} 405test 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 411test text-11.3 {TextWidgetCmd procedure, "insert" option} { 412 .t insert 1.2 xyzzy 413 .t get 1.0 1.end 414} {Lixyzzyne 1} 415test 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} 420test 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}} 426test 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}} 431test 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}} 437test 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}} 441test 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}} 447test 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}} 452 453# Edit, mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere. 454 455test 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}} 458test 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} 462test 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} 466test 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} 470test 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}"}} 478test text-12.6 {ConfigureText procedure} { 479 .t2 configure -tabs {10 20 30} 480 .t2 configure -tabs {} 481 .t2 cget -tabs 482} {} 483test 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}} 486test 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} 493test text-12.9 {ConfigureText procedure} { 494 .t2 configure -selectborderwidth {} 495 .t2 tag cget sel -borderwidth 496} {} 497test text-12.10 {ConfigureText procedure} { 498 list [catch {.t2 configure -selectborderwidth foo} msg] $msg 499} {1 {bad screen distance "foo"}} 500test 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} 506test 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} 514test 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} 522test 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} 531test 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}} 540test 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. 543 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} 552test 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. 557 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} 567test 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. 572 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} 588 589test 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} 600 601test 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} 610 611test text-15.1 {TextCmdDeletedProc procedure} { 612 text .tx1 613 rename .tx1 {} 614 list [info command .tx*] [winfo exists .tx1] 615} {{} 0} 616test 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} 630 631test text-16.1 {InsertChars procedure} { 632 catch {destroy .t2} 633 text .t2 634 .t2 insert 2.0 abcd\n 635 .t2 get 1.0 end 636} {abcd 637 638} 639test text-16.2 {InsertChars procedure} { 640 catch {destroy .t2} 641 text .t2 642 .t2 insert 1.0 abcd\n 643 .t2 insert end 123\n 644 .t2 get 1.0 end 645} {abcd 646123 647 648} 649test text-16.3 {InsertChars procedure} { 650 catch {destroy .t2} 651 text .t2 652 .t2 insert 1.0 abcd\n 653 .t2 insert 10.0 123 654 .t2 get 1.0 end 655} {abcd 656123 657} 658test 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 "Short\n" 668 .t2 index @0,0 669} {2.56} 670test 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 "Short\n" 680 .t2 index @0,0 681} {2.0} 682test 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 "Short\n" 692 .t2 index @0,0 693} {1.56} 694test 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 "Short\n" 704 .t2 index @0,0 705} {1.56} 706catch {destroy .t2} 707 708proc setup {} { 709 .t delete 1.0 end 710 .t insert 1.0 "Line 1 711abcde 71212345 713Line 4" 714} 715 716.t delete 1.0 end 717test text-17.1 {DeleteChars procedure} { 718 .t get 1.0 end 719} { 720} 721test text-17.2 {DeleteChars procedure} { 722 list [catch {.t delete foobar} msg] $msg 723} {1 {bad text index "foobar"}} 724test text-17.3 {DeleteChars procedure} { 725 list [catch {.t delete 1.0 lousy} msg] $msg 726} {1 {bad text index "lousy"}} 727test text-17.4 {DeleteChars procedure} { 728 setup 729 .t delete 2.1 730 .t get 1.0 end 731} {Line 1 732acde 73312345 734Line 4 735} 736test text-17.5 {DeleteChars procedure} { 737 setup 738 .t delete 2.3 739 .t get 1.0 end 740} {Line 1 741abce 74212345 743Line 4 744} 745test text-17.6 {DeleteChars procedure} { 746 setup 747 .t delete 2.end 748 .t get 1.0 end 749} {Line 1 750abcde12345 751Line 4 752} 753test 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 759abcde 76012345 761Li 762}} 763test 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 769abcde 77012345 771}} 772test text-17.9 {DeleteChars procedure} { 773 setup 774 .t delete 2.2 2.2 775 .t get 1.0 end 776} {Line 1 777abcde 77812345 779Line 4 780} 781test text-17.10 {DeleteChars procedure} { 782 setup 783 .t delete 2.3 2.1 784 .t get 1.0 end 785} {Line 1 786abcde 78712345 788Line 4 789} 790test 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 "abc\n123\nx\ny\nz\nq\nr\ns" 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} 801test 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 "abc\n123\nx\ny\nz\nq\nr\ns" 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} 813catch {destroy .t2} 814toplevel .t2 815text .t2.t -width 1 -height 10 -wrap char 816frame .t2.f -width 200 -height 20 -relief raised -bd 2 817pack .t2.f .t2.t -side left 818wm geometry .t2 +0+0 819update 820test text-17.13 {DeleteChars procedure, updates affecting topIndex} { 821 .t2.t delete 1.0 end 822 .t2.t insert end "abcde\n12345\nqrstuv" 823 .t2.t yview 2.1 824 .t2.t delete 1.4 2.3 825 .t2.t index @0,0 826} {1.2} 827test text-17.14 {DeleteChars procedure, updates affecting topIndex} { 828 .t2.t delete 1.0 end 829 .t2.t insert end "abcde\n12345\nqrstuv" 830 .t2.t yview 2.1 831 .t2.t delete 2.3 2.4 832 .t2.t index @0,0 833} {2.0} 834test text-17.15 {DeleteChars procedure, updates affecting topIndex} { 835 .t2.t delete 1.0 end 836 .t2.t insert end "abcde\n12345\nqrstuv" 837 .t2.t yview 1.3 838 .t2.t delete 1.0 1.2 839 .t2.t index @0,0 840} {1.1} 841test 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 def\n01 2345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n" 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} 856 857.t delete 1.0 end 858foreach 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.4\n 860} 861test text-18.1 {TextFetchSelection procedure} { 862 .t tag add sel 1.3 3.4 863 selection get 864} {a.1a.2a.3a.4 865b.0b.1b.2b.3b.4 866c.0c} 867test 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 876b.0b.1b.2b.3b.4 877c.0c} 878test 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} 883test 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 893cj.0j.1j.2j.3j.4m} 894set x "" 895for {set i 1} {$i < 200} {incr i} { 896 append x "This is line $i, padded to just about 53 characters.\n" 897} 898test 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} $x\n 904 905test text-19.1 {TkTextLostSelection procedure} {unixOnly} { 906 catch {destroy .t2} 907 text .t2 908 .t2 insert 1.0 "abc\ndef\nghijk\n1234" 909 .t2 tag add sel 1.2 3.3 910 .t.e select to 1 911 .t2 tag ranges sel 912} {} 913test text-19.2 {TkTextLostSelection procedure} {macOrPc} { 914 catch {destroy .t2} 915 text .t2 916 .t2 insert 1.0 "abc\ndef\nghijk\n1234" 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} 921catch {destroy .t2} 922test text-19.3 {TkTextLostSelection procedure} { 923 catch {destroy .t2} 924 text .t2 925 .t2 insert 1.0 "abcdef\nghijk\n1234" 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} 933 934.t delete 1.0 end 935.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" 936test 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}} 939test text-20.2 {TextSearchCmd procedure, -backwards option} { 940 .t search -backwards xyz 1.4 941} {1.1} 942test text-20.3 {TextSearchCmd procedure, -forwards option} { 943 .t search -forwards xyz 1.4 944} {1.5} 945test text-20.4 {TextSearchCmd procedure, -exact option} { 946 .t search -f -exact x. 1.0 947} {1.9} 948test text-20.5 {TextSearchCmd procedure, -regexp option} { 949 .t search -b -regexp x.z 1.4 950} {1.1} 951test 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} 955test text-20.7 {TextSearchCmd procedure, -count option} { 956 list [catch {.t search -count} msg] $msg 957} {1 {no value given for "-count" option}} 958test 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} 961test text-20.9 {TextSearchCmd procedure, -nocase option} { 962 .t search -n BaR 1.1 963} {2.13} 964test text-20.10 {TextSearchCmd procedure, -- option} { 965 .t search -- -forward 1.0 966} {2.4} 967test 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?"}} 970test 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?"}} 973test text-20.13 {TextSearchCmd procedure, check index} { 974 list [catch {.t search abc gorp} msg] $msg 975} {1 {bad text index "gorp"}} 976test text-20.14 {TextSearchCmd procedure, startIndex == "end"} { 977 .t search non-existent end 978} {} 979test text-20.15 {TextSearchCmd procedure, startIndex == "end"} { 980 .t search non-existent end 981} {} 982test text-20.16 {TextSearchCmd procedure, bad stopIndex} { 983 list [catch {.t search abc 1.0 lousy} msg] $msg 984} {1 {bad text index "lousy"}} 985test text-20.17 {TextSearchCmd procedure, pattern case conversion} { 986 list [.t search -nocase BAR 1.1] [.t search BAR 1.1] 987} {2.13 {}} 988test 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}} 991test text-20.19 {TextSearchCmd procedure, skip dummy last line} { 992 .t search -backwards BaR end 1.0 993} {2.23} 994test text-20.20 {TextSearchCmd procedure, skip dummy last line} { 995 .t search -backwards \n end 1.0 996} {3.9} 997test text-20.21 {TextSearchCmd procedure, skip dummy last line} { 998 .t search \n end 999} {1.15} 1000test text-20.22 {TextSearchCmd procedure, skip dummy last line} { 1001 .t search -back \n 1.0 1002} {3.9} 1003test 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} 1009test text-20.24 {TextSearchCmd procedure, stripping newlines} { 1010 .t search the\n 1.0 1011} {1.12} 1012test text-20.25 {TextSearchCmd procedure, stripping newlines} { 1013 .t search -regexp the\n 1.0 1014} {} 1015test text-20.26 {TextSearchCmd procedure, stripping newlines} { 1016 .t search -regexp {the$} 1.0 1017} {1.12} 1018test text-20.27 {TextSearchCmd procedure, stripping newlines} { 1019 .t search -regexp \n 1.0 1020} {} 1021test 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} 1024test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} { 1025 .t search -backwards xyz 1.6 1026} {1.5} 1027test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} { 1028 .t search -backwards xyz 1.5 1029} {1.1} 1030test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} { 1031 .t search xyz 1.5 1032} {1.5} 1033test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} { 1034 .t search xyz 1.6 1035} {3.0} 1036test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} { 1037 .t search {} 1.end 1038} {1.15} 1039test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} { 1040 .t search f 1.end 1041} {2.0} 1042test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} { 1043 .t search {} end 1044} {1.0} 1045test 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 1052catch {destroy .t2} 1053toplevel .t2 1054wm geometry .t2 +0+0 1055text .t2.t -width 30 -height 10 1056pack .t2.t 1057.t2.t insert 1.0 "This is a line\nand this is another" 1058.t2.t insert end "\nand this is yet another" 1059frame .t2.f -width 20 -height 20 -bd 2 -relief raised 1060.t2.t window create 2.5 -window .t2.f 1061test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} { 1062 .t2.t search his 2.6 1063} {2.6} 1064test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} { 1065 .t2.t search this 2.6 1066} {3.4} 1067test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} { 1068 .t2.t search is 2.6 1069} {2.7} 1070test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} { 1071 .t2.t search his 2.7 1072} {3.5} 1073test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} { 1074 .t2.t search -backwards "his is another" 2.6 1075} {2.6} 1076test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} { 1077 .t2.t search -backwards "his is" 2.6 1078} {1.1} 1079destroy .t2 1080test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} { 1081 .t search -backwards forw 2.5 1082} {2.5} 1083test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} { 1084 .t search forw 2.5 1085} {2.5} 1086test 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} {{} {}} 1091test 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} 1095test 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} 1099test 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 {}} 1103test 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 {}} 1109test 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} 1126test 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}} 1131test text-20.51 {TextSearchCmd procedure, wrap-around} { 1132 .t search -backwards xyz 1.1 1133} {3.5} 1134test text-20.52 {TextSearchCmd procedure, wrap-around} { 1135 .t search -backwards xyz 1.1 1.0 1136} {} 1137test text-20.53 {TextSearchCmd procedure, wrap-around} { 1138 .t search xyz 3.6 1139} {1.1} 1140test text-20.54 {TextSearchCmd procedure, wrap-around} { 1141 .t search xyz 3.6 end 1142} {} 1143test text-20.55 {TextSearchCmd procedure, no match} { 1144 .t search non_existent 3.5 1145} {} 1146test text-20.56 {TextSearchCmd procedure, no match} { 1147 .t search -regexp non_existent 3.5 1148} {} 1149test text-20.57 {TextSearchCmd procedure, special cases} { 1150 .t search -back x 1.1 1151} {1.0} 1152test text-20.58 {TextSearchCmd procedure, special cases} { 1153 .t search -back x 1.0 1154} {3.8} 1155test text-20.59 {TextSearchCmd procedure, special cases} { 1156 .t search \n {end-2c} 1157} {3.9} 1158test text-20.60 {TextSearchCmd procedure, special cases} { 1159 .t search \n end 1160} {1.15} 1161test text-20.61 {TextSearchCmd procedure, special cases} { 1162 .t search x 1.0 1163} {1.0} 1164test 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. 1167 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} {} 1173test text-20.63 {TextSearchCmd, unicode} { 1174 .t delete 1.0 end 1175 .t insert end "foo\u30c9\u30cabar" 1176 .t search \u30c9\u30ca 1.0 1177} 1.3 1178test text-20.64 {TextSearchCmd, unicode} { 1179 .t delete 1.0 end 1180 .t insert end "foo\u30c9\u30cabar" 1181 list [.t search -count n \u30c9\u30ca 1.0] $n 1182} {1.3 2} 1183test text-20.65 {TextSearchCmd, unicode with non-text segments} { 1184 .t delete 1.0 end 1185 button .b1 -text baz 1186 .t insert end "foo\u30c9" 1187 .t window create end -window .b1 1188 .t insert end "\u30cabar" 1189 set result [list [.t search -count n \u30c9\u30ca 1.0] $n] 1190 destroy .b1 1191 set result 1192} {1.3 3} 1193 1194test 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 1200test 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 1208test text-20.68 {TextSearchCmd, hidden text does not affect match index} { 1209 deleteWindows 1210 pack [text .t2] 1211 .t2 insert end "foobar\nbarbaz\nbazboo" 1212 .t2 search boo 1.0 1213} 3.3 1214test text-20.69 {TextSearchCmd, hidden text does not affect match index} { 1215 deleteWindows 1216 pack [text .t2] 1217 .t2 insert end "foobar\nbarbaz\nbazboo" 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 1222 1223test 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 1231test 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 1239test 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 1248deleteWindows 1249text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 1250pack .t2 1251.t2 insert end "1\t2\t3\t4\t55.5" 1252test text-21.1 {TkTextGetTabs procedure} { 1253 list [catch {.t2 configure -tabs "\{{}"} msg] $msg 1254} {1 {unmatched open brace in list}} 1255test text-21.2 {TkTextGetTabs procedure} { 1256 list [catch {.t2 configure -tabs xyz} msg] $msg 1257} {1 {bad screen distance "xyz"}} 1258test 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} 1263test 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} 1271test 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} 1279test 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}} 1282test text-21.7 {TkTextGetTabs procedure} { 1283 list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg 1284} {1 {bad screen distance "!44"}} 1285 1286deleteWindows 1287text .t 1288pack .t 1289.t insert 1.0 "One Line" 1290.t mark set insert 1.0 1291 1292test 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?}} 1295test 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?}} 1298test 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?}} 1301test 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?}} 1304test text-22.5 {TextDumpCmd procedure, bad args} { 1305 list [catch {.t dump bogus} msg] $msg 1306} {1 {bad text index "bogus"}} 1307test text-22.6 {TextDumpCmd procedure, one index} { 1308 .t dump -text 1.2 1309} {text e 1.2} 1310test text-22.7 {TextDumpCmd procedure, two indices} { 1311 .t dump -text 1.0 1.end 1312} {text {One Line} 1.0} 1313test text-22.8 {TextDumpCmd procedure, "end" index} { 1314 .t dump -text 1.end end 1315} {text { 1316} 1.8} 1317test text-22.9 {TextDumpCmd procedure, same indices} { 1318 .t dump 1.5 1.5 1319} {} 1320test text-22.10 {TextDumpCmd procedure, negative range} { 1321 .t dump 1.5 1.0 1322} {} 1323 1324.t delete 1.0 end 1325.t insert end "Line One\nLine Two\nLine Three\nLine Four" 1326.t mark set insert 1.0 1327.t mark set current 1.0 1328 1329test text-22.11 {TextDumpCmd procedure, stop at begin-line} { 1330 .t dump -text 1.0 2.0 1331} {text {Line One 1332} 1.0} 1333test 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} 1338 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 1344test text-22.13 {TextDumpCmd procedure, tags only} { 1345 .t dump -tag 2.1 2.8 1346} {} 1347test text-22.14 {TextDumpCmd procedure, tags only} { 1348 .t dump -tag 2.0 2.8 1349} {tagon x 2.0} 1350test 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} 1353test 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} 1356 1357.t mark set insert 1.0 1358.t mark set current 1.0 1359test text-22.17 {TextDumpCmd procedure, marks only} { 1360 .t dump -mark 1.1 1.8 1361} {} 1362test text-22.18 {TextDumpCmd procedure, marks only} { 1363 .t dump -mark 2.0 2.8 1364} {mark m 2.4} 1365test text-22.19 {TextDumpCmd procedure, marks only} { 1366 .t dump -mark 1.1 4.end 1367} {mark m 2.4 mark n 4.0} 1368test 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} 1371 1372button .hello -text Hello 1373.t window create 3.end -window .hello 1374for {set i 0} {$i < 100} {incr i} { 1375 .t insert end "-\n" 1376} 1377.t window create 100.0 -create { } 1378test text-22.21 {TextDumpCmd procedure, windows only} { 1379 .t dump -window 1.0 5.0 1380} {window .hello 3.10} 1381test text-22.22 {TextDumpCmd procedure, windows only} { 1382 .t dump -window 5.0 end 1383} {window {} 100.0} 1384 1385.t delete 1.0 end 1386eval {.t mark unset} [.t mark names] 1387.t insert end "Line One\nLine Two\nLine Three\nLine 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 1392proc Append {varName key value index} { 1393 upvar #0 $varName x 1394 lappend x $key $index $value 1395} 1396test 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}} 1405test 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} 1410catch {unset x} 1411test 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 \xb1\xb1\xb1 1416 .t dump -all 1.0 2.0 1417} "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3" 1418test 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 abc\xb1\xb1\xb1 1423 .t dump -all 1.0 2.0 1424} "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6" 1425 1426set l [interp hidden] 1427deleteWindows 1428 1429test 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] 1436 1437test text-24.1 {bug fix - 1642} { 1438 catch {destroy .t} 1439 text .t 1440 pack .t 1441 .t insert end "line 1\n" 1442 .t insert end "line 2\n" 1443 .t insert end "line 3\n" 1444 .t insert end "line 4\n" 1445 .t insert end "line 5\n" 1446 tk::TextSetCursor .t 3.0 1447 .t search -backward -regexp "\$" insert 1.0 1448} {2.6} 1449 1450test 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 ...?"}} 1453 1454test 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}} 1457 1458test text-25.3 {TextEditUndo procedure, undoing changes} { 1459 catch {destroy .t} 1460 text .t -undo 1 1461 pack .t 1462 .t insert end "line 1\n" 1463 .t delete 1.4 1.6 1464 .t insert end "should be gone after undo\n" 1465 .t edit undo 1466 .t get 1.0 end 1467} "line\n\n" 1468 1469test text-25.4 {TextEditRedo procedure, redoing changes} { 1470 catch {destroy .t} 1471 text .t -undo 1 1472 pack .t 1473 .t insert end "line 1\n" 1474 .t delete 1.4 1.6 1475 .t insert end "should be back after redo\n" 1476 .t edit undo 1477 .t edit redo 1478 .t get 1.0 end 1479} "line\nshould be back after redo\n\n" 1480 1481test text-25.5 {TextEditUndo procedure, resetting stack} { 1482 catch {destroy .t} 1483 text .t -undo 1 1484 pack .t 1485 .t insert end "line 1\n" 1486 .t delete 1.4 1.6 1487 .t insert end "should be back after redo\n" 1488 .t edit reset 1489 catch {.t edit undo} msg 1490 set msg 1491} "nothing to undo" 1492 1493test text-25.6 {TextEditCmd procedure, insert separator} { 1494 catch {destroy .t} 1495 text .t -undo 1 1496 pack .t 1497 .t insert end "line 1\n" 1498 .t edit separator 1499 .t insert end "line 2\n" 1500 .t edit undo 1501 .t get 1.0 end 1502} "line 1\n\n" 1503 1504test 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 1\n" 1509 .t delete 1.4 1.6 1510 .t insert end "line 2\n" 1511 .t edit undo 1512 .t get 1.0 end 1513} "\n" 1514 1515test text-25.8 {TextEditCmd procedure, modified flag} { 1516 catch {destroy .t} 1517 text .t 1518 pack .t 1519 .t insert end "line 1\n" 1520 .t edit modified 1521} {1} 1522 1523test text-25.9 {TextEditCmd procedure, reset modified flag} { 1524 catch {destroy .t} 1525 text .t 1526 pack .t 1527 .t insert end "line 1\n" 1528 .t edit modified 0 1529 .t edit modified 1530} {0} 1531 1532test 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} 1539test 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} 1554 1555test 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 special\n" 1563 set ::retval 1564} {modified} 1565test 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} 1574test 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} 1585 1586test 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 special\n" 1594 .t tag add sel 1.0 1.1 1595 set ::retval 1596} {selection_changed} 1597 1598test 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 1\n" 1603 .t delete 1.4 1.6 1604 .t insert end "line 2\n" 1605 catch {.t edit undo} 1606 catch {.t edit undo} 1607 catch {.t edit undo} 1608 .t get 1.0 end 1609} "line 1\n\n" 1610 1611test 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 1\n" 1616 $t delete 1.4 1.6 1617 $t insert end "line 2\n" 1618 $t edit undo 1619 $t edit undo 1620 $t get 1.0 end 1621} "line 1\n\n" 1622 1623test text-25.18 {patch 1469210 - inserting after undo} -setup { 1624 destroy .t 1625} -body { 1626 text .t -undo 1 1627 .t insert end foo 1628 .t edit modified 0 1629 .t edit undo 1630 .t insert end bar 1631 .t edit modified 1632} -cleanup { 1633 destroy .t 1634} -result 1 1635 1636test text-26.1 {bug fix - 624372, ControlUtfProc long lines} { 1637 destroy .t 1638 pack [text .t -wrap none] 1639 .t insert end [string repeat "\1" 500] 1640} {} 1641 1642deleteWindows 1643option clear 1644 1645# cleanup 1646::tcltest::cleanupTests 1647return 1648