summaryrefslogtreecommitdiffstats
path: root/tests/text.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/text.test')
-rw-r--r--tests/text.test1262
1 files changed, 1262 insertions, 0 deletions
diff --git a/tests/text.test b/tests/text.test
new file mode 100644
index 0000000..3bd5a09
--- /dev/null
+++ b/tests/text.test
@@ -0,0 +1,1262 @@
+# This file is a Tcl script to test the code in the file tkText.c.
+# This file is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) text.test 1.46 97/10/13 15:18:31
+
+if {[string compare test [info procs test]] == 1} then \
+ {source defs}
+
+eval destroy [winfo child .]
+
+# Create entries in the option database to be sure that geometry options
+# like border width have predictable values.
+
+option add *Text.borderWidth 2
+option add *Text.highlightThickness 2
+option add *Text.font {Courier -12}
+
+text .t -width 20 -height 10
+pack append . .t {top expand fill}
+update
+.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 .
+
+entry .t.e
+.t.e insert end abcdefg
+.t.e select from 0
+
+.t insert 1.0 "Line 1
+abcdefghijklm
+12345
+Line 4
+bOy GIrl .#@? x_yz
+!@#$%
+Line 7"
+
+catch {destroy .t2}
+text .t2
+set i 0
+foreach test {
+ {-background #ff00ff #ff00ff <gorp>}
+ {-bd 4 4 foo}
+ {-bg blue blue #xx}
+ {-borderwidth 7 7 ++}
+ {-cursor watch watch lousy}
+ {-exportselection no 0 maybe}
+ {-fg red red stupid}
+ {-font fixed fixed {}}
+ {-foreground #012 #012 bogus}
+ {-height 5 5 bad}
+ {-highlightbackground #123 #123 bogus}
+ {-highlightcolor #234 #234 bogus}
+ {-highlightthickness -2 0 bad}
+ {-insertbackground green green <bogus>}
+ {-insertborderwidth 45 45 bogus}
+ {-insertofftime 100 100 2.4}
+ {-insertontime 47 47 e1}
+ {-insertwidth 2.3 2 47d}
+ {-padx 3.4 3 2.4.}
+ {-pady 82 82 bogus}
+ {-relief raised raised bumpy}
+ {-selectbackground #ffff01234567 #ffff01234567 bogus}
+ {-selectborderwidth 21 21 3x}
+ {-selectforeground yellow yellow #12345}
+ {-spacing1 20 20 1.3x}
+ {-spacing1 -5 0 bogus}
+ {-spacing2 5 5 bogus}
+ {-spacing2 -1 0 bogus}
+ {-spacing3 20 20 bogus}
+ {-spacing3 -10 0 bogus}
+ {-state disabled disabled foo}
+ {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
+ {-width 73 73 2.4}
+ {-wrap word word bad_wrap}
+} {
+ test text-1.[incr i] {text options} {
+ set result {}
+ lappend result [catch {.t2 configure [lindex $test 0] [lindex $test 3]}]
+ .t2 configure [lindex $test 0] [lindex $test 1]
+ lappend result [.t2 cget [lindex $test 0]]
+ } [list 1 [lindex $test 2]]
+}
+test text-1.[incr i] {text options} {
+ .t2 configure -takefocus "any old thing"
+ .t2 cget -takefocus
+} {any old thing}
+test text-1.[incr i] {text options} {
+ .t2 configure -xscrollcommand "x scroll command"
+ .t2 configure -xscrollcommand
+} {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}}
+test text-1.[incr i] {text options} {
+ .t2 configure -yscrollcommand "test command"
+ .t2 configure -yscrollcommand
+} {-yscrollcommand yScrollCommand ScrollCommand {} {test command}}
+test text-1.[incr i] {text options} {
+ set result {}
+ foreach i [.t2 configure] {
+ 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}}
+
+test text-2.1 {Tk_TextCmd procedure} {
+ list [catch {text} msg] $msg
+} {1 {wrong # args: should be "text pathName ?options?"}}
+test text-2.2 {Tk_TextCmd procedure} {
+ list [catch {text foobar} msg] $msg
+} {1 {bad window path name "foobar"}}
+test text-2.3 {Tk_TextCmd procedure} {
+ catch {destroy .t2}
+ list [catch {text .t2 -gorp nofun} msg] $msg [winfo exists .t2]
+} {1 {unknown option "-gorp"} 0}
+test text-2.4 {Tk_TextCmd procedure} {
+ catch {destroy .t2}
+ list [catch {text .t2 -bd 2 -fg red} msg] $msg \
+ [lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4]
+} {0 .t2 2 red}
+if {$tcl_platform(platform) == "macintosh"} {
+ set relief solid
+} elseif {$tcl_platform(platform) == "windows"} {
+ set relief flat
+} else {
+ set relief raised
+}
+test text-2.5 {Tk_TextCmd procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 tag cget sel -relief
+} $relief
+test text-2.6 {Tk_TextCmd procedure} {
+ catch {destroy .t2}
+ list [text .t2] [winfo class .t2]
+} {.t2 Text}
+
+test text-3.1 {TextWidgetCmd procedure, basics} {
+ list [catch {.t} msg] $msg
+} {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, 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
+} {1 {wrong # args: should be ".t bbox index"}}
+test text-4.2 {TextWidgetCmd procedure, "bbox" option} {
+ list [catch {.t bbox a b} msg] $msg
+} {1 {wrong # args: should be ".t bbox index"}}
+test text-4.3 {TextWidgetCmd procedure, "bbox" option} {
+ list [catch {.t bbox bad_mark} msg] $msg
+} {1 {bad text index "bad_mark"}}
+
+test text-5.1 {TextWidgetCmd procedure, "cget" option} {
+ list [catch {.t cget} msg] $msg
+} {1 {wrong # args: should be ".t cget option"}}
+test text-5.2 {TextWidgetCmd procedure, "cget" option} {
+ list [catch {.t cget a b} msg] $msg
+} {1 {wrong # args: should be ".t cget option"}}
+test text-5.3 {TextWidgetCmd procedure, "cget" option} {
+ list [catch {.t cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test text-5.4 {TextWidgetCmd procedure, "cget" option} {
+ .t configure -bd 17
+ .t cget -bd
+} {17}
+.t configure -bd [lindex [.t configure -bd] 3]
+
+test text-6.1 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare a b} msg] $msg
+} {1 {wrong # args: should be ".t compare index1 op index2"}}
+test text-6.2 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare a b c d} msg] $msg
+} {1 {wrong # args: should be ".t compare index1 op index2"}}
+test text-6.3 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare @x == 1.0} msg] $msg
+} {1 {bad text index "@x"}}
+test text-6.4 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare 1.0 < @y} msg] $msg
+} {1 {bad text index "@y"}}
+test text-6.5 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 < 1.0] [.t compare 1.1 < 1.1] [.t compare 1.1 < 1.2]
+} {0 0 1}
+test text-6.6 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 <= 1.0] [.t compare 1.1 <= 1.1] [.t compare 1.1 <= 1.2]
+} {0 1 1}
+test text-6.7 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 == 1.0] [.t compare 1.1 == 1.1] [.t compare 1.1 == 1.2]
+} {0 1 0}
+test text-6.8 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 >= 1.0] [.t compare 1.1 >= 1.1] [.t compare 1.1 >= 1.2]
+} {1 1 0}
+test text-6.9 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 > 1.0] [.t compare 1.1 > 1.1] [.t compare 1.1 > 1.2]
+} {1 0 0}
+test text-6.10 {TextWidgetCmd procedure, "compare" option} {
+ list [.t com 1.1 != 1.0] [.t compare 1.1 != 1.1] [.t compare 1.1 != 1.2]
+} {1 0 1}
+test text-6.11 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare 1.0 <x 1.2} msg] $msg
+} {1 {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=}}
+test text-6.12 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare 1.0 >> 1.2} msg] $msg
+} {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}}
+test text-6.13 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare 1.0 z 1.2} msg] $msg
+} {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, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+
+# "configure" option is already covered above
+
+test text-7.1 {TextWidgetCmd procedure, "debug" option} {
+ list [catch {.t debug 0 1} msg] $msg
+} {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, 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
+} 1
+test text-7.4 {TextWidgetCmd procedure, "debug" option} {
+ .t debug false
+ .t debug
+} 0
+.t debug
+
+test text-8.1 {TextWidgetCmd procedure, "delete" option} {
+ list [catch {.t delete} msg] $msg
+} {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?"}}
+test text-8.3 {TextWidgetCmd procedure, "delete" option} {
+ list [catch {.t delete @x 2.2} msg] $msg
+} {1 {bad text index "@x"}}
+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 delete 2.3
+ .t g 2.0 2.end
+} abcdefghijklm
+.t con -state normal
+test text-8.6 {TextWidgetCmd procedure, "delete" option} {
+ .t delete 2.3
+ .t get 2.0 2.end
+} abcefghijklm
+test text-8.7 {TextWidgetCmd procedure, "delete" option} {
+ .t delete 2.1 2.3
+ .t get 2.0 2.end
+} aefghijklm
+
+test text-9.1 {TextWidgetCmd procedure, "get" option} {
+ list [catch {.t get} msg] $msg
+} {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?"}}
+test text-9.3 {TextWidgetCmd procedure, "get" option} {
+ list [catch {.t get @q 3.1} msg] $msg
+} {1 {bad text index "@q"}}
+test text-9.4 {TextWidgetCmd procedure, "get" option} {
+ list [catch {.t get 3.1 @r} msg] $msg
+} {1 {bad text index "@r"}}
+test text-9.5 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.7 5.3
+} {}
+test text-9.6 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.3 5.5
+} { G}
+test text-9.7 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.3 end
+} { GIrl .#@? x_yz
+!@#$%
+Line 7
+}
+.t mark set a 5.3
+.t mark set b 5.3
+.t mark set c 5.5
+test text-9.8 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.7
+} {y GIr}
+test text-9.9 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2
+} {y}
+test text-9.10 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4
+} {y }
+
+test text-10.1 {TextWidgetCmd procedure, "index" option} {
+ list [catch {.t index} msg] $msg
+} {1 {wrong # args: should be ".t index index"}}
+test text-10.2 {TextWidgetCmd procedure, "index" option} {
+ list [catch {.t ind a b} msg] $msg
+} {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, 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"}}
+test text-10.5 {TextWidgetCmd procedure, "index" option} {
+ .t index 1.2
+} 1.2
+
+test text-11.1 {TextWidgetCmd procedure, "insert" option} {
+ list [catch {.t insert 1.2} msg] $msg
+} {1 {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"}}
+test text-11.2 {TextWidgetCmd procedure, "insert" option} {
+ .t config -state disabled
+ .t insert 1.2 xyzzy
+ .t get 1.0 1.end
+} {Line 1}
+.t config -state normal
+test text-11.3 {TextWidgetCmd procedure, "insert" option} {
+ .t insert 1.2 xyzzy
+ .t get 1.0 1.end
+} {Lixyzzyne 1}
+test text-11.4 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text" x
+ .t tag ranges x
+} {1.0 1.11}
+test text-11.5 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text" x
+ .t insert 1.2 "XYZ" y
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.0 1.2 1.5 1.14} {1.2 1.5}}
+test text-11.6 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text" {x y z}
+ list [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
+} {{1.0 1.11} {1.0 1.11} {1.0 1.11}}
+test text-11.7 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text" {x y z}
+ .t insert 1.3 "A" {a b z}
+ list [.t tag ranges a] [.t tag ranges b] [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
+} {{1.3 1.4} {1.3 1.4} {1.0 1.3 1.4 1.12} {1.0 1.3 1.4 1.12} {1.0 1.12}}
+test text-11.8 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ list [catch {.t insert 1.0 "Sample text" "a \{b"} msg] $msg
+} {1 {unmatched open brace in list}}
+test text-11.9 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "First" bold " " {} second "x y z" " third"
+ list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges x] \
+ [.t tag ranges y] [.t tag ranges z]
+} {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}}
+test text-11.10 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "First" bold " second" silly
+ 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.
+
+test text-12.1 {ConfigureText procedure} {
+ list [catch {.t2 configure -state foobar} msg] $msg
+} {1 {bad state value "foobar": must be normal or disabled}}
+test text-12.2 {ConfigureText procedure} {
+ .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1
+ list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
+} {0 1 1}
+test text-12.3 {ConfigureText procedure} {
+ .t2 configure -spacing1 1 -spacing2 -1 -spacing3 1
+ list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
+} {1 0 1}
+test text-12.4 {ConfigureText procedure} {
+ .t2 configure -spacing1 1 -spacing2 1 -spacing3 -3
+ list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
+} {1 1 0}
+test text-12.5 {ConfigureText procedure} {
+ set x [list [catch {.t2 configure -tabs {30 foo}} msg] $msg $errorInfo]
+ .t2 configure -tabs {10 20 30}
+ set x
+} {1 {bad tab alignment "foo": must be left, right, center, or numeric} {bad tab alignment "foo": must be left, right, center, or numeric
+ (while processing -tabs option)
+ invoked from within
+".t2 configure -tabs {30 foo}"}}
+test text-12.6 {ConfigureText procedure} {
+ .t2 configure -tabs {10 20 30}
+ .t2 configure -tabs {}
+ .t2 cget -tabs
+} {}
+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}}
+test text-12.8 {ConfigureText procedure} {
+ .t2 configure -selectborderwidth 17 -selectforeground #332211 \
+ -selectbackground #abc
+ list [lindex [.t2 tag config sel -borderwidth] 4] \
+ [lindex [.t2 tag config sel -foreground] 4] \
+ [lindex [.t2 tag config sel -background] 4]
+} {17 #332211 #abc}
+test text-12.9 {ConfigureText procedure} {
+ .t2 configure -selectborderwidth {}
+ .t2 tag cget sel -borderwidth
+} {}
+test text-12.10 {ConfigureText procedure} {
+ list [catch {.t2 configure -selectborderwidth foo} msg] $msg
+} {1 {bad screen distance "foo"}}
+test text-12.11 {ConfigureText procedure} {
+ catch {destroy .t2}
+ .t.e select to 2
+ text .t2 -exportselection 1
+ selection get
+} {ab}
+test text-12.12 {ConfigureText procedure} {
+ catch {destroy .t2}
+ .t.e select to 2
+ text .t2 -exportselection 0
+ .t2 insert insert 1234657890
+ .t2 tag add sel 1.0 1.4
+ selection get
+} {ab}
+test text-12.13 {ConfigureText procedure} {
+ catch {destroy .t2}
+ .t.e select to 1
+ text .t2 -exportselection 1
+ .t2 insert insert 1234657890
+ .t2 tag add sel 1.0 1.4
+ selection get
+} {1234}
+test text-12.14 {ConfigureText procedure} {
+ catch {destroy .t2}
+ .t.e select to 1
+ text .t2 -exportselection 0
+ .t2 insert insert 1234657890
+ .t2 tag add sel 1.0 1.4
+ .t2 configure -exportselection 1
+ selection get
+} {1234}
+test text-12.15 {ConfigureText procedure} {
+ catch {destroy .t2}
+ text .t2 -exportselection 1
+ .t2 insert insert 1234657890
+ .t2 tag add sel 1.0 1.4
+ set result [selection get]
+ .t2 configure -exportselection 0
+ lappend result [catch {selection get} msg] $msg
+} {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
+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
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ update
+ wm geometry .t2
+} {150x140+0+0}
+test text-12.17 {ConfigureText procedure} {
+ # This test was failing Windows because the title bar on .t2
+ # 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
+ text .t2.t -width 20 -height 10 -setgrid 1
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ update
+ wm geometry .t2
+} {20x10+0+0}
+test text-12.18 {ConfigureText procedure} {
+ # This test was failing on Windows because the title bar on .t2
+ # 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
+ text .t2.t -width 20 -height 10 -setgrid 1
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ update
+ set result [wm geometry .t2]
+ wm geometry .t2 15x8
+ update
+ lappend result [wm geometry .t2]
+ .t2.t configure -wrap word
+ update
+ lappend result [wm geometry .t2]
+} {20x10+0+0 15x8+0+0 15x8+0+0}
+
+test text-13.1 {TextWorldChanged procedure, spacing options} fonts {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 10
+ set result [winfo reqheight .t2]
+ .t2 configure -spacing1 2
+ lappend result [winfo reqheight .t2]
+ .t2 configure -spacing3 1
+ lappend result [winfo reqheight .t2]
+ .t2 configure -spacing1 0
+ lappend result [winfo reqheight .t2]
+} {140 160 170 150}
+
+test text-14.1 {TextEventProc procedure} {
+ text .tx1 -bg #543210
+ rename .tx1 .tx2
+ set x {}
+ lappend x [winfo exists .tx1]
+ lappend x [.tx2 cget -bg]
+ destroy .tx1
+ lappend x [info command .tx*] [winfo exists .tx1] [winfo exists .tx2]
+} {1 #543210 {} 0 0}
+
+test text-15.1 {TextCmdDeletedProc procedure} {
+ text .tx1
+ rename .tx1 {}
+ list [info command .tx*] [winfo exists .tx1]
+} {{} 0}
+test text-15.2 {TextCmdDeletedProc procedure, disabling -setgrid} fonts {
+ catch {destroy .top}
+ toplevel .top
+ wm geom .top +0+0
+ text .top.t -setgrid 1 -width 20 -height 10
+ pack .top.t
+ update
+ set x [wm geometry .top]
+ rename .top.t {}
+ update
+ lappend x [wm geometry .top]
+ destroy .top
+ set x
+} {20x10+0+0 150x140+0+0}
+
+test text-16.1 {InsertChars procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 2.0 abcd\n
+ .t2 get 1.0 end
+} {abcd
+
+}
+test text-16.2 {InsertChars procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 abcd\n
+ .t2 insert end 123\n
+ .t2 get 1.0 end
+} {abcd
+123
+
+}
+test text-16.3 {InsertChars procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 abcd\n
+ .t2 insert 10.0 123
+ .t2 get 1.0 end
+} {abcd
+123
+}
+test text-16.4 {InsertChars procedure, inserting on top visible line} {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 4 -wrap word
+ pack .t2
+ .t2 insert insert "Now is the time for all great men to come to the "
+ .t2 insert insert "aid of their party.\n"
+ .t2 insert insert "Now is the time for all great men.\n"
+ .t2 see end
+ update
+ .t2 insert 1.0 "Short\n"
+ .t2 index @0,0
+} {2.56}
+test text-16.5 {InsertChars procedure, inserting on top visible line} {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 4 -wrap word
+ pack .t2
+ .t2 insert insert "Now is the time for all great men to come to the "
+ .t2 insert insert "aid of their party.\n"
+ .t2 insert insert "Now is the time for all great men.\n"
+ .t2 see end
+ update
+ .t2 insert 1.55 "Short\n"
+ .t2 index @0,0
+} {2.0}
+test text-16.6 {InsertChars procedure, inserting on top visible line} {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 4 -wrap word
+ pack .t2
+ .t2 insert insert "Now is the time for all great men to come to the "
+ .t2 insert insert "aid of their party.\n"
+ .t2 insert insert "Now is the time for all great men.\n"
+ .t2 see end
+ update
+ .t2 insert 1.56 "Short\n"
+ .t2 index @0,0
+} {1.56}
+test text-16.7 {InsertChars procedure, inserting on top visible line} {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 4 -wrap word
+ pack .t2
+ .t2 insert insert "Now is the time for all great men to come to the "
+ .t2 insert insert "aid of their party.\n"
+ .t2 insert insert "Now is the time for all great men.\n"
+ .t2 see end
+ update
+ .t2 insert 1.57 "Short\n"
+ .t2 index @0,0
+} {1.56}
+catch {destroy .t2}
+
+proc setup {} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1
+abcde
+12345
+Line 4"
+}
+
+.t delete 1.0 end
+test text-17.1 {DeleteChars procedure} {
+ .t get 1.0 end
+} {
+}
+test text-17.2 {DeleteChars procedure} {
+ list [catch {.t delete foobar} msg] $msg
+} {1 {bad text index "foobar"}}
+test text-17.3 {DeleteChars procedure} {
+ list [catch {.t delete 1.0 lousy} msg] $msg
+} {1 {bad text index "lousy"}}
+test text-17.4 {DeleteChars procedure} {
+ setup
+ .t delete 2.1
+ .t get 1.0 end
+} {Line 1
+acde
+12345
+Line 4
+}
+test text-17.5 {DeleteChars procedure} {
+ setup
+ .t delete 2.3
+ .t get 1.0 end
+} {Line 1
+abce
+12345
+Line 4
+}
+test text-17.6 {DeleteChars procedure} {
+ setup
+ .t delete 2.end
+ .t get 1.0 end
+} {Line 1
+abcde12345
+Line 4
+}
+test text-17.7 {DeleteChars procedure} {
+ setup
+ .t tag add sel 4.2 end
+ .t delete 4.2 end
+ list [.t tag ranges sel] [.t get 1.0 end]
+} {{} {Line 1
+abcde
+12345
+Li
+}}
+test text-17.8 {DeleteChars procedure} {
+ setup
+ .t tag add sel 1.0 end
+ .t delete 4.0 end
+ list [.t tag ranges sel] [.t get 1.0 end]
+} {{1.0 3.5} {Line 1
+abcde
+12345
+}}
+test text-17.9 {DeleteChars procedure} {
+ setup
+ .t delete 2.2 2.2
+ .t get 1.0 end
+} {Line 1
+abcde
+12345
+Line 4
+}
+test text-17.10 {DeleteChars procedure} {
+ setup
+ .t delete 2.3 2.1
+ .t get 1.0 end
+} {Line 1
+abcde
+12345
+Line 4
+}
+test text-17.11 {DeleteChars procedure} {
+ catch {destroy .t2}
+ toplevel .t2
+ text .t2.t -width 20 -height 5
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
+ update
+ .t2.t delete 1.0 3.0
+ list [.t2.t index @0,0] [.t2.t get @0,0]
+} {1.0 x}
+test text-17.12 {DeleteChars procedure} {
+ catch {destroy .t2}
+ toplevel .t2
+ text .t2.t -width 20 -height 5
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
+ .t2.t yview 3.0
+ update
+ .t2.t delete 2.0 4.0
+ list [.t2.t index @0,0] [.t2.t get @0,0]
+} {2.0 y}
+catch {destroy .t2}
+toplevel .t2
+text .t2.t -width 1 -height 10 -wrap char
+frame .t2.f -width 200 -height 20 -relief raised -bd 2
+pack .t2.f .t2.t -side left
+wm geometry .t2 +0+0
+update
+test text-17.13 {DeleteChars procedure, updates affecting topIndex} {
+ .t2.t delete 1.0 end
+ .t2.t insert end "abcde\n12345\nqrstuv"
+ .t2.t yview 2.1
+ .t2.t delete 1.4 2.3
+ .t2.t index @0,0
+} {1.2}
+test text-17.14 {DeleteChars procedure, updates affecting topIndex} {
+ .t2.t delete 1.0 end
+ .t2.t insert end "abcde\n12345\nqrstuv"
+ .t2.t yview 2.1
+ .t2.t delete 2.3 2.4
+ .t2.t index @0,0
+} {2.0}
+test text-17.15 {DeleteChars procedure, updates affecting topIndex} {
+ .t2.t delete 1.0 end
+ .t2.t insert end "abcde\n12345\nqrstuv"
+ .t2.t yview 1.3
+ .t2.t delete 1.0 1.2
+ .t2.t index @0,0
+} {1.1}
+test text-17.16 {DeleteChars procedure, updates affecting topIndex} {
+ catch {destroy .t2}
+ toplevel .t2
+ text .t2.t -width 6 -height 10 -wrap word
+ frame .t2.f -width 200 -height 20 -relief raised -bd 2
+ pack .t2.f .t2.t -side left
+ wm geometry .t2 +0+0
+ update
+ .t2.t insert end "abc def\n01 2345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n"
+ .t2.t yview 2.4
+ .t2.t delete 2.5
+ set x [.t2.t index @0,0]
+ .t2.t delete 2.5
+ list $x [.t2.t index @0,0]
+} {2.3 2.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} {
+ .t insert end $i.0$i.1$i.2$i.3$i.4\n
+}
+test text-18.1 {TextFetchSelection procedure} {
+ .t tag add sel 1.3 3.4
+ selection get
+} {a.1a.2a.3a.4
+b.0b.1b.2b.3b.4
+c.0c}
+test text-18.2 {TextFetchSelection procedure} {
+ .t tag add x 1.2
+ .t tag add x 1.4
+ .t tag add x 2.0
+ .t tag add x 2.3
+ .t tag remove sel 1.0 end
+ .t tag add sel 1.0 3.4
+ selection get
+} {a.0a.1a.2a.3a.4
+b.0b.1b.2b.3b.4
+c.0c}
+test text-18.3 {TextFetchSelection procedure} {
+ .t tag remove sel 1.0 end
+ .t tag add sel 13.3
+ selection get
+} {m}
+test text-18.4 {TextFetchSelection procedure} {
+ .t tag remove x 1.0 end
+ .t tag add sel 1.0 3.4
+ .t tag remove sel 1.0 end
+ .t tag add sel 1.2 1.5
+ .t tag add sel 2.4 3.1
+ .t tag add sel 10.0 10.end
+ .t tag add sel 13.3
+ selection get
+} {0a..1b.2b.3b.4
+cj.0j.1j.2j.3j.4m}
+set x ""
+for {set i 1} {$i < 200} {incr i} {
+ append x "This is line $i, padded to just about 53 characters.\n"
+}
+test text-18.5 {TextFetchSelection procedure, long selections} {
+ .t delete 1.0 end
+ .t insert end $x
+ .t tag add sel 1.0 end
+ selection get
+} $x\n
+
+test text-19.1 {TkTextLostSelection procedure} {unixOnly} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 "abc\ndef\nghijk\n1234"
+ .t2 tag add sel 1.2 3.3
+ .t.e select to 1
+ .t2 tag ranges sel
+} {}
+test text-19.2 {TkTextLostSelection procedure} {macOrPc} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 "abc\ndef\nghijk\n1234"
+ .t2 tag add sel 1.2 3.3
+ .t.e select to 1
+ .t2 tag ranges sel
+} {1.2 3.3}
+catch {destroy .t2}
+test text-19.3 {TkTextLostSelection procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 "abcdef\nghijk\n1234"
+ .t2 tag add sel 1.0 1.3
+ set x [selection get]
+ selection clear
+ lappend x [catch {selection get} msg] $msg
+ .t2 tag add sel 1.0 1.3
+ lappend x [selection get]
+} {abc 1 {PRIMARY selection doesn't exist or form "STRING" not defined} abc}
+
+.t delete 1.0 end
+.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 -forward, -backward, -exact, -regexp, -nocase, -count, or --}}
+test text-20.2 {TextSearchCmd procedure, -backwards option} {
+ .t search -backwards xyz 1.4
+} {1.1}
+test text-20.3 {TextSearchCmd procedure, -forwards option} {
+ .t search -forwards xyz 1.4
+} {1.5}
+test text-20.4 {TextSearchCmd procedure, -exact option} {
+ .t search -f -exact x. 1.0
+} {1.9}
+test text-20.5 {TextSearchCmd procedure, -regexp option} {
+ .t search -b -regexp x.z 1.4
+} {1.1}
+test text-20.6 {TextSearchCmd procedure, -count option} {
+ set length unmodified
+ list [.t search -count length x. 1.4] $length
+} {1.9 2}
+test text-20.7 {TextSearchCmd procedure, -count option} {
+ list [catch {.t search -count} msg] $msg
+} {1 {no value given for "-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
+} {2.13}
+test text-20.10 {TextSearchCmd procedure, -- option} {
+ .t search -- -forward 1.0
+} {2.4}
+test text-20.11 {TextSearchCmd procedure, argument parsing} {
+ list [catch {.t search abc} msg] $msg
+} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
+test text-20.12 {TextSearchCmd procedure, argument parsing} {
+ list [catch {.t search abc d e f} msg] $msg
+} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
+test text-20.13 {TextSearchCmd procedure, check index} {
+ list [catch {.t search abc gorp} msg] $msg
+} {1 {bad text index "gorp"}}
+test text-20.14 {TextSearchCmd procedure, startIndex == "end"} {
+ .t search non-existent end
+} {}
+test text-20.15 {TextSearchCmd procedure, startIndex == "end"} {
+ .t search non-existent end
+} {}
+test text-20.16 {TextSearchCmd procedure, bad stopIndex} {
+ list [catch {.t search abc 1.0 lousy} msg] $msg
+} {1 {bad text index "lousy"}}
+test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
+ list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
+} {2.13 {}}
+test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
+ list [catch {.t search -regexp a( 1.0} msg] $msg
+} {1 {couldn't compile regular expression pattern: unmatched ()}}
+test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
+ .t search -backwards BaR end 1.0
+} {2.23}
+test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
+ .t search -backwards \n end 1.0
+} {3.9}
+test text-20.21 {TextSearchCmd procedure, skip dummy last line} {
+ .t search \n end
+} {1.15}
+test text-20.22 {TextSearchCmd procedure, skip dummy last line} {
+ .t search -back \n 1.0
+} {3.9}
+test text-20.23 {TextSearchCmd procedure, extract line contents} {
+ .t tag add foo 1.2
+ .t tag add x 1.3
+ .t mark set silly 1.2
+ .t search xyz 3.6
+} {1.1}
+test text-20.24 {TextSearchCmd procedure, stripping newlines} {
+ .t search the\n 1.0
+} {1.12}
+test text-20.25 {TextSearchCmd procedure, stripping newlines} {
+ .t search -regexp the\n 1.0
+} {}
+test text-20.26 {TextSearchCmd procedure, stripping newlines} {
+ .t search -regexp {the$} 1.0
+} {1.12}
+test text-20.27 {TextSearchCmd procedure, stripping newlines} {
+ .t search -regexp \n 1.0
+} {}
+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}
+test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search -backwards xyz 1.6
+} {1.5}
+test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search -backwards xyz 1.5
+} {1.1}
+test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search xyz 1.5
+} {1.5}
+test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search xyz 1.6
+} {3.0}
+test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search {} 1.end
+} {1.15}
+test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search f 1.end
+} {2.0}
+test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search {} end
+} {1.0}
+catch {destroy .t2}
+toplevel .t2
+wm geometry .t2 +0+0
+text .t2.t -width 30 -height 10
+pack .t2.t
+.t2.t insert 1.0 "This is a line\nand this is another"
+.t2.t insert end "\nand this is yet another"
+frame .t2.f -width 20 -height 20 -bd 2 -relief raised
+.t2.t window create 2.5 -window .t2.f
+test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search his 2.6
+} {2.6}
+test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search this 2.6
+} {3.4}
+test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search is 2.6
+} {2.7}
+test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search his 2.7
+} {3.5}
+test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search -backwards "his is another" 2.6
+} {2.6}
+test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search -backwards "his is" 2.6
+} {1.1}
+destroy .t2
+test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search -backwards forw 2.5
+} {2.5}
+test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search forw 2.5
+} {2.5}
+test text-20.44 {TextSearchCmd procedure, firstChar and lastChar} {
+ catch {destroy .t2}
+ text .t2
+ list [.t2 search a 1.0] [.t2 search -backward a 1.0]
+} {{} {}}
+test text-20.45 {TextSearchCmd procedure, regexp match length} {
+ set length unchanged
+ list [.t search -regexp -count length x(.)(.*)z 1.1] $length
+} {1.1 7}
+test text-20.46 {TextSearchCmd procedure, regexp match length} {
+ set length unchanged
+ list [.t search -regexp -backward -count length fo* 2.5] $length
+} {2.0 3}
+test text-20.47 {TextSearchCmd procedure, checking stopIndex} {
+ list [.t search bar 2.1 2.13] [.t search bar 2.1 2.14] \
+ [.t search bar 2.12 2.14] [.t search bar 2.14 2.14]
+} {{} 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]
+} {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
+ frame .t.f3 -width 20 -height 20 -relief raised -bd 2
+ frame .t.f4 -width 20 -height 20 -relief raised -bd 2
+ .t window create 2.10 -window .t.f3
+ .t window create 2.8 -window .t.f2
+ .t window create 2.8 -window .t.f1
+ .t window create 2.1 -window .t.f4
+ set result ""
+ lappend result [.t search -count x forward 1.0] $x
+ lappend result [.t search -count x wa 1.0] $x
+ .t delete 2.1
+ .t delete 2.8 2.10
+ .t delete 2.10
+ set result
+} {2.6 10 2.11 2}
+test text-20.50 {TextSearchCmd procedure, error setting variable} {
+ catch {unset a}
+ set a 44
+ list [catch {.t search -count a(2) xyz 1.0} msg] $msg
+} {1 {can't set "a(2)": variable isn't array}}
+test text-20.51 {TextSearchCmd procedure, wrap-around} {
+ .t search -backwards xyz 1.1
+} {3.5}
+test text-20.52 {TextSearchCmd procedure, wrap-around} {
+ .t search -backwards xyz 1.1 1.0
+} {}
+test text-20.53 {TextSearchCmd procedure, wrap-around} {
+ .t search xyz 3.6
+} {1.1}
+test text-20.54 {TextSearchCmd procedure, wrap-around} {
+ .t search xyz 3.6 end
+} {}
+test text-20.55 {TextSearchCmd procedure, no match} {
+ .t search non_existent 3.5
+} {}
+test text-20.56 {TextSearchCmd procedure, no match} {
+ .t search -regexp non_existent 3.5
+} {}
+test text-20.57 {TextSearchCmd procedure, special cases} {
+ .t search -back x 1.1
+} {1.0}
+test text-20.58 {TextSearchCmd procedure, special cases} {
+ .t search -back x 1.0
+} {3.8}
+test text-20.59 {TextSearchCmd procedure, special cases} {
+ .t search \n {end-2c}
+} {3.9}
+test text-20.60 {TextSearchCmd procedure, special cases} {
+ .t search \n end
+} {1.15}
+test text-20.61 {TextSearchCmd procedure, special cases} {
+ .t search x 1.0
+} {1.0}
+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.
+
+ set p abcdefg1234567890
+ set p $p$p$p$p$p$p$p$p
+ set p $p$p$p$p$p
+ .t search -nocase $p 1.0
+} {}
+
+eval destroy [winfo child .]
+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}}
+test text-21.2 {TkTextGetTabs procedure} {
+ list [catch {.t2 configure -tabs xyz} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test text-21.3 {TkTextGetTabs procedure} {
+ .t2 configure -tabs {100 200}
+ update idletasks
+ list [lindex [.t2 bbox 1.2] 0] [lindex [.t2 bbox 1.4] 0]
+} {100 200}
+test text-21.4 {TkTextGetTabs procedure} {
+ .t2 configure -tabs {100 right 200 left 300 center 400 numeric}
+ update idletasks
+ list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
+ [lindex [.t2 bbox 1.4] 0] \
+ [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
+ [lindex [.t2 bbox 1.10] 0]
+} {100 200 300 400}
+test text-21.5 {TkTextGetTabs procedure} {
+ .t2 configure -tabs {105 r 205 l 305 c 405 n}
+ update idletasks
+ list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
+ [lindex [.t2 bbox 1.4] 0] \
+ [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
+ [lindex [.t2 bbox 1.10] 0]
+} {105 205 305 405}
+test text-21.6 {TkTextGetTabs procedure} {
+ list [catch {.t2 configure -tabs {100 left 200 lork}} msg] $msg
+} {1 {bad tab alignment "lork": must be left, right, center, or numeric}}
+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 .]
+text .t
+pack .t
+.t insert 1.0 "One Line"
+.t mark set insert 1.0
+
+test text-22.1 {TextDumpCmd procedure, bad args} {
+ list [catch {.t dump} msg] $msg
+} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
+test text-22.2 {TextDumpCmd procedure, bad args} {
+ list [catch {.t dump -all} msg] $msg
+} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
+test text-22.3 {TextDumpCmd procedure, bad args} {
+ list [catch {.t dump -command} msg] $msg
+} {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?}}
+test text-22.5 {TextDumpCmd procedure, bad args} {
+ list [catch {.t dump bogus} msg] $msg
+} {1 {bad text index "bogus"}}
+test text-22.6 {TextDumpCmd procedure, one index} {
+ .t dump -text 1.2
+} {text e 1.2}
+test text-22.7 {TextDumpCmd procedure, two indices} {
+ .t dump -text 1.0 1.end
+} {text {One Line} 1.0}
+test text-22.8 {TextDumpCmd procedure, "end" index} {
+ .t dump -text 1.end end
+} {text {
+} 1.8}
+test text-22.9 {TextDumpCmd procedure, same indices} {
+ .t dump 1.5 1.5
+} {}
+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
+} 1.0}
+test text-22.12 {TextDumpCmd procedure, span multiple lines} {
+ .t dump -text 1.5 3.end
+} {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
+.t mark set n 4.0
+.t mark set END end
+test text-22.13 {TextDumpCmd procedure, tags only} {
+ .t dump -tag 2.1 2.8
+} {}
+test text-22.14 {TextDumpCmd procedure, tags only} {
+ .t dump -tag 2.0 2.8
+} {tagon x 2.0}
+test text-22.15 {TextDumpCmd procedure, tags only} {
+ .t dump -tag 1.0 4.end
+} {tagon y 1.0 tagon x 2.0 tagoff x 2.8}
+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} {
+ .t dump -mark 1.1 1.8
+} {}
+test text-22.18 {TextDumpCmd procedure, marks only} {
+ .t dump -mark 2.0 2.8
+} {mark m 2.4}
+test text-22.19 {TextDumpCmd procedure, marks only} {
+ .t dump -mark 1.1 4.end
+} {mark m 2.4 mark n 4.0}
+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} {
+ .t insert end "-\n"
+}
+.t window create 100.0 -create { }
+test text-22.21 {TextDumpCmd procedure, windows only} {
+ .t dump -window 1.0 5.0
+} {window .hello 3.10}
+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"
+.t mark set insert 1.0
+.t mark set current 1.0
+.t tag add x 2.0 2.end
+.t mark set m 2.4
+proc Append {varName key value index} {
+ upvar #0 $varName x
+ lappend x $key $index $value
+}
+test text-22.23 {TextDumpCmd procedure, command script} {
+ set x {}
+ .t dump -command {Append x} -all 1.0 end
+ set x
+} {mark 1.0 current mark 1.0 insert text 1.0 {Line One
+} tagon 2.0 x text 2.0 Line mark 2.4 m text 2.4 { Two} tagoff 2.8 x text 2.8 {
+} text 3.0 {Line Three
+} text 4.0 {Line Four
+}}
+test text-22.24 {TextDumpCmd procedure, command script} {
+ set x {}
+ .t dump -mark -command {Append x} 1.0 end
+ set x
+} {mark 1.0 current mark 1.0 insert mark 2.4 m}
+catch {unset x}
+
+set l [interp hidden]
+eval destroy [winfo children .]
+
+test text-23.1 {text widget vs hidden commands} {
+ catch {destroy .t}
+ text .t
+ interp hide {} .t
+ destroy .t
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+eval destroy [winfo child .]
+option clear