[nongnu] elpa/geiser-chez 1bb0a87 06/37: Handle exceptions of ChezScheme and multi-value as well

[Philip Kaludercic]

branch: elpa/geiser-chez
commit 1bb0a878513ffeac666205b96b92174323322eae
Author: Chaos Eternal <chaos@shlug.org>
Commit: Chaos Eternal <chaos@shlug.org>

    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(-)

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)