Initial revision

1 files changed, 492 insertions, 0 deletions

diff --git a/tests/canvText.test b/tests/canvText.test
new file mode 100644
index 0000000..b121c25
--- /dev/null
+++ b/tests/canvText.test
@@ -0,0 +1,492 @@
+# This file is a Tcl script to test out the procedures in tkCanvText.c,
+# which implement canvas "text" items.  It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1996-1997 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: @(#) canvText.test 1.8 97/06/24 13:34:16
+
+if {"[info procs test]" != "test"} {
+    source defs
+}
+
+foreach i [winfo children .] {
+    destroy $i
+}
+wm geometry . {}
+raise .
+
+canvas .c -width 400 -height 300 -bd 2 -relief sunken
+pack .c
+update
+
+set i 1
+.c create text 20 20 -tag test
+
+set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+set ay [font metrics $font -linespace]
+set ax [font measure $font 0]
+
+
+foreach test {
+    {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}}
+    {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}}
+    {-font {Times 40} {Times 40} {} {font "" doesn't exist}}
+    {-justify left left xyz {bad justification "xyz": must be left, right, or center}}
+    {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}}
+    {-tags {test a b c} {test a b c} {} {}}
+    {-text xyz xyz {} {}}
+    {-width 6 6 xyz {bad screen distance "xyz"}}
+} {
+    set name [lindex $test 0]
+    test canvText-1.$i {configuration options} {
+	.c itemconfigure test $name [lindex $test 1]
+	list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
+    } [list [lindex $test 2] [lindex $test 2]]
+    incr i
+    if {[lindex $test 3] != ""} {
+	test canvText-1.$i {configuration options} {
+	    list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
+	} [list 1 [lindex $test 4]]
+    }
+    incr i
+}
+test canvText-1.$i {configuration options} {
+    .c itemconfigure test -tags {test xyz}
+    .c itemcget xyz -tags
+} {test xyz}
+
+.c delete test
+.c create text 20 20 -tag test
+
+test canvText-2.1 {CreateText procedure: args} {
+    list [catch {.c create text} msg] $msg
+} {1 {wrong # args: should be ".c create text x y ?options?"}}
+test canvText-2.2 {CreateText procedure: args} {
+    list [catch {.c create text xyz 0} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test canvText-2.3 {CreateText procedure: args} {
+    list [catch {.c create text 0 xyz} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test canvText-2.4 {CreateText procedure: args} {
+    list [catch {.c create text 0 0 -xyz xyz} msg] $msg
+} {1 {unknown option "-xyz"}}
+test canvText-2.5 {CreateText procedure} {
+    .c create text 0 0 -tags x
+    set x [.c coords x]
+    .c delete x
+    set x
+} {0.0 0.0}
+
+focus -force .c
+.c focus test
+.c coords test 0 0
+update
+
+test canvText-3.1 {TextCoords procedure} {
+    .c coords test
+} {0.0 0.0}
+test canvText-3.2 {TextCoords procedure} {
+    list [catch {.c coords test xyz 0} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test canvText-3.3 {TextCoords procedure} {
+    list [catch {.c coords test 0 xyz} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test canvText-3.4 {TextCoords procedure} {
+    .c coords test 10 10
+    set result {}
+    foreach element [.c coords test] {
+	lappend result [format %.1f $element]
+    }
+    set result
+} {10.0 10.0}
+test canvText-3.5 {TextCoords procedure} {
+    list [catch {.c coords test 10} msg] $msg
+} {1 {wrong # coordinates: expected 0 or 2, got 1}}
+test canvText-3.6 {TextCoords procedure} {
+    list [catch {.c coords test 10 10 10} msg] $msg
+} {1 {wrong # coordinates: expected 0 or 2, got 3}}
+
+test canvText-4.1 {ConfigureText procedure} {
+    list [catch {.c itemconfig test -fill xyz} msg] $msg
+} {1 {unknown color name "xyz"}}
+test canvText-4.2 {ConfigureText procedure} {
+    .c itemconfig test -fill blue
+    .c itemcget test -fill
+} {blue}
+test canvText-4.3 {ConfigureText procedure: construct font gcs} {
+    .c itemconfig test -font "times 20" -fill black -stipple gray50
+    list [.c itemcget test -font] [.c itemcget test -fill] [.c itemcget test -stipple]
+} {{times 20} black gray50}
+test canvText-4.4 {ConfigureText procedure: construct cursor gc} {
+    .c itemconfig test -text "abcdefg"
+    .c select from test 2
+    .c select to test 4
+    .c icursor test 3
+
+    # Both black -> cursor becomes white.
+    .c config -insertbackground black
+    .c config -selectbackground black
+    .c itemconfig test -just left
+    update
+
+    # Both same color (and not black) -> cursor becomes black.
+    .c config -insertbackground red
+    .c config -selectbackground red
+    .c itemconfig test -just left
+    update
+} {}
+test canvText-4.5 {ConfigureText procedure: adjust selection} {
+    set x {}
+    .c itemconfig test -text "abcdefghi"
+    .c select from test 2
+    .c select to test 6
+    lappend x [selection get]
+    .c dchars test 1 end
+    lappend x [catch {selection get}]
+    .c insert test end "bcdefghi"
+    .c select from test 2
+    .c select to test 6
+    lappend x [selection get]
+    .c dchars test 4 end
+    lappend x [selection get]
+    .c insert test end "efghi"
+    .c select from test 6
+    .c select to test 2
+    lappend x [selection get]
+    .c dchars test 4 end
+    lappend x [selection get]
+} {cdefg 1 cdefg cd cdef cd}
+test canvText-4.6 {ConfigureText procedure: adjust cursor} {
+    .c itemconfig test -text "abcdefghi"
+    set x {}
+    .c icursor test 6
+    .c dchars test 4 end
+    .c index test insert
+} {4}
+
+test canvText-5.1 {ConfigureText procedure: adjust cursor} {
+    .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 -text "xyz"
+    .c delete x
+} {}
+
+test canvText-6.1 {ComputeTextBbox procedure} {fonts} {
+    .c itemconfig test -font $font -text 0
+    .c coords test 0 0
+    set x {}
+    lappend x [.c itemconfig test -anchor n; .c bbox test]
+    lappend x [.c itemconfig test -anchor nw; .c bbox test]
+    lappend x [.c itemconfig test -anchor w; .c bbox test]
+    lappend x [.c itemconfig test -anchor sw; .c bbox test]
+    lappend x [.c itemconfig test -anchor s; .c bbox test]
+    lappend x [.c itemconfig test -anchor se; .c bbox test]
+    lappend x [.c itemconfig test -anchor e; .c bbox test]
+    lappend x [.c itemconfig test -anchor ne; .c bbox test]
+    lappend x [.c itemconfig test -anchor center; .c bbox test]
+} "{[expr -$ax/2-1] 0 [expr $ax/2+1] $ay}\
+{-1 0 [expr $ax+1] $ay}\
+{-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]}\
+{-1 -$ay [expr $ax+1] 0}\
+{[expr -$ax/2-1] -$ay [expr $ax/2+1] 0}\
+{[expr -$ax-1] -$ay 1 0}\
+{[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]}\
+{[expr -$ax-1] 0 1 $ay}\
+{[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]}"
+
+focus .c
+.c focus test
+.c itemconfig test -text "abcd\nefghi\njklmnopq"
+test canvText-7.1 {DisplayText procedure: stippling} {
+    .c itemconfig test -stipple gray50
+    update
+    .c itemconfig test -stipple {}
+    update
+} {}
+test canvText-7.2 {DisplayText procedure: draw selection} {
+    .c select from test 0
+    .c select to test end
+    update
+    selection get
+} "abcd\nefghi\njklmnopq"
+test canvText-7.3 {DisplayText procedure: selection} {
+    .c select from test 0
+    .c select to test end
+    update
+    selection get
+} "abcd\nefghi\njklmnopq"
+test canvText-7.4 {DisplayText procedure: one line selection} {
+    .c select from test 2
+    .c select to test 3
+    update
+} {}
+test canvText-7.5 {DisplayText procedure: multi-line selection} {
+    .c select from test 2
+    .c select to test 12
+    update
+} {}
+test canvText-7.6 {DisplayText procedure: draw cursor} {
+    .c icursor test 3
+    update
+} {}
+test canvText-7.7 {DisplayText procedure: selected text different color} {
+    .c config -selectforeground blue
+    .c itemconfig test -anchor n
+    update
+} {}
+test canvText-7.8 {DisplayText procedure: not selected} {
+    .c select clear
+    update
+} {}
+
+test canvText-8.1 {TextInsert procedure: 0 length insert} {
+    .c insert test end {}
+} {}
+test canvText-8.2 {TextInsert procedure: before beginning/after end} {
+    # Can't test this because GetTextIndex filters out those numbers.
+} {}
+test canvText-8.3 {TextInsert procedure: inserting in a selected item} {
+    .c itemconfig test -text "abcdefg"
+    .c select from test 2
+    .c select to test 4
+    .c insert test 1 "xyz"
+    .c itemcget test -text
+} {axyzbcdefg}
+test canvText-8.4 {TextInsert procedure: inserting before selection} {
+    .c itemconfig test -text "abcdefg"
+    .c select from test 2
+    .c select to test 4
+    .c insert test 1 "xyz"
+    list [.c index test sel.first] [.c index test sel.last]
+} {5 7}
+test canvText-8.5 {TextInsert procedure: inserting in selection} {
+    .c itemconfig test -text "abcdefg"
+    .c select from test 2
+    .c select to test 4
+    .c insert test 3 "xyz"
+    list [.c index test sel.first] [.c index test sel.last]
+} {2 7}
+test canvText-8.6 {TextInsert procedure: inserting after selection} {
+    .c itemconfig test -text "abcdefg"
+    .c select from test 2
+    .c select to test 4
+    .c insert test 5 "xyz"
+    list [.c index test sel.first] [.c index test sel.last]
+} {2 4}
+test canvText-8.7 {TextInsert procedure: inserting in unselected item} {
+    .c itemconfig test -text "abcdefg"
+    .c select clear
+    .c insert test 5 "xyz"
+    .c itemcget test -text
+} {abcdexyzfg}
+test canvText-8.8 {TextInsert procedure: inserting before cursor} {
+    .c itemconfig test -text "abcdefg"
+    .c icursor test 3
+    .c insert test 2 "xyz"
+    .c index test insert
+} {6}
+test canvText-8.9 {TextInsert procedure: inserting after cursor} {
+    .c itemconfig test -text "abcdefg"
+    .c icursor test 3
+    .c insert test 4 "xyz"
+    .c index test insert
+} {3}
+
+test canvText-9.1 {TextInsert procedure: before beginning/after end} {
+    # Can't test this because GetTextIndex filters out those numbers.
+} {}
+test canvText-9.2 {TextInsert procedure: start > end} {
+    .c itemconfig test -text "abcdefg"
+    .c dchars test 4 2
+    .c itemcget test -text
+} {abcdefg}
+test canvText-9.3 {TextInsert procedure: deleting from a selected item} {
+    .c itemconfig test -text "abcdefg"
+    .c select from test 2
+    .c select to test 4
+    .c dchars test 3 5
+    .c itemcget test -text
+} {abcg}
+test canvText-9.4 {TextInsert procedure: deleting before start} {
+    .c itemconfig test -text "abcdefghijk"
+    .c select from test 4
+    .c select to test 8
+    .c dchars test 1 1
+    list [.c index test sel.first] [.c index test sel.last]
+} {3 7}
+test canvText-9.5 {TextInsert procedure: keep start > first char deleted} {
+    .c itemconfig test -text "abcdefghijk"
+    .c select from test 4
+    .c select to test 8
+    .c dchars test 2 6
+    list [.c index test sel.first] [.c index test sel.last]
+} {2 3}
+test canvText-9.6 {TextInsert procedure: deleting inside selection} {
+    .c itemconfig test -text "abcdefghijk"
+    .c select from test 4
+    .c select to test 8
+    .c dchars test 6 6
+    list [.c index test sel.first] [.c index test sel.last]
+} {4 7}
+test canvText-9.7 {TextInsert procedure: keep end > first char deleted} {
+    .c itemconfig test -text "abcdefghijk"
+    .c select from test 4
+    .c select to test 8
+    .c dchars test 6 10
+    list [.c index test sel.first] [.c index test sel.last]
+} {4 5}
+test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} {
+    .c itemconfig test -text "abcdefghijk"
+    .c select from test 4
+    .c select to test 8
+    .c dchars test 3 10
+    list [catch {.c index test sel.first} msg] $msg
+} {1 {selection isn't in item}}
+test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} {
+    .c itemconfig test -text "abcdefghijk"
+    .c select from test 4
+    .c select to test 8
+    .c dchars test 4 7
+    list [.c index test sel.first] [.c index test sel.last]
+} {4 4}
+test canvText-9.10 {TextInsert procedure: move anchor} {
+    .c itemconfig test -text "abcdefghijk"
+    .c select from test 6
+    .c select to test 8
+    .c dchars test 2 4
+    .c select to test 1
+    list [.c index test sel.first] [.c index test sel.last]
+} {1 2}
+test canvText-9.11 {TextInsert procedure: keep anchor >= first} {
+    .c itemconfig test -text "abcdefghijk"
+    .c select from test 6
+    .c select to test 8
+    .c dchars test 5 7
+    .c select to test 1
+    list [.c index test sel.first] [.c index test sel.last]
+} {1 4}
+test canvText-9.12 {TextInsert procedure: anchor doesn't move} {
+    .c itemconfig test -text "abcdefghijk"
+    .c select from test 2
+    .c select to test 5
+    .c dchars test 6 8
+    .c select to test 8
+    list [.c index test sel.first] [.c index test sel.last]
+} {2 8}
+test canvText-9.13 {TextInsert procedure: move cursor} {
+    .c itemconfig test -text "abcdefghijk"
+    .c icursor test 6
+    .c dchars test 2 4
+    .c index test insert
+} {3}
+test canvText-9.14 {TextInsert procedure: keep cursor >= first} {
+    .c itemconfig test -text "abcdefghijk"
+    .c icursor test 6
+    .c dchars test 2 10
+    .c index test insert
+} {2}
+test canvText-9.15 {TextInsert procedure: cursor doesn't move} {
+    .c itemconfig test -text "abcdefghijk"
+    .c icursor test 5
+    .c dchars test 7 9
+    .c index test insert
+} {5}
+    
+test canvText-10.1 {TextToPoint procedure} {
+    .c coords test 0 0
+    .c itemconfig test -text 0 -anchor center
+    .c index test @0,0
+} {0}
+
+test canvText-11.1 {TextToArea procedure} {
+    .c coords test 0 0
+    .c itemconfig test -text 0 -anchor center
+    .c find overlapping 0 0 1 1
+} [.c find withtag test]
+test canvText-11.2 {TextToArea procedure} {
+    .c coords test 0 0
+    .c itemconfig test -text 0 -anchor center
+    .c find overlapping 1000 1000 1001 1001
+} {}
+
+test canvText-12.1 {ScaleText procedure} {
+    .c coords test 100 100
+    .c scale all 50 50 2 2
+    .c coords test
+} {150.0 150.0}
+
+test canvText-13.1 {TranslateText procedure} {
+    .c coords test 100 100
+    .c move all 10 10
+    .c coords test
+} {110.0 110.0}
+    
+.c itemconfig test -text "abcdefghijklmno" -anchor nw
+.c select from test 5
+.c select to test 8
+.c icursor test 12
+.c coords test 0 0
+test canvText-14.1 {GetTextIndex procedure} {
+    list [.c index test end] [.c index test insert] \
+	[.c index test sel.first] [.c index test sel.last] \
+	[.c index test @0,0] \
+	[.c index test -1] [.c index test 10] [.c index test 100]
+} {15 12 5 8 0 0 10 15}
+test canvText-14.2 {GetTextIndex procedure: select error} {
+    .c select clear
+    list [catch {.c index test sel.first} msg] $msg
+} {1 {selection isn't in item}}
+test canvText-14.3 {GetTextIndex procedure: select error} {
+    .c select clear
+    list [catch {.c index test sel.last} msg] $msg
+} {1 {selection isn't in item}}
+test canvText-14.4 {GetTextIndex procedure: select error} {
+    .c select clear
+    list [catch {.c index test sel.} msg] $msg
+} {1 {bad index "sel."}}
+test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} {
+    list [catch {.c index test xyz} msg] $msg
+} {1 {bad index "xyz"}}
+
+test canvText-15.1 {SetTextCursor procedure} {
+    .c itemconfig -text "abcdefg"
+    .c icursor test 3
+    .c index test insert
+} {3}
+
+test canvText-16.1 {GetSelText procedure} {
+    .c itemconfig test -text "abcdefghijklmno" -anchor nw
+    .c select from test 5
+    .c select to test 8
+    selection get
+} {fghi}
+
+set font {Courier 12 italic}
+set ax [font measure $font 0]
+set ay [font metrics $font -linespace]
+
+test canvText-17.1 {TextToPostscript procedure} {
+    .c delete all
+    .c config -height 300 -highlightthickness 0 -bd 0
+    update
+    .c create text 100 100 -tags test 
+    .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax]
+    .c itemconfig test -anchor n -fill black
+    set x [.c postscript]
+    set x [string range $x [string first "/Courier-Oblique" $x] end]
+} "/Courier-Oblique findfont [font actual $font -size] scalefont ISOEncode setfont
+0.000 0.000 0.000 setrgbcolor AdjustColor
+100 200 \[
+(000)
+(000)
+(00)
+] $ay -0.5 0 0 false DrawText
+grestore
+restore showpage
+
+%%Trailer
+end
+%%EOF
+"