diff options
author | Steve Bennett <steveb@workware.net.au> | 2010-03-03 16:02:25 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2010-10-15 11:02:49 +1000 |
commit | 8a21e1c0ea44a829f84e526a8302e6effbc4a9b1 (patch) | |
tree | 84f7fe867f2a3adce1a936a5f1e7cdcb724f4cfd /tree.tcl | |
parent | b83beb2febcbe0abcf338e3f915b43889ce93eca (diff) | |
download | jimtcl-8a21e1c0ea44a829f84e526a8302e6effbc4a9b1.zip jimtcl-8a21e1c0ea44a829f84e526a8302e6effbc4a9b1.tar.gz jimtcl-8a21e1c0ea44a829f84e526a8302e6effbc4a9b1.tar.bz2 |
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>
Diffstat (limited to 'tree.tcl')
-rw-r--r-- | tree.tcl | 34 |
1 files changed, 16 insertions, 18 deletions
@@ -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 |