1 ;;; -*- show-trailing-whitespace: t; indent-tabs: nil -*-
3 ;;; Copyright (c) 2007 David Lichteblau. All rights reserved.
5 ;;; Redistribution and use in source and binary forms, with or without
6 ;;; modification, are permitted provided that the following conditions
9 ;;; * Redistributions of source code must retain the above copyright
10 ;;; notice, this list of conditions and the following disclaimer.
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.
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.
29 (in-package :cxml-stp-impl
)
32 (declaim (optimize (debug 2)))
37 (defgeneric data
(node)
39 "@arg[node]{a @class{comment}, @class{processing-instruction},
41 @return{a string of XML characters}
42 @short{Returns the node's data.}"))
44 (defgeneric (setf data
) (newval node
)
46 "@arg[newval]{a string of XML characters}
47 @arg[node]{a @class{comment}, @class{processing-instruction},
50 @short{Sets the node's data.}"))
52 (defun make-comment (data)
53 "@arg[data]{a string containing XML characters only}
54 @return{an @class{comment}}
55 @short{This function creates a comment node.}
57 @code{data} must not contain two consecutive dashes, or a dash
59 (let ((result (make-instance 'comment
)))
60 (setf (data result
) data
)
63 (defmethod copy ((node comment
))
64 (make-instance 'comment
:data
(data node
)))
66 (defmethod string-value ((node comment
))
69 (defmethod (setf data
) :around
(newval (node comment
))
70 (unless newval
(setf newval
""))
71 (unless (xml-characters-p newval
)
72 (stp-error "comment data includes characters that cannot be ~
73 represented in XML at all: ~S"
75 (when (search "--" newval
)
76 (stp-error "forbidden -- in comment"))
77 (when (alexandria:ends-with
#\- newval
)
78 (stp-error "- at end of comment"))
79 (call-next-method newval node
))
81 (defmethod serialize ((node comment
) handler
)
82 (sax:comment handler
(data node
)))
87 (defmethod slots-for-print-object append
((node comment
))
90 (defreader comment
(data)
91 (setf (data this
) data
))