Fixed comment workaround
[xuriella.git] / html.lisp
blobdc75b3316ee04e0d1c3c8422259e48c7e36821da
1 ;;; -*- show-trailing-whitespace: t; indent-tabs-mode: nil -*-
3 ;;; Copyright (c) 2007,2008 David Lichteblau, Ivan Shvedunov.
4 ;;; All rights reserved.
6 ;;; Redistribution and use in source and binary forms, with or without
7 ;;; modification, are permitted provided that the following conditions
8 ;;; are met:
9 ;;;
10 ;;; * Redistributions of source code must retain the above copyright
11 ;;; notice, this list of conditions and the following disclaimer.
12 ;;;
13 ;;; * Redistributions in binary form must reproduce the above
14 ;;; copyright notice, this list of conditions and the following
15 ;;; disclaimer in the documentation and/or other materials
16 ;;; provided with the distribution.
17 ;;;
18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 (in-package :xuriella)
33 ;;; Handler for the HTML output method.
34 ;;;
35 ;;; Dispatches requests to either an HTML sink or an XML sink, depending
36 ;;; on the namespace of the event.
37 ;;;
38 ;;; Inserts the http-equiv meta tag.
40 (defclass combi-sink (sax:content-handler)
41 ((hax-target :initarg :hax-target :accessor sink-hax-target)
42 (sax-target :initarg :sax-target :accessor sink-sax-target)
43 (encoding :initarg :encoding :accessor sink-encoding)))
45 (defmethod initialize-instance :after ((handler combi-sink) &key)
46 (setf (sink-encoding handler)
47 (or (sink-encoding handler) "UTF-8")))
49 (defmethod sax:start-document ((handler combi-sink))
50 nil)
52 (defmethod sax:start-dtd ((handler combi-sink) name pubid sysid)
53 (when (or pubid sysid)
54 (hax:start-document (sink-hax-target handler) name pubid sysid)))
56 (defun maybe-close-tag (combi-sink)
57 (cxml::maybe-close-tag (sink-sax-target combi-sink)))
59 (defmethod sax:start-element ((handler combi-sink) uri lname qname attrs)
60 (with-slots (hax-target sax-target encoding) handler
61 (maybe-close-tag handler)
62 (cond
63 ((equal uri "")
64 (sax:start-element hax-target *html* lname qname attrs)
65 (when (and encoding (equalp lname "head"))
66 (let* ((content (format nil "text/html; charset=~A" encoding))
67 (attrs
68 (list (hax:make-attribute "http-equiv" "Content-Type")
69 (hax:make-attribute "content" content))))
70 (sax:start-element hax-target *html* "meta" "meta" attrs)
71 (sax:end-element hax-target *html* "meta" "meta"))))
73 (sax:start-element sax-target uri lname qname attrs)))))
75 (defmethod sax:end-element ((handler combi-sink) uri lname qname)
76 (with-slots (hax-target sax-target) handler
77 (maybe-close-tag handler)
78 (if (equal uri "")
79 (sax:end-element hax-target *html* lname qname)
80 (sax:end-element sax-target uri lname qname))))
82 (defmethod sax:end-document ((handler combi-sink))
83 (hax:end-document (sink-hax-target handler)))
85 (defmethod sax:processing-instruction ((handler combi-sink) target data)
86 (maybe-close-tag handler)
87 (sax:processing-instruction (sink-hax-target handler) target data))
89 (defmethod sax:characters ((handler combi-sink) data)
90 (maybe-close-tag handler)
91 (sax:characters (sink-hax-target handler) data))
93 (defmethod sax:unescaped ((handler combi-sink) data)
94 (maybe-close-tag handler)
95 (sax:unescaped (sink-hax-target handler) data))
97 (defmethod sax:comment ((handler combi-sink) data)
98 (maybe-close-tag handler)
99 (sax:comment (sink-hax-target handler) data))
104 ;;; Handler for the default output method.
106 ;;; Waits for the document element, then decides between combi-sink and
107 ;;; xml sink.
109 ;;; Also figures out the root element name for the doctype.
111 (defclass auto-detect-sink (cxml:broadcast-handler)
112 ((switchedp :initform nil :accessor sink-switched-p)
113 (detected-method :initarg :detected-method :accessor sink-detected-method)
114 (sysid :initform nil :accessor sink-sysid)
115 (pubid :initform nil :accessor sink-pubid)
116 (buffered-events :initform '() :accessor sink-buffered-events)))
118 (defun make-auto-detect-sink (combi-sink fixed-method)
119 (make-instance 'auto-detect-sink
120 :handlers (list combi-sink)
121 :detected-method fixed-method))
123 (defmethod sax:start-document ((handler auto-detect-sink))
124 nil)
126 (defmethod sax:start-dtd ((handler auto-detect-sink) name pubid sysid)
127 (setf (sink-sysid handler) sysid)
128 (setf (sink-pubid handler) pubid))
130 (defmethod sax:start-element
131 :before
132 ((handler auto-detect-sink) uri lname qname attrs)
133 (unless (sink-switched-p handler)
134 (if (ecase (sink-detected-method handler)
135 (:html t)
136 (:xml nil)
137 ((nil) (and (equal uri "") (string-equal lname "html"))))
138 (switch-to-html-output handler qname)
139 (switch-to-xml-output handler qname))))
141 (defmethod sax:end-document :before ((handler auto-detect-sink))
142 (unless (sink-switched-p handler)
143 (if (eq (sink-detected-method handler) :html)
144 (switch-to-html-output handler "root")
145 (switch-to-xml-output handler "root"))))
147 (defmethod sax:characters ((handler auto-detect-sink) data)
148 (cond
149 ((sink-switched-p handler)
150 (call-next-method))
152 (unless (or (whitespacep data) (sink-detected-method handler))
153 (setf (sink-detected-method handler) :xml))
154 (push (list 'sax:characters data) (sink-buffered-events handler)))))
156 (defmethod sax:processing-instruction
157 ((handler auto-detect-sink) target data)
158 (cond
159 ((sink-switched-p handler)
160 (call-next-method))
162 (push (list 'sax:processing-instruction target data)
163 (sink-buffered-events handler)))))
165 (defmethod sax:unescaped ((handler auto-detect-sink) data)
166 (cond
167 ((sink-switched-p handler)
168 (call-next-method))
170 (push (list 'sax:unescaped data) (sink-buffered-events handler)))))
172 (defmethod sax:comment ((handler auto-detect-sink) data)
173 (cond
174 ((sink-switched-p handler)
175 (call-next-method))
177 (push (list 'sax:comment data) (sink-buffered-events handler)))))
179 (define-condition |hey test suite, this is an HTML document| ()
182 (defun switch-to-html-output (handler qname)
183 (signal '|hey test suite, this is an HTML document|)
184 (setf (sink-switched-p handler) t)
185 (when (or (sink-sysid handler) (sink-pubid handler))
186 (hax:start-document (car (cxml:broadcast-handler-handlers handler))
187 qname
188 (sink-pubid handler)
189 (sink-sysid handler)))
190 (replay-buffered-events handler))
192 (defun switch-to-xml-output (handler qname)
193 (setf (sink-switched-p handler) t)
194 (let ((target
195 (sink-sax-target (car (cxml:broadcast-handler-handlers handler)))))
196 (setf (cxml:broadcast-handler-handlers handler) (list target))
197 (sax:start-document target)
198 (when (sink-sysid handler)
199 (sax:start-dtd target qname (sink-pubid handler) (sink-sysid handler))
200 (sax:end-dtd target)))
201 (replay-buffered-events handler))
203 (defun replay-buffered-events (handler)
204 (loop
205 for (event . args) in (nreverse (sink-buffered-events handler))
206 do (apply event handler args)))