[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! ''[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] [http://sourceforge.net/project/showfiles.php?group_id=69413] 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 { tree:rename:validate %W $::tree::path $tree::active } bind $path.rename { 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 { TreeCtrl::DoubleButton1 %W %x %y break } bind tree:init { set TreeCtrl::Priv(selectMode) toggle tree:button1 %W %x %y break } bind tree:init { set TreeCtrl::Priv(selectMode) add tree:button1 %W %x %y break } bind tree:init { set TreeCtrl::Priv(selectMode) set tree:button1 %W %x %y break } bind tree:init { tree:motion1 %W %x %y break } bind tree:init { 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 { 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 {popup::show %W main} bind $tree::text {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 } [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) ---- [Category Application] - [Category Editor utility]