further repl tweaks
authorAndy Wingo <wingo@pobox.com>
Fri, 8 Oct 2010 17:27:45 +0000 (19:27 +0200)
committerAndy Wingo <wingo@pobox.com>
Fri, 8 Oct 2010 17:27:45 +0000 (19:27 +0200)
* module/system/repl/error-handling.scm (error-string): Refactor a
  little.
  (call-with-error-handling): Ensure a trailing newline when printing
  the error-msg.

* module/system/repl/repl.scm (run-repl): We don't know the name of the
  meta-command here.

module/system/repl/error-handling.scm
module/system/repl/repl.scm

index 609d9c3..58317a8 100644 (file)
 ;;;
 
 (define (error-string stack key args)
-  (with-output-to-string
-    (lambda ()
-      (pmatch args
-        ((,subr ,msg ,args . ,rest)
-         (guard (> (vector-length stack) 0))
+  (pmatch args
+    ((,subr ,msg ,args . ,rest)
+     (guard (> (vector-length stack) 0))
+     (with-output-to-string
+       (lambda ()
          (display-error (vector-ref stack 0) (current-output-port)
-                        subr msg args rest))
-        (else
-         (format #t "Throw to key `~a' with args `~s'." key args))))))
+                        subr msg args rest))))
+    (else
+     (format #f "Throw to key `~a' with args `~s'." key args))))
 
 (define* (call-with-error-handling thunk #:key
                                    (on-error 'debug) (post-error 'catch)
                   (debug (make-debug stack 0 error-msg)))
              (with-saved-ports
               (lambda ()
-                (display error-msg)
+                (format #t "~a~%" error-msg)
                 (format #t "Entering a new prompt.  ")
                 (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")
                 ((@ (system repl repl) start-repl) #:debug debug))))))
index 9691dfb..fbe7b12 100644 (file)
                  (if (eq? k 'quit)
                      (abort args)
                      (begin
-                       (format #t "While executing meta-command `~A'~%" string)
+                       (format #t "While executing meta-command:~%")
                        (pmatch args
                          ((,subr ,msg ,args . ,rest)
                           (display-error #f (current-output-port) subr msg args rest))