/[cmucl]/src/pcl/gray-streams.lisp
ViewVC logotype

Contents of /src/pcl/gray-streams.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Tue Jun 2 02:43:15 1998 UTC (15 years, 10 months ago) by dtc
Branch: MAIN
Branch point for: RELENG_18
Changes since 1.1: +124 -33 lines
Integrate some of the documentation from the original
stream-definition-by-user proposal by David N. Gray.
1 ;;;
2 ;;; **********************************************************************
3 ;;; This code was written by Douglas T. Crosher and has been placed in
4 ;;; the Public domain, and is provided 'as is'.
5 ;;;
6 (ext:file-comment
7 "$Header: /tiger/var/lib/cvsroots/cmucl/src/pcl/gray-streams.lisp,v 1.2 1998/06/02 02:43:15 dtc Exp $")
8 ;;;
9 ;;; **********************************************************************
10 ;;;
11 ;;; Gray streams implementation for CMUCL.
12 ;;; Based on the stream-definition-by-user proposal by David N. Gray.
13 ;;;
14
15 (in-package "LISP")
16
17
18
19 (fmakunbound 'stream-element-type)
20
21 (defgeneric stream-element-type (stream)
22 (:documentation
23 "Returns a type specifier for the kind of object returned by the
24 Stream. Class FUNDAMENTAL-CHARACTER-STREAM provides a default method
25 which returns CHARACTER."))
26
27 (defmethod stream-element-type ((stream lisp-stream))
28 (funcall (lisp-stream-misc stream) stream :element-type))
29
30 (defmethod stream-element-type ((stream fundamental-character-stream))
31 'character)
32
33
34
35 (defgeneric pcl-open-stream-p (stream)
36 (:documentation
37 "Return true if Stream is not closed. A default method is provided
38 by class FUNDAMENTAL-STREAM which returns true if CLOSE has not been
39 called on the stream."))
40
41 (defmethod pcl-open-stream-p ((stream lisp-stream))
42 (not (eq (lisp-stream-in stream) #'closed-flame)))
43
44 (defmethod pcl-open-stream-p ((stream fundamental-stream))
45 nil)
46
47 ;;; Bootstrapping hack.
48 (pcl-open-stream-p (make-string-output-stream))
49 (setf (fdefinition 'open-stream-p) #'pcl-open-stream-p)
50
51
52
53
54 (defgeneric pcl-close (stream &key abort)
55 (:documentation
56 "Closes the given Stream. No more I/O may be performed, but
57 inquiries may still be made. If :Abort is non-nil, an attempt is made
58 to clean up the side effects of having created the stream."))
59
60 (defmethod pcl-close ((stream lisp-stream) &key abort)
61 (when (open-stream-p stream)
62 (funcall (lisp-stream-misc stream) stream :close abort))
63 t)
64
65 (setf (fdefinition 'close) #'pcl-close)
66
67
68
69 (fmakunbound 'input-stream-p)
70
71 (defgeneric input-stream-p (stream)
72 (:documentation "Returns non-nil if the given Stream can perform input operations."))
73
74 (defmethod input-stream-p ((stream lisp-stream))
75 (and (not (eq (lisp-stream-in stream) #'closed-flame))
76 (or (not (eq (lisp-stream-in stream) #'ill-in))
77 (not (eq (lisp-stream-bin stream) #'ill-bin)))))
78
79 (defmethod input-stream-p ((stream fundamental-input-stream))
80 t)
81
82
83
84 (fmakunbound 'output-stream-p)
85
86 (defgeneric output-stream-p (stream)
87 (:documentation "Returns non-nil if the given Stream can perform output operations."))
88
89 (defmethod output-stream-p ((stream lisp-stream))
90 (and (not (eq (lisp-stream-in stream) #'closed-flame))
91 (or (not (eq (lisp-stream-out stream) #'ill-out))
92 (not (eq (lisp-stream-bout stream) #'ill-bout)))))
93
94 (defmethod output-stream-p ((stream fundamental-output-stream))
95 t)
96
97
98 ;;; Character input streams.
99 ;;;
100 ;;; A character input stream can be created by defining a class that
101 ;;; includes FUNDAMENTAL-CHARACTER-INPUT-STREAM and defining methods
102 ;;; for the generic functions below.
103
104 (defgeneric stream-read-char (stream)
105 (:documentation
106 "This reads one character from the stream. It returns either a
107 character object, or the symbol :EOF if the stream is at end-of-file.
108 Every subclass of FUNDAMENTAL-CHARACTER-INPUT-STREAM must define a
109 method for this function."))
110
111 (defgeneric stream-unread-char (stream character)
112 (:documentation
113 "Un-does the last call to STREAM-READ-CHAR, as in UNREAD-CHAR.
114 Returns NIL. Every subclass of FUNDAMENTAL-CHARACTER-INPUT-STREAM
115 must define a method for this function."))
116
117 (defgeneric stream-read-char-no-hang (stream)
118 (:documentation
119 "This is used to implement READ-CHAR-NO-HANG. It returns either a
120 character, or NIL if no input is currently available, or :EOF if
121 end-of-file is reached. The default method provided by
122 FUNDAMENTAL-CHARACTER-INPUT-STREAM simply calls STREAM-READ-CHAR; this
123 is sufficient for file streams, but interactive streams should define
124 their own method."))
125
126 (defmethod stream-read-char-no-hang ((stream fundamental-character-input-stream))
127 (stream-read-char stream))
128
129 (defgeneric stream-peek-char (stream)
130 (:documentation
131 "Used to implement PEEK-CHAR; this corresponds to peek-type of NIL.
132 It returns either a character or :EOF. The default method calls
133 STREAM-READ-CHAR and STREAM-UNREAD-CHAR."))
134
135 (defmethod stream-peek-char ((stream fundamental-character-input-stream))
136 (let ((char (stream-read-char stream)))
137 (unless (eq char :eof)
138 (stream-unread-char stream char))
139 char))
140
141 (defgeneric stream-listen (stream)
142 (:documentation
143 "Used by LISTEN. Returns true or false. The default method uses
144 STREAM-READ-CHAR-NO-HANG and STREAM-UNREAD-CHAR. Most streams should
145 define their own method since it will usually be trivial and will
146 always be more efficient than the default method."))
147
148 (defmethod stream-listen ((stream fundamental-character-input-stream))
149 (let ((char (stream-read-char-no-hang stream)))
150 (when (characterp char)
151 (stream-unread-char stream char)
152 t)))
153
154 (defgeneric stream-read-line (stream)
155 (:documentation
156 "Used by READ-LINE. A string is returned as the first value. The
157 second value is true if the string was terminated by end-of-file
158 instead of the end of a line. The default method uses repeated
159 calls to STREAM-READ-CHAR."))
160
161 (defmethod stream-read-line ((stream fundamental-character-input-stream))
162 (let ((res (make-string 80))
163 (len 80)
164 (index 0))
165 (loop
166 (let ((ch (stream-read-char stream)))
167 (cond ((eq ch :eof)
168 (return (values (shrink-vector res index) t)))
169 (t
170 (when (char= ch #\newline)
171 (return (values (shrink-vector res index) nil)))
172 (when (= index len)
173 (setq len (* len 2))
174 (let ((new (make-string len)))
175 (replace new res)
176 (setq res new)))
177 (setf (schar res index) ch)
178 (incf index)))))))
179
180 (defgeneric stream-clear-input (stream)
181 (:documentation
182 "Implements CLEAR-INPUT for the stream, returning NIL. The default
183 method does nothing."))
184
185 (defmethod stream-clear-input ((stream fundamental-character-input-stream))
186 nil)
187
188
189 ;;; Character output streams.
190 ;;;
191 ;;; A character output stream can be created by defining a class that
192 ;;; includes FUNDAMENTAL-CHARACTER-OUTPUT-STREAM and defining methods
193 ;;; for the generic functions below.
194
195 (defgeneric stream-write-char (stream character)
196 (:documentation
197 "Writes character to the stream and returns the character. Every
198 subclass of FUNDAMENTAL-CHARACTER-OUTPUT-STREAM must have a method
199 defined for this function."))
200
201 (defgeneric stream-line-column (stream)
202 (:documentation
203 "This function returns the column number where the next character
204 will be written, or NIL if that is not meaningful for this stream.
205 The first column on a line is numbered 0. This function is used in
206 the implementation of PPRINT and the FORMAT ~T directive. For every
207 character output stream class that is defined, a method must be
208 defined for this function, although it is permissible for it to
209 always return NIL."))
210
211 ;;; Stream-line-length is a CMUCL extension to Gray streams.
212 (defgeneric stream-line-length (stream)
213 (:documentation "Return the stream line length or Nil."))
214
215 (defmethod stream-line-length ((stream fundamental-character-output-stream))
216 nil)
217
218 (defgeneric stream-start-line-p (stream)
219 (:documentation
220 "This is a predicate which returns T if the stream is positioned at
221 the beginning of a line, else NIL. It is permissible to always return
222 NIL. This is used in the implementation of FRESH-LINE. Note that
223 while a value of 0 from STREAM-LINE-COLUMN also indicates the
224 beginning of a line, there are cases where STREAM-START-LINE-P can be
225 meaningfully implemented although STREAM-LINE-COLUMN can't be. For
226 example, for a window using variable-width characters, the column
227 number isn't very meaningful, but the beginning of the line does have
228 a clear meaning. The default method for STREAM-START-LINE-P on class
229 FUNDAMENTAL-CHARACTER-OUTPUT-STREAM uses STREAM-LINE-COLUMN, so if
230 that is defined to return NIL, then a method should be provided for
231 either STREAM-START-LINE-P or STREAM-FRESH-LINE."))
232
233 (defmethod stream-start-line-p ((stream fundamental-character-output-stream))
234 (eql (stream-line-column stream) 0))
235
236 (defgeneric stream-write-string (stream string &optional (start 0) end)
237 (:documentation
238 "This is used by WRITE-STRING. It writes the string to the stream,
239 optionally delimited by start and end, which default to 0 and NIL.
240 The string argument is returned. The default method provided by
241 FUNDAMENTAL-CHARACTER-OUTPUT-STREAM uses repeated calls to
242 STREAM-WRITE-CHAR."))
243
244 (defmethod stream-write-string ((stream fundamental-character-output-stream)
245 string &optional (start 0) end)
246 (declare (string string)
247 (fixnum start))
248 (let ((end (or end (length string))))
249 (declare (fixnum end))
250 (do ((pos start (1+ pos)))
251 ((>= pos end))
252 (declare (type index pos))
253 (stream-write-char stream (aref string pos))))
254 string)
255
256 (defgeneric stream-terpri (stream)
257 (:documentation
258 "Writes an end of line, as for TERPRI. Returns NIL. The default
259 method does (STREAM-WRITE-CHAR stream #\NEWLINE)."))
260
261 (defmethod stream-terpri ((stream fundamental-character-output-stream))
262 (stream-write-char stream #\Newline))
263
264 (defgeneric stream-fresh-line (stream)
265 (:documentation
266 "Outputs a new line to the Stream if it is not positioned at the
267 begining of a line. Returns T if it output a new line, nil
268 otherwise. Used by FRESH-LINE. The default method uses
269 STREAM-START-LINE-P and STREAM-TERPRI."))
270
271 (defmethod stream-fresh-line ((stream fundamental-character-output-stream))
272 (unless (stream-start-line-p stream)
273 (stream-terpri stream)
274 t))
275
276 (defgeneric stream-finish-output (stream)
277 (:documentation
278 "Attempts to ensure that all output sent to the Stream has reached
279 its destination, and only then returns false. Implements
280 FINISH-OUTPUT. The default method does nothing."))
281
282 (defmethod stream-finish-output ((stream fundamental-output-stream))
283 nil)
284
285 (defgeneric stream-force-output (stream)
286 (:documentation
287 "Attempts to force any buffered output to be sent. Implements
288 FORCE-OUTPUT. The default method does nothing."))
289
290 (defmethod stream-force-output ((stream fundamental-output-stream))
291 nil)
292
293 (defgeneric stream-clear-output (stream)
294 (:documentation
295 "Clears the given output Stream. Implements CLEAR-OUTPUT. The
296 default method does nothing."))
297
298 (defmethod stream-clear-output ((stream fundamental-output-stream))
299 nil)
300
301 (defgeneric stream-advance-to-column (stream column)
302 (:documentation
303 "Writes enough blank space so that the next character will be
304 written at the specified column. Returns true if the operation is
305 successful, or NIL if it is not supported for this stream. This is
306 intended for use by by PPRINT and FORMAT ~T. The default method uses
307 STREAM-LINE-COLUMN and repeated calls to STREAM-WRITE-CHAR with a
308 #\SPACE character; it returns NIL if STREAM-LINE-COLUMN returns NIL."))
309
310 (defmethod stream-advance-to-column ((stream fundamental-character-output-stream)
311 column)
312 (let ((current-column (stream-line-column stream)))
313 (when current-column
314 (let ((fill (- column current-column)))
315 (dotimes (i fill)
316 (stream-write-char stream #\Space)))
317 T)))
318
319
320 ;;; Binary streams.
321 ;;;
322 ;;; Binary streams can be created by defining a class that includes
323 ;;; either FUNDAMENTAL-BINARY-INPUT-STREAM or
324 ;;; FUNDAMENTAL-BINARY-OUTPUT-STREAM (or both) and defining a method
325 ;;; for STREAM-ELEMENT-TYPE and for one or both of the following
326 ;;; generic functions.
327
328 (defgeneric stream-read-byte (stream)
329 (:documentation
330 "Used by READ-BYTE; returns either an integer, or the symbol :EOF
331 if the stream is at end-of-file."))
332
333 (defgeneric stream-write-byte (stream integer)
334 (:documentation
335 "Implements WRITE-BYTE; writes the integer to the stream and
336 returns the integer as the result."))
337
338
339 ;;; Example character output stream encapsulating a lisp-stream.
340 (defun make-character-output-stream (lisp-stream)
341 (declare (type lisp-stream lisp-stream))
342 (make-instance 'character-output-stream :lisp-stream lisp-stream))
343
344 (defmethod open-stream-p ((stream character-output-stream))
345 (open-stream-p (character-output-stream-lisp-stream stream)))
346
347 (defmethod close ((stream character-output-stream) &key abort)
348 (close (character-output-stream-lisp-stream stream) :abort abort))
349
350 (defmethod input-stream-p ((stream character-output-stream))
351 (input-stream-p (character-output-stream-lisp-stream stream)))
352
353 (defmethod output-stream-p ((stream character-output-stream))
354 (output-stream-p (character-output-stream-lisp-stream stream)))
355
356 (defmethod stream-write-char ((stream character-output-stream) character)
357 (write-char character (character-output-stream-lisp-stream stream)))
358
359 (defmethod stream-line-column ((stream character-output-stream))
360 (charpos (character-output-stream-lisp-stream stream)))
361
362 (defmethod stream-line-length ((stream character-output-stream))
363 (line-length (character-output-stream-lisp-stream stream)))
364
365 (defmethod stream-finish-output ((stream character-output-stream))
366 (finish-output (character-output-stream-lisp-stream stream)))
367
368 (defmethod stream-force-output ((stream character-output-stream))
369 (force-output (character-output-stream-lisp-stream stream)))
370
371 (defmethod stream-clear-output ((stream character-output-stream))
372 (clear-output (character-output-stream-lisp-stream stream)))
373
374
375 ;;; Example character input stream encapsulating a lisp-stream.
376
377 (defun make-character-input-stream (lisp-stream)
378 (declare (type lisp-stream lisp-stream))
379 (make-instance 'character-input-stream :lisp-stream lisp-stream))
380
381 (defmethod open-stream-p ((stream character-input-stream))
382 (open-stream-p (character-input-stream-lisp-stream stream)))
383
384 (defmethod close ((stream character-input-stream) &key abort)
385 (close (character-input-stream-lisp-stream stream) :abort abort))
386
387 (defmethod input-stream-p ((stream character-input-stream))
388 (input-stream-p (character-input-stream-lisp-stream stream)))
389
390 (defmethod output-stream-p ((stream character-input-stream))
391 (output-stream-p (character-input-stream-lisp-stream stream)))
392
393 (defmethod stream-read-char ((stream character-input-stream))
394 (read-char (character-input-stream-lisp-stream stream)))
395
396 (defmethod stream-unread-char ((stream character-input-stream) character)
397 (unread-char character (character-input-stream-lisp-stream stream)))
398
399 (defmethod stream-read-char-no-hang ((stream character-input-stream))
400 (read-char-no-hang (character-input-stream-lisp-stream stream) nil :eof))
401
402 #+nil
403 (defmethod stream-peek-char ((stream character-input-stream))
404 (peek-char nil (character-input-stream-lisp-stream stream) nil :eof))
405
406 #+nil
407 (defmethod stream-listen ((stream character-input-stream))
408 (listen (character-input-stream-lisp-stream stream)))
409
410 (defmethod stream-clear-input ((stream character-input-stream))
411 (clear-input (character-input-stream-lisp-stream stream)))

  ViewVC Help
Powered by ViewVC 1.1.5