html.lisp

   1 ;;; -*- show-trailing-whitespace: t; indent-tabs: nil -*-
   2
   3 ;;; Copyright (c) 2007,2008 David Lichteblau, Ivan Shvedunov.
   4 ;;; All rights reserved.
   5
   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.
  29
  30 (in-package :xuriella)
  31
  32
  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.
  39
  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
  45 (defmethod initialize-instance :after ((handler combi-sink) &key)
  46   (setf (sink-encoding handler)
  47         (or (sink-encoding handler) "utf-8")))
  48
  49 (defmethod sax:start-document ((handler combi-sink))
  50   nil)
  51
  52 (defmethod sax:start-dtd ((handler combi-sink) name pubid systemid)
  53   (hax:start-document (sink-hax-target handler) name pubid systemid))
  54
  55 (defun maybe-close-tag (combi-sink)
  56   (cxml::maybe-close-tag (sink-sax-target combi-sink)))
  57
  58 (defmethod sax:start-element ((handler combi-sink) uri lname qname attrs)
  59   (with-slots (hax-target sax-target encoding) handler
  60     (maybe-close-tag handler)
  61     (cond
  62       ((equal uri "")
  63        (sax:start-element hax-target *html* lname qname attrs)
  64        (when (and encoding (equalp lname "head"))
  65          (let* ((content (format nil "text/html; charset=~A" encoding))
  66                 (attrs
  67                  (list (hax:make-attribute "http-equiv" "Content-Type")
  68                        (hax:make-attribute "content" content))))
  69            (sax:start-element hax-target *html* "meta" "meta" attrs)
  70            (sax:end-element hax-target *html* "meta" "meta"))))
  71       (t
  72        (sax:start-element sax-target uri lname qname attrs)))))
  73
  74 (defmethod sax:end-element ((handler combi-sink) uri lname qname)
  75   (with-slots (hax-target sax-target) handler
  76     (maybe-close-tag handler)
  77     (if (equal uri "")
  78         (sax:end-element hax-target *html* lname qname)
  79         (sax:end-element sax-target uri lname qname))))
  80
  81 (defmethod sax:end-document ((handler combi-sink))
  82   (hax:end-document (sink-hax-target handler)))
  83
  84 (defmethod sax:processing-instruction ((handler combi-sink) target data)
  85   (maybe-close-tag handler)
  86   (sax:processing-instruction (sink-hax-target handler) target data))
  87
  88 (defmethod sax:characters ((handler combi-sink) data)
  89   (maybe-close-tag handler)
  90   (sax:characters (sink-hax-target handler) data))
  91
  92 (defmethod sax:unescaped ((handler combi-sink) data)
  93   (maybe-close-tag handler)
  94   (sax:unescaped (sink-hax-target handler) data))
  95
  96 (defmethod sax:comment ((handler combi-sink) data)
  97   (maybe-close-tag handler)
  98   (sax:comment (sink-hax-target handler) data))