summaryrefslogtreecommitdiff
path: root/tcl/tests/text.test
diff options
context:
space:
mode:
Diffstat (limited to 'tcl/tests/text.test')
-rw-r--r--tcl/tests/text.test1594
1 files changed, 0 insertions, 1594 deletions
diff --git a/tcl/tests/text.test b/tcl/tests/text.test
deleted file mode 100644
index 730a3182927..00000000000
--- a/tcl/tests/text.test
+++ /dev/null
@@ -1,1594 +0,0 @@
-# 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.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-#
-# RCS: @(#) $Id$
-
-package require tcltest 2.1
-namespace import -force tcltest::configure
-namespace import -force tcltest::testsDirectory
-configure -testdir [file join [pwd] [file dirname [info script]]]
-configure -loadfile [file join [testsDirectory] constraints.tcl]
-tcltest::loadTestedCommands
-
-# Create entries in the option database to be sure that geometry options
-# like border width have predictable values.
-
-option add *Text.borderWidth 2
-option add *Text.highlightThickness 2
-option add *Text.font {Courier -12}
-
-text .t -width 20 -height 10
-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 {
- {-autoseparators yes 1 nah}
- {-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 {}}
- {-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}
- {-maxundo 5 5 noway}
- {-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 d disabled foo}
- {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
- {-undo 1 1 eh}
- {-width 73 73 2.4}
- {-wrap w 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
-} {1 blue {} {} 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
-} {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}
-if {$tcl_platform(platform) == "macintosh"} {
- set relief solid
-} elseif {$tcl_platform(platform) == "windows"} {
- set relief flat
-} else {
- set relief raised
-}
-test text-2.5 {Tk_TextCmd procedure} {
- catch {destroy .t2}
- text .t2
- .t2 tag cget sel -relief
-} $relief
-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, dump, edit, get, image, 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, dump, edit, get, image, 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, dump, edit, get, image, 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 {bad text index "a"}}
-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 configure -state disabled
- .t delete 2.3
- .t g 2.0 2.end
-} abcdefghijklm
-.t configure -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-8.8 {TextWidgetCmd procedure, "delete" option} {
- # All indices are checked before we actually delete anything
- list [catch {.t delete 2.1 2.3 foo} msg] $msg \
- [.t get 2.0 2.end]
-} {1 {bad text index "foo"} aefghijklm}
-set prevtext [.t get 1.0 end-1c]
-test text-8.9 {TextWidgetCmd procedure, "delete" option} {
- # auto-forward one byte if the last "pair" is just one
- .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
- .t delete 2.1 2.3 2.3
- .t get 1.0 end-1c
-} foo\naefghijklm
-test text-8.10 {TextWidgetCmd procedure, "delete" option} {
- # all indices will be ordered before deletion
- .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
- .t delete 2.0 2.3 2.7 2.9 2.4
- .t get 1.0 end-1c
-} foo\ndfgjklm
-test text-8.11 {TextWidgetCmd procedure, "delete" option} {
- # and check again with even pairs
- .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
- .t delete 2.0 2.2 2.7 2.9 2.4 2.5
- .t get 1.0 end-1c
-} foo\ncdfgjklm
-test text-8.12 {TextWidgetCmd procedure, "delete" option} {
- # we should get the longest range on equal start indices
- .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
- .t delete 2.0 2.2 2.0 2.5 2.0 2.3 2.8 2.7
- .t get 1.0 end-1c
-} foo\nfghijklm
-test text-8.13 {TextWidgetCmd procedure, "delete" option} {
- # we should get the longest range on equal start indices
- .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
- .t delete 2.0 2.2 1.2 2.6 2.0 2.5
- .t get 1.0 end-1c
-} foghijklm
-test text-8.14 {TextWidgetCmd procedure, "delete" option} {
- # we should get the longest range on equal start indices
- .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
- .t delete 2.0 2.2 2.0 2.5 1.1 2.3 2.8 2.7
- .t get 1.0 end-1c
-} ffghijklm
-test text-8.15 {TextWidgetCmd procedure, "delete" option} {
- # we should get the watch for overlapping ranges - they should
- # essentially be merged into one span.
- .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
- .t delete 2.0 2.6 2.2 2.8
- .t get 1.0 end-1c
-} foo\nijklm
-test text-8.16 {TextWidgetCmd procedure, "delete" option} {
- # we should get the watch for overlapping ranges - they should
- # essentially be merged into one span.
- .t delete 1.0 end; .t insert 1.0 "foo\nabcdefghijklm"
- .t delete 2.0 2.6 2.2 2.4
- .t get 1.0 end-1c
-} foo\nghijklm
-
-.t delete 1.0 end; .t insert 1.0 $prevtext
-
-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 {bad text index "a"}}
-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-9.11 {TextWidgetCmd procedure, "get" option} {
- .t get 5.2 5.4 5.4
-} {{y } G}
-test text-9.12 {TextWidgetCmd procedure, "get" option} {
- .t get 5.2 5.4 5.4 5.5
-} {{y } G}
-test text-9.13 {TextWidgetCmd procedure, "get" option} {
- .t get 5.2 5.4 5.5 "5.5+5c"
-} {{y } {Irl .}}
-test text-9.14 {TextWidgetCmd procedure, "get" option} {
- .t get 5.2 5.4 5.4 5.5 end-3c
-} {{y } G { }}
-test text-9.15 {TextWidgetCmd procedure, "get" option} {
- .t get 5.2 5.4 5.4 5.5 end-3c end
-} {{y } G { 7
-}}
-test text-9.17 {TextWidgetCmd procedure, "get" option} {
- list [catch {.t get 5.2 5.4 5.5 foo} msg] $msg
-} {1 {bad text index "foo"}}
-
-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, dump, edit, get, image, 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}}
-
-# Edit, 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} {
- # This test was failing Windows because the title bar on .t2
- # was a certain minimum size and it was interfering with the size
- # requested by the -setgrid. The "overrideredirect" gets rid of the
- # titlebar so the toplevel can shrink to the appropriate size.
-
- catch {destroy .t2}
- toplevel .t2
- wm overrideredirect .t2 1
- 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} {
- # This test was failing on Windows because the title bar on .t2
- # was a certain minimum size and it was interfering with the size
- # requested by the -setgrid. The "overrideredirect" gets rid of the
- # titlebar so the toplevel can shrink to the appropriate size.
-
- catch {destroy .t2}
- toplevel .t2
- wm overrideredirect .t2 1
- 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 {TextWorldChanged procedure, spacing options} fonts {
- catch {destroy .t2}
- text .t2 -width 20 -height 10
- set result [winfo reqheight .t2]
- .t2 configure -spacing1 2
- lappend result [winfo reqheight .t2]
- .t2 configure -spacing3 1
- lappend result [winfo reqheight .t2]
- .t2 configure -spacing1 0
- lappend result [winfo reqheight .t2]
-} {140 160 170 150}
-
-test text-14.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-15.1 {TextCmdDeletedProc procedure} {
- text .tx1
- rename .tx1 {}
- list [info command .tx*] [winfo exists .tx1]
-} {{} 0}
-test text-15.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-16.1 {InsertChars procedure} {
- catch {destroy .t2}
- text .t2
- .t2 insert 2.0 abcd\n
- .t2 get 1.0 end
-} {abcd
-
-}
-test text-16.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-16.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-16.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-16.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-16.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-16.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-17.1 {DeleteChars procedure} {
- .t get 1.0 end
-} {
-}
-test text-17.2 {DeleteChars procedure} {
- list [catch {.t delete foobar} msg] $msg
-} {1 {bad text index "foobar"}}
-test text-17.3 {DeleteChars procedure} {
- list [catch {.t delete 1.0 lousy} msg] $msg
-} {1 {bad text index "lousy"}}
-test text-17.4 {DeleteChars procedure} {
- setup
- .t delete 2.1
- .t get 1.0 end
-} {Line 1
-acde
-12345
-Line 4
-}
-test text-17.5 {DeleteChars procedure} {
- setup
- .t delete 2.3
- .t get 1.0 end
-} {Line 1
-abce
-12345
-Line 4
-}
-test text-17.6 {DeleteChars procedure} {
- setup
- .t delete 2.end
- .t get 1.0 end
-} {Line 1
-abcde12345
-Line 4
-}
-test text-17.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-17.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-17.9 {DeleteChars procedure} {
- setup
- .t delete 2.2 2.2
- .t get 1.0 end
-} {Line 1
-abcde
-12345
-Line 4
-}
-test text-17.10 {DeleteChars procedure} {
- setup
- .t delete 2.3 2.1
- .t get 1.0 end
-} {Line 1
-abcde
-12345
-Line 4
-}
-test text-17.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-17.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-17.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-17.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-17.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-17.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-18.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-18.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-18.3 {TextFetchSelection procedure} {
- .t tag remove sel 1.0 end
- .t tag add sel 13.3
- selection get
-} {m}
-test text-18.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-18.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-19.1 {TkTextLostSelection procedure} {unixOnly} {
- 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
-} {}
-test text-19.2 {TkTextLostSelection procedure} {macOrPc} {
- 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
-} {1.2 3.3}
-catch {destroy .t2}
-test text-19.3 {TkTextLostSelection procedure} {
- catch {destroy .t2}
- text .t2
- .t2 insert 1.0 "abcdef\nghijk\n1234"
- .t2 tag add sel 1.0 1.3
- set x [selection get]
- selection clear
- lappend x [catch {selection get} msg] $msg
- .t2 tag add sel 1.0 1.3
- lappend x [selection get]
-} {abc 1 {PRIMARY selection doesn't exist or form "STRING" not defined} abc}
-
-.t delete 1.0 end
-.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
-test text-20.1 {TextSearchCmd procedure, argument parsing} {
- list [catch {.t search -} msg] $msg
-} {1 {bad switch "-": must be --, -backward, -count, -elide, -exact, -forward, -nocase, or -regexp}}
-test text-20.2 {TextSearchCmd procedure, -backwards option} {
- .t search -backwards xyz 1.4
-} {1.1}
-test text-20.3 {TextSearchCmd procedure, -forwards option} {
- .t search -forwards xyz 1.4
-} {1.5}
-test text-20.4 {TextSearchCmd procedure, -exact option} {
- .t search -f -exact x. 1.0
-} {1.9}
-test text-20.5 {TextSearchCmd procedure, -regexp option} {
- .t search -b -regexp x.z 1.4
-} {1.1}
-test text-20.6 {TextSearchCmd procedure, -count option} {
- set length unmodified
- list [.t search -count length x. 1.4] $length
-} {1.9 2}
-test text-20.7 {TextSearchCmd procedure, -count option} {
- list [catch {.t search -count} msg] $msg
-} {1 {no value given for "-count" option}}
-test text-20.8 {TextSearchCmd procedure, -nocase option} {
- list [.t search -nocase BaR 1.1] [.t search BaR 1.1]
-} {2.13 2.23}
-test text-20.9 {TextSearchCmd procedure, -nocase option} {
- .t search -n BaR 1.1
-} {2.13}
-test text-20.10 {TextSearchCmd procedure, -- option} {
- .t search -- -forward 1.0
-} {2.4}
-test text-20.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-20.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-20.13 {TextSearchCmd procedure, check index} {
- list [catch {.t search abc gorp} msg] $msg
-} {1 {bad text index "gorp"}}
-test text-20.14 {TextSearchCmd procedure, startIndex == "end"} {
- .t search non-existent end
-} {}
-test text-20.15 {TextSearchCmd procedure, startIndex == "end"} {
- .t search non-existent end
-} {}
-test text-20.16 {TextSearchCmd procedure, bad stopIndex} {
- list [catch {.t search abc 1.0 lousy} msg] $msg
-} {1 {bad text index "lousy"}}
-test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
- list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
-} {2.13 {}}
-test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
- list [catch {.t search -regexp a( 1.0} msg] $msg
-} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
-test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
- .t search -backwards BaR end 1.0
-} {2.23}
-test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
- .t search -backwards \n end 1.0
-} {3.9}
-test text-20.21 {TextSearchCmd procedure, skip dummy last line} {
- .t search \n end
-} {1.15}
-test text-20.22 {TextSearchCmd procedure, skip dummy last line} {
- .t search -back \n 1.0
-} {3.9}
-test text-20.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-20.24 {TextSearchCmd procedure, stripping newlines} {
- .t search the\n 1.0
-} {1.12}
-test text-20.25 {TextSearchCmd procedure, stripping newlines} {
- .t search -regexp the\n 1.0
-} {}
-test text-20.26 {TextSearchCmd procedure, stripping newlines} {
- .t search -regexp {the$} 1.0
-} {1.12}
-test text-20.27 {TextSearchCmd procedure, stripping newlines} {
- .t search -regexp \n 1.0
-} {}
-test text-20.28 {TextSearchCmd procedure, line case conversion} {
- list [.t search -nocase bar 2.18] [.t search bar 2.18]
-} {2.23 2.13}
-test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} {
- .t search -backwards xyz 1.6
-} {1.5}
-test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} {
- .t search -backwards xyz 1.5
-} {1.1}
-test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} {
- .t search xyz 1.5
-} {1.5}
-test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} {
- .t search xyz 1.6
-} {3.0}
-test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} {
- .t search {} 1.end
-} {1.15}
-test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} {
- .t search f 1.end
-} {2.0}
-test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} {
- .t search {} end
-} {1.0}
-test text-20.36 {TextSearchCmd procedure, regexp finds empty lines} {
- # Test for fix of bug #1643
- .t insert end "\n"
- tk::TextSetCursor .t 4.0
- .t search -forward -regexp {^$} insert end
-} {4.0}
-
-catch {destroy .t2}
-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-20.36 {TextSearchCmd procedure, firstChar and lastChar} {
- .t2.t search his 2.6
-} {2.6}
-test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} {
- .t2.t search this 2.6
-} {3.4}
-test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} {
- .t2.t search is 2.6
-} {2.7}
-test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} {
- .t2.t search his 2.7
-} {3.5}
-test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} {
- .t2.t search -backwards "his is another" 2.6
-} {2.6}
-test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} {
- .t2.t search -backwards "his is" 2.6
-} {1.1}
-destroy .t2
-test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} {
- .t search -backwards forw 2.5
-} {2.5}
-test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} {
- .t search forw 2.5
-} {2.5}
-test text-20.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-20.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-20.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-20.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-20.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-20.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-20.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-20.51 {TextSearchCmd procedure, wrap-around} {
- .t search -backwards xyz 1.1
-} {3.5}
-test text-20.52 {TextSearchCmd procedure, wrap-around} {
- .t search -backwards xyz 1.1 1.0
-} {}
-test text-20.53 {TextSearchCmd procedure, wrap-around} {
- .t search xyz 3.6
-} {1.1}
-test text-20.54 {TextSearchCmd procedure, wrap-around} {
- .t search xyz 3.6 end
-} {}
-test text-20.55 {TextSearchCmd procedure, no match} {
- .t search non_existent 3.5
-} {}
-test text-20.56 {TextSearchCmd procedure, no match} {
- .t search -regexp non_existent 3.5
-} {}
-test text-20.57 {TextSearchCmd procedure, special cases} {
- .t search -back x 1.1
-} {1.0}
-test text-20.58 {TextSearchCmd procedure, special cases} {
- .t search -back x 1.0
-} {3.8}
-test text-20.59 {TextSearchCmd procedure, special cases} {
- .t search \n {end-2c}
-} {3.9}
-test text-20.60 {TextSearchCmd procedure, special cases} {
- .t search \n end
-} {1.15}
-test text-20.61 {TextSearchCmd procedure, special cases} {
- .t search x 1.0
-} {1.0}
-test text-20.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
-} {}
-test text-20.63 {TextSearchCmd, unicode} {
- .t delete 1.0 end
- .t insert end "foo\u30c9\u30cabar"
- .t search \u30c9\u30ca 1.0
-} 1.3
-test text-20.64 {TextSearchCmd, unicode} {
- .t delete 1.0 end
- .t insert end "foo\u30c9\u30cabar"
- list [.t search -count n \u30c9\u30ca 1.0] $n
-} {1.3 2}
-test text-20.65 {TextSearchCmd, unicode with non-text segments} {
- .t delete 1.0 end
- button .b1 -text baz
- .t insert end "foo\u30c9"
- .t window create end -window .b1
- .t insert end "\u30cabar"
- set result [list [.t search -count n \u30c9\u30ca 1.0] $n]
- destroy .b1
- set result
-} {1.3 3}
-
-test text-20.66 {TextSearchCmd, hidden text does not affect match index} {
- deleteWindows
- pack [text .t2]
- .t2 insert end "12345H7890"
- .t2 search 7 1.0
-} 1.6
-test text-20.67 {TextSearchCmd, hidden text does not affect match index} {
- deleteWindows
- pack [text .t2]
- .t2 insert end "12345H7890"
- .t2 tag configure hidden -elide true
- .t2 tag add hidden 1.5
- .t2 search 7 1.0
-} 1.6
-test text-20.68 {TextSearchCmd, hidden text does not affect match index} {
- deleteWindows
- pack [text .t2]
- .t2 insert end "foobar\nbarbaz\nbazboo"
- .t2 search boo 1.0
-} 3.3
-test text-20.69 {TextSearchCmd, hidden text does not affect match index} {
- deleteWindows
- pack [text .t2]
- .t2 insert end "foobar\nbarbaz\nbazboo"
- .t2 tag configure hidden -elide true
- .t2 tag add hidden 2.0 3.0
- .t2 search boo 1.0
-} 3.3
-
-test text-20.70 {TextSearchCmd, -regexp -nocase searches} {
- catch {destroy .t}
- pack [text .t]
- .t insert end "word1 word2"
- set res [.t search -nocase -regexp {\mword.} 1.0 end]
- destroy .t
- set res
-} 1.0
-test text-20.71 {TextSearchCmd, -regexp -nocase searches} {
- catch {destroy .t}
- pack [text .t]
- .t insert end "word1 word2"
- set res [.t search -nocase -regexp {word.\M} 1.0 end]
- destroy .t
- set res
-} 1.0
-test text-20.72 {TextSearchCmd, -regexp -nocase searches} {
- catch {destroy .t}
- pack [text .t]
- .t insert end "word1 word2"
- set res [.t search -nocase -regexp {word.\W} 1.0 end]
- destroy .t
- set res
-} 1.0
-
-deleteWindows
-text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
-pack .t2
-.t2 insert end "1\t2\t3\t4\t55.5"
-test text-21.1 {TkTextGetTabs procedure} {
- list [catch {.t2 configure -tabs "\{{}"} msg] $msg
-} {1 {unmatched open brace in list}}
-test text-21.2 {TkTextGetTabs procedure} {
- list [catch {.t2 configure -tabs xyz} msg] $msg
-} {1 {bad screen distance "xyz"}}
-test text-21.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-21.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-21.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-21.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-21.7 {TkTextGetTabs procedure} {
- list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg
-} {1 {bad screen distance "!44"}}
-
-deleteWindows
-text .t
-pack .t
-.t insert 1.0 "One Line"
-.t mark set insert 1.0
-
-test text-22.1 {TextDumpCmd procedure, bad args} {
- list [catch {.t dump} msg] $msg
-} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
-test text-22.2 {TextDumpCmd procedure, bad args} {
- list [catch {.t dump -all} msg] $msg
-} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
-test text-22.3 {TextDumpCmd procedure, bad args} {
- list [catch {.t dump -command} msg] $msg
-} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
-test text-22.4 {TextDumpCmd procedure, bad args} {
- list [catch {.t dump -bogus} msg] $msg
-} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
-test text-22.5 {TextDumpCmd procedure, bad args} {
- list [catch {.t dump bogus} msg] $msg
-} {1 {bad text index "bogus"}}
-test text-22.6 {TextDumpCmd procedure, one index} {
- .t dump -text 1.2
-} {text e 1.2}
-test text-22.7 {TextDumpCmd procedure, two indices} {
- .t dump -text 1.0 1.end
-} {text {One Line} 1.0}
-test text-22.8 {TextDumpCmd procedure, "end" index} {
- .t dump -text 1.end end
-} {text {
-} 1.8}
-test text-22.9 {TextDumpCmd procedure, same indices} {
- .t dump 1.5 1.5
-} {}
-test text-22.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-22.11 {TextDumpCmd procedure, stop at begin-line} {
- .t dump -text 1.0 2.0
-} {text {Line One
-} 1.0}
-test text-22.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-22.13 {TextDumpCmd procedure, tags only} {
- .t dump -tag 2.1 2.8
-} {}
-test text-22.14 {TextDumpCmd procedure, tags only} {
- .t dump -tag 2.0 2.8
-} {tagon x 2.0}
-test text-22.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-22.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-22.17 {TextDumpCmd procedure, marks only} {
- .t dump -mark 1.1 1.8
-} {}
-test text-22.18 {TextDumpCmd procedure, marks only} {
- .t dump -mark 2.0 2.8
-} {mark m 2.4}
-test text-22.19 {TextDumpCmd procedure, marks only} {
- .t dump -mark 1.1 4.end
-} {mark m 2.4 mark n 4.0}
-test text-22.20 {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-22.21 {TextDumpCmd procedure, windows only} {
- .t dump -window 1.0 5.0
-} {window .hello 3.10}
-test text-22.22 {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-22.23 {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-22.24 {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}
-test text-22.25 {TextDumpCmd procedure, unicode characters} {
- catch {destroy .t}
- text .t
- .t delete 1.0 end
- .t insert 1.0 \xb1\xb1\xb1
- .t dump -all 1.0 2.0
-} "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3"
-test text-22.26 {TextDumpCmd procedure, unicode characters} {
- catch {destroy .t}
- text .t
- .t delete 1.0 end
- .t insert 1.0 abc\xb1\xb1\xb1
- .t dump -all 1.0 2.0
-} "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6"
-
-set l [interp hidden]
-deleteWindows
-
-test text-23.1 {text widget vs hidden commands} {
- catch {destroy .t}
- text .t
- interp hide {} .t
- destroy .t
- list [winfo children .] [interp hidden]
-} [list {} $l]
-
-test text-24.1 {bug fix - 1642} {
- catch {destroy .t}
- text .t
- pack .t
- .t insert end "line 1\n"
- .t insert end "line 2\n"
- .t insert end "line 3\n"
- .t insert end "line 4\n"
- .t insert end "line 5\n"
- tk::TextSetCursor .t 3.0
- .t search -backward -regexp "\$" insert 1.0
-} {2.6}
-
-test text-25.1 {TextEditCmd procedure, argument parsing} {
- list [catch {.t edit} msg] $msg
-} {1 {wrong # args: should be ".t edit option ?arg arg ...?"}}
-
-test text-25.2 {TextEditCmd procedure, argument parsing} {
- list [catch {.t edit gorp} msg] $msg
-} {1 {bad edit option "gorp": must be modified, redo, reset, separator or undo}}
-
-test text-25.3 {TextEditUndo procedure, undoing changes} {
- catch {destroy .t}
- text .t -undo 1
- pack .t
- .t insert end "line 1\n"
- .t delete 1.4 1.6
- .t insert end "should be gone after undo\n"
- .t edit undo
- .t get 1.0 end
-} "line\n\n"
-
-test text-25.4 {TextEditRedo procedure, redoing changes} {
- catch {destroy .t}
- text .t -undo 1
- pack .t
- .t insert end "line 1\n"
- .t delete 1.4 1.6
- .t insert end "should be back after redo\n"
- .t edit undo
- .t edit redo
- .t get 1.0 end
-} "line\nshould be back after redo\n\n"
-
-test text-25.5 {TextEditUndo procedure, resetting stack} {
- catch {destroy .t}
- text .t -undo 1
- pack .t
- .t insert end "line 1\n"
- .t delete 1.4 1.6
- .t insert end "should be back after redo\n"
- .t edit reset
- catch {.t edit undo} msg
- set msg
-} "nothing to undo"
-
-test text-25.6 {TextEditCmd procedure, insert separator} {
- catch {destroy .t}
- text .t -undo 1
- pack .t
- .t insert end "line 1\n"
- .t edit separator
- .t insert end "line 2\n"
- .t edit undo
- .t get 1.0 end
-} "line 1\n\n"
-
-test text-25.7 {-autoseparators configuration option} {
- catch {destroy .t}
- text .t -undo 1 -autoseparators 0
- pack .t
- .t insert end "line 1\n"
- .t delete 1.4 1.6
- .t insert end "line 2\n"
- .t edit undo
- .t get 1.0 end
-} "\n"
-
-test text-25.8 {TextEditCmd procedure, modified flag} {
- catch {destroy .t}
- text .t
- pack .t
- .t insert end "line 1\n"
- .t edit modified
-} {1}
-
-test text-25.9 {TextEditCmd procedure, reset modified flag} {
- catch {destroy .t}
- text .t
- pack .t
- .t insert end "line 1\n"
- .t edit modified 0
- .t edit modified
-} {0}
-
-test text-25.10 {TextEditCmd procedure, set modified flag} {
- catch {destroy .t}
- text .t
- pack .t
- .t edit modified 1
- .t edit modified
-} {1}
-
-test text-25.11 {<<Modified>> virtual event} {
- set ::retval unmodified
- catch {destroy .t}
- text .t -undo 1
- pack .t
- bind .t <<Modified>> "set ::retval modified"
- update idletasks
- .t insert end "nothing special\n"
- set ::retval
-} {modified}
-
-test text-25.12 {<<Selection>> virtual event} {
- set ::retval no_selection
- catch {destroy .t}
- text .t -undo 1
- pack .t
- bind .t <<Selection>> "set ::retval selection_changed"
- update idletasks
- .t insert end "nothing special\n"
- .t tag add sel 1.0 1.1
- set ::retval
-} {selection_changed}
-
-test text-25.13 {-maxundo configuration option} {
- catch {destroy .t}
- text .t -undo 1 -autoseparators 1 -maxundo 2
- pack .t
- .t insert end "line 1\n"
- .t delete 1.4 1.6
- .t insert end "line 2\n"
- catch {.t edit undo}
- catch {.t edit undo}
- catch {.t edit undo}
- .t get 1.0 end
-} "line 1\n\n"
-
-deleteWindows
-option clear
-
-# cleanup
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
-
View Lorry Controller Status