summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/text.test537
-rw-r--r--tests/textImage.test22
-rw-r--r--tests/textIndex.test25
-rw-r--r--tests/textWind.test160
4 files changed, 733 insertions, 11 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
diff --git a/tests/textImage.test b/tests/textImage.test
index 6b66a1a..8ef5033 100644
--- a/tests/textImage.test
+++ b/tests/textImage.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textImage.test,v 1.9 2004/05/23 17:34:49 dkf Exp $
+# RCS: @(#) $Id: textImage.test,v 1.10 2004/09/10 12:13:43 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -343,8 +343,26 @@ test textImage-4.3 {alignment and padding checking} {fonts} {
}
set result
} {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}}
-# cleanup
+test textImage-5.0 {peer widget images} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ image create photo large -width 50 -height 50
+ large put green -to 0 0 50 50
+ }
+ catch {destroy .t .tt}
+ pack [text .t]
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ .t image create end -image large
+ .t image create end -image small -padx 5 -pady 10
+ .t insert end test
+ update
+ destroy .t .tt
+} {}
+
+# cleanup
catch {destroy .t}
foreach image [image names] {image delete $image}
font delete test_font
diff --git a/tests/textIndex.test b/tests/textIndex.test
index b3cf64e..b4c7d11 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textIndex.test,v 1.13 2004/06/17 22:38:57 dkf Exp $
+# RCS: @(#) $Id: textIndex.test,v 1.14 2004/09/10 12:13:43 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -782,6 +782,29 @@ test textIndex-19.12 {Display lines} {
.t index "2.40 -1displaylines"
} {2.20}
+test textIndex-19.13 {Display lines} {
+ destroy .t
+ text .txt -height 1 -wrap word -yscroll ".sbar set" -width 400
+ scrollbar .sbar -command ".txt yview"
+ grid .txt .sbar -sticky news
+ grid configure .sbar -sticky ns
+ grid rowconfigure . 0 -weight 1
+ grid columnconfigure . 0 -weight 1
+ .txt configure -width 10
+ .txt tag config STAMP -elide 1
+ .txt tag config NICK-tick -elide 0
+ .txt insert end "+++++ Loading History ++++++++++++++++\n"
+ .txt mark set HISTORY {2.0 - 1 line}
+ .txt insert HISTORY { } STAMP
+ .txt insert HISTORY {tick } {NICK NICK-tick}
+ .txt insert HISTORY "\n" {NICK NICK-tick}
+ .txt insert HISTORY {[23:51] } STAMP
+ .txt insert HISTORY "\n" {NICK NICK-tick}
+ # Must not crash
+ .txt index "2.0 - 2 display lines"
+ destroy .txt .sbar
+} {}
+
proc text_test_word {startend chars start} {
destroy .t
text .t
diff --git a/tests/textWind.test b/tests/textWind.test
index 71a0354..8cea3ad 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textWind.test,v 1.17 2004/06/17 22:38:57 dkf Exp $
+# RCS: @(#) $Id: textWind.test,v 1.18 2004/09/10 12:13:43 vincentdarley Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -190,6 +190,7 @@ test textWind-2.18 {TkTextWindowCmd procedure} {
} {1 {unknown option "-gorp"} 0 1.0 1}
test textWind-2.19 {TkTextWindowCmd procedure} {
.t delete 1.0 end
+ catch {destroy .f}
frame .f -width 10 -height 6 -bg $color
list [catch {.t window create 1.0 -gorp -window .f stupid} msg] $msg \
[winfo exists .f] [.t index 1.end] [catch {.t index .f}]
@@ -408,6 +409,7 @@ proc bgerror args {
test textWind-10.1 {EmbWinLayoutProc procedure} {
.t delete 1.0 end
.t insert 1.0 "Some sample text"
+ destroy .f
.t window create 1.5 -create {
frame .f -width 10 -height 20 -bg $color
}
@@ -861,6 +863,162 @@ test textWind-16.4 {EmbWinTextStructureProc procedure} {
} {1 {47 5 30 20}}
pack .t
+test textWind-17.1 {peer widgets and embedded windows} {
+ catch {destroy .t .tt}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert end "Line 1"
+ frame .f -width 20 -height 10 -bg blue
+ .t window create 1.3 -window .f
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ update ; update
+ destroy .t .tt
+ winfo exists .f
+} {0}
+
+test textWind-17.2 {peer widgets and embedded windows} {
+ catch {destroy .t .f}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert end "Line 1\nLine 2"
+ frame .f -width 20 -height 10 -bg blue
+ .t window create 1.4 -window .f
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ update ; update
+ destroy .t
+ .tt.t insert 1.0 "foo"
+ update
+ destroy .tt
+} {}
+
+test textWind-17.3 {peer widget and -create} {
+ catch {destroy .t}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ update ; update
+ .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue}
+ update
+ destroy .t .tt
+} {}
+
+test textWind-17.4 {peer widget deleted one window shouldn't delete others} {
+ catch {destroy .t .tt}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue}
+ update ; update
+ destroy .tt
+ set res {}
+ lappend res [.t get 1.2]
+ update
+ lappend res [.t get 1.2]
+} {{} {}}
+
+test textWind-17.5 {peer widget window configuration} {
+ catch {destroy .t .tt}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue}
+ update ; update
+ set res [list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window]]
+ destroy .tt .t
+ set res
+} {.t.f .tt.t.f}
+
+test textWind-17.6 {peer widget window configuration} {
+ catch {destroy .t .tt}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ .t window create 1.2 -create {frame %W.f -width 10 -height 20 -bg blue}
+ update ; update
+ set res [list [.t window configure 1.2 -window] \
+ [.tt.t window configure 1.2 -window]]
+ destroy .tt .t
+ set res
+} {{-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}}
+
+test textWind-17.7 {peer widget window configuration} {
+ catch {destroy .t .tt}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue]
+ update ; update
+ set res [list [.t window cget 1.2 -window] [.tt.t window cget 1.2 -window]]
+ destroy .tt .t
+ set res
+} {.t.f {}}
+
+test textWind-17.8 {peer widget window configuration} {
+ catch {destroy .t .tt}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue]
+ update ; update
+ set res [list [.t window configure 1.2 -window] \
+ [.tt.t window configure 1.2 -window]]
+ destroy .tt .t
+ set res
+} {{-window {} {} {} .t.f} {-window {} {} {} {}}}
+
+test textWind-17.8 {peer widget window configuration} {
+ catch {destroy .t .tt}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue]
+ update ; update
+ .tt.t window configure 1.2 -window [frame .tt.t.f -width 10 -height 20 -bg red]
+ set res [list [.t window configure 1.2 -window] \
+ [.tt.t window configure 1.2 -window]]
+ destroy .tt .t
+ set res
+} {{-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}}
+
+test textWind-17.9 {peer widget window configuration} {
+ catch {destroy .t .tt}
+ pack [text .t]
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ toplevel .tt
+ pack [.t peer create .tt.t]
+ .t window create 1.2 -window [frame .t.f -width 10 -height 20 -bg blue]
+ .tt.t window create 1.2 -window [frame .tt.t.f -width 25 -height 20 -bg blue]
+ update ; update
+ .t window configure 1.2 -create \
+ {destroy %W.f ; frame %W.f -width 50 -height 7 -bg red}
+ .tt.t window configure 1.2 -window {}
+ .t window configure 1.2 -window {}
+ set res [list [.t window configure 1.2 -window] \
+ [.tt.t window configure 1.2 -window]]
+ update
+ lappend res [.t window configure 1.2 -window] \
+ [.tt.t window configure 1.2 -window]
+ destroy .tt .t
+ set res
+} {{-window {} {} {} {}} {-window {} {} {} {}} {-window {} {} {} .t.f} {-window {} {} {} .tt.t.f}}
+
catch {destroy .t}
option clear