batch-mode? in terms of *repl-level*

[bpt/guile.git] / module / ice-9 / scm-style-repl.scm

diff --git a/module/ice-9/scm-style-repl.scm b/module/ice-9/scm-style-repl.scm
index e544872..c316c38 100644 (file)
--- a/module/ice-9/scm-style-repl.scm
+++ b/module/ice-9/scm-style-repl.scm
@@ -17,11 +17,47 @@
 ;;;;
 
 (define-module (ice-9 scm-style-repl)
+  #:export (scm-repl-silent
+            scm-repl-print-unspecified
+            scm-repl-verbose
+            scm-repl-prompt)
+  
   ;; #:replace, as with deprecated code enabled these will be in the root env
-  #:replace (error-catching-loop
+  #:replace (assert-repl-silence
+             assert-repl-print-unspecified
+             assert-repl-verbosity
+
+             bad-throw
+             error-catching-loop
              error-catching-repl
              scm-style-repl))
 
+(define scm-repl-silent #f)
+(define (assert-repl-silence v) (set! scm-repl-silent v))
+
+(define scm-repl-print-unspecified #f)
+(define (assert-repl-print-unspecified v) (set! scm-repl-print-unspecified v))
+
+(define scm-repl-verbose #f)
+(define (assert-repl-verbosity v) (set! scm-repl-verbose v))
+
+(define scm-repl-prompt "guile> ")
+
+\f
+
+;; bad-throw is the hook that is called upon a throw to a an unhandled
+;; key (unless the throw has four arguments, in which case
+;; it's usually interpreted as an error throw.)
+;; If the key has a default handler (a throw-handler-default property),
+;; it is applied to the throw.
+;;
+(define (bad-throw key . args)
+  (let ((default (symbol-property key 'throw-handler-default)))
+    (or (and default (apply default key args))
+        (apply error "unhandled-exception:" key args))))
+
+\f
+
 (define (error-catching-loop thunk)
   (let ((status #f)
         (interactive #t))
@@ -93,12 +129,9 @@
                     default-pre-unwind-handler)))
 
         (if next (loop next) status)))
-    (set! set-batch-mode?! (lambda (arg)
-                             (cond (arg
-                                    (set! interactive #f)
-                                    (restore-signals))
-                                   (#t
-                                    (error "sorry, not implemented")))))
+    (set! ensure-batch-mode! (lambda ()
+                               (set! interactive #f)
+                               (restore-signals)))
     (set! batch-mode? (lambda () (not interactive)))
     (call-with-blocked-asyncs
      (lambda () (loop (lambda () #t))))))