hax.lisp

   1 ;;; -*- show-trailing-whitespace: t; indent-tabs: nil -*-
   2 ;;; ---------------------------------------------------------------------------
   3 ;;;     Title: An event API for the HTML parser, inspired by SAX
   4 ;;;   Created: 2007-10-14
   5 ;;;    Author: David Lichteblau
   6 ;;;   License: BSD
   7 ;;; ---------------------------------------------------------------------------
   8 ;;;  (c) copyright 2005,2007 David Lichteblau
   9
  10 ;;; Redistribution and use  in source and binary   forms, with or  without
  11 ;;; modification, are permitted provided that the following conditions are
  12 ;;; met:
  13 ;;;
  14 ;;; 1. Redistributions  of  source  code  must retain  the above copyright
  15 ;;;    notice, this list of conditions and the following disclaimer.
  16 ;;;
  17 ;;; 2. Redistributions in  binary form must reproduce  the above copyright
  18 ;;;    notice, this list of conditions and the following disclaimer in the
  19 ;;;    documentation and/or other materials provided with the distribution
  20 ;;;
  21 ;;; THIS  SOFTWARE   IS PROVIDED ``AS  IS''   AND ANY  EXPRESS  OR IMPLIED
  22 ;;; WARRANTIES, INCLUDING, BUT NOT LIMITED  TO, THE IMPLIED WARRANTIES  OF
  23 ;;; MERCHANTABILITY  AND FITNESS FOR A  PARTICULAR PURPOSE ARE DISCLAIMED.
  24 ;;; IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
  25 ;;; INDIRECT,  INCIDENTAL,  SPECIAL, EXEMPLARY,  OR CONSEQUENTIAL  DAMAGES
  26 ;;; (INCLUDING, BUT NOT LIMITED TO,   PROCUREMENT OF SUBSTITUTE GOODS   OR
  27 ;;; SERVICES;  LOSS OF  USE,  DATA, OR  PROFITS; OR BUSINESS INTERRUPTION)
  28 ;;; HOWEVER  CAUSED AND ON ANY THEORY  OF LIABILITY,  WHETHER IN CONTRACT,
  29 ;;; STRICT LIABILITY, OR  TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
  30 ;;; IN ANY WAY  OUT OF THE  USE OF THIS SOFTWARE,  EVEN IF ADVISED OF  THE
  31 ;;; POSSIBILITY OF SUCH DAMAGE.
  32
  33 (defpackage :hax
  34   (:use :common-lisp)
  35   (:export #:abstract-handler
  36            #:default-handler
  37
  38            #:make-attribute
  39            #:standard-attribute
  40            #:find-attribute
  41            #:attribute-name
  42            #:attribute-value
  43            #:attribute-specified-p
  44
  45            #:start-document
  46            #:start-element
  47            #:characters
  48            #:end-element
  49            #:end-document
  50            #:comment))
  51
  52 (in-package :hax)
  53
  54
  55 ;;;; ATTRIBUTE
  56
  57 (defgeneric attribute-name (attribute))
  58 (defgeneric attribute-value (attribute))
  59 (defgeneric attribute-specified-p (attribute))
  60
  61 (defclass standard-attribute ()
  62   ((name :initarg :name :accessor attribute-name)
  63    (value :initarg :value :accessor attribute-value)
  64    (specified-p :initarg :specified-p :accessor attribute-specified-p)))
  65
  66 (defun make-attribute (name value &optional (specified-p t))
  67   (make-instance 'standard-attribute
  68                  :name name
  69                  :value value
  70                  :specified-p specified-p))
  71
  72 (defun %rod= (x y)
  73   ;; allow rods *and* strings *and* null
  74   (cond
  75     ((zerop (length x)) (zerop (length y)))
  76     ((zerop (length y)) nil)
  77     ((stringp x) (string= x y))
  78     (t (runes:rod= x y))))
  79
  80 (defun find-attribute (name attrs)
  81   (find name attrs :key #'attribute-name :test #'%rod=))
  82
  83
  84 ;;;; ABSTRACT-HANDLER and DEFAULT-HANDLER
  85
  86 (defclass abstract-handler () ())
  87 (defclass default-handler (abstract-handler) ())
  88
  89 (defgeneric start-document (handler name public-id system-id)
  90   (:method ((handler null) name public-id system-id)
  91     (declare (ignore name public-id system-id))
  92     nil)
  93   (:method ((handler default-handler) name public-id system-id)
  94     (declare (ignore name public-id system-id))
  95     nil))
  96
  97 (defgeneric start-element (handler name attributes)
  98   (:method ((handler null) name attributes)
  99     (declare (ignore name attributes))
 100     nil)
 101   (:method ((handler default-handler) name attributes)
 102     (declare (ignore name attributes))
 103     nil))
 104
 105 (defgeneric characters (handler data)
 106   (:method ((handler null) data)
 107     (declare (ignore data))
 108     nil)
 109   (:method ((handler default-handler) data)
 110     (declare (ignore data))
 111     nil))
 112
 113 (defgeneric end-element (handler name)
 114   (:method ((handler null) name)
 115     (declare (ignore name))
 116     nil)
 117   (:method ((handler default-handler) name)
 118     (declare (ignore name))
 119     nil))
 120
 121 (defgeneric end-document (handler)
 122   (:method ((handler null)) nil)
 123   (:method ((handler default-handler)) nil))
 124
 125 (defgeneric comment (handler data)
 126   (:method ((handler null) data)
 127     (declare (ignore data))
 128     nil)
 129   (:method ((handler default-handler) data)
 130     (declare (ignore data))
 131     nil))