OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [text.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# This file is a Tcl script to test the code in the file tkText.c.
2 
# This file is organized in the standard fashion for Tcl tests.
3 
#
4 
# Copyright (c) 1992-1994 The Regents of the University of California.
5 
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
6 
#
7 
# See the file "license.terms" for information on usage and redistribution
8 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9 
#
10 
# RCS: @(#) $Id: text.test,v 1.1.1.1 2002-01-16 10:25:59 markom Exp $
11 
 
12 
if {[string compare test [info procs test]] == 1} then \
13 
  {source defs}
14 
 
15 
eval destroy [winfo child .]
16 
 
17 
# Create entries in the option database to be sure that geometry options
18 
# like border width have predictable values.
19 
 
20 
option add *Text.borderWidth 2
21 
option add *Text.highlightThickness 2
22 
option add *Text.font {Courier -12}
23 
 
24 
text .t -width 20 -height 10
25 
pack append . .t {top expand fill}
26 
update
27 
.t debug on
28 
wm geometry . {}
29 
 
30 
# The statements below reset the main window;  it's needed if the window
31 
# manager is mwm to make mwm forget about a previous minimum size setting.
32 
 
33 
wm withdraw .
34 
wm minsize . 1 1
35 
wm positionfrom . user
36 
wm deiconify .
37 
 
38 
entry .t.e
39 
.t.e insert end abcdefg
40 
.t.e select from 0
41 
 
42 
.t insert 1.0 "Line 1
43 
abcdefghijklm
44 
12345
45 
Line 4
46 
bOy GIrl .#@? x_yz
47 
!@#$%
48 
Line 7"
49 
 
50 
catch {destroy .t2}
51 
text .t2
52 
set i 0
53 
foreach test {
54 
    {-background #ff00ff #ff00ff }
55 
    {-bd 4 4 foo}
56 
    {-bg blue blue #xx}
57 
    {-borderwidth 7 7 ++}
58 
    {-cursor watch watch lousy}
59 
    {-exportselection no 0 maybe}
60 
    {-fg red red stupid}
61 
    {-font fixed fixed {}}
62 
    {-foreground #012 #012 bogus}
63 
    {-height 5 5 bad}
64 
    {-highlightbackground #123 #123 bogus}
65 
    {-highlightcolor #234 #234 bogus}
66 
    {-highlightthickness -2 0 bad}
67 
    {-insertbackground green green }
68 
    {-insertborderwidth 45 45 bogus}
69 
    {-insertofftime 100 100 2.4}
70 
    {-insertontime 47 47 e1}
71 
    {-insertwidth 2.3 2 47d}
72 
    {-padx 3.4 3 2.4.}
73 
    {-pady 82 82 bogus}
74 
    {-relief raised raised bumpy}
75 
    {-selectbackground #ffff01234567 #ffff01234567 bogus}
76 
    {-selectborderwidth 21 21 3x}
77 
    {-selectforeground yellow yellow #12345}
78 
    {-spacing1 20 20 1.3x}
79 
    {-spacing1 -5 0 bogus}
80 
    {-spacing2 5 5 bogus}
81 
    {-spacing2 -1 0 bogus}
82 
    {-spacing3 20 20 bogus}
83 
    {-spacing3 -10 0 bogus}
84 
    {-state disabled disabled foo}
85 
    {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
86 
    {-width 73 73 2.4}
87 
    {-wrap word word bad_wrap}
88 
} {
89 
    test text-1.[incr i] {text options} {
90 
        set result {}
91 
        lappend result [catch {.t2 configure [lindex $test 0] [lindex $test 3]}]
92 
        .t2 configure [lindex $test 0] [lindex $test 1]
93 
        lappend result [.t2 cget [lindex $test 0]]
94 
    } [list 1 [lindex $test 2]]
95 
}
96 
test text-1.[incr i] {text options} {
97 
    .t2 configure -takefocus "any old thing"
98 
    .t2 cget -takefocus
99 
} {any old thing}
100 
test text-1.[incr i] {text options} {
101 
    .t2 configure -xscrollcommand "x scroll command"
102 
    .t2 configure -xscrollcommand
103 
} {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}}
104 
test text-1.[incr i] {text options} {
105 
    .t2 configure -yscrollcommand "test command"
106 
    .t2 configure -yscrollcommand
107 
} {-yscrollcommand yScrollCommand ScrollCommand {} {test command}}
108 
test text-1.[incr i] {text options} {
109 
    set result {}
110 
    foreach i [.t2 configure] {
111 
        lappend result [lindex $i 4]
112 
    }
113 
    set result
114 
} {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}}
115 
 
116 
test text-2.1 {Tk_TextCmd procedure} {
117 
    list [catch {text} msg] $msg
118 
} {1 {wrong # args: should be "text pathName ?options?"}}
119 
test text-2.2 {Tk_TextCmd procedure} {
120 
    list [catch {text foobar} msg] $msg
121 
} {1 {bad window path name "foobar"}}
122 
test text-2.3 {Tk_TextCmd procedure} {
123 
    catch {destroy .t2}
124 
    list [catch {text .t2 -gorp nofun} msg] $msg [winfo exists .t2]
125 
} {1 {unknown option "-gorp"} 0}
126 
test text-2.4 {Tk_TextCmd procedure} {
127 
    catch {destroy .t2}
128 
    list [catch {text .t2 -bd 2 -fg red} msg] $msg \
129 
        [lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4]
130 
} {0 .t2 2 red}
131 
if {$tcl_platform(platform) == "macintosh"} {
132 
    set relief solid
133 
} elseif {$tcl_platform(platform) == "windows"} {
134 
    set relief flat
135 
} else {
136 
    set relief raised
137 
}
138 
test text-2.5 {Tk_TextCmd procedure} {
139 
    catch {destroy .t2}
140 
    text .t2
141 
    .t2 tag cget sel -relief
142 
} $relief
143 
test text-2.6 {Tk_TextCmd procedure} {
144 
    catch {destroy .t2}
145 
    list [text .t2] [winfo class .t2]
146 
} {.t2 Text}
147 
 
148 
test text-3.1 {TextWidgetCmd procedure, basics} {
149 
    list [catch {.t} msg] $msg
150 
} {1 {wrong # args: should be ".t option ?arg arg ...?"}}
151 
test text-3.2 {TextWidgetCmd procedure} {
152 
    list [catch {.t gorp 1.0 z 1.2} msg] $msg
153 
} {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
154 
 
155 
test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
156 
    list [catch {.t bbox} msg] $msg
157 
} {1 {wrong # args: should be ".t bbox index"}}
158 
test text-4.2 {TextWidgetCmd procedure, "bbox" option} {
159 
    list [catch {.t bbox a b} msg] $msg
160 
} {1 {wrong # args: should be ".t bbox index"}}
161 
test text-4.3 {TextWidgetCmd procedure, "bbox" option} {
162 
    list [catch {.t bbox bad_mark} msg] $msg
163 
} {1 {bad text index "bad_mark"}}
164 
 
165 
test text-5.1 {TextWidgetCmd procedure, "cget" option} {
166 
    list [catch {.t cget} msg] $msg
167 
} {1 {wrong # args: should be ".t cget option"}}
168 
test text-5.2 {TextWidgetCmd procedure, "cget" option} {
169 
    list [catch {.t cget a b} msg] $msg
170 
} {1 {wrong # args: should be ".t cget option"}}
171 
test text-5.3 {TextWidgetCmd procedure, "cget" option} {
172 
    list [catch {.t cget -gorp} msg] $msg
173 
} {1 {unknown option "-gorp"}}
174 
test text-5.4 {TextWidgetCmd procedure, "cget" option} {
175 
    .t configure -bd 17
176 
    .t cget -bd
177 
} {17}
178 
.t configure -bd [lindex [.t configure -bd] 3]
179 
 
180 
test text-6.1 {TextWidgetCmd procedure, "compare" option} {
181 
    list [catch {.t compare a b} msg] $msg
182 
} {1 {wrong # args: should be ".t compare index1 op index2"}}
183 
test text-6.2 {TextWidgetCmd procedure, "compare" option} {
184 
    list [catch {.t compare a b c d} msg] $msg
185 
} {1 {wrong # args: should be ".t compare index1 op index2"}}
186 
test text-6.3 {TextWidgetCmd procedure, "compare" option} {
187 
    list [catch {.t compare @x == 1.0} msg] $msg
188 
} {1 {bad text index "@x"}}
189 
test text-6.4 {TextWidgetCmd procedure, "compare" option} {
190 
    list [catch {.t compare 1.0 < @y} msg] $msg
191 
} {1 {bad text index "@y"}}
192 
test text-6.5 {TextWidgetCmd procedure, "compare" option} {
193 
    list [.t compare 1.1 < 1.0] [.t compare 1.1 < 1.1] [.t compare 1.1 < 1.2]
194 
} {0 0 1}
195 
test text-6.6 {TextWidgetCmd procedure, "compare" option} {
196 
    list [.t compare 1.1 <= 1.0] [.t compare 1.1 <= 1.1] [.t compare 1.1 <= 1.2]
197 
} {0 1 1}
198 
test text-6.7 {TextWidgetCmd procedure, "compare" option} {
199 
    list [.t compare 1.1 == 1.0] [.t compare 1.1 == 1.1] [.t compare 1.1 == 1.2]
200 
} {0 1 0}
201 
test text-6.8 {TextWidgetCmd procedure, "compare" option} {
202 
    list [.t compare 1.1 >= 1.0] [.t compare 1.1 >= 1.1] [.t compare 1.1 >= 1.2]
203 
} {1 1 0}
204 
test text-6.9 {TextWidgetCmd procedure, "compare" option} {
205 
    list [.t compare 1.1 > 1.0] [.t compare 1.1 > 1.1] [.t compare 1.1 > 1.2]
206 
} {1 0 0}
207 
test text-6.10 {TextWidgetCmd procedure, "compare" option} {
208 
    list [.t com 1.1 != 1.0] [.t compare 1.1 != 1.1] [.t compare 1.1 != 1.2]
209 
} {1 0 1}
210 
test text-6.11 {TextWidgetCmd procedure, "compare" option} {
211 
    list [catch {.t compare 1.0
212 
} {1 {bad comparison operator "=, >, or !=}}
213 
test text-6.12 {TextWidgetCmd procedure, "compare" option} {
214 
    list [catch {.t compare 1.0 >> 1.2} msg] $msg
215 
} {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}}
216 
test text-6.13 {TextWidgetCmd procedure, "compare" option} {
217 
    list [catch {.t compare 1.0 z 1.2} msg] $msg
218 
} {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}}
219 
test text-6.14 {TextWidgetCmd procedure, "compare" option} {
220 
    list [catch {.t co 1.0 z 1.2} msg] $msg
221 
} {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
222 
 
223 
# "configure" option is already covered above
224 
 
225 
test text-7.1 {TextWidgetCmd procedure, "debug" option} {
226 
    list [catch {.t debug 0 1} msg] $msg
227 
} {1 {wrong # args: should be ".t debug boolean"}}
228 
test text-7.2 {TextWidgetCmd procedure, "debug" option} {
229 
    list [catch {.t de 0 1} msg] $msg
230 
} {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
231 
test text-7.3 {TextWidgetCmd procedure, "debug" option} {
232 
    .t debug true
233 
    .t deb
234 
} 1
235 
test text-7.4 {TextWidgetCmd procedure, "debug" option} {
236 
    .t debug false
237 
    .t debug
238 
} 0
239 
.t debug
240 
 
241 
test text-8.1 {TextWidgetCmd procedure, "delete" option} {
242 
    list [catch {.t delete} msg] $msg
243 
} {1 {wrong # args: should be ".t delete index1 ?index2?"}}
244 
test text-8.2 {TextWidgetCmd procedure, "delete" option} {
245 
    list [catch {.t delete a b c} msg] $msg
246 
} {1 {wrong # args: should be ".t delete index1 ?index2?"}}
247 
test text-8.3 {TextWidgetCmd procedure, "delete" option} {
248 
    list [catch {.t delete @x 2.2} msg] $msg
249 
} {1 {bad text index "@x"}}
250 
test text-8.4 {TextWidgetCmd procedure, "delete" option} {
251 
    list [catch {.t delete 2.3 @y} msg] $msg
252 
} {1 {bad text index "@y"}}
253 
test text-8.5 {TextWidgetCmd procedure, "delete" option} {
254 
    .t con -state disabled
255 
    .t delete 2.3
256 
    .t g 2.0 2.end
257 
} abcdefghijklm
258 
.t con -state normal
259 
test text-8.6 {TextWidgetCmd procedure, "delete" option} {
260 
    .t delete 2.3
261 
    .t get 2.0 2.end
262 
} abcefghijklm
263 
test text-8.7 {TextWidgetCmd procedure, "delete" option} {
264 
    .t delete 2.1 2.3
265 
    .t get 2.0 2.end
266 
} aefghijklm
267 
 
268 
test text-9.1 {TextWidgetCmd procedure, "get" option} {
269 
    list [catch {.t get} msg] $msg
270 
} {1 {wrong # args: should be ".t get index1 ?index2?"}}
271 
test text-9.2 {TextWidgetCmd procedure, "get" option} {
272 
    list [catch {.t get a b c} msg] $msg
273 
} {1 {wrong # args: should be ".t get index1 ?index2?"}}
274 
test text-9.3 {TextWidgetCmd procedure, "get" option} {
275 
    list [catch {.t get @q 3.1} msg] $msg
276 
} {1 {bad text index "@q"}}
277 
test text-9.4 {TextWidgetCmd procedure, "get" option} {
278 
    list [catch {.t get 3.1 @r} msg] $msg
279 
} {1 {bad text index "@r"}}
280 
test text-9.5 {TextWidgetCmd procedure, "get" option} {
281 
    .t get 5.7 5.3
282 
} {}
283 
test text-9.6 {TextWidgetCmd procedure, "get" option} {
284 
    .t get 5.3 5.5
285 
} { G}
286 
test text-9.7 {TextWidgetCmd procedure, "get" option} {
287 
    .t get 5.3 end
288 
} { GIrl .#@? x_yz
289 
!@#$%
290 
Line 7
291 
}
292 
.t mark set a 5.3
293 
.t mark set b 5.3
294 
.t mark set c 5.5
295 
test text-9.8 {TextWidgetCmd procedure, "get" option} {
296 
    .t get 5.2 5.7
297 
} {y GIr}
298 
test text-9.9 {TextWidgetCmd procedure, "get" option} {
299 
    .t get 5.2
300 
} {y}
301 
test text-9.10 {TextWidgetCmd procedure, "get" option} {
302 
    .t get 5.2 5.4
303 
} {y }
304 
 
305 
test text-10.1 {TextWidgetCmd procedure, "index" option} {
306 
    list [catch {.t index} msg] $msg
307 
} {1 {wrong # args: should be ".t index index"}}
308 
test text-10.2 {TextWidgetCmd procedure, "index" option} {
309 
    list [catch {.t ind a b} msg] $msg
310 
} {1 {wrong # args: should be ".t index index"}}
311 
test text-10.3 {TextWidgetCmd procedure, "index" option} {
312 
    list [catch {.t in a b} msg] $msg
313 
} {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
314 
test text-10.4 {TextWidgetCmd procedure, "index" option} {
315 
    list [catch {.t index @xyz} msg] $msg
316 
} {1 {bad text index "@xyz"}}
317 
test text-10.5 {TextWidgetCmd procedure, "index" option} {
318 
    .t index 1.2
319 
} 1.2
320 
 
321 
test text-11.1 {TextWidgetCmd procedure, "insert" option} {
322 
    list [catch {.t insert 1.2} msg] $msg
323 
} {1 {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"}}
324 
test text-11.2 {TextWidgetCmd procedure, "insert" option} {
325 
    .t config -state disabled
326 
    .t insert 1.2 xyzzy
327 
    .t get 1.0 1.end
328 
} {Line 1}
329 
.t config -state normal
330 
test text-11.3 {TextWidgetCmd procedure, "insert" option} {
331 
    .t insert 1.2 xyzzy
332 
    .t get 1.0 1.end
333 
} {Lixyzzyne 1}
334 
test text-11.4 {TextWidgetCmd procedure, "insert" option} {
335 
    .t delete 1.0 end
336 
    .t insert 1.0 "Sample text" x
337 
    .t tag ranges x
338 
} {1.0 1.11}
339 
test text-11.5 {TextWidgetCmd procedure, "insert" option} {
340 
    .t delete 1.0 end
341 
    .t insert 1.0 "Sample text" x
342 
    .t insert 1.2 "XYZ" y
343 
    list [.t tag ranges x] [.t tag ranges y]
344 
} {{1.0 1.2 1.5 1.14} {1.2 1.5}}
345 
test text-11.6 {TextWidgetCmd procedure, "insert" option} {
346 
    .t delete 1.0 end
347 
    .t insert 1.0 "Sample text" {x y z}
348 
    list [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
349 
} {{1.0 1.11} {1.0 1.11} {1.0 1.11}}
350 
test text-11.7 {TextWidgetCmd procedure, "insert" option} {
351 
    .t delete 1.0 end
352 
    .t insert 1.0 "Sample text" {x y z}
353 
    .t insert 1.3 "A" {a b z}
354 
    list [.t tag ranges a] [.t tag ranges b] [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
355 
} {{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}}
356 
test text-11.8 {TextWidgetCmd procedure, "insert" option} {
357 
    .t delete 1.0 end
358 
    list [catch {.t insert 1.0 "Sample text" "a \{b"} msg] $msg
359 
} {1 {unmatched open brace in list}}
360 
test text-11.9 {TextWidgetCmd procedure, "insert" option} {
361 
    .t delete 1.0 end
362 
    .t insert 1.0 "First" bold " " {} second "x y z" " third"
363 
    list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges x] \
364 
            [.t tag ranges y] [.t tag ranges z]
365 
} {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}}
366 
test text-11.10 {TextWidgetCmd procedure, "insert" option} {
367 
    .t delete 1.0 end
368 
    .t insert 1.0 "First" bold " second" silly
369 
    list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly]
370 
} {{First second} {1.0 1.5} {1.5 1.12}}
371 
 
372 
# Mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere.
373 
 
374 
test text-12.1 {ConfigureText procedure} {
375 
    list [catch {.t2 configure -state foobar} msg] $msg
376 
} {1 {bad state value "foobar": must be normal or disabled}}
377 
test text-12.2 {ConfigureText procedure} {
378 
    .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1
379 
    list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
380 
} {0 1 1}
381 
test text-12.3 {ConfigureText procedure} {
382 
    .t2 configure -spacing1 1 -spacing2 -1 -spacing3 1
383 
    list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
384 
} {1 0 1}
385 
test text-12.4 {ConfigureText procedure} {
386 
    .t2 configure -spacing1 1 -spacing2 1 -spacing3 -3
387 
    list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
388 
} {1 1 0}
389 
test text-12.5 {ConfigureText procedure} {
390 
    set x [list [catch {.t2 configure -tabs {30 foo}} msg] $msg $errorInfo]
391 
    .t2 configure -tabs {10 20 30}
392 
    set x
393 
} {1 {bad tab alignment "foo": must be left, right, center, or numeric} {bad tab alignment "foo": must be left, right, center, or numeric
394 
    (while processing -tabs option)
395 
    invoked from within
396 
".t2 configure -tabs {30 foo}"}}
397 
test text-12.6 {ConfigureText procedure} {
398 
    .t2 configure -tabs {10 20 30}
399 
    .t2 configure -tabs {}
400 
    .t2 cget -tabs
401 
} {}
402 
test text-12.7 {ConfigureText procedure} {
403 
    list [catch {.t2 configure -wrap bogus} msg] $msg
404 
} {1 {bad wrap mode "bogus": must be char, none, or word}}
405 
test text-12.8 {ConfigureText procedure} {
406 
    .t2 configure -selectborderwidth 17 -selectforeground #332211 \
407 
            -selectbackground #abc
408 
    list [lindex [.t2 tag config sel -borderwidth] 4] \
409 
        [lindex [.t2 tag config sel -foreground] 4] \
410 
        [lindex [.t2 tag config sel -background] 4]
411 
} {17 #332211 #abc}
412 
test text-12.9 {ConfigureText procedure} {
413 
    .t2 configure -selectborderwidth {}
414 
    .t2 tag cget sel -borderwidth
415 
} {}
416 
test text-12.10 {ConfigureText procedure} {
417 
    list [catch {.t2 configure -selectborderwidth foo} msg] $msg
418 
} {1 {bad screen distance "foo"}}
419 
test text-12.11 {ConfigureText procedure} {
420 
    catch {destroy .t2}
421 
    .t.e select to 2
422 
    text .t2 -exportselection 1
423 
    selection get
424 
} {ab}
425 
test text-12.12 {ConfigureText procedure} {
426 
    catch {destroy .t2}
427 
    .t.e select to 2
428 
    text .t2 -exportselection 0
429 
    .t2 insert insert 1234657890
430 
    .t2 tag add sel 1.0 1.4
431 
    selection get
432 
} {ab}
433 
test text-12.13 {ConfigureText procedure} {
434 
    catch {destroy .t2}
435 
    .t.e select to 1
436 
    text .t2 -exportselection 1
437 
    .t2 insert insert 1234657890
438 
    .t2 tag add sel 1.0 1.4
439 
    selection get
440 
} {1234}
441 
test text-12.14 {ConfigureText procedure} {
442 
    catch {destroy .t2}
443 
    .t.e select to 1
444 
    text .t2 -exportselection 0
445 
    .t2 insert insert 1234657890
446 
    .t2 tag add sel 1.0 1.4
447 
    .t2 configure -exportselection 1
448 
    selection get
449 
} {1234}
450 
test text-12.15 {ConfigureText procedure} {
451 
    catch {destroy .t2}
452 
    text .t2 -exportselection 1
453 
    .t2 insert insert 1234657890
454 
    .t2 tag add sel 1.0 1.4
455 
    set result [selection get]
456 
    .t2 configure -exportselection 0
457 
    lappend result [catch {selection get} msg] $msg
458 
} {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
459 
test text-12.16 {ConfigureText procedure} {fonts} {
460 
    # This test is non-portable because the window size will vary depending
461 
    # on the font size, which can vary.
462 
 
463 
    catch {destroy .t2}
464 
    toplevel .t2
465 
    text .t2.t -width 20 -height 10
466 
    pack append .t2 .t2.t top
467 
    wm geometry .t2 +0+0
468 
    update
469 
    wm geometry .t2
470 
} {150x140+0+0}
471 
test text-12.17 {ConfigureText procedure} {
472 
    # This test was failing Windows because the title bar on .t2
473 
    # was a certain minimum size and it was interfering with the size
474 
    # requested by the -setgrid.  The "overrideredirect" gets rid of the
475 
    # titlebar so the toplevel can shrink to the appropriate size.
476 
 
477 
    catch {destroy .t2}
478 
    toplevel .t2
479 
    wm overrideredirect .t2 1
480 
    text .t2.t -width 20 -height 10 -setgrid 1
481 
    pack append .t2 .t2.t top
482 
    wm geometry .t2 +0+0
483 
    update
484 
    wm geometry .t2
485 
} {20x10+0+0}
486 
test text-12.18 {ConfigureText procedure} {
487 
    # This test was failing on Windows because the title bar on .t2
488 
    # was a certain minimum size and it was interfering with the size
489 
    # requested by the -setgrid.  The "overrideredirect" gets rid of the
490 
    # titlebar so the toplevel can shrink to the appropriate size.
491 
 
492 
    catch {destroy .t2}
493 
    toplevel .t2
494 
    wm overrideredirect .t2 1
495 
    text .t2.t -width 20 -height 10 -setgrid 1
496 
    pack append .t2 .t2.t top
497 
    wm geometry .t2 +0+0
498 
    update
499 
    set result [wm geometry .t2]
500 
    wm geometry .t2 15x8
501 
    update
502 
    lappend result [wm geometry .t2]
503 
    .t2.t configure -wrap word
504 
    update
505 
    lappend result [wm geometry .t2]
506 
} {20x10+0+0 15x8+0+0 15x8+0+0}
507 
 
508 
test text-13.1 {TextWorldChanged procedure, spacing options} fonts {
509 
    catch {destroy .t2}
510 
    text .t2 -width 20 -height 10
511 
    set result [winfo reqheight .t2]
512 
    .t2 configure -spacing1 2
513 
    lappend result [winfo reqheight .t2]
514 
    .t2  configure -spacing3 1
515 
    lappend result [winfo reqheight .t2]
516 
    .t2 configure -spacing1 0
517 
    lappend result [winfo reqheight .t2]
518 
} {140 160 170 150}
519 
 
520 
test text-14.1 {TextEventProc procedure} {
521 
    text .tx1 -bg #543210
522 
    rename .tx1 .tx2
523 
    set x {}
524 
    lappend x [winfo exists .tx1]
525 
    lappend x [.tx2 cget -bg]
526 
    destroy .tx1
527 
    lappend x [info command .tx*] [winfo exists .tx1] [winfo exists .tx2]
528 
} {1 #543210 {} 0 0}
529 
 
530 
test text-15.1 {TextCmdDeletedProc procedure} {
531 
    text .tx1
532 
    rename .tx1 {}
533 
    list [info command .tx*] [winfo exists .tx1]
534 
} {{} 0}
535 
test text-15.2 {TextCmdDeletedProc procedure, disabling -setgrid} fonts {
536 
    catch {destroy .top}
537 
    toplevel .top
538 
    wm geom .top +0+0
539 
    text .top.t -setgrid 1 -width 20 -height 10
540 
    pack .top.t
541 
    update
542 
    set x [wm geometry .top]
543 
    rename .top.t {}
544 
    update
545 
    lappend x [wm geometry .top]
546 
    destroy .top
547 
    set x
548 
} {20x10+0+0 150x140+0+0}
549 
 
550 
test text-16.1 {InsertChars procedure} {
551 
    catch {destroy .t2}
552 
    text .t2
553 
    .t2 insert 2.0 abcd\n
554 
    .t2 get 1.0 end
555 
} {abcd
556 
 
557 
}
558 
test text-16.2 {InsertChars procedure} {
559 
    catch {destroy .t2}
560 
    text .t2
561 
    .t2 insert 1.0 abcd\n
562 
    .t2 insert end 123\n
563 
    .t2 get 1.0 end
564 
} {abcd
565 
123
566 
 
567 
}
568 
test text-16.3 {InsertChars procedure} {
569 
    catch {destroy .t2}
570 
    text .t2
571 
    .t2 insert 1.0 abcd\n
572 
    .t2 insert 10.0 123
573 
    .t2 get 1.0 end
574 
} {abcd
575 
123
576 
}
577 
test text-16.4 {InsertChars procedure, inserting on top visible line} {
578 
    catch {destroy .t2}
579 
    text .t2 -width 20 -height 4 -wrap word
580 
    pack .t2
581 
    .t2 insert insert "Now is the time for all great men to come to the "
582 
    .t2 insert insert "aid of their party.\n"
583 
    .t2 insert insert "Now is the time for all great men.\n"
584 
    .t2 see end
585 
    update
586 
    .t2 insert 1.0 "Short\n"
587 
    .t2 index @0,0
588 
} {2.56}
589 
test text-16.5 {InsertChars procedure, inserting on top visible line} {
590 
    catch {destroy .t2}
591 
    text .t2 -width 20 -height 4 -wrap word
592 
    pack .t2
593 
    .t2 insert insert "Now is the time for all great men to come to the "
594 
    .t2 insert insert "aid of their party.\n"
595 
    .t2 insert insert "Now is the time for all great men.\n"
596 
    .t2 see end
597 
    update
598 
    .t2 insert 1.55 "Short\n"
599 
    .t2 index @0,0
600 
} {2.0}
601 
test text-16.6 {InsertChars procedure, inserting on top visible line} {
602 
    catch {destroy .t2}
603 
    text .t2 -width 20 -height 4 -wrap word
604 
    pack .t2
605 
    .t2 insert insert "Now is the time for all great men to come to the "
606 
    .t2 insert insert "aid of their party.\n"
607 
    .t2 insert insert "Now is the time for all great men.\n"
608 
    .t2 see end
609 
    update
610 
    .t2 insert 1.56 "Short\n"
611 
    .t2 index @0,0
612 
} {1.56}
613 
test text-16.7 {InsertChars procedure, inserting on top visible line} {
614 
    catch {destroy .t2}
615 
    text .t2 -width 20 -height 4 -wrap word
616 
    pack .t2
617 
    .t2 insert insert "Now is the time for all great men to come to the "
618 
    .t2 insert insert "aid of their party.\n"
619 
    .t2 insert insert "Now is the time for all great men.\n"
620 
    .t2 see end
621 
    update
622 
    .t2 insert 1.57 "Short\n"
623 
    .t2 index @0,0
624 
} {1.56}
625 
catch {destroy .t2}
626 
 
627 
proc setup {} {
628 
    .t delete 1.0 end
629 
    .t insert 1.0 "Line 1
630 
abcde
631 
12345
632 
Line 4"
633 
}
634 
 
635 
.t delete 1.0 end
636 
test text-17.1 {DeleteChars procedure} {
637 
    .t get 1.0 end
638 
} {
639 
}
640 
test text-17.2 {DeleteChars procedure} {
641 
    list [catch {.t delete foobar} msg] $msg
642 
} {1 {bad text index "foobar"}}
643 
test text-17.3 {DeleteChars procedure} {
644 
    list [catch {.t delete 1.0 lousy} msg] $msg
645 
} {1 {bad text index "lousy"}}
646 
test text-17.4 {DeleteChars procedure} {
647 
    setup
648 
    .t delete 2.1
649 
    .t get 1.0 end
650 
} {Line 1
651 
acde
652 
12345
653 
Line 4
654 
}
655 
test text-17.5 {DeleteChars procedure} {
656 
    setup
657 
    .t delete 2.3
658 
    .t get 1.0 end
659 
} {Line 1
660 
abce
661 
12345
662 
Line 4
663 
}
664 
test text-17.6 {DeleteChars procedure} {
665 
    setup
666 
    .t delete 2.end
667 
    .t get 1.0 end
668 
} {Line 1
669 
abcde12345
670 
Line 4
671 
}
672 
test text-17.7 {DeleteChars procedure} {
673 
    setup
674 
    .t tag add sel 4.2 end
675 
    .t delete 4.2 end
676 
    list [.t tag ranges sel] [.t get 1.0 end]
677 
} {{} {Line 1
678 
abcde
679 
12345
680 
Li
681 
}}
682 
test text-17.8 {DeleteChars procedure} {
683 
    setup
684 
    .t tag add sel 1.0 end
685 
    .t delete 4.0 end
686 
    list [.t tag ranges sel] [.t get 1.0 end]
687 
} {{1.0 3.5} {Line 1
688 
abcde
689 
12345
690 
}}
691 
test text-17.9 {DeleteChars procedure} {
692 
    setup
693 
    .t delete 2.2 2.2
694 
    .t get 1.0 end
695 
} {Line 1
696 
abcde
697 
12345
698 
Line 4
699 
}
700 
test text-17.10 {DeleteChars procedure} {
701 
    setup
702 
    .t delete 2.3 2.1
703 
    .t get 1.0 end
704 
} {Line 1
705 
abcde
706 
12345
707 
Line 4
708 
}
709 
test text-17.11 {DeleteChars procedure} {
710 
    catch {destroy .t2}
711 
    toplevel .t2
712 
    text .t2.t -width 20 -height 5
713 
    pack append .t2 .t2.t top
714 
    wm geometry .t2 +0+0
715 
    .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
716 
    update
717 
    .t2.t delete 1.0 3.0
718 
    list [.t2.t index @0,0] [.t2.t get @0,0]
719 
} {1.0 x}
720 
test text-17.12 {DeleteChars procedure} {
721 
    catch {destroy .t2}
722 
    toplevel .t2
723 
    text .t2.t -width 20 -height 5
724 
    pack append .t2 .t2.t top
725 
    wm geometry .t2 +0+0
726 
    .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
727 
    .t2.t yview 3.0
728 
    update
729 
    .t2.t delete 2.0 4.0
730 
    list [.t2.t index @0,0] [.t2.t get @0,0]
731 
} {2.0 y}
732 
catch {destroy .t2}
733 
toplevel .t2
734 
text .t2.t -width 1 -height 10 -wrap char
735 
frame .t2.f -width 200 -height 20 -relief raised -bd 2
736 
pack .t2.f .t2.t -side left
737 
wm geometry .t2 +0+0
738 
update
739 
test text-17.13 {DeleteChars procedure, updates affecting topIndex} {
740 
    .t2.t delete 1.0 end
741 
    .t2.t insert end "abcde\n12345\nqrstuv"
742 
    .t2.t yview 2.1
743 
    .t2.t delete 1.4 2.3
744 
    .t2.t index @0,0
745 
} {1.2}
746 
test text-17.14 {DeleteChars procedure, updates affecting topIndex} {
747 
    .t2.t delete 1.0 end
748 
    .t2.t insert end "abcde\n12345\nqrstuv"
749 
    .t2.t yview 2.1
750 
    .t2.t delete 2.3 2.4
751 
    .t2.t index @0,0
752 
} {2.0}
753 
test text-17.15 {DeleteChars procedure, updates affecting topIndex} {
754 
    .t2.t delete 1.0 end
755 
    .t2.t insert end "abcde\n12345\nqrstuv"
756 
    .t2.t yview 1.3
757 
    .t2.t delete 1.0 1.2
758 
    .t2.t index @0,0
759 
} {1.1}
760 
test text-17.16 {DeleteChars procedure, updates affecting topIndex} {
761 
    catch {destroy .t2}
762 
    toplevel .t2
763 
    text .t2.t -width 6 -height 10 -wrap word
764 
    frame .t2.f -width 200 -height 20 -relief raised -bd 2
765 
    pack .t2.f .t2.t -side left
766 
    wm geometry .t2 +0+0
767 
    update
768 
    .t2.t insert end "abc def\n01 2345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n"
769 
    .t2.t yview 2.4
770 
    .t2.t delete 2.5
771 
    set x [.t2.t index @0,0]
772 
    .t2.t delete 2.5
773 
    list $x [.t2.t index @0,0]
774 
} {2.3 2.0}
775 
 
776 
.t delete 1.0 end
777 
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} {
778 
    .t insert end $i.0$i.1$i.2$i.3$i.4\n
779 
}
780 
test text-18.1 {TextFetchSelection procedure} {
781 
    .t tag add sel 1.3 3.4
782 
    selection get
783 
} {a.1a.2a.3a.4
784 
b.0b.1b.2b.3b.4
785 
c.0c}
786 
test text-18.2 {TextFetchSelection procedure} {
787 
    .t tag add x 1.2
788 
    .t tag add x 1.4
789 
    .t tag add x 2.0
790 
    .t tag add x 2.3
791 
    .t tag remove sel 1.0 end
792 
    .t tag add sel 1.0 3.4
793 
    selection get
794 
} {a.0a.1a.2a.3a.4
795 
b.0b.1b.2b.3b.4
796 
c.0c}
797 
test text-18.3 {TextFetchSelection procedure} {
798 
    .t tag remove sel 1.0 end
799 
    .t tag add sel 13.3
800 
    selection get
801 
} {m}
802 
test text-18.4 {TextFetchSelection procedure} {
803 
    .t tag remove x 1.0 end
804 
    .t tag add sel 1.0 3.4
805 
    .t tag remove sel 1.0 end
806 
    .t tag add sel 1.2 1.5
807 
    .t tag add sel 2.4 3.1
808 
    .t tag add sel 10.0 10.end
809 
    .t tag add sel 13.3
810 
    selection get
811 
} {0a..1b.2b.3b.4
812 
cj.0j.1j.2j.3j.4m}
813 
set x ""
814 
for {set i 1} {$i < 200} {incr i} {
815 
    append x "This is line $i, padded to just about 53 characters.\n"
816 
}
817 
test text-18.5 {TextFetchSelection procedure, long selections} {
818 
    .t delete 1.0 end
819 
    .t insert end $x
820 
    .t tag add sel 1.0 end
821 
    selection get
822 
} $x\n
823 
 
824 
test text-19.1 {TkTextLostSelection procedure} {unixOnly} {
825 
    catch {destroy .t2}
826 
    text .t2
827 
    .t2 insert 1.0 "abc\ndef\nghijk\n1234"
828 
    .t2 tag add sel 1.2 3.3
829 
    .t.e select to 1
830 
    .t2 tag ranges sel
831 
} {}
832 
test text-19.2 {TkTextLostSelection procedure} {macOrPc} {
833 
    catch {destroy .t2}
834 
    text .t2
835 
    .t2 insert 1.0 "abc\ndef\nghijk\n1234"
836 
    .t2 tag add sel 1.2 3.3
837 
    .t.e select to 1
838 
    .t2 tag ranges sel
839 
} {1.2 3.3}
840 
catch {destroy .t2}
841 
test text-19.3 {TkTextLostSelection procedure} {
842 
    catch {destroy .t2}
843 
    text .t2
844 
    .t2 insert 1.0 "abcdef\nghijk\n1234"
845 
    .t2 tag add sel 1.0 1.3
846 
    set x [selection get]
847 
    selection clear
848 
    lappend x [catch {selection get} msg] $msg
849 
    .t2 tag add sel 1.0 1.3
850 
    lappend x [selection get]
851 
} {abc 1 {PRIMARY selection doesn't exist or form "STRING" not defined} abc}
852 
 
853 
.t delete 1.0 end
854 
.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
855 
test text-20.1 {TextSearchCmd procedure, argument parsing} {
856 
    list [catch {.t search -} msg] $msg
857 
} {1 {bad switch "-": must be -forward, -backward, -exact, -regexp, -nocase, -count, or --}}
858 
test text-20.2 {TextSearchCmd procedure, -backwards option} {
859 
    .t search -backwards xyz 1.4
860 
} {1.1}
861 
test text-20.3 {TextSearchCmd procedure, -forwards option} {
862 
    .t search -forwards xyz 1.4
863 
} {1.5}
864 
test text-20.4 {TextSearchCmd procedure, -exact option} {
865 
    .t search -f -exact x. 1.0
866 
} {1.9}
867 
test text-20.5 {TextSearchCmd procedure, -regexp option} {
868 
    .t search -b -regexp x.z 1.4
869 
} {1.1}
870 
test text-20.6 {TextSearchCmd procedure, -count option} {
871 
    set length unmodified
872 
    list [.t search -count length x. 1.4] $length
873 
} {1.9 2}
874 
test text-20.7 {TextSearchCmd procedure, -count option} {
875 
    list [catch {.t search -count} msg] $msg
876 
} {1 {no value given for "-count" option}}
877 
test text-20.8 {TextSearchCmd procedure, -nocase option} {
878 
    list [.t search -nocase BaR 1.1] [.t search BaR 1.1]
879 
} {2.13 2.23}
880 
test text-20.9 {TextSearchCmd procedure, -nocase option} {
881 
    .t search -n BaR 1.1
882 
} {2.13}
883 
test text-20.10 {TextSearchCmd procedure, -- option} {
884 
    .t search -- -forward 1.0
885 
} {2.4}
886 
test text-20.11 {TextSearchCmd procedure, argument parsing} {
887 
    list [catch {.t search abc} msg] $msg
888 
} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
889 
test text-20.12 {TextSearchCmd procedure, argument parsing} {
890 
    list [catch {.t search abc d e f} msg] $msg
891 
} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
892 
test text-20.13 {TextSearchCmd procedure, check index} {
893 
    list [catch {.t search abc gorp} msg] $msg
894 
} {1 {bad text index "gorp"}}
895 
test text-20.14 {TextSearchCmd procedure, startIndex == "end"} {
896 
    .t search non-existent end
897 
} {}
898 
test text-20.15 {TextSearchCmd procedure, startIndex == "end"} {
899 
    .t search non-existent end
900 
} {}
901 
test text-20.16 {TextSearchCmd procedure, bad stopIndex} {
902 
    list [catch {.t search abc 1.0 lousy} msg] $msg
903 
} {1 {bad text index "lousy"}}
904 
test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
905 
    list [.t search -nocase BAR 1.1] [.t search BAR 1.1]
906 
} {2.13 {}}
907 
test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
908 
    list [catch {.t search -regexp a( 1.0} msg] $msg
909 
} {1 {couldn't compile regular expression pattern: unmatched ()}}
910 
test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
911 
    .t search -backwards BaR end 1.0
912 
} {2.23}
913 
test text-20.20 {TextSearchCmd procedure, skip dummy last line} {
914 
    .t search -backwards \n end 1.0
915 
} {3.9}
916 
test text-20.21 {TextSearchCmd procedure, skip dummy last line} {
917 
    .t search \n end
918 
} {1.15}
919 
test text-20.22 {TextSearchCmd procedure, skip dummy last line} {
920 
    .t search -back \n 1.0
921 
} {3.9}
922 
test text-20.23 {TextSearchCmd procedure, extract line contents} {
923 
    .t tag add foo 1.2
924 
    .t tag add x 1.3
925 
    .t mark set silly 1.2
926 
    .t search xyz 3.6
927 
} {1.1}
928 
test text-20.24 {TextSearchCmd procedure, stripping newlines} {
929 
    .t search the\n 1.0
930 
} {1.12}
931 
test text-20.25 {TextSearchCmd procedure, stripping newlines} {
932 
    .t search -regexp the\n 1.0
933 
} {}
934 
test text-20.26 {TextSearchCmd procedure, stripping newlines} {
935 
    .t search -regexp {the$} 1.0
936 
} {1.12}
937 
test text-20.27 {TextSearchCmd procedure, stripping newlines} {
938 
    .t search -regexp \n 1.0
939 
} {}
940 
test text-20.28 {TextSearchCmd procedure, line case conversion} {
941 
    list [.t search -nocase bar 2.18] [.t search bar 2.18]
942 
} {2.23 2.13}
943 
test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} {
944 
    .t search -backwards xyz 1.6
945 
} {1.5}
946 
test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} {
947 
    .t search -backwards xyz 1.5
948 
} {1.1}
949 
test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} {
950 
    .t search xyz 1.5
951 
} {1.5}
952 
test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} {
953 
    .t search xyz 1.6
954 
} {3.0}
955 
test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} {
956 
    .t search {} 1.end
957 
} {1.15}
958 
test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} {
959 
    .t search f 1.end
960 
} {2.0}
961 
test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} {
962 
    .t search {} end
963 
} {1.0}
964 
catch {destroy .t2}
965 
toplevel .t2
966 
wm geometry .t2 +0+0
967 
text .t2.t -width 30 -height 10
968 
pack .t2.t
969 
.t2.t insert 1.0 "This is a line\nand this is another"
970 
.t2.t insert end "\nand this is yet another"
971 
frame .t2.f -width 20 -height 20 -bd 2 -relief raised
972 
.t2.t window create 2.5 -window .t2.f
973 
test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} {
974 
    .t2.t search his 2.6
975 
} {2.6}
976 
test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} {
977 
    .t2.t search this 2.6
978 
} {3.4}
979 
test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} {
980 
    .t2.t search is 2.6
981 
} {2.7}
982 
test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} {
983 
    .t2.t search his 2.7
984 
} {3.5}
985 
test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} {
986 
    .t2.t search -backwards "his is another" 2.6
987 
} {2.6}
988 
test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} {
989 
    .t2.t search -backwards "his is" 2.6
990 
} {1.1}
991 
destroy .t2
992 
test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} {
993 
    .t search -backwards forw 2.5
994 
} {2.5}
995 
test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} {
996 
    .t search forw 2.5
997 
} {2.5}
998 
test text-20.44 {TextSearchCmd procedure, firstChar and lastChar} {
999 
    catch {destroy .t2}
1000 
    text .t2
1001 
    list [.t2 search a 1.0] [.t2 search -backward a 1.0]
1002 
} {{} {}}
1003 
test text-20.45 {TextSearchCmd procedure, regexp match length} {
1004 
    set length unchanged
1005 
    list [.t search -regexp -count length x(.)(.*)z 1.1] $length
1006 
} {1.1 7}
1007 
test text-20.46 {TextSearchCmd procedure, regexp match length} {
1008 
    set length unchanged
1009 
    list [.t search -regexp -backward -count length fo* 2.5] $length
1010 
} {2.0 3}
1011 
test text-20.47 {TextSearchCmd procedure, checking stopIndex} {
1012 
    list [.t search bar 2.1 2.13] [.t search bar 2.1 2.14] \
1013 
            [.t search bar 2.12 2.14] [.t search bar 2.14 2.14]
1014 
} {{} 2.13 2.13 {}}
1015 
test text-20.48 {TextSearchCmd procedure, checking stopIndex} {
1016 
    list [.t search -backwards bar 2.20 2.13] \
1017 
            [.t search -backwards bar 2.20 2.14] \
1018 
            [.t search -backwards bar 2.14 2.13] \
1019 
            [.t search -backwards bar 2.13 2.13]
1020 
} {2.13 {} 2.13 {}}
1021 
test text-20.49 {TextSearchCmd procedure, embedded windows and index/count} {
1022 
    frame .t.f1 -width 20 -height 20 -relief raised -bd 2
1023 
    frame .t.f2 -width 20 -height 20 -relief raised -bd 2
1024 
    frame .t.f3 -width 20 -height 20 -relief raised -bd 2
1025 
    frame .t.f4 -width 20 -height 20 -relief raised -bd 2
1026 
    .t window create 2.10 -window .t.f3
1027 
    .t window create 2.8 -window .t.f2
1028 
    .t window create 2.8 -window .t.f1
1029 
    .t window create 2.1 -window .t.f4
1030 
    set result ""
1031 
    lappend result [.t search -count x forward 1.0] $x
1032 
    lappend result [.t search -count x wa 1.0] $x
1033 
    .t delete 2.1
1034 
    .t delete 2.8 2.10
1035 
    .t delete 2.10
1036 
    set result
1037 
} {2.6 10 2.11 2}
1038 
test text-20.50 {TextSearchCmd procedure, error setting variable} {
1039 
    catch {unset a}
1040 
    set a 44
1041 
    list [catch {.t search -count a(2) xyz 1.0} msg] $msg
1042 
} {1 {can't set "a(2)": variable isn't array}}
1043 
test text-20.51 {TextSearchCmd procedure, wrap-around} {
1044 
    .t search -backwards xyz 1.1
1045 
} {3.5}
1046 
test text-20.52 {TextSearchCmd procedure, wrap-around} {
1047 
    .t search -backwards xyz 1.1 1.0
1048 
} {}
1049 
test text-20.53 {TextSearchCmd procedure, wrap-around} {
1050 
    .t search xyz 3.6
1051 
} {1.1}
1052 
test text-20.54 {TextSearchCmd procedure, wrap-around} {
1053 
    .t search xyz 3.6 end
1054 
} {}
1055 
test text-20.55 {TextSearchCmd procedure, no match} {
1056 
    .t search non_existent 3.5
1057 
} {}
1058 
test text-20.56 {TextSearchCmd procedure, no match} {
1059 
    .t search -regexp non_existent 3.5
1060 
} {}
1061 
test text-20.57 {TextSearchCmd procedure, special cases} {
1062 
    .t search -back x 1.1
1063 
} {1.0}
1064 
test text-20.58 {TextSearchCmd procedure, special cases} {
1065 
    .t search -back x 1.0
1066 
} {3.8}
1067 
test text-20.59 {TextSearchCmd procedure, special cases} {
1068 
    .t search \n {end-2c}
1069 
} {3.9}
1070 
test text-20.60 {TextSearchCmd procedure, special cases} {
1071 
    .t search \n end
1072 
} {1.15}
1073 
test text-20.61 {TextSearchCmd procedure, special cases} {
1074 
    .t search x 1.0
1075 
} {1.0}
1076 
test text-20.62 {TextSearchCmd, freeing copy of pattern} {
1077 
    # This test doesn't return a result, but it will generate
1078 
    # a core leak if the pattern copy isn't properly freed.
1079 
 
1080 
    set p abcdefg1234567890
1081 
    set p $p$p$p$p$p$p$p$p
1082 
    set p $p$p$p$p$p
1083 
    .t search -nocase $p 1.0
1084 
} {}
1085 
 
1086 
eval destroy [winfo child .]
1087 
text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
1088 
pack .t2
1089 
.t2 insert end "1\t2\t3\t4\t55.5"
1090 
test text-21.1 {TkTextGetTabs procedure} {
1091 
    list [catch {.t2 configure -tabs "\{{}"} msg] $msg
1092 
} {1 {unmatched open brace in list}}
1093 
test text-21.2 {TkTextGetTabs procedure} {
1094 
    list [catch {.t2 configure -tabs xyz} msg] $msg
1095 
} {1 {bad screen distance "xyz"}}
1096 
test text-21.3 {TkTextGetTabs procedure} {
1097 
    .t2 configure -tabs {100 200}
1098 
    update idletasks
1099 
    list [lindex [.t2 bbox 1.2] 0] [lindex [.t2 bbox 1.4] 0]
1100 
} {100 200}
1101 
test text-21.4 {TkTextGetTabs procedure} {
1102 
    .t2 configure -tabs {100 right 200 left 300 center 400 numeric}
1103 
    update idletasks
1104 
    list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
1105 
            [lindex [.t2 bbox 1.4] 0] \
1106 
            [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
1107 
            [lindex [.t2 bbox 1.10] 0]
1108 
} {100 200 300 400}
1109 
test text-21.5 {TkTextGetTabs procedure} {
1110 
    .t2 configure -tabs {105 r 205 l 305 c 405 n}
1111 
    update idletasks
1112 
    list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
1113 
            [lindex [.t2 bbox 1.4] 0] \
1114 
            [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
1115 
            [lindex [.t2 bbox 1.10] 0]
1116 
} {105 205 305 405}
1117 
test text-21.6 {TkTextGetTabs procedure} {
1118 
    list [catch {.t2 configure -tabs {100 left 200 lork}} msg] $msg
1119 
} {1 {bad tab alignment "lork": must be left, right, center, or numeric}}
1120 
test text-21.7 {TkTextGetTabs procedure} {
1121 
    list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg
1122 
} {1 {bad screen distance "!44"}}
1123 
 
1124 
eval destroy [winfo child .]
1125 
text .t
1126 
pack .t
1127 
.t insert 1.0 "One Line"
1128 
.t mark set insert 1.0
1129 
 
1130 
test text-22.1 {TextDumpCmd procedure, bad args} {
1131 
    list [catch {.t dump} msg] $msg
1132 
} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
1133 
test text-22.2 {TextDumpCmd procedure, bad args} {
1134 
    list [catch {.t dump -all} msg] $msg
1135 
} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
1136 
test text-22.3 {TextDumpCmd procedure, bad args} {
1137 
    list [catch {.t dump -command} msg] $msg
1138 
} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
1139 
test text-22.4 {TextDumpCmd procedure, bad args} {
1140 
    list [catch {.t dump -bogus} msg] $msg
1141 
} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
1142 
test text-22.5 {TextDumpCmd procedure, bad args} {
1143 
    list [catch {.t dump bogus} msg] $msg
1144 
} {1 {bad text index "bogus"}}
1145 
test text-22.6 {TextDumpCmd procedure, one index} {
1146 
    .t dump -text 1.2
1147 
} {text e 1.2}
1148 
test text-22.7 {TextDumpCmd procedure, two indices} {
1149 
    .t dump -text 1.0 1.end
1150 
} {text {One Line} 1.0}
1151 
test text-22.8 {TextDumpCmd procedure, "end" index} {
1152 
    .t dump -text 1.end end
1153 
} {text {
1154 
} 1.8}
1155 
test text-22.9 {TextDumpCmd procedure, same indices} {
1156 
    .t dump 1.5 1.5
1157 
} {}
1158 
test text-22.10 {TextDumpCmd procedure, negative range} {
1159 
    .t dump 1.5 1.0
1160 
} {}
1161 
 
1162 
.t delete 1.0 end
1163 
.t insert end "Line One\nLine Two\nLine Three\nLine Four"
1164 
.t mark set insert 1.0
1165 
.t mark set current 1.0
1166 
 
1167 
test text-22.11 {TextDumpCmd procedure, stop at begin-line} {
1168 
    .t dump -text 1.0 2.0
1169 
} {text {Line One
1170 
} 1.0}
1171 
test text-22.12 {TextDumpCmd procedure, span multiple lines} {
1172 
    .t dump -text 1.5 3.end
1173 
} {text {One
1174 
} 1.5 text {Line Two
1175 
} 2.0 text {Line Three} 3.0}
1176 
 
1177 
.t tag add x 2.0 2.end
1178 
.t tag add y 1.0 end
1179 
.t mark set m 2.4
1180 
.t mark set n 4.0
1181 
.t mark set END end
1182 
test text-22.13 {TextDumpCmd procedure, tags only} {
1183 
    .t dump -tag 2.1 2.8
1184 
} {}
1185 
test text-22.14 {TextDumpCmd procedure, tags only} {
1186 
    .t dump -tag 2.0 2.8
1187 
} {tagon x 2.0}
1188 
test text-22.15 {TextDumpCmd procedure, tags only} {
1189 
    .t dump -tag 1.0 4.end
1190 
} {tagon y 1.0 tagon x 2.0 tagoff x 2.8}
1191 
test text-22.16 {TextDumpCmd procedure, tags only} {
1192 
    .t dump -tag 1.0 end
1193 
} {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0}
1194 
 
1195 
.t mark set insert 1.0
1196 
.t mark set current 1.0
1197 
test text-22.17 {TextDumpCmd procedure, marks only} {
1198 
    .t dump -mark 1.1 1.8
1199 
} {}
1200 
test text-22.18 {TextDumpCmd procedure, marks only} {
1201 
    .t dump -mark 2.0 2.8
1202 
} {mark m 2.4}
1203 
test text-22.19 {TextDumpCmd procedure, marks only} {
1204 
    .t dump -mark 1.1 4.end
1205 
} {mark m 2.4 mark n 4.0}
1206 
test text-22.20 {TextDumpCmd procedure, marks only} {
1207 
    .t dump -mark 1.0 end
1208 
} {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0}
1209 
 
1210 
button .hello -text Hello
1211 
.t window create 3.end -window .hello
1212 
for {set i 0} {$i < 100} {incr i} {
1213 
    .t insert end "-\n"
1214 
}
1215 
.t window create 100.0 -create { }
1216 
test text-22.21 {TextDumpCmd procedure, windows only} {
1217 
    .t dump -window 1.0 5.0
1218 
} {window .hello 3.10}
1219 
test text-22.22 {TextDumpCmd procedure, windows only} {
1220 
    .t dump -window 5.0 end
1221 
} {window {} 100.0}
1222 
 
1223 
.t delete 1.0 end
1224 
eval {.t mark unset} [.t mark names]
1225 
.t insert end "Line One\nLine Two\nLine Three\nLine Four"
1226 
.t mark set insert 1.0
1227 
.t mark set current 1.0
1228 
.t tag add x 2.0 2.end
1229 
.t mark set m 2.4
1230 
proc Append {varName key value index} {
1231 
    upvar #0 $varName x
1232 
    lappend x $key $index $value
1233 
}
1234 
test text-22.23 {TextDumpCmd procedure, command script} {
1235 
    set x {}
1236 
    .t dump -command {Append x} -all 1.0 end
1237 
    set x
1238 
} {mark 1.0 current mark 1.0 insert text 1.0 {Line One
1239 
} tagon 2.0 x text 2.0 Line mark 2.4 m text 2.4 { Two} tagoff 2.8 x text 2.8 {
1240 
} text 3.0 {Line Three
1241 
} text 4.0 {Line Four
1242 
}}
1243 
test text-22.24 {TextDumpCmd procedure, command script} {
1244 
    set x {}
1245 
    .t dump -mark -command {Append x} 1.0 end
1246 
    set x
1247 
} {mark 1.0 current mark 1.0 insert mark 2.4 m}
1248 
catch {unset x}
1249 
 
1250 
set l [interp hidden]
1251 
eval destroy [winfo children .]
1252 
 
1253 
test text-23.1 {text widget vs hidden commands} {
1254 
    catch {destroy .t}
1255 
    text .t
1256 
    interp hide {} .t
1257 
    destroy .t
1258 
    list [winfo children .] [interp hidden]
1259 
} [list {} $l]
1260 
 
1261 
eval destroy [winfo child .]
1262 
option clear

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.