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