X-Git-Url: http://git.kpe.io/?p=xmlutils.git;a=blobdiff_plain;f=pxml1.cl;fp=pxml1.cl;h=cc6df9dc05544fa1223d3bba34c8acb5d25bd96c;hp=d7c925206f2ccd09efb68d61eff5a6e93ced1fc5;hb=1e8aa1df433841c85c5a0b44fbd92964672e18b5;hpb=2d40f4169cc89aaecf1a762cae1e2d7cd55587ab diff --git a/pxml1.cl b/pxml1.cl index d7c9252..cc6df9d 100644 --- a/pxml1.cl +++ b/pxml1.cl @@ -19,15 +19,13 @@ ;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, ;; Suite 330, Boston, MA 02111-1307 USA ;; -;; $Id: pxml1.cl,v 1.2 2002/10/16 03:45:52 kevin Exp $ - -;; Change Log +;; Change Log ;; ;; 10/14/00 add namespace support; xml-error fix (in-package :net.xml.parser) -(pxml-dribble-bug-hook "$Id: pxml1.cl,v 1.2 2002/10/16 03:45:52 kevin Exp $") +(pxml-dribble-bug-hook "$Id: pxml1.cl,v 1.3 2003/06/20 02:21:23 kevin Exp $") (defparameter *collectors* (list nil nil nil nil nil nil nil nil)) @@ -271,14 +269,14 @@ (declare (ignorable tokenbuf) (optimize (speed 3) (safety 1))) ;; need no-OO check because external format support isn't completely done yet (when (not (typep p 'string-input-simple-stream)) - #+(and allegro (version>= 6 0 pre-final 1)) + #+(version>= 6 0 pre-final 1) (let ((format (ignore-errors (excl:sniff-for-unicode p)))) (if* (eq format (find-external-format :unicode)) then - #+allegro (setf (stream-external-format p) format) + (setf (stream-external-format p) format) else - #+allegro (setf (stream-external-format p) (find-external-format :utf8)))) - #-(and allegro (version>= 6 0 pre-final 1)) + (setf (stream-external-format p) (find-external-format :utf8)))) + #-(version>= 6 0 pre-final 1) (let* ((c (read-char p nil)) c2 (c-code (if c (char-code c) nil))) (if* (eq #xFF c-code) then @@ -286,12 +284,12 @@ (setf c-code (if c (char-code c2) nil)) (if* (eq #xFE c-code) then (format t "set unicode~%") - #+allegro (setf (stream-external-format p) - (find-external-format #+(and allegro (version>= 6 0 pre-final 1)) :unicode - #-(and allegro (version>= 6 0 pre-final 1)) :fat-little)) + (setf (stream-external-format p) + (find-external-format #+(version>= 6 0 pre-final 1) :unicode + #-(version>= 6 0 pre-final 1) :fat-little)) else (xml-error "stream has incomplete Unicode marker")) - else #+allegro (setf (stream-external-format p) + else (setf (stream-external-format p) (find-external-format :utf8)) (when c (push c (iostruct-unget-char tokenbuf)) @@ -411,7 +409,7 @@ (xml-error "XML declaration tag does not include correct 'encoding' or 'standalone' attribute")) (when (and (fourth val) (string= "standalone" (symbol-name (fourth val)))) (if* (equal (fifth val) "yes") then - (setf (iostruct-standalonep tokenbuf) t) + (setf (iostruct-standalonep tokenbuf) t) elseif (not (equal (fifth val) "no")) then (xml-error "XML declaration tag does not include correct 'standalone' attribute value"))) (dotimes (i (length (third val))) @@ -421,16 +419,26 @@ (not (member c '(#\. #\_ #\- #\:))) ) (xml-error "XML declaration tag does not include correct 'version' attribute value")))) - (when (and (fourth val) (eql :encoding (fourth val))) - (dotimes (i (length (fifth val))) - (let ((c (schar (fifth val) i))) - (when (and (not (alpha-char-p c)) - (if* (> i 0) then - (and (not (digit-char-p c)) - (not (member c '(#\. #\_ #\-)))) - else t)) - (xml-error "XML declaration tag does not include correct 'encoding' attribute value"))))) - ) + (if* (and (fourth val) (eql :encoding (fourth val))) + then (dotimes (i (length (fifth val))) + (let ((c (schar (fifth val) i))) + (when (and (not (alpha-char-p c)) + (if* (> i 0) then + (and (not (digit-char-p c)) + (not (member c '(#\. #\_ #\-)))) + else t)) + (xml-error "XML declaration tag does not include correct 'encoding' attribute value")))) + ;; jkf 3/26/02 + ;; if we have a stream we're reading from set its external-format + ;; to the encoding + ;; note - tokenbuf is really an iostruct, not a tokenbuf + (if* (tokenbuf-stream (iostruct-tokenbuf tokenbuf)) + then (setf (stream-external-format + (tokenbuf-stream (iostruct-tokenbuf tokenbuf))) + (find-external-format (fifth val)))) + + + )) (defun xml-error (text) (declare (optimize (speed 3) (safety 1)))