update TEA 3.13

3 files changed, 0 insertions, 4919 deletions

diff --git a/tclxml/tcldom-tcl/dom.tcl b/tclxml/tcldom-tcl/dom.tcl
deleted file mode 100644
index b3edc99..0000000
--- a/tclxml/tcldom-tcl/dom.tcl
+++ /dev/null
@@ -1,4291 +0,0 @@
-# dom.tcl --
-#
-#	This file implements the Tcl language binding for the DOM -
-#	the Document Object Model.  Support for the core specification
-#	is given here.  Layered support for specific languages, 
-#	such as HTML, will be in separate modules.
-#
-# Copyright (c) 1998-2004 Zveno Pty Ltd
-# http://www.zveno.com/
-#
-# See the file "LICENSE" in this distribution for information on usage and
-# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# $Id: dom.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $
-
-# We need the xml package, so that we get Name defined
-
-package require xml 3.0
-
-package provide dom::tcl 3.0
-
-# Define generic constants
-
-namespace eval dom {
-    namespace export DOMImplementation
-    namespace export hasFeature createDocument create createDocumentType
-    namespace export createNode destroy isNode parse selectNode serialize
-    namespace export trim
-
-    namespace export document documentFragment node
-    namespace export element textNode attribute
-    namespace export processingInstruction
-    namespace export documenttype
-    namespace export event
-
-    variable maxSpecials
-    if {![info exists maxSpecials]} {
-	set maxSpecials 10
-    }
-
-    variable strictDOM 0
-
-    # Default -indentspec value
-    #	spaces-per-indent-level {collapse-re collapse-value}
-    variable indentspec [list 2 [list {        } \t]]
-
-    # The Namespace URI for XML Namespace declarations
-    variable xmlnsURI http://www.w3.org/2000/xmlns/
-
-    # DOM Level 2 Event defaults
-    variable bubbles
-    array set bubbles {
-	DOMFocusIn 1
-	DOMFocusOut 1
-	DOMActivate 1
-	click 1
-	mousedown 1
-	mouseup 1
-	mouseover 1
-	mousemove 1
-	mouseout 1
-	DOMSubtreeModified 1
-	DOMNodeInserted 1
-	DOMNodeRemoved 1
-	DOMNodeInsertedIntoDocument 0
-	DOMNodeRemovedFromDocument 0
-	DOMAttrModified 1
-	DOMAttrRemoved 1
-	DOMCharacterDataModified 1
-    }
-    variable cancelable
-    array set cancelable {
-	DOMFocusIn 0
-	DOMFocusOut 0
-	DOMActivate 1
-	click 1
-	mousedown 1
-	mouseup 1
-	mouseover 1
-	mousemove 0
-	mouseout 1
-	DOMSubtreeModified 0
-	DOMNodeInserted 0
-	DOMNodeRemoved 0
-	DOMNodeInsertedIntoDocument 0
-	DOMNodeRemovedFromDocument 0
-	DOMAttrModified 0
-	DOMAttrRemoved 0
-	DOMCharacterDataModified 0
-    }
-}
-
-namespace eval dom::tcl {
-    namespace export DOMImplementation
-    namespace export hasFeature createDocument create createDocumentType
-    namespace export createNode destroy isNode parse selectNode serialize
-    namespace export trim
-
-    namespace export document documentFragment node
-    namespace export element textNode attribute
-    namespace export processingInstruction
-    namespace export event
-}
-
-foreach p {DOMImplementation hasFeature createDocument create createDocumentType createNode destroy isNode parse selectNode serialize trim document documentFragment node element textNode attribute processingInstruction event documenttype} {
-
-    proc dom::$p args "return \[eval tcl::$p \$args\]"
-
-}
-
-# Data structures
-#
-# Documents are stored in a Tcl namespace within the ::dom namespace.
-# The Document array variable stores data for the document itself.
-# Each node has an array variable for its data.
-#
-# "Live" data objects are stored as a separate Tcl variable.
-# Lists, such as child node lists, are Tcl list variables (ie scalar)
-# and keyed-value lists, such as attribute lists, are Tcl array
-# variables.  The accessor function returns the variable name,
-# which the application should treat as a read-only object.
-#
-# A token is a FQ Tcl variable name.
-
-# dom::tcl::DOMImplementation --
-#
-#	Implementation-dependent functions.
-#	Most importantly, this command provides a function to
-#	create a document instance.
-#
-# Arguments:
-#	method	method to invoke
-#	token	token for node
-#	args	arguments for method
-#
-# Results:
-#	Depends on method used.
-
-namespace eval dom::tcl {
-    variable DOMImplementationOptions {}
-    variable DOMImplementationCounter
-    if {![info exists DOMImplementationCounter]} {
-	set DOMImplementationCounter 0
-    }
-}
-
-proc dom::tcl::DOMImplementation {method args} {
-    variable DOMImplementationOptions
-    variable DOMImplementationCounter
-
-    switch -- $method {
-
-	hasFeature {
-
-	    if {[llength $args] != 2} {
-		return -code error "wrong # args: should be dom::DOMImplementation method args..."
-	    }
-
-	    # Later on, could use Tcl package facility
-	    if {[regexp {create|destroy|parse|query|serialize|trim|Events|UIEvents|isNode} [lindex $args 0]]} {
-		if {![string compare [lindex $args 1] "1.0"]} {
-		    return 1
-		} else {
-		    return 0
-		}
-	    } else {
-		return 0
-	    }
-
-	}
-
-	createDocument {
-	    # createDocument introduced in DOM Level 2
-
-	    if {[llength $args] != 3} {
-		return -code error "wrong # args: should be DOMImplementation nsURI name doctype"
-	    }
-
-	    set doc [DOMImplementation create]
-
-	    if {[string length [lindex $args 2]]} {
-		array set $doc [list document:doctype [lindex $args 2]]
-	    }
-
-	    document createElementNS $doc [lindex $args 0] [lindex $args 1]
-
-	    return $doc
-	}
-
-	create {
-
-	    # Non-standard method (see createDocument)
-	    # Bootstrap a document instance
-
-	    if {[llength $args] > 0} {
-		return -code error "wrong # args: should be DOMImplementation create"
-	    }
-
-	    # Allocate unique document array name
-	    set ns [namespace current]::document[incr DOMImplementationCounter]
-	    set name ${ns}::Document
-
-	    # Create the Tcl namespace for this document
-	    namespace eval $ns {
-		namespace export Document
-	    }
-
-	    set varPrefix ${name}var
-	    set arrayPrefix ${name}arr
-
-	    array set $name [list counter 1 \
-		node:nodeType document			\
-		node:parentNode {}			\
-		node:nodeName #document			\
-		node:nodeValue {}			\
-		node:childNodes ${varPrefix}1		\
-		documentFragment:masterDoc $name	\
-		document:implementation [namespace current]::DOMImplementation		\
-		document:xmldecl {version 1.0}		\
-		document:documentElement {}		\
-		document:doctype {}			\
-		]
-
-	    # Initialise child node list
-	    set $varPrefix {}
-
-	    # Create a Tcl command for the document
-	    proc $name {method args} "return \[eval [namespace current]::document \[list \$method\] $name \$args\]"
-
-	    # Capture destruction of the document
-	    trace add command $name delete [namespace code [list Document:Delete $name]]
-
-	    # Return the new toplevel node
-	    return $name
-	}
-
-	createDocumentType {
-	    # Introduced in DOM Level 2
-
-	    # Patch from c.l.t., Richard Calmbach (rc@hnc.com )
-
-	    if {[llength $args] < 3 || [llength $args] > 4} {
-		return -code error "wrong # args: should be: DOMImplementation createDocumentType qname publicid systemid ?internaldtd?"
-	    }
-
-	    return [eval CreateDocType $args]
-	}
-
-	createNode {
-	    # Non-standard method
-	    # Creates node(s) in the given document given an XPath expression
-
-	    if {[llength $args] != 2} {
-		return -code error "wrong # args: should be dom::DOMImplementation createNode xpath"
-	    }
-
-	    package require xpath
-
-	    return [XPath:CreateNode [lindex $args 0] [lindex $args 1]]
-	}
-
-	destroy {
-
-	    # Free all memory associated with a node
-
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be dom::DOMImplementation destroy token"
-	    }
-
-	    if {[catch {upvar #0 [lindex $args 0] node}]} {
-		# If the document is being destroyed then the Tcl namespace no longer exists
-		return {}
-	    }
-
-	    switch $node(node:nodeType) {
-
-		document -
-		documentFragment {
-
-		    if {[string length $node(node:parentNode)]} {
-			unset $node(node:childNodes)
-
-			# Dispatch events
-			event postMutationEvent $node(node:parentNode) DOMSubtreeModified
-
-			return {}
-		    }
-
-		    # else this is the root document node,
-		    # and we can optimize the cleanup.
-		    # No need to dispatch events.
-
-		    # First remove all command traces
-		    foreach nodecmd [info commands [namespace qualifiers [lindex $args 0]]::*] {
-			trace remove command $nodecmd delete [namespace code [list Node:Delete $nodecmd]]
-		    }
-
-		    namespace delete [namespace qualifiers [lindex $args 0]]
-		}
-
-		documentType {
-		    trace remove command [lindex $args 0] delete [namespace code [list DocumentType:Delete [lindex $args 0]]]
-		    rename [lindex $args 0] {}
-		    unset [lindex $args 0]
-		}
-
-		element {
-		    # First make sure the node is removed from the tree
-		    if {[string length $node(node:parentNode)]} {
-			node removeChild $node(node:parentNode) [lindex $args 0]
-		    }
-		    unset $node(node:childNodes)
-		    unset $node(element:attributeList)
-		    unset node
-		    set name [lindex $args 0]
-		    trace remove command $name delete [namespace code [list Node:Delete $name]]
-		    rename $name {}
-
-		    # Don't dispatch events here -
-		    # already done by removeChild
-		}
-
-		event {
-		    set name [lindex $args 0]
-		    trace remove command $name delete [namespace code [list Node:Delete $name]]
-		    rename $name {}
-		    unset node
-		}
-
-		default {
-		    # Store the parent for later
-		    set parent $node(node:parentNode)
-
-		    # First make sure the node is removed from the tree
-		    if {[string length $node(node:parentNode)]} {
-			node removeChild $node(node:parentNode) [lindex $args 0]
-		    }
-		    unset node
-		    set name [lindex $args 0]
-		    trace remove command $name delete [namespace code [list Node:Delete $name]]
-		    rename $name {}
-
-		    # Dispatch events
-		    event postMutationEvent $parent DOMSubtreeModified
-
-		}
-
-	    }
-
-	    return {}
-
-	}
-
-	isNode {
-	    # isNode - non-standard method
-	    # Sometimes it is useful to check if an arbitrary string
-	    # refers to a DOM node
-
-	    upvar #0 [lindex $args 0] node
-
-	    if {![info exists node]} {
-		return 0
-	    } elseif {[info exists node(node:nodeType)]} {
-		return 1
-	    } else {
-		return 0
-	    }
-	}
-
-	parse {
-
-	    # This implementation uses TclXML version 2.0.
-	    # TclXML can choose the best installed parser.
-
-	    if {[llength $args] < 1} {
-		return -code error "wrong # args: should be dom::DOMImplementation parse xml ?args...?"
-	    }
-
-	    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 {}
-
-	    if {[string length $opts(-parser)]} {
-		set parserOpt [list -parser $opts(-parser)]
-	    } else {
-		set parserOpt {}
-	    }
-	    if {[catch {package require xml} version]} {
-		eval $errorCleanup
-		return -code error "unable to load XML parsing package"
-	    }
-	    set parser [eval xml::parser $parserOpt]
-
-	    $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]] \
-		-commentcommand [namespace code [list ParseComment $state]] \
-		-entityreferencecommand [namespace code [list ParseEntityReference $state]] \
-		-xmldeclcommand [namespace code [list ParseXMLDeclaration $state]] \
-		-doctypecommand [namespace code [list ParseDocType $state]] \
-		-final 1
-
-	    # 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]]
-		    uplevel #0 $opts(-progresscommand)
-		}
-		$parser configure -final true
-	    } elseif {[catch {$parser parse [lindex $args 0]} err]} {
-		catch {rename $parser {}}
-		catch {unset $state}
-		return -code error $err
-	    }
-
-	    # Free data structures which are no longer required
-	    $parser free
-	    catch {rename $parser {}}
-
-	    set doc [lindex [array get $state docNode] 1]
-	    unset $state
-	    return $doc
-
-	}
-
-	selectNode {
-	    # Non-standard method
-	    # Returns nodeset in the given document matching an XPath expression
-
-	    if {[llength $args] != 2} {
-		return -code error "wrong # args: should be dom::DOMImplementation selectNode token xpath"
-	    }
-
-	    package require xpath
-
-	    return [XPath:SelectNode [lindex $args 0] [lindex $args 1]]
-	}
-
-	serialize {
-
-	    if {[llength $args] < 1} {
-		return -code error "wrong # args: should be dom::DOMImplementation serialize token"
-	    }
-
-	    upvar #0 [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 # args: should be dom::DOMImplementation trim token"
-	    }
-
-	    Trim [lindex $args 0]
-
-	    # Dispatch DOMSubtreeModified event once here?
-
-	    return {}
-
-	}
-
-	default {
-	    return -code error "unknown method \"$method\""
-	}
-
-    }
-
-    return {}
-}
-
-namespace eval dom::tcl {
-    foreach method {hasFeature createDocument create createDocumentType createNode destroy isNode parse selectNode serialize trim} {
-	proc $method args "eval [namespace current]::DOMImplementation $method \$args"
-    }
-}
-
-# dom::tcl::Document:Delete --
-#
-#	Handle destruction of a document
-#
-# Arguments:
-#	name	document token
-#	old	)
-#	new	) args added by trace command
-#	op	)
-
-proc dom::tcl::Document:Delete {name old new op} {
-    DOMImplementation destroy $name
-    return {}
-}
-
-# dom::tcl::document --
-#
-#	Functions for a document node.
-#
-# Arguments:
-#	method	method to invoke
-#	token	token for node
-#	args	arguments for method
-#
-# Results:
-#	Depends on method used.
-
-namespace eval dom::tcl {
-    variable documentOptionsRO doctype|implementation|documentElement
-    variable documentOptionsRW actualEncoding|encoding|standalone|version
-}
-
-proc dom::tcl::document {method token args} {
-    variable documentOptionsRO
-    variable documentOptionsRW
-
-    upvar #0 $token node
-
-    set result {}
-
-    switch -- $method {
-	cget {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::document method token ?args ...?\""
-	    }
-	    if {[regexp [format {^-(%s)$} $documentOptionsRO] [lindex $args 0] discard option]} {
-		return $node(document:$option)
-	    } elseif {[regexp [format {^-(%s)$} $documentOptionsRW] [lindex $args 0] discard option]} {
-		switch -- $option {
-		    encoding -
-		    version -
-		    standalone {
-			array set xmldecl $node(document:xmldecl)
-			return $xmldecl($option)
-		    }
-		    default {
-			return $node(document:$option)
-		    }
-		}
-	    } else {
-		return -code error "bad option \"[lindex $args 0]\""
-	    }
-	}
-	configure {
-	    if {[llength $args] == 1} {
-		return [document cget $token [lindex $args 0]]
-	    } elseif {[expr [llength $args] % 2]} {
-		return -code error "no value specified for option \"[lindex $args end]\""
-	    } else {
-		foreach {option value} $args {
-		    if {[regexp [format {^-(%s)$} $documentOptionsRW] $option discard opt]} {
-			switch -- $opt {
-			    encoding {
-				catch {unset xmldecl}
-				array set xmldecl $node(document:xmldecl)
-				set xmldecl(encoding) $value
-				set node(document:xmldecl) [array get xmldecl]
-			    }
-			    standalone {
-				if {[string is boolean $value]} {
-				    catch {unset xmldecl}
-				    array set xmldecl $node(document:xmldecl)
-				    if {[string is true $value]} {
-					set xmldecl(standalone) yes
-				    } else {
-					set xmldecl(standalone) no
-				    }
-				    set node(document:xmldecl) [array get xmldecl]
-				} else {
-				    return -code error "unsupported value for option \"$option\" - must be boolean"
-				}
-			    }
-			    version {
-				if {$value == "1.0"} {
-				    catch {unset xmldecl}
-				    array set xmldecl $node(document:xmldecl)
-				    set xmldecl(version) $value
-				    set node(document:xmldecl) [array get xmldecl]
-				} else {
-				    return -code error "unsupported value for option \"$option\""
-				}
-			    }
-			    default {
-				set node(document:$opt) $value
-			    }
-			}
-		    } elseif {[regexp [format {^-(%s)$} $documentOptionsRO] $option discard opt]} {
-			return -code error "attribute \"$option\" is read-only"
-		    } else {
-			return -code error "bad option \"$option\""
-		    }
-		}
-	    }
-	}
-
-	createElement {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"document createElement token name\""
-	    }
-
-	    # Check that the element name is kosher
-	    if {![regexp ^$::xml::Name\$ [lindex $args 0]]} {
-		return -code error "invalid element name \"[lindex $args 0]\""
-	    }
-
-	    # Invoke internal factory function
-	    set result [CreateElement $token [lindex $args 0] {}]
-
-	}
-	createDocumentFragment {
-	    if {[llength $args]} {
-		return -code error "wrong # args: should be \"document createDocumentFragment token\""
-	    }
-
-	    set result [CreateGeneric $token node:nodeType documentFragment node:nodeName #document-fragment node:nodeValue {}]
-	}
-	createTextNode {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"document createTextNode token text\""
-	    }
-
-	    set result [CreateTextNode $token [lindex $args 0]]
-	}
-	createComment {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"document createComment token data\""
-	    }
-
-	    set result [CreateGeneric $token node:nodeType comment node:nodeName #comment node:nodeValue [lindex $args 0]]
-	}
-	createCDATASection {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"document createCDATASection token data\""
-	    }
-
-	    set result [CreateTextNode $token [lindex $args 0]]
-	    node configure $result -cdatasection 1
-	}
-	createProcessingInstruction {
-	    if {[llength $args] != 2} {
-		return -code error "wrong # args: should be \"document createProcessingInstruction token target data\""
-	    }
-
-	    set result [CreateGeneric $token node:nodeType processingInstruction \
-		    node:nodeName [lindex $args 0] node:nodeValue [lindex $args 1]]
-	}
-	createAttribute {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"document createAttributes token name\""
-	    }
-
-	    # Check that the attribute name is kosher
-	    if {![regexp ^$::xml::Name\$ [lindex $args 0]]} {
-		return -code error "invalid attribute name \"[lindex $args 0]\""
-	    }
-
-	    set result [CreateGeneric $token node:nodeType attribute node:nodeName [lindex $args 0]]
-	}
-	createEntity {
-	    set result [CreateGeneric $token node:nodeType entity]
-	}
-	createEntityReference {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"document createEntityReference token name\""
-	    }
-	    set result [CreateGeneric $token node:nodeType entityReference node:nodeName [lindex $args 0]]
-	}
-
-	importNode {
-	    # Introduced in DOM Level 2
-
-	    if {[llength $args] < 1} {
-		return -code error "wrong # args: should be \"importNode token ?-deep boolean?\""
-	    }
-	    array set opts {
-		-deep 1
-	    }
-	    array set opts [lrange $args 1 end]
-	    set opts(-deep) [Boolean $opts(-deep)]
-
-	    if {[namespace qualifiers [lindex $args 0]] == [namespace qualifiers $token]} {
-		return -code error "source node \"[lindex $args 0]\" is in the same document"
-	    }
-
-	    switch [node cget [lindex $args 0] -nodeType] {
-		document -
-		documentType {
-		    return -code error "node type \"[node cget [lindex $args 0] -type]\" cannot be imported"
-		}
-		documentFragment {
-		    set result [document createDocumentFragment $token]
-		    if {$opts(-deep)} {
-			foreach child [node children [lindex $args 0]] {
-			    $result appendChild [$token importNode $child -deep 1]
-			}
-		    }
-		}
-		element {
-		    set result [CreateElement {} [node cget [lindex $args 0] -nodeName] [array get [node cget [lindex $args 0] -attributes]] -document $token]
-		    if {$opts(-deep)} {
-			foreach child [node children [lindex $args 0]] {
-			    $result appendChild [$token importNode $child -deep 1]
-			}
-		    }
-		}
-		textNode {
-		    set result [CreateTextNode {} [node cget [lindex $args 0] -nodeValue] -document $token]
-		}
-		attribute -
-		processingInstruction -
-		comment {
-		    set result [CreateGeneric {} -document $token node:nodeType [node cget [lindex $args 0] -nodeType] node:nodeName [node cget [lindex $args 0] -nodeName] node:nodeValue [node cget [lindex $args 0] -nodeValue]]
-		}
-	    }
-	}
-
-	createElementNS {
-	    # Introduced in DOM Level 2
-
-	    if {[llength $args] != 2} {
-		return -code error "wrong # args: should be: \"createElementNS nsuri qualname\""
-	    }
-
-	    # Check that the qualified name is kosher
-	    if {[catch {foreach {prefix localname} [::xml::qnamesplit [lindex $args 1]]  break} err]} {
-		return -code error "invalid qualified name \"[lindex $args 1]\" due to \"$err\""
-	    }
-
-	    # Invoke internal factory function
-	    set result [CreateElement $token [lindex $args 1] {} -prefix $prefix -namespace [lindex $args 0] -localname $localname]
-	}
-
-	createAttributeNS {
-	    # Introduced in DOM Level 2
-
-	    return -code error "not yet implemented"
-	}
-
-	getElementsByTagNameNS {
-	    # Introduced in DOM Level 2
-
-	    return -code error "not yet implemented"
-	}
-
-	getElementsById {
-	    # Introduced in DOM Level 2
-
-	    return -code error "not yet implemented"
-	}
-
-	createEvent {
-	    # Introduced in DOM Level 2
-
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"document createEvent token type\""
-	    }
-
-	    set result [CreateEvent $token [lindex $args 0]]
-
-	}
-
-	getElementsByTagName {
-	    if {[llength $args] < 1} {
-		return -code error "wrong # args: should be \"document getElementsByTagName token what\""
-	    }
-
-	    return [eval Element:GetByTagName [list $token [lindex $args 0]] \
-		    [lrange $args 1 end]]
-	}
-
-	default {
-	    return -code error "unknown method \"$method\""
-	}
-
-    }
-
-    # Dispatch events
-
-    # Node insertion events are generated here instead of the
-    # internal factory procedures.  This is because the factory
-    # procedures are meant to be mean-and-lean during the parsing
-    # phase, and dispatching events at that time would be an
-    # excessive overhead.  The factory methods here are pretty
-    # heavyweight anyway.
-
-    if {[string match create* $method] && [string compare $method "createEvent"]} {
-
-	event postMutationEvent $result DOMNodeInserted -relatedNode $token
-	event postMutationEvent $result DOMNodeInsertedIntoDocument
-	event postMutationEvent $token DOMSubtreeModified
-
-    }
-
-    return $result
-}
-
-###	Factory methods
-###
-### These are lean-and-mean for fastest possible tree building
-
-# dom::tcl::CreateElement --
-#
-#	Append an element to the given (parent) node (if any)
-#
-# Arguments:
-#	token	parent node (if empty -document option is mandatory)
-#	name	element name (no checking performed here)
-#	aList	attribute list
-#	args	configuration options
-#
-# Results:
-#	New node created, parent optionally modified
-
-proc dom::tcl::CreateElement {token name aList args} {
-    array set opts $args
-
-    if {[string length $token]} {
-	upvar #0 $token parent
-	upvar #0 [namespace qualifiers $token]::Document document
-	set child [namespace qualifiers $token]::node[incr document(counter)]
-    } elseif {[info exists opts(-document)]} {
-	upvar #0 $opts(-document) document
-	set child [namespace qualifiers $opts(-document)]::node[incr document(counter)]
-    } else {
-	return -code error "no parent or document specified"
-    }
-
-    upvar #0 $child new
-
-    # Create the new node
-    # NB. normally we'd use Node:create here,
-    # but inline it instead for performance
-    array set new [list \
-	    node:parentNode $token		\
-	    node:childNodes ${child}var		\
-	    node:nodeType element		\
-	    node:nodeName $name			\
-	    node:namespaceURI {}		\
-	    node:prefix {}			\
-	    node:localName $name		\
-	    node:nodeValue {}			\
-	    element:attributeList ${child}arr	\
-	    element:attributeNodes {}		\
-    ]
-
-    catch {set new(node:namespaceURI) $opts(-namespace)}
-    catch {set new(node:localName) $opts(-localname)}
-    catch {set new(node:prefix) $opts(-prefix)}
-
-    # Initialise associated variables
-    set ${child}var {}
-    array set ${child}arr $aList
-    catch {
-	foreach {ns nsAttrList} $opts(-namespaceattributelists) {
-	    foreach {attrName attrValue} $nsAttrList {
-		array set ${child}arr [list $ns^$attrName $attrValue]
-	    }
-	}
-    }
-
-    # Update parent record
-
-    # Does this element qualify as the document element?
-    # If so, then has a document element already been set?
-
-    if {[string length $token] && 
-	[string equal $parent(node:nodeType) document]} {
-
-	if {$token == $parent(documentFragment:masterDoc)} {
-	    if {[info exists parent(document:documentElement)] && \
-		    [string length $parent(document:documentElement)]} {
-		# Do not attach to the tree
-		set new(node:parentNode) {}
-	    } else {
-
-		# Check against document type decl
-		if {[string length $parent(document:doctype)]} {
-		    upvar #0 $parent(document:doctype) doctypedecl
-		    if {[string compare $name $doctypedecl(doctype:name)]} {
-			return -code error "mismatch between root element type in document type declaration \"$doctypedecl(doctype:name)\" and root element \"$name\""
-		    }
-
-		} else {
-		    # Synthesize document type declaration
-		    set doctype [CreateDocType $name {} {}]
-		    set document(document:doctype) $doctype
-		}
-
-		set parent(document:documentElement) $child
-		catch {lappend $parent(node:childNodes) $child}
-	    }
-	} else {
-	    catch {lappend $parent(node:childNodes) $child}
-	}
-    } else {
-	catch {lappend $parent(node:childNodes) $child}
-    }
-
-    proc $child {method args} "return \[eval [namespace current]::node \[list \$method\] $child \$args\]"
-    trace add command $child delete [namespace code [list Node:Delete $child]]
-
-    return $child
-}
-
-# dom::tcl::CreateTextNode --
-#
-#	Append a textNode node to the given (parent) node (if any).
-#
-#	This factory function can also be performed by
-#	CreateGeneric, but text nodes are created so often
-#	that this specific factory procedure speeds things up.
-#
-# Arguments:
-#	token	parent node (if empty -document option is mandatory)
-#	text	initial text
-#	args	additional configuration options
-#
-# Results:
-#	New node created, parent optionally modified
-
-proc dom::tcl::CreateTextNode {token text args} {
-    array set opts $args
-
-    if {[string length $token]} {
-	upvar #0 $token parent
-	upvar #0 [namespace qualifiers $token]::Document document
-	set child [namespace qualifiers $token]::node[incr document(counter)]
-    } elseif {[info exists opts(-document)]} {
-	upvar #0 $opts(-document) document
-	set child [namespace qualifiers $opts(-document)]::node[incr document(counter)]
-    } else {
-	return -code error "no parent or document specified"
-    }
-
-    upvar #0 $child new
-
-    # Create the new node
-    # NB. normally we'd use Node:create here,
-    # but inline it instead for performance
-
-    # Text nodes never have children, so don't create a variable
-
-    array set new [list \
-	    node:parentNode $token		\
-	    node:childNodes ${child}var		\
-	    node:nodeType textNode		\
-	    node:nodeValue $text		\
-	    node:nodeName #text			\
-	    node:cdatasection 0			\
-    ]
-
-    set ${child}var {}
-
-    # Update parent record
-    catch {lappend $parent(node:childNodes) $child}
-
-    proc $child {method args} "return \[eval [namespace current]::node \[list \$method\] $child \$args\]"
-    trace add command $child delete [namespace code [list Node:Delete $child]]
-
-    return $child
-}
-
-# dom::tcl::CreateGeneric --
-#
-#	This is a template used for type-specific factory procedures
-#
-# Arguments:
-#	token	parent node (if empty -document option is mandatory)
-#	args	optional values
-#
-# Results:
-#	New node created, parent modified
-
-proc dom::tcl::CreateGeneric {token args} {
-    array set opts $args
-
-    if {[string length $token]} {
-	upvar #0 $token parent
-	upvar #0 [namespace qualifiers $token]::Document document
-	set child [namespace qualifiers $token]::node[incr document(counter)]
-    } elseif {[info exists opts(-document)]} {
-	upvar #0 $opts(-document) document
-	set child [namespace qualifiers $opts(-document)]::node[incr document(counter)]
-    } else {
-	return -code error "no parent or document specified"
-    }
-    upvar #0 $child new
-
-    # Create the new node
-    # NB. normally we'd use Node:create here,
-    # but inline it instead for performance
-    array set new [eval list [list \
-	    node:parentNode $token	\
-	    node:childNodes ${child}var	] \
-	    $args			\
-    ]
-    set ${child}var {}
-
-    switch -glob -- [string length $token],$opts(node:nodeType) {
-	0,* -
-	*,attribute -
-	*,namespace {
-	    # These type of nodes are not children of their parent
-	}
-
-	default {
-	    # Update parent record
-	    lappend $parent(node:childNodes) $child
-	}
-    }
-
-    proc $child {method args} "return \[eval [namespace current]::node \[list \$method\] $child \$args\]"
-    trace add command $child delete [namespace code [list Node:Delete $child]]
-
-    return $child
-}
-
-### Specials
-
-# dom::tcl::CreateDocType --
-#
-#	Create a Document Type Declaration node.
-#
-# Arguments:
-#	name	root element type
-#	publicid	public identifier
-#	systemid	system identifier
-#	internaldtd	internal DTD subset
-#
-# Results:
-#	Returns node id of the newly created node.
-
-proc dom::tcl::CreateDocType {name publicid systemid {internaldtd {}}} {
-    if {![regexp ^$::xml::QName\$ $name]} {
-	return -code error "invalid QName \"$name\""
-    }
-
-    set nodename [namespace current]::$name
-    upvar #0 $nodename doctype
-    if {[info exists doctype]} {
-	return $nodename
-    }
-
-    if {[llength $internaldtd] == 1 && [string length [lindex $internaldtd 0]] == 0} {
-	set dtd {}
-    }
-
-    array set doctype [list \
-	    node:childNodes {} \
-	    node:nodeType documentType \
-	    node:nodeName $name \
-	    node:nodeValue {} \
-	    doctype:name $name \
-	    doctype:entities {} \
-	    doctype:notations {} \
-	    doctype:publicId $publicid \
-	    doctype:systemId $systemid \
-	    doctype:internalSubset $internaldtd \
-    ]
-
-    proc $nodename {method args} "return \[eval [namespace current]::documenttype \[list \$method\] $nodename \$args\]"
-    trace add command $nodename delete [namespace code [list DocumentType:Delete $nodename]]
-
-    return $nodename
-}
-
-# dom::tcl::documenttype --
-#
-#	Functions for a document type declaration node.
-#
-# Arguments:
-#	method	method to invoke
-#	token	token for node
-#	args	arguments for method
-#
-# Results:
-#	Depends on method used.
-
-namespace eval dom::tcl {
-    variable documenttypeOptionsRO name|entities|notations|publicId|systemId|internalSubset
-    variable documenttypeOptionsRW {}
-}
-
-proc dom::tcl::documenttype {method token args} {
-    variable documenttypeOptionsRO
-    variable documenttypeOptionsRW
-
-    upvar #0 $token node
-
-    set result {}
-
-    switch -- $method {
-	cget {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::documenttype method token ?args ...?\""
-	    }
-	    if {[regexp [format {^-(%s)$} $documenttypeOptionsRO] [lindex $args 0] discard option]} {
-		switch -- $option {
-		    name {
-			return $node(node:nodeName)
-		    }
-		    default {
-			return $node(doctype:$option)
-		    }
-		}
-	    } elseif {[regexp [format {^-(%s)$} $documenttypeOptionsRW] [lindex $args 0] discard option]} {
-		return $node(doctype:$option)
-	    } else {
-		return -code error "bad option \"[lindex $args 0]\""
-	    }
-	}
-	configure {
-	    if {[llength $args] == 1} {
-		return [documenttype cget $token [lindex $args 0]]
-	    } elseif {[expr [llength $args] % 2]} {
-		return -code error "no value specified for option \"[lindex $args end]\""
-	    } else {
-		foreach {option value} $args {
-		    if {[regexp [format {^-(%s)$} $documenttypeOptionsRW] $option discard opt]} {
-			switch -- $opt {
-			    default {
-				set node(doctype:$opt) $value
-			    }
-			}
-		    } elseif {[regexp [format {^-(%s)$} $documenttypeOptionsRO] $option discard opt]} {
-			return -code error "attribute \"$option\" is read-only"
-		    } else {
-			return -code error "bad option \"$option\""
-		    }
-		}
-	    }
-	}
-    }
-
-    return $result
-}
-
-# dom::tcl::DocumentType:Delete --
-#
-#	Handle node destruction
-#
-# Arguments:
-#	name	node token
-#	old	)
-#	new	) arguments appended by trace command
-#	op	)
-#
-# Results:
-#	Node is destroyed
-
-proc dom::tcl::DocumentType:Delete {name old new op} {
-    DOMImplementation destroy $name
-}
-
-# dom::tcl::node --
-#
-#	Functions for a general node.
-#
-#	Implements EventTarget Interface - introduced in DOM Level 2
-#
-# Arguments:
-#	method	method to invoke
-#	token	token for node
-#	args	arguments for method
-#
-# Results:
-#	Depends on method used.
-
-namespace eval dom::tcl {
-    variable nodeOptionsRO nodeType|parentNode|childNodes|firstChild|lastChild|previousSibling|nextSibling|attributes|namespaceURI|prefix|localName|ownerDocument
-    variable nodeOptionsRW nodeValue|cdatasection
-
-    # Allowing nodeName to be rw is not standard DOM.
-    # A validating implementation would have to be very careful
-    # in allowing this feature
-    if {$::dom::strictDOM} {
-	append nodeOptionsRO |nodeName
-    } else {
-	append nodeOptionsRW |nodeName
-    }
-}
-# NB. cdatasection is not a standard DOM option
-
-proc dom::tcl::node {method token args} {
-    variable nodeOptionsRO
-    variable nodeOptionsRW
-
-    upvar #0 $token node
-
-    set result {}
-
-    switch -glob -- $method {
-	cg* {
-	    # cget
-
-	    # Some read-only configuration options are computed
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::node cget token option\""
-	    }
-	    if {[regexp [format {^-(%s)$} $nodeOptionsRO] [lindex $args 0] discard option]} {
-		switch $option {
-		    nodeName {
-			set result $node(node:nodeName)
-			switch $node(node:nodeType) {
-			    textNode {
-				catch {set result [expr {$node(node:cdatasection) ? "#cdata-section" : $node(node:nodeName)}]}
-			    }
-			    default {
-			    }
-			}
-		    }
-		    childNodes {
-			# How are we going to handle documentElement?
-			set result $node(node:childNodes)
-		    }
-		    firstChild {
-			upvar #0 $node(node:childNodes) children
-			switch $node(node:nodeType) {
-			    document {
-				set result [lindex $children 0]
-				catch {set result $node(document:documentElement)}
-			    }
-			    default {
-				set result [lindex $children 0]
-			    }
-			}
-		    }
-		    lastChild {
-			upvar #0 $node(node:childNodes) children
-			switch $node(node:nodeType) {
-			    document {
-				set result [lindex $children end]
-				catch {set result $node(document:documentElement)}
-			    }
-			    default {
-				set result [lindex $children end]
-			    }
-			}
-		    }
-		    previousSibling {
-			# BUG: must take documentElement into account
-			# Find the parent node
-			upvar #0 $node(node:parentNode) parent
-			upvar #0 $parent(node:childNodes) children
-			set idx [lsearch $children $token]
-			if {$idx >= 0} {
-			    set sib [lindex $children [incr idx -1]]
-			    if {[llength $sib]} {
-				set result $sib
-			    } else {
-				set result {}
-			    }
-			} else {
-			    set result {}
-			}
-		    }
-		    nextSibling {
-			# BUG: must take documentElement into account
-			# Find the parent node
-			upvar #0 $node(node:parentNode) parent
-			upvar #0 $parent(node:childNodes) children
-			set idx [lsearch $children $token]
-			if {$idx >= 0} {
-			    set sib [lindex $children [incr idx]]
-			    if {[llength $sib]} {
-				set result $sib
-			    } else {
-				set result {}
-			    }
-			} else {
-			    set result {}
-			}
-		    }
-		    attributes {
-			if {[string compare $node(node:nodeType) element]} {
-			    set result {}
-			} else {
-			    set result $node(element:attributeList)
-			}
-		    }
-		    ownerDocument {
-			if {[string compare $node(node:parentNode) {}]} {
-			    return [namespace qualifiers $token]::Document
-			} else {
-			    return $token
-			}
-		    }
-		    default {
-			return [GetField node(node:$option)]
-		    }
-		}
-	    } elseif {[regexp [format {^-(%s)$} $nodeOptionsRW] [lindex $args 0] discard option]} {
-		return [GetField node(node:$option)]
-	    } else {
-		return -code error "unknown option \"[lindex $args 0]\""
-	    }
-	}
-	co* {
-	    # configure
-
-	    if {[llength $args] == 1} {
-		return [node cget $token [lindex $args 0]]
-	    } elseif {[expr [llength $args] % 2]} {
-		return -code error "wrong \# args: should be \"::dom::node configure node option\""
-	    } else {
-		foreach {option value} $args {
-		    if {[regexp [format {^-(%s)$} $nodeOptionsRW] $option discard opt]} {
-
-			switch $opt,$node(node:nodeType) {
-			    nodeValue,textNode -
-			    nodeValue,processingInstruction {
-				# Dispatch event
-				set evid [CreateEvent $token DOMCharacterDataModified]
-				event initMutationEvent $evid DOMCharacterDataModified 1 0 {} $node(node:nodeValue) $value {} {}
-				set node(node:nodeValue) $value
-				node dispatchEvent $token $evid
-				DOMImplementation destroy $evid
-			    }
-			    default {
-				set node(node:$opt) $value
-			    }
-			}
-
-		    } elseif {[regexp [format {^-(%s)$} $nodeOptionsRO] $option discard opt]} {
-			return -code error "attribute \"$option\" is read-only"
-		    } else {
-			return -code error "unknown option \"$option\""
-		    }
-		}
-	    }
-	}
-
-	in* {
-
-	    # insertBefore
-
-	    # Previous and next sibling relationships are OK, 
-	    # because they are dynamically determined
-
-	    if {[llength $args] < 1 || [llength $args] > 2} {
-		return -code error "wrong # args: should be \"dom::node insertBefore token new ?ref?\""
-	    }
-
-	    upvar #0 [lindex $args 0] newChild
-	    if {[string compare [namespace qualifiers [lindex $args 0]] [namespace qualifiers $token]]} {
-		return -code error "new node must be in the same document"
-	    }
-
-	    switch [llength $args] {
-		1 {
-		    # Append as the last node
-		    if {[string length $newChild(node:parentNode)]} {
-			node removeChild $newChild(node:parentNode) [lindex $args 0]
-		    }
-		    lappend $node(node:childNodes) [lindex $args 0]
-		    set newChild(node:parentNode) $token
-		}
-		2 {
-		    upvar #0 [lindex $args 1] refChild
-
-		    if {[string compare [namespace qualifiers [lindex $args 1]] [namespace qualifiers [lindex $args 0]]]} {
-			return -code error "nodes must be in the same document"
-		    }
-		    set idx [lsearch [set $node(node:childNodes)] [lindex $args 1]]
-		    if {$idx < 0} {
-			return -code error "no such reference child"
-		    } else {
-
-			# Remove from previous parent
-			if {[string length $newChild(node:parentNode)]} {
-			    node removeChild $newChild(node:parentNode) [lindex $args 0]
-			}
-
-			# Insert into new node
-			set $node(node:childNodes) \
-				[linsert [set $node(node:childNodes)] $idx [lindex $args 0]]
-			set newChild(node:parentNode) $token
-		    }
-		}
-	    }
-
-	    event postMutationEvent [lindex $args 0] DOMNodeInserted -relatedNode $token
-	    FireNodeInsertedEvents [lindex $args 0]
-	    event postMutationEvent $token DOMSubtreeModified
-
-	    set result [lindex $args 0]
-
-	}
-
-	rep* {
-
-	    # replaceChild
-
-	    if {[llength $args] != 2} {
-		return -code error "wrong # args: should be \"dom::node replaceChild token new old\""
-	    }
-
-	    upvar #0 [lindex $args 0] newChild
-	    upvar #0 [lindex $args 1] oldChild
-	    upvar #0 $node(node:childNodes) children
-
-	    # Find where to insert new child
-	    set idx [lsearch $children [lindex $args 1]]
-	    if {$idx < 0} {
-		return -code error "no such old child"
-	    }
-
-	    # Remove new child from current parent
-	    if {[string length $newChild(node:parentNode)]} {
-		node removeChild $newChild(node:parentNode) [lindex $args 0]
-	    }
-
-	    set children \
-		[lreplace $children $idx $idx [lindex $args 0]]
-	    set newChild(node:parentNode) $token
-
-	    # Update old child to reflect lack of parentage
-	    set oldChild(node:parentNode) {}
-
-	    set result [lindex $args 1]
-
-	    event postMutationEvent [lindex $args 0] DOMNodeInserted -relatedNode $token
-	    FireNodeInsertedEvents [lindex $args 0]
-	    event postMutationEvent $token DOMSubtreeModified
-
-	}
-
-	removeC* {
-
-	    # removeChild
-
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::node removeChild token child\""
-	    }
-	    upvar #0 [lindex $args 0] oldChild
-	    if {[string compare [namespace qualifiers [lindex $args 0]] [namespace qualifiers $token]]} {
-		return -code error "node \"[lindex $args 0]\" is not a child"
-	    }
-
-	    # Remove the child from the parent
-	    upvar #0 $node(node:childNodes) myChildren
-	    if {[set idx [lsearch $myChildren [lindex $args 0]]] < 0} {
-		return -code error "node \"[lindex $args 0]\" is not a child"
-	    }
-	    set myChildren [lreplace $myChildren $idx $idx]
-
-	    # Update the child to reflect lack of parentage
-	    set oldChild(node:parentNode) {}
-
-	    set result [lindex $args 0]
-
-	    # Event propagation has a problem here:
-	    # Nodes that until recently were ancestors may
-	    # want to capture the event, but we've just removed
-	    # the parentage information.  They get a DOMSubtreeModified
-	    # instead.
-	    event postMutationEvent [lindex $args 0] DOMNodeRemoved -relatedNode $token
-	    FireNodeRemovedEvents [lindex $args 0]
-	    event postMutationEvent $token DOMSubtreeModified
-
-	}
-
-	ap* {
-
-	    # appendChild
-
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::node appendChild token child\""
-	    }
-
-	    # Add to new parent
-	    node insertBefore $token [lindex $args 0]
-
-	    set result [lindex $args 0]
-
-	}
-
-	hasChildNodes {
-	    set result [Min 1 [llength [set $node(node:childNodes)]]]
-	}
-
-	isSameNode {
-	    # Introduced in DOM Level 3
-	    switch [llength $args] {
-		1 {
-		    return [expr {$token == [lindex $args 0]}]
-		}
-		default {
-		    return -code error "wrong # args: should be \"dom::node isSameNode token ref\""
-		}
-	    }
-	}
-
-	cl* {
-	    # cloneNode
-
-	    # May need to pay closer attention to generation of events here
-
-	    set deep 0
-	    switch [llength $args] {
-		0 {
-		}
-		2 {
-		    foreach {opt value} $args {
-			switch -- $opt {
-			    -deep {
-				set deep [Boolean $value]
-			    }
-			    default {
-				return -code error "bad option \"$opt\""
-			    }
-			}
-		    }
-		}
-		default {
-		    return -code error "wrong # args: should be \"dom::node cloneNode token ?-deep boolean?\""
-		}
-	    }
-
-	    switch $node(node:nodeType) {
-		element {
-		    set result [CreateElement {} $node(node:nodeName) [array get $node(element:attributeList)] -document [namespace qualifiers $token]::Document]
-		    if {$deep} {
-			foreach child [set $node(node:childNodes)] {
-			    node appendChild $result [node cloneNode $child -deep 1]
-			}
-		    }
-		}
-		textNode {
-		    set result [CreateTextNode {} $node(node:nodeValue) -document [namespace qualifiers $token]::Document]
-		}
-		document {
-		    set result [DOMImplementation create]
-		    upvar #0 $result clonedDoc
-		    array set clonedDoc [array get node document:doctype]
-		    if {$deep} {
-			foreach child [set $node(node:childNodes)] {
-			    node appendChild $result [document importNode $result $child -deep 1]
-			}
-		    }
-		}
-		documentFragment -
-		default {
-		    set result [CreateGeneric {} node:nodeType $node(node:nodeType) -document [namespace qualifiers $token]::Document]
-		    if {$deep} {
-			foreach child [set $node(node:childNodes)] {
-			    node appendChild $result [node cloneNode $child -deep 1]
-			}
-		    }
-		}
-	    }
-	}
-
-	ch* {
-	    # children -- non-standard method
-
-	    # If this is a textNode, then catch the error
-	    set result {}
-	    catch {set result [set $node(node:childNodes)]}
-
-	}
-
-	par* {
-	    # parent -- non-standard method
-
-	    return $node(node:parentNode)
-
-	}
-
-	pat* {
-	    # path -- non-standard method
-
-	    for {
-		set ancestor $token
-		upvar #0 $token ancestorNd
-		set result {}
-	    } {[string length $ancestorNd(node:parentNode)]} {
-		set ancestor $ancestorNd(node:parentNode)
-		upvar #0 $ancestor ancestorNd
-	    } {
-		set result [linsert $result 0 $ancestor]
-	    }
-	    # The last node is the document node
-	    set result [linsert $result 0 $ancestor]
-
-	}
-
-	createNode {
-	    # createNode -- non-standard method
-
-	    # Creates node(s) in this document given an XPath expression.
-	    # Relative location paths have this node as their initial context.
-
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::node createNode token path\""
-	    }
-
-	    package require xpath
-
-	    return [XPath:CreateNode $token [lindex $args 0]]
-	}
-
-	selectNode {
-	    # selectNode -- non-standard method
-
-	    # Returns nodeset in this document matching an XPath expression.
-	    # Relative location paths have this node as their initial context.
-
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::node selectNode token path\""
-	    }
-
-	    package require xpath
-
-	    return [XPath:SelectNode $token [lindex $args 0]]
-	}
-
-	stringValue {
-	    # stringValue -- non-standard method
-	    # Returns string value of a node, as defined by XPath Rec.
-
-	    if {[llength $args] > 0} {
-		return -code error "wrong # args: should be \"dom::node stringValue token\""
-	    }
-
-	    switch $node(node:nodeType) {
-		document -
-		documentFragment -
-		element {
-		    set value {}
-		    foreach child [set $node(node:childNodes)] {
-			switch [node cget $child -nodeType] {
-			    element -
-			    textNode {
-				append value [node stringValue $child]
-			    }
-			    default {
-				# Other nodes are not considered
-			    }
-			}
-		    }
-		    return $value
-		}
-		attribute -
-		textNode -
-		processingInstruction -
-		comment {
-		    return $node(node:nodeValue)
-		}
-		default {
-		    return {}
-		}
-	    }
-
-	}
-
-	addEv* {
-	    # addEventListener -- introduced in DOM Level 2
-
-	    if {[llength $args] < 1} {
-		return -code error "wrong # args: should be \"dom::node addEventListener token type ?listener? ?option value...?\""
-	    }
-
-	    set type [lindex $args 0]
-	    set args [lrange $args 1 end]
-	    set listener [lindex $args 0]
-	    if {[llength $args] == 1} {
-		set args {}
-	    } elseif {[llength $args] > 1} {
-		if {[string match -* $listener]} {
-		    set listener {}
-		} else {
-		    set args [lrange $args 1 end]
-		}
-	    }
-	    array set opts {-usecapture 0}
-	    if {[catch {array set opts $args}]} {
-		return -code error "missing value for option \"[lindex $args end]\""
-	    }
-	    set opts(-usecapture) [Boolean $opts(-usecapture)]
-	    set listenerType [expr {$opts(-usecapture) ? "capturer" : "listener"}]
-
-	    if {[string length $listener]} {
-		if {![info exists node(event:$type:$listenerType)] || \
-			[lsearch $node(event:$type:$listenerType) $listener] < 0} {
-		    lappend node(event:$type:$listenerType) $listener
-		}
-		# else avoid registering same listener twice
-	    } else {
-		# List all listeners
-		set result {}
-		catch {set result $node(event:$type:$listenerType)}
-		return $result
-	    }
-	}
-
-	removeE* {
-	    # removeEventListener -- introduced in DOM Level 2
-
-	    if {[llength $args] < 2} {
-		return -code error "wrong # args: should be \"dom::node removeEventListener token type listener ?option value...?\""
-	    }
-
-	    set type [lindex $args 0]
-	    set listener [lindex $args 1]
-	    array set opts {-usecapture 0}
-	    array set opts [lrange $args 2 end]
-	    set opts(-usecapture) [Boolean $opts(-usecapture)]
-	    set listenerType [expr {$opts(-usecapture) ? "capturer" : "listener"}]
-
-	    set idx [lsearch $node(event:$type:$listenerType) $listener]
-	    if {$idx >= 0} {
-		set node(event:$type:$listenerType) [lreplace $node(event:$type:$listenerType) $idx $idx]
-	    }
-
-	}
-
-	disp* {
-	    # dispatchEvent -- introduced in DOM Level 2
-
-	    # This is where the fun happens!
-	    # Check to see if there one or more event listener,
-	    # if so trigger the listener(s).
-	    # Then pass the event up to the ancestor.
-	    # This may be modified by event capturing and bubbling.
-
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::node dispatchEvent token eventnode\""
-	    }
-
-	    set eventId [lindex $args 0]
-	    upvar #0 $eventId event
-	    set type $event(type)
-
-	    if {![string length $event(eventPhase)]} {
-
-		# This is the initial dispatch of the event.
-		# First trigger any capturing event listeners
-		# Starting from the root, proceed downward
-
-		set event(eventPhase) capturing_phase
-		set event(target) $token
-
-		# DOM L2 specifies that the ancestors are determined
-		# at the moment of event dispatch, so using a static
-		# list is the correct thing to do
-
-		foreach ancestor [lreplace [node path $token] end end] {
-		    set event(currentNode) $ancestor
-
-		    upvar #0 $ancestor ancNode
-
-		    if {[info exists ancNode(event:$type:capturer)]} {
-			foreach capturer $ancNode(event:$type:capturer) {
-			    if {[catch {uplevel #0 $capturer [list $eventId]} capturerError]} {
-				bgerror "error in capturer \"$capturerError\""
-			    }
-			}
-
-			# A listener may stop propagation,
-			# but we check here to let all of the
-			# listeners at that level complete
-
-			if {$event(cancelable) && $event(stopPropagation)} {
-			    break
-			}
-		    }
-		}
-
-		# Prepare for next phase
-		set event(eventPhase) at_target
-
-	    }
-
-	    set event(currentNode) $token
-
-	    if {[info exists node(event:$type:listener)]} {
-		foreach listener $node(event:$type:listener) {
-		    if {[catch {uplevel #0 $listener [list $eventId]} listenerError]} {
-			bgerror "error in listener \"$listenerError\""
-		    }
-		}
-	    }
-
-	    set event(eventPhase) bubbling_phase
-
-	    # Now propagate the event
-	    if {$event(cancelable) && $event(stopPropagation)} {
-		# Event has been cancelled
-	    } elseif {[llength $node(node:parentNode)]} {
-		# Go ahead and propagate
-		node dispatchEvent $node(node:parentNode) $eventId
-	    }
-
-	    set event(dispatched) 1
-	}
-
-	default {
-	    return -code error "unknown method \"$method\""
-	}
-
-    }
-
-    return $result
-}
-
-# dom::tcl::Node:create --
-#
-#	Generic node creation.
-#	See also CreateElement, CreateTextNode, CreateGeneric.
-#
-# Arguments:
-#	pVar	array in caller which contains parent details
-#	args	configuration options
-#
-# Results:
-#	New child node created.
-
-proc dom::tcl::Node:create {pVar args} {
-    upvar #0 $pVar parent
-
-    array set opts {-name {} -value {}}
-    array set opts $args
-
-    upvar #0 [namespace qualifiers $pVar]::Document document
-
-    # Create new node
-    if {![info exists opts(-id)]} {
-	set opts(-id) node[incr document(counter)]
-    }
-    set child [namespace qualifiers $pVar]::$opts(-id)
-    upvar #0 $child new
-    array set new [list \
-	    node:parentNode $opts(-parent)	\
-	    node:childNodes ${child}var		\
-	    node:nodeType $opts(-type)		\
-	    node:nodeName $opts(-name)		\
-	    node:nodeValue $opts(-value)	\
-	    element:attributeList ${child}arr	\
-    ]
-    set ${child}var {}
-    array set ${child}arr {}
-
-    # Update parent node
-    if {![info exists parent(document:documentElement)]} {
-	lappend parent(node:childNodes) $child
-    }
-
-    proc $child {method args} "return \[eval [namespace current]::node \[list \$method\] $child \$args\]"
-    trace add command $child delete [namespace code [list Node:Delete $child]]
-
-    return $child
-}
-
-# dom::tcl::Node:set --
-#
-#	Generic node update
-#
-# Arguments:
-#	token	node token
-#	args	configuration options
-#
-# Results:
-#	Node modified.
-
-proc dom::tcl::Node:set {token args} {
-    upvar #0 $token node
-
-    foreach {key value} $args {
-	set node($key) $value
-    }
-
-    return {}
-}
-
-# dom::tcl::Node:Delete --
-#
-#	Handle node destruction
-#
-# Arguments:
-#	name	node token
-#	old	)
-#	new	) arguments appended by trace command
-#	op	)
-#
-# Results:
-#	Node is destroyed
-
-proc dom::tcl::Node:Delete {name old new op} {
-    if {[catch {DOMImplementation destroy $name} ret]} {
-	# Document has been deleted... namespace has been destroyed
-    } else {
-	return $ret
-    }
-}
-
-# dom::tcl::FireNodeInsertedEvents --
-#
-#	Recursively descend the tree triggering DOMNodeInserted
-#	events as we go.
-#
-# Arguments:
-#	nodeid	Node ID
-#
-# Results:
-#	DOM L2 DOMNodeInserted events posted
-
-proc dom::tcl::FireNodeInsertedEvents nodeid {
-    event postMutationEvent $nodeid DOMNodeInsertedIntoDocument
-    foreach child [node children $nodeid] {
-	FireNodeInsertedEvents $child
-    }
-
-    return {}
-}
-
-# dom::tcl::FireNodeRemovedEvents --
-#
-#	Recursively descend the tree triggering DOMNodeRemoved
-#	events as we go.
-#
-# Arguments:
-#	nodeid	Node ID
-#
-# Results:
-#	DOM L2 DOMNodeRemoved events posted
-
-proc dom::tcl::FireNodeRemovedEvents nodeid {
-    event postMutationEvent $nodeid DOMNodeRemovedFromDocument
-    foreach child [node children $nodeid] {
-	FireNodeRemovedEvents $child
-    }
-
-    return {}
-}
-
-# dom::tcl::element --
-#
-#	Functions for an element.
-#
-# Arguments:
-#	method	method to invoke
-#	token	token for node
-#	args	arguments for method
-#
-# Results:
-#	Depends on method used.
-
-namespace eval dom::tcl {
-    variable elementOptionsRO tagName|empty
-    variable elementOptionsRW {}
-}
-
-proc dom::tcl::element {method token args} {
-    variable elementOptionsRO
-    variable elementOptionsRW
-
-    upvar #0 $token node
-
-    if {[string compare $node(node:nodeType) "element"]} {
-	return -code error "malformed node token \"$token\""
-    }
-    set result {}
-
-    switch -- $method {
-
-	cget {
-	    # Some read-only configuration options are computed
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::element cget token option\""
-	    }
-	    if {[regexp [format {^-(%s)$} $elementOptionsRO] [lindex $args 0] discard option]} {
-		switch $option {
-		    tagName {
-			set result [lindex $node(node:nodeName) 0]
-		    }
-		    empty {
-			if {![info exists node(element:empty)]} {
-			    return 0
-			} else {
-			    return $node(element:empty)
-			}
-		    }
-		    default {
-			return $node(node:$option)
-		    }
-		}
-	    } elseif {[regexp [format {^-(%s)$} $elementOptionsRW] [lindex $args 0] discard option]} {
-		return $node(node:$option)
-	    } else {
-		return -code error "bad option \"[lindex $args 0]\""
-	    }
-	}
-	configure {
-	    if {[llength $args] == 1} {
-		return [document cget $token [lindex $args 0]]
-	    } elseif {[expr [llength $args] % 2]} {
-		return -code error "no value specified for option \"[lindex $args end]\""
-	    } else {
-		foreach {option value} $args {
-		    if {[regexp [format {^-(%s)$} $elementOptionsRO] $option discard opt]} {
-			return -code error "option \"$option\" cannot be modified"
-		    } elseif {[regexp [format {^-(%s)$} $elementOptionsRW] $option discard opt]} {
-			return -code error "not implemented"
-		    } else {
-			return -code error "bad option \"$option\""
-		    }
-		}
-	    }
-	}
-
-	getAttribute {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::element getAttribute token name\""
-	    }
-
-	    set result {}
-
-	    upvar #0 $node(element:attributeList) attrList
-	    catch {set result $attrList([lindex $args 0])}
-
-	    return $result
-
-	}
-
-	setAttribute {
-	    if {[llength $args] != 2} {
-		return -code error "wrong # args: should be \"dom::element setAttribute token name value\""
-	    }
-
-	    # Check that the attribute name is kosher
-	    if {![regexp ^$::xml::Name\$ [lindex $args 0]]} {
-		return -code error "invalid attribute name \"[lindex $args 0]\""
-	    }
-
-	    upvar #0 $node(element:attributeList) attrList
-	    set evid [CreateEvent $token DOMAttrModified]
-	    set oldValue {}
-	    catch {set oldValue $attrList([lindex $args 0])}
-	    event initMutationEvent $evid DOMAttrModified 1 0 $token $oldValue [lindex $args 1] [lindex $args 0] [expr {[info exists attrList([lindex $args 0])] ? "modification" : "addition"}]
-	    set result [set attrList([lindex $args 0]) [lindex $args 1]]
-	    node dispatchEvent $token $evid
-	    DOMImplementation destroy $evid
-
-	}
-
-	removeAttribute {
-	    if {[llength $args] != 1} {
-		return -code error "wrong # args: should be \"dom::element removeAttribute token name\""
-	    }
-
-	    upvar #0 $node(element:attributeList) attrList
-	    catch {unset attrList([lindex $args 0])}
-
-	    event postMutationEvent $token DOMAttrRemoved -attrName [lindex $args 0] -attrChange removal
-
-	}
-
-	getAttributeNS {
-	    if {[llength $args] != 2} {
-		return -code error "wrong # args: should be \"dom::element getAttributeNS token ns name\""
-	    }
-
-	    set result {}
-	    upvar #0 $node(element:attributeList) attrList
-	    catch {set result $attrList([lindex $args 0]^[lindex $args 1])}
-
-	    return $result
-
-	}
-
-	setAttributeNS {
-	    if {[llength $args] != 3} {
-		return -code error "wrong # args: should be \"dom::element setAttributeNS token ns attr value\""
-	    }
-
-	    # Check that the attribute name is kosher
-	    if {![regexp ^$::xml::QName\$ [lindex $args 1] discard prefix localName]} {
-		return -code error "invalid qualified attribute name \"[lindex $args 1]\""
-	    }
-
-	    # BUG: At the moment the prefix is ignored
-
-	    upvar #0 $node(element:attributeList) attrList
-	    set evid [CreateEvent $token DOMAttrModified]
-	    set oldValue {}
-	    catch {set oldValue $attrList([lindex $args 0]^$localName)}
-	    event initMutationEvent $evid DOMAttrModified 1 0 $token $oldValue [lindex $args 2] [lindex $args 0]^localName [expr {[info exists attrList([lindex $args 0]^$localName)] ? "modification" : "addition"}]
-	    set result [set attrList([lindex $args 0]^$localName) [lindex $args 2]]
-	    node dispatchEvent $token $evid
-	    DOMImplementation destroy $evid
-
-	}
-
-	removeAttributeNS {
-	    if {[llength $args] != 2} {
-		return -code error "wrong # args: should be \"dom::element removeAttributeNS token ns name\""
-	    }
-
-	    upvar #0 $node(element:attributeList) attrList
-	    catch {unset attrList([lindex $args 0]^[lindex $args 1])}
-
-	    event postMutationEvent $token DOMAttrRemoved -attrName [lindex $args 0]^[lindex $args 1] -attrChange removal
-
-	}
-
-	getAttributeNode {
-	    array set tmp [array get $node(element:attributeList)]
-	    if {![info exists tmp([lindex $args 0])]} {
-		return {}
-	    }
-
-	    # Synthesize an attribute node if one doesn't already exist
-	    array set attrNodes $node(element:attributeNodes)
-	    if {[catch {set result $attrNodes([lindex $args 0])}]} {
-		set result [CreateGeneric $token node:nodeType attribute node:nodeName [lindex $args 0] node:nodeValue $tmp([lindex $args 0])]
-		lappend node(element:attributeNodes) [lindex $args 0] $result
-	    }
-	}
-
-	setAttributeNode -
-	removeAttributeNode -
-	getAttributeNodeNS -
-	setAttributeNodeNS -
-	removeAttributeNodeNS {
-	    return -code error "not yet implemented"
-	}
-
-	getElementsByTagName {
-	    if {[llength $args] < 1} {
-		return -code error "wrong # args: should be \"dom::element getElementsByTagName token name\""
-	    }
-
-	    return [eval Element:GetByTagName [list $token [lindex $args 0]] \
-		    [lrange $args 1 end]]
-	}
-
-	normalize {
-	    if {[llength $args]} {
-		return -code error "wrong # args: should be dom::element normalize token"
-	    }
-
-	    Element:Normalize node [set $node(node:childNodes)]
-	}
-
-	default {
-	    return -code error "bad method \"$method\": should be cget, configure, getAttribute, setAttribute, removeAttribute, getAttributeNS, setAttributeNS, removeAttributeNS, getAttributeNode, setAttributeNode, removeAttributeNode, getAttributeNodeNS, setAttributeNodeNS, removeAttributeNodeNS, getElementsByTagName or normalize"
-	}
-
-    }
-
-    return $result
-}
-
-# dom::tcl::Element:GetByTagName --
-#
-#	Search for (child) elements
-#
-#	This used to be non-recursive, but then I read the DOM spec
-#	properly and discovered that it should recurse.  The -deep
-#	option allows for backward-compatibility, and defaults to the
-#	DOM-specified value of true.
-#
-# Arguments:
-#	token	parent node
-#	name	element type to search for
-#	args	configuration options
-#
-# Results:
-#	The name of the variable containing the list of matching node tokens
-
-proc dom::tcl::Element:GetByTagName {token name args} {
-    upvar #0 $token node
-    upvar #0 [namespace qualifiers $token]::Document document
-
-    array set cfg {-deep 1}
-    array set cfg $args
-    set cfg(-deep) [Boolean $cfg(-deep)]
-
-    # Guard against arbitrary glob characters
-    # Checking that name is a legal XML Name does this
-    # However, '*' is permitted
-    if {![regexp ^$::xml::Name\$ $name] && [string compare $name "*"]} {
-	return -code error "invalid element name"
-    }
-
-    # Allocate variable name for this search
-    set searchVar ${token}search[incr document(counter)]
-    upvar \#0 $searchVar search
-
-    # Make list live by interposing on variable reads
-    # I don't think we need to interpose on unsets,
-    # and writing to this variable by the application is
-    # not permitted.
-
-    trace variable $searchVar w [namespace code Element:GetByTagName:Error]
-
-    if {[string compare $node(node:nodeType) "document"]} {
-	trace variable $searchVar r [namespace code [list Element:GetByTagName:Search [set $node(node:childNodes)] $name $cfg(-deep)]]
-    } elseif {[llength $node(document:documentElement)]} {
-	# Document Element must exist and must be an element type node
-	trace variable $searchVar r [namespace code [list Element:GetByTagName:Search $node(document:documentElement) $name $cfg(-deep)]]
-    }
-
-    return $searchVar
-}
-
-# dom::tcl::Element:GetByTagName:Search --
-#
-#	Search for elements.  This does the real work.
-#	Because this procedure is invoked everytime
-#	the variable is read, it returns the live list.
-#
-# Arguments:
-#	tokens	nodes to search (inclusive)
-#	name	element type to search for
-#	deep	whether to search recursively
-#	name1	\
-#	name2	 > appended by trace command
-#	op	/
-#
-# Results:
-#	List of matching node tokens
-
-proc dom::tcl::Element:GetByTagName:Search {tokens name deep name1 name2 op} {
-    set result {}
-
-    foreach tok $tokens {
-	upvar #0 $tok nodeInfo
-	switch -- $nodeInfo(node:nodeType) {
-	    element {
-		if {[string match $name [GetField nodeInfo(node:nodeName)]]} {
-		    lappend result $tok
-		}
-		if {$deep} {
-		    set childResult [Element:GetByTagName:Search [set $nodeInfo(node:childNodes)] $name $deep {} {} {}]
-		    if {[llength $childResult]} {
-			eval lappend result $childResult
-		    }
-		}
-	    }
-	}
-    }
-
-    if {[string length $name1]} {
-	set $name1 $result
-	return {}
-    } else {
-	return $result
-    }
-}
-
-# dom::tcl::Element:GetByTagName:Error --
-#
-#	Complain about the application writing to a variable
-#	that this package maintains.
-#
-# Arguments:
-#	name1	\
-#	name2	 > appended by trace command
-#	op	/
-#
-# Results:
-#	Error code returned.
-
-proc dom::tcl::Element:GetByTagName:Error {name1 name2 op} {
-    return -code error "dom: Read-only variable"
-}
-
-# dom::tcl::Element:Normalize --
-#
-#	Normalize the text nodes
-#
-# Arguments:
-#	pVar	parent array variable in caller
-#	nodes	list of node tokens
-#
-# Results:
-#	Adjacent text nodes are coalesced
-
-proc dom::tcl::Element:Normalize {pVar nodes} {
-    upvar #0 $pVar parent
-
-    set textNode {}
-
-    foreach n $nodes {
-	upvar #0 $n child
-	set cleanup {}
-
-	switch $child(node:nodeType) {
-	    textNode {
-		if {[llength $textNode]} {
-
-		    # Coalesce into previous node
-		    set evid [CreateEvent $n DOMCharacterDataModified]
-		    event initMutationEvent $evid DOMCharacterDataModified 1 0 {} $text(node:nodeValue) $text(node:nodeValue)$child(node:nodeValue) {} {}
-		    append text(node:nodeValue) $child(node:nodeValue)
-		    node dispatchEvent $n $evid
-		    DOMImplementation destroy $evid
-
-		    # Remove this child
-		    upvar #0 $parent(node:childNodes) childNodes
-		    set idx [lsearch $childNodes $n]
-		    set childNodes [lreplace $childNodes $idx $idx]
-		    unset $n
-		    set cleanup [list event postMutationEvent [node parent $n] DOMSubtreeModified]
-		    event postMutationEvent $n DOMNodeRemoved
-
-		    set $textNode [array get text]
-		} else {
-		    set textNode $n
-		    catch {unset text}
-		    array set text [array get child]
-		}
-	    }
-	    element -
-	    document -
-	    documentFragment {
-		set textNode {}
-		Element:Normalize child [set $child(node:childNodes)]
-	    }
-	    default {
-		set textNode {}
-	    }
-	}
-
-	eval $cleanup
-    }
-
-    return {}
-}
-
-# dom::tcl::processinginstruction --
-#
-#	Functions for a processing intruction.
-#
-# Arguments:
-#	method	method to invoke
-#	token	token for node
-#	args	arguments for method
-#
-# Results:
-#	Depends on method used.
-
-namespace eval dom::tcl {
-    variable piOptionsRO target
-    variable piOptionsRW data
-}
-
-proc dom::tcl::processinginstruction {method token args} {
-    variable piOptionsRO
-    variable piOptionsRW
-
-    upvar #0 $token node
-
-    set result {}
-
-    switch -- $method {
-
-	cget {
-	    # Some read-only configuration options are computed
-	    if {[llength $args] != 1} {
-		return -code error "too many arguments"
-	    }
-	    if {[regexp [format {^-(%s)$} $elementOptionsRO] [lindex $args 0] discard option]} {
-		switch $option {
-		    target {
-			set result [lindex $node(node:nodeName) 0]
-		    }
-		    default {
-			return $node(node:$option)
-		    }
-		}
-	    } elseif {[regexp [format {^-(%s)$} $elementOptionsRW] [lindex $args 0] discard option]} {
-		switch $option {
-		    data {
-			return $node(node:nodeValue)
-		    }
-		    default {
-			return $node(node:$option)
-		    }
-		}
-	    } else {
-		return -code error "unknown option \"[lindex $args 0]\""
-	    }
-	}
-	configure {
-	    if {[llength $args] == 1} {
-		return [document cget $token [lindex $args 0]]
-	    } elseif {[expr [llength $args] % 2]} {
-		return -code error "no value specified for option \"[lindex $args end]\""
-	    } else {
-		foreach {option value} $args {
-		    if {[regexp [format {^-(%s)$} $elementOptionsRO] $option discard opt]} {
-			return -code error "attribute \"$option\" is read-only"
-		    } elseif {[regexp [format {^-(%s)$} $elementOptionsRW] $option discard opt]} {
-			switch $opt {
-			    data {
-				set evid [CreateEvent $token DOMCharacterDataModified]
-				event initMutationEvent $evid DOMCharacterModified 1 0 {} $node(node:nodeValue) $value {} {}
-				set node(node:nodeValue) $value
-				node dispatchEvent $token $evid
-				DOMImplementation destroy $evid
-			    }
-			    default {
-				set node(node:$opt) $value
-			    }
-			}
-		    } else {
-			return -code error "unknown option \"$option\""
-		    }
-		}
-	    }
-	}
-
-	default {
-	    return -code error "unknown method \"$method\""
-	}
-
-    }
-
-    return $result
-}
-
-#################################################
-#
-# DOM Level 2 Interfaces
-#
-#################################################
-
-# dom::tcl::event --
-#
-#	Implements Event Interface
-#
-#	Subclassed Interfaces are also defined here,
-#	such as UIEvents.
-#
-# Arguments:
-#	method	method to invoke
-#	token	token for event
-#	args	arguments for method
-#
-# Results:
-#	Depends on method used.
-
-namespace eval dom::tcl {
-    variable eventOptionsRO type|target|currentNode|eventPhase|bubbles|cancelable|timeStamp|detail|view|screenX|screenY|clientX|clientY|ctrlKey|shiftKey|altKey|metaKey|button|relatedNode|prevValue|newValue|attrName|attrChange
-    variable eventOptionsRW {}
-
-    # Issue: should the attributes belonging to the subclassed Interface
-    # be separated out?
-
-    variable uieventOptionsRO detail|view
-    variable uieventOptionsRW {}
-
-    variable mouseeventOptionsRO screenX|screenY|clientX|clientY|ctrlKey|shiftKey|altKey|metaKey|button|relatedNode
-    variable mouseeventOptionsRW {}
-
-    variable mutationeventOptionsRO relatedNode|prevValue|newValue|attrName
-    variable mutationeventOptionsRW {}
-}
-
-proc dom::tcl::event {method token args} {
-    variable eventOptionsRO
-    variable eventOptionsRW
-
-    upvar #0 $token event
-
-    set result {}
-
-    switch -glob -- $method {
-
-	cg* {
-	    # cget
-
-	    if {[llength $args] != 1} {
-		return -code error "too many arguments"
-	    }
-	    if {[regexp [format {^-(%s)$} $eventOptionsRO] [lindex $args 0] discard option]} {
-		return $event($option)
-	    } elseif {[regexp [format {^-(%s)$} $eventOptionsRW] [lindex $args 0] discard option]} {
-		return $event($option)
-	    } else {
-		return -code error "unknown option \"[lindex $args 0]\""
-	    }
-	}
-
-	co* {
-	    # configure
-
-	    if {[llength $args] == 1} {
-		return [event cget $token [lindex $args 0]]
-	    } elseif {[expr [llength $args] % 2]} {
-		return -code error "no value specified for option \"[lindex $args end]\""
-	    } else {
-		foreach {option value} $args {
-		    if {[regexp [format {^-(%s)$} $eventOptionsRW] $option discard opt]} {
-			set event($opt) $value
-		    } elseif {[regexp [format {^-(%s)$} $eventOptionsRO] $option discard opt]} {
-			return -code error "attribute \"$option\" is read-only"
-		    } else {
-			return -code error "unknown option \"$option\""
-		    }
-		}
-	    }
-
-	}
-
-	st* {
-	    # stopPropagation
-
-	    set event(stopPropagation) 1
-	}
-
-	pr* {
-	    # preventDefault
-
-	    set event(preventDefault) 1
-	}
-
-	initE* {
-	    # initEvent
-
-	    if {[llength $args] != 3} {
-		return -code error "wrong # args: should be dom::event initEvent token type bubbles cancelable"
-	    }
-
-	    if {$event(dispatched)} {
-		return -code error "event has been dispatched"
-	    }
-
-	    foreach {event(type) event(bubbles) event(cancelable)} $args break
-	}
-
-	initU* {
-	    # initUIEvent
-
-	    if {[llength $args] < 4 || [llength $args] > 5} {
-		return -code error "wrong # args: should be dom::event initUIEvent token type bubbles cancelable view detail"
-	    }
-
-	    if {$event(dispatched)} {
-		return -code error "event has been dispatched"
-	    }
-
-	    set event(detail) 0
-	    foreach {event(type) event(bubbles) event(cancelable) event(view) event(detail)} $args break
-	}
-
-	initMo* {
-	    # initMouseEvent
-
-	    if {[llength $args] != 15} {
-		return -code error "wrong # args: should be dom::event initMouseEvent token type bubbles cancelable view detail screenX screenY clientX clientY ctrlKey altKey shiftKey metaKey button relatedNode"
-	    }
-
-	    if {$event(dispatched)} {
-		return -code error "event has been dispatched"
-	    }
-
-	    set event(detail) 1
-	    foreach {event(type) event(bubbles) event(cancelable) event(view) event(detail) event(screenX) event(screenY) event(clientX) event(clientY) event(ctrlKey) event(altKey) event(shiftKey) event(metaKey) event(button) event(relatedNode)} $args break
-	}
-
-	initMu* {
-	    # initMutationEvent
-
-	    if {[llength $args] != 8} {
-		return -code error "wrong # args: should be dom::event initMutationEvent token type bubbles cancelable relatedNode prevValue newValue attrName attrChange"
-	    }
-
-	    if {$event(dispatched)} {
-		return -code error "event has been dispatched"
-	    }
-
-	    foreach {event(type) event(bubbles) event(cancelable) event(relatedNode) event(prevValue) event(newValue) event(attrName) event(attrChange)} $args break
-	}
-
-	postUI* {
-	    # postUIEvent, non-standard convenience method
-
-	    set evType [lindex $args 0]
-	    array set evOpts [list \
-		    -bubbles $::dom::bubbles($evType) -cancelable $::dom::cancelable($evType)	\
-		    -view {}			\
-		    -detail {}			\
-	    ]
-	    array set evOpts [lrange $args 1 end]
-
-	    set evid [CreateEvent $token $evType]
-	    event initUIEvent $evid $evType $evOpts(-bubbles) $evOpts(-cancelable) $evOpts(-view) $evOpts(-detail)
-	    node dispatchEvent $token $evid
-	    DOMImplementation destroy $evid
-
-	}
-
-	postMo* {
-	    # postMouseEvent, non-standard convenience method
-
-	    set evType [lindex $args 0]
-	    array set evOpts [list \
-		    -bubbles $::dom::bubbles($evType) -cancelable $::dom::cancelable($evType)	\
-		    -view {}			\
-		    -detail {}			\
-		    -screenX {}			\
-		    -screenY {}			\
-		    -clientX {}			\
-		    -clientY {}			\
-		    -ctrlKey {}			\
-		    -altKey {}			\
-		    -shiftKey {}		\
-		    -metaKey {}			\
-		    -button {}			\
-		    -relatedNode {}		\
-	    ]
-	    array set evOpts [lrange $args 1 end]
-
-	    set evid [CreateEvent $token $evType]
-	    event initMouseEvent $evid $evType $evOpts(-bubbles) $evOpts(-cancelable) $evOpts(-view) $evOpts(-detail) $evOpts(-screenX) $evOpts(-screenY) $evOpts(-clientX) $evOpts(-clientY) $evOpts(-ctrlKey) $evOpts(-altKey) $evOpts(-shiftKey) $evOpts(-metaKey) $evOpts(-button) $evOpts(-relatedNode)
-	    node dispatchEvent $token $evid
-	    DOMImplementation destroy $evid
-
-	}
-
-	postMu* {
-	    # postMutationEvent, non-standard convenience method
-
-	    set evType [lindex $args 0]
-	    array set evOpts [list \
-		    -bubbles $::dom::bubbles($evType) -cancelable $::dom::cancelable($evType)	\
-		    -relatedNode {}			\
-		    -prevValue {} -newValue {}		\
-		    -attrName {} -attrChange {}		\
-	    ]
-	    array set evOpts [lrange $args 1 end]
-
-	    set evid [CreateEvent $token $evType]
-	    event initMutationEvent $evid $evType $evOpts(-bubbles) $evOpts(-cancelable) $evOpts(-relatedNode) $evOpts(-prevValue) $evOpts(-newValue) $evOpts(-attrName) $evOpts(-attrChange)
-	    node dispatchEvent $token $evid
-	    DOMImplementation destroy $evid
-
-	}
-
-	default {
-	    return -code error "unknown method \"$method\""
-	}
-    }
-
-    return $result
-}
-
-# dom::tcl::CreateEvent --
-#
-#	Create an event object
-#
-# Arguments:
-#	token	parent node
-#	type	event type
-#	args	configuration options
-#
-# Results:
-#	Returns event token
-
-proc dom::tcl::CreateEvent {token type args} {
-    array set opts $args
-    if {[string length $token]} {
-	upvar #0 $token parent
-	upvar #0 [namespace qualifiers $token]::Document document
-	set child [namespace qualifiers $token]::event[incr document(counter)]
-    } elseif {[info exists $opts(-document)]} {
-	upvar #0 $opts(-document) document
-	set child [namespace qualifiers $opts(-document)]::event[incr document(counter)]
-    }
-
-    upvar #0 $child event
-
-    # Create the event
-    array set event [list \
-	    node:nodeType event	\
-	    type $type		\
-	    target {}		\
-	    currentNode {}	\
-	    cancelable 1	\
-	    stopPropagation 0	\
-	    preventDefault 0	\
-	    dispatched 0	\
-	    bubbles 1		\
-	    eventPhase {}	\
-	    timeStamp [clock clicks -milliseconds]	\
-	    ]
-
-    proc $child {method args} "return \[eval [namespace current]::event \[list \$method\] $child \$args\]"
-    trace add command $child delete [namespace code [list Node:Delete $child]]
-
-    return $child
-}
-
-#################################################
-#
-# Serialisation
-#
-#################################################
-
-# dom::tcl::Serialize:documentFragment --
-#
-#	Produce text for documentFragment.
-#
-# Arguments:
-#	token	node token
-#	args	configuration options
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:documentFragment {token args} {
-    upvar #0 $token node
-
-    if {[string compare "Document" [namespace tail $token]]} {
-	return [eval [list Serialize:node $token] $args]
-    } else {
-	if {[string compare {} [GetField node(document:documentElement)]]} {
-	    return [eval Serialize:document [list $token] $args]
-	} else {
-	    return -code error "document has no document element"
-	}
-    }
-
-}
-
-# dom::tcl::Serialize:document --
-#
-#	Produce text for document.
-#
-# Arguments:
-#	token	node token
-#	args	configuration options
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:document {token args} {
-    upvar #0 $token node
-    array set opts {
-	-showxmldecl 1
-	-showdoctypedecl 1
-    }
-    array set opts $args
-
-    set result {}
-
-    if {[string length $node(document:doctype)]} {
-
-	upvar #0 $node(document:doctype) doctype
-
-	# Bug fix: can't use Serialize:attributeList for XML declaration,
-	# since attributes must occur in a given order (XML 2.8 [23])
-
-	set result {}
-
-	if {$opts(-showxmldecl)} {
-	    append result <?xml[Serialize:XMLDecl version $node(document:xmldecl)][Serialize:XMLDecl encoding $node(document:xmldecl)][Serialize:XMLDecl standalone $node(document:xmldecl)]?>\n
-	}
-	if {$opts(-showdoctypedecl)} {
-	    # Is document element in an XML Namespace?
-	    # If so then include prefix in doctype decl
-	    foreach {prefix localName} [::xml::qnamesplit $doctype(doctype:name)] break
-	    if {![string length $prefix]} {
-		# The prefix may not have been allocated yet
-		upvar #0 $node(document:documentElement) docel
-		if {[info exists docel(node:namespaceURI)] && \
-			[string length $docel(node:namespaceURI)]} {
-		    set declPrefix [GetNamespacePrefix $node(document:documentElement) $docel(node:namespaceURI)]
-		    set docelName $declPrefix:$doctype(doctype:name)
-		} else {
-		    set docelName $doctype(doctype:name)
-		}
-	    } else {
-		set docelName $doctype(doctype:name)
-	    }
-	    # Applied patch by Marco Gonnelli, bug #590914
-	    append result <!DOCTYPE\ $docelName[Serialize:ExternalID $doctype(doctype:publicId) $doctype(doctype:systemId)][expr {[string length $doctype(doctype:internalSubset)] ? " \[[string trim $doctype(doctype:internalSubset) \{\} ]\]" : {}}]>\n
-	}
-    }
-
-    # BUG #525505: Want to serialize all children including the
-    # document element.
-
-    if {[info exists $node(node:childNodes)]} {
-	foreach child [set $node(node:childNodes)] {
-	    append result [eval Serialize:[node cget $child -nodeType] [list $child] $args]
-	}
-    }
-
-    return $result
-}
-
-# dom::tcl::Serialize:ExternalID --
-#
-#	Returned appropriately quoted external identifiers
-#
-# Arguments:
-#	publicid	public identifier
-#	systemid	system identifier
-#
-# Results:
-#	text
-
-proc dom::tcl::Serialize:ExternalID {publicid systemid} {
-
-    switch -glob -- [string length $publicid],[string length $systemid] {
-	0,0 {
-	    return {}
-	}
-	0,* {
-	    return " SYSTEM \"$systemid\""
-	}
-	*,* {
-	    # Patch from c.l.t., Richard Calmbach (rc@hnc.com )
-	    return " PUBLIC \"$publicid\" \"$systemid\""
-	}
-    }
-
-    return {}
-}
-
-# dom::tcl::Serialize:XMLDecl --
-#
-#	Produce text for XML Declaration attribute.
-#	Order is determine by document serialisation procedure.
-#
-# Arguments:
-#	attr	required attribute
-#	attList	attribute list
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:XMLDecl {attr attrList} {
-    array set data $attrList
-    if {![info exists data($attr)]} {
-	return {}
-    } elseif {[string length $data($attr)]} {
-	return " $attr='$data($attr)'"
-    } else {
-	return {}
-    }
-}
-
-# dom::tcl::Serialize:node --
-#
-#	Produce text for an arbitrary node.
-#	This simply serializes the child nodes of the node.
-#
-# Arguments:
-#	token	node token
-#	args	configuration options
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:node {token args} {
-    upvar #0 $token node
-    array set opts $args
-
-    if {[info exists opts(-indent)]} {
-	# NB. 0|1 cannot be used as booleans - mention this in docn
-	if {[regexp {^false|no|off$} $opts(-indent)]} {
-	    # No action required
-	} elseif {[regexp {^true|yes|on$} $opts(-indent)]} {
-	    set opts(-indent) 1
-	} else {
-	    incr opts(-indent)
-	}
-    }
-
-    set result {}
-    foreach childToken [set $node(node:childNodes)] {
-	upvar #0 $childToken child
-	append result [eval [list Serialize:$child(node:nodeType) $childToken] [array get opts]]
-    }
-
-    return $result
-}
-
-# dom::tcl::Serialize:element --
-#
-#	Produce text for an element.
-#
-# Arguments:
-#	token	node token
-#	args	configuration options
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:element {token args} {
-    upvar #0 $token node
-    array set opts {-newline {}}
-    array set opts $args
-
-    set result {}
-    set newline {}
-    if {[lsearch $opts(-newline) $node(node:nodeName)] >= 0} {
-	append result \n
-	set newline \n
-    }
-    append result [eval Serialize:Indent [array get opts]]
-    switch [info exists node(node:namespaceURI)],[info exists node(node:prefix)] {
-
-	1,1 {
-	    # XML Namespace is in scope, prefix supplied
-	    if {[string length $node(node:prefix)]} {
-		# Make sure that there's a declaration for this XML Namespace
-		set declPrefix [GetNamespacePrefix $token $node(node:namespaceURI) -prefix $node(node:prefix)]
-		# ASSERTION: $declPrefix == $node(node:prefix)
-		set nsPrefix $node(node:prefix):
-	    } elseif {[string length $node(node:namespaceURI)]} {
-		set nsPrefix [GetNamespacePrefix $token $node(node:namespaceURI)]:
-	    } else {
-		set nsPrefix {}
-	    }
-	}
-
-	1,0 {
-	    # XML Namespace is in scope, no prefix
-	    set nsPrefix [GetNamespacePrefix $token $node(node:namespaceURI)]:
-	    if {![string compare $nsPrefix :]} {
-		set nsPrefix {}
-	    }
-	}
-
-	0,1 {
-	    # Internal error
-	    set nsPrefix {}
-	}
-
-	0,0 -
-	default {
-	    # No XML Namespace is in scope
-	    set nsPrefix {}
-	}
-    }
-    append result <$nsPrefix$node(node:localName)
-
-    append result [Serialize:attributeList [array get $node(element:attributeList)]]
-
-    if {![llength [set $node(node:childNodes)]]} {
-
-	append result />$newline
-
-    } else {
-
-	append result >$newline
-
-	# Do the children
-	if {[hasmixedcontent $token]} {
-	    set opts(-indent) no
-	}
-	append result [eval Serialize:node [list $token] [array get opts]]
-
-	append result [eval Serialize:Indent [array get opts]]
-	append result "$newline</$nsPrefix$node(node:localName)>$newline"
-
-    }
-
-    return $result
-}
-
-# dom::tcl::GetNamespacePrefix --
-#
-#	Determine the XML Namespace prefix for a Namespace URI
-#
-# Arguments:
-#	token	node token
-#	nsuri	XML Namespace URI
-#	args	configuration options
-#
-# Results:
-#	Returns prefix.
-#	May add prefix information to node
-
-proc dom::tcl::GetNamespacePrefix {token nsuri args} {
-    upvar #0 $token node
-    array set options $args
-
-    GetNamespaceDecl $token $nsuri declNode prefix
-
-    if {[llength $declNode]} {
-	# A declaration was found for this Namespace URI
-	return $prefix
-    } else {
-	# No declaration found.  Allocate a prefix
-	# and add XML Namespace declaration
-	set prefix {}
-	catch {set prefix $options(-prefix)}
-	if {![string compare $prefix {}]} {
-	    upvar #0 [namespace qualifiers $token]::Document document
-	    set prefix ns[incr document(counter)]
-	}
-	set node(node:prefix) $prefix
-	upvar \#0 $node(element:attributeList) attrs
-	set attrs(${::dom::xmlnsURI}^$prefix) $nsuri
-
-	return $prefix
-    }
-}
-
-# dom::tcl::GetNamespaceDecl --
-#
-#	Find the XML Namespace declaration.
-#
-# Arguments:
-#	token	node token
-#	nsuri	XML Namespace URI
-#	nodeVar	Variable name for declaration
-#	prefVar Variable for prefix
-#
-# Results:
-#	If the declaration is found returns node and prefix
-
-proc dom::tcl::GetNamespaceDecl {token nsuri nodeVar prefVar} {
-    upvar #0 $token node
-    upvar $nodeVar declNode
-    upvar $prefVar prefix
-
-    while {[string length $node(node:parentNode)]} {
-
-	# Check this node's XML Namespace declarations
-	catch {unset attrs}
-	array set attrs [array get $node(element:attributeList)]
-	foreach {nsdecl decluri} [array get attrs ${::dom::xmlnsURI}^*] {
-	    if {![string compare $decluri $nsuri]} {
-		regexp [format {%s\^(.*)} $::dom::xmlnsURI] $nsdecl dummy prefix
-		set declNode $token
-		return
-	    }
-	}
-
-	# Move up to parent
-	set token $node(node:parentNode)
-	upvar #0 $token node
-    }
-
-    # Got to Document node and didn't find XML NS decl
-    set prefix {}
-    set declNode {}
-}
-
-# dom::tcl::Serialize:textNode --
-#
-#	Produce text for a text node.  This procedure may
-#	return a CDATA section where appropriate.
-#
-# Arguments:
-#	token	node token
-#	args	configuration options
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:textNode {token args} {
-    upvar #0 $token node
-
-    if {$node(node:cdatasection)} {
-	return [Serialize:CDATASection $node(node:nodeValue)]
-    } elseif {[Serialize:ExceedsThreshold $node(node:nodeValue)]} {
-	return [Serialize:CDATASection $node(node:nodeValue)]
-    } else {
-	return [Encode $node(node:nodeValue)]
-    }
-}
-
-# dom::tcl::Serialize:ExceedsThreshold --
-#
-#	Applies heuristic(s) to determine whether a text node
-#	should be formatted as a CDATA section.
-#
-# Arguments:
-#	text	node text
-#
-# Results:
-#	Boolean.
-
-proc dom::tcl::Serialize:ExceedsThreshold {text} {
-    return [expr {[regsub -all {[<>&]} $text {} discard] > $::dom::maxSpecials}]
-}
-
-# dom::tcl::Serialize:CDATASection --
-#
-#	Formats a CDATA section.
-#
-# Arguments:
-#	text	node text
-#
-# Results:
-#	XML text.
-
-proc dom::tcl::Serialize:CDATASection {text} {
-    set result {}
-    while {[regexp {(.*)]]>(.*)} $text discard text trailing]} {
-	set result \]\]&gt\;<!\[CDATA\[$trailing\]\]>$result
-    }
-    return <!\[CDATA\[$text\]\]>$result
-}
-
-# dom::tcl::Serialize:processingInstruction --
-#
-#	Produce text for a PI node.
-#
-# Arguments:
-#	token	node token
-#	args	configuration options
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:processingInstruction {token args} {
-    upvar #0 $token node
-
-    return "[eval Serialize:Indent $args]<?$node(node:nodeName)[expr {$node(node:nodeValue) == "" ? "" : " $node(node:nodeValue)"}]?>"
-}
-
-# dom::tcl::Serialize:comment --
-#
-#	Produce text for a comment node.
-#
-# Arguments:
-#	token	node token
-#	args	configuration options
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:comment {token args} {
-    upvar #0 $token node
-
-    return [eval Serialize:Indent $args]<!--$node(node:nodeValue)-->
-}
-
-# dom::tcl::Serialize:entityReference --
-#
-#	Produce text for an entity reference.
-#
-# Arguments:
-#	token	node token
-#	args	configuration options
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:entityReference {token args} {
-    upvar #0 $token node
-
-    return &$node(node:nodeName)\;
-}
-
-# dom::tcl::Encode --
-#
-#	Encode special characters
-#
-# Arguments:
-#	value	text value
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Encode value {
-    array set Entity {
-	$ $
-	< &lt;
-	> &gt;
-	& &amp;
-	\" &quot;
-	' &apos;
-    }
-
-    regsub -all {([$<>&"'])} $value {$Entity(\1)} value
-
-    return [subst -nocommand -nobackslash $value]
-}
-
-# dom::tcl::Serialize:attributeList --
-#
-#	Produce text for an attribute list.
-#
-# Arguments:
-#	l	name/value paired list
-#
-# Results:
-#	XML format text.
-
-proc dom::tcl::Serialize:attributeList {l} {
-
-    set result {}
-    foreach {name value} $l {
-
-	if {[regexp {^([^^]+)\^(.*)$} $name discard nsuri prefix]} {
-	    if {[string compare $nsuri $::dom::xmlnsURI]} {
-		# Need the node token to resolve the Namespace URI
-		append result { } ?:$prefix =
-	    } else {
-		# A Namespace declaration
-		append result { } xmlns:$prefix =
-	    }
-	} else {
-	    append result { } $name =
-	}
-
-	# Handle special characters
-	regsub -all & $value {\&amp;} value
-	regsub -all < $value {\&lt;} value
-
-	if {![string match *\"* $value]} {
-	    append result \"$value\"
-	} elseif {![string match *'* $value]} {
-	    append result '$value'
-	} else {
-	    regsub -all \" $value {\&quot;} value
-	    append result \"$value\"
-	}
-
-    }
-
-    return $result
-}
-
-# dom::tcl::Serialize:Indent --
-#
-#	Calculate the indentation required, if any
-#
-# Arguments:
-#	args	configuration options, which may specify -indent
-#
-# Results:
-#	May return white space
-
-proc dom::tcl::Serialize:Indent args {
-    array set opts [list -indentspec $::dom::indentspec]
-    array set opts $args
-
-    if {![info exists opts(-indent)] || \
-	    [regexp {^false|no|off$} $opts(-indent)]} {
-	return {}
-    }
-
-    if {[regexp {^true|yes|on$} $opts(-indent)]} {
-	# Default indent level is 0
-	return \n
-    }
-
-    if {!$opts(-indent)} {
-	return \n
-    }
-
-    set ws [format \n%\ [expr $opts(-indent) * [lindex $opts(-indentspec) 0]]s { }]
-    regsub -all [lindex [lindex $opts(-indentspec) 1] 0] $ws [lindex [lindex $opts(-indentspec) 1] 1] ws
-
-    return $ws
-
-}
-
-#################################################
-#
-# Parsing
-#
-#################################################
-
-# dom::tcl::ParseElementStart --
-#
-#	Push a new element onto the stack.
-#
-# Arguments:
-#	stateVar	global state array variable
-#	name		element name
-#	attrList	attribute list
-#	args		configuration options
-#
-# Results:
-#	An element is created within the currently open element.
-
-proc dom::tcl::ParseElementStart {stateVar name attrList args} {
-
-    upvar #0 $stateVar state
-    array set opts $args
-
-    # Push namespace declarations
-    # We need to be able to map namespaceURI's back to prefixes
-    set nsattrlists {}
-    catch {
-	foreach {namespaceURI prefix} $opts(-namespacedecls) {
-	    lappend state(NS:$namespaceURI) $prefix
-
-	    # Also, synthesize namespace declaration attributes
-	    # TclXML is a little too clever when it parses them away!
-
-	    lappend nsattrlists $prefix $namespaceURI
-	}
-	lappend opts(-namespaceattributelists) $::dom::xmlnsURI $nsattrlists
-
-    }
-
-    set nsarg {}
-    catch {
-	lappend nsarg -namespace $opts(-namespace)
-	lappend nsarg -localname $name
-	lappend nsarg -prefix [lindex $state(NS:$opts(-namespace)) end]
-    }
-
-    lappend state(current) \
-	[eval CreateElement [list [lindex $state(current) end] $name $attrList] $nsarg [array get opts -namespaceattributelists]]
-
-    if {[info exists opts(-empty)] && $opts(-empty)} {
-	# Flag this node as being an empty element
-	upvar #0 [lindex $state(current) end] node
-	set node(element:empty) 1
-    }
-
-    # Temporary: implement -progresscommand here, because of broken parser
-    if {[string length $state(-progresscommand)]} {
-	if {!([incr state(progCounter)] % $state(-chunksize))} {
-	    uplevel #0 $state(-progresscommand)
-	}
-    }
-}
-
-# dom::tcl::ParseElementEnd --
-#
-#	Pop an element from the stack.
-#
-# Arguments:
-#	stateVar	global state array variable
-#	name		element name
-#	args		configuration options
-#
-# Results:
-#	Currently open element is closed.
-
-proc dom::tcl::ParseElementEnd {stateVar name args} {
-    upvar #0 $stateVar state
-
-    set state(current) [lreplace $state(current) end end]
-}
-
-# dom::tcl::ParseCharacterData --
-#
-#	Add a textNode to the currently open element.
-#
-# Arguments:
-#	stateVar	global state array variable
-#	data		character data
-#
-# Results:
-#	A textNode is created.
-
-proc dom::tcl::ParseCharacterData {stateVar data} {
-    upvar #0 $stateVar state
-
-    CreateTextNode [lindex $state(current) end] $data
-}
-
-# dom::tcl::ParseProcessingInstruction --
-#
-#	Add a PI to the currently open element.
-#
-# Arguments:
-#	stateVar	global state array variable
-#	name		PI name
-#	target		PI target
-#
-# Results:
-#	A processingInstruction node is created.
-
-proc dom::tcl::ParseProcessingInstruction {stateVar name target} {
-    upvar #0 $stateVar state
-
-    CreateGeneric [lindex $state(current) end] node:nodeType processingInstruction node:nodeName $name node:nodeValue $target
-}
-
-# dom::tcl::ParseXMLDeclaration --
-#
-#	Add information from the XML Declaration to the document.
-#
-# Arguments:
-#	stateVar	global state array variable
-#	version		version identifier
-#	encoding	character encoding
-#	standalone	standalone document declaration
-#
-# Results:
-#	Document node modified.
-
-proc dom::tcl::ParseXMLDeclaration {stateVar version encoding standalone} {
-    upvar #0 $stateVar state
-
-    upvar #0 $state(docNode) document
-    array set xmldecl $document(document:xmldecl)
-
-    array set xmldecl [list version $version	\
-	    standalone $standalone		\
-	    encoding $encoding			\
-    ]
-
-    set document(document:xmldecl) [array get xmldecl]
-
-    return {}
-}
-
-# dom::tcl::ParseDocType --
-#
-#	Add a Document Type Declaration node to the document.
-#
-# Arguments:
-#	stateVar	global state array variable
-#	root		root element type
-#	publit		public identifier literal
-#	systemlist	system identifier literal
-#	dtd		internal DTD subset
-#
-# Results:
-#	DocType node added
-
-proc dom::tcl::ParseDocType {stateVar root {publit {}} {systemlit {}} {dtd {}} args} {
-    upvar #0 $stateVar state
-    upvar #0 $state(docNode) document
-
-    set document(document:doctype) [CreateDocType $state(docNode) $publit $systemlit $dtd]
-
-    return {}
-}
-
-# dom::tcl::ParseComment --
-#
-#	Parse comment
-#
-# Arguments:
-#	stateVar	state array
-#	data		comment data
-#
-# Results:
-#	Comment node added to DOM tree
-
-proc dom::tcl::ParseComment {stateVar data} {
-    upvar #0 $stateVar state
-
-    CreateGeneric [lindex $state(current) end] node:nodeType comment node:nodeValue $data
-
-    return {}
-}
-
-# dom::tcl::ParseEntityReference --
-#
-#	Parse an entity reference
-#
-# Arguments:
-#	stateVar	state variable
-#	ref		entity
-#
-# Results:
-#	Entity reference node added to DOM tree
-
-proc dom::tcl::ParseEntityReference {stateVar ref} {
-    upvar #0 $stateVar state
-
-    CreateGeneric [lindex $state(current) end] node:nodeType entityReference node:nodeName $ref
-
-    return {}
-}
-
-#################################################
-#
-# Trim white space
-#
-#################################################
-
-# dom::tcl::Trim --
-#
-#	Remove textNodes that only contain white space
-#
-# Arguments:
-#	nodeid	node to trim
-#
-# Results:
-#	textNode nodes may be removed (from descendants)
-
-proc dom::tcl::Trim nodeid {
-    upvar #0 $nodeid node
-
-    switch $node(node:nodeType) {
-
-	textNode {
-	    if {![string length [string trim $node(node:nodeValue)]]} {
-		node removeChild $node(node:parentNode) $nodeid
-	    }
-	}
-
-	default {
-	    # Some nodes have no child list.  Reported by Jim Hollister <jhollister@objectspace.com>
-	    set children {}
-	    catch {set children [set $node(node:childNodes)]}
-	    foreach child $children {
-		Trim $child
-	    }
-	}
-
-    }
-
-    return {}
-}
-
-#################################################
-#
-# XPath support
-#
-#################################################
-
-# dom::tcl::XPath:CreateNode --
-#
-#	Given an XPath expression, create the node
-#	referred to by the expression.  Nodes required
-#	as steps of the path are created if they do
-#	not exist.
-#
-# Arguments:
-#	node	context node
-#	path	location path
-#
-# Results:
-#	Node(s) created in the DOM tree.
-#	Returns token for deepest node in the expression.
-
-proc dom::tcl::XPath:CreateNode {node path} {
-
-    set root [::dom::node cget $node -ownerDocument]
-
-    set spath [::xpath::split $path]
-
-    if {[llength $spath] <= 1} {
-	# / - do nothing
-	return $root
-    }
-
-    if {![llength [lindex $spath 0]]} {
-	# Absolute location path
-	set context $root
-	set spath [lrange $spath 1 end]
-	set contexttype document
-    } else {
-	set context $node
-	set contexttype [::dom::node cget $node -nodeType]
-    }
-
-    foreach step $spath {
-
-	# Sanity check on path
-	switch $contexttype {
-	    document -
-	    documentFragment -
-	    element {}
-	    default {
-		return -code error "node type \"$contexttype\" have no children"
-	    }
-	}
-
-	switch [lindex $step 0] {
-
-	    child {
-		if {[llength [lindex $step 1]] > 1} {
-		    foreach {nodetype discard} [lindex $step 1] break
-
-		    switch -- $nodetype {
-			text {
-			    set posn [CreateNode:FindPosition [lindex $step 2]]
-
-			    set count 0
-			    set targetNode {}
-			    foreach child [::dom::node children $context] {
-				switch [::dom::node cget $child -nodeType] {
-				    textNode {
-					incr count
-					if {$count == $posn} {
-					    set targetNode $child
-					    break
-					}
-				    }
-				    default {}
-				}
-			    }
-
-			    if {[string length $targetNode]} {
-				set context $targetNode
-			    } else {
-				# Creating sequential textNodes doesn't make sense
-				set context [::dom::document createTextNode $context {}]
-			    }
-			    set contexttype textNode
-			}
-			default {
-			    return -code error "node type test \"${nodetype}()\" not supported"
-			}
-		    }
-		} else {
-		    # Find the child element
-		    set posn [CreateNode:FindPosition [lindex $step 2]]
-
-		    set count 0
-		    set targetNode {}
-		    foreach child [::dom::node children $context] {
-			switch [node cget $child -nodeType] {
-			    element {
-				if {![string compare [lindex $step 1] [::dom::node cget $child -nodeName]]} {
-				    incr count
-				    if {$count == $posn} {
-					set targetNode $child
-					break
-				    }
-				}
-			    }
-			    default {}
-			}
-		    }
-
-		    if {[string length $targetNode]} {
-			set context $targetNode
-		    } else {
-			# Didn't find it so create required elements
-			while {$count < $posn} {
-			    set child [::dom::document createElement $context [lindex $step 1]]
-			    incr count
-			}
-			set context $child
-		    }
-		    set contexttype element
-
-		}
-	    }
-
-	    default {
-		return -code error "axis \"[lindex $step 0]\" is not supported"
-	    }
-	}
-    }
-
-    return $context
-}
-
-# dom::tcl::CreateNode:FindPosition --
-
-proc dom::tcl::CreateNode:FindPosition predicates {
-    switch [llength $predicates] {
-	0 {
-	    return 1
-	}
-	1 {
-	    # Fall-through
-	}
-	default {
-	    return -code error "multiple predicates not yet supported"
-	}
-    }
-    set predicate [lindex $predicates 0]
-
-    switch -- [lindex [lindex $predicate 0] 0] {
-	function {
-	    switch -- [lindex [lindex $predicate 0] 1] {
-		position {
-		    if {[lindex $predicate 1] == "="} {
-			if {[string compare [lindex [lindex $predicate 2] 0] "number"]} {
-			    return -code error "operand must be a number"
-			} else {
-			    set posn [lindex [lindex $predicate 2] 1]
-			}
-		    } else {
-			return -code error "operator must be \"=\""
-		    }
-		}
-		default {
-		    return -code error "predicate function \"[lindex [lindex $predicate 0] 1]\" not supported"
-		}
-	    }
-	}
-	default {
-	    return -code error "predicate must be position() function"
-	}
-    }
-
-    return $posn
-}
-
-# dom::tcl::XPath:SelectNode --
-#
-#	Match nodes with an XPath location path
-#
-# Arguments:
-#	ctxt	context - Tcl list
-#	path	location path
-#
-# Results:
-#	Returns Tcl list of matching nodes
-
-proc dom::tcl::XPath:SelectNode {ctxt path} {
-
-    if {![llength $ctxt]} {
-	return {}
-    }
-
-    set spath [xpath::split $path]
-
-    if {[string length [node parent [lindex $ctxt 0]]]} {
-	set root [namespace qualifiers [lindex $ctxt 0]]::Document
-    } else {
-	set root [lindex $ctxt 0]
-    }
-
-    if {[llength $spath] == 0} {
-	return $root
-    }
-    if {[llength $spath] == 1 && [llength [lindex $spath 0]] == 0} {
-	return $root
-    }
-
-    if {![llength [lindex $spath 0]]} {
-	set ctxt $root
-	set spath [lrange $spath 1 end]
-    }
-
-    return [XPath:SelectNode:Rel $ctxt $spath]
-}
-
-# dom::tcl::XPath:SelectNode:Rel --
-#
-#	Match nodes with an XPath location path
-#
-# Arguments:
-#	ctxt	context - Tcl list
-#	path	split location path
-#
-# Results:
-#	Returns Tcl list of matching nodes
-
-proc dom::tcl::XPath:SelectNode:Rel {ctxt spath} {
-    if {![llength $spath]} {
-	return $ctxt
-    }
-
-    set step [lindex $spath 0]
-    set result {}
-    switch [lindex $step 0] {
-
-	child {
-	    # All children are candidates
-	    set children {}
-	    foreach node [XPath:SN:GetElementTypeNodes $ctxt] {
-		eval lappend children [node children $node]
-	    }
-
-	    # Now apply node test to each child
-	    foreach node $children {
-		if {[XPath:SN:ApplyNodeTest $node [lindex $step 1]]} {
-		    lappend result $node
-		}
-	    }
-
-	}
-
-	descendant-or-self {
-	    foreach node $ctxt {
-		if {[XPath:SN:ApplyNodeTest $node [lindex $step 1]]} {
-		    lappend result $node
-		}
-		eval lappend result [XPath:SN:DescendAndTest [node children $node] [lindex $step 1]]
-	    }
-	}
-
-	descendant {
-	    foreach node $ctxt {
-		eval lappend result [XPath:SN:DescendAndTest [node children $node] [lindex $step 1]]
-	    }
-	}
-
-	attribute {
-	    if {[string compare [lindex $step 1] "*"]} {
-		foreach node $ctxt {
-		    set attrNode [element getAttributeNode $node [lindex $step 1]]
-		    if {[llength $attrNode]} {
-			lappend result $attrNode
-		    }
-		}
-	    } else {
-		# All attributes are returned
-		foreach node $ctxt {
-		    foreach attrName [array names [node cget $node -attributes]] {
-			set attrNode [element getAttributeNode $node $attrName]
-			if {[llength $attrNode]} {
-			    lappend result $attrNode
-			}
-		    }
-		}
-	    }
-	}
-
-	default {
-	    return -code error "axis \"[lindex $step 0]\" is not supported"
-	}
-    }
-
-    # Now apply predicates
-    set result [XPath:ApplyPredicates $result [lindex $step 2]]
-
-    # Apply the next location step
-    return [XPath:SelectNode:Rel $result [lrange $spath 1 end]]
-}
-
-# dom::tcl::XPath:SN:GetElementTypeNodes --
-#
-#	Reduce nodeset to those nodes of element type
-#
-# Arguments:
-#	nodeset	set of nodes
-#
-# Results:
-#	Returns nodeset in which all nodes are element type
-
-proc dom::tcl::XPath:SN:GetElementTypeNodes nodeset {
-    set result {}
-    foreach node $nodeset {
-	switch [node cget $node -nodeType] {
-	    document -
-	    documentFragment -
-	    element {
-		lappend result $node
-	    }
-	    default {}
-	}
-    }
-    return $result
-}
-
-# dom::tcl::XPath:SN:ApplyNodeTest --
-#
-#	Apply the node test to a node
-#
-# Arguments:
-#	node	DOM node to test
-#	test	node test
-#
-# Results:
-#	1 if node passes, 0 otherwise
-
-proc dom::tcl::XPath:SN:ApplyNodeTest {node test} {
-    if {[llength $test] > 1} {
-	foreach {name typetest} $test break
-	# Node type test
-	switch -glob -- $name,[node cget $node -nodeType] {
-	    node,* {
-		return 1
-	    }
-	    text,textNode -
-	    comment,comment -
-	    processing-instruction,processingInstruction {
-		return 1
-	    }
-	    text,* -
-	    comment,* -
-	    processing-instruction,* {
-		return 0
-	    }
-	    default {
-		return -code error "illegal node type test \"[lindex $step 1]\""
-	    }
-	}
-    } else {
-	# Node name test
-	switch -glob -- $test,[node cget $node -nodeType],[node cget $node -nodeName] \
-		\\*,element,* {
-	    return 1
-	} \
-		\\*,* {
-	    return 0
-	} \
-		*,element,$test {
-	    return 1
-	}
-    }
-
-    return 0
-}
-
-# dom::tcl::XPath:SN:DescendAndTest --
-#
-#	Descend the element hierarchy,
-#	apply the node test as we go
-#
-# Arguments:
-#	nodeset	nodes to be tested and descended
-#	test	node test
-#
-# Results:
-#	Returned nodeset of nodes which pass the test
-
-proc dom::tcl::XPath:SN:DescendAndTest {nodeset test} {
-    set result {}
-
-    foreach node $nodeset {
-	if {[XPath:SN:ApplyNodeTest $node $test]} {
-	    lappend result $node
-	}
-	switch [node cget $node -nodeType] {
-	    document -
-	    documentFragment -
-	    element {
-		eval lappend result [XPath:SN:DescendAndTest [node children $node] $test]
-	    }
-	}
-    }
-
-    return $result
-}
-
-# dom::tcl::XPath:ApplyPredicates --
-#
-#	Filter a nodeset with predicates
-#
-# Arguments:
-#	ctxt	current context nodeset
-#	preds	list of predicates
-#
-# Results:
-#	Returns new (possibly reduced) context nodeset
-
-proc dom::tcl::XPath:ApplyPredicates {ctxt preds} {
-
-    set result {}
-    foreach node $ctxt {
-	set passed 1
-	foreach predicate $preds {
-	    if {![XPath:ApplyPredicate $node $predicate]} {
-		set passed 0
-		break
-	    }
-	}
-	if {$passed} {
-	    lappend result $node
-	}
-    }
-
-    return $result
-}
-
-# dom::tcl::XPath:ApplyPredicate --
-#
-#	Filter a node with a single predicate
-#
-# Arguments:
-#	node	current context node
-#	pred	predicate
-#
-# Results:
-#	Returns boolean
-
-proc dom::tcl::XPath:ApplyPredicate {node pred} {
-
-    switch -- [lindex $pred 0] {
-	= -
-	!= -
-	>= -
-	<= -
-	> -
-	> {
-
-	    if {[llength $pred] != 3} {
-		return -code error "malformed expression"
-	    }
-
-	    set operand1 [XPath:Pred:ResolveExpr $node [lindex $pred 1]]
-	    set operand2 [XPath:Pred:ResolveExpr $node [lindex $pred 2]]
-
-	    # Convert operands to the correct type, if necessary
-	    switch -glob [lindex $operand1 0],[lindex $operand2 0] {
-		literal,literal {
-		    return [XPath:Pred:CompareLiterals [lindex $pred 0] [lindex $operand1 1] [lindex $operand2 1]]
-		}
-
-		number,number -
-		literal,number -
-		number,literal {
-		    # Compare as numbers
-		    return [XPath:Pred:CompareNumbers [lindex $pred 0] [lindex $operand1 1] [lindex $operand2 1]]
-		}
-
-		boolean,boolean {
-		    # Compare as booleans
-		    return -code error "boolean comparison not yet implemented"
-		}
-
-		node,node {
-		    # Nodeset comparison
-		    return -code error "nodeset comparison not yet implemented"
-		}
-
-		node,* {
-		    set value {}
-		    if {[llength [lindex $operand1 1]]} {
-			set value [node stringValue [lindex [lindex $operand1 1] 0]]
-		    }
-		    return [XPath:Pred:CompareLiterals [lindex $pred 0] $value [lindex $operand2 1]]
-		}
-		*,node {
-		    set value {}
-		    if {[llength [lindex $operand2 1]]} {
-			set value [node stringValue [lindex [lindex $operand2 1] 0]]
-		    }
-		    return [XPath:Pred:CompareLiterals [lindex $pred 0] $value [lindex $operand1 1]]
-		}
-
-		default {
-		    return -code error "can't compare [lindex $operand1 0] to [lindex $operand2 0]"
-		}
-	    }
-	}
-
-	function {
-	    return -code error "invalid predicate"
-	}
-	number -
-	literal {
-	    return -code error "invalid predicate"
-	}
-
-	path {
-	    set nodeset [XPath:SelectNode:Rel $node [lindex $pred 1]]
-	    return [expr {[llength $nodeset] > 0 ? 1 : 0}]
-	}
-
-    }
-
-    return 1
-}
-
-# dom::tcl::XPath:Pred:Compare --
-
-proc dom::tcl::XPath:Pred:CompareLiterals {op operand1 operand2} {
-    set result [string compare $operand1 $operand2]
-
-    # The obvious:
-    #return [expr {$result $opMap($op) 0}]
-    # doesn't compile
-    
-    switch $op {
-	= {
-	    return [expr {$result == 0}]
-	}
-	!= {
-	    return [expr {$result != 0}]
-	}
-	<= {
-	    return [expr {$result <= 0}]
-	}
-	>= {
-	    return [expr {$result >= 0}]
-	}
-	< {
-	    return [expr {$result < 0}]
-	}
-	> {
-	    return [expr {$result > 0}]
-	}
-    }
-    return -code error "internal error"
-}
-
-# dom::tcl::XPath:Pred:ResolveExpr --
-
-proc dom::tcl::XPath:Pred:ResolveExpr {node expr} {
-
-    switch [lindex $expr 0] {
-	path {
-	    return [list node [XPath:SelectNode:Rel $node [lindex $expr 1]]]
-	}
-
-	function -
-	group {
-	    return -code error "[lindex $expr 0] not yet implemented"
-	}
-	literal -
-	number -
-	boolean {
-	    return $expr
-	}
-
-	default {
-	    return -code error "internal error"
-	}
-    }
-
-    return {}
-}
-
-#################################################
-#
-# Miscellaneous
-#
-#################################################
-
-# dom::tcl::hasmixedcontent --
-#
-#	Determine whether an element contains mixed content
-#
-# Arguments:
-#	token	dom node
-#
-# Results:
-#	Returns 1 if element contains mixed content,
-#	0 otherwise
-
-proc dom::tcl::hasmixedcontent token {
-    upvar #0 $token node
-
-    if {[string compare $node(node:nodeType) "element"]} {
-	# Really undefined
-	return 0
-    }
-
-    foreach child [set $node(node:childNodes)] {
-	upvar #0 $child childnode
-	if {![string compare $childnode(node:nodeType) "textNode"]} {
-	    return 1
-	}
-    }
-
-    return 0
-}
-
-# dom::tcl::prefix2namespaceURI --
-#
-#	Given an XML Namespace prefix, find the corresponding Namespace URI
-#
-# Arguments:
-#	node	DOM Node
-#	prefix	XML Namespace prefix
-#
-# Results:
-#	Returns URI
-
-proc dom::tcl::prefix2namespaceURI {node prefix} {
-
-    # Search this node and its ancestors for the appropriate
-    # XML Namespace declaration
-
-    set parent [dom::node parent $node]
-    set nsuri [dom::element getAttributeNS $node $::dom::xmlnsURI $prefix]
-    if {[string length $parent] && ![string length $nsuri]} {
-	set nsuri [dom::element getAttributeNS $parent $::dom::xmlnsURI $prefix]
-	set parent [dom::node parent $parent]
-    }
-
-    if {[string length $nsuri]} {
-	return $nsuri
-    } else {
-	return -code error "unable to find namespace URI for prefix \"$prefix\""
-    }
-
-}
-
-# dom::tcl::namespaceURI2prefix --
-#
-#	Given an XML Namespace URI, find the corresponding prefix
-#
-# Arguments:
-#	node	DOM Node
-#	nsuri	XML Namespace URI
-#
-# Results:
-#	Returns prefix
-
-proc dom::tcl::namespaceURI2prefix {node nsuri} {
-
-    # Search this node and its ancestors for the desired
-    # XML Namespace declaration
-
-    set found 0
-    set prefix {}
-    set parent [dom::node parent $node]
-    while {[string length $parent]} {
-	upvar #0 $node nodeinfo
-	catch {unset attrs}
-	array set attrs [array get $nodeinfo(element:attributeList)]
-	foreach {nsdecl declNSuri} [array get attrs ${::dom::xmlnsURI}^*] {
-	    if {![string compare $declNSuri $nsuri]} {
-		set found 1
-		set prefix [lindex [split $nsdecl ^] 1]
-		break
-	    }
-	}
-	if {$found} {
-	    break
-	}
-	set node $parent
-	set parent [dom::node parent $node]
-    }
-
-    if {$found} {
-	return $prefix
-    } else {
-	return -code error "unable to find prefix for namespace URI \"$nsuri\""
-    }
-
-}
-
-# dom::tcl::GetField --
-#
-#	Return a value, or empty string if not defined
-#
-# Arguments:
-#	var	name of variable to return
-#
-# Results:
-#	Returns the value, or empty string if variable is not defined.
-
-proc dom::tcl::GetField var {
-    upvar $var v
-    if {[info exists v]} {
-	return $v
-    } else {
-	return {}
-    }
-}
-
-# dom::tcl::Min --
-#
-#	Return the minimum of two numeric values
-#
-# Arguments:
-#	a	a value
-#	b	another value
-#
-# Results:
-#	Returns the value which is lower than the other.
-
-proc dom::tcl::Min {a b} {
-    return [expr {$a < $b ? $a : $b}]
-}
-
-# dom::tcl::Max --
-#
-#	Return the maximum of two numeric values
-#
-# Arguments:
-#	a	a value
-#	b	another value
-#
-# Results:
-#	Returns the value which is greater than the other.
-
-proc dom::tcl::Max {a b} {
-    return [expr {$a > $b ? $a : $b}]
-}
-
-# dom::tcl::Boolean --
-#
-#	Return a boolean value
-#
-# Arguments:
-#	b	value
-#
-# Results:
-#	Returns 0 or 1
-
-proc dom::tcl::Boolean b {
-    regsub -nocase {^(true|yes|1|on)$} $b 1 b
-    regsub -nocase {^(false|no|0|off)$} $b 0 b
-    return $b
-}
-
diff --git a/tclxml/tcldom-tcl/dommap.tcl b/tclxml/tcldom-tcl/dommap.tcl
deleted file mode 100644
index 9d9ec87..0000000
--- a/tclxml/tcldom-tcl/dommap.tcl
+++ /dev/null
@@ -1,108 +0,0 @@
-# dommap.tcl --
-#
-#	Apply a mapping function to a DOM structure
-#
-# Copyright (c) 1998-2003 Zveno Pty Ltd
-# http://www.zveno.com/
-#
-# See the file "LICENSE" in this distribution for information on usage and
-# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# $Id: dommap.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $
-
-package provide dommap 1.0
-
-# We need the DOM
-package require dom 2.6
-
-namespace eval dommap {
-    namespace export map
-}
-
-# dommap::apply --
-#
-#	Apply a function to a DOM document.
-#
-#	The callback command is invoked with the node ID of the
-#	matching DOM node as its argument.  The command may return
-#	an error, continue or break code to alter the processing
-#	of further nodes.
-#
-#	Filter functions may be applied to match particular
-#	nodes.  Valid functions include:
-#
-#	-nodeType regexp
-#	-nodeName regexp
-#	-nodeValue regexp
-#	-attribute {regexp regexp}
-#
-#	If a filter is specified then the node must match for the
-#	callback command to be invoked.  If a filter is not specified
-#	then all nodes match that filter.
-#
-# Arguments:
-#	node	DOM document node
-#	cmd	callback command
-#	args	configuration options
-#
-# Results:
-#	Depends on callback command
-
-proc dommap::apply {node cmd args} {
-    array set opts $args
-
-    # Does this node match?
-    set match 1
-    catch {set match [expr $match && [regexp $opts(-nodeType) [::dom::node cget $node -nodeType]]]}
-    catch {set match [expr $match && [regexp $opts(-nodeName) [::dom::node cget $node -nodeName]]]}
-    catch {set match [expr $match && [regexp $opts(-nodeValue) [::dom::node cget $node -nodeValue]]]}
-    if {$match && ![string compare [::dom::node cget $node -nodeType] element]} {
-	set match 0
-	foreach {attrName attrValue} [array get [::dom::node cget $node -attributes]] {
-	    set match 1
-	    catch {set match [expr $match && [regexp [lindex $opts(-attribute) 0] $attrName]]}
-	    catch {set match [expr $match && [regexp [lindex $opts(-attribute) 1] $attrValue]]}
-	    if {$match} break
-	}
-    }
-    if {$match && [set code [catch {eval $cmd [list $node]} msg]]} {
-	switch $code {
-	    0 {}
-	    3 {
-		return -code break
-	    }
-	    4 {
-		return -code continue
-	    }
-	    default {
-		return -code error $msg
-	    }
-	}
-    }
-
-    # Process children
-    foreach child [::dom::node children $node] {
-	switch [catch {eval apply [list $child] [list $cmd] $args} msg] {
-	    0 {
-		# No action required
-	    }
-	    3 {
-		# break
-		return -code break
-	    }
-	    4 {
-		# continue - skip processing of siblings
-		return
-	    }
-	    1 -
-	    2 -
-	    default {
-		# propagate the error message
-		return -code error $msg
-	    }
-	}
-    }
-
-    return {}
-}
-
diff --git a/tclxml/tcldom-tcl/xmlswitch.tcl b/tclxml/tcldom-tcl/xmlswitch.tcl
deleted file mode 100644
index 4e2a2a1..0000000
--- a/tclxml/tcldom-tcl/xmlswitch.tcl
+++ /dev/null
@@ -1,520 +0,0 @@
-# xmlswitch.tcl --
-#
-#	This file implements a control structure for Tcl.
-#	'xmlswitch' iterates over an XML document.  Features in
-#	the document may be specified using XPath location paths,
-#	and these will trigger Tcl scripts when matched.
-#
-# Copyright (c) 2008 Explain
-# http://www.explain.com.au/
-# Copyright (c) 2000-2003 Zveno Pty Ltd
-# http://www.zveno.com/
-#
-# See the file "LICENSE" in this distribution for information on usage and
-# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# $Id: xmlswitch.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $
-
-package provide xmlswitch 3.2
-
-# We need the xml, dom and xpath packages
-
-package require xml 3.2
-package require dom 3.2
-package require xpath 1.0
-
-namespace eval xmlswitch {
-    namespace export xmlswitch xmlswitchcont xmlswitchend
-    namespace export domswitch
-    namespace export free rootnode
-
-    variable counter 0
-
-    variable typemap
-    array set typemap {
-	text textNode
-	comment comment
-	processing-instruction processingInstruction
-    }
-}
-
-# xmlswitch::xmlswitch --
-#
-#	Parse XML data, matching for XPath locations along the way
-#	and (possibly) triggering callbacks.
-#
-#	A DOM tree is built as a side-effect (necessary for resolving
-#	XPath location paths).
-#
-# Arguments:
-#	xml	XML document
-#	args	configuration options,
-#		plus a single path/script expression, or multiple expressions
-#
-# Results:
-#	Tcl callbacks may be invoked.
-#	If -async option is true returns a token for this "process".
-
-proc xmlswitch::xmlswitch {xml args} {
-    variable counter
-
-    set stateVarName [namespace current]::State[incr counter]
-    upvar #0 $stateVarName state
-    set state(stateVarName) $stateVarName
-    set state(-async) 0
-
-    set state(pathArray) ${stateVarName}Paths
-    upvar #0 $state(pathArray) paths
-    array set paths {}
-
-    set cleanup {
-	unset state
-	unset paths
-    }
-
-    # Find configuration options and remove
-    set numOpts 0
-    foreach {opt value} $args {
-	switch -glob -- $opt {
-	    -* {
-		set state($opt) $value
-		incr numOpts 2
-	    }
-	    default {
-		set args [lrange $args $numOpts end]
-		break
-	    }
-	}
-    }
-
-    switch -- [llength $args] {
-	0 {
-	    # Nothing to do
-	    eval $cleanup
-	    return $stateVarName
-	}
-	1 {
-	    foreach {path script} [lindex $args 0] {
-		set paths([xpath::split $path]) $script
-	    }
-	}
-	default {
-	    if {[llength $args] % 2} {
-		eval $cleanup
-		return -code error "no script matching location path \"[lindex $args end]\""
-	    }
-	    foreach {path script} $args {
-		set paths([xpath::split $path]) $script
-	    }
-	}
-    }
-
-    set root [set state(root) [dom::DOMImplementation create]]
-    set state(current) $root
-
-    # Parse the document
-    # We're going to do this incrementally, so the caller can
-    # break at any time
-    set state(parser) [eval xml::parser [array get state -parser]]
-    #append cleanup "\n $parser destroy\n"
-    $state(parser) configure \
-	    -elementstartcommand [namespace code [list ParseElementStart $stateVarName]]	\
-	    -elementendcommand [namespace code [list ParseElementEnd $stateVarName]]		\
-	    -characterdatacommand [namespace code [list ParseCharacterData $stateVarName]]	\
-	    -final 0
-
-#	    -processinginstructioncommand [namespace code [list ParsePI $stateVarName]]		\
-#	    -commentcommand [namespace code [list ParseComment]]
-
-    if {[catch {$state(parser) parse $xml} err]} {
-	eval $cleanup
-	return -code error $err
-    }
-
-    if {$state(-async)} {
-	return $stateVarName
-    } else {
-	eval $cleanup
-	return {}
-    }
-}
-
-# xmlswitch::xmlswitchcont --
-#
-#	Provide more XML data to parse
-#
-# Arguments:
-#	token	state variable name
-#	xml	XML data
-#
-# Results:
-#	More parsing
-
-proc xmlswitch::xmlswitchcont {token xml} {
-    upvar #0 $token state
-
-    $state(parser) parse $xml
-
-    return {}
-}
-
-# xmlswitch::xmlswitchend --
-#
-#	Signal that no further data is available
-#
-# Arguments:
-#	token	state array
-#
-# Results:
-#	Parser configuration changed
-
-proc xmlswitch::xmlswitchend token {
-    upvar #0 $token state
-
-    $state(parser) configure -final true
-
-    return {}
-}
-
-# xmlswitch::rootnode --
-#
-#	Get the root node
-#
-# Arguments:
-#	token	state array
-#
-# Results:
-#	Returns root node token
-
-proc xmlswitch::rootnode token {
-    upvar #0 $token state
-
-    return $state(root)
-}
-
-# xmlswitch::free --
-#
-#	Free resources EXCEPT the DOM tree.
-#	"-all" causes DOM tree to be destroyed too.
-#
-# Arguments:
-#	token	state array
-#	args	options
-#
-# Results:
-#	Resources freed.
-
-proc xmlswitch::free {token args} {
-    upvar #0 $token state
-
-    if {[lsearch $args "-all"] >= 0} {
-	dom::DOMImplementation destroy $state(root)
-    }
-
-    catch {unset $state(pathArray)}
-    catch {unset state}
-
-    catch {$state(parser) free}
-
-    return {}
-}
-
-# xmlswitch::ParseElementStart --
-#
-#	Handle element start tag
-#
-# Arguments:
-#	token	state array
-#	name	element type
-#	attrList attribute list
-#	args	options
-# Results:
-#	All XPath location paths are checked for a match,
-#	and script evaluated for matching XPath.
-#	DOM tree node added.
-
-proc xmlswitch::ParseElementStart:dbgdisabled {token name attrList args} {
-    if {[catch {eval ParseElementStart:dbg [list $token $name $attrList] $args} msg]} {
-	puts stderr [list ParseElementStart failed with msg $msg]
-	puts stderr $::errorInfo
-	return -code error $msg
-    } else {
-	puts stderr [list ParseElementStart returned OK]
-    }
-    return $msg
-}
-proc xmlswitch::ParseElementStart {token name attrList args} {
-
-    upvar #0 $token state
-    array set opts $args
-
-    #puts stderr [list xmlswitch::ParseElementStart $token $name $attrList $args]
-
-    lappend state(current) \
-	    [dom::document createElement [lindex $state(current) end] $name]
-    foreach {name value} $attrList {
-	dom::element setAttribute [lindex $state(current) end] $name $value
-    }
-
-    MatchTemplates $token [lindex $state(current) end]
-
-    return {}
-}
-
-# xmlswitch::ParseElementEnd --
-#
-#	Handle element end tag
-#
-# Arguments:
-#	token	state array
-#	name	element type
-#	args	options
-# Results:
-#	State changed
-
-proc xmlswitch::ParseElementEnd {token name args} {
-    upvar #0 $token state
-
-    set state(current) [lreplace $state(current) end end]
-
-    return {}
-}
-
-# xmlswitch::ParseCharacterData --
-#
-#	Handle character data
-#
-# Arguments:
-#	token	state array
-#	data	pcdata
-#
-# Results:
-#	All XPath location paths are checked for a match,
-#	and script evaluated for matching XPath.
-#	DOM tree node added.
-
-proc xmlswitch::ParseCharacterData {token data} {
-    upvar #0 $token state
-
-    lappend state(current) \
-	    [dom::document createTextNode [lindex $state(current) end] $data]
-
-    MatchTemplates $token [lindex $state(current) end]
-
-    set state(current) [lreplace $state(current) end end]
-
-    return {}
-}
-
-# xmlswitch::domswitch --
-#
-#	Similar to xmlswitch above, but iterates over a pre-built
-#	DOM tree.
-#
-# Arguments:
-#	xml	XML document
-#	args	a single path/script expression, or multiple expressions
-#
-# Results:
-#	Tcl callbacks may be invoked.
-
-proc xmlswitch::domswitch {xml args} {
-}
-
-# xmlswitch::MatchTemplates --
-#
-#	Check all templates for one which matches
-#	the current node.
-#
-# Arguments:
-#	token	state array
-#	node	Current DOM node
-#
-# Results:
-#	If a template matches, its script is evaluated
-
-proc xmlswitch::MatchTemplates {token node} {
-    upvar #0 $token state
-    upvar #0 $state(pathArray) paths
-
-    #puts stderr [list xmlswitch::MatchTemplates $token $node (type: [dom::node cget $node -nodeType]) (name: [dom::node cget $node -nodeName])]
-
-    set matches {}
-
-    foreach {path script} [array get paths] {
-
-	#puts stderr [list checking path $path for a match]
-
-	set context $node
-
-	# Work backwards along the path, reversing each axis
-	set match 0
-	set i [llength $path]
-	#puts stderr [list $i steps to be tested]
-	while {[incr i -1] >= 0} {
-	    #puts stderr [list step $i [lindex $path $i]]
-	    switch -glob [llength [lindex $path $i]],$i {
-		0,0 {
-		    #puts stderr [list absolute path, end of steps - am I at the root?]
-		    if {![string length [dom::node parent $context]]} {
-			#puts stderr [list absolute path matched]
-			lappend matches [list $path $script]
-		    } else {
-			#puts stderr [list absolute path did not match]
-		    }
-		}
-		*,0 {
-		    #puts stderr [list last step, relative path]
-		    switch [lindex [lindex $path $i] 0] {
-			child {
-			    if {[NodeTest [lindex $path $i] $context] && \
-				    [CheckPredicates [lindex $path $i] $context]} {
-				#puts stderr [list relative path matched]
-				lappend matches [list $path $script]
-			    } else {
-				#puts stderr [list relative path did not match]
-			    }
-			}
-			default {
-			    return -code error "axis \"[lindex [lindex $path $i] 0]\" not supported"
-			}
-		    }
-		}
-		default {
-		    #puts stderr [list continuing checking steps]
-		    switch [lindex [lindex $path $i] 0] {
-			child {
-			    if {[NodeTest [lindex $path $i] $context] && \
-				    [CheckPredicates [lindex $path $i] $context]} {
-				set context [dom::node parent $context]
-			    } else {
-				#puts stderr [list no match]
-			    }
-			}
-			default {
-			    return -code error "axis \"[lindex [lindex $path $i] 0]\" not supported"
-			}
-		    }
-		}
-	    }
-	}
-    }
-
-    # TODO: If there are multiple matches then we must pick the
-    # most specific match
-
-    if {[llength $matches] > 1} {
-	# For the moment we'll just take the first match
-	set matches [list [lindex $matches 0]]
-    }
-
-    if {[llength $matches]} {
-	#puts stderr [list evaluating callback at level [info level]]
-	uplevel 3 [lindex [lindex $matches 0] 1]
-    }
-
-    return {}
-}
-
-# xmlswitch::NodeTest --
-#
-#	Check that the node passes the node (type) test
-#
-# Arguments:
-#	step	Location step
-#	node	DOM node
-#
-# Results:
-#	Boolean
-
-proc xmlswitch::NodeTest {step node} {
-
-    if {[llength [lindex $step 1]] > 1} {
-	switch -glob -- [lindex [lindex $step 1] 0],[dom::node cget $node -nodeType] {
-	    node,* -
-	    text,textNode -
-	    comment,comment -
-	    processing-instruction,processingInstruction {
-		return 1
-	    }
-	    default {
-		return 0
-	    }
-	}
-    } elseif {![string compare [lindex $step 1] "*"]} {
-	return 1
-    } elseif {![string compare [lindex $step 1] [dom::node cget $node -nodeName]]} {
-	return 1
-    } else {
-	return 0
-    }
-}
-
-# xmlswitch::CheckPredicates --
-#
-#	Check that the node passes the predicates
-#
-# Arguments:
-#	step	Location step
-#	node	DOM node
-#
-# Results:
-#	Boolean
-
-proc xmlswitch::CheckPredicates {step node} {
-    variable typemap
-
-    set predicates [lindex $step 2]
-    # Shortcut: no predicates means everything passes
-    if {![llength $predicates]} {
-	return 1
-    }
-
-    # Get the context node set
-    switch [lindex $step 0] {
-	child {
-	    set nodeset {}
-	    if {[llength [lindex $step 1]]} {
-		foreach {name typetest} [lindex $step 1] break
-		switch -- $name {
-		    node {
-			set nodeset [dom::node children [dom::node parent $node]]
-		    }
-		    text -
-		    comment -
-		    processing-instruction {
-			foreach child [dom::node children [dom::node parent $node]] {
-			    if {![string compare [dom::node cget $child -nodeType] $typemap($name)]} {
-				lappend nodeset $child
-			    }
-			}
-		    }
-		    default {
-			# Error
-		    }
-		}
-	    } else {
-		foreach child [dom::node children [dom::node parent $node]] {
-		    if {![string compare [lindex $step 1] [dom::node cget $child -nodeName]]} {
-			lappend nodeset $child
-		    }
-		}
-	    }
-	}
-	default {
-	    return -code error "axis \"[lindex $step 0]\" not supported"
-	}
-    }
-
-    foreach predicate $predicates {
-	# position() is the only supported predicate
-	if {[lsearch $nodeset $node] + 1 == $predicate} {
-	    # continue
-	} else {
-	    return 0
-	}
-    }
-
-    return 1
-}
-