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