src/new-cl/gray-streams.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- GRAY stream mixin.
   4 ;;;
   5
   6 (in-package :iolib.common-lisp)
   7
   8 (defclass trivial-gray-stream-mixin () ())
   9
  10 (defgeneric stream-read-sequence
  11     (stream sequence start end &key &allow-other-keys))
  12
  13 (defgeneric stream-write-sequence
  14     (stream sequence start end &key &allow-other-keys))
  15
  16 (defgeneric stream-file-position (stream))
  17
  18 (defgeneric (setf stream-file-position) (newval stream))
  19
  20 (defmethod stream-write-string
  21     ((stream trivial-gray-stream-mixin) seq &optional start end)
  22   (stream-write-sequence stream seq (or start 0) (or end (length seq))))
  23
  24 ;; Implementations should provide this default method, I believe, but
  25 ;; at least sbcl and allegro don't.
  26 (defmethod stream-terpri ((stream trivial-gray-stream-mixin))
  27   (write-char #\newline stream))
  28
  29 (defmethod stream-file-position ((stream trivial-gray-stream-mixin))
  30   nil)
  31
  32 (defmethod (setf stream-file-position)
  33     (newval (stream trivial-gray-stream-mixin))
  34   (declare (ignore newval))
  35   nil)
  36
  37 #+allegro
  38 (progn
  39   (defmethod excl:stream-read-sequence
  40       ((s trivial-gray-stream-mixin) seq &optional start end)
  41     (stream-read-sequence s seq (or start 0) (or end (length seq))))
  42
  43   (defmethod excl:stream-write-sequence
  44       ((s trivial-gray-stream-mixin) seq &optional start end)
  45     (stream-write-sequence s seq (or start 0) (or end (length seq)))))
  46
  47 #+cmu
  48 (progn
  49   (defmethod ext:stream-read-sequence
  50       ((s trivial-gray-stream-mixin) seq &optional start end)
  51     (stream-read-sequence s seq (or start 0) (or end (length seq))))
  52
  53   (defmethod ext:stream-write-sequence
  54       ((s trivial-gray-stream-mixin) seq &optional start end)
  55     (stream-write-sequence s seq (or start 0) (or end (length seq)))))
  56
  57 #+lispworks
  58 (progn
  59   (defmethod stream:stream-read-sequence
  60       ((s trivial-gray-stream-mixin) seq start end)
  61     (stream-read-sequence s seq start end))
  62
  63   (defmethod stream:stream-write-sequence
  64       ((s trivial-gray-stream-mixin) seq start end)
  65     (stream-write-sequence s seq start end))
  66
  67   (defmethod stream:stream-file-position ((stream trivial-gray-stream-mixin))
  68     (stream-file-position stream))
  69
  70   (defmethod (setf stream:stream-file-position)
  71       (newval (stream trivial-gray-stream-mixin))
  72     (setf (stream-file-position stream) newval)))
  73
  74 #+openmcl
  75 (progn
  76   (defmethod ccl:stream-read-vector
  77       ((s trivial-gray-stream-mixin) seq start end)
  78     (stream-read-sequence s seq start end))
  79
  80   (defmethod ccl:stream-write-vector
  81       ((s trivial-gray-stream-mixin) seq start end)
  82     (stream-write-sequence s seq start end)))
  83
  84 #+clisp
  85 (eval-when (:compile-toplevel :load-toplevel :execute)
  86   (let* ((pkg (find-package :gray))
  87          (sym (and pkg (find-symbol (string '#:stream-read-sequence) pkg))))
  88     (unless (and sym (fboundp sym))
  89       (error "Your CLISP does not have ~A and is therefore unsupported"
  90              "gray:stream-read-sequence"))))
  91
  92 #+clisp
  93 (progn
  94   (defmethod gray:stream-read-sequence
  95       ((s trivial-gray-stream-mixin) seq &key start end)
  96     (stream-read-sequence s seq (or start 0) (or end (length seq))))
  97
  98   (defmethod gray:stream-write-sequence
  99       ((s trivial-gray-stream-mixin) seq &key start end)
 100     (stream-write-sequence s seq (or start 0) (or end (length seq))))
 101
 102   (defmethod gray:stream-position ((stream trivial-gray-stream-mixin) position)
 103     (if position
 104         (setf (stream-file-position stream) position)
 105         (stream-file-position stream))))
 106
 107 #+sbcl
 108 (progn
 109   (defmethod sb-gray:stream-read-sequence
 110       ((s trivial-gray-stream-mixin) seq &optional start end)
 111     (stream-read-sequence s seq (or start 0) (or end (length seq))))
 112
 113   (defmethod sb-gray:stream-write-sequence
 114       ((s trivial-gray-stream-mixin) seq &optional start end)
 115     (stream-write-sequence s seq (or start 0) (or end (length seq))))
 116
 117   ;; SBCL extension:
 118   (defmethod sb-gray:stream-line-length ((stream trivial-gray-stream-mixin))
 119     80))
 120
 121 #+ecl
 122 (progn
 123   (defmethod gray:stream-read-sequence
 124       ((s trivial-gray-stream-mixin) seq &optional start end)
 125     (stream-read-sequence s seq (or start 0) (or end (length seq))))
 126
 127   (defmethod gray:stream-write-sequence
 128       ((s trivial-gray-stream-mixin) seq &optional start end)
 129     (stream-write-sequence s seq (or start 0) (or end (length seq)))))