From 1bb0a878513ffeac666205b96b92174323322eae Mon Sep 17 00:00:00 2001
From: Chaos Eternal <chaos@shlug.org>
Date: Fri, 18 Aug 2017 16:27:30 +0800
Subject: Handle exceptions of ChezScheme and multi-value as well

- Capture exceptions of ChezScheme
- handles multi-value return
---
 scheme/chez/geiser/geiser.ss | 31 +++++++++++++++++++++++++++----
 1 file changed, 27 insertions(+), 4 deletions(-)

(limited to 'scheme/chez/geiser')

diff --git a/scheme/chez/geiser/geiser.ss b/scheme/chez/geiser/geiser.ss
index 2fa648c..6568120 100644
--- a/scheme/chez/geiser/geiser.ss
+++ b/scheme/chez/geiser/geiser.ss
@@ -30,11 +30,34 @@
 
   (define (geiser:eval module form . rest)
     rest
-    (let ((result (if module
-                      (eval form (environment module))
-                      (eval form))))
+    (let* ((try-eval (lambda (x . y)
+		       (call/cc
+			(lambda (k)
+			  (with-exception-handler
+			      (lambda (e)
+				(k e))
+			    (lambda () 
+				    (if (null? y) (eval x)
+					(eval x (car y)))
+				    ))))))
+	   (result-mid (call-with-values
+			   (lambda () (if module
+					  (try-eval form (environment module))
+					  (try-eval form)))
+			 (lambda (x . y)
+			   (if (null? y)
+			       x
+			       (cons x y)))))
+	   (result result-mid)
+	   (error (if (condition? result-mid)
+		      (cons 'error (list
+				    (cons 'key
+					  (with-output-to-string
+					    (lambda () (display-condition result-mid))))))
+		      '())))
       (write `((result ,(write-to-string result))
-               (output . "")))
+               (output . "")
+	       ,error))
       (newline)))
 
   (define (geiser:module-completions prefix . rest)
-- 
cgit v1.2.3