Output prefixing character stream - SBCL 1.0.31 User Manual
Description: SBCL 1.0.31 User Manual

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

##### 10.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