Skip to content
Browse files

Use readline's callback interface instead of implicit busy polling.

Closes PR 13350.
  • Loading branch information...
1 parent c19b8a4 commit 8b434db8c4c6cc4688c8d2ff6d65b3c89d0fe6a8 @dyoo committed Feb 8, 2013
Showing with 58 additions and 7 deletions.
  1. +42 −7 collects/readline/mzrl.rkt
  2. +16 −0 collects/xrepl/xrepl.rkt
View
49 collects/readline/mzrl.rkt
@@ -32,11 +32,49 @@
(let ([s (bytes->string/utf-8 (make-byte-string x))]) (free x) s)
eof))))
-(define readline
- (get-ffi-obj "readline" libreadline (_fun _string -> _string/eof/free)))
-(define readline-bytes
- (get-ffi-obj "readline" libreadline (_fun _bytes -> _bytes/eof/free)))
+(define rl-callback-handler-install
+ (get-ffi-obj "rl_callback_handler_install" libreadline
+ (_fun _string (_fun _string/eof/free -> _void) -> _void)))
+
+(define rl-callback-handler-install/bytes
+ (get-ffi-obj "rl_callback_handler_install" libreadline
+ (_fun _bytes (_fun _bytes/eof/free -> _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)))
+
+;; We need to tell readline to pull content through our own
+;; function, to avoid the buffering issues between C and Racket.
+(set-ffi-obj! "rl_getc_function" libreadline (_fun _pointer -> _int)
+ (lambda (_)
+ (define next-byte (read-byte real-input-port))
+ (if (eof-object? next-byte) -1 next-byte)))
+
+
+(define (make-readline rl-callback-handler-install)
+ (define (readline prompt)
+ (define result #f)
+ (rl-callback-handler-install prompt
+ (lambda (r)
+ (rl-callback-handler-remove)
+ (set! result r)))
+ (let loop ()
+ (cond [result result]
+ [else
+ (sync/enable-break real-input-port)
+ (rl-callback-read-char)
+ (loop)])))
+ readline)
+
+(define readline (make-readline rl-callback-handler-install))
+(define readline-bytes (make-readline rl-callback-handler-install/bytes))
+
(define add-history
(get-ffi-obj "add_history" libreadline (_fun _string -> _void)))
@@ -115,9 +153,6 @@
(unless (terminal-port? real-input-port)
(log-warning "mzrl warning: input port is not a terminal\n"))
-;; make it possible to run Scheme threads while waiting for input
-(set-ffi-obj! "rl_event_hook" libreadline (_fun -> _int)
- (lambda () (sync/enable-break real-input-port) 0))
;; force cursor on a new line
View
16 collects/xrepl/xrepl.rkt
@@ -1478,8 +1478,24 @@
;; ----------------------------------------------------------------------------
;; set up the xrepl environment
+
+
+;; When a user types "(require xrepl)" and presses enter at the normal
+;; repl, there's a trailing newline that we want to consume so that readline
+;; doesn't see it.
+(define (maybe-consume-newline)
+ (when (terminal-port? (current-input-port))
+ (define buffer (bytes 0 0))
+ (define peeked (peek-bytes-avail!* buffer 0 #f (current-input-port)))
+ (when (number? peeked)
+ (for ([i peeked])
+ (define b (bytes-ref buffer i))
+ (when (member (integer->char b) '(#\newline #\return))
+ (read-byte (current-input-port)))))))
+
(provide setup-xrepl-environment)
(define (setup-xrepl-environment)
+ (maybe-consume-newline)
(define (tweak param maker) (param (maker (param))))
(tweak error-display-handler make-xrepl-display-handler)
(tweak current-eval make-xrepl-evaluator)

0 comments on commit 8b434db

Please sign in to comment.
Something went wrong with that request. Please try again.