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

pfade decodieren?

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

72
xml/xml-parse.lisp
View File

@ -1270,11 +1270,13 @@
((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.")))))
@ -2435,6 +2437,7 @@
(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)
@ -2457,6 +2460,7 @@
(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) :\] )))
@ -2480,7 +2484,6 @@
(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*))
@ -2896,28 +2899,31 @@
(values nil nil))) (values nil nil)))
(defun uri-to-pathname (uri) (defun uri-to-pathname (uri)
(let ((scheme (puri:uri-scheme uri)) (flet ((unescape (str)
(path (puri:uri-parsed-path uri))) (puri::decode-escaped-encoding str t puri::*reserved-characters*)))
(unless (member scheme '(nil :file)) (let ((scheme (puri:uri-scheme uri))
(error 'parser-error (path (puri:uri-parsed-path uri)))
:format-control "URI scheme ~S not supported" (setf path (cons (car path) (mapcar #'unescape (cdr path))))
:format-arguments (list scheme))) (unless (member scheme '(nil :file))
(if (eq (car path) :relative) (error 'parser-error
(multiple-value-bind (name type) :format-control "URI scheme ~S not supported"
(parse-name.type (car (last path))) :format-arguments (list scheme)))
(make-pathname :directory (butlast path) (if (eq (car path) :relative)
:name name (multiple-value-bind (name type)
:type type)) (parse-name.type (car (last path)))
(multiple-value-bind (name type) (make-pathname :directory (butlast path)
(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))))
@ -3246,20 +3252,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)