contrib/sb-simple-streams/null.lisp

   1 ;;; -*- lisp -*-
   2 ;;;
   3 ;;; **********************************************************************
   4 ;;; This code was written by Paul Foley and has been placed in the public
   5 ;;; domain.
   6 ;;;
   7
   8 ;;; Sbcl port by Rudi Schlatte.
   9
  10 (in-package "SB-SIMPLE-STREAMS")
  11
  12 ;;;
  13 ;;; **********************************************************************
  14 ;;;
  15 ;;; Definition of Null-Simple-Stream
  16
  17 (def-stream-class null-simple-stream (single-channel-simple-stream)
  18   ())
  19
  20 (declaim (ftype j-read-char-fn null-read-char))
  21 (defun null-read-char (stream eof-error-p eof-value blocking)
  22   (declare (ignore blocking))
  23   (sb-impl::eof-or-lose stream eof-error-p eof-value))
  24
  25 (declaim (ftype j-read-chars-fn null-read-chars))
  26 (defun null-read-chars (stream string search start end blocking)
  27   (declare (ignore stream string search start end blocking))
  28   (values 0 :eof))
  29
  30 (declaim (ftype j-unread-char-fn null-unread-char))
  31 (defun null-unread-char (stream relaxed)
  32   (declare (ignore stream relaxed)))
  33
  34 (declaim (ftype j-write-char-fn null-write-char))
  35 (defun null-write-char (character stream)
  36   (declare (ignore stream))
  37   character)
  38
  39 (declaim (ftype j-write-chars-fn null-write-chars))
  40 (defun null-write-chars (string stream start end)
  41   (declare (ignore string stream))
  42   (- end start))
  43
  44 (declaim (ftype j-listen-fn null-listen))
  45 (defun null-listen (stream)
  46   (declare (ignore stream))
  47   nil)
  48
  49 (defmethod device-open ((stream null-simple-stream) options)
  50   (with-stream-class (null-simple-stream stream)
  51     (add-stream-instance-flags stream :simple :input :output)
  52     ;;(install-single-channel-character-strategy
  53     ;; stream (getf options :external-format :default) nil)
  54     (setf (sm j-read-char stream) #'null-read-char
  55           (sm j-read-chars stream) #'null-read-chars
  56           (sm j-unread-char stream) #'null-unread-char
  57           (sm j-write-char stream) #'null-write-char
  58           (sm j-write-chars stream) #'null-write-chars
  59           (sm j-listen stream) #'null-listen))
  60   stream)
  61
  62 (defmethod device-buffer-length ((stream null-simple-stream))
  63   256)
  64
  65 (defmethod device-read ((stream null-simple-stream) buffer
  66                         start end blocking)
  67   (declare (ignore buffer start end blocking))
  68   -1)
  69
  70 (defmethod device-write ((stream null-simple-stream) buffer
  71                          start end blocking)
  72   (declare (ignore buffer blocking))
  73   (- end start))