r5162: *** empty log message ***
[xmlutils.git] / pxml1.cl
index d7c925206f2ccd09efb68d61eff5a6e93ced1fc5..cc6df9dc05544fa1223d3bba34c8acb5d25bd96c 100644 (file)
--- a/pxml1.cl
+++ b/pxml1.cl
 ;; 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))
 
   (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
              (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))
     (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)))
                 (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)))