home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / tree.tcl < prev    next >
Text File  |  2000-11-02  |  48KB  |  1,362 lines
  1. # ------------------------------------------------------------------------------
  2. #  tree.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: tree.tcl,v 1.1.1.1 1996/02/22 06:05:56 daniel 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.             {-drawcross  Enum       auto    0 {auto allways never}}
  61.         }
  62.     }
  63.  
  64.     Widget::tkinclude Tree canvas :cmd \
  65.         remove     {-insertwidth -insertbackground -insertborderwidth -insertofftime \
  66.                         -insertontime -selectborderwidth -closeenough -confine -scrollregion \
  67.                         -xscrollincrement -yscrollincrement -width -height} \
  68.         initialize {-relief sunken -borderwidth 2 -takefocus 1 \
  69.                         -highlightthickness 1 -width 200}
  70.  
  71.     Widget::declare Tree {
  72.         {-deltax           Int 10 0 {=0 ""}}
  73.         {-deltay           Int 15 0 {=0 ""}}
  74.         {-padx             Int 20 0 {=0 ""}}
  75.         {-background       TkResource "" 0 listbox}
  76.         {-selectbackground TkResource "" 0 listbox}
  77.         {-selectforeground TkResource "" 0 listbox}
  78.         {-width            TkResource "" 0 listbox}
  79.         {-height           TkResource "" 0 listbox}
  80.         {-showlines        Boolean 1  0}
  81.         {-linesfill        TkResource black  0 {frame -background}}
  82.         {-linestipple      TkResource ""     0 {label -bitmap}}
  83.         {-redraw           Boolean 1  0}
  84.         {-opencmd          String  "" 0}
  85.         {-closecmd         String  "" 0}
  86.         {-dropovermode     Flag    "wpn" 0 "wpn"}
  87.         {-bg               Synonym -background}
  88.     }
  89.     DragSite::include Tree "TREE_NODE" 1
  90.     DropSite::include Tree {
  91.         TREE_NODE {copy {} move {}}
  92.     }
  93.  
  94.     Widget::addmap Tree "" :cmd {-deltay -yscrollincrement}
  95.  
  96.     proc ::Tree { path args } { return [eval Tree::create $path $args] }
  97.     proc use {} {}
  98.  
  99.     variable _edit
  100. }
  101.  
  102.  
  103. # ------------------------------------------------------------------------------
  104. #  Command Tree::create
  105. # ------------------------------------------------------------------------------
  106. proc Tree::create { path args } {
  107.     variable $path
  108.     upvar 0  $path data
  109.  
  110.     Widget::init Tree $path $args
  111.  
  112.     set data(root)         {{}}
  113.     set data(selnodes)     {}
  114.     set data(upd,level)    0
  115.     set data(upd,nodes)    {}
  116.     set data(upd,afterid)  ""
  117.     set data(dnd,scroll)   ""
  118.     set data(dnd,afterid)  ""
  119.     set data(dnd,selnodes) {}
  120.     set data(dnd,node)     ""
  121.  
  122.     set path [eval canvas $path [Widget::subcget $path :cmd] \
  123.                   -width  [expr {[Widget::getoption $path -width]*8}] \
  124.                   -height [expr {[Widget::getoption $path -height]*[Widget::getoption $path -deltay]}] \
  125.                   -xscrollincrement 8]
  126.  
  127.     $path bind cross <ButtonPress-1> {Tree::_cross_event %W}
  128.     bind $path <Configure> "Tree::_update_scrollregion $path"
  129.     bind $path <Destroy>   "Tree::_destroy $path"
  130.  
  131.     DragSite::setdrag $path $path Tree::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1
  132.     DropSite::setdrop $path $path Tree::_over_cmd Tree::_drop_cmd 1
  133.  
  134.     rename $path ::$path:cmd
  135.     proc ::$path { cmd args } "return \[eval Tree::\$cmd $path \$args\]"
  136.  
  137.     return $path
  138. }
  139.  
  140.  
  141. # ------------------------------------------------------------------------------
  142. #  Command Tree::configure
  143. # ------------------------------------------------------------------------------
  144. proc Tree::configure { path args } {
  145.     variable $path
  146.     upvar 0  $path data
  147.  
  148.     set res [Widget::configure $path $args]
  149.  
  150.     set ch1 [expr {[Widget::hasChanged $path -deltax val] |
  151.                    [Widget::hasChanged $path -deltay dy]  |
  152.                    [Widget::hasChanged $path -padx val]   |
  153.                    [Widget::hasChanged $path -showlines val]}]
  154.  
  155.     set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
  156.                    [Widget::hasChanged $path -selectforeground val]}]
  157.  
  158.     if { [Widget::hasChanged $path -linesfill   fill] |
  159.          [Widget::hasChanged $path -linestipple stipple] } {
  160.         $path:cmd itemconfigure line  -fill $fill -stipple $stipple
  161.         $path:cmd itemconfigure cross -foreground $fill
  162.     }
  163.  
  164.     if { $ch1 } {
  165.         _redraw_idle $path 3
  166.     } elseif { $ch2 } {
  167.         _redraw_idle $path 1
  168.     }
  169.  
  170.     if { [Widget::hasChanged $path -height h] } {
  171.         $path:cmd configure -height [expr {$h*$dy}]
  172.     }
  173.     if { [Widget::hasChanged $path -width w] } {
  174.         $path:cmd configure -width [expr {$w*8}]
  175.     }
  176.  
  177.     if { [Widget::hasChanged $path -redraw bool] && $bool } {
  178.         set upd $data(upd,level)
  179.         set data(upd,level) 0
  180.         _redraw_idle $path $upd
  181.     }
  182.  
  183.     set force [Widget::hasChanged $path -dragendcmd dragend]
  184.     DragSite::setdrag $path $path Tree::_init_drag_cmd $dragend $force
  185.     DropSite::setdrop $path $path Tree::_over_cmd Tree::_drop_cmd
  186.  
  187.     return $res
  188. }
  189.  
  190.  
  191. # ------------------------------------------------------------------------------
  192. #  Command Tree::cget
  193. # ------------------------------------------------------------------------------
  194. proc Tree::cget { path option } {
  195.     return [Widget::cget $path $option]
  196. }
  197.  
  198.  
  199. # ------------------------------------------------------------------------------
  200. #  Command Tree::insert
  201. # ------------------------------------------------------------------------------
  202. proc Tree::insert { path index parent node args } {
  203.     variable $path
  204.     upvar 0  $path data
  205.  
  206.     if { [info exists data($node)] } {
  207.         return -code error "node \"$node\" already exists"
  208.     }
  209.     if { ![info exists data($parent)] } {
  210.         return -code error "node \"$parent\" does not exist"
  211.     }
  212.  
  213.     Widget::init Tree::Node $path.$node $args
  214.     if { ![string compare $index "end"] } {
  215.         lappend data($parent) $node
  216.     } else {
  217.         incr index
  218.         set data($parent) [linsert $data($parent) $index $node]
  219.     }
  220.     set data($node) [list $parent]
  221.  
  222.     if { ![string compare $parent "root"] } {
  223.         _redraw_idle $path 3
  224.     } elseif { [visible $path $parent] } {
  225.         # parent is visible...
  226.         if { [Widget::getoption $path.$parent -open] } {
  227.             # ...and opened -> redraw whole
  228.             _redraw_idle $path 3
  229.         } else {
  230.             # ...and closed -> redraw cross
  231.             lappend data(upd,nodes) $parent 8
  232.             _redraw_idle $path 2
  233.         }
  234.     }
  235.     return $node
  236. }
  237.  
  238.  
  239. # ------------------------------------------------------------------------------
  240. #  Command Tree::itemconfigure
  241. # ------------------------------------------------------------------------------
  242. proc Tree::itemconfigure { path node args } {
  243.     variable $path
  244.     upvar 0  $path data
  245.  
  246.     if { ![string compare $node "root"] || ![info exists data($node)] } {
  247.         return -code error "node \"$node\" does not exist"
  248.     }
  249.  
  250.     set result [Widget::configure $path.$node $args]
  251.     if { [visible $path $node] } {
  252.         set lopt   {}
  253.         set flag   0
  254.         foreach opt {-window -image -drawcross -font -text -fill} {
  255.             set flag [expr {$flag << 1}]
  256.             if { [Widget::hasChanged $path.$node $opt val] } {
  257.                 set flag [expr {$flag | 1}]
  258.             }
  259.         }
  260.  
  261.         if { [Widget::hasChanged $path.$node -open val] } {
  262.             _redraw_idle $path 3
  263.         } elseif { $data(upd,level) < 3 && $flag } {
  264.             if { [set idx [lsearch $data(upd,nodes) $node]] == -1 } {
  265.                 lappend data(upd,nodes) $node $flag
  266.             } else {
  267.                 incr idx
  268.                 set flag [expr {[lindex $data(upd,nodes) $idx] | $flag}]
  269.                 set data(upd,nodes) [lreplace $data(upd,nodes) $idx $idx $flag]
  270.             }
  271.             _redraw_idle $path 2
  272.         }
  273.     }
  274.     return $result
  275. }
  276.  
  277.  
  278. # ------------------------------------------------------------------------------
  279. #  Command Tree::itemcget
  280. # ------------------------------------------------------------------------------
  281. proc Tree::itemcget { path node option } {
  282.     variable $path
  283.     upvar 0  $path data
  284.  
  285.     if { ![string compare $node "root"] || ![info exists data($node)] } {
  286.         return -code error "node \"$node\" does not exist"
  287.     }
  288.  
  289.     return [Widget::cget $path.$node $option]
  290. }
  291.  
  292.  
  293. # ------------------------------------------------------------------------------
  294. #  Command Tree::bindText
  295. # ------------------------------------------------------------------------------
  296. proc Tree::bindText { path event script } {
  297.     if { $script != "" } {
  298.         $path:cmd bind "node" $event \
  299.             "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
  300.     } else {
  301.         $path:cmd bind "node" $event {}
  302.     }
  303. }
  304.  
  305.  
  306. # ------------------------------------------------------------------------------
  307. #  Command Tree::bindImage
  308. # ------------------------------------------------------------------------------
  309. proc Tree::bindImage { path event script } {
  310.     if { $script != "" } {
  311.         $path:cmd bind "img" $event \
  312.             "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
  313.     } else {
  314.         $path:cmd bind "img" $event {}
  315.     }
  316. }
  317.  
  318.  
  319. # ------------------------------------------------------------------------------
  320. #  Command Tree::delete
  321. # ------------------------------------------------------------------------------
  322. proc Tree::delete { path args } {
  323.     variable $path
  324.     upvar 0  $path data
  325.  
  326.     foreach lnodes $args {
  327.         foreach node $lnodes {
  328.             if { [string compare $node "root"] && [info exists data($node)] } {
  329.                 set parent [lindex $data($node) 0]
  330.                 set idx    [lsearch $data($parent) $node]
  331.                 set data($parent) [lreplace $data($parent) $idx $idx]
  332.                 _subdelete $path $node
  333.             }
  334.         }
  335.     }
  336.  
  337.     set sel $data(selnodes)
  338.     set data(selnodes) {}
  339.     eval selection $path set $sel
  340.     _redraw_idle $path 3
  341. }
  342.  
  343.  
  344. # ------------------------------------------------------------------------------
  345. #  Command Tree::move
  346. # ------------------------------------------------------------------------------
  347. proc Tree::move { path parent node index } {
  348.     variable $path
  349.     upvar 0  $path data
  350.  
  351.     if { ![string compare $node "root"] || ![info exists data($node)] } {
  352.         return -code error "node \"$node\" does not exist"
  353.     }
  354.     if { ![info exists data($parent)] } {
  355.         return -code error "node \"$parent\" does not exist"
  356.     }
  357.     set p $parent
  358.     while { [string compare $p "root"] } {
  359.         if { ![string compare $p $node] } {
  360.             return -code error "node \"$parent\" is a descendant of \"$node\""
  361.         }
  362.         set p [parent $path $p]
  363.     }
  364.  
  365.     set oldp        [lindex $data($node) 0]
  366.     set idx         [lsearch $data($oldp) $node]
  367.     set data($oldp) [lreplace $data($oldp) $idx $idx]
  368.     set data($node) [concat [list $parent] [lrange $data($node) 1 end]]
  369.     if { ![string compare $index "end"] } {
  370.         lappend data($parent) $node
  371.     } else {
  372.         incr index
  373.         set data($parent) [linsert $data($parent) $index $node]
  374.     }
  375.     if { ([visible $path $oldp]   && [Widget::getoption $path.$oldp   -open]) ||
  376.          ([visible $path $parent] && [Widget::getoption $path.$parent -open]) } {
  377.         _redraw_idle $path 3
  378.     }
  379. }
  380.  
  381.  
  382. # ------------------------------------------------------------------------------
  383. #  Command Tree::reorder
  384. # ------------------------------------------------------------------------------
  385. proc Tree::reorder { path node neworder } {
  386.     variable $path
  387.     upvar 0  $path data
  388.  
  389.     if { ![info exists data($node)] } {
  390.         return -code error "node \"$node\" does not exist"
  391.     }
  392.     set children [lrange $data($node) 1 end]
  393.     if { [llength $children] } {
  394.         set children [BWidget::lreorder $children $neworder]
  395.         set data($node) [linsert $children 0 [lindex $data($node) 0]]
  396.         if { [visible $path $node] && [Widget::getoption $path.$node -open] } {
  397.             _redraw_idle $path 3
  398.         }
  399.     }
  400. }
  401.  
  402.  
  403. # ------------------------------------------------------------------------------
  404. #  Command Tree::selection
  405. # ------------------------------------------------------------------------------
  406. proc Tree::selection { path cmd args } {
  407.     variable $path
  408.     upvar 0  $path data
  409.  
  410.     switch -- $cmd {
  411.         set {
  412.             set data(selnodes) {}
  413.             foreach node $args {
  414.                 if { [info exists data($node)] } {
  415.                     if { [lsearch $data(selnodes) $node] == -1 } {
  416.                         lappend data(selnodes) $node
  417.                     }
  418.                 }
  419.             }
  420.         }
  421.         add {
  422.             foreach node $args {
  423.                 if { [info exists data($node)] } {
  424.                     if { [lsearch $data(selnodes) $node] == -1 } {
  425.                         lappend data(selnodes) $node
  426.                     }
  427.                 }
  428.             }
  429.         }
  430.         remove {
  431.             foreach node $args {
  432.                 if { [set idx [lsearch $data(selnodes) $node]] != -1 } {
  433.                     set data(selnodes) [lreplace $data(selnodes) $idx $idx]
  434.                 }
  435.             }
  436.         }
  437.         clear {
  438.             set data(selnodes) {}
  439.         }
  440.         get {
  441.             return $data(selnodes)
  442.         }
  443.         default {
  444.             return
  445.         }
  446.     }
  447.     _redraw_idle $path 1
  448. }
  449.  
  450.  
  451. # ------------------------------------------------------------------------------
  452. #  Command Tree::exists
  453. # ------------------------------------------------------------------------------
  454. proc Tree::exists { path node } {
  455.     variable $path
  456.     upvar 0  $path data
  457.  
  458.     return [info exists data($node)]
  459. }
  460.  
  461.  
  462. # ------------------------------------------------------------------------------
  463. #  Command Tree::visible
  464. # ------------------------------------------------------------------------------
  465. proc Tree::visible { path node } {
  466.     set idn [$path:cmd find withtag n:$node]
  467.     return [llength $idn]
  468. }
  469.  
  470.  
  471. # ------------------------------------------------------------------------------
  472. #  Command Tree::parent
  473. # ------------------------------------------------------------------------------
  474. proc Tree::parent { path node } {
  475.     variable $path
  476.     upvar 0  $path data
  477.  
  478.     if { ![info exists data($node)] } {
  479.         return -code error "node \"$node\" does not exist"
  480.     }
  481.     return [lindex $data($node) 0]
  482. }
  483.  
  484.  
  485. # ------------------------------------------------------------------------------
  486. #  Command Tree::index
  487. # ------------------------------------------------------------------------------
  488. proc Tree::index { path node } {
  489.     variable $path
  490.     upvar 0  $path data
  491.  
  492.     if { ![string compare $node "root"] || ![info exists data($node)] } {
  493.         return -code error "node \"$node\" does not exist"
  494.     }
  495.     set parent [lindex $data($node) 0]
  496.     return [expr {[lsearch $data($parent) $node] - 1}]
  497. }
  498.  
  499.  
  500. # ------------------------------------------------------------------------------
  501. #  Command Tree::nodes
  502. # ------------------------------------------------------------------------------
  503. proc Tree::nodes { path node } {
  504.     variable $path
  505.     upvar 0  $path data
  506.  
  507.     if { ![info exists data($node)] } {
  508.         return -code error "node \"$node\" does not exist"
  509.     }
  510.     return [lrange $data($node) 1 end]
  511. }
  512.  
  513.  
  514. # ------------------------------------------------------------------------------
  515. #  Command Tree::see
  516. # ------------------------------------------------------------------------------
  517. proc Tree::see { path node } {
  518.     set idn [$path:cmd find withtag n:$node]
  519.     if { $idn != "" } {
  520.         Tree::_see $path $idn left
  521.     }
  522. }
  523.  
  524.  
  525. # ------------------------------------------------------------------------------
  526. #  Command Tree::opentree
  527. # ------------------------------------------------------------------------------
  528. proc Tree::opentree { path node } {
  529.     variable $path
  530.     upvar 0  $path data
  531.  
  532.     if { ![string compare $node "root"] || ![info exists data($node)] } {
  533.         return -code error "node \"$node\" does not exist"
  534.     }
  535.  
  536.     _recexpand $path $node 1 [Widget::getoption $path -opencmd]
  537.     _redraw_idle $path 3
  538. }
  539.  
  540.  
  541. # ------------------------------------------------------------------------------
  542. #  Command Tree::closetree
  543. # ------------------------------------------------------------------------------
  544. proc Tree::closetree { path node } {
  545.     variable $path
  546.     upvar 0  $path data
  547.  
  548.     if { ![string compare $node "root"] || ![info exists data($node)] } {
  549.         return -code error "node \"$node\" does not exist"
  550.     }
  551.  
  552.     _recexpand $path $node 0 [Widget::getoption $path -closecmd]
  553.     _redraw_idle $path 3
  554. }
  555.  
  556.  
  557. # ------------------------------------------------------------------------------
  558. #  Command Tree::edit
  559. # ------------------------------------------------------------------------------
  560. proc Tree::edit { path node text {verifycmd ""} {clickres 0} {select 1}} {
  561.     variable _edit
  562.  
  563.     set idn [$path:cmd find withtag n:$node]
  564.     if { $idn != "" } {
  565.         Tree::_see $path $idn right
  566.         Tree::_see $path $idn left
  567.  
  568.         set oldfg  [$path:cmd itemcget $idn -fill]
  569.         set sbg    [Widget::getoption $path -selectbackground]
  570.         set coords [$path:cmd coords $idn]
  571.         set x      [lindex $coords 0]
  572.         set y      [lindex $coords 1]
  573.         set bd     [expr {[$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness]}]
  574.         set w      [expr {[winfo width $path] - 2*$bd}]
  575.         set wmax   [expr {[$path:cmd canvasx $w]-$x}]
  576.  
  577.         set _edit(text) $text
  578.         set _edit(wait) 0
  579.  
  580.         $path:cmd itemconfigure $idn    -fill [Widget::getoption $path -background]
  581.         $path:cmd itemconfigure s:$node -fill {} -outline {}
  582.  
  583.         set frame  [frame $path.edit \
  584.                         -relief flat -borderwidth 0 -highlightthickness 0 \
  585.                         -background [Widget::getoption $path -background]]
  586.         set ent    [entry $frame.edit \
  587.                         -width              0     \
  588.                         -relief             solid \
  589.                         -borderwidth        1     \
  590.                         -highlightthickness 0     \
  591.                         -foreground         [Widget::getoption $path.$node -fill] \
  592.                         -background         [Widget::getoption $path -background] \
  593.                         -selectforeground   [Widget::getoption $path -selectforeground] \
  594.                         -selectbackground   $sbg  \
  595.                         -font               [Widget::getoption $path.$node -font] \
  596.                         -textvariable       Tree::_edit(text)]
  597.         pack $ent -ipadx 8 -anchor w
  598.  
  599.         set idw [$path:cmd create window $x $y -window $frame -anchor w]
  600.         trace variable Tree::_edit(text) w "Tree::_update_edit_size $path $ent $idw $wmax"
  601.         tkwait visibility $ent
  602.         grab  $frame
  603.         BWidget::focus set $ent
  604.  
  605.         _update_edit_size $path $ent $idw $wmax
  606.         update
  607.         if { $select } {
  608.             $ent selection from 0
  609.             $ent selection to   end
  610.             $ent icursor end
  611.             $ent xview end
  612.         }
  613.  
  614.         bind $ent <Escape> {set Tree::_edit(wait) 0}
  615.         bind $ent <Return> {set Tree::_edit(wait) 1}
  616.         if { $clickres == 0 || $clickres == 1 } {
  617.             bind $frame <Button>  "set Tree::_edit(wait) $clickres"
  618.         }
  619.  
  620.         set ok 0
  621.         while { !$ok } {
  622.             tkwait variable Tree::_edit(wait)
  623.             if { !$_edit(wait) || $verifycmd == "" ||
  624.                  [uplevel \#0 $verifycmd [list $_edit(text)]] } {
  625.                 set ok 1
  626.             }
  627.         }
  628.  
  629.         trace vdelete Tree::_edit(text) w "Tree::_update_edit_size $path $ent $idw $wmax"
  630.         grab release $frame
  631.         BWidget::focus release $ent
  632.         destroy $frame
  633.         $path:cmd delete $idw
  634.         $path:cmd itemconfigure $idn    -fill $oldfg
  635.         $path:cmd itemconfigure s:$node -fill $sbg -outline $sbg
  636.  
  637.         if { $_edit(wait) } {
  638.             return $_edit(text)
  639.         }
  640.     }
  641.     return ""
  642. }
  643.  
  644.  
  645. # ------------------------------------------------------------------------------
  646. #  Command Tree::xview
  647. # ------------------------------------------------------------------------------
  648. proc Tree::xview { path args } {
  649.     return [eval $path:cmd xview $args]
  650. }
  651.  
  652.  
  653. # ------------------------------------------------------------------------------
  654. #  Command Tree::yview
  655. # ------------------------------------------------------------------------------
  656. proc Tree::yview { path args } {
  657.     return [eval $path:cmd yview $args]
  658. }
  659.  
  660.  
  661. # ------------------------------------------------------------------------------
  662. #  Command Tree::_update_edit_size
  663. # ------------------------------------------------------------------------------
  664. proc Tree::_update_edit_size { path entry idw wmax args } {
  665.     set entw [winfo reqwidth $entry]
  666.     if { $entw+8 >= $wmax } {
  667.         $path:cmd itemconfigure $idw -width $wmax
  668.     } else {
  669.         $path:cmd itemconfigure $idw -width 0
  670.     }
  671. }
  672.  
  673.  
  674. # ------------------------------------------------------------------------------
  675. #  Command Tree::_destroy
  676. # ------------------------------------------------------------------------------
  677. proc Tree::_destroy { path } {
  678.     variable $path
  679.     upvar 0  $path data
  680.  
  681.     if { $data(upd,afterid) != "" } {
  682.         after cancel $data(upd,afterid)
  683.     }
  684.     if { $data(dnd,afterid) != "" } {
  685.         after cancel $data(dnd,afterid)
  686.     }
  687.     foreach node [lrange $data(root) 1 end] {
  688.         _subdelete $path $node
  689.     }
  690.     Widget::destroy $path
  691.     unset data
  692.     rename $path {}
  693. }
  694.  
  695.  
  696. # ------------------------------------------------------------------------------
  697. #  Command Tree::_see
  698. # ------------------------------------------------------------------------------
  699. proc Tree::_see { path idn side } {
  700.     set bbox [$path:cmd bbox $idn]
  701.     set scrl [$path:cmd cget -scrollregion]
  702.  
  703.     set ymax [lindex $scrl 3]
  704.     set dy   [$path:cmd cget -yscrollincrement]
  705.     set yv   [$path yview]
  706.     set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]
  707.     set yv1  [expr {round([lindex $yv 1]*$ymax/$dy)}]
  708.     set y    [expr {int([lindex [$path:cmd coords $idn] 1]/$dy)}]
  709.     if { $y < $yv0 } {
  710.         $path:cmd yview scroll [expr {$y-$yv0}] units
  711.     } elseif { $y >= $yv1 } {
  712.         $path:cmd yview scroll [expr {$y-$yv1+1}] units
  713.     }
  714.  
  715.     set xmax [lindex $scrl 2]
  716.     set dx   [$path:cmd cget -xscrollincrement]
  717.     set xv   [$path xview]
  718.     if { ![string compare $side "right"] } {
  719.         set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}]
  720.         set x1  [expr {int([lindex $bbox 2]/$dx)}]
  721.         if { $x1 >= $xv1 } {
  722.             $path:cmd xview scroll [expr {$x1-$xv1+1}] units
  723.         }
  724.     } else {
  725.         set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}]
  726.         set x0  [expr {int([lindex $bbox 0]/$dx)}]
  727.         if { $x0 < $xv0 } {
  728.             $path:cmd xview scroll [expr {$x0-$xv0}] units
  729.         }
  730.     }
  731. }
  732.  
  733.  
  734. # ------------------------------------------------------------------------------
  735. #  Command Tree::_recexpand
  736. # ------------------------------------------------------------------------------
  737. proc Tree::_recexpand { path node expand cmd } {
  738.     variable $path
  739.     upvar 0  $path data
  740.  
  741.     if { [Widget::getoption $path.$node -open] != $expand } {
  742.         Widget::setoption $path.$node -open $expand
  743.         if { $cmd != "" } {
  744.             uplevel \#0 $cmd $node
  745.         }
  746.     }
  747.  
  748.     foreach subnode [lrange $data($node) 1 end] {
  749.         _recexpand $path $subnode $expand $cmd
  750.     }
  751. }
  752.  
  753.  
  754. # ------------------------------------------------------------------------------
  755. #  Command Tree::_subdelete
  756. # ------------------------------------------------------------------------------
  757. proc Tree::_subdelete { path node } {
  758.     variable $path
  759.     upvar 0  $path data
  760.  
  761.     foreach subnode [lrange $data($node) 1 end] {
  762.         _subdelete $path $subnode
  763.     }
  764.     unset data($node)
  765.     if { [set win [Widget::getoption $path.$node -window]] != "" } {
  766.         destroy $win
  767.     }
  768.     Widget::destroy $path.$node
  769. }
  770.  
  771.  
  772. # ------------------------------------------------------------------------------
  773. #  Command Tree::_update_scrollregion
  774. # ------------------------------------------------------------------------------
  775. proc Tree::_update_scrollregion { path } {
  776.     set bd   [expr {2*([$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness])}]
  777.     set w    [expr {[winfo width  $path] - $bd}]
  778.     set h    [expr {[winfo height $path] - $bd}]
  779.     set xinc [$path:cmd cget -xscrollincrement]
  780.     set yinc [$path:cmd cget -yscrollincrement]
  781.     set bbox [$path:cmd bbox all]
  782.     if { [llength $bbox] } {
  783.         set xs [lindex $bbox 2]
  784.         set ys [lindex $bbox 3]
  785.  
  786.         if { $w < $xs } {
  787.             set w [expr {int($xs)}]
  788.             if { [set r [expr {$w % $xinc}]] } {
  789.                 set w [expr {$w+$xinc-$r}]
  790.             }
  791.         }
  792.         if { $h < $ys } {
  793.             set h [expr {int($ys)}]
  794.             if { [set r [expr {$h % $yinc}]] } {
  795.                 set h [expr {$h+$yinc-$r}]
  796.             }
  797.         }
  798.     }
  799.  
  800.     $path:cmd configure -scrollregion [list 0 0 $w $h]
  801. }
  802.  
  803.  
  804. # ------------------------------------------------------------------------------
  805. #  Command Tree::_cross_event
  806. # ------------------------------------------------------------------------------
  807. proc Tree::_cross_event { path } {
  808.     variable $path
  809.     upvar 0  $path data
  810.  
  811.     set node [string range [lindex [$path:cmd gettags current] 1] 2 end]
  812.     if { [Widget::getoption $path.$node -open] } {
  813.         if { [set cmd [Widget::getoption $path -closecmd]] != "" } {
  814.             uplevel \#0 $cmd $node
  815.         }
  816.         Widget::setoption $path.$node -open 0
  817.     } else {
  818.         if { [set cmd [Widget::getoption $path -opencmd]] != "" } {
  819.             uplevel \#0 $cmd $node
  820.         }
  821.         Widget::setoption $path.$node -open 1
  822.     }
  823.     _redraw_idle $path 3
  824. }
  825.  
  826.  
  827. # ------------------------------------------------------------------------------
  828. #  Command Tree::_draw_node
  829. # ------------------------------------------------------------------------------
  830. proc Tree::_draw_node { path node x0 y0 deltax deltay padx showlines } {
  831.     global   env
  832.     variable $path
  833.     upvar 0  $path data
  834.  
  835.     set x1 [expr {$x0+$deltax+5}]
  836.     set y1 $y0
  837.     if { $showlines } {
  838.         $path:cmd create line $x0 $y0 $x1 $y0 \
  839.             -fill    [Widget::getoption $path -linesfill]   \
  840.             -stipple [Widget::getoption $path -linestipple] \
  841.             -tags    line
  842.     }
  843.     $path:cmd create text [expr {$x1+$padx}] $y0 \
  844.         -text   [Widget::getoption $path.$node -text] \
  845.         -fill   [Widget::getoption $path.$node -fill] \
  846.         -font   [Widget::getoption $path.$node -font] \
  847.         -anchor w \
  848.         -tags   "node n:$node"
  849.     set len [expr {[llength $data($node)] > 1}]
  850.     set dc  [Widget::getoption $path.$node -drawcross]
  851.     set exp [Widget::getoption $path.$node -open]
  852.  
  853.     if { $len && $exp } {
  854.         set y1 [_draw_subnodes $path [lrange $data($node) 1 end] \
  855.                     [expr {$x0+$deltax}] $y0 $deltax $deltay $padx $showlines]
  856.     }
  857.  
  858.     if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
  859.         if { $exp } {
  860.             set bmp [file join $env(BWIDGET_LIBRARY) "images" "minus.xbm"]
  861.         } else {
  862.             set bmp [file join $env(BWIDGET_LIBRARY) "images" "plus.xbm"]
  863.         }
  864.         $path:cmd create bitmap $x0 $y0 \
  865.             -bitmap     @$bmp \
  866.             -background [$path:cmd cget -background] \
  867.             -foreground [Widget::getoption $path -linesfill] \
  868.             -tags       "cross c:$node" -anchor c
  869.     }
  870.  
  871.     if { [set win [Widget::getoption $path.$node -window]] != "" } {
  872.         $path:cmd create window $x1 $y0 -window $win -anchor w -tags "win i:$node"
  873.     } elseif { [set img [Widget::getoption $path.$node -image]] != "" } {
  874.         $path:cmd create image $x1 $y0 -image $img -anchor w -tags "img i:$node"
  875.     }
  876.     return $y1
  877. }
  878.  
  879.  
  880. # ------------------------------------------------------------------------------
  881. #  Command Tree::_draw_subnodes
  882. # ------------------------------------------------------------------------------
  883. proc Tree::_draw_subnodes { path nodes x0 y0 deltax deltay padx showlines } {
  884.     set y1 $y0
  885.     foreach node $nodes {
  886.         set yp $y1
  887.         set y1 [_draw_node $path $node $x0 [expr {$y1+$deltay}] $deltax $deltay $padx $showlines]
  888.     }
  889.     if { $showlines && [llength $nodes] } {
  890.         set id [$path:cmd create line $x0 $y0 $x0 [expr {$yp+$deltay}] \
  891.                     -fill    [Widget::getoption $path -linesfill]   \
  892.                     -stipple [Widget::getoption $path -linestipple] \
  893.                     -tags    line]
  894.  
  895.         $path:cmd lower $id
  896.     }
  897.     return $y1
  898. }
  899.  
  900.  
  901. # ------------------------------------------------------------------------------
  902. #  Command Tree::_update_nodes
  903. # ------------------------------------------------------------------------------
  904. proc Tree::_update_nodes { path } {
  905.     global   env
  906.     variable $path
  907.     upvar 0  $path data
  908.  
  909.     set deltax [Widget::getoption $path -deltax]
  910.     set padx   [Widget::getoption $path -padx]
  911.     foreach {node flag} $data(upd,nodes) {
  912.         set idn [$path:cmd find withtag "n:$node"]
  913.         if { $idn == "" } {
  914.             continue
  915.         }
  916.         set c  [$path:cmd coords $idn]
  917.         set x0 [expr {[lindex $c 0]-$deltax}]
  918.         set y0 [lindex $c 1]
  919.         if { $flag & 48 } {
  920.             # -window or -image modified
  921.             set win  [Widget::getoption $path.$node -window]
  922.             set img  [Widget::getoption $path.$node -image]
  923.             set idi  [$path:cmd find withtag i:$node]
  924.             set type [lindex [$path:cmd gettags $idi] 0]
  925.             if { [string length $win] } {
  926.                 if { ![string compare $type "win"] } {
  927.                     $path:cmd itemconfigure $idi -window $win
  928.                 } else {
  929.                     $path:cmd delete $idi
  930.                     $path:cmd create window $x0 $y0 -window $win -anchor w -tags "win i:$node"
  931.                 }
  932.             } elseif { [string length $img] } {
  933.                 if { ![string compare $type "img"] } {
  934.                     $path:cmd itemconfigure $idi -image $img
  935.                 } else {
  936.                     $path:cmd delete $idi
  937.                     $path:cmd create image $x0 $y0 -image $img -anchor w -tags "img i:$node"
  938.                 }
  939.             } else {
  940.                 $path:cmd delete $idi
  941.             }
  942.         }
  943.  
  944.         if { $flag & 8 } {
  945.             # -drawcross modified
  946.             set len [expr {[llength $data($node)] > 1}]
  947.             set dc  [Widget::getoption $path.$node -drawcross]
  948.             set exp [Widget::getoption $path.$node -open]
  949.             set idc [$path:cmd find withtag c:$node]
  950.  
  951.             if { [string compare $dc "never"] && ($len || ![string compare $dc "allways"]) } {
  952.                 if { $exp } {
  953.                     set bmp [file join $env(BWIDGET_LIBRARY) "images" "minus.xbm"]
  954.                 } else {
  955.                     set bmp [file join $env(BWIDGET_LIBRARY) "images" "plus.xbm"]
  956.                 }
  957.                 if { $idc == "" } {
  958.                     $path:cmd create bitmap $x0 $y0 \
  959.                         -bitmap     @$bmp \
  960.                         -background [$path:cmd cget -background] \
  961.                         -foreground [Widget::getoption $path -linesfill] \
  962.                         -tags       "cross c:$node" -anchor c
  963.                 } else {
  964.                     $path:cmd itemconfigure $idc -bitmap @$bmp
  965.                 }
  966.             } else {
  967.                 $path:cmd delete $idc
  968.             }
  969.         }
  970.  
  971.         if { $flag & 7 } {
  972.             # -font, -text or -fill modified
  973.             $path:cmd itemconfigure $idn \
  974.                 -text [Widget::getoption $path.$node -text] \
  975.                 -fill [Widget::getoption $path.$node -fill] \
  976.                 -font [Widget::getoption $path.$node -font]
  977.         }
  978.     }
  979. }
  980.  
  981.  
  982. # ------------------------------------------------------------------------------
  983. #  Command Tree::_draw_tree
  984. # ------------------------------------------------------------------------------
  985. proc Tree::_draw_tree { path } {
  986.     variable $path
  987.     upvar 0  $path data
  988.  
  989.     $path:cmd delete all
  990.     $path:cmd configure -cursor watch
  991.     _draw_subnodes $path [lrange $data(root) 1 end] 8 \
  992.         [expr {-[Widget::getoption $path -deltay]/2}] \
  993.         [Widget::getoption $path -deltax] \
  994.         [Widget::getoption $path -deltay] \
  995.         [Widget::getoption $path -padx]   \
  996.         [Widget::getoption $path -showlines]
  997.     $path:cmd configure -cursor [Widget::getoption $path -cursor]
  998. }
  999.  
  1000.  
  1001. # ------------------------------------------------------------------------------
  1002. #  Command Tree::_redraw_tree
  1003. # ------------------------------------------------------------------------------
  1004. proc Tree::_redraw_tree { path } {
  1005.     variable $path
  1006.     upvar 0  $path data
  1007.  
  1008.     if { [Widget::getoption $path -redraw] } {
  1009.         if { $data(upd,level) == 2 } {
  1010.             _update_nodes $path
  1011.         } elseif { $data(upd,level) == 3 } {
  1012.             _draw_tree $path
  1013.         }
  1014.         _redraw_selection $path
  1015.         _update_scrollregion $path
  1016.         set data(upd,nodes)   {}
  1017.         set data(upd,level)   0
  1018.         set data(upd,afterid) ""
  1019.     }
  1020. }
  1021.  
  1022.  
  1023. # ------------------------------------------------------------------------------
  1024. #  Command Tree::_redraw_selection
  1025. # ------------------------------------------------------------------------------
  1026. proc Tree::_redraw_selection { path } {
  1027.     variable $path
  1028.     upvar 0  $path data
  1029.  
  1030.     set selbg [Widget::getoption $path -selectbackground]
  1031.     set selfg [Widget::getoption $path -selectforeground]
  1032.     foreach id [$path:cmd find withtag sel] {
  1033.         set node [string range [lindex [$path:cmd gettags $id] 1] 2 end]
  1034.         $path:cmd itemconfigure "n:$node" -fill [Widget::getoption $path.$node -fill]
  1035.     }
  1036.     $path:cmd delete sel
  1037.     foreach node $data(selnodes) {
  1038.         set bbox [$path:cmd bbox "n:$node"]
  1039.         if { [llength $bbox] } {
  1040.             set id [eval $path:cmd create rectangle $bbox -fill $selbg -outline $selbg -tags [list "sel s:$node"]]
  1041.             $path:cmd itemconfigure "n:$node" -fill $selfg
  1042.             $path:cmd lower $id
  1043.         }
  1044.     }
  1045. }
  1046.  
  1047.  
  1048. # ------------------------------------------------------------------------------
  1049. #  Command Tree::_redraw_idle
  1050. # ------------------------------------------------------------------------------
  1051. proc Tree::_redraw_idle { path level } {
  1052.     variable $path
  1053.     upvar 0  $path data
  1054.  
  1055.     if { [Widget::getoption $path -redraw] && $data(upd,afterid) == "" } {
  1056.         set data(upd,afterid) [after idle Tree::_redraw_tree $path]
  1057.     }
  1058.     if { $level > $data(upd,level) } {
  1059.         set data(upd,level) $level
  1060.     }
  1061.     return ""
  1062. }
  1063.  
  1064.  
  1065. # --------------------------------------------------------------------------------------------
  1066. # Commandes pour le Drag and Drop
  1067.  
  1068.  
  1069. # ------------------------------------------------------------------------------
  1070. #  Command Tree::_init_drag_cmd
  1071. # ------------------------------------------------------------------------------
  1072. proc Tree::_init_drag_cmd { path X Y top } {
  1073.     set ltags [$path:cmd gettags current]
  1074.     set item  [lindex $ltags 0]
  1075.     if { ![string compare $item "node"] ||
  1076.          ![string compare $item "img"]  ||
  1077.          ![string compare $item "win"] } {
  1078.         set node [string range [lindex $ltags 1] 2 end]
  1079.         if { [set cmd [Widget::getoption $path -draginitcmd]] != "" } {
  1080.             return [uplevel \#0 $cmd [list $path $node $top]]
  1081.         }
  1082.         if { [set type [Widget::getoption $path -dragtype]] == "" } {
  1083.             set type "TREE_NODE"
  1084.         }
  1085.         if { [set img [Widget::getoption $path.$node -image]] != "" } {
  1086.             pack [label $top.l -image $img -padx 0 -pady 0]
  1087.         }
  1088.         return [list $type {copy move link} $node]
  1089.     }
  1090.     return {}
  1091. }
  1092.  
  1093.  
  1094. # ------------------------------------------------------------------------------
  1095. #  Command Tree::_drop_cmd
  1096. # ------------------------------------------------------------------------------
  1097. proc Tree::_drop_cmd { path source X Y op type dnddata } {
  1098.     variable $path
  1099.     upvar 0  $path data
  1100.  
  1101.     $path:cmd delete drop
  1102.     if { [string length $data(dnd,afterid)] } {
  1103.         after cancel $data(dnd,afterid)
  1104.         set data(dnd,afterid) ""
  1105.     }
  1106.     set data(dnd,scroll) ""
  1107.     if { [llength $data(dnd,node)] } {
  1108.         if { [set cmd [Widget::getoption $path -dropcmd]] != "" } {
  1109.             return [uplevel \#0 $cmd [list $path $source $data(dnd,node) $op $type $dnddata]]
  1110.         }
  1111.     }
  1112.     return 0
  1113. }
  1114.  
  1115.  
  1116. # ------------------------------------------------------------------------------
  1117. #  Command Tree::_over_cmd
  1118. # ------------------------------------------------------------------------------
  1119. proc Tree::_over_cmd { path source event X Y op type dnddata } {
  1120.     variable $path
  1121.     upvar 0  $path data
  1122.  
  1123.     if { ![string compare $event "leave"] } {
  1124.         # we leave the window tree
  1125.         $path:cmd delete drop
  1126.         if { [string length $data(dnd,afterid)] } {
  1127.             after cancel $data(dnd,afterid)
  1128.             set data(dnd,afterid) ""
  1129.         }
  1130.         set data(dnd,scroll) ""
  1131.         return 0
  1132.     }
  1133.  
  1134.     if { ![string compare $event "enter"] } {
  1135.         # we enter the window tree - dnd data initialization
  1136.         set mode [Widget::getoption $path -dropovermode]
  1137.         set data(dnd,mode) 0
  1138.         foreach c {w p n} {
  1139.             set data(dnd,mode) [expr {($data(dnd,mode) << 1) | ([string first $c $mode] != -1)}]
  1140.         }
  1141.         set bbox [$path:cmd bbox all]
  1142.         if { [llength $bbox] } {
  1143.             set data(dnd,xs) [lindex $bbox 2]
  1144.         } else {
  1145.             set data(dnd,xs) 0
  1146.         }
  1147.         set data(dnd,node) {}
  1148.     }
  1149.  
  1150.     set x [expr {$X-[winfo rootx $path]}]
  1151.     set y [expr {$Y-[winfo rooty $path]}]
  1152.     $path:cmd delete drop
  1153.     set data(dnd,node) {}
  1154.  
  1155.     # test for auto-scroll unless mode is widget only
  1156.     if { $data(dnd,mode) != 4 && [_auto_scroll $path $x $y] != "" } {
  1157.         return 2
  1158.     }
  1159.  
  1160.     if { $data(dnd,mode) & 4 } {
  1161.         # dropovermode includes widget
  1162.         set target [list widget]
  1163.         set vmode  4
  1164.     } else {
  1165.         set target [list ""]
  1166.         set vmode  0
  1167.     }
  1168.  
  1169.     set xc [$path:cmd canvasx $x]
  1170.     set xs $data(dnd,xs)
  1171.     if { $xc <= $xs } {
  1172.         set yc   [$path:cmd canvasy $y]
  1173.         set dy   [$path:cmd cget -yscrollincrement]
  1174.         set line [expr {int($yc/$dy)}]
  1175.         set xi   0
  1176.         set yi   [expr {$line*$dy}]
  1177.         set ys   [expr {$yi+$dy}]
  1178.         foreach id [$path:cmd find overlapping $xi $yi $xs $ys] {
  1179.             set ltags [$path:cmd gettags $id]
  1180.             set item  [lindex $ltags 0]
  1181.             if { ![string compare $item "node"] ||
  1182.                  ![string compare $item "img"]  ||
  1183.                  ![string compare $item "win"] } {
  1184.                 # item is the label or image/window of the node
  1185.                 set node [string range [lindex $ltags 1] 2 end]
  1186.                 set xi   [expr {[lindex [$path:cmd coords n:$node] 0]-[Widget::getoption $path -padx]}]
  1187.  
  1188.                 if { $data(dnd,mode) & 1 } {
  1189.                     # dropovermode includes node
  1190.                     lappend target $node
  1191.                     set vmode [expr {$vmode | 1}]
  1192.                 } else {
  1193.                     lappend target ""
  1194.                 }
  1195.  
  1196.                 if { $data(dnd,mode) & 2 } {
  1197.                     # dropovermode includes position
  1198.                     if { $yc >= $yi+$dy/2 } {
  1199.                         # position is after $node
  1200.                         if { [Widget::getoption $path.$node -open] &&
  1201.                              [llength $data($node)] > 1 } {
  1202.                             # $node is open and have subnodes
  1203.                             # drop position is 0 in children of $node
  1204.                             set parent $node
  1205.                             set index  0
  1206.                             set xli    [expr {$xi-5}]
  1207.                         } else {
  1208.                             # $node is not open and doesn't have subnodes
  1209.                             # drop position is after $node in children of parent of $node
  1210.                             set parent [lindex $data($node) 0]
  1211.                             set index  [lsearch $data($parent) $node]
  1212.                             set xli    [expr {$xi-[Widget::getoption $path -deltax]-5}]
  1213.                         }
  1214.                         set yl $ys
  1215.                     } else {
  1216.                         # position is before $node
  1217.                         # drop position is before $node in children of parent of $node
  1218.                         set parent [lindex $data($node) 0]
  1219.                         set index  [expr {[lsearch $data($parent) $node] - 1}]
  1220.                         set xli    [expr {$xi-[Widget::getoption $path -deltax]-5}]
  1221.                         set yl     $yi
  1222.                     }
  1223.                     lappend target [list $parent $index]
  1224.                     set vmode  [expr {$vmode | 2}]
  1225.                 } else {
  1226.                     lappend target {}
  1227.                 }
  1228.  
  1229.                 if { ($vmode & 3) == 3 } {
  1230.                     # result have both node and position
  1231.                     # we compute what is the preferred method
  1232.                     if { $yc-$yi <= 3 || $ys-$yc <= 3 } {
  1233.                         lappend target "position"
  1234.                     } else {
  1235.                         lappend target "node"
  1236.                     }
  1237.                 }
  1238.                 break
  1239.             }
  1240.         }
  1241.     }
  1242.  
  1243.     if { $vmode && [set cmd [Widget::getoption $path -dropovercmd]] != "" } {
  1244.         # user-defined dropover command
  1245.         set res     [uplevel \#0 $cmd [list $path $source $target $op $type $dnddata]]
  1246.         set code    [lindex $res 0]
  1247.         set newmode 0
  1248.         if { $code & 1 } {
  1249.             # update vmode
  1250.             set mode [lindex $res 1]
  1251.             if { ($vmode & 1) && ![string compare $mode "node"] } {
  1252.                 set newmode 1
  1253.             } elseif { ($vmode & 2) && ![string compare $mode "position"] } {
  1254.                 set newmode 2
  1255.             } elseif { ($vmode & 4) && ![string compare $mode "widget"] } {
  1256.                 set newmode 4
  1257.             }
  1258.         }
  1259.         set vmode $newmode
  1260.     } else {
  1261.         if { ($vmode & 3) == 3 } {
  1262.             # result have both item and position
  1263.             # we choose the preferred method
  1264.             if { ![string compare [lindex $target 3] "position"] } {
  1265.                 set vmode [expr {$vmode & ~1}]
  1266.             } else {
  1267.                 set vmode [expr {$vmode & ~2}]
  1268.             }
  1269.         }
  1270.  
  1271.         if { $data(dnd,mode) == 4 || $data(dnd,mode) == 0 } {
  1272.             # dropovermode is widget or empty - recall is not necessary
  1273.             set code 1
  1274.         } else {
  1275.             set code 3
  1276.         }
  1277.     }
  1278.  
  1279.     # draw dnd visual following vmode
  1280.     if { $vmode & 1 } {
  1281.         set data(dnd,node) [list "node" [lindex $target 1]]
  1282.         $path:cmd create rectangle $xi $yi $xs $ys -tags drop
  1283.     } elseif { $vmode & 2 } {
  1284.         set data(dnd,node) [concat "position" [lindex $target 2]]
  1285.         $path:cmd create line $xli [expr {$yl-$dy/2}] $xli $yl $xs $yl -tags drop
  1286.     } elseif { $vmode & 4 } {
  1287.         set data(dnd,node) [list "widget"]
  1288.     } else {
  1289.         set code [expr {$code & 2}]
  1290.     }
  1291.  
  1292.     if { $code & 1 } {
  1293.         DropSite::setcursor based_arrow_down
  1294.     } else {
  1295.         DropSite::setcursor dot
  1296.     }
  1297.     return $code
  1298. }
  1299.  
  1300.  
  1301. # ------------------------------------------------------------------------------
  1302. #  Command Tree::_auto_scroll
  1303. # ------------------------------------------------------------------------------
  1304. proc Tree::_auto_scroll { path x y } {
  1305.     variable $path
  1306.     upvar 0  $path data
  1307.  
  1308.     set xmax   [winfo width  $path]
  1309.     set ymax   [winfo height $path]
  1310.     set scroll {}
  1311.     if { $y <= 6 } {
  1312.         if { [lindex [$path:cmd yview] 0] > 0 } {
  1313.             set scroll [list yview -1]
  1314.             DropSite::setcursor sb_up_arrow
  1315.         }
  1316.     } elseif { $y >= $ymax-6 } {
  1317.         if { [lindex [$path:cmd yview] 1] < 1 } {
  1318.             set scroll [list yview 1]
  1319.             DropSite::setcursor sb_down_arrow
  1320.         }
  1321.     } elseif { $x <= 6 } {
  1322.         if { [lindex [$path:cmd xview] 0] > 0 } {
  1323.             set scroll [list xview -1]
  1324.             DropSite::setcursor sb_left_arrow
  1325.         }
  1326.     } elseif { $x >= $xmax-6 } {
  1327.         if { [lindex [$path:cmd xview] 1] < 1 } {
  1328.             set scroll [list xview 1]
  1329.             DropSite::setcursor sb_right_arrow
  1330.         }
  1331.     }
  1332.  
  1333.     if { [string length $data(dnd,afterid)] && [string compare $data(dnd,scroll) $scroll] } {
  1334.         after cancel $data(dnd,afterid)
  1335.         set data(dnd,afterid) ""
  1336.     }
  1337.  
  1338.     set data(dnd,scroll) $scroll
  1339.     if { [string length $scroll] && ![string length $data(dnd,afterid)] } {
  1340.         set data(dnd,afterid) [after 200 Tree::_scroll $path $scroll]
  1341.     }
  1342.     return $data(dnd,afterid)
  1343. }
  1344.  
  1345.  
  1346. # ------------------------------------------------------------------------------
  1347. #  Command Tree::_scroll
  1348. # ------------------------------------------------------------------------------
  1349. proc Tree::_scroll { path cmd dir } {
  1350.     variable $path
  1351.     upvar 0  $path data
  1352.  
  1353.     if { ($dir == -1 && [lindex [$path:cmd $cmd] 0] > 0) ||
  1354.          ($dir == 1  && [lindex [$path:cmd $cmd] 1] < 1) } {
  1355.         $path:cmd $cmd scroll $dir units
  1356.         set data(dnd,afterid) [after 100 Tree::_scroll $path $cmd $dir]
  1357.     } else {
  1358.         set data(dnd,afterid) ""
  1359.         DropSite::setcursor dot
  1360.     }
  1361. }
  1362.