base/gray-stream-mixin.lisp

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