tree.tcl

tree.tcl
This file is part of Unifix BWidget Toolkit
$Id: tree.tcl,v 1.37 2002/10/14 20:54:12 hobbs Exp $
Index of commands:
- Tree::create
- Tree::configure
- Tree::cget
- Tree::insert
- Tree::itemconfigure
- Tree::itemcget
- Tree::bindText
- Tree::bindImage
- Tree::delete
- Tree::move
- Tree::reorder
- Tree::selection
- Tree::exists
- Tree::parent
- Tree::index
- Tree::nodes
- Tree::see
- Tree::opentree
- Tree::closetree
- Tree::edit
- Tree::xview
- Tree::yview
- Tree::_update_edit_size
- Tree::_destroy
- Tree::_see
- Tree::_recexpand
- Tree::_subdelete
- Tree::_update_scrollregion
- Tree::_cross_event
- Tree::_draw_node
- Tree::_draw_subnodes
- Tree::_update_nodes
- Tree::_draw_tree
- Tree::_redraw_tree
- Tree::_redraw_selection
- Tree::_redraw_idle
- Tree::_drag_cmd
- Tree::_drop_cmd
- Tree::_over_cmd
- Tree::_auto_scroll
- Tree::_scroll


Tree
Comments  
Arguments  
Used by  
Uses  
namespace eval Tree {
    namespace eval Node {
        Widget::declare Tree::Node {
            {-text       String     ""      0}
            {-font       TkResource ""      0 listbox}
            {-image      TkResource ""      0 label}
            {-window     String     ""      0}
            {-fill       TkResource black   0 {listbox -foreground}}
            {-data       String     ""      0}
            {-open       Boolean    0       0}
        {-selectable Boolean    1       0}
            {-drawcross  Enum       auto    0 {auto allways never}}
        }
    }

    Widget::tkinclude Tree canvas .c \
        remove     {
    -insertwidth -insertbackground -insertborderwidth -insertofftime
    -insertontime -selectborderwidth -closeenough -confine -scrollregion
    -xscrollincrement -yscrollincrement -width -height
    } \
        initialize {
    -relief sunken -borderwidth 2 -takefocus 1
    -highlightthickness 1 -width 200
    }

    Widget::declare Tree {
        {-deltax           Int 10 0 "%d >= 0"}
        {-deltay           Int 15 0 "%d >= 0"}
        {-padx             Int 20 0 "%d >= 0"}
        {-background       TkResource "" 0 listbox}
        {-selectbackground TkResource "" 0 listbox}
        {-selectforeground TkResource "" 0 listbox}
    {-selectcommand    String     "" 0}
        {-width            TkResource "" 0 listbox}
        {-height           TkResource "" 0 listbox}
        {-selectfill       Boolean 0  0}
        {-showlines        Boolean 1  0}
        {-linesfill        TkResource black  0 {listbox -foreground}}
        {-linestipple      TkResource ""     0 {label -bitmap}}
        {-redraw           Boolean 1  0}
        {-opencmd          String  "" 0}
        {-closecmd         String  "" 0}
        {-dropovermode     Flag    "wpn" 0 "wpn"}
        {-bg               Synonym -background}
    }
    DragSite::include Tree "TREE_NODE" 1
    DropSite::include Tree {
        TREE_NODE {copy {} move {}}
    }

    Widget::addmap Tree "" .c {-deltay -yscrollincrement}

    # Trees on windows have a white (system window) background
    if { $::tcl_platform(platform) == "windows" } {
    option add *Tree.c.background SystemWindow widgetDefault
    option add *TreeNode.fill SystemWindowText widgetDefault
    }

    bind TreeSentinalStart <Button-1> {
    if { $::Tree::sentinal(%W) } {
        set ::Tree::sentinal(%W) 0
        break
    }
    }
    
    bind TreeSentinalEnd <Button-1> {
    set ::Tree::sentinal(%W) 0
    }
    
    bind TreeFocus <Button-1> [list focus %W]

    proc ::Tree { path args } { return [eval Tree::create $path $args] }
    proc use {} {}

    variable _edit
}


Tree::__call_selectcmd
Comments  
Arguments path
Used by  
Uses Widget::getoption
proc Tree::__call_selectcmd { path } {
    variable $path
    upvar 0  $path data

    set selectcmd [Widget::getoption $path -selectcommand]
    if { ![string equal $selectcmd ""] } {
    lappend selectcmd $path
    lappend selectcmd $data(selnodes)
    uplevel \#0 $selectcmd
    }
    return
}


Tree::_auto_scroll
Comments Command Tree::_auto_scroll
Arguments path
x
y
Used by  
Uses DropSite::setcursor
Tree::_scroll
proc Tree::_auto_scroll { path x y } {
    variable $path
    upvar 0  $path data

    set xmax   [winfo width  $path]
    set ymax   [winfo height $path]
    set scroll {}
    if { $y <= 6 } {
        if { [lindex [$path.c yview] 0] > 0 } {
            set scroll [list yview -1]
            DropSite::setcursor sb_up_arrow
        }
    } elseif { $y >= $ymax-6 } {
        if { [lindex [$path.c yview] 1] < 1 } {
            set scroll [list yview 1]
            DropSite::setcursor sb_down_arrow
        }
    } elseif { $x <= 6 } {
        if { [lindex [$path.c xview] 0] > 0 } {
            set scroll [list xview -1]
            DropSite::setcursor sb_left_arrow
        }
    } elseif { $x >= $xmax-6 } {
        if { [lindex [$path.c xview] 1] < 1 } {
            set scroll [list xview 1]
            DropSite::setcursor sb_right_arrow
        }
    }

    if { [string length $data(dnd,afterid)] && [string compare $data(dnd,scroll) $scroll] } {
        after cancel $data(dnd,afterid)
        set data(dnd,afterid) ""
    }

    set data(dnd,scroll) $scroll
    if { [string length $scroll] && ![string length $data(dnd,afterid)] } {
        set data(dnd,afterid) [after 200 Tree::_scroll $path $scroll]
    }
    return $data(dnd,afterid)
}


Tree::_cross_event
Comments Command Tree::_cross_event
Arguments path
Used by Tree::create
Uses Tree::itemconfigure
Widget::getoption
Tree::_get_node_name
proc Tree::_cross_event { path } {
    variable $path
    upvar 0  $path data

    set node [Tree::_get_node_name $path current 1]
    if { [Widget::getoption $path.$node -open] } {
        Tree::itemconfigure $path $node -open 0
        if { [set cmd [Widget::getoption $path -closecmd]] != "" } {
            uplevel \#0 $cmd $node
        }
    } else {
        Tree::itemconfigure $path $node -open 1
        if { [set cmd [Widget::getoption $path -opencmd]] != "" } {
            uplevel \#0 $cmd $node
        }
    }
}


Tree::_destroy
Comments Command Tree::_destroy
Arguments path
Used by  
Uses Widget::destroy
proc Tree::_destroy { path } {
    variable $path
    upvar 0  $path data

    if { $data(upd,afterid) != "" } {
        after cancel $data(upd,afterid)
    }
    if { $data(dnd,afterid) != "" } {
        after cancel $data(dnd,afterid)
    }
    _subdelete $path [lrange $data(root) 1 end]
    Widget::destroy $path
    unset data
    rename $path {}
}


Tree::_draw_node
Comments Command Tree::_draw_node
Arguments path
node
x0
y0
deltax
deltay
padx
showlines
Used by  
Uses Widget::getoption
proc Tree::_draw_node { path node x0 y0 deltax deltay padx showlines } {
    global   env
    variable $path
    upvar 0  $path data

    set x1 [expr {$x0+$deltax+5}]
    set y1 $y0
    if { $showlines } {
        $path.c create line $x0 $y0 $x1 $y0 \
            -fill    [Widget::getoption $path -linesfill]   \
            -stipple [Widget::getoption $path -linestipple] \
            -tags    line
    }
    $path.c create text [expr {$x1+$padx}] $y0 \
        -text   [Widget::getoption $path.$node -text] \
        -fill   [Widget::getoption $path.$node -fill] \
        -font   [Widget::getoption $path.$node -font] \
        -anchor w \
        -tags   "TreeItemSentinal node n:$node"
    set len [expr {[llength $data($node)] > 1}]
    set dc  [Widget::getoption $path.$node -drawcross]
    set exp [Widget::getoption $path.$node -open]

    if { $len && $exp } {
        set y1 [_draw_subnodes $path [lrange $data($node) 1 end] \
                    [expr {$x0+$deltax}] $y0 $deltax $deltay $padx $showlines]
    }

    if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
        if { $exp } {
            set bmp [file join $::BWIDGET::LIBRARY "images" "minus.xbm"]
        } else {
            set bmp [file join $::BWIDGET::LIBRARY "images" "plus.xbm"]
        }
        $path.c create bitmap $x0 $y0 \
            -bitmap     @$bmp \
            -background [$path.c cget -background] \
            -foreground [Widget::getoption $path -linesfill] \
            -tags       "cross c:$node" -anchor c
    }

    if { [set win [Widget::getoption $path.$node -window]] != "" } {
        $path.c create window $x1 $y0 -window $win -anchor w \
        -tags "TreeItemSentinal win i:$node"
    } elseif { [set img [Widget::getoption $path.$node -image]] != "" } {
        $path.c create image $x1 $y0 -image $img -anchor w \
        -tags "TreeItemSentinal img i:$node"
    }
    return $y1
}


Tree::_draw_subnodes
Comments Command Tree::_draw_subnodes
Arguments path
nodes
x0
y0
deltax
deltay
padx
showlines
Used by  
Uses Widget::getoption
proc Tree::_draw_subnodes { path nodes x0 y0 deltax deltay padx showlines } {
    set y1 $y0
    foreach node $nodes {
        set yp $y1
        set y1 [_draw_node $path $node $x0 [expr {$y1+$deltay}] $deltax $deltay $padx $showlines]
    }
    if { $showlines && [llength $nodes] } {
        set id [$path.c create line $x0 $y0 $x0 [expr {$yp+$deltay}] \
                    -fill    [Widget::getoption $path -linesfill]   \
                    -stipple [Widget::getoption $path -linestipple] \
                    -tags    line]

        $path.c lower $id
    }
    return $y1
}


Tree::_draw_tree
Comments Command Tree::_draw_tree
Arguments path
Used by  
Uses Widget::getoption
proc Tree::_draw_tree { path } {
    variable $path
    upvar 0  $path data

    $path.c delete all
    set cursor [$path.c cget -cursor]
    $path.c configure -cursor watch
    _draw_subnodes $path [lrange $data(root) 1 end] 8 \
        [expr {-[Widget::getoption $path -deltay]/2}] \
        [Widget::getoption $path -deltax] \
        [Widget::getoption $path -deltay] \
        [Widget::getoption $path -padx]   \
        [Widget::getoption $path -showlines]
    $path.c configure -cursor $cursor
}


Tree::_drop_cmd
Comments Command Tree::_drop_cmd
Arguments path
source
X
Y
op
type
dnddata
Used by Tree::create
Tree::configure
Uses Widget::getoption
proc Tree::_drop_cmd { path source X Y op type dnddata } {
    set path [winfo parent $path]
    variable $path
    upvar 0  $path data

    $path.c delete drop
    if { [string length $data(dnd,afterid)] } {
        after cancel $data(dnd,afterid)
        set data(dnd,afterid) ""
    }
    set data(dnd,scroll) ""
    if { [llength $data(dnd,node)] } {
        if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
            return [uplevel \#0 $cmd [list $path $source $data(dnd,node) $op $type $dnddata]]
        }
    }
    return 0
}


Tree::_get_current_node
Comments Tree::_get_current_node --

Get the current node for either single or multiple
node selection trees. If the tree allows for
multiple selection, return the cursor node. Otherwise,
if there is a selection, return the first node in the
list. If there is no selection, return the root node.

arguments:
win name of the tree widget

Results:
The current node.
Arguments win
Used by  
Uses  
proc Tree::_get_current_node {win} {
    if {[info exists selectTree::selectCursor($win)]} {
    set result $selectTree::selectCursor($win)
    } elseif {[set selList [$win selection get]] != {}} {
    set result [lindex $selList 0]
    } else {
    set result ""
    }
    return $result
}


Tree::_get_node_name
Comments Tree::_get_node_name --

Given a canvas item, get the name of the tree node represented by that
item.

Arguments:
path tree to query
item Optional canvas item to examine; if omitted,
defaults to "current"
tagindex Optional tag index, since the n:nodename tag is not
in the same spot for all canvas items. If omitted,
defaults to "end-1", so it works with "current" item.

Results:
node name of the tree node.
Arguments path
item
tagindex
Used by Tree::find
Tree::_keynav
Tree::_init_drag_cmd
Tree::selection
Tree::_cross_event
Tree::_over_cmd
Tree::bindImage
Tree::_redraw_selection
Tree::bindText
Uses  
proc Tree::_get_node_name {path {item current} {tagindex end-1}} {
    return [string range [lindex [$path.c gettags $item] $tagindex] 2 end]
}


Tree::_init_drag_cmd
Comments Command Tree::_init_drag_cmd
Arguments path
X
Y
top
Used by Tree::create
Tree::configure
Uses Tree::_get_node_name
Widget::getoption
proc Tree::_init_drag_cmd { path X Y top } {
    set path [winfo parent $path]
    set ltags [$path.c gettags current]
    set item  [lindex $ltags 1]
    if { ![string compare $item "node"] ||
         ![string compare $item "img"]  ||
         ![string compare $item "win"] } {
        set node [Tree::_get_node_name $path current 2]
        if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
            return [uplevel \#0 $cmd [list $path $node $top]]
        }
        if { [set type [Widget::getoption $path -dragtype]] == "" } {
            set type "TREE_NODE"
        }
        if { [set img [Widget::getoption $path.$node -image]] != "" } {
            pack [label $top.l -image $img -padx 0 -pady 0]
        }
        return [list $type {copy move link} $node]
    }
    return {}
}


Tree::_keynav
Comments Tree::_keynav --

Handle navigational keypresses on the tree.

Arguments:
which tag indicating the direction of motion:
up move to the node graphically above current
down move to the node graphically below current
left close current if open, else move to parent
right open current if closed, else move to child
open open current if closed, close current if open
win name of the tree widget

Results:
None.
Arguments which
win
Used by  
Uses Widget::getoption
Tree::_get_node_name
Widget::cget
proc Tree::_keynav {which win} {
    # Keyboard navigation is riddled with special cases.  In order to avoid
    # the complex logic, we will instead make a list of all the visible,
    # selectable nodes, then do a simple next or previous operation.

    # One easy way to get all of the visible nodes is to query the canvas
    # object for all the items with the "node" tag; since the tree is always
    # completely redrawn, this list will be in vertical order.
    set nodes {}
    foreach nodeItem [$win.c find withtag node] {
    set node [Tree::_get_node_name $win $nodeItem 2]
    if { [Widget::cget $win.$node -selectable] } {
        lappend nodes $node
    }
    }
    
    # Keyboard navigation is all relative to the current node
    # surles: Get the current node for single or multiple selection schemas.
    set node [_get_current_node $win]

    switch -exact -- $which {
    "up" {
        # Up goes to the node that is vertically above the current node
        # (NOT necessarily the current node's parent)
        if { [string equal $node ""] } {
        return
        }
        set index [lsearch $nodes $node]
        incr index -1
        if { $index >= 0 } {
        $win selection set [lindex $nodes $index]
        _set_current_node $win [lindex $nodes $index]
        $win see [lindex $nodes $index]
        return
        }
    }
    "down" {
        # Down goes to the node that is vertically below the current node
        if { [string equal $node ""] } {
        $win selection set [lindex $nodes 0]
        _set_current_node $win [lindex $nodes 0]
        $win see [lindex $nodes 0]
        return
        }

        set index [lsearch $nodes $node]
        incr index
        if { $index < [llength $nodes] } {
        $win selection set [lindex $nodes $index]
        _set_current_node $win [lindex $nodes $index]
        $win see [lindex $nodes $index]
        return
        }
    }
    "right" {
        # On a right arrow, if the current node is closed, open it.
        # If the current node is open, go to its first child
        if { [string equal $node ""] } {
        return
        }
        set open [$win itemcget $node -open]
            if { $open } {
                if { [llength [$win nodes $node]] } {
            set index [lsearch $nodes $node]
            incr index
            if { $index < [llength $nodes] } {
            $win selection set [lindex $nodes $index]
            _set_current_node $win [lindex $nodes $index]
            $win see [lindex $nodes $index]
            return
            }
                }
            } else {
                $win itemconfigure $node -open 1
                if { [set cmd [Widget::getoption $win -opencmd]] != "" } {
                    uplevel \#0 $cmd $node
                }
                return
            }
    }
    "left" {
        # On a left arrow, if the current node is open, close it.
        # If the current node is closed, go to its parent.
        if { [string equal $node ""] } {
        return
        }
        set open [$win itemcget $node -open]
        if { $open } {
        $win itemconfigure $node -open 0
                if { [set cmd [Widget::getoption $win -closecmd]] != "" } {
                    uplevel \#0 $cmd $node
                }
        return
        } else {
        set parent [$win parent $node]
            if { [string equal $parent "root"] } {
            set parent $node
                } else {
                    while { ![$win itemcget $parent -selectable] } {
                set parent [$win parent $parent]
                if { [string equal $parent "root"] } {
                set parent $node
                break
                }
                    }
        }
        $win selection set $parent
        _set_current_node $win $parent
        $win see $parent
        return
        }
    }
    "space" {
        if { [string equal $node ""] } {
        return
        }
        set open [$win itemcget $node -open]
        if { [llength [$win nodes $node]] } {

        # Toggle the open status of the chosen node.

        $win itemconfigure $node -open [expr {$open?0:1}]

        if {$open} {
            # Node was open, is now closed. Call the close-cmd

            if { [set cmd [Widget::getoption $win -closecmd]] != "" } {
            uplevel \#0 $cmd $node
            }
        } else {
            # Node was closed, is now open. Call the open-cmd

            if { [set cmd [Widget::getoption $win -opencmd]] != "" } {
            uplevel \#0 $cmd $node
            }
                }
        }
    }
    }
    return
}


Tree::_over_cmd
Comments Command Tree::_over_cmd
Arguments path
source
event
X
Y
op
type
dnddata
Used by Tree::create
Tree::configure
Uses DropSite::setcursor
Widget::getoption
Tree::_get_node_name
proc Tree::_over_cmd { path source event X Y op type dnddata } {
    set path [winfo parent $path]
    variable $path
    upvar 0  $path data

    if { ![string compare $event "leave"] } {
        # we leave the window tree
        $path.c delete drop
        if { [string length $data(dnd,afterid)] } {
            after cancel $data(dnd,afterid)
            set data(dnd,afterid) ""
        }
        set data(dnd,scroll) ""
        return 0
    }

    if { ![string compare $event "enter"] } {
        # we enter the window tree - dnd data initialization
        set mode [Widget::getoption $path -dropovermode]
        set data(dnd,mode) 0
        foreach c {w p n} {
            set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}]
        }
        set bbox [$path.c bbox all]
        if { [llength $bbox] } {
            set data(dnd,xs) [lindex $bbox 2]
            set data(dnd,empty) 0
        } else {
            set data(dnd,xs) 0
            set data(dnd,empty) 1
        }
        set data(dnd,node) {}
    }

    set x [expr {$X-[winfo rootx $path]}]
    set y [expr {$Y-[winfo rooty $path]}]
    $path.c delete drop
    set data(dnd,node) {}

    # test for auto-scroll unless mode is widget only
    if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } {
        return 2
    }

    if { $data(dnd,mode) & 4 } {
        # dropovermode includes widget
        set target [list widget]
        set vmode  4
    } else {
        set target [list ""]
        set vmode  0
    }
    if { ($data(dnd,mode) & 2) && $data(dnd,empty) } {
        # dropovermode includes position and tree is empty
        lappend target [list root 0]
        set vmode  [expr {$vmode | 2}]
    }

    set xc [$path.c canvasx $x]
    set xs $data(dnd,xs)
    if { $xc <= $xs } {
        set yc   [$path.c canvasy $y]
        set dy   [$path.c cget -yscrollincrement]
        set line [expr {int($yc/$dy)}]
        set xi   0
        set yi   [expr {$line*$dy}]
        set ys   [expr {$yi+$dy}]
        set found 0
        foreach id [$path.c find overlapping $xi $yi $xs $ys] {
            set ltags [$path.c gettags $id]
            set item  [lindex $ltags 1]
            if { ![string compare $item "node"] ||
                 ![string compare $item "img"]  ||
                 ![string compare $item "win"] } {
                # item is the label or image/window of the node
                set node [Tree::_get_node_name $path $id 2]
        set found 1
        break
        }
    }
    if {$found} {
            set xi [expr {[lindex [$path.c coords n:$node] 0]-[Widget::getoption $path -padx]-1}]
                if { $data(dnd,mode) & 1 } {
                    # dropovermode includes node
                    lappend target $node
                    set vmode [expr {$vmode | 1}]
                } else {
                    lappend target ""
                }

                if { $data(dnd,mode) & 2 } {
                    # dropovermode includes position
                    if { $yc >= $yi+$dy/2 } {
                        # position is after $node
                        if { [Widget::getoption $path.$node -open] &&
                             [llength $data($node)] > 1 } {
                            # $node is open and have subnodes
                            # drop position is 0 in children of $node
                            set parent $node
                            set index  0
                            set xli    [expr {$xi-5}]
                        } else {
                            # $node is not open and doesn't have subnodes
                            # drop position is after $node in children of parent of $node
                            set parent [lindex $data($node) 0]
                            set index  [lsearch $data($parent) $node]
                            set xli    [expr {$xi-[Widget::getoption $path -deltax]-5}]
                        }
                        set yl $ys
                    } else {
                        # position is before $node
                        # drop position is before $node in children of parent of $node
                        set parent [lindex $data($node) 0]
                        set index  [expr {[lsearch $data($parent) $node] - 1}]
                        set xli    [expr {$xi-[Widget::getoption $path -deltax]-5}]
                        set yl     $yi
                    }
                    lappend target [list $parent $index]
                    set vmode  [expr {$vmode | 2}]
                } else {
                    lappend target {}
                }

                if { ($vmode & 3) == 3 } {
                    # result have both node and position
                    # we compute what is the preferred method
                    if { $yc-$yi <= 3 || $ys-$yc <= 3 } {
                        lappend target "position"
                    } else {
                        lappend target "node"
                    }
                }
            }
        }

    if { $vmode && [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
        # user-defined dropover command
        set res     [uplevel \#0 $cmd [list $path $source $target $op $type $dnddata]]
        set code    [lindex $res 0]
        set newmode 0
        if { $code & 1 } {
            # update vmode
            set mode [lindex $res 1]
            if { ($vmode & 1) && ![string compare $mode "node"] } {
                set newmode 1
            } elseif { ($vmode & 2) && ![string compare $mode "position"] } {
                set newmode 2
            } elseif { ($vmode & 4) && ![string compare $mode "widget"] } {
                set newmode 4
            }
        }
        set vmode $newmode
    } else {
        if { ($vmode & 3) == 3 } {
            # result have both item and position
            # we choose the preferred method
            if { ![string compare [lindex $target 3] "position"] } {
                set vmode [expr {$vmode & ~1}]
            } else {
                set vmode [expr {$vmode & ~2}]
            }
        }

        if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } {
            # dropovermode is widget or empty - recall is not necessary
            set code 1
        } else {
            set code 3
        }
    }

    if {!$data(dnd,empty)} {
    # draw dnd visual following vmode
    if { $vmode & 1 } {
        set data(dnd,node) [list "node" [lindex $target 1]]
        $path.c create rectangle $xi $yi $xs $ys -tags drop
    } elseif { $vmode & 2 } {
        set data(dnd,node) [concat "position" [lindex $target 2]]
        $path.c create line $xli [expr {$yl-$dy/2}] $xli $yl $xs $yl -tags drop
    } elseif { $vmode & 4 } {
        set data(dnd,node) [list "widget"]
    } else {
        set code [expr {$code & 2}]
    }
    }

    if { $code & 1 } {
        DropSite::setcursor based_arrow_down
    } else {
        DropSite::setcursor dot
    }
    return $code
}


Tree::_recexpand
Comments Command Tree::_recexpand
JDC : added option recursive
Arguments path
node
expand
recursive
cmd
Used by  
Uses Widget::getoption
Widget::setoption
proc Tree::_recexpand { path node expand recursive cmd } {
    variable $path
    upvar 0  $path data

    if { [Widget::getoption $path.$node -open] != $expand } {
        Widget::setoption $path.$node -open $expand
        if { $cmd != "" } {
            uplevel \#0 $cmd $node
        }
    }

    if { $recursive } {
    foreach subnode [lrange $data($node) 1 end] {
        _recexpand $path $subnode $expand $recursive $cmd
    }
    }
}


Tree::_redraw_idle
Comments Command Tree::_redraw_idle
Arguments path
level
Used by  
Uses Tree::_redraw_tree
Widget::getoption
proc Tree::_redraw_idle { path level } {
    variable $path
    upvar 0  $path data

    if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } {
        set data(upd,afterid) [after idle Tree::_redraw_tree $path]
    }
    if { $level > $data(upd,level) } {
        set data(upd,level) $level
    }
    return ""
}


Tree::_redraw_selection
Comments Command Tree::_redraw_selection
Arguments path
Used by  
Uses Tree::_get_node_name
Widget::getoption
proc Tree::_redraw_selection { path } {
    variable $path
    upvar 0  $path data

    set selbg [Widget::getoption $path -selectbackground]
    set selfg [Widget::getoption $path -selectforeground]
    set fill  [Widget::getoption $path -selectfill]
    if {$fill} {
        set scroll [$path.c cget -scrollregion]
        if {[llength $scroll]} {
            set xmax [expr {[lindex $scroll 2]-1}]
        } else {
            set xmax [winfo width $path]
        }
    }
    foreach id [$path.c find withtag sel] {
        set node [Tree::_get_node_name $path $id 1]
        $path.c itemconfigure "n:$node" -fill [Widget::getoption $path.$node -fill]
    }
    $path.c delete sel
    foreach node $data(selnodes) {
        set bbox [$path.c bbox "n:$node"]
        if { [llength $bbox] } {
            if {$fill} {
                set bbox [list 0 [lindex $bbox 1] $xmax [lindex $bbox 3]]
            }
            set id [eval $path.c create rectangle $bbox \
            -fill $selbg -outline $selbg -tags [list "sel s:$node"]]
            $path.c itemconfigure "n:$node" -fill $selfg
            $path.c lower $id
        }
    }
}


Tree::_redraw_tree
Comments Command Tree::_redraw_tree
Arguments path
Used by Tree::_redraw_idle
Uses Widget::getoption
proc Tree::_redraw_tree { path } {
    variable $path
    upvar 0  $path data

    if { [Widget::getoption $path -redraw] } {
        if { $data(upd,level) == 2 } {
            _update_nodes $path
        } elseif { $data(upd,level) == 3 } {
            _draw_tree $path
        }
        _redraw_selection $path
        _update_scrollregion $path
        set data(upd,nodes)   {}
        set data(upd,level)   0
        set data(upd,afterid) ""
    }
}


Tree::_scroll
Comments Command Tree::_scroll
Arguments path
cmd
dir
Used by Tree::_auto_scroll
Tree::_scroll
Uses DropSite::setcursor
Tree::_scroll
proc Tree::_scroll { path cmd dir } {
    variable $path
    upvar 0  $path data

    if { ($dir == -1 && [lindex [$path.c $cmd] 0] > 0) ||
         ($dir == 1  && [lindex [$path.c $cmd] 1] < 1) } {
        $path.c $cmd scroll $dir units
        set data(dnd,afterid) [after 100 Tree::_scroll $path $cmd $dir]
    } else {
        set data(dnd,afterid) ""
        DropSite::setcursor dot
    }
}


Tree::_see
Comments Command Tree::_see
Arguments path
idn
Used by Tree::edit
Tree::see
Uses  
proc Tree::_see { path idn } {
    set bbox [$path.c bbox $idn]
    set scrl [$path.c cget -scrollregion]

    set ymax [lindex $scrl 3]
    set dy   [$path.c cget -yscrollincrement]
    set yv   [$path yview]
    set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]
    set yv1  [expr {round([lindex $yv 1]*$ymax/$dy)}]
    set y    [expr {int([lindex [$path.c coords $idn] 1]/$dy)}]
    if { $y < $yv0 } {
        $path.c yview scroll [expr {$y-$yv0}] units
    } elseif { $y >= $yv1 } {
        $path.c yview scroll [expr {$y-$yv1+1}] units
    }

    set xmax [lindex $scrl 2]
    set dx   [$path.c cget -xscrollincrement]
    set xv   [$path xview]
    set x0   [expr {int([lindex $bbox 0]/$dx)}]
    set xv0  [expr {round([lindex $xv 0]*$xmax/$dx)}]
    set xv1  [expr {round([lindex $xv 1]*$xmax/$dx)}]
    if { $x0 >= $xv1 || $x0 < $xv0 } {
    $path.c xview scroll [expr {$x0-$xv0}] units
    }
}


Tree::_set_current_node
Comments Tree::_set_current_node --

Set the current node for either single or multiple
node selection trees.

arguments:
win Name of the tree widget
node The current node.

Results:
None.
Arguments win
node
Used by  
Uses  
proc Tree::_set_current_node {win node} {
    if {[info exists selectTree::selectCursor($win)]} {
    set selectTree::selectCursor($win) $node
    }
    return
}


Tree::_subdelete
Comments Command Tree::_subdelete
Arguments path
lnodes
Used by  
Uses Widget::destroy
Widget::getoption
proc Tree::_subdelete { path lnodes } {
    variable $path
    upvar 0  $path data

    while { [llength $lnodes] } {
        set lsubnodes [list]
        foreach node $lnodes {
            foreach subnode [lrange $data($node) 1 end] {
                lappend lsubnodes $subnode
            }
            unset data($node)
            if { [set win [Widget::getoption $path.$node -window]] != "" } {
                destroy $win
            }
            Widget::destroy $path.$node
        }
        set lnodes $lsubnodes
    }
}


Tree::_update_edit_size
Comments Command Tree::_update_edit_size
Arguments path
entry
idw
wmax
args
Used by  
Uses  
proc Tree::_update_edit_size { path entry idw wmax args } {
    set entw [winfo reqwidth $entry]
    if { $entw+8 >= $wmax } {
        $path.c itemconfigure $idw -width $wmax
    } else {
        $path.c itemconfigure $idw -width 0
    }
}


Tree::_update_nodes
Comments Command Tree::_update_nodes
Arguments path
Used by  
Uses Widget::getoption
proc Tree::_update_nodes { path } {
    global   env
    variable $path
    upvar 0  $path data

    set deltax [Widget::getoption $path -deltax]
    set padx   [Widget::getoption $path -padx]
    foreach {node flag} $data(upd,nodes) {
        set idn [$path.c find withtag "n:$node"]
        if { $idn == "" } {
            continue
        }
        set c  [$path.c coords $idn]
        set x0 [expr {[lindex $c 0]-$padx}]
        set y0 [lindex $c 1]
        if { $flag & 48 } {
            # -window or -image modified
            set win  [Widget::getoption $path.$node -window]
            set img  [Widget::getoption $path.$node -image]
            set idi  [$path.c find withtag i:$node]
            set type [lindex [$path.c gettags $idi] 1]
            if { [string length $win] } {
                if { ![string compare $type "win"] } {
                    $path.c itemconfigure $idi -window $win
                } else {
                    $path.c delete $idi
                    $path.c create window $x0 $y0 -window $win -anchor w \
                -tags "TreeItemSentinal win i:$node"
                }
            } elseif { [string length $img] } {
                if { ![string compare $type "img"] } {
                    $path.c itemconfigure $idi -image $img
                } else {
                    $path.c delete $idi
                    $path.c create image $x0 $y0 -image $img -anchor w \
                -tags "TreeItemSentinal img i:$node"
                }
            } else {
                $path.c delete $idi
            }
        }

        if { $flag & 8 } {
            # -drawcross modified
            set len [expr {[llength $data($node)] > 1}]
            set dc  [Widget::getoption $path.$node -drawcross]
            set exp [Widget::getoption $path.$node -open]
            set idc [$path.c find withtag c:$node]

            if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
                if { $exp } {
                    set bmp [file join $::BWIDGET::LIBRARY "images" "minus.xbm"]
                } else {
                    set bmp [file join $::BWIDGET::LIBRARY "images" "plus.xbm"]
                }
                if { $idc == "" } {
                    $path.c create bitmap [expr {$x0-$deltax-5}] $y0 \
                        -bitmap     @$bmp \
                        -background [$path.c cget -background] \
                        -foreground [Widget::getoption $path -linesfill] \
                        -tags       "cross c:$node" -anchor c
                } else {
                    $path.c itemconfigure $idc -bitmap @$bmp
                }
            } else {
                $path.c delete $idc
            }
        }

        if { $flag & 7 } {
            # -font, -text or -fill modified
            $path.c itemconfigure $idn \
                -text [Widget::getoption $path.$node -text] \
                -fill [Widget::getoption $path.$node -fill] \
                -font [Widget::getoption $path.$node -font]
        }
    }
}


Tree::_update_scrollregion
Comments Command Tree::_update_scrollregion
Arguments path
Used by  
Uses Widget::getoption
proc Tree::_update_scrollregion { path } {
    set bd   [expr {2*([$path.c cget -borderwidth]+[$path.c cget -highlightthickness])}]
    set w    [expr {[winfo width  $path] - $bd}]
    set h    [expr {[winfo height $path] - $bd}]
    set xinc [$path.c cget -xscrollincrement]
    set yinc [$path.c cget -yscrollincrement]
    set bbox [$path.c bbox node]
    if { [llength $bbox] } {
        set xs [lindex $bbox 2]
        set ys [lindex $bbox 3]

        if { $w < $xs } {
            set w [expr {int($xs)}]
            if { [set r [expr {$w % $xinc}]] } {
                set w [expr {$w+$xinc-$r}]
            }
        }
        if { $h < $ys } {
            set h [expr {int($ys)}]
            if { [set r [expr {$h % $yinc}]] } {
                set h [expr {$h+$yinc-$r}]
            }
        }
    }

    $path.c configure -scrollregion [list 0 0 $w $h]

    if {[Widget::getoption $path -selectfill]} {
        _redraw_selection $path
    }
}


Tree::bindImage
Comments Command Tree::bindImage
Arguments path
event
script
Used by Tree::create
Uses Tree::_get_node_name
proc Tree::bindImage { path event script } {
    if { $script != "" } {
        $path.c bind "img" $event \
        "$script \[Tree::_get_node_name $path current 2\]"
    } else {
        $path.c bind "img" $event {}
    }
}


Tree::bindText
Comments Command Tree::bindText
Arguments path
event
script
Used by Tree::create
Uses Tree::_get_node_name
proc Tree::bindText { path event script } {
    if { $script != "" } {
        $path.c bind "node" $event \
            "$script \[Tree::_get_node_name $path current 2\]"
    } else {
        $path.c bind "node" $event {}
    }
}


Tree::cget
Comments Command Tree::cget
Arguments path
option
Used by  
Uses Widget::cget
proc Tree::cget { path option } {
    return [Widget::cget $path $option]
}


Tree::closetree
Comments Command Tree::closetree
Arguments path
node
recursive
Used by  
Uses Widget::getoption
proc Tree::closetree { path node {recursive 1} } {
    variable $path
    upvar 0  $path data

    if { ![string compare $node "root"] || ![info exists data($node)] } {
        return -code error "node \"$node\" does not exist"
    }

    _recexpand $path $node 0 $recursive [Widget::getoption $path -closecmd]
    _redraw_idle $path 3
}


Tree::configure
Comments Command Tree::configure
Arguments path
args
Used by  
Uses Tree::_drop_cmd
Widget::hasChanged
Tree::_init_drag_cmd
DragSite::setdrag
Widget::configure
DropSite::setdrop
Tree::_over_cmd
proc Tree::configure { path args } {
    variable $path
    upvar 0  $path data

    set res [Widget::configure $path $args]

    set ch1 [expr {[Widget::hasChanged $path -deltax val] |
                   [Widget::hasChanged $path -deltay dy]  |
                   [Widget::hasChanged $path -padx val]   |
                   [Widget::hasChanged $path -showlines val]}]

    set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
                   [Widget::hasChanged $path -selectforeground val]}]

    if { [Widget::hasChanged $path -linesfill   fill] |
         [Widget::hasChanged $path -linestipple stipple] } {
        $path.c itemconfigure line  -fill $fill -stipple $stipple
        $path.c itemconfigure cross -foreground $fill
    }

    if { $ch1 } {
        _redraw_idle $path 3
    } elseif { $ch2 } {
        _redraw_idle $path 1
    }

    if { [Widget::hasChanged $path -height h] } {
        $path.c configure -height [expr {$h*$dy}]
    }
    if { [Widget::hasChanged $path -width w] } {
        $path.c configure -width [expr {$w*8}]
    }

    if { [Widget::hasChanged $path -redraw bool] && $bool } {
        set upd $data(upd,level)
        set data(upd,level) 0
        _redraw_idle $path $upd
    }

    set force [Widget::hasChanged $path -dragendcmd dragend]
    DragSite::setdrag $path $path.c Tree::_init_drag_cmd $dragend $force
    DropSite::setdrop $path $path.c Tree::_over_cmd Tree::_drop_cmd

    return $res
}


Tree::create
Comments Command Tree::create
Arguments path
args
Used by  
Uses Widget::cget
Widget::subcget
Tree::_init_drag_cmd
BWidget::refocus
Tree::_cross_event
Tree::_drop_cmd
DropSite::setdrop
Tree::bindText
Widget::init
Tree::bindImage
Tree::_over_cmd
DragSite::setdrag
proc Tree::create { path args } {
    variable $path
    upvar 0  $path data

    Widget::init Tree $path $args
    set ::Tree::sentinal($path.c) 0
    
    set data(root)         {{}}
    set data(selnodes)     {}
    set data(upd,level)    0
    set data(upd,nodes)    {}
    set data(upd,afterid)  ""
    set data(dnd,scroll)   ""
    set data(dnd,afterid)  ""
    set data(dnd,selnodes) {}
    set data(dnd,node)     ""

    frame $path -class Tree -bd 0 -highlightthickness 0 -relief flat \
        -takefocus 0
    # For 8.4+ we don't want to inherit the padding
    catch {$path configure -padx 0 -pady 0}
    eval canvas $path.c [Widget::subcget $path .c] -xscrollincrement 8
    bindtags $path.c [list TreeSentinalStart TreeFocus $path.c Canvas \
        [winfo toplevel $path] all TreeSentinalEnd]
    pack $path.c -expand yes -fill both
    $path.c bind cross <ButtonPress-1> [list Tree::_cross_event $path]

    # Added by ericm@scriptics.com
    # These allow keyboard traversal of the tree
    bind $path.c <KeyPress-Up>    "Tree::_keynav up $path"
    bind $path.c <KeyPress-Down>  "Tree::_keynav down $path"
    bind $path.c <KeyPress-Right> "Tree::_keynav right $path"
    bind $path.c <KeyPress-Left>  "Tree::_keynav left $path"
    bind $path.c <KeyPress-space> "+Tree::_keynav space $path"

    # These allow keyboard control of the scrolling
    bind $path.c <Control-KeyPress-Up>    "$path.c yview scroll -1 units"
    bind $path.c <Control-KeyPress-Down>  "$path.c yview scroll  1 units"
    bind $path.c <Control-KeyPress-Left>  "$path.c xview scroll -1 units"
    bind $path.c <Control-KeyPress-Right> "$path.c xview scroll  1 units"
    # ericm@scriptics.com

    bind $path <Configure> "Tree::_update_scrollregion $path"
    bind $path <Destroy>   "Tree::_destroy $path"
    bind $path <FocusIn>   [list after idle {BWidget::refocus %W %W.c}]

    DragSite::setdrag $path $path.c Tree::_init_drag_cmd \
        [Widget::cget $path -dragendcmd] 1
    DropSite::setdrop $path $path.c Tree::_over_cmd Tree::_drop_cmd 1

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval Tree::\$cmd $path \$args\]"

    set w [Widget::cget $path -width]
    set h [Widget::cget $path -height]
    set dy [Widget::cget $path -deltay]
    $path.c configure -width [expr {$w*8}] -height [expr {$h*$dy}]

    # ericm
    # Bind <Button-1> to select the clicked node -- no reason not to, right?
    Tree::bindText  $path <Button-1> "$path selection set"
    Tree::bindImage $path <Button-1> "$path selection set"
    Tree::bindText  $path <Control-Button-1> "$path selection toggle"
    Tree::bindImage $path <Control-Button-1> "$path selection toggle"


    # Add sentinal bindings for double-clicking on items, to handle the
    # gnarly Tk bug wherein:
    # ButtonClick
    # ButtonClick
    # On a canvas item translates into button click on the item, button click
    # on the canvas, double-button on the item, single button click on the
    # canvas (which can happen if the double-button on the item causes some
    # other event to be handled in between when the button clicks are examined
    # for the canvas)
    $path.c bind TreeItemSentinal <Double-Button-1> \
        "set ::Tree::sentinal($path.c) 1"
    # ericm

    return $path
}


Tree::delete
Comments Command Tree::delete
Arguments path
args
Used by  
Uses  
proc Tree::delete { path args } {
    variable $path
    upvar 0  $path data

    set sel $data(selnodes)

    foreach lnodes $args {
    foreach node $lnodes {
        if { [string compare $node "root"] && [info exists data($node)] } {
        set parent [lindex $data($node) 0]
        set idx       [lsearch $data($parent) $node]
        set data($parent) [lreplace $data($parent) $idx $idx]
        set idx       [lsearch $sel $node]
        if { $idx >= 0 } {
            set sel [lreplace $sel $idx $idx]
        }
        _subdelete $path [list $node]
        }
    }
    }

    set data(selnodes) {}
    eval [list selection $path set] $sel
    _redraw_idle $path 3
}


Tree::edit
Comments Command Tree::edit
Arguments path
node
text
verifycmd
clickres
select
Used by  
Uses BWidget::focus
Tree::_see
Widget::getoption
proc Tree::edit { path node text {verifycmd ""} {clickres 0} {select 1}} {
    variable _edit
    variable $path
    upvar 0  $path data

    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
        after cancel $data(upd,afterid)
        _redraw_tree $path
    }
    set idn [$path.c find withtag n:$node]
    if { $idn != "" } {
        Tree::_see $path $idn

        set oldfg  [$path.c itemcget $idn -fill]
        set sbg    [Widget::getoption $path -selectbackground]
        set coords [$path.c coords $idn]
        set x      [lindex $coords 0]
        set y      [lindex $coords 1]
        set bd     [expr {[$path.c cget -borderwidth]+[$path.c cget -highlightthickness]}]
        set w      [expr {[winfo width $path] - 2*$bd}]
        set wmax   [expr {[$path.c canvasx $w]-$x}]

        set _edit(text) $text
        set _edit(wait) 0

        $path.c itemconfigure $idn    -fill [Widget::getoption $path -background]
        $path.c itemconfigure s:$node -fill {} -outline {}

        set frame  [frame $path.edit \
                        -relief flat -borderwidth 0 -highlightthickness 0 \
                        -background [Widget::getoption $path -background]]
        set ent    [entry $frame.edit \
                        -width              0     \
                        -relief             solid \
                        -borderwidth        1     \
                        -highlightthickness 0     \
                        -foreground         [Widget::getoption $path.$node -fill] \
                        -background         [Widget::getoption $path -background] \
                        -selectforeground   [Widget::getoption $path -selectforeground] \
                        -selectbackground   $sbg  \
                        -font               [Widget::getoption $path.$node -font] \
                        -textvariable       Tree::_edit(text)]
        pack $ent -ipadx 8 -anchor w

        set idw [$path.c create window $x $y -window $frame -anchor w]
        trace variable Tree::_edit(text) w "Tree::_update_edit_size $path $ent $idw $wmax"
        tkwait visibility $ent
        grab  $frame
        BWidget::focus set $ent

        _update_edit_size $path $ent $idw $wmax
        update
        if { $select } {
            $ent selection range 0 end
            $ent icursor end
            $ent xview end
        }

        bindtags $ent [list $ent Entry]
        bind $ent <Escape> {set Tree::_edit(wait) 0}
        bind $ent <Return> {set Tree::_edit(wait) 1}
        if { $clickres == 0 || $clickres == 1 } {
            bind $frame <Button>  "set Tree::_edit(wait) $clickres"
        }

        set ok 0
        while { !$ok } {
            tkwait variable Tree::_edit(wait)
            if { !$_edit(wait) || $verifycmd == "" ||
                 [uplevel \#0 $verifycmd [list $_edit(text)]] } {
                set ok 1
            }
        }

        trace vdelete Tree::_edit(text) w "Tree::_update_edit_size $path $ent $idw $wmax"
        grab release $frame
        BWidget::focus release $ent
        destroy $frame
        $path.c delete $idw
        $path.c itemconfigure $idn    -fill $oldfg
        $path.c itemconfigure s:$node -fill $sbg -outline $sbg

        if { $_edit(wait) } {
            return $_edit(text)
        }
    }
    return ""
}


Tree::exists
Comments Command Tree::exists
Arguments path
node
Used by  
Uses  
proc Tree::exists { path node } {
    variable $path
    upvar 0  $path data

    return [info exists data($node)]
}


Tree::find
Comments Tree::find
Returns the node given a position.
findInfo @x,y ?confine?
lineNumber
Arguments path
findInfo
confine
Used by  
Uses Tree::_get_node_name
Widget::getoption
Widget::cget
proc Tree::find {path findInfo {confine ""}} {
    if {[regexp -- {^@([0-9]+),([0-9]+)$} $findInfo match x y]} {
        set x [$path.c canvasx $x]
        set y [$path.c canvasy $y]
    } elseif {[regexp -- {^[0-9]+$} $findInfo lineNumber]} {
        set dy [Widget::getoption $path -deltay]
        set y  [expr {$dy*($lineNumber+0.5)}]
        set confine ""
    } else {
        return -code error "invalid find spec \"$findInfo\""
    }

    set found  0
    set region [$path.c bbox all]
    if {[llength $region]} {
        set xi [lindex $region 0]
        set xs [lindex $region 2]
        foreach id [$path.c find overlapping $xi $y $xs $y] {
            set ltags [$path.c gettags $id]
            set item  [lindex $ltags 1]
            if { ![string compare $item "node"] ||
                 ![string compare $item "img"]  ||
                 ![string compare $item "win"] } {
                # item is the label or image/window of the node
                set node  [Tree::_get_node_name $path $id 2]
                set found 1
                break
            }
        }
    }

    if {$found} {
        if {[string compare $confine "confine"] == 0} {
            # test if x stand inside node bbox
            set xi [expr {[lindex [$path.c coords n:$node] 0]-[Widget::cget $path -padx]}]
            set xs [lindex [$path.c bbox n:$node] 2]
            if {$x >= $xi && $x <= $xs} {
                return $node
            }
        } else {
            return $node
        }
    }
    return ""
}


Tree::index
Comments Command Tree::index
Arguments path
node
Used by  
Uses  
proc Tree::index { path node } {
    variable $path
    upvar 0  $path data

    if { ![string compare $node "root"] || ![info exists data($node)] } {
        return -code error "node \"$node\" does not exist"
    }
    set parent [lindex $data($node) 0]
    return [expr {[lsearch $data($parent) $node] - 1}]
}


Tree::insert
Comments Command Tree::insert
Arguments path
index
parent
node
args
Used by  
Uses Widget::init
Widget::getMegawidgetOption
proc Tree::insert { path index parent node args } {
    variable $path
    upvar 0  $path data

    if { [info exists data($node)] } {
        return -code error "node \"$node\" already exists"
    }
    if { ![info exists data($parent)] } {
        return -code error "node \"$parent\" does not exist"
    }

    Widget::init Tree::Node $path.$node $args
    if { ![string compare $index "end"] } {
        lappend data($parent) $node
    } else {
        incr index
        set data($parent) [linsert $data($parent) $index $node]
    }
    set data($node) [list $parent]

    if { ![string compare $parent "root"] } {
        _redraw_idle $path 3
    } elseif { [visible $path $parent] } {
        # parent is visible...
        if { [Widget::getMegawidgetOption $path.$parent -open] } {
            # ...and opened -> redraw whole
            _redraw_idle $path 3
        } else {
            # ...and closed -> redraw cross
            lappend data(upd,nodes) $parent 8
            _redraw_idle $path 2
        }
    }
    return $node
}


Tree::itemcget
Comments Command Tree::itemcget
Arguments path
node
option
Used by  
Uses Widget::cget
proc Tree::itemcget { path node option } {
    # Instead of upvar'ing $path as data for this test, just directly refer to
    # it, as that is faster.
    if { ![string compare $node "root"] || \
        ![info exists ::Tree::${path}($node)] } {
        return -code error "node \"$node\" does not exist"
    }

    return [Widget::cget $path.$node $option]
}


Tree::itemconfigure
Comments Command Tree::itemconfigure
Arguments path
node
args
Used by Tree::_cross_event
Uses Widget::hasChanged
Widget::configure
proc Tree::itemconfigure { path node args } {
    variable $path
    upvar 0  $path data

    if { ![string compare $node "root"] || ![info exists data($node)] } {
        return -code error "node \"$node\" does not exist"
    }

    set result [Widget::configure $path.$node $args]
    if { [visible $path $node] } {
        set lopt   {}
        set flag   0
        foreach opt {-window -image -drawcross -font -text -fill} {
            set flag [expr {$flag << 1}]
            if { [Widget::hasChanged $path.$node $opt val] } {
                set flag [expr {$flag | 1}]
            }
        }

        if { [Widget::hasChanged $path.$node -open val] } {
            if {[llength $data($node)] > 1} {
                # node have subnodes - full redraw
                _redraw_idle $path 3
            } else {
                # force a redraw of the plus/minus sign
                set flag [expr {$flag | 8}]
            }
        }
    if { $data(upd,level) < 3 && $flag } {
            if { [set idx [lsearch $data(upd,nodes) $node]] == -1 } {
                lappend data(upd,nodes) $node $flag
            } else {
                incr idx
                set flag [expr {[lindex $data(upd,nodes) $idx] | $flag}]
                set data(upd,nodes) [lreplace $data(upd,nodes) $idx $idx $flag]
            }
            _redraw_idle $path 2
        }
    }
    return $result
}


Tree::line
Comments Command Tree::line
Returns the line where is drawn a node.
Arguments path
node
Used by  
Uses Widget::getoption
proc Tree::line {path node} {
    set item [$path.c find withtag n:$node]
    if {[string length $item]} {
        set dy   [Widget::getoption $path -deltay]
        set y    [lindex [$path.c coords $item] 1]
        set line [expr {int($y/$dy)}]
    } else {
        set line -1
    }
    return $line
}


Tree::move
Comments Command Tree::move
Arguments path
parent
node
index
Used by  
Uses Widget::getoption
proc Tree::move { path parent node index } {
    variable $path
    upvar 0  $path data

    if { ![string compare $node "root"] || ![info exists data($node)] } {
        return -code error "node \"$node\" does not exist"
    }
    if { ![info exists data($parent)] } {
        return -code error "node \"$parent\" does not exist"
    }
    set p $parent
    while { [string compare $p "root"] } {
        if { ![string compare $p $node] } {
            return -code error "node \"$parent\" is a descendant of \"$node\""
        }
        set p [parent $path $p]
    }

    set oldp        [lindex $data($node) 0]
    set idx         [lsearch $data($oldp) $node]
    set data($oldp) [lreplace $data($oldp) $idx $idx]
    set data($node) [concat [list $parent] [lrange $data($node) 1 end]]
    if { ![string compare $index "end"] } {
        lappend data($parent) $node
    } else {
        incr index
        set data($parent) [linsert $data($parent) $index $node]
    }
    if { (![string compare $oldp "root"] ||
          ([visible $path $oldp] && [Widget::getoption $path.$oldp   -open])) ||
         (![string compare $parent "root"] ||
          ([visible $path $parent] && [Widget::getoption $path.$parent -open])) } {
        _redraw_idle $path 3
    }
}


Tree::nodes
Comments Command Tree::nodes
Arguments path
node
first
last
Used by  
Uses  
proc Tree::nodes { path node {first ""} {last ""} } {
    variable $path
    upvar 0  $path data

    if { ![info exists data($node)] } {
        return -code error "node \"$node\" does not exist"
    }

    if { ![string length $first] } {
        return [lrange $data($node) 1 end]
    }

    if { ![string length $last] } {
        return [lindex [lrange $data($node) 1 end] $first]
    } else {
        return [lrange [lrange $data($node) 1 end] $first $last]
    }
}


Tree::opentree
Comments Command Tree::opentree
JDC: added option recursive
Arguments path
node
recursive
Used by  
Uses Widget::getoption
proc Tree::opentree { path node {recursive 1} } {
    variable $path
    upvar 0  $path data

    if { ![string compare $node "root"] || ![info exists data($node)] } {
        return -code error "node \"$node\" does not exist"
    }

    _recexpand $path $node 1 $recursive [Widget::getoption $path -opencmd]
    _redraw_idle $path 3
}


Tree::parent
Comments Command Tree::parent
Arguments path
node
Used by  
Uses  
proc Tree::parent { path node } {
    variable $path
    upvar 0  $path data

    if { ![info exists data($node)] } {
        return -code error "node \"$node\" does not exist"
    }
    return [lindex $data($node) 0]
}


Tree::reorder
Comments Command Tree::reorder
Arguments path
node
neworder
Used by  
Uses BWidget::lreorder
Widget::getoption
proc Tree::reorder { path node neworder } {
    variable $path
    upvar 0  $path data

    if { ![info exists data($node)] } {
        return -code error "node \"$node\" does not exist"
    }
    set children [lrange $data($node) 1 end]
    if { [llength $children] } {
        set children [BWidget::lreorder $children $neworder]
        set data($node) [linsert $children 0 [lindex $data($node) 0]]
        if { [visible $path $node] && [Widget::getoption $path.$node -open] } {
            _redraw_idle $path 3
        }
    }
}


Tree::see
Comments Command Tree::see
Arguments path
node
Used by  
Uses Widget::getoption
Tree::_see
proc Tree::see { path node } {
    variable $path
    upvar 0  $path data

    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
        after cancel $data(upd,afterid)
        _redraw_tree $path
    }
    set idn [$path.c find withtag n:$node]
    if { $idn != "" } {
        Tree::_see $path $idn
    }
}


Tree::selection
Comments Command Tree::selection
Arguments path
cmd
args
Used by  
Uses Tree::_get_node_name
Widget::getoption
proc Tree::selection { path cmd args } {
    variable $path
    upvar 0  $path data

    switch -- $cmd {
    toggle {
            foreach node $args {
                if {![info exists data($node)]} {
            return -code error \
                "$path selection toggle: Cannot toggle unknown node \"$node\"."
        }
        }
            foreach node $args {
        if {[$path selection includes $node]} {
            $path selection remove $node
        } else {
            $path selection add $node
        }
            }
    }
        set {
            foreach node $args {
                if {![info exists data($node)]} {
            return -code error \
                "$path selection set: Cannot select unknown node \"$node\"."
        }
        }
            set data(selnodes) {}
            foreach node $args {
        if { [Widget::getoption $path.$node -selectable] } {
            if { [lsearch $data(selnodes) $node] == -1 } {
            lappend data(selnodes) $node
            }
        }
            }
        __call_selectcmd $path
        }
        add {
            foreach node $args {
                if {![info exists data($node)]} {
            return -code error \
                "$path selection add: Cannot select unknown node \"$node\"."
        }
        }
            foreach node $args {
        if { [Widget::getoption $path.$node -selectable] } {
            if { [lsearch $data(selnodes) $node] == -1 } {
            lappend data(selnodes) $node
            }
        }
            }
        __call_selectcmd $path
        }
    range {
        # Here's our algorithm:
        #    make a list of all nodes, then take the range from node1
        #    to node2 and select those nodes
        #
        # This works because of how this widget handles redraws:
        #    The tree is always completely redrawn, and always from
        #    top to bottom. So the list of visible nodes *is* the
        #    list of nodes, and we can use that to decide which nodes
        #    to select.

        if {[llength $args] != 2} {
        return -code error \
            "wrong#args: Expected $path selection range node1 node2"
        }

        foreach {node1 node2} $args break

        if {![info exists data($node1)]} {
        return -code error \
            "$path selection range: Cannot start range at unknown node \"$node1\"."
        }
        if {![info exists data($node2)]} {
        return -code error \
            "$path selection range: Cannot end range at unknown node \"$node2\"."
        }

        set nodes {}
        foreach nodeItem [$path.c find withtag node] {
        set node [Tree::_get_node_name $path $nodeItem 2]
        if { [Widget::getoption $path.$node -selectable] } {
            lappend nodes $node
        }
        }
        # surles: Set the root string to the first element on the list.
        if {$node1 == "root"} {
        set node1 [lindex $nodes 0]
        }
        if {$node2 == "root"} {
        set node2 [lindex $nodes 0]
        }

        # Find the first visible ancestor of node1, starting with node1
        while {[set index1 [lsearch -exact $nodes $node1]] == -1} {
        set node1 [lindex $data($node1) 0]
        }
        # Find the first visible ancestor of node2, starting with node2
        while {[set index2 [lsearch -exact $nodes $node2]] == -1} {
        set node2 [lindex $data($node2) 0]
        }
        # If the nodes were given in backwards order, flip the
        # indices now
        if { $index2 < $index1 } {
        incr index1 $index2
        set index2 [expr {$index1 - $index2}]
        set index1 [expr {$index1 - $index2}]
        }
        set data(selnodes) [lrange $nodes $index1 $index2]
        __call_selectcmd $path
    }
        remove {
            foreach node $args {
                if { [set idx [lsearch $data(selnodes) $node]] != -1 } {
                    set data(selnodes) [lreplace $data(selnodes) $idx $idx]
                }
            }
        __call_selectcmd $path
        }
        clear {
        if {[llength $args] != 0} {
        return -code error \
            "wrong#args: Expected $path selection clear"
        }
            set data(selnodes) {}
        __call_selectcmd $path
        }
        get {
        if {[llength $args] != 0} {
        return -code error \
            "wrong#args: Expected $path selection get"
        }
            return $data(selnodes)
        }
        includes {
        if {[llength $args] != 1} {
        return -code error \
            "wrong#args: Expected $path selection includes node"
        }
        set node [lindex $args 0]
            return [expr {[lsearch $data(selnodes) $node] != -1}]
        }
        default {
            return
        }
    }
    _redraw_idle $path 1
}


Tree::visible
Comments Command Tree::visible
Arguments path
node
Used by  
Uses  
proc Tree::visible { path node } {
    set idn [$path.c find withtag n:$node]
    return [llength $idn]
}


Tree::visiblenodes
Comments Tree::visiblenodes --

Retrieve a list of all the nodes in a tree.

Arguments:
path tree to retrieve nodes for.

Results:
nodes list of nodes in the tree.
Arguments path
Used by  
Uses Widget::getMegawidgetOption
proc Tree::visiblenodes { path } {
    variable $path
    upvar 0  $path data

    # Root is always open (?), so all of its children automatically get added
    # to the result, and to the stack.
    set st [lrange $data(root) 1 end]
    set result $st

    while { [llength $st] } {
    set node [lindex $st end]
    set st [lreplace $st end end]
    # Danger, danger!  Using getMegawidgetOption is fragile, but much
    # much faster than going through cget.
    if { [Widget::getMegawidgetOption $path.$node -open] } {
        set nodes [lrange $data($node) 1 end]
        set result [concat $result $nodes]
        set st [concat $st $nodes]
    }
    }
    return $result
}


Tree::xview
Comments Command Tree::xview
Arguments path
args
Used by  
Uses  
proc Tree::xview { path args } {
    return [eval $path.c xview $args]
}


Tree::yview
Comments Command Tree::yview
Arguments path
args
Used by  
Uses  
proc Tree::yview { path args } {
    return [eval $path.c yview $args]
}
generated by zdoc.tcl on 2003-03-06 00:21:55