1#
2# [7Jun2005] TO CHECK: [$tv see {}] -- shouldn't work (at least, shouldn't do
3# what it currently does)
4#
5
6package require tk
7package require tcltest 2.2
8namespace import -force tcltest::*
9loadTestedCommands
10
11# consistencyCheck --
12#	Traverse the tree to make sure the item data structures
13#	are properly linked.
14#
15#	Since [$tv children] follows ->next links and [$tv index]
16#	follows ->prev links, this should cover all invariants.
17#
18proc consistencyCheck {tv {item {}}} {
19    set i 0;
20    foreach child [$tv children $item] {
21	assert {[$tv parent $child] == $item} "parent $child = $item"
22	assert {[$tv index $child] == $i} "index $child [$tv index $child]=$i"
23	incr i
24	consistencyCheck $tv $child
25    }
26}
27
28proc assert {expr {message ""}} {
29    if {![uplevel 1 [list expr $expr]]} {
30        set error "PANIC! PANIC! PANIC: $message ($expr failed)"
31    	puts stderr $error
32	error $error
33    }
34}
35
36test treeview-0 "treeview test - setup" -body {
37    ttk::treeview .tv -columns {a b c}
38    pack .tv -expand true -fill both
39    update
40}
41
42test treeview-1.1 "columns" -body {
43    .tv configure -columns {a b c}
44}
45
46test treeview-1.2 "Bad columns" -body {
47    #.tv configure -columns {illegal "list"value}
48    ttk::treeview .badtv -columns {illegal "list"value}
49} -returnCodes error -result "list element in quotes followed by*" -match glob
50
51test treeview-1.3 "bad displaycolumns" -body {
52    .tv configure -displaycolumns {a b d}
53} -returnCodes error -result "Invalid column index d"
54
55test treeview-1.4 "more bad displaycolumns" -body {
56    .tv configure -displaycolumns {1 2 3}
57} -returnCodes error -result "Column index 3 out of bounds"
58
59test treeview-1.5 "Don't forget to check negative numbers" -body {
60    .tv configure -displaycolumns {1 -2 3}
61} -returnCodes error -result "Column index -2 out of bounds"
62
63# Item creation.
64#
65test treeview-2.1 "insert -- not enough args" -body {
66    .tv insert
67} -returnCodes error -result "wrong # args: *" -match glob
68
69test treeview-2.3 "insert -- bad integer index" -body {
70    .tv insert {} badindex
71} -returnCodes error -result "expected integer *" -match glob
72
73test treeview-2.4 "insert -- bad parent node" -body {
74    .tv insert badparent end
75} -returnCodes error -result "Item badparent not found" -match glob
76
77test treeview-2.5 "insert -- finaly insert a node" -body {
78    .tv insert {} end -id newnode -text "New node"
79} -result newnode
80
81test treeview-2.6 "insert -- make sure node was inserted" -body {
82    .tv children {}
83} -result [list newnode]
84
85test treeview-2.7 "insert -- prevent duplicate node names" -body {
86    .tv insert {} end -id newnode
87} -returnCodes error -result "Item newnode already exists"
88
89test treeview-2.8 "insert -- new node at end" -body {
90    .tv insert {} end -id lastnode
91    consistencyCheck .tv
92    .tv children {}
93} -result [list newnode lastnode]
94
95consistencyCheck .tv
96
97test treeview-2.9 "insert -- new node at beginning" -body {
98    .tv insert {} 0 -id firstnode
99    consistencyCheck .tv
100    .tv children {}
101} -result [list firstnode newnode lastnode]
102
103test treeview-2.10 "insert -- one more node" -body {
104    .tv insert {} 2 -id onemore
105    consistencyCheck .tv
106    .tv children {}
107} -result [list firstnode newnode onemore lastnode]
108
109test treeview-2.11 "insert -- and another one" -body {
110    .tv insert {} 2 -id anotherone
111    consistencyCheck .tv
112    .tv children {}
113} -result [list firstnode newnode anotherone onemore lastnode]
114
115test treeview-2.12 "insert -- one more at end" -body {
116    .tv insert {} end -id newlastone
117    consistencyCheck .tv
118    .tv children {}
119} -result [list firstnode newnode anotherone onemore lastnode newlastone]
120
121test treeview-2.13 "insert -- one more at beginning" -body {
122    .tv insert {} 0 -id newfirstone
123    consistencyCheck .tv
124    .tv children {}
125} -result [list newfirstone firstnode newnode anotherone onemore lastnode newlastone]
126
127test treeview-2.14 "insert -- bad options" -body {
128    .tv insert {} end -badoption foo
129} -returnCodes error -result {unknown option "-badoption"}
130
131test treeview-2.15 "insert -- at position 0 w/no children" -body {
132    .tv insert newnode 0 -id newnode.n2 -text "Foo"
133    .tv children newnode
134} -result newnode.n2	;# don't crash
135
136test treeview-2.16 "insert -- insert way past end" -body {
137    .tv insert newnode 99 -id newnode.n3 -text "Foo"
138    consistencyCheck .tv
139    .tv children newnode
140} -result [list newnode.n2 newnode.n3]
141
142test treeview-2.17 "insert -- insert before beginning" -body {
143    .tv insert newnode -1 -id newnode.n1 -text "Foo"
144    consistencyCheck .tv
145    .tv children newnode
146}  -result [list newnode.n1 newnode.n2 newnode.n3]
147
148###
149#
150test treeview-3.1 "parent" -body {
151    .tv parent newnode.n1
152} -result newnode
153test treeview-3.2 "parent - top-level node" -body {
154    .tv parent newnode
155} -result {}
156test treeview-3.3 "parent - root node" -body {
157    .tv parent {}
158} -result {}
159test treeview-3.4 "index" -body {
160    list [.tv index newnode.n3] [.tv index newnode.n2] [.tv index newnode.n1]
161} -result [list 2 1 0]
162test treeview-3.5 "index - exhaustive test" -body {
163    set result [list]
164    foreach item [.tv children {}] {
165	lappend result [.tv index $item]
166    }
167    set result
168} -result [list 0 1 2 3 4 5 6]
169
170test treeview-3.6 "detach" -body {
171    .tv detach newnode
172    consistencyCheck .tv
173    .tv children {}
174} -result [list newfirstone firstnode anotherone onemore lastnode newlastone]
175# XREF: treeview-2.13
176
177test treeview-3.7 "detach didn't screw up internal links" -body {
178    consistencyCheck .tv
179    set result [list]
180    foreach item [.tv children {}] {
181	lappend result [.tv index $item]
182    }
183    set result
184} -result [list 0 1 2 3 4 5]
185
186test treeview-3.8 "detached node has no parent, index 0" -body {
187    list [.tv parent newnode] [.tv index newnode]
188} -result [list {} 0]
189# @@@ Can't distinguish detached nodes from first root node
190
191test treeview-3.9 "detached node's children undisturbed" -body {
192    .tv children newnode
193} -result [list newnode.n1 newnode.n2 newnode.n3]
194
195test treeview-3.10 "detach is idempotent" -body {
196    .tv detach newnode
197    consistencyCheck .tv
198    .tv children {}
199} -result [list newfirstone firstnode anotherone onemore lastnode newlastone]
200
201test treeview-3.11 "Can't detach root item" -body {
202    .tv detach [list {}]
203    update
204    consistencyCheck .tv
205} -returnCodes error -result "Cannot detach root item"
206consistencyCheck .tv
207
208test treeview-3.12 "Reattach" -body {
209    .tv move newnode {} end
210    consistencyCheck .tv
211    .tv children {}
212} -result [list newfirstone firstnode anotherone onemore lastnode newlastone newnode]
213
214# Bug # ?????
215test treeview-3.13 "Re-reattach" -body {
216    .tv move newnode {} end
217    consistencyCheck .tv
218    .tv children {}
219} -result [list newfirstone firstnode anotherone onemore lastnode newlastone newnode]
220
221catch {
222    .tv insert newfirstone end -id x1
223    .tv insert newfirstone end -id x2
224    .tv insert newfirstone end -id x3
225}
226
227test treeview-3.14 "Duplicated entry in children list" -body {
228    .tv children newfirstone [list x3 x1 x2 x3]
229    # ??? Maybe this should raise an error?
230    consistencyCheck .tv
231    .tv children newfirstone
232} -result [list x3 x1 x2]
233
234test treeview-3.14.1 "Duplicated entry in children list" -body {
235    .tv children newfirstone [list x1 x2 x3 x3 x2 x1]
236    consistencyCheck .tv
237    .tv children newfirstone
238} -result [list x1 x2 x3]
239
240test treeview-3.15 "Consecutive duplicate entries in children list" -body {
241    .tv children newfirstone [list x1 x2 x2 x3]
242    consistencyCheck .tv
243    .tv children newfirstone
244} -result [list x1 x2 x3]
245
246test treeview-3.16 "Insert child after self" -body {
247    .tv move x2 newfirstone 1
248    consistencyCheck .tv
249    .tv children newfirstone
250} -result [list x1 x2 x3]
251
252test treeview-3.17 "Insert last child after self" -body {
253    .tv move x3 newfirstone 2
254    consistencyCheck .tv
255    .tv children newfirstone
256} -result [list x1 x2 x3]
257
258test treeview-3.18 "Insert last child after end" -body {
259    .tv move x3 newfirstone 3
260    consistencyCheck .tv
261    .tv children newfirstone
262} -result [list x1 x2 x3]
263
264test treeview-4.1 "opened - initial state" -body {
265    .tv item newnode -open
266} -result 0
267test treeview-4.2 "opened - open node" -body {
268    .tv item newnode -open 1
269    .tv item newnode -open
270} -result 1
271test treeview-4.3 "opened - closed node" -body {
272    .tv item newnode -open 0
273    .tv item newnode -open
274} -result 0
275
276test treeview-5.1 "item -- error checks" -body {
277    .tv item newnode -text "Bad values" -values "{bad}list"
278} -returnCodes error -result "list element in braces followed by*" -match glob
279
280test treeview-5.2 "item -- error leaves options unchanged " -body {
281    .tv item newnode -text
282} -result "New node"
283
284test treeview-5.3 "Heading" -body {
285    .tv heading #0 -text "Heading"
286}
287
288test treeview-5.4 "get cell" -body {
289    set l [list a b c]
290    .tv item newnode -values $l
291    .tv set newnode 1
292} -result b
293
294test treeview-5.5 "set cell" -body {
295    .tv set newnode 1 XXX
296    .tv item newnode -values
297} -result [list a XXX c]
298
299test treeview-5.6 "set illegal cell" -body {
300    .tv set newnode #0 YYY
301} -returnCodes error -result "Display column #0 cannot be set"
302
303test treeview-5.7 "set illegal cell" -body {
304    .tv set newnode 3 YY	;# 3 == current #columns
305} -returnCodes error -result "Column index 3 out of bounds"
306
307test treeview-5.8 "set display columns" -body {
308    .tv configure -displaycolumns [list 2 1 0]
309    .tv set newnode #1 X
310    .tv set newnode #2 Y
311    .tv set newnode #3 Z
312    .tv item newnode -values
313} -result [list Z Y X]
314
315test treeview-5.9 "display columns part 2" -body {
316    list [.tv column #1 -id] [.tv column #2 -id] [.tv column #3 -id]
317} -result [list c b a]
318
319test treeview-5.10 "cannot set column -id" -body {
320    .tv column #1 -id X
321} -returnCodes error -result "Attempt to change read-only option"
322
323test treeview-5.11 "get" -body {
324    .tv set newnode #1
325} -result X
326
327test treeview-5.12 "get dictionary" -body {
328    .tv set newnode
329} -result [list a Z b Y c X]
330
331test treeview-5.13 "get, no value" -body {
332    set newitem [.tv insert {} end]
333    set result [.tv set $newitem #1]
334    .tv delete $newitem
335    set result
336} -result {}
337
338
339test treeview-6.1 "deletion - setup" -body {
340    .tv insert {} end -id dtest
341    foreach id [list a b c d e] {
342	.tv insert dtest end -id $id
343    }
344    .tv children dtest
345} -result [list a b c d e]
346
347test treeview-6.1.1 "delete" -body {
348    .tv delete b
349    consistencyCheck .tv
350    list [.tv exists b] [.tv children dtest]
351} -result [list 0 [list a c d e]]
352
353consistencyCheck .tv
354
355test treeview-6.2 "delete - duplicate items in list" -body {
356    .tv delete [list a e a e]
357    consistencyCheck .tv
358    .tv children dtest
359} -result [list c d]
360
361test treeview-6.3 "delete - descendants removed" -body {
362    .tv insert c  end -id c1
363    .tv insert c  end -id c2
364    .tv insert c1 end -id c11
365    consistencyCheck .tv
366    .tv delete c
367    consistencyCheck .tv
368    list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11]
369} -result [list 0 0 0 0]
370
371test treeview-6.4 "delete - delete parent and descendants" -body {
372    .tv insert dtest end -id c
373    .tv insert c  end -id c1
374    .tv insert c  end -id c2
375    .tv insert c1 end -id c11
376    consistencyCheck .tv
377    .tv delete [list c c1 c2 c11]
378    consistencyCheck .tv
379    list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11]
380} -result [list 0 0 0 0]
381
382test treeview-6.5 "delete - delete descendants and parent" -body {
383    .tv insert dtest end -id c
384    .tv insert c  end -id c1
385    .tv insert c  end -id c2
386    .tv insert c1 end -id c11
387    consistencyCheck .tv
388    .tv delete [list c11 c1 c2 c]
389    consistencyCheck .tv
390    list [.tv exists c] [.tv exists c1] [.tv exists c2] [.tv exists c11]
391} -result [list 0 0 0 0]
392
393test treeview-6.6 "delete - end" -body {
394    consistencyCheck .tv
395    .tv children dtest
396} -result [list d]
397
398test treeview-7.1 "move" -body {
399    .tv insert d end -id d1
400    .tv insert d end -id d2
401    .tv insert d end -id d3
402    .tv move d3 d 0
403    consistencyCheck .tv
404    .tv children d
405} -result [list d3 d1 d2]
406
407test treeview-7.2 "illegal move" -body {
408   .tv move d d2 end
409} -returnCodes error -result "Cannot insert d as descendant of d2"
410
411test treeview-7.3 "illegal move has no effect" -body {
412    consistencyCheck .tv
413    .tv children d
414} -result [list d3 d1 d2]
415
416test treeview-7.4 "Replace children" -body {
417    .tv children d [list d3 d2 d1]
418    consistencyCheck .tv
419    .tv children d
420} -result [list d3 d2 d1]
421
422test treeview-7.5 "replace children - precondition" -body {
423    # Just check to make sure the test suite so far has left
424    # us in the state we expect to be in:
425    list [.tv parent newnode] [.tv children newnode]
426} -result [list {} [list newnode.n1 newnode.n2 newnode.n3]]
427
428test treeview-7.6 "Replace children - illegal move" -body {
429    .tv children newnode.n1 [list newnode.n1 newnode.n2 newnode.n3]
430} -returnCodes error -result "Cannot insert newnode.n1 as descendant of newnode.n1"
431
432consistencyCheck .tv
433
434test treeview-8.0 "Selection set" -body {
435    .tv selection set [list newnode.n1 newnode.n3 newnode.n2]
436    .tv selection
437} -result [list newnode.n1 newnode.n2 newnode.n3]
438
439test treeview-8.1 "Selection add" -body {
440    .tv selection add [list newnode]
441    .tv selection
442} -result [list newnode newnode.n1 newnode.n2 newnode.n3]
443
444test treeview-8.2 "Selection toggle" -body {
445    .tv selection toggle [list newnode.n2 d3]
446    .tv selection
447} -result [list newnode newnode.n1 newnode.n3 d3]
448
449test treeview-8.3 "Selection remove" -body {
450    .tv selection remove [list newnode.n2 d3]
451    .tv selection
452} -result [list newnode newnode.n1 newnode.n3]
453
454test treeview-8.4 "Selection - clear" -body {
455    .tv selection set {}
456    .tv selection
457} -result {}
458
459test treeview-8.5 "Selection - bad operation" -body {
460    .tv selection badop foo
461} -returnCodes error -match glob -result {bad selection operation "badop": must be *}
462
463test treeview-8.6 "Selection - <<TreeviewSelect>> on selection add" -body {
464    .tv selection set {}
465    bind .tv <<TreeviewSelect>> {set res 1}
466    set res 0
467    .tv selection add newnode.n1
468    update
469    set res
470} -result 1
471
472test treeview-8.7 "<<TreeviewSelect>> on selected item deletion" -body {
473    .tv selection set {}
474    .tv insert "" end -id selectedDoomed -text DeadItem
475    .tv insert "" end -id doomed -text AlsoDead
476    .tv selection add selectedDoomed
477    update
478    bind .tv <<TreeviewSelect>> {lappend res 1}
479    set res 0
480    .tv delete doomed
481    update
482    set res [expr {$res == 0}]
483    .tv delete selectedDoomed
484    update
485    set res
486} -result {1 1}
487
488### NEED: more tests for see/yview/scrolling
489
490proc scrollcallback {args} {
491    set ::scrolldata $args
492}
493test treeview-9.0 "scroll callback - empty tree" -body {
494    .tv configure -yscrollcommand scrollcallback
495    .tv delete [.tv children {}]
496    update
497    set ::scrolldata
498} -result [list 0.0 1.0]
499
500test treeview-9.1 "scrolling" -setup {
501    pack [ttk::treeview .tree -show tree] -fill y
502    for {set i 1} {$i < 100} {incr i} {
503        .tree insert {} end -text $i
504    }
505} -body {
506    .tree yview scroll 5 units
507    .tree identify item 2 2
508} -cleanup {
509    destroy .tree
510} -result {I006}
511
512test treeview-9.2 {scrolling on see command - bug [14188104c3]} -setup {
513    toplevel .top
514    ttk::treeview .top.tree -show {} -height 10 -columns {label} \
515            -yscrollcommand [list .top.vs set]
516    ttk::scrollbar .top.vs -command {.top.tree yview}
517    grid .top.tree -row 0 -column 0 -sticky ns
518    grid .top.vs -row 0 -column 1 -sticky ns
519    update
520    proc setrows {n} {
521        .top.tree delete [.top.tree children {}]
522        for {set i 1} {$i <= $n} {incr i} {
523            .top.tree insert {} end -id row$i \
524                    -values [list [format "Row %2.2d" $i]]
525        }
526        .top.tree see row1
527        update idletasks
528    }
529} -body {
530    setrows 10
531    set res [.top.vs get]
532    setrows 20
533    lappend res [expr [lindex [.top.vs get] 1] < 1]
534} -cleanup {
535    destroy .top
536} -result {0.0 1.0 1}
537
538test treeview-9.3 {scrolling on see command, requested item is closed} -setup {
539    toplevel .top
540    ttk::treeview .top.tree -show tree -height 10 -columns {label} \
541            -yscrollcommand [list .top.vs set]
542    ttk::scrollbar .top.vs -command {.top.tree yview}
543    grid .top.tree -row 0 -column 0 -sticky ns
544    grid .top.vs -row 0 -column 1 -sticky ns
545
546    .top.tree insert {} end -id a -text a
547    .top.tree insert a  end -id b -text b
548    .top.tree insert b  end -id c -text c
549    .top.tree insert c  end -id d -text d
550    .top.tree insert d  end -id e -text e
551    for {set i 6} {$i <= 15} {incr i} {
552        .top.tree insert {} end -id row$i \
553                -values [list [format "Row %2.2d" $i]]
554    }
555    update
556} -body {
557    set before [lindex [.top.vs get] 1]
558    .top.tree see e
559    update idletasks
560    set after [lindex [.top.vs get] 1]
561    expr $after < $before
562} -cleanup {
563    destroy .top
564} -result 1
565
566### identify tests:
567#
568proc identify* {tv comps args} {
569    foreach {x y} $args {
570	foreach comp $comps {
571	    lappend result [$tv identify $comp $x $y]
572	}
573    }
574    return $result
575}
576
577# get list of column IDs from list of display column ids.
578#
579proc columnids {tv dcols} {
580    set result [list]
581    foreach dcol $dcols {
582	if {[catch {
583	    lappend result [$tv column $dcol -id]
584	}]} {
585	    lappend result ERROR
586	}
587    }
588    return $result
589}
590
591test treeview-identify-setup "identify series - setup" -body {
592    destroy .tv
593    ttk::setTheme default
594    ttk::treeview .tv -columns [list A B C]
595    .tv insert {} end -id branch -text branch -open true
596    .tv insert branch end -id item1 -text item1
597    .tv insert branch end -id item2 -text item2
598    .tv insert branch end -id item3 -text item3
599
600    .tv column #0 -width 50	;# 0-50
601    .tv column A -width 50	;# 50-100
602    .tv column B -width 50	;# 100-150
603    .tv column C -width 50	;# 150-200 (plus slop for margins)
604
605    wm geometry . {} ; pack .tv ; update
606}
607
608test treeview-identify-1 "identify heading" -body {
609    .tv configure -show {headings tree}
610    update idletasks
611    identify* .tv {region column} 10 10
612} -result [list heading #0]
613
614test treeview-identify-2 "identify columns" -body {
615    .tv configure -displaycolumns #all
616    update idletasks
617    columnids .tv [identify* .tv column 25 10  75 10  125 10  175 10]
618} -result [list {} A B C]
619
620test treeview-identify-3 "reordered columns" -body {
621    .tv configure -displaycolumns {B A C}
622    update idletasks
623    columnids .tv [identify* .tv column 25 10  75 10  125 10  175 10]
624} -result [list {} B A C]
625
626test treeview-identify-4 "no tree column" -body {
627    .tv configure -displaycolumns #all -show {headings}
628    update idletasks
629    identify* .tv {region column} 25 10  75 10  125 10  175 10
630} -result [list heading #1 heading #2 heading #3 nothing {}]
631
632# Item height in default theme is 20px
633test treeview-identify-5 "vertical scan - no headings" -body {
634    .tv configure -displaycolumns #all -show {tree}
635    update idletasks
636    identify* .tv {region item} 25 10  25 30  25 50  25 70  25 90
637} -result [list tree branch tree item1 tree item2 tree item3 nothing {}]
638
639test treeview-identify-6 "vertical scan - with headings" -body {
640    .tv configure -displaycolumns #all -show {tree headings}
641    update idletasks
642    identify* .tv {region item} 25 10  25 30  25 50  25 70  25 90
643} -result [list heading {} tree branch tree item1 tree item2 tree item3]
644
645test treeview-identify-7 "vertical scan - headings, no tree" -body {
646    .tv configure -displaycolumns #all -show {headings}
647    update idletasks
648    identify* .tv {region item} 25 10  25 30  25 50  25 70  25 90
649} -result [list heading {} cell branch cell item1 cell item2 cell item3]
650
651# In default theme, -indent and -itemheight both 20px
652# Disclosure element name is "Treeitem.indicator"
653set disclosure "*.indicator"
654test treeview-identify-8 "identify element" -body {
655    .tv configure -show {tree}
656    .tv insert branch  0 -id branch2 -open true
657    .tv insert branch2 0 -id branch3 -open true
658    .tv insert branch3 0 -id leaf3
659    update idletasks;
660    identify* .tv {item element} 10 10  30 30  50 50
661} -match glob -result [list \
662	branch $disclosure branch2 $disclosure branch3 $disclosure]
663
664# See #2381555
665test treeview-identify-9 "identify works when horizontally scrolled" -setup {
666    .tv configure -show {tree headings}
667    foreach column {#0 A B C} {
668	.tv column $column -stretch 0 -width 50
669    }
670    place .tv -x 0 -y 0 -width 100
671} -body {
672    set result [list]
673    foreach xoffs {0 50 100} {
674	.tv xview $xoffs ; update
675	lappend result [identify* .tv {region column} 10 10 60 10]
676    }
677    set result
678} -result [list \
679	[list heading #0 heading #1] \
680	[list heading #1 heading #2] \
681	[list heading #2 heading #3] ]
682
683test treeview-identify-cleanup "identify - cleanup" -body {
684    destroy .tv
685}
686
687### NEED: tests for focus item, selection
688
689### Misc. tests:
690
691destroy .tv
692test treeview-10.1 "Root node properly initialized (#1541739)" -setup {
693    ttk::treeview .tv
694    .tv insert {} end -id a
695    .tv see a
696} -cleanup {
697    destroy .tv
698}
699
700test treeview-3006842 "Null bindings" -setup {
701    ttk::treeview .tv -show tree
702} -body {
703    .tv tag bind empty <Button-1> {}
704    .tv insert {} end -text "Click me" -tags empty
705    event generate .tv <Button-1> -x 10 -y 10
706    .tv tag bind empty
707} -result {} -cleanup {
708    destroy .tv
709}
710
711test treeview-3085489-1 "tag add, no -tags" -setup {
712    ttk::treeview .tv
713} -body {
714    set item [.tv insert {} end]
715    .tv tag add foo $item
716    .tv item $item -tags
717} -cleanup {
718    destroy .tv
719} -result [list foo]
720
721test treeview-3085489-2 "tag remove, no -tags" -setup {
722    ttk::treeview .tv
723} -body {
724    set item [.tv insert {} end]
725    .tv tag remove foo $item
726    .tv item $item -tags
727} -cleanup {
728    destroy .tv
729} -result [list]
730
731test treeview-368fa4561e "indicators cannot be clicked on leafs" -setup {
732    pack [ttk::treeview .tv]
733    .tv insert {} end -id foo -text "<-- (1) Click the blank space to my left"
734    update
735} -body {
736    foreach {x y w h} [.tv bbox foo #0] {}
737    set res [.tv item foo -open]
738    # using $h even for x computation is intentional here in order to simulate
739    # a mouse click on the (invisible since we're on a leaf) indicator
740    event generate .tv <Button-1> \
741            -x [expr {$x + $h / 2}] \
742            -y [expr {$y + $h / 2}]
743    lappend res [.tv item foo -open]
744    .tv insert foo end -text "sub"
745    lappend res [.tv item foo -open]
746} -cleanup {
747    destroy .tv
748} -result {0 0 0}
749
750test treeview-ce470f20fd-1 "dragging further than the right edge of the treeview is allowed" -setup {
751    pack [ttk::treeview .tv]
752    .tv heading #0 -text "Drag my right edge -->"
753    update
754} -body {
755    set res [.tv column #0 -width]
756    .tv drag #0 400
757    lappend res [expr {[.tv column #0 -width] > $res}]
758} -cleanup {
759    destroy .tv
760} -result {200 1}
761
762proc nostretch {tv} {
763    foreach col [$tv cget -columns] {
764        $tv column $col -stretch 0
765    }
766    $tv column #0 -stretch 0
767    update idletasks ; # redisplay $tv
768}
769
770test treeview-ce470f20fd-2 "changing -stretch resizes columns" -setup {
771    pack [ttk::treeview .tv -columns {bar colA colB colC foo}]
772    foreach col [.tv cget -columns] {
773        .tv heading $col -text $col
774    }
775    nostretch .tv
776    .tv column colA -width 50 ; .tv column colB -width 50 ; # slack created
777    update idletasks ; # redisplay treeview
778} -body {
779    # when no column is stretchable and one of them becomes stretchable
780    # the stretchable column takes the slack and the widget is redisplayed
781    # automatically at idle time
782    set res [.tv column colA -width]
783    .tv column colA -stretch 1
784    update idletasks ; # no slack anymore, widget redisplayed
785    lappend res [expr {[.tv column colA -width] > $res}]
786} -cleanup {
787    destroy .tv
788} -result {50 1}
789
790test treeview-ce470f20fd-3 "changing -stretch resizes columns" -setup {
791    pack [ttk::treeview .tv -columns {bar colA colB colC foo}]
792    foreach col [.tv cget -columns] {
793        .tv heading $col -text $col
794    }
795    .tv configure -displaycolumns {colB colA colC}
796    nostretch .tv
797    .tv column colA -width 50 ; .tv column colB -width 50 ; # slack created
798    update idletasks ; # redisplay treeview
799} -body {
800    # only some columns are displayed (and in a different order than declared
801    # in -columns), a displayed column becomes stretchable  --> the stretchable
802    # column expands
803    set res [.tv column colA -width]
804    .tv column colA -stretch 1
805    update idletasks ; # no slack anymore, widget redisplayed
806    lappend res [expr {[.tv column colA -width] > $res}]
807} -cleanup {
808    destroy .tv
809} -result {50 1}
810
811test treeview-ce470f20fd-4 "changing -stretch resizes columns" -setup {
812    pack [ttk::treeview .tv -columns {bar colA colB colC foo}]
813    foreach col [.tv cget -columns] {
814        .tv heading $col -text $col
815    }
816    .tv configure -displaycolumns {colB colA colC}
817    nostretch .tv
818    .tv column colA -width 50 ; .tv column bar -width 60 ; # slack created
819    update idletasks ; # redisplay treeview
820} -body {
821    # only some columns are displayed (and in a different order than declared
822    # in -columns), a non-displayed column becomes stretchable  --> nothing
823    # happens
824    set origTreeWidth [winfo width .tv]
825    set res [list [.tv column bar -width] [.tv column colA -width]]
826    .tv column bar -stretch 1
827    update idletasks ; # no change, widget redisplayed
828    lappend res [.tv column bar -width] [.tv column colA -width]
829    # this column becomes visible  --> widget resizes
830    .tv configure -displaycolumns {bar colC colA colB}
831    update idletasks ; # no slack anymore because the widget resizes (shrinks)
832    lappend res [.tv column bar -width] [.tv column colA -width] \
833                [expr {[winfo width .tv] < $origTreeWidth}]
834} -cleanup {
835    destroy .tv
836} -result {60 50 60 50 60 50 1}
837
838test treeview-11.1 "style command" -body {
839    ttk::treeview .w
840    list [.w cget -style] [.w style] [winfo class .w]
841} -cleanup {
842    destroy .w
843} -result {{} Treeview Treeview}
844test treeview-11.2 "style command" -body {
845    ttk::style configure customStyle.Treeview
846    ttk::treeview .w -style customStyle.Treeview
847    list [.w cget -style] [.w style] [winfo class .w]
848} -cleanup {
849    destroy .w
850} -result {customStyle.Treeview customStyle.Treeview Treeview}
851
852tcltest::cleanupTests
853