[cxml-cvs] CVS update: cxml/xml/xml-parse.lisp
David Lichteblau
dlichteblau at common-lisp.net
Sat Nov 26 22:15:11 UTC 2005
Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv15327/xml
Modified Files:
xml-parse.lisp
Log Message:
trailing whitespace weg
Date: Sat Nov 26 23:15:10 2005
Author: dlichteblau
Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.7 cxml/xml/xml-parse.lisp:1.8
--- cxml/xml/xml-parse.lisp:1.7 Sat Nov 26 22:48:25 2005
+++ cxml/xml/xml-parse.lisp Sat Nov 26 23:15:10 2005
@@ -23,8 +23,8 @@
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
-;;; License along with this library; if not, write to the
-;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307 USA.
;;; Streams
@@ -83,7 +83,7 @@
;; :#fixed
;; :#pcdata
;; :s
-;; :\[ :\] :\( :\) :|\ :\> :\" :\' :\, :\? :\* :\+
+;; :\[ :\] :\( :\) :|\ :\> :\" :\' :\, :\? :\* :\+
;; *data-behaviour* = :DOC
;;
@@ -96,7 +96,7 @@
;;; NOTES
;;
;; Stream buffers as well as RODs are supposed to be encoded in
-;; UTF-16.
+;; UTF-16.
;; where does the time go?
;; DATA-RUNE-P
@@ -105,7 +105,7 @@
;; CLOSy DOM
;; UTF-8 decoder (13%)
;; READ-ATTVAL (10%)
-;;
+;;
;;; TODO
;;
@@ -153,7 +153,7 @@
;;
;; o merge node representation with SGML module
;; [???]
-;;
+;;
;; o line/column number recording
;;
;; o better error messages
@@ -294,7 +294,7 @@
;; respectively. If there are not enough bytes in `input' to decode a
;; full character, decoding shold be abandomed; the caller has to
;; ensure that the remaining bytes of `input' are passed to the
-;; decoder again with more bytes appended.
+;; decoder again with more bytes appended.
;;
;; `eof-p' now in turn indicates, if the given input sequence, is all
;; the producer does have and might be used to produce error messages
@@ -319,9 +319,9 @@
;; Let us first define fast fixnum arithmetric get rid of type
;; checks. (After all we know what we do here).
-(defmacro fx-op (op &rest xs)
+(defmacro fx-op (op &rest xs)
`(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))))
-(defmacro fx-pred (op &rest xs)
+(defmacro fx-pred (op &rest xs)
`(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))
(defmacro %+ (&rest xs) `(fx-op + , at xs))
@@ -342,9 +342,9 @@
;;; XXX Geschwindigkeit dieser Definitionen untersuchen!
-(defmacro rune-op (op &rest xs)
+(defmacro rune-op (op &rest xs)
`(code-rune (,op ,@(mapcar (lambda (x) `(rune-code ,x)) xs))))
-(defmacro rune-pred (op &rest xs)
+(defmacro rune-pred (op &rest xs)
`(,op ,@(mapcar (lambda (x) `(rune-code ,x)) xs)))
(defmacro %rune+ (&rest xs) `(rune-op + , at xs))
@@ -370,7 +370,7 @@
;;; make-rod-hashtable
;;; rod-hash-get hashtable rod &optional start end -> value ; successp
;;; (setf (rod-hash-get hashtable rod &optional start end) new-value
-;;;
+;;;
(defstruct (rod-hashtable (:constructor make-rod-hashtable/low))
size ;size of table
@@ -554,8 +554,8 @@
(,i 0)
(,b ,scratch))
(declare (type fixnum ,n ,i))
- (macrolet
- ((,collect (x)
+ (macrolet
+ ((,collect (x)
`((lambda (x)
(locally
(declare #.*fast*)
@@ -575,7 +575,7 @@
`(let ((,rod (make-rod ,i)))
(while (not (%= ,i 0))
(setf ,i (%- ,i 1))
- (setf (%rune ,rod ,i)
+ (setf (%rune ,rod ,i)
(aref (the (simple-array rune (*)) ,b) ,i)))
,rod))
(:raw
@@ -590,8 +590,8 @@
`(let ((,n (length ,scratch))
(,i 0))
(declare (type fixnum ,n ,i))
- (macrolet
- ((,collect (x)
+ (macrolet
+ ((,collect (x)
`((lambda (x)
(locally
(declare #.*fast*)
@@ -611,7 +611,7 @@
`(let ((,rod (make-rod ,i)))
(while (%> ,i 0)
(setf ,i (%- ,i 1))
- (setf (%rune ,rod ,i)
+ (setf (%rune ,rod ,i)
(aref (the (simple-array rune (*)) ,scratch) ,i)))
,rod))
(:raw
@@ -670,14 +670,21 @@
;;;; DTD
;;;;
-(define-condition parser-error (simple-error) ())
-(define-condition validity-error (parser-error) ())
+(define-condition parse-error (simple-error) ())
+(define-condition well-formedness-violation (parse-error) ())
+(define-condition end-of-xstream (well-formedness-violation) ())
+(define-condition validity-error (parse-error) ())
(defun validity-error (x &rest args)
(error 'validity-error
:format-control "Validity constraint violated: ~@?"
:format-arguments (list x args)))
+(defun wf-error (x &rest args)
+ (error 'well-formedness-violation
+ :format-control "Validity constraint violated: ~@?"
+ :format-arguments (list x args)))
+
(defvar *validate* t)
(defvar *markup-declaration-external-p* nil)
@@ -768,7 +775,7 @@
(defun validate-attribute* (ctx adef value)
(let ((type (attdef-type adef))
- (default (attdef-default adef)))
+ (default (attdef-default adef)))
(when (and (listp default)
(eq (car default) :FIXED)
(not (rod= value (cadr default))))
@@ -921,7 +928,7 @@
;; `zstream' is for error messages
(let ((def (get-entity-definition entity-name kind (dtd *ctx*))))
(unless def
- (if zstream
+ (if zstream
(perror zstream "Entity '~A' is not defined." (rod-string entity-name))
(error "Entity '~A' is not defined." (rod-string entity-name))))
(let (r)
@@ -1145,7 +1152,7 @@
(defun peek-token (input)
(cond ((zstream-token-category input)
- (values
+ (values
(zstream-token-category input)
(zstream-token-semantic input)))
(t
@@ -1224,7 +1231,7 @@
(t
(error "Unexpected character ~S." c))))
(:DOC
- (cond
+ (cond
((rune= c #/&)
(multiple-value-bind (kind data) (read-entity-ref input)
(cond ((eq kind :NAMED)
@@ -1450,7 +1457,7 @@
(assert (rune= c #/\;))
(ecase mode
(:ATT
- (recurse-on-entity
+ (recurse-on-entity
zinput name :general
(lambda (zinput)
(muffle (car (zstream-input-stack zinput))
@@ -1471,7 +1478,7 @@
(setf c (read-rune input))
(assert (rune= c #/\;))
(cond (*expand-pe-p*
- (recurse-on-entity
+ (recurse-on-entity
zinput name :parameter
(lambda (zinput)
(muffle (car (zstream-input-stack zinput))
@@ -1560,8 +1567,8 @@
(unless (data-rune-p d)
(error "Illegal char: ~S." d))
(when (rune= d #/>) (return))
- (when (rune= d #/?)
- (collect #/?)
+ (when (rune= d #/?)
+ (collect #/?)
(go state-2))
(collect #/?)
(collect d)
@@ -1659,7 +1666,7 @@
(when (rune= d #/\]) (go state-2))
(collect d)
(go state-1)
-
+
state-2 ;; #/\] seen
(setf d (peek-rune input))
(when (or (eq d :eof) (rune= d #/<) (rune= d #/&))
@@ -1672,7 +1679,7 @@
(collect #/\])
(collect d)
(go state-1)
-
+
state-3 ;; #/\] #/\] seen
(setf d (peek-rune input))
(when (or (eq d :eof) (rune= d #/<) (rune= d #/&))
@@ -1682,7 +1689,7 @@
(read-rune input)
(unless (data-rune-p d)
(error "Illegal char: ~S." d))
- (when (rune= d #/>)
+ (when (rune= d #/>)
(error "For no apparent reason ']]>' in not allowed in a CharData token -- you lost."))
(when (rune= d #/\])
(collect #/\])
@@ -1848,14 +1855,14 @@
(defun p/default-decl (input)
;; [60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED'
;; | (('#FIXED' S)? AttValue) /* VC: Required Attribute */
- ;;
+ ;;
;; /* VC: Attribute Default Legal */
;; /* WFC: No < in Attribute Values */
;; /* VC: Fixed Attribute Default */
(multiple-value-bind (cat sem) (peek-token input)
- (cond ((eq cat :|#REQUIRED|)
+ (cond ((eq cat :|#REQUIRED|)
(consume-token input) :REQUIRED)
- ((eq cat :|#IMPLIED|)
+ ((eq cat :|#IMPLIED|)
(consume-token input) :IMPLIED)
((eq cat :|#FIXED|)
(consume-token input)
@@ -2173,10 +2180,10 @@
((and (walk (car x))
(walk (cdr x)))))))
(walk cspec))))
-
+
;; wir fahren besser, wenn wir machen:
-;; cspec ::= 'EMPTY' | 'ANY' | '#PCDATA'
+;; cspec ::= 'EMPTY' | 'ANY' | '#PCDATA'
;; | Name
;; | cs
;; cs ::= '(' S? cspec ( S? '|' S? cspec)* S? ')' ('?' | '*' | '+')?
@@ -2186,8 +2193,8 @@
(let ((term
(let ((names nil) op-cat op res stream)
(multiple-value-bind (cat sem) (peek-token input)
- (cond ((eq cat :name)
- (consume-token input)
+ (cond ((eq cat :name)
+ (consume-token input)
(cond ((rod= sem '#.(string-rod "EMPTY"))
:EMPTY)
((rod= sem '#.(string-rod "ANY"))
@@ -2247,14 +2254,14 @@
(trivialp (cadr cspec)))))
:PCDATA
cspec)))
-
+
;; [52] AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>'
-
+
;; [52] AttlistDecl ::= '<!ATTLIST' S Name AttDefs S? '>'
;; [52] AttlistDecl ::= '<!ATTLIST' S Name S? '>'
;; [53] AttDefs ::= S Name S AttType S DefaultDecl AttDefs
-;; [53] AttDefs ::=
+;; [53] AttDefs ::=
(defun p/notation-decl (input)
(let (name id)
@@ -2381,7 +2388,7 @@
(defun p/markup-decl-unsafe (input)
;; markupdecl ::= elementdecl | AttlistDecl /* VC: Proper Declaration/PE Nesting */
- ;; | EntityDecl | NotationDecl
+ ;; | EntityDecl | NotationDecl
;; | PI | Comment /* WFC: PEs in Internal Subset */
(case (peek-token input)
(:|<!ELEMENT| (p/element-decl input))
@@ -2530,7 +2537,7 @@
(:COMMENT
(sax:comment (handler *ctx*) (nth-value 1 (peek-token input))))
(:PI
- (sax:processing-instruction
+ (sax:processing-instruction
(handler *ctx*)
(car (nth-value 1 (peek-token input)))
(cdr (nth-value 1 (peek-token input))))))
@@ -2598,10 +2605,10 @@
(unless v
(validity-error "(11) IDREF: ~S not defined" (rod-string k))))
(id-table *ctx*))
-
- (dolist (name (referenced-notations *ctx*))
+
+ (dolist (name (referenced-notations *ctx*))
(unless (find-notation name (dtd *ctx*))
- (validity-error "(23) Notation Declared: ~S" (rod-string name)))))
+ (validity-error "(23) Notation Declared: ~S" (rod-string name)))))
(sax:end-document handler))))
(defun p/element (input)
@@ -2698,7 +2705,7 @@
(p/content input))))
((:<!\[)
(consume-token input)
- (cons
+ (cons
(let ((input (car (zstream-input-stack input))))
(unless (and (rune= #/C (read-rune input))
(rune= #/D (read-rune input))
@@ -2749,7 +2756,7 @@
(unless (eq (peek-rune i) :eof)
(error "Garbage at end of XML PI."))
;; versioninfo muss da sein
- ;; dann ? encodingdecl
+ ;; dann ? encodingdecl
;; dann ? sddecl
;; dann ende
(when (and (not (eq (caar atts) (intern-name '#.(string-rod "version"))))
@@ -2793,7 +2800,7 @@
(error "Hypersensitivity pitfall: ~
XML PI's 'standalone' attribute must be exactly \"yes\" or \"no\" and not ~S."
(rod-string (cdar atts))))
- (setf (xml-header-standalone-p res)
+ (setf (xml-header-standalone-p res)
(if (rod-equal '#.(string-rod "yes") (cdar atts))
:yes
:no))
@@ -2802,7 +2809,7 @@
(error "XML designers decided to disallow future extensions to the set ~
of allowed XML PI's attributes -- you might have lost big on ~S (~S)"
(rod-string content) sd-ok-p
- ))
+ ))
res))
;;;; ---------------------------------------------------------------------------
@@ -2847,7 +2854,7 @@
(dolist (pair pairs)
(if first
(setf first nil)
- (write-char #\& s))
+ (write-char #\& s))
(write-string (escape (car pair)) s)
(write-char #\= s)
(write-string (escape (cdr pair)) s))))))
@@ -2949,7 +2956,7 @@
(defun parse-stream (stream handler &rest args)
(let ((xstream
- (make-xstream
+ (make-xstream
stream
:name (make-stream-name
:entity-name "main document"
@@ -3062,7 +3069,7 @@
(defparameter *test-files*
'(;;"jclark:xmltest;not-wf;*;*.xml"
- "jclark:xmltest;valid;*;*.xml"
+ "jclark:xmltest;valid;*;*.xml"
;;"jclark:xmltest;invalid;*.xml"
))
@@ -3089,7 +3096,7 @@
(negative-test-file filename))))
(defun positive-test-file (filename out-filename)
- (multiple-value-bind (nodes condition)
+ (multiple-value-bind (nodes condition)
(ignore-errors (parse-file filename))
(cond (condition
(warn "**** Error in ~S: ~A." filename condition)
@@ -3122,7 +3129,7 @@
t)))))))
(defun negative-test-file (filename)
- (multiple-value-bind (nodes condition)
+ (multiple-value-bind (nodes condition)
(ignore-errors (parse-file filename))
(declare (ignore nodes))
(cond (condition
@@ -3214,17 +3221,17 @@
(t
we continue
(sf rptr (%+ rptr 1))) ))
- , at body ))
+ , at body ))
||#
;(defun read-data-until (predicate input continuation)
; )
(defmacro read-data-until* ((predicate input res res-start res-end) &body body)
- "Read data from `input' until `predicate' applied to the read char
+ "Read data from `input' until `predicate' applied to the read char
turns true. Then execute `body' with `res', `res-start', `res-end'
bound to denote a subsequence (of RUNEs) containing the read portion.
- The rune upon which `predicate' turned true is neither consumed from
+ The rune upon which `predicate' turned true is neither consumed from
the stream, nor included in `res'.
Keep the predicate short, this it may be included more than once into
@@ -3234,11 +3241,11 @@
(collect (gensym))
(c (gensym)))
`(LET ((,input-var ,input))
- (MULTIPLE-VALUE-BIND (,res ,res-start ,res-end)
+ (MULTIPLE-VALUE-BIND (,res ,res-start ,res-end)
(WITH-RUNE-COLLECTOR/RAW (,collect)
(LOOP
(LET ((,c (PEEK-RUNE ,input-var)))
- (COND ((EQ ,c :EOF)
+ (COND ((EQ ,c :EOF)
;; xxx error message
(RETURN))
((FUNCALL ,predicate ,c)
@@ -3248,11 +3255,11 @@
(CONSUME-RUNE ,input-var))))))
(LOCALLY
, at body)))))
-
+
(defun read-name-token (input)
(read-data-until* ((lambda (rune)
(declare (type rune rune))
- (not (name-rune-p rune)))
+ (not (name-rune-p rune)))
input
r rs re)
(intern-name r rs re)))
@@ -3308,7 +3315,7 @@
(let ((name (read-name-token input)))
(setf c (read-rune input))
(assert (rune= c #/\;))
- (recurse-on-entity
+ (recurse-on-entity
zinput name :general
(lambda (zinput)
(muffle (car (zstream-input-stack zinput)))))))))
@@ -3325,7 +3332,7 @@
(t
(collect c)))))))
(declare (dynamic-extent #'muffle))
- (recurse-on-entity
+ (recurse-on-entity
zinput name :general
(lambda (zinput)
(muffle (car (zstream-input-stack zinput))))) ))))
@@ -3385,7 +3392,7 @@
'((#"" . nil)
(#"xmlns" . #"http://www.w3.org/2000/xmlns/")
(#"xml" . #"http://www.w3.org/XML/1998/namespace")))
-
+
;; We already know that name is part of a valid XML name, so all we
;; have to check is that the first rune is a name-start-rune and that
;; there is not colon in it.
@@ -3403,7 +3410,7 @@
(values prefix local-name)
(error "~S is not a valid NcName." local-name)))
(values () qname))))
-
+
(defun decode-qname (qname)
"decode-qname name => namespace-uri, prefix, local-name"
(declare (type runes:simple-rod qname))
@@ -3509,7 +3516,7 @@
(let (attributes)
(dolist (pair attr-alist)
(push (build-attribute (car pair) (cdr pair) t) attributes))
-
+
;; 5.3 Uniqueness of Attributes
;; In XML documents conforming to [the xmlns] specification, no
;; tag may contain two attributes which:
@@ -3532,7 +3539,7 @@
(error "Multiple definitions of attribute ~S in namespace ~S."
(mu (sax:attribute-local-name attr-1))
(mu (sax:attribute-namespace-uri attr-1))))))))
-
+
(defun build-attribute (name value specified-p)
(multiple-value-bind (prefix local-name) (split-qname name)
(declare (ignorable local-name))
@@ -3549,25 +3556,6 @@
:namespace-uri uri
:local-name local-name
:specified-p specified-p)))))
-
-;;; Faster constructors
-
-;; Since using the general DOM interface to construct the parsed trees
-;; may turn out to be quite expensive (That depends on the underlying
-;; DOM implementation). A particular DOM implementation may choose to
-;; implement an XML:FAST-CONSTRUCTORS method:
-
-;; XML:FAST-CONSTRUCTORS document [method]
-;;
-;; Return an alist of constructors suitable for the document `document'.
-;;
-;; (:MAKE-TEXT document parent data)
-;; (:MAKE-PROCESSING-INSTRUCTION document parent target content)
-;; (:MAKE-NODE document parent attributes content)
-;; [`attributes' now in turn is an alist]
-;; (:MAKE-CDATA document parent data)
-;; (:MAKE-COMMENT document parent data)
-;;
;;;;;;;;;;;;;;;;;
@@ -3592,18 +3580,8 @@
;; `base' yielding an absolute system identifier suitable for
;; OPEN-SYS-ID.
-;; xstream Controller Protocol
-;;
-;;
-
-
-#||
-(defun xml-parse (system-id &key document standalone-p)
- )
-||#
;;;;;;;;;;;;;;;;;
-
;;; SAX validation handler
(defclass validator ()
More information about the Cxml-cvs
mailing list