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!
Comments
Load buttons and pop-up
escargo - Here's a link to LoadButtons.tcl: LoadButtons -Batch loading of images graphics for GUI objects and to popup.tcl: Popup Menus -An all in one solution for application wide popup menus.
What (and where) are the GIF images that LoadButtons is trying to load?
WJG Escargo, thanks for adding the extra links. GIFs. As this was a re-working of the treectrl demos, just copy the treectrl/pics directory to wherever treepad.tcl and the various other items have been saved then edit the LoadButtons.tcl and popup.tcl to turn off the demo mode. I appreciate that this listing is perhaps too long for a wiki page but, seeing as this is for the most part an adaption of someonelse's code rather than my own, the wiki is the most appropriate place to post it.
escargo - The SourceForge site for treectrl [L1 ] has a zip file containing more than the files that ActiveState 8.4.12 had in it. I found the demo directory with the pics directory under that.
Be sure to change the LoadButtons.tcl: "set DEMO(loadbuttons) no"
Otherwise treepad.tcl will fail.
WJG-this has been changed below... Just after the modules have been loaded.
#---------------
# 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.
#
# Usage:
# -----
# See demo proc for example
#---------------
set DEMO(treectrl) yes
package require treectrl ;# http://wiki.tcl.tk/6064
# some other modules..
source LoadButtons.tcl ;# http://wiki.tcl.tk/15580
source popup.tcl ;# http://wiki.tcl.tk/15392
# turn off demos belonging to other modules
set DEMO(loadbuttons) no
set DEMO(popup) no
LoadButtons [pwd]/pics -pattern *.gif -display no
# 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
}
#---------------
# the ubiquitous demo!
#---------------
if {$DEMO(treectrl)} {
console show
# file format
# itemid parent children text data
set DemoData {\
{date 10/Mar/06 author {William J Giddings}}
{Item#0 {} {1} {Root} {This is the root..}}
{Item#1 {0} {2} {Page1} {Page 1}}
{Item#2 {1} {3 4 5 6} {Item_A1} {1: Item 1}}
{Item#3 {2} {} {Item_A2} {2: Item 2}}
{Item#4 {2} {} {Item_A3} {4: Item 3}}
{Item#5 {2} {} {Item_A4} {5: Item 4}}
{Item#6 {2} {} {Item_A5} {6: Item 5}}
}
set fp [open dump.dat w]
puts $fp $DemoData
close $fp
treepad
}Error in the executing of a script
SEH 20061028 -- When trying to execute this script I get the following error:
bad option "tail": must be blank, cget, configure, copy, data, get, put, read, redither, transparency, or write
while executing
"EvalAttached $::tk::console::defaultPrompt"
(procedure "ConsolePrompt" line 9)
invoked from within
"ConsolePrompt"
(procedure "tk::ConsoleInvoke" line 23)
invoked from within
"tk::ConsoleInvoke"
(command bound to event)exe please!
Robert Abitbol 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!