From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Fri, 5 Sep 2014 22:36:33 +0000 (-0700)
Subject: gtk: Fix and fluidize load-option/suppress-loading-message?.
X-Git-Tag: mit-scheme-pucked-9.2.12~399
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6e4a7fb25aee6e502df46206c6411e33a920cc8f;p=mit-scheme.git

gtk: Fix and fluidize load-option/suppress-loading-message?.
---

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index a2eb5752f..b8ebdf251 100644
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -551,7 +551,8 @@ USA.
 (define (load-ffi-quietly)
   (if (not (name->package '(FFI)))
       (let ((kernel (lambda ()
-		      (let-fluid load/suppress-loading-message? #t
+		      (let-fluids load-option/suppress-loading-message? #t
+				  load/suppress-loading-message? #t
 			(lambda ()
 			  (load-option 'FFI))))))
 	(if (nearest-cmdl/batch-mode?)
diff --git a/src/runtime/option.scm b/src/runtime/option.scm
index d5aabc9cd..e2eff9432 100644
--- a/src/runtime/option.scm
+++ b/src/runtime/option.scm
@@ -29,7 +29,7 @@ USA.
 
 (declare (usual-integrations))
 
-(define load-option/suppress-loading-message? #f)
+(define load-option/suppress-loading-message?)
 
 (define (load-option name #!optional no-error?)
   (let ((no-error? (and (not (default-object? no-error?)) no-error?)))
@@ -42,7 +42,7 @@ USA.
 
     (define (notifier option)
       (named-lambda (notify port)
-	(if (not load-option/suppress-loading-message?)
+	(if (not (fluid load-option/suppress-loading-message?))
 	    (begin
 	      (write-string "Loading " port)
 	      (write-string (symbol-name option) port)
@@ -115,7 +115,8 @@ USA.
 
 (define (initialize-package!)
   (set! *options* (make-fluid '()))
-  (set! *parent* (make-fluid initial-load-options)))
+  (set! *parent* (make-fluid initial-load-options))
+  (set! load-option/suppress-loading-message? (make-fluid #f)))
 
 (define (dummy-option-loader)
   unspecific)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 4812034aa..e3de7bd46 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3007,6 +3007,7 @@ USA.
   (files "option")
   (parent (runtime))
   (export ()
+	  load-option/suppress-loading-message?
 	  *initial-options-file*
 	  define-load-option
 	  dummy-option-loader
@@ -3343,8 +3344,7 @@ USA.
 	  link-shim
 	  install-shim
 	  install-load-option
-	  install-html
-	  load-option/suppress-loading-message?)
+	  install-html)
   (initialization (initialize-package!)))
 
 (define-package (runtime program-copier)