xml/recoder.lisp

   1 ;;;; recoder.lisp -- SAX handler for string conversion
   2 ;;;;
   3 ;;;; This file is part of the CXML parser, released under Lisp-LGPL.
   4 ;;;; See file COPYING for details.
   5 ;;;;
   6 ;;;; Developed 2004 for headcraft - http://headcraft.de/
   7 ;;;; Copyright: David Lichteblau
   8
   9 (in-package :cxml)
  10
  11 (defclass recoder ()
  12     ((recoder :initarg :recoder :accessor recoder)
  13      (chained-handler :initarg :chained-handler :accessor chained-handler)))
  14
  15 (defun make-recoder (chained-handler recoder-fn)
  16   (make-instance 'recoder
  17     :recoder recoder-fn
  18     :chained-handler chained-handler))
  19
  20 (macrolet ((%string (rod)
  21              `(let ((rod ,rod))
  22                 (if (typep rod '(or rod string))
  23                     (funcall (recoder handler) rod)
  24                     rod)))
  25            (defwrapper (name (&rest args) &rest forms)
  26              `(defmethod ,name ((handler recoder) ,@args)
  27                 (,name (chained-handler handler) ,@forms))))
  28   (defwrapper sax:start-document ())
  29
  30   (defwrapper sax:start-element
  31       (namespace-uri local-name qname attributes)
  32     (%string namespace-uri)
  33     (%string local-name)
  34     (%string qname)
  35     (mapcar (lambda (attr)
  36               (sax:make-attribute
  37                :namespace-uri (%string (sax:attribute-namespace-uri attr))
  38                :local-name (%string (sax:attribute-local-name attr))
  39                :qname (%string (sax:attribute-qname attr))
  40                :value (%string (sax:attribute-value attr))
  41                :specified-p (sax:attribute-specified-p attr)))
  42             attributes))
  43
  44   (defwrapper sax:start-prefix-mapping (prefix uri)
  45     (%string prefix)
  46     (%string uri))
  47
  48   (defwrapper sax:characters (data)
  49     (%string data))
  50
  51   (defwrapper sax:processing-instruction (target data)
  52     (%string target)
  53     (%string data))
  54
  55   (defwrapper sax:end-prefix-mapping (prefix)
  56     (%string prefix))
  57
  58   (defwrapper sax:end-element (namespace-uri local-name qname)
  59     (%string namespace-uri)
  60     (%string local-name)
  61     (%string qname))
  62
  63   (defwrapper sax:end-document ())
  64
  65   (defwrapper sax:comment (data)
  66     (%string data))
  67
  68   (defwrapper sax:start-cdata ())
  69
  70   (defwrapper sax:end-cdata ())
  71
  72   (defwrapper sax:start-dtd (name public-id system-id)
  73     (%string name)
  74     (%string public-id)
  75     (%string system-id))
  76
  77   (defwrapper sax:start-internal-subset ())
  78   (defwrapper sax:end-internal-subset ())
  79
  80   (defwrapper sax:end-dtd ())
  81
  82   (defwrapper sax:unparsed-entity-declaration
  83       (name public-id system-id notation-name)
  84     (%string name)
  85     (%string public-id)
  86     (%string system-id)
  87     (%string notation-name))
  88
  89   (defwrapper sax:external-entity-declaration
  90       (kind name public-id system-id)
  91     (%string kind)
  92     (%string name)
  93     (%string public-id)
  94     (%string system-id))
  95
  96   (defwrapper sax:internal-entity-declaration
  97       (kind name value)
  98     kind
  99     (%string name)
 100     (%string value))
 101
 102   (defwrapper sax:notation-declaration
 103       (name public-id system-id)
 104     (%string name)
 105     (%string public-id)
 106     (%string system-id))
 107
 108   (defwrapper sax:element-declaration (name model)
 109     (%string name)
 110     model)
 111
 112   (defwrapper sax:attribute-declaration
 113       (element-name attribute-name type default)
 114     (%string element-name)
 115     (%string attribute-name)
 116     (%string type)
 117     (%string default))
 118
 119   (defwrapper sax:entity-resolver
 120       (resolver)
 121     resolver)
 122
 123   (defwrapper sax::dtd
 124       (dtd)
 125     dtd))