classes.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 :cxml-stp-impl)
  30
  31 #+sbcl
  32 (declaim (optimize (debug 2)))
  33
  34 (defclass named-node-mixin ()
  35   ((local-name :reader local-name :accessor %local-name)
  36    (prefix :initform nil
  37            :reader namespace-prefix
  38            :accessor %namespace-prefix)
  39    (namespace-uri :initform nil
  40                   :reader namespace-uri
  41                   :accessor %namespace-uri)))
  42
  43 (defclass attribute (leaf-node named-node-mixin)
  44   ((value :accessor value))
  45   (:documentation
  46    "@short{Instances of this class represent attributes of an @class{element},
  47     excluding namespace declarations.}
  48
  49     The @fun{parent} of an attribute is always an @class{element} or nil,
  50     but the attribute is not a child of that element.
  51
  52     @see-slot{local-name}
  53     @see-slot{namespace-prefix}
  54     @see-slot{namespace-uri}
  55     @see-slot{qualified-name}
  56     @see-slot{value}
  57     @see{list-attributes}
  58     @see-constructor{make-attribute}"))
  59
  60 (defclass comment (leaf-node)
  61   ((data :initarg :data :accessor data))
  62   (:documentation
  63    "Instances of this class represent XML comments.
  64     @see-slot{data}
  65     @see-constructor{make-comment}"))
  66
  67 (defclass cxml-stp:document-type (leaf-node)
  68   ((root-element-name :accessor root-element-name)
  69    (system-id :initform nil :accessor system-id)
  70    (public-id :initform nil :accessor public-id)
  71    (internal-subset :initform nil :accessor internal-subset)
  72    (dtd :initform nil :accessor dtd))
  73   (:documentation
  74    "@short{Instances of this class represent the DOCTYPE declaration at the
  75     beginning of a document.}
  76
  77     The document type is an optional child of a @class{document}.  At most
  78     one document type is allowed, and it must precede the document element.
  79
  80     Since STP checks well-formedness only, not validity, the document type
  81     only declares what DTD the document claims to be conforming to, but
  82     does not guarantee that it actually does.
  83
  84     @see-constructor{make-document-type}
  85     @see-slot{root-element-name}
  86     @see-slot{system-id}
  87     @see-slot{public-id}
  88     @see-slot{internal-subset}"))
  89 (setf (find-class 'document-type) (find-class 'cxml-stp:document-type))
  90 #+clozure (deftype document-type () 'cxml-stp:document-type)
  91
  92 (defclass cxml-stp:document (parent-node) ()
  93   (:documentation
  94    "@short{Instances of this class represent an entire XML document.}
  95
  96     A document may have at most one document-type, and must have exactly one
  97     element as a child (in this order).
  98
  99     It may also have comments and processing-instructions anywhere.
 100
 101     @see-constructor{make-document}
 102     @see-slot{document-element}
 103     @see-slot{document-type}"))
 104 (setf (find-class 'document) (find-class 'cxml-stp:document))
 105 #+clozure (deftype document () (find-class 'cxml-stp:document))
 106
 107 (defclass element (parent-node named-node-mixin)
 108   ((attributes :initform nil :accessor %attributes)
 109    (namespaces :initform nil :accessor %namespaces))
 110   (:documentation
 111    "@short{Instances of this class represent XML elements with their attributes
 112     and namespaces.}
 113
 114     See @class{node} for functions to query the list of children.
 115
 116     See @class{parent-node} for functions to add or remove children.
 117
 118     @see-slot{local-name}
 119     @see-slot{namespace-prefix}
 120     @see-slot{namespace-uri}
 121     @see-slot{qualified-name}
 122     @see{add-attribute}
 123     @see{remove-attribute}
 124     @see{find-attribute-named}
 125     @see{find-attribute-if}
 126     @see{with-attributes}
 127     @see{list-attributes}
 128     @see{map-attributes}
 129     @see{attribute-value}
 130     @see{find-namespace}
 131     @see{find-attribute-namespace}
 132     @see{find-local-namespace}
 133     @see{find-extra-namespace}
 134     @see{add-extra-namespace}
 135     @see{remove-extra-namespace}
 136     @see{map-extra-namespaces}
 137    @see-constructor{make-element}"))
 138
 139 (defclass leaf-node (node) ())
 140
 141 (defclass node ()
 142   ((parent :initform nil :reader parent :writer (setf %parent)))
 143   (:documentation
 144    "@short{The superclass of all nodes.}
 145
 146     Although only @class{document} and @class{element} allow children,
 147     read-only functions accessing the list of children are available for
 148     all nodes and always return zero children for other classes.
 149
 150     @see-slot{parent}
 151     @see-slot{base-uri}
 152     @see{document}
 153     @see{root}
 154     @see{detach}
 155     @see{copy}
 156     @see{serialize}
 157     @see{map-children}
 158     @see{do-children}
 159     @see{list-children}
 160     @see{first-child}
 161     @see{last-child}
 162     @see{nth-child}
 163     @see{previous-sibling}
 164     @see{next-sibling}
 165     @see{count-children}
 166     @see{find-child}
 167     @see{child-position}
 168     @see{count-children-if}
 169     @see{find-child-if}
 170     @see{child-position-if}
 171     @see{filter-children}
 172     @see{map-recursively}
 173     @see{do-recursively}
 174     @see{find-recursively}
 175     @see{filter-recursively}"))
 176
 177 (defclass parent-node (node)
 178   ((%base-uri :initform nil)
 179    (%children :initform nil :accessor %children))
 180   (:documentation
 181    "@short{Instances of this class can have children.}
 182
 183     See @class{node} for functions to query the list of children without
 184     changing it.
 185
 186     @see{prepend-child}
 187     @see{append-child}
 188     @see{delete-nth-child}
 189     @see{delete-child}
 190     @see{insert-child-before}
 191     @see{insert-child-after}
 192     @see{replace-child}
 193     @see{insert-child}
 194     @see{delete-child-if}
 195     @see{replace-children}"))
 196
 197 (defclass processing-instruction (leaf-node)
 198   ((target :initarg :target :accessor target)
 199    (data :initarg :data :accessor data))
 200   (:documentation
 201    "Instances of this class represent processing instructions.
 202     @see-slot{target}
 203     @see-slot{data}
 204     @see-constructor{make-processing-instruction}"))
 205
 206 (defclass text (leaf-node)
 207   ((data :initarg :data :accessor data))
 208   (:documentation
 209    "Instances of this class represent text nodes.
 210     @see-slot{data}
 211     @see-constructor{make-text}"))