Version 7 of dictree

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

Example Usage:

    # a sample dict with some data:
    dict set d author "Alexander Mlynski-Wiese"
    dict set d data   "2012-12-21"

    # 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 dictionaries whereever possible.

If you do not want this interpretation for any node, just press ALT and click the node with the mouse, and it will collapse into a leaf. Click again to show it as a node with childs 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 store the content into 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

dictree.tcl

package require Tk
package provide dictree        1.0

namespace eval dictree {
}

#-------------------------------------------------------------------------------
#  dictree w d
#  create a treeview widget and fill it with the dict data
#-------------------------------------------------------------------------------
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"
    }

    entry $w.e

    set parent ""
    dict for {key val} $d {
        dictree::addNode $w $parent $key $val
    }

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

    grid $w.sby  -row 0 -column 1 -sticky ns
    grid $w.sbx  -row 1 -column 0 -sticky ew
    grid rowconfigure          $w 0 -weight 1
    grid columnconfigure $w 0 -weight 1

    dictree::bindings $w

    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 {
#-------------------------------------------------------------------------------
#  bindings                create the bindings for the treeview
#-------------------------------------------------------------------------------
proc bindings { w { debug 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 }

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

    if { $debug } {
        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 fill 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 dictionary and create a subnode
        dict for {key val} $d {
            addNode $w $node $key $val
        }
    } errmsg ] } {
        # make node a leaf
        $w set $node value $d
    }
}

#-------------------------------------------------------------------------------
#  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        between collapse / expand
#-------------------------------------------------------------------------------
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         the hierarchy one level up (left) or down (right)
#-------------------------------------------------------------------------------
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 node
#-------------------------------------------------------------------------------
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 (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
#-------------------------------------------------------------------------------
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"
}

#-------------------------------------------------------------------------------
#  nopen                node open/close
#-------------------------------------------------------------------------------
proc nopen { w items mode } {
    foreach item $items {
        $w item $item -open $mode
    }
}

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

#-------------------------------------------------------------------------------
#  end of namespace
#-------------------------------------------------------------------------------
}

#-------------------------------------------------------------------------------
#  "main" function if this module is not used as a library
#-------------------------------------------------------------------------------
if { [info exist argv0] && [info script] == $argv0 } {

    # read dict from file
    set h [open [lindex $argv 0] "r"]
    set d [read $h]
    close $h

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

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

Category Command

Category GUI