diff --git a/lib/chibi/repl.module b/lib/chibi/repl.module index 405d9a0e..742b9581 100644 --- a/lib/chibi/repl.module +++ b/lib/chibi/repl.module @@ -2,6 +2,8 @@ (define-module (chibi repl) (export repl) (import-immutable (scheme)) - (import (chibi process) - (chibi term edit-line)) + (import (chibi ast) + (chibi process) + (chibi term edit-line) + (srfi 18)) (include "repl.scm")) diff --git a/lib/chibi/repl.scm b/lib/chibi/repl.scm index 307b0253..b7ff79bc 100644 --- a/lib/chibi/repl.scm +++ b/lib/chibi/repl.scm @@ -1,58 +1,41 @@ +;;;; repl.scm - friendlier repl with line editing and signal handling +;; +;; Copyright (c) 2010 Alex Shinn. All rights reserved. +;; BSD-style license: http://synthcode.com/license.txt + +(define-syntax handle-exceptions + (syntax-rules () + ((handle-exceptions exn handler expr) + (call-with-current-continuation + (lambda (return) + (with-exception-handler (lambda (exn) (return handler)) + (lambda () expr))))))) + +(define (with-signal-handler sig handler thunk) + (let ((old-handler #f)) + (dynamic-wind + (lambda () (set! old-handler (set-signal-action! sig handler))) + thunk + (lambda () (set-signal-action! sig old-handler))))) (define (run-repl module env) - (if module (display module)) - (display "> ") - (flush-output) - (let lp () - (let ((ch (peek-char))) - (cond ((eof-object? ch) - (exit 0)) - ((and (char? ch) (char-whitespace? ch)) - (read-char) - (lp))))) - (cond - ((eq? #\@ (peek-char)) - (read-char) - (let ((sym (read))) - (if (not (symbol? sym)) - (error "repl: invalid @ syntax: @" sym) - (case sym - ((config) - (let ((res (eval (read) *config-env*))) - (cond - ((not (eq? res (if #f #f))) - (write res) - (newline))) - (run-repl module env))) - ((in) - (let ((mod (read))) - (if (or (not mod) (equal? mod '(scheme))) - (run-repl #f (interaction-environment)) - (let ((env (eval `(module-env (load-module ',mod)) - *config-env*))) - (run-repl mod env))))) - (else - (error "repl: unknown @ escape" sym)))))) - (else - (let ((expr (read))) - (cond - ((eof-object? expr) - (exit 0)) - (else - (let ((res (eval expr env))) - (cond - ((not (eq? res (if #f #f))) - (write res) - (newline))) - (run-repl module env)))))))) + (let ((line (edit-line (if module (string-append (symbol->string module) "> ") "> ")))) + (cond + ((or (not line) (eof-object? line))) + ((equal? line "") (run-repl module env)) + (else + (handle-exceptions exn (print-exception exn (current-error-port)) + (let* ((expr (call-with-input-string line read)) + (thread (make-thread (lambda () + (let ((res (eval expr env))) + (if (not (eq? res (if #f #f))) + (write res))))))) + (with-signal-handler + signal/interrupt + (lambda (n) (thread-terminate! thread)) + (lambda () (thread-start! thread) (thread-join! thread))))) + (newline) + (run-repl module env))))) (define (repl) - (set-signal-action! signal/interrupt - (lambda (n info) - (newline) - (run-repl #f (interaction-environment)))) - (current-exception-handler - (lambda (exn) - (print-exception exn (current-error-port)) - (run-repl #f (interaction-environment)))) (run-repl #f (interaction-environment))) diff --git a/lib/chibi/term/edit-line.scm b/lib/chibi/term/edit-line.scm index c3b022ea..1c985919 100644 --- a/lib/chibi/term/edit-line.scm +++ b/lib/chibi/term/edit-line.scm @@ -367,7 +367,12 @@ (buffer-goto! buf out (- (buffer-pos buf) 1))) (define (command/forward-delete-char ch buf out return) - (buffer-delete! buf out (buffer-pos buf) (+ (buffer-pos buf) 1))) + (cond + ((zero? (- (buffer-length buf) (buffer-min buf))) + (newline out) + (return 'eof)) + (else + (buffer-delete! buf out (buffer-pos buf) (+ (buffer-pos buf) 1))))) (define (command/backward-delete-char ch buf out return) (buffer-delete! buf out (- (buffer-pos buf) 1) (buffer-pos buf))) @@ -443,7 +448,7 @@ (let* ((width (or terminal-width (get-terminal-width out))) (buf (make-buffer)) (done? #f) - (return (lambda o (set! done? #t)))) + (return (lambda o (set! done? (if (pair? o) (car o) #t))))) (buffer-refresh?-set! buf #t) (buffer-width-set! buf width) (buffer-insert! buf out prompt) @@ -457,7 +462,8 @@ (let lp ((kmap keymap)) (let ((ch (read-char in))) (if (eof-object? ch) - (buffer->string buf) + (let ((res (buffer->string buf))) + (if (equal? res "") ch res)) (let ((x (keymap-lookup kmap (char->integer ch)))) (cond ((keymap? x) @@ -465,7 +471,9 @@ ((procedure? x) (x ch buf out return) (buffer-refresh buf out) - (if done? (buffer->string buf) (lp keymap))) + (if done? + (and (not (eq? done? 'eof)) (buffer->string buf)) + (lp keymap))) (else ;;(command/beep ch buf out return) (lp keymap)))))))))))))