From 8b451fe673cf375d69c53ab750a7f2f07149968f Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Wed, 25 Sep 2002 11:40:07 +0000
Subject: [PATCH] + Factor out exit hooks into a separate package. + Let exit
 call the exit hooks.

---
 scsh/scsh-interfaces.scm |  4 ++++
 scsh/scsh-package.scm    | 27 +++++++++++++++++++++++++--
 scsh/scsh.scm            |  9 +++++----
 scsh/top.scm             | 22 +++-------------------
 4 files changed, 37 insertions(+), 25 deletions(-)

diff --git a/scsh/scsh-interfaces.scm b/scsh/scsh-interfaces.scm
index 3345005..203a17d 100644
--- a/scsh/scsh-interfaces.scm
+++ b/scsh/scsh-interfaces.scm
@@ -595,6 +595,10 @@
 	  scsh-version-string
 	  scsh-release-name))
 
+(define-interface exit-hooks-interface
+  (export call-exit-hooks-and-narrow
+	  add-narrowed-exit-hook!
+	  add-exit-hook!))
 
 ;;; This is probably bogus.
 (define-interface string-ports-interface
diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm
index bfca910..ae43c6d 100644
--- a/scsh/scsh-package.scm
+++ b/scsh/scsh-package.scm
@@ -241,6 +241,7 @@
 	features
 	general-tables
 	simple-syntax
+	exit-hooks
 
 	scsh-errors
 	scsh-endian)  
@@ -335,8 +336,6 @@
 
 (define-structure scsh-top-package (export parse-switches-and-execute
 					   with-scsh-initialized
-					   add-exit-hook!
-					   add-narrowed-exit-hook!
 					   repl)
   (open command-processor
 	command-levels          ; with-new-session
@@ -370,9 +369,33 @@
 			 char-set-contains?
 			 string->char-set))
 	root-scheduler          ; scheme-exit-now
+	exit-hooks
 	scheme)
   (files top meta-arg))
 
+(define-structure exit-hooks exit-hooks-interface
+  (open scheme
+	threads)
+  (begin
+    (define *exit-hooks* '())
+    (define (add-exit-hook! thunk)
+      (set! *exit-hooks* (cons thunk *exit-hooks*)))
+    (define (call-exit-hooks!)
+      (for-each (lambda (thunk) (thunk)) *exit-hooks*))
+    
+    (define *narrowed-exit-hooks* '())
+    (define (add-narrowed-exit-hook! thunk)
+      (set! *narrowed-exit-hooks* (cons thunk *narrowed-exit-hooks*)))
+    (define (call-narrowed-exit-hooks!)
+      (for-each (lambda (thunk) (thunk)) *narrowed-exit-hooks*))
+    
+    (define (call-exit-hooks-and-narrow thunk)
+      (call-exit-hooks!)
+      (narrow
+       (lambda ()
+	 (call-narrowed-exit-hooks!)
+	 (thunk))))))
+
 
 (define-structure field-reader-package scsh-field-reader-interface
   (open receiving             ; receive
diff --git a/scsh/scsh.scm b/scsh/scsh.scm
index 9773e16..4069719 100644
--- a/scsh/scsh.scm
+++ b/scsh/scsh.scm
@@ -1135,10 +1135,11 @@
     proc))
 
 (define (exit . maybe-status)
-  (flush-all-ports)
-  (exit/errno (:optional  maybe-status 0))
-  (display "The evil undead walk the earth." 2)
-  (if #t (error "(exit) returned.")))
+  (call-exit-hooks-and-narrow
+   (lambda ()
+     (exit/errno (:optional  maybe-status 0))
+     (display "The evil undead walk the earth." 2)
+     (if #t (error "(exit) returned.")))))
 
 
 ;;; The classic T 2.0 primitive.
diff --git a/scsh/top.scm b/scsh/top.scm
index b3f73da..6dba92a 100644
--- a/scsh/top.scm
+++ b/scsh/top.scm
@@ -327,9 +327,7 @@
 	    (lambda (c m)
 	      (scheme-exit-now 1))
 	    (lambda ()
-	      (call-exit-hooks)
-	      (narrow (lambda ()
-			(call-narrowed-exit-hooks)))
+	      (call-exit-hooks-and-narrow (lambda () #t))
 	      (more)))))
      (lambda ()
        (with-scsh-initialized
@@ -352,7 +350,7 @@
 			      (interaction-environment)))
 	   
 	    (cond ((not term-switch)	; -- interactive
-		   (scsh-exit-now
+		   (scsh-exit-now       ;; TODO: ,exit will bypass this
 		    (restart-command-processor 
 		     args 
 		     context 
@@ -389,23 +387,9 @@
       (if (eof-object? (read)) val
 	  (error "More than one value read from string" s)))))
 
-(define *exit-hooks* '())
-(define (add-exit-hook! thunk)
-  (set! *exit-hooks* (cons thunk *exit-hooks*)))
-(define (call-exit-hooks)
-  (for-each (lambda (thunk) (thunk)) *exit-hooks*))
-
-(define *narrowed-exit-hooks* '())
-(define (add-narrowed-exit-hook! thunk)
-  (set! *narrowed-exit-hooks* (cons thunk *narrowed-exit-hooks*)))
-(define (call-narrowed-exit-hooks)
-  (for-each (lambda (thunk) (thunk)) *narrowed-exit-hooks*))
-
 (define (scsh-exit-now status)
-  (call-exit-hooks)
-  (narrow
+  (call-exit-hooks-and-narrow
    (lambda ()
-     (call-narrowed-exit-hooks)
      (scheme-exit-now status))))
 
 (add-narrowed-exit-hook! flush-all-ports-no-threads)