diff --git a/collects/readline/doc.txt b/collects/readline/doc.txt index 5a37dc5a01..d610d05148 100644 --- a/collects/readline/doc.txt +++ b/collects/readline/doc.txt @@ -7,8 +7,9 @@ with the MzScheme read-eval-print-loop. Normal use of readline ---------------------- -The _rep.ss_ library installs a readline-based function for the -prompt-and-read part of MzScheme's read-eval-print loop. +The _rep.ss_ library installs a readline-based input port, and hooks +the prompt-and-read part of MzScheme's read-eval-print loop to +interact with it. You can put the following in your ~/.mzschemerc so that MzScheme starts with readline support on xterms: @@ -16,10 +17,63 @@ starts with readline support on xterms: (when (equal? "xterm" (getenv "TERM")) (dynamic-require '(lib "rep.ss" "readline") #f)) +or start MzScheme with + + mzscheme -L rep.ss readline + The readline history is stored across invocations in MzScheme's preferences file, assuming MzScheme exits normally. +Interacting with the readline-enabled input port +------------------------------------------------ + +The _pread.ss_ library provides customization, and support for +prompt-reading after "rep.ss" installs the new input port. + +The reading facility that the new input port provides can be +customized with these parameters: + +> show-all-prompts + If #f (the default), no prompt is shown until you write input that + is completely readable. For example, when you type + (foo bar) (+ 1 + 2) + you will see a single prompt in the beginning. If this parameter is + set to #t, you will see the second prompt when reading the second + expression. + +> max-history + The number of history entries to save. Defaults to 100. + +> keep-duplicates + If this is #f (the default), then lines that are equal to the + previous one are not added as new history items. + +> keep-blanks + If #f (the default), blank input lines are not kept in history. + + +The new input port that you get when you require "rep.ss" is a custom +port that uses readline for all inputs. The problem is when you want +to display a prompt and then read some input: readline will get +confused if it's not used when the cursor is at the beginning of the +line, which is why it has a `prompt' argument. To use this prompt: + + (parameterize ([readline-prompt some-byte-string]) + ...code-that-reads...) + +This will make the first call to readline use the prompt, and +subsequent calls will use an all-spaces prompt of the same length +(this can happen if you're reading an s-expression). The normal value +of `readline-prompt' is #f for an empty prompt (and 'spaces after the +prompt is used, which is why you should use `parameterize' to restore +it to #f). + +(A proper solution would be to install a custom output port too which +will keep track of text that is displayed without a trailing newline.) + + Direct bindings for readline hackers ------------------------------------ @@ -45,3 +99,14 @@ The _readline.ss_ library provides two functions: proc, which is expected to be a `string -> (list-of string)' procedure; the `type' argument defaults to `_string' but you can use it with `_bytes' instead + + +License Issues +-------------- + +GNU's readline library is covered by the GPL, and that applies to code +that links with it. PLT Scheme is LGPL, so this code is not used by +default -- you should explicitly enable it if you want to. Also, be +aware that if you write code that uses this library, it will make your +code link to the readline library when invoked -- with the usual GPL +implications. diff --git a/collects/readline/pread.ss b/collects/readline/pread.ss index 99f80101ca..173bac6476 100644 --- a/collects/readline/pread.ss +++ b/collects/readline/pread.ss @@ -1,73 +1,140 @@ - (module pread mzscheme - (require "readline.ss" - (lib "file.ss")) + (require (lib "readline.ss" "readline") (lib "file.ss")) - (define MAX-HISTORY 100) - (define KEEP-DUPLICATES #f) - (define KEEP-BLANKS #f) + ;; configuration + (define show-all-prompts (make-parameter #f)) + (define max-history (make-parameter 100)) + (define keep-duplicates (make-parameter #f)) + (define keep-blanks (make-parameter #f)) + (provide show-all-prompts max-history keep-duplicates keep-blanks) - (define leftovers null) - (define counter 1) + ;; History management (define local-history - (let ([hist (get-preference 'mzrl-history (lambda () null))]) + (let ([hist (get-preference 'readline-input-history (lambda () null))]) (for-each add-history hist) (reverse hist))) (define (save-history) - (put-preferences '(mzrl-history) (list (reverse local-history)))) + (put-preferences '(readline-input-history) (list (reverse local-history)))) - (define (readline/hist p) - (let ([s (readline p)]) - (when (and (string? s) - (or KEEP-BLANKS (not (zero? (string-length s)))) - (or KEEP-DUPLICATES + (define (readline-bytes/hist p) + (let ([s (readline-bytes p)]) + (when (and (bytes? s) + (or (keep-blanks) (not (zero? (bytes-length s)))) + (or (keep-duplicates) (null? local-history) (not (equal? s (car local-history))))) - (add-history s) + (add-history-bytes s) (set! local-history (cons s local-history)) - (let loop ([n MAX-HISTORY] [l local-history]) + (let loop ([n (max-history)] [l local-history]) (cond [(null? l) 'done] [(zero? n) (set-cdr! l '())] [else (loop (sub1 n) (cdr l))]))) s)) - (exit-handler (let ([old (exit-handler)]) - (lambda (v) - (save-history) - (old v)))) + (exit-handler + (let ([old (exit-handler)]) + (lambda (v) (save-history) (old v)))) - (define (prompt-read-using-readline get-prompt) - (if (pair? leftovers) - (begin0 (car leftovers) - (set! leftovers (cdr leftovers))) - (let big-loop () - (let loop ([s (readline/hist (get-prompt 0))] [next-pos 1] [force? #f]) - (if (eof-object? s) - (begin (save-history) s) - (with-handlers ([(if force? (lambda (x) #f) exn:fail:read:eof?) - (lambda (exn) - (let ([v (readline/hist (get-prompt next-pos))]) - (loop (string-append s "\n" - (if (eof-object? v) "" v)) - (add1 next-pos) - (eof-object? v))))]) - (let ([p (open-input-string (string-append s "\n"))]) - (port-count-lines! p) - (let ([rs (let loop () - (let ([r (parameterize ([read-accept-reader #t]) - (read-syntax - (string->path - (format "repl-~a" counter)) - p))]) - (if (eof-object? r) - null - (cons r (loop)))))]) - (if (null? rs) - (big-loop) - (begin0 (car rs) - (set! counter (add1 counter)) - (set! leftovers (cdr rs)))))))))))) + ;; implement an input port that goes through readline - (provide prompt-read-using-readline)) + ;; readline-prompt can be + ;; #f: no prompt (normal state), + ;; bytes: a prompt to use + ;; 'space: a port has been used, now use spaces instead + ;; (from readline-prompt-spaces) + (provide readline-prompt) + (define readline-prompt (make-parameter #f)) + (define readline-prompt-spaces (make-parameter #" ")) + + (define (get-current-prompt) + (let ([p (readline-prompt)]) + (case p + [(#f) #""] + [(space) (readline-prompt-spaces)] + [else (unless (= (bytes-length (readline-prompt-spaces)) + (bytes-length p)) + (readline-prompt-spaces (make-bytes (bytes-length p) 32))) + (readline-prompt 'spaces) ; use spaces next time + p]))) + + (provide readline-input) + (define readline-input + (let ([buffer #f] + [skip #f] + [blen #f] + [LF (bytes-ref #"\n" 0)]) + (define (close!) (set! buffer eof) (save-history)) + (define (reader tgt) + (let loop () + (cond [(eof-object? buffer) eof] + [(not buffer) + (set! buffer (readline-bytes/hist (get-current-prompt))) + (if (eof-object? buffer) + (begin (save-history) buffer) + (begin (set! skip 0) + (set! blen (bytes-length buffer)) + (reader tgt)))] + [else + ;; copy bytes + (let ([tgtlen (bytes-length tgt)] + [left (- blen skip)]) + (cond [(< tgtlen left) ; not enough target space + (let ([end (+ skip tgtlen)]) + (bytes-copy! tgt 0 buffer skip end) + (set! skip end) + tgtlen)] + [(= tgtlen left) ; enough room for text but no newline + (bytes-copy! tgt 0 buffer skip blen) + (set! skip blen) + left] + [else ; enough room for text with newline + (bytes-copy! tgt 0 buffer skip blen) + (bytes-set! tgt left LF) + (set! buffer #f) + (add1 left)]))]))) + (make-input-port 'readline reader #f close!))) + + ;; like read-syntax, but waits until valid input is ready + (define read-complete-syntax + (let ([leftovers '()] + [counter 1]) + (lambda () + (if (pair? leftovers) + (begin0 (car leftovers) + (set! leftovers (cdr leftovers))) + (let big-loop () + (let loop ([s (read-line)] [next-pos 1] [force? #f]) + (if (eof-object? s) + (begin (save-history) s) + (with-handlers ([(if force? (lambda (x) #f) exn:fail:read:eof?) + (lambda (exn) + (let ([v (read-line)]) + (loop (string-append + s "\n" (if (eof-object? v) "" v)) + (add1 next-pos) + (eof-object? v))))]) + (let ([p (open-input-string (string-append s "\n"))]) + (port-count-lines! p) + (let ([rs (let loop () + (let ([r (read-syntax + (string->symbol + (format "repl-~a" counter)) + p)]) + (if (eof-object? r) '() (cons r (loop)))))]) + (if (null? rs) + (big-loop) + (begin0 (car rs) + (set! counter (add1 counter)) + (set! leftovers (cdr rs)))))))))))))) + + ;; a function that can be used for current-prompt-read + (provide read-cmdline-syntax) + (define (read-cmdline-syntax) + ;; needs to set `readline-prompt' to get a prompt when reading + (parameterize ([read-accept-reader #t] + [readline-prompt #"> "]) + (if (show-all-prompts) (read-syntax) (read-complete-syntax)))) + + ) diff --git a/collects/readline/rep.ss b/collects/readline/rep.ss index 4caa461776..2bb64f2026 100644 --- a/collects/readline/rep.ss +++ b/collects/readline/rep.ss @@ -2,10 +2,12 @@ (module rep mzscheme (require "pread.ss") - (current-prompt-read - (let ([orig-read (current-prompt-read)] - [orig-input (current-input-port)]) - (lambda () - (if (eq? (current-input-port) orig-input) - (prompt-read-using-readline (lambda (n) (if (zero? n) "> " " "))) - (orig-read)))))) + ;; Change the input port and readline-prompt hook + + (if (eq? 'stdin (object-name (current-input-port))) + (current-input-port readline-input) + ;; don't replace some random port + (error 'readline-input + "invoke this library when the current-input-port is stdin")) + + (current-prompt-read read-cmdline-syntax))