diff options
| -rw-r--r-- | elisp/geiser-debug.el | 2 | ||||
| -rw-r--r-- | scheme/racket/geiser/eval.rkt | 26 |
2 files changed, 24 insertions, 4 deletions
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index fa30506..ad55d0b 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -67,7 +67,7 @@ non-null value.") (erase-buffer) (insert what) (newline 2) - (when res + (when (and res (not err)) (insert res) (newline 2)) (unless (geiser-debug--display-error impl module key output) diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt index e0bcffa..db50ded 100644 --- a/scheme/racket/geiser/eval.rkt +++ b/scheme/racket/geiser/eval.rkt @@ -30,9 +30,28 @@ (define (exn-key e) (vector-ref (struct->vector e) 0)) +(define current-marks (make-parameter (current-continuation-marks))) + +(define (get-real-context e) + (let ((ec (continuation-mark-set->context (exn-continuation-marks e))) + (cc (continuation-mark-set->context (current-marks)))) + (filter-not (lambda (c) (member c cc)) ec))) + +(define (display-exn-context c) + (define (maybe-display p x) (when x (display p) (display x)) x) + (when (and (pair? c) (cdr c)) + (let ((sloc (cdr c))) + (and (maybe-display "" (srcloc-source sloc)) + (maybe-display ":" (srcloc-line sloc)) + (maybe-display ":" (srcloc-column sloc))) + (maybe-display ": " (car c)) + (newline)))) + (define (set-last-error e) (set! last-result `((error (key . ,(exn-key e))))) - (display (exn-message e))) + (display (exn-message e)) + (newline) (newline) + (for-each display-exn-context (get-real-context e))) (define (write-value v) (with-output-to-string @@ -46,8 +65,9 @@ (let ((output (with-output-to-string (lambda () - (with-handlers ((exn? set-last-error)) - (call-with-values thunk set-last-result)))))) + (parameterize ((current-marks (current-continuation-marks))) + (with-handlers ((exn? set-last-error)) + (call-with-values thunk set-last-result))))))) (append last-result `((output . ,output))))) (define (eval-in form spec lang) |