X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=pxml1.cl;h=ce9fa65946ecfeeb3f3887815f5ba9ab4ec4a77a;hb=96edd80309cfaea1949768cd4b3a5f7e0dc203d5;hp=d7c925206f2ccd09efb68d61eff5a6e93ced1fc5;hpb=d7019014ac92cbc1098abc26c7e6d35d17390f0f;p=xmlutils.git

diff --git a/pxml1.cl b/pxml1.cl
index d7c9252..ce9fa65 100644
--- a/pxml1.cl
+++ b/pxml1.cl
@@ -19,21 +19,19 @@
 ;; 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$")
 
 (defparameter *collectors* (list nil nil nil nil nil nil nil nil))
 
 (defun put-back-collector (col)
   (declare (optimize (speed 3) (safety 1)))
-  (mp::without-scheduling
+  (without-scheduling
     (do ((cols *collectors* (cdr cols)))
 	((null cols)
 	 ; toss it away
@@ -85,7 +83,7 @@
 (defun get-tokenbuf ()
   (declare (optimize (speed 3) (safety 1)))
   (let (buf)
-    (mp::without-scheduling
+    (without-scheduling
       (do* ((bufs *tokenbufs* (cdr bufs))
 	    (this (car bufs) (car bufs)))
 	  ((null bufs))
@@ -187,7 +185,7 @@
 
 (defun put-back-tokenbuf (buf)
   (declare (optimize (speed 3) (safety 1)))
-  (mp::without-scheduling
+  (without-scheduling
     (do ((bufs *tokenbufs* (cdr bufs)))
 	((null bufs)
 	 ; toss it away
@@ -199,7 +197,7 @@
 (defun get-collector ()
   (declare (optimize (speed 3) (safety 1)))
   (let (col)
-    (mp::without-scheduling
+    (without-scheduling
       (do* ((cols *collectors* (cdr cols))
 	    (this (car cols) (car cols)))
 	  ((null cols))
@@ -268,17 +266,20 @@
     (if* (and from-stream (eq tmp-char #\return)) then #\newline else tmp-char)))
 
 (defun unicode-check (p tokenbuf)
+  #-allegro (return-from unicode-check t)
+  #+allegro
   (declare (ignorable tokenbuf) (optimize (speed 3) (safety 1)))
   ;; need no-OO check because external format support isn't completely done yet
+  #+allegro
   (when (not (typep p 'string-input-simple-stream))
-    #+(and allegro (version>= 6 0 pre-final 1))
+    #+allegro
     (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))))
+    #-allegro
     (let* ((c (read-char p nil)) c2
 	   (c-code (if c (char-code c) nil)))
       (if* (eq #xFF c-code) then
@@ -286,12 +287,13 @@
 	      (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
+			 #+allegro :unicode
+			 #-allegro :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 +413,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 +423,27 @@
 		 (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
+     #+allegro
+	  (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)))