chibi.repl uses edit-line, catches interrupts

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"))

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)))

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)))))))))))))