cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 65fa35fde63b362ec099e886cfe1c6cd4794eaad
parent 7a24111228b17532667522f2f3b3aefc9c2c02aa
Author: Tomas Hlavaty <tom@logand.com>
Date:   Thu, 24 Oct 2013 01:09:57 +0200

improved xml parsing

Diffstat:
Mxml.lisp | 24+++++++++++++-----------
1 file changed, 13 insertions(+), 11 deletions(-)

diff --git a/xml.lisp b/xml.lisp @@ -38,22 +38,24 @@ (skip () (rw:skip reader)) (till (markers) (rw:till reader markers))) (do (z) - ((eql #\> (peek)) - (assert (eql #\> (next))) + ((progn (skip) (eql #\> (peek))) + (next) (let ((f (equal (car z) finish))) (when f (pop z)) (values (nreverse z) f))) - (push (cons (prog1 (till '(#\space #\tab #\newline #\> #\=)) + (push (cons (prog1 (till '(#\space #\tab #\return #\newline #\> #\=)) (skip) (when (eql #\= (peek)) (next) (skip))) (let ((q (peek))) - (when (member q '(#\" #\')) - (next) - (prog1 (till (cons q '(#\space #\tab #\newline #\>))) - (assert (eql q (next))) - (skip))))) + (case q + ((#\" #\') + (next) + (prog1 (till (list q)) + (assert (eql q (next))))) + (t ;; TODO only when enabled no-quoted-attributes + (till '(#\space #\tab #\return #\newline #\>)))))) z)))) (defun xmarkup-reader (reader) @@ -67,7 +69,7 @@ (#\< (next) (skip) - (let ((e (till '(#\space #\tab #\newline #\>)))) + (let ((e (till '(#\space #\tab #\return #\newline #\>)))) (skip) (case (car e) ;; TODO doctype (#\? @@ -135,9 +137,9 @@ (when (and (cdr z) (find-if-not (lambda (c) - (or (member c '(#\space #\tab #\newline)))) + (or (member c '(#\space #\tab #\return #\newline)))) (cdr a))) - (push (string-trim '(#\space #\tab #\newline) + (push (string-trim '(#\space #\tab #\return #\newline) (concatenate 'string (cdr a))) (car z)))))))) (etypecase x