This procedure is defined in the server but not documented via ad_proc or proc_doc and may be intended as a private interface.
The procedure is defined as:
proc dom::DOMImplementation {method args} {
variable DOMImplementationOptions
variable DOMImplementationCounter
switch -- $method {
hasFeature {
if {[llength $args] != 2} {
return -code error "wrong number of arguments"
}
# Later on, could use Tcl package facility
if {[regexp {create|destroy|parse|serialize|trim} [lindex $args 0]]} {
if {[lindex $args 1] eq "1.0" } {
return 1
} else {
return 0
}
} else {
return 0
}
}
create {
# Bootstrap a document instance
switch [llength $args] {
0 {
# Allocate unique document array name
set name [namespace current]::document[incr DOMImplementationCounter]
}
1 {
# Use array name provided. Should check that it is safe.
set name [lindex $args 0]
unset -nocomplain $name
}
default {
return -code error "wrong number of arguments"
}
}
set varPrefix ${name}var
set arrayPrefix ${name}arr
array set $name [list counter 1 node1 [list id node1 docArray $name node:nodeType documentFragment node:parentNode {} node:childNodes ${varPrefix}1 documentFragment:masterDoc node1 document:implementation {} document:xmldecl {version 1.0} document:documentElement {} document:doctype {} ]]
# Initialise child node list
set ${varPrefix}1 {}
# Return the new top-level node
return ${name}(node1)
}
destroy {
# Cleanup a document
if {[llength $args] != 1} {
return -code error "wrong number of arguments"
}
array set node [set [lindex $args 0]]
# Patch from Gerald Lester
##
## First release all the associated variables
##
upvar #0 $node(docArray) docArray
for {set i 0} {$i < $docArray(counter)} {incr i} {
unset -nocomplain ${docArrayName}var$i
unset -nocomplain ${docArrayName}arr$i
}
##
## Then release the main document array
##
if {![info exists $node(docArray)]} {
return -code error "unable to destroy document"
}
unset -nocomplain $node(docArray)
return {}
}
parse {
# This implementation allows use of either of two event-based,
# non-validating XML parsers:
# . TclXML Tcl-only parser (version 1.3 or higher)
# . TclExpat parser
array set opts {-parser {} -progresscommand {} -chunksize 8196}
if {[catch {array set opts [lrange $args 1 end]}]} {
return -code error "bad configuration options"
}
# Create a state array for this parse session
set state [namespace current]::parse[incr DOMImplementationCounter]
array set $state [array get opts -*]
array set $state [list progCounter 0]
set errorCleanup {}
switch -- $opts(-parser) {
expat {
if {[catch {package require expat} version]} {
eval $errorCleanup
return -code error "expat extension is not available"
}
set parser [expat [namespace current]::xmlparser]
}
tcl {
if {[catch {package require xml 1.3} version]} {
eval $errorCleanup
return -code error "XML parser package is not available"
}
set parser [::xml::parser xmlparser]
}
default {
# Automatically determine which parser to use
if {[catch {package require expat} version]} {
if {[catch {package require xml 1.3} version]} {
eval $errorCleanup
return -code error "unable to load XML parser"
} else {
set parser [::xml::parser xmlparser]
}
} else {
set parser [expat [namespace current]::xmlparser]
}
}
}
$parser configure -elementstartcommand [namespace code [list ParseElementStart $state]] -elementendcommand [namespace code [list ParseElementEnd $state]] -characterdatacommand [namespace code [list ParseCharacterData $state]] -processinginstructioncommand [namespace code [list ParseProcessingInstruction $state]] -final true
# TclXML has features missing from expat
catch {
$parser configure -xmldeclcommand [namespace code [list ParseXMLDeclaration $state]] -doctypecommand [namespace code [list ParseDocType $state]]
}
# Create top-level document
array set $state [list docNode [DOMImplementation create]]
array set $state [list current [lindex [array get $state docNode] 1]]
# Parse data
# Bug in TclExpat - doesn't handle non-final inputs
if {0 && [string length $opts(-progresscommand)]} {
$parser configure -final false
while {[string length [lindex $args 0]]} {
$parser parse [string range [lindex $args 0] 0 $opts(-chunksize)]
#set args [lreplace $args 0 0 # [string range [lindex $args 0] $opts(-chunksize) end]]
lset args 0 [string range [lindex $args 0] $opts(-chunksize) end]
uplevel #0 $opts(-progresscommand)
}
$parser configure -final true
} elseif {[catch {$parser parse [lindex $args 0]} err]} {
catch {rename $parser {}}
unset -nocomplain $state
return -code error $err
}
# Free data structures which are no longer required
catch {rename $parser {}}
set doc [lindex [array get $state docNode] 1]
unset $state
return $doc
}
serialize {
if {[llength $args] < 1} {
return -code error "wrong number of arguments"
}
GetHandle documentFragment [lindex $args 0] node
return [eval [list Serialize:$node(node:nodeType)] $args]
}
trim {
# Removes textNodes that only contain white space
if {[llength $args] != 1} {
return -code error "wrong number of arguments"
}
Trim [lindex $args 0]
return {}
}
default {
return -code error "unknown method \"$method\""
}
}
return {}
}
