1.0.3.18: Fix build on FreeBSD/amd64
[sbcl.git] / 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
137
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