summaryrefslogtreecommitdiffstats
path: root/tests/text.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/text.test')
-rw-r--r--tests/text.test2291
1 files changed, 2224 insertions, 67 deletions
diff --git a/tests/text.test b/tests/text.test
index 62136ca..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
@@ -132,6 +133,8 @@ test text-2.4 {Tk_TextCmd procedure} {
} {0 .t2 2 red}
if {$tcl_platform(platform) == "windows"} {
set relief flat
+} elseif {[tk windowingsystem] eq "aqua"} {
+ set relief solid
} else {
set relief raised
}
@@ -150,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
@@ -218,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
@@ -227,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
@@ -320,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"}}
@@ -375,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
@@ -387,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"}}
@@ -450,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]
@@ -478,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
@@ -536,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
@@ -550,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
@@ -565,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
@@ -898,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"
@@ -906,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"
@@ -931,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}
@@ -954,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}
@@ -1005,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}
@@ -1038,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
@@ -1098,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
@@ -1160,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
@@ -1186,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]
@@ -1215,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]
@@ -1240,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}}
@@ -1296,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"}}
@@ -1316,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
@@ -1331,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
@@ -1349,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} {
@@ -1364,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} {
@@ -1377,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"
@@ -1418,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
@@ -1446,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
@@ -1461,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
@@ -1473,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
@@ -1485,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
@@ -1496,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
@@ -1507,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
@@ -1515,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
@@ -1524,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
@@ -1547,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}
@@ -1578,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}
@@ -1590,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
@@ -1603,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 {
@@ -1635,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