New readline-using layer for REPL interaction

svn: r4480

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
+The _rep.ss_ library installs a readline-based input port, and hooks
-prompt-and-read part of MzScheme's read-eval-print loop.
+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.

collects/readline/pread.ss

@@ -1,73 +1,140 @@
-
 (module pread mzscheme
-  (require "readline.ss"
+  (require (lib "readline.ss" "readline") (lib "file.ss"))
-           (lib "file.ss"))
 
-  (define MAX-HISTORY 100)
+  ;; configuration
-  (define KEEP-DUPLICATES #f)
+  (define show-all-prompts (make-parameter #f))
-  (define KEEP-BLANKS     #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)
+  ;; History management
-  (define counter 1)
 
   (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)
+  (define (readline-bytes/hist p)
-    (let ([s (readline p)])
+    (let ([s (readline-bytes p)])
-      (when (and (string? s)
+      (when (and (bytes? s)
-                 (or KEEP-BLANKS (not (zero? (string-length s))))
+                 (or (keep-blanks) (not (zero? (bytes-length s))))
-                 (or KEEP-DUPLICATES
+                 (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)])
+  (exit-handler
-                  (lambda (v)
+   (let ([old (exit-handler)])
-                    (save-history)
+     (lambda (v) (save-history) (old v))))
-                    (old v))))
 
-  (define (prompt-read-using-readline get-prompt)
+  ;; implement an input port that goes through readline
-    (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))))))))))))
 
-  (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))))
+
+  )

collects/readline/rep.ss

@@ -2,10 +2,12 @@
 (module rep mzscheme
   (require "pread.ss")
 
-  (current-prompt-read
+  ;; Change the input port and readline-prompt hook
-   (let ([orig-read  (current-prompt-read)]
+
-	 [orig-input (current-input-port)])
+  (if (eq? 'stdin (object-name (current-input-port)))
-     (lambda ()
+    (current-input-port readline-input)
-       (if (eq? (current-input-port) orig-input)
+    ;; don't replace some random port
-         (prompt-read-using-readline (lambda (n) (if (zero? n) "> " "  ")))
+    (error 'readline-input
-         (orig-read))))))
+           "invoke this library when the current-input-port is stdin"))
+
+  (current-prompt-read read-cmdline-syntax))