'''Motivation'''

[tdom] is much faster than the tcl-only implementation [TclDOM]. The usage syntax for both APIs is very different. The idea is to adjust the syntax of [TclDOM] that it can be used as a dropin replacement for [tdom] if the latter is not available for a certain platform. So code like the following can be written.

  proc createHTML {} {
        set text "Sample page"
        set doc [dom createDocument html]
        set root [$doc documentElement]
        set head [$doc createElement head]
      
        set title [$doc createElement title]
        $title appendChild [$doc createTextNode "$text"] 
        $root appendChild $head
        $head appendChild $title
        $root appendChild [$doc createElement body]
        foreach style {jsComponents.css dg-mpimg.css} {
            set link [$doc createElement link]
            $link setAttribute rel stylesheet
            $link setAttribute text text/css
            $link setAttribute href /css/$style
            $head appendChild $link
        }
        puts [$doc asHTML]
    }
  
    catch {package require tdom}
    if {[info commands dom] eq "dom"} {
        puts "Output via tdom"
    } else {
        puts "tdom not supported on this platform"
        puts "falling back to TclDOM
        snitDom dom
        puts "Output via tcl::dom snitDom"
    }
    createHTML

'''TclDOM changes'''

TclDOM is missing some node/element commands so I was adding them into the source code of dom.tcl.
Here comes the diff:

 $ diff tdom0.8.1.vfs/lib/tcldom3.0/dom.tcl /d/tcl-lib/tcldom3.0/dom.tcl 
 1211,1249d1210
 <         *stChild {
 <             # firstChild or lastChild
 <             set result [dom::tcl::node cget $token -$method]
 <       }
 <         *Sibling {
 <             # previousSibling or nextSibling
 <             set result [dom::tcl::node cget $token -$method]
 <         }
 <         hasAttribute {
 <             if {[dom::element getAttribute $token [lindex $args 0]] eq ""} {
 <                 set result false
 <             } else {
 <                 set result true
 <             }
 <         }
 <         *Attribute {
 <             switch $node(node:nodeType) {
 <                 textNode {}
 <                 default {
 <                     if {[llength $args] == 1} {
 <                         set result [dom::element $method $token [lindex $args 0]]
 <                     } else {
 <                         set result [dom::element $method $token [lindex $args 0] [lindex $args 1]] 
 <                     }
 <                 }
 <             }
 <         }
 <         selectNodes {
 <             switch $node(node:nodeType) {
 <                 textNode {}
 <                 default {
 <                     if {[llength $args] == 1} {
 <                         set result [dom::selectNode $token [lindex $args 0]]
 <                     } else {
 <                         set result [dom::selectNode $token [lindex $args 0] [lindex $args 1] [lindex $args 2]]
 <                     }
 <                 }
 <             }
 <         }
 3005,3006c2966,2967
 <         # dgroth fixes bad browser behaviour with <div foo='bar'/> tags
 <       append result "></$nsPrefix$node(node:localName)>$newline"
 ---
 > 
 >       append result />$newline

'''The snitDOM type'''

 #  System        : SNITDOM_TCL
 #  Module        : 
 #  Object Name   : $RCSfile: 13473,v $
 #  Revision      : $Revision: 1.5 $
 #  Date          : $Date: 2005-02-04 07:01:25 $
 #  Author        : $Author: jcw $
 #  Last Modified : <050203.1215>
 #
 #  Description	A wrapper type which allows to use tcl::dom with a tdom syntax
 #
 #  $Log: 13473,v $
 #  Revision 1.5  2005-02-04 07:01:25  jcw
 #  13473-1107431558-DDG,141.14.20.59
 #
 #  Revision 1.1  2005/02/03 11:14:54  dgroth
 #  initial cvs import
 #
 ##############################################################################
 
 package require snit 0.93
 package require dom::tcl 3.0
 package provide snitDom 0.1
 snit::type snitDom {
    variable DOMDOC
    method createDocument {docElemName args} {
        # Creates a new DOM document object with 
        # one element node 
        # with node name docElemName
        set DOMDOC [dom::DOMImplementation create]
        set document [sdomDocument %AUTO% $DOMDOC]
        $document CreateRoot $docElemName
        return $document
    }
    method createDocumentNode {} {
        # not tested yet
        set DOMDOC [dom::DOMImplementation create]
        set document [sdomDocument %AUTO% $DOMDOC]
        return $document
    }
    method parse {xml} {
        set DOMDOC [dom::DOMImplementation parse $xml]
        set document [sdomDocument %AUTO% $DOMDOC]
        return $document
    }
    method delete {} {
        # not tested yet
        dom::DOMImplementation destroy $DOMDOC
    }
        
 }
 snit::type sdomDocument {
    variable DOMDOC
    #variable ROOT
    delegate method * to DOMDOC
    constructor {doc args} {
        set DOMDOC $doc
        # no options so no configurelist
        #$self configurelist $args
      
        
    }  
    method CreateRoot {rootElem} {
        dom::document createElement $DOMDOC $rootElem
        #return $ROOT
    }
    method documentElement {} {
        return [dom::document cget $DOMDOC -documentElement]
        # return $ROOT
    }
    method asHTML {} {
        regsub {.+?<html>} [dom::serialize $DOMDOC -method "html" -indent true] <html> html
        return $html
    }
    method asXML {} {
        return [dom::serialize $DOMDOC -method "xml"]
    }
 }