summaryrefslogtreecommitdiff
path: root/tk/tests/text.test
diff options
context:
space:
mode:
Diffstat (limited to 'tk/tests/text.test')
-rw-r--r--tk/tests/text.test262
1 files changed, 234 insertions, 28 deletions
diff --git a/tk/tests/text.test b/tk/tests/text.test
index e002c7e43b5..730a3182927 100644
--- a/tk/tests/text.test
+++ b/tk/tests/text.test
@@ -8,11 +8,12 @@
#
# RCS: @(#) $Id$
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
-
-eval destroy [winfo child .]
+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]
+tcltest::loadTestedCommands
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
@@ -51,6 +52,7 @@ catch {destroy .t2}
text .t2
set i 0
foreach test {
+ {-autoseparators yes 1 nah}
{-background #ff00ff #ff00ff <gorp>}
{-bd 4 4 foo}
{-bg blue blue #xx}
@@ -69,6 +71,7 @@ foreach test {
{-insertofftime 100 100 2.4}
{-insertontime 47 47 e1}
{-insertwidth 2.3 2 47d}
+ {-maxundo 5 5 noway}
{-padx 3.4 3 2.4.}
{-pady 82 82 bogus}
{-relief raised raised bumpy}
@@ -83,6 +86,7 @@ foreach test {
{-spacing3 -10 0 bogus}
{-state d disabled foo}
{-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
+ {-undo 1 1 eh}
{-width 73 73 2.4}
{-wrap w word bad_wrap}
} {
@@ -111,7 +115,7 @@ test text-1.[incr i] {text options} {
lappend result [lindex $i 4]
}
set result
-} {blue {} {} 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 73 word {x scroll command} {test command}}
+} {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}}
test text-2.1 {Tk_TextCmd procedure} {
list [catch {text} msg] $msg
@@ -150,7 +154,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, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+} {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}}
test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
list [catch {.t bbox} msg] $msg
@@ -218,7 +222,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, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+} {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}}
# "configure" option is already covered above
@@ -227,7 +231,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, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+} {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}}
test text-7.3 {TextWidgetCmd procedure, "debug" option} {
.t debug true
.t deb
@@ -240,10 +244,10 @@ test text-7.4 {TextWidgetCmd procedure, "debug" option} {
test text-8.1 {TextWidgetCmd procedure, "delete" option} {
list [catch {.t delete} msg] $msg
-} {1 {wrong # args: should be ".t delete index1 ?index2?"}}
+} {1 {wrong # args: should be ".t delete index1 ?index2 ...?"}}
test text-8.2 {TextWidgetCmd procedure, "delete" option} {
list [catch {.t delete a b c} msg] $msg
-} {1 {wrong # args: should be ".t delete index1 ?index2?"}}
+} {1 {bad text index "a"}}
test text-8.3 {TextWidgetCmd procedure, "delete" option} {
list [catch {.t delete @x 2.2} msg] $msg
} {1 {bad text index "@x"}}
@@ -251,11 +255,11 @@ test text-8.4 {TextWidgetCmd procedure, "delete" option} {
list [catch {.t delete 2.3 @y} msg] $msg
} {1 {bad text index "@y"}}
test text-8.5 {TextWidgetCmd procedure, "delete" option} {
- .t con -state disabled
+ .t configure -state disabled
.t delete 2.3
.t g 2.0 2.end
} abcdefghijklm
-.t con -state normal
+.t configure -state normal
test text-8.6 {TextWidgetCmd procedure, "delete" option} {
.t delete 2.3
.t get 2.0 2.end
@@ -264,13 +268,71 @@ test text-8.7 {TextWidgetCmd procedure, "delete" option} {
.t delete 2.1 2.3
.t get 2.0 2.end
} aefghijklm
+test text-8.8 {TextWidgetCmd procedure, "delete" option} {
+ # All indices are checked before we actually delete anything
+ list [catch {.t delete 2.1 2.3 foo} msg] $msg \
+ [.t get 2.0 2.end]
+} {1 {bad text index "foo"} aefghijklm}
+set prevtext [.t get 1.0 end-1c]
+test text-8.9 {TextWidgetCmd procedure, "delete" option} {
+ # auto-forward one byte if the last "pair" is just one
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.1 2.3 2.3
+ .t get 1.0 end-1c
+} foo\naefghijklm
+test text-8.10 {TextWidgetCmd procedure, "delete" option} {
+ # all indices will be ordered before deletion
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.3 2.7 2.9 2.4
+ .t get 1.0 end-1c
+} foo\ndfgjklm
+test text-8.11 {TextWidgetCmd procedure, "delete" option} {
+ # and check again with even pairs
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.2 2.7 2.9 2.4 2.5
+ .t get 1.0 end-1c
+} foo\ncdfgjklm
+test text-8.12 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the longest range on equal start indices
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.2 2.0 2.5 2.0 2.3 2.8 2.7
+ .t get 1.0 end-1c
+} foo\nfghijklm
+test text-8.13 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the longest range on equal start indices
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.2 1.2 2.6 2.0 2.5
+ .t get 1.0 end-1c
+} foghijklm
+test text-8.14 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the longest range on equal start indices
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.2 2.0 2.5 1.1 2.3 2.8 2.7
+ .t get 1.0 end-1c
+} ffghijklm
+test text-8.15 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the watch for overlapping ranges - they should
+ # essentially be merged into one span.
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .t delete 2.0 2.6 2.2 2.8
+ .t get 1.0 end-1c
+} foo\nijklm
+test text-8.16 {TextWidgetCmd procedure, "delete" option} {
+ # we should get the watch for overlapping ranges - they should
+ # essentially be merged into one span.
+ .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
+ .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-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 index1 ?index2 ...?"}}
test text-9.2 {TextWidgetCmd procedure, "get" option} {
list [catch {.t get a b c} msg] $msg
-} {1 {wrong # args: should be ".t get index1 ?index2?"}}
+} {1 {bad text index "a"}}
test text-9.3 {TextWidgetCmd procedure, "get" option} {
list [catch {.t get @q 3.1} msg] $msg
} {1 {bad text index "@q"}}
@@ -301,6 +363,25 @@ test text-9.9 {TextWidgetCmd procedure, "get" option} {
test text-9.10 {TextWidgetCmd procedure, "get" option} {
.t get 5.2 5.4
} {y }
+test text-9.11 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4 5.4
+} {{y } G}
+test text-9.12 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4 5.4 5.5
+} {{y } G}
+test text-9.13 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4 5.5 "5.5+5c"
+} {{y } {Irl .}}
+test text-9.14 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4 5.4 5.5 end-3c
+} {{y } G { }}
+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.17 {TextWidgetCmd procedure, "get" option} {
+ list [catch {.t get 5.2 5.4 5.5 foo} msg] $msg
+} {1 {bad text index "foo"}}
test text-10.1 {TextWidgetCmd procedure, "index" option} {
list [catch {.t index} msg] $msg
@@ -310,7 +391,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, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+} {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}}
test text-10.4 {TextWidgetCmd procedure, "index" option} {
list [catch {.t index @xyz} msg] $msg
} {1 {bad text index "@xyz"}}
@@ -369,7 +450,7 @@ test text-11.10 {TextWidgetCmd procedure, "insert" option} {
list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly]
} {{First second} {1.0 1.5} {1.5 1.12}}
-# Mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere.
+# Edit, mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere.
test text-12.1 {ConfigureText procedure} {
list [catch {.t2 configure -state foobar} msg] $msg
@@ -964,7 +1045,7 @@ test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} {
test text-20.36 {TextSearchCmd procedure, regexp finds empty lines} {
# Test for fix of bug #1643
.t insert end "\n"
- tkTextSetCursor .t 4.0
+ tk::TextSetCursor .t 4.0
.t search -forward -regexp {^$} insert end
} {4.0}
@@ -1111,13 +1192,13 @@ test text-20.65 {TextSearchCmd, unicode with non-text segments} {
} {1.3 3}
test text-20.66 {TextSearchCmd, hidden text does not affect match index} {
- eval destroy [winfo child .]
+ deleteWindows
pack [text .t2]
.t2 insert end "12345H7890"
.t2 search 7 1.0
} 1.6
test text-20.67 {TextSearchCmd, hidden text does not affect match index} {
- eval destroy [winfo child .]
+ deleteWindows
pack [text .t2]
.t2 insert end "12345H7890"
.t2 tag configure hidden -elide true
@@ -1125,13 +1206,13 @@ test text-20.67 {TextSearchCmd, hidden text does not affect match index} {
.t2 search 7 1.0
} 1.6
test text-20.68 {TextSearchCmd, hidden text does not affect match index} {
- eval destroy [winfo child .]
+ deleteWindows
pack [text .t2]
.t2 insert end "foobar\nbarbaz\nbazboo"
.t2 search boo 1.0
} 3.3
test text-20.69 {TextSearchCmd, hidden text does not affect match index} {
- eval destroy [winfo child .]
+ deleteWindows
pack [text .t2]
.t2 insert end "foobar\nbarbaz\nbazboo"
.t2 tag configure hidden -elide true
@@ -1164,7 +1245,7 @@ test text-20.72 {TextSearchCmd, -regexp -nocase searches} {
set res
} 1.0
-eval destroy [winfo child .]
+deleteWindows
text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
pack .t2
.t2 insert end "1\t2\t3\t4\t55.5"
@@ -1202,7 +1283,7 @@ test text-21.7 {TkTextGetTabs procedure} {
list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg
} {1 {bad screen distance "!44"}}
-eval destroy [winfo child .]
+deleteWindows
text .t
pack .t
.t insert 1.0 "One Line"
@@ -1343,7 +1424,7 @@ test text-22.26 {TextDumpCmd procedure, unicode characters} {
} "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6"
set l [interp hidden]
-eval destroy [winfo children .]
+deleteWindows
test text-23.1 {text widget vs hidden commands} {
catch {destroy .t}
@@ -1362,11 +1443,137 @@ test text-24.1 {bug fix - 1642} {
.t insert end "line 3\n"
.t insert end "line 4\n"
.t insert end "line 5\n"
- tkTextSetCursor .t 3.0
+ tk::TextSetCursor .t 3.0
.t search -backward -regexp "\$" insert 1.0
} {2.6}
-eval destroy [winfo child .]
+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}}
+
+test text-25.3 {TextEditUndo procedure, undoing changes} {
+ catch {destroy .t}
+ text .t -undo 1
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "should be gone after undo\n"
+ .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
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "should be back after redo\n"
+ .t edit undo
+ .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
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "should be back after redo\n"
+ .t edit reset
+ 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
+ pack .t
+ .t insert end "line 1\n"
+ .t edit separator
+ .t insert end "line 2\n"
+ .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
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "line 2\n"
+ .t edit undo
+ .t get 1.0 end
+} "\n"
+
+test text-25.8 {TextEditCmd procedure, modified flag} {
+ catch {destroy .t}
+ text .t
+ pack .t
+ .t insert end "line 1\n"
+ .t edit modified
+} {1}
+
+test text-25.9 {TextEditCmd procedure, reset modified flag} {
+ catch {destroy .t}
+ text .t
+ pack .t
+ .t insert end "line 1\n"
+ .t edit modified 0
+ .t edit modified
+} {0}
+
+test text-25.10 {TextEditCmd procedure, set modified flag} {
+ catch {destroy .t}
+ text .t
+ pack .t
+ .t edit modified 1
+ .t edit modified
+} {1}
+
+test text-25.11 {<<Modified>> virtual event} {
+ set ::retval unmodified
+ catch {destroy .t}
+ text .t -undo 1
+ pack .t
+ bind .t <<Modified>> "set ::retval modified"
+ update idletasks
+ .t insert end "nothing special\n"
+ set ::retval
+} {modified}
+
+test text-25.12 {<<Selection>> virtual event} {
+ set ::retval no_selection
+ catch {destroy .t}
+ text .t -undo 1
+ pack .t
+ bind .t <<Selection>> "set ::retval selection_changed"
+ update idletasks
+ .t insert end "nothing special\n"
+ .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
+ pack .t
+ .t insert end "line 1\n"
+ .t delete 1.4 1.6
+ .t insert end "line 2\n"
+ catch {.t edit undo}
+ catch {.t edit undo}
+ catch {.t edit undo}
+ .t get 1.0 end
+} "line 1\n\n"
+
+deleteWindows
option clear
# cleanup
@@ -1385,4 +1592,3 @@ return
-
View Lorry Controller Status