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

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [tk/] [tests/] [textTag.test] - Blame information for rev 1780

Go to most recent revision | 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 tkTextTag.c.
2
# This file is organized in the standard fashion for Tcl tests.
3
#
4
# Copyright (c) 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: textTag.test,v 1.1.1.1 2002-01-16 10:26:00 markom Exp $
11
 
12
if {[string compare test [info procs test]] == 1} then \
13
  {source defs}
14
 
15
catch {destroy .t}
16
if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
17
    puts "The font needed by these tests isn't available, so I'm"
18
    puts "going to skip the tests."
19
    return
20
}
21
pack append . .t {top expand fill}
22
update
23
.t debug on
24
wm geometry . {}
25
set bigFont {Helvetica 24}
26
 
27
# The statements below reset the main window;  it's needed if the window
28
# manager is mwm, to make mwm forget about a previous minimum size setting.
29
 
30
wm withdraw .
31
wm minsize . 1 1
32
wm positionfrom . user
33
wm deiconify .
34
 
35
entry .t.e
36
.t.e insert 0 "Text"
37
 
38
.t insert 1.0 "Line 1
39
abcdefghijklm
40
12345
41
Line 4
42
bOy GIrl .#@? x_yz
43
!@#$%
44
Line 7"
45
 
46
 
47
set i 1
48
foreach test {
49
    {-background #012345 #012345 non-existent
50
            {unknown color name "non-existent"}}
51
    {-bgstipple gray50 gray50 badStipple
52
            {bitmap "badStipple" not defined}}
53
    {-borderwidth 2 2 46q
54
            {bad screen distance "46q"}}
55
    {-fgstipple gray25 gray25 bogus
56
            {bitmap "bogus" not defined}}
57
    {-font fixed fixed {}
58
            {font "" doesn't exist}}
59
    {-foreground #001122 #001122 {silly color}
60
            {unknown color name "silly color"}}
61
    {-justify left left middle
62
            {bad justification "middle": must be left, right, or center}}
63
    {-lmargin1 10 10 bad
64
            {bad screen distance "bad"}}
65
    {-lmargin2 10 10 bad
66
            {bad screen distance "bad"}}
67
    {-offset 2 2 100xyz
68
            {bad screen distance "100xyz"}}
69
    {-overstrike on on stupid
70
            {expected boolean value but got "stupid"}}
71
    {-relief raised raised stupid
72
            {bad relief type "stupid": must be flat, groove, raised, ridge, solid, or sunken}}
73
    {-rmargin 10 10 bad
74
            {bad screen distance "bad"}}
75
    {-spacing1 10 10 bad
76
            {bad screen distance "bad"}}
77
    {-spacing2 10 10 bad
78
            {bad screen distance "bad"}}
79
    {-spacing3 10 10 bad
80
            {bad screen distance "bad"}}
81
    {-tabs {10 20 30} {10 20 30} {10 fork}
82
            {bad tab alignment "fork": must be left, right, center, or numeric}}
83
    {-underline no no stupid
84
            {expected boolean value but got "stupid"}}
85
} {
86
    set name [lindex $test 0]
87
    test textTag-1.$i {tag configuration options} {
88
        .t tag configure x $name [lindex $test 1]
89
        .t tag cget x $name
90
    } [lindex $test 2]
91
    incr i
92
    if {[lindex $test 3] != ""} {
93
        test textTag-1.$i {configuration options} {
94
            list [catch {.t tag configure x $name [lindex $test 3]} msg] $msg
95
        } [list 1 [lindex $test 4]]
96
    }
97
    .t tag configure x $name [lindex [.t tag configure x $name] 3]
98
    incr i
99
}
100
test textTag-2.1 {TkTextTagCmd - "add" option} {
101
    list [catch {.t tag} msg] $msg
102
} {1 {wrong # args: should be ".t tag option ?arg arg ...?"}}
103
test textTag-2.2 {TkTextTagCmd - "add" option} {
104
    list [catch {.t tag gorp} msg] $msg
105
} {1 {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, raise, ranges, or remove}}
106
test textTag-2.3 {TkTextTagCmd - "add" option} {
107
    list [catch {.t tag add foo} msg] $msg
108
} {1 {wrong # args: should be ".t tag add tagName index1 ?index2 index1 index2 ...?"}}
109
test textTag-2.4 {TkTextTagCmd - "add" option} {
110
    list [catch {.t tag add x gorp} msg] $msg
111
} {1 {bad text index "gorp"}}
112
test textTag-2.5 {TkTextTagCmd - "add" option} {
113
    list [catch {.t tag add x 1.2 gorp} msg] $msg
114
} {1 {bad text index "gorp"}}
115
test textTag-2.6 {TkTextTagCmd - "add" option} {
116
    .t tag add sel 3.2 3.4
117
    .t tag add sel 3.2 3.0
118
    .t tag ranges sel
119
} {3.2 3.4}
120
test textTag-2.7 {TkTextTagCmd - "add" option} {
121
    .t tag add x 1.0 1.end
122
    .t tag ranges x
123
} {1.0 1.6}
124
test textTag-2.8 {TkTextTagCmd - "add" option} {
125
    .t tag remove x 1.0 end
126
    .t tag add x 1.2
127
    .t tag ranges x
128
} {1.2 1.3}
129
test textTag-2.9 {TkTextTagCmd - "add" option} {
130
    .t.e select from 0
131
    .t.e select to 4
132
    .t tag add sel 3.2 3.4
133
    selection get
134
} 34
135
test textTag-2.11 {TkTextTagCmd - "add" option} {
136
    .t.e select from 0
137
    .t.e select to 4
138
    .t configure -exportselection 0
139
    .t tag add sel 3.2 3.4
140
    selection get
141
} Text
142
test textTag-2.12 {TkTextTagCmd - "add" option} {
143
    .t tag remove sel 1.0 end
144
    .t tag add sel 1.1 1.5 2.4 3.1 4.2 4.4
145
    .t tag ranges sel
146
} {1.1 1.5 2.4 3.1 4.2 4.4}
147
test textTag-2.13 {TkTextTagCmd - "add" option} {
148
    .t tag remove sel 1.0 end
149
    .t tag add sel 1.1 1.5 2.4
150
    .t tag ranges sel
151
} {1.1 1.5 2.4 2.5}
152
 
153
catch {.t tag delete x}
154
test textTag-3.1 {TkTextTagCmd - "bind" option} {
155
    list [catch {.t tag bind} msg] $msg
156
} {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}}
157
test textTag-3.2 {TkTextTagCmd - "bind" option} {
158
    list [catch {.t tag bind 1 2 3 4} msg] $msg
159
} {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}}
160
test textTag-3.3 {TkTextTagCmd - "bind" option} {
161
    .t tag bind x  script1
162
    .t tag bind x 
163
} script1
164
test textTag-3.4 {TkTextTagCmd - "bind" option} {
165
    list [catch {.t tag bind x  script2} msg] $msg
166
} {1 {bad event type or keysym "Gorp"}}
167
test textTag-3.5 {TkTextTagCmd - "bind" option} {
168
    .t tag delete x
169
    .t tag bind x  script1
170
    list [catch {.t tag bind x  script2} msg] $msg [.t tag bind x]
171
} {1 {requested illegal events; only key, button, motion, enter, leave, and virtual events may be used} }
172
test textTag-3.6 {TkTextTagCmd - "bind" option} {
173
    .t tag delete x
174
    .t tag bind x  script1
175
    .t tag bind x  script2
176
    .t tag bind x a xyzzy
177
    list [lsort [.t tag bind x]] [.t tag bind x ] [.t tag bind x a]
178
} {{  a} script1 xyzzy}
179
test textTag-3.7 {TkTextTagCmd - "bind" option} {
180
    .t tag delete x
181
    .t tag bind x  script1
182
    .t tag bind x  +script2
183
    .t tag bind x 
184
} {script1
185
script2}
186
 
187
 
188
test textTag-4.1 {TkTextTagCmd - "cget" option} {
189
    list [catch {.t tag cget a} msg] $msg
190
} {1 {wrong # args: should be ".t tag cget tagName option"}}
191
test textTag-4.2 {TkTextTagCmd - "cget" option} {
192
    list [catch {.t tag cget a b c} msg] $msg
193
} {1 {wrong # args: should be ".t tag cget tagName option"}}
194
test textTag-4.3 {TkTextTagCmd - "cget" option} {
195
    .t tag delete foo
196
    list [catch {.t tag cget foo bar} msg] $msg
197
} {1 {tag "foo" isn't defined in text widget}}
198
test textTag-4.4 {TkTextTagCmd - "cget" option} {
199
    list [catch {.t tag cget sel bogus} msg] $msg
200
} {1 {unknown option "bogus"}}
201
test textTag-4.5 {TkTextTagCmd - "cget" option} {
202
    .t tag delete x
203
    .t tag configure x -background red
204
    list [catch {.t tag cget x -background} msg] $msg
205
} {0 red}
206
 
207
test textTag-5.1 {TkTextTagCmd - "configure" option} {
208
    list [catch {.t tag configure} msg] $msg
209
} {1 {wrong # args: should be ".t tag configure tagName ?option? ?value? ?option value ...?"}}
210
test textTag-5.2 {TkTextTagCmd - "configure" option} {
211
    list [catch {.t tag configure x -foo} msg] $msg
212
} {1 {unknown option "-foo"}}
213
test textTag-5.3 {TkTextTagCmd - "configure" option} {
214
    list [catch {.t tag configure x -background red -underline} msg] $msg
215
} {1 {value for "-underline" missing}}
216
test textTag-5.4 {TkTextTagCmd - "configure" option} {
217
    .t tag delete x
218
    .t tag configure x -underline yes
219
    .t tag configure x -underline
220
} {-underline {} {} {} yes}
221
test textTag-5.5 {TkTextTagCmd - "configure" option} {
222
    .t tag delete x
223
    .t tag configure x -overstrike on
224
    .t tag cget x -overstrike
225
} {on}
226
test textTag-5.6 {TkTextTagCmd - "configure" option} {
227
    list [catch {.t tag configure x -overstrike foo} msg] $msg
228
} {1 {expected boolean value but got "foo"}}
229
test textTag-5.7 {TkTextTagCmd - "configure" option} {
230
    .t tag delete x
231
    list [catch {.t tag configure x -underline stupid} msg] $msg
232
} {1 {expected boolean value but got "stupid"}}
233
test textTag-5.8 {TkTextTagCmd - "configure" option} {
234
    .t tag delete x
235
    .t tag configure x -justify left
236
    .t tag configure x -justify
237
} {-justify {} {} {} left}
238
test textTag-5.9 {TkTextTagCmd - "configure" option} {
239
    .t tag delete x
240
    list [catch {.t tag configure x -justify bogus} msg] $msg
241
} {1 {bad justification "bogus": must be left, right, or center}}
242
test textTag-5.10 {TkTextTagCmd - "configure" option} {
243
    .t tag delete x
244
    list [catch {.t tag configure x -justify fill} msg] $msg
245
} {1 {bad justification "fill": must be left, right, or center}}
246
test textTag-5.11 {TkTextTagCmd - "configure" option} {
247
    .t tag delete x
248
    .t tag configure x -offset 2
249
    .t tag configure x -offset
250
} {-offset {} {} {} 2}
251
test textTag-5.12 {TkTextTagCmd - "configure" option} {
252
    .t tag delete x
253
    list [catch {.t tag configure x -offset 1.0q} msg] $msg
254
} {1 {bad screen distance "1.0q"}}
255
test textTag-5.13 {TkTextTagCmd - "configure" option} {
256
    .t tag delete x
257
    .t tag configure x -lmargin1 2 -lmargin2 4 -rmargin 5
258
    list [.t tag configure x -lmargin1] [.t tag configure x -lmargin2] \
259
            [.t tag configure x -rmargin]
260
} {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5}}
261
test textTag-5.14 {TkTextTagCmd - "configure" option} {
262
    .t tag delete x
263
    list [catch {.t tag configure x -lmargin1 2.0x} msg] $msg
264
} {1 {bad screen distance "2.0x"}}
265
test textTag-5.15 {TkTextTagCmd - "configure" option} {
266
    .t tag delete x
267
    list [catch {.t tag configure x -lmargin2 gorp} msg] $msg
268
} {1 {bad screen distance "gorp"}}
269
test textTag-5.16 {TkTextTagCmd - "configure" option} {
270
    .t tag delete x
271
    list [catch {.t tag configure x -rmargin 140.1.1} msg] $msg
272
} {1 {bad screen distance "140.1.1"}}
273
.t tag delete x
274
test textTag-5.17 {TkTextTagCmd - "configure" option} {
275
    .t tag delete x
276
    .t tag configure x -spacing1 2 -spacing2 4 -spacing3 6
277
    list [.t tag configure x -spacing1] [.t tag configure x -spacing2] \
278
            [.t tag configure x -spacing3]
279
} {{-spacing1 {} {} {} 2} {-spacing2 {} {} {} 4} {-spacing3 {} {} {} 6}}
280
test textTag-5.18 {TkTextTagCmd - "configure" option} {
281
    .t tag delete x
282
    list [catch {.t tag configure x -spacing1 2.0x} msg] $msg
283
} {1 {bad screen distance "2.0x"}}
284
test textTag-5.19 {TkTextTagCmd - "configure" option} {
285
    .t tag delete x
286
    list [catch {.t tag configure x -spacing1 lousy} msg] $msg
287
} {1 {bad screen distance "lousy"}}
288
test textTag-5.20 {TkTextTagCmd - "configure" option} {
289
    .t tag delete x
290
    list [catch {.t tag configure x -spacing1 4.2.3} msg] $msg
291
} {1 {bad screen distance "4.2.3"}}
292
test textTag-5.21 {TkTextTagCmd - "configure" option} {
293
    .t configure -selectborderwidth 2 -selectforeground blue \
294
            -selectbackground black
295
    .t tag configure sel -borderwidth 4 -foreground green -background yellow
296
    set x {}
297
    foreach i {-selectborderwidth -selectforeground -selectbackground} {
298
        lappend x [lindex [.t configure $i] 4]
299
    }
300
    set x
301
} {4 green yellow}
302
test textTag-5.22 {TkTextTagCmd - "configure" option} {
303
    .t configure -selectborderwidth 20
304
    .t tag configure sel -borderwidth {}
305
    .t cget -selectborderwidth
306
} {}
307
 
308
test textTag-6.1 {TkTextTagCmd - "delete" option} {
309
    list [catch {.t tag delete} msg] $msg
310
} {1 {wrong # args: should be ".t tag delete tagName tagName ..."}}
311
test textTag-6.2 {TkTextTagCmd - "delete" option} {
312
    list [catch {.t tag delete zork} msg] $msg
313
} {0 {}}
314
test textTag-6.3 {TkTextTagCmd - "delete" option} {
315
    .t tag delete x
316
    .t tag config x -background black
317
    .t tag config y -foreground white
318
    .t tag config z -background black
319
    .t tag delete y z
320
    lsort [.t tag names]
321
} {sel x}
322
test textTag-6.4 {TkTextTagCmd - "delete" option} {
323
    .t tag config x -background black
324
    .t tag config y -foreground white
325
    .t tag config z -background black
326
    eval .t tag delete [.t tag names]
327
    .t tag names
328
} {sel}
329
test textTag-6.5 {TkTextTagCmd - "delete" option} {
330
    .t tag bind x  foo
331
    .t tag delete x
332
    .t tag configure x -background black
333
    .t tag bind x
334
} {}
335
 
336
proc tagsetup {} {
337
    .t tag delete x y z a b c d
338
    .t tag remove sel 1.0 end
339
    foreach i {a b c d} {
340
        .t tag configure $i -background black
341
    }
342
}
343
test textTag-7.1 {TkTextTagCmd - "lower" option} {
344
    list [catch {.t tag lower} msg] $msg
345
} {1 {wrong # args: should be ".t tag lower tagName ?belowThis?"}}
346
test textTag-7.2 {TkTextTagCmd - "lower" option} {
347
    list [catch {.t tag lower foo} msg] $msg
348
} {1 {tag "foo" isn't defined in text widget}}
349
test textTag-7.3 {TkTextTagCmd - "lower" option} {
350
    list [catch {.t tag lower sel bar} msg] $msg
351
} {1 {tag "bar" isn't defined in text widget}}
352
test textTag-7.4 {TkTextTagCmd - "lower" option} {
353
    tagsetup
354
    .t tag lower c
355
    .t tag names
356
} {c sel a b d}
357
test textTag-7.5 {TkTextTagCmd - "lower" option} {
358
    tagsetup
359
    .t tag lower d b
360
    .t tag names
361
} {sel a d b c}
362
test textTag-7.6 {TkTextTagCmd - "lower" option} {
363
    tagsetup
364
    .t tag lower a c
365
    .t tag names
366
} {sel b a c d}
367
 
368
test textTag-8.1 {TkTextTagCmd - "names" option} {
369
    list [catch {.t tag names a b} msg] $msg
370
} {1 {wrong # args: should be ".t tag names ?index?"}}
371
test textTag-8.2 {TkTextTagCmd - "names" option} {
372
    tagsetup
373
    .t tag names
374
} {sel a b c d}
375
test textTag-8.3 {TkTextTagCmd - "names" option} {
376
    tagsetup
377
    .t tag add "a b" 2.1 2.6
378
    .t tag add c 2.4 2.7
379
    .t tag names 2.5
380
} {c {a b}}
381
 
382
.t tag delete x y z a b c d {a b}
383
.t tag add x 2.3 2.5
384
.t tag add x 2.9 3.1
385
.t tag add x 7.2
386
test textTag-9.1 {TkTextTagCmd - "nextrange" option} {
387
    list [catch {.t tag nextrange x} msg] $msg
388
} {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}}
389
test textTag-9.2 {TkTextTagCmd - "nextrange" option} {
390
    list [catch {.t tag nextrange x 1 2 3} msg] $msg
391
} {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}}
392
test textTag-9.3 {TkTextTagCmd - "nextrange" option} {
393
    list [catch {.t tag nextrange foo 1.0} msg] $msg
394
} {0 {}}
395
test textTag-9.4 {TkTextTagCmd - "nextrange" option} {
396
    list [catch {.t tag nextrange x foo} msg] $msg
397
} {1 {bad text index "foo"}}
398
test textTag-9.5 {TkTextTagCmd - "nextrange" option} {
399
    list [catch {.t tag nextrange x 1.0 bar} msg] $msg
400
} {1 {bad text index "bar"}}
401
test textTag-9.6 {TkTextTagCmd - "nextrange" option} {
402
    .t tag nextrange x 1.0
403
} {2.3 2.5}
404
test textTag-9.7 {TkTextTagCmd - "nextrange" option} {
405
    .t tag nextrange x 2.2
406
} {2.3 2.5}
407
test textTag-9.8 {TkTextTagCmd - "nextrange" option} {
408
    .t tag nextrange x 2.3
409
} {2.3 2.5}
410
test textTag-9.9 {TkTextTagCmd - "nextrange" option} {
411
    .t tag nextrange x 2.4
412
} {2.9 3.1}
413
test textTag-9.10 {TkTextTagCmd - "nextrange" option} {
414
    .t tag nextrange x 2.4 2.9
415
} {}
416
test textTag-9.11 {TkTextTagCmd - "nextrange" option} {
417
    .t tag nextrange x 2.4 2.10
418
} {2.9 3.1}
419
test textTag-9.12 {TkTextTagCmd - "nextrange" option} {
420
    .t tag nextrange x 2.4 2.11
421
} {2.9 3.1}
422
test textTag-9.13 {TkTextTagCmd - "nextrange" option} {
423
    .t tag nextrange x 7.0
424
} {7.2 7.3}
425
test textTag-9.14 {TkTextTagCmd - "nextrange" option} {
426
    .t tag nextrange x 7.3
427
} {}
428
 
429
test textTag-10.1 {TkTextTagCmd - "prevrange" option} {
430
    list [catch {.t tag prevrange x} msg] $msg
431
} {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}}
432
test textTag-10.2 {TkTextTagCmd - "prevrange" option} {
433
    list [catch {.t tag prevrange x 1 2 3} msg] $msg
434
} {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}}
435
test textTag-10.3 {TkTextTagCmd - "prevrange" option} {
436
    list [catch {.t tag prevrange foo end} msg] $msg
437
} {0 {}}
438
test textTag-10.4 {TkTextTagCmd - "prevrange" option} {
439
    list [catch {.t tag prevrange x foo} msg] $msg
440
} {1 {bad text index "foo"}}
441
test textTag-10.5 {TkTextTagCmd - "prevrange" option} {
442
    list [catch {.t tag prevrange x end bar} msg] $msg
443
} {1 {bad text index "bar"}}
444
test textTag-10.6 {TkTextTagCmd - "prevrange" option} {
445
    .t tag prevrange x end
446
} {7.2 7.3}
447
test textTag-10.7 {TkTextTagCmd - "prevrange" option} {
448
    .t tag prevrange x 2.4
449
} {2.3 2.5}
450
test textTag-10.8 {TkTextTagCmd - "prevrange" option} {
451
    .t tag prevrange x 2.5
452
} {2.3 2.5}
453
test textTag-10.9 {TkTextTagCmd - "prevrange" option} {
454
    .t tag prevrange x 2.9
455
} {2.3 2.5}
456
test textTag-10.10 {TkTextTagCmd - "prevrange" option} {
457
    .t tag prevrange x 2.9 2.6
458
} {}
459
test textTag-10.11 {TkTextTagCmd - "prevrange" option} {
460
    .t tag prevrange x 2.9 2.5
461
} {}
462
test textTag-10.12 {TkTextTagCmd - "prevrange" option} {
463
    .t tag prevrange x 2.9 2.3
464
} {2.3 2.5}
465
test textTag-10.13 {TkTextTagCmd - "prevrange" option} {
466
    .t tag prevrange x 7.0
467
} {2.9 3.1}
468
test textTag-10.14 {TkTextTagCmd - "prevrange" option} {
469
    .t tag prevrange x 2.3
470
} {}
471
 
472
test textTag-11.1 {TkTextTagCmd - "raise" option} {
473
    list [catch {.t tag raise} msg] $msg
474
} {1 {wrong # args: should be ".t tag raise tagName ?aboveThis?"}}
475
test textTag-11.2 {TkTextTagCmd - "raise" option} {
476
    list [catch {.t tag raise foo} msg] $msg
477
} {1 {tag "foo" isn't defined in text widget}}
478
test textTag-11.3 {TkTextTagCmd - "raise" option} {
479
    list [catch {.t tag raise sel bar} msg] $msg
480
} {1 {tag "bar" isn't defined in text widget}}
481
test textTag-11.4 {TkTextTagCmd - "raise" option} {
482
    tagsetup
483
    .t tag raise c
484
    .t tag names
485
} {sel a b d c}
486
test textTag-11.5 {TkTextTagCmd - "raise" option} {
487
    tagsetup
488
    .t tag raise d b
489
    .t tag names
490
} {sel a b d c}
491
test textTag-11.6 {TkTextTagCmd - "raise" option} {
492
    tagsetup
493
    .t tag raise a c
494
    .t tag names
495
} {sel b c a d}
496
 
497
test textTag-12.1 {TkTextTagCmd - "ranges" option} {
498
    list [catch {.t tag ranges} msg] $msg
499
} {1 {wrong # args: should be ".t tag ranges tagName"}}
500
test textTag-12.2 {TkTextTagCmd - "ranges" option} {
501
    .t tag delete x
502
    .t tag ranges x
503
} {}
504
test textTag-12.3 {TkTextTagCmd - "ranges" option} {
505
    .t tag delete x
506
    .t tag add x 2.2
507
    .t tag add x 2.7 4.15
508
    .t tag add x 5.2 5.5
509
    .t tag ranges x
510
} {2.2 2.3 2.7 4.6 5.2 5.5}
511
test textTag-12.4 {TkTextTagCmd - "ranges" option} {
512
    .t tag delete x
513
    .t tag add x 1.0 3.0
514
    .t tag add x 4.0 end
515
    .t tag ranges x
516
} {1.0 3.0 4.0 8.0}
517
 
518
test textTag-13.1 {TkTextTagCmd - "remove" option} {
519
    list [catch {.t tag remove} msg] $msg
520
} {1 {wrong # args: should be ".t tag remove tagName index1 ?index2 index1 index2 ...?"}}
521
test textTag-13.2 {TkTextTagCmd - "remove" option} {
522
    .t tag delete x
523
    .t tag add x 2.2 2.11
524
    .t tag remove x 2.3 2.7
525
    .t tag ranges x
526
} {2.2 2.3 2.7 2.11}
527
test textTag-13.3 {TkTextTagCmd - "remove" option} {
528
    .t configure -exportselection 1
529
    .t tag remove sel 1.0 end
530
    .t tag add sel 2.4 3.3
531
    .t.e select to 4
532
    .t tag remove sel 2.7 3.1
533
    selection get
534
} Text
535
 
536
.t tag delete x a b c d
537
test textTag-14.1 {SortTags} {
538
    foreach i {a b c d} {
539
        .t tag add $i 2.0 2.2
540
    }
541
    .t tag names 2.1
542
} {a b c d}
543
.t tag delete a b c d
544
test textTag-14.2 {SortTags} {
545
    foreach i {a b c d} {
546
        .t tag configure $i -background black
547
    }
548
    foreach i {d c b a} {
549
        .t tag add $i 2.0 2.2
550
    }
551
    .t tag names 2.1
552
} {a b c d}
553
.t tag delete x a b c d
554
test textTag-14.3 {SortTags} {
555
    for {set i 0} {$i < 30} {incr i} {
556
        .t tag add x$i 2.0 2.2
557
    }
558
    .t tag names 2.1
559
} {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
560
test textTag-14.4 {SortTags} {
561
    for {set i 0} {$i < 30} {incr i} {
562
        .t tag configure x$i -background black
563
    }
564
    for {set i 29} {$i >= 0} {incr i -1} {
565
        .t tag add x$i 2.0 2.2
566
    }
567
    .t tag names 2.1
568
} {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
569
 
570
foreach tag [.t tag names] {
571
    catch {.t tag delete $tag}
572
}
573
set c [.t bbox 2.1]
574
set x1 [expr [lindex $c 0] + [lindex $c 2]/2]
575
set y1 [expr [lindex $c 1] + [lindex $c 3]/2]
576
set c [.t bbox 3.2]
577
set x2 [expr [lindex $c 0] + [lindex $c 2]/2]
578
set y2 [expr [lindex $c 1] + [lindex $c 3]/2]
579
set c [.t bbox 4.3]
580
set x3 [expr [lindex $c 0] + [lindex $c 2]/2]
581
set y3 [expr [lindex $c 1] + [lindex $c 3]/2]
582
 
583
test textTag-15.1 {TkTextBindProc} {
584
    bind .t  {lappend x up}
585
    .t tag bind x  {lappend x x-up}
586
    .t tag bind y  {lappend x y-up}
587
    set x {}
588
    .t tag add x 2.0 2.4
589
    .t tag add y 4.3
590
    event gen .t  -x $x1 -y $y1
591
    event gen .t  -x $x1 -y $y1
592
    event gen .t  -x $x2 -y $y2
593
    event gen .t  -x $x2 -y $y2
594
    event gen .t  -x $x3 -y $y3
595
    event gen .t  -x $x3 -y $y3
596
    bind .t  {}
597
    set x
598
} {x-up up up y-up up}
599
test textTag-15.2 {TkTextBindProc} {
600
    catch {.t tag delete x}
601
    catch {.t tag delete y}
602
    .t tag bind x  {lappend x x-enter}
603
    .t tag bind x  {lappend x x-down}
604
    .t tag bind x  {lappend x x-up}
605
    .t tag bind x  {lappend x x-leave}
606
    .t tag bind y  {lappend x y-enter}
607
    .t tag bind y  {lappend x y-down}
608
    .t tag bind y  {lappend x y-up}
609
    .t tag bind y  {lappend x y-leave}
610
    event gen .t  -x 0 -y 0
611
    set x {}
612
    .t tag add x 2.0 2.4
613
    .t tag add y 4.3
614
    event gen .t  -x $x1 -y $y1
615
    lappend x |
616
    event gen .t 
617
    lappend x |
618
    event gen .t  -x $x3 -y $y3 -state 0x100
619
    lappend x |
620
    event gen .t  -x $x3 -y $y3
621
    set x
622
} {x-enter | x-down | | x-up x-leave y-enter}
623
test textTag-15.3 {TkTextBindProc} {
624
    catch {.t tag delete x}
625
    catch {.t tag delete y}
626
    .t tag bind x  {lappend x x-enter}
627
    .t tag bind x  {lappend x x-down}
628
    .t tag bind x  {lappend x x-up}
629
    .t tag bind x  {lappend x x-leave}
630
    .t tag bind y  {lappend x y-enter}
631
    .t tag bind y  {lappend x y-down}
632
    .t tag bind y  {lappend x y-up}
633
    .t tag bind y  {lappend x y-leave}
634
    event gen .t  -x 0 -y 0
635
    set x {}
636
    .t tag add x 2.0 2.4
637
    .t tag add y 4.3
638
    event gen .t  -x $x1 -y $y1
639
    lappend x |
640
    event gen .t  -x $x1 -y $y1
641
    lappend x |
642
    event gen .t  -x $x1 -y $y1 -state 0x100
643
    lappend x |
644
    event gen .t  -x $x3 -y $y3  -state 0x300
645
    lappend x |
646
    event gen .t  -x $x3 -y $y3 -state 0x300
647
    lappend x |
648
    event gen .t  -x $x3 -y $y3 -state 0x200
649
    set x
650
} {x-enter | x-down | | | x-up | x-leave y-enter}
651
 
652
foreach tag [.t tag names] {
653
    catch {.t tag delete $tag}
654
}
655
.t tag configure big -font $bigFont
656
test textTag-16.1 {TkTextPickCurrent procedure} {
657
    event gen .t  -state 0x100 -x $x1 -y $y1
658
    set x [.t index current]
659
    event gen .t  -x $x2 -y $y2
660
    lappend x [.t index current]
661
    event gen .t  -x $x2 -y $y2
662
    lappend x [.t index current]
663
    event gen .t  -x $x3 -y $y3 -state 0x100
664
    lappend x [.t index current]
665
    event gen .t  -state 0x100 -x $x3 -y $y3
666
    lappend x [.t index current]
667
    event gen .t  -state 0x300 -x $x3 -y $y3
668
    lappend x [.t index current]
669
    event gen .t  -state 0x100 -x $x3 -y $y3
670
    lappend x [.t index current]
671
} {2.1 3.2 3.2 3.2 3.2 3.2 4.3}
672
test textTag-16.2 {TkTextPickCurrent procedure} {
673
    event gen .t  -state 0x100 -x $x1 -y $y1
674
    event gen .t  -x $x2 -y $y2
675
    set x [.t index current]
676
    .t tag add big 3.0
677
    update
678
    lappend x [.t index current]
679
} {3.2 3.1}
680
.t tag remove big 1.0 end
681
foreach i {a b c d} {
682
    .t tag bind $i  "lappend x enter-$i"
683
    .t tag bind $i  "lappend x leave-$i"
684
}
685
test textTag-16.3 {TkTextPickCurrent procedure} {
686
    foreach i {a b c d} {
687
        .t tag remove $i 1.0 end
688
    }
689
    .t tag lower b
690
    .t tag lower a
691
    set x {}
692
    event gen .t  -x $x1 -y $y1
693
    .t tag add a 2.1 3.3
694
    .t tag add b 2.1
695
    .t tag add c 3.2
696
    update
697
    lappend x |
698
    event gen .t  -x $x2 -y $y2
699
    lappend x |
700
    event gen .t  -x $x3 -y $y3
701
    set x
702
} {enter-a enter-b | leave-b enter-c | leave-a leave-c}
703
test textTag-16.4 {TkTextPickCurrent procedure} {
704
    foreach i {a b c d} {
705
        .t tag remove $i 1.0 end
706
    }
707
    .t tag lower b
708
    .t tag lower a
709
    set x {}
710
    event gen .t  -x $x1 -y $y1
711
    .t tag add a 2.1 3.3
712
    .t tag add b 2.1
713
    .t tag add c 2.1
714
    update
715
    lappend x |
716
    .t tag lower c
717
    event gen .t  -x $x2 -y $y2
718
    set x
719
} {enter-a enter-b enter-c | leave-c leave-b}
720
foreach i {a b c d} {
721
    .t tag delete $i
722
}
723
test textTag-16.5 {TkTextPickCurrent procedure} {
724
    foreach i {a b c d} {
725
        .t tag remove $i 1.0 end
726
    }
727
    event gen .t  -x $x1 -y $y1
728
    .t tag bind a  {.t tag add big 3.0 3.2}
729
    .t tag add a 3.2
730
    event gen .t  -x $x2 -y $y2
731
    .t index current
732
} {3.2}
733
test textTag-16.6 {TkTextPickCurrent procedure} {
734
    foreach i {a b c d} {
735
        .t tag remove $i 1.0 end
736
    }
737
    event gen .t  -x $x1 -y $y1
738
    .t tag bind a  {.t tag add big 3.0 3.2}
739
    .t tag add a 3.2
740
    event gen .t  -x $x2 -y $y2
741
    update
742
    .t index current
743
} {3.1}
744
test textTag-16.7 {TkTextPickCurrent procedure} {
745
    foreach i {a b c d} {
746
        .t tag remove $i 1.0 end
747
    }
748
    event gen .t  -x $x1 -y $y1
749
    .t tag bind a  {.t tag add big 3.0 3.2}
750
    .t tag add a 2.1
751
    event gen .t  -x $x2 -y $y2
752
    .t index current
753
} {3.1}
754
 
755
catch {destroy .t}
756
concat {}

powered by: WebSVN 2.1.0

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