New readline-using layer for REPL interaction
svn: r4480
This commit is contained in:
Eli Barzilay
parent
2abe03bac8
commit
fd5fdceaaa
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user