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