* readline.scm: Moved from ../ice-9.

Dynamically link libguilereadline.so.
(readline): Just define in this module, do not overwrite builtin
variable.  The builtin readline function is now named "%readline",
so this works.  See below.
(activate-readline): New function which contains the readline
activation code formerly found in top-repl.

diff --git a/guile-readline/readline.scm b/guile-readline/readline.scm
new file mode 100644 (file)
index 0000000..99727e0
--- /dev/null
+++ b/guile-readline/readline.scm
@@ -0,0 +1,173 @@
+;;;; readline.scm --- support functions for command-line editing
+;;;;
+;;;;   Copyright (C) 1997 Free Software Foundation, Inc.
+;;;; 
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;; 
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;;;; Boston, MA 02111-1307 USA
+;;;; 
+;;;; Contributed by Daniel Risacher <risacher@worldnet.att.net>.
+;;;; Extensions based upon code by
+;;;; Andrew Archibald <aarchiba@undergrad.math.uwaterloo.ca>.
+
+(define-module (ice-9 readline)
+  :use-module (ice-9 session)
+  :use-module (ice-9 regex))
+
+;;; Dynamically link the glue code for accessing the readline library
+
+(dynamic-call "scm_init_readline" (dynamic-link "libguilereadline.so"))
+
+;;; MDJ 980513 <djurfeldt@nada.kth.se>:
+;;; There should probably be low-level support instead of this code.
+
+(define prompt "")
+(define prompt2 "")
+(define input-port (current-input-port))
+(define output-port (current-output-port))
+(define read-hook #f)
+
+(define (make-readline-port)
+  (let ((read-string "")
+       (string-index -1))
+    (letrec ((get-character
+             (lambda ()
+               (cond 
+                ((eof-object? read-string)
+                 read-string)
+                ((>= string-index (string-length read-string))
+                 (begin
+                   (set! string-index -1)
+                   #\nl))
+                ((= string-index -1)
+                 (begin
+                   (set! read-string
+                         (%readline (if (string? prompt)
+                                        prompt
+                                        (prompt))
+                                    input-port
+                                    output-port
+                                    read-hook))
+                   (set! string-index 0)
+                   (if (not (eof-object? read-string))
+                       (begin
+                         (or (string=? read-string "")
+                             (begin
+                               (add-history read-string)
+                               (set! prompt prompt2)))
+                         (get-character))
+                       read-string)))
+                (else 
+                 (let ((res (string-ref read-string string-index)))
+                   (set! string-index (+ 1 string-index))
+                   res))))))         
+      (make-soft-port
+       (vector write-char display #f get-character #f)
+       "rw"))))
+
+;;; We only create one readline port.  There's no point in having
+;;; more, since they would all share the tty and history ---
+;;; everything except the prompt.  And don't forget the
+;;; compile/load/run phase distinctions.  Also, the readline library
+;;; isn't reentrant.
+(define the-readline-port #f)
+
+(define history-variable "GUILE_HISTORY")
+(define history-file (string-append (getenv "HOME") "/.guile_history"))
+
+(define-public readline-port
+  (let ((do (lambda (r/w)
+             (if (memq 'history-file (readline-options-interface))
+                 (r/w (or (getenv history-variable)
+                          history-file))))))
+    (lambda ()
+      (if (not the-readline-port)
+         (begin
+           (do read-history) 
+           (set! the-readline-port (make-readline-port))
+           (add-hook! exit-hook (lambda () (do write-history)))))
+      the-readline-port)))
+
+;;; The user might try to use readline in his programs.  It then
+;;; becomes very uncomfortable that the current-input-port is the
+;;; readline port...
+;;;
+;;; Here, we detect this situation and replace it with the
+;;; underlying port.
+;;;
+;;; %readline is the low-level readline procedure.
+
+(define-public (readline . args)
+  (let ((prompt prompt)
+       (inp input-port))
+    (cond ((not (null? args))
+          (set! prompt (car args))
+          (set! args (cdr args))
+          (cond ((not (null? args))
+                 (set! inp (car args))
+                 (set! args (cdr args))))))
+    (apply %readline
+          prompt
+          (if (eq? inp the-readline-port)
+              input-port
+              inp)
+          args)))
+
+(define-public (set-readline-prompt! p . rest)
+  (set! prompt p)
+  (if (not (null? rest))
+      (set! prompt2 (car rest))))
+
+(define-public (set-readline-input-port! p)
+  (set! input-port p))
+
+(define-public (set-readline-output-port! p)
+  (set! output-port p))
+
+(define-public (set-readline-read-hook! h)
+  (set! read-hook h))
+
+(define-public apropos-completion-function
+  (let ((completions '()))
+    (lambda (text cont?)
+      (if (not cont?)
+         (set! completions
+               (map symbol->string
+                    (apropos-internal (string-append "^"
+                                                     (regexp-quote text))))))
+      (if (null? completions)
+         #f
+         (let ((retval (car completions)))
+           (begin (set! completions (cdr completions))
+                  retval))))))
+
+(set! *readline-completion-function* apropos-completion-function)
+
+(define-public (activate-readline)
+  (if (and (isatty? (current-input-port))
+          (not (and (module-defined? the-root-module
+                                     'use-emacs-interface)
+                    use-emacs-interface)))
+      (let ((read-hook (lambda () (run-hook before-read-hook))))
+       (set-current-input-port (readline-port))
+       (set! repl-reader
+             (lambda (prompt)
+               (dynamic-wind
+                   (lambda ()
+                     (set-readline-prompt! prompt "... ")
+                     (set-readline-read-hook! read-hook))
+                   (lambda () (read))
+                   (lambda ()
+                     (set-readline-prompt! "" "")
+                     (set-readline-read-hook! #f))))))))