OSCL/CXML
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

oops, revert

Browse Source
This commit is contained in:
dlichteblau
2005-08-16 15:03:05 +00:00
parent 9d52ec3f05
commit b5230358fa
1 changed files with 33 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

72
xml/xml-parse.lisp
View File

@ -1270,13 +1270,11 @@
((rune= #// d) ((rune= #// d)
(let ((c (peek-rune input))) (let ((c (peek-rune input)))
(cond ((name-start-rune-p c) (cond ((name-start-rune-p c)
(ensure-dtd) ;fixme
(read-tag-2 zinput input :etag)) (read-tag-2 zinput input :etag))
(t (t
(error "Expecting name start rune after \"</\"."))))) (error "Expecting name start rune after \"</\".")))))
((name-start-rune-p d) ((name-start-rune-p d)
(unread-rune d input) (unread-rune d input)
(ensure-dtd) ;fixme
(read-tag-2 zinput input :stag)) (read-tag-2 zinput input :stag))
(t (t
(error "Expected '!' or '?' after '<' in DTD."))))) (error "Expected '!' or '?' after '<' in DTD.")))))
@ -2437,7 +2435,6 @@
(defun p/doctype-decl (input &optional dtd-extid) (defun p/doctype-decl (input &optional dtd-extid)
(let () (let ()
(let ((*expand-pe-p* nil) (let ((*expand-pe-p* nil)
(fresh-dtd-p t)
name extid) name extid)
(expect input :|<!DOCTYPE|) (expect input :|<!DOCTYPE|)
(p/S input) (p/S input)
@ -2460,7 +2457,6 @@
(when (disallow-internal-subset *ctx*) (when (disallow-internal-subset *ctx*)
(error "document includes an internal subset")) (error "document includes an internal subset"))
(ensure-dtd) (ensure-dtd)
(setf fresh-dtd-p nil)
(consume-token input) (consume-token input)
(while (progn (p/S? input) (while (progn (p/S? input)
(not (eq (peek-token input) :\] ))) (not (eq (peek-token input) :\] )))
@ -2484,6 +2480,7 @@
(let* ((effective-extid (let* ((effective-extid
(extid-using-catalog (absolute-extid input extid))) (extid-using-catalog (absolute-extid input extid)))
(sysid (extid-system effective-extid)) (sysid (extid-system effective-extid))
(fresh-dtd-p (null (dtd *ctx*)))
(cached-dtd (cached-dtd
(and fresh-dtd-p (and fresh-dtd-p
(not (standalone-p *ctx*)) (not (standalone-p *ctx*))
@ -2899,31 +2896,28 @@
(values nil nil))) (values nil nil)))
(defun uri-to-pathname (uri) (defun uri-to-pathname (uri)
(flet ((unescape (str) (let ((scheme (puri:uri-scheme uri))
(puri::decode-escaped-encoding str t puri::*reserved-characters*))) (path (puri:uri-parsed-path uri)))
(let ((scheme (puri:uri-scheme uri)) (unless (member scheme '(nil :file))
(path (puri:uri-parsed-path uri))) (error 'parser-error
(setf path (cons (car path) (mapcar #'unescape (cdr path)))) :format-control "URI scheme ~S not supported"
(unless (member scheme '(nil :file)) :format-arguments (list scheme)))
(error 'parser-error (if (eq (car path) :relative)
:format-control "URI scheme ~S not supported" (multiple-value-bind (name type)
:format-arguments (list scheme))) (parse-name.type (car (last path)))
(if (eq (car path) :relative) (make-pathname :directory (butlast path)
(multiple-value-bind (name type) :name name
(parse-name.type (car (last path))) :type type))
(make-pathname :directory (butlast path) (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 :name name
:type type)) :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)))))))
(defun parse-xstream (xstream handler &rest args) (defun parse-xstream (xstream handler &rest args)
(let ((zstream (make-zstream :input-stack (list xstream)))) (let ((zstream (make-zstream :input-stack (list xstream))))
@ -3252,20 +3246,20 @@
(let ((input-var (gensym)) (let ((input-var (gensym))
(collect (gensym)) (collect (gensym))
(c (gensym))) (c (gensym)))
`(let ((,input-var ,input)) `(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) (WITH-RUNE-COLLECTOR/RAW (,collect)
(loop (LOOP
(let ((,c (peek-rune ,input-var))) (LET ((,c (PEEK-RUNE ,input-var)))
(cond ((eq ,c :eof) (COND ((EQ ,c :EOF)
;; xxx error message ;; xxx error message
(return)) (RETURN))
((funcall ,predicate ,c) ((FUNCALL ,predicate ,c)
(return)) (RETURN))
(t (t
(,collect ,c) (,collect ,c)
(consume-rune ,input-var)))))) (CONSUME-RUNE ,input-var))))))
(locally (LOCALLY
,@body))))) ,@body)))))
(defun read-name-token (input) (defun read-name-token (input)