WJG (10/Mar/06) More notes to follow.
But in brief this a re-hack of the treectrl demos (Random and Random500) to provide a multipage text editor. Something of wiki, but the use of the tree enables the users to organise their jottings into a structured order. As said, more to follow. Also, apologies for the size of this project. Somewhere in the treectrl docs it sorta says 'a little more coding in required'. Well, it's true!
Resolve of the configuration problems
WJG (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
# https://wiki.tcl-lang.org/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: https://wiki.tcl-lang.org/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 program
Many thanks!