Fluidize standard-error-hook, standard-warning-hook and...
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Sat, 1 Feb 2014 05:47:42 +0000 (22:47 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Tue, 12 Aug 2014 00:30:27 +0000 (17:30 -0700)
...standard-breakpoint-hook.  These are exported to () so... apologies
in advance.

doc/ref-manual/error.texi
src/runtime/error.scm
src/runtime/rep.scm

index 0b66105b16bdb30dcf9440c552ad1ffe070efc8f..d9c42a3bd500858ba22743cd73cc57da92b30c9f 100644 (file)
@@ -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.
index 993209086e02232ad7a86954fe1cc2fc404eb546..50a32f14e94579afc22f818495ec6d445d505fd8 100644 (file)
@@ -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)))
 \f
 (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
index a91d12019e9a5b0e2733d2ce37fd96c69e413eda..9c2215d964e18813a95210c20e6f49b15984abaf 100644 (file)
@@ -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)