diff options
Diffstat (limited to 'tests/text.test')
| -rw-r--r-- | tests/text.test | 1262 |
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 |