rl-broken.rkt

#lang racket/base
(require ffi/unsafe
         racket/port)

(provide readline start)

(define libreadline (ffi-lib "libreadline" '("5" "6" "4" "")))

(define rl-callback-handler-install
  (get-ffi-obj "rl_callback_handler_install" libreadline
               (_fun _bytes (_fun _bytes/eof -> _void) -> _void)))

(define rl-callback-read-char
  (get-ffi-obj "rl_callback_read_char" libreadline
               (_fun -> _void)))

(define rl-callback-handler-remove
  (get-ffi-obj "rl_callback_handler_remove" libreadline
               (_fun -> _void)))

(define (readline prompt)
  (define ch (make-channel))
  (rl-callback-handler-install 
   prompt 
   (lambda (result) 
     (rl-callback-handler-remove)
     (thread (lambda () (channel-put ch result)))))
  (define port (current-input-port))
  (let loop ()
    (define sync-result (sync/enable-break port ch))
    (cond [(input-port? sync-result)
           (rl-callback-read-char)
           (loop)]
          [else sync-result])))

(file-stream-buffer-mode (current-input-port) 'none)


(define (setup-io)
  ;; Setting the buffer mode during module load appears to not
  ;; work.
  (file-stream-buffer-mode (current-input-port) 'none)
  ;; If the user just called setup-io, then there's a newline following
  ;; the call to (start).
  (let eat-leading-newlines ()
    (define buffer (bytes 0))
    (when (and (equal? 1 (peek-bytes-avail!* buffer 0 #f (current-input-port)))
               (equal? (char->integer #\newline) (bytes-ref buffer 0)))
      (read-bytes-avail! buffer (current-input-port))
      (eat-leading-newlines))))
(setup-io)


(define (start)
  (let loop ()
    (define next-line (readline #">>> "))
    (unless (eof-object? next-line)
      (printf "You typed: ~s\n" next-line)
      (loop))))