From db4d645996d1c3da9d50504baa34f3c685cd3b83 Mon Sep 17 00:00:00 2001 From: jao Date: Sat, 8 Oct 2022 20:54:03 +0100 Subject: better display of evaluation results (dups, spurious compile msgs) --- geiser-chez.el | 6 ++--- src/geiser/geiser.ss | 75 ++++++++++++++++++++++++++-------------------------- 2 files changed, 39 insertions(+), 42 deletions(-) diff --git a/geiser-chez.el b/geiser-chez.el index 7f29927..b179ef7 100644 --- a/geiser-chez.el +++ b/geiser-chez.el @@ -204,10 +204,8 @@ This function uses `geiser-chez-init-file' if it exists." "Display an error found during evaluation with the given KEY and message MSG." (when (stringp msg) (save-excursion (insert msg)) - (geiser-edit--buttonize-files)) - (and (not key) - (not (zerop (length msg))) - msg)) + (geiser-edit--buttonize-files) + (not (zerop (length msg))))) ;;; Keywords and syntax: diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss index 6546579..0a7798b 100644 --- a/src/geiser/geiser.ss +++ b/src/geiser/geiser.ss @@ -9,10 +9,36 @@ geiser:macroexpand) (import (chezscheme)) + (define (call-with-result thunk) + (let ((output-string (open-output-string))) + (write + (call/cc + (lambda (k) + (with-exception-handler + (lambda (e) + (debug-condition e) ; save the condition for the debugger + (k `((result "") + (output . ,(with-output-to-string + (lambda () (display-condition e)))) + (error (key . condition))))) + (lambda () + (call-with-values + (lambda () + (parameterize ((current-output-port output-string)) (thunk))) + (lambda result + `((result ,(with-output-to-string + (lambda () + (pretty-print + (if (null? (cdr result)) (car result) result))))) + (output . ,(get-output-string output-string)))))))))) + (newline) + (close-output-port output-string))) + (define (last-index-of str-list char idx last-idx) (if (null? str-list) last-idx - (last-index-of (cdr str-list) char (+ 1 idx) (if (char=? char (car str-list)) idx last-idx)))) + (last-index-of (cdr str-list) char (+ 1 idx) + (if (char=? char (car str-list)) idx last-idx)))) (define (obj-file-name name) (let ((idx (last-index-of (string->list name) #\. 0 -1))) @@ -22,8 +48,11 @@ (define (geiser:load-file filename) (let ((output-filename (obj-file-name filename))) - (maybe-compile-file filename output-filename) - (load output-filename))) + (call-with-result + (lambda () + (with-output-to-string + (lambda () (maybe-compile-file filename output-filename))) + (load output-filename))))) (define string-prefix? (lambda (x y) @@ -35,50 +64,20 @@ (prefix? (fx+ i 1))))))))) (define (geiser:completions prefix . rest) - rest (sort string-ci