diff options
| -rw-r--r-- | elisp/geiser-racket.el | 9 | ||||
| -rw-r--r-- | scheme/racket/geiser.rkt | 2 | ||||
| -rw-r--r-- | scheme/racket/geiser/eval.rkt | 26 |
3 files changed, 16 insertions, 21 deletions
diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el index dcff4cc..d876714 100644 --- a/elisp/geiser-racket.el +++ b/elisp/geiser-racket.el @@ -158,6 +158,14 @@ This function uses `geiser-racket-init-file' if it exists." "path:\"?\\([^>\"\n]+\\)\"?>" "module: \"\\([^>\"\n]+\\)\"")) +(defconst geiser-racket--geiser-file-rx + "^/[^:\n\"]*/geiser/[^:\n\"]*:") + +(defun geiser-racket--purge-trace () + (save-excursion + (while (re-search-forward geiser-racket--geiser-file-rx nil t) + (kill-whole-line)))) + (defun geiser-racket--find-files (rx) (save-excursion (while (re-search-forward rx nil t) @@ -179,6 +187,7 @@ This function uses `geiser-racket-init-file' if it exists." (when key (let ((end (point))) (goto-char p) + (geiser-racket--purge-trace) (mapc 'geiser-racket--find-files geiser-racket--file-rxs) (goto-char end) (newline))))) diff --git a/scheme/racket/geiser.rkt b/scheme/racket/geiser.rkt index 45d1289..1ab7983 100644 --- a/scheme/racket/geiser.rkt +++ b/scheme/racket/geiser.rkt @@ -17,6 +17,8 @@ "Racket version 5.0 or better required (found ~a)" (version))) +(require errortrace) + (require geiser/user) ;;; geiser.rkt ends here diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt index de53728..f2cf39f 100644 --- a/scheme/racket/geiser/eval.rkt +++ b/scheme/racket/geiser/eval.rkt @@ -19,6 +19,7 @@ make-repl-reader) (require geiser/enter geiser/modules geiser/autodoc) +(require errortrace/errortrace-lib) (define last-result (void)) @@ -30,28 +31,12 @@ (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)) (newline) (newline) - (for-each display-exn-context (get-real-context e))) + (parameterize ([error-context-display-depth 10]) + (print-error-trace (current-output-port) e))) (define (write-value v) (with-output-to-string @@ -65,9 +50,8 @@ (let ([output (with-output-to-string (lambda () - (parameterize ([current-marks (current-continuation-marks)]) - (with-handlers ([exn? set-last-error]) - (call-with-values thunk set-last-result)))))]) + (with-handlers ([exn? set-last-error]) + (call-with-values thunk set-last-result))))]) (append last-result `((output . ,output))))) (define (eval-in form spec lang) |