summaryrefslogtreecommitdiffstats
path: root/tests/text.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/text.test')
-rw-r--r--tests/text.test537
1 files changed, 530 insertions, 7 deletions
diff --git a/tests/text.test b/tests/text.test
index 27c922c..63b43ce 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: text.test,v 1.31 2004/06/24 12:45:43 dkf Exp $
+# RCS: @(#) $Id: text.test,v 1.32 2004/09/10 12:13:43 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -114,7 +114,7 @@ test text-1.[incr i] {text options} {
lappend result [lindex $i 4]
}
set result
-} {1 blue {} {} 0 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 5 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 1 73 word {x scroll command} {test command}}
+} {1 blue {} {} 0 7 watch {} 0 {} fixed #012 5 #123 #234 0 {} green 45 100 47 2 5 3 82 raised #ffff01234567 21 yellow 0 0 0 0 {} disabled {1i 2i 3i 4i} {any old thing} 1 73 word {x scroll command} {test command}}
test text-2.1 {Tk_TextCmd procedure} {
list [catch {text} msg] $msg
@@ -151,7 +151,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, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, replace, scan, search, see, tag, window, xview, or yview}}
+} {1 {bad option "gorp": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}}
test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
list [catch {.t bbox} msg] $msg
@@ -219,7 +219,7 @@ test text-6.13 {TextWidgetCmd procedure, "compare" option} {
} {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}}
test text-6.14 {TextWidgetCmd procedure, "compare" option} {
list [catch {.t co 1.0 z 1.2} msg] $msg
-} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, replace, scan, search, see, tag, window, xview, or yview}}
+} {1 {ambiguous option "co": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}}
# "configure" option is already covered above
@@ -228,7 +228,7 @@ test text-7.1 {TextWidgetCmd procedure, "debug" option} {
} {1 {wrong # args: should be ".t debug boolean"}}
test text-7.2 {TextWidgetCmd procedure, "debug" option} {
list [catch {.t de 0 1} msg] $msg
-} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, replace, scan, search, see, tag, window, xview, or yview}}
+} {1 {ambiguous option "de": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}}
test text-7.3 {TextWidgetCmd procedure, "debug" option} {
.t debug true
.t deb
@@ -334,7 +334,8 @@ test text-8.19 {TextWidgetCmd procedure, "replace" option} {
list [catch {.t replace 2.1 2.3 foo} err] $err
} {0 {}}
.t delete 1.0 end; .t insert 1.0 $prevtext
-test text-8.20 {TextWidgetCmd procedure, "replace" option} {
+test text-8.20 {TextWidgetCmd procedure, "replace" option with undo} {
+ .t configure -undo 0
.t configure -undo 1
# Ensure it is treated as a single undo action
.t replace 2.1 2.3 foo
@@ -343,6 +344,90 @@ test text-8.20 {TextWidgetCmd procedure, "replace" option} {
string equal [.t get 1.0 end-1c] $prevtext
} {1}
+test text-8.21 {TextWidgetCmd procedure, "replace" option with undo} {
+ .t configure -undo 0
+ .t configure -undo 1
+ .t replace 2.1 2.3 foo
+ # Ensure we can override a text widget and intercept undo
+ # actions. If in the future a different mechanism is available
+ # to do this, then we should be able to change this test. The
+ # behaviour tested for here is not, strictly speaking, documented.
+ rename .t test.t
+ set res {}
+ proc .t {args} { lappend ::res $args ; uplevel 1 test.t $args }
+ .t edit undo
+ rename .t {}
+ rename test.t .t
+ .t configure -undo 0
+ set res
+} {{edit undo} {delete 2.1 2.4} {mark set insert 2.1} {see insert} {insert 2.1 ef} {mark set insert 2.3} {see insert}}
+
+test text-8.22 {TextWidgetCmd procedure, "replace" option with undo} {
+ .t configure -undo 0
+ .t configure -undo 1
+ # Ensure that undo (even composite undo like 'replace')
+ # works when the widget shows nothing useful.
+ .t replace 2.1 2.3 foo
+ .t configure -start 1 -end 1
+ .t edit undo
+ .t configure -start {} -end {}
+ .t configure -undo 0
+ if {![string equal [.t get 1.0 end-1c] $prevtext]} {
+ set res [list [.t get 1.0 end-1c] ne $prevtext]
+ } else {
+ set res 1
+ }
+} {1}
+
+.t delete 1.0 end; .t insert 1.0 $prevtext
+
+test text-8.23 {TextWidgetCmd procedure, "replace" option with peers, undo} {
+ .t configure -undo 0
+ .t configure -undo 1
+ .t peer create .tt -undo 1
+ # Ensure that undo (even composite undo like 'replace')
+ # works when the the event took place in one peer, which
+ # is then deleted, before the undo takes place in another peer.
+ .tt replace 2.1 2.3 foo
+ .tt configure -start 1 -end 1
+ destroy .tt
+ .t edit undo
+ .t configure -start {} -end {}
+ .t configure -undo 0
+ if {![string equal [.t get 1.0 end-1c] $prevtext]} {
+ set res [list [.t get 1.0 end-1c] ne $prevtext]
+ } else {
+ set res 1
+ }
+} {1}
+
+.t delete 1.0 end; .t insert 1.0 $prevtext
+
+test text-8.24 {TextWidgetCmd procedure, "replace" option with peers, undo} {
+ .t configure -undo 0
+ .t configure -undo 1
+ .t peer create .tt -undo 1
+ # Ensure that undo (even composite undo like 'replace')
+ # works when the the event took place in one peer, which
+ # is then deleted, before the undo takes place in another peer
+ # which isn't showing everything.
+ .tt replace 2.1 2.3 foo
+ set res [.tt get 2.1 2.4]
+ .tt configure -start 1 -end 1
+ destroy .tt
+ .t configure -start 3 -end 4
+ # msg will actually be set to a silently ignored error message here,
+ # (that the .tt command doesn't exist), but that is not important.
+ lappend res [catch {.t edit undo} msg]
+ .t configure -undo 0
+ .t configure -start {} -end {}
+ if {![string equal [.t get 1.0 end-1c] $prevtext]} {
+ lappend res [list [.t get 1.0 end-1c] ne $prevtext]
+ } else {
+ lappend res 1
+ }
+} {foo 0 1}
+
.t delete 1.0 end; .t insert 1.0 $prevtext
test text-9.1 {TextWidgetCmd procedure, "get" option} {
@@ -741,7 +826,7 @@ test text-10.2 {TextWidgetCmd procedure, "index" option} {
} {1 {wrong # args: should be ".t index index"}}
test text-10.3 {TextWidgetCmd procedure, "index" option} {
list [catch {.t in a b} msg] $msg
-} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, replace, scan, search, see, tag, window, xview, or yview}}
+} {1 {ambiguous option "in": must be bbox, cget, compare, configure, count, debug, delete, dlineinfo, dump, edit, get, image, index, insert, mark, peer, replace, scan, search, see, tag, window, xview, or yview}}
test text-10.4 {TextWidgetCmd procedure, "index" option} {
list [catch {.t index @xyz} msg] $msg
} {1 {bad text index "@xyz"}}
@@ -2974,6 +3059,444 @@ test text-28.0 {repeated insert and scroll} {
set result 1
} {1}
+test text-29.0 {peer widgets} {
+ destroy .t .tt
+ toplevel .tt
+ pack [text .t]
+ pack [.t peer create .tt.t]
+ destroy .t .tt
+} {}
+
+test text-29.1 {peer widgets} {
+ destroy .t .t1 .t2
+ toplevel .t1
+ toplevel .t2
+ pack [text .t]
+ pack [.t peer create .t1.t]
+ pack [.t peer create .t2.t]
+ .t insert end "abcd\nabcd"
+ update
+ destroy .t1
+ update
+ .t insert end "abcd\nabcd"
+ update
+ destroy .t .t2
+ update
+} {}
+
+test text-29.2 {peer widgets} {
+ destroy .t .t1 .t2
+ toplevel .t1
+ toplevel .t2
+ pack [text .t]
+ pack [.t peer create .t1.t]
+ pack [.t peer create .t2.t]
+ .t insert end "abcd\nabcd"
+ update
+ destroy .t
+ update
+ .t2.t insert end "abcd\nabcd"
+ update
+ destroy .t .t2
+ update
+} {}
+
+test text-29.3 {peer widgets} {
+ destroy .t .tt
+ toplevel .tt
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ pack [.t peer create .tt.t -start 5 -end 11]
+ update
+ destroy .t .tt
+} {}
+
+test text-29.4 {peer widgets} {
+ destroy .t .tt
+ toplevel .tt
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ pack [.t peer create .tt.t -start 5 -end 11]
+ pack [.tt.t peer create .tt.t2]
+ set res [list [.tt.t index end] [.tt.t2 index end]]
+ update
+ destroy .t .tt
+ set res
+} {7.0 7.0}
+
+test text-29.4.1 {peer widgets} {
+ destroy .t .tt
+ toplevel .tt
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ pack [.t peer create .tt.t -start 5 -end 11]
+ pack [.tt.t peer create .tt.t2 -start {} -end {}]
+ set res [list [.tt.t index end] [.tt.t2 index end]]
+ update
+ destroy .t .tt
+ set res
+} {7.0 21.0}
+
+test text-29.5 {peer widgets} {
+ destroy .t .tt
+ toplevel .tt
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ pack [.t peer create .tt.t -start 5 -end 11]
+ update ; update
+ set p1 [.tt.t count -update -ypixels 1.0 end]
+ set p2 [.t count -update -ypixels 5.0 11.0]
+ if {$p1 == $p2} {
+ set res "ok"
+ } else {
+ set res "$p1 and $p2 not equal"
+ }
+ destroy .t .tt
+ set res
+} {ok}
+
+test text-29.6 {peer widgets} {
+ destroy .t .tt
+ toplevel .tt
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ pack [.t peer create .tt.t -start 5 -end 11]
+ update ; update
+ .t delete 3.0 6.0
+ set res [.tt.t index end]
+ destroy .t .tt
+ set res
+} {6.0}
+
+test text-29.7 {peer widgets} {
+ destroy .t .tt
+ toplevel .tt
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ pack [.t peer create .tt.t -start 5 -end 11]
+ update ; update
+ .t delete 8.0 12.0
+ set res [.tt.t index end]
+ destroy .t .tt
+ set res
+} {4.0}
+
+test text-29.8 {peer widgets} {
+ destroy .t .tt
+ toplevel .tt
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ pack [.t peer create .tt.t -start 5 -end 11]
+ update ; update
+ .t delete 3.0 13.0
+ set res [.tt.t index end]
+ destroy .t .tt
+ set res
+} {1.0}
+
+test text-29.9 {peer widgets} {
+ destroy .t
+ pack [text .t]
+ for {set i 1} {$i < 100} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ .t tag add sel 1.0 end-1c
+ set res {}
+ lappend res [.t tag ranges sel]
+ .t configure -start 10 -end 20
+ lappend res [.t tag ranges sel]
+ destroy .t
+ set res
+} {{1.0 100.0} {1.0 11.0}}
+
+test text-29.10 {peer widgets} {
+ destroy .t
+ pack [text .t]
+ for {set i 1} {$i < 100} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ .t tag add sel 1.0 end-1c
+ set res {}
+ lappend res [.t tag ranges sel]
+ .t configure -start 11
+ lappend res [.t tag ranges sel]
+ destroy .t
+ set res
+} {{1.0 100.0} {1.0 90.0}}
+
+test text-29.11 {peer widgets} {
+ destroy .t
+ pack [text .t]
+ for {set i 1} {$i < 100} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ .t tag add sel 1.0 end-1c
+ set res {}
+ lappend res [.t tag ranges sel]
+ .t configure -end 90
+ lappend res [.t tag ranges sel]
+ destroy .t
+ set res
+} {{1.0 100.0} {1.0 90.0}}
+
+test text-29.12 {peer widgets} {
+ destroy .t
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ .t tag add sel 1.0 3.0 5.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0
+ set res {}
+ lappend res [.t tag prevrange sel 1.0]
+ .t configure -start 6 -end 12
+ lappend res [.t tag ranges sel]
+ lappend res "next" [.t tag nextrange sel 4.0] \
+ [.t tag nextrange sel 5.0] [.t tag nextrange sel 6.0] \
+ [.t tag nextrange sel 7.0]
+ lappend res "prev" [.t tag prevrange sel 1.0] \
+ [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \
+ [.t tag prevrange sel 4.0]
+ destroy .t
+ set res
+} {{} {1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}}
+
+test text-29.13 {peer widgets} {
+ destroy .t
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ .t tag add sel 1.0 3.0 9.0 11.0 13.0 15.0 17.0 19.0
+ set res {}
+ .t configure -start 6 -end 12
+ lappend res [.t tag ranges sel]
+ lappend res "next" [.t tag nextrange sel 4.0] \
+ [.t tag nextrange sel 5.0] [.t tag nextrange sel 6.0] \
+ [.t tag nextrange sel 7.0]
+ lappend res "prev" [.t tag prevrange sel 1.0] \
+ [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \
+ [.t tag prevrange sel 4.0]
+ destroy .t
+ set res
+} {{4.0 6.0} next {4.0 6.0} {} {} {} prev {} {} {} {}}
+
+test text-29.14 {peer widgets} {
+ destroy .t
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ .t tag add sel 1.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0
+ set res {}
+ .t configure -start 6 -end 12
+ lappend res [.t tag ranges sel]
+ lappend res "next" [.t tag nextrange sel 4.0] \
+ [.t tag nextrange sel 5.0] [.t tag nextrange sel 6.0] \
+ [.t tag nextrange sel 7.0]
+ lappend res "prev" [.t tag prevrange sel 1.0] \
+ [.t tag prevrange sel 2.0] [.t tag prevrange sel 3.0] \
+ [.t tag prevrange sel 4.0]
+ destroy .t
+ set res
+} {{1.0 2.0 4.0 6.0} next {4.0 6.0} {} {} {} prev {} {1.0 2.0} {1.0 2.0} {1.0 2.0}}
+
+test text-29.15 {peer widgets} {
+ destroy .t
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ set res {}
+ .t tag add sel 1.0 11.0
+ lappend res [.t tag ranges sel]
+ lappend res [catch {.t configure -start 15 -end 10}]
+ lappend res [.t tag ranges sel]
+ .t configure -start 6 -end 12
+ lappend res [.t tag ranges sel]
+ .t configure -start {} -end {}
+ lappend res [.t tag ranges sel]
+ destroy .t
+ set res
+} {{1.0 11.0} 1 {1.0 11.0} {1.0 6.0} {1.0 11.0}}
+
+test text-29.16 {peer widgets} {
+ destroy .t
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ set res {}
+ .t tag add sel 1.0 11.0
+ lappend res [.t index sel.first]
+ lappend res [.t index sel.last]
+ destroy .t
+ set res
+} {1.0 11.0}
+
+test text-29.17 {peer widgets} {
+ destroy .t
+ pack [text .t]
+ for {set i 1} {$i < 20} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ set res {}
+ .t tag delete sel
+ set res [list [catch {.t index sel.first} msg] $msg]
+ destroy .t
+ set res
+} {1 {text doesn't contain any characters tagged with "sel"}}
+
+proc makeText {} {
+ set w .g
+ set font "Times 11"
+ destroy .g
+ toplevel .g
+ frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken
+ set t $w.f.text
+ text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \
+ -height 35 -wrap word -highlightthickness 0 -borderwidth 0
+ pack $t -expand yes -fill both
+ scrollbar $w.scroll -command "$t yview"
+ pack $w.scroll -side right -fill y
+ pack $w.f -expand yes -fill both
+ $t tag configure center -justify center -spacing1 5m -spacing3 5m
+ $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \
+ -spacing1 3m -spacing2 0 -spacing3 0
+ for {set i 0} {$i < 40} {incr i} {
+ $t insert end "${i}word "
+ }
+ return $t
+}
+
+test text-30.1 {line heights on creation} {
+ set w [makeText]
+ update ; after 1000 ; update
+ set before [$w count -ypixels 1.0 2.0]
+ $w insert 1.0 "a"
+ update
+ set after [$w count -ypixels 1.0 2.0]
+ destroy .g
+ if {$before != $after} {
+ set res "Count changed: $before $after"
+ } else {
+ set res "ok"
+ }
+} {ok}
+
+destroy .t
+text .t
+test text-31.1 {TextWidgetCmd procedure, "peer" option} {
+ list [catch {.t peer foo 1} msg] $msg
+} {1 {bad peer option "foo": must be create or names}}
+test text-31.2 {TextWidgetCmd procedure, "peer" option} {
+ list [catch {.t peer names foo} msg] $msg
+} {1 {wrong # args: should be ".t peer names"}}
+test text-31.3 {TextWidgetCmd procedure, "peer" option} {
+ list [catch {.t p names} msg] $msg
+} {0 {}}
+test text-31.4 {TextWidgetCmd procedure, "peer" option} {
+ .t peer names
+} {}
+test text-31.5 {TextWidgetCmd procedure, "peer" option} {
+ list [catch {.t peer create foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test text-31.6 {TextWidgetCmd procedure, "peer" option} {
+ .t peer create .t2
+ set res {}
+ lappend res [.t peer names]
+ lappend res [.t2 peer names]
+ destroy .t2
+ lappend res [.t peer names]
+} {.t2 .t {}}
+test text-31.7 {peer widget -start, -end} {
+ set res [list [catch {.t configure -start 10 -end 5} msg] $msg]
+ .t configure -start {} -end {}
+ set res
+} {0 {}}
+test text-31.8 {peer widget -start, -end} {
+ .t delete 1.0 end
+ for {set i 1} {$i < 100} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ list [catch {.t configure -start 10 -end 5} msg] $msg
+} {1 {-startline must be less than or equal to -endline}}
+test text-31.9 {peer widget -start, -end} {
+ .t delete 1.0 end
+ for {set i 1} {$i < 100} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ set res [list [catch {.t configure -start 5 -end 10} msg] $msg]
+ .t configure -start {} -end {}
+ set res
+} {0 {}}
+
+test text-31.10 {peer widget -start, -end} {
+ .t delete 1.0 end
+ for {set i 1} {$i < 100} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ set res [.t index end]
+ lappend res [catch {.t configure -start 5 -end 10 -tab foo}]
+ lappend res [.t index end]
+ lappend res [catch {.t configure -tab foo -start 15 -end 20}]
+ lappend res [.t index end]
+ .t configure -start {} -end {}
+ lappend res [.t index end]
+ set res
+} {101.0 1 101.0 1 101.0 101.0}
+
+test text-31.11 {peer widget -start, -end} {
+ .t delete 1.0 end
+ for {set i 1} {$i < 100} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ set res [.t index end]
+ lappend res [catch {.t configure -start 5 -end 15}]
+ lappend res [.t index end]
+ lappend res [catch {.t configure -start 10 -end 40}]
+ lappend res [.t index end]
+ .t configure -start {} -end {}
+ lappend res [.t index end]
+ set res
+} {101.0 0 11.0 0 31.0 101.0}
+
+test text-32.1 {peer widget -start, -end and selection} {
+ .t delete 1.0 end
+ for {set i 1} {$i < 100} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ .t tag add sel 10.0 20.0
+ set res {}
+ lappend res [.t tag ranges sel]
+ .t configure -start 5 -end 30
+ lappend res [.t tag ranges sel]
+ .t configure -start 5 -end 15
+ lappend res [.t tag ranges sel]
+ .t configure -start 15 -end 30
+ lappend res [.t tag ranges sel]
+ .t configure -start 15 -end 16
+ lappend res [.t tag ranges sel]
+ .t configure -start 25 -end 30
+ lappend res [.t tag ranges sel]
+ .t configure -start {} -end {}
+ lappend res [.t tag ranges sel]
+ set res
+} {{10.0 20.0} {6.0 16.0} {6.0 11.0} {1.0 6.0} {1.0 2.0} {} {10.0 20.0}}
+
deleteWindows
option clear