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 (wrapped-stream)
  51   ())
  52 @end group
  53
  54 @group
  55 (defmethod stream-read-char ((stream wrapped-character-input-stream))
  56   (read-char (stream-of stream)))
  57 @end group
  58
  59 @group
  60 (defmethod stream-unread-char ((stream wrapped-character-input-stream)
  61                                char)
  62   (unread-char char (stream-of stream)))
  63 @end group
  64
  65 @group
  66 (defclass counting-character-input-stream
  67     (wrapped-character-input-stream)
  68   ((char-count :initform 1 :accessor char-count-of)
  69    (line-count :initform 1 :accessor line-count-of)
  70    (col-count :initform 1 :accessor col-count-of)
  71    (prev-col-count :initform 1 :accessor prev-col-count-of)))
  72 @end group
  73
  74 @group
  75 (defmethod stream-read-char ((stream counting-character-input-stream))
  76   (with-accessors ((inner-stream stream-of) (chars char-count-of)
  77                    (lines line-count-of) (cols col-count-of)
  78                    (prev prev-col-count-of)) stream
  79       (let ((char (call-next-method)))
  80         (cond ((eql char :eof)
  81                :eof)
  82               ((char= char #\Newline)
  83                (incf lines)
  84                (incf chars)
  85                (setf prev cols)
  86                (setf cols 1)
  87                char)
  88               (t
  89                (incf chars)
  90                (incf cols)
  91                char)))))
  92 @end group
  93
  94 @group
  95 (defmethod stream-unread-char ((stream counting-character-input-stream)
  96                                char)
  97   (with-accessors ((inner-stream stream-of) (chars char-count-of)
  98                    (lines line-count-of) (cols col-count-of)
  99                    (prev prev-col-count-of)) stream
 100       (cond ((char= char #\Newline)
 101              (decf lines)
 102              (decf chars)
 103              (setf cols prev))
 104             (t
 105              (decf chars)
 106              (decf cols)
 107              char))
 108       (call-next-method)))
 109 @end group
 110 @end lisp
 111
 112 The default methods for @codew{stream-read-char-no-hang},
 113 @codew{stream-peek-char}, @codew{stream-listen},
 114 @codew{stream-clear-input}, @codew{stream-read-line}, and
 115 @codew{stream-read-sequence} should be sufficient (though the last two
 116 will probably be slower than methods that forwarded directly).
 117
 118 Here's a sample use of this class:
 119
 120 @lisp
 121 @group
 122 (with-input-from-string (input "1 2
 123  3 :foo  ")
 124   (let ((counted-stream (make-instance 'counting-character-input-stream
 125                          :stream input)))
 126     (loop for thing = (read counted-stream) while thing
 127        unless (numberp thing) do
 128          (error "Non-number ~S (line ~D, column ~D)" thing
 129                 (line-count-of counted-stream)
 130                 (- (col-count-of counted-stream)
 131                    (length (format nil "~S" thing))))
 132        end
 133        do (print thing))))
 134 @end group
 135 @verbatim
 136 1
 137 2
 138 3
 139 Non-number :FOO (line 2, column 5)
 140   [Condition of type SIMPLE-ERROR]
 141 @end verbatim
 142 @end lisp
 143
 144 @node Output prefixing character stream
 145 @subsubsection Output prefixing character stream
 146
 147 One use for a wrapped output stream might be to prefix each line of
 148 text with a timestamp, e.g., for a logging stream.  Here's a simple
 149 stream that does this, though without any fancy line-wrapping.  Note
 150 that all character output stream classes must implement
 151 @codew{stream-write-char} and @codew{stream-line-column}.
 152
 153 @lisp
 154 @group
 155 (defclass wrapped-stream (fundamental-stream)
 156   ((stream :initarg :stream :reader stream-of)))
 157 @end group
 158
 159 @group
 160 (defmethod stream-element-type ((stream wrapped-stream))
 161   (stream-element-type (stream-of stream)))
 162 @end group
 163
 164 @group
 165 (defmethod close ((stream wrapped-stream) &key abort)
 166   (close (stream-of stream) :abort abort))
 167 @end group
 168
 169 @group
 170 (defclass wrapped-character-output-stream
 171     (wrapped-stream fundamental-character-output-stream)
 172   ((col-index :initform 0 :accessor col-index-of)))
 173 @end group
 174
 175 @group
 176 (defmethod stream-line-column ((stream wrapped-character-output-stream))
 177   (col-index-of stream))
 178 @end group
 179
 180 @group
 181 (defmethod stream-write-char ((stream wrapped-character-output-stream)
 182                               char)
 183   (with-accessors ((inner-stream stream-of) (cols col-index-of)) stream
 184     (write-char char inner-stream)
 185     (if (char= char #\Newline)
 186         (setf cols 0)
 187         (incf cols))))
 188 @end group
 189
 190 @group
 191 (defclass prefixed-character-output-stream
 192     (wrapped-character-output-stream)
 193   ((prefix :initarg :prefix :reader prefix-of)))
 194 @end group
 195
 196 @group
 197 (defgeneric write-prefix (prefix stream)
 198   (:method ((prefix string) stream) (write-string prefix stream))
 199   (:method ((prefix function) stream) (funcall prefix stream)))
 200 @end group
 201
 202 @group
 203 (defmethod stream-write-char ((stream prefixed-character-output-stream)
 204                               char)
 205   (with-accessors ((inner-stream stream-of) (cols col-index-of)
 206                    (prefix prefix-of)) stream
 207     (when (zerop cols)
 208       (write-prefix prefix inner-stream))
 209     (call-next-method)))
 210 @end group
 211 @end lisp
 212
 213 As with the example input stream, this implements only the minimal
 214 protocol.  A production implementation should also provide methods for
 215 at least @codew{stream-write-line}, @codew{stream-write-sequence}.
 216
 217 And here's a sample use of this class:
 218
 219 @lisp
 220 @group
 221 (flet ((format-timestamp (stream)
 222          (apply #'format stream "[~2@@*~2,' D:~1@@*~2,'0D:~0@@*~2,'0D] "
 223                 (multiple-value-list (get-decoded-time)))))
 224   (let ((output (make-instance 'prefixed-character-output-stream
 225                                :stream *standard-output*
 226                                :prefix #'format-timestamp)))
 227     (loop for string in '("abc" "def" "ghi") do
 228          (write-line string output)
 229          (sleep 1))))
 230 @end group
 231 @verbatim
 232 [ 0:30:05] abc
 233 [ 0:30:06] def
 234 [ 0:30:07] ghi
 235 NIL
 236 @end verbatim
 237 @end lisp
 238 @unmacro codew