+ Factor out exit hooks into a separate package.

+ Let exit call the exit hooks.

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

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

scsh/scsh.scm

@@ -1135,10 +1135,11 @@
     proc))
 
 (define (exit . maybe-status)
-  (flush-all-ports)
+  (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.")))
+     (if #t (error "(exit) returned.")))))
 
 
 ;;; The classic T 2.0 primitive.

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)