Raw Terminal Input in Chez Scheme

direct_tty.ss

;;
;; direct_tty.ss
;;
;; This is a demonstration program using some of the Chez Scheme FFI
;; to put the terminal into "raw" mode, read a line of characters,
;; possibly containing control characters that would normally
;; terminate input, without echoing the characters typed. Once the
;; user presses the line termination character, (user defined, see the
;; `quit?` procedure), the program displays the line.
;;
;; The program shows how to obtain character-by-character input with
;; immediate examination of each character. Such a procedure is useful
;; when writing things like text editors where you want the program to
;; respond immediately to keyboard commands without waiting for the
;; entire line to be entered.
;;

;;------------------------------------------------------------------------------
;; Procedures for convenient printing.
;;

;; Return #t if the character is an ASCII control character, false
;; otherwise.
(define (char-control? c)
  (let ((char-num (char->integer c)))
    (or (= char-num 127)
        (< char-num 32))))

;; If c is a control character, it is converted into a two-character
;; string that indicates its special status by preceding it with a
;; "^".
(define (char->readable c)
  (if (char-control? c)
      (string #\^ (integer->char (+ 64 (char->integer c))))
      (string c)))

;; Return a transform of the input string with embedded control chars
;; converted to human-readable form showing a "^" prepended to it.
(define (string->readable s)
  (let loop ((lst (string->list s))
             (acc ""))
    (if (null? lst)
        acc
        (loop (cdr lst) (string-append acc (char->readable (car lst)))))))

;; Display a series of arguments followed by a newline.
(define (println . args)
  (for-each display args)
  (newline))

;; When in raw mode, lines need to be ended with CR/LF pairs to act
;; like normal printing.
(define (println-in-raw . args)
  (for-each display args)
  (display (string #\return #\newline)))

;;------------------------------------------------------------------------------
;; Foreign fuction stuff. Assure we have access to the needed
;; functions from the C runtime and import them.
;;

;; Load the C runtime on macOS. Other OSs will require something
;; different.

(load-shared-object "libc.dylib")

;; Assure that we have access to all of the functions we require.

(if (and (foreign-entry? "isatty")
         (foreign-entry? "tcgetattr")
         (foreign-entry? "tcsetattr")
         (foreign-entry? "cfmakeraw"))
    (println "We have access to needed functions from the C standard library.")
    (println "Can't find needed functions in the C standard library"))

(if (and (foreign-entry? "(cs)s_errno")
         (foreign-entry? "(cs)s_strerror"))
    (println "We have access to needed functions from the Chez C runtime.")
    (begin
      (println "Can't find needed functions in the Chez C runtime.")
      (exit 1)))

;;-----------------------------------------------------------------------------
;; termios-related stuff.

;; Explanation of `termios` and `cfmakeraw`. This is from the
;; `cfmakeraw(3)` Linux man page. Descriptions reflect the result of
;; related flags settings.
;;
;; termios_p->c_iflag &= ~(IGNBRK |  // Do not ignore a BREAK
;;                         BRKINT |  // BREAK will produce a null byte
;;                         PARMRK |  // Ignore parity errors
;;                         ISTRIP |  // Do not strip the eigth bit
;;                         INCLCR |  // Do not translate NL to CR on input
;;                         IGNCR  |  // Do not ignore carriage return on input
;;                         ICRNL  |  // Do not translate a carriage return to newline
;;                         IXON   ); // Disable XON/XOFF flow control on output
;; termios_p->c_oflag &= ~OPOST;     // Disable implementation-defined output processing
;; termios_p->c_lflag &= ~(ECHO   |  // Do not echo characters
;;                         ECHONL |  // Do not echo newline characters
;;                         ICANON |  // Disable canonical mode ("cooked") processing
;;                         ISIG   |  // Do not generate INTR, QUIT, SUSP or DSUSP signals
;;                         IEXTEN ); // Disable implemenation-defined input processing
;; termios_p->c_cflag &= ~(CSIZE  |  // No character size mask
;;                         PARENB ); // Turn off parity generation
;; termios_p->c_cflag |= CS8;        // 8-bit characters
;;
;; NOTE: The use of 8-bit characters makes this a bit incompatible with the `read-char`
;; procedure, which works with UTF-8 characters. Needs more work.
;;
;; The following definitions and structure are from the file
;; /Library/Developer/CommandLineTools/SDKs/MacOSX10.15.sdk/System/Library/Frameworks/Kernel.framework/Headers/sys/termios.h
;; on an iMac.

;; #define NCCS            20
;; typedef unsigned long   tcflag_t;
;; typedef unsigned char   cc_t;
;; typedef unsigned long   speed_t;

(define NCCS 20)

(define-ftype termios
  (struct
    [c_iflag unsigned-long] ; input flags
    [c_oflag unsigned-long] ; output flags
    [c_cflag unsigned-long] ; control flags
    [c_lflag unsigned-long] ; local flags
    ;; It seems like Chez will not let me use the defined constant
    ;; NCCS above for the size of the array. Gotta use the literal 20.
    [c_cc (array 20 char)] ; special control chars
    [c_ispeed unsigned-long] ; input speed
    [c_ospeed unsigned-long] ; output speed
    ))

;;-----------------------------------------------------------------------------
;; Give ourselves access to a bunch of foreign function interfaces.

;; int isatty(int fildes); Returns 1 if the file descriptor represents
;; a terminal, 0 otherwise.
(define isatty (foreign-procedure "isatty" (int) int))

;; int tcgetattr(int fd, struct termios *termios_p); Copy the current
;; attributes into the buffer (termios struct) pointed to. Returns 0
;; on success, -1 on failure in which case errno will contain the
;; error code.
(define tcgetattr (foreign-procedure "tcgetattr" (int (* termios)) int))

;; int tcsetattr(inf fd, int optional_atcions, const struct termios
;; *termios_p); Copy the buffer (termios struct) pointed to into the
;; terminal associated the the integer file descriptor. Returns 0 on
;; success, -1 on failure code is copied into errno.
(define tcsetattr (foreign-procedure "tcsetattr" (int int (* termios)) int))

;; void cfmakeraw(struct termios *termio_p);
(define cfmakeraw (foreign-procedure "cfmakeraw" ((* termios)) void))

;; Don't actually use these anymore. Left them here as a reminder
;; about using the "(cs)" calling scheme to reference functions in the
;; Chez Scheme run time.
(define errno (foreign-procedure "(cs)s_errno" () int))
(define strerror (foreign-procedure "(cs)s_strerror" (int) scheme-object))

;; Define some file descriptors for stdin/out. Couldn't find this
;; documented anywhere. These values are from Chez expediter.c.
(define STDIN_FD 0)
(define STDOUT_FD 1)

(if (= 1 (isatty STDIN_FD))
    (println "We have a terminal.")
    (println "Output is not a terminal."))

;; Allocate a buffer large enough to hold a termios struct and return
;; a pointer to it. Don't forget to release it manually when finished
;; with it.
(define (alloc-termios-buf)
  (make-ftype-pointer termios
                      (foreign-alloc (ftype-sizeof termios))))

;;-----------------------------------------------------------------------------
;; Reading lines from a terminal.

;; Return #t if a program terminating condition is observed; #f
;; otherwise.
(define (quit? c)
  (if (or (eof-object? c)
          (char=? c #\q)
          (char=? c #\newline)
          (char=? c #\return))
      (begin
        (println "Finished  because c = " (char->readable c))
        #t)
      #f))

;; Read a line of characters from the terminal. Since we assume raw
;; mode, there is no echo. Return a string composed of the typed
;; characters. This procedure is not much different from the standard
;; `get-line` procedure in R5Rs, but examines individual characters
;; for special actions that can be activated in raw mode.
(define (inner-read-line)
  (let loop ((acc "")
             (c (read-char)))
    (if (quit? c)
        acc
        (loop (string-append acc (string c)) (read-char)))))

;; Return a pointer to a termios structure for the given file
;; descriptor. Assumes the device is already set up in cooked mode.
(define (cooked-termios fd)
  (let ((my-termios (alloc-termios-buf)))
    (tcgetattr fd my-termios)
    my-termios))

;; Return a pointer to a termios structure for the given file
;; descriptor. Assumes the device is already set up in cooked mode and
;; creates a version of the termios structure initialized to set it up
;; in raw mode.
(define (raw-termios fd)
  (let ((my-termios (cooked-termios fd)))
    (cfmakeraw my-termios)
    my-termios))

;; Arguments passed to tcsetattr() describing how to switch to the new
;; termios settings. From termios.h.
(define TCSA 0)      ; Make change immediately.
(define TCSADRAIN 1) ; Drain output, then change.
(define TCSAFLUSH 2) ; Drain output, flush input.

;; Read a line from the standard input in raw mode and return it. The
;; existing terminal attributes are read and restored before exiting.
(define (read-raw-line)
  (let* ((cooked-attrs (cooked-termios STDIN_FD))
         (raw-attrs (raw-termios STDIN_FD))
         (get-raw! (lambda ()
                     (tcsetattr STDIN_FD TCSAFLUSH raw-attrs)))
         (get-cooked! (lambda ()
                        (tcsetattr STDIN_FD TCSAFLUSH cooked-attrs)
                        ;; Don't forget to handle foreign memory.
                        (foreign-free (ftype-pointer-address cooked-attrs))
                        (foreign-free (ftype-pointer-address raw-attrs))))
         (a-line (dynamic-wind
                   get-raw!
                   inner-read-line
                   get-cooked!)))
    a-line))

(println "Enter an invisible line of text:")
(println-in-raw "\rResult of reading line in raw mode: "
                (string->readable (read-raw-line)))

2022-08-10: Update with simplifications.