From c7e5b8e20afe827eca020c46370095889b41967f Mon Sep 17 00:00:00 2001
From: Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
Date: Wed, 23 Apr 2003 09:21:30 +0000
Subject: [PATCH] Add display-continuation.

---
 scsh/interaction/README                | 23 +++++++++++++++++++++++
 scsh/interaction/inspect-exception.scm | 17 +++++++++++++++--
 scsh/interaction/interfaces.scm        |  4 +++-
 scsh/interaction/packages.scm          |  4 +++-
 4 files changed, 44 insertions(+), 4 deletions(-)

diff --git a/scsh/interaction/README b/scsh/interaction/README
index 9e9f8d4..e08d2f6 100644
--- a/scsh/interaction/README
+++ b/scsh/interaction/README
@@ -84,3 +84,26 @@ Error: exception
        (channel-maybe-write 32 '#{Byte-vector 10} 0 1 '#{Output-channel 4} ---)
 
 WARNING: Returning does not work from a scsh with a running REPL!!!
+
+
+
+(with-fatal-and-capturing-error-handler handler thunk)
+
+An exception handler with allows to capture the continuation of the
+exception. Here HANDLER is a procedure like
+
+(handler condition continuation decline) -> val
+
+CONDITION and DECLINE are the same as in the usual WITH-HANDLER
+procedure. CONTINUATION represents the continuation of the
+exception. However, this is not a procedure but the VM's continuation
+object. The continuation of HANDLER is the continuation of
+WITH-FATAL-AND-CAPTURING-ERROR-HANDLER.
+
+
+(display-continuation continuation [port] -> unspecified
+
+The procedural analogy to the ,proceed command. Continuation must be a
+continuation object as captured by
+WITH-FATAL-AND-CAPTURING-ERROR-HANDLER, not a procedure as captured by
+CALL-WITH-CURRENT-CONTINUATION.
\ No newline at end of file
diff --git a/scsh/interaction/inspect-exception.scm b/scsh/interaction/inspect-exception.scm
index 9d0f1fd..b57f947 100644
--- a/scsh/interaction/inspect-exception.scm
+++ b/scsh/interaction/inspect-exception.scm
@@ -5,7 +5,7 @@
 ;;; the distribution.
 
 ;; From SUnet plus one more call/cc to capture the continuation of the error
-(define (with-fatal-and-capturing-error-handler* handler thunk)
+(define (with-fatal-and-capturing-error-handler handler thunk)
   (call-with-current-continuation
    (lambda (accept)
      ((call-with-current-continuation
@@ -23,7 +23,7 @@
 	  (lambda () (call-with-values thunk accept)))))))))
 
 (define (with-inspecting-handler port prepare thunk)
-  (with-fatal-and-capturing-error-handler*
+  (with-fatal-and-capturing-error-handler
    (lambda (condition condition-continuation more)
      (with-handler
       (lambda (c2 m2)
@@ -37,3 +37,16 @@
             (with-continuation condition-continuation (lambda () res)))
           (more))))
       thunk))
+
+(define display-preview (eval 'display-preview 
+                              (rt-structure->environment (reify-structure 'debugging))))
+
+(define (display-continuation continuation . maybe-port)
+  (let ((out (if (null? maybe-port)
+                           (current-output-port)
+                           (car maybe-port))))
+    (if continuation
+        (display-preview (continuation-preview continuation)
+                         out)
+        (display 'bottom-contination out))))
+      
\ No newline at end of file
diff --git a/scsh/interaction/interfaces.scm b/scsh/interaction/interfaces.scm
index 4f4f023..6f7fdc1 100644
--- a/scsh/interaction/interfaces.scm
+++ b/scsh/interaction/interfaces.scm
@@ -3,7 +3,9 @@
 	  remote-repl))
 
 (define-interface inspect-exception-interface
-  (export with-inspecting-handler))
+  (export with-inspecting-handler
+          with-fatal-and-capturing-error-handler
+          display-continuation))
 
 (define-interface socket2stdports-interface
   (export socket<->stdports))
diff --git a/scsh/interaction/packages.scm b/scsh/interaction/packages.scm
index f599ab4..f01a6f3 100644
--- a/scsh/interaction/packages.scm
+++ b/scsh/interaction/packages.scm
@@ -10,6 +10,8 @@
 (define-structure inspect-exception inspect-exception-interface
 					    
   (open scheme-with-scsh
+        rt-modules
+        exceptions
 	conditions
 	escapes
 	handle
@@ -20,4 +22,4 @@
   (open scheme-with-scsh
 	handle
 	threads)
-  (files socket2stdport))
\ No newline at end of file
+  (files socket2stdport))