diff options
Diffstat (limited to 'tests/text.test')
| -rw-r--r-- | tests/text.test | 2295 |
1 files changed, 2225 insertions, 70 deletions
diff --git a/tests/text.test b/tests/text.test index bf70658..52689ba 100644 --- a/tests/text.test +++ b/tests/text.test @@ -7,13 +7,11 @@ # All rights reserved. package require tcltest 2.1 -namespace import -force tcltest::configure -namespace import -force tcltest::testsDirectory -configure -testdir [file join [pwd] [file dirname [info script]]] -configure -loadfile [file join [testsDirectory] constraints.tcl] +eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test -# Create entries in the option database to be sure that geometry options +# Create entries in the odeption database to be sure that geometry options # like border width have predictable values. option add *Text.borderWidth 2 @@ -54,6 +52,7 @@ foreach test { {-background #ff00ff #ff00ff <gorp>} {-bd 4 4 foo} {-bg blue blue #xx} + {-blockcursor 0 0 xx} {-borderwidth 7 7 ++} {-cursor watch watch lousy} {-exportselection no 0 maybe} @@ -64,6 +63,7 @@ foreach test { {-highlightbackground #123 #123 bogus} {-highlightcolor #234 #234 bogus} {-highlightthickness -2 0 bad} + {-inactiveselectbackground #ffff01234567 #ffff01234567 bogus} {-insertbackground green green <bogus>} {-insertborderwidth 45 45 bogus} {-insertofftime 100 100 2.4} @@ -84,6 +84,7 @@ foreach test { {-spacing3 -10 0 bogus} {-state d disabled foo} {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs} + {-tabstyle wordprocessor wordprocessor garbage} {-undo 1 1 eh} {-width 73 73 2.4} {-wrap w word bad_wrap} @@ -113,7 +114,7 @@ test text-1.[incr i] {text options} { lappend result [lindex $i 4] } set result -} {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}} +} {1 blue {} {} 0 7 watch {} 0 {} fixed #012 5 #123 #234 0 #ffff01234567 green 45 100 47 2 5 3 82 raised #ffff01234567 21 yellow 0 0 0 0 {} disabled {1i 2i 3i 4i} wordprocessor {any old thing} 1 73 word {x scroll command} {test command}} test text-2.1 {Tk_TextCmd procedure} { list [catch {text} msg] $msg @@ -130,10 +131,10 @@ test text-2.4 {Tk_TextCmd procedure} { list [catch {text .t2 -bd 2 -fg red} msg] $msg \ [lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4] } {0 .t2 2 red} -if {$tcl_platform(platform) == "macintosh"} { - set relief solid -} elseif {$tcl_platform(platform) == "windows"} { +if {$tcl_platform(platform) == "windows"} { set relief flat +} elseif {[tk windowingsystem] eq "aqua"} { + set relief solid } else { set relief raised } @@ -152,7 +153,7 @@ test text-3.1 {TextWidgetCmd procedure, basics} { } {1 {wrong # args: should be ".t option ?arg arg ...?"}} test text-3.2 {TextWidgetCmd procedure} { list [catch {.t gorp 1.0 z 1.2} msg] $msg -} {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}} +} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} test text-4.1 {TextWidgetCmd procedure, "bbox" option} { list [catch {.t bbox} msg] $msg @@ -220,7 +221,7 @@ test text-6.13 {TextWidgetCmd procedure, "compare" option} { } {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}} test text-6.14 {TextWidgetCmd procedure, "compare" option} { list [catch {.t co 1.0 z 1.2} msg] $msg -} {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}} +} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} # "configure" option is already covered above @@ -229,7 +230,7 @@ test text-7.1 {TextWidgetCmd procedure, "debug" option} { } {1 {wrong # args: should be ".t debug boolean"}} test text-7.2 {TextWidgetCmd procedure, "debug" option} { list [catch {.t de 0 1} msg] $msg -} {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}} +} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} test text-7.3 {TextWidgetCmd procedure, "debug" option} { .t debug true .t deb @@ -322,12 +323,119 @@ test text-8.16 {TextWidgetCmd procedure, "delete" option} { .t delete 2.0 2.6 2.2 2.4 .t get 1.0 end-1c } foo\nghijklm +.t delete 1.0 end; .t insert 1.0 $prevtext +test text-8.17 {TextWidgetCmd procedure, "replace" option} { + list [catch {.t replace 1.3 2.3} err] $err +} {1 {wrong # args: should be ".t replace index1 index2 chars ?tagList chars tagList ...?"}} +test text-8.18 {TextWidgetCmd procedure, "replace" option} { + list [catch {.t replace 3.1 2.3 foo} err] $err +} {1 {Index "2.3" before "3.1" in the text}} +test text-8.19 {TextWidgetCmd procedure, "replace" option} { + list [catch {.t replace 2.1 2.3 foo} err] $err +} {0 {}} +.t delete 1.0 end; .t insert 1.0 $prevtext +test text-8.20 {TextWidgetCmd procedure, "replace" option with undo} { + .t configure -undo 0 + .t configure -undo 1 + # Ensure it is treated as a single undo action + .t replace 2.1 2.3 foo + .t edit undo + .t configure -undo 0 + string equal [.t get 1.0 end-1c] $prevtext +} {1} +test text-8.21 {TextWidgetCmd procedure, "replace" option with undo} { + .t configure -undo 0 + .t configure -undo 1 + .t replace 2.1 2.3 foo + # Ensure we can override a text widget and intercept undo + # actions. If in the future a different mechanism is available + # to do this, then we should be able to change this test. The + # behaviour tested for here is not, strictly speaking, documented. + rename .t test.t + set res {} + proc .t {args} { lappend ::res $args ; uplevel 1 test.t $args } + .t edit undo + rename .t {} + rename test.t .t + .t configure -undo 0 + set res +} {{edit undo} {delete 2.1 2.4} {mark set insert 2.1} {see insert} {insert 2.1 ef} {mark set insert 2.3} {see insert}} +test text-8.22 {TextWidgetCmd procedure, "replace" option with undo} { + .t configure -undo 0 + .t configure -undo 1 + # Ensure that undo (even composite undo like 'replace') + # works when the widget shows nothing useful. + .t replace 2.1 2.3 foo + .t configure -start 1 -end 1 + .t edit undo + .t configure -start {} -end {} + .t configure -undo 0 + if {![string equal [.t get 1.0 end-1c] $prevtext]} { + set res [list [.t get 1.0 end-1c] ne $prevtext] + } else { + set res 1 + } +} {1} +.t delete 1.0 end; .t insert 1.0 $prevtext +test text-8.23 {TextWidgetCmd procedure, "replace" option with peers, undo} { + .t configure -undo 0 + .t configure -undo 1 + .t peer create .tt -undo 1 + # Ensure that undo (even composite undo like 'replace') + # works when the the event took place in one peer, which + # is then deleted, before the undo takes place in another peer. + .tt replace 2.1 2.3 foo + .tt configure -start 1 -end 1 + destroy .tt + .t edit undo + .t configure -start {} -end {} + .t configure -undo 0 + if {![string equal [.t get 1.0 end-1c] $prevtext]} { + set res [list [.t get 1.0 end-1c] ne $prevtext] + } else { + set res 1 + } +} {1} +.t delete 1.0 end; .t insert 1.0 $prevtext +test text-8.24 {TextWidgetCmd procedure, "replace" option with peers, undo} { + .t configure -undo 0 + .t configure -undo 1 + .t peer create .tt -undo 1 + # Ensure that undo (even composite undo like 'replace') + # works when the the event took place in one peer, which + # is then deleted, before the undo takes place in another peer + # which isn't showing everything. + .tt replace 2.1 2.3 foo + set res [.tt get 2.1 2.4] + .tt configure -start 1 -end 1 + destroy .tt + .t configure -start 3 -end 4 + # msg will actually be set to a silently ignored error message here, + # (that the .tt command doesn't exist), but that is not important. + lappend res [catch {.t edit undo} msg] + .t configure -undo 0 + .t configure -start {} -end {} + if {![string equal [.t get 1.0 end-1c] $prevtext]} { + lappend res [list [.t get 1.0 end-1c] ne $prevtext] + } else { + lappend res 1 + } +} {foo 0 1} +test text-8.25 {TextWidgetCmd procedure, "replace" option crash} -setup { + destroy .tt +} -body { + text .tt + .tt insert 0.0 foo\n + .tt replace end-1l end bar +} -cleanup { + destroy .tt +} -result {} .t delete 1.0 end; .t insert 1.0 $prevtext test text-9.1 {TextWidgetCmd procedure, "get" option} { list [catch {.t get} msg] $msg -} {1 {wrong # args: should be ".t get index1 ?index2 ...?"}} +} {1 {wrong # args: should be ".t get ?-displaychars? ?--? index1 ?index2 ...?"}} test text-9.2 {TextWidgetCmd procedure, "get" option} { list [catch {.t get a b c} msg] $msg } {1 {bad text index "a"}} @@ -377,9 +485,356 @@ test text-9.15 {TextWidgetCmd procedure, "get" option} { .t get 5.2 5.4 5.4 5.5 end-3c end } {{y } G { 7 }} +test text-9.16 {TextWidgetCmd procedure, "get" option} { + .t get 5.2 5.3 5.4 5.3 +} {y} test text-9.17 {TextWidgetCmd procedure, "get" option} { + .t index "5.2 +3 indices" +} {5.5} +test text-9.17a {TextWidgetCmd procedure, "get" option} { + .t index "5.2 +3chars" +} {5.5} +test text-9.17b {TextWidgetCmd procedure, "get" option} { + .t index "5.2 +3displayindices" +} {5.5} +.t tag configure elide -elide 1 +.t tag add elide 5.2 5.4 +test text-9.18 {TextWidgetCmd procedure, "get" option} { list [catch {.t get 5.2 5.4 5.5 foo} msg] $msg } {1 {bad text index "foo"}} +test text-9.19 {TextWidgetCmd procedure, "get" option} { + .t get 5.2 5.4 5.4 5.5 end-3c end +} {{y } G { 7 +}} +test text-9.20 {TextWidgetCmd procedure, "get" option} { + .t get -displaychars 5.2 5.4 5.4 5.5 end-3c end +} {{} G { 7 +}} +test text-9.21 {TextWidgetCmd procedure, "get" option} { + list [.t index "5.1 +4indices"] [.t index "5.1+4d indices"] +} {5.5 5.7} +test text-9.22 {TextWidgetCmd procedure, "get" option} { + list [.t index "5.1 +4a chars"] [.t index "5.1+4d chars"] +} {5.5 5.7} +test text-9.23 {TextWidgetCmd procedure, "get" option} { + list [.t index "5.5 -4indices"] [.t index "5.7-4d indices"] +} {5.1 5.1} +test text-9.24 {TextWidgetCmd procedure, "get" option} { + list [.t index "5.5 -4a chars"] [.t index "5.7-4d chars"] +} {5.1 5.1} +.t window create 5.4 +test text-9.25 {TextWidgetCmd procedure, "get" option} { + list [.t index "5.1 +4indices"] [.t index "5.1+4d indices"] +} {5.5 5.7} +test text-9.25a {TextWidgetCmd procedure, "get" option} { + list [.t index "5.1 +4a chars"] [.t index "5.1+4d chars"] +} {5.6 5.8} +test text-9.26 {TextWidgetCmd procedure, "get" option} { + list [.t index "5.5 -4indices"] [.t index "5.7-4d indices"] +} {5.1 5.1} +test text-9.26a {TextWidgetCmd procedure, "get" option} { + list [.t index "5.6 -4a chars"] [.t index "5.8-4d chars"] +} {5.1 5.1} +.t delete 5.4 +.t tag add elide 5.5 5.6 +test text-9.27 {TextWidgetCmd procedure, "get" option} { + .t get -displaychars 5.2 5.8 +} {Grl} +.t tag delete elide +.t mark unset a +.t mark unset b +.t mark unset c +test text-9.2.1 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count} msg] $msg +} {1 {wrong # args: should be ".t count ?options? index1 index2"}} +test text-9.2.2.1 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count blah 1.0 2.0} msg] $msg +} {1 {bad option "blah" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels}} +test text-9.2.2 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count a b} msg] $msg +} {1 {bad text index "a"}} +test text-9.2.3 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count @q 3.1} msg] $msg +} {1 {bad text index "@q"}} +test text-9.2.4 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count 3.1 @r} msg] $msg +} {1 {bad text index "@r"}} +test text-9.2.5 {TextWidgetCmd procedure, "count" option} { + .t count 5.7 5.3 +} {-4} +test text-9.2.6 {TextWidgetCmd procedure, "count" option} { + .t count 5.3 5.5 +} {2} +test text-9.2.7 {TextWidgetCmd procedure, "count" option} { + .t count 5.3 end +} {29} +.t mark set a 5.3 +.t mark set b 5.3 +.t mark set c 5.5 +test text-9.2.8 {TextWidgetCmd procedure, "count" option} { + .t count 5.2 5.7 +} {5} +test text-9.2.9 {TextWidgetCmd procedure, "count" option} { + .t count 5.2 5.3 +} {1} +test text-9.2.10 {TextWidgetCmd procedure, "count" option} { + .t count 5.2 5.4 +} {2} +test text-9.2.17 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count 5.2 foo} msg] $msg +} {1 {bad text index "foo"}} +.t tag configure elide -elide 1 +.t tag add elide 2.2 3.4 +.t tag add elide 4.0 4.1 +test text-9.2.18 {TextWidgetCmd procedure, "count" option} { + .t count -displayindices 2.0 3.0 +} {2} +test text-9.2.19 {TextWidgetCmd procedure, "count" option} { + .t count -displayindices 2.2 3.0 +} {0} +test text-9.2.20 {TextWidgetCmd procedure, "count" option} { + .t count -displayindices 2.0 4.2 +} {5} +# Create one visible and one invisible window +frame .t.w1 +frame .t.w2 +.t mark set a 2.2 +# Creating this window here means that the elidden text +# now starts at 2.3, but 'a' is automatically moved to 2.3 +.t window create 2.1 -window .t.w1 +.t window create 3.1 -window .t.w2 +test text-9.2.21 {TextWidgetCmd procedure, "count" option} { + .t count -displayindices 2.0 3.0 +} {3} +test text-9.2.22 {TextWidgetCmd procedure, "count" option} { + .t count -displayindices 2.2 3.0 +} {1} +test text-9.2.23 {TextWidgetCmd procedure, "count" option} { + .t count -displayindices a 3.0 +} {0} +test text-9.2.24 {TextWidgetCmd procedure, "count" option} { + .t count -displayindices 2.0 4.2 +} {6} +test text-9.2.25 {TextWidgetCmd procedure, "count" option} { + .t count -displaychars 2.0 3.0 +} {2} +test text-9.2.26 {TextWidgetCmd procedure, "count" option} { + .t count -displaychars 2.2 3.0 +} {1} +test text-9.2.27 {TextWidgetCmd procedure, "count" option} { + .t count -displaychars a 3.0 +} {0} +test text-9.2.28 {TextWidgetCmd procedure, "count" option} { + .t count -displaychars 2.0 4.2 +} {5} +test text-9.2.29 {TextWidgetCmd procedure, "count" option} { + list [.t count -indices 2.2 3.0] [.t count 2.2 3.0] +} {10 10} +test text-9.2.30 {TextWidgetCmd procedure, "count" option} { + list [.t count -indices a 3.0] [.t count a 3.0] +} {9 9} +test text-9.2.31 {TextWidgetCmd procedure, "count" option} { + .t count -indices 2.0 4.2 +} {21} +test text-9.2.32 {TextWidgetCmd procedure, "count" option} { + .t count -chars 2.2 3.0 +} {10} +test text-9.2.33 {TextWidgetCmd procedure, "count" option} { + .t count -chars a 3.0 +} {9} +test text-9.2.34 {TextWidgetCmd procedure, "count" option} { + .t count -chars 2.0 4.2 +} {19} +destroy .t.w1 +destroy .t.w2 +set current [.t get 1.0 end-1c] +.t delete 1.0 end +.t insert end [string repeat "abcde " 50]\n +.t insert end [string repeat "fghij " 50]\n +.t insert end [string repeat "klmno " 50] +test text-9.2.35 {TextWidgetCmd procedure, "count" option} { + .t count -lines 1.0 end +} {3} +test text-9.2.36 {TextWidgetCmd procedure, "count" option} { + .t count -lines end 1.0 +} {-3} +test text-9.2.37 {TextWidgetCmd procedure, "count" option} { + list [catch {.t count -lines 1.0 2.0 3.0} res] $res +} {1 {bad option "1.0" must be -chars, -displaychars, -displayindices, -displaylines, -indices, -lines, -update, -xpixels, or -ypixels}} +test text-9.2.38 {TextWidgetCmd procedure, "count" option} { + .t count -lines end end +} {0} +test text-9.2.39 {TextWidgetCmd procedure, "count" option} { + .t count -lines 1.5 2.5 +} {1} +test text-9.2.40 {TextWidgetCmd procedure, "count" option} { + .t count -lines 2.5 "2.5 lineend" +} {0} +test text-9.2.41 {TextWidgetCmd procedure, "count" option} { + .t count -lines 2.7 "1.0 lineend" +} {-1} +test text-9.2.42 {TextWidgetCmd procedure, "count" option} { + set old_wrap [.t cget -wrap] + .t configure -wrap none + set res [.t count -displaylines 1.0 end] + .t configure -wrap $old_wrap + set res +} {3} +test text-9.2.43 {TextWidgetCmd procedure, "count" option} { + .t count -lines -chars -indices -displaylines 1.0 end +} {3 903 903 45} +.t configure -wrap none +test text-9.2.44 {TextWidgetCmd procedure, "count" option} -setup { + .t delete 1.0 end + update + set res {} +} -body { + .t insert end "Line 1 - This is Line 1\n" + .t insert end "Line 2 - This is Line 2\n" + .t insert end "Line 3 - This is Line 3\n" + .t insert end "Line 4 - This is Line 4\n" + .t insert end "Line 5 - This is Line 5\n" + lappend res [.t count -displaylines 1.19 3.24] [.t count -displaylines 1.0 end] + .t tag add hidden 2.9 3.17 + .t tag configure hidden -elide true + lappend res [.t count -displaylines 1.19 3.24] [.t count -displaylines 1.0 end] +} -result {2 6 2 5} + +# Newer tags are higher priority +.t tag configure elide1 -elide 0 +.t tag configure elide2 -elide 1 +.t tag configure elide3 -elide 0 +.t tag configure elide4 -elide 1 + +test text-0.2.44.0 {counting with tag priority eliding} { + .t delete 1.0 end + .t insert end "hello" + list [.t count -displaychars 1.0 1.0] \ + [.t count -displaychars 1.0 1.1] \ + [.t count -displaychars 1.0 1.2] \ + [.t count -displaychars 1.0 1.3] \ + [.t count -displaychars 1.0 1.4] \ + [.t count -displaychars 1.0 1.5] \ + [.t count -displaychars 1.0 1.6] \ + [.t count -displaychars 1.0 2.6] \ +} {0 1 2 3 4 5 5 6} +test text-0.2.44 {counting with tag priority eliding} { + .t delete 1.0 end + .t insert end "hello" + .t tag add elide1 1.2 1.4 + .t count -displaychars 1.0 1.5 +} {5} +test text-0.2.45 {counting with tag priority eliding} { + .t delete 1.0 end + .t insert end "hello" + .t tag add elide2 1.2 1.4 + .t count -displaychars 1.0 1.5 +} {3} +test text-0.2.46 {counting with tag priority eliding} { + set res {} + .t delete 1.0 end + .t insert end "hello" + .t tag add elide2 1.2 1.4 + .t tag add elide1 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide1 1.2 1.4 + .t tag add elide2 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] +} {3 3} +test text-0.2.47 {counting with tag priority eliding} { + set res {} + .t delete 1.0 end + .t insert end "hello" + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide3 1.2 1.4 + .t tag add elide3 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] +} {5 5} +test text-0.2.48 {counting with tag priority eliding} { + set res {} + .t delete 1.0 end + .t insert end "hello" + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + .t tag add elide4 1.2 1.4 + .t tag add elide1 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide1 1.2 1.4 + .t tag add elide4 1.2 1.4 + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] +} {3 3} +test text-0.2.49 {counting with tag priority eliding} { + set res {} + .t delete 1.0 end + .t insert end "hello" + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + .t tag add elide1 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide1 1.2 1.4 + .t tag add elide2 1.2 1.4 + .t tag add elide3 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] +} {5 5} +test text-0.2.50 {counting with tag priority eliding} { + set res {} + .t delete 1.0 end + .t insert end "hello" + .t tag add elide2 1.0 1.5 + .t tag add elide1 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + lappend res [.t count -displaychars 1.1 1.5] + lappend res [.t count -displaychars 1.2 1.5] + lappend res [.t count -displaychars 1.3 1.5] + .t delete 1.0 end + .t insert end "hello" + .t tag add elide1 1.0 1.5 + .t tag add elide2 1.2 1.4 + lappend res [.t count -displaychars 1.0 1.5] + lappend res [.t count -displaychars 1.1 1.5] + lappend res [.t count -displaychars 1.2 1.5] + lappend res [.t count -displaychars 1.3 1.5] +} {0 0 0 0 3 2 1 1} +test text-0.2.51 {counting with tag priority eliding} { + set res {} + .t delete 1.0 end + .t tag configure WELCOME -elide 1 + .t tag configure SYSTEM -elide 0 + .t tag configure TRAFFIC -elide 1 + .t insert end "\n" {SYSTEM TRAFFIC} + .t insert end "\n" WELCOME + lappend res [.t count -displaychars 1.0 end] + lappend res [.t count -displaychars 1.0 end-1c] + lappend res [.t count -displaychars 1.0 1.2] + lappend res [.t count -displaychars 2.0 end] + lappend res [.t count -displaychars 2.0 end-1c] + lappend res [.t index "1.0 +1 indices"] + lappend res [.t index "1.0 +1 display indices"] + lappend res [.t index "1.0 +1 display chars"] + lappend res [.t index end] + lappend res [.t index "end -1 indices"] + lappend res [.t index "end -1 display indices"] + lappend res [.t index "end -1 display chars"] + lappend res [.t index "end -2 indices"] + lappend res [.t index "end -2 display indices"] + lappend res [.t index "end -2 display chars"] +} {1 0 0 1 0 2.0 4.0 4.0 4.0 3.0 3.0 3.0 2.0 1.0 1.0} + +.t delete 1.0 end +.t insert end $current +unset current test text-10.1 {TextWidgetCmd procedure, "index" option} { list [catch {.t index} msg] $msg @@ -389,7 +844,7 @@ test text-10.2 {TextWidgetCmd procedure, "index" option} { } {1 {wrong # args: should be ".t index index"}} test text-10.3 {TextWidgetCmd procedure, "index" option} { list [catch {.t in a b} msg] $msg -} {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}} +} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}} test text-10.4 {TextWidgetCmd procedure, "index" option} { list [catch {.t index @xyz} msg] $msg } {1 {bad text index "@xyz"}} @@ -452,7 +907,7 @@ test text-11.10 {TextWidgetCmd procedure, "insert" option} { test text-12.1 {ConfigureText procedure} { list [catch {.t2 configure -state foobar} msg] $msg -} {1 {bad state value "foobar": must be normal or disabled}} +} {1 {bad state "foobar": must be disabled or normal}} test text-12.2 {ConfigureText procedure} { .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1 list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3] @@ -480,7 +935,7 @@ test text-12.6 {ConfigureText procedure} { } {} test text-12.7 {ConfigureText procedure} { list [catch {.t2 configure -wrap bogus} msg] $msg -} {1 {bad wrap mode "bogus": must be char, none, or word}} +} {1 {bad wrap "bogus": must be char, none, or word}} test text-12.8 {ConfigureText procedure} { .t2 configure -selectborderwidth 17 -selectforeground #332211 \ -selectbackground #abc @@ -538,7 +993,6 @@ test text-12.15 {ConfigureText procedure} { test text-12.16 {ConfigureText procedure} {fonts} { # This test is non-portable because the window size will vary depending # on the font size, which can vary. - catch {destroy .t2} toplevel .t2 text .t2.t -width 20 -height 10 @@ -552,7 +1006,6 @@ test text-12.17 {ConfigureText procedure} { # was a certain minimum size and it was interfering with the size # requested by the -setgrid. The "overrideredirect" gets rid of the # titlebar so the toplevel can shrink to the appropriate size. - catch {destroy .t2} toplevel .t2 wm overrideredirect .t2 1 @@ -567,7 +1020,6 @@ test text-12.18 {ConfigureText procedure} { # was a certain minimum size and it was interfering with the size # requested by the -setgrid. The "overrideredirect" gets rid of the # titlebar so the toplevel can shrink to the appropriate size. - catch {destroy .t2} toplevel .t2 wm overrideredirect .t2 1 @@ -900,7 +1352,7 @@ test text-18.5 {TextFetchSelection procedure, long selections} { selection get } $x\n -test text-19.1 {TkTextLostSelection procedure} {unixOnly} { +test text-19.1 {TkTextLostSelection procedure} unix { catch {destroy .t2} text .t2 .t2 insert 1.0 "abc\ndef\nghijk\n1234" @@ -908,7 +1360,7 @@ test text-19.1 {TkTextLostSelection procedure} {unixOnly} { .t.e select to 1 .t2 tag ranges sel } {} -test text-19.2 {TkTextLostSelection procedure} {macOrPc} { +test text-19.2 {TkTextLostSelection procedure} win { catch {destroy .t2} text .t2 .t2 insert 1.0 "abc\ndef\nghijk\n1234" @@ -933,10 +1385,13 @@ test text-19.3 {TkTextLostSelection procedure} { .t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx" test text-20.1 {TextSearchCmd procedure, argument parsing} { list [catch {.t search -} msg] $msg -} {1 {bad switch "-": must be --, -backward, -count, -elide, -exact, -forward, -nocase, or -regexp}} +} {1 {bad switch "-": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}} test text-20.2 {TextSearchCmd procedure, -backwards option} { .t search -backwards xyz 1.4 } {1.1} +test text-20.2.1 {TextSearchCmd procedure, -all option} { + .t search -all xyz 1.4 +} {1.5 3.0 3.5 1.1} test text-20.3 {TextSearchCmd procedure, -forwards option} { .t search -forwards xyz 1.4 } {1.5} @@ -956,9 +1411,19 @@ test text-20.7 {TextSearchCmd procedure, -count option} { test text-20.8 {TextSearchCmd procedure, -nocase option} { list [.t search -nocase BaR 1.1] [.t search BaR 1.1] } {2.13 2.23} -test text-20.9 {TextSearchCmd procedure, -nocase option} { - .t search -n BaR 1.1 +test text-20.9 {TextSearchCmd procedure, -n ambiguous option} { + list [catch {.t search -n BaR 1.1} msg] $msg +} {1 {bad switch "-n": must be --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, -overlap, -regexp, or -strictlimits}} +test text-20.9.1 {TextSearchCmd procedure, -nocase option} { + .t search -noc BaR 1.1 } {2.13} +test text-20.9.2 {TextSearchCmd procedure, -nolinestop option} { + list [catch {.t search -nolinestop BaR 1.1} msg] $msg +} {1 {the "-nolinestop" option requires the "-regexp" option to be present}} +test text-20.9.3 {TextSearchCmd procedure, -nolinestop option} { + set msg "" + list [.t search -nolinestop -regexp -count msg e.*o 1.1] $msg +} {1.14 32} test text-20.10 {TextSearchCmd procedure, -- option} { .t search -- -forward 1.0 } {2.4} @@ -1007,15 +1472,15 @@ test text-20.23 {TextSearchCmd procedure, extract line contents} { test text-20.24 {TextSearchCmd procedure, stripping newlines} { .t search the\n 1.0 } {1.12} -test text-20.25 {TextSearchCmd procedure, stripping newlines} { +test text-20.25 {TextSearchCmd procedure, handling newlines} { .t search -regexp the\n 1.0 -} {} +} {1.12} test text-20.26 {TextSearchCmd procedure, stripping newlines} { .t search -regexp {the$} 1.0 } {1.12} -test text-20.27 {TextSearchCmd procedure, stripping newlines} { +test text-20.27 {TextSearchCmd procedure, handling newlines} { .t search -regexp \n 1.0 -} {} +} {1.15} test text-20.28 {TextSearchCmd procedure, line case conversion} { list [.t search -nocase bar 2.18] [.t search bar 2.18] } {2.23 2.13} @@ -1040,7 +1505,7 @@ test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} { test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} { .t search {} end } {1.0} -test text-20.36 {TextSearchCmd procedure, regexp finds empty lines} { +test text-20.35a {TextSearchCmd procedure, regexp finds empty lines} { # Test for fix of bug #1643 .t insert end "\n" tk::TextSetCursor .t 4.0 @@ -1100,10 +1565,16 @@ test text-20.47 {TextSearchCmd procedure, checking stopIndex} { } {{} 2.13 2.13 {}} test text-20.48 {TextSearchCmd procedure, checking stopIndex} { list [.t search -backwards bar 2.20 2.13] \ - [.t search -backwards bar 2.20 2.14] \ - [.t search -backwards bar 2.14 2.13] \ - [.t search -backwards bar 2.13 2.13] + [.t search -backwards bar 2.20 2.14] \ + [.t search -backwards bar 2.14 2.13] \ + [.t search -backwards bar 2.13 2.13] } {2.13 {} 2.13 {}} +test text-20.48.1 {TextSearchCmd procedure, checking stopIndex} { + list [.t search -backwards -strict bar 2.20 2.13] \ + [.t search -backwards -strict bar 2.20 2.14] \ + [.t search -backwards -strict bar 2.14 2.13] \ + [.t search -backwards -strict bar 2.13 2.13] +} {2.13 {} {} {}} test text-20.49 {TextSearchCmd procedure, embedded windows and index/count} { frame .t.f1 -width 20 -height 20 -relief raised -bd 2 frame .t.f2 -width 20 -height 20 -relief raised -bd 2 @@ -1162,7 +1633,9 @@ test text-20.61 {TextSearchCmd procedure, special cases} { test text-20.62 {TextSearchCmd, freeing copy of pattern} { # This test doesn't return a result, but it will generate # a core leak if the pattern copy isn't properly freed. - + # (actually in Tk 8.5 objectification means there is no + # longer a copy of the pattern, but we leave this test in + # anyway). set p abcdefg1234567890 set p $p$p$p$p$p$p$p$p set p $p$p$p$p$p @@ -1188,7 +1661,6 @@ test text-20.65 {TextSearchCmd, unicode with non-text segments} { destroy .b1 set result } {1.3 3} - test text-20.66 {TextSearchCmd, hidden text does not affect match index} { deleteWindows pack [text .t2] @@ -1217,7 +1689,6 @@ test text-20.69 {TextSearchCmd, hidden text does not affect match index} { .t2 tag add hidden 2.0 3.0 .t2 search boo 1.0 } 3.3 - test text-20.70 {TextSearchCmd, -regexp -nocase searches} { catch {destroy .t} pack [text .t] @@ -1242,11 +1713,1075 @@ test text-20.72 {TextSearchCmd, -regexp -nocase searches} { destroy .t set res } 1.0 - +test text-20.73 {TextSearchCmd, hidden text and start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search bar 1.3 +} 1.3 +test text-20.74 {TextSearchCmd, hidden text shouldn't influence start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.0 1.2 + .t2 search bar 1.3 +} 1.3 +test text-20.75 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list [.t2 search -count foo foar 1.3] $foo +} {1.0 6} +test text-20.75.1 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list \ + [.t2 search -strict -count foo foar 1.3] \ + [.t2 search -strict -count foo foar 2.3] $foo +} {{} 1.0 6} +test text-20.76 {TextSearchCmd, hidden text and start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -regexp bar 1.3 +} 1.3 +test text-20.77 {TextSearchCmd, hidden text shouldn't influence start index} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.0 1.2 + .t2 search -regexp bar 1.3 +} 1.3 +test text-20.78 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list [.t2 search -regexp -count foo foar 1.3] $foo +} {1.0 6} +test text-20.78.1 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + list [.t2 search -count foo foar 1.3] $foo +} {1.0 6} +test text-20.78.2 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 search -strict -count foo foar 1.3 +} {} +test text-20.78.3 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 tag add hidden 2.2 2.4 + list [.t2 search -regexp -all -count foo foar 1.3] $foo +} {{2.0 3.0 1.0} {6 4 6}} +test text-20.78.4 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 tag add hidden 2.2 2.4 + list [.t2 search -all -count foo foar 1.3] $foo +} {{2.0 3.0 1.0} {6 4 6}} +test text-20.78.5 {TextSearchCmd, hidden text inside match must count in length} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoar" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.2 1.4 + .t2 tag add hidden 2.2 2.4 + list [.t2 search -strict -all -count foo foar 1.3] $foo +} {{2.0 3.0} {6 4}} +test text-20.78.6 {TextSearchCmd, single line with -all} { + deleteWindows + pack [text .t2] + .t2 insert end " X\n X\n X\n X\n X\n X\n" + .t2 search -all -regexp { +| *\n} 1.0 end +} {1.0 1.2 2.0 2.2 3.0 3.2 4.0 4.2 5.0 5.2 6.0 6.2 7.0} +test text-20.79 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo foobar\nfoo 1.0] $foo +} {1.0 10} +test text-20.80 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo bar\nfoo 1.0] $foo +} {1.3 7} +test text-20.81 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo \nfoo 1.0] $foo +} {1.6 4} +test text-20.82 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} +test text-20.83 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -count foo bar\nfoobar\nfoobanearly 1.0 +} {} +test text-20.84 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo foobar\nfoo 1.0] $foo +} {1.0 10} +test text-20.85 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo bar\nfoo 1.0] $foo +} {1.3 7} +test text-20.86 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo \nfoo 1.0] $foo +} {1.6 4} +test text-20.87 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} +test text-20.88 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} {} +test text-20.89 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -regexp -count foo bar\nfoo 1.0 +} {2.4} +test text-20.90 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -regexp -count foo bar\nfoobar\n\n 1.0 +} {} +test text-20.91 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 search "\n\n" 1.0 +} {} +test text-20.92 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo foobar\nfoo end] $foo +} {2.0 10} +test text-20.93 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo bar\nfoo 1.0] $foo +} {2.3 7} +test text-20.94 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo \nfoo 1.0] $foo +} {2.6 4} +test text-20.95 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} +test text-20.96 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -backwards -count foo bar\nfoobar\nfoobanearly 1.0 +} {} +test text-20.97 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo foobar\nfoo end] $foo +} {2.0 10} +test text-20.97.1 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo foobar\nfo end] $foo +} {2.0 9} +test text-20.98 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo bar\nfoo 1.0] $foo +} {2.3 7} +test text-20.99 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo \nfoo 1.0] $foo +} {2.6 4} +test text-20.100 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + list [.t2 search -backwards -regexp -count foo bar\nfoobar\nfoo 1.0] $foo +} {1.3 14} +test text-20.101 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -backwards -regexp -count foo bar\nfoobar\nfoobanearly 1.0 +} {} +test text-20.102 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -backwards -regexp -count foo bar\nfoo 1.0 +} {2.4} +test text-20.103 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfaoobar\nfoobar" + .t2 search -backwards -regexp -count foo bar\nfoobar\n\n 1.0 +} {} +test text-20.104 {TextSearchCmd, multiline matching end of window} { + deleteWindows + pack [text .t2] + .t2 search -backwards "\n\n" 1.0 +} {} +test text-20.105 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { Tcl_Obj *objPtr)); +static Tcl_Obj* FSNormalizeAbsolutePath + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t2 search -forwards -regexp $markExpr 1.41 end +} {} +test text-20.106 {TextSearchCmd, multiline regexp matching} { + # Practical example which used to crash Tk, but only after the + # search is complete. This is memory corruption caused by + # a bug in Tcl's handling of string objects. + # (Tcl bug 635200) + deleteWindows + pack [text .t2] + .t2 insert 1.0 {static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static Tcl_Obj* FSNormalizeAbsolutePath + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t2 search -forwards -regexp $markExpr 1.41 end +} {} +test text-20.107 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { +static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static Tcl_Obj* FSNormalizeAbsolutePath + _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t2 search -backwards -all -regexp $markExpr end +} {2.0} +test text-20.108 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -all -regexp -count foo bar\nfoo 1.0 +} {1.3 2.3} +test text-20.109 {TextSearchCmd, multiline matching} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -all -backwards -regexp -count foo bar\nfoo 1.0 +} {2.3 1.3} +test text-20.110 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -- "blah" 3.3 1.3 +} {} +test text-20.111 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "foobar\nfoobar\nfoobar" + .t2 search -backwards -- "blah" 1.3 3.3 +} {} +test text-20.112 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -backwards -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} {1.31} +test text-20.113 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -regexp -- "\[\]\")\}\[(\{\]" 1.30 "1.0 lineend" +} {1.31} +test text-20.114 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -backwards -all -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0 +} {1.31 1.29 1.3} +test text-20.115 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -all -regexp -- "\[\]\")\}\[(\{\]" 1.0 "1.0 lineend" +} {1.3 1.29 1.31} +test text-20.116 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -backwards -- "\{" "1.32" 1.0 +} {1.31} +test text-20.117 {TextSearchCmd, wrapping and limits} { + deleteWindows + pack [text .t2] + .t2 insert end "if (stringPtr->uallocated > 0) \{x" + .t2 search -- "\{" 1.30 "1.0 lineend" +} {1.31} +test text-20.118 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { + +void +Tcl_SetObjLength(objPtr, length) + register Tcl_Obj *objPtr; /* Pointer to object. This object must + * not currently be shared. */ + register int length; /* Number of bytes desired for string + * representation of object, not including + * terminating null byte. */ +\{ + char *new; +} + set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" + append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" + append markExpr "\[ \n\t\r\]*\\()" + .t2 search -all -regexp -- $markExpr 1.0 +} {4.0} +test text-20.119 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + set markExpr {^[a-z]+} + # This should not match, and should not wrap + .t2 search -regexp -- $markExpr end end +} {} +test text-20.120 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + set markExpr {^[a-z]+} + # This should not match, and should not wrap + .t2 search -regexp -- $markExpr end+10c end +} {} +test text-20.121 {TextSearchCmd, multiline regexp matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + set markExpr {^[a-z]+} + # This should not match, and should not wrap + .t2 search -regexp -backwards -- $markExpr 1.0 1.0 +} {} +test text-20.122 {TextSearchCmd, regexp linestop} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -- {i.*x} 1.0 +} {2.6} +test text-20.123 {TextSearchCmd, multiline regexp nolinestop matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -nolinestop -- {i.*x} 1.0 +} {1.1} +test text-20.124 {TextSearchCmd, regexp linestop} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -all -overlap -- {i.*x} 1.0 +} {2.6} +test text-20.124.1 {TextSearchCmd, regexp linestop} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + .t2 search -regexp -all -- {i.*x} 1.0 +} {2.6} +test text-20.125 {TextSearchCmd, multiline regexp nolinestop matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + list [.t2 search -regexp -all -overlap -count c -nolinestop -- {i.*x} 1.0] $c +} {{1.1 2.6} {26 10}} +test text-20.125.1 {TextSearchCmd, multiline regexp nolinestop matching} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "first line\nlast line of text" + list [.t2 search -regexp -all -count c -nolinestop -- {i.*x} 1.0] $c +} {1.1 26} +test text-20.126 {TextSearchCmd, stop at end of line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " \t\n last line of text" + .t2 search -regexp -nolinestop -- {[^ \t]} 1.0 +} {1.3} +test text-20.127 {TextSearchCmd, overlapping all matches} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde abcde" + list [.t2 search -regexp -all -overlap -count c -- {\w+} 1.0] $c +} {{1.0 1.6} {5 5}} +test text-20.127.1 {TextSearchCmd, non-overlapping all matches} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde abcde" + list [.t2 search -regexp -all -count c -- {\w+} 1.0] $c +} {{1.0 1.6} {5 5}} +test text-20.128 {TextSearchCmd, stop at end of line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde abcde" + list [.t2 search -backwards -regexp -all -count c -- {\w+} 1.0] $c +} {{1.6 1.0} {5 5}} +test text-20.129 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -regexp -count c -- {Z\w+} 1.21 1.5] $c +} {1.8 8} +test text-20.130 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -all -overlap -regexp -count c -- {Z\w+} 1.21 1.5] $c +} {1.8 8} +test text-20.130.1 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.5] $c +} {1.8 8} +test text-20.131 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -overlap -all -regexp -count c -- {Z\w+} 1.21 1.1] $c +} {1.4 12} +test text-20.131.1 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -overlap -all -regexp -count c -- {Z[^Z]+Z} 1.21 1.1] $c +} {{1.8 1.4} {5 5}} +test text-20.131.2 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 1.21 1.1] $c +} {1.4 12} +test text-20.132 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t2 search -backwards -all -overlap -regexp -count c -- {Z\w+} 2.21 1.5] $c +} {{2.4 1.8} {12 8}} +test text-20.132.1 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.5] $c +} {{2.4 1.8} {12 8}} +test text-20.133 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t2 search -backwards -overlap -all -regexp -count c -- {Z\w+} 2.21 1.1] $c +} {{2.4 1.4} {12 12}} +test text-20.133.1 {TextSearchCmd, backwards search stop index } { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "bla ZabcZdefZghi and some text again" + .t2 insert 1.0 "bla ZabcZdefZghi and some text again\n" + list [.t2 search -backwards -all -regexp -count c -- {Z\w+} 2.21 1.1] $c +} {{2.4 1.4} {12 12}} +test text-20.134 {TextSearchCmd, search -all example} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 { + +See the package: supersearch for more information. + + +See the package: incrementalSearch for more information. + +package: Brws . + + +See the package: marks for more information. + +} + set pat {package: ([a-zA-Z0-9][-a-zA-Z0-9._+#/]*)} + list [.t2 search -nolinestop -regexp -nocase -all -forwards \ + -count c -- $pat 1.0 end] $c +} {{3.8 6.8 8.0 11.8} {20 26 13 14}} +test text-20.135 {TextSearchCmd, backwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -backwards -regexp {fooba+rfoo} end +} {1.6} +test text-20.135.1 {TextSearchCmd, backwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -backwards -overlap -all -regexp {fooba+rfoo} end +} {1.6 1.0} +test text-20.135.2 {TextSearchCmd, backwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -backwards -all -regexp {fooba+rfoo} end +} {1.6} +test text-20.135.3 {TextSearchCmd, forwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -all -overlap -regexp {fooba+rfoo} end +} {1.0 1.6} +test text-20.135.4 {TextSearchCmd, forwards search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foobarfoobaaaaaaaaaaarfoo" + .t2 search -all -regexp {fooba+rfoo} end +} {1.0} +test text-20.136 {TextSearchCmd, forward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abababab" + .t2 search -exact -overlap -all {abab} 1.0 +} {1.0 1.2 1.4} +test text-20.136.1 {TextSearchCmd, forward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abababab" + .t2 search -exact -all {abab} 1.0 +} {1.0 1.4} +test text-20.137 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "ababababab" + .t2 search -exact -overlap -backwards -all {abab} end +} {1.6 1.4 1.2 1.0} +test text-20.137.1 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "ababababab" + .t2 search -exact -backwards -all {abab} end +} {1.6 1.2} +test text-20.137.2 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abababababab" + .t2 search -exact -backwards -all {abab} end +} {1.8 1.4 1.0} +test text-20.138 {TextSearchCmd, forward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -exact -overlap -all "foo\nbar\nfoo" 1.0 +} {1.0 3.0 5.0} +test text-20.138.1 {TextSearchCmd, forward exact search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -exact -all "foo\nbar\nfoo" 1.0 +} {1.0 5.0} +test text-20.139 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -exact -overlap -backward -all "foo\nbar\nfoo" end +} {5.0 3.0 1.0} +test text-20.140 {TextSearchCmd, backward exact search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -exact -backward -all "foo\nbar\nfoo" end +} {5.0 1.0} +test text-20.141 {TextSearchCmd, backward exact search overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -regexp -backward -overlap -all "foo\nbar\nfoo" end +} {5.0 3.0 1.0} +test text-20.142 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "foo\nbar\nfoo\nbar\nfoo\nbar\nfoo\n" + .t2 search -regexp -backward -all "foo\nbar\nfoo" end +} {5.0 1.0} +test text-20.142a {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 +} {1.7} +test text-20.143 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.5 +} {1.7} +test text-20.144 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.7 +} {1.7} +test text-20.145 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -- {(\$)?[\w:_]+} 1.9 1.8 +} {1.8} +test text-20.146 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.3 +} {1.7 1.3} +test text-20.147 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 1.9 1.13 +} {} +test text-20.148 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 2.0 1.3 +} {1.12 1.7 1.3} +test text-20.149 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 " aasda asdj werwer" + .t2 search -regexp -backward -all -- {(\$)?[\w:_]+} 1.3 +} {1.1 1.12 1.7 1.3} +test text-20.150 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\n" + .t2 search -regexp -backward -all -- {(\w+\n)+} end +} {1.0} +test text-20.151 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\n" + .t2 search -regexp -backward -all -- {(\w+\n)+} end 1.5 +} {2.0} +test text-20.152 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + .t2 search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 +} {2.0} +test text-20.153 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo +} {1.0 20} +test text-20.154 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + set res {} + lappend res \ + [list [.t2 search -regexp -all -count foo -- {(\w+\n)+} 1.0] $foo] \ + [list [.t2 search -regexp -all -count foo -- {(\w+)+} 1.0] $foo] +} {{1.0 20} {{1.0 2.0 3.0 4.0} {5 5 5 1}}} +test text-20.155 {TextSearchCmd, regexp search greedy} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -all -nolinestop -count foo -- {.*} 1.0] $foo +} {1.0 20} +test text-20.156 {TextSearchCmd, regexp search greedy} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -all -count foo -- {.*} 1.0] $foo +} {{1.0 2.0 3.0 4.0} {5 5 5 1}} +test text-20.157 {TextSearchCmd, regexp search greedy multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -count foo -- {(\w+\n\w)+} 1.0] $foo +} {1.0 19} +test text-20.158 {TextSearchCmd, regexp search greedy multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -backwards -count foo -- {(\w+\n\w)+} end] $foo +} {1.0 19} +test text-20.159 {TextSearchCmd, regexp search greedy multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -all -backwards -count foo -- {(\w+\n\w)+} end] $foo +} {1.0 19} +test text-20.160 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + .t2 search -regexp -backward -all -- {(\w+\n\w)+} end 1.5 +} {2.0} +test text-20.161 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + .t2 search -regexp -backward -all -- {(\w+\n\w)+} end 1.3 +} {1.3} +test text-20.162 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -forward -count foo -- {(\w+\n\w)+} 1.3] $foo +} {1.3 16} +test text-20.163 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -forward -all -count foo -- {(\w+\n\w)+} 1.3] $foo + # This result is somewhat debatable -- the two results do overlap, + # but only because the search has totally wrapped around back to + # the start. +} {{1.3 1.0} {16 19}} +test text-20.164 {TextSearchCmd, backward regexp search no-overlaps} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "abcde\nabcde\nabcde\na" + list [.t2 search -regexp -forward -all -count foo -- {(\w+\n\w)+} 1.0 1.3] $foo +} {1.0 19} +test text-20.165 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" + list [.t2 search -regexp -forward -all -count foo -- {(a+\n(b+\n))+} 1.0] $foo +} {1.0 20} +test text-20.166 {TextSearchCmd, regexp search complex cases} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\naaaa\nbbbb\n" + list [.t2 search -regexp -forward -all -count foo \ + -- {(a+\n(b+\n))+} 1.0] $foo +} {1.0 20} +test text-20.167 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" + set foo {} + list [.t2 search -regexp -forward -all -count foo \ + -- {(b+\nc+\nb+)\na+} 1.0] $foo +} {2.0 19} +test text-20.168 {TextSearchCmd, regexp search multi-line} {knownBug} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" + set foo {} + list [.t2 search -regexp -forward -all -count foo \ + -- {(a+|b+\nc+\nb+)\na+} 1.0] $foo +} {2.0 19} +test text-20.169 {TextSearchCmd, regexp search multi-line} {knownBug} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" + set foo {} + list [.t2 search -regexp -forward -all -count foo \ + -- {(a+|b+\nc+\nb+)+\na+} 1.0] $foo +} {2.0 19} +test text-20.170 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\ncccc\nbbbb\naaaa\n" + set foo {} + list [.t2 search -regexp -forward -all -count foo \ + -- {((a+|b+\nc+\nb+)+\n)+a+} 1.0] $foo +} {1.0 24} +test text-20.171 {TextSearchCmd, regexp search multi-line} {knownBug} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" + list [.t2 search -regexp -backward -all -count foo \ + -- {b+\n|a+\n(b+\n)+} end] $foo +} {1.0 25} +test text-20.172 {TextSearchCmd, regexp search multi-line} {knownBug} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aaaa\nbbbb\nbbbb\nbbbb\nbbbb\n" + .t2 search -regexp -backward -- {b+\n|a+\n(b+\n)+} end + # Should match at 1.0 for a true greedy match +} {1.0} +test text-20.172.1 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "line0\nline1\nline1\nline1\nline1\nline2\nline2\nline2\nline3\n" + .t2 search -nolinestop -regexp -nocase -forwards -- {^(.*)\n(\1\n)+} 1.0 end + # Matches at 6.0 currently +} {2.0} +test text-20.173 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "\naaaxxx\nyyy\n" + set res {} + lappend res [.t2 search -count c -regexp -- {x*\ny*} 2.0] $c + lappend res [.t2 search -count c -regexp -- {x*\ny*} 2.1] $c + set res +} {2.3 7 2.3 7} +test text-20.174 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "\naaa\n\n\n\n\nxxx\n" + set res {} + lappend res [.t2 search -count c -regexp -- {\n+} 2.0] $c + lappend res [.t2 search -count c -regexp -- {\n+} 2.1] $c + set res +} {2.3 5 2.3 5} +test text-20.175 {TextSearchCmd, regexp search multi-line} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "\naaa\n\n\t \n\t\t\t \n\nxxx\n" + set res {} + lappend res [.t2 search -count c -regexp -- {(\n+(\t+ *)*)+} 2.0] $c + set res +} {2.3 13} +test text-20.176 {TextSearchCmd, empty search range} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\na\na\n" + .t2 search -- a 2.0 1.0 +} {} +test text-20.177 {TextSearchCmd, empty search range} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\na\na\n" + .t2 search -backwards -- a 1.0 2.0 +} {} +test text-20.178 {TextSearchCmd, empty search range} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\na\na\n" + .t2 search -- a 1.0 1.0 +} {} +test text-20.179 {TextSearchCmd, empty search range} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\na\na\n" + .t2 search -backwards -- a 2.0 2.0 +} {} +test text-20.180 {TextSearchCmd, elide up to match} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\nb\nc" + .t2 tag configure e -elide 1 + set res {} + lappend res [.t2 search -regexp a 1.0] + lappend res [.t2 search -regexp b 1.0] + lappend res [.t2 search -regexp c 1.0] + .t2 tag add e 1.0 2.0 + lappend res [.t2 search -regexp a 1.0] + lappend res [.t2 search -regexp b 1.0] + lappend res [.t2 search -regexp c 1.0] + lappend res [.t2 search -elide -regexp a 1.0] + lappend res [.t2 search -elide -regexp b 1.0] + lappend res [.t2 search -elide -regexp c 1.0] +} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-20.181 {TextSearchCmd, elide up to match, backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\nb\nc" + .t2 tag configure e -elide 1 + set res {} + lappend res [.t2 search -backward -regexp a 1.0] + lappend res [.t2 search -backward -regexp b 1.0] + lappend res [.t2 search -backward -regexp c 1.0] + .t2 tag add e 1.0 2.0 + lappend res [.t2 search -backward -regexp a 1.0] + lappend res [.t2 search -backward -regexp b 1.0] + lappend res [.t2 search -backward -regexp c 1.0] + lappend res [.t2 search -backward -elide -regexp a 1.0] + lappend res [.t2 search -backward -elide -regexp b 1.0] + lappend res [.t2 search -backward -elide -regexp c 1.0] +} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-20.182 {TextSearchCmd, elide up to match} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\nb\nc" + .t2 tag configure e -elide 1 + set res {} + lappend res [.t2 search a 1.0] + lappend res [.t2 search b 1.0] + lappend res [.t2 search c 1.0] + .t2 tag add e 1.0 2.0 + lappend res [.t2 search a 1.0] + lappend res [.t2 search b 1.0] + lappend res [.t2 search c 1.0] + lappend res [.t2 search -elide a 1.0] + lappend res [.t2 search -elide b 1.0] + lappend res [.t2 search -elide c 1.0] +} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-20.183 {TextSearchCmd, elide up to match, backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "a\nb\nc" + .t2 tag configure e -elide 1 + set res {} + lappend res [.t2 search -backward a 1.0] + lappend res [.t2 search -backward b 1.0] + lappend res [.t2 search -backward c 1.0] + .t2 tag add e 1.0 2.0 + lappend res [.t2 search -backward a 1.0] + lappend res [.t2 search -backward b 1.0] + lappend res [.t2 search -backward c 1.0] + lappend res [.t2 search -backward -elide a 1.0] + lappend res [.t2 search -backward -elide b 1.0] + lappend res [.t2 search -backward -elide c 1.0] +} {1.0 2.0 3.0 {} 2.0 3.0 1.0 2.0 3.0} +test text-20.184 {TextSearchCmd, elide up to match} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aa\nbb\ncc" + .t2 tag configure e -elide 1 + set res {} + lappend res [.t2 search ab 1.0] + lappend res [.t2 search bc 1.0] + .t2 tag add e 1.1 2.1 + lappend res [.t2 search ab 1.0] + lappend res [.t2 search b 1.0] + .t2 tag remove e 1.0 end + .t2 tag add e 2.1 3.1 + lappend res [.t2 search bc 1.0] + lappend res [.t2 search c 1.0] + .t2 tag remove e 1.0 end + .t2 tag add e 2.1 3.0 + lappend res [.t2 search bc 1.0] + lappend res [.t2 search c 1.0] +} {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} +test text-20.185 {TextSearchCmd, elide up to match} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "aa\nbb\ncc" + .t2 tag configure e -elide 1 + set res {} + lappend res [.t2 search -regexp ab 1.0] + lappend res [.t2 search -regexp bc 1.0] + .t2 tag add e 1.1 2.1 + lappend res [.t2 search -regexp ab 1.0] + lappend res [.t2 search -regexp b 1.0] + .t2 tag remove e 1.0 end + .t2 tag add e 2.1 3.1 + lappend res [.t2 search -regexp bc 1.0] + lappend res [.t2 search -regexp c 1.0] + .t2 tag remove e 1.0 end + .t2 tag add e 2.1 3.0 + lappend res [.t2 search -regexp bc 1.0] + lappend res [.t2 search -regexp c 1.0] +} {{} {} 1.0 2.1 2.0 3.1 2.0 3.0} +test text-20.186 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -- "world" 1.3 1.8 +} {} +test text-20.187 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -- "world" 1.3 1.10 +} {} +test text-20.188 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -- "world" 1.3 1.11 +} {1.6} +test text-20.189 {TextSearchCmd, strict limits backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -backward -- "world" 2.3 1.8 +} {} +test text-20.190 {TextSearchCmd, strict limits backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -backward -- "world" 2.3 1.6 +} {1.6} +test text-20.191 {TextSearchCmd, strict limits backwards} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -strictlimits -backward -- "world" 2.3 1.7 +} {} +test text-20.192 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -regexp -strictlimits -- "world" 1.3 1.8 +} {} +test text-20.193 {TextSearchCmd, strict limits} { + deleteWindows + pack [text .t2] + .t2 insert 1.0 "Hello world!\nThis is a test\n" + .t2 search -regexp -strictlimits -backward -- "world" 2.3 1.8 +} {} + deleteWindows text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 pack .t2 .t2 insert end "1\t2\t3\t4\t55.5" + test text-21.1 {TkTextGetTabs procedure} { list [catch {.t2 configure -tabs "\{{}"} msg] $msg } {1 {unmatched open brace in list}} @@ -1298,7 +2833,7 @@ test text-22.3 {TextDumpCmd procedure, bad args} { } {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}} test text-22.4 {TextDumpCmd procedure, bad args} { list [catch {.t dump -bogus} msg] $msg -} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}} +} {1 {bad option "-bogus": must be -all, -command, -image, -mark, -tag, -text, or -window}} test text-22.5 {TextDumpCmd procedure, bad args} { list [catch {.t dump bogus} msg] $msg } {1 {bad text index "bogus"}} @@ -1318,12 +2853,10 @@ test text-22.9 {TextDumpCmd procedure, same indices} { test text-22.10 {TextDumpCmd procedure, negative range} { .t dump 1.5 1.0 } {} - .t delete 1.0 end .t insert end "Line One\nLine Two\nLine Three\nLine Four" .t mark set insert 1.0 .t mark set current 1.0 - test text-22.11 {TextDumpCmd procedure, stop at begin-line} { .t dump -text 1.0 2.0 } {text {Line One @@ -1333,7 +2866,6 @@ test text-22.12 {TextDumpCmd procedure, span multiple lines} { } {text {One } 1.5 text {Line Two } 2.0 text {Line Three} 3.0} - .t tag add x 2.0 2.end .t tag add y 1.0 end .t mark set m 2.4 @@ -1351,7 +2883,6 @@ test text-22.15 {TextDumpCmd procedure, tags only} { test text-22.16 {TextDumpCmd procedure, tags only} { .t dump -tag 1.0 end } {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0} - .t mark set insert 1.0 .t mark set current 1.0 test text-22.17 {TextDumpCmd procedure, marks only} { @@ -1366,7 +2897,6 @@ test text-22.19 {TextDumpCmd procedure, marks only} { test text-22.20 {TextDumpCmd procedure, marks only} { .t dump -mark 1.0 end } {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0} - button .hello -text Hello .t window create 3.end -window .hello for {set i 0} {$i < 100} {incr i} { @@ -1379,7 +2909,6 @@ test text-22.21 {TextDumpCmd procedure, windows only} { test text-22.22 {TextDumpCmd procedure, windows only} { .t dump -window 5.0 end } {window {} 100.0} - .t delete 1.0 end eval {.t mark unset} [.t mark names] .t insert end "Line One\nLine Two\nLine Three\nLine Four" @@ -1420,6 +2949,15 @@ test text-22.26 {TextDumpCmd procedure, unicode characters} { .t insert 1.0 abc\xb1\xb1\xb1 .t dump -all 1.0 2.0 } "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6" +test text-22.27 {TextDumpCmd procedure, peer present} -setup { + destroy .t +} -body { + text .t + .t peer create .t.t + .t dump -all 1.0 end +} -cleanup { + destroy .t +} -result "mark insert 1.0 mark current 1.0 text {\n} 1.0" set l [interp hidden] deleteWindows @@ -1448,11 +2986,9 @@ test text-24.1 {bug fix - 1642} { test text-25.1 {TextEditCmd procedure, argument parsing} { list [catch {.t edit} msg] $msg } {1 {wrong # args: should be ".t edit option ?arg arg ...?"}} - test text-25.2 {TextEditCmd procedure, argument parsing} { list [catch {.t edit gorp} msg] $msg -} {1 {bad edit option "gorp": must be modified, redo, reset, separator or undo}} - +} {1 {bad edit option "gorp": must be modified, redo, reset, separator, or undo}} test text-25.3 {TextEditUndo procedure, undoing changes} { catch {destroy .t} text .t -undo 1 @@ -1463,7 +2999,6 @@ test text-25.3 {TextEditUndo procedure, undoing changes} { .t edit undo .t get 1.0 end } "line\n\n" - test text-25.4 {TextEditRedo procedure, redoing changes} { catch {destroy .t} text .t -undo 1 @@ -1475,7 +3010,6 @@ test text-25.4 {TextEditRedo procedure, redoing changes} { .t edit redo .t get 1.0 end } "line\nshould be back after redo\n\n" - test text-25.5 {TextEditUndo procedure, resetting stack} { catch {destroy .t} text .t -undo 1 @@ -1487,7 +3021,6 @@ test text-25.5 {TextEditUndo procedure, resetting stack} { catch {.t edit undo} msg set msg } "nothing to undo" - test text-25.6 {TextEditCmd procedure, insert separator} { catch {destroy .t} text .t -undo 1 @@ -1498,7 +3031,6 @@ test text-25.6 {TextEditCmd procedure, insert separator} { .t edit undo .t get 1.0 end } "line 1\n\n" - test text-25.7 {-autoseparators configuration option} { catch {destroy .t} text .t -undo 1 -autoseparators 0 @@ -1509,7 +3041,6 @@ test text-25.7 {-autoseparators configuration option} { .t edit undo .t get 1.0 end } "\n" - test text-25.8 {TextEditCmd procedure, modified flag} { catch {destroy .t} text .t @@ -1517,7 +3048,6 @@ test text-25.8 {TextEditCmd procedure, modified flag} { .t insert end "line 1\n" .t edit modified } {1} - test text-25.9 {TextEditCmd procedure, reset modified flag} { catch {destroy .t} text .t @@ -1526,7 +3056,6 @@ test text-25.9 {TextEditCmd procedure, reset modified flag} { .t edit modified 0 .t edit modified } {0} - test text-25.10 {TextEditCmd procedure, set modified flag} { catch {destroy .t} text .t @@ -1549,7 +3078,6 @@ test text-25.10.1 {TextEditCmd procedure, set modified flag repeat} { update idletasks lappend ::retval [.t edit modified] } {0 modified 1 1} - test text-25.11 {<<Modified>> virtual event} { set ::retval unmodified catch {destroy .t} @@ -1580,7 +3108,6 @@ test text-25.11.2 {<<Modified>> virtual event - delete before Modified} { .t delete 1.0 1.2 set ::retval } {thing special} - test text-25.12 {<<Selection>> virtual event} { set ::retval no_selection catch {destroy .t} @@ -1592,7 +3119,6 @@ test text-25.12 {<<Selection>> virtual event} { .t tag add sel 1.0 1.1 set ::retval } {selection_changed} - test text-25.13 {-maxundo configuration option} { catch {destroy .t} text .t -undo 1 -autoseparators 1 -maxundo 2 @@ -1605,19 +3131,15 @@ test text-25.13 {-maxundo configuration option} { catch {.t edit undo} .t get 1.0 end } "line 1\n\n" - -test text-25.14 {undo with space-based path} { - set t {.t e x t} - destroy $t - text $t -undo 1 - $t insert end "line 1\n" - $t delete 1.4 1.6 - $t insert end "line 2\n" - $t edit undo - $t edit undo - $t get 1.0 end -} "line 1\n\n" - +test text-25.15 {bug fix 1536735 - undo with empty text} { + catch {destroy .t} + text .t -undo 1 + set r [.t edit modified] + .t delete 1.0 + lappend r [.t edit modified] + lappend r [catch {.t edit undo}] + lappend r [.t edit modified] +} {0 0 1 0} test text-25.18 {patch 1469210 - inserting after undo} -setup { destroy .t } -body { @@ -1637,9 +3159,642 @@ test text-26.1 {bug fix - 624372, ControlUtfProc long lines} { .t insert end [string repeat "\1" 500] } {} +test text-27.1 {tabs - must be positive and must be increasing} { + destroy .t + pack [text .t -wrap none] + list [catch {.t configure -tabs {0}} msg] $msg +} {1 {tab stop "0" is not at a positive distance}} +test text-27.2 {tabs - must be positive and must be increasing} { + destroy .t + pack [text .t -wrap none] + list [catch {.t configure -tabs {-5}} msg] $msg +} {1 {tab stop "-5" is not at a positive distance}} +test text-27.3 {tabs - must be positive and must be increasing} {knownBug} { + # This bug will be fixed in Tk 9.0, when we can allow a minor + # incompatibility with Tk 8.x + destroy .t + pack [text .t -wrap none] + list [catch {.t configure -tabs {10c 5c}} msg] $msg +} {1 {tabs must be monotonically increasing, but "5c" is smaller than or equal to the previous tab}} +test text-27.4 {tabs - must be positive and must be increasing} { + destroy .t + pack [text .t -wrap none] + .t insert end "a\tb\tc\td\te" + catch {.t configure -tabs {10c 5c}} + update ; update ; update + # This test must simply not go into an infinite loop to succeed + set result 1 +} {1} + +test text-28.0 {repeated insert and scroll} { + foreach subcmd { + {moveto 1} + {scroll 1 pages} + {scroll 100 pixels} + {scroll 10 units} + } { + destroy .t + pack [text .t] + for {set i 0} {$i < 30} {incr i} { + .t insert end "blabla\n" + eval .t yview $subcmd + } + } + # This test must simply not crash to succeed + set result 1 +} {1} + +test text-29.0 {peer widgets} { + destroy .t .tt + toplevel .tt + pack [text .t] + pack [.t peer create .tt.t] + destroy .t .tt +} {} +test text-29.1 {peer widgets} { + destroy .t .t1 .t2 + toplevel .t1 + toplevel .t2 + pack [text .t] + pack [.t peer create .t1.t] + pack [.t peer create .t2.t] + .t insert end "abcd\nabcd" + update + destroy .t1 + update + .t insert end "abcd\nabcd" + update + destroy .t .t2 + update +} {} +test text-29.2 {peer widgets} { + destroy .t .t1 .t2 + toplevel .t1 + toplevel .t2 + pack [text .t] + pack [.t peer create .t1.t] + pack [.t peer create .t2.t] + .t insert end "abcd\nabcd" + update + destroy .t + update + .t2.t insert end "abcd\nabcd" + update + destroy .t .t2 + update +} {} +test text-29.3 {peer widgets} { + destroy .t .tt + toplevel .tt + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .tt.t -start 5 -end 11] + update + destroy .t .tt +} {} +test text-29.4 {peer widgets} { + destroy .t .tt + toplevel .tt + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .tt.t -start 5 -end 11] + pack [.tt.t peer create .tt.t2] + set res [list [.tt.t index end] [.tt.t2 index end]] + update + destroy .t .tt + set res +} {7.0 7.0} +test text-29.4.1 {peer widgets} { + destroy .t .tt + toplevel .tt + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .tt.t -start 5 -end 11] + pack [.tt.t peer create .tt.t2 -start {} -end {}] + set res [list [.tt.t index end] [.tt.t2 index end]] + update + destroy .t .tt + set res +} {7.0 21.0} +test text-29.5 {peer widgets} { + destroy .t .tt + toplevel .tt + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .tt.t -start 5 -end 11] + update ; update + set p1 [.tt.t count -update -ypixels 1.0 end] + set p2 [.t count -update -ypixels 5.0 11.0] + if {$p1 == $p2} { + set res "ok" + } else { + set res "$p1 and $p2 not equal" + } + destroy .t .tt + set res +} {ok} +test text-29.6 {peer widgets} { + destroy .t .tt + toplevel .tt + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .tt.t -start 5 -end 11] + update ; update + .t delete 3.0 6.0 + set res [.tt.t index end] + destroy .t .tt + set res +} {6.0} +test text-29.7 {peer widgets} { + destroy .t .tt + toplevel .tt + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .tt.t -start 5 -end 11] + update ; update + .t delete 8.0 12.0 + set res [.tt.t index end] + destroy .t .tt + set res +} {4.0} +test text-29.8 {peer widgets} { + destroy .t .tt + toplevel .tt + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + pack [.t peer create .tt.t -start 5 -end 11] + update ; update + .t delete 3.0 13.0 + set res [.tt.t index end] + destroy .t .tt + set res +} {1.0} +test text-29.9 {peer widgets} { + destroy .t + pack [text .t] + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 end-1c + set res {} + lappend res [.t tag ranges sel] + .t configure -start 10 -end 20 + lappend res [.t tag ranges sel] + destroy .t + set res +} {{1.0 100.0} {1.0 11.0}} +test text-29.10 {peer widgets} { + destroy .t + pack [text .t] + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 end-1c + set res {} + lappend res [.t tag ranges sel] + .t configure -start 11 + lappend res [.t tag ranges sel] + destroy .t + set res +} {{1.0 100.0} {1.0 90.0}} +test text-29.11 {peer widgets} { + destroy .t + pack [text .t] + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 end-1c + set res {} + lappend res [.t tag ranges sel] + .t configure -end 90 + lappend res [.t tag ranges sel] + destroy .t + set res +} {{1.0 100.0} {1.0 90.0}} +test text-29.12 {peer widgets} { + destroy .t + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 3.0 5.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 + set res {} + lappend res [.t tag prevrange sel 1.0] + .t configure -start 6 -end 12 + lappend res [.t tag ranges sel] + lappend res "next" [.t tag nextrange sel 4.0] \ + [.t tag nextrange sel 5.0] [.t tag nextrange sel 6.0] \ + [.t tag nextrange sel 7.0] + lappend res "prev" [.t tag prevrange sel 1.0] \ + [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \ + [.t tag prevrange sel 4.0] + destroy .t + set res +} {{} {1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}} +test text-29.13 {peer widgets} { + destroy .t + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 3.0 9.0 11.0 13.0 15.0 17.0 19.0 + set res {} + .t configure -start 6 -end 12 + lappend res [.t tag ranges sel] + lappend res "next" [.t tag nextrange sel 4.0] \ + [.t tag nextrange sel 5.0] [.t tag nextrange sel 6.0] \ + [.t tag nextrange sel 7.0] + lappend res "prev" [.t tag prevrange sel 1.0] \ + [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \ + [.t tag prevrange sel 4.0] + destroy .t + set res +} {{4.0 6.0} next {4.0 6.0} {} {} {} prev {} {} {} {}} +test text-29.14 {peer widgets} { + destroy .t + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 1.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 + set res {} + .t configure -start 6 -end 12 + lappend res [.t tag ranges sel] + lappend res "next" [.t tag nextrange sel 4.0] \ + [.t tag nextrange sel 5.0] [.t tag nextrange sel 6.0] \ + [.t tag nextrange sel 7.0] + lappend res "prev" [.t tag prevrange sel 1.0] \ + [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \ + [.t tag prevrange sel 4.0] + destroy .t + set res +} {{1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}} +test text-29.15 {peer widgets} { + destroy .t + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + set res {} + .t tag add sel 1.0 11.0 + lappend res [.t tag ranges sel] + lappend res [catch {.t configure -start 15 -end 10}] + lappend res [.t tag ranges sel] + .t configure -start 6 -end 12 + lappend res [.t tag ranges sel] + .t configure -start {} -end {} + lappend res [.t tag ranges sel] + destroy .t + set res +} {{1.0 11.0} 1 {1.0 11.0} {1.0 6.0} {1.0 11.0}} +test text-29.16 {peer widgets} { + destroy .t + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + set res {} + .t tag add sel 1.0 11.0 + lappend res [.t index sel.first] + lappend res [.t index sel.last] + destroy .t + set res +} {1.0 11.0} +test text-29.17 {peer widgets} { + destroy .t + pack [text .t] + for {set i 1} {$i < 20} {incr i} { + .t insert end "Line $i\n" + } + set res {} + .t tag delete sel + set res [list [catch {.t index sel.first} msg] $msg] + destroy .t + set res +} {1 {text doesn't contain any characters tagged with "sel"}} + +proc makeText {} { + set w .g + set font "Times 11" + destroy .g + toplevel .g + frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken + set t $w.f.text + text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ + -height 35 -wrap word -highlightthickness 0 -borderwidth 0 + pack $t -expand yes -fill both + scrollbar $w.scroll -command "$t yview" + pack $w.scroll -side right -fill y + pack $w.f -expand yes -fill both + $t tag configure center -justify center -spacing1 5m -spacing3 5m + $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \ + -spacing1 3m -spacing2 0 -spacing3 0 + for {set i 0} {$i < 40} {incr i} { + $t insert end "${i}word " + } + return $t +} + +test text-30.1 {line heights on creation} { + set w [makeText] + update ; after 1000 ; update + set before [$w count -ypixels 1.0 2.0] + $w insert 1.0 "a" + update + set after [$w count -ypixels 1.0 2.0] + destroy .g + if {$before != $after} { + set res "Count changed: $before $after" + } else { + set res "ok" + } +} {ok} + +destroy .t +text .t +test text-31.1 {TextWidgetCmd procedure, "peer" option} { + list [catch {.t peer foo 1} msg] $msg +} {1 {bad peer option "foo": must be create or names}} +test text-31.2 {TextWidgetCmd procedure, "peer" option} { + list [catch {.t peer names foo} msg] $msg +} {1 {wrong # args: should be ".t peer names"}} +test text-31.3 {TextWidgetCmd procedure, "peer" option} { + list [catch {.t p names} msg] $msg +} {0 {}} +test text-31.4 {TextWidgetCmd procedure, "peer" option} { + .t peer names +} {} +test text-31.5 {TextWidgetCmd procedure, "peer" option} { + list [catch {.t peer create foo} msg] $msg +} {1 {bad window path name "foo"}} +test text-31.6 {TextWidgetCmd procedure, "peer" option} { + .t peer create .t2 + set res {} + lappend res [.t peer names] + lappend res [.t2 peer names] + destroy .t2 + lappend res [.t peer names] +} {.t2 .t {}} +test text-31.7 {peer widget -start, -end} { + set res [list [catch {.t configure -start 10 -end 5} msg] $msg] + .t configure -start {} -end {} + set res +} {0 {}} +test text-31.8 {peer widget -start, -end} { + .t delete 1.0 end + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + list [catch {.t configure -start 10 -end 5} msg] $msg +} {1 {-startline must be less than or equal to -endline}} +test text-31.9 {peer widget -start, -end} { + .t delete 1.0 end + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + set res [list [catch {.t configure -start 5 -end 10} msg] $msg] + .t configure -start {} -end {} + set res +} {0 {}} +test text-31.10 {peer widget -start, -end} { + .t delete 1.0 end + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + set res [.t index end] + lappend res [catch {.t configure -start 5 -end 10 -tab foo}] + lappend res [.t index end] + lappend res [catch {.t configure -tab foo -start 15 -end 20}] + lappend res [.t index end] + .t configure -start {} -end {} + lappend res [.t index end] + set res +} {101.0 1 101.0 1 101.0 101.0} +test text-31.11 {peer widget -start, -end} { + .t delete 1.0 end + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + set res [.t index end] + lappend res [catch {.t configure -start 5 -end 15}] + lappend res [.t index end] + lappend res [catch {.t configure -start 10 -end 40}] + lappend res [.t index end] + .t configure -start {} -end {} + lappend res [.t index end] + set res +} {101.0 0 11.0 0 31.0 101.0} + +test text-32.1 {peer widget -start, -end and selection} { + .t delete 1.0 end + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t tag add sel 10.0 20.0 + set res {} + lappend res [.t tag ranges sel] + .t configure -start 5 -end 30 + lappend res [.t tag ranges sel] + .t configure -start 5 -end 15 + lappend res [.t tag ranges sel] + .t configure -start 15 -end 30 + lappend res [.t tag ranges sel] + .t configure -start 15 -end 16 + lappend res [.t tag ranges sel] + .t configure -start 25 -end 30 + lappend res [.t tag ranges sel] + .t configure -start {} -end {} + lappend res [.t tag ranges sel] + set res +} {{10.0 20.0} {6.0 16.0} {6.0 11.0} {1.0 6.0} {1.0 2.0} {} {10.0 20.0}} + +test text-32.2 {peer widget -start, -end and deletion (bug 1630262)} -setup { + destroy .t .pt + set res {} +} -body { + text .t + .t peer create .pt + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -startline 5 + # none of the following delete shall crash + # (all did before fixing bug 1630262) + # 1. delete on the same line: line1 == line2 in DeleteIndexRange, + # and resetView is true neither for .t not for .pt + .pt delete 2.0 2.2 + # 2. delete just one line: line1 < line2 in DeleteIndexRange, + # and resetView is true only for .t, not for .pt + .pt delete 2.0 3.0 + # 3. delete several lines: line1 < line2 in DeleteIndexRange, + # and resetView is true only for .t, not for .pt + .pt delete 2.0 5.0 + # 4. delete to the end line: line1 < line2 in DeleteIndexRange, + # and resetView is true only for .t, not for .pt + .pt delete 2.0 end + # this test succeeds provided there is no crash + set res 1 +} -cleanup { + destroy .pt +} -result {1} + +test text-32.3 {peer widget -start, -end and deletion (bug 1630262)} -setup { + destroy .t .pt + set res {} +} -body { + text .t + .t peer create .pt + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -startline 5 + .pt configure -startline 3 + # the following delete shall not crash + # (it did before fixing bug 1630262) + .pt delete 2.0 3.0 + # moreover -startline shall be correct + # (was wrong before fixing bug 1630262) + lappend res [.t cget -start] [.pt cget -start] +} -cleanup { + destroy .pt +} -result {4 3} + +test text-32.4 {peer widget -start, -end and deletion (bug 1630262)} -setup { + destroy .t .pt + set res {} +} -body { + text .t + .t peer create .pt + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -startline 5 -endline 15 + .pt configure -startline 8 -endline 12 + # .pt now shows a range entirely inside the range of .pt + # from .t, delete lines located after [.pt cget -end] + .t delete 9.0 10.0 + # from .t, delete lines straddling [.pt cget -end] + .t delete 6.0 9.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] + .t configure -startline 5 -endline 12 + .pt configure -startline 8 -endline 12 + # .pt now shows again a range entirely inside the range of .pt + # from .t, delete lines located before [.pt cget -start] + .t delete 2.0 3.0 + # from .t, delete lines straddling [.pt cget -start] + .t delete 2.0 5.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] + .t configure -startline 22 -endline 31 + .pt configure -startline 42 -endline 51 + # .t now shows a range entirely before the range of .pt + # from .t, delete some lines, then do it from .pt + .t delete 2.0 3.0 + .t delete 2.0 5.0 + .pt delete 2.0 5.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] + .t configure -startline 55 -endline 75 + .pt configure -startline 60 -endline 70 + # .pt now shows a range entirely inside the range of .t + # from .t, delete a range straddling the entire range of .pt + .t delete 3.0 18.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] +} -cleanup { + destroy .pt +} -result {5 11 8 10 5 8 6 8 22 27 38 44 55 60 57 57} + +test text-33.1 {widget dump -command alters tags} { + .t delete 1.0 end + .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c + .t tag configure b -background red + proc Dumpy {key value index} { + #puts "KK: $key, $value" + .t tag add $value [list $index linestart] [list $index lineend] + } + .t dump -all -command Dumpy 1.0 end + set result "ok" +} {ok} +test text-33.2 {widget dump -command makes massive changes} { + .t delete 1.0 end + .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c + .t tag configure b -background red + proc Dumpy {key value index} { + #puts "KK: $key, $value" + .t delete 1.0 end + } + .t dump -all -command Dumpy 1.0 end + set result "ok" +} {ok} +test text-33.3 {widget dump -command destroys widget} { + .t delete 1.0 end + .t insert end "abc\n" a "---" {} "def" b " \n" {} "ghi\n" c + .t tag configure b -background red + proc Dumpy {key value index} { + #puts "KK: $key, $value" + destroy .t + } + .t dump -all -command Dumpy 1.0 end + set result "ok" +} {ok} + deleteWindows option clear +test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup { + proc bgerror {m} {set ::my_error $m} + set ::my_error {} + pack [set w [text .t-1]] +} -body { + tkwait visibility $w + event generate $w <1> + event generate $w <1> + update + set ::my_error +} -cleanup { + destroy .t-1 +} -result {} + +test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup { + proc bgerror {m} {set ::my_error $m} + set ::my_error {} + pack [set w [text .t+1]] +} -body { + tkwait visibility $w + event generate $w <1> + event generate $w <1> + update + set ::my_error +} -cleanup { + destroy $w +} -result {} + +test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup { + proc bgerror {m} {set ::my_error $m} + set ::my_error {} + pack [set w [text .t*1]] +} -body { + tkwait visibility $w + event generate $w <1> + event generate $w <1> + update + set ::my_error +} -cleanup { + destroy $w +} -result {} + # cleanup -::tcltest::cleanupTests +cleanupTests return |