diff --git a/code/stream.lisp b/code/stream.lisp
index dafccf6ba59ad93a61cce86a81ee8753d4cfe3ff..c86430d0c5cb125b89df8a488f41ac196a43b3b1 100644
--- a/code/stream.lisp
+++ b/code/stream.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.55 2002/11/13 02:50:34 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.56 2002/11/19 14:30:57 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -366,51 +366,94 @@
 	(stream-unread-char stream character)))
   nil)
 
+;;; In the interest of ``once and only once'' this macro contains the
+;;; framework necessary to implement a peek-char function, which has
+;;; two special-cases (one for gray streams and one for echo streams)
+;;; in addition to the normal case.
+;;;
+;;; All arguments are forms which will be used for a specific purpose
+;;; PEEK-TYPE - the current peek-type as defined by ANSI CL
+;;; EOF-VALUE - the eof-value argument to peek-char
+;;; CHAR-VAR - the variable which will be used to store the current character
+;;; READ-FORM - the form which will be used to read a character
+;;; UNREAD-FORM - ditto for unread-char
+;;; SKIPPED-CHAR-FORM - the form to execute when skipping a character
+;;; EOF-DETECTED-FORM - the form to execute when EOF has been detected
+;;;                     (this will default to CHAR-VAR)
+(defmacro generalized-peeking-mechanism (peek-type eof-value char-var read-form unread-form
+						   &optional (skipped-char-form nil)
+						   (eof-detected-form nil))
+  `(let ((,char-var ,read-form))
+    (cond ((eql ,char-var ,eof-value) 
+	   ,(if eof-detected-form
+		eof-detected-form
+		char-var))
+	  ((characterp ,peek-type)
+	   (do ((,char-var ,char-var ,read-form))
+	       ((or (eql ,char-var ,eof-value) 
+		    (char= ,char-var ,peek-type))
+		(cond ((eql ,char-var ,eof-value)
+		       ,(if eof-detected-form
+			    eof-detected-form
+			    char-var))
+		      (t ,unread-form
+			 ,char-var)))
+	     ,skipped-char-form))
+	  ((eql ,peek-type t)
+	   (do ((,char-var ,char-var ,read-form))
+	       ((or (eql ,char-var ,eof-value)
+		    (not (whitespace-char-p ,char-var)))
+		(cond ((eql ,char-var ,eof-value)
+		       ,(if eof-detected-form
+			    eof-detected-form
+			    char-var))
+		      (t ,unread-form
+			 ,char-var)))
+	     ,skipped-char-form))
+	  ((null ,peek-type)
+	   ,unread-form
+	   ,char-var)
+	  (t
+	   (error "Impossible case reached in PEEK-CHAR")))))
+
 (defun peek-char (&optional (peek-type nil) (stream *standard-input*)
 			    (eof-errorp t) eof-value recursive-p)
   "Peeks at the next character in the input Stream.  See manual for details."
   (declare (ignore recursive-p))
+  ;; FIXME: The type of PEEK-TYPE is also declared in a DEFKNOWN, but
+  ;; the compiler doesn't seem to be smart enough to go from there to
+  ;; imposing a type check. Figure out why (because PEEK-TYPE is an
+  ;; &OPTIONAL argument?) and fix it, and then this explicit type
+  ;; check can go away.
+  (unless (typep peek-type '(or character boolean))
+    (error 'simple-type-error
+	   :datum peek-type
+	   :expected-type '(or character boolean)
+	   :format-control "~@<bad PEEK-TYPE=~S, ~_expected ~S~:>"
+	   :format-arguments (list peek-type '(or character boolean))))
   (let ((stream (in-synonym-of stream)))
-    (if (lisp-stream-p stream)
-	(let ((char (read-char stream eof-errorp eof-value)))
-	  (cond ((eq char eof-value) char)
-		((characterp peek-type)
-		 (do ((char char (read-char stream eof-errorp eof-value)))
-		     ((or (eq char eof-value) (char= char peek-type))
-		      (unless (eq char eof-value)
-			(unread-char char stream))
-		      char)))
-		((eq peek-type t)
-		 (do ((char char (read-char stream eof-errorp eof-value)))
-		     ((or (eq char eof-value) (not (whitespace-char-p char)))
-		      (unless (eq char eof-value)
-			(unread-char char stream))
-		      char)))
-		(t
-		 (unread-char char stream)
-		 char)))
-	;; Fundamental-stream.
-	(cond ((characterp peek-type)
-	       (do ((char (stream-read-char stream) (stream-read-char stream)))
-		   ((or (eq char :eof) (char= char peek-type))
-		    (cond ((eq char :eof)
-			   (eof-or-lose stream eof-errorp eof-value))
-			  (t
-			   (stream-unread-char stream char)
-			   char)))))
-	      ((eq peek-type t)
-	       (do ((char (stream-read-char stream) (stream-read-char stream)))
-		   ((or (eq char :eof) (not (whitespace-char-p char)))
-		    (cond ((eq char :eof)
-			   (eof-or-lose stream eof-errorp eof-value))
-			  (t
-			   (stream-unread-char stream char)
-			   char)))))
-	      (t
-	       (let ((char (stream-peek-char stream)))
-		 (if (eq char :eof)
-		     (eof-or-lose stream eof-errorp eof-value)
-		     char)))))))
+    (cond ((typep stream 'echo-stream)
+	   (echo-misc stream 
+		      :peek-char
+		      peek-type
+		      (list eof-errorp eof-value)))
+	  ((lisp-stream-p stream)
+	   (generalized-peeking-mechanism
+	    peek-type eof-value char
+	    (read-char stream eof-errorp eof-value)
+	    (unread-char char stream)))
+	  (t
+	   ;; by elimination, must be Gray streams FUNDAMENTAL-STREAM
+	   (generalized-peeking-mechanism
+	    peek-type :eof char
+	    (if (null peek-type)
+		(stream-peek-char stream)
+		(stream-read-char stream))
+	    (if (null peek-type)
+		()
+		(stream-unread-char stream char))
+	    ()
+	    (eof-or-lose stream eof-errorp eof-value))))))
 
 (defun listen (&optional (stream *standard-input*))
   "Returns T if a character is availible on the given Stream."
@@ -1060,6 +1103,7 @@ output to Output-stream"
   (in-fun echo-in read-char lisp-stream-out stream-write-char)
   (in-fun echo-bin read-byte lisp-stream-bout stream-write-byte))
 
+
 (defun echo-misc (stream operation &optional arg1 arg2)
   (let* ((in (two-way-stream-input-stream stream))
 	 (out (two-way-stream-output-stream stream)))
@@ -1078,6 +1122,33 @@ output to Output-stream"
 	     in-type `(and ,in-type ,out-type))))
       (:close
        (set-closed-flame stream))
+      (:peek-char
+       ;; For the special case of peeking into an echo-stream
+       ;; arg1 is peek-type, arg2 is (eof-errorp eof-value)
+       ;; returns peeked-char, eof-value, or errors end-of-file
+       (let ((unread-char-p nil))
+	 (destructuring-bind (eof-errorp eof-value)
+	     arg2
+	   (flet ((outfn (c)
+		    (unless unread-char-p
+		      (if (lisp-stream-p out)
+			  (funcall (lisp-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 eof-errorp eof-value)))))
+	     (generalized-peeking-mechanism
+	      arg1 eof-value char
+	      (infn)
+	      (unread-char char in)
+	      (outfn char))))))
       (t
        (or (if (lisp-stream-p in)
 	       (funcall (lisp-stream-misc in) in operation arg1 arg2)