From a3cd2b988f1a423eb034707762d065636048134c Mon Sep 17 00:00:00 2001 From: Jim Blandy Date: Thu, 23 Oct 1997 05:00:55 +0000 Subject: [PATCH] Add support for readline function. * readline.scm: New module. * boot-9.scm (repl-reader): New function. (scm-style-repl): Call repl-reader, instead of doing the reading ourselves. Remove repl-report-reset; it was never used for anything. (top-repl): If we've got the readline primitives, then redefine repl-reader to use them. If we've got the readline primitives, import the readline module. --- ice-9/boot-9.scm | 51 +++++++++++++++++++++++++------- ice-9/readline.scm | 72 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 112 insertions(+), 11 deletions(-) create mode 100644 ice-9/readline.scm diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 11668b05f..fc2873f43 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -2438,11 +2438,18 @@ (define before-read-hook '()) (define after-read-hook '()) +;;; The default repl-reader function. We may override this if we've +;;; the readline library. +(define repl-reader + (lambda (prompt) + (display prompt) + (force-output) + (read (current-input-port)))) + (define (scm-style-repl) (letrec ( (start-gc-rt #f) (start-rt #f) - (repl-report-reset (lambda () #f)) (repl-report-start-timing (lambda () (set! start-gc-rt (gc-run-time)) (set! start-rt (get-internal-run-time)))) @@ -2468,17 +2475,19 @@ ((char=? ch #\newline) (read-char)))))) (-read (lambda () - (if scm-repl-prompt - (begin - (display (cond ((string? scm-repl-prompt) - scm-repl-prompt) - ((thunk? scm-repl-prompt) - (scm-repl-prompt)) - (else "> "))) - (force-output) - (repl-report-reset))) + ;; It would be nice if we could run this after the + ;; first prompt was printed, but with readline + ;; that's not possible, so we punt. (run-hooks before-read-hook) - (let ((val (read (current-input-port)))) + (let ((val + (let ((prompt (cond ((string? scm-repl-prompt) + scm-repl-prompt) + ((thunk? scm-repl-prompt) + (scm-repl-prompt)) + (scm-repl-prompt "> ") + (else "")))) + (repl-reader prompt)))) + ;; As described in R4RS, the READ procedure updates the ;; port to point to the first characetr past the end of ;; the external representation of the object. This @@ -2761,6 +2770,17 @@ ;; the protected thunk. (lambda () + + ;; If we've got readline, use it to prompt the user. This is a + ;; kludge, but we'll fix it soon. At least we only get + ;; readline involved when we're actually running the repl. + (if (memq 'readline *features*) + (begin + (set-current-input-port (readline-port)) + (set! repl-reader + (lambda (prompt) + (set-readline-prompt! prompt) + (read))))) (scm-style-repl)) ;; call at exit. @@ -2824,6 +2844,15 @@ (if (memq 'regex *features*) (define-module (guile) :use-module (ice-9 regex))) + +;;; Load readline code if rreadline primitives are available. +;;; +;;; Ideally, we wouldn't do this until we were sure we were actually +;;; going to enter the repl, but autoloading individual functions is +;;; clumsy at the moment. +(if (memq 'readline *features*) + (define-module (guile) :use-module (ice-9 readline))) + ;;; {Check that the interpreter and scheme code match up.} diff --git a/ice-9/readline.scm b/ice-9/readline.scm new file mode 100644 index 000000000..cb47d6522 --- /dev/null +++ b/ice-9/readline.scm @@ -0,0 +1,72 @@ +;;;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;;;; +;;;; Contributed by Daniel Risacher . + +(define-module (ice-9 readline)) + +(define prompt "") + +(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 prompt)) + (set! string-index 0) + (if (not (eof-object? read-string)) + (begin + (or (string=? read-string "") + (add-history read-string)) + (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. +(define the-readline-port #f) + +(define-public (readline-port) + (if (not the-readline-port) + (set! the-readline-port (make-readline-port))) + the-readline-port) + +(define-public (set-readline-prompt! p) + (set! prompt p)) + + +;(define myport (make-readline-port)) +;(define (doit) +; (set-current-input-port myport))