scsh-expect/scheme/tty-utils.scm

47 lines
1.7 KiB
Scheme
Raw Normal View History

2004-07-15 13:34:49 -04:00
;;; 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))))