# ------------------------------------------------------------------------------#  tree.tcl#  This file is part of Unifix BWidget Toolkit#  $Id: tree.tcl,v 1.12 1999/07/09 08:10:38 eric 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# ------------------------------------------------------------------------------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}            {-drawcross  Enum       auto    0 {auto allways never}}        }    }    Widget::tkinclude Tree canvas :cmd \        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 {=0 ""}}        {-deltay           Int 15 0 {=0 ""}}        {-padx             Int 20 0 {=0 ""}}        {-background       TkResource "" 0 listbox}        {-selectbackground TkResource "" 0 listbox}        {-selectforeground TkResource "" 0 listbox}        {-width            TkResource "" 0 listbox}        {-height           TkResource "" 0 listbox}        {-showlines        Boolean 1  0}        {-linesfill        TkResource black  0 {frame -background}}        {-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 "" :cmd {-deltay -yscrollincrement}    proc ::Tree { path args } { return [eval Tree::create $path $args] }    proc use {} {}    variable _edit}# ------------------------------------------------------------------------------#  Command Tree::create# ------------------------------------------------------------------------------proc Tree::create { path args } {    variable $path    upvar 0  $path data    Widget::init Tree $path $args    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)     ""    set path [eval canvas $path [Widget::subcget $path :cmd] \                  -width  [expr {[Widget::getoption $path -width]*8}] \                  -height [expr {[Widget::getoption $path -height]*[Widget::getoption $path -deltay]}] \                  -xscrollincrement 8]    $path bind cross <ButtonPress-1> {Tree::_cross_event %W}    bind $path <Configure> "Tree::_update_scrollregion $path"    bind $path <Destroy>   "Tree::_destroy $path"    DragSite::setdrag $path $path Tree::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1    DropSite::setdrop $path $path Tree::_over_cmd Tree::_drop_cmd 1    rename $path ::$path:cmd    proc ::$path { cmd args } "return \[eval Tree::\$cmd $path \$args\]"    return $path}# ------------------------------------------------------------------------------#  Command Tree::configure# ------------------------------------------------------------------------------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:cmd itemconfigure line  -fill $fill -stipple $stipple        $path:cmd itemconfigure cross -foreground $fill    }    if { $ch1 } {        _redraw_idle $path 3    } elseif { $ch2 } {        _redraw_idle $path 1    }    if { [Widget::hasChanged $path -height h] } {        $path:cmd configure -height [expr {$h*$dy}]    }    if { [Widget::hasChanged $path -width w] } {        $path:cmd 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 Tree::_init_drag_cmd $dragend $force    DropSite::setdrop $path $path Tree::_over_cmd Tree::_drop_cmd    return $res}# ------------------------------------------------------------------------------#  Command Tree::cget# ------------------------------------------------------------------------------proc Tree::cget { path option } {    return [Widget::cget $path $option]}# ------------------------------------------------------------------------------#  Command Tree::insert# ------------------------------------------------------------------------------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::getoption $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}# ------------------------------------------------------------------------------#  Command Tree::itemconfigure# ------------------------------------------------------------------------------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] } {            _redraw_idle $path 3        } elseif { $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}# ------------------------------------------------------------------------------#  Command Tree::itemcget# ------------------------------------------------------------------------------proc Tree::itemcget { path node option } {    variable $path    upvar 0  $path data    if { ![string compare $node "root"] || ![info exists data($node)] } {        return -code error "node \"$node\" does not exist"    }    return [Widget::cget $path.$node $option]}# ------------------------------------------------------------------------------#  Command Tree::bindText# ------------------------------------------------------------------------------proc Tree::bindText { path event script } {    if { $script != "" } {        $path:cmd bind "node" $event \            "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"    } else {        $path:cmd bind "node" $event {}    }}# ------------------------------------------------------------------------------#  Command Tree::bindImage# ------------------------------------------------------------------------------proc Tree::bindImage { path event script } {    if { $script != "" } {        $path:cmd bind "img" $event \            "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"    } else {        $path:cmd bind "img" $event {}    }}# ------------------------------------------------------------------------------#  Command Tree::delete# ------------------------------------------------------------------------------proc Tree::delete { path args } {    variable $path    upvar 0  $path data    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]                _subdelete $path [list $node]            }        }    }    set sel $data(selnodes)    set data(selnodes) {}    eval selection $path set $sel    _redraw_idle $path 3}# ------------------------------------------------------------------------------#  Command Tree::move# ------------------------------------------------------------------------------proc Tree::move { path parent node index } {    variable $path