dictree

AMW Inspired by eDictor, today I created the dictree megawidget using a ttk::treeview to display and 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.

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
Shift+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]

Possible Enhancements

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 args } {

    frame $w
    ttk::treeview $w.t -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.t yview"
        ttk::scrollbar ${w}.sbx -orient horizontal -command "$w.t xview"
    } else {
        scrollbar ${w}.sby -orient vertical   -command "$w.t yview"
        scrollbar ${w}.sbx -orient horizontal -command "$w.t xview"
    }

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

    entry $w.e                                        ;# widget used for editing

    grid $w.t    -row 0 -column 0 -sticky news
    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.t                        ;# create the bindings

    dict for {key val} $d {                        ;# populate the treeview
        dictree::addNode $w.t "" $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.t $args }
            default {
                if { [catch {
                    uplevel 1 _$self $cmd $args
                } ] } {
                    uplevel 1 $self.t $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-plus>          { dictree::expand   %W [%W selection] }
    bind $w <Alt-minus>         { dictree::collapse %W [%W selection] }

    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 <Shift-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::rise %W [%W selection]  1; break }
    bind $w <Alt-Right>         { dictree::rise %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]
    set isdict 0
    catch {
        if { [dict get $d] == $d } {
            set isdict 1
        }
    }
    if { $isdict} {
        # interpret data $d as a dictionary and create a subnode
        dict for {key val} $d {
            addNode $w $node $key $val
        }
    } else {
        # $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 items } {
    foreach item $items {
        set children ""
        catch { set children [$w children $item] }
        if { $children != "" } {
            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 items } {
    global errorInfo
    foreach item $items {
        if { [$w children $item] == "" } {
            set d [$w set $item value]
            set isdict 0
            catch {
                if { [dict get $d] == $d } {
                    set isdict 1
                }
            }
            if { $isdict} {
                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
}

#-------------------------------------------------------------------------------
#  adopt                move item to new parent
#-------------------------------------------------------------------------------
proc adopt { w item newparent newindex } {
    set name [$w item $item -text]
    set children [$w children $newparent]
    if { $children == "" } {
        return 0
    }
    foreach child $children {
        if { $name == [$w item $child -text] } {
            # not allowed: parent already has a child with that name
            return 0
        }
    }
    $w move $item $newparent $newindex
    $w item $newparent -open 1
    return 1
}

#-------------------------------------------------------------------------------
#  rise                 rise/fall one level in the hierarchy
#-------------------------------------------------------------------------------
proc rise { w item increment } {
    if { $item == "" || [llength $item] != 1 } { return }
    set parent  [$w parent $item]

    if { $increment > 0 } {
        # rise in the hierarchy, make my grandpa my new parent
        set newparent [$w parent $parent]        ;# grandpa
        set newindex  [$w index  $parent]
        incr newindex                                ;# behind my old parent
        adopt $w $item $newparent $newindex

    } else {
        # fall 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 { $brother != "" } {
            if { [adopt $w $item $brother end] } {
                return
            }
        }
        foreach brother $brothers {
            if { $brother != $item } {
                if { [adopt $w $item $brother end] } {
                    return
                }
            }
        }
    }
}

#-------------------------------------------------------------------------------
#  edit                 edit node text or value
#-------------------------------------------------------------------------------
proc edit { w item column { next "" } } {
    global dictree
    if { $item == "" || [llength $item] != 1 } { return }
    foreach {bx by bw bh} [$w bbox $item $column] {}
    set ym [expr $by + $bh/2]
    while { $bx < 50 && [$w identify element $bx $ym] != "text" } {
        incr bx
        incr bw -1
    }

    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]
    }
    set parent [winfo parent $w ] 
    if { [catch {
        place $parent.e -x $bx -y $by -width $bw -height $bh
    } ] } {
        return
    }
    $parent.e configure -textvariable dictree($w,text)        \
                       -validate key         \
                       -validatecommand "dictree::edit_check $parent $item $column %P"
    if { $dictree($w,text) == "(new)" } {
        $parent.e selection range 0 end
    } else {
        $parent.e selection clear
    }
    $parent.e configure -background white
    $parent.e icursor end
    focus $parent.e
    grab  $parent.e
    bind  $parent.e <Return> "dictree::edit_done $w $item $column $next"
    bind  $parent.e <Escape> "dictree::edit_done $w $item {} $next"
}

#-------------------------------------------------------------------------------
#  edit_check                check if name is allowed
#-------------------------------------------------------------------------------
proc edit_check { w item column value } {
    global dictree
    set ok 1
    if { $column == "#0" } {
        set parent [$w parent $item]
        foreach child [$w children $parent] {
            if { $child != $item &&
                    [$w item $child -text] == $value } {
                    set ok 0
            }
        }
        set parent [winfo parent $w ] 
        if { ! $ok } {
            $w.e configure -background red
        } else {
            $w.e configure -background white
        }
    }
    return 1
}

#-------------------------------------------------------------------------------
#  edit_done                finish editing
#-------------------------------------------------------------------------------
proc edit_done { w item {column "" } { next "" } } {
    global dictree
    set parent [winfo parent $w ] 
    if { $column != "" && [$parent.e cget -background] == "red" } {
        return
    }

    grab release $parent.e
    focus $w
    if { $column == "#0" } {
        $w item $item -text $dictree($w,text)
    } elseif { $column != "" } {
        $w set $item $column $dictree($w,text)
    }
    place forget $parent.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 ""
    file stat $dir fstat
    foreach item [lsort [array names fstat]] {
        dict set d . $item $fstat($item)
    }
    foreach subdir [lsort [glob -directory $dir -nocomplain -types d "*"]] {
        dict set d {*}[dictdir $subdir]
    }
    foreach fname [lsort [glob -directory $dir -nocomplain -types f "*"]] {
        file stat $fname fstat
        # sorted:
        foreach item [lsort [array names fstat]] {
            dict set d [file tail $fname] $item $fstat($item)
        }
        # faster but unsorted:
        # dict set d [file tail $fname] [array get fstat]
    }
    return [list [file tail $dir]/ $d]
}

#-------------------------------------------------------------------------------
#  main                        "main" for demo program
#-------------------------------------------------------------------------------
proc main { 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::main {*}$argv
}

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

Small error in editing

    entry $w.e                                        ;# widget used for editing

Should be

    entry $w.t.e                                        ;# widget used for editing

Bezoar 4/7/2016

I made the edits for the errors above in the code to allow the widget to work right out of the box. I also changed binding to edit value from Alt-F2 to Shift-F2

Category Command

Category Editor utility

Category GUI

Category Widget