#       Rolf Ade (rolf@pointsman.de):   'fake' nodelists/live childNodes
#
#   written by Jochen Loewer
#   April, 1999
#
#----------------------------------------------------------------------------

package require tdom 

#----------------------------------------------------------------------------
#   setup namespaces for additional Tcl level methods, etc.
#
#----------------------------------------------------------------------------
namespace eval ::dom {
    namespace eval  domDoc {
    }
    namespace eval  domNode {
    }
    namespace eval  DOMImplementation {
    }
    namespace eval  xpathFunc {
    }
    namespace eval  xpathFuncHelper {
    }
}

namespace eval ::tdom { 
    variable extRefHandlerDebug 0
    variable useForeignDTD ""

    namespace export xmlOpenFile xmlReadFile xmlReadFileForSimple \
        extRefHandler baseURL
}

    }
    foreach { arg1Typ arg1Value } $args break
    set str [::dom::xpathFuncHelper::coerce2string $arg1Typ $arg1Value ]
    # The XSLT recommendation says: "The element-available
    # function returns true if and only if the expanded-name
    # is the name of an instruction." The following xsl
    # elements are not in the category instruction.
    # xsl:attribute-set 
    # xsl:decimal-format 
    # xsl:include
    # xsl:key 
    # xsl:namespace-alias
    # xsl:output
    # xsl:param
    # xsl:strip-space
    # xsl:preserve-space
    # xsl:template
    # xsl:import

}

#----------------------------------------------------------------------------
#   IANAEncoding2TclEncoding
#
#----------------------------------------------------------------------------

# As of version 8.3.4 tcl supports 
# cp860 cp861 cp862 cp863 tis-620 cp864 cp865 cp866 gb12345 cp949
# cp950 cp869 dingbats ksc5601 macCentEuro cp874 macUkraine jis0201
# gb2312 euc-cn euc-jp iso8859-10 macThai jis0208 iso2022-jp
# macIceland iso2022 iso8859-13 iso8859-14 jis0212 iso8859-15 cp737
# iso8859-16 big5 euc-kr macRomania macTurkish gb1988 iso2022-kr
# macGreek ascii cp437 macRoman iso8859-1 iso8859-2 iso8859-3 ebcdic
# macCroatian koi8-r iso8859-4 iso8859-5 cp1250 macCyrillic iso8859-6
# cp1251 koi8-u macDingbats iso8859-7 cp1252 iso8859-8 cp1253
# iso8859-9 cp1254 cp1255 cp850 cp1256 cp932 identity cp1257 cp852
# macJapan cp1258 shiftjis utf-8 cp855 cp936 symbol cp775 unicode
# cp857
# 
# Just add more mappings (and mail them to the tDOM mailing list, please).

proc ::tdom::IANAEncoding2TclEncoding {IANAName} {
    
    # First the most widespread encodings with there
    # preferred MIME name, to speed lookup in this
    # usual cases. Later the official names and the
    # aliases.
    #
    # For "official names for character sets that may be
    # used in the Internet" see 
    # http://www.iana.org/assignments/character-sets
    # (that's the source for the encoding names below)
    # 
    # Matching is case-insensitive

    switch [string tolower $IANAName] {
        "us-ascii"    {return ascii}
        "utf-8"       {return utf-8}
        "utf-16"      {return unicode}
        "iso-8859-1"  {return iso8859-1}

        "cp1256"      {return cp1256}
        "cp1257"      {return cp1257}

        "windows-1251" -
        "cp1251"      {return cp1251}

        "windows-1252" -
        "cp1252"      {return cp1252}    

        "iso_8859-1:1987" -
        "iso-ir-100" -
        "iso_8859-1" -
        "latin1" -
        "l1" -
        "ibm819" -
        "cp819" -
        "csisolatin1" {return iso8859-1}
        
        "iso_8859-2:1987" -
        "iso-ir-101" -
        "iso_8859-2" -
        "iso-8859-2" -
        "latin2" -
        "l2" -
        "csisolatin2" {return iso8859-2}

        "iso_8859-5:1988" -
        "iso-ir-144" -
        "iso_8859-5" -
        "iso-8859-5" -
        "cyrillic" -
        "csisolatincyrillic" {return iso8859-5}

        "ms_kanji" -
        "csshiftjis"  {return shiftjis}
        
        "csiso2022kr" {return iso2022-kr}

        "ibm866" -
        "csibm866"    {return cp866}
        
        default {
            # There are much more encoding names out there
            # It's only laziness, that let me stop here.
            error "Unrecognized encoding name '$IANAName'"
        }
    }
}

#----------------------------------------------------------------------------
#   xmlOpenFileWorker
#
#----------------------------------------------------------------------------
proc ::tdom::xmlOpenFileWorker {filename {encodingString {}} {forSimple 0} {forRead 0}} {

    # This partly (mis-)use the encoding of a channel handed to [dom
    # parse -channel ..] as a marker: if the channel encoding is utf-8
    # then behind the scene Tcl_Read() is used, otherwise
    # Tcl_ReadChars(). This is used for the encodings understood (and
    # checked) by the used expat implementation: utf-8 and utf-16 (in
    # either byte order).
    
    set fd [open $filename]

    if {$encodingString != {}} {
        upvar $encodingString encString
    }

    # The autodetection of the encoding follows
    # XML Recomendation, Appendix F

    fconfigure $fd -encoding binary
    if {![binary scan [read $fd 4] "H8" firstBytes]} {
        # very short (< 4 Bytes) file
        seek $fd 0 start
        set encString UTF-8
        return $fd
    }
    
    # First check for BOM
    switch [string range $firstBytes 0 3] {
        "feff" {
            # feff: UTF-16, big-endian BOM
            if {$forSimple || $forRead} {
                error "UTF-16be is not supported"
            }
            seek $fd 0 start
            set encString UTF-16be
            fconfigure $fd -encoding utf-8
            return $fd
        }
        "fffe" {
            # ffef: UTF-16, little-endian BOM
            set encString UTF-16le          
            if {$forSimple || $forRead} {
                seek $fd 2 start
                fconfigure $fd -encoding unicode
            } else {
                seek $fd 0 start
                fconfigure $fd -encoding utf-8
            }
            return $fd
        }
    }
    
    
    # If the entity has a XML Declaration, the first four characters
    # must be "<?xm".
    switch $firstBytes {
        "3c3f786d" {
            # UTF-8, ISO 646, ASCII, some part of ISO 8859, Shift-JIS,
            # EUC, or any other 7-bit, 8-bit, or mixed-width encoding which 
            # ensures that the characters of ASCII have their normal positions,
            # width and values; the actual encoding declaration must be read to
            # detect which of these applies, but since all of these encodings
            # use the same bit patterns for the ASCII characters, the encoding
            # declaration itself be read reliably.

            # First 300 bytes should be enough for a XML Declaration

            seek $fd 0 start
            set xmlDeclaration [read $fd [expr {$closeIndex + 5}]]
            # extract the encoding information
            set pattern {^[^>]+encoding=[\x20\x9\xd\xa]*["']([^ "']+)['"]}
            # emacs: "
            if {![regexp $pattern $head - encStr]} {
                # Probably something like <?xml version="1.0"?>. 
                # Without encoding declaration this must be UTF-8
                set encoding utf-8
                set encString UTF-8
            } else {
                set encoding [IANAEncoding2TclEncoding $encStr]
                set encString $encStr
            }

            if {$forSimple} {
                seek $fd 2 start
                set encoding unicode
            } else {
                seek $fd 0 start
                set encoding utf-8
            }
            set encString UTF-16le          
        }
        "4c6fa794" {
            # EBCDIC in some flavor
            error "EBCDIC not supported"
        }
        default {
            # UTF-8 without an encoding declaration

#
#----------------------------------------------------------------------------
proc ::tdom::xmlOpenFile {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFileWorker $filename encString]
    return $fd
}

#----------------------------------------------------------------------------
#   xmlReadFile
#
#----------------------------------------------------------------------------
proc ::tdom::xmlReadFile {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFileWorker $filename encString 0 1]
    set data [read $fd [file size $filename]]
    close $fd 
    return $data
}

#----------------------------------------------------------------------------
#   xmlReadFileForSimple
#
#----------------------------------------------------------------------------
proc ::tdom::xmlReadFileForSimple {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFileWorker $filename encString 1]
    set data [read $fd [file size $filename]]
    close $fd 
    return $data
}

#----------------------------------------------------------------------------
#   extRefHandler
#   
#   A very simple external entity resolver, included for convenience.
#   Depends on the tcllib package uri and resolves only file URLs. 
#
#----------------------------------------------------------------------------

if {![catch {package require uri}]} {
    proc ::tdom::extRefHandler {base systemId publicId} {
        variable extRefHandlerDebug
        variable useForeignDTD

            }
        }
    }
}

#----------------------------------------------------------------------------
#   baseURL
#   
#   A simple convenience proc which returns an absolute URL for a given
#   filename.
#
#----------------------------------------------------------------------------
proc ::tdom::baseURL {path} {
    # FIXME - path components need to be URL-encoded

        } else {
            # Drive based path
            return "file:///$path"
        }
    }
}

namespace eval ::tDOM { 
    variable extRefHandlerDebug 0
    variable useForeignDTD ""

    namespace export xmlOpenFile xmlReadFile xmlReadFileForSimple \
        extRefHandler baseURL
}

foreach ::tdom::cmd {
    xmlOpenFile
    xmlReadFile
    xmlReadFileForSimple
    extRefHandler
    baseURL

} {
    interp alias {} tDOM::$::tdom::cmd {} tdom::$::tdom::cmd
}

# EOF