Add HOOK/EXIT and HOOK/QUIT to allow EXIT and QUIT to be overridden.

diff --git a/v7/src/runtime/global.scm b/v7/src/runtime/global.scm
index 510ce2929779bc7dd4ea436b69eb33596bfbd487..c1c424bd1f0c774cd93442a95eb200a344c2d645 100644 (file)
--- a/v7/src/runtime/global.scm
+++ b/v7/src/runtime/global.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.40 1992/07/21 21:57:58 cph Exp $
+$Id: global.scm,v 14.41 1992/09/14 23:08:42 cph Exp $
 
 Copyright (c) 1988-92 Massachusetts Institute of Technology
 
@@ -193,11 +193,13 @@ MIT in each case. |#
          (wait-loop)))))
 
 (define (exit #!optional integer)
-  (cond ((not (prompt-for-confirmation "Kill Scheme")))
-       ((default-object? integer)
-        (%exit))
-       (else
-        (%exit integer))))
+  (hook/exit (if (default-object? integer) false integer)))
+
+(define (default/exit integer)
+  (if (prompt-for-confirmation "Kill Scheme")
+      (if integer (%exit integer) (%exit))))
+
+(define hook/exit default/exit)
 
 (define (%exit #!optional integer)
   (event-distributor/invoke! event:before-exit)
@@ -206,9 +208,14 @@ MIT in each case. |#
       ((ucode-primitive exit-with-value 1) integer)))
 
 (define (quit)
+  (hook/quit))
+
+(define (default/quit)
   (with-absolutely-no-interrupts (ucode-primitive halt))
   unspecific)
 
+(define hook/quit default/quit)
+
 (define syntaxer/default-environment
   (let () (the-environment)))
 

diff --git a/v8/src/runtime/global.scm b/v8/src/runtime/global.scm
index 73280c4a65db3768fca52979334a183d5c0540a1..c1c424bd1f0c774cd93442a95eb200a344c2d645 100644 (file)
--- a/v8/src/runtime/global.scm
+++ b/v8/src/runtime/global.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.40 1992/07/21 21:57:58 cph Exp $
+$Id: global.scm,v 14.41 1992/09/14 23:08:42 cph Exp $
 
 Copyright (c) 1988-92 Massachusetts Institute of Technology
 
@@ -193,11 +193,13 @@ MIT in each case. |#
          (wait-loop)))))
 
 (define (exit #!optional integer)
-  (cond ((not (prompt-for-confirmation "Kill Scheme")))
-       ((default-object? integer)
-        (%exit))
-       (else
-        (%exit integer))))
+  (hook/exit (if (default-object? integer) false integer)))
+
+(define (default/exit integer)
+  (if (prompt-for-confirmation "Kill Scheme")
+      (if integer (%exit integer) (%exit))))
+
+(define hook/exit default/exit)
 
 (define (%exit #!optional integer)
   (event-distributor/invoke! event:before-exit)
@@ -206,9 +208,14 @@ MIT in each case. |#
       ((ucode-primitive exit-with-value 1) integer)))
 
 (define (quit)
+  (hook/quit))
+
+(define (default/quit)
   (with-absolutely-no-interrupts (ucode-primitive halt))
   unspecific)
 
+(define hook/quit default/quit)
+
 (define syntaxer/default-environment
   (let () (the-environment)))