From 741e3472be4aa7ae39d8d4dbb6e0875817f3d577 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Fri, 31 Jan 2014 22:47:42 -0700
Subject: [PATCH] Fluidize standard-error-hook, standard-warning-hook and...

...standard-breakpoint-hook.  These are exported to () so... apologies
in advance.
---
 doc/ref-manual/error.texi |  8 ++++----
 src/runtime/error.scm     | 20 ++++++++++++--------
 src/runtime/rep.scm       | 16 +++++++++-------
 3 files changed, 25 insertions(+), 19 deletions(-)

diff --git a/doc/ref-manual/error.texi b/doc/ref-manual/error.texi
index 0b66105b1..d9c42a3bd 100644
--- a/doc/ref-manual/error.texi
+++ b/doc/ref-manual/error.texi
@@ -454,9 +454,9 @@ order to simulate the effect of calling @code{error}, code may call
 @cindex fluid binding
 @cindex dynamic binding
 @cindex REP loop
-This variable controls the behavior of the procedure
+This fluid controls the behavior of the procedure
 @code{standard-error-handler}, and hence @code{error}.  It is intended
-to be bound with @code{fluid-let} and is normally @code{#f}.  It may be
+to be bound with @code{let-fluid} and is normally @code{#f}.  It may be
 changed to a procedure of one argument and will then be invoked (with
 @code{standard-error-hook} rebound to @code{#f}) by
 @code{standard-error-handler} just prior to starting the error
@@ -488,9 +488,9 @@ however.  For that purpose an explicit restart must be provided.)
 @findex standard-warning-handler
 @cindex fluid binding
 @cindex dynamic binding
-This variable controls the behavior of the procedure
+This fluid controls the behavior of the procedure
 @code{standard-warning-handler}, and hence @code{warn}.  It is intended
-to be bound with @code{fluid-let} and is normally @code{#f}.  It may be
+to be bound with @code{let-fluid} and is normally @code{#f}.  It may be
 changed to a procedure of one argument and will then be invoked (with
 @code{standard-warning-hook} rebound to @code{#f}) by
 @code{standard-warning-handler} in lieu of writing the warning message.
diff --git a/src/runtime/error.scm b/src/runtime/error.scm
index 993209086..50a32f14e 100644
--- a/src/runtime/error.scm
+++ b/src/runtime/error.scm
@@ -599,25 +599,27 @@ USA.
 	     (default-handler condition)))))))
 
 (define (standard-error-handler condition)
-  (let ((hook standard-error-hook))
+  (let ((hook (fluid standard-error-hook)))
     (if hook
-	(fluid-let ((standard-error-hook #f))
-	  (hook condition))))
+	(let-fluid standard-error-hook #f
+		   (lambda ()
+		     (hook condition)))))
   (repl/start (push-repl 'INHERIT condition '() "error>")))
 
 (define (standard-warning-handler condition)
-  (let ((hook standard-warning-hook))
+  (let ((hook (fluid standard-warning-hook)))
     (if hook
-	(fluid-let ((standard-warning-hook #f))
-	  (hook condition))
+	(let-fluid standard-warning-hook #f
+		   (lambda ()
+		     (hook condition)))
 	(let ((port (notification-output-port)))
 	  (fresh-line port)
 	  (write-string ";Warning: " port)
 	  (write-condition-report condition port)
 	  (newline port)))))
 
-(define standard-error-hook #f)
-(define standard-warning-hook #f)
+(define standard-error-hook)
+(define standard-warning-hook)
 
 (define (condition-signaller type field-names default-handler)
   (guarantee-condition-handler default-handler 'CONDITION-SIGNALLER)
@@ -760,6 +762,8 @@ USA.
   (memq condition-type:error (%condition-type/generalizations type)))
 
 (define (initialize-package!)
+  (set! standard-error-hook (make-fluid #f))
+  (set! standard-warning-hook (make-fluid #f))
   (set! hook/invoke-condition-handler default/invoke-condition-handler)
   ;; No eta conversion for bootstrapping and efficiency reasons.
   (set! hook/invoke-restart
diff --git a/src/runtime/rep.scm b/src/runtime/rep.scm
index a91d12019..9c2215d96 100644
--- a/src/runtime/rep.scm
+++ b/src/runtime/rep.scm
@@ -34,6 +34,7 @@ USA.
 
 (define (initialize-package!)
   (set! *nearest-cmdl* (make-fluid #f))
+  (set! standard-breakpoint-hook (make-fluid #f))
   (set! hook/repl-read default/repl-read)
   (set! hook/repl-eval default/repl-eval)
   (set! hook/repl-write default/repl-write)
@@ -123,13 +124,13 @@ USA.
 	      *interaction-i/o-port* #f
 	      *working-directory-pathname* (fluid *working-directory-pathname*)
 	      *nearest-cmdl* cmdl
+	      standard-error-hook #f
+	      standard-warning-hook #f
+	      standard-breakpoint-hook #f
 	      (lambda ()
 		(fluid-let ((dynamic-handler-frames '())
 			    (*bound-restarts*
 			     (if (cmdl/parent cmdl) *bound-restarts* '()))
-			    (standard-error-hook #f)
-			    (standard-warning-hook #f)
-			    (standard-breakpoint-hook #f)
 			    (*default-pathname-defaults*
 			     *default-pathname-defaults*))
 		  (let loop ((message message))
@@ -944,14 +945,15 @@ USA.
   unspecific)
 
 (define (standard-breakpoint-handler condition)
-  (let ((hook standard-breakpoint-hook))
+  (let ((hook (fluid standard-breakpoint-hook)))
     (if hook
-	(fluid-let ((standard-breakpoint-hook #f))
-	  (hook condition))))
+	(let-fluid standard-breakpoint-hook #f
+		   (lambda ()
+		     (hook condition)))))
   (repl/start (push-repl (breakpoint/environment condition)
 			 condition
 			 '()
 			 (breakpoint/prompt condition))
 	      (breakpoint/message condition)))
 
-(define standard-breakpoint-hook #f)
\ No newline at end of file
+(define standard-breakpoint-hook)
-- 
2.25.1