From 8a21e1c0ea44a829f84e526a8302e6effbc4a9b1 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Wed, 3 Mar 2010 16:02:25 +1000
Subject: Improvements to tailcall

Add tests and documentation
Make tailcall work within 'try'
Fix tailcall interaction with uplevel
Use tailcall for dispatch in tree.tcl
Also some related improvements in tree.tcl

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

(limited to 'tree.tcl')

diff --git a/tree.tcl b/tree.tcl
index c534f85..6b961c7 100644
--- a/tree.tcl
+++ b/tree.tcl
@@ -70,12 +70,12 @@ proc tree {action handle} {
 	# and other nodes are automatically named "node1", "node2", etc.
 
 	if {$action eq "destroy"} {
-		$handle destroy
+		$handle _destroy
 		rename $handle ""
 		return
 	} elseif {$action eq "create"} {
 		# Create the root node
-		foreach {dummy rootref} [_tree_makenode ""] {}
+		lassign [_tree_makenode ""] dummy rootref
 
 		# Create the tree containing one node
 		set tree [dict create root $rootref]
@@ -85,26 +85,13 @@ proc tree {action handle} {
 
 		proc $handle {command args} {treeref} {
 			#puts "You invoked [list treehandle $command $args]"
-			uplevel 1 [list tree_$command $treeref {expand}$args]
+			tailcall tree_$command $treeref {*}$args
 		}
 	} else {
 		error "Usage: tree destroy|create handle"
 	}
 }
 
-# treehandle destroy
-#
-# Discards all the nodes
-#
-proc tree_destroy {treeref} {
-	set tree [getref $treeref]
-	foreach {nodename noderef} $tree {
-		set node [getref $noderef]
-		unset node
-	}
-	unset tree
-}
-
 # treehandle insert node ?index?
 #
 proc tree_insert {treeref node {index end}} {
@@ -112,7 +99,7 @@ proc tree_insert {treeref node {index end}} {
 	set parentref [_tree_getnoderef $treeref $node]
 
 	# Make a new node
-	foreach {childname childref} [_tree_makenode $parentref] {}
+	lassign [_tree_makenode $parentref] childname childref
 
 	# Add it to the list of children in the parent node
 	_tree_update_node $treeref $node parent {
@@ -210,7 +197,7 @@ proc tree_walk {treeref node type vars code} {
 	set n [_tree_getnode $treeref $node]
 
 	# set up vars
-	foreach {actionvar namevar} $vars {}
+	lassign $vars actionvar namevar
 
 	if {$type ne "child"} {
 		upvar $namevar name
@@ -256,6 +243,17 @@ proc tree_walk {treeref node type vars code} {
 # INTERNAL procedures below this point
 #
 
+# Discards all the nodes
+#
+proc tree__destroy {treeref} {
+	set tree [getref $treeref]
+	foreach {nodename noderef} $tree {
+		setref $noderef {}
+	}
+	setref $treeref {}
+}
+
+
 # Make a new child node of the parent
 #
 # Note that this does *not* add the node
-- 
cgit v1.1