1# ----------------------------------------------------------------------------
2#  tree.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: tree.tcl,v 1.62 2009/09/08 20:46:40 oberdorfer Exp $
5# ----------------------------------------------------------------------------
6#  Index of commands:
7#     - Tree::create
8#     - Tree::configure
9#     - Tree::cget
10#     - Tree::insert
11#     - Tree::itemconfigure
12#     - Tree::itemcget
13#     - Tree::bindArea
14#     - Tree::bindText
15#     - Tree::bindImage
16#     - Tree::delete
17#     - Tree::move
18#     - Tree::reorder
19#     - Tree::selection
20#     - Tree::exists
21#     - Tree::parent
22#     - Tree::index
23#     - Tree::nodes
24#     - Tree::see
25#     - Tree::opentree
26#     - Tree::closetree
27#     - Tree::edit
28#     - Tree::xview
29#     - Tree::yview
30#     - Tree::_update_edit_size
31#     - Tree::_destroy
32#     - Tree::_see
33#     - Tree::_recexpand
34#     - Tree::_subdelete
35#     - Tree::_update_scrollregion
36#     - Tree::_cross_event
37#     - Tree::_draw_node
38#     - Tree::_draw_subnodes
39#     - Tree::_update_nodes
40#     - Tree::_draw_tree
41#     - Tree::_redraw_tree
42#     - Tree::_redraw_selection
43#     - Tree::_redraw_idle
44#     - Tree::_drag_cmd
45#     - Tree::_drop_cmd
46#     - Tree::_over_cmd
47#     - Tree::_auto_scroll
48#     - Tree::_scroll
49#     - Tree::_themechanged
50# ----------------------------------------------------------------------------
51
52namespace eval Tree {
53    Widget::define Tree tree DragSite DropSite DynamicHelp
54
55    namespace eval Node {
56        Widget::declare Tree::Node {
57            {-text       String     ""      0}
58 	    {-font       String     "TkTextFont" 0}
59            {-image      TkResource ""      0 label}
60            {-window     String     ""      0}
61            {-fill       Color      "SystemWindowText" 0}
62            {-data       String     ""      0}
63            {-open       Boolean    0       0}
64	    {-selectable Boolean    1       0}
65            {-drawcross  Enum       auto    0 {auto always never allways}}
66	    {-padx       Int        -1      0 "%d >= -1"}
67	    {-deltax     Int        -1      0 "%d >= -1"}
68	    {-anchor     String     "w"     0 ""}
69        }
70    }
71
72    DynamicHelp::include Tree::Node balloon
73
74    Widget::tkinclude Tree canvas .c \
75	    remove     {
76	-insertwidth -insertbackground -insertborderwidth -insertofftime
77	-insertontime -selectborderwidth -closeenough -confine -scrollregion
78	-xscrollincrement -yscrollincrement -width -height
79    } \
80	    initialize {
81	-relief sunken -borderwidth 2 -takefocus 1
82	-highlightthickness 1 -width 200
83    }
84
85    Widget::declare Tree {
86        {-deltax           Int 10 0 "%d >= 0"}
87        {-deltay           Int 15 0 "%d >= 0"}
88        {-padx             Int 20 0 "%d >= 0"}
89        {-background       Color      "SystemWindow"  0}
90        {-selectbackground Color      "SystemHighlight"  0}
91        {-selectforeground Color      "SystemHighlightText" 0}
92	{-selectcommand    String     "" 0}
93        {-width            TkResource "" 0 listbox}
94        {-height           TkResource "" 0 listbox}
95        {-selectfill       Boolean 0  0}
96        {-showlines        Boolean 1  0}
97        {-linesfill        Color      "SystemWindowText"  0}
98        {-linestipple      TkResource ""     0 {label -bitmap}}
99	{-crossfill        Color      "SystemWindowText"  0}
100        {-redraw           Boolean 1  0}
101        {-opencmd          String  "" 0}
102        {-closecmd         String  "" 0}
103        {-dropovermode     Flag    "wpn" 0 "wpn"}
104        {-bg               Synonym -background}
105
106        {-crossopenimage    String  ""  0}
107        {-crosscloseimage   String  ""  0}
108        {-crossopenbitmap   String  ""  0}
109        {-crossclosebitmap  String  ""  0}
110    }
111
112    DragSite::include Tree "TREE_NODE" 1
113    DropSite::include Tree {
114        TREE_NODE {copy {} move {}}
115    }
116
117    Widget::addmap Tree "" .c {-deltay -yscrollincrement}
118
119    # Trees on windows have a white (system window) background
120    if { $::tcl_platform(platform) == "windows" } {
121	option add *Tree.c.background SystemWindow widgetDefault
122	option add *TreeNode.fill SystemWindowText widgetDefault
123    }
124
125    bind Tree <FocusIn>   [list after idle {BWidget::refocus %W %W.c}]
126    bind Tree <Destroy>   [list Tree::_destroy %W]
127    bind Tree <Configure> [list Tree::_update_scrollregion %W]
128
129
130    bind TreeSentinalStart <Button-1> {
131	if { $::Tree::sentinal(%W) } {
132	    set ::Tree::sentinal(%W) 0
133	    break
134	}
135    }
136
137    bind TreeSentinalEnd <Button-1> {
138	set ::Tree::sentinal(%W) 0
139    }
140
141    bind TreeFocus <Button-1> [list focus %W]
142
143    if {[lsearch [bindtags .] TreeThemeChanged] < 0} {
144        bindtags . [linsert [bindtags .] 1 TreeThemeChanged]
145    }
146
147    variable _edit
148}
149
150
151# ----------------------------------------------------------------------------
152#  Command Tree::create
153# ----------------------------------------------------------------------------
154proc Tree::create { path args } {
155    variable $path
156    upvar 0  $path data
157
158    Widget::init Tree $path $args
159    set ::Tree::sentinal($path.c) 0
160
161    if {[Widget::cget $path -crossopenbitmap] == ""} {
162        set file [file join $::BWIDGET::LIBRARY images "minus.xbm"]
163        Widget::configure $path [list -crossopenbitmap @$file]
164    }
165    if {[Widget::cget $path -crossclosebitmap] == ""} {
166        set file [file join $::BWIDGET::LIBRARY images "plus.xbm"]
167        Widget::configure $path [list -crossclosebitmap @$file]
168    }
169
170    set data(root)         {{}}
171    set data(selnodes)     {}
172    set data(upd,level)    0
173    set data(upd,nodes)    {}
174    set data(upd,afterid)  ""
175    set data(dnd,scroll)   ""
176    set data(dnd,afterid)  ""
177    set data(dnd,selnodes) {}
178    set data(dnd,node)     ""
179
180    frame $path -class Tree -bd 0 -highlightthickness 0 -relief flat \
181	    -takefocus 0
182    # For 8.4+ we don't want to inherit the padding
183    catch {$path configure -padx 0 -pady 0}
184    eval [list canvas $path.c] [Widget::subcget $path .c] -xscrollincrement 8
185    bindtags $path.c [list TreeSentinalStart TreeFocus $path.c Canvas \
186	    [winfo toplevel $path] all TreeSentinalEnd]
187    pack $path.c -expand yes -fill both
188    $path.c bind cross <ButtonPress-1> [list Tree::_cross_event $path]
189
190    # Added by ericm@scriptics.com
191    # These allow keyboard traversal of the tree
192    bind $path.c <KeyPress-Up>    [list Tree::_keynav up $path]
193    bind $path.c <KeyPress-Down>  [list Tree::_keynav down $path]
194    bind $path.c <KeyPress-Right> [list Tree::_keynav right $path]
195    bind $path.c <KeyPress-Left>  [list Tree::_keynav left $path]
196    bind $path.c <KeyPress-space> [list +Tree::_keynav space $path]
197
198    # These allow keyboard control of the scrolling
199    bind $path.c <Control-KeyPress-Up>    [list $path.c yview scroll -1 units]
200    bind $path.c <Control-KeyPress-Down>  [list $path.c yview scroll  1 units]
201    bind $path.c <Control-KeyPress-Left>  [list $path.c xview scroll -1 units]
202    bind $path.c <Control-KeyPress-Right> [list $path.c xview scroll  1 units]
203    # ericm@scriptics.com
204
205    BWidget::bindMouseWheel $path.c
206    BWidget::bindMiddleMouseMovement $path.c
207
208    DragSite::setdrag $path $path.c Tree::_init_drag_cmd \
209	    [Widget::cget $path -dragendcmd] 1
210    DropSite::setdrop $path $path.c Tree::_over_cmd Tree::_drop_cmd 1
211
212    Widget::create Tree $path
213
214    set w [Widget::cget $path -width]
215    set h [Widget::cget $path -height]
216    set dy [Widget::cget $path -deltay]
217    $path.c configure -width [expr {$w*8}] -height [expr {$h*$dy}]
218
219    # ericm
220    # Bind <Button-1> to select the clicked node -- no reason not to, right?
221
222    ## Bind button 1 to select the node via the _mouse_select command.
223    ## This command will generate the proper <<TreeSelect>> virtual event
224    ## when necessary.
225    set selectcmd Tree::_mouse_select
226    Tree::bindText  $path <Button-1>         [list $selectcmd $path set]
227    Tree::bindImage $path <Button-1>         [list $selectcmd $path set]
228    Tree::bindText  $path <Control-Button-1> [list $selectcmd $path toggle]
229    Tree::bindImage $path <Control-Button-1> [list $selectcmd $path toggle]
230
231    # Add sentinal bindings for double-clicking on items, to handle the
232    # gnarly Tk bug wherein:
233    # ButtonClick
234    # ButtonClick
235    # On a canvas item translates into button click on the item, button click
236    # on the canvas, double-button on the item, single button click on the
237    # canvas (which can happen if the double-button on the item causes some
238    # other event to be handled in between when the button clicks are examined
239    # for the canvas)
240    $path.c bind TreeItemSentinal <Double-Button-1> \
241	[list set ::Tree::sentinal($path.c) 1]
242    # ericm
243
244    bind TreeThemeChanged <<ThemeChanged>> \
245	   "+ [namespace current]::_themechanged $path"
246
247    return $path
248}
249
250
251# ----------------------------------------------------------------------------
252#  Command Tree::configure
253# ----------------------------------------------------------------------------
254proc Tree::configure { path args } {
255    variable $path
256    upvar 0  $path data
257
258    set res [Widget::configure $path $args]
259
260    set ch1 [expr {[Widget::hasChanged $path -deltax val] |
261                   [Widget::hasChanged $path -deltay dy]  |
262                   [Widget::hasChanged $path -padx val]   |
263                   [Widget::hasChanged $path -showlines val]}]
264
265    set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
266                   [Widget::hasChanged $path -selectforeground val]}]
267
268    if { [Widget::hasChanged $path -linesfill   fill] |
269         [Widget::hasChanged $path -linestipple stipple] } {
270        $path.c itemconfigure line  -fill $fill -stipple $stipple
271    }
272
273    if { [Widget::hasChanged $path -crossfill fill] } {
274        $path.c itemconfigure cross -foreground $fill
275    }
276
277    if {[Widget::hasChanged $path -selectfill fill]} {
278	# Make sure that the full-width boxes have either all or none
279	# of the standard node bindings
280	if {$fill} {
281	    foreach event [$path.c bind "node"] {
282		$path.c bind "box" $event [$path.c bind "node" $event]
283	    }
284	} else {
285	    foreach event [$path.c bind "node"] {
286		$path.c bind "box" $event {}
287	    }
288	}
289    }
290
291    if { $ch1 } {
292        _redraw_idle $path 3
293    } elseif { $ch2 } {
294        _redraw_idle $path 1
295    }
296
297    if { [Widget::hasChanged $path -height h] } {
298        $path.c configure -height [expr {$h*$dy}]
299    }
300    if { [Widget::hasChanged $path -width w] } {
301        $path.c configure -width [expr {$w*8}]
302    }
303
304    if { [Widget::hasChanged $path -redraw bool] && $bool } {
305        set upd $data(upd,level)
306        set data(upd,level) 0
307        _redraw_idle $path $upd
308    }
309
310    set force [Widget::hasChanged $path -dragendcmd dragend]
311    DragSite::setdrag $path $path.c Tree::_init_drag_cmd $dragend $force
312    DropSite::setdrop $path $path.c Tree::_over_cmd Tree::_drop_cmd
313
314    return $res
315}
316
317
318# ----------------------------------------------------------------------------
319#  Command Tree::cget
320# ----------------------------------------------------------------------------
321proc Tree::cget { path option } {
322    return [Widget::cget $path $option]
323}
324
325
326# ----------------------------------------------------------------------------
327#  Command Tree::insert
328# ----------------------------------------------------------------------------
329proc Tree::insert { path index parent node args } {
330    variable $path
331    upvar 0  $path data
332
333    set node [_node_name $path $node]
334    set node [Widget::nextIndex $path $node]
335
336    if { [info exists data($node)] } {
337        return -code error "node \"$node\" already exists"
338    }
339    set parent [_node_name $path $parent]
340    if { ![info exists data($parent)] } {
341        return -code error "node \"$parent\" does not exist"
342    }
343
344    Widget::init Tree::Node $path.$node $args
345    if {[string equal $index "end"]} {
346        lappend data($parent) $node
347    } else {
348        incr index
349        set data($parent) [linsert $data($parent) $index $node]
350    }
351    set data($node) [list $parent]
352
353    if { [string equal $parent "root"] } {
354        _redraw_idle $path 3
355    } elseif { [visible $path $parent] } {
356        # parent is visible...
357        if { [Widget::getMegawidgetOption $path.$parent -open] } {
358            # ...and opened -> redraw whole
359            _redraw_idle $path 3
360        } else {
361            # ...and closed -> redraw cross
362            lappend data(upd,nodes) $parent 8
363            _redraw_idle $path 2
364        }
365    }
366
367    return $node
368}
369
370
371# ----------------------------------------------------------------------------
372#  Command Tree::itemconfigure
373# ----------------------------------------------------------------------------
374proc Tree::itemconfigure { path node args } {
375    variable $path
376    upvar 0  $path data
377
378    set node [_node_name $path $node]
379    if { [string equal $node "root"] || ![info exists data($node)] } {
380        return -code error "node \"$node\" does not exist"
381    }
382
383    set result [Widget::configure $path.$node $args]
384
385    _set_help $path $node
386
387    if { [visible $path $node] } {
388        set lopt   {}
389        set flag   0
390        foreach opt {-window -image -drawcross -font -text -fill} {
391            set flag [expr {$flag << 1}]
392            if { [Widget::hasChanged $path.$node $opt val] } {
393                set flag [expr {$flag | 1}]
394            }
395        }
396
397        if { [Widget::hasChanged $path.$node -open val] } {
398            if {[llength $data($node)] > 1} {
399                # node have subnodes - full redraw
400                _redraw_idle $path 3
401            } else {
402                # force a redraw of the plus/minus sign
403                set flag [expr {$flag | 8}]
404            }
405        }
406
407	if {$data(upd,level) < 3 && [Widget::hasChanged $path.$node -padx x]} {
408	    _redraw_idle $path 3
409	}
410
411	if { $data(upd,level) < 3 && $flag } {
412            if { [set idx [lsearch -exact $data(upd,nodes) $node]] == -1 } {
413                lappend data(upd,nodes) $node $flag
414            } else {
415                incr idx
416                set flag [expr {[lindex $data(upd,nodes) $idx] | $flag}]
417                set data(upd,nodes) [lreplace $data(upd,nodes) $idx $idx $flag]
418            }
419            _redraw_idle $path 2
420        }
421    }
422    return $result
423}
424
425
426# ----------------------------------------------------------------------------
427#  Command Tree::itemcget
428# ----------------------------------------------------------------------------
429proc Tree::itemcget { path node option } {
430    # Instead of upvar'ing $path as data for this test, just directly refer to
431    # it, as that is faster.
432    set node [_node_name $path $node]
433    if { [string equal $node "root"] || \
434	    ![info exists ::Tree::${path}($node)] } {
435        return -code error "node \"$node\" does not exist"
436    }
437
438    return [Widget::cget $path.$node $option]
439}
440
441# ----------------------------------------------------------------------------
442# Command Tree::bindArea
443# ----------------------------------------------------------------------------
444proc Tree::bindArea { path event script } {
445    bind $path.c $event $script
446}
447
448# ----------------------------------------------------------------------------
449#  Command Tree::bindText
450# ----------------------------------------------------------------------------
451proc Tree::bindText { path event script } {
452    if {[string length $script]} {
453	append script " \[Tree::_get_node_name [list $path] current 2 1\]"
454    }
455    $path.c bind "node" $event $script
456    if {[Widget::getoption $path -selectfill]} {
457	$path.c bind "box" $event $script
458    } else {
459	$path.c bind "box" $event {}
460    }
461}
462
463
464# ----------------------------------------------------------------------------
465#  Command Tree::bindImage
466# ----------------------------------------------------------------------------
467proc Tree::bindImage { path event script } {
468    if {[string length $script]} {
469	append script " \[Tree::_get_node_name [list $path] current 2 1\]"
470    }
471    $path.c bind "img" $event $script
472    if {[Widget::getoption $path -selectfill]} {
473	$path.c bind "box" $event $script
474    } else {
475	$path.c bind "box" $event {}
476    }
477}
478
479
480# ----------------------------------------------------------------------------
481#  Command Tree::delete
482# ----------------------------------------------------------------------------
483proc Tree::delete { path args } {
484    variable $path
485    upvar 0  $path data
486
487    set sel 0
488    foreach lnodes $args {
489	foreach node $lnodes {
490            set node [_node_name $path $node]
491	    if { ![string equal $node "root"] && [info exists data($node)] } {
492		set parent [lindex $data($node) 0]
493		set idx	   [lsearch -exact $data($parent) $node]
494		set data($parent) [lreplace $data($parent) $idx $idx]
495		incr sel [_subdelete $path [list $node]]
496	    }
497	}
498    }
499    if {$sel} {
500	# if selection changed, call the selectcommand
501	__call_selectcmd $path
502    }
503
504    _redraw_idle $path 3
505}
506
507
508# ----------------------------------------------------------------------------
509#  Command Tree::move
510# ----------------------------------------------------------------------------
511proc Tree::move { path parent node index } {
512    variable $path
513    upvar 0  $path data
514
515    set node [_node_name $path $node]
516    if { [string equal $node "root"] || ![info exists data($node)] } {
517        return -code error "node \"$node\" does not exist"
518    }
519    if { ![info exists data($parent)] } {
520        return -code error "node \"$parent\" does not exist"
521    }
522    set p $parent
523    while { ![string equal $p "root"] } {
524        if { [string equal $p $node] } {
525            return -code error "node \"$parent\" is a descendant of \"$node\""
526        }
527        set p [parent $path $p]
528    }
529
530    set oldp        [lindex $data($node) 0]
531    set idx         [lsearch -exact $data($oldp) $node]
532    set data($oldp) [lreplace $data($oldp) $idx $idx]
533    set data($node) [concat [list $parent] [lrange $data($node) 1 end]]
534    if { [string equal $index "end"] } {
535        lappend data($parent) $node
536    } else {
537        incr index
538        set data($parent) [linsert $data($parent) $index $node]
539    }
540    if { ([string equal $oldp "root"] ||
541          ([visible $path $oldp] && [Widget::getoption $path.$oldp   -open])) ||
542         ([string equal $parent "root"] ||
543          ([visible $path $parent] && [Widget::getoption $path.$parent -open])) } {
544        _redraw_idle $path 3
545    }
546}
547
548
549# ----------------------------------------------------------------------------
550#  Command Tree::reorder
551# ----------------------------------------------------------------------------
552proc Tree::reorder { path node neworder } {
553    variable $path
554    upvar 0  $path data
555
556    set node [_node_name $path $node]
557    if { ![info exists data($node)] } {
558        return -code error "node \"$node\" does not exist"
559    }
560    set children [lrange $data($node) 1 end]
561    if { [llength $children] } {
562        set children [BWidget::lreorder $children $neworder]
563        set data($node) [linsert $children 0 [lindex $data($node) 0]]
564        if { [visible $path $node] && [Widget::getoption $path.$node -open] } {
565            _redraw_idle $path 3
566        }
567    }
568}
569
570
571# ----------------------------------------------------------------------------
572#  Command Tree::selection
573# ----------------------------------------------------------------------------
574proc Tree::selection { path cmd args } {
575    variable $path
576    upvar 0  $path data
577
578    switch -- $cmd {
579	toggle {
580            foreach node $args {
581                set node [_node_name $path $node]
582                if {![info exists data($node)]} {
583		    return -code error \
584			    "$path selection toggle: Cannot toggle unknown node \"$node\"."
585		}
586	    }
587            foreach node $args {
588                set node [_node_name $path $node]
589		if {[$path selection includes $node]} {
590		    $path selection remove $node
591		} else {
592		    $path selection add $node
593		}
594            }
595	}
596        set {
597            foreach node $args {
598                set node [_node_name $path $node]
599                if {![info exists data($node)]} {
600		    return -code error \
601			    "$path selection set: Cannot select unknown node \"$node\"."
602		}
603	    }
604            set data(selnodes) {}
605            foreach node $args {
606                set node [_node_name $path $node]
607		if { [Widget::getoption $path.$node -selectable] } {
608		    if { [lsearch -exact $data(selnodes) $node] == -1 } {
609			lappend data(selnodes) $node
610		    }
611		}
612            }
613	    __call_selectcmd $path
614        }
615        add {
616            foreach node $args {
617                set node [_node_name $path $node]
618                if {![info exists data($node)]} {
619		    return -code error \
620			    "$path selection add: Cannot select unknown node \"$node\"."
621		}
622	    }
623            foreach node $args {
624                set node [_node_name $path $node]
625		if { [Widget::getoption $path.$node -selectable] } {
626		    if { [lsearch -exact $data(selnodes) $node] == -1 } {
627			lappend data(selnodes) $node
628		    }
629		}
630            }
631	    __call_selectcmd $path
632        }
633	range {
634	    # Here's our algorithm:
635	    #    make a list of all nodes, then take the range from node1
636	    #    to node2 and select those nodes
637	    #
638	    # This works because of how this widget handles redraws:
639	    #    The tree is always completely redrawn, and always from
640	    #    top to bottom. So the list of visible nodes *is* the
641	    #    list of nodes, and we can use that to decide which nodes
642	    #    to select.
643
644	    if {[llength $args] != 2} {
645		return -code error \
646			"wrong#args: Expected $path selection range node1 node2"
647	    }
648
649	    foreach {node1 node2} $args break
650
651            set node1 [_node_name $path $node1]
652            set node2 [_node_name $path $node2]
653	    if {![info exists data($node1)]} {
654		return -code error \
655			"$path selection range: Cannot start range at unknown node \"$node1\"."
656	    }
657	    if {![info exists data($node2)]} {
658		return -code error \
659			"$path selection range: Cannot end range at unknown node \"$node2\"."
660	    }
661
662	    set nodes {}
663	    foreach nodeItem [$path.c find withtag node] {
664		set node [Tree::_get_node_name $path $nodeItem 2]
665		if { [Widget::getoption $path.$node -selectable] } {
666		    lappend nodes $node
667		}
668	    }
669	    # surles: Set the root string to the first element on the list.
670	    if {$node1 == "root"} {
671		set node1 [lindex $nodes 0]
672	    }
673	    if {$node2 == "root"} {
674		set node2 [lindex $nodes 0]
675	    }
676
677	    # Find the first visible ancestor of node1, starting with node1
678	    while {[set index1 [lsearch -exact $nodes $node1]] == -1} {
679		set node1 [lindex $data($node1) 0]
680	    }
681	    # Find the first visible ancestor of node2, starting with node2
682	    while {[set index2 [lsearch -exact $nodes $node2]] == -1} {
683		set node2 [lindex $data($node2) 0]
684	    }
685	    # If the nodes were given in backwards order, flip the
686	    # indices now
687	    if { $index2 < $index1 } {
688		incr index1 $index2
689		set index2 [expr {$index1 - $index2}]
690		set index1 [expr {$index1 - $index2}]
691	    }
692	    set data(selnodes) [lrange $nodes $index1 $index2]
693	    __call_selectcmd $path
694	}
695        remove {
696            foreach node $args {
697                set node [_node_name $path $node]
698                if { [set idx [lsearch -exact $data(selnodes) $node]] != -1 } {
699                    set data(selnodes) [lreplace $data(selnodes) $idx $idx]
700                }
701            }
702	    __call_selectcmd $path
703        }
704        clear {
705	    if {[llength $args] != 0} {
706		return -code error \
707			"wrong#args: Expected $path selection clear"
708	    }
709            set data(selnodes) {}
710	    __call_selectcmd $path
711        }
712        get {
713	    if {[llength $args] != 0} {
714		return -code error \
715			"wrong#args: Expected $path selection get"
716	    }
717            set nodes [list]
718	    foreach node $data(selnodes) {
719		lappend nodes [_node_name_rev $path $node]
720	    }
721	    return $nodes
722        }
723        includes {
724	    if {[llength $args] != 1} {
725		return -code error \
726			"wrong#args: Expected $path selection includes node"
727	    }
728	    set node [lindex $args 0]
729            set node [_node_name $path $node]
730            return [expr {[lsearch -exact $data(selnodes) $node] != -1}]
731        }
732        default {
733            return
734        }
735    }
736    _redraw_idle $path 1
737}
738
739
740proc Tree::getcanvas { path } {
741    return $path.c
742}
743
744
745proc Tree::__call_selectcmd { path } {
746    variable $path
747    upvar 0  $path data
748
749    set selectcmd [Widget::getoption $path -selectcommand]
750    if {[llength $selectcmd]} {
751	lappend selectcmd $path
752	lappend selectcmd $data(selnodes)
753	uplevel \#0 $selectcmd
754    }
755    return
756}
757
758# ----------------------------------------------------------------------------
759#  Command Tree::exists
760# ----------------------------------------------------------------------------
761proc Tree::exists { path node } {
762    variable $path
763    upvar 0  $path data
764
765    set node [_node_name $path $node]
766    return [info exists data($node)]
767}
768
769
770# ----------------------------------------------------------------------------
771#  Command Tree::visible
772# ----------------------------------------------------------------------------
773proc Tree::visible { path node } {
774    set node [_node_name $path $node]
775    set idn [$path.c find withtag n:$node]
776    return [llength $idn]
777}
778
779
780# ----------------------------------------------------------------------------
781#  Command Tree::parent
782# ----------------------------------------------------------------------------
783proc Tree::parent { path node } {
784    variable $path
785    upvar 0  $path data
786
787    set node [_node_name $path $node]
788    if { ![info exists data($node)] } {
789        return -code error "node \"$node\" does not exist"
790    }
791    return [lindex $data($node) 0]
792}
793
794
795# ----------------------------------------------------------------------------
796#  Command Tree::index
797# ----------------------------------------------------------------------------
798proc Tree::index { path node } {
799    variable $path
800    upvar 0  $path data
801
802    set node [_node_name $path $node]
803    if { [string equal $node "root"] || ![info exists data($node)] } {
804        return -code error "node \"$node\" does not exist"
805    }
806    set parent [lindex $data($node) 0]
807    return [expr {[lsearch -exact $data($parent) $node] - 1}]
808}
809
810
811# ----------------------------------------------------------------------------
812#  Tree::find
813#     Returns the node given a position.
814#  findInfo     @x,y ?confine?
815#               lineNumber
816# ----------------------------------------------------------------------------
817proc Tree::find {path findInfo {confine ""}} {
818    if {[regexp -- {^@([0-9]+),([0-9]+)$} $findInfo match x y]} {
819        set x [$path.c canvasx $x]
820        set y [$path.c canvasy $y]
821    } elseif {[regexp -- {^[0-9]+$} $findInfo lineNumber]} {
822        set dy [Widget::getoption $path -deltay]
823        set y  [expr {$dy*($lineNumber+0.5)}]
824        set confine ""
825    } else {
826        return -code error "invalid find spec \"$findInfo\""
827    }
828
829    set found  0
830    set region [$path.c bbox all]
831    if {[llength $region]} {
832        set xi [lindex $region 0]
833        set xs [lindex $region 2]
834        foreach id [$path.c find overlapping $xi $y $xs $y] {
835            set ltags [$path.c gettags $id]
836            set item  [lindex $ltags 1]
837            if { [string equal $item "node"] ||
838                 [string equal $item "img"]  ||
839                 [string equal $item "win"] } {
840                # item is the label or image/window of the node
841                set node  [Tree::_get_node_name $path $id 2]
842                set found 1
843                break
844            }
845        }
846    }
847
848    if {$found} {
849        if {![string equal $confine ""]} {
850            # test if x stand inside node bbox
851	    set padx [_get_node_padx $path $node]
852            set xi [expr {[lindex [$path.c coords n:$node] 0] - $padx}]
853            set xs [lindex [$path.c bbox n:$node] 2]
854            if {$x >= $xi && $x <= $xs} {
855                return [_node_name_rev $path $node]
856            }
857        } else {
858            return [_node_name_rev $path $node]
859        }
860    }
861    return ""
862}
863
864
865# ----------------------------------------------------------------------------
866#  Command Tree::line
867#     Returns the line where a node was drawn.
868# ----------------------------------------------------------------------------
869proc Tree::line {path node} {
870    set node [_node_name $path $node]
871    set item [$path.c find withtag n:$node]
872    if {[string length $item]} {
873        set dy   [Widget::getoption $path -deltay]
874        set y    [lindex [$path.c coords $item] 1]
875        set line [expr {int($y/$dy)}]
876    } else {
877        set line -1
878    }
879    return $line
880}
881
882
883# ----------------------------------------------------------------------------
884#  Command Tree::nodes
885# ----------------------------------------------------------------------------
886proc Tree::nodes { path node {first ""} {last ""} } {
887    variable $path
888    upvar 0  $path data
889
890    set node [_node_name $path $node]
891    if { ![info exists data($node)] } {
892        return -code error "node \"$node\" does not exist"
893    }
894
895    if { ![string length $first] } {
896        return [lrange $data($node) 1 end]
897    }
898
899    if { ![string length $last] } {
900        return [lindex [lrange $data($node) 1 end] $first]
901    } else {
902        return [lrange [lrange $data($node) 1 end] $first $last]
903    }
904}
905
906
907# Tree::visiblenodes --
908#
909#	Retrieve a list of all the nodes in a tree.
910#
911# Arguments:
912#	path	tree to retrieve nodes for.
913#
914# Results:
915#	nodes	list of nodes in the tree.
916
917proc Tree::visiblenodes { path } {
918    variable $path
919    upvar 0  $path data
920
921    # Root is always open (?), so all of its children automatically get added
922    # to the result, and to the stack.
923    set st [lrange $data(root) 1 end]
924    set result $st
925
926    while {[llength $st]} {
927	set node [lindex $st end]
928	set st [lreplace $st end end]
929	# Danger, danger!  Using getMegawidgetOption is fragile, but much
930	# much faster than going through cget.
931	if { [Widget::getMegawidgetOption $path.$node -open] } {
932	    set nodes [lrange $data($node) 1 end]
933	    set result [concat $result $nodes]
934	    set st [concat $st $nodes]
935	}
936    }
937    return $result
938}
939
940# ----------------------------------------------------------------------------
941#  Command Tree::see
942# ----------------------------------------------------------------------------
943proc Tree::see { path node } {
944    variable $path
945    upvar 0  $path data
946
947    set node [_node_name $path $node]
948    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
949        after cancel $data(upd,afterid)
950        _redraw_tree $path
951    }
952    set idn [$path.c find withtag n:$node]
953    if { $idn != "" } {
954        Tree::_see $path $idn
955    }
956}
957
958
959# ----------------------------------------------------------------------------
960#  Command Tree::opentree
961# ----------------------------------------------------------------------------
962# JDC: added option recursive
963proc Tree::opentree { path node {recursive 1} } {
964    variable $path
965    upvar 0  $path data
966
967    set node [_node_name $path $node]
968    if { [string equal $node "root"] || ![info exists data($node)] } {
969        return -code error "node \"$node\" does not exist"
970    }
971
972    _recexpand $path $node 1 $recursive [Widget::getoption $path -opencmd]
973    _redraw_idle $path 3
974}
975
976
977# ----------------------------------------------------------------------------
978#  Command Tree::closetree
979# ----------------------------------------------------------------------------
980proc Tree::closetree { path node {recursive 1} } {
981    variable $path
982    upvar 0  $path data
983
984    set node [_node_name $path $node]
985    if { [string equal $node "root"] || ![info exists data($node)] } {
986        return -code error "node \"$node\" does not exist"
987    }
988
989    _recexpand $path $node 0 $recursive [Widget::getoption $path -closecmd]
990    _redraw_idle $path 3
991}
992
993
994proc Tree::toggle { path node } {
995    if {[$path itemcget $node -open]} {
996        $path closetree $node 0
997    } else {
998        $path opentree $node 0
999    }
1000}
1001
1002
1003# ----------------------------------------------------------------------------
1004#  Command Tree::edit
1005# ----------------------------------------------------------------------------
1006proc Tree::edit { path node text {verifycmd ""} {clickres 0} {select 1}} {
1007    variable _edit
1008    variable $path
1009    upvar 0  $path data
1010
1011    set node [_node_name $path $node]
1012    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
1013        after cancel $data(upd,afterid)
1014        _redraw_tree $path
1015    }
1016    set idn [$path.c find withtag n:$node]
1017    if { $idn != "" } {
1018        Tree::_see $path $idn
1019
1020        set oldfg  [$path.c itemcget $idn -fill]
1021        set sbg    [Widget::getoption $path -selectbackground]
1022        set coords [$path.c coords $idn]
1023        set x      [lindex $coords 0]
1024        set y      [lindex $coords 1]
1025        set bd     [expr {[$path.c cget -borderwidth]+[$path.c cget -highlightthickness]}]
1026        set w      [expr {[winfo width $path] - 2*$bd}]
1027        set wmax   [expr {[$path.c canvasx $w]-$x}]
1028
1029        set _edit(text) $text
1030        set _edit(wait) 0
1031
1032        $path.c itemconfigure $idn    -fill [Widget::getoption $path -background]
1033        $path.c itemconfigure s:$node -fill {} -outline {}
1034
1035        set frame  [frame $path.edit \
1036                        -relief flat -borderwidth 0 -highlightthickness 0 \
1037                        -background [Widget::getoption $path -background]]
1038        set ent    [entry $frame.edit \
1039                        -width              0     \
1040                        -relief             solid \
1041                        -borderwidth        1     \
1042                        -highlightthickness 0     \
1043                        -foreground         [Widget::getoption $path.$node -fill] \
1044                        -background         [Widget::getoption $path -background] \
1045                        -selectforeground   [Widget::getoption $path -selectforeground] \
1046                        -selectbackground   $sbg  \
1047                        -font               [Widget::getoption $path.$node -font] \
1048                        -textvariable       Tree::_edit(text)]
1049        pack $ent -ipadx 8 -anchor w
1050
1051        set idw [$path.c create window $x $y -window $frame -anchor w]
1052        trace variable Tree::_edit(text) w \
1053	    [list Tree::_update_edit_size $path $ent $idw $wmax]
1054        tkwait visibility $ent
1055        grab  $frame
1056        BWidget::focus set $ent
1057
1058        _update_edit_size $path $ent $idw $wmax
1059        update
1060        if { $select } {
1061            $ent selection range 0 end
1062            $ent icursor end
1063            $ent xview end
1064        }
1065
1066        bindtags $ent [list $ent Entry]
1067        bind $ent <Escape> {set Tree::_edit(wait) 0}
1068        bind $ent <Return> {set Tree::_edit(wait) 1}
1069        if { $clickres == 0 || $clickres == 1 } {
1070            bind $frame <Button>  [list set Tree::_edit(wait) $clickres]
1071        }
1072
1073        set ok 0
1074        while { !$ok } {
1075            tkwait variable Tree::_edit(wait)
1076            if { !$_edit(wait) || [llength $verifycmd]==0 ||
1077                 [uplevel \#0 $verifycmd [list $_edit(text)]] } {
1078                set ok 1
1079            }
1080        }
1081
1082        trace vdelete Tree::_edit(text) w \
1083	    [list Tree::_update_edit_size $path $ent $idw $wmax]
1084        grab release $frame
1085        BWidget::focus release $ent
1086        destroy $frame
1087        $path.c delete $idw
1088        $path.c itemconfigure $idn    -fill $oldfg
1089        $path.c itemconfigure s:$node -fill $sbg -outline $sbg
1090
1091        if { $_edit(wait) } {
1092            return $_edit(text)
1093        }
1094    }
1095    return ""
1096}
1097
1098
1099# ----------------------------------------------------------------------------
1100#  Command Tree::xview
1101# ----------------------------------------------------------------------------
1102proc Tree::xview { path args } {
1103    return [eval [linsert $args 0 $path.c xview]]
1104}
1105
1106
1107# ----------------------------------------------------------------------------
1108#  Command Tree::yview
1109# ----------------------------------------------------------------------------
1110proc Tree::yview { path args } {
1111    return [eval [linsert $args 0 $path.c yview]]
1112}
1113
1114
1115# ----------------------------------------------------------------------------
1116#  Command Tree::_update_edit_size
1117# ----------------------------------------------------------------------------
1118proc Tree::_update_edit_size { path entry idw wmax args } {
1119    set entw [winfo reqwidth $entry]
1120    if { $entw+8 >= $wmax } {
1121        $path.c itemconfigure $idw -width $wmax
1122    } else {
1123        $path.c itemconfigure $idw -width 0
1124    }
1125}
1126
1127
1128# ----------------------------------------------------------------------------
1129#  Command Tree::_see
1130# ----------------------------------------------------------------------------
1131proc Tree::_see { path idn } {
1132    set bbox [$path.c bbox $idn]
1133    set scrl [$path.c cget -scrollregion]
1134
1135    set ymax [lindex $scrl 3]
1136    set dy   [$path.c cget -yscrollincrement]
1137    set yv   [$path yview]
1138    set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]
1139    set yv1  [expr {round([lindex $yv 1]*$ymax/$dy)}]
1140    set y    [expr {int([lindex [$path.c coords $idn] 1]/$dy)}]
1141    if { $y < $yv0 } {
1142        $path.c yview scroll [expr {$y-$yv0}] units
1143    } elseif { $y >= $yv1 } {
1144        $path.c yview scroll [expr {$y-$yv1+1}] units
1145    }
1146
1147    set xmax [lindex $scrl 2]
1148    set dx   [$path.c cget -xscrollincrement]
1149    set xv   [$path xview]
1150    set x0   [expr {int([lindex $bbox 0]/$dx)}]
1151    set xv0  [expr {round([lindex $xv 0]*$xmax/$dx)}]
1152    set xv1  [expr {round([lindex $xv 1]*$xmax/$dx)}]
1153    if { $x0 >= $xv1 || $x0 < $xv0 } {
1154	$path.c xview scroll [expr {$x0-$xv0}] units
1155    }
1156}
1157
1158
1159# ----------------------------------------------------------------------------
1160#  Command Tree::_recexpand
1161# ----------------------------------------------------------------------------
1162# JDC : added option recursive
1163proc Tree::_recexpand { path node expand recursive cmd } {
1164    variable $path
1165    upvar 0  $path data
1166
1167    if { [Widget::getoption $path.$node -open] != $expand } {
1168        Widget::setoption $path.$node -open $expand
1169        if {[llength $cmd]} {
1170            uplevel \#0 $cmd [list $node]
1171        }
1172    }
1173
1174    if { $recursive } {
1175	foreach subnode [lrange $data($node) 1 end] {
1176	    _recexpand $path $subnode $expand $recursive $cmd
1177	}
1178    }
1179}
1180
1181
1182# ----------------------------------------------------------------------------
1183#  Command Tree::_subdelete
1184# ----------------------------------------------------------------------------
1185proc Tree::_subdelete { path lnodes } {
1186    variable $path
1187    upvar 0  $path data
1188
1189    set sel $data(selnodes)
1190    set selchanged 0
1191
1192    while { [llength $lnodes] } {
1193        set lsubnodes [list]
1194        foreach node $lnodes {
1195            foreach subnode [lrange $data($node) 1 end] {
1196                lappend lsubnodes $subnode
1197            }
1198            unset data($node)
1199	    set idx [lsearch -exact $sel $node]
1200	    if { $idx >= 0 } {
1201		set sel [lreplace $sel $idx $idx]
1202		incr selchanged
1203	    }
1204            if { [set win [Widget::getoption $path.$node -window]] != "" } {
1205                destroy $win
1206            }
1207            Widget::destroy $path.$node
1208        }
1209        set lnodes $lsubnodes
1210    }
1211
1212    set data(selnodes) $sel
1213    # return number of sel items changes
1214    return $selchanged
1215}
1216
1217
1218# ----------------------------------------------------------------------------
1219#  Command Tree::_update_scrollregion
1220# ----------------------------------------------------------------------------
1221proc Tree::_update_scrollregion { path } {
1222    set bd   [expr {2*([$path.c cget -borderwidth]+[$path.c cget -highlightthickness])}]
1223    set w    [expr {[winfo width  $path] - $bd}]
1224    set h    [expr {[winfo height $path] - $bd}]
1225    set xinc [$path.c cget -xscrollincrement]
1226    set yinc [$path.c cget -yscrollincrement]
1227    set bbox [$path.c bbox node]
1228    if { [llength $bbox] } {
1229        set xs [lindex $bbox 2]
1230        set ys [lindex $bbox 3]
1231
1232        if { $w < $xs } {
1233            set w [expr {int($xs)}]
1234            if { [set r [expr {$w % $xinc}]] } {
1235                set w [expr {$w+$xinc-$r}]
1236            }
1237        }
1238        if { $h < $ys } {
1239            set h [expr {int($ys)}]
1240            if { [set r [expr {$h % $yinc}]] } {
1241                set h [expr {$h+$yinc-$r}]
1242            }
1243        }
1244    }
1245
1246    $path.c configure -scrollregion [list 0 0 $w $h]
1247
1248    if {[Widget::getoption $path -selectfill]} {
1249        _redraw_selection $path
1250    }
1251}
1252
1253
1254# ----------------------------------------------------------------------------
1255#  Command Tree::_cross_event
1256# ----------------------------------------------------------------------------
1257proc Tree::_cross_event { path } {
1258    variable $path
1259    upvar 0  $path data
1260
1261    set node [Tree::_get_node_name $path current 1]
1262    if { [Widget::getoption $path.$node -open] } {
1263        Tree::itemconfigure $path $node -open 0
1264        if {[llength [set cmd [Widget::getoption $path -closecmd]]]} {
1265            uplevel \#0 $cmd [list $node]
1266        }
1267    } else {
1268        Tree::itemconfigure $path $node -open 1
1269        if {[llength [set cmd [Widget::getoption $path -opencmd]]]} {
1270            uplevel \#0 $cmd [list $node]
1271        }
1272    }
1273}
1274
1275
1276proc Tree::_draw_cross { path node open x y } {
1277    set idc [$path.c find withtag c:$node]
1278
1279    if { $open } {
1280        set img [Widget::cget $path -crossopenimage]
1281        set bmp [Widget::cget $path -crossopenbitmap]
1282    } else {
1283        set img [Widget::cget $path -crosscloseimage]
1284        set bmp [Widget::cget $path -crossclosebitmap]
1285    }
1286
1287    ## If we already have a cross for this node, we just adjust the image.
1288    if {$idc != ""} {
1289        if {$img == ""} {
1290            $path.c itemconfigure $idc -bitmap $bmp
1291        } else {
1292            $path.c itemconfigure $idc -image $img
1293        }
1294        return
1295    }
1296
1297    ## Create a new image for the cross.  If the user has specified an
1298    ## image, it overrides a bitmap.
1299    if {$img == ""} {
1300        $path.c create bitmap $x $y \
1301            -bitmap     $bmp \
1302            -background [$path.c cget -background] \
1303            -foreground [Widget::getoption $path -crossfill] \
1304            -tags       [list cross c:$node] -anchor c
1305    } else {
1306        $path.c create image $x $y \
1307            -image      $img \
1308            -tags       [list cross c:$node] -anchor c
1309    }
1310}
1311
1312
1313# ----------------------------------------------------------------------------
1314#  Command Tree::_draw_node
1315# ----------------------------------------------------------------------------
1316proc Tree::_draw_node { path node x0 y0 deltax deltay padx showlines } {
1317    variable $path
1318    upvar 0  $path data
1319
1320    set x1 [expr {$x0+$deltax+5}]
1321    set y1 $y0
1322    if { $showlines } {
1323        $path.c create line $x0 $y0 $x1 $y0 \
1324            -fill    [Widget::getoption $path -linesfill]   \
1325            -stipple [Widget::getoption $path -linestipple] \
1326            -tags    line
1327    }
1328    $path.c create text [expr {$x1+$padx}] $y0 \
1329        -text   [Widget::getoption $path.$node -text] \
1330        -fill   [Widget::getoption $path.$node -fill] \
1331        -font   [Widget::getoption $path.$node -font] \
1332        -anchor w \
1333    	-tags   [Tree::_get_node_tags $path $node [list node n:$node]]
1334    set len [expr {[llength $data($node)] > 1}]
1335    set dc  [Widget::getoption $path.$node -drawcross]
1336    set exp [Widget::getoption $path.$node -open]
1337
1338    if { $len && $exp } {
1339        set y1 [_draw_subnodes $path [lrange $data($node) 1 end] \
1340                    [expr {$x0+$deltax}] $y0 $deltax $deltay $padx $showlines]
1341    }
1342
1343    if {![string equal $dc "never"]
1344	&& ($len || [string equal $dc "always"] || [string equal $dc "allways"])} {
1345        _draw_cross $path $node $exp $x0 $y0
1346    }
1347
1348    if { [set win [Widget::getoption $path.$node -window]] != "" } {
1349	set a [Widget::cget $path.$node -anchor]
1350        $path.c create window $x1 $y0 -window $win -anchor $a \
1351		-tags [Tree::_get_node_tags $path $node [list win i:$node]]
1352    } elseif { [set img [Widget::getoption $path.$node -image]] != "" } {
1353	set a [Widget::cget $path.$node -anchor]
1354        $path.c create image $x1 $y0 -image $img -anchor $a \
1355		-tags   [Tree::_get_node_tags $path $node [list img i:$node]]
1356    }
1357    set box [$path.c bbox n:$node i:$node]
1358    set id [$path.c create rect 0 [lindex $box 1] \
1359		[winfo screenwidth $path] [lindex $box 3] \
1360		-tags [Tree::_get_node_tags $path $node [list box b:$node]] \
1361		-fill {} -outline {}]
1362    $path.c lower $id
1363
1364    _set_help $path $node
1365
1366    return $y1
1367}
1368
1369
1370# ----------------------------------------------------------------------------
1371#  Command Tree::_draw_subnodes
1372# ----------------------------------------------------------------------------
1373proc Tree::_draw_subnodes { path nodes x0 y0 deltax deltay padx showlines } {
1374    set y1 $y0
1375    foreach node $nodes {
1376	set padx   [_get_node_padx $path $node]
1377	set deltax [_get_node_deltax $path $node]
1378        set yp $y1
1379        set y1 [_draw_node $path $node $x0 [expr {$y1+$deltay}] $deltax $deltay $padx $showlines]
1380    }
1381    # Only draw a line to the invisible root node above the tree widget when
1382    # there are multiple top nodes.
1383    set len [llength $nodes]
1384    if { $showlines && $len && !($y0 < 0 && $len < 2) } {
1385        set id [$path.c create line $x0 $y0 $x0 [expr {$yp+$deltay}] \
1386                    -fill    [Widget::getoption $path -linesfill]   \
1387                    -stipple [Widget::getoption $path -linestipple] \
1388                    -tags    line]
1389
1390        $path.c lower $id
1391    }
1392    return $y1
1393}
1394
1395
1396# ----------------------------------------------------------------------------
1397#  Command Tree::_update_nodes
1398# ----------------------------------------------------------------------------
1399proc Tree::_update_nodes { path } {
1400    variable $path
1401    upvar 0  $path data
1402
1403    foreach {node flag} $data(upd,nodes) {
1404	set idn [$path.c find withtag "n:$node"]
1405	if { $idn == "" } {
1406	    continue
1407	}
1408	set padx   [_get_node_padx $path $node]
1409	set deltax [_get_node_deltax $path $node]
1410	set c  [$path.c coords $idn]
1411	set x1 [expr {[lindex $c 0]-$padx}]
1412	set x0 [expr {$x1-$deltax-5}]
1413	set y0 [lindex $c 1]
1414	if { $flag & 48 } {
1415	    # -window or -image modified
1416	    set win  [Widget::getoption $path.$node -window]
1417	    set img  [Widget::getoption $path.$node -image]
1418	    set anc  [Widget::cget $path.$node -anchor]
1419	    set idi  [$path.c find withtag i:$node]
1420	    set type [lindex [$path.c gettags $idi] 1]
1421	    if { [string length $win] } {
1422		if { [string equal $type "win"] } {
1423		    $path.c itemconfigure $idi -window $win
1424		} else {
1425		    $path.c delete $idi
1426		    $path.c create window $x1 $y0 -window $win -anchor $anc \
1427			-tags [_get_node_tags $path $node [list win i:$node]]
1428		}
1429	    } elseif { [string length $img] } {
1430		if { [string equal $type "img"] } {
1431		    $path.c itemconfigure $idi -image $img
1432		} else {
1433		    $path.c delete $idi
1434		    $path.c create image $x1 $y0 -image $img -anchor $anc \
1435			-tags [_get_node_tags $path $node [list img i:$node]]
1436		}
1437	    } else {
1438		$path.c delete $idi
1439	    }
1440	}
1441
1442	if { $flag & 8 } {
1443	    # -drawcross modified
1444	    set len [expr {[llength $data($node)] > 1}]
1445	    set dc  [Widget::getoption $path.$node -drawcross]
1446	    set exp [Widget::getoption $path.$node -open]
1447
1448	    if {![string equal $dc "never"]
1449		&& ($len || [string equal $dc "always"] || [string equal $dc "allways"])} {
1450		_draw_cross $path $node $exp $x0 $y0
1451	    } else {
1452		set idc [$path.c find withtag c:$node]
1453		$path.c delete $idc
1454	    }
1455	}
1456
1457	if { $flag & 7 } {
1458	    # -font, -text or -fill modified
1459	    $path.c itemconfigure $idn \
1460		-text [Widget::getoption $path.$node -text] \
1461		-fill [Widget::getoption $path.$node -fill] \
1462		-font [Widget::getoption $path.$node -font]
1463	}
1464    }
1465}
1466
1467
1468# ----------------------------------------------------------------------------
1469#  Command Tree::_draw_tree
1470# ----------------------------------------------------------------------------
1471proc Tree::_draw_tree { path } {
1472    variable $path
1473    upvar 0  $path data
1474
1475    $path.c delete all
1476    set cursor [$path.c cget -cursor]
1477    $path.c configure -cursor watch
1478    _draw_subnodes $path [lrange $data(root) 1 end] 8 \
1479        [expr {-[Widget::getoption $path -deltay]/2}] \
1480        [Widget::getoption $path -deltax] \
1481        [Widget::getoption $path -deltay] \
1482        [Widget::getoption $path -padx]   \
1483        [Widget::getoption $path -showlines]
1484    $path.c configure -cursor $cursor
1485}
1486
1487
1488# ----------------------------------------------------------------------------
1489#  Command Tree::_redraw_tree
1490# ----------------------------------------------------------------------------
1491proc Tree::_redraw_tree { path } {
1492    variable $path
1493    upvar 0  $path data
1494
1495    if { [Widget::getoption $path -redraw] } {
1496        if { $data(upd,level) == 2 } {
1497            _update_nodes $path
1498        } elseif { $data(upd,level) == 3 } {
1499            _draw_tree $path
1500        }
1501        _redraw_selection $path
1502        _update_scrollregion $path
1503        set data(upd,nodes)   {}
1504        set data(upd,level)   0
1505        set data(upd,afterid) ""
1506    }
1507}
1508
1509
1510# ----------------------------------------------------------------------------
1511#  Command Tree::_redraw_selection
1512# ----------------------------------------------------------------------------
1513proc Tree::_redraw_selection { path } {
1514    variable $path
1515    upvar 0  $path data
1516
1517    set selbg [Widget::getoption $path -selectbackground]
1518    set selfg [Widget::getoption $path -selectforeground]
1519    set fill  [Widget::getoption $path -selectfill]
1520    if {$fill} {
1521        set scroll [$path.c cget -scrollregion]
1522        if {[llength $scroll]} {
1523            set xmax [expr {[lindex $scroll 2]-1}]
1524        } else {
1525            set xmax [winfo width $path]
1526        }
1527    }
1528    foreach id [$path.c find withtag sel] {
1529        set node [Tree::_get_node_name $path $id 1]
1530        $path.c itemconfigure "n:$node" -fill [Widget::getoption $path.$node -fill]
1531    }
1532    $path.c delete sel
1533    foreach node $data(selnodes) {
1534        set bbox [$path.c bbox "n:$node"]
1535        if { [llength $bbox] } {
1536            if {$fill} {
1537		# get the image to (if any), as it may have different height
1538		set bbox [$path.c bbox "n:$node" "i:$node"]
1539                set bbox [list 0 [lindex $bbox 1] $xmax [lindex $bbox 3]]
1540            }
1541            set id [$path.c create rectangle $bbox -tags [list sel s:$node] \
1542			-fill $selbg -outline $selbg]
1543	    if {$selfg != ""} {
1544		# Don't allow an empty fill - that would be transparent
1545		$path.c itemconfigure "n:$node" -fill $selfg
1546	    }
1547            $path.c lower $id
1548        }
1549    }
1550}
1551
1552
1553# ----------------------------------------------------------------------------
1554#  Command Tree::_redraw_idle
1555# ----------------------------------------------------------------------------
1556proc Tree::_redraw_idle { path level } {
1557    variable $path
1558    upvar 0  $path data
1559
1560    if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } {
1561        set data(upd,afterid) [after idle [list Tree::_redraw_tree $path]]
1562    }
1563    if { $level > $data(upd,level) } {
1564        set data(upd,level) $level
1565    }
1566    return ""
1567}
1568
1569
1570# ----------------------------------------------------------------------------
1571#  Command Tree::_init_drag_cmd
1572# ----------------------------------------------------------------------------
1573proc Tree::_init_drag_cmd { path X Y top } {
1574    set path [winfo parent $path]
1575    set ltags [$path.c gettags current]
1576    set item  [lindex $ltags 1]
1577    if { [string equal $item "node"] ||
1578         [string equal $item "img"]  ||
1579         [string equal $item "win"] } {
1580        set node [Tree::_get_node_name $path current 2]
1581        if {[llength [set cmd [Widget::getoption $path -draginitcmd]]]} {
1582            return [uplevel \#0 $cmd [list $path $node $top]]
1583        }
1584        if { [set type [Widget::getoption $path -dragtype]] == "" } {
1585            set type "TREE_NODE"
1586        }
1587        if { [set img [Widget::getoption $path.$node -image]] != "" } {
1588            pack [label $top.l -image $img -padx 0 -pady 0]
1589        }
1590        return [list $type {copy move link} $node]
1591    }
1592    return {}
1593}
1594
1595
1596# ----------------------------------------------------------------------------
1597#  Command Tree::_drop_cmd
1598# ----------------------------------------------------------------------------
1599proc Tree::_drop_cmd { path source X Y op type dnddata } {
1600    set path [winfo parent $path]
1601    variable $path
1602    upvar 0  $path data
1603
1604    $path.c delete drop
1605    if { [string length $data(dnd,afterid)] } {
1606        after cancel $data(dnd,afterid)
1607        set data(dnd,afterid) ""
1608    }
1609    set data(dnd,scroll) ""
1610    if {[llength [set cmd [Widget::getoption $path -dropcmd]]]} {
1611	return [uplevel \#0 $cmd \
1612		    [list $path $source $data(dnd,node) $op $type $dnddata]]
1613    }
1614    return 0
1615}
1616
1617
1618# ----------------------------------------------------------------------------
1619#  Command Tree::_over_cmd
1620# ----------------------------------------------------------------------------
1621proc Tree::_over_cmd { path source event X Y op type dnddata } {
1622    set path [winfo parent $path]
1623    variable $path
1624    upvar 0  $path data
1625
1626    if { [string equal $event "leave"] } {
1627        # we leave the window tree
1628        $path.c delete drop
1629        if { [string length $data(dnd,afterid)] } {
1630            after cancel $data(dnd,afterid)
1631            set data(dnd,afterid) ""
1632        }
1633        set data(dnd,scroll) ""
1634        return 0
1635    }
1636
1637    if { [string equal $event "enter"] } {
1638        # we enter the window tree - dnd data initialization
1639        set mode [Widget::getoption $path -dropovermode]
1640        set data(dnd,mode) 0
1641        foreach c {w p n} {
1642            set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}]
1643        }
1644        set bbox [$path.c bbox all]
1645        if { [llength $bbox] } {
1646            set data(dnd,xs) [lindex $bbox 2]
1647            set data(dnd,empty) 0
1648        } else {
1649            set data(dnd,xs) 0
1650            set data(dnd,empty) 1
1651        }
1652        set data(dnd,node) {}
1653    }
1654
1655    set x [expr {$X-[winfo rootx $path]}]
1656    set y [expr {$Y-[winfo rooty $path]}]
1657    $path.c delete drop
1658    set data(dnd,node) {}
1659
1660    # test for auto-scroll unless mode is widget only
1661    if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } {
1662        return 2
1663    }
1664
1665    if { $data(dnd,mode) & 4 } {
1666        # dropovermode includes widget
1667        set target [list widget]
1668        set vmode  4
1669    } else {
1670        set target [list ""]
1671        set vmode  0
1672    }
1673    if { ($data(dnd,mode) & 2) && $data(dnd,empty) } {
1674        # dropovermode includes position and tree is empty
1675        lappend target [list root 0]
1676        set vmode  [expr {$vmode | 2}]
1677    }
1678
1679    set xc [$path.c canvasx $x]
1680    set xs $data(dnd,xs)
1681    if { $xc <= $xs } {
1682        set yc   [$path.c canvasy $y]
1683        set dy   [$path.c cget -yscrollincrement]
1684        set line [expr {int($yc/$dy)}]
1685        set xi   0
1686        set yi   [expr {$line*$dy}]
1687        set ys   [expr {$yi+$dy}]
1688        set found 0
1689        foreach id [$path.c find overlapping $xi $yi $xs $ys] {
1690            set ltags [$path.c gettags $id]
1691            set item  [lindex $ltags 1]
1692            if { [string equal $item "node"] ||
1693                 [string equal $item "img"]  ||
1694                 [string equal $item "win"] } {
1695                # item is the label or image/window of the node
1696                set node [Tree::_get_node_name $path $id 2]
1697		set found 1
1698		break
1699	    }
1700	}
1701	if {$found} {
1702	    set padx   [_get_node_padx $path $node]
1703	    set deltax [_get_node_deltax $path $node]
1704            set xi [expr {[lindex [$path.c coords n:$node] 0] - $padx - 1}]
1705                if { $data(dnd,mode) & 1 } {
1706                    # dropovermode includes node
1707                    lappend target $node
1708                    set vmode [expr {$vmode | 1}]
1709                } else {
1710                    lappend target ""
1711                }
1712
1713                if { $data(dnd,mode) & 2 } {
1714                    # dropovermode includes position
1715                    if { $yc >= $yi+$dy/2 } {
1716                        # position is after $node
1717                        if { [Widget::getoption $path.$node -open] &&
1718                             [llength $data($node)] > 1 } {
1719                            # $node is open and have subnodes
1720                            # drop position is 0 in children of $node
1721                            set parent $node
1722                            set index  0
1723                            set xli    [expr {$xi-5}]
1724                        } else {
1725                            # $node is not open and doesn't have subnodes
1726                            # drop position is after $node in children of parent of $node
1727                            set parent [lindex $data($node) 0]
1728                            set index  [lsearch -exact $data($parent) $node]
1729                            set xli    [expr {$xi - $deltax - 5}]
1730                        }
1731                        set yl $ys
1732                    } else {
1733                        # position is before $node
1734                        # drop position is before $node in children of parent of $node
1735                        set parent [lindex $data($node) 0]
1736                        set index  [expr {[lsearch -exact $data($parent) $node] - 1}]
1737                        set xli    [expr {$xi - $deltax - 5}]
1738                        set yl     $yi
1739                    }
1740                    lappend target [list $parent $index]
1741                    set vmode  [expr {$vmode | 2}]
1742                } else {
1743                    lappend target {}
1744                }
1745
1746                if { ($vmode & 3) == 3 } {
1747                    # result have both node and position
1748                    # we compute what is the preferred method
1749                    if { $yc-$yi <= 3 || $ys-$yc <= 3 } {
1750                        lappend target "position"
1751                    } else {
1752                        lappend target "node"
1753                    }
1754                }
1755            }
1756        }
1757
1758    if {$vmode && [llength [set cmd [Widget::getoption $path -dropovercmd]]]} {
1759        # user-defined dropover command
1760        set res     [uplevel \#0 $cmd [list $path $source $target $op $type $dnddata]]
1761        set code    [lindex $res 0]
1762        set newmode 0
1763        if { $code & 1 } {
1764            # update vmode
1765            set mode [lindex $res 1]
1766            if { ($vmode & 1) && [string equal $mode "node"] } {
1767                set newmode 1
1768            } elseif { ($vmode & 2) && [string equal $mode "position"] } {
1769                set newmode 2
1770            } elseif { ($vmode & 4) && [string equal $mode "widget"] } {
1771                set newmode 4
1772            }
1773        }
1774        set vmode $newmode
1775    } else {
1776        if { ($vmode & 3) == 3 } {
1777            # result have both item and position
1778            # we choose the preferred method
1779            if { [string equal [lindex $target 3] "position"] } {
1780                set vmode [expr {$vmode & ~1}]
1781            } else {
1782                set vmode [expr {$vmode & ~2}]
1783            }
1784        }
1785
1786        if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } {
1787            # dropovermode is widget or empty - recall is not necessary
1788            set code 1
1789        } else {
1790            set code 3
1791        }
1792    }
1793
1794    if {!$data(dnd,empty)} {
1795	# draw dnd visual following vmode
1796	if { $vmode & 1 } {
1797	    set data(dnd,node) [list "node" [lindex $target 1]]
1798	    $path.c create rectangle $xi $yi $xs $ys -tags drop
1799	} elseif { $vmode & 2 } {
1800	    set data(dnd,node) [concat "position" [lindex $target 2]]
1801	    $path.c create line $xli [expr {$yl-$dy/2}] $xli $yl $xs $yl -tags drop
1802	} elseif { $vmode & 4 } {
1803	    set data(dnd,node) [list "widget"]
1804	} else {
1805	    set code [expr {$code & 2}]
1806	}
1807    }
1808
1809    if { $code & 1 } {
1810        DropSite::setcursor based_arrow_down
1811    } else {
1812        DropSite::setcursor dot
1813    }
1814    return $code
1815}
1816
1817
1818# ----------------------------------------------------------------------------
1819#  Command Tree::_auto_scroll
1820# ----------------------------------------------------------------------------
1821proc Tree::_auto_scroll { path x y } {
1822    variable $path
1823    upvar 0  $path data
1824
1825    set xmax   [winfo width  $path]
1826    set ymax   [winfo height $path]
1827    set scroll {}
1828    if { $y <= 6 } {
1829        if { [lindex [$path.c yview] 0] > 0 } {
1830            set scroll [list yview -1]
1831            DropSite::setcursor sb_up_arrow
1832        }
1833    } elseif { $y >= $ymax-6 } {
1834        if { [lindex [$path.c yview] 1] < 1 } {
1835            set scroll [list yview 1]
1836            DropSite::setcursor sb_down_arrow
1837        }
1838    } elseif { $x <= 6 } {
1839        if { [lindex [$path.c xview] 0] > 0 } {
1840            set scroll [list xview -1]
1841            DropSite::setcursor sb_left_arrow
1842        }
1843    } elseif { $x >= $xmax-6 } {
1844        if { [lindex [$path.c xview] 1] < 1 } {
1845            set scroll [list xview 1]
1846            DropSite::setcursor sb_right_arrow
1847        }
1848    }
1849
1850    if { [string length $data(dnd,afterid)] && ![string equal $data(dnd,scroll) $scroll] } {
1851        after cancel $data(dnd,afterid)
1852        set data(dnd,afterid) ""
1853    }
1854
1855    set data(dnd,scroll) $scroll
1856    if { [string length $scroll] && ![string length $data(dnd,afterid)] } {
1857        set data(dnd,afterid) [after 200 [list Tree::_scroll $path $scroll]]
1858    }
1859    return $data(dnd,afterid)
1860}
1861
1862
1863# ----------------------------------------------------------------------------
1864#  Command Tree::_scroll
1865# ----------------------------------------------------------------------------
1866proc Tree::_scroll { path scroll } {
1867    variable $path
1868    upvar 0  $path data
1869    set cmd [lindex $scroll 0]
1870    set dir [lindex $scroll 1]
1871    if { ($dir == -1 && [lindex [$path.c $cmd] 0] > 0) ||
1872         ($dir == 1  && [lindex [$path.c $cmd] 1] < 1) } {
1873        $path.c $cmd scroll $dir units
1874        set data(dnd,afterid) [after 50 [list Tree::_scroll $path $scroll]]
1875    } else {
1876        set data(dnd,afterid) ""
1877        DropSite::setcursor dot
1878    }
1879}
1880
1881# Tree::_keynav --
1882#
1883#	Handle navigational keypresses on the tree.
1884#
1885# Arguments:
1886#	which      tag indicating the direction of motion:
1887#                  up         move to the node graphically above current
1888#                  down       move to the node graphically below current
1889#                  left       close current if open, else move to parent
1890#                  right      open current if closed, else move to child
1891#                  open       open current if closed, close current if open
1892#       win        name of the tree widget
1893#
1894# Results:
1895#	None.
1896
1897proc Tree::_keynav {which win} {
1898    # check for an empty tree
1899    if {[$win nodes root] eq ""} {
1900        return
1901    }
1902
1903    # Keyboard navigation is riddled with special cases.  In order to avoid
1904    # the complex logic, we will instead make a list of all the visible,
1905    # selectable nodes, then do a simple next or previous operation.
1906
1907    # One easy way to get all of the visible nodes is to query the canvas
1908    # object for all the items with the "node" tag; since the tree is always
1909    # completely redrawn, this list will be in vertical order.
1910    set nodes {}
1911    foreach nodeItem [$win.c find withtag node] {
1912	set node [Tree::_get_node_name $win $nodeItem 2]
1913	if { [Widget::cget $win.$node -selectable] } {
1914	    lappend nodes $node
1915	}
1916    }
1917
1918    # Keyboard navigation is all relative to the current node
1919    # surles: Get the current node for single or multiple selection schemas.
1920    set node [_get_current_node $win]
1921
1922    switch -exact -- $which {
1923	"up" {
1924	    # Up goes to the node that is vertically above the current node
1925	    # (NOT necessarily the current node's parent)
1926	    if { [string equal $node ""] } {
1927		return
1928	    }
1929	    set index [lsearch -exact $nodes $node]
1930	    incr index -1
1931	    if { $index >= 0 } {
1932		$win selection set [lindex $nodes $index]
1933		_set_current_node $win [lindex $nodes $index]
1934		$win see [lindex $nodes $index]
1935		event generate $win <<TreeSelect>>
1936		return
1937	    }
1938	}
1939	"down" {
1940	    # Down goes to the node that is vertically below the current node
1941	    if { [string equal $node ""] } {
1942		$win selection set [lindex $nodes 0]
1943		_set_current_node $win [lindex $nodes 0]
1944		$win see [lindex $nodes 0]
1945		event generate $win <<TreeSelect>>
1946		return
1947	    }
1948
1949	    set index [lsearch -exact $nodes $node]
1950	    incr index
1951	    if { $index < [llength $nodes] } {
1952		$win selection set [lindex $nodes $index]
1953		_set_current_node $win [lindex $nodes $index]
1954		$win see [lindex $nodes $index]
1955		event generate $win <<TreeSelect>>
1956		return
1957	    }
1958	}
1959	"right" {
1960	    # On a right arrow, if the current node is closed, open it.
1961	    # If the current node is open, go to its first child
1962	    if { [string equal $node ""] } {
1963		return
1964	    }
1965	    set open [$win itemcget $node -open]
1966            if { $open } {
1967                if { [llength [$win nodes $node]] } {
1968		    set index [lsearch -exact $nodes $node]
1969		    incr index
1970		    if { $index < [llength $nodes] } {
1971			$win selection set [lindex $nodes $index]
1972			_set_current_node $win [lindex $nodes $index]
1973			$win see [lindex $nodes $index]
1974			event generate $win <<TreeSelect>>
1975			return
1976		    }
1977                }
1978            } else {
1979                $win itemconfigure $node -open 1
1980                if {[llength [set cmd [Widget::getoption $win -opencmd]]]} {
1981                    uplevel \#0 $cmd [list $node]
1982                }
1983                return
1984            }
1985	}
1986	"left" {
1987	    # On a left arrow, if the current node is open, close it.
1988	    # If the current node is closed, go to its parent.
1989	    if { [string equal $node ""] } {
1990		return
1991	    }
1992	    set open [$win itemcget $node -open]
1993	    if { $open } {
1994		$win itemconfigure $node -open 0
1995                if {[llength [set cmd [Widget::getoption $win -closecmd]]]} {
1996                    uplevel \#0 $cmd [list $node]
1997                }
1998		return
1999	    } else {
2000		set parent [$win parent $node]
2001	        if { [string equal $parent "root"] } {
2002		    set parent $node
2003                } else {
2004                    while { ![$win itemcget $parent -selectable] } {
2005		        set parent [$win parent $parent]
2006		        if { [string equal $parent "root"] } {
2007			    set parent $node
2008			    break
2009		        }
2010                    }
2011		}
2012		$win selection set $parent
2013		_set_current_node $win $parent
2014		$win see $parent
2015		event generate $win <<TreeSelect>>
2016		return
2017	    }
2018	}
2019	"space" {
2020	    if { [string equal $node ""] } {
2021		return
2022	    }
2023	    set open [$win itemcget $node -open]
2024	    if { [llength [$win nodes $node]] } {
2025
2026		# Toggle the open status of the chosen node.
2027
2028		$win itemconfigure $node -open [expr {$open?0:1}]
2029
2030		if {$open} {
2031		    # Node was open, is now closed. Call the close-cmd
2032
2033		    if {[llength [set cmd [Widget::getoption $win -closecmd]]]} {
2034			uplevel \#0 $cmd [list $node]
2035		    }
2036		} else {
2037		    # Node was closed, is now open. Call the open-cmd
2038
2039		    if {[llength [set cmd [Widget::getoption $win -opencmd]]]} {
2040			uplevel \#0 $cmd [list $node]
2041		    }
2042                }
2043	    }
2044	}
2045    }
2046    return
2047}
2048
2049# Tree::_get_current_node --
2050#
2051#	Get the current node for either single or multiple
2052#	node selection trees.  If the tree allows for
2053#	multiple selection, return the cursor node.  Otherwise,
2054#	if there is a selection, return the first node in the
2055#	list.  If there is no selection, return the root node.
2056#
2057# arguments:
2058#       win        name of the tree widget
2059#
2060# Results:
2061#	The current node.
2062
2063proc Tree::_get_current_node {win} {
2064    if {[info exists selectTree::selectCursor($win)]} {
2065	set result $selectTree::selectCursor($win)
2066    } elseif {[llength [set selList [$win selection get]]]} {
2067	set result [lindex $selList 0]
2068    } else {
2069	set result ""
2070    }
2071    return $result
2072}
2073
2074# Tree::_set_current_node --
2075#
2076#	Set the current node for either single or multiple
2077#	node selection trees.
2078#
2079# arguments:
2080#       win        Name of the tree widget
2081#	node	   The current node.
2082#
2083# Results:
2084#	None.
2085
2086proc Tree::_set_current_node {win node} {
2087    if {[info exists selectTree::selectCursor($win)]} {
2088	set selectTree::selectCursor($win) $node
2089    }
2090    return
2091}
2092
2093# Tree::_get_node_name --
2094#
2095#	Given a canvas item, get the name of the tree node represented by that
2096#	item.
2097#
2098# Arguments:
2099#	path		tree to query
2100#	item		Optional canvas item to examine; if omitted,
2101#			defaults to "current"
2102#	tagindex	Optional tag index, since the n:nodename tag is not
2103#			in the same spot for all canvas items.  If omitted,
2104#			defaults to "end-1", so it works with "current" item.
2105#
2106# Results:
2107#	node	name of the tree node.
2108
2109proc Tree::_get_node_name {path {item current} {tagindex end-1} {truename 0}} {
2110    set node [string range [lindex [$path.c gettags $item] $tagindex] 2 end]
2111    if {$truename} {
2112	return [_node_name_rev $path $node]
2113    }
2114    return $node
2115}
2116
2117# Tree::_get_node_padx --
2118#
2119#	Given a node in the tree, return it's padx value.  If the value is
2120#	less than 0, default to the padx of the entire tree.
2121#
2122# Arguments:
2123#	path		Tree to query
2124#	node		Node in the tree
2125#
2126# Results:
2127#	padx		The numeric padx value
2128proc Tree::_get_node_padx {path node} {
2129    set padx [Widget::getoption $path.$node -padx]
2130    if {$padx < 0} { set padx [Widget::getoption $path -padx] }
2131    return $padx
2132}
2133
2134# Tree::_get_node_deltax --
2135#
2136#	Given a node in the tree, return it's deltax value.  If the value is
2137#	less than 0, default to the deltax of the entire tree.
2138#
2139# Arguments:
2140#	path		Tree to query
2141#	node		Node in the tree
2142#
2143# Results:
2144#	deltax		The numeric deltax value
2145proc Tree::_get_node_deltax {path node} {
2146    set deltax [Widget::getoption $path.$node -deltax]
2147    if {$deltax < 0} { set deltax [Widget::getoption $path -deltax] }
2148    return $deltax
2149}
2150
2151
2152# Tree::_get_node_tags --
2153#
2154#	Given a node in the tree, return a list of tags to apply to its
2155#       canvas item.
2156#
2157# Arguments:
2158#	path		Tree to query
2159#	node		Node in the tree
2160#	tags		A list of tags to add to the final list
2161#
2162# Results:
2163#	list		The list of tags to apply to the canvas item
2164proc Tree::_get_node_tags {path node {tags ""}} {
2165    eval [linsert $tags 0 lappend list TreeItemSentinal]
2166    if {[Widget::getoption $path.$node -helptext] == "" &&
2167        [Widget::getoption $path.$node -helpcmd]  == ""} { return $list }
2168
2169    switch -- [Widget::getoption $path.$node -helptype] {
2170	balloon {
2171	    lappend list BwHelpBalloon
2172	}
2173	variable {
2174	    lappend list BwHelpVariable
2175	}
2176    }
2177    return $list
2178}
2179
2180# Tree::_set_help --
2181#
2182#	Register dynamic help for a node in the tree.
2183#
2184# Arguments:
2185#	path		Tree to query
2186#	node		Node in the tree
2187#       force		Optional argument to force a reset of the help
2188#
2189# Results:
2190#	none
2191proc Tree::_set_help { path node } {
2192    Widget::getVariable $path help
2193
2194    set item $path.$node
2195    set opts [list -helptype -helptext -helpvar -helpcmd]
2196    foreach {cty ctx cv cc} [eval [linsert $opts 0 Widget::hasChangedX $item]] break
2197    set text [Widget::getoption $item -helptext]
2198    set cmd  [Widget::getoption $item -helpcmd]
2199
2200    ## If we've never set help for this item before, and text or cmd is not
2201    ## blank, we need to setup help. We also need to reset help if any of the
2202    ## options have changed.
2203    if { (![info exists help($node)] && ($text != "" || $cmd != ""))
2204         || $cty || $ctx || $cv } {
2205	set help($node) 1
2206	set type [Widget::getoption $item -helptype]
2207        set var [Widget::getoption $item -helpvar]
2208        DynamicHelp::add $path.c -item n:$node -type $type -text $text -variable $var -command $cmd
2209        DynamicHelp::add $path.c -item i:$node -type $type -text $text -variable $var -command $cmd
2210        DynamicHelp::add $path.c -item b:$node -type $type -text $text -variable $var -command $cmd
2211    }
2212}
2213
2214proc Tree::_mouse_select { path cmd args } {
2215    eval [linsert $args 0 selection $path $cmd]
2216    switch -- $cmd {
2217        "add" - "clear" - "remove" - "set" - "toggle" {
2218            event generate $path <<TreeSelect>>
2219        }
2220    }
2221}
2222
2223proc Tree::_node_name { path node } {
2224    # Make sure node names are safe as tags and variable names
2225    set map [list & \1 | \2 ^ \3 ! \4 :: \5]
2226    return  [string map $map $node]
2227}
2228
2229proc Tree::_node_name_rev { path node } {
2230    # Allow reverse interpretation of node names
2231    set map [list \1 & \2 | \3 ^ \4 ! \5 ::]
2232    return  [string map $map $node]
2233}
2234
2235
2236# ----------------------------------------------------------------------------
2237#  Command Tree::_destroy
2238# ----------------------------------------------------------------------------
2239proc Tree::_destroy { path } {
2240    variable $path
2241    upvar 0  $path data
2242
2243    if { $data(upd,afterid) != "" } {
2244        after cancel $data(upd,afterid)
2245    }
2246    if { $data(dnd,afterid) != "" } {
2247        after cancel $data(dnd,afterid)
2248    }
2249    _subdelete $path [lrange $data(root) 1 end]
2250    Widget::destroy $path
2251    unset data
2252}
2253
2254
2255proc Tree::_getnodes {path {node "root"}} {
2256    set nodes [$path nodes $node]
2257    foreach node $nodes {
2258        set nodes [concat $nodes [_getnodes $path $node]]
2259    }
2260    return $nodes
2261}
2262
2263
2264# ----------------------------------------------------------------------------
2265#  Command Tree::_themechanged
2266# ----------------------------------------------------------------------------
2267proc Tree::_themechanged { path } {
2268
2269    if { ![winfo exists $path] } { return }
2270    BWidget::set_themedefaults
2271
2272    $path configure \
2273           -background $BWidget::colors(SystemWindow) \
2274           -selectbackground $BWidget::colors(SystemHighlight) \
2275           -selectforeground $BWidget::colors(SystemHighlightText) \
2276           -linesfill $BWidget::colors(SystemWindowText) \
2277           -crossfill $BWidget::colors(SystemWindowText)
2278
2279    # make sure, existing items appear in the same color as well:
2280    set res [$path nodes "root"]
2281
2282    # res(ult) might be either a string or a list...
2283    if {[llength $res] == 0 && [string length $res] > 0} {
2284
2285        foreach node [_getnodes $path $res] {
2286            $path itemconfigure $node \
2287	             -fill $BWidget::colors(SystemWindowText)
2288        }
2289    } elseif { [llength $res] > 0 } {
2290
2291        foreach n $res {
2292            foreach node [_getnodes $path $n] {
2293                $path itemconfigure $node \
2294	                 -fill $BWidget::colors(SystemWindowText)
2295            }
2296	}
2297    }
2298
2299    _redraw_idle $path 3
2300}
2301