source: trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp @ 12373

Last change on this file since 12373 was 12373, checked in by ehuelsmann, 12 years ago

Change parents of FUNDAMENTAL-STREAM in Gray streams.

Note: includes experimental removal of override of TWO-WAY-STREAM.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 22.7 KB
Line 
1;;; gray-streams.lisp
2;;;
3;;; Copyright (C) 2004-2007 Peter Graves, Andras Simon
4;;; $Id: gray-streams.lisp 12373 2010-01-13 19:55:22Z ehuelsmann $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
19;;;
20;;; As a special exception, the copyright holders of this library give you
21;;; permission to link this library with independent modules to produce an
22;;; executable, regardless of the license terms of these independent
23;;; modules, and to copy and distribute the resulting executable under
24;;; terms of your choice, provided that you also meet, for each linked
25;;; independent module, the terms and conditions of the license of that
26;;; module.  An independent module is a module which is not derived from
27;;; or based on this library.  If you modify this library, you may extend
28;;; this exception to your version of the library, but you are not
29;;; obligated to do so.  If you do not wish to do so, delete this
30;;; exception statement from your version.
31
32;;; Adapted from:
33;;;; Gray Streams Implementation for Corman Lisp - Version 1.3
34;;;;
35;;;; Copyright (C) 2000 Christopher Double. All Rights Reserved.
36;;;;
37;;;; License
38;;;; =======
39;;;; This software is provided 'as-is', without any express or implied
40;;;; warranty. In no event will the author be held liable for any damages
41;;;; arising from the use of this software.
42;;;;
43;;;; Permission is granted to anyone to use this software for any purpose,
44;;;; including commercial applications, and to alter it and redistribute
45;;;; it freely, subject to the following restrictions:
46;;;;
47;;;; 1. The origin of this software must not be misrepresented; you must
48;;;;    not claim that you wrote the original software. If you use this
49;;;;    software in a product, an acknowledgment in the product documentation
50;;;;    would be appreciated but is not required.
51;;;;
52;;;; 2. Altered source versions must be plainly marked as such, and must
53;;;;    not be misrepresented as being the original software.
54;;;;
55;;;; 3. This notice may not be removed or altered from any source
56;;;;    distribution.
57;;;;
58;;;; Notes
59;;;; =====
60;;;; A simple implementation of Gray streams for Corman Lisp 1.42.
61;;;; Gray streams are 'clos' based streams as described at:
62;;;;
63;;;; ftp://parcftp.xerox.com/pub/cl/cleanup/mail/stream-definition-by-user.mail
64;;;;
65;;;; Some differences exist between this implementation and the
66;;;; specification above. See notes below for details.
67;;;;
68;;;; More recent versions of this software may be available at:
69;;;;   http://www.double.co.nz/cl
70;;;;
71;;;; Comments, suggestions and bug reports to the author,
72;;;; Christopher Double, at: chris@double.co.nz
73;;;;
74;;;; 03/03/2001 - 1.0
75;;;;              Initial release.
76;;;;
77;;;; 20/08/2001 - 1.1
78;;;;              Small modifications by Frederic Bastenaire (fba@free.fr)
79;;;;              (lines flagged by  ;; # fb 1.01)
80;;;;              - Make it work with the READ function by
81;;;;                defining %read-char, %read-char-with-error
82;;;;               and input-character-stream-p
83;;;;              - Add nickname GS to package "GRAY-STREAMS" for ease of use
84;;;;              - added missing '*' to *old-write-byte* in gray-write-byte
85;;;;
86;;;; 03/01/2002 - 1.2
87;;;;              Fixed bug with GRAY-WRITE-LINE and GRAY-WRITE-STRING
88;;;;              that appeared in Corman Lisp 2.0 due to changes to
89;;;;              WRITE-LINE and WRITE-STRING.
90;;;;
91;;;; 04/01/2002 - 1.3
92;;;;              Added support for STREAM-READ-SEQUENCE and STREAM-WRITE-SEQUENCE.
93;;;;              Fixed STREAM-WRITE-STRING bug.
94;;;;
95;;;; Notes
96;;;; =====
97;;;;
98;;;;
99;;;; Much of the implementation of the Gray streams below is from the
100;;;; document referenced earlier.
101;;;;
102(defpackage "GRAY-STREAMS"
103  (:use
104   "COMMON-LISP")
105  (:nicknames "GS") ;; # fb 1.01
106  (:export
107   "FUNDAMENTAL-STREAM"
108   "STREAM-OPEN-STREAM-P"
109   "STREAM-STREAMP"
110   "STREAM-INPUT-STREAM-P"
111   "STREAM-OUTPUT-STREAM-P"
112   "STREAM-STREAM-ELEMENT-TYPE"
113   "STREAM-CLOSE"
114   "FUNDAMENTAL-OUTPUT-STREAM"
115   "FUNDAMENTAL-INPUT-STREAM"
116   "FUNDAMENTAL-CHARACTER-STREAM"
117   "FUNDAMENTAL-BINARY-STREAM"
118   "STREAM-READ-BYTE"
119   "STREAM-WRITE-BYTE"
120   "FUNDAMENTAL-CHARACTER-INPUT-STREAM"
121   "STREAM-READ-CHAR"
122   "STREAM-UNREAD-CHAR"
123   "STREAM-READ-CHAR-NO-HANG"
124   "STREAM-PEEK-CHAR"
125   "STREAM-LISTEN"
126   "STREAM-READ-LINE"
127   "STREAM-CLEAR-INPUT"
128   "FUNDAMENTAL-CHARACTER-OUTPUT-STREAM"
129   "STREAM-WRITE-CHAR"
130   "STREAM-LINE-COLUMN"
131   "STREAM-START-LINE-P"
132   "STREAM-WRITE-STRING"
133   "STREAM-TERPRI"
134   "STREAM-FRESH-LINE"
135   "STREAM-FINISH-OUTPUT"
136   "STREAM-FORCE-OUTPUT"
137   "STREAM-CLEAR-OUTPUT"
138   "STREAM-ADVANCE-TO-COLUMN"
139   "STREAM-READ-SEQUENCE"
140   "STREAM-WRITE-SEQUENCE"
141   "FUNDAMENTAL-BINARY-INPUT-STREAM"
142   "FUNDAMENTAL-BINARY-OUTPUT-STREAM"))
143
144(in-package :gray-streams)
145
146(defvar *old-read-char* #'read-char)
147(defvar *old-peek-char* #'peek-char)
148(defvar *old-unread-char* #'unread-char)
149(defvar *old-listen* nil)
150(defvar *old-read-line* #'read-line)
151(defvar *old-read-char-no-hang* #'read-char-no-hang)
152(defvar *old-write-char* #'write-char)
153(defvar *old-fresh-line* #'fresh-line)
154(defvar *old-terpri* #'terpri)
155(defvar *old-write-string* #'write-string)
156(defvar *old-write-line* #'write-line)
157(defvar *old-force-output* #'sys::%force-output)
158(defvar *old-finish-output* #'sys::%finish-output)
159(defvar *old-clear-output* #'sys::%clear-output)
160(defvar *old-clear-input* #'clear-input)
161(defvar *old-read-byte* #'read-byte)
162(defvar *old-write-byte* #'write-byte)
163(defvar *old-stream-element-type* #'cl::stream-element-type)
164(defvar *old-close* #'cl::close)
165(defvar *old-input-character-stream-p*
166  #'(lambda (s) (and (input-stream-p s) (eql (stream-element-type s) 'character))))
167(defvar *old-input-stream-p* #'cl::input-stream-p)
168(defvar *old-output-stream-p* #'cl::output-stream-p)
169(defvar *old-open-stream-p* #'cl::open-stream-p)
170(defvar *old-streamp* #'cl::streamp)
171(defvar *old-read-sequence* #'cl::read-sequence)
172(defvar *old-write-sequence* #'cl::write-sequence)
173(defvar *old-make-two-way-stream* #'cl:make-two-way-stream)
174(defvar *old-two-way-stream-input-stream* #'cl:two-way-stream-input-stream)
175(defvar *old-two-way-stream-output-stream* #'cl:two-way-stream-output-stream)
176
177
178(defun old-streamp (stream)
179  (or (xp::xp-structure-p stream)
180      (funcall *old-streamp* stream)))
181
182(defclass fundamental-stream (standard-object stream))
183
184(defgeneric gray-close (stream &key abort))
185(defgeneric gray-open-stream-p (stream))
186(defgeneric gray-streamp (stream))
187(defgeneric gray-input-stream-p (stream))
188(defgeneric gray-input-character-stream-p (stream)) ;; # fb 1.01
189(defgeneric gray-output-stream-p (stream))
190(defgeneric gray-stream-element-type (stream))
191
192
193(defmethod stream-streamp ((s fundamental-stream))
194  s)
195
196(defclass fundamental-input-stream (fundamental-stream))
197
198(defmethod stream-input-character-stream-p (s)  ;; # fb 1.01
199  (and (stream-input-stream-p s)
200       (eq (stream-stream-element-type s) 'character)))
201
202(defmethod stream-input-stream-p ((s fundamental-input-stream))
203  (declare (ignore s))
204  t)
205
206(defclass fundamental-output-stream (fundamental-stream))
207
208(defmethod stream-output-stream-p ((s fundamental-output-stream))
209  (declare (ignore s))
210  t)
211
212(defclass fundamental-character-stream (fundamental-stream))
213
214(defmethod stream-stream-element-type ((s fundamental-character-stream))
215  (declare (ignore s))
216  'character)
217
218(defclass fundamental-binary-stream (fundamental-stream))
219
220(defgeneric stream-read-byte (stream))
221(defgeneric stream-write-byte (stream integer))
222
223(defclass fundamental-character-input-stream
224  (fundamental-input-stream fundamental-character-stream))
225
226(defgeneric stream-read-char (stream))
227(defgeneric stream-unread-char (stream character))
228(defgeneric stream-read-char-no-hang (stream))
229(defgeneric stream-peek-char (stream))
230(defgeneric stream-listen (stream))
231(defgeneric stream-read-line (stream))
232(defgeneric stream-clear-input (stream))
233
234(defmethod stream-peek-char ((stream fundamental-character-input-stream))
235  (let ((character (stream-read-char stream)))
236    (unless (eq character :eof)
237      (stream-unread-char stream character))
238    character))
239
240(defmethod stream-listen ((stream  fundamental-character-input-stream))
241  (let ((char (stream-read-char-no-hang stream)))
242    (and (not (null char))
243         (not (eq char :eof))
244         (progn
245           (stream-unread-char stream char)
246           t))))
247
248(defmethod stream-read-line ((stream  fundamental-character-input-stream))
249  (let ((line (make-array 64
250                          :element-type 'character
251                          :fill-pointer 0
252                          :adjustable t)))
253    (loop
254      (let ((character (stream-read-char stream)))
255        (if (eq character :eof)
256            (return (values line t))
257            (if (eql character #\Newline)
258                (return (values line nil))
259                (vector-push-extend character line)))))))
260
261(defmethod stream-clear-input (stream)
262  (declare (ignore stream))
263  nil)
264
265(defclass fundamental-character-output-stream
266  (fundamental-output-stream fundamental-character-stream))
267
268(defgeneric stream-write-char (stream character))
269(defgeneric stream-line-column (stream))
270(defgeneric stream-start-line-p (stream))
271(defgeneric stream-write-string (stream string &optional start end))
272(defgeneric stream-terpri (stream))
273(defmethod stream-terpri (stream)
274  (stream-write-char stream #\Newline))
275
276(defgeneric stream-fresh-line (stream))
277(defgeneric stream-finish-output (stream))
278(defgeneric stream-force-output (stream))
279(defgeneric stream-clear-output (stream))
280(defgeneric stream-advance-to-column (stream column))
281(defgeneric stream-read-sequence (stream sequence &optional start end))
282(defgeneric stream-write-sequence (stream sequence &optional start end))
283
284(defmethod stream-force-output (stream)
285  (declare (ignore stream))
286  nil)
287
288(defmethod stream-clear-output (stream)
289  (declare (ignore stream))
290  nil)
291
292(defmethod stream-start-line-p ((stream fundamental-character-output-stream))
293  (equal (stream-line-column stream) 0))
294
295(defmethod stream-write-string ((stream fundamental-character-output-stream)
296                                string
297                                &optional (start 0) end)
298  (let ((end (or end (length string))))
299    (do ((i start (1+ i)))
300        ((>= i end) string)
301      (stream-write-char stream (char string i)))))
302
303(defmethod stream-fresh-line ((stream fundamental-character-output-stream))
304  (if (stream-start-line-p stream)
305      nil
306      (progn
307        (stream-terpri stream)
308        t)))
309
310(defmethod stream-advance-to-column ((stream fundamental-character-output-stream)
311                                     column)
312  (let ((current (stream-line-column stream)))
313    (unless (null current)
314      (dotimes (i (- current column) t)
315        (stream-write-char stream #\Space)))))
316
317(defmethod stream-read-sequence ((stream  fundamental-character-input-stream)
318                                 sequence &optional (start 0) end)
319  (let ((element-type (stream-element-type stream))
320        (end (or end (length sequence)))
321        (eof (cons nil nil)))
322    (cond
323     ((eq element-type 'character)
324      (dotimes (count (- end start) (- end start))
325        (let ((c (stream-read-char stream nil eof)))
326          (if (eq c eof)
327              (return (+ count start)))
328          (setf (elt sequence (+ count start)) c))))
329     ((or (eq element-type 'byte)
330          (eq element-type 'unsigned-byte)
331          (eq element-type 'signed-byte))
332      (dotimes (count (- end start) (- end start))
333        (let ((b (stream-read-byte stream nil eof)))
334          (if (eq b eof)
335              (return (+ count start)))
336          (setf (elt sequence (+ count start)) b))))
337     (t (error "Cannot READ-SEQUENCE on stream of :ELEMENT-TYPE ~A"
338               element-type)))))
339
340(defmethod stream-write-sequence ((stream fundamental-character-output-stream)
341                                  sequence &optional (start 0) end)
342  (let ((element-type (stream-element-type stream))
343        (end (or end (length sequence))))
344    (if (eq element-type 'character)
345        (do ((n start (+ n 1)))
346            ((= n end))
347          (stream-write-char
348           stream
349           (if (typep (elt sequence n) 'number)
350               (#+nil ccl:int-char code-char (elt sequence n))
351               (elt sequence n))))
352        (do ((n start (+ n 1)))
353            ((= n end))
354          (stream-write-byte (elt sequence n) stream))))    ;; recoded to avoid LOOP, because it isn't loaded yet
355  (stream-force-output stream))
356
357(defclass fundamental-binary-input-stream
358  (fundamental-input-stream fundamental-binary-stream))
359
360(defclass fundamental-binary-output-stream
361  (fundamental-output-stream fundamental-binary-stream))
362
363(defun decode-read-arg (arg)
364  (cond ((null arg) *standard-input*)
365        ((eq arg t) *terminal-io*)
366        (t arg)))
367
368(defun decode-print-arg (arg)
369  (cond ((null arg) *standard-output*)
370        ((eq arg t) *terminal-io*)
371        (t arg)))
372
373(defun report-eof (stream eof-errorp eof-value)
374  (if eof-errorp
375      (error 'end-of-file :stream stream)
376      eof-value))
377
378(defun check-for-eof (value stream eof-errorp eof-value)
379  (if (eq value :eof)
380      (report-eof stream eof-errorp eof-value)
381      value))
382
383(defun gray-read-char (&optional input-stream (eof-errorp t) eof-value recursive-p)
384  (let ((stream (decode-read-arg input-stream)))
385    (if (old-streamp stream)
386        (funcall *old-read-char* stream eof-errorp eof-value recursive-p)
387        (check-for-eof (stream-read-char stream) stream eof-errorp eof-value))))
388
389(defun gray-peek-char (&optional peek-type input-stream (eof-errorp t)
390                                 eof-value recursive-p)
391  (let ((stream (decode-read-arg input-stream)))
392    (if (old-streamp stream)
393        (funcall *old-peek-char* peek-type stream eof-errorp eof-value recursive-p)
394        (if (null peek-type)
395            (check-for-eof (stream-peek-char stream) stream eof-errorp eof-value)
396            (loop
397              (let ((value (stream-peek-char stream)))
398                (if (eq value :eof)
399                    (return (report-eof stream eof-errorp eof-value))
400                    (if (if (eq peek-type t)
401                            (not (member value
402                                         '(#\space #\tab #\newline #\return)))
403                            (char= peek-type value))
404                        (return value)
405                        (stream-read-char stream)))))))))
406
407(defun gray-unread-char (character &optional input-stream)
408  (let ((stream (decode-read-arg input-stream)))
409    (if (old-streamp stream)
410        (funcall *old-unread-char* character stream)
411        (stream-unread-char stream character))))
412
413(defun gray-listen (&optional input-stream)
414  (let ((stream (decode-read-arg input-stream)))
415    (if (old-streamp stream)
416        (funcall *old-listen* stream)
417        (stream-listen stream))))
418
419(defun gray-read-line (&optional input-stream (eof-error-p t)
420                                 eof-value recursive-p)
421  (let ((stream (decode-read-arg input-stream)))
422    (if (old-streamp stream)
423        (funcall *old-read-line* stream eof-error-p eof-value recursive-p)
424        (multiple-value-bind (string eofp)
425          (stream-read-line stream)
426          (if eofp
427              (if (= (length string) 0)
428                  (report-eof stream eof-error-p eof-value)
429                  (values string t))
430              (values string nil))))))
431
432(defun gray-clear-input (&optional input-stream)
433  (let ((stream (decode-read-arg input-stream)))
434    (if (old-streamp stream)
435        (funcall *old-clear-input* stream)
436        (stream-clear-input stream))))
437
438(defun gray-read-char-no-hang (&optional input-stream (eof-errorp t)
439                                         eof-value recursive-p)
440  (let ((stream (decode-read-arg input-stream)))
441    (if (old-streamp stream)
442        (funcall *old-read-char-no-hang* stream eof-errorp eof-value recursive-p)
443        (check-for-eof (stream-read-char-no-hang stream)
444                       stream eof-errorp eof-value))))
445
446(defun gray-write-char (character &optional output-stream)
447  (let ((stream (decode-print-arg output-stream)))
448    (if (old-streamp stream)
449        (funcall *old-write-char* character stream)
450        (stream-write-char stream character))))
451
452(defun gray-fresh-line (&optional output-stream)
453  (let ((stream (decode-print-arg output-stream)))
454    (if (old-streamp stream)
455        (funcall *old-fresh-line* stream)
456        (stream-fresh-line stream))))
457
458(defun gray-terpri (&optional output-stream)
459  (let ((stream (decode-print-arg output-stream)))
460    (if (old-streamp stream)
461        (funcall *old-terpri* stream)
462        (stream-terpri stream))))
463
464(defun gray-write-string (string &optional output-stream &key (start 0) end)
465  (let ((stream (decode-print-arg output-stream)))
466    (if (old-streamp stream)
467        (funcall *old-write-string* string stream :start start :end end)
468        (stream-write-string stream string start end))))
469
470(defun gray-write-line (string &optional output-stream &key (start 0) end)
471  (let ((stream (decode-print-arg output-stream)))
472    (if (old-streamp stream)
473        (funcall *old-write-line* string stream :start start :end end)
474        (progn
475          (stream-write-string stream string start end)
476          (stream-terpri stream)
477          string))))
478
479(defun gray-force-output (&optional output-stream)
480  (let ((stream (decode-print-arg output-stream)))
481    (if (old-streamp stream)
482        (funcall *old-force-output* stream)
483        (stream-force-output stream))))
484
485(defun gray-finish-output (&optional output-stream)
486  (let ((stream (decode-print-arg output-stream)))
487    (if (old-streamp stream)
488        (funcall *old-finish-output* stream)
489        (stream-finish-output stream))))
490
491(defun gray-clear-output (&optional output-stream)
492  (let ((stream (decode-print-arg output-stream)))
493    (if (old-streamp stream)
494        (funcall *old-clear-output* stream)
495        (stream-clear-output stream))))
496
497(defun gray-read-byte (binary-input-stream &optional (eof-errorp t) eof-value)
498  (if (old-streamp binary-input-stream)
499      (funcall *old-read-byte* binary-input-stream eof-errorp eof-value)
500      (check-for-eof (stream-read-byte binary-input-stream)
501                     binary-input-stream eof-errorp eof-value)))
502
503(defun gray-write-byte (integer binary-output-stream)
504  (if (old-streamp binary-output-stream)
505      (funcall *old-write-byte* integer binary-output-stream)
506      (stream-write-byte binary-output-stream integer)))
507
508(defmethod stream-line-column ((stream stream))
509  nil)
510
511(defun gray-stream-column (&optional input-stream)
512  (let ((stream (decode-read-arg input-stream)))
513    (if (old-streamp stream)
514        nil ;(funcall *old-stream-column* stream)
515        (stream-line-column stream))))
516
517(defmethod gray-stream-element-type (stream)
518  (funcall *old-stream-element-type* stream))
519
520(defmethod gray-close (stream &key abort)
521  (funcall *old-close* stream :abort abort))
522
523(defmethod gray-input-stream-p (stream)
524  (funcall *old-input-stream-p* stream))
525
526(defmethod gray-input-character-stream-p (stream)
527  (funcall *old-input-character-stream-p* stream))
528
529(defmethod gray-output-stream-p (stream)
530  (funcall *old-output-stream-p* stream))
531
532(defmethod gray-open-stream-p (stream)
533  (funcall *old-open-stream-p* stream))
534
535(defmethod gray-streamp (stream)
536  (funcall *old-streamp* stream))
537
538(defun gray-write-sequence (sequence stream &key (start 0) end)
539  (if (old-streamp stream)
540      (funcall *old-write-sequence* sequence stream :start start :end end)
541      (stream-write-sequence stream sequence start end)))
542
543(defun gray-read-sequence (sequence stream &key (start 0) end)
544  (if (old-streamp stream)
545      (funcall *old-read-sequence* sequence stream :start start :end end)
546      (stream-read-sequence stream sequence start end)))
547
548#|
549(defstruct (two-way-stream-g (:include stream))
550  input-stream output-stream)
551
552(defun gray-make-two-way-stream (in out)
553  (if (and (old-streamp in) (old-streamp out))
554      (funcall *old-make-two-way-stream* in out)
555      (make-two-way-stream-g :input-stream in :output-stream out)))
556
557(defun gray-two-way-stream-input-stream (stream)
558  (if (old-streamp stream)
559      (funcall *old-two-way-stream-input-stream* stream)
560      (two-way-stream-g-input-stream stream)))
561
562(defun gray-two-way-stream-output-stream (stream)
563  (if (old-streamp stream)
564      (funcall *old-two-way-stream-output-stream* stream)
565      (two-way-stream-g-output-stream stream)))
566
567|#
568
569(setf (symbol-function 'common-lisp::read-char) #'gray-read-char)
570(setf (symbol-function 'common-lisp::peek-char) #'gray-peek-char)
571(setf (symbol-function 'common-lisp::unread-char) #'gray-unread-char)
572(setf (symbol-function 'common-lisp::read-line) #'gray-read-line)
573(setf (symbol-function 'common-lisp::clear-input) #'gray-clear-input)
574(setf (symbol-function 'common-lisp::read-char-no-hang) #'gray-read-char-no-hang)
575(setf (symbol-function 'common-lisp::write-char) #'gray-write-char)
576(setf (symbol-function 'common-lisp::fresh-line) #'gray-fresh-line)
577(setf (symbol-function 'common-lisp::terpri) #'gray-terpri)
578(setf (symbol-function 'common-lisp::write-string) #'gray-write-string)
579(setf (symbol-function 'common-lisp::write-line) #'gray-write-line)
580(setf (symbol-function 'sys::%force-output) #'gray-force-output)
581(setf (symbol-function 'sys::%finish-output) #'gray-finish-output)
582(setf (symbol-function 'sys::%clear-output) #'gray-clear-output)
583(setf (symbol-function 'common-lisp::read-byte) #'gray-read-byte)
584(setf (symbol-function 'common-lisp::write-byte) #'gray-write-byte)
585(setf (symbol-function 'common-lisp::stream-column) #'gray-stream-column)
586(setf (symbol-function 'common-lisp::stream-element-type) #'gray-stream-element-type)
587(setf (symbol-function 'common-lisp::close) #'gray-close)
588(setf (symbol-function 'common-lisp::input-stream-p) #'gray-input-stream-p)
589(setf (symbol-function 'common-lisp::input-character-stream-p) #'gray-input-character-stream-p)  ;; # fb 1.01
590(setf (symbol-function 'common-lisp::output-stream-p) #'gray-output-stream-p)
591(setf (symbol-function 'common-lisp::open-stream-p) #'gray-open-stream-p)
592(setf (symbol-function 'common-lisp::streamp) #'gray-streamp)
593(setf (symbol-function 'common-lisp::read-sequence) #'gray-read-sequence)
594(setf (symbol-function 'common-lisp::write-sequence) #'gray-write-sequence)
595
596#|
597(setf (symbol-function 'common-lisp::make-two-way-stream) #'gray-make-two-way-stream)
598(setf (symbol-function 'common-lisp::two-way-stream-input-stream) #'gray-two-way-stream-input-stream)
599(setf (symbol-function 'common-lisp::two-way-stream-output-stream) #'gray-two-way-stream-output-stream)
600|#
601
602(provide 'gray-streams)
Note: See TracBrowser for help on using the repository browser.