X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/6cecdff760a6930346c8f5235870c6ad48a2ef80..62651cb317c40ecb9f8257928f6f745ecb814747:/guile-readline/ice-9/readline.scm

diff --git a/guile-readline/ice-9/readline.scm b/guile-readline/ice-9/readline.scm
index 59224524b..38fb23fc7 100644
--- a/guile-readline/ice-9/readline.scm
+++ b/guile-readline/ice-9/readline.scm
@@ -1,10 +1,10 @@
 ;;;; readline.scm --- support functions for command-line editing
 ;;;;
-;;;; 	Copyright (C) 1997, 1999, 2000, 2001, 2002, 2006 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 1997, 1999, 2000, 2001, 2002, 2006, 2009, 2010 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)
+;;;; the Free Software Foundation; either version 3, or (at your option)
 ;;;; any later version.
 ;;;; 
 ;;;; This program is distributed in the hope that it will be useful,
@@ -24,10 +24,15 @@
 
 
 (define-module (ice-9 readline)
-  :use-module (ice-9 session)
-  :use-module (ice-9 regex)
-  :use-module (ice-9 buffered-input)
-  :no-backtrace)
+  #:use-module (ice-9 session)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 buffered-input)
+  #:no-backtrace
+  #:export (filename-completion-function
+	    add-history
+	    read-history
+	    write-history
+	    clear-history))
 
 
 
@@ -68,8 +73,8 @@
 ;;; Dirk:FIXME:: If the-readline-port, input-port or output-port are closed,
 ;;; guile will enter an endless loop or crash.
 
-(define prompt "")
-(define prompt2 "")
+(define new-input-prompt "")
+(define continuation-prompt "")
 (define input-port (current-input-port))
 (define output-port (current-output-port))
 (define read-hook #f)
@@ -77,8 +82,8 @@
 (define (make-readline-port)
   (make-line-buffered-input-port (lambda (continuation?)
                                    (let* ((prompt (if continuation?
-                                                      prompt2
-                                                      prompt))
+                                                      continuation-prompt
+                                                      new-input-prompt))
                                           (str (%readline (if (string? prompt)
                                                               prompt
                                                               (prompt))
@@ -125,7 +130,7 @@
 ;;; %readline is the low-level readline procedure.
 
 (define-public (readline . args)
-  (let ((prompt prompt)
+  (let ((prompt new-input-prompt)
 	(inp input-port))
     (cond ((not (null? args))
 	   (set! prompt (car args))
@@ -141,9 +146,9 @@
 	   args)))
 
 (define-public (set-readline-prompt! p . rest)
-  (set! prompt p)
+  (set! new-input-prompt p)
   (if (not (null? rest))
-      (set! prompt2 (car rest))))
+      (set! continuation-prompt (car rest))))
 
 (define-public (set-readline-input-port! p)
   (cond ((or (not (file-port? p)) (not (input-port? p)))
@@ -168,24 +173,22 @@
 (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))))))
+
 (if (provided? 'regex)
-    (begin
-      (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)
-      ))
+    (set! *readline-completion-function* apropos-completion-function))
 
 (define-public (with-readline-completion-function completer thunk)
   "With @var{completer} as readline completion function, call @var{thunk}."
@@ -198,23 +201,24 @@
 	  (set! *readline-completion-function* old-completer)))))
 
 (define-public (activate-readline)
-  (if (and (isatty? (current-input-port))
-	   (not (let ((guile-user-module (resolve-module '(guile-user))))
-		  (and (module-defined? guile-user-module 'use-emacs-interface)
-		       (module-ref guile-user-module 'use-emacs-interface)))))
-      (let ((read-hook (lambda () (run-hook before-read-hook))))
+  (if (isatty? (current-input-port))
+      (let ((repl-read-hook (lambda () (run-hook before-read-hook))))
 	(set-current-input-port (readline-port))
 	(set! repl-reader
-	      (lambda (prompt)
-		(dynamic-wind
-		    (lambda ()
+	      (lambda* (repl-prompt
+                        #:optional (reader (fluid-ref current-reader)))
+		(let ((outer-new-input-prompt new-input-prompt)
+		      (outer-continuation-prompt continuation-prompt)
+		      (outer-read-hook read-hook))
+		  (dynamic-wind
+                    (lambda ()
                       (set-buffered-input-continuation?! (readline-port) #f)
-		      (set-readline-prompt! prompt "... ")
-		      (set-readline-read-hook! read-hook))
-		    (lambda () (read))
-		    (lambda ()
-		      (set-readline-prompt! "" "")
-		      (set-readline-read-hook! #f)))))
+                      (set-readline-prompt! repl-prompt "... ")
+                      (set-readline-read-hook! repl-read-hook))
+                    (lambda () ((or reader read) (current-input-port)))
+                    (lambda ()
+                      (set-readline-prompt! outer-new-input-prompt outer-continuation-prompt)
+                      (set-readline-read-hook! outer-read-hook))))))
 	(set! (using-readline?) #t))))
 
 (define-public (make-completion-function strings)