diff options
| author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-02-21 04:22:07 +0100 |
|---|---|---|
| committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2009-02-21 04:22:07 +0100 |
| commit | 612c7390fc3ff78ac9b0b10b83304095cfceccd5 (patch) | |
| tree | 171732c34a0b1a1ae14b7620788880c01c29c2b6 | |
| parent | a585a046ddc523cb69977c856f3386d8bb65c325 (diff) | |
| download | geiser-guile-612c7390fc3ff78ac9b0b10b83304095cfceccd5.tar.gz geiser-guile-612c7390fc3ff78ac9b0b10b83304095cfceccd5.tar.bz2 | |
Better stack delimitation: include only frames relevant to the eval'd expression.
| -rw-r--r-- | scheme/guile/geiser/emacs.scm | 38 |
1 files changed, 21 insertions, 17 deletions
diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm index d5e245b..147af7c 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -40,14 +40,12 @@ #:use-module (system base compile) #:use-module ((geiser introspection) :renamer (symbol-prefix-proc 'ge:))) -(define (write-result result output) - (write (list (cons 'result result) (cons 'output output))) - (newline)) +(define (make-result result output) + (list (cons 'result result) (cons 'output output))) -(define (write-error key args stack) - (write (list (cons 'error (apply parse-error (cons key args))) - (cons 'stack (parse-stack stack)))) - (newline)) +(define (make-error key args stack) + (list (cons 'error (apply parse-error (cons key args))) + (cons 'stack (parse-stack stack)))) (define (parse-stack stack) (if stack @@ -71,16 +69,22 @@ (let ((module (or (and (list? module-name) (resolve-module module-name)) (current-module))) - (captured-stack #f)) - (catch #t - (lambda () - (let ((result #f)) - (let ((output (with-output-to-string - (lambda () - (set! result (evaluator form module)))))) - (write-result result output)))) - (lambda (key . args) (write-error key args captured-stack)) - (lambda (key . args) (set! captured-stack (make-stack #t)))))) + (result #f) + (captured-stack #f) + (error #f)) + (let ((output + (with-output-to-string + (lambda () + (set! result + (catch #t + (lambda () + (start-stack 'id (evaluator form module))) + (lambda (key . args) + (set! error (make-error key args captured-stack))) + (lambda (key . args) + (set! captured-stack (make-stack #t 2 2))))))))) + (write (or error (make-result result output))) + (newline)))) (define (eval-compile form module) (save-module-excursion |