Update of /project/cxml/cvsroot/cxml/xml In directory common-lisp.net:/tmp/cvs-serv4658
Modified Files: xml-parse.lisp Log Message: oops, revert
Date: Tue Aug 16 17:03:05 2005 Author: dlichteblau
Index: cxml/xml/xml-parse.lisp diff -u cxml/xml/xml-parse.lisp:1.5 cxml/xml/xml-parse.lisp:1.6 --- cxml/xml/xml-parse.lisp:1.5 Tue Aug 16 17:01:24 2005 +++ cxml/xml/xml-parse.lisp Tue Aug 16 17:03:05 2005 @@ -1270,13 +1270,11 @@ ((rune= #// d) (let ((c (peek-rune input))) (cond ((name-start-rune-p c) - (ensure-dtd) ;fixme (read-tag-2 zinput input :etag)) (t (error "Expecting name start rune after "</"."))))) ((name-start-rune-p d) (unread-rune d input) - (ensure-dtd) ;fixme (read-tag-2 zinput input :stag)) (t (error "Expected '!' or '?' after '<' in DTD."))))) @@ -2437,7 +2435,6 @@ (defun p/doctype-decl (input &optional dtd-extid) (let () (let ((*expand-pe-p* nil) - (fresh-dtd-p t) name extid) (expect input :|<!DOCTYPE|) (p/S input) @@ -2460,7 +2457,6 @@ (when (disallow-internal-subset *ctx*) (error "document includes an internal subset")) (ensure-dtd) - (setf fresh-dtd-p nil) (consume-token input) (while (progn (p/S? input) (not (eq (peek-token input) :] ))) @@ -2484,6 +2480,7 @@ (let* ((effective-extid (extid-using-catalog (absolute-extid input extid))) (sysid (extid-system effective-extid)) + (fresh-dtd-p (null (dtd *ctx*))) (cached-dtd (and fresh-dtd-p (not (standalone-p *ctx*)) @@ -2899,31 +2896,28 @@ (values nil nil)))
(defun uri-to-pathname (uri) - (flet ((unescape (str) - (puri::decode-escaped-encoding str t puri::*reserved-characters*))) - (let ((scheme (puri:uri-scheme uri)) - (path (puri:uri-parsed-path uri))) - (setf path (cons (car path) (mapcar #'unescape (cdr path)))) - (unless (member scheme '(nil :file)) - (error 'parser-error - :format-control "URI scheme ~S not supported" - :format-arguments (list scheme))) - (if (eq (car path) :relative) - (multiple-value-bind (name type) - (parse-name.type (car (last path))) - (make-pathname :directory (butlast path) + (let ((scheme (puri:uri-scheme uri)) + (path (puri:uri-parsed-path uri))) + (unless (member scheme '(nil :file)) + (error 'parser-error + :format-control "URI scheme ~S not supported" + :format-arguments (list scheme))) + (if (eq (car path) :relative) + (multiple-value-bind (name type) + (parse-name.type (car (last path))) + (make-pathname :directory (butlast path) + :name name + :type type)) + (multiple-value-bind (name type) + (parse-name.type (car (last (cdr path)))) + (destructuring-bind (host device) + (split-sequence-if (lambda (x) (eql x #+)) + (or (puri:uri-host uri) "+")) + (make-pathname :host (string-or host) + :device (string-or device) + :directory (cons :absolute (butlast (cdr path))) :name name - :type type)) - (multiple-value-bind (name type) - (parse-name.type (car (last (cdr path)))) - (destructuring-bind (host device) - (split-sequence-if (lambda (x) (eql x #+)) - (or (puri:uri-host uri) "+")) - (make-pathname :host (string-or host) - :device (string-or device) - :directory (cons :absolute (butlast (cdr path))) - :name name - :type type))))))) + :type type))))))
(defun parse-xstream (xstream handler &rest args) (let ((zstream (make-zstream :input-stack (list xstream)))) @@ -3252,20 +3246,20 @@ (let ((input-var (gensym)) (collect (gensym)) (c (gensym))) - `(let ((,input-var ,input)) - (multiple-value-bind (,res ,res-start ,res-end) - (with-rune-collector/raw (,collect) - (loop - (let ((,c (peek-rune ,input-var))) - (cond ((eq ,c :eof) + `(LET ((,input-var ,input)) + (MULTIPLE-VALUE-BIND (,res ,res-start ,res-end) + (WITH-RUNE-COLLECTOR/RAW (,collect) + (LOOP + (LET ((,c (PEEK-RUNE ,input-var))) + (COND ((EQ ,c :EOF) ;; xxx error message - (return)) - ((funcall ,predicate ,c) - (return)) + (RETURN)) + ((FUNCALL ,predicate ,c) + (RETURN)) (t (,collect ,c) - (consume-rune ,input-var)))))) - (locally + (CONSUME-RUNE ,input-var)))))) + (LOCALLY ,@body)))))
(defun read-name-token (input)