Resolve of the configuration problemsWJG (30/10/06) Following on from the recents comments and requests on this page, I've gathered all the necessary bits together for this simple application so any configuration problems should 'go away'.-----> See older versions of this page for more details on the problems described by users.
#---------------
# treepad.tcl
#---------------
# Adapted from TreeCTRLdemo.tcl
# by William J Giddings, 2006.
#
# Description:
# -----------
#
# Multipage text editor using a treectrl tree widget
# to organise the text in a structured manner.
#
#---------------
#---------------
package require treectrl
#---------------
# popupmenu stuff
# create some menu icons
image create photo im_new -data "R0lGODlhEAAQAMQAAP////f33e/v9+3t1+rr6+fnztzcxtjWvdbOvdTQyMrJubm5qKmqmJiYh4yUiXh4dmZmZFZWVDY2NTIyKSUlIwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAEAAQAAAFYGAijklFnmfFmChZVYZBteULxwXrPhByHIZCYYKqECaLn3AQ0ImMAoniUBgwmy5CQOKgWq86Y8SBCFoDaGytAVym0a9nLFh9BwzxEq7+zj+/fU4jFQtpfi0VASs0KYIjIQA7"
image create photo im_copy -data R0lGODlhEAAQAIUAAFxaXPwCBNze3GxubERCRPz+/Pz29Pzy5OTe3LS2tAQCBPTq3PTizLyulKyqrOzexLymhLy+vPTy9OzWvLyifMTCxHRydOzSrLyihPz6/OTKpLyabOzu7OTm5MS2nMSqjKSipDQyNJyenLSytOTi5NTS1JyanNTW1JSWlLy6vKyurAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAEALAAAAAAQABAAAAaUQIBwCAgYj0eAYLkcEJBIZWFaGBie0ICUOnBiowKq4YBIKIbJcGG8YDQUDoHTKGU/HhBFpHrVIiQHbQ8TFAoVBRZeSoEIgxcYhhkSAmZKghcXGht6EhwdDmcRHh4NHxgbmwkcCwIgZwqwsbAhCR0CCiIKWQAOCQkjJAolJrpQShK2wicoxVEJKSMqDiAizLuysiF+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
image create photo im_cut -data R0lGODlhEAAQAIEAAPwCBAQCBPz+/ISChCH5BAEAAAAALAAAAAAQABAAAAIwhI9pwaHrGFRBNDdPlYB3bWHQ1YXPtYln+iCpmqCDp6El7Ylsp6ssR1uYSKuW0V8AACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
image create photo im_delete -data R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJyanPz+/Ozq7GxqbPT29GxubMzOzDQyNIyKjHRydERCROTi3IyKhPz29Ox6bPzCxPzy7PTm3NS6rIQCBMxCNPTq3PTi1PTezMyynPTm1PTaxOzWvMyulOzGrMymhPTq5OzOtNTKxNTOzNTCtNS+rMSehAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaKQAAgQCwahcihYMkcBAiBpLJApRoOBWgyIKhSEQkFgrBAcr1URiPhKAsDD3QB8RhA3FM0IlLHnyUTVBMSFBUWfl0XGBMTGBcZGodmcQWKjpAbHIgIBY2LHRoempOdjooTGx8giIOPFYofISJ+DyMXI6AfFySyfiUmJSUnKBYcICIpfgELzM3OZX5BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
image create photo im_paste -data R0lGODlhEAAQAIUAAPwCBCQiFHRqNIx+LFxSBDw6PKSaRPz+/NTOjKyiZDw+POTe3AQCBIR2HPT23Ly2dIR2FMTCxLS2tCQmJKSipExGLHx+fHR2dJyenJyanJSSlERCRGRmZNTW1ERGRNze3GxubBweHMzOzJSWlIyOjHRydPz29MzKzIyKjPTq3Ly2rLy+vISGhPzy5LymhISChPTizOzWvKyurPTexOzSrDQyNHx6fCwuLGxqbOzKpMSabAQGBMS2nLyulMSidAAAACH5BAEAAAAALAAAAAAQABAAAAa7QIBQGBAMCMMkoMAsGA6IBKFZECoWDEbDgXgYIIRIRDJZMigUMKHCrlgul7KCgcloNJu8fsMpFzoZgRoeHx0fHwsgGyEACiIjIxokhAeVByUmG0snkpIbC5YHF4obBREkJCgon5YmKQsqDAUrqiwsrAcmLSkpLrISLC/CrCYOKTAxvgUywhYvGx+6xzM0vjUSNhdvn7zIMdUMNxw4IByKH8fINDk6DABZWTsbYzw9Li4+7UoAHvD+4X6CAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
image create photo im_redo -data R0lGODlhEAAQAIUAAPwCBBxOHBxSHBRGHKzCtNzu3MTSzBQ2FLzSxIzCjCSKFCyeHDzCLAxGHAwuFDSCNBxKLES+NHSmfBQ6FBxWJAQaDAQWFAw+HDSyLJzOnISyjMTexAQOBAwmDAw+FMzizAQODDymNKzWrAQKDAwaDEy6TFTGTFSyXDyKTAQCBAwiFBQyHAwSFAwmHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ2QIBwSCwaj0hAICBICgcDQsEgaB4PiIRiW0AEiE3sdsFgcK2CBsCheEAcjgYjoigwJRM2pUK0XDAKGRobDRwKHUcegAsfExUdIEcVCgshImojfEUkCiUmJygHACkqHEQpqKkpogAgK5FOQywtprFDKRwptrZ+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7
image create photo im_undo -data R0lGODlhEAAQAIUAAPwCBBxSHBxOHMTSzNzu3KzCtBRGHCSKFIzCjLzSxBQ2FAxGHDzCLCyeHBQ+FHSmfAwuFBxKLDSCNMzizISyjJzOnDSyLAw+FAQSDAQeDBxWJAwmDAQOBKzWrDymNAQaDAQODAwaDDyKTFSyXFTGTEy6TAQCBAQKDAwiFBQyHAwSFAwmHAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ1QIBwSCwaj0hiQCBICpcDQsFgGAaIguhhi0gohIsrQEDYMhiNrRfgeAQC5fMCAolIDhD2hFI5WC4YRBkaBxsOE2l/RxsHHA4dHmkfRyAbIQ4iIyQlB5NFGCAACiakpSZEJyinTgAcKSesACorgU4mJ6uxR35BACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
# define package namespace
namespace eval popup {
set VERSION 0.1
}
#define menus, works for cascades too..
set ::popup::menu(main) {
{cascade -label "New" -hidemargin 0 -compound left -image im_new -command {.txt1 delete 1.0 end}}
{cascade -label "Edit" -menu .edit}
{separator}
{command -label Exit -command exit}
}
set ::popup::menu(edit) {
{command -label Undo -hidemargin 0 -compound left -image im_undo -command {event generate [focus] <<Undo>>}}
{command -label Redo -hidemargin 1 -compound left -image im_redo -command {event generate [focus] <<Redo>>}}
{separator}
{command -label Cut -compound left -image im_cut -command {event generate [focus] <<Cut>>}}
{command -label Copy -compound left -image im_copy -command {event generate [focus] <<Copy>>}}
{command -label Paste -compound left -image im_paste -command {event generate [focus] <<Paste>>}}
}
set ::popup::menu(file) {
{command -label Open -command {File:Open .txt}}
{command -label Save -command {File:Reload .txt}}
{command -label Save -command {File:Save .txt}}
}
#----------------
# create menu (m) with from list of supplied items (a)
#---------------
proc popup::create {m} {
set c $m
set m ".[string tolower $m]"
# destroy any pre-exising menu with the same name
destroy $m
# create new menus
menu $m -tearoff 0
foreach i $popup::menu($c) {
eval $m add $i
}
}
#---------------
# display the popup menu adjacent to the current pointer location
#---------------
proc popup::show {w m} {
set m ".[string tolower $m]"
# set w [winfo parent $m]
# lassign [winfo pointerxy $w] x y
foreach {x y} [winfo pointerxy $w] {}
set ::active(tag) $m
#get active ta
tk_popup $m $x $y
}
#---------------
# treepad stuff itself
#---------------
#---------------
# some basic tree graphics
#---------------
image create photo help-book-closed -data {
R0lGODlhEAAQACIAACwAAAAAEAAQAIIAAAB/AH9/f3+/v7////8AAAAAAAAA
AAADQEi6BMBwuRBeVJNSy7LWXDN8ZCUFYwliVKqagOaWTizTgMDeW07ou5ZD
MCAMHKeNrngMNTbGhvOUQ14k1quWkQAAOw==
}
image create photo help-book-open -data {
R0lGODlhEAAQACIAACwAAAAAEAAQAIIAAAB/AH9/f3///wC/v7////8AAAAA
AAADTVgl2v6CsEdBKNKJ7aya3NJdWFgMAgAoHkucXxGsbQG8CirTpP0OsZmt
d2vohLUiUIQMkIqfl3B4KW5w06Ht6shSnWDwqqMqm8eUtCIBADs=
}
image create photo small-txt -data {
R0lGODlhEAAQALIAAAAAAAAAMwAAZgAAmQAAzAAA/wAzAAAzMyH5BAUAAAIA
LAAAAAAQABAAggAAAH9/f/8AAL+/v////wAAAAAAAAAAAANAKArE3ioKFki9
MNbHs6hEKIoDoI0oUZ4N4DCqqYBpuM6hq8P3V5MyX2tnC9JqPdDOVWT9kr/m
bECtWnuT5TKSAAAh/oBUaGlzIGFuaW1hdGVkIEdJRiBmaWxlIHdhcyBjb25z
dHJ1Y3RlZCB1c2luZyBVbGVhZCBHSUYgQW5pbWF0b3IgTGl0ZSwgdmlzaXQg
dXMgYXQgaHR0cDovL3d3dy51bGVhZC5jb20gdG8gZmluZCBvdXQgbW9yZS4B
VVNTUENNVAAh/wtQSUFOWUdJRjIuMAdJbWFnZQEBADs=
}
# custom namespace
namespace eval tree {
variable path
variable text
variable active
variable fname untitled.dat
variable lines yes
variable stripeClr #f2f8ff
}
#---------------
# rename the item tree label
#---------------
proc tree:rename {path active x y} {
# get the scrren position of the text box
foreach {x1 y1 x2 y2} [$path item bbox $active colItem elemTxtName] {}
# create entry then position it over tree text enrty
entry $path.rename -borderwidth 1 -relief solid -background #ffffdd
$path.rename insert 0 [ $path item element cget $active colItem elemTxtName -text ]
# minimum width for entry, just in case text = " "
set w [expr $x2-$x1]
if {$w <50} {set w 50}
place $path.rename \
-x [incr x1 -5] \
-y [incr y1 -5] \
-width $w \
-height [expr $y2-$y1]
# edit it
focus -force $path.rename
# close and update when focus changes or return pressed
bind $path.rename <Key-Return> { tree:rename:validate %W $::tree::path $tree::active }
bind $path.rename <FocusOut> { tree:rename:validate %W $::tree::path $tree::active }
}
#---------------
# update tree, then destroy entry widget
#---------------
proc tree:rename:validate {w path active} {
# do not permit empty fields, must be a space
set str [$w get]
if {$str==""} {set str " "}
$path item element configure $active colItem elemTxtName -text $str
destroy $w
# return focus back to the tree widget
focus $path
}
#---------------
# tree:init
#---------------
proc tree:init {T} {
# Get environment default colors
set w [listbox .listbox]
set SystemHighlightText [$w cget -selectforeground]
set SystemHighlight [$w cget -selectbackground]
destroy $w
# determine row height
set height [font metrics [$T cget -font] -linespace]
if {$height < 18} { set height 18 }
# configure the treectrl widget
$T configure \
-itemheight $height \
-selectmode single \
-showroot yes \
-showrootbutton yes \
-showbuttons yes \
-showlines $::tree::lines \
-scrollmargin 16 \
-xscrolldelay "500 50" \
-yscrolldelay "500 50"
# Create columns..
$T column create \
-expand yes \
-text Item \
-itembackground "$::tree::stripeClr {}" \
-tag colItem
# then configure
$T configure -treecolumn colItem
# Create elements
$T element create elemImgFolder image -image {help-book-open {open} help-book-closed {}}
$T element create elemImgFile image -image small-txt
$T element create elemTxtName text -fill [list $SystemHighlightText {selected focus}]
$T element create elemTxtCount text -fill blue
$T element create elemTxtAny text
$T element create elemRectSel rect -showfocus yes -fill [list $SystemHighlight {selected focus} gray {selected !focus}]
# Create styles using the elements
set S [$T style create styFolder]
$T style elements $S {elemRectSel elemImgFolder elemTxtName elemTxtCount}
$T style layout $S elemImgFolder -padx {0 4} -expand ns
$T style layout $S elemTxtName -padx {0 4} -expand ns
$T style layout $S elemTxtCount -padx {0 6} -expand ns
$T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2
set S [$T style create styFile]
$T style elements $S {elemRectSel elemImgFile elemTxtName}
$T style layout $S elemImgFile -padx {0 4} -expand ns
$T style layout $S elemTxtName -padx {0 4} -expand ns
$T style layout $S elemRectSel -union [list elemTxtName] -iexpand ns -ipadx 2
set S [$T style create styAny]
$T style elements $S {elemTxtAny}
$T style layout $S elemTxtAny -padx 6 -expand ns
TreeCtrl::SetSensitive $T {
{colItem styFolder elemRectSel elemImgFolder elemTxtName}
{colItem styFile elemRectSel elemImgFile elemTxtName}
}
TreeCtrl::SetDragImage $T {
{colItem styFolder elemImgFolder elemTxtName}
{colItem styFile elemImgFile elemTxtName}
}
# Add bindings
bind tree:init <Double-ButtonPress-1> {
TreeCtrl::DoubleButton1 %W %x %y
break
}
bind tree:init <Control-ButtonPress-1> {
set TreeCtrl::Priv(selectMode) toggle
tree:button1 %W %x %y
break
}
bind tree:init <Shift-ButtonPress-1> {
set TreeCtrl::Priv(selectMode) add
tree:button1 %W %x %y
break
}
bind tree:init <ButtonPress-1> {
set TreeCtrl::Priv(selectMode) set
tree:button1 %W %x %y
break
}
bind tree:init <Button1-Motion> {
tree:motion1 %W %x %y
break
}
bind tree:init <ButtonRelease-1> {
tree:release1 %W %x %y
break
}
bindtags $T [list $T tree:init TreeCtrl [winfo toplevel $T] all]
return
}
#---------------
# toggle tree lines
#---------------
proc tree:showlines {T} {
if { [$T cget -showlines] } {
$T configure -showlines no
} else {
$T configure -showlines yes
}
}
#---------------
# choose view style, tree or collapser
#---------------
proc tree:style {T {style tree}} {
switch [string tolower $style] {
collapser {
set lines no
set images "\{mac-collapse open mac-expand {}\}"
}
tree {
set lines yes
set images "\{\}"
}
default {
return
}
}
# apply the changes
eval $T configure \
-showlines $lines \
-showbuttons yes \
-buttonimage $images
}
#---------------
# tree:button1
#---------------
proc tree:button1 {T x y} {
variable TreeCtrl::Priv
focus $T
set id [$T identify $x $y]
set Priv(buttonMode) ""
# Click outside any item
if {$id eq ""} {
$T selection clear
# Click in header
} elseif {[lindex $id 0] eq "header"} {
TreeCtrl::ButtonPress1 $T $x $y
# Click in item
} else {
foreach {where item arg1 arg2 arg3 arg4} $id {}
switch $arg1 {
button {
$T item toggle $item
}
line {
$T item toggle $arg2
}
column {
set ok 0
# Clicked an element
if {[llength $id] == 6} {
set column [lindex $id 3]
set E [lindex $id 5]
foreach list $Priv(sensitive,$T) {
set C [lindex $list 0]
set S [lindex $list 1]
set eList [lrange $list 2 end]
if {[$T column compare $column != $C]} continue
if {[$T item style set $item $C] ne $S} continue
if {[lsearch -exact $eList $E] == -1} continue
set ok 1
break
}
}
if {!$ok} {
$T selection clear
return
}
set Priv(drag,motion) 0
set Priv(drag,click,x) $x
set Priv(drag,click,y) $y
set Priv(drag,x) [$T canvasx $x]
set Priv(drag,y) [$T canvasy $y]
set Priv(drop) ""
if {$Priv(selectMode) eq "add"} {
TreeCtrl::BeginExtend $T $item
} elseif {$Priv(selectMode) eq "toggle"} {
TreeCtrl::BeginToggle $T $item
} elseif {![$T selection includes $item]} {
TreeCtrl::BeginSelect $T $item
}
$T activate $item
if {[$T selection includes $item]} {
set Priv(buttonMode) drag
}
}
}
}
return
}
#---------------
# tree:motion1
#---------------
proc tree:motion1 {T x y} {
variable TreeCtrl::Priv
switch $Priv(buttonMode) {
"drag" {
set Priv(autoscan,command,$T) {tree:motion %T %x %y}
TreeCtrl::AutoScanCheck $T $x $y
tree:motion $T $x $y
}
default {
TreeCtrl::Motion1 $T $x $y
}
}
return
}
#---------------
# motion
#---------------
proc tree:motion {T x y} {
variable TreeCtrl::Priv
switch $Priv(buttonMode) {
"drag" {
if {!$Priv(drag,motion)} {
# Detect initial mouse movement
if {(abs($x - $Priv(drag,click,x)) <= 4) &&
(abs($y - $Priv(drag,click,y)) <= 4)} return
set Priv(selection) [$T selection get]
set Priv(drop) ""
$T dragimage clear
# For each selected item, add 2nd and 3rd elements of
# column "item" to the dragimage
foreach I $Priv(selection) {
foreach list $Priv(dragimage,$T) {
set C [lindex $list 0]
set S [lindex $list 1]
if {[$T item style set $I $C] eq $S} {
eval $T dragimage add $I $C [lrange $list 2 end]
}
}
}
set Priv(drag,motion) 1
}
# Find the item under the cursor
set cursor X_cursor
set drop ""
set id [$T identify $x $y]
set ok 0
if {($id ne "") && ([lindex $id 0] eq "item") && ([llength $id] == 6)} {
set item [lindex $id 1]
set column [lindex $id 3]
set E [lindex $id 5]
foreach list $Priv(sensitive,$T) {
set C [lindex $list 0]
set S [lindex $list 1]
set eList [lrange $list 2 end]
if {[$T column compare $column != $C]} continue
if {[$T item style set $item $C] ne $S} continue
if {[lsearch -exact $eList $E] == -1} continue
set ok 1
break
}
}
if {$ok} {
# If the item is not in the pre-drag selection
# (i.e. not being dragged) see if we can drop on it
if {[lsearch -exact $Priv(selection) $item] == -1} {
set drop $item
# We can drop if dragged item isn't an ancestor
foreach item2 $Priv(selection) {
if {[$T item isancestor $item2 $item]} {
set drop ""
break
}
}
if {$drop ne ""} {
scan [$T item bbox $drop] "%d %d %d %d" x1 y1 x2 y2
if {$y < $y1 + 3} {
set cursor top_side
set Priv(drop,pos) prevsibling
} elseif {$y >= $y2 - 3} {
set cursor bottom_side
set Priv(drop,pos) nextsibling
} else {
set cursor ""
set Priv(drop,pos) lastchild
}
}
}
}
if {[$T cget -cursor] ne $cursor} {
$T configure -cursor $cursor
}
# Select the item under the cursor (if any) and deselect
# the previous drop-item (if any)
$T selection modify $drop $Priv(drop)
set Priv(drop) $drop
# Show the dragimage in its new position
set x [expr {[$T canvasx $x] - $Priv(drag,x)}]
set y [expr {[$T canvasy $y] - $Priv(drag,y)}]
$T dragimage offset $x $y
$T dragimage configure -visible yes
}
default {
TreeCtrl::Motion1 $T $x $y
}
}
return
}
#---------------
# release the dragged item
#---------------
proc tree:release1 {T x y} {
variable TreeCtrl::Priv
if {![info exists Priv(buttonMode)]} return
switch $Priv(buttonMode) {
"drag" {
TreeCtrl::AutoScanCancel $T
$T dragimage configure -visible no
$T selection modify {} $Priv(drop)
$T configure -cursor ""
if {$Priv(drop) ne ""} {
tree:drop $T $Priv(drop) $Priv(selection) $Priv(drop,pos)
}
unset Priv(buttonMode)
}
default {
TreeCtrl::Release1 $T $x $y
}
}
return
}
#---------------
# drop the dragged item
#---------------
proc tree:drop {T target source pos} {
set parentList {}
switch -- $pos {
lastchild { set parent $target }
prevsibling { set parent [$T item parent $target] }
nextsibling { set parent [$T item parent $target] }
}
foreach item $source {
# Ignore any item whose ancestor is also selected
set ignore 0
foreach ancestor [$T item ancestors $item] {
if {[lsearch -exact $source $ancestor] != -1} {
set ignore 1
break
}
}
if {$ignore} continue
# Update the old parent of this moved item later
if {[lsearch -exact $parentList $item] == -1} {
lappend parentList [$T item parent $item]
}
# Add to target
$T item $pos $target $item
# Recursively update text: depth
set itemList [$T item firstchild $item]
while {[llength $itemList]} {
# Pop
set item [lindex $itemList end]
set itemList [lrange $itemList 0 end-1]
set item2 [$T item nextsibling $item]
if {$item2 ne ""} {
# Push
lappend itemList $item2
}
set item2 [$T item firstchild $item]
if {$item2 ne ""} {
# Push
lappend itemList $item2
}
}
}
# Update items that lost some children
foreach item $parentList {
set numChildren [$T item numchildren $item]
if {$numChildren == 0} {
$T item configure $item -button no
$T item style map $item colItem styFile {elemTxtName elemTxtName}
} else {
$T item element configure $item colItem elemTxtCount -text "($numChildren)"
}
}
# Update the target that gained some children
if {[$T item style set $parent colItem] ne "styFolder"} {
$T item configure $parent -button yes
$T item style map $parent colItem styFolder {elemTxtName elemTxtName}
}
set numChildren [$T item numchildren $parent]
$T item element configure $parent colItem elemTxtCount -text "($numChildren)"
return
}
#---------------
# create the root
#---------------
proc tree:addRoot {w txt} {
global ${w}_data
$w item configure root -button yes
$w item style set root colItem styFolder
$w item element configure root colItem elemTxtName -text $txt
set ${w}_data(0) "ROOT DATA"
}
#---------------
# create the root
#---------------
proc tree:showroot {w} {
if {[$w cget -showroot]} {
$w configure -showroot no -showrootbutton no
} else {
$w configure -showroot yes -showrootbutton yes
}
}
#---------------
# create new entry
#---------------
proc tree:addItem {w txt {parent 0} {data NEW}} {
global ${w}_data
set first yes
if {[$w item children $parent] !=""} { set first no}
set item [$w item create]
$w item style set $item colItem styFile
$w item element configure $item colItem elemTxtName -text $txt
$w item lastchild $parent $item
if {$first} {
set str [ $w item element cget $parent colItem elemTxtName -text ]
# update root if necessary
$w item configure $parent -button yes
$w item style set $parent colItem styFolder
$w item element configure $parent colItem elemTxtName -text $str
}
set ${w}_data($item) $data
return $item
}
#---------------
# delete tree item and associated data
#---------------
proc tree:deleteItem {w i} {
global ${w}_data
# delete item,
$w item delete $i
# determine the differences between the tree and data lists
# http://wiki.tcl.tk/15489
foreach i [array names ${w}_data] {
if {[lsearch -exact [$w item range first last] $i]==-1} {
lappend diff $i
}
}
# reconcile two lists by deleting unwanted data entries
array unset ${w}_data $diff
}
#---------------
# dump all values
#---------------
proc tree:dump {w} {
global ${w}_data
foreach i [$w item range first last] {
if {$i==""} {set item root}
set parent [$w item parent $i]
set children [$w item children $i]
set txt [ $w item element cget $i colItem elemTxtName -text ]
set data [set ${w}_data($i)]
append j "\{Item#$i \{$parent\} \{$children\} \{$txt\} \{$data\}\}\n"
}
return $j
}
#---------------
# save treectrl contents
#---------------
proc tree:save {w fname} {
global ${w}_info
set fp [open $fname "w"]
# first entry is a file info block
puts $fp "\{[array get ${w}_info]\}"
# the tree and data
puts $fp [tree:dump $w]
close $fp
}
#---------------
# load treectrl contents
#---------------
proc tree:load {w fname} {
global ${w}_data ${w}_info
# delete existing data
$w item delete all
array unset ${w}_info
# open file
set fp [open $fname "r"]
set str [read $fp]
# extract the info block, this is always list item 0
array set ${w}_info [lindex $str 0]
for {set i 1} {$i <= [llength $str]} {incr i} {
# now follows the actual data
foreach {item parent children text data} [lindex $str $i] {
if {$parent == ""} {
# must be root
tree:addRoot $w $text
set ${w}_data(0) $data
} else {
# any other item
catch { tree:addItem $w $text $parent $data }
}
}
}
close $fp
}
#---------------
# add a new item
#---------------
proc tree:new {w t} {
global ${w}_data
#$w item delete first last
$w item delete all
$t delete 1.0 end
array unset ${w}_data [array names ${w}_data]
tree:addRoot $w Root
tree:addItem $w page 0
}
#---------------
# change the displayed item
# a active item
# p previus item
#---------------
proc tree:show {t w a p} {
global ${w}_data
# save old data
set ${w}_data($p) [$t get 1.0 end-1c]
# show new data
$t delete 1.0 end
$t insert end [set ${w}_data($a)]
}
#---------------
# the ubiquitous demo
#---------------
proc treepad { {base {}} } {
global i path
if {$base=="."} {set base ""}
# create paned window to hold tree and text
panedwindow ${base}.pane
pack ${base}.pane -side top -expand yes -fill both
# give path default value
set ::tree::path ${base}.pane.tree
treectrl $::tree::path \
-width 200 -height 300 \
-showrootbutton no \
-showbuttons yes \
-showlines yes \
-selectmode extended
set tree::text ${base}.pane.txt
text $tree::text -font {Times 12} -background #f8f8f8 -undo true
# add to panes
${base}.pane add $tree::path $tree::text
# binding to set active item
$::tree::path notify bind $::tree::path <ActiveItem> {
set tree::path %W
set tree::active %c
set x [winfo pointerx %W]
set y [winfo pointery %W]
tree:show $::tree::text %W %c %p
}
# a simple counter
set i 0
# modify menus to suit application
set ::popup::menu(main) {
{cascade -label "Insert" -hidemargin 0 -command { tree:addItem $tree::path Item_A[incr i] $tree::active }}
{command -label "Delete" -command {tree:deleteItem $tree::path $tree::active}}
{command -label "Rename" -command { tree:rename $tree::path $tree::active $x $y}}
{separator}
{command -label "'Collapser'" -command {tree:style $tree::path collapser}}
{command -label "'Tree'" -command {tree:style $tree::path tree}}
{separator}
{command -label "Toggle Lines" -command {tree:showlines $tree::path}}
{command -label "Show Root" -command {tree:showroot $tree::path}}
{separator}
{command -label "New" -command {
tree:new $tree::path $tree::text
}}
{command -label "Load Tree.." -command {
set tree::fname [tk_getOpenFile \
-defaultextension {.dat} \
-initialdir . \
-filetypes {{{Tree Text} *.dat Text} {all *.* Text} } \
-initialfile $tree::fname \
-title "Load File..."]
tree:load $tree::path $tree::fname
}}
{command -label "Save Tree.." -command {
set tree::fname [tk_getSaveFile \
-defaultextension {.dat} \
-initialdir . \
-filetypes {{{Tree Text} *.dat Text} {all *.* Text} } \
-initialfile $tree::fname \
-title "Save File..."]
tree:save $tree::path $tree::fname
}}
}
# add a couple of items to the 'standard' edit popup
append ::popup::menu(edit) {
{separator}
{command -label "Insert File.." -command {
set tmp [tk_getOpenFile \
-defaultextension {.txt} \
-initialdir . \
-filetypes {{{Tree Text} *.txt Text} {all *.* Text} } \
-initialfile {} \
-title "Insert File..."]
set fp [open $tmp r]
$tree::text insert insert [read $fp]
close $fp
}}
}
# initlialise the popup menus..
popup::create main
popup::create edit
# assign bindings..
bind $tree::path <Button-3> {popup::show %W main}
bind $tree::text <Button-3> {popup::show %W edit}
tree:init $tree::path
tree:new $tree::path $tree::text
}
#---------------
# run application
#---------------
treepadSEH 20061031 -- When I try to execute the above script, I get the following error:
expected integer but got "colItem"
(processing "-treecolumn" option)
invoked from within
"$T configure -treecolumn colItem"
(procedure "tree:init" line 15)
invoked from within
"tree:init $tree::path"
(procedure "treepad" line 74)
invoked from within
"treepad"Exe please![unperson] I like your ideas, William. Well, you are writing your own editors for writing your thesis on Eastern Religion. As they say: necessity is the mother of invention'. This is also the way I work.Is TreePad available as an exe that could run with Windows 98 or with Windows XP? If so, I'd love to try it! I have been looking for an outliner since the days of the Majestic GrandView on Dos but I can't seem to find one as good and moreover as intuitive (very important characteristic!).If you want easy instructions to produce an exe, see here: http://wiki.tcl.tk/11861
Thanks in advance!WJG (30 Oct 06) I now have the above wrapped as a starkit, I'll email you a copy.[unperson] No, please! Starkits don't work with my OS. Please make an exe following the instructions posted here: How to compile a TCL script into an EXE programMany thanks!