summaryrefslogtreecommitdiff
path: root/scheme/chez/geiser/geiser.ss
diff options
context:
space:
mode:
authorjitwit <jrn@bluefarm.ca>2019-12-05 15:03:50 -0500
committerjitwit <jrn@bluefarm.ca>2019-12-05 15:03:50 -0500
commit7bc8f62409b66bdb35b934c632d7fea12a53d636 (patch)
tree255a283fa422136f9d7656570461530e9855c569 /scheme/chez/geiser/geiser.ss
parent2d682c0ae4963bfc28966cdf9f4544412c846d11 (diff)
downloadgeiser-chez-7bc8f62409b66bdb35b934c632d7fea12a53d636.tar.gz
geiser-chez-7bc8f62409b66bdb35b934c632d7fea12a53d636.tar.bz2
Capture stdout in ChezScheme's eval:geiser
Diffstat (limited to 'scheme/chez/geiser/geiser.ss')
-rw-r--r--scheme/chez/geiser/geiser.ss60
1 files changed, 28 insertions, 32 deletions
diff --git a/scheme/chez/geiser/geiser.ss b/scheme/chez/geiser/geiser.ss
index 38bc68f..70b6b67 100644
--- a/scheme/chez/geiser/geiser.ss
+++ b/scheme/chez/geiser/geiser.ss
@@ -47,38 +47,34 @@
(define (geiser:eval module form . rest)
rest
- (let* ((body (lambda ()
- (if module
- (eval form (environment module))
- (eval form))))
- (gen-result (lambda (result-mid is-error?)
- (if is-error?
- `((result "")
- (output . "")
- (error . ,(list
- (cons 'key
- (with-output-to-string
- (lambda ()
- (display-condition result-mid)))))))
- `((result ,(with-output-to-string
- (lambda ()
- (pretty-print result-mid))))
- (output . "")))))
- (result (call/cc
- (lambda (k)
- (with-exception-handler
- (lambda (e)
- (k (gen-result e #t)))
- (lambda ()
- (call-with-values
- (lambda ()
- (body))
- (lambda (x . y)
- (if (null? y)
- (k (gen-result x #f))
- (k (gen-result (cons x y) #f)))))))))))
- (write result)
- (newline)))
+ (let ((output-string (open-output-string)))
+ (write
+ (call/cc
+ (lambda (k)
+ (with-exception-handler
+ (lambda (e)
+ (k `((result "")
+ (output . ,(get-output-string output-string))
+ (error (key . ,(with-output-to-string
+ (lambda ()
+ (display-condition e))))))))
+ (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:module-completions prefix . rest)
(define (substring? s1 s2)