if 0 {
Sample session:
% Tree mytree ::mytree
Insert some nodes
% mytree insert root 0 domNode4 % mytree insert root 0 domNode5 % mytree insert root 0 domNode6 % mytree children root domNode6 domNode5 domNode4 % mytree insert domNode4 0 domNode7 % mytree domDoc domDoc1 % [mytree domDoc] documentElement domNode2
Perform an xpath query for all the leaves in the tree
% [[mytree domDoc] documentElement] selectNodes {//*[count(child::*)=0]}
domNode5 domNode6 domNode7}
# Partial wrapping of tDOM functionality with tcllib tree interface
package require tdom
package require XOTcl
namespace import xotcl::*
Class Tree
Tree instproc init {{existingDomDoc ""}} {
[self] instvar domDoc
if {[string length $existingDomDoc] == 0} {
set domDoc [dom createDocument node]
} else {
set domDoc $existingDomDoc
}
[self] parametercmd domDoc
next
}
Tree instproc insertNode {parent idx child} {
# tcllib tree indexing starts at zero, but DOM starts at one
incr idx
set sibling [$parent child $idx]
if {[string length $sibling] == 0} {
return [$parent appendChild $child]
} else {
return [$parent insertBefore $child $sibling]
}
}
# tcllib tree allows an optional third argument to specify the
# name of the node. tDOM doens't allow node names to be specified
# The easy way out--don't allow the third argument
Tree instproc insert {parent idx} {
[self] instvar domDoc
# Create the node
set newNode [$domDoc createElement node]
# Add the node to the tree
[self] insertNode $parent $idx $newNode
}
Tree instproc move {newParent idx nodeToMove args} {
foreach node [concat $nodeToMove $args] {
set oldParent [$node parentNode]
$oldParent removeChild $node
[self] insertNode $newParent $idx $node
incr idx
}
}
Tree instproc keyexists {node -key key} {
$node hasAttribute $key
}
Tree instproc keys {node} {
$node attributes
}
Tree instproc depth {node} {
return [llength [$node ancestor all]]
}
Tree instproc size {node} {
return [llength [$node descendant all]]
}
Tree instproc isleaf {node} {
return [expr [llength [$node descendant all]] == 0]
}
# This seems correct, but isn't giving me what I expect
Tree instproc index {node} {
return [llength [$node psibling all]]
}
# Try this instead
Tree instproc index {node} {
return [lsearch [[self] children [[self] parent $node]] $node]
}
Tree instproc numchildren {node} {
return [llength [$node child all]]
}
Tree instproc set {node args} {
switch [llength $args] {
0 {
$node getAttribute data
}
1 {
$node setAttribute data [lindex $args 0]
$node getAttribute data
}
2 {
$node getAttribute [lindex $args 1]
}
3 {
set switch [lindex $args 0]
set key [lindex $args 1]
set value [lindex $args 2]
$node setAttribute $key $value
$node getAttribute $key
}
default {error "wrong number of arguments"}
}
}
# Dynamically construct the simple command that have only a node argument
foreach {treeCmd domCmd} {children childNodes parent parentNode previous previousSibling next nextSibling delete delete} {
Tree instproc $treeCmd {node} "\$node $domCmd"
}
Tree instproc destroy {args} {
[self] instvar domDoc
$domDoc delete
next
}
# The tcllib interface always names the root node "root"
# tDOM doesn't have a way to specify node names. Therefore,
# install this filter to automatically convert "root" to the
# actual root element
Tree instproc convertRoot {node args} {
[self] instvar domDoc
# Convert input node from name "root"
if {$node == "root"} {
set node [$domDoc documentElement]
}
# Dispatch the method
set retVal [eval next $node $args]
# Convert output node to name "root"
if {$retVal == [$domDoc documentElement]} {
return root
} else {
return $retVal
}
}
Tree instfilter convertRoot
# Only call the filter for methods that have node as a first argument
Tree instfilterguard convertRoot {
([lsearch {init destroy} [self calledproc]] < 0) &&
([lsearch [Tree info instcommands] [self calledproc]] >= 0)
}