release/src/router/usbmodeswitch/jim/tree.tcl

   1 # Conceptually compatible with tcllib ::struct::tree
   2 # but uses an object based interface.
   3 # To mimic tcllib, do:
   4 #   rename [tree] mytree
   5
   6 package require oo
   7
   8 # set pt [tree]
   9 #
  10 #   Create a tree
  11 #   This automatically creates a node named "root"
  12 #
  13 # $pt destroy
  14 #
  15 #   Destroy the tree and all it's nodes
  16 #
  17 # $pt set <nodename> <key> <value>
  18 #
  19 #   Set the value for the given key
  20 #
  21 # $pt lappend <nodename> <key> <value> ...
  22 #
  23 #   Append to the (list) value(s) for the given key, or set if not yet set
  24 #
  25 # $pt keyexists <nodename> <key>
  26 #
  27 #   Returns 1 if the given key exists
  28 #
  29 # $pt get <nodename> <key>
  30 #
  31 #   Returns the value associated with the given key
  32 #
  33 # $pt getall <nodename>
  34 #
  35 #   Returns the entire attribute dictionary associated with the given key
  36 #
  37 # $pt depth <nodename>
  38 #
  39 #   Returns the depth of the given node. The depth of "root" is 0.
  40 #
  41 # $pt parent <nodename>
  42 #
  43 #   Returns the name of the parent node, or "" for the root node.
  44 #
  45 # $pt numchildren <nodename>
  46 #
  47 #   Returns the number of child nodes.
  48 #
  49 # $pt children <nodename>
  50 #
  51 #   Returns a list of the child nodes.
  52 #
  53 # $pt next <nodename>
  54 #
  55 #   Returns the next sibling node, or "" if none.
  56 #
  57 # $pt insert <nodename> ?index?
  58 #
  59 #   Add a new child node to the given node.
  60 #   THe default index is "end"
  61 #   Returns the name of the newly added node
  62 #
  63 # $pt walk <nodename> dfs|bfs {actionvar nodevar} <code>
  64 #
  65 #   Walks the tree starting from the given node, either breadth first (bfs)
  66 #   depth first (dfs).
  67 #   The value "enter" or "exit" is stored in variable $actionvar
  68 #   The name of each node is stored in $nodevar.
  69 #   The script $code is evaluated twice for each node, on entry and exit.
  70 #
  71 # $pt dump
  72 #
  73 #   Dumps the tree contents to stdout
  74
  75 #------------------------------------------
  76 # Internal implementation.
  77 # The tree class has 4 instance variables.
  78 # - tree is a dictionary. key=node, value=node value dictionary
  79 # - parent is a dictionary. key=node, value=parent of this node
  80 # - children is a dictionary. key=node, value=list of child nodes for this node
  81 # - nodeid is an integer which increments to give each node a unique id
  82
  83 # Construct a tree with a single root node with no parent and no children
  84 class tree {
  85         tree {root {}}
  86         parents {root {}}
  87         children {root {}}
  88         nodeid 0
  89 }
  90
  91 # Simply walk up the tree to get the depth
  92 tree method depth {node} {
  93         set depth 0
  94         while {$node ne "root"} {
  95                 incr depth
  96                 set node [dict get $parents $node]
  97         }
  98         return $depth
  99 }
 100
 101 tree method parent {node} {
 102         dict get $parents $node
 103 }
 104
 105 tree method children {node} {
 106         dict get $children $node
 107 }
 108
 109 tree method numchildren {node} {
 110         llength [dict get $children $node]
 111 }
 112
 113 tree method next {node} {
 114         # My siblings are my parents children
 115         set siblings [dict get $children [dict get $parents $node]]
 116         # Find me
 117         set i [lsearch $siblings $node]
 118         incr i
 119         lindex $siblings $i
 120 }
 121
 122 tree method set {node key value} {
 123         dict set tree $node $key $value
 124         return $value
 125 }
 126
 127 tree method get {node key} {
 128         dict get $tree $node $key
 129 }
 130
 131 tree method keyexists {node key} {
 132         dict exists $tree $node $key
 133 }
 134
 135 tree method getall {node} {
 136         dict get $tree $node
 137 }
 138
 139 tree method insert {node {index end}} {
 140
 141         # Make a new node and add it to the tree
 142         set childname node[incr nodeid]
 143         dict set tree $childname {}
 144
 145         # The new node has no children
 146         dict set children $childname {}
 147
 148         # Set the parent
 149         dict set parents $childname $node
 150
 151         # And add it as a child
 152         set nodes [dict get $children $node]
 153         dict set children $node [linsert $nodes $index $childname]
 154
 155         return $childname
 156 }
 157
 158 tree method lappend {node key args} {
 159         if {[dict exists $tree $node $key]} {
 160                 set result [dict get $tree $node $key]
 161         }
 162         lappend result {*}$args
 163         dict set tree $node $key $result
 164         return $result
 165 }
 166
 167 # $tree walk node bfs|dfs {action loopvar} <code>
 168 #
 169 tree method walk {node type vars code} {
 170         # set up vars
 171         lassign $vars actionvar namevar
 172
 173         set n $node
 174
 175         if {$type ne "child"} {
 176                 upvar 2 $namevar name $actionvar action
 177
 178                 # Enter this node
 179                 set name $node
 180                 set action enter
 181
 182                 uplevel 2 $code
 183         }
 184
 185         if {$type eq "dfs"} {
 186                 # Depth-first so do the children
 187                 foreach child [$self children $n] {
 188                         uplevel 2 [list $self walk $child $type $vars $code]
 189                 }
 190         } elseif {$type ne "none"} {
 191                 # Breadth-first so do the children to one level only
 192                 foreach child [$self children $n] {
 193                         uplevel 2 [list $self walk $child none $vars $code]
 194                 }
 195
 196                 # Now our grandchildren
 197                 foreach child [$self children $n] {
 198                         uplevel 2 [list $self walk $child child $vars $code]
 199                 }
 200         }
 201
 202         if {$type ne "child"} {
 203                 # Exit this node
 204                 set name $node
 205                 set action exit
 206
 207                 uplevel 2 $code
 208         }
 209 }
 210
 211 tree method dump {} {
 212         $self walk root dfs {action n} {
 213                 set indent [string repeat "  " [$self depth $n]]
 214                 if {$action eq "enter"} {
 215                         puts "$indent$n ([$self getall $n])"
 216                 }
 217         }
 218         puts ""
 219 }