;;;; readline.scm --- support functions for command-line editing
;;;;
-;;;; Copyright (C) 1997, 1999, 2000, 2001, 2002 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,
;;;;
;;;; 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
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
;;;;
;;;; Contributed by Daniel Risacher <risacher@worldnet.att.net>.
;;;; Extensions based upon code by
\f
(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))
\f
;;; but only when it isn't already present.
(if (not (provided? 'readline))
- (load-extension "libguilereadline" "scm_init_readline"))
+ (load-extension "libguilereadline-v-18" "scm_init_readline"))
(if (not (provided? 'readline))
(scm-error 'misc-error
;;; 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)
(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))
;;; %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))
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)))
(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}."
(lambda ()
(set! *readline-completion-function* old-completer)))))
+(define readline-repl-reader
+ (let ((boot-9-repl-reader repl-reader))
+ (lambda* (repl-prompt #:optional (reader (fluid-ref current-reader)))
+ (let ((port (current-input-port)))
+ (if (eq? port (readline-port))
+ (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?! port #f)
+ (set-readline-prompt! repl-prompt "... ")
+ (set-readline-read-hook! (lambda ()
+ (run-hook before-read-hook))))
+ (lambda () ((or reader read) port))
+ (lambda ()
+ (set-readline-prompt! outer-new-input-prompt
+ outer-continuation-prompt)
+ (set-readline-read-hook! outer-read-hook))))
+ (boot-9-repl-reader repl-prompt reader))))))
+
(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))))
- (set-current-input-port (readline-port))
- (set! repl-reader
- (lambda (prompt)
- (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! (using-readline?) #t))))
+ (if (isatty? (current-input-port))
+ (begin
+ (set-current-input-port (readline-port))
+ (set! repl-reader readline-repl-reader)
+ (set! (using-readline?) #t))))
+
+(define-public (make-completion-function strings)
+ "Construct and return a completion function for a list of strings.
+The returned function is suitable for passing to
+@code{with-readline-completion-function. The argument @var{strings}
+should be a list of strings, where each string is one of the possible
+completions."
+ (letrec ((strs '())
+ (regexp #f)
+ (completer (lambda (text continue?)
+ (if continue?
+ (if (null? strs)
+ #f
+ (let ((str (car strs)))
+ (set! strs (cdr strs))
+ (if (string-match regexp str)
+ str
+ (completer text #t))))
+ (begin
+ (set! strs strings)
+ (set! regexp
+ (string-append "^" (regexp-quote text)))
+ (completer text #t))))))
+ completer))