From 81cca1b95aa5ceeb5a505993176bb1ef5ff8437e Mon Sep 17 00:00:00 2001 From: David Lichteblau Date: Mon, 24 Mar 2008 17:12:16 +0100 Subject: [PATCH] Implemented doctype-writing --- TEST | 14 +++++++------- html.lisp | 59 ++++++++++++++++++++++++++++++++++++++++------------------- xslt.lisp | 42 ++++++++++++++++++++++++++++++------------ 3 files changed, 77 insertions(+), 38 deletions(-) diff --git a/TEST b/TEST index 1ceb525..f04c03a 100644 --- a/TEST +++ b/TEST @@ -6265,7 +6265,7 @@ PASS output_output12 [XSLT-Result-Tree] Expected output (1): Xalan_Conformance_Tests/output/output_output12.saxon Actual output: Xalan_Conformance_Tests/output/output_output12.xuriella -FAIL output_output13 [XSLT-Result-Tree]: output doesn't match +PASS output_output13 [XSLT-Result-Tree] Stylesheet: Xalan_Conformance_Tests/output/output13.noindent-xsl Data: Xalan_Conformance_Tests/output/output13.xml Expected output (1): Xalan_Conformance_Tests/output/output_output13.saxon @@ -6277,7 +6277,7 @@ PASS output_output14 [XSLT-Result-Tree] Expected output (1): Xalan_Conformance_Tests/output/output_output14.saxon Actual output: Xalan_Conformance_Tests/output/output_output14.xuriella -FAIL output_output15 [XSLT-Result-Tree]: output doesn't match +PASS output_output15 [XSLT-Result-Tree] Stylesheet: Xalan_Conformance_Tests/output/output15.noindent-xsl Data: Xalan_Conformance_Tests/output/output15.xml Expected output (1): Xalan_Conformance_Tests/output/output_output15.saxon @@ -6601,13 +6601,13 @@ PASS output_output63 [XSLT-Result-Tree] Expected output (1): Xalan_Conformance_Tests/output/output_output63.saxon Actual output: Xalan_Conformance_Tests/output/output_output63.xuriella -FAIL output_output64 [XSLT-Result-Tree]: output doesn't match +PASS output_output64 [XSLT-Result-Tree] Stylesheet: Xalan_Conformance_Tests/output/output64.noindent-xsl Data: Xalan_Conformance_Tests/output/output64.xml Expected output (1): Xalan_Conformance_Tests/output/output_output64.saxon Actual output: Xalan_Conformance_Tests/output/output_output64.xuriella -FAIL output_output65 [XSLT-Result-Tree]: output doesn't match +PASS output_output65 [XSLT-Result-Tree] Stylesheet: Xalan_Conformance_Tests/output/output65.noindent-xsl Data: Xalan_Conformance_Tests/output/output65.xml Expected output (1): Xalan_Conformance_Tests/output/output_output65.saxon @@ -6710,7 +6710,7 @@ PASS output_output81 [XSLT-Result-Tree] Expected output (1): Xalan_Conformance_Tests/output/output_output81.saxon Actual output: Xalan_Conformance_Tests/output/output_output81.xuriella -FAIL output_output82 [XSLT-Result-Tree]: output doesn't match +PASS output_output82 [XSLT-Result-Tree] Stylesheet: Xalan_Conformance_Tests/output/output82.noindent-xsl Data: Xalan_Conformance_Tests/output/output82.xml Expected output (1): Xalan_Conformance_Tests/output/output_output82.saxon @@ -12864,7 +12864,7 @@ PASS BVTs_bvt065 [Mixed] Expected output (1): MSFT_Conformance_Tests/BVTs/BVTs_bvt065.saxon Actual output: MSFT_Conformance_Tests/BVTs/BVTs_bvt065.xuriella -FAIL BVTs_bvt066 [Mixed]: output doesn't match +PASS BVTs_bvt066 [Mixed] Stylesheet: MSFT_Conformance_Tests/BVTs/out-default3.noindent-xsl Data: MSFT_Conformance_Tests/BVTs/data.xml Expected output (1): MSFT_Conformance_Tests/BVTs/BVTs_bvt066.saxon @@ -22654,4 +22654,4 @@ PASS XSLTFunctions_DocumentFuncWithEmptyArg [Mixed] Expected output (1): MSFT_Conformance_Tests/XSLTFunctions/XSLTFunctions_DocumentFuncWithEmptyArg.saxon Actual output: MSFT_Conformance_Tests/XSLTFunctions/XSLTFunctions_DocumentFuncWithEmptyArg.xuriella -Passed 2666/3078 tests. +Passed 2672/3078 tests. diff --git a/html.lisp b/html.lisp index 92dc941..1459cb5 100644 --- a/html.lisp +++ b/html.lisp @@ -49,8 +49,9 @@ (defmethod sax:start-document ((handler combi-sink)) nil) -(defmethod sax:start-dtd ((handler combi-sink) name pubid systemid) - (hax:start-document (sink-hax-target handler) name pubid systemid)) +(defmethod sax:start-dtd ((handler combi-sink) name pubid sysid) + (when (or pubid sysid) + (hax:start-document (sink-hax-target handler) name pubid sysid))) (defun maybe-close-tag (combi-sink) (cxml::maybe-close-tag (sink-sax-target combi-sink))) @@ -104,40 +105,52 @@ ;;; ;;; Waits for the document element, then decides between combi-sink and ;;; xml sink. +;;; +;;; Also figures out the root element name for the doctype. (defclass auto-detect-sink (cxml:broadcast-handler) ((switchedp :initform nil :accessor sink-switched-p) + (detected-method :initarg :detected-method :accessor sink-detected-method) + (sysid :initform nil :accessor sink-sysid) + (pubid :initform nil :accessor sink-pubid) (buffered-events :initform '() :accessor sink-buffered-events))) -(defun make-auto-detect-sink (combi-sink) - (make-instance 'auto-detect-sink :handlers (list combi-sink))) +(defun make-auto-detect-sink (combi-sink fixed-method) + (make-instance 'auto-detect-sink + :handlers (list combi-sink) + :detected-method fixed-method)) (defmethod sax:start-document ((handler auto-detect-sink)) nil) -(defmethod sax:start-dtd ((handler auto-detect-sink) name pubid systemid) - (assert nil)) +(defmethod sax:start-dtd ((handler auto-detect-sink) name pubid sysid) + (setf (sink-sysid handler) sysid) + (setf (sink-pubid handler) pubid)) (defmethod sax:start-element :before ((handler auto-detect-sink) uri lname qname attrs) (unless (sink-switched-p handler) - (if (and (equal uri "") (string-equal lname "html")) - (switch-to-html-output handler) - (switch-to-xml-output handler)))) + (if (ecase (sink-detected-method handler) + (:html t) + (:xml nil) + ((nil) (and (equal uri "") (string-equal lname "html")))) + (switch-to-html-output handler qname) + (switch-to-xml-output handler qname)))) (defmethod sax:end-document :before ((handler auto-detect-sink)) (unless (sink-switched-p handler) - (switch-to-xml-output handler))) + (if (eq (sink-detected-method handler) :html) + (switch-to-html-output handler "root") + (switch-to-xml-output handler "root")))) (defmethod sax:characters ((handler auto-detect-sink) data) (cond ((sink-switched-p handler) (call-next-method)) - ((not (whitespacep data)) - (switch-to-xml-output handler) - (call-next-method)) (t + (unless (or (whitespacep data) (sink-detected-method handler)) + (setf (sink-detected-method handler) :xml)) (push (list 'sax:characters data) (sink-buffered-events handler))))) (defmethod sax:processing-instruction @@ -166,20 +179,28 @@ (define-condition |hey test suite, this is an HTML document| () ()) -(defun switch-to-html-output (handler) +(defun switch-to-html-output (handler qname) (signal '|hey test suite, this is an HTML document|) (setf (sink-switched-p handler) t) + (when (or (sink-sysid handler) (sink-pubid handler)) + (hax:start-document (car (cxml:broadcast-handler-handlers handler)) + qname + (sink-pubid handler) + (sink-sysid handler))) (replay-buffered-events handler)) -(defun switch-to-xml-output (handler) +(defun switch-to-xml-output (handler qname) (setf (sink-switched-p handler) t) - (setf (cxml:broadcast-handler-handlers handler) - (list (sink-sax-target - (car (cxml:broadcast-handler-handlers handler))))) + (let ((target + (sink-sax-target (car (cxml:broadcast-handler-handlers handler))))) + (setf (cxml:broadcast-handler-handlers handler) (list target)) + (sax:start-document target) + (when (sink-sysid handler) + (sax:start-dtd target qname (sink-pubid handler) (sink-sysid handler)) + (sax:end-dtd target))) (replay-buffered-events handler)) (defun replay-buffered-events (handler) - (sax:start-document (car (cxml:broadcast-handler-handlers handler))) (loop for (event . args) in (nreverse (sink-buffered-events handler)) do (apply event handler args))) diff --git a/xslt.lisp b/xslt.lisp index cec0c80..db2ad91 100644 --- a/xslt.lisp +++ b/xslt.lisp @@ -688,7 +688,9 @@ method indent omit-xml-declaration - encoding) + encoding + doctype-system + doctype-public) (defun parse-output! (stylesheet ) (let ((outputs (list-toplevel "output" ))) @@ -705,8 +707,8 @@ indent encoding ;;; media-type -;;; doctype-system -;;; doctype-public + doctype-system + doctype-public omit-xml-declaration ;;; standalone ;;; cdata-section-elements @@ -715,6 +717,8 @@ (setf (output-method spec) method) (setf (output-indent spec) indent) (setf (output-encoding spec) encoding) + (setf (output-doctype-system spec) doctype-system) + (setf (output-doctype-public spec) doctype-public) (setf (output-omit-xml-declaration spec) omit-xml-declaration)))))) (defun make-empty-declaration-array () @@ -1285,6 +1289,11 @@ (make-output-sink output-spec output))) ((or hax:abstract-handler sax:abstract-handler) (with-xml-output output + (when (typep output '(or combi-sink auto-detect-sink)) + (sax:start-dtd output + :autodetect-me-please + (output-doctype-public output-spec) + (output-doctype-system output-spec))) (funcall fn))))) (defun make-output-sink (output-spec stream) @@ -1309,15 +1318,24 @@ :ystream ystream) :sax-target sax-target :encoding (output-encoding output-spec)))) - (cond - ((equalp (output-method output-spec) "HTML") - (make-combi-sink)) - ((equalp (output-method output-spec) "TEXT") - (make-text-filter sax-target)) - ((equalp (output-method output-spec) "XML") - sax-target) - (t - (make-auto-detect-sink (make-combi-sink))))))) + (let ((method-key + (cond + ((equalp (output-method output-spec) "HTML") :html) + ((equalp (output-method output-spec) "TEXT") :text) + ((equalp (output-method output-spec) "XML") :xml) + (t nil)))) + (cond + ((and (eq method-key :html) + (null (output-doctype-system output-spec)) + (null (output-doctype-public output-spec))) + (make-combi-sink)) + ((eq method-key :text) + (make-text-filter sax-target)) + ((and (eq method-key :xml) + (null (output-doctype-system output-spec))) + sax-target) + (t + (make-auto-detect-sink (make-combi-sink) method-key))))))) (defstruct template match-expression -- 2.11.4.GIT