tree: Allow nodes to be deleted

Signed-off-by: Steve Bennett <steveb@workware.net.au>

2 files changed, 39 insertions, 0 deletions

diff --git a/tests/tree.test b/tests/tree.test
index 5a7cf74..22a16f5 100644
--- a/tests/tree.test
+++ b/tests/tree.test
@@ -110,6 +110,21 @@ test tree-2.3 "walk bfs" {
 	set result
 } {rootnode childnode1 root.c2 root.c3 childnode2 n.c4 n.c5 n.c5.c6}
 
+test tree-3.1 "delete nodes" {
+	$pt delete node6
+	set result {}
+	$pt walk root bfs {action n} {
+		if {$action == "enter"} {
+			lappend result [$pt get $n name]
+		}
+	}
+	set result
+} {rootnode childnode1 root.c2 root.c3 childnode2 n.c4}
+
+test tree-3.2 "can't delete root node" -body {
+	$pt delete root
+} -returnCodes error -result {can't delete root node}
+
 $pt destroy
 
 testreport
diff --git a/tree.tcl b/tree.tcl
index d897c51..38a0a94 100644
--- a/tree.tcl
+++ b/tree.tcl
@@ -60,6 +60,10 @@ package require oo
 #   THe default index is "end"
 #   Returns the name of the newly added node
 #
+# $pt delete <nodename>
+#
+#   Delete the given node and all it's children.
+#
 # $pt walk <nodename> dfs|bfs {actionvar nodevar} <code>
 #
 #   Walks the tree starting from the given node, either breadth first (bfs)
@@ -155,6 +159,26 @@ tree method insert {node {index end}} {
 	return $childname
 }
 
+tree method delete {node} {
+	if {$node eq "root"} {
+		return -code error "can't delete root node"
+	}
+	$self walk $node dfs {action subnode} {
+		if {$action eq "exit"} {
+			# Remove the node
+			dict unset tree $subnode
+			# And remove as a child of our parent
+			set parent [$self parent $subnode]
+			if {$parent ne ""} {
+				set siblings [dict get $children $parent]
+				set i [lsearch $siblings $subnode]
+				dict set children $parent [lreplace $siblings $i $i]
+			}
+		}
+	}
+}
+
+
 tree method lappend {node key args} {
 	if {[dict exists $tree $node $key]} {
 		set result [dict get $tree $node $key]