handle-system-error to scm-style-repl

* module/ice-9/boot-9.scm:
* module/ice-9/scm-style-repl.scm (handle-system-error): Move here from
  boot-9.

* module/ice-9/deprecated.scm (handle-system-error): Keep a deprecated
  wrapper in the root environment.

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index d7f010f..e09bb96 100644 (file)
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2710,27 +2710,6 @@ module '(ice-9 q) '(make-q q-length))}."
                              narrowing)))
         (set! stack-saved? #t))))
 
-(define (handle-system-error key . args)
-  (let ((cep (current-error-port)))
-    (cond ((not (stack? (fluid-ref the-last-stack))))
-          ((memq 'backtrace (debug-options-interface))
-           (let ((highlights (if (or (eq? key 'wrong-type-arg)
-                                     (eq? key 'out-of-range))
-                                 (list-ref args 3)
-                                 '())))
-             (run-hook before-backtrace-hook)
-             (newline cep)
-             (display "Backtrace:\n")
-             (display-backtrace (fluid-ref the-last-stack) cep
-                                #f #f highlights)
-             (newline cep)
-             (run-hook after-backtrace-hook))))
-    (run-hook before-error-hook)
-    (apply display-error (fluid-ref the-last-stack) cep args)
-    (run-hook after-error-hook)
-    (force-output cep)
-    (throw 'abort key)))
-
 (define (quit . args)
   (apply throw 'quit args))
 

diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 27c70f8..1df6741 100644 (file)
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -58,7 +58,8 @@
             set-batch-mode?!
             repl
             pre-unwind-handler-dispatch
-            default-pre-unwind-handler)
+            default-pre-unwind-handler
+            handle-system-error)
 
   #:replace (module-ref-submodule module-define-submodule!))
 
@@ -630,3 +631,9 @@ the `(system repl common)' module.")
    "`default-pre-unwind-handler' is deprecated. Use it from 
 `(ice-9 scm-style-repl)' if you need it.")
   (apply (@ (ice-9 scm-style-repl) default-pre-unwind-handler) key args))
+
+(define (handle-system-error key . args)
+  (issue-deprecation-warning
+   "`handle-system-error' is deprecated. Use it from 
+`(ice-9 scm-style-repl)' if you need it.")
+  (apply (@ (ice-9 scm-style-repl) handle-system-error) key args))

diff --git a/module/ice-9/scm-style-repl.scm b/module/ice-9/scm-style-repl.scm
index 5ce8185..d873b10 100644 (file)
--- a/module/ice-9/scm-style-repl.scm
+++ b/module/ice-9/scm-style-repl.scm
@@ -31,7 +31,8 @@
              bad-throw
              error-catching-loop
              error-catching-repl
-             scm-style-repl))
+             scm-style-repl
+             handle-system-error))
 
 (define scm-repl-silent #f)
 (define (assert-repl-silence v) (set! scm-repl-silent v))
@@ -257,3 +258,24 @@
                                        -eval
                                        -print)))
       (-quit status))))
+
+(define (handle-system-error key . args)
+  (let ((cep (current-error-port)))
+    (cond ((not (stack? (fluid-ref the-last-stack))))
+          ((memq 'backtrace (debug-options-interface))
+           (let ((highlights (if (or (eq? key 'wrong-type-arg)
+                                     (eq? key 'out-of-range))
+                                 (list-ref args 3)
+                                 '())))
+             (run-hook before-backtrace-hook)
+             (newline cep)
+             (display "Backtrace:\n")
+             (display-backtrace (fluid-ref the-last-stack) cep
+                                #f #f highlights)
+             (newline cep)
+             (run-hook after-backtrace-hook))))
+    (run-hook before-error-hook)
+    (apply display-error (fluid-ref the-last-stack) cep args)
+    (run-hook after-error-hook)
+    (force-output cep)
+    (throw 'abort key)))