TreePad -Structured multipage text editor using TreeCtrl

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
 #---------------
 treepad

SEH 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!