1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00

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.
This commit is contained in:
Andy Wingo 2010-10-08 19:27:45 +02:00
parent 7cd6d77c64
commit a627100bf3
2 changed files with 10 additions and 10 deletions

View file

@ -34,15 +34,15 @@
;;; ;;;
(define (error-string stack key args) (define (error-string stack key args)
(with-output-to-string (pmatch args
(lambda () ((,subr ,msg ,args . ,rest)
(pmatch args (guard (> (vector-length stack) 0))
((,subr ,msg ,args . ,rest) (with-output-to-string
(guard (> (vector-length stack) 0)) (lambda ()
(display-error (vector-ref stack 0) (current-output-port) (display-error (vector-ref stack 0) (current-output-port)
subr msg args rest)) subr msg args rest))))
(else (else
(format #t "Throw to key `~a' with args `~s'." key args)))))) (format #f "Throw to key `~a' with args `~s'." key args))))
(define* (call-with-error-handling thunk #:key (define* (call-with-error-handling thunk #:key
(on-error 'debug) (post-error 'catch) (on-error 'debug) (post-error 'catch)
@ -148,7 +148,7 @@
(debug (make-debug stack 0 error-msg))) (debug (make-debug stack 0 error-msg)))
(with-saved-ports (with-saved-ports
(lambda () (lambda ()
(display error-msg) (format #t "~a~%" error-msg)
(format #t "Entering a new prompt. ") (format #t "Entering a new prompt. ")
(format #t "Type `,bt' for a backtrace or `,q' to continue.\n") (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")
((@ (system repl repl) start-repl) #:debug debug)))))) ((@ (system repl repl) start-repl) #:debug debug))))))

View file

@ -129,7 +129,7 @@
(if (eq? k 'quit) (if (eq? k 'quit)
(abort args) (abort args)
(begin (begin
(format #t "While executing meta-command `~A'~%" string) (format #t "While executing meta-command:~%")
(pmatch args (pmatch args
((,subr ,msg ,args . ,rest) ((,subr ,msg ,args . ,rest)
(display-error #f (current-output-port) subr msg args rest)) (display-error #f (current-output-port) subr msg args rest))