# 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)
 }