[cxml-cvs] CVS update: cxml/xml/xml-parse.lisp

[David Lichteblau]

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
            , at body)))))
   
 (defun read-name-token (input)