From 59f01cb74b4b6f8c32cc4083735050b233ad4380 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Fri, 2 Jun 2017 12:10:27 +1000
Subject: tree: Allow nodes to be deleted

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 tree.tcl | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

(limited to 'tree.tcl')

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]
-- 
cgit v1.1