html.lisp

   1 ;;; -*- show-trailing-whitespace: t; indent-tabs: nil -*-
   2
   3 ;;; Copyright (c) 2007 David Lichteblau. All rights reserved.
   4
   5 ;;; Redistribution and use in source and binary forms, with or without
   6 ;;; modification, are permitted provided that the following conditions
   7 ;;; are met:
   8 ;;;
   9 ;;;   * Redistributions of source code must retain the above copyright
  10 ;;;     notice, this list of conditions and the following disclaimer.
  11 ;;;
  12 ;;;   * Redistributions in binary form must reproduce the above
  13 ;;;     copyright notice, this list of conditions and the following
  14 ;;;     disclaimer in the documentation and/or other materials
  15 ;;;     provided with the distribution.
  16 ;;;
  17 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
  18 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  19 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  20 ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
  21 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  22 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
  23 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  24 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  25 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  26 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  27 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  28
  29 (in-package :xuriella)
  30
  31
  32 ;;; Handler for the HTML output method.
  33 ;;;
  34 ;;; Dispatches requests to either an HTML sink or an XML sink, depending
  35 ;;; on the namespace of the event.
  36 ;;;
  37 ;;; Inserts the http-equiv meta tag.
  38
  39 (defclass combi-sink (sax:content-handler)
  40   ((hax-target :initarg :hax-target :accessor sink-hax-target)
  41    (sax-target :initarg :sax-target :accessor sink-sax-target)
  42    (encoding :initarg :encoding :accessor sink-encoding)))
  43
  44 (defmethod initialize-instance :after ((handler combi-sink) &key)
  45   (setf (sink-encoding handler)
  46         (or (sink-encoding handler) "utf-8")))
  47
  48 (defmethod sax:start-document ((handler combi-sink))
  49   nil)
  50
  51 (defmethod sax:start-dtd ((handler combi-sink) name pubid systemid)
  52   (hax:start-document (sink-hax-target handler) name pubid systemid))
  53
  54 (defun maybe-close-tag (combi-sink)
  55   (cxml::maybe-close-tag (sink-sax-target combi-sink)))
  56
  57 (defmethod sax:start-element ((handler combi-sink) uri lname qname attrs)
  58   (with-slots (hax-target sax-target encoding) handler
  59     (maybe-close-tag handler)
  60     (cond
  61       ((equal uri "")
  62        (sax:start-element hax-target *html* lname qname attrs)
  63        (when (and encoding (equalp lname "head"))
  64          (let* ((content (format nil "text/html; charset=~A" encoding))
  65                 (attrs
  66                  (list (hax:make-attribute "http-equiv" "Content-Type")
  67                        (hax:make-attribute "content" content))))
  68            (sax:start-element hax-target *html* "meta" "meta" attrs)
  69            (sax:end-element hax-target *html* "meta" "meta"))))
  70       (t
  71        (sax:start-element sax-target uri lname qname attrs)))))
  72
  73 (defmethod sax:end-element ((handler combi-sink) uri lname qname)
  74   (with-slots (hax-target sax-target) handler
  75     (maybe-close-tag handler)
  76     (if (equal uri "")
  77         (sax:end-element hax-target *html* lname qname)
  78         (sax:end-element sax-target uri lname qname))))
  79
  80 (defmethod sax:end-document ((handler combi-sink))
  81   (hax:end-document (sink-hax-target handler)))
  82
  83 (defmethod sax:processing-instruction ((handler combi-sink) target data)
  84   (maybe-close-tag handler)
  85   (sax:processing-instruction (sink-hax-target handler) target data))
  86
  87 (defmethod sax:characters ((handler combi-sink) data)
  88   (maybe-close-tag handler)
  89   (sax:characters (sink-hax-target handler) data))
  90
  91 (defmethod sax:unescaped ((handler combi-sink) data)
  92   (maybe-close-tag handler)
  93   (sax:unescaped (sink-hax-target handler) data))
  94
  95 (defmethod sax:comment ((handler combi-sink) data)
  96   (maybe-close-tag handler)
  97   (sax:comment (sink-hax-target handler) data))