1199 lines
39 KiB
Plaintext
1199 lines
39 KiB
Plaintext
|
# 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.33 96/08/21 09:56:17
|
||
|
|
|
||
|
|
if {[string compare test [info procs test]] == 1} then \
|
||
|
|
{source defs}
|
||
|
|
|
||
|
|
eval destroy [winfo child .]
|
||
|
|
if [catch {text .t \
|
||
|
|
-font -adobe-courier-medium-r-normal--12-120-75-75-m-70-iso8859-1 \
|
||
|
|
-width 20 -height 10}] {
|
||
|
|
puts "The font needed by these tests isn't available, so I'm"
|
||
|
|
puts "going to skip the tests."
|
||
|
|
return
|
||
|
|
}
|
||
|
|
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 never_heard_of}
|
||
|
|
{-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}
|
||
|
|
test text-2.5 {Tk_TextCmd procedure} {
|
||
|
|
catch {destroy .t2}
|
||
|
|
text .t2
|
||
|
|
.t2 tag cget sel -relief
|
||
|
|
} {raised}
|
||
|
|
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, 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, 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, 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, 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} {
|
||
|
|
catch {destroy .t2}
|
||
|
|
toplevel .t2
|
||
|
|
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} {
|
||
|
|
catch {destroy .t2}
|
||
|
|
toplevel .t2
|
||
|
|
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 {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-14.1 {TextCmdDeletedProc procedure} {
|
||
|
|
text .tx1
|
||
|
|
rename .tx1 {}
|
||
|
|
list [info command .tx*] [winfo exists .tx1]
|
||
|
|
} {{} 0}
|
||
|
|
test text-14.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-15.1 {InsertChars procedure} {
|
||
|
|
catch {destroy .t2}
|
||
|
|
text .t2
|
||
|
|
.t2 insert 2.0 abcd\n
|
||
|
|
.t2 get 1.0 end
|
||
|
|
} {abcd
|
||
|
|
|
||
|
|
}
|
||
|
|
test text-15.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-15.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-15.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-15.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-15.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-15.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-16.1 {DeleteChars procedure} {
|
||
|
|
.t get 1.0 end
|
||
|
|
} {
|
||
|
|
}
|
||
|
|
test text-16.2 {DeleteChars procedure} {
|
||
|
|
list [catch {.t delete foobar} msg] $msg
|
||
|
|
} {1 {bad text index "foobar"}}
|
||
|
|
test text-16.3 {DeleteChars procedure} {
|
||
|
|
list [catch {.t delete 1.0 lousy} msg] $msg
|
||
|
|
} {1 {bad text index "lousy"}}
|
||
|
|
test text-16.4 {DeleteChars procedure} {
|
||
|
|
setup
|
||
|
|
.t delete 2.1
|
||
|
|
.t get 1.0 end
|
||
|
|
} {Line 1
|
||
|
|
acde
|
||
|
|
12345
|
||
|
|
Line 4
|
||
|
|
}
|
||
|
|
test text-16.5 {DeleteChars procedure} {
|
||
|
|
setup
|
||
|
|
.t delete 2.3
|
||
|
|
.t get 1.0 end
|
||
|
|
} {Line 1
|
||
|
|
abce
|
||
|
|
12345
|
||
|
|
Line 4
|
||
|
|
}
|
||
|
|
test text-16.6 {DeleteChars procedure} {
|
||
|
|
setup
|
||
|
|
.t delete 2.end
|
||
|
|
.t get 1.0 end
|
||
|
|
} {Line 1
|
||
|
|
abcde12345
|
||
|
|
Line 4
|
||
|
|
}
|
||
|
|
test text-16.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-16.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-16.9 {DeleteChars procedure} {
|
||
|
|
setup
|
||
|
|
.t delete 2.2 2.2
|
||
|
|
.t get 1.0 end
|
||
|
|
} {Line 1
|
||
|
|
abcde
|
||
|
|
12345
|
||
|
|
Line 4
|
||
|
|
}
|
||
|
|
test text-16.10 {DeleteChars procedure} {
|
||
|
|
setup
|
||
|
|
.t delete 2.3 2.1
|
||
|
|
.t get 1.0 end
|
||
|
|
} {Line 1
|
||
|
|
abcde
|
||
|
|
12345
|
||
|
|
Line 4
|
||
|
|
}
|
||
|
|
test text-16.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-16.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-16.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-16.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-16.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-16.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-17.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-17.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-17.3 {TextFetchSelection procedure} {
|
||
|
|
.t tag remove sel 1.0 end
|
||
|
|
.t tag add sel 13.3
|
||
|
|
selection get
|
||
|
|
} {m}
|
||
|
|
test text-17.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-17.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-18.1 {TkTextLostSelection procedure} {
|
||
|
|
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
|
||
|
|
} {}
|
||
|
|
catch {destroy .t2}
|
||
|
|
|
||
|
|
.t delete 1.0 end
|
||
|
|
.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
|
||
|
|
test text-19.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-19.2 {TextSearchCmd procedure, -backwards option} {
|
||
|
|
.t search -backwards xyz 1.4
|
||
|
|
} {1.1}
|
||
|
|
test text-19.3 {TextSearchCmd procedure, -forwards option} {
|
||
|
|
.t search -forwards xyz 1.4
|
||
|
|
} {1.5}
|
||
|
|
test text-19.4 {TextSearchCmd procedure, -exact option} {
|
||
|
|
.t search -f -exact x. 1.0
|
||
|
|
} {1.9}
|
||
|
|
test text-19.5 {TextSearchCmd procedure, -regexp option} {
|
||
|
|
.t search -b -regexp x.z 1.4
|
||
|
|
} {1.1}
|
||
|
|
test text-19.6 {TextSearchCmd procedure, -count option} {
|
||
|
|
set length unmodified
|
||
|
|
list [.t search -count length x. 1.4] $length
|
||
|
|
} {1.9 2}
|
||
|
|
test text-19.7 {TextSearchCmd procedure, -count option} {
|
||
|
|
list [catch {.t search -count} msg] $msg
|
||
|
|
} {1 {no value given for "-count" option}}
|
||
|
|
test text-19.8 {TextSearchCmd procedure, -nocase option} {
|
||
|
|
list [.t search -nocase BaR 1.1] [.t search BaR 1.1]
|
||
|
|
} {2.13 2.23}
|
||
|
|
test text-19.9 {TextSearchCmd procedure, -nocase option} {
|
||
|
|
.t search -n BaR 1.1
|
||
|
|
} {2.13}
|
||
|
|
test text-19.10 {TextSearchCmd procedure, -- option} {
|
||
|
|
.t search -- -forward 1.0
|
||
|
|
} {2.4}
|
||
|
|
test text-19.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-19.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-19.13 {TextSearchCmd procedure, check index} {
|
||
|
|
list [catch {.t search abc gorp} msg] $msg
|
||
|
|
} {1 {bad text index "gorp"}}
|
||
|
|
test text-19.14 {TextSearchCmd procedure, startIndex == "end"} {
|
||
|
|
.t search non-existent end
|
||
|
|
} {}
|
||
|
|
test text-19.15 {TextSearchCmd procedure, startIndex == "end"} {
|
||
|
|
.t search non-existent end
|
||
|
|
} {}
|
||
|
|
test text-19.16 {TextSearchCmd procedure, bad stopIndex} {
|
||
|
|
list [catch {.t search abc 1.0 lousy} msg] $msg
|
||
|
|
} {1 {bad text index "lousy"}}
|
||
|
|
test text-19.17 {TextSearchCmd procedure, pattern case conversion} {
|
||
|
|
list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
|
||
|
|
} {2.13 {}}
|
||
|
|
test text-19.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-19.19 {TextSearchCmd procedure, skip dummy last line} {
|
||
|
|
.t search -backwards BaR end 1.0
|
||
|
|
} {2.23}
|
||
|
|
test text-19.20 {TextSearchCmd procedure, skip dummy last line} {
|
||
|
|
.t search -backwards \n end 1.0
|
||
|
|
} {3.9}
|
||
|
|
test text-19.21 {TextSearchCmd procedure, skip dummy last line} {
|
||
|
|
.t search \n end
|
||
|
|
} {1.15}
|
||
|
|
test text-19.22 {TextSearchCmd procedure, skip dummy last line} {
|
||
|
|
.t search -back \n 1.0
|
||
|
|
} {3.9}
|
||
|
|
test text-19.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-19.24 {TextSearchCmd procedure, stripping newlines} {
|
||
|
|
.t search the\n 1.0
|
||
|
|
} {1.12}
|
||
|
|
test text-19.25 {TextSearchCmd procedure, stripping newlines} {
|
||
|
|
.t search -regexp the\n 1.0
|
||
|
|
} {}
|
||
|
|
test text-19.26 {TextSearchCmd procedure, stripping newlines} {
|
||
|
|
.t search -regexp {the$} 1.0
|
||
|
|
} {1.12}
|
||
|
|
test text-19.27 {TextSearchCmd procedure, stripping newlines} {
|
||
|
|
.t search -regexp \n 1.0
|
||
|
|
} {}
|
||
|
|
test text-19.28 {TextSearchCmd procedure, line case conversion} {
|
||
|
|
list [.t search -nocase bar 2.18] [.t search bar 2.18]
|
||
|
|
} {2.23 2.13}
|
||
|
|
test text-19.29 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t search -backwards xyz 1.6
|
||
|
|
} {1.5}
|
||
|
|
test text-19.30 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t search -backwards xyz 1.5
|
||
|
|
} {1.1}
|
||
|
|
test text-19.31 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t search xyz 1.5
|
||
|
|
} {1.5}
|
||
|
|
test text-19.32 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t search xyz 1.6
|
||
|
|
} {3.0}
|
||
|
|
test text-19.33 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t search {} 1.end
|
||
|
|
} {1.15}
|
||
|
|
test text-19.34 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t search f 1.end
|
||
|
|
} {2.0}
|
||
|
|
test text-19.35 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t search {} end
|
||
|
|
} {1.0}
|
||
|
|
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-19.36 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t2.t search his 2.6
|
||
|
|
} {2.6}
|
||
|
|
test text-19.37 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t2.t search this 2.6
|
||
|
|
} {3.4}
|
||
|
|
test text-19.38 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t2.t search is 2.6
|
||
|
|
} {2.7}
|
||
|
|
test text-19.39 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t2.t search his 2.7
|
||
|
|
} {3.5}
|
||
|
|
test text-19.40 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t2.t search -backwards "his is another" 2.6
|
||
|
|
} {2.6}
|
||
|
|
test text-19.41 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t2.t search -backwards "his is" 2.6
|
||
|
|
} {1.1}
|
||
|
|
destroy .t2
|
||
|
|
test text-19.42 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t search -backwards forw 2.5
|
||
|
|
} {2.5}
|
||
|
|
test text-19.43 {TextSearchCmd procedure, firstChar and lastChar} {
|
||
|
|
.t search forw 2.5
|
||
|
|
} {2.5}
|
||
|
|
test text-19.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-19.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-19.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-19.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-19.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-19.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-19.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-19.51 {TextSearchCmd procedure, wrap-around} {
|
||
|
|
.t search -backwards xyz 1.1
|
||
|
|
} {3.5}
|
||
|
|
test text-19.52 {TextSearchCmd procedure, wrap-around} {
|
||
|
|
.t search -backwards xyz 1.1 1.0
|
||
|
|
} {}
|
||
|
|
test text-19.53 {TextSearchCmd procedure, wrap-around} {
|
||
|
|
.t search xyz 3.6
|
||
|
|
} {1.1}
|
||
|
|
test text-19.54 {TextSearchCmd procedure, wrap-around} {
|
||
|
|
.t search xyz 3.6 end
|
||
|
|
} {}
|
||
|
|
test text-19.55 {TextSearchCmd procedure, no match} {
|
||
|
|
.t search non_existent 3.5
|
||
|
|
} {}
|
||
|
|
test text-19.56 {TextSearchCmd procedure, no match} {
|
||
|
|
.t search -regexp non_existent 3.5
|
||
|
|
} {}
|
||
|
|
test text-19.57 {TextSearchCmd procedure, special cases} {
|
||
|
|
.t search -back x 1.1
|
||
|
|
} {1.0}
|
||
|
|
test text-19.58 {TextSearchCmd procedure, special cases} {
|
||
|
|
.t search -back x 1.0
|
||
|
|
} {3.8}
|
||
|
|
test text-19.59 {TextSearchCmd procedure, special cases} {
|
||
|
|
.t search \n {end-2c}
|
||
|
|
} {3.9}
|
||
|
|
test text-19.60 {TextSearchCmd procedure, special cases} {
|
||
|
|
.t search \n end
|
||
|
|
} {1.15}
|
||
|
|
test text-19.61 {TextSearchCmd procedure, special cases} {
|
||
|
|
.t search x 1.0
|
||
|
|
} {1.0}
|
||
|
|
test text-19.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
|
||
|
|
pack .t2
|
||
|
|
.t2 insert end "1\t2\t3\t4\t55.5"
|
||
|
|
test text-20.1 {TkTextGetTabs procedure} {
|
||
|
|
list [catch {.t2 configure -tabs "\{{}"} msg] $msg
|
||
|
|
} {1 {unmatched open brace in list}}
|
||
|
|
test text-20.2 {TkTextGetTabs procedure} {
|
||
|
|
list [catch {.t2 configure -tabs xyz} msg] $msg
|
||
|
|
} {1 {bad screen distance "xyz"}}
|
||
|
|
test text-20.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-20.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-20.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-20.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-20.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-21.1 {TextDumpCmd procedure, bad args} {
|
||
|
|
list [catch {.t dump} msg] $msg
|
||
|
|
} {1 {Usage: .t dump ?-all -text -mark -tag -window? ?-command script? index ?index2?}}
|
||
|
|
test text-21.2 {TextDumpCmd procedure, bad args} {
|
||
|
|
list [catch {.t dump -all} msg] $msg
|
||
|
|
} {1 {Usage: .t dump ?-all -text -mark -tag -window? ?-command script? index ?index2?}}
|
||
|
|
test text-21.3 {TextDumpCmd procedure, bad args} {
|
||
|
|
list [catch {.t dump -command} msg] $msg
|
||
|
|
} {1 {Usage: .t dump ?-all -text -mark -tag -window? ?-command script? index ?index2?}}
|
||
|
|
test text-21.4 {TextDumpCmd procedure, bad args} {
|
||
|
|
list [catch {.t dump -bogus} msg] $msg
|
||
|
|
} {1 {Usage: .t dump ?-all -text -mark -tag -window? ?-command script? index ?index2?}}
|
||
|
|
test text-21.5 {TextDumpCmd procedure, bad args} {
|
||
|
|
list [catch {.t dump bogus} msg] $msg
|
||
|
|
} {1 {bad text index "bogus"}}
|
||
|
|
test text-21.6 {TextDumpCmd procedure, one index} {
|
||
|
|
.t dump -text 1.2
|
||
|
|
} {text e 1.2}
|
||
|
|
test text-21.7 {TextDumpCmd procedure, two indices} {
|
||
|
|
.t dump -text 1.0 1.end
|
||
|
|
} {text {One Line} 1.0}
|
||
|
|
test text-21.8 {TextDumpCmd procedure, "end" index} {
|
||
|
|
.t dump -text 1.end end
|
||
|
|
} {text {
|
||
|
|
} 1.8}
|
||
|
|
test text-21.9 {TextDumpCmd procedure, same indices} {
|
||
|
|
.t dump 1.5 1.5
|
||
|
|
} {}
|
||
|
|
test text-21.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-21.11 {TextDumpCmd procedure, stop at begin-line} {
|
||
|
|
.t dump -text 1.0 2.0
|
||
|
|
} {text {Line One
|
||
|
|
} 1.0}
|
||
|
|
test text-21.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-21.13 {TextDumpCmd procedure, tags only} {
|
||
|
|
.t dump -tag 2.1 2.8
|
||
|
|
} {}
|
||
|
|
test text-21.14 {TextDumpCmd procedure, tags only} {
|
||
|
|
.t dump -tag 2.0 2.8
|
||
|
|
} {tagon x 2.0}
|
||
|
|
test text-21.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-21.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-21.13 {TextDumpCmd procedure, marks only} {
|
||
|
|
.t dump -mark 1.1 1.8
|
||
|
|
} {}
|
||
|
|
test text-21.14 {TextDumpCmd procedure, marks only} {
|
||
|
|
.t dump -mark 2.0 2.8
|
||
|
|
} {mark m 2.4}
|
||
|
|
test text-21.15 {TextDumpCmd procedure, marks only} {
|
||
|
|
.t dump -mark 1.1 4.end
|
||
|
|
} {mark m 2.4 mark n 4.0}
|
||
|
|
test text-21.16 {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-21.17 {TextDumpCmd procedure, windows only} {
|
||
|
|
.t dump -window 1.0 5.0
|
||
|
|
} {window .hello 3.10}
|
||
|
|
test text-21.18 {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-21.19 {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-21.19 {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}
|
||
|
|
|
||
|
|
eval destroy [winfo child .]
|
||
|
|
|