[bknr-cvs] hans changed trunk/bknr/web/src/web/template-handler.lisp
BKNR Commits
bknr at bknr.net
Mon Sep 1 16:02:12 UTC 2008
Revision: 3762
Author: hans
URL: http://bknr.net/trac/changeset/3762
Fix namespace declaration attribute output.
U trunk/bknr/web/src/web/template-handler.lisp
Modified: trunk/bknr/web/src/web/template-handler.lisp
===================================================================
--- trunk/bknr/web/src/web/template-handler.lisp 2008-09-01 16:01:56 UTC (rev 3761)
+++ trunk/bknr/web/src/web/template-handler.lisp 2008-09-01 16:02:12 UTC (rev 3762)
@@ -128,11 +128,38 @@
:specified-p t))))
attrs))
+(defstruct parsed-template
+ namespace-attrs
+ dom
+ last-change
+ nsuri-alias-map)
+
(defun parse-template (template-pathname)
- (let ((sax:*include-xmlns-attributes* t))
- (cxml:parse-file (namestring (probe-file template-pathname))
- (cxml-xmls:make-xmls-builder)
- :validate nil)))
+ "Parse the XML template in the file TEMPLATE-PATHNAME, return a PARSED-TEMPLATE structure."
+ ;; In order to generate xmlns attributes, we use the internal
+ ;; CXML-XMLS::COMPUTE-ATTRIBUTES/LNAMES function. This may need to
+ ;; be revised with newer cxml releases.
+ (let* ((sax:*include-xmlns-attributes* t)
+ (dom (cxml:parse-file (namestring (probe-file template-pathname))
+ (cxml-xmls:make-xmls-builder)
+ :validate nil))
+ real-attributes
+ namespace-declarations
+ (nsuri-alias-map (make-hash-table :test #'equal)))
+ (dolist (attribute (cxml-xmls:node-attrs dom))
+ (destructuring-bind ((alias . namespace-url) value) attribute
+ (cond
+ ((equal namespace-url "http://www.w3.org/2000/xmlns/")
+ (setf (gethash value nsuri-alias-map) alias)
+ (push attribute namespace-declarations))
+ (t
+ (push attribute real-attributes)))))
+ (setf (cxml-xmls:node-attrs dom) real-attributes)
+ (make-parsed-template
+ :namespace-attrs (cxml-xmls::compute-attributes/lnames (cxml-xmls:make-node :attrs namespace-declarations) t)
+ :dom dom
+ :last-change (file-write-date template-pathname)
+ :nsuri-alias-map nsuri-alias-map)))
(defvar *tag-children*)
@@ -140,6 +167,9 @@
"Function to be called by application defined tags to emit their children."
(mapc (curry #'emit-template-node *template-expander*) *tag-children*))
+(defvar *namespace-attributes* nil
+ "Bound to the list of namespace attributes to emit on the top level node.")
+
(defun emit-template-node (expander node)
(if (stringp node)
(sax:characters *html-sink* (expand-variables node #'get-template-var))
@@ -159,29 +189,19 @@
and collect (expand-variables name #'get-template-var))))))
(t
(sax:start-element *html-sink* nil nil name
- (xmls-attributes-to-sax (rcurry #'expand-variables #'get-template-var) attrs))
+ (append (when *namespace-attributes*
+ (prog1
+ *namespace-attributes*
+ (setf *namespace-attributes* nil)))
+ (xmls-attributes-to-sax (rcurry #'expand-variables #'get-template-var) attrs)))
(dolist (child children)
(emit-template-node expander child))
(sax:end-element *html-sink* nil nil name))))))
-(defun emit-parsed-template (expander toplevel)
- "Emit the given XMLS compatible structure as XML to *HTML-SINK*."
- ;; In order to generate xmlns attributes, we use the internal
- ;; CXML-XMLS::COMPUTE-ATTRIBUTES/LNAMES function. This may need to
- ;; be revised with newer cxml releases.
- (let* ((toplevel-attributes (cxml-xmls::compute-attributes/lnames toplevel t))
- (*template-expander* expander)
- (*nsuri-alias-map* (let ((map (make-hash-table :test #'equal)))
- (dolist (attribute toplevel-attributes)
- (when (scan "^xmlns($|:)" (sax:attribute-qname attribute))
- (setf (gethash (sax:attribute-value attribute) map)
- (sax:attribute-local-name attribute))))
- map)))
- (sax:start-element *html-sink* (node-ns toplevel) (node-name toplevel) (node-name toplevel)
- toplevel-attributes)
- (dolist (node (node-children toplevel))
- (emit-template-node expander node))
- (sax:end-element *html-sink* (node-ns toplevel) (node-name toplevel) (node-name toplevel))))
+(defun emit-parsed-template (expander parsed-template)
+ "Emit the given parsed template as XHML to *HTML-SINK*."
+ (let* ((*template-expander* expander))
+ (emit-template-node expander (parsed-template-dom parsed-template))))
(defun find-template (dir components)
(if (null components)
@@ -221,28 +241,28 @@
(defun get-cached-template (pathname expander)
(let* ((table (template-expander-cached-templates expander))
(namestring (namestring pathname))
- (cache-entry (gethash namestring table))
+ (parsed-template (gethash namestring table))
(current-write-date (file-write-date namestring)))
- (unless (and cache-entry (eql (car cache-entry) current-write-date))
- (setf cache-entry
- (cons current-write-date (parse-template pathname)))
- (setf (gethash namestring table) cache-entry))
- (cdr cache-entry)))
+ (unless (and parsed-template
+ (eql current-write-date (parsed-template-last-change parsed-template)))
+ (setf parsed-template (parse-template pathname)
+ (gethash namestring table) parsed-template))
+ parsed-template))
-(defun emit-template (expander stream node env)
+(defun emit-template (expander stream parsed-template env)
(let* ((*template-env* env)
(*html-sink* (cxml:make-character-stream-sink stream :canonical nil)))
- (if (node-attribute node "suppress-xml-headers")
- (emit-parsed-template expander node)
- (progn
- (sax:start-document *html-sink*)
- (sax:start-dtd *html-sink*
- "html"
- "-//W3C//DTD XHTML 1.0 Transitional//EN"
- "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
- (sax:end-dtd *html-sink*)
- (emit-parsed-template expander node)))
+ (sax:start-dtd *html-sink*
+ "html"
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
+ (sax:end-dtd *html-sink*)
+ (let ((*namespace-attributes* (parsed-template-namespace-attrs parsed-template))
+ (*nsuri-alias-map* (parsed-template-nsuri-alias-map parsed-template)))
+ (emit-parsed-template expander parsed-template))
+ ;; We call sax:end-document to close the sink, which works even though we did not call sax:start-document.
(sax:end-document *html-sink*)))
+
;; template handler
(defclass template-handler (prefix-handler template-expander)
More information about the Bknr-cvs
mailing list