Version 27 of dictree

Updated 2012-12-22 08:58:24 by amw

AMW Inspired by eDictor, today I created the dictree megawidget using a ttk::treeview to edit the content of a dict.

Example Usage:

    # create a sample dict with some data:
    dict set d author firstname "Alexander"
    dict set d author surname   "Mlynski-Wiese"
    dict set d date   "2012-12-21"
    dict set d prog name    "dictree"
    dict set d prog version 1.1
    # --> author {firstname Alexander surname Mlynski-Wiese} date 2012-12-21 prog {name dictree version 1.1}

    # create the widget and populate it with the dict data:
    dictree .t $d

    # display the widget:
    pack .t -expand yes -fill both

The widget will dive as deeply as possible into the data by interpreting it as nested dictionary whereever possible.

dictree_screenshot

If you do not want this kind interpretation for any node, just press Alt and click on the node with the mouse, and it will collapse into a leaf.
Click again to expand it to a node with children again.

Alternatively, press Alt+Enter to collapse/expand the selected node in this sense.

The following keys allow modification of the data:

  • Alt+Up/Down moves the selected node up or down within it's current hierarchy level
  • Alt+Left/Right raises or lowers the selected node to the next hierarchy level
  • F2 will allow modification of the selected node's name
  • Alt+F2 will allow to edit the selected node's value (only if it is a leaf)
  • Delete will delete the selected node(s)
  • Insert will insert a new node as a sibbling before the selected node
  • Alt+Insert will insert a new node as a sibbling after the selected node

After editing, you can 'reap' the tree to return the content as a dict:

    set edited_d [.t reap]

To Do

  • prevent creation of identical-named nodes on same level, as they cannot be reaped into a dict
  • on right-button click, show a context menue to add/delete/edit/move the node
  • drag and drop of node

Code

The code below can be used

  • as a package within other projects, or
  • as a standalone application
    • to display a dict loaded from a file
    • to fill a demo dictionary with directory information and display it using dictree

  dictree.tcl
#===============================================================================
#  dictree widget        display and edit dictionary data in ttk::treeview
#
#  21.12.2012, Alexander Mlynski-Wiese
#===============================================================================

package require Tcl                8.5
package require Tk
package require Ttk

package provide dictree                1.0

#-------------------------------------------------------------------------------
#  dictree w d
#  create a treeview widget with the pathname $w
#  and fill it with the dictionary data $d
#-------------------------------------------------------------------------------
proc dictree { w d } {

    ttk::treeview $w -columns {key value} -displaycolumns value        \
                -yscroll "${w}.sby set" -xscroll "${w}.sbx set"

    if {[tk windowingsystem] ne "aqua"} {
        ttk::scrollbar ${w}.sby -orient vertical   -command "$w yview"
        ttk::scrollbar ${w}.sbx -orient horizontal -command "$w xview"
    } else {
        scrollbar ${w}.sby -orient vertical   -command "$w yview"
        scrollbar ${w}.sbx -orient horizontal -command "$w xview"
    }

    $w heading \#0   -text "Directory Key(s)"
    $w heading value -text "Value"

    entry $w.e                                        ;# widget used for editing

    grid $w.sby  -row 0 -column 1 -sticky ns        ;# arrange the scrollbars
    grid $w.sbx  -row 1 -column 0 -sticky ew
    grid rowconfigure          $w 0 -weight 1
    grid columnconfigure $w 0 -weight 1

    dictree::bindings $w                        ;# create the bindings

    dict for {key val} $d {                        ;# populate the treeview
        dictree::addNode $w "" $key $val
    }

    #-----------------------------------------------------------------------
    #  "overload" the widget proc to support additional commands
    #-----------------------------------------------------------------------
    rename $w _$w
    proc $w {cmd args} {
        set self [lindex [info level 0] 0] ;# get name I was called with
        switch -- $cmd {
            reap    {uplevel 1 dictree::reap $self $args }
            default {uplevel 1 _$self $cmd $args}
        }
    }

    return $w
}

namespace eval dictree {        ;# "private" functions
#-------------------------------------------------------------------------------
#  bindings                create the bindings for the treeview
#-------------------------------------------------------------------------------
proc bindings { w { debug 0 } } {

    bind $w <plus>              { dictree::setopen %W [%W selection] 1 }
    bind $w <minus>             { dictree::setopen %W [%W selection] 0 }

    bind $w <Alt-ButtonPress-1> { dictree::toggle %W [%W identify item %x %y] }
    bind $w <Alt-Return>        { dictree::toggle %W [%W selection]; break }

    bind $w <F2>                { dictree::edit %W [%W selection] "#0" }
    bind $w <Alt-F2>            { dictree::edit %W [%W selection] "value" }

    bind $w <Alt-Up>            { dictree::move %W [%W selection] -1; break }
    bind $w <Alt-Down>          { dictree::move %W [%W selection]  1; break }

    bind $w <Alt-Left>          { dictree::jump %W [%W selection]  1; break }
    bind $w <Alt-Right>         { dictree::jump %W [%W selection] -1; break }

    bind $w <Delete>            { dictree::delete %W [%W selection] }
    bind $w <Insert>            { dictree::insert %W [%W selection] }
    bind $w <Alt-Insert>        { dictree::insert %W [%W selection] 1 }

    if { $debug } {
        # to aid developing additional bindings:
        bind $w <ButtonPress-1> {
            set item [%W identify item %x %y]
            puts "%x,%y: %W item $item: [%W item $item]"
        }
        bind $w <KeyPress> { puts %K }
    }

    return $w
}

#-------------------------------------------------------------------------------
#  addNode                recursive proc to create and fill the nodes
#-------------------------------------------------------------------------------
proc addNode { w parent title d } {
    set node [$w insert $parent end -text $title]
    if { [catch {
        # try to interpret data $d as a dictionary and create a subnode
        dict for {key val} $d {
            addNode $w $node $key $val
        }
    } errmsg ] } {
        # $d is not a dictionary: make this node a leaf
        $w set $node value $d
    }
}

#-------------------------------------------------------------------------------
#  setopen                open/close node(s)
#-------------------------------------------------------------------------------
proc setopen { w items mode } {
    foreach item $items {
        $w item $item -open $mode
    }
}

#-------------------------------------------------------------------------------
#  collapse                collapse all child nodes and make node $item a leaf
#-------------------------------------------------------------------------------
proc collapse { w item } {
    if { [$w children $item] != "" } {
        set value ""
        foreach child [$w children $item] {
            collapse $w $child
            lappend value [$w item $child -text]
            lappend value [$w set $child value]
            $w delete $child
        }
        $w set $item value $value
    }
}

#-------------------------------------------------------------------------------
#  expand                 if possible, expand leaf value to child nodes
#-------------------------------------------------------------------------------
proc expand { w item } {
    global errorInfo
    if { [$w children $item] == "" } {
        set d [$w set $item value]
        catch {
            dict for {key val} $d {
                addNode $w $item $key $val
            }
            $w set $item value ""
        }
    }
}

#-------------------------------------------------------------------------------
#  toggle                toggle node(s) between collapsed / expanded
#-------------------------------------------------------------------------------
proc toggle { w items } {
    foreach item $items {
        if { [$w children $item] != "" } {
            collapse $w $item
        } else {
            expand $w $item
        }
    }
}

#-------------------------------------------------------------------------------
#  move                        move node up/down among siblings, i.e. keep parent node
#-------------------------------------------------------------------------------
proc move { w item increment } {
    if { $item == "" || [llength $item] != 1 } { return }
    set parent [$w parent $item]
    set index  [$w index  $item]
    incr index $increment
    $w move $item $parent $index
}

#-------------------------------------------------------------------------------
#  jump                 rise/fall one level in the hierarchy
#-------------------------------------------------------------------------------
proc jump { w item increment } {
    if { $item == "" || [llength $item] != 1 } { return }
    set parent  [$w parent $item]
    if { $increment > 0 } {
        # raise in the hierarchy, make my grandpa my new parent
        set grandpa [$w parent $parent]
        set index   [$w index  $parent]
           $w move $item $grandpa [expr $index + 1]
        $w item $grandpa -open 1

    } else {
        # drop in the hierarchy, make a brother my new parent
        set index    [$w index $item]
        set brothers [$w children $parent]
        set brother  [lindex $brothers [expr $index-1]]
        if { [$w children $brother] == "" } {
            foreach brother $brothers {
                if { $brother != $item &&
                     [$w children $brother] != "" } {
                    break
                }
            }
        }
        if { $brother != $item && [$w children $brother] != "" } {
            $w move $item $brother end
            $w item $brother -open 1
        }
    }
}

#-------------------------------------------------------------------------------
#  edit                 edit node text or value
#-------------------------------------------------------------------------------
proc edit { w item column { next "" } } {
    global dictree
    if { $item == "" || [llength $item] != 1 } { return }
    foreach {x y width height} [$w bbox $item $column] {}

    if { $column == "#0" } {
        set dictree($w,text) [$w item $item -text]
    } elseif { [$w children $item] != "" } {
        return
    } else {
        set dictree($w,text) [$w set $item $column]
    }
    if { [catch {
        place $w.e -x $x -y $y -width $width -height $height
    } ] } {
        return
    }
    $w.e configure -textvariable dictree($w,text)
    if { $dictree($w,text) == "(new)" } {
        $w.e selection range 0 end
    }
    focus $w.e
    grab  $w.e
    bind  $w.e <Return> "dictree::edit_done $w $item $column $next"
    bind  $w.e <Escape> "dictree::edit_done $w $item {} $next"
}

#-------------------------------------------------------------------------------
#  edit_done                finish editing
#-------------------------------------------------------------------------------
proc edit_done { w item {column "" } { next "" } } {
    global dictree
    grab release $w.e
    focus $w
    if { $column == "#0" } {
        $w item $item -text $dictree($w,text)
    } elseif { $column != "" } {
        $w set $item $column $dictree($w,text)
    }
    place forget $w.e
    if { $next != "" } {
        if { $column == "" } {
            $w delete $item
            $w selection set $dictree($w,selection)
        } else {
            edit $w $item $next
        }
    }
    unset dictree($w,text)
    catch { unset dictree($w,selection) }
}

#-------------------------------------------------------------------------------
#  delete                delete node(s) (after confirmation)
#-------------------------------------------------------------------------------
proc delete { w items } {
    set count [llength $items]
    set msg "Do you really want to delete the following "
    if { $count > 1 } {
        append msg "$count nodes:\n"
    } else {
        append msg "node:\n"
    }
    foreach item $items {
        append msg " [$w item $item -text]"
    }
    append msg "?"
    if { [tk_messageBox -title "Delete nodes" \
                    -icon warning -message $msg -type yesno] == "yes" } {
                $w delete $items
    }
}

#-------------------------------------------------------------------------------
#  insert                insert & edit new node before/after given node
#-------------------------------------------------------------------------------
proc insert { w item { offset 0 } } {
    global dictree
    if { $item == "" || [llength $item] != 1 } { return }

    set dictree($w,selection) [$w selection]

    set parent [$w parent $item]
    set index  [$w index  $item]

    set newidx [expr $index + $offset]
    set node [$w insert $parent $newidx -text "(new)"]
    $w set $node value "(new)"
    $w selection set $node
    edit $w $node "#0" "value"
}

#-------------------------------------------------------------------------------
#  reap                        return the content of the treeview as dictionary
#-------------------------------------------------------------------------------
proc reap { w { node "" } } {
    set children [$w children $node]
    if { [llength $children] == 0 } {
        set value [$w set $node value]
        dict set d [$w item $node -text] $value
    } else {
        foreach child $children {
            set value [reap $w $child]
            if { $node == "" } {
                lappend d {*}$value
            } else {
                dict lappend d [$w item $node -text] {*}$value
            }
        }
    }
    return $d
}

#-------------------------------------------------------------------------------
#  dictdir                generate example dict with filesystem info
#-------------------------------------------------------------------------------
proc dictdir { dir } {
    set d ""
    foreach subdir [lsort [glob -directory $dir -nocomplain -types d "*"]] {
        dict set d [file tail $dir]/ [dictdir $subdir]
    }
    foreach fname [lsort [glob -directory $dir -nocomplain -types f "*"]] {
        file stat $fname fstat
        # unsorted but faster:
        # dict set d [file tail $dir]/ [file tail $fname] [array get fstat]
        # sorted:
        foreach item [lsort [array names fstat]] {
            dict set d [file tail $dir]/ [file tail $fname] $item $fstat($item)
        }
    }
    return $d
}

#-------------------------------------------------------------------------------
#  example                use as "main" for a demo program
#-------------------------------------------------------------------------------
proc example { args } {
    set fname [pwd]                                ;# default to current dir
    if { [llength $args] >= 1 } {                ;# check for commandline arg
        set fname [lindex $args 0]
    }
    if { [file isdirectory $fname] } {                ;# directory was given:
        set d [dictdir $fname]                        ;# parse directory

    } else {                                        ;# file was given:
        set h [open [lindex $args 0] "r"]        ;# read dict from file
        set d [read $h]
        close $h
    }

    # create dictree control:
    dictree .t $d
    pack .t -expand yes -fill both
}

#-------------------------------------------------------------------------------
#  end of namespace dict::
#-------------------------------------------------------------------------------
}

#-------------------------------------------------------------------------------
#  "main" function: run demo if this module is called rather than sourced
#-------------------------------------------------------------------------------
if { [info exist argv0] && [info script] == $argv0 } {
    dictree::example {*}$argv
}

#-------------------------------------------------------------------------------
#  end of file
#-------------------------------------------------------------------------------