diff options
author | jao <jao@gnu.org> | 2022-10-08 20:54:03 +0100 |
---|---|---|
committer | jao <jao@gnu.org> | 2022-10-08 20:54:03 +0100 |
commit | db4d645996d1c3da9d50504baa34f3c685cd3b83 (patch) | |
tree | 387a2deb75b2c8d987031cc57bbc72469a071aab | |
parent | 48427d4aecc6fed751d266673f1ce2ad57ddbcfc (diff) | |
download | geiser-chez-db4d645996d1c3da9d50504baa34f3c685cd3b83.tar.gz geiser-chez-db4d645996d1c3da9d50504baa34f3c685cd3b83.tar.bz2 |
better display of evaluation results (dups, spurious compile msgs)
-rw-r--r-- | geiser-chez.el | 6 | ||||
-rw-r--r-- | 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<? (filter (lambda (el) (string-prefix? prefix el)) - (map write-to-string (environment-symbols (interaction-environment)))))) + (map write-to-string + (environment-symbols (interaction-environment)))))) (define (write-to-string x) (with-output-to-string (lambda () (write x)))) - (define (geiser:eval module form . rest) - rest - (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 . ,(format "~a~%~a" - (get-output-string output-string) - (with-output-to-string - (lambda () - (display-condition e))))) - (error (key . geiser-debugger))))) - (lambda () - (call-with-values - ;; evaluate form, allow for multiple return values, - ;; and capture output in output-string. - (lambda () - (parameterize ((current-output-port output-string)) - (if module - (eval form (environment module)) - (eval form)))) - (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 (geiser:eval module form) + (call-with-result + (lambda () (if module (eval form (environment module)) (eval form))))) (define (geiser:module-completions prefix . rest) (define (substring? s1 s2) |