Update of /project/cxml/cvsroot/cxml/xml In directory common-lisp.net:/tmp/cvs-serv16321/xml Modified Files: xml-parse.lisp Log Message: mein lieblingsfehler! error while parsing arguments to DESTRUCTURING-BIND: invalid number of elements in () to satisfy lambda list (CXML::NAME &REST CXML::ATTRS): at least 1 expected, but 0 found Date: Sun Nov 27 13:56:56 2005 Author: dlichteblau Index: cxml/xml/xml-parse.lisp diff -u cxml/xml/xml-parse.lisp:1.27 cxml/xml/xml-parse.lisp:1.28 --- cxml/xml/xml-parse.lisp:1.27 Sun Nov 27 13:43:29 2005 +++ cxml/xml/xml-parse.lisp Sun Nov 27 13:56:56 2005 @@ -2596,37 +2596,41 @@ (defun p/element-ns (input) - (destructuring-bind (cat (name &rest attrs)) - (multiple-value-list (read-token input)) - (validate-start-element *ctx* name) - (let ((ns-decls (declare-namespaces name attrs))) - (multiple-value-bind (ns-uri prefix local-name) (decode-qname name) - (declare (ignore prefix)) - (let* ((raw-attlist (build-attribute-list-ns attrs)) - (attlist - (remove-if-not (lambda (a) - (or sax:*include-xmlns-attributes* - (not (xmlns-attr-p (sax:attribute-qname a))))) - (process-attributes *ctx* name raw-attlist)))) - (cond ((eq cat :ztag) - (sax:start-element (handler *ctx*) ns-uri local-name name attlist) - (sax:end-element (handler *ctx*) ns-uri local-name name)) + (multiple-value-bind (cat sem) (read-token input) + (case cat + ((:stag :ztag)) + (:eof (eox input)) + (t (wf-error "element expected"))) + (destructuring-bind (&optional name &rest attrs) sem + (validate-start-element *ctx* name) + (let ((ns-decls (declare-namespaces name attrs))) + (multiple-value-bind (ns-uri prefix local-name) (decode-qname name) + (declare (ignore prefix)) + (let* ((raw-attlist (build-attribute-list-ns attrs)) + (attlist + (remove-if-not (lambda (a) + (or sax:*include-xmlns-attributes* + (not (xmlns-attr-p (sax:attribute-qname a))))) + (process-attributes *ctx* name raw-attlist)))) + (cond ((eq cat :ztag) + (sax:start-element (handler *ctx*) ns-uri local-name name attlist) + (sax:end-element (handler *ctx*) ns-uri local-name name)) - ((eq cat :stag) - (sax:start-element (handler *ctx*) ns-uri local-name name attlist) - (p/content input) - (multiple-value-bind (cat2 sem2) (read-token input) - (unless (and (eq cat2 :etag) - (eq (car sem2) name)) - (perror input "Bad nesting. ~S / ~S" (mu name) (mu (cons cat2 sem2)))) - (when (cdr sem2) - (wf-error "no attributes allowed in end tag"))) - (sax:end-element (handler *ctx*) ns-uri local-name name)) + ((eq cat :stag) + (sax:start-element (handler *ctx*) ns-uri local-name name attlist) + (p/content input) + (multiple-value-bind (cat2 sem2) (read-token input) + (unless (and (eq cat2 :etag) + (eq (car sem2) name)) + (perror input "Bad nesting. ~S / ~S" (mu name) (mu (cons cat2 sem2)))) + (when (cdr sem2) + (wf-error "no attributes allowed in end tag"))) + (sax:end-element (handler *ctx*) ns-uri local-name name)) - (t - (wf-error "Expecting element, got ~S." cat))))) - (undeclare-namespaces ns-decls)) - (validate-end-element *ctx* name))) + (t + (wf-error "Expecting element, got ~S." cat))))) + (undeclare-namespaces ns-decls)) + (validate-end-element *ctx* name)))) (defun perror (stream format-string &rest format-args) (when (zstream-p stream)