Droptree -Enhanced BWidget Tree Operations

 #---------------
 # DropTree.tcl
 #---------------
 # William J. Giddings, The Flying Facet Animation Company, 2003
 #
 #
 # This pack provides supportive element manipulation functions for the BWidget tree widget.
 # Developed from orginal code supplied by Richard Suchenwirth, Tickler's Wiki.
 #
 # NB: The widget definition allows for data to be associated with the node.  
 # This entry is used to save text data for inclusion in the notions editor.
 # 
 # Additional Functions
 #---------------
 # Persistence, enable tree nodes to be saved and loaded.
 #
 # Interactive Use:
 #---------------
 # Click on entry label/image and drag to new location, release over:
 # New Image, move to new location.
 # New Label, make subordinate
 # Any other, move to bottom of the list.

 # package wide
 # counters
 # ::$path.tnodes  ;# total number of lines
 #---------------

 package require BWidget
 package provide DropTree 1.0

 # set debugging options
 set DEBUG false 
 if {$DEBUG} { catch {console show}  }


 namespace eval DropTree {

        set lastnode "0"
        set lastfont ""

        #set fontstyle ""
        set dragimage ""
        set lastimage ""
        set image ""
        set g(x) ""
        set g(y) ""
        set current 1
        set path ""
        set cmd ""
        set pick ""


 }

 #---------------
 # Debugg assist proc
 # cp = calling proceedure
 #---------------
 proc DropTree::debug { {cp {?}} } {

  if {![winfo exists .debug]} {
    toplevel .debug
    pack [text .debug.txt -font {Arial 10}] -fill both -expand yes
  }

  append str "PROC\t\t$cp\n"
  
  # append test vars as required 
  set lst  "
    DropTree::pick
    DropTree::current 
    DropTree::lastnode
    DropTree::path
    ::$DropTree::path.tnodes 
    ::$DropTree::path.pick   
    "
  foreach v  $lst  {
     append str "variable:\t\t$v\n"
     append str "content:\t\t[set $v]\n" 
  }
  .debug.txt delete 1.0 end
  .debug.txt insert end $str
 }

 #---------------
 #
 #---------------
 proc ttdblock { {i ""} {str NEW} } {
        if {$i != "" } { set str "$i $str" }
        return "\
                # page styles
                # paragraph styles
                # character base styles
                ttd.tagdef Monospace -font {-family $notions::mono -size 9}
                ttd.tagdef Heading_1 -font {-family $notions::display -size 14 -weight bold}
                ttd.tagdef Heading_2 -font {-family $notions::display -size 14 -weight bold}
                ttd.tagdef Heading_3 -font {-family $notions::display -size 12 -weight bold -slant italic}
                ttd.tagdef Heading_4 -font {-family $notions::display -size 12 -weight bold -slant italic}                
                ttd.tagdef Default -font {-family $notions::basefont -size 12}
                ttd.tagdef Quote -font {-family $notions::basefont -size 10}
                ttd.tagdef Itrans -font {-family {URW Palladio IT} -size 10}
                ttd.tagdef Devanagri -font {-family {Sanskrit 99} -size 16}
                
                ttd.imgdef img_separator \
                                -data R0lGODlh9AEMAPcAAAAAAAEBAQICAgMDAwQEBAUFBQYGBgcHBwgICAkJCQoKCgsLCwwMDA0NDQ4ODg8PDxAQEBERERISEhMTExQUFBUVFRYWFhcXFxgYGBkZGRoaGhsbGxwcHB0dHR4eHh8fHyAgICEhISIiIiMjIyQkJCUlJSYmJicnJygoKCkpKSoqKisrKywsLC0tLS4uLi8vLzAwMDExMTIyMjMzMzQ0NDU1NTY2Njc3Nzg4ODk5OTo6Ojs7Ozw8PD09PT4+Pj8/P0BAQEFBQUJCQkNDQ0REREVFRUZGRkdHR0hISElJSUpKSktLS0xMTE1NTU5OTk9PT1BQUFFRUVJSUlNTU1RUVFVVVVZWVldXV1hYWFlZWVpaWltbW1xcXF1dXV5eXl9fX2BgYGFhYWJiYmNjY2RkZGVlZWZmZmdnZ2hoaGlpaWpqamtra2xsbG1tbW5ubm9vb3BwcHFxcXJycnNzc3R0dHV1dXZ2dnd3d3h4eHl5eXp6ent7e3x8fH19fX5+fn9/f4CAgIGBgYKCgoODg4SEhIWFhYaGhoeHh4iIiImJiYqKiouLi4yMjI2NjY6Ojo+Pj5CQkJGRkZKSkpOTk5SUlJWVlZaWlpeXl5iYmJmZmZqampubm5ycnJ2dnZ6enp+fn6CgoKGhoaKioqOjo6SkpKWlpaampqenp6ioqKmpqaqqqqurq6ysrK2tra6urq+vr7CwsLGxsbKysrOzs7S0tLW1tba2tre3t7i4uLm5ubq6uru7u7y8vL29vb6+vr+/v8DAwMHBwcLCwsPDw8TExMXFxcbGxsfHx8jIyMnJycrKysvLy8zMzM3Nzc7Ozs/Pz9DQ0NHR0dLS0tPT09TU1NXV1dbW1tfX19jY2NnZ2dra2tvb29zc3N3d3d7e3t/f3+Dg4OHh4eLi4uPj4+Tk5OXl5ebm5ufn5+jo6Onp6erq6uvr6+zs7O3t7e7u7u/v7/Dw8PHx8fLy8vPz8/T09PX19fb29vf39/j4+Pn5+fr6+vv7+/z8/P39/f7+/v///ywAAAAA9AEMAAAIwAD/CRxIsKDBgwgTKlzIsKHDhxAjSpxIsaLFixgzatzIsaPHjyBDihxJsqTJkyhTqlzJsqXLlzBjypxJs6bNmzhz6tzJs6fPn0CDCh1KtKjRiK8iKV3KtKnTp1CjSp1KtarVq1izat3KtavXr2DDih1LtqzZsuEIrhvHtq3bt3Djyp1Lt67du3jz6t3Lt6/fv4ADCx5MuLDhw4gP3zvKuLHjx5AjS55MubLly5gza97MubPnz6BDix5NurTp0yUDAgA7
                        
                
                ttd.tagon Default
                ttd.tagon Heading_1
                ttd.text \{$str\n\}
                ttd.image -align center -padx 0 -pady 0 -image img_separator
                ttd.text \{\n\}
                ttd.tagoff Heading_1
                ttd.tagoff Default
                "
        
 ################################################################################
 #         return "\
 #                 # -*- tcl -*- #
 #                 ttd.version 1.0
 #                 ttd.tagdef document -font {-family Helvetica -size 10}
 #                 ttd.tagdef body -font {-size 10} -lmargin1 20 -lmargin2 20
 #                 ttd.tagdef header -background lightgray -borderwidth 2 -font {-weight bold} -foreground darkgreen -relief raised
 #                 ttd.tagon document
 #                 ttd.tagon header
 #                 ttd.text \{$str\}
 #                 ttd.tagoff header
 #                 ttd.tagon body
 #                 ttd.text \{\n\nType here..\}
 #                 ttd.tagoff body
 #                 ttd.tagoff document"
 ################################################################################
 }


 #---------------
 #
 #---------------
 proc DropTree::motion {w x y label} {

        if {[$w gettags marked] == ""} {
                set DropTree::image [[winfo parent $w] itemcget $label -image]
                $w create image [expr $x+18] [expr $y +15] -image $DropTree::image -tag marked
        } else {
            $w move marked [expr $x-$DropTree::g(x)] [expr $y-$DropTree::g(y)]
        }

  set DropTree::g(x) $x
        set DropTree::g(y) $y

        #always restore lastnode settings
        if {[regexp i: $DropTree::lastnode]} {
                $w itemconfigure $DropTree::lastnode -image $DropTree::lastimage
        } elseif  [regexp n: $DropTree::lastnode] {
                $w itemconfigure $DropTree::lastnode -font $DropTree::lastfont 
        }

        set c [$w gettags [$w find closest $x $y]]

        foreach i $c {
                if {[regexp i: $i]} {
                        set DropTree::lastimage [$w itemcget $i -image]
                        #draw a shaded, bounding box around image and text
                        foreach {x1 y1 x2 y2} [$w bbox $i] {}
                        $w delete CURSOR
                        $w create rectangle 0 [expr $y1-2] [winfo width $w] $y2 -tag CURSOR -fill gray95 -outline black ;# -fill pink
                        $w lower CURSOR
                        set DropTree::lastnode $i
                } elseif  [regexp n: $i] {
                        $w delete CURSOR
                        set DropTree::lastfont [$w itemcget $i -font]
                        $w itemconfigure $i -font "[font configure $DropTree::lastfont] -weight bold -underline 1"
                        set DropTree::lastnode $i
                }
        }
 }

 #---------------
 #
 #---------------
 proc DropTree::release {w x y label} {

  $w delete marked
        set path [winfo parent $w]
        #is it text?
    if [regexp n:(.+) [$w gettags [$w find closest $x $y]] -> target] {
                if {$label ne $target} {
                        catch {
                                #make sub-ordinate to target
                                $path move $target $label 0
                                $path opentree $target
                        } ;#end catch
                }
        }
        #or,is it an image?
        if  [regexp i:(.+) [$w gettags [$w find closest $x $y]] -> target]  {
                        catch {$path move [$path parent $target] $label [$path index $target] }
        }
        # set DropTree::lastnode ""
        set ::$path.pick $label
        set DropTree::pick $label

  if {$::DEBUG} {DropTree::debug DropTree::release}
 
        return ::$path.pick
 }
 #---------------
 #
 #---------------
 proc DropTree::init {path} {

  set DropTree::path $path

        #set DropTree::cmd $cmd

        set ::$path.tnodes "0"
        set ::$path.pick ""

        #create default font
        catch {        font create Sans -size 10 -family sans         }

        #set DropTree::fontstyle "bold underline"
        set DropTree::dragimage im_treepage_2
        set DropTree::lastnode ""
        foreach i {Image Text} {
                $path bind$i <B1-Motion> {DropTree::motion %W %x %y}
                $path bind$i <ButtonRelease-1> {DropTree::release %W %x %y}
        }

        #initialize popup menus, current node appended to the proc call
        $path bindText <Button-3> _treepopup
        $path bindImage <Button-3> _treepopup

        menu .tpopup -tearoff 0


        #add new menu options
        .tpopup insert 0 command \
                        -label {Insert} \
                        -command {
                                #insert tree
                                set i [DropTree::insert $notions::tree $DropTree::current]
                                puts "i: $i DropTree::current: $DropTree::current"
 #                                 if {$::N(version)=="0.6"} {
 #                                         set ::notions::listing($i) "tagon Heading_1 \"1.0 linestart\"
 #                                                 text \{New $i\n\} 1.0
 #                                                 tagoff Heading_1 \"1.[string length "New $i"] lineend\"
 #                                                 image img_separator 2.0
 #                                                 text \{\n\} 2.1"
 #                                         }
                                #notions::show $i
                        }
        .tpopup insert 1 command \
                                        -label {Delete} \
                                        -command {\
                                                $notions::tree delete $DropTree::current
                                                
                                        }
        .tpopup insert 2 command -label {Rename} -command {DropTree::rename $notions::tree $DropTree::current}
        

 #        .tpopup add command -label {Insert} -command "_insert $path \$DropTree::current"
 #        .tpopup add command -label {Delete} -command "$path delete \$DropTree::current"
 #        .tpopup add command -label {Rename} -command "_rename $path \$DropTree::current"
        .tpopup add separator
        .tpopup add cascade -label {Change} -menu .tpopup.cas

        menu .tpopup.cas -tearoff 0
        .tpopup.cas add command -label {Colour..} -command "
                        $path itemconfigure \$DropTree::current -fill \[tk_chooseColor \
                                -parent $path \
                                -initialcolor black \
                                -title \{Choose Colour..\}\]
                        "
        .tpopup.cas add command -label {Image..} -command "_selectimage .si $path \"Select Image..\""
        .tpopup.cas add command -label {Font..}
        .tpopup.cas add separator
        .tpopup.cas add command -label {Hide lines} -command "
                        if \{ \[$path cget -showlines\] \} \{
                                $path configure -showlines 0
                                .tpopup.cas entryconfigure 4 -label \{Show Lines\}
                                \} else \{
                                $path configure -showlines 1
                                .tpopup.cas entryconfigure 4 -label \{Hide Lines\}
                                \}
                        "
 }
 #---------------
 #
 #---------------
 proc _treepopup {current} {
        set DropTree::current $current
        set DropTree::path [winfo parent [focus]]
        tk_popup .tpopup [winfo pointerx [focus]] [winfo pointery [focus]]
        }

 #---------------
 #
 #---------------
 proc DropTree::insert {path node} {

        incr ::$path.tnodes
        
        switch $::N(version) {
                0.6 {
                        $path insert 0 $node [set ::$path.tnodes] \
                                -text "[set ::$path.tnodes] New" \
                                -image im_treepage \
                                -font {Sans}
                }
                0.7 {
                        $path insert 0 $node [set ::$path.tnodes] \
                                -text "[set ::$path.tnodes] New" \
                                -image im_treepage \
                                -font {Sans} \
                                -data [ttdblock [set ::$path.tnodes] "New"]
                }
        }
        $path opentree $node
        DropTree::rename $path [set ::$path.tnodes]


  if {$::DEBUG} {DropTree::debug DropTree::insert}
  
        return [set ::$path.tnodes]
 }

 #---------------
 #
 #---------------

 proc DropTree::rename {path node} {
        $path itemconfigure $node -text [$path edit $node [$path itemcget $node -text]] 
 }


 #---------------
 #
 #---------------
 proc _selectimage {path parent title} {

        #TREE images, all images are 16x16 pixels.

        #blue
        image create photo im_1 -data R0lGODlhDQAQAKIAAP///+Li4rGxsYWO/yAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPjDmJcFDSQcLNGwd4mEYxFmCGnBCsofWypwtv8l3PdMvTuZ5PV7GhUC6AYMlsuhIAOw==
        #cream
        image create photo im_2 -data R0lGODlhDQAQAKIAAP////781+Li4rGxsSAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPhDnJcFDSQMTNGwd4mEYxFmCG3CCsofWypwtv8l3PdMvTuZ5PV7GhUC7AYMlsuhIAOw==
        #cyan
        image create photo im_3 -data R0lGODlhDQAQAKIAAP///+Li4rGxsSAgGwD78wAAAAAAAAAAACwAAAAADQAQAAADNDi6U/BvkDmHcFBSMsLNGwd4mEYxFmCGnBCsofWypwtv8l3PdMvTuZ5PV7GhUC6AYMlsuhIAOw==
        #green
        image create photo im_4 -data R0lGODlhDQAQAKIAAP///+Li4rGxsX37j05YSgAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPjDmJcFDSQcLNGwd4mEYxFmCGnBCsofWypwtv8l3PdMvTuZ5PV7GhUC6AYMlsuhIAOw==
        #grey
        image create photo im_5 -data R0lGODlhDQAQAKIAAP///+Li4t/e3rGxsSAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPiDnJcFBSQcLNGwd4mEYxFmCG3BCsofWypwtv8l3PdMvTuZ5PV7GhUC7AYMlsuhIAOw==
        #magenta
        image create photo im_6 -data R0lGODlhDQAQAKIAAP////sA+eLi4rGxsSAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPhDnJcFDSQMTNGwd4mEYxFmCG3CCsofWypwtv8l3PdMvTuZ5PV7GhUC7AYMlsuhIAOw==
        #orange
        image create photo im_7 -data R0lGODlhDQAQAKIAAP////q2SuLi4rGxsSAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPhDnJcFDSQMTNGwd4mEYxFmCG3CCsofWypwtv8l3PdMvTuZ5PV7GhUC7AYMlsuhIAOw==
        #pink
        image create photo im_8 -data R0lGODlhDQAQAKIAAP////5/f+Li4rGxsSAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPhDnJcFDSQMTNGwd4mEYxFmCG3CCsofWypwtv8l3PdMvTuZ5PV7GhUC7AYMlsuhIAOw==
        #purple
        image create photo im_9 -data R0lGODlhDQAQAKIAAP///+Li4rcA+7GxsSAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPiDnJcFBSQcLNGwd4mEYxFmCG3BCsofWypwtv8l3PdMvTuZ5PV7GhUC7AYMlsuhIAOw==
        #white
        image create photo im_10 -data R0lGODlhDQAQAKIAAP///+Li4rGxsSAgGwAAAAAAAAAAAAAAACwAAAAADQAQAAADMji6Q/BvwCgclHOEeieQm4VdjPB5mRCM6KCynrui10tT8y3DaU7vt8+LQZQBBMikUpUAADs=
        #yellow
        image create photo im_11 -data R0lGODlhDQAQAKIAAP/////+heLi4rGxsSAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPhDnJcFDSQMTNGwd4mEYxFmCG3CCsofWypwtv8l3PdMvTuZ5PV7GhUC7AYMlsuhIAOw==
        #book closed
        image create photo im_12 -data  R0lGODlhEAAPAKIAAP////8AAMDAwICAgAAAAAAAAAAAAAAAACwAAAAAEAAPAAADPgi6QMRwuRBeVJNSy7LWXCN8ZCUFYwliVKqahOaWTizTxMDeWw7ou5ZjIAAIHKeNrngMNTbGhvOUQ14kVkgCADs=
        #book open_1
        image create photo im_13 -data R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAACwAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IMQCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc0yv+DVSEUuFxIAOw==
        #book open_2
        image create photo im_14 -data R0lGODlhDwANAKIAAP////8AAMbGxoSEhAAAAAAAAAAAAAAAACwAAAAADwANAAADOQhArM5EQRnbgiI+tzLJwCAp4seAQxmWHhgub3cSgQi/pknCdu5tlJbgV/kMIUZPckKpXDSch4WTAAA7
        #book page
        image create photo im_15 -data R0lGODlhCwAPAKIAAP//////AMDAwICAgAAA/wAAAAAAAAAAACwAAAAACwAPAAADMzi6CzAugiAgDGE68aB0RXgRJBFVX0SNpQlUWfahQOvSsgrX7eZJMlQMWBEYj8iQchlKAAA7
        #treepage
        image create photo im_16
        im_16 copy im_treepage -to 0 0 [image width im_treepage] [image height im_treepage]

        #cross
        image create photo im_17 -data R0lGODlhDgAQAPEAAAAAAOnp6f///wAA/ywAAAAADgAQAEACLpSPFoEB/1gyEYLj4tENbo5Zk2BlgGRKY6MqT3eSXmLFo3nddSuk/YxLqDKrQwEAOw==
        #tick
        image create photo im_18 -data R0lGODlhDgAQAPEAAAAAAOrq6v///wAAACwAAAAADgAQAEACKpSPFwENwlyaxoFoqVYNtmBgl2c5YJJtqvCokoeaYmWGmXWSZc6l2qgpAAA7

        toplevel $path
        #wm attributes $path -toolwindow 1 
        wm transient $path $parent
        grab $path
        wm title $path $title
        wm resizable $path 0 0

        focus $path

        #image frame
        frame $path.fr1
        #create a 4x4 grid of options
        set pad 2
        set ipad 2
        set i 1
        for {set row 1} {$row <= 5} {incr row} {
                for {set col 1} {$col <= 5} {incr col} {
                        catch {
                        button $path.fr1.b$row$col \
                                -image im_$i \
                                -borderwidth 1 \
                                -relief sunken \
                                -bg white \
                                -overrelief raised \
                                -command "$parent itemconfigure $DropTree::current -image im_$i ; grab release $path ; destroy $path " 
                                #-activebackground white
                        grid $path.fr1.b$row$col -row $row -column $col -ipadx $pad -ipady $pad  -padx $ipad -pady $ipad
                        }
                        incr i
                        }
                }

        pack $path.fr1 -fill both

        #buttons
        frame $path.fr2
        button $path.fr2.but1 -text "Ok"     -width 10 -command "grab release $path ; destroy $path"
        button $path.fr2.but2 -text "Cancel" -width 10 -command "grab release $path ; destroy $path"
        pack $path.fr2.but1 $path.fr2.but2 -side left -anchor w -padx 3
        pack $path.fr2 -side bottom -fill x -padx 2

        set w [winfo reqwidth $path]        
        set h [winfo reqheight $path]
        set dx [expr [winfo pointerx $parent] - $w/2]
        set dy [expr [winfo pointery $parent] - $h/2]
        wm geometry $path +$dx+$dy
 }

 #---------------
 #
 #---------------
 proc LoadTree {path args} {
        set channel 0
        set close 0
        set filetype ""
        set file_types {
                { "All Files" *} 
                }
        set dir [pwd]
        set title "Load Tree.."

        foreach {arg opt} $args {
                switch  -- $arg {
                        -channel {set channel $opt}
                        -types   {set types $opt}
                        -dir     {set dir $opt}
                        -title   {set title $opt}
                        }
                }

        if {$channel==0} {
                set fname [tk_getOpenFile \
                -initialdir $dir \
                -filetypes $file_types \
                -title "LoadTree.." \
                -parent .]
        
                set channel [open $fname "r"]
        fconfigure $channel -encoding $::N(encoding)
                set close 1
                }

                # get total number of nodes
                # gets $channel data
                # set ::$path.tnodes $data
                # for {set i 0} {$i < [set ::$path.tnodes] } {incr i} {
                        # gets $channel data ;#1
                        # eval $path insert $data
                # }

        ReadTree $channel $path

        if {$close} {close $channel}
 }

 #---------------
 # # read tree data infrom an openfile
 #----------------
 proc ReadTree {fp path} {
        switch $::N(version) {
                0.6 {
                        #get total number of nodes
                        gets $fp data
                        set ::$path.tnodes $data
                        for {set i 0} {$i < [set ::$path.tnodes] } {incr i} {
                                gets $fp data
                                catch { 
                                eval $path insert $data 
                                }
                        }
                }
                0.7 {
                        set ::$path.tnodes 0
                        set data [read $fp]
                        foreach i $data {
                                catch { 
                                eval $path insert $i 
                                }
                                incr ::$path.tnodes
                        }
                        #set ::$path.tnodes $i
                }
        }
 }

 #---------------
 #
 #---------------
 proc SaveTree {path args} {

        set channel ""
        set filetype ""
        set file_types {
                { "Notions" .dat}
                { "All Files" *} 
                }
        set dir [pwd]
        set title "Save Tree.."

        foreach {arg opt} $args {
                switch  -- $arg {
                        -channel {set channel $opt}
                        -types   {set types $opt}
                        -dir     {set dir $opt}
                        -title   {set title $opt}
                        }
                }

        if {$channel == ""} {
                set fname [tk_getSaveFile  \
                -initialdir $dir \
                -filetypes $file_types \
                -title "Save Tree.." \
                -parent .]

                if {$fname == "" } {return 0}
                #add the right file extension        
                if {[file extension $fname]!= ".dat"} {
                    append fname .dat
                }

        #backup the file
        droptree:backup $fname
        
                set channel [open $fname "w"]
        fconfigure $channel -encoding $::N(encoding)
                set close 1
                }

        if {$::N(version)=="0.6"} {        puts $channel "[set ::$path.tnodes]" }

        for {set i 1 } {$i <= [set ::$path.tnodes]} {incr i} {
                catch {
                        puts $channel "\
                                        \{[$path index $i] \
                                        [$path parent $i] \
                                        $i \
                                        -text  \{[$path itemcget $i -text]\} \
                                        -font  \{[$path itemcget $i -font]\} \
                                        -image \{[$path itemcget $i -image]\} \
                                        -fill  \{[$path itemcget $i -fill]\} \
                                        -data  \{[$path itemcget $i -data]\}\}"
                }
        }

        if {$close} {close $channel}
        return $fname
 }

 #---------------
 #
 #---------------
 proc DropTree::dump {path} {
    set dump ""
        for {set i 0 } {$i <= [set ::$path.tnodes]} {incr i} {
                catch {
                        set dump "$dump \{[$path index $i] [$path parent $i] $i -text  \{[$path itemcget $i -text]\} -font  \{[$path itemcget $i -font]\} -image \{[$path itemcget $i -image]\} -fill  \{[$path itemcget $i -fill]\} -data  \{[$path itemcget $i -data]\}\}"
                }
        }
    return $dump
 }

 #---------------
 #
 #---------------

 proc #_nodelist {{node root} {v ::nl} } {
        set $v ""
        nodelist $node $v
        puts $::nl
 }

 #---------------
 #
 #---------------
 proc nodelist { {node root} {v ::nl} } {
        # get root list
        # this value must be kept within the droptree namespace
        # 
        set l [$notions::tree nodes $node]
        foreach i $l {
                if { [llength [$notions::tree nodes $i]] > 0 } {
                        append $v "$i "
                        nodelist $i
                } else  {
                        append $v "$i "
                 }
                
        }
 }

 #---------------
 #
 #---------------
 proc listit {l} {
        foreach i $l {
                if {[llength $i] > 1} {
                        puts *
                        listit $i
                } else  {
                        puts $i
                }
        }
 }

 #---------------
 #
 #---------------
 proc droptree:backup { fname { levels 3 } } {
     if { [ catch {
        if { [ file exists $fname ] } {
           set dir [ file dirname $fname ]
           set files [ glob -nocomplain -path ${fname} .ba* ]
           set i $levels
           while { [ incr i -1 ] } {
              if { [ lsearch -exact $files ${fname}.ba$i ] > -1 } {
                 file rename -force ${fname}.ba$i ${fname}.ba[ incr i ]
                 incr i -1
              }
           }
           if { [ file exists ${fname}.bak ] } {
              file rename -force ${fname}.bak ${fname}.ba2
           }
           file rename -force $fname ${fname}.bak
        }
     } err ] } {
        return -code error "bak($fname $levels): $err"
     }
 }


 #---------------
 # the ubiquitous demo
 #---------------

 proc demo {} {
  # 22-jan-06 
  #change to version 7 
        set ::N(version) 0.6
        set path .t
        pack [Tree $path -deltax 10 -deltay 20 -showlines 1 -linestipple gray50 -redraw 1] -fill both -expand 1 -side left -anchor nw

  # CODE STUB, THIS IS EXTRACTED FROM NOTIONS0.7
  namespace eval notions {}
  set notions::tree $path
  # END STUB


        DropTree::init $path
        image create photo im_treepage -data R0lGODlhDQAQAKIAAP////781+Li4rGxsSAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPhDnJcFDSQMTNGwd4mEYxFmCG3CCsofWypwtv8l3PdMvTuZ5PV7GhUC7AYMlsuhIAOw==
        image create photo im_treepage_2 -data R0lGODlhDQAQAKIAAP////7X1+Li4rGxsSAgGwAAAAAAAAAAACwAAAAADQAQAAADNEi6VPCPhDnJcFDSQMTNGwd4mEYxFmCG3CCsofWypwtv8l3PdMvTuZ5PV7GhUC7AYMlsuhIAOw==

        #set ::$path.tnodes ""

        #load sample tree
         set fp [open test.lst "r"]
         fconfigure $fp -encoding utf-8
         LoadTree .t -channel $fp
         close $fp

  puts [DropTree::dump .t]

 }

 foreach {arg val} $argv {
        switch -- $arg {
                -demo { console show ; demo }
        }
 }

 demo

ABU Please include "test.lst" for running the demo.


WJG Here you go..

 7
 0 root 0 -text {0 Apple}   -font {Sans} -image im_treepage -fill SystemWindowText
 1 root 1 -text {1 Bannana} -font {Sans} -image im_treepage -fill SystemWindowText
 2 root 2 -text {2 Orange}  -font {Sans} -image im_treepage -fill SystemWindowText
 3 root 3 -text {3 Quince}  -font {Sans} -image im_treepage -fill SystemWindowText
 4 root 4 -text {4 Cherry}  -font {Sans} -image im_treepage -fill SystemWindowText
 5 root 5 -text {5 Peach}   -font {Sans} -image im_treepage -fill SystemWindowText
 6 root 6 -text {6 Pear}    -font {Sans} -image im_treepage -fill SystemWindowText