'''Motivation''' snitDom: https://bitbucket.org/mittelmark/tcl-code/downloads/tdom0.8.3.kit Contains tdom0.8.3 (shared libs for Linux-x86, Win32-x86 and OSX-x86), tnc (shared libs as for tdom), snit, uri, snitDom and the patched tcldom3.0 (see below). [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
tags < append result ">$newline" --- > > append result />$newline '''The snitDOM type''' ====== # System : SNITDOM_TCL # Module : # Object Name : $RCSfile: 13473,v $ # Revision : $Revision: 1.7 $ # Date : $Date: 2005-02-04 07:01:27 $ # 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.7 2005-02-04 07:01:27 jcw # 13473-1107437321-lwv,134.243.216.133 # # 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 {.+?} [dom::serialize $DOMDOC -method "html" -indent true] html return $html } method asXML {} { return [dom::serialize $DOMDOC -method "xml"] } } ====== '''Starkit, ready to use''' https://bitbucket.org/mittelmark/tcl-code/downloads/tdom0.8.3.kit Contains tdom0.8.3 (shared libs for Linux-x86, Win32-x86 and OSX-x86), snit, snitDom and the patched tcldom3.0. '''Sample session''' % cd /home/dgroth/mytcl % wget https://bitbucket.org/mittelmark/tcl-code/downloads/tdom0.8.3.kit % tclkit-8.4.19 (mytcl) 1 % source tdom0.8.3.kit (mytcl) 2 % package require snitDom (mytcl) 3 % 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] > } (mytcl) 4 % # just in case tdom was loaded (mytcl) 5 % catch {package require tdom} 0 (mytcl) 6 % if {[info commands dom] eq "dom"} { > puts "Output via tdom" > } else { > puts "tdom not supported on this platform" > snitDom dom > puts "Output via tcl::dom snitDom" > } Output via tdom (mytcl) 7 % (mytcl) 7 % createHTML Sample page (mytcl) 8 % rename dom "" (mytcl) 9 % package require snitDom 0.1 (mytcl) 10 % snitDom dom ::dom (mytcl) 11 % createHTML Sample page ---- See also [snit]. <> Package