96 lines
3.4 KiB
Racket
96 lines
3.4 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/port)
|
|
|
|
(provide cook-io)
|
|
|
|
(define clear-to-eol "\033[2K")
|
|
(define kill-line (string-append "\r" clear-to-eol))
|
|
|
|
(struct buffer (chars consume-next-linefeed?) #:transparent)
|
|
|
|
(define (buffer-empty? b)
|
|
(null? (buffer-chars b)))
|
|
|
|
(define (buffer-adjust b new-chars)
|
|
(struct-copy buffer b
|
|
[chars new-chars]
|
|
[consume-next-linefeed? #f]))
|
|
|
|
(define (buffer-contents b)
|
|
(list->string (reverse (buffer-chars b))))
|
|
|
|
(define (update-buffer b key prompt k-eof k-complete k-ongoing)
|
|
(case key
|
|
((#\backspace #\rubout) ;; backspace = ^H = code 8; delete = code 127
|
|
(if (buffer-empty? b)
|
|
(k-ongoing b "")
|
|
(k-ongoing (buffer-adjust b (cdr (buffer-chars b))) "\b \b")))
|
|
((#\return) (k-complete (buffer-contents b) (buffer '() #t)))
|
|
((#\newline) (if (buffer-consume-next-linefeed? b)
|
|
(k-ongoing (struct-copy buffer b [consume-next-linefeed? #f]) "")
|
|
(k-complete (buffer-contents b) (buffer '() #f))))
|
|
((#\page) (k-ongoing b (string-append kill-line prompt (buffer-contents b))))
|
|
((#\004) ;; control-D, UNIX EOF
|
|
(if (buffer-empty? b)
|
|
(k-eof)
|
|
(k-ongoing b "")))
|
|
((#\033) ;; escape
|
|
(k-ongoing (buffer '() #f) (string-append kill-line prompt)))
|
|
(else (if (char-iso-control? key)
|
|
(k-ongoing b "")
|
|
(k-ongoing (buffer-adjust b (cons key (buffer-chars b))) (string key))))))
|
|
|
|
(define (cook-io raw-in raw-out prompt)
|
|
(define-values (cooked-in cooked-out) (make-pipe))
|
|
(define (close-ports)
|
|
(close-output-port cooked-out) ;; signal to our reader that we're not sending more
|
|
(close-input-port raw-in)) ;; signal to upstream that we are done reading
|
|
(thread
|
|
(lambda ()
|
|
(define input-buffer (make-bytes 4096))
|
|
(let loop ((b (buffer '() #f)))
|
|
(if (port-closed? cooked-in)
|
|
;; The ultimate reader of our cooked output has closed
|
|
;; their input port. We are therefore done.
|
|
(close-ports)
|
|
;; TODO: remove polling for port-closed when we get port-closed-evt
|
|
(let ((count (sync/timeout 0.5 (read-bytes-avail!-evt input-buffer raw-in))))
|
|
(cond
|
|
((eof-object? count) ;; end-of-file on input
|
|
(close-ports))
|
|
((eq? count #f) ;; timeout - poll to see if cooked-out has been closed
|
|
(loop b))
|
|
(else ;; a number - count of bytes read
|
|
(let process-bytes ((i 0) (b b))
|
|
(if (>= i count)
|
|
(loop b)
|
|
(update-buffer b (integer->char (bytes-ref input-buffer i)) prompt
|
|
close-ports
|
|
(lambda (line new-b)
|
|
(with-handlers ((exn:fail? void)) ;; ignore write errors
|
|
(write-string "\r\n" raw-out))
|
|
(write-string line cooked-out)
|
|
(newline cooked-out)
|
|
(process-bytes (+ i 1) new-b))
|
|
(lambda (new-b feedback)
|
|
(with-handlers ((exn:fail? void)) ;; ignore write errors
|
|
(write-string feedback raw-out))
|
|
(process-bytes (+ i 1) new-b))))))))))))
|
|
(values cooked-in (cook-output raw-out)))
|
|
|
|
(define (cook-output raw-out)
|
|
(define-values (cooked-in cooked-out) (make-pipe))
|
|
(thread
|
|
(lambda ()
|
|
(define buffer (make-bytes 4096))
|
|
(let loop ()
|
|
(define count (read-bytes-avail! buffer cooked-in))
|
|
(if (eof-object? count)
|
|
(begin (close-input-port cooked-in)
|
|
(close-output-port raw-out))
|
|
(let ((raw-data (regexp-replace* #"\n" (subbytes buffer 0 count) #"\r\n")))
|
|
(write-bytes raw-data raw-out)
|
|
(loop))))))
|
|
cooked-out)
|