Version 2 of Tree nodes in motion

Updated 2003-11-20 20:47:47

if 0 {Richard Suchenwirth 2003-11-19 - Here is how to move nodes on a BWidget Tree widget - basically three procs to be bound to <1>, <B1-Motion> and <ButtonRelease-1> events.

When you click on a node's text, a movable copy of the text is added on the canvas (which underlies the Tree implementation), and follows the mouse motion. When you release the mouse button on another node, the "moving" node is indeed moved to be the first child of that node (if possible - one can't reparent into a descendant of itself). }

 package require BWidget

 proc tree'mark {w x y label} {
    set text [[winfo parent $w] itemcget $label -text]
    $w create text $x $y -text $text -tag marked
    set ::g(x) $x
    set ::g(y) $y
 }

 proc tree'motion {w x y label} {
    $w move marked [expr $x-$::g(x)] [expr $y-$::g(y)]
    set ::g(x) $x
    set ::g(y) $y
 }
 proc tree'release {w x y label} {
    $w delete marked
    if [regexp n:(.+) [$w gettags [$w find closest $x $y]] -> target] {
        if {$label ne $target} {
            set tree [winfo parent $w]
            catch {
                $tree move $target $label 0
                $tree opentree $target
            }
        }
    }
 }

#----- testing demo:

 pack [Tree .t]

 .t insert 0 root node1 -text hello
 .t insert 0 root node2 -text world
 .t insert 0 root node3  -text again
 .t insert 0 node2 node4 -text fourth

 .t bindText <1>               {+ tree'mark %W %x %y}
 .t bindText <B1-Motion>       {tree'motion %W %x %y}
 .t bindText <ButtonRelease-1> {tree'release %W %x %y}

MPJ Nice. The only problem I saw was that you can not move a node to the top level.


Arts and crafts of Tcl-Tk programming