doc/manual/gray-streams-examples.texinfo

   1 @node Gray Streams examples
   2 @subsection Gray Streams examples
   3
   4 @macro codew{stuff}
   5 @code{@w{\stuff\}}
   6 @end macro
   7
   8 Below are two classes of stream that can be conveniently defined as
   9 wrappers for Common Lisp streams.  These are meant to serve as
  10 examples of minimal implementations of the protocols that must be
  11 followed when defining Gray streams.  Realistic uses of the Gray
  12 Streams API would implement the various methods that can do I/O in
  13 batches, such as @codew{stream-read-line}, @codew{stream-write-string},
  14 @codew{stream-read-sequence}, and @codew{stream-write-sequence}.
  15
  16
  17 @menu
  18 * Character counting input stream::
  19 * Output prefixing character stream::
  20 @end menu
  21
  22 @node Character counting input stream
  23 @subsubsection  Character counting input stream
  24
  25 It is occasionally handy for programs that process input files to
  26 count the number of characters and lines seen so far, and the number
  27 of characters seen on the current line, so that useful messages may be
  28 reported in case of parsing errors, etc.  Here is a character input
  29 stream class that keeps track of these counts.  Note that all
  30 character input streams must implement @codew{stream-read-char} and
  31 @codew{stream-unread-char}.
  32
  33 @lisp
  34 @group
  35 (defclass wrapped-stream (fundamental-stream)
  36   ((stream :initarg :stream :reader stream-of)))
  37 @end group
  38
  39 @group
  40 (defmethod stream-element-type ((stream wrapped-stream))
  41   (stream-element-type (stream-of stream)))
  42 @end group
  43
  44 @group
  45 (defmethod close ((stream wrapped-stream) &key abort)
  46   (close (stream-of stream) :abort abort))
  47 @end group
  48
  49 @group
  50 (defclass wrapped-character-input-stream
  51     (wrapped-stream fundamental-character-output-stream)
  52   ())
  53 @end group
  54
  55 @group
  56 (defmethod stream-read-char ((stream wrapped-character-input-stream))
  57   (read-char (stream-of stream) nil :eof))
  58 @end group
  59
  60 @group
  61 (defmethod stream-unread-char ((stream wrapped-character-input-stream)
  62                                char)
  63   (unread-char char (stream-of stream)))
  64 @end group
  65
  66 @group
  67 (defclass counting-character-input-stream
  68     (wrapped-character-input-stream)
  69   ((char-count :initform 1 :accessor char-count-of)
  70    (line-count :initform 1 :accessor line-count-of)
  71    (col-count :initform 1 :accessor col-count-of)
  72    (prev-col-count :initform 1 :accessor prev-col-count-of)))
  73 @end group
  74
  75 @group
  76 (defmethod stream-read-char ((stream counting-character-input-stream))
  77   (with-accessors ((inner-stream stream-of) (chars char-count-of)
  78                    (lines line-count-of) (cols col-count-of)
  79                    (prev prev-col-count-of)) stream
  80       (let ((char (call-next-method)))
  81         (cond ((eql char :eof)
  82                :eof)
  83               ((char= char #\Newline)
  84                (incf lines)
  85                (incf chars)
  86                (setf prev cols)
  87                (setf cols 1)
  88                char)
  89               (t
  90                (incf chars)
  91                (incf cols)
  92                char)))))
  93 @end group
  94
  95 @group
  96 (defmethod stream-unread-char ((stream counting-character-input-stream)
  97                                char)
  98   (with-accessors ((inner-stream stream-of) (chars char-count-of)
  99                    (lines line-count-of) (cols col-count-of)
 100                    (prev prev-col-count-of)) stream
 101       (cond ((char= char #\Newline)
 102              (decf lines)
 103              (decf chars)
 104              (setf cols prev))
 105             (t
 106              (decf chars)
 107              (decf cols)
 108              char))
 109       (call-next-method)))
 110 @end group
 111 @end lisp
 112
 113 The default methods for @codew{stream-read-char-no-hang},
 114 @codew{stream-peek-char}, @codew{stream-listen},
 115 @codew{stream-clear-input}, @codew{stream-read-line}, and
 116 @codew{stream-read-sequence} should be sufficient (though the last two
 117 will probably be slower than methods that forwarded directly).
 118
 119 Here's a sample use of this class:
 120
 121 @lisp
 122 @group
 123 (with-input-from-string (input "1 2
 124  3 :foo  ")
 125   (let ((counted-stream (make-instance 'counting-character-input-stream
 126                          :stream input)))
 127     (loop for thing = (read counted-stream) while thing
 128        unless (numberp thing) do
 129          (error "Non-number ~S (line ~D, column ~D)" thing
 130                 (line-count-of counted-stream)
 131                 (- (col-count-of counted-stream)
 132                    (length (format nil "~S" thing))))
 133        end
 134        do (print thing))))
 135 @end group
 136 @verbatim
 137 1
 138 2
 139 3
 140 Non-number :FOO (line 2, column 5)
 141   [Condition of type SIMPLE-ERROR]
 142 @end verbatim
 143 @end lisp
 144
 145 @node Output prefixing character stream
 146 @subsubsection Output prefixing character stream
 147
 148 One use for a wrapped output stream might be to prefix each line of
 149 text with a timestamp, e.g., for a logging stream.  Here's a simple
 150 stream that does this, though without any fancy line-wrapping.  Note
 151 that all character output stream classes must implement
 152 @codew{stream-write-char} and @codew{stream-line-column}.
 153
 154 @lisp
 155 @group
 156 (defclass wrapped-stream (fundamental-stream)
 157   ((stream :initarg :stream :reader stream-of)))
 158 @end group
 159
 160 @group
 161 (defmethod stream-element-type ((stream wrapped-stream))
 162   (stream-element-type (stream-of stream)))
 163 @end group
 164
 165 @group
 166 (defmethod close ((stream wrapped-stream) &key abort)
 167   (close (stream-of stream) :abort abort))
 168 @end group
 169
 170 @group
 171 (defclass wrapped-character-output-stream
 172     (wrapped-stream fundamental-character-output-stream)
 173   ((col-index :initform 0 :accessor col-index-of)))
 174 @end group
 175
 176 @group
 177 (defmethod stream-line-column ((stream wrapped-character-output-stream))
 178   (col-index-of stream))
 179 @end group
 180
 181 @group
 182 (defmethod stream-write-char ((stream wrapped-character-output-stream)
 183                               char)
 184   (with-accessors ((inner-stream stream-of) (cols col-index-of)) stream
 185     (write-char char inner-stream)
 186     (if (char= char #\Newline)
 187         (setf cols 0)
 188         (incf cols))))
 189 @end group
 190
 191 @group
 192 (defclass prefixed-character-output-stream
 193     (wrapped-character-output-stream)
 194   ((prefix :initarg :prefix :reader prefix-of)))
 195 @end group
 196
 197 @group
 198 (defgeneric write-prefix (prefix stream)
 199   (:method ((prefix string) stream) (write-string prefix stream))
 200   (:method ((prefix function) stream) (funcall prefix stream)))
 201 @end group
 202
 203 @group
 204 (defmethod stream-write-char ((stream prefixed-character-output-stream)
 205                               char)
 206   (with-accessors ((inner-stream stream-of) (cols col-index-of)
 207                    (prefix prefix-of)) stream
 208     (when (zerop cols)
 209       (write-prefix prefix inner-stream))
 210     (call-next-method)))
 211 @end group
 212 @end lisp
 213
 214 As with the example input stream, this implements only the minimal
 215 protocol.  A production implementation should also provide methods for
 216 at least @codew{stream-write-line}, @codew{stream-write-sequence}.
 217
 218 And here's a sample use of this class:
 219
 220 @lisp
 221 @group
 222 (flet ((format-timestamp (stream)
 223          (apply #'format stream "[~2@@*~2,' D:~1@@*~2,'0D:~0@@*~2,'0D] "
 224                 (multiple-value-list (get-decoded-time)))))
 225   (let ((output (make-instance 'prefixed-character-output-stream
 226                                :stream *standard-output*
 227                                :prefix #'format-timestamp)))
 228     (loop for string in '("abc" "def" "ghi") do
 229          (write-line string output)
 230          (sleep 1))))
 231 @end group
 232 @verbatim
 233 [ 0:30:05] abc
 234 [ 0:30:06] def
 235 [ 0:30:07] ghi
 236 NIL
 237 @end verbatim
 238 @end lisp
 239 @unmacro codew