summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorvincentdarley <vincentdarley>2003-10-31 09:02:06 (GMT)
committervincentdarley <vincentdarley>2003-10-31 09:02:06 (GMT)
commit5aca2c785542acbefba1c55007389e41d19ea6f3 (patch)
tree1a7d95870c1e63f3d43b706e7e97421c104b19b7 /tests
parent51c19c5c75da3a7e10f2000ef8cf96bf9fed814c (diff)
downloadtk-5aca2c785542acbefba1c55007389e41d19ea6f3.zip
tk-5aca2c785542acbefba1c55007389e41d19ea6f3.tar.gz
tk-5aca2c785542acbefba1c55007389e41d19ea6f3.tar.bz2
TIP 155 implementation
Diffstat (limited to 'tests')
-rw-r--r--tests/text.test765
-rw-r--r--tests/textDisp.test486
-rw-r--r--tests/textImage.test10
-rw-r--r--tests/textIndex.test92
-rw-r--r--tests/textWind.test8
5 files changed, 1268 insertions, 93 deletions
diff --git a/tests/text.test b/tests/text.test
index 6f8a72e..0622a03 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -6,11 +6,12 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: text.test,v 1.22 2003/05/19 21:19:52 dkf Exp $
+# RCS: @(#) $Id: text.test,v 1.23 2003/10/31 09:02:15 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
tcltest::loadTestedCommands
+namespace import -force tcltest::test
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
@@ -53,6 +54,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}
@@ -112,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 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}}
test text-2.1 {Tk_TextCmd procedure} {
list [catch {text} msg] $msg
@@ -151,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, replace, scan, search, see, tag, window, xview, or yview}}
test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
list [catch {.t bbox} msg] $msg
@@ -219,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 {ambiguous 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, replace, scan, search, see, tag, window, xview, or yview}}
# "configure" option is already covered above
@@ -228,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 {ambiguous 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, replace, scan, search, see, tag, window, xview, or yview}}
test text-7.3 {TextWidgetCmd procedure, "debug" option} {
.t debug true
.t deb
@@ -324,9 +326,30 @@ test text-8.16 {TextWidgetCmd procedure, "delete" option} {
.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} {
+ .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}
+
+.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"}}
@@ -376,9 +399,208 @@ 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.17 {TextWidgetCmd procedure, "get" option} {
+ .t index "5.2 +3chars"
+} {5.5}
+test text-9.17 {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.26 {TextWidgetCmd procedure, "get" option} {
+ list [.t index "5.1 +4a chars"] [.t index "5.1+4d chars"]
+} {5.6 5.8}
+test text-9.25 {TextWidgetCmd procedure, "get" option} {
+ list [.t index "5.5 -4indices"] [.t index "5.7-4d indices"]
+} {5.1 5.1}
+test text-9.26 {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.23 {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
+.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
@@ -388,7 +610,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 {ambiguous 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, 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"}}
@@ -932,7 +1154,7 @@ 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 --, -all, -backward, -count, -elide, -exact, -forward, -nocase, -nolinestop, 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}
@@ -960,7 +1182,7 @@ test text-20.8 {TextSearchCmd procedure, -nocase option} {
} {2.13 2.23}
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, or -regexp}}
+} {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}
@@ -1112,10 +1334,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
@@ -1174,6 +1402,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
@@ -1276,6 +1507,16 @@ test text-20.75 {TextSearchCmd, hidden text inside match must count in length} {
.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]
@@ -1311,6 +1552,15 @@ test text-20.78.1 {TextSearchCmd, hidden text inside match must count in length}
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
@@ -1318,7 +1568,7 @@ test text-20.78.2 {TextSearchCmd, hidden text inside match must count in length}
list [.t2 search -regexp -all -count foo foar 1.3] $foo
} {{2.0 3.0 1.0} {6 4 6}}
-test text-20.78.3 {TextSearchCmd, hidden text inside match must count in length} {
+test text-20.78.4 {TextSearchCmd, hidden text inside match must count in length} {
deleteWindows
pack [text .t2]
.t2 insert end "foobar\nfoobar\nfoar"
@@ -1328,6 +1578,16 @@ test text-20.78.3 {TextSearchCmd, hidden text inside match must count in length}
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.79 {TextSearchCmd, multiline matching} {
deleteWindows
pack [text .t2]
@@ -1457,9 +1717,16 @@ 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 1.0] $foo
+ 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]
@@ -1521,7 +1788,7 @@ static Tcl_Obj* FSNormalizeAbsolutePath
} {}
test text-20.106 {TextSearchCmd, multiline regexp matching} {
- # Practical example which crashes Tk, but only after the
+ # 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)
@@ -1598,7 +1865,7 @@ test text-20.114 {TextSearchCmd, wrapping and limits} {
pack [text .t2]
.t2 insert end "if (stringPtr->uallocated > 0) \{x"
.t2 search -backwards -all -regexp -- "\[\]\")\}\[(\{\]" "1.32" 1.0
-} {1.3 1.29 1.31}
+} {1.31 1.29 1.3}
test text-20.115 {TextSearchCmd, wrapping and limits} {
deleteWindows
@@ -1687,6 +1954,13 @@ 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}
@@ -1694,8 +1968,15 @@ test text-20.125 {TextSearchCmd, multiline regexp nolinestop matching} {
deleteWindows
pack [text .t2]
.t2 insert 1.0 "first line\nlast line of text"
- .t2 search -regexp -all -nolinestop -- {i.*x} 1.0
-} {1.1 1.7 2.6}
+ 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
@@ -1703,13 +1984,453 @@ test text-20.126 {TextSearchCmd, stop at end of line} {
.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 {
-test text-20.126 {TextSearchCmd, stop at end of line} {
+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 " \t\n last line of text"
- .t2 search -regexp -- {[^ \t]} 1.0
-} {2.3}
+ .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.142 {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}
deleteWindows
text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 79310b0..da8659b 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -6,11 +6,12 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textDisp.test,v 1.9 2003/04/01 21:06:53 dgp Exp $
+# RCS: @(#) $Id: textDisp.test,v 1.10 2003/10/31 09:02:16 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
tcltest::loadTestedCommands
+namespace import -force tcltest::test
# The procedure below is used as the scrolling command for the text;
# it just saves the scrolling information in a variable "scrollInfo".
@@ -37,6 +38,7 @@ option add *Text.highlightThickness 2
# because some window managers don't allow the overall width of a window
# to get very narrow.
+catch {destroy .f .t}
frame .f -width 100 -height 20
pack append . .f left
@@ -547,7 +549,7 @@ test textDisp-4.11 {UpdateDisplayInfo, filling in extra vertical space} {
} {6.40 {13.0 7.0 6.80 6.60 6.40} {6.40 6.60 6.80 7.0 13.0}}
test textDisp-4.12 {UpdateDisplayInfo, filling in extra vertical space} {
.t delete 1.0 end
- .t insert end "1\n2\n3\n4\n5\n7\n8\n9\n10\n11\n12\n13"
+ .t insert end "1\n2\n3\n4\n5\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16"
button .b -text "Test" -bd 2 -highlightthickness 2
.t window create 3.end -window .b
.t yview moveto 1
@@ -793,7 +795,7 @@ test textDisp-6.7 {DisplayText, vertical scrollbar updates} {
.t delete 1.0 end
update
set scrollInfo
-} {0 1}
+} {0.0 1.0}
test textDisp-6.8 {DisplayText, vertical scrollbar updates} {
.t configure -wrap char
.t delete 1.0 end
@@ -805,7 +807,7 @@ test textDisp-6.8 {DisplayText, vertical scrollbar updates} {
}
update
set scrollInfo
-} {0 0.769231}
+} {0.0 0.769230769231}
.t configure -yscrollcommand {} -xscrollcommand scroll
test textDisp-6.9 {DisplayText, horizontal scrollbar updates} {
.t configure -wrap none
@@ -817,7 +819,7 @@ test textDisp-6.9 {DisplayText, horizontal scrollbar updates} {
.t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx
update
set scrollInfo
-} {0 0.363636}
+} {0.0 0.363636363636}
# The following group of tests is marked non-portable because
# they result in a lot of extra redisplay under Ultrix. I don't
@@ -1020,10 +1022,12 @@ test textDisp-8.11 {TkTextChanged, scrollbar notification when changes are off-s
update
set scrollInfo ""
.t insert end "a\nb\nc\n"
- update
+ # We need to wait for our asychronous callbacks to update the
+ # scrollbar
+ update ; after 50; update
.t configure -yscrollcommand ""
set scrollInfo
-} {0 0.625}
+} {0.0 0.625}
test textDisp-9.1 {TkTextRedrawTag} {
.t configure -wrap char
@@ -1209,12 +1213,12 @@ test textDisp-11.6 {TkTextSetYView} {
} {28.0 {28.0 29.0}}
test textDisp-11.7 {TkTextSetYView} {
.t yview 30.0
- update
+ update ; update
set tk_textRedraw {}
.t yview -pickplace 26.0
update
list [.t index @0,0] $tk_textRedraw
-} {22.0 {22.0 23.0 24.0 25.0 26.0 27.0 28.0 29.0}}
+} {21.0 {21.0 22.0 23.0 24.0 25.0 26.0 27.0 28.0 29.0}}
test textDisp-11.8 {TkTextSetYView} {
.t yview 30.0
update
@@ -1230,7 +1234,7 @@ test textDisp-11.9 {TkTextSetYView} {
.t yview -pickplace 43.0
update
list [.t index @0,0] $tk_textRedraw
-} {39.0 {40.0 41.0 42.0 43.0 44.0 45.0 46.0 47.0 48.0}}
+} {38.0 {40.0 41.0 42.0 43.0 44.0 45.0 46.0 47.0 48.0}}
test textDisp-11.10 {TkTextSetYView} {
.t yview 30.0
update
@@ -1257,7 +1261,7 @@ test textDisp-11.12 {TkTextSetYView, wrapped line is off-screen} {
list [.t index @0,0] $tk_textRedraw
} {2.0 10.20}
.t delete 10.0 11.0
-test textDisp-11.13 {TkTestSetYView, partially-visible last line} {
+test textDisp-11.13 {TkTestSetYView, partially visible last line} {
catch {destroy .top}
toplevel .top
wm geometry .top +0+0
@@ -1276,8 +1280,10 @@ test textDisp-11.13 {TkTestSetYView, partially-visible last line} {
set tk_textRedraw {}
.top.t see 5.0
update
+ # Note, with smooth scrolling, the results of this test
+ # have changed, and the old '2.0 {5.0 6.0}' is quite wrong.
list [.top.t index @0,0] $tk_textRedraw
-} {2.0 {5.0 6.0}}
+} {1.0 5.0}
catch {destroy .top}
toplevel .top
wm geometry .top +0+0
@@ -1299,7 +1305,8 @@ test textDisp-11.15 {TkTextSetYView, only a few lines visible} {
update
.top.t see 11.0
.top.t index @0,0
-} {10.0}
+ # Thie index 9.0 should be just visible by a couple of pixels
+} {9.0}
test textDisp-11.16 {TkTextSetYView, only a few lines visible} {
.top.t yview 8.0
update
@@ -1311,7 +1318,8 @@ test textDisp-11.17 {TkTextSetYView, only a few lines visible} {
update
.top.t see 4.0
.top.t index @0,0
-} {3.0}
+ # Thie index 2.0 should be just visible by a couple of pixels
+} {2.0}
destroy .top
.t configure -wrap word
@@ -1323,21 +1331,21 @@ test textDisp-12.1 {MeasureUp} {
.t yview -pickplace 52.0
update
.t index @0,0
-} {50.0}
+} {49.0}
test textDisp-12.2 {MeasureUp} {
.t yview 100.0
update
.t yview -pickplace 53.0
update
.t index @0,0
-} {50.15}
+} {50.0}
test textDisp-12.3 {MeasureUp} {
.t yview 100.0
update
.t yview -pickplace 50.10
update
.t index @0,0
-} {46.0}
+} {45.0}
.t configure -wrap none
test textDisp-12.4 {MeasureUp} {
.t yview 100.0
@@ -1345,14 +1353,14 @@ test textDisp-12.4 {MeasureUp} {
.t yview -pickplace 53.0
update
.t index @0,0
-} {49.0}
+} {48.0}
test textDisp-12.5 {MeasureUp} {
.t yview 100.0
update
.t yview -pickplace 50.10
update
.t index @0,0
-} {46.0}
+} {45.0}
.t configure -wrap none
.t delete 1.0 end
@@ -1394,7 +1402,7 @@ test textDisp-13.6 {TkTextSeeCmd procedure} {
set x [.t index @0,0]
.t configure -wrap none
set x
-} {28.0}
+} {27.0}
test textDisp-13.7 {TkTextSeeCmd procedure} {fonts} {
.t xview moveto 0
.t yview moveto 0
@@ -1463,7 +1471,7 @@ test textDisp-14.1 {TkTextXviewCmd procedure} {
.t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
.t xview moveto .5
.t xview
-} {0.5 0.857143}
+} {0.5 0.857142857143}
.t configure -wrap char
test textDisp-14.2 {TkTextXviewCmd procedure} {
.t delete 1.0 end
@@ -1472,7 +1480,7 @@ test textDisp-14.2 {TkTextXviewCmd procedure} {
.t insert end "xxxxx\n"
.t insert end "xxxx"
.t xview
-} {0 1}
+} {0.0 1.0}
.t configure -wrap none
test textDisp-14.3 {TkTextXviewCmd procedure} {
.t delete 1.0 end
@@ -1481,7 +1489,7 @@ test textDisp-14.3 {TkTextXviewCmd procedure} {
.t insert end "xxxxx\n"
.t insert end "xxxx"
.t xview
-} {0 1}
+} {0.0 1.0}
test textDisp-14.4 {TkTextXviewCmd procedure} {
list [catch {.t xview moveto} msg] $msg
} {1 {wrong # args: should be ".t xview moveto fraction"}}
@@ -1498,7 +1506,7 @@ test textDisp-14.7 {TkTextXviewCmd procedure} {
.t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
.t xview moveto .3
.t xview
-} {0.303571 0.660714}
+} {0.303571428571 0.660714285714}
test textDisp-14.8 {TkTextXviewCmd procedure} {
.t delete 1.0 end
.t insert end xxxxxxxxx\n
@@ -1506,7 +1514,7 @@ test textDisp-14.8 {TkTextXviewCmd procedure} {
.t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
.t xview moveto -.4
.t xview
-} {0 0.357143}
+} {0.0 0.357142857143}
test textDisp-14.9 {TkTextXviewCmd procedure} {
.t delete 1.0 end
.t insert end xxxxxxxxx\n
@@ -1514,7 +1522,7 @@ test textDisp-14.9 {TkTextXviewCmd procedure} {
.t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
.t xview m 1.4
.t xview
-} {0.642857 1}
+} {0.642857142857 1.0}
test textDisp-14.10 {TkTextXviewCmd procedure} {
list [catch {.t xview scroll a} msg] $msg
} {1 {wrong # args: should be ".t xview scroll number units|pages"}}
@@ -1619,13 +1627,13 @@ for {set i 2} {$i <= 200} {incr i} {
.t tag add big 100.0 105.0
.t insert 151.end { has a lot of extra text, so that it wraps around on the screen several times over.}
.t insert 153.end { also has enoug extra text to wrap.}
-update
+update ; .t count -update -ypixels 1.0 end
test textDisp-16.1 {TkTextYviewCmd procedure} {
.t yview 21.0
set x [.t yview]
.t yview 1.0
- set x
-} {0.1 0.15}
+ list [expr {int([lindex $x 0]*100)}] [expr {int ([lindex $x 1] * 100)}]
+} {9 14}
test textDisp-16.2 {TkTextYviewCmd procedure} {
list [catch {.t yview 2 3} msg] $msg
} {1 {unknown option "2": must be moveto or scroll}}
@@ -1661,7 +1669,7 @@ test textDisp-16.10 {TkTextYviewCmd procedure, "moveto" option} {
test textDisp-16.11 {TkTextYviewCmd procedure, "moveto" option} {
.t yview moveto 0.5
.t index @0,0
-} {101.0}
+} {103.0}
test textDisp-16.12 {TkTextYviewCmd procedure, "moveto" option} {
.t yview moveto -1
.t index @0,0
@@ -1673,19 +1681,19 @@ test textDisp-16.13 {TkTextYviewCmd procedure, "moveto" option} {
test textDisp-16.14 {TkTextYviewCmd procedure, "moveto" option} {
.t yview moveto .75
.t index @0,0
-} {151.0}
+} {151.60}
test textDisp-16.15 {TkTextYviewCmd procedure, "moveto" option} {
.t yview moveto .752
.t index @0,0
-} {151.20}
+} {151.60}
test textDisp-16.16 {TkTextYviewCmd procedure, "moveto" option} {
.t yview moveto .754
.t index @0,0
-} {151.60}
+} {151.80}
test textDisp-16.17 {TkTextYviewCmd procedure, "moveto" option} {
.t yview moveto .755
.t index @0,0
-} {152.0}
+} {151.80}
test textDisp-16.18 {TkTextYviewCmd procedure, "moveto" roundoff} {fonts} {
catch {destroy .top1}
toplevel .top1
@@ -1702,12 +1710,15 @@ test textDisp-16.18 {TkTextYviewCmd procedure, "moveto" roundoff} {fonts} {
} {0.333333 0.833333}
test textDisp-16.19 {TkTextYviewCmd procedure, "scroll" option} {
list [catch {.t yview scroll a} msg] $msg
-} {1 {wrong # args: should be ".t yview scroll number units|pages"}}
+} {1 {wrong # args: should be ".t yview scroll number units|pages|pixels"}}
test textDisp-16.20 {TkTextYviewCmd procedure, "scroll" option} {
list [catch {.t yview scroll a b c} msg] $msg
-} {1 {wrong # args: should be ".t yview scroll number units|pages"}}
+} {1 {wrong # args: should be ".t yview scroll number units|pages|pixels"}}
test textDisp-16.21 {TkTextYviewCmd procedure, "scroll" option} {
list [catch {.t yview scroll badInt bogus} msg] $msg
+} {1 {bad argument "bogus": must be units, pages or pixels}}
+test textDisp-16.21.2 {TkTextYviewCmd procedure, "scroll" option} {
+ list [catch {.t yview scroll badInt units} msg] $msg
} {1 {expected integer but got "badInt"}}
test textDisp-16.22 {TkTextYviewCmd procedure, "scroll" option, back pages} {
.t yview 50.0
@@ -1715,16 +1726,19 @@ test textDisp-16.22 {TkTextYviewCmd procedure, "scroll" option, back pages} {
.t yview scroll -1 pages
.t index @0,0
} {42.0}
+test textDisp-16.22.1 {TkTextYviewCmd procedure, "scroll" option, back pages} {
+ list [catch {.t yview scroll -3 p} res] $res
+} {1 {ambiguous argument "p": must be units, pages or pixels}}
test textDisp-16.23 {TkTextYviewCmd procedure, "scroll" option, back pages} {
.t yview 50.0
update
- .t yview scroll -3 p
+ .t yview scroll -3 pa
.t index @0,0
} {26.0}
test textDisp-16.24 {TkTextYviewCmd procedure, "scroll" option, back pages} {
.t yview 5.0
update
- .t yview scroll -3 p
+ .t yview scroll -3 pa
.t index @0,0
} {1.0}
test textDisp-16.25 {TkTextYviewCmd procedure, "scroll" option, back pages} {
@@ -1781,10 +1795,65 @@ test textDisp-16.31 {TkTextYviewCmd procedure, "scroll units" option} {
} {151.40}
test textDisp-16.32 {TkTextYviewCmd procedure} {
list [catch {.t yview scroll 12 bogoids} msg] $msg
-} {1 {bad argument "bogoids": must be units or pages}}
+} {1 {bad argument "bogoids": must be units, pages or pixels}}
test textDisp-16.33 {TkTextYviewCmd procedure} {
list [catch {.t yview bad_arg 1 2} msg] $msg
} {1 {unknown option "bad_arg": must be moveto or scroll}}
+test textDisp-16.34 {TkTextYviewCmd procedure} {
+ set res {}
+ .t yview 1.0
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+ .t yview scroll 1 pixels
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+ .t yview scroll 1 pixels
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+ .t yview scroll 1 pixels
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+ .t yview scroll 1 pixels
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+ .t yview scroll 1 pixels
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+} {0.0 1.0 2.0 3.0 4.0 5.0}
+test textDisp-16.35 {TkTextYviewCmd procedure} {
+ set res {}
+ .t yview 1.0
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+ .t yview scroll 13 pixels
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+ .t yview scroll -4 pixels
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+ .t yview scroll -9 pixels
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+} {0.0 13.0 9.0 0.0}
+test textDisp-16.36 {TkTextYviewCmd procedure} {
+ set res {}
+ .t yview 1.0
+ .t yview scroll 5 pixels
+ .t yview scroll -1 pages
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+ .t yview scroll 5 pixels
+ .t yview scroll -1 units
+ lappend res [expr {[lindex [.t yview] 0] * [.t count -ypixels 1.0 end]}]
+} {0.0 0.0}
+test textDisp-16.37 {TkTextYviewCmd procedure} {
+ list [catch {.t yview scroll 1.3 pixels} msg] $msg
+} {0 {}}
+test textDisp-16.38 {TkTextYviewCmd procedure} {
+ list [catch {.t yview scroll 1.3blah pixels} msg] $msg
+} {1 {bad screen distance "1.3blah"}}
+test textDisp-16.39 {TkTextYviewCmd procedure} {
+ list [catch {.t yview scroll 1.3i pixels} msg] $msg
+} {0 {}}
+test textDisp-16.40 {text count -xpixels} {
+ set res {}
+ lappend res [.t count -xpixels 1.0 1.5] \
+ [.t count -xpixels 1.5 1.0] \
+ [.t count -xpixels 1.0 13.0] \
+ [.t count -xpixels 1.0 "1.0 displaylineend"] \
+ [.t count -xpixels 1.0 "1.0 lineend"] \
+ [.t count -xpixels 1.0 "1.0 displaylineend"] \
+ [.t count -xpixels 1.0 end]
+} {35 -35 0 42 42 42 0}
.t delete 1.0 end
foreach i {a b c d e f g h i j k l m n o p q r s t u v w x y z} {
@@ -1861,7 +1930,7 @@ test textDisp-18.1 {GetXView procedure} {
.t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx
update
set scrollInfo
-} {0 0.363636}
+} {0.0 0.363636363636}
test textDisp-18.2 {GetXView procedure} {
.t configure -wrap char
.t delete 1.0 end
@@ -1870,13 +1939,13 @@ test textDisp-18.2 {GetXView procedure} {
.t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx
update
set scrollInfo
-} {0 1}
+} {0.0 1.0}
test textDisp-18.3 {GetXView procedure} {
.t configure -wrap none
.t delete 1.0 end
update
set scrollInfo
-} {0 1}
+} {0.0 1.0}
test textDisp-18.4 {GetXView procedure} {
.t configure -wrap none
.t delete 1.0 end
@@ -1885,7 +1954,7 @@ test textDisp-18.4 {GetXView procedure} {
.t insert end xxxxxxxxxxxxxxxxx
update
set scrollInfo
-} {0 1}
+} {0.0 1.0}
test textDisp-18.5 {GetXView procedure} {
.t configure -wrap none
.t delete 1.0 end
@@ -1895,7 +1964,7 @@ test textDisp-18.5 {GetXView procedure} {
.t xview scroll 31 units
update
set scrollInfo
-} {0.563636 0.927273}
+} {0.563636363636 0.927272727273}
test textDisp-18.6 {GetXView procedure} {
.t configure -wrap none
.t delete 1.0 end
@@ -1916,7 +1985,7 @@ test textDisp-18.6 {GetXView procedure} {
.t configure -wrap none
update
lappend x $scrollInfo
-} {{0.553571 0.910714} {0 1} {0 1} {0 0.357143}}
+} {{0.553571428571 0.910714285714} {0.0 1.0} {0.0 1.0} {0.0 0.357142857143}}
test textDisp-18.7 {GetXView procedure} {
.t configure -wrap none
.t delete 1.0 end
@@ -1948,7 +2017,7 @@ test textDisp-18.8 {GetXView procedure} {
"error "scrolling error""
(procedure "scrollError" line 2)
invoked from within
-"scrollError 0 1"
+"scrollError 0.0 1.0"
(horizontal scrolling command executed by text)}}
catch {rename bgerror {}}
catch {rename bogus {}}
@@ -1960,7 +2029,7 @@ test textDisp-19.1 {GetYView procedure} {
.t delete 1.0 end
update
set scrollInfo
-} {0 1}
+} {0.0 1.0}
test textDisp-19.2 {GetYView procedure} {
.t configure -wrap char
.t delete 1.0 end
@@ -1973,7 +2042,7 @@ test textDisp-19.2 {GetYView procedure} {
test textDisp-19.3 {GetYView procedure} {
.t configure -wrap char
.t delete 1.0 end
- update
+ update; after 10 ; update
set scrollInfo "unchanged"
.t insert 1.0 "Line 1\nLine 2 is so long that it wraps around\nLine 3"
update
@@ -1990,7 +2059,7 @@ test textDisp-19.4 {GetYView procedure} {
}
update
set scrollInfo
-} {0 0.769231}
+} {0.0 0.769230769231}
test textDisp-19.5 {GetYView procedure} {
.t configure -wrap char
.t delete 1.0 end
@@ -1999,9 +2068,9 @@ test textDisp-19.5 {GetYView procedure} {
.t insert end "\nLine $i"
}
.t insert 2.end " is really quite long; in fact it's so long that it wraps three times"
- update
+ update ; after 100
set x $scrollInfo
-} {0 0.538462}
+} {0.0 0.625}
test textDisp-19.6 {GetYView procedure} {
.t configure -wrap char
.t delete 1.0 end
@@ -2013,7 +2082,7 @@ test textDisp-19.6 {GetYView procedure} {
.t yview 4.0
update
set x $scrollInfo
-} {0.230769 1}
+} {0.375 1.0}
test textDisp-19.7 {GetYView procedure} {
.t configure -wrap char
.t delete 1.0 end
@@ -2023,9 +2092,9 @@ test textDisp-19.7 {GetYView procedure} {
}
.t insert 2.end " is really quite long; in fact it's so long that it wraps three times"
.t yview 2.26
- update
+ update; after 1; update
set x $scrollInfo
-} {0.097166 0.692308}
+} {0.125 0.75}
test textDisp-19.8 {GetYView procedure} {
.t configure -wrap char
.t delete 1.0 end
@@ -2036,8 +2105,9 @@ test textDisp-19.8 {GetYView procedure} {
.t insert 10.end " is really quite long; in fact it's so long that it wraps three times"
.t yview 2.0
update
+ .t count -update -ypixels 1.0 end
set x $scrollInfo
-} {0.0769231 0.732268}
+} {0.0625 0.6875}
test textDisp-19.9 {GetYView procedure} {
.t configure -wrap char
.t delete 1.0 end
@@ -2048,7 +2118,7 @@ test textDisp-19.9 {GetYView procedure} {
.t yview 3.0
update
set scrollInfo
-} {0.133333 0.8}
+} {0.133333333333 0.8}
test textDisp-19.10 {GetYView procedure} {
.t configure -wrap char
.t delete 1.0 end
@@ -2059,7 +2129,29 @@ test textDisp-19.10 {GetYView procedure} {
.t yview 11.0
update
set scrollInfo
-} {0.333333 1}
+} {0.333333333333 1.0}
+test textDisp-19.10.1 {Widget manipulation causes height miscount} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ .t yview 11.0
+ update
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ .t insert end "\nThis last line wraps around four "
+ .t insert end "times with a bit left on the last line."
+ .t yview insert
+ update
+ .t count -update -ypixels 1.0 end
+ set scrollInfo
+} {0.5 1.0}
test textDisp-19.11 {GetYView procedure} {
.t configure -wrap word
.t delete 1.0 end
@@ -2071,8 +2163,134 @@ test textDisp-19.11 {GetYView procedure} {
.t insert end "times with a bit left on the last line."
.t yview insert
update
+ .t count -update -ypixels 1.0 end
set scrollInfo
-} {0.625 1}
+} {0.5 1.0}
+test textDisp-19.11.2 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines 1.0 end
+} {20}
+test textDisp-19.11.3 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines end 1.0
+} {-20}
+test textDisp-19.11.4 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines 1.1 1.3
+} {0}
+test textDisp-19.11.5 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines 16.0 16.1
+} {0}
+test textDisp-19.11.5.1 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines 16.0 16.5
+} {0}
+test textDisp-19.11.6 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines 16.0 16.20
+} {1}
+test textDisp-19.11.7 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines 16.0 16.40
+} {2}
+test textDisp-19.11.8 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines "16.0 displaylineend +1c" "16.0 lineend"
+} {3}
+test textDisp-19.11.9 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines 16.0 "16.0 lineend"
+} {4}
+test textDisp-19.11.10 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines 16.0 "16.0 +4displaylines"
+} {4}
+test textDisp-19.11.11 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines 16.0 "16.0 +2displaylines"
+} {2}
+test textDisp-19.11.12 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t count -displaylines "16.0 +1displayline" "16.0 +2displaylines -1c"
+} {0}
+.t tag configure elide -elide 1
+test textDisp-19.11.13 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "16.0 +1displaylines" "16.0 +1displaylines +6c"
+ .t count -displaylines 16.0 "16.0 +4displaylines"
+} {4}
+test textDisp-19.11.14 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "16.0 +1displaylines" "16.0 +1displaylines displaylineend"
+ .t count -displaylines 16.0 "16.0 +4displaylines"
+} {4}
+test textDisp-19.11.15 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "16.0 +1displaylines" "16.0 +2displaylines"
+ .t count -displaylines 16.0 "16.0 +4displaylines -1c"
+} {3}
+test textDisp-19.11.15 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "16.0 +1displaylines" "16.0 +2displaylines"
+ .t count -displaylines 16.0 "16.0 +4displaylines"
+} {4}
+test textDisp-19.11.16 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "12.0" "14.0"
+ .t count -displaylines 12.0 16.0
+} {2}
+test textDisp-19.11.17 {TextWidgetCmd procedure, "index +displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "12.0" "14.0"
+ list [.t index "11.5 +2d lines"] \
+ [.t index "12.0 +2d lines"] [.t index "11.0 +2d lines"] \
+ [.t index "13.0 +2d lines"] [.t index "13.1 +3d lines"] \
+ [.t index "13.0 +4d lines"]
+} {15.5 16.0 15.0 16.0 16.15 16.33}
+test textDisp-19.11.18 {TextWidgetCmd procedure, "index +displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "12.0" "14.0"
+ list [.t index "15.5 -2d lines"] \
+ [.t index "16.0 -2d lines"] [.t index "15.0 -2d lines"] \
+ [.t index "16.0 -3d lines"] [.t index "16.17 -4d lines"] \
+ [.t index "16.36 -5d lines"]
+} {11.5 14.0 11.0 11.0 11.2 11.3}
+test textDisp-19.11.19 {TextWidgetCmd procedure, "count -displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "12.0" "16.0 +1displaylines"
+ .t count -displaylines 12.0 17.0
+} {4}
+test textDisp-19.11.20 {TextWidgetCmd procedure, "index +displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "12.0" "16.0 +1displaylines"
+ list [.t index "11.5 +2d lines"] \
+ [.t index "12.0 +2d lines"] [.t index "11.0 +2d lines"] \
+ [.t index "13.0 +2d lines"] [.t index "13.0 +3d lines"] \
+ [.t index "13.0 +4d lines"]
+} {16.38 16.50 16.33 16.50 16.67 17.0}
+test textDisp-19.11.21 {TextWidgetCmd procedure, "index +displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "12.0" "16.0 +1displaylines"
+ list [.t index "16.38 -2d lines"] \
+ [.t index "16.50 -3d lines"] [.t index "16.33 -2d lines"] \
+ [.t index "16.53 -4d lines"] [.t index "16.69 -4d lines"] \
+ [.t index "17.1 -5d lines"]
+} {11.5 11.0 11.0 10.3 11.2 11.0}
+test textDisp-19.11.22 {TextWidgetCmd procedure, "index +displaylines"} {
+ .t tag remove elide 1.0 end
+ list [.t index "end +5d lines"] \
+ [.t index "end -3d lines"] [.t index "1.0 -2d lines"] \
+ [.t index "1.0 +4d lines"] [.t index "1.0 +50d lines"] \
+ [.t index "end -50d lines"]
+} {17.0 16.33 1.0 5.0 17.0 1.0}
+test textDisp-19.11.23 {TextWidgetCmd procedure, "index +displaylines"} {
+ .t tag remove elide 1.0 end
+ .t tag add elide "12.3" "16.0 +1displaylines"
+ list [.t index "11.5 +2d lines"] \
+ [.t index "12.0 +2d lines"] [.t index "11.0 +2d lines"] \
+ [.t index "13.0 +2d lines"] [.t index "13.0 +3d lines"] \
+ [.t index "13.0 +4d lines"]
+} {16.21 16.33 16.16 16.50 16.67 17.0}
+.t tag remove elide 1.0 end
+test textDisp-19.11.24 {TextWidgetCmd procedure, "index +/-displaylines"} {
+ list [.t index "11.5 + -1 display lines"] \
+ [.t index "11.5 + +1 disp lines"] \
+ [.t index "11.5 - -1 disp lines"] \
+ [.t index "11.5 - +1 disp lines"] \
+ [.t index "11.5 -1 disp lines"] \
+ [.t index "11.5 +1 disp lines"] \
+ [.t index "11.5 +0 disp lines"]
+} {10.5 12.5 12.5 10.5 10.5 12.5 11.5}
+.t tag remove elide 1.0 end
test textDisp-19.12 {GetYView procedure, partially visible last line} {
catch {destroy .top}
toplevel .top
@@ -2080,12 +2298,13 @@ test textDisp-19.12 {GetYView procedure, partially visible last line} {
text .top.t -width 40 -height 5
pack .top.t -expand yes -fill both
.top.t insert end "Line 1\nLine 2\nLine 3\nLine 4\nLine 5"
- update
+ # Need to wait for asychronous calculations to complete.
+ update ; after 10
scan [wm geom .top] %dx%d twidth theight
wm geom .top ${twidth}x[expr $theight - 3]
update
.top.t yview
-} {0 0.8}
+} {0.0 0.9625}
test textDisp-19.13 {GetYView procedure, partially visible last line} {fonts} {
catch {destroy .top}
toplevel .top
@@ -2109,7 +2328,8 @@ test textDisp-19.14 {GetYView procedure} {
}
.t insert end "\nThis last line wraps around four "
.t insert end "times with a bit left on the last line."
- update
+ # Need to update so everything is calculated.
+ update ; .t count -update -ypixels 1.0 end
set scrollInfo "unchanged"
.t mark set insert 3.0
.t tag configure x -background red
@@ -2143,9 +2363,30 @@ test textDisp-19.15 {GetYView procedure} {
"error "scrolling error""
(procedure "scrollError" line 2)
invoked from within
-"scrollError 0 1"
+"scrollError 0.0 1.0"
(vertical scrolling command executed by text)} NONE}
+test textDisp-19.16 {count -ypixels} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ .t insert end "\nThis last line wraps around four "
+ .t insert end "times with a bit left on the last line."
+ # Need to update so everything is calculated.
+ update
+ set res {}
+ lappend res \
+ [.t count -ypixels 1.0 end] \
+ [.t count -update -ypixels 1.0 end] \
+ [.t count -ypixels 15.0 16.0] \
+ [.t count -ypixels 15.0 "16.0 displaylineend +1c"] \
+ [.t count -ypixels 16.0 "16.0 displaylineend +1c"] \
+ [.t count -ypixels "16.0 +1 displaylines" "16.0 +4 displaylines +3c"]
+} {300 300 15 30 15 45}
+
.t delete 1.0 end
.t insert end "Line 1"
for {set i 2} {$i <= 200} {incr i} {
@@ -2862,6 +3103,127 @@ test textDisp-29.3 {miscellaneous: lines wrap but are still too long} {fonts} {
list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
} {{0.536667 1} 300x50+-156+18 {}}
+test textDisp-30.1 {elidden text complications} {knownBug} {
+ .t2.t delete 1.0 end
+ .t2.t insert 1.0 "1111\n2222\n3333"
+ .t2.t tag configure elidden -elide 1 -background red
+ .t2.t tag add elidden 1.2 3.2
+ # Known Bug: the newline at 1.4 will not be elidden.
+ # Each logical line must have its own DLines
+ .t2.t count -displaylines 1.0 end
+} {1}
+
+.t configure -height 1
+update
+
+test textDisp-31.1 {line embedded window height update} {
+ set res {}
+ .t delete 1.0 end
+ .t insert end "abcd\nefgh\nijkl\nmnop\nqrst\nuvwx\nyx"
+ frame .t.f -background red -width 100 -height 100
+ .t window create 3.0 -window .t.f
+ lappend res [.t count -update -ypixels 1.0 end]
+ .t.f configure -height 10
+ lappend res [.t count -ypixels 1.0 end]
+ lappend res [.t count -update -ypixels 1.0 end]
+ set res
+} {190 190 105}
+
+test textDisp-31.2 {line update index shifting} {
+ set res {}
+ .t.f configure -height 100
+ update
+ lappend res [.t count -update -ypixels 1.0 end]
+ .t.f configure -height 10
+ .t insert 1.0 "abc\n"
+ .t insert 1.0 "abc\n"
+ lappend res [.t count -ypixels 1.0 end]
+ lappend res [.t count -update -ypixels 1.0 end]
+ .t.f configure -height 100
+ .t delete 1.0 3.0
+ lappend res [.t count -ypixels 1.0 end]
+ lappend res [.t count -update -ypixels 1.0 end]
+ set res
+} {190 220 135 105 190}
+
+test textDisp-31.3 {line update index shifting} {
+ # Should do exactly the same as the above, as long
+ # as we are correctly tagging the correct lines for
+ # recalculation. The 'update' and 'delay' must be
+ # long enough to ensure all asynchronous updates
+ # have been performed.
+ set res {}
+ .t.f configure -height 100
+ update
+ lappend res [.t count -update -ypixels 1.0 end]
+ .t.f configure -height 10
+ .t insert 1.0 "abc\n"
+ .t insert 1.0 "abc\n"
+ lappend res [.t count -ypixels 1.0 end]
+ update ; after 1000 ; update
+ lappend res [.t count -ypixels 1.0 end]
+ .t.f configure -height 100
+ .t delete 1.0 3.0
+ lappend res [.t count -ypixels 1.0 end]
+ update ; after 1000 ; update
+ lappend res [.t count -ypixels 1.0 end]
+ set res
+} {190 220 135 105 190}
+
+test textDisp-31.4 {line embedded image height update} {
+ set res {}
+ image create photo textest -height 100 -width 10
+ .t delete 3.0
+ .t image create 3.0 -image textest
+ update
+ lappend res [.t count -update -ypixels 1.0 end]
+ textest configure -height 10
+ lappend res [.t count -ypixels 1.0 end]
+ lappend res [.t count -update -ypixels 1.0 end]
+ set res
+} {190 190 105}
+
+test textDisp-31.5 {line update index shifting} {
+ set res {}
+ textest configure -height 100
+ update ; after 1000 ; update
+ lappend res [.t count -update -ypixels 1.0 end]
+ textest configure -height 10
+ .t insert 1.0 "abc\n"
+ .t insert 1.0 "abc\n"
+ lappend res [.t count -ypixels 1.0 end]
+ lappend res [.t count -update -ypixels 1.0 end]
+ textest configure -height 100
+ .t delete 1.0 3.0
+ lappend res [.t count -ypixels 1.0 end]
+ lappend res [.t count -update -ypixels 1.0 end]
+ set res
+} {190 220 135 105 190}
+
+test textDisp-31.6 {line update index shifting} {
+ # Should do exactly the same as the above, as long
+ # as we are correctly tagging the correct lines for
+ # recalculation. The 'update' and 'delay' must be
+ # long enough to ensure all asynchronous updates
+ # have been performed.
+ set res {}
+ textest configure -height 100
+ update ; after 1000 ; update
+ lappend res [.t count -update -ypixels 1.0 end]
+ textest configure -height 10
+ .t insert 1.0 "abc\n"
+ .t insert 1.0 "abc\n"
+ lappend res [.t count -ypixels 1.0 end]
+ update ; after 1000 ; update
+ lappend res [.t count -ypixels 1.0 end]
+ textest configure -height 100
+ .t delete 1.0 3.0
+ lappend res [.t count -ypixels 1.0 end]
+ update ; after 1000 ; update
+ lappend res [.t count -ypixels 1.0 end]
+ set res
+} {190 220 135 105 190}
+
deleteWindows
option clear
diff --git a/tests/textImage.test b/tests/textImage.test
index 30cd6b7..3436875 100644
--- a/tests/textImage.test
+++ b/tests/textImage.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textImage.test,v 1.7 2003/05/19 21:19:52 dkf Exp $
+# RCS: @(#) $Id: textImage.test,v 1.8 2003/10/31 09:02:16 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -143,7 +143,7 @@ test textImage-1.15 {align argument checking} {
text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
pack .t
list [catch {.t image create end -image small -align wrong} msg] $msg
-} {1 {bad alignment "wrong": must be baseline, bottom, center, or top}}
+} {1 {bad align "wrong": must be baseline, bottom, center, or top}}
test textImage-1.16 {configure} {
catch {
@@ -302,7 +302,9 @@ test textImage-4.2 {alignment checking - baseline} {
.t image create end -image small -align baseline
.t insert end test
set result ""
- foreach size {10 15 20 30} {
+ # Sizes larger than 25 can be too big and lead to a negative 'norm',
+ # at least on Windows XP with certain settings.
+ foreach size {10 15 20 25} {
font configure test_font2 -size $size
array set Metrics [font metrics test_font2]
update
@@ -316,7 +318,7 @@ test textImage-4.2 {alignment checking - baseline} {
font delete test_font2
unset Metrics
set result
-} {{10 0} {15 0} {20 0} {30 0}}
+} {{10 0} {15 0} {20 0} {25 0}}
test textImage-4.3 {alignment and padding checking} {fonts} {
catch {
diff --git a/tests/textIndex.test b/tests/textIndex.test
index 0f9a468..1c53b17 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textIndex.test,v 1.9 2003/05/19 13:04:24 vincentdarley Exp $
+# RCS: @(#) $Id: textIndex.test,v 1.10 2003/10/31 09:02:17 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -695,6 +695,96 @@ test testIndex-18.1 {Object indices don't cache mark names} {
set res
} {3.4 3.0 1.0}
+frame .f -width 100 -height 20
+pack append . .f left
+
+set fixedFont {Courier -12}
+set fixedHeight [font metrics $fixedFont -linespace]
+set fixedWidth [font measure $fixedFont m]
+
+set varFont {Times -14}
+set bigFont {Helvetica -24}
+destroy .t
+text .t -font $fixedFont -width 20 -height 10 -wrap char
+pack append . .t {top expand fill}
+.t tag configure big -font $bigFont
+.t debug on
+wm geometry . {}
+
+# The statements below reset the main window; it's needed if the window
+# manager is mwm to make mwm forget about a previous minimum size setting.
+
+wm withdraw .
+wm minsize . 1 1
+wm positionfrom . user
+wm deiconify .
+update
+
+# Some window managers (like olwm under SunOS 4.1.3) misbehave in a way
+# that tends to march windows off the top and left of the screen. If
+# this happens, some tests will fail because parts of the window will
+# not need to be displayed (because they're off-screen). To keep this
+# from happening, move the window if it's getting near the left or top
+# edges of the screen.
+
+if {([winfo rooty .] < 50) || ([winfo rootx .] < 50)} {
+ wm geom . +50+50
+}
+
+set str [string repeat "hello " 20]
+
+.t insert end "$str one two three four five six seven height nine ten\n"
+.t insert end "$str one two three four five six seven height nine ten\n"
+.t insert end "$str one two three four five six seven height nine ten\n"
+
+test testIndex-19.1 {Display lines} {
+ .t index "2.7 displaylinestart"
+} {2.0}
+
+test testIndex-19.2 {Display lines} {
+ .t index "2.7 displaylineend"
+} {2.19}
+
+test testIndex-19.3 {Display lines} {
+ .t index "2.30 displaylinestart"
+} {2.20}
+
+test testIndex-19.4 {Display lines} {
+ .t index "2.30 displaylineend"
+} {2.39}
+
+test testIndex-19.5 {Display lines} {
+ .t index "2.40 displaylinestart"
+} {2.40}
+
+test testIndex-19.6 {Display lines} {
+ .t index "2.40 displaylineend"
+} {2.59}
+
+test testIndex-19.7 {Display lines} {
+ .t index "2.7 +1displaylines"
+} {2.27}
+
+test testIndex-19.8 {Display lines} {
+ .t index "2.7 -1displaylines"
+} {1.167}
+
+test testIndex-19.9 {Display lines} {
+ .t index "2.30 +1displaylines"
+} {2.50}
+
+test testIndex-19.10 {Display lines} {
+ .t index "2.30 -1displaylines"
+} {2.10}
+
+test testIndex-19.11 {Display lines} {
+ .t index "2.40 +1displaylines"
+} {2.60}
+
+test testIndex-19.12 {Display lines} {
+ .t index "2.40 -1displaylines"
+} {2.20}
+
# cleanup
rename textimage {}
catch {destroy .t}
diff --git a/tests/textWind.test b/tests/textWind.test
index ea60b89..6d60d54 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textWind.test,v 1.8 2003/09/30 08:45:46 patthoyts Exp $
+# RCS: @(#) $Id: textWind.test,v 1.9 2003/10/31 09:02:17 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -630,7 +630,7 @@ test textWind-13.1 {EmbWinBboxProc procedure} {
update
list [winfo geom .f] [.t bbox .f]
} {5x5+21+6 {21 6 5 5}}
-test textWind-13.2 {EmbWinBboxProc procedure} {
+test textWind-13.2 {EmbWinBboxProc procedure} {fonts} {
.t delete 1.0 end
.t insert 1.0 "Some sample text"
frame .f -width 5 -height 5 -bg $color
@@ -686,7 +686,7 @@ test textWind-13.8 {EmbWinBboxProc procedure} {fonts} {
update
list [winfo geom .f] [.t bbox .f]
} {5x11+21+6 {21 6 5 11}}
-test textWind-13.9 {EmbWinBboxProc procedure, spacing options} {
+test textWind-13.9 {EmbWinBboxProc procedure, spacing options} {fonts} {
.t configure -spacing1 5 -spacing3 2
.t delete 1.0 end
.t insert 1.0 "Some sample text"
@@ -736,7 +736,7 @@ test textWind-14.3 {EmbWinDelayedUnmap procedure} {
update
.t yview 2.0
set result [winfo ismapped .f]
- update
+ update ; after 10
list $result [winfo ismapped .f]
} {1 0}
test textWind-14.4 {EmbWinDelayedUnmap procedure} {