47 lines
1.7 KiB
Scheme
47 lines
1.7 KiB
Scheme
|
;;; Some scsh utilities to mung the tty.
|
||
|
|
;;; Designed and implemented by David Fisher and Olin Shivers.
|
||
|
|
;;; Copyright (C) 1998 by the Scheme Underground.
|
||
|
|
|
||
|
|
;;; (modify-tty proc [tty-fd/port/fname])
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; Get the tty's current tty-info record. Apply PROC to the record;
|
||
|
|
;;; set the tty's mode to the result tty-info record returned by PROC.
|
||
|
|
;;; Return the original, unmodified tty-info record.
|
||
|
|
|
||
|
|
;;; RAW RAW-INITIALIZE ECHO-ON ECHO-OFF CANONICAL
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
;;; These are tty-info -> tty-info functions. They can be used as the PROC
|
||
|
|
;;; parameter to MODIFY-TTY.
|
||
|
|
|
||
|
|
(define (modify-tty proc . maybe-tty)
|
||
|
|
(let* ((tty (:optional maybe-tty (current-input-port)))
|
||
|
|
(info0 (tty-info tty)))
|
||
|
|
(set-tty-info/now tty (proc (copy-tty-info info0)))
|
||
|
|
info0))
|
||
|
|
|
||
|
|
;;; Make a proc that frobs the :local-flags field of a tty-info record.
|
||
|
|
(define (local-flags-modifier modifier)
|
||
|
|
(lambda (ti)
|
||
|
|
(modify-tty-info:local-flags ti modifier)
|
||
|
|
ti))
|
||
|
|
|
||
|
|
(define echo-off
|
||
|
|
(let ((no-echo (bitwise-not ttyl/echo)))
|
||
|
|
(local-flags-modifier (lambda (lf) (bitwise-and lf no-echo)))))
|
||
|
|
|
||
|
|
(define echo-on
|
||
|
|
(local-flags-modifier (lambda (lf) (bitwise-ior lf ttyl/echo))))
|
||
|
|
|
||
|
|
(define raw
|
||
|
|
(let ((no-canon (bitwise-not ttyl/canonical)))
|
||
|
|
(local-flags-modifier (lambda (lf) (bitwise-and lf no-canon)))))
|
||
|
|
|
||
|
|
(define (raw-initialize tty-info)
|
||
|
|
;; min and time can't be set until the terminal is in raw mode. Really.
|
||
|
|
(set-tty-info:min tty-info 0)
|
||
|
|
(set-tty-info:time tty-info 0)
|
||
|
|
tty-info)
|
||
|
|
|
||
|
|
(define canonical
|
||
|
|
(local-flags-modifier (lambda (lf) (bitwise-ior lf ttyl/canonical))))
|