Gray Streams examples
---------------------

Below are two classes of stream that can be conveniently defined as wrappers for Common Lisp streams.  These are meant to serve as examples of minimal implementations of the protocols that must be followed when defining Gray streams.  Realistic uses of the Gray Streams API would implement the various methods that can do I/O in batches, such as stream-read-line, stream-write-string, stream-read-sequence, and stream-write-sequence.

Character counting input stream
...............................

It is occasionally handy for programs that process input files to count the number of characters and lines seen so far, and the number of characters seen on the current line, so that useful messages may be reported in case of parsing errors, etc.  Here is a character input stream class that keeps track of these counts.  Note that all character input streams must implement stream-read-char and stream-unread-char.

     (defclass wrapped-stream (fundamental-stream)
       ((stream :initarg :stream :reader stream-of)))

     (defmethod stream-element-type ((stream wrapped-stream))
       (stream-element-type (stream-of stream)))

     (defmethod close ((stream wrapped-stream) &key abort)
       (close (stream-of stream) :abort abort))

     (defclass wrapped-character-input-stream
         (wrapped-stream fundamental-character-output-stream)
       ())

     (defmethod stream-read-char ((stream wrapped-character-input-stream))
       (read-char (stream-of stream) nil :eof))

     (defmethod stream-unread-char ((stream wrapped-character-input-stream)
                                    char)
       (unread-char char (stream-of stream)))

     (defclass counting-character-input-stream
         (wrapped-character-input-stream)
       ((char-count :initform 1 :accessor char-count-of)
        (line-count :initform 1 :accessor line-count-of)
        (col-count :initform 1 :accessor col-count-of)
        (prev-col-count :initform 1 :accessor prev-col-count-of)))

     (defmethod stream-read-char ((stream counting-character-input-stream))
       (with-accessors ((inner-stream stream-of) (chars char-count-of)
                        (lines line-count-of) (cols col-count-of)
                        (prev prev-col-count-of)) stream
           (let ((char (call-next-method)))
             (cond ((eql char :eof)
                    :eof)
                   ((char= char #\Newline)
                    (incf lines)
                    (incf chars)
                    (setf prev cols)
                    (setf cols 1)
                    char)
                   (t
                    (incf chars)
                    (incf cols)
                    char)))))

     (defmethod stream-unread-char ((stream counting-character-input-stream)
                                    char)
       (with-accessors ((inner-stream stream-of) (chars char-count-of)
                        (lines line-count-of) (cols col-count-of)
                        (prev prev-col-count-of)) stream
           (cond ((char= char #\Newline)
                  (decf lines)
                  (decf chars)
                  (setf cols prev))
                 (t
                  (decf chars)
                  (decf cols)
                  char))
           (call-next-method)))

The default methods for stream-read-char-no-hang, stream-peek-char, stream-listen, stream-clear-input, stream-read-line, and stream-read-sequence should be sufficient (though the last two will probably be slower than methods that forwarded directly).

Here's a sample use of this class:

     (with-input-from-string (input "1 2
      3 :foo  ")
       (let ((counted-stream (make-instance 'counting-character-input-stream
                              :stream input)))
         (loop for thing = (read counted-stream) while thing
            unless (numberp thing) do
              (error "Non-number ~S (line ~D, column ~D)" thing
                     (line-count-of counted-stream)
                     (- (col-count-of counted-stream)
                        (length (format nil "~S" thing))))
            end
            do (print thing))))

     1
     2
     3
     Non-number :FOO (line 2, column 5)
       [Condition of type SIMPLE-ERROR]

Output prefixing character stream
.................................

One use for a wrapped output stream might be to prefix each line of text with a timestamp, e.g., for a logging stream.  Here's a simple stream that does this, though without any fancy line-wrapping.  Note that all character output stream classes must implement stream-write-char and stream-line-column.

     (defclass wrapped-stream (fundamental-stream)
       ((stream :initarg :stream :reader stream-of)))

     (defmethod stream-element-type ((stream wrapped-stream))
       (stream-element-type (stream-of stream)))

     (defmethod close ((stream wrapped-stream) &key abort)
       (close (stream-of stream) :abort abort))

     (defclass wrapped-character-output-stream
         (wrapped-stream fundamental-character-output-stream)
       ((col-index :initform 0 :accessor col-index-of)))

     (defmethod stream-line-column ((stream wrapped-character-output-stream))
       (col-index-of stream))

     (defmethod stream-write-char ((stream wrapped-character-output-stream)
                                   char)
       (with-accessors ((inner-stream stream-of) (cols col-index-of)) stream
         (write-char char inner-stream)
         (if (char= char #\Newline)
             (setf cols 0)
             (incf cols))))

     (defclass prefixed-character-output-stream
         (wrapped-character-output-stream)
       ((prefix :initarg :prefix :reader prefix-of)))

     (defgeneric write-prefix (prefix stream)
       (:method ((prefix string) stream) (write-string prefix stream))
       (:method ((prefix function) stream) (funcall prefix stream)))

     (defmethod stream-write-char ((stream prefixed-character-output-stream)
                                   char)
       (with-accessors ((inner-stream stream-of) (cols col-index-of)
                        (prefix prefix-of)) stream
         (when (zerop cols)
           (write-prefix prefix inner-stream))
         (call-next-method)))

As with the example input stream, this implements only the minimal protocol.  A production implementation should also provide methods for at least stream-write-line, stream-write-sequence.

And here's a sample use of this class:

     (flet ((format-timestamp (stream)
              (apply #'format stream "[~2@*~2,' D:~1@*~2,'0D:~0@*~2,'0D] "
                     (multiple-value-list (get-decoded-time)))))
       (let ((output (make-instance 'prefixed-character-output-stream
                                    :stream *standard-output*
                                    :prefix #'format-timestamp)))
         (loop for string in '("abc" "def" "ghi") do
              (write-line string output)
              (sleep 1))))

     [ 0:30:05] abc
     [ 0:30:06] def
     [ 0:30:07] ghi
     NIL