diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/text.test | 537 | ||||
-rw-r--r-- | tests/textImage.test | 22 | ||||
-rw-r--r-- | tests/textIndex.test | 25 | ||||
-rw-r--r-- | tests/textWind.test | 160 |
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 |