# ----------------------------------------------------------------------------#  tree.tcl#  This file is part of Unifix BWidget Toolkit#  $Id: tree.tcl 3417 2004-12-03 00:31:24Z tjikkun $# ----------------------------------------------------------------------------#  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 {    Widget::define Tree tree DragSite DropSite DynamicHelp    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}}	    {-padx       Int        -1      0 "%d >= -1"}	    {-deltax     Int        -1      0 "%d >= -1"}	    {-anchor     String     "w"     0 ""}        }    }    DynamicHelp::include Tree::Node balloon    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}}	{-crossfill        TkResource black  0 {listbox -foreground}}        {-redraw           Boolean 1  0}        {-opencmd          String  "" 0}        {-closecmd         String  "" 0}        {-dropovermode     Flag    "wpn" 0 "wpn"}        {-bg               Synonym -background}        {-crossopenimage    String  ""  0}        {-crosscloseimage   String  ""  0}        {-crossopenbitmap   String  ""  0}        {-crossclosebitmap  String  ""  0}    }    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 Tree <FocusIn>   [list after idle {BWidget::refocus %W %W.c}]    bind Tree <Destroy>   [list Tree::_destroy %W]    bind Tree <Configure> [list Tree::_update_scrollregion %W]    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]    variable _edit}# ----------------------------------------------------------------------------#  Command Tree::create# ----------------------------------------------------------------------------proc Tree::create { path args } {    variable $path    upvar 0  $path data    Widget::init Tree $path $args    set ::Tree::sentinal($path.c) 0    if {[Widget::cget $path -crossopenbitmap] == ""} {        set file [file join $::BWIDGET::LIBRARY images "minus.xbm"]        Widget::configure $path [list -crossopenbitmap @$file]    }    if {[Widget::cget $path -crossclosebitmap] == ""} {        set file [file join $::BWIDGET::LIBRARY images "plus.xbm"]        Widget::configure $path [list -crossclosebitmap @$file]    }    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 [list 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>    [list Tree::_keynav up $path]    bind $path.c <KeyPress-Down>  [list Tree::_keynav down $path]    bind $path.c <KeyPress-Right> [list Tree::_keynav right $path]    bind $path.c <KeyPress-Left>  [list Tree::_keynav left $path]    bind $path.c <KeyPress-space> [list +Tree::_keynav space $path]    # These allow keyboard control of the scrolling    bind $path.c <Control-KeyPress-Up>    [list $path.c yview scroll -1 units]    bind $path.c <Control-KeyPress-Down>  [list $path.c yview scroll  1 units]    bind $path.c <Control-KeyPress-Left>  [list $path.c xview scroll -1 units]    bind $path.c <Control-KeyPress-Right> [list $path.c xview scroll  1 units]    # ericm@scriptics.com    BWidget::bindMouseWheel $path.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    Widget::create Tree $path    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?    ## Bind button 1 to select the node via the _mouse_select command.    ## This command will generate the proper <<TreeSelect>> virtual event    ## when necessary.    set selectcmd Tree::_mouse_select    Tree::bindText  $path <Button-1>         [list $selectcmd $path set]    Tree::bindImage $path <Button-1>         [list $selectcmd $path set]    Tree::bindText  $path <Control-Button-1> [list $selectcmd $path toggle]    Tree::bindImage $path <Control-Button-1> [list $selectcmd $path 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> \	[list set ::Tree::sentinal($path.c) 1]    # ericm    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.c itemconfigure line  -fill $fill -stipple $stipple    }    if { [Widget::hasChanged $path -crossfill fill] } {        $path.c itemconfigure cross -foreground $fill    }    if {[Widget::hasChanged $path -selectfill fill]} {	# Make sure that the full-width boxes have either all or none	# of the standard node bindings	if {$fill} {	    foreach event [$path.c bind "node"] {		$path.c bind "box" $event [$path.c bind "node" $event]	    }	} else {	    foreach event [$path.c bind "node"] {		$path.c bind "box" $event {}	    }	}    }    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}# ----------------------------------------------------------------------------#  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    set node [_node_name $path $node]    set node [Widget::nextIndex $path $node]    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 equal $index "end"]} {        lappend data($parent) $node    } else {        incr index        set data($parent) [linsert $data($parent) $index $node]    }    set data($node) [list $parent]    if { [string equal $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}# ----------------------------------------------------------------------------#  Command Tree::itemconfigure# ----------------------------------------------------------------------------proc Tree::itemconfigure { path node args } {    variable $path    upvar 0  $path data    set node [_node_name $path $node]    if { [string equal $node "root"] || ![info exists data($node)] } {        return -code error "node \"$node\" does not exist"    }    set result [Widget::configure $path.$node $args]    _set_help $path $node    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 && [Widget::hasChanged $path.$node -padx x]} {	    _redraw_idle $path 3