From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 14 Sep 1992 23:08:42 +0000 (+0000)
Subject: Add HOOK/EXIT and HOOK/QUIT to allow EXIT and QUIT to be overridden.
X-Git-Tag: 20090517-FFI~8969
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=de7aba06630ee2ff47ba43319eea28be78abb88f;p=mit-scheme.git

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 510ce2929..c1c424bd1 100644
--- 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 73280c4a6..c1c424bd1 100644
--- 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)))