* Reformattings
* Avoid keeping empty history lines * Avoid keeping repetitive history lines * Provided (and documented) set-completion-function! * Change sample use to a conditional `dynamic-require' * Use raw mallocs instead of eternal for completions svn: r4434
This commit is contained in:
Eli Barzilay
parent
b8586b743d
commit
33f93c0d2e
|
|
@ -10,10 +10,11 @@ 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.
|
||||
|
||||
I put the following in my ~/.mzschemerc so that MzScheme always starts
|
||||
with readline support:
|
||||
You can put the following in your ~/.mzschemerc so that MzScheme starts with
|
||||
readline support on xterms:
|
||||
|
||||
(require (lib "rep.ss" "readline"))
|
||||
(when (equal? "xterm" (getenv "TERM"))
|
||||
(dynamic-require '(lib "rep.ss" "readline") #f))
|
||||
|
||||
The readline history is stored across invocations in MzScheme's
|
||||
preferences file, assuming MzScheme exits normally.
|
||||
|
|
@ -24,8 +25,14 @@ Direct bindings for readline hackers
|
|||
|
||||
The _readline.ss_ library provides two functions:
|
||||
|
||||
> (readline prompt-string) - prints the given prompt string and reads
|
||||
an S-expression.
|
||||
> (readline prompt-string)
|
||||
prints the given prompt string and reads a line
|
||||
|
||||
> (add-history s) - adds the given string to the readline history,
|
||||
which is accessible to the user via the up-arrow key
|
||||
> (add-history s)
|
||||
adds the given string to the readline history, which is accessible
|
||||
to the user via the up-arrow key
|
||||
|
||||
> (set-completion-function! proc)
|
||||
sets readline's `rl_completion_entry_function' function according to
|
||||
proc, which is expected to be a `string -> (list-of string)'
|
||||
procedure
|
||||
|
|
|
|||
|
|
@ -3,9 +3,8 @@
|
|||
(require (lib "foreign.ss")) (unsafe!)
|
||||
(provide readline add-history set-completion-function!)
|
||||
|
||||
; libtermcap maybe needed
|
||||
(define libtermcap (with-handlers ([exn:fail? void])
|
||||
(ffi-lib "libtermcap")))
|
||||
;; libtermcap maybe needed
|
||||
(define libtermcap (with-handlers ([exn:fail? void]) (ffi-lib "libtermcap")))
|
||||
(define libreadline (ffi-lib "libreadline"))
|
||||
|
||||
(define readline
|
||||
|
|
@ -28,8 +27,7 @@
|
|||
(if (zero? state)
|
||||
(begin (set! cur (func str)) (complete str 1))
|
||||
(and (pair? cur)
|
||||
(begin0 (malloc (add1 (bytes-length (car cur)))
|
||||
(car cur) 'eternal)
|
||||
(begin0 (malloc (add1 (bytes-length (car cur))) (car cur) 'raw)
|
||||
(set! cur (cdr cur))))))
|
||||
complete))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,69 +1,73 @@
|
|||
|
||||
(module pread mzscheme
|
||||
(require "readline.ss"
|
||||
(lib "file.ss"))
|
||||
(lib "file.ss"))
|
||||
|
||||
(define MAX-HISTORY 100)
|
||||
(define leftovers null)
|
||||
(define KEEP-DUPLICATES #f)
|
||||
(define KEEP-BLANKS #f)
|
||||
|
||||
(define leftovers null)
|
||||
(define counter 1)
|
||||
|
||||
(define local-history (get-preference 'mzrl-history (lambda () null)))
|
||||
|
||||
(define (do-readline p)
|
||||
(let ([s (readline p)])
|
||||
(when (string? s)
|
||||
(add-history s)
|
||||
(if (= (length local-history) MAX-HISTORY)
|
||||
(set! local-history (cdr local-history)))
|
||||
(set! local-history (append local-history (list s))))
|
||||
s))
|
||||
(define local-history
|
||||
(let ([hist (get-preference 'mzrl-history (lambda () null))])
|
||||
(for-each add-history hist)
|
||||
(reverse hist)))
|
||||
|
||||
(define (save-history)
|
||||
(put-preferences '(mzrl-history) (list local-history)))
|
||||
(put-preferences '(mzrl-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
|
||||
(null? local-history)
|
||||
(not (equal? s (car local-history)))))
|
||||
(add-history s)
|
||||
(set! local-history (cons s 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))))
|
||||
|
||||
(for-each add-history (if (list? local-history) local-history null))
|
||||
(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 (do-readline (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 (do-readline (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))))))))))))
|
||||
(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))))))))))))
|
||||
|
||||
(provide prompt-read-using-readline))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,4 @@
|
|||
|
||||
(module readline mzscheme
|
||||
(require "mzrl.ss") ;; should load .so form
|
||||
|
||||
(provide readline add-history))
|
||||
|
||||
(require "mzrl.ss")
|
||||
(provide readline add-history set-completion-function!))
|
||||
|
|
|
|||
|
|
@ -2,12 +2,10 @@
|
|||
(module rep mzscheme
|
||||
(require "pread.ss")
|
||||
|
||||
(current-prompt-read
|
||||
(let ([orig-read (current-prompt-read)]
|
||||
(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))))))
|
||||
|
||||
|
||||
(prompt-read-using-readline (lambda (n) (if (zero? n) "> " " ")))
|
||||
(orig-read))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user