#lang racket

(define-syntax-rule (with-raw body ...)
  (let ([saved #f])
    (define (stty x) (system (~a "stty " x)) (void))
    (dynamic-wind (λ() (set! saved (with-output-to-string (λ() (stty "-g"))))
                       (stty "raw -echo opost"))
                  (λ() body ...)
                  (λ() (stty saved)))))

(define (->bytes x)
  (cond [(bytes? x)  x]
        [(string? x) (string->bytes/utf-8 x)]
        [(not (list? x)) (error '->bytes "don't know how to convert: ~e" x)]
        [(andmap byte? x) (list->bytes x)]
        [(andmap char? x) (->bytes (list->string x))]))
(define (open x)
  (open-input-bytes (->bytes x)))

(define macros (make-vector 256 #f))
(define (macro-set! seq expansion)
  (let loop ([bs (bytes->list (->bytes seq))] [v (vector macros)] [i 0])
    (if (null? bs)
      (vector-set! v i expansion)
      (begin (unless (vector-ref v i) (vector-set! v i (make-vector 256 #f)))
             (loop (cdr bs) (vector-ref v i) (car bs))))))

;; Some examples
(macro-set! "\3" exit)
(macro-set! "ME" "Random J. Hacker")
(macro-set! "EMAIL" (λ() (open "ME <me@example.com>")))
(macro-set! "\r" "\r\n")
(macro-set! "\n" "\r\n")
(for ([c "ABCD"]) (macro-set! (~a "\eO" c) (~a "\e[" c)))

(with-raw
  (printf "Type away, `C-c' to exit...\n")
  (let loop ([inps (list (current-input-port))] [v macros] [pending '()])
    (define b (read-byte (car inps)))
    (if (eq? b eof) (loop (cdr inps) v pending)
        (let mloop ([m (vector-ref v b)])
          (cond [(vector? m) (loop inps m (cons b pending))]
                [(input-port? m) (loop (cons m inps) macros '())]
                [(or (bytes? m) (string? m))
                 (display m) (flush-output) (loop inps macros '())]
                [(procedure? m) (mloop (m))]
                [(and m (not (void? m))) (error "bad macro mapping!")]
                [(pair? pending)
                 (define rp (reverse (cons b pending)))
                 (write-byte (car rp)) (flush-output)
                 (loop (if (null? (cdr rp)) inps
                           (cons (open (list->bytes (cdr rp))) inps))
                       macros '())]
                [else (write-byte b) (flush-output) (loop inps v '())])))))