/[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.1 - (hide annotations)
Tue May 5 00:33:20 1998 UTC (15 years, 11 months ago) by dtc
Branch: MAIN
Gray streams support for CMUCL.
1 dtc 1.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.1 1998/05/05 00:33:20 dtc Exp $")
8     ;;;
9     ;;; **********************************************************************
10     ;;;
11     ;;; Gray streams implementation for CMUCL.
12     ;;;
13    
14     (in-package "LISP")
15    
16    
17    
18     (fmakunbound 'stream-element-type)
19    
20     (defgeneric stream-element-type (stream)
21     (:documentation "Returns a type specifier for the kind of object returned by the Stream."))
22    
23     (defmethod stream-element-type ((stream lisp-stream))
24     (funcall (lisp-stream-misc stream) stream :element-type))
25    
26     (defmethod stream-element-type ((stream fundamental-character-stream))
27     'character)
28    
29    
30    
31     (defgeneric pcl-open-stream-p (stream)
32     (:documentation "Return true if Stream is not closed."))
33    
34     (defmethod pcl-open-stream-p ((stream lisp-stream))
35     (not (eq (lisp-stream-in stream) #'closed-flame)))
36    
37     (defmethod pcl-open-stream-p ((stream fundamental-stream))
38     nil)
39    
40     ;;; Bootstrapping hack.
41     (pcl-open-stream-p (make-string-output-stream))
42     (setf (fdefinition 'open-stream-p) #'pcl-open-stream-p)
43    
44    
45    
46    
47     (defgeneric pcl-close (stream &key abort)
48     (:documentation "Closes the given Stream. No more I/O may be performed, but inquiries
49     may still be made. If :Abort is non-nil, an attempt is made to clean
50     up the side effects of having created the stream."))
51    
52     (defmethod pcl-close ((stream lisp-stream) &key abort)
53     (when (open-stream-p stream)
54     (funcall (lisp-stream-misc stream) stream :close abort))
55     t)
56    
57     (setf (fdefinition 'close) #'pcl-close)
58    
59    
60    
61     (fmakunbound 'input-stream-p)
62    
63     (defgeneric input-stream-p (stream)
64     (:documentation "Returns non-nil if the given Stream can perform input operations."))
65    
66     (defmethod input-stream-p ((stream lisp-stream))
67     (and (not (eq (lisp-stream-in stream) #'closed-flame))
68     (or (not (eq (lisp-stream-in stream) #'ill-in))
69     (not (eq (lisp-stream-bin stream) #'ill-bin)))))
70    
71     (defmethod input-stream-p ((stream fundamental-input-stream))
72     t)
73    
74    
75    
76     (fmakunbound 'output-stream-p)
77    
78     (defgeneric output-stream-p (stream)
79     (:documentation "Returns non-nil if the given Stream can perform output operations."))
80    
81     (defmethod output-stream-p ((stream lisp-stream))
82     (and (not (eq (lisp-stream-in stream) #'closed-flame))
83     (or (not (eq (lisp-stream-out stream) #'ill-out))
84     (not (eq (lisp-stream-bout stream) #'ill-bout)))))
85    
86     (defmethod output-stream-p ((stream fundamental-output-stream))
87     t)
88    
89    
90     ;;; Character input streams.
91    
92     (defgeneric stream-read-char (stream)
93     (:documentation "Reads one character, :eof on end of file."))
94    
95     (defgeneric stream-unread-char (stream character)
96     (:documentation "Unreads one character, and returns nil."))
97    
98     (defgeneric stream-read-char-no-hang (stream)
99     (:documentation "Reads either a character, or NIL is none is available,
100     and :eof on end of file."))
101    
102     (defmethod stream-read-char-no-hang ((stream fundamental-character-input-stream))
103     (stream-read-char stream))
104    
105     (defgeneric stream-peek-char (stream)
106     (:documentation "Reads either a character or :eof without removing the character
107     from the stream."))
108    
109     (defmethod stream-peek-char ((stream fundamental-character-input-stream))
110     (let ((char (stream-read-char stream)))
111     (unless (eq char :eof)
112     (stream-unread-char stream char))
113     char))
114    
115     (defgeneric stream-listen (stream)
116     (:documentation "Return true if input is available, otherwise false."))
117    
118     (defmethod stream-listen ((stream fundamental-character-input-stream))
119     (let ((char (stream-read-char-no-hang stream)))
120     (when (characterp char)
121     (stream-unread-char stream char)
122     char)))
123    
124     (defgeneric stream-read-line (stream)
125     (:documentation "Reads the first line, and returns a string and T as the second
126     value if the line was terminated by end-of-file."))
127    
128     (defmethod stream-read-line ((stream fundamental-character-input-stream))
129     (let ((res (make-string 80))
130     (len 80)
131     (index 0))
132     (loop
133     (let ((ch (stream-read-char stream)))
134     (cond ((eq ch :eof)
135     (return (values (shrink-vector res index) t)))
136     (t
137     (when (char= ch #\newline)
138     (return (values (shrink-vector res index) nil)))
139     (when (= index len)
140     (setq len (* len 2))
141     (let ((new (make-string len)))
142     (replace new res)
143     (setq res new)))
144     (setf (schar res index) ch)
145     (incf index)))))))
146    
147     (defgeneric stream-clear-input (stream)
148     (:documentation "Clears buffered input, and returns Nil."))
149    
150     (defmethod stream-clear-input ((stream fundamental-character-input-stream))
151     nil)
152    
153    
154     ;;; Character output streams.
155    
156     (defgeneric stream-write-char (stream character)
157     (:documentation "Outputs the Character to the Stream."))
158    
159     (defgeneric stream-line-column (stream)
160     (:documentation "Return the current column number for the stream or Nil."))
161    
162     ;;; Stream-line-length is a CMUCL extension to Gray streams.
163     (defgeneric stream-line-length (stream)
164     (:documentation "Return the stream line length or Nil."))
165    
166     (defmethod stream-line-length ((stream fundamental-character-output-stream))
167     nil)
168    
169     (defgeneric stream-start-line-p (stream)
170     (:documentation "Return true when at the start of a line otherwise false."))
171    
172     (defmethod stream-start-line-p ((stream fundamental-character-output-stream))
173     (eql (stream-line-column stream) 0))
174    
175     (defgeneric stream-write-string (stream string &optional (start 0) end)
176     (:documentation "Outputs the String to the given Stream."))
177    
178     (defmethod stream-write-string ((stream fundamental-character-output-stream)
179     string &optional (start 0) end)
180     (declare (string string)
181     (fixnum start))
182     (let ((end (or end (length string))))
183     (declare (fixnum end))
184     (do ((pos start (1+ pos)))
185     ((>= pos end))
186     (declare (type index pos))
187     (stream-write-char stream (aref string pos))))
188     string)
189    
190     (defgeneric stream-terpri (stream)
191     (:documentation "Outputs a new line to the Stream."))
192    
193     (defmethod stream-terpri ((stream fundamental-character-output-stream))
194     (stream-write-char stream #\Newline))
195    
196     (defgeneric stream-fresh-line (stream)
197     (:documentation "Outputs a new line to the Stream if it is not positioned at the begining of
198     a line. Returns T if it output a new line, nil otherwise."))
199    
200     (defmethod stream-fresh-line ((stream fundamental-character-output-stream))
201     (unless (stream-start-line-p stream)
202     (stream-terpri stream)
203     t))
204    
205     (defgeneric stream-finish-output (stream)
206     (:documentation "Attempts to ensure that all output sent to the Stream has reached its
207     destination, and only then returns false."))
208    
209     (defmethod stream-finish-output ((stream fundamental-output-stream))
210     nil)
211    
212     (defgeneric stream-force-output (stream)
213     (:documentation "Attempts to force any buffered output to be sent."))
214    
215     (defmethod stream-force-output ((stream fundamental-output-stream))
216     nil)
217    
218     (defgeneric stream-clear-output (stream)
219     (:documentation "Clears the given output Stream."))
220    
221     (defmethod stream-clear-output ((stream fundamental-output-stream))
222     nil)
223    
224     (defgeneric stream-advance-to-column (stream column)
225     (:documentation "Write enough space to the stream so that the next character is
226     written to the given column. Returns true if successful, or false if not
227     supported."))
228    
229     (defmethod stream-advance-to-column ((stream fundamental-character-output-stream)
230     column)
231     (let ((current-column (stream-line-column stream)))
232     (when current-column
233     (let ((fill (- column current-column)))
234     (dotimes (i fill)
235     (stream-write-char stream #\Space)))
236     T)))
237    
238    
239     ;;; Binary streams.
240    
241     (defgeneric stream-read-byte (stream)
242     (:documentation "Returns an integer of :eof."))
243    
244     (defgeneric stream-write-byte (stream integer)
245     (:documentation "Writes integer to stream, returning integer."))
246    
247    
248     ;;; Example character output stream encapsulating a lisp-stream.
249     (defun make-character-output-stream (lisp-stream)
250     (declare (type lisp-stream lisp-stream))
251     (make-instance 'character-output-stream :lisp-stream lisp-stream))
252    
253     (defmethod open-stream-p ((stream character-output-stream))
254     (open-stream-p (character-output-stream-lisp-stream stream)))
255    
256     (defmethod close ((stream character-output-stream) &key abort)
257     (close (character-output-stream-lisp-stream stream) :abort abort))
258    
259     (defmethod input-stream-p ((stream character-output-stream))
260     (input-stream-p (character-output-stream-lisp-stream stream)))
261    
262     (defmethod output-stream-p ((stream character-output-stream))
263     (output-stream-p (character-output-stream-lisp-stream stream)))
264    
265     (defmethod stream-write-char ((stream character-output-stream) character)
266     (write-char character (character-output-stream-lisp-stream stream)))
267    
268     (defmethod stream-line-column ((stream character-output-stream))
269     (charpos (character-output-stream-lisp-stream stream)))
270    
271     (defmethod stream-line-length ((stream character-output-stream))
272     (line-length (character-output-stream-lisp-stream stream)))
273    
274     (defmethod stream-finish-output ((stream character-output-stream))
275     (finish-output (character-output-stream-lisp-stream stream)))
276    
277     (defmethod stream-force-output ((stream character-output-stream))
278     (force-output (character-output-stream-lisp-stream stream)))
279    
280     (defmethod stream-clear-output ((stream character-output-stream))
281     (clear-output (character-output-stream-lisp-stream stream)))
282    
283    
284     ;;; Example character input stream encapsulating a lisp-stream.
285    
286     (defun make-character-input-stream (lisp-stream)
287     (declare (type lisp-stream lisp-stream))
288     (make-instance 'character-input-stream :lisp-stream lisp-stream))
289    
290     (defmethod open-stream-p ((stream character-input-stream))
291     (open-stream-p (character-input-stream-lisp-stream stream)))
292    
293     (defmethod close ((stream character-input-stream) &key abort)
294     (close (character-input-stream-lisp-stream stream) :abort abort))
295    
296     (defmethod input-stream-p ((stream character-input-stream))
297     (input-stream-p (character-input-stream-lisp-stream stream)))
298    
299     (defmethod output-stream-p ((stream character-input-stream))
300     (output-stream-p (character-input-stream-lisp-stream stream)))
301    
302     (defmethod stream-read-char ((stream character-input-stream))
303     (read-char (character-input-stream-lisp-stream stream)))
304    
305     (defmethod stream-unread-char ((stream character-input-stream) character)
306     (unread-char character (character-input-stream-lisp-stream stream)))
307    
308     (defmethod stream-read-char-no-hang ((stream character-input-stream))
309     (read-char-no-hang (character-input-stream-lisp-stream stream) nil :eof))
310    
311     #+nil
312     (defmethod stream-peek-char ((stream character-input-stream))
313     (peek-char nil (character-input-stream-lisp-stream stream) nil :eof))
314    
315     #+nil
316     (defmethod stream-listen ((stream character-input-stream))
317     (listen (character-input-stream-lisp-stream stream)))
318    
319     (defmethod stream-clear-input ((stream character-input-stream))
320     (clear-input (character-input-stream-lisp-stream stream)))

  ViewVC Help
Powered by ViewVC 1.1.5