• Natural trees have roots, branches, leaves and fruits.
• Roots grow branches.
• Branches grow branches, leaves and fruits.
• Branches are paths for juices to reach the leaves and fruits.
• Leaves are an end to themselves. They grow chlorophyll.
• Fruits are the hope for future generations. That's why they are initially beautiful flowers; they are the center of a lot of activity and go through a lot of changes.
• Fruits finally grow seeds.
• Seeds will some day grow trees of their own.

     package require Tk
      namespace eval ::tktree {

        # Images used for open and close state of subgroups
        set ::tktree::imgcollapse [image create photo .tktreeopenbm -data {
          R0lGODdhCQAJAIAAAAEBAf///ywAAAAACQAJAAACEISPoRvG614D80x5ZXyogwIAOw==}]
        set ::tktree::imgexpand [image create photo .tktreeclosebm -data {
          R0lGODdhCQAJAIAAAAEBAf///ywAAAAACQAJAAACEYSPoRu28KCSDSJLc44s3lMAADs=}]
        ###Default images for groups and children
        set ::tktree::imgsubgroups [image create photo .tktreeimgfolder -data {
                    R0lGODlhEAANAKIAANnZ2Xh4eLi4uPj4APj4+AAAAP///////yH5BAEAAAAA
                    LAAAAAAQAA0AAANkCIChiqDLITgyEgi6GoIjIyMYugCBpMsaWBA0giMjIzgy
                    UYBBMjIoIyODEgVBODIygiMjE1gQJIMyMjIoI1GAQSMjODIyghMFQSgjI4My
                    MhJYEDSCIyMjODJRgKHLXAiApcsMmAA7}]
        set ::tktree::imgchildren [image create photo .tktreeimgfile -data {
                    R0lGODlhDQAQAKIAANnZ2Xh4ePj4+Li4uAAAAP///////////yH5BAEAAAAA
                    LAAAAAANABAAAANSGLoLgACBoqsRCBAoujqCASGDojtESCEihCREIjgUKLo8
                    hCGCpCsySIGiy0MYIki6IoMUKLo8hCGCpCsySIGiy0MYKLo8hIGiy0MYOLo8
                    SLrMCQA7}]

        #### Swtich all subgroups of a layer to open or close
        proc ::tktree::switchlayer {win opn {layer /}} {
          variable cfg
          foreach child $cfg($win,$layer:subgroups) {
            set cfg($win,$child:open) $opn
            switchlayer $win $opn $child
          }
          buildwhenidle $win
        }

        ####  will open or close the item given
        proc ::tktree::switchstate {win item} {
          set ::tktree::cfg($win,$item:open) [expr ! $::tktree::cfg($win,$item:open)]
          buildwhenidle $win
        }

        #### Select the next item up or down
        proc ::tktree::updown {win down} {
          variable cfg
          set index [lsearch -exact $cfg($win,sortlist) $cfg($win,selection)]
          if {$down} {incr index} {incr index -1}
          if {$index < 0} {set index end} elseif {$index >= [llength $cfg($win,sortlist)]} {set index 0}
          setselection $win [lindex $cfg($win,sortlist) $index]
        }

        #### left-right button binding commands
        proc ::tktree::leftright {win right} {
          variable cfg
          set item $cfg($win,selection)
          set index [lsearch -exact $cfg($win,sortlist) $item]
          set parentindex [lsearch -exact $cfg($win,sortlist) [file dirname $item]]
          if {$parentindex == -1} {set parentindex [expr $index - 1]}
          if {$cfg($win,$item:group)} {
            if {$right} {
              if {$cfg($win,$item:open)} {incr index} {set cfg($win,$item:open) 1}
            } else {
              if {$cfg($win,$item:open)} {set cfg($win,$item:open) 0} {set index $parentindex}
            }
          } else {
            if {$right} {incr index} {set index $parentindex}
          }
          if {$index < 0} {set index end} elseif {$index >= [llength $cfg($win,sortlist)]} {set index 0}
          setselection $win [lindex $cfg($win,sortlist) $index]
          buildwhenidle $win
        }

        #### will return the pathname of the item at x and y cooridinates
        proc ::tktree::labelat {win x y} {
          set x [$win canvasx $x]; set y [$win canvasy $y]
          foreach m [$win find overlapping $x $y $x $y] {
            if {[info exists ::tktree::cfg($win,tag:$m)]} {return $::tktree::cfg($win,tag:$m)}
          }
          return ""
        }

        #### will return the path of the current selection in the given tree widget
        proc ::tktree::getselection {win} {
          return $::tktree::cfg($win,selection)
        }

        #### adjust the scrollview to show the selected item as needed
        proc ::tktree::scrolladjust {win tag} {
          update
          set item [$win bbox $tag]
          set region [$win cget -scrollregion]
          foreach {axis idx1 idx2} {yview 1 3 xview 0 2} {
            set range [expr abs([lindex $region $idx2]) - abs([lindex $region $idx1])]
            set itemtop [lindex $item $idx1];  set itembot [lindex $item $idx2]
            set viewtop [expr $range * [lindex [$win $axis] 0]]
            set viewbot [expr $range * [lindex [$win $axis] 1]]
            if {$itembot > $viewbot} {$win $axis moveto [expr ($itembot. - $viewbot + $viewtop) / $range]}
            if {$itemtop < $viewtop} {$win $axis moveto [expr $itemtop. / $range]}
          }
        }

        #### will set the current selection to the given item on the given tree
        proc ::tktree::setselection {win item} {
          variable cfg
          if {![llength $cfg($win,sortlist)]} {return}
          if {$item eq ""} {set item [lindex $cfg($win,sortlist) 0]}
          if {![info exists cfg($win,$item:tag)]} {set item [lindex $cfg($win,sortlist) 0]}
          if {[$win gettags $cfg($win,$item:tag)] ne ""} {
            $win select from $cfg($win,$item:tag) 0
            $win select to $cfg($win,$item:tag) end
            set cfg($win,selection) $item
            scrolladjust $win $cfg($win,$item:tag)
          } {
            setselection $win "/[lindex $cfg($win,/:sortlist) 0]"
          }
        }

        #### will delete the item given from the tree given
        proc ::tktree::delitem {win item} {
          variable cfg
          if {$item eq "/"} {
            array unset cfg $win,* ; catch {destroy $win}
          } {
            set group [file dirname $item]
            if {$cfg($win,$item:group)} {set type subgroups} {set type children}
            set index [lsearch -exact $cfg($win,$group:$type) $item]
            set cfg($win,$group:$type) [lreplace $cfg($win,$group:$type) $index $index]
            array unset cfg $win,$item*
            buildwhenidle $win
          }
        }

        #### create a new item in the tree and rebuild the widget
        proc ::tktree::newitem {win item args} {
          variable cfg
          if {[string index $item 0] ne "/"} {set item /$item}
          if {[string index $item end] eq "/"} {
            set subgroup 1
            set type subgroups
            set item [string range $item 0 end-1]
            set cfg($win,$item:command) [list ::tktree::switchstate $win $item]
          } {
            set subgroup 0
            set type children
            set cfg($win,$item:command) {}
          }
          #Build parent group if needed
          set group [file dirname $item]
          if {![info exists cfg($win,$group:open)]} {newitem $win "$group\/"}
          lappend cfg($win,$group:$type) $item
          #Configure the new item
          set cfg($win,$item:group) $subgroup
          set cfg($win,$item:subgroups) {}
          set cfg($win,$item:children) {}
          set cfg($win,$item:sortlist) {}
          set cfg($win,$item:tags) {}
          set cfg($win,$item:open) 0
          set cfg($win,$item:image) {}
          set cfg($win,$item:textcolor) $cfg($win,textcolor)
          set cfg($win,$item:font) $cfg($win,font)
          set cfg($win,$item:offset) 0
          if {$cfg($win,images)} {set cfg($win,$item:image) [eval list \$::tktree::img$type]}
          foreach {confitem confval} $args {
            switch -exact -- $confitem {
              -textcolor  {set cfg($win,$item:textcolor) $confval}
              -command    {set cfg($win,$item:command)   $confval}
              -image      {set cfg($win,$item:image)     $confval}
              -font       {set cfg($win,$item:font)      $confval}
              -displace   {set cfg($win,$item:displace)  $confval}
            }
          }
          buildwhenidle $win
        }

        #### Draw the given layer of the tree on the canvas starting at xposition
        proc ::tktree::buildlayer {win layer xpos} {
          variable cfg
          set displace $cfg($win,displace)
          #Record y positions for vertical line later on
          set ystart $cfg($win,y); set yend $cfg($win,y)
          if {$layer eq "/"} {set cfg($win,sortlist) ""}
          foreach child $cfg($win,$layer:sortlist) {
            lappend cfg($win,sortlist) $child
            #Check spacing required for images
            set imgwidth 0; set imgheight 0
            if {[string length $cfg($win,$child:image)]} {
              set imgwidth [expr  ([image width $cfg($win,$child:image)] + 2) / 2]
              set imgheight [expr ([image height $cfg($win,$child:image)] + 2) / 2]
            }
            #find X-axis points for image, horiz line, and text
            if {$imgwidth} {
              set centerX [expr $imgwidth + $xpos + 7]
              set rightX  [expr $xpos + 7]
              set textX   [expr {($imgwidth * 2) + $xpos + 10 + $cfg($win,displace)/3}]
            } {
              set centerX [expr $xpos + 10]
              set rightX  [expr $centerX + 4]
              set textX   [expr $rightX + 1]
            }
            #Find the proper amount to increment the y axis
            set fontheight [lindex [font metrics $cfg($win,$child:font)] 5]
            set yincr [expr ($fontheight + 1) / 2]
            if {$imgheight > $yincr} {set yincr $imgheight}
            incr cfg($win,y) $yincr
            #Draw the horizonal line
            $win create line $xpos $cfg($win,y) $rightX $cfg($win,y) -fill $cfg($win,linecolor)
            set yend $cfg($win,y)
            #Draw the image, if it exists
            if {$imgwidth} {
              set it [$win create image $centerX $cfg($win,y) -image $cfg($win,$child:image)]
              $win bind $it <1> [list ::tktree::setselection $win $child]
            }
            #Draw text and store tags for reference
            set cfg($win,$child:tag) [$win create text $textX $cfg($win,y) \
                -text [file tail $child] -font $cfg($win,$child:font) -anchor w -tags x -fill $cfg($win,$child:textcolor)]
            set cfg($win,tag:$cfg($win,$child:tag)) $child
            #Command binding
            $win bind $cfg($win,$child:tag) <1> [list ::tktree::setselection $win $child]
            $win bind $cfg($win,$child:tag) <Double-1> $cfg($win,$child:command)
            #next step up on the y axis
            incr cfg($win,y) $yincr
            #If its a group, add open-close functionality
            if {$cfg($win,$child:group)} {
              if {$cfg($win,$child:open)} {set img collapse} {set img expand}
              set ocimg [$win create image [expr {$xpos+$cfg($win,displace)}] [expr $cfg($win,y) - $yincr] -image [eval list \$::tktree::img$img]]
              $win bind $ocimg <1> [list ::tktree::switchstate $win $child]
              if {$cfg($win,$child:open)} {buildlayer $win $child $centerX}
            }
          }
          #Vertical line
          $win lower [$win create line $xpos [expr $ystart - 7] $xpos $yend -fill $cfg($win,linecolor)]
        }

        #### sort the layer by subgroups then children
        proc ::tktree::sortlayer {win {layer /}} {
          variable cfg
          set cfg($win,$layer:subgroups) [lsort -dictionary $cfg($win,$layer:subgroups)]
          set cfg($win,$layer:children) [lsort -dictionary $cfg($win,$layer:children)]
          set cfg($win,$layer:sortlist) [join [list $cfg($win,$layer:subgroups) $cfg($win,$layer:children)]]
          foreach group $cfg($win,$layer:subgroups) {sortlayer $win $group}
        }

        #### build the tree at the given path
        proc ::tktree::buildtree {win} {
          variable cfg
          $win delete all
          sortlayer $win
          set xpos 5
          set cfg($win,y) 5
          #Draw global expand/contract button, if needed
          if {[string length $cfg($win,/:subgroups)] && $cfg($win,expandall)} {
            set exp 0
            foreach subgroup $cfg($win,/:subgroups) {incr exp $cfg($win,$subgroup:open)}
            if {$exp} {set type collapse} {set type expand}
            set ocimg [$win create image 1 1 -image [eval list \$::tktree::img$type] -anchor w]
            $win bind $ocimg <1> [list ::tktree::switchlayer $win [expr ! $exp]]
          }
          #Build the layers and set initial selection
          buildlayer $win / $xpos
          $win config -scrollregion [$win bbox all]
          setselection $win $cfg($win,selection)
        }

        #### internal use - set up a handle to build the tree when everything is idle
        proc ::tktree::buildwhenidle {win} {
          catch {after cancel $::tktree::cfg($win,buildHandle)}
          set ::tktree::cfg($win,buildHandle) [after idle [list ::tktree::buildtree $win]]
        }

        #### will create a new tree widget at the given path
        proc ::tktree::treecreate {win args} {
          variable cfg
          #Default configuration for new tree
          set cfg($win,selection) {}
          set cfg($win,selidx)    {}
          set cfg($win,/:subgroups) {}
          set cfg($win,/:children) {}
          set cfg($win,/:open)     1
          set cfg($win,images)     1
          set cfg($win,expandall)  1
          set cfg($win,linecolor)  black
          set cfg($win,textcolor)  black
          set cfg($win,displace)   0
          set cfg($win,font) {-family Helvetica -size 10}
          #Parse and setup custom configuration options
          set canvascfg ""
          foreach {item val} $args {
            switch -- $item {
              -linecolor            {set cfg($win,linecolor) $val}
              -textcolor            {set cfg($win,textcolor) $val}
              -font                 {set cfg($win,font)      $val}
              -images               {set cfg($win,images)    $val}
              -expandall            {set cfg($win,expandall) $val}
              -displace             {set cfg($win,displace)  $val}
              default               {lappend canvascfg $item $val}
            }
          }
          #Build the canvas
          eval {canvas $win -takefocus 1 -highlightthickness 0 -highlightcolor #008080} $canvascfg
          bind $win <Destroy> [list ::tktree::delitem $win /]
          bind $win <1>  [list focus $win]
          bind $win <Return> {eval $::tktree::cfg(%W,[::tktree::getselection %W]:command)}
          bind $win <space> {eval $::tktree::cfg(%W,[::tktree::getselection %W]:command)}
          bind $win <Up>    [list ::tktree::updown $win 0]
          bind $win <Down>    [list ::tktree::updown $win 1]
          bind $win <Left>    [list ::tktree::leftright $win 0]
          bind $win <Right>    [list ::tktree::leftright $win 1]

          #Build the tree when idle
          buildwhenidle $win
        }
     }

     ## COMMANDS:
     ##    a quick note about arguements:
     ##     pathname = the qualified tk window pathname for the canvas widget
     ##     itempath = the full path for a tree item
     ##        the tree separtes groupings with a "/" therefore pathnames are as follows
     ##        /item1 is a child on the root of the tree
     ##        /goup1/ is a subgroup on the root level of the tree
     ##        /group1/group2/item1  is a child in the subgroup group2 of the subgroup group1
     ##
     ##  ::tktree::treecreate pathname [options]
     ##    will create a new tree widget with the given window pathname
     ##      optional arguments:
     ##        -linecolor            = The color of the branching lines (black)
     ##        -textcolor            = text color (black)
     ##        -font                 = the font for the text (Helvetica size 10)
     ##        -images               = set to 0 to disable images, defaults to 1
     ##        -expandall            = set to 0 to turn off the expand/collapse all button at the top
     ##    **All other arguements are passed to the canvas
     ##
     ##  ::tktree::newitem pathname itempath [options]
     ##    will create the new item given by itempath, and rebuild the widget
     ##        if an itempath is given with a group that does not exist, the group will be created
     ##      optional arguments:
     ##        -textcolor = the color for the text (defaults to the default tree color, see treecreate)
     ##        -command   = the command to be executed on a double-1 for the item
     ##                     if it is a group, the default command will open/close the group
     ##        -image     = the path of an image to be drawn as an icon for the item
     ##                        by default an image is drawn (folder or file)
     ##                        set the option to null for no image
     ##        -font      = font for the particular item (defaults to the default tree font, see treecreate)
     ##
     ##  ::tktree::delitem pathname itempath
     ##    will delete the item given and rebuild the widget
     ##    if the item is a group, all subgroups and children will also be deleted
     ##    if the item is root (/), then all elements of the tree will be deleted
     ##
     ##  ::tktree::labelat pathname xpos ypos
     ##    returns the name of the item at xpos and ypos coordinates
     ##
     ##  ::tktree::getselection pathname
     ##    returns the current sselection
     ##
     ##  ::tktree::setselection pathname itempath
     ##    set the current selection to the item given
     ##
     ## BINDINGS:
     ##  canvas <destroy>            delitem will be called for the root path
     ##  item <button-1>             will change the selection to the item under the cursor
     ##  plus/minus box <button-1>   on a group will change the state of that group (opened or closed)
     ##                              the plus/minus at the top of the widget will expand/collapse recursively
     ##  <double-1><Return><space>   all will launch the command specified for that item (groups switchstate by default)
     ##  <Up><Down><Left><Right>     navigation of the tree widget

    ::tktree::treecreate .tree -height 150 -width 120
    pack .tree -expand 1 -fill both -padx 5 -pady 5 -side left
    focus .tree
    foreach item {/group1/item1 /group1/item2 /group1/subgroup/item1 /group2/item1 /item1} {
        ::tktree::newitem .tree $item -command [list tk_messageBox -message "$item executed"]
    }

    ::tktree::treecreate .tree1 -displace 30 -height 150 -width 120
    pack .tree1 -expand 1 -fill both -padx 5 -pady 5 -side left
    focus .tree1
    foreach item {/group1/item1 /group1/item2 /group1/subgroup/item1 /group2/item1 /item1} {
        ::tktree::newitem .tree1 $item -command [list tk_messageBox -message "$item executed"]
    }
    ::tktree::treecreate .tree2 -displace 20 -height 150 -width 120
    pack .tree2 -expand 1 -fill both -padx 5 -pady 5 -side left
    focus .tree2
    foreach item {/group1/item1 /group1/item2 /group1/subgroup/item1 /group2/item1 /item1} {
        ::tktree::newitem .tree2 $item -command [list tk_messageBox -message "$item executed"]
    }

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References