appveyor.yml: update OpenSSL DLL paths
[jimtcl.git] / tree.tcl
blob38a0a94fdf1a202417b7f8b8f26874531786976b
1 # Conceptually compatible with tcllib ::struct::tree
2 # but uses an object based interface.
3 # To mimic tcllib, do:
4 # rename [tree] mytree
6 package require oo
8 # set pt [tree]
10 # Create a tree
11 # This automatically creates a node named "root"
13 # $pt destroy
15 # Destroy the tree and all it's nodes
17 # $pt set <nodename> <key> <value>
19 # Set the value for the given key
21 # $pt lappend <nodename> <key> <value> ...
23 # Append to the (list) value(s) for the given key, or set if not yet set
25 # $pt keyexists <nodename> <key>
27 # Returns 1 if the given key exists
29 # $pt get <nodename> <key>
31 # Returns the value associated with the given key
33 # $pt getall <nodename>
35 # Returns the entire attribute dictionary associated with the given key
37 # $pt depth <nodename>
39 # Returns the depth of the given node. The depth of "root" is 0.
41 # $pt parent <nodename>
43 # Returns the name of the parent node, or "" for the root node.
45 # $pt numchildren <nodename>
47 # Returns the number of child nodes.
49 # $pt children <nodename>
51 # Returns a list of the child nodes.
53 # $pt next <nodename>
55 # Returns the next sibling node, or "" if none.
57 # $pt insert <nodename> ?index?
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
63 # $pt delete <nodename>
65 # Delete the given node and all it's children.
67 # $pt walk <nodename> dfs|bfs {actionvar nodevar} <code>
69 # Walks the tree starting from the given node, either breadth first (bfs)
70 # depth first (dfs).
71 # The value "enter" or "exit" is stored in variable $actionvar
72 # The name of each node is stored in $nodevar.
73 # The script $code is evaluated twice for each node, on entry and exit.
75 # $pt dump
77 # Dumps the tree contents to stdout
79 #------------------------------------------
80 # Internal implementation.
81 # The tree class has 4 instance variables.
82 # - tree is a dictionary. key=node, value=node value dictionary
83 # - parent is a dictionary. key=node, value=parent of this node
84 # - children is a dictionary. key=node, value=list of child nodes for this node
85 # - nodeid is an integer which increments to give each node a unique id
87 # Construct a tree with a single root node with no parent and no children
88 class tree {
89 tree {root {}}
90 parents {root {}}
91 children {root {}}
92 nodeid 0
95 # Simply walk up the tree to get the depth
96 tree method depth {node} {
97 set depth 0
98 while {$node ne "root"} {
99 incr depth
100 set node [dict get $parents $node]
102 return $depth
105 tree method parent {node} {
106 dict get $parents $node
109 tree method children {node} {
110 dict get $children $node
113 tree method numchildren {node} {
114 llength [dict get $children $node]
117 tree method next {node} {
118 # My siblings are my parents children
119 set siblings [dict get $children [dict get $parents $node]]
120 # Find me
121 set i [lsearch $siblings $node]
122 incr i
123 lindex $siblings $i
126 tree method set {node key value} {
127 dict set tree $node $key $value
128 return $value
131 tree method get {node key} {
132 dict get $tree $node $key
135 tree method keyexists {node key} {
136 dict exists $tree $node $key
139 tree method getall {node} {
140 dict get $tree $node
143 tree method insert {node {index end}} {
145 # Make a new node and add it to the tree
146 set childname node[incr nodeid]
147 dict set tree $childname {}
149 # The new node has no children
150 dict set children $childname {}
152 # Set the parent
153 dict set parents $childname $node
155 # And add it as a child
156 set nodes [dict get $children $node]
157 dict set children $node [linsert $nodes $index $childname]
159 return $childname
162 tree method delete {node} {
163 if {$node eq "root"} {
164 return -code error "can't delete root node"
166 $self walk $node dfs {action subnode} {
167 if {$action eq "exit"} {
168 # Remove the node
169 dict unset tree $subnode
170 # And remove as a child of our parent
171 set parent [$self parent $subnode]
172 if {$parent ne ""} {
173 set siblings [dict get $children $parent]
174 set i [lsearch $siblings $subnode]
175 dict set children $parent [lreplace $siblings $i $i]
182 tree method lappend {node key args} {
183 if {[dict exists $tree $node $key]} {
184 set result [dict get $tree $node $key]
186 lappend result {*}$args
187 dict set tree $node $key $result
188 return $result
191 # $tree walk node bfs|dfs {action loopvar} <code>
193 tree method walk {node type vars code} {
194 # set up vars
195 lassign $vars actionvar namevar
197 set n $node
199 if {$type ne "child"} {
200 upvar 2 $namevar name $actionvar action
202 # Enter this node
203 set name $node
204 set action enter
206 uplevel 2 $code
209 if {$type eq "dfs"} {
210 # Depth-first so do the children
211 foreach child [$self children $n] {
212 uplevel 2 [list $self walk $child $type $vars $code]
214 } elseif {$type ne "none"} {
215 # Breadth-first so do the children to one level only
216 foreach child [$self children $n] {
217 uplevel 2 [list $self walk $child none $vars $code]
220 # Now our grandchildren
221 foreach child [$self children $n] {
222 uplevel 2 [list $self walk $child child $vars $code]
226 if {$type ne "child"} {
227 # Exit this node
228 set name $node
229 set action exit
231 uplevel 2 $code
235 tree method dump {} {
236 $self walk root dfs {action n} {
237 set indent [string repeat " " [$self depth $n]]
238 if {$action eq "enter"} {
239 puts "$indent$n ([$self getall $n])"
242 puts ""