From fb406390b7dbb44f8811d2ff07f058019c026715 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 24 Jan 2011 17:14:18 -0700 Subject: [PATCH] fix readline port to obey port protocol & use interaction port handler --- in particular, it no longer blocks on a read request; the call to the readline library now uses a separate thread, so that the input port can return an event --- collects/readline/pread.rkt | 98 +++++++++++++++++++++----------- collects/readline/readline.scrbl | 20 ++++++- 2 files changed, 81 insertions(+), 37 deletions(-) diff --git a/collects/readline/pread.rkt b/collects/readline/pread.rkt index 046717de57..1ceb1752cd 100644 --- a/collects/readline/pread.rkt +++ b/collects/readline/pread.rkt @@ -123,40 +123,60 @@ ;; chunk as one big multiline string. (provide readline-prompt) (define readline-prompt (make-parameter #f)) -(define readline-prompt-spaces (make-parameter #" ")) -(define multiline-chunk (make-parameter '())) -(define (do-multiline-chunk) - (let ([chunk (multiline-chunk)]) +(define-struct readline-state (prompt-spaces multiline-chunk) + #:mutable) + +(define readline-state-cell (make-thread-cell #f)) +(define (get-readline-state) + (or (thread-cell-ref readline-state-cell) + (let ([state (readline-state #" " '())]) + (thread-cell-set! readline-state-cell state) + state))) + +(define (do-multiline-chunk state) + (let ([chunk (readline-state-multiline-chunk state)]) (when (pair? chunk) (drop-from-history chunk) (add-to-history (apply bytes-append (reverse chunk)) #f) - (multiline-chunk '())))) + (set-readline-state-multiline-chunk! state '())))) -(define (readline-bytes/multiline-chunk prompt) +(define (readline-bytes/multiline-chunk prompt state) (let ([line (readline-bytes/hist prompt #t)]) (when (and (bytes? line) (not (zero? (bytes-length line)))) - (let ([c (multiline-chunk)]) - (multiline-chunk (if (pair? c) - (list* line (readline-prompt-spaces) #"\n" c) - (cons line c))))) + (let ([c (readline-state-multiline-chunk state)]) + (set-readline-state-multiline-chunk! + state + (if (pair? c) + (list* line (readline-state-prompt-spaces state) #"\n" c) + (cons line c))))) line)) -(define (do-one-line) +(define (do-one-line state k) (let ([p (readline-prompt)]) (case p - [(#f) (do-multiline-chunk) (readline-bytes/hist #"" #f)] - [(space) (readline-bytes/multiline-chunk (readline-prompt-spaces))] - [else (do-multiline-chunk) - (unless (= (bytes-length (readline-prompt-spaces)) - (bytes-length p)) - (readline-prompt-spaces (make-bytes (bytes-length p) 32))) - (readline-prompt 'space) ; use spaces next time - (readline-bytes/multiline-chunk p)]))) + [(#f) (thread (lambda () + (do-multiline-chunk state) + (k (readline-bytes/hist #"" #f))))] + [(space) (thread + (lambda () + (k (readline-bytes/multiline-chunk (readline-state-prompt-spaces state) + state))))] + [else (readline-prompt 'space) ; use spaces next time + (thread + (lambda () + (do-multiline-chunk state) + (unless (= (bytes-length (readline-state-prompt-spaces state)) + (bytes-length p)) + (set-readline-state-prompt-spaces! + state + (make-bytes (bytes-length p) 32))) + (k (readline-bytes/multiline-chunk p state))))]))) (provide readline-input) (define readline-input (let ([buffer #f] + [evt #f] [skip #f] [blen #f] [closed? #f] @@ -166,13 +186,22 @@ (let loop () (cond [closed? eof] [(eof-object? buffer) (set! buffer #f) eof] + [evt evt] [(not buffer) - (set! buffer (do-one-line)) - (if (eof-object? buffer) - (begin (save-history) (set! buffer #f) eof) - (begin (set! skip 0) - (set! blen (bytes-length buffer)) - (reader tgt)))] + (set! evt + (wrap-evt + (do-one-line + (get-readline-state) + (lambda (buf) + (if (eof-object? buf) + (save-history) + (begin + (set! skip 0) + (set! blen (bytes-length buf)))) + (set! buffer buf) + (set! evt #f))) + (lambda (v) 0))) + evt] [else ;; copy bytes (let ([tgtlen (bytes-length tgt)] @@ -202,12 +231,13 @@ (define prompt (current-prompt)) (flush-output) ;; needs to set `readline-prompt' to get a prompt when reading - (parameterize ([read-accept-reader #t] [readline-prompt prompt]) - (unless (eq? readline-input (current-input-port)) - ;; not the readline port -- print the prompt (changing the - ;; readline-prompt and using read-complete-syntax below should still - ;; work fine) - (display prompt) (flush-output)) - (begin0 (let ([in (current-input-port)]) - ((current-read-interaction) (object-name in) in)) - (do-multiline-chunk)))) + (parameterize ([readline-prompt prompt]) + (let ([in ((current-get-interaction-input-port))]) + (unless (eq? 'readline-input (object-name in)) + ;; not the readline port -- print the prompt (changing the + ;; readline-prompt and using read-complete-syntax below should still + ;; work fine) + (display prompt) (flush-output)) + (begin0 ((current-read-interaction) (object-name in) in) + (do-multiline-chunk (get-readline-state)))))) + diff --git a/collects/readline/readline.scrbl b/collects/readline/readline.scrbl index a07fdd1989..17b7ce8a37 100644 --- a/collects/readline/readline.scrbl +++ b/collects/readline/readline.scrbl @@ -21,8 +21,9 @@ library with the Racket @racket[read-eval-print-loop]. @defmodule*[(readline readline/rep-start)] The @racketmodname[readline] library installs a @|readline|-based -input port, and hooks the prompt-and-read part of Racket's -@racket[read-eval-print-loop] to interact with it +input port (whose name is @racket['readline-input]) and hooks the +prompt-and-read part of Racket's @racket[read-eval-print-loop] to +interact with it. You can start Racket with @@ -63,6 +64,20 @@ useful. In addition, the @|readline| history is stored across invocations in Racket's preferences file, assuming that Racket exits normally. +The @racketmodname[readline] library adjusts +@racket[read-eval-print-loop] by setting the prompt read handler as +determined by @racket[current-prompt-read]. The call to the read +interaction handler (as determined by +@racket[current-read-interaction]) is parameterized to set +@racket[readline-prompt], so that a prompt will be printed when +reading starts. To compensate for the prompt printed via +@racket[readline-prompt], when the interaction input port's name (as +produced by function in the +@racket[current-get-interaction-input-port] parameter) is +@racket['readline-input], the prompt read handler skips printing a +prompt; otherwise, it displays a prompt as determined by +@racket[current-prompt]. + @defproc[(install-readline!) void?]{ Adds @racket[(require readline/rep)] to the result of @@ -77,7 +92,6 @@ For more fine-grained control, such as conditionally loading @|readline| based on an environment variable, edit @filepath{~/.racketrc} manually.} - @section{Interacting with the @|Readline|-Enabled Input Port } @defmodule[readline/pread]{ The @racketmodname[readline/pread] library