xml/sax-proxy.lisp

   1 ;;;; sax-proxy.lisp
   2 ;;;;
   3 ;;;; This file is part of the CXML parser, released under Lisp-LGPL.
   4 ;;;; See file COPYING for details.
   5 ;;;;
   6 ;;;; Copyright (c) 2004 David Lichteblau
   7 ;;;; Author: David Lichteblau
   8
   9 (in-package :cxml)
  10
  11 (defclass broadcast-handler (sax:abstract-handler)
  12   ((handlers :initform nil
  13              :initarg :handlers
  14              :accessor broadcast-handler-handlers))
  15   (:documentation
  16    "A SAX handler which passes every event it receives on to each of several
  17     chained handlers, somewhat similar to the way a @foo{broadcast-stream}
  18     works.
  19
  20     You can subclass @foo{broadcast-handler} to modify the events
  21     before they are being passed on.  Define methods on your handler
  22     class for the events to be modified.  All other events will pass
  23     through to the chained handlers unmodified.
  24
  25     Broadcast handler functions return the result of calling the event
  26     function on the last handler in the list.  In particular,
  27     the overall result from @foo{sax:end-document} will be ignored
  28     for all other handlers.
  29
  30     @see-slot{broadcast-handler-handlers}"))
  31
  32 (setf (documentation #'broadcast-handler-handlers 'function)
  33       "@arg[instance]{A @class{broadcast-handler}}
  34        @return{A list of @class{SAX handler}s.}
  35
  36        Returns the list of SAX handlers that arechained to this broadcast
  37        handler.")
  38
  39 (defun make-broadcast-handler (&rest handlers)
  40   "@arg[handlers]{A list of @class{SAX handler}s.}
  41    @return{A @class{broadcast-handler}.}
  42
  43    Creates a SAX handler which passes every event it receives on to each
  44    handler specified as an argument to this function.
  45
  46    See @class{broadcast-handler} for details. "
  47   (make-instance 'broadcast-handler :handlers handlers))
  48
  49 (defclass sax-proxy (broadcast-handler)
  50   ()
  51   (:documentation
  52    "@class{sax-proxy} is a subclass of @class{broadcast-handler} which
  53     sends events to exactly one chained handler.
  54
  55     This class is still included for compatibility with older versions of
  56     CXML which did not include the more general @class{broadcast-handler}
  57     yet, but has been retrofitted as a subclass of the latter.
  58
  59     @see-slot{proxy-chained-handler}"))
  60
  61 (defmethod initialize-instance
  62     :after ((instance sax-proxy) &key chained-handler)
  63   (setf (proxy-chained-handler instance) chained-handler))
  64
  65 (defmethod proxy-chained-handler ((instance sax-proxy))
  66   "@arg[instance]{A @class{sax-proxy}.}
  67    @return{A @class{SAX handler}s.}
  68
  69    Returns the SAX handler that is chained to this SAX proxy."
  70   (car (broadcast-handler-handlers instance)))
  71
  72 (defmethod (setf proxy-chained-handler) (newval (instance sax-proxy))
  73   (setf (broadcast-handler-handlers instance) (list newval)))
  74
  75 #-rune-is-character
  76 (defmethod hax:%want-strings-p ((handler broadcast-handler))
  77   (hax:%want-strings-p (car (broadcast-handler-handlers instance))))
  78
  79 (macrolet ((define-proxy-method (name (&rest args))
  80              `(defmethod ,name ((handler broadcast-handler) ,@args)
  81                 (let (result)
  82                   (dolist (next (broadcast-handler-handlers handler))
  83                     (setf result (,name next ,@args)))
  84                   result))))
  85   (define-proxy-method sax:start-document ())
  86   (define-proxy-method sax:start-element (uri lname qname attributes))
  87   (define-proxy-method sax:start-prefix-mapping (prefix uri))
  88   (define-proxy-method sax:characters (data))
  89   (define-proxy-method sax:unescaped (data))
  90   (define-proxy-method sax:processing-instruction (target data))
  91   (define-proxy-method sax:end-prefix-mapping (prefix))
  92   (define-proxy-method sax:end-element (namespace-uri local-name qname))
  93   (define-proxy-method sax:end-document ())
  94   (define-proxy-method sax:comment (data))
  95   (define-proxy-method sax:start-cdata ())
  96   (define-proxy-method sax:end-cdata ())
  97   (define-proxy-method sax:start-dtd (name public-id system-id))
  98   (define-proxy-method sax:end-dtd ())
  99   (define-proxy-method sax:start-internal-subset ())
 100   (define-proxy-method sax:end-internal-subset ())
 101   (define-proxy-method sax:unparsed-entity-declaration (name pub sys not))
 102   (define-proxy-method sax:external-entity-declaration (kind name pub sys))
 103   (define-proxy-method sax:internal-entity-declaration (kind name value))
 104   (define-proxy-method sax:notation-declaration (name public-id system-id))
 105   (define-proxy-method sax:element-declaration (name model))
 106   (define-proxy-method sax:attribute-declaration (elt attr type default))
 107   (define-proxy-method sax:entity-resolver (resolver))
 108   (define-proxy-method sax::dtd (dtd)))
 109
 110 (defmethod sax:register-sax-parser :after ((handler broadcast-handler) parser)
 111   (dolist (next (broadcast-handler-handlers handler))
 112     (sax:register-sax-parser next parser)))