Observe doctype in xuriella:document
[xuriella.git] / html.lisp
blob38e3d6d79c4ee518aba2b710a501c20ad79b418c
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)
44 (media-type :initarg :media-type :accessor sink-media-type)))
46 (defmethod initialize-instance :after ((handler combi-sink) &key)
47 (setf (sink-encoding handler)
48 (or (sink-encoding handler) "UTF-8")))
50 (defmethod sax:start-document ((handler combi-sink))
51 nil)
53 (defmethod sax:start-dtd ((handler combi-sink) name pubid sysid)
54 (when (or pubid sysid)
55 (hax:start-document (sink-hax-target handler) name pubid sysid)))
57 (defun maybe-close-tag (combi-sink)
58 (cxml::maybe-close-tag (sink-sax-target combi-sink)))
60 (defmethod sax:start-element ((handler combi-sink) uri lname qname attrs)
61 (with-slots (hax-target sax-target encoding) handler
62 (maybe-close-tag handler)
63 (cond
64 ((equal uri "")
65 (sax:start-element hax-target *html* lname qname attrs)
66 (when (and encoding (equalp lname "head"))
67 (let* ((content (format nil "~A; charset=~A"
68 (or (sink-media-type handler) "text/html")
69 encoding))
70 (attrs
71 (list (hax:make-attribute "http-equiv" "Content-Type")
72 (hax:make-attribute "content" content))))
73 (sax:start-element hax-target *html* "meta" "meta" attrs)
74 (sax:end-element hax-target *html* "meta" "meta"))))
76 (sax:start-element sax-target uri lname qname attrs)))))
78 (defmethod sax:end-element ((handler combi-sink) uri lname qname)
79 (with-slots (hax-target sax-target) handler
80 (maybe-close-tag handler)
81 (if (equal uri "")
82 (sax:end-element hax-target *html* lname qname)
83 (sax:end-element sax-target uri lname qname))))
85 (defmethod sax:end-document ((handler combi-sink))
86 (hax:end-document (sink-hax-target handler)))
88 (defmethod sax:processing-instruction ((handler combi-sink) target data)
89 (maybe-close-tag handler)
90 (sax:processing-instruction (sink-hax-target handler) target data))
92 (defmethod sax:characters ((handler combi-sink) data)
93 (maybe-close-tag handler)
94 (sax:characters (sink-hax-target handler) data))
96 (defmethod sax:unescaped ((handler combi-sink) data)
97 (maybe-close-tag handler)
98 (sax:unescaped (sink-hax-target handler) data))
100 (defmethod sax:comment ((handler combi-sink) data)
101 (maybe-close-tag handler)
102 (sax:comment (sink-hax-target handler) data))
107 ;;; Handler for the default output method.
109 ;;; Waits for the document element, then decides between combi-sink and
110 ;;; xml sink.
112 ;;; Also figures out the root element name for the doctype.
114 (defclass auto-detect-sink (cxml:broadcast-handler)
115 ((switchedp :initform nil :accessor sink-switched-p)
116 (detected-method :initarg :detected-method :accessor sink-detected-method)
117 (sysid :initform nil :accessor sink-sysid)
118 (pubid :initform nil :accessor sink-pubid)
119 (buffered-events :initform '() :accessor sink-buffered-events)))
121 (defun make-auto-detect-sink (combi-sink fixed-method)
122 (make-instance 'auto-detect-sink
123 :handlers (list combi-sink)
124 :detected-method fixed-method))
126 (defmethod sax:start-document ((handler auto-detect-sink))
127 nil)
129 (defmethod sax:start-dtd ((handler auto-detect-sink) name pubid sysid)
130 (setf (sink-sysid handler) sysid)
131 (setf (sink-pubid handler) pubid))
133 (defmethod sax:start-element
134 :before
135 ((handler auto-detect-sink) uri lname qname attrs)
136 (unless (sink-switched-p handler)
137 (if (ecase (sink-detected-method handler)
138 (:html t)
139 (:xml nil)
140 ((nil) (and (equal uri "") (string-equal lname "html"))))
141 (switch-to-html-output handler qname)
142 (switch-to-xml-output handler qname))))
144 (defmethod sax:end-document :before ((handler auto-detect-sink))
145 (unless (sink-switched-p handler)
146 (if (eq (sink-detected-method handler) :html)
147 (switch-to-html-output handler "root")
148 (switch-to-xml-output handler "root"))))
150 (defmethod sax:characters ((handler auto-detect-sink) data)
151 (cond
152 ((sink-switched-p handler)
153 (call-next-method))
155 (unless (or (whitespacep data) (sink-detected-method handler))
156 (setf (sink-detected-method handler) :xml))
157 (push (list 'sax:characters data) (sink-buffered-events handler)))))
159 (defmethod sax:processing-instruction
160 ((handler auto-detect-sink) target data)
161 (cond
162 ((sink-switched-p handler)
163 (call-next-method))
165 (push (list 'sax:processing-instruction target data)
166 (sink-buffered-events handler)))))
168 (defmethod sax:unescaped ((handler auto-detect-sink) data)
169 (cond
170 ((sink-switched-p handler)
171 (call-next-method))
173 (push (list 'sax:unescaped data) (sink-buffered-events handler)))))
175 (defmethod sax:comment ((handler auto-detect-sink) data)
176 (cond
177 ((sink-switched-p handler)
178 (call-next-method))
180 (push (list 'sax:comment data) (sink-buffered-events handler)))))
182 (define-condition |hey test suite, this is an HTML document| ()
185 (defun switch-to-html-output (handler qname)
186 (signal '|hey test suite, this is an HTML document|)
187 (setf (sink-switched-p handler) t)
188 (when (or (sink-sysid handler) (sink-pubid handler))
189 (hax:start-document (car (cxml:broadcast-handler-handlers handler))
190 qname
191 (sink-pubid handler)
192 (sink-sysid handler)))
193 (replay-buffered-events handler))
195 (defun switch-to-xml-output (handler qname)
196 (setf (sink-switched-p handler) t)
197 (let ((target
198 (sink-sax-target (car (cxml:broadcast-handler-handlers handler)))))
199 (setf (cxml:broadcast-handler-handlers handler) (list target))
200 (sax:start-document target)
201 (when (sink-sysid handler)
202 (sax:start-dtd target qname (sink-pubid handler) (sink-sysid handler))
203 (sax:end-dtd target)))
204 (replay-buffered-events handler))
206 (defun replay-buffered-events (handler)
207 (loop
208 for (event . args) in (nreverse (sink-buffered-events handler))
209 do (apply event handler args)))