# comanche_tree.tcl --

namespace eval ::comanche:: {

}

# tree getRootNode
# tree addNode
# tree deleteNode
# tree nodeConfigure
# tree nodeCget 
#
# Attributes for the nodes are defined in the subclass, so we can have simple specific
# nodes. We need hooks for events nodeAdded, nodeDeleted, nodeModified
#
# There were thoughts of having getRoot|Node, but it is better to agree on "root" identifier

class ::comanche::tree {
    variable nodeAttributes
    variable nodes
    method addNode {parentNode nodeAttrsList}
    method deleteNode {node}
    method nodeConfigure 
    method nodeCget
}

class ::comanche::namespaceTree {
    variable nodeAttributes {-text -openImage -closedImage -tipMouseOver -classList -nodeId}
    variable nodes
    constructor  {}  {
	set nodes(root,-parent) {}
	set nodes(root,-children) {}
    }
    method addNode {parentNode nodeAttrsList}
    method deleteNode {node}
    method nodeConfigure {node nodeAttrsList}
    method nodeCget {node nodeAttrsList}
    method doesNodeExists {node}
    method hasChildren {node}
    protected method _setAttribute {node attribute value}
    protected method _getAttribute {node attribute}
    protected method _addChild { parentNode ChildNode }
    protected method _deleteChild { parentNode ChildNode }
    protected method _newNode {}
    protected method _raiseErrorIfNodeNotExists {node}
    protected method _checkAttributeExists {node attribute}
    protected method _raiseEvent {event node}
}



body ::comanche::namespaceTree::_newNode {} {
    set node node[unique::newId]
    foreach attribute $nodeAttributes {
	set nodes($node,$attribute) {}
    }
    set nodes($node,-parent) {}
    set nodes($node,-children) {}
    set nodes($node,-nodeId) $node
    return $node
}

body ::comanche::namespaceTree::addNode { parentNode nodeAttrsList} {
    _raiseErrorIfNodeNotExists $parentNode
    set node [_newNode]
    set nodes($node,parent) $parentNode
    _addChild $parentNode $node
    if [catch {nodeConfigure $node $nodeAttrsList} mesg] {
	deleteNode $node
	error $mesg
    }
    _raiseEvent nodeAdded $node
    return $node
}

body ::comanche::namespaceTree::nodeConfigure { node nodeAttrsList} {
    _raiseErrorIfNodeNotExists $node
    foreach {attribute value} $nodeAttrsList {
	if [regexp {(-parent)|(-children)} $attribute] {
	    error "Cannot set attribute $attribute directly"
	}
	_setAttribute $node $attribute $value
    }
    return $node
}

body ::comanche::namespaceTree::nodeCget { node nodeAttrsList} {
    _raiseErrorIfNodeNotExists $node
    set result {}
    switch [llength $nodeAttrsList] {
	0 {
	    if [string match $node root] {
		set attributes {-parent -children}
	    } else {
		set attributes [concat $nodeAttributes -parent -children]
	    }
	} 
	1 {
	   return [_getAttribute $node $nodeAttrsList] 
	}
	default {
	    set attributes $nodeAttrsList
	}
    }
    foreach attribute $attributes {
	lappend result $attribute [_getAttribute $node $attribute]
    }
    return $result
}

body ::comanche::namespaceTree::hasChildren {node} {
    _raiseErrorIfNodeNotExists $node
    if [llength [_getAttribute $node -children]] {
        return 1
    } else {
        return 0
    }
}

body ::comanche::namespaceTree::deleteNode { node } {
    _raiseErrorIfNodeNotExists $node
    foreach child [_getAttribute $node -children] {
	deleteNode $child
    }
    _deleteChild $nodes($node,-parent) $node
    foreach index [array names nodes $node,*] {
	unset nodes($index)
    }
    _raiseEvent nodeDeleted $node
}

body ::comanche::namespaceTree::_deleteChild { parentNode childNode} {
    set children [_getAttribute $parentNode -children] 
    set index [lsearch -exact $children $childNode]
    if [string match $index -1] {
	error "Node $childNode is not a child of $parentNode and cannot be removed"
    }
    _setAttribute $parentNode -children [lreplace $children $index $index]
}

body ::comanche::namespaceTree::_addChild { parentNode childNode} {
    _setAttribute $childNode -parent $parentNode
    _setAttribute $parentNode -children [concat [_getAttribute $parentNode -children] $childNode]
}

body ::comanche::namespaceTree::_setAttribute { node attribute value } {
    _checkAttributeExists $node $attribute
    set nodes($node,$attribute) $value
}

body ::comanche::namespaceTree::_getAttribute { node attribute } {
    _checkAttributeExists $node $attribute
    return $nodes($node,$attribute) 
}

body ::comanche::namespaceTree::_checkAttributeExists { node attribute } {
    if ![info exists nodes($node,$attribute)] {
	error "Node $node does not have attribute $attribute"
    }
}

body ::comanche::namespaceTree::_raiseErrorIfNodeNotExists { node } {
    if ![doesNodeExists $node] {
	error "Node $node does not exists"
    }
}

body ::comanche::namespaceTree::doesNodeExists { node } {
    return [info exists nodes($node,-children)]
}

body ::comanche::namespaceTree::_raiseEvent {type node} {
}


