From a627100bf39c64f986536e9faff564e5602e0efa Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 8 Oct 2010 19:27:45 +0200 Subject: [PATCH] further repl tweaks * 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 | 18 +++++++++--------- module/system/repl/repl.scm | 2 +- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm index 609d9c3a1..58317a80d 100644 --- a/module/system/repl/error-handling.scm +++ b/module/system/repl/error-handling.scm @@ -34,15 +34,15 @@ ;;; (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) @@ -148,7 +148,7 @@ (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)))))) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 9691dfb2a..fbe7b12bc 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -129,7 +129,7 @@ (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))