contrib/sb-simple-streams/terminal.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 ;;; Terminal-Simple-Stream
  16
  17 (defvar *terminal-control-in-table*
  18   (make-control-table #\Newline #'std-dc-newline-in-handler))
  19
  20 (def-stream-class terminal-simple-stream (dual-channel-simple-stream)
  21   ())
  22
  23 (defmethod device-open ((stream terminal-simple-stream) options)
  24   (with-stream-class (terminal-simple-stream stream)
  25     (when (getf options :input-handle)
  26       (setf (sm input-handle stream) (getf options :input-handle))
  27       (add-stream-instance-flags stream :simple :dual :input)
  28       (when (sb-unix:unix-isatty (sm input-handle stream))
  29         (add-stream-instance-flags stream :interactive))
  30       (unless (sm buffer stream)
  31         (let ((length (device-buffer-length stream)))
  32           (setf (sm buffer stream) (allocate-buffer length)
  33                 (sm buf-len stream) length)))
  34       (setf (sm control-in stream) *terminal-control-in-table*))
  35     (when (getf options :output-handle)
  36       (setf (sm output-handle stream) (getf options :output-handle))
  37       (add-stream-instance-flags stream :simple :dual :output)
  38       (unless (sm out-buffer stream)
  39         (let ((length (device-buffer-length stream)))
  40           (setf (sm out-buffer stream) (make-string length)
  41                 (sm max-out-pos stream) length)))
  42       (setf (sm control-out stream) *std-control-out-table*))
  43     (let ((efmt (getf options :external-format :default)))
  44       (compose-encapsulating-streams stream efmt)
  45       (install-dual-channel-character-strategy
  46        (melding-stream stream) efmt)))
  47   stream)
  48
  49 (defmethod device-read ((stream terminal-simple-stream) buffer
  50                         start end blocking)
  51   (let ((result (call-next-method)))
  52     (if (= result -1) -2 result)))
  53
  54 (defmethod device-clear-input ((stream terminal-simple-stream) buffer-only)
  55   (unless buffer-only
  56     (let ((buffer (allocate-buffer sb-impl::+bytes-per-buffer+)))
  57       (unwind-protect
  58            (loop until (<= (read-octets stream buffer
  59                                         0 sb-impl::+bytes-per-buffer+ nil)
  60                            0))
  61         (free-buffer buffer)))))