3 ;;; **********************************************************************
4 ;;; This code was written by Paul Foley and has been placed in the public
8 ;;; Sbcl port by Rudi Schlatte.
10 (in-package "SB-SIMPLE-STREAMS")
13 ;;; **********************************************************************
15 ;;; Terminal-Simple-Stream
17 (defvar *terminal-control-in-table
*
18 (make-control-table #\Newline
#'std-dc-newline-in-handler
))
20 (def-stream-class terminal-simple-stream
(dual-channel-simple-stream)
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
)))
49 (defmethod device-read ((stream terminal-simple-stream
) buffer
51 (let ((result (call-next-method)))
52 (if (= result -
1) -
2 result
)))
54 (defmethod device-clear-input ((stream terminal-simple-stream
) buffer-only
)
56 (let ((buffer (allocate-buffer sb-impl
::+bytes-per-buffer
+)))
58 (loop until
(<= (read-octets stream buffer
59 0 sb-impl
::+bytes-per-buffer
+ nil
)
61 (free-buffer buffer
)))))