1# Commands covered:  treectrl
2#
3# This file contains a collection of tests for the treectrl command of
4# the tktreectrl extension.  Sourcing this file into Tcl runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright (c) 2000 by Scriptics Corporation.
8# Copyright (c) 2002 by Christian Krone.
9#
10# See the file "license.terms" for information on usage and redistribution
11# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12#
13# RCS: @(#) $Id: treectrl.test,v 1.35 2009/04/18 18:41:52 treectrl Exp $
14
15if {[lsearch [namespace children] ::tcltest] == -1} {
16    package require tcltest 2
17    namespace import ::tcltest::*
18}
19
20package require Tk
21package require treectrl
22
23test treectrl-1.1 {Usage} -body {
24    treectrl
25} -returnCodes error -result {wrong # args: should be "treectrl pathName ?options?"}
26
27test treectrl-1.2 {Unknown option} -body {
28    treectrl .t -foo bar
29} -returnCodes error -result {unknown option "-foo"}
30
31test treectrl-1.3 {Create a tree} -body {
32    treectrl .t
33} -result {.t}
34
35test treectrl-1.4 {configure: List all options} -body {
36	.t configure
37} -result {{-background background Background white *}*} -match glob
38
39test treectrl-1.5 {configure -background with totally empty visible tree} -body {
40    pack .t -expand yes -fill both
41    update idletasks
42    .t configure -background white
43    update idletasks
44} -result {}
45
46test treectrl-1.6 {configure: -background option} -body {
47    .t configure -background yellow
48    .t configure -background
49} -result {-background background Background white yellow}
50
51test treectrl-1.7 {configure: invalid -backgroundmode option} -body {
52    .t configure -backgroundmode foo
53} -returnCodes error -result {bad backgroundmode "foo": must be column, order, ordervisible, row, index, or visindex}
54
55test treectrl-1.8 {configure: -backgroundmode option} -body {
56    .t configure -backgroundmode column
57    .t configure -backgroundmode
58} -result {-backgroundmode backgroundMode BackgroundMode row column}
59
60test treectrl-1.9 {configure: invalid -buttonsize option} -body {
61    .t configure -buttonsize foo
62} -returnCodes error -result {bad screen distance "foo"}
63
64test treectrl-1.10 {configure: -buttonsize option} -body {
65    .t configure -buttonsize 1c
66    .t configure -buttonsize
67} -result {-buttonsize buttonSize ButtonSize 9 1c}
68
69test treectrl-1.11 {configure: invalid -buttoncolor option} -body {
70    .t configure -buttoncolor foo
71} -returnCodes error -result {unknown color name "foo"}
72
73test treectrl-1.12 {configure: -buttoncolor option} -body {
74    .t configure -buttoncolor red
75    .t configure -buttoncolor
76} -result {-buttoncolor buttonColor ButtonColor #808080 red}
77
78test treectrl-1.13 {configure: invalid -buttonbitmap option} -body {
79    .t configure -buttonbitmap foo
80} -returnCodes error -result {bitmap "foo" not defined}
81
82test treectrl-1.14 {configure: -buttonbitmap option} -body {
83    .t configure -buttonbitmap hourglass
84    .t configure -buttonbitmap
85} -result {-buttonbitmap buttonBitmap ButtonBitmap {} hourglass}
86
87test treectrl-1.17 {configure: invalid -buttonimage option} -body {
88    .t configure -buttonimage foo
89} -returnCodes error -result {image "foo" doesn't exist}
90
91test treectrl-1.18 {configure: -buttonimage option} -body {
92    image create photo emptyImg
93    .t configure -buttonimage emptyImg
94    .t configure -buttonimage
95} -result {-buttonimage buttonImage ButtonImage {} emptyImg}
96
97test treectrl-1.21 {configure: invalid -doublebuffer option} -body {
98    .t configure -doublebuffer foo
99} -returnCodes error -result {bad doublebuffer "foo": must be none, item, or window}
100
101test treectrl-1.22 {configure: -doublebuffer option} -body {
102    .t configure -doublebuffer window
103    .t configure -doublebuffer
104} -result {-doublebuffer doubleBuffer DoubleBuffer item window}
105
106test treectrl-1.23 {configure: invalid -indent option} -body {
107    .t configure -indent foo
108} -returnCodes error -result {bad screen distance "foo"}
109
110test treectrl-1.24 {configure: -indent option} -body {
111    .t configure -indent 2c
112    .t configure -indent
113} -result {-indent indent Indent 19 2c}
114
115test treectrl-1.25 {configure: invalid -itemheight option} -body {
116    .t configure -itemheight foo
117} -returnCodes error -result {bad screen distance "foo"}
118
119test treectrl-1.26 {configure: -itemheight option} -body {
120    .t configure -itemheight 18m
121    .t configure -itemheight
122} -result {-itemheight itemHeight ItemHeight 0 18m}
123
124test treectrl-1.27 {configure: invalid -linestyle option} -body {
125    .t configure -linestyle foo
126} -returnCodes error -result {bad linestyle "foo": must be dot or solid}
127
128test treectrl-1.28 {configure: -linestyle option} -body {
129    .t configure -linestyle solid
130    .t configure -linestyle
131} -result {-linestyle lineStyle LineStyle dot solid}
132
133test treectrl-1.29 {configure: invalid -linethickness option} -body {
134    .t configure -linethickness foo
135} -returnCodes error -result {bad screen distance "foo"}
136
137test treectrl-1.30 {configure: -linethickness option} -body {
138    .t configure -linethickness 3m
139    .t configure -linethickness
140} -result {-linethickness lineThickness LineThickness 1 3m}
141
142test treectrl-1.31 {configure: invalid -linecolor option} -body {
143    .t configure -linecolor #foo
144} -returnCodes error -result {invalid color name "#foo"}
145
146test treectrl-1.32 {configure: -linethickness option} -body {
147    .t configure -linecolor gray20
148    .t configure -linecolor
149} -result {-linecolor lineColor LineColor #808080 gray20}
150
151test treectrl-1.33 {configure: invalid -orient option} -body {
152    .t configure -orient foo
153} -returnCodes error -result {bad orient "foo": must be horizontal or vertical}
154
155test treectrl-1.34 {configure: -orient option} -body {
156    .t configure -orient h
157    .t configure -orient
158} -result {-orient orient Orient vertical horizontal}
159
160test treectrl-1.35 {configure: invalid -relief option} -body {
161    .t configure -relief foo
162} -returnCodes error -result {bad relief "foo": must be flat, groove, raised, ridge, solid, or sunken}
163
164test treectrl-1.36 {configure: -relief option} -body {
165    .t configure -relief flat
166    .t configure -relief
167} -result {-relief relief Relief sunken flat}
168
169test treectrl-1.37 {configure: invalid -showbuttons option} -body {
170    .t configure -showbuttons foo
171} -returnCodes error -result {expected boolean value but got "foo"}
172
173test treectrl-1.38 {configure: -showbuttons option} -body {
174    .t configure -showbuttons off
175    .t configure -showbuttons
176} -result {-showbuttons showButtons ShowButtons 1 0}
177
178test treectrl-1.39 {configure: invalid -showheader option} -body {
179    .t configure -showheader foo
180} -returnCodes error -result {expected boolean value but got "foo"}
181
182test treectrl-1.40 {configure: -showheader option} -body {
183    .t configure -showheader off
184    .t configure -showheader
185} -result {-showheader showHeader ShowHeader 1 0}
186
187test treectrl-1.41 {configure: invalid -showlines option} -body {
188    .t configure -showlines foo
189} -returnCodes error -result {expected boolean value but got "foo"}
190
191test treectrl-1.42 {configure: -showlines option} -body {
192    .t configure -showlines false
193    .t configure -showlines
194} -result {-showlines showLines ShowLines 1 0}
195
196test treectrl-1.43 {configure: invalid -showroot option} -body {
197    .t configure -showroot foo
198} -returnCodes error -result {expected boolean value but got "foo"}
199
200test treectrl-1.44 {configure: -showroot option} -body {
201    .t configure -showroot no
202    .t configure -showroot
203} -result {-showroot showRoot ShowRoot 1 0}
204
205test treectrl-1.45 {configure: invalid -showrootbutton option} -body {
206    .t configure -showrootbutton foo
207} -returnCodes error -result {expected boolean value but got "foo"}
208
209test treectrl-1.46 {configure: -showrootbutton option} -body {
210    .t configure -showrootbutton True
211    .t configure -showrootbutton
212} -result {-showrootbutton showRootButton ShowRootButton 0 1}
213
214test treectrl-1.47 {configure: invalid -treecolumn option} -body {
215    .t configure -treecolumn foo
216} -returnCodes error -result {column "foo" doesn't exist}
217
218test treectrl-1.49 {configure: -treecolumn option with known column} -body {
219    .t column create -tag column0
220    .t column create -tag column2
221    .t configure -treecolumn 1
222    .t configure -treecolumn
223} -result {-treecolumn treeColumn TreeColumn {} 1}
224
225test treectrl-1.50 {configure: invalid -wrap mode} -body {
226    .t configure -wrap foo
227} -returnCodes error -result {bad wrap "foo"}
228
229test treectrl-1.51 {configure: invalid -wrap option: bogus width} -body {
230    .t configure -wrap {item bar}
231} -returnCodes error -result {bad wrap "item bar"}
232
233test treectrl-1.52 {configure: invalid -wrap option: superflous width} -body {
234    .t configure -wrap {1 window}
235} -returnCodes error -result {bad wrap "1 window"}
236
237test treectrl-1.53 {configure: -wrap option} -body {
238    .t configure -wrap {7 items}
239    .t configure -wrap
240} -result {-wrap wrap Wrap {} {7 items}}
241
242test treectrl-1.54 {configure: -wrap empty option} -body {
243    .t configure -wrap {}
244    .t configure -wrap
245} -result {-wrap wrap Wrap {} {}}
246
247# Before continuing to test the item descriptions and their modifiers,
248# lets create some items with this hierarchy:
249# 0
250# + 1
251# | + 2
252# | + 3
253# |   + 4
254# + 5
255# | + 6
256# | + 7
257# + 8
258test treectrl-2.16 {create some items} -body {
259.t configure -showroot 1 -orient vertical
260    set n1 [.t item create]; .t item lastchild 0   $n1
261    set n2 [.t item create]; .t item lastchild $n1 $n2
262    set n3 [.t item create]; .t item lastchild $n1 $n3
263    set n4 [.t item create]; .t item lastchild $n3 $n4
264    set n5 [.t item create]; .t item lastchild 0   $n5
265    set n6 [.t item create]; .t item lastchild $n5 $n6
266    set n7 [.t item create]; .t item lastchild $n5 $n7
267    set n8 [.t item create]; .t item lastchild 0   $n8
268} -result {8}
269
270test treectrl-5.1 {state: missing args} -body {
271    .t state
272} -returnCodes error -result {wrong # args: should be ".t state command ?arg arg ...?"}
273
274test treectrl-5.2 {state: invalid command} -body {
275    .t state foo
276} -returnCodes error -result {bad command "foo": must be *} -match glob
277
278test treectrl-5.3 {state names: too many args} -body {
279    .t state names foo bar
280} -returnCodes error -result {wrong # args: should be ".t state names"}
281
282test treectrl-5.4 {state names: no states defined yet} -body {
283    .t state names
284} -result {}
285
286test treectrl-5.5 {state define: missing args} -body {
287    .t state define
288} -returnCodes error -result {wrong # args: should be ".t state define stateName"}
289
290test treectrl-5.6 {state define: overflow check} -body {
291    set msg ""
292    set ret 0
293    for {set ix 0} {$ix < 1000} {incr ix} {
294	set ret [catch {.t state define state$ix} msg]
295	if {$ret} {break}
296    }
297    list $ret $ix $msg
298} -result {1 27 {cannot define any more states}}
299
300test treectrl-5.7 {state names} -body {
301    .t state names
302} -result {state0 state1 state2 state3 state4 state5 state6 state7 state8 state9 state10 state11 state12 state13 state14 state15 state16 state17 state18 state19 state20 state21 state22 state23 state24 state25 state26}
303
304test treectrl-5.8 {state undefine: missing args is ok} -body {
305    .t state undefine
306} -result {}
307
308test treectrl-5.9 {state undefine: too many args} -body {
309    eval {.t state undefine} [lrange [.t state names] 3 end]
310    .t state names
311} -result {state0 state1 state2}
312
313test treectrl-5.10 {state undefine} -body {
314    foreach state [lrange [.t state names] 1 end] {
315	.t state undefine $state
316    }
317    .t state names
318} -result {state0}
319
320test treectrl-5.11 {state linkage: missing args} -body {
321    .t state linkage
322} -returnCodes error -result {wrong # args: should be ".t state linkage state"}
323
324test treectrl-5.12 {state linkage: unknown state} -body {
325    .t state linkage foo
326} -returnCodes error -result {unknown state "foo"}
327
328test treectrl-5.13 {state linkage: predefined state} -body {
329    .t state linkage open
330} -result {static}
331
332test treectrl-5.14 {state linkage: user defined state} -body {
333    .t state linkage state0
334} -result {dynamic}
335
336test treectrl-5.15 {state define: strange state name} -body {
337    .t state define ~user
338} -returnCodes error -result {invalid state name "~user"}
339
340test treectrl-5.17 {state define: strange state name} -body {
341    .t state linkage ~user
342} -returnCodes error -result {can't specify '~' for this command}
343
344test treectrl-5.18 {state undefine: strange state name} -body {
345    .t state undefine ~user
346} -returnCodes error -result {can't specify '~' for this command}
347
348test treectrl-5.19 {state define: strange state name} -body {
349    .t state define !WatchIt!
350} -returnCodes error -result {invalid state name "!WatchIt!"}
351
352test treectrl-5.20 {state define: strange state name} -body {
353    .t state define ""
354} -returnCodes error -result {invalid state name ""}
355
356test treectrl-7.0 {some prerequisites for the marquee test} -body {
357    .t element create eImage image -width 202 -height 18m
358    .t element create eRect rect -width 10c -height 18m
359    .t style create testStyle2
360    .t style elements testStyle2 {eImage eRect}
361    .t item style set 2
362    .t item style set 8 0 testStyle2
363    update idletasks
364} -result {}
365
366test treectrl-7.1 {marquee: missing args} -body {
367    .t marquee
368} -returnCodes error -result {wrong # args: should be ".t marquee command ?arg arg ...?"}
369
370test treectrl-7.2 {marquee: unknown command} -body {
371    .t marquee foo
372} -returnCodes error -result {bad command "foo": must be *} -match glob
373
374test treectrl-7.3 {marquee anchor: not yet modified} -body {
375    .t marquee anchor
376} -result {0 0}
377
378test treectrl-7.4 {marquee anchor: odd arguments} -body {
379    .t marquee anchor 1
380} -returnCodes error -result {wrong # args: should be ".t marquee anchor ?x y?"}
381
382test treectrl-7.5 {marquee identify: should be empty} -body {
383    .t marquee identify
384} -result {}
385
386test treectrl-7.6 {marquee anchor: set it} -body {
387    .t marquee anchor 5 5
388} -result {}
389
390test treectrl-7.7 {marquee coords: retrieve them} -body {
391    .t marquee coords
392} -result {5 5 0 0}
393
394test treectrl-7.8 {marquee identify: just the root} -body {
395    .t marquee identify
396} -result {{0 0}}
397
398test treectrl-7.9 {marquee corner: set it} -body {
399    .t marquee corner 600 600
400    .t marquee coords
401} -result {5 5 600 600}
402
403test treectrl-7.10 {marquee identify} -body {
404    .t marquee identify
405} -result {{0 0} {1 0} {2 0} {3 0} {4 0} {5 0} {6 0} {7 0} {8 {0 eRect eImage}}}
406
407test treectrl-7.11 {marquee identify: after invalid item style map} -body {
408    catch {.t item style map 1 0 noStyle {foo bar}}
409    .t marquee identify
410} -result {{0 0} {1 0} {2 0} {3 0} {4 0} {5 0} {6 0} {7 0} {8 {0 eRect eImage}}}
411
412test treectrl-7.12 {marquee visible} -body {
413    list [.t marquee configure -visible] \
414	 [.t marquee cget -visible] \
415	 [.t marquee configure -visible 1] \
416	 [.t marquee cget -visible]
417} -result {{-visible {} {} 0 0} 0 {} 1}
418
419test treectrl-8.1 {selection: missing args} -body {
420    .t selection
421} -returnCodes error -result {wrong # args: should be ".t selection command ?arg arg ...?"}
422
423test treectrl-8.2 {selection: unknown command} -body {
424    .t selection foo
425} -returnCodes error -result {bad command "foo": must be *} -match glob
426
427test treectrl-8.3 {selection count/get: nothing selected yet} -body {
428    list [.t selection count] [.t selection get]
429} -result {0 {}}
430
431test treectrl-8.4 {selection anchor: always defined} -body {
432    .t selection anchor
433} -result {0}
434
435test treectrl-8.5 {selection anchor: modifies the anchor item} -body {
436    .t selection anchor "root lastchild"
437    .t item id anchor
438} -result {8}
439
440test treectrl-8.6 {selection count/get: still nothing selected} -body {
441    list [.t selection count] [.t selection get]
442} -result {0 {}}
443
444test treectrl-8.7 {selection add: all children of an item} -body {
445    .t selection add "1 firstchild" "1 lastchild"
446    list [.t selection count] [lsort -integer [.t selection get]]
447} -result {2 {2 3}}
448
449test treectrl-8.8 {selection add: all items and then some} -body {
450    .t selection add all "1 lastchild"
451    list [.t selection count] [lsort -integer [.t selection get]]
452} -result {9 {0 1 2 3 4 5 6 7 8}}
453
454test treectrl-8.9 {selection clear} -body {
455    .t selection add all
456    .t selection clear "root firstchild"
457    list [.t selection count] [lsort -integer [.t selection get]]
458} -result {8 {0 2 3 4 5 6 7 8}}
459
460test treectrl-8.10 {selection clear: some items and then all} -body {
461    .t selection clear "root lastchild" all
462    list [.t selection count] [.t selection get]
463} -result {0 {}}
464
465test treectrl-8.11 {selection modify: to be or not to be?} -body {
466    .t selection modify all all
467    list [.t selection count] [lsort -integer [.t selection get]]
468} -result {9 {0 1 2 3 4 5 6 7 8}}
469
470test treectrl-8.12 {selection clear: totally empty} -body {
471    .t selection clear
472    list [.t selection count] [lsort -integer [.t selection get]]
473} -result {0 {}}
474
475test treectrl-8.12 {selection modify: to be or not to be?} -body {
476    .t selection modify {{root firstchild} {root lastchild}} {{root lastchild}}
477    list [.t selection count] [lsort -integer [.t selection get]]
478} -result {2 {1 8}}
479
480test treectrl-8.13 {selection includes: missing args} -body {
481    .t selection includes
482} -returnCodes error -result {wrong # args: should be ".t selection includes item"}
483
484test treectrl-8.14 {selection includes: invalid item} -body {
485    .t selection includes {foo bar}
486} -returnCodes error -result {item "foo bar" doesn't exist}
487
488test treectrl-8.15 {selection includes: item is selected} -body {
489    .t selection includes {root child 2}
490} -result {1}
491
492test treectrl-8.16 {selection includes: item is not selected} -body {
493    .t selection includes {root child 0 firstchild}
494} -result {0}
495
496test treectrl-9.1 {see: missing args} -body {
497    .t see
498} -returnCodes error -result {wrong # args: should be ".t see item ?column? ?option value ...?"}
499
500test treectrl-9.2 {see: bogus option} -body {
501    .t see first -bar
502} -returnCodes error -result {bad option "-bar": must be -center}
503
504test treectrl-9.3 {see: invalid item} -body {
505    .t see foo
506} -returnCodes error -result {item "foo" doesn't exist}
507
508test treectrl-9.4 {see: bottom most item} -body {
509    .t see "root bottom"
510} -result {}
511
512test treectrl-9.5 {see: last item, bad column} -body {
513    .t see last foo
514} -returnCodes error -result {column "foo" doesn't exist}
515
516test treectrl-9.6 {see: missing option value} -body {
517    .t see first -center
518} -returnCodes error -result {missing value for "-center" option}
519
520test treectrl-9.7 {see: bogus option value} -body {
521    .t see first -center xz
522} -returnCodes error -result {bad -center value "xz": *} -match glob
523
524test treectrl-9.8 {see: -center xy} -body {
525    .t see first -center xy
526} -result {}
527
528test treectrl-10.1 {range: missing args} -body {
529    .t item range
530} -returnCodes error -result {wrong # args: should be ".t item range first last"}
531
532test treectrl-10.2 {range: too many args} -body {
533    .t item range foo bar baz
534} -returnCodes error -result {wrong # args: should be ".t item range first last"}
535
536test treectrl-10.3 {range: select all from top to bottom} -body {
537    .t item range "root top" "root bottom"
538} -result {0 1 2 3 4 5 6 7 8}
539
540test treectrl-10.4 {range: select all from bottom to top} -body {
541    .t item range "root bottom" "root top"
542} -result {0 1 2 3 4 5 6 7 8}
543
544test treectrl-11.1 {orphans: too many args} -body {
545    .t orphans foo
546} -returnCodes error -result {wrong # args: should be ".t orphans"}
547
548test treectrl-11.2 {orphans: lets make one} -body {
549    .t item remove 8
550    .t orphans
551} -result {8}
552
553test treectrl-11.3 {orphans: no orphans} -body {
554    .t item lastchild 0 8
555    .t orphans
556} -result {}
557
558test treectrl-12.1 {contentbox: too many args} -body {
559    .t contentbox foo
560} -returnCodes error -result {wrong # args: should be ".t contentbox"}
561
562test treectrl-12.2 {contentbox} -body {
563    .t contentbox
564} -result {3 3 203 203}
565
566test treectrl-12.3 {contentbox: simple double check with borders} -body {
567    expr {[lindex [.t contentbox] 0] \
568		== ([.t cget -bd]+[.t cget -highlightthickness])}
569} -result {1}
570
571test treectrl-12.4 {element delete while item is still displayed} -body {
572    .t element create elText text -text hallo
573    .t style create stText
574    .t style element stText elText
575    set new [.t item create]
576    .t item style set $new 0 stText
577    .t item lastchild 0 $new
578    .t element delete elText
579    place [frame .obscure] -in .t -relwidth 1.0 -relheight 1.0
580    update
581    destroy .obscure
582    update
583} -result {}
584
585test treectrl-13.1 {depth: too many args} -body {
586    .t depth foo bar
587} -returnCodes error -result {wrong # args: should be ".t depth ?item?"}
588
589test treectrl-13.2 {depth of the root item} -body {
590    .t depth root
591} -result {0}
592
593test treectrl-13.3 {depth of a deeper item} -body {
594    .t depth "root firstchild lastchild"
595} -result {2}
596
597test treectrl-13.4 {depth of the tree} -body {
598    .t depth
599} -result {3}
600
601test treectrl-13.5 {depth of the tree} -body {
602    .t depth
603} -setup {
604    set rootKids [.t item children root]
605    foreach i $rootKids {.t item remove $i}
606} -cleanup {
607    foreach i $rootKids {.t item lastchild root $i}
608} -result {0}
609
610test treectrl-14.1 {rename and change some columns} -body {
611    .t column delete column0
612    .t column create -tag column1
613    .t column create -tag column3
614    .t column move "order 0" "order 2"
615    .t column move "order 0" tail
616    .t element create eRect2 rect -fill blue -height 20 -width 150
617    .t style create testStyle3
618    .t style elements testStyle3 eRect2
619    .t item style set 1 column1 testStyle3
620} -result {}
621
622test treectrl-15.1 {identify: missing args} -body {
623	wm geometry . 400x200 ; update
624    .t identify
625} -returnCodes error -result {wrong # args: should be ".t identify x y"}
626
627test treectrl-15.2 {identify: negative coords} -body {
628    .t configure -showheader 1 -showlines 1 -showbuttons 1 \
629	-borderwidth 2 -highlightthickness 1 -treecolumn 2 \
630	-itemheight 0 -linethickness 1 -indent 40
631    .t item configure 1 -button true
632    update idletasks
633    .t identify -5 -5
634} -result {}
635
636test treectrl-15.3 {identify: header left} -body {
637	# column 0 has width 0
638	# column 1 has width 0
639	# column 2 has width 40 + 40 + 150 = 230
640	# borders are 2 + 1 = 3
641    .t identify 3 4
642} -result {header 2 left}
643
644test treectrl-15.4 {identify: header} -body {
645    .t identify 40 4
646} -result {header 2}
647
648test treectrl-15.5 {identify: header right} -body {
649    .t identify 232 4
650} -result {header 2 right}
651
652test treectrl-15.6 {identify: tail left} -body {
653    .t identify 233 4
654} -result {header tail left}
655
656test treectrl-15.7 {identify: tail} -body {
657    .t identify 250 4
658} -result {header tail}
659
660test treectrl-15.8 {identify: item (to the left)} -body {
661    .t identify 4 10
662} -result {item 1}
663
664test treectrl-15.9 {identify: button} -body {
665    .t identify 60 10
666} -result {item 1 button}
667
668test treectrl-15.10 {identify: over element} -body {
669    .t identify 150 10
670} -result {item 1 column 2 elem eRect2}
671
672test treectrl-15.11 {identify: item (to the right)} -body {
673    # first make column wider, otherwise we can't get right of the item
674    .t column configure column1 -width 250
675    update idletasks 
676    .t identify 233 10
677} -result {item 1 column 2}
678
679test treectrl-16.1 {dragimage: missing args} -body {
680    .t dragimage
681} -returnCodes error -result {wrong # args: should be ".t dragimage command ?arg arg ...?"}
682
683test treectrl-16.2 {dragimage: unknown command} -body {
684    .t dragimage foo
685} -returnCodes error -result {bad command "foo": must be *} -match glob
686
687test treectrl-16.3 {dragimage configure} -body {
688    .t dragimage configure
689} -result {{-visible {} {} 0 0}}
690
691test treectrl-16.4 {dragimage configure -visible} -body {
692    .t dragimage configure -visible
693} -result {-visible {} {} 0 0}
694
695test treectrl-16.5 {dragimage cget -visible} -body {
696    .t dragimage cget -visible
697} -result {0}
698
699test treectrl-16.6 {dragimage offset: without preceding add} -body {
700    .t dragimage offset
701} -result {0 0}
702
703test treectrl-16.7 {dragimage add: invalid item} -body {
704    .t dragimage add foo
705} -returnCodes error -result {item "foo" doesn't exist}
706
707test treectrl-16.8 {dragimage add: invalid column} -body {
708    .t dragimage add 1 foo
709} -returnCodes error -result {column "foo" doesn't exist}
710
711test treectrl-16.9 {dragimage add: invalid element} -body {
712    .t dragimage add 1 2 foo
713} -returnCodes error -result {element "foo" doesn't exist}
714
715test treectrl-16.10 {dragimage add: is still not visible} -body {
716    .t dragimage add 1 2
717    .t dragimage cget -visible
718} -result {0}
719
720test treectrl-16.11 {dragimage visible} -body {
721    .t dragimage configure -visible 1
722    .t dragimage cget -visible
723} -result {1}
724
725test treectrl-16.12 {dragimage offset} -body {
726    .t dragimage offset 10 10
727    .t dragimage offset
728} -result {10 10}
729
730test treectrl-16.13 {dragimage clear: too many args} -body {
731    .t dragimage clear 1
732} -returnCodes error -result {wrong # args: should be ".t dragimage clear"}
733
734test treectrl-16.14 {dragimage clear: doesn't modify the offset} -body {
735    .t dragimage clear
736    .t dragimage offset
737} -result {10 10}
738
739test treectrl-17.1 {columnproxy: Normally left blank} -body {
740    # BTW: This shouldn't be an option...
741    .t cget -columnproxy
742} -result {}
743
744test treectrl-17.2 {columnproxy: Normally left blank} -body {
745    .t configure -columnproxy foo
746} -returnCodes error -result {bad screen distance "foo"}
747
748test treectrl-17.3 {columnproxy: Negative screen distance} -body {
749    # It is unclear if this should be forbiden...
750    .t configure -columnproxy -1c
751    update idletasks
752    .t cget -columnproxy
753} -result {-1c}
754
755test treectrl-17.4 {columnproxy: screen distance bigger than width} -body {
756    # It is unclear if this should be forbiden...
757	set x [expr {[winfo width .t] + 10}]
758    .t configure -columnproxy $x
759    update idletasks
760    expr {[.t cget -columnproxy] == $x}
761} -result {1}
762
763test treectrl-17.5 {columnproxy} -body {
764    .t configure -columnproxy 100
765    update idletasks
766    .t cget -columnproxy
767} -result {100}
768
769test treectrl-18.1 {-defaultstyle: setup} -body {
770    .t column delete all
771    .t column create -tags a
772    .t column create -tags b
773    .t column create -tags c
774    .t column create -tags d
775
776    .t item delete all
777
778    .t style create a
779    .t style create b
780    .t style create c
781    .t style create d
782} -result {d}
783
784test treectrl-18.2 {-defaultstyle: set} -constraints {
785    deprecated
786} -body {
787    .t configure -defaultstyle {a b c d}
788    .t cget -defaultstyle
789} -result {a b c d}
790
791test treectrl-18.3 {-defaultstyle: new items get default styles} -constraints {
792    deprecated
793} -body {
794    set I [.t item create]
795    .t item style set $I
796} -result {a b c d}
797
798test treectrl-18.4 {-defaultstyle: moving column updates -defaultstyle} -constraints {
799    deprecated
800} -body {
801    .t column move "tag a" "tag c"
802    .t cget -defaultstyle
803} -result {b a c d}
804
805test treectrl-18.5 {-defaultstyle: moving column updates -defaultstyle} -constraints {
806    deprecated
807} -body {
808    .t column move "tag a" tail
809    .t cget -defaultstyle
810} -result {b c d a}
811
812test treectrl-18.6 {-defaultstyle: moving column updates -defaultstyle} -constraints {
813    deprecated
814} -body {
815    .t column move "tag a" "tag b"
816    .t cget -defaultstyle
817} -result {a b c d}
818
819test treectrl-18.7 {-defaultstyle: moving column updates -defaultstyle} -constraints {
820    deprecated
821} -body {
822    .t column create -tags e
823    .t column move "tag e" "tag d"
824    .t cget -defaultstyle
825} -result {a b c {} d}
826
827test treectrl-18.8 {-defaultstyle: moving column updates -defaultstyle} -constraints {
828    deprecated
829} -body {
830    .t column create -tags f
831    .t column move "tag c" tail
832    .t cget -defaultstyle
833} -result {a b {} d {} c}
834
835test treectrl-18.9 {-defaultstyle: deleting column does not update -defaultstyle} -constraints {
836    deprecated
837} -body {
838    .t column delete "tag e"
839    .t cget -defaultstyle
840} -result {a b {} d {} c}
841
842# cleanup
843image delete emptyImg
844::tcltest::cleanupTests
845return
846