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"
}
createHTMLTclDOM 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 />$newlineThe 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"]
}
}