Previous: Character counting input stream, Up: Gray Streams examples


9.2.8.2 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