+
+;;; 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
+ (bug "Impossible case reached in PEEK-CHAR")))))
+