#---------------
# 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 }
}
}
demoABU 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