#
# Library functions for the ic_xml library
#
# File: ic_xml/lib/ic_xml_inter.tcl
#
# $Revision$ on $Date$
# 
# Copyright (c) 1993-2004 ICEM CFD Engineering
#
# Author: Jason Aftosmis (jason@icemcfd.com)
#
# TODO:
#   o 
#
#---------------------------------------------------------------------
#

namespace eval IcXmlInter {
    variable _version "0.1b"
    
    namespace import ::IcXml::*
    
    variable _base_dir [file join [file dirname [info script]]]
    
    variable _cur_impl_ns  "tDomImpl" ;# we default to tDOM --jka
    
    variable _initialized 0
    
    # a list of open docObjects -- this is SUPER important -jka    
    variable _doc_objv
    
    proc ::IcXmlInter {args} { return [IcXmlInter::_init $args] }
    
    proc err   {text} { if 1 { return [ic_xml_err   "IcXmlInter: $text"] } }
    proc debug {text} { if 1 { return [ic_xml_debug "IcXmlInter debug: $text"] } }
}

## Test the interface -- FIXME

proc IcXmlInter::test {} {
    
    if [_init] {
	return SUCCESS
    }  
    return FAILURE
}


## Initialize the interface
## args:
##   One can specify an "-implementation" such as: "tDomImpl"

proc IcXmlInter::_init {args} {
    variable _initialized 0
    variable _cur_impl_ns_has_failed    
    #
    # --> see if this has failed already
    #
    if {[info exists _cur_impl_ns_has_failed] && $_cur_impl_ns_has_failed} {
	return 0
    }
    #
    # --> see if this has been done already
    #
    if { $_initialized } {
	return 1
    }
    #
    # --> map the implementation namespaces to the source files
    #
    array set init_impl_files {
	tDomImpl   "tdom_impl.tcl"
    }
    #
    # --> determine the implementation & check that source file exists
    #
    variable _cur_impl_ns
    foreach {n v} $args {
	switch -- $n {
	    "-implementation" - "-impl" {
		set _cur_impl_ns $v
	    }
	    default {
		set [string range $n 1 end] $v
	    }
	}
    }
    if ![info exists init_impl_files($_cur_impl_ns)] {
	err "don't know what to do with the \"$_cur_impl_ns\" impl"
	return 0
    }
    #
    # --> source the implementation
    #
    variable _base_dir
    foreach src $init_impl_files($_cur_impl_ns) {
	set f [file join $_base_dir $src]
	if [catch {source $f} res] {
	    #err "could not source file $f: $res"
	}
    }
    #
    # --> check the namespaces validity & decide whether things went well enough    
    #     if i could count on > tcl8.4, i'd use "namespace exists" fixme --jka
    #
    if ![_nsValid] {
	set _initialized 0
	return -code error $_initialized
    }
    
    set _initialized 1
    return $_initialized
}


## Get the NameSpace for the current IMPLementation. Internal use only.

proc IcXmlInter::_nsImplGet {} {
    variable _cur_impl_ns
    
    if { ("" == $_cur_impl_ns) && ![_init] } {
	err "cannot find valid implementation of \"$_cur_impl_ns\""
	return -code error ""
    }
    return $_cur_impl_ns
}


## Get the NameSpace for the current IMPLementation. Internal use only.

proc IcXmlInter::_nsValid {} {
    variable _cur_impl_ns
    variable _cur_impl_ns_has_failed
    
    if {[info exists _cur_impl_ns_has_failed] && $_cur_impl_ns_has_failed} {
	return 0
    }
    
    # fixme to use "namespace exists" when tcl8.4 --jka
    if {"" == [namespace children "::IcXmlInter"]} {
	#err "cannot find specified implementation \"$_cur_impl_ns\""
	set _cur_impl_ns_has_failed 1
	return 0
    }
    # domCreate being a representative command
    if {("" == [_nsImplGet]) || ("" == [info commands [_nsImplGet]::*])} {
	#err "cannot find specified implementation \"$_cur_impl_ns\""
	set _cur_impl_ns_has_failed 1
	return 0
    }
    return 1
}


## 

proc IcXmlInter::domKeyUnique {} {
    variable _doc_objv
    
    set def_object_base "dom_object_"
    set i 0
    set dom_key "$def_object_base$i"
    while [info exists _doc_objv($dom_key)] {
	incr i
	set dom_key "$def_object_base$i"
	if ![info exists _doc_objv($dom_key)] {
	    break
	}	
    }
    
    debug "got unique key $dom_key"
    
    return $dom_key
}


## 

proc IcXmlInter::domKeyIsValid { dom_key } {
    variable _doc_objv
    
    if {![info exists _doc_objv($dom_key)] || \
	    ("" == $_doc_objv($dom_key))} {
	err "cannot find DOM object by name of \"$dom_key\"!"
	return 0
    }
    
    return 1
}


## 

proc IcXmlInter::domGet { dom_key } {
    variable _doc_objv
    
    if ![domKeyIsValid $dom_key] {
	return -code error "Invalid XML DOM key: $dom_key"
    }
    
    return $_doc_objv($dom_key)
}



## FIXME

proc IcXmlInter::destroy {} {
    variable _doc_objv
    
    if ![info exists _doc_objv] {
	return FIXME
    }
    
    foreach dom_key [array names _doc_objv] {
	set docObj _doc_objv($dom_key)
	[_nsImplGet]::domDelete $docObj
    }
    
    return FIXME
}


# --------------------------------------------------------------------
#
#
# --------------------------------------------------------------------


## 

proc IcXmlInter::domCreate { root_element_name } {
    variable _doc_objv
    
    set dom_key [domKeyUnique]

    if [catch { [_nsImplGet]::domCreate $root_element_name } docObj] {
	err "could not create a DOM for \"$root_element_name\""
	return -code error ""
    }
    
    set _doc_objv($dom_key) $docObj
    
    debug "created document with root element $root_element_name, docObj $docObj"
    
    return $dom_key
}


## 

proc IcXmlInter::domOpen { xml_file } {
    variable _doc_objv
    
    if ![file exists $xml_file] {
	err "could not find the XML file \"$xml_file\" to open"
	return ""
    }
    
    set domKey [domKeyUnique]
    
    set docObj [[_nsImplGet]::domOpen $xml_file]
    
    set _doc_objv($domKey) $docObj
    
    return $domKey
}


## 

proc IcXmlInter::domFormat { domKey format args } {
    
    if [catch {domGet $domKey} docObj] {
	err "could not get DOM for \"$domKey\""
	return ""
    }
    
    set xsl_file ""
    
    foreach {n v} $args {
	set [string range $n 1 end] $v
    }
    
    switch -- $format {
	HTML - html - xsl - XSL {
	    set data [[_nsImplGet]::domGetAsHtml $docObj "$xsl_file"]
	}
	XML - xml {
	    set data [[_nsImplGet]::domGetAsXml $docObj]
	}
	default {
	    return -code error "IcXmlInter: can't understand format $format"
	}
    }
    
    #debug "for docObj $docObj, ${format}_data is:\n\n$data\n\n"
        
    return $data
}


## 

proc IcXmlInter::domClose { domKey } {
    
    if [catch {domGet $domKey} docObj] {
	err "could not get DOM for \"$domKey\""
	return ""
    }

    debug "deleting docObj $docObj with key $domKey"

    set stat [[_nsImplGet]::domDelete $docObj]
    if $stat {
	err "could not close document $docObj"
    } else {
	debug "closed document $docObj"
    }
    
    return $stat
}


## 

proc IcXmlInter::domRoot { domKey {attributes ""} } {

    if [catch {domGet $domKey} docObj] {
	err "could not get DOM for \"$domKey\""
	return ""
    }
    
    set rootObj [[_nsImplGet]::domRoot $docObj]
    
    if {"" != $attributes} {
	debug "now adding attribues: $attributes..."
	foreach {n v} $attributes {
	    [_nsImplGet]::domElementAddAttribute $rootObj $n $v
	}
	
	debug "added attribues"
    }
    
    return $rootObj
}


#---------------------------------------------------------------------
#
# -->   Element-(creation|modification|deletion) procs
#
# --------------------------------------------------------------------


## 

proc IcXmlInter::elementCreate { domKey element_name {parent ""} {attributes ""} {value ""} } {
    
    if [catch {domGet $domKey} docObj] {
	err "could not get DOM for \"$domKey\""
	return ""
    }
    
    set nodeObj [[_nsImplGet]::domElementCreate $docObj $element_name]
    
    debug "created element $nodeObj..."
       
    if {"" != $attributes} {
	debug "now adding attribues: $attributes..."
	foreach {n v} $attributes {
	    [_nsImplGet]::domElementAddAttribute $nodeObj $n $v
	}
	
	debug "added attribues"
    }
    
    if {"" != $value} {
    	debug "now setting value: $value..."
	textNodeCreate $domKey $value $nodeObj
    	debug "set value"
    }
    
    if {"" != $parent} {
	[_nsImplGet]::domElementAppendChild $parent $nodeObj
	
	debug "assigned to parent $parent"
    }
    
    return $nodeObj
}

##

proc IcXmlInter::elementAdd { parentObj nodeObj } {
    
    debug "adding element $nodeObj..."
    
    [_nsImplGet]::domElementAppendChild $parentObj $nodeObj
    
    debug "assigned to parent $parentObj"
    
    return $nodeObj
}


## This is for when one node wants to get copied into a different doc

proc IcXmlInter::elementCopy { parentObj nodeObj } {
    
    debug "adding element $nodeObj..."    
    
    set clonedNodeObj [[_nsImplGet]::domCloneElement $nodeObj]
    #set clonedNodeObj $nodeObj ;# this should work, but tDOM crashes
    # sent bug to rolf@poinstman.de
    
    debug "but actually its clone...$clonedNodeObj"

    [_nsImplGet]::domElementAppendChild $parentObj $clonedNodeObj
    
    debug "assigned to parent $parentObj"
    
    return $clonedNodeObj
}

##

proc IcXmlInter::getElement { parentObj element_name } {    
    return [[_nsImplGet]::domElementGet $parentObj $element_name]
}


##

proc IcXmlInter::getElementName { nodeObj } {
    return [[_nsImplGet]::domElementGetName $nodeObj]
}


##

proc IcXmlInter::elementDelete { domKey nodeObj } {
    
    if [catch {domGet $domKey} docObj] {
	err "could not get DOM for \"$domKey\""
	return ""
    }
    
    return [[_nsImplGet]::domElementDelete $docObj $nodeObj]
}


##

proc IcXmlInter::textNodeCreate { domKey text {parent ""} } {
    
    if [catch {domGet $domKey} docObj] {
	err "could not get DOM for \"$domKey\""
	return ""
    }
    
    set nodeObj [[_nsImplGet]::domTextNodeCreate $docObj $text]
    
    debug "created text node $nodeObj with text $text..."
    
    if {"" != $parent} {
	[_nsImplGet]::domElementAppendChild $parent $nodeObj
	
	debug "assigned to parent $parent"
    }
    
    return $nodeObj
}
