X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=ac44a9053cd6df6b538f738d83ce6b5294d791d5;hb=24407d11d34abdaaef6d839fd0b2665c73b0e6d5;hp=807c42203ec7d9765ae7f5aab2aceccdfd1f97fa;hpb=f3ea7a91cddd3ce35290ddd4e54abbe8a7a3a452;p=sbcl.git

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 807c422..ac44a90 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -11,10 +11,6 @@
 
 (in-package "SB!IMPL")
 
-(deftype string-stream ()
-  '(or string-input-stream string-output-stream
-       fill-pointer-output-stream))
-
 ;;;; standard streams
 
 ;;; The initialization of these streams is performed by
@@ -996,7 +992,6 @@
   (in-fun echo-bin read-byte ansi-stream-bout stream-write-byte
 	  eof-error-p eof-value))
 
-
 (defun echo-misc (stream operation &optional arg1 arg2)
   (let* ((in (two-way-stream-input-stream stream))
 	 (out (two-way-stream-output-stream stream)))
@@ -1018,18 +1013,39 @@
        (set-closed-flame stream))
       (:peek-char
        ;; For the special case of peeking into an echo-stream
-       ;; arg1 is peek-type, arg2 is (eof-error-p eof-value)
+       ;; arg1 is PEEK-TYPE, arg2 is (EOF-ERROR-P EOF-VALUE)
        ;; returns peeked-char, eof-value, or errors end-of-file
-       (flet ((outfn (c)
-		(if (ansi-stream-p out)
-		    (funcall (ansi-stream-out out) out c)
-		    ;; gray-stream
-		    (stream-write-char out c))))
-	 (generalized-peeking-mechanism
-	  arg1 (second arg2) char
-	  (read-char in (first arg2) (second arg2))
-	  (unread-char char in)
-	  (outfn char))))
+       ;;
+       ;; Note: This code could be moved into PEEK-CHAR if desired.
+       ;; I am unsure whether this belongs with echo-streams because it is
+       ;; echo-stream specific, or PEEK-CHAR because it is peeking code.
+       ;; -- mrd 2002-11-18
+       ;;
+       ;; UNREAD-CHAR-P indicates whether the current character was one
+       ;; that was previously unread.  In that case, we need to ensure that
+       ;; the semantics for UNREAD-CHAR are held; the character should
+       ;; not be echoed again.
+       (let ((unread-char-p nil))
+	 (flet ((outfn (c)
+		  (unless unread-char-p
+		    (if (ansi-stream-p out)
+			(funcall (ansi-stream-out out) out c)
+			;; gray-stream
+			(stream-write-char out c))))
+		(infn ()
+		  ;; Obtain input from unread buffer or input stream,
+		  ;; and set the flag appropriately.
+		  (cond ((not (null (echo-stream-unread-stuff stream)))
+			 (setf unread-char-p t)
+			 (pop (echo-stream-unread-stuff stream)))
+			(t
+			 (setf unread-char-p nil)
+			 (read-char in (first arg2) (second arg2))))))
+	   (generalized-peeking-mechanism
+	    arg1 (second arg2) char
+	    (infn)
+	    (unread-char char in)
+	    (outfn char)))))
       (t
        (or (if (ansi-stream-p in)
 	       (funcall (ansi-stream-misc in) in operation arg1 arg2)
@@ -1037,20 +1053,27 @@
 	   (if (ansi-stream-p out)
 	       (funcall (ansi-stream-misc out) out operation arg1 arg2)
 	       (stream-misc-dispatch out operation arg1 arg2)))))))
+
+;;;; base STRING-STREAM stuff
 
+(defstruct (string-stream
+             (:include ansi-stream)
+             (:constructor nil)
+             (:copier nil))
+  (string nil :type string))
 
-;;;; string input streams
+;;;; STRING-INPUT-STREAM stuff
 
 (defstruct (string-input-stream
-	     (:include ansi-stream
+	     (:include string-stream
 		       (in #'string-inch)
 		       (bin #'string-binch)
 		       (n-bin #'string-stream-read-n-bytes)
-		       (misc #'string-in-misc))
+		       (misc #'string-in-misc)
+                       (string nil :type simple-string))
 	     (:constructor internal-make-string-input-stream
 			   (string current end))
 	     (:copier nil))
-  (string nil :type simple-string)
   (current nil :type index)
   (end nil :type index))
 
@@ -1131,17 +1154,17 @@
   (internal-make-string-input-stream (coerce string 'simple-string)
 				     start end))
 
-;;;; string output streams
+;;;; STRING-OUTPUT-STREAM stuff
 
 (defstruct (string-output-stream
-	    (:include ansi-stream
+	    (:include string-stream
 		      (out #'string-ouch)
 		      (sout #'string-sout)
-		      (misc #'string-out-misc))
+		      (misc #'string-out-misc)
+                      ;; The string we throw stuff in.
+                      (string (make-string 40) :type simple-string))
 	    (:constructor make-string-output-stream ())
 	    (:copier nil))
-  ;; The string we throw stuff in.
-  (string (make-string 40) :type simple-string)
   ;; Index of the next location to use.
   (index 0 :type fixnum))
 
@@ -1230,16 +1253,17 @@
 	(satisfies array-has-fill-pointer-p)))
 
 (defstruct (fill-pointer-output-stream
- 	    (:include ansi-stream
+ 	    (:include string-stream
 		      (out #'fill-pointer-ouch)
 		      (sout #'fill-pointer-sout)
-		      (misc #'fill-pointer-misc))
+		      (misc #'fill-pointer-misc)
+                      ;; a string with a fill pointer where we stuff
+                      ;; the stuff we write
+                      (string (error "missing argument")
+                              :type string-with-fill-pointer
+                              :read-only t))
 	    (:constructor make-fill-pointer-output-stream (string))
-	    (:copier nil))
-  ;; a string with a fill pointer where we stuff the stuff we write
-  (string (error "missing argument")
-	  :type string-with-fill-pointer
-	  :read-only t))
+	    (:copier nil)))
 
 (defun fill-pointer-ouch (stream character)
   (let* ((buffer (fill-pointer-output-stream-string stream))