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