From 74a1797f60e26c7adbc491840f89bbaab08e504d Mon Sep 17 00:00:00 2001
From: Richard M Kreuter <kreuter@users.sourceforge.net>
Date: Thu, 3 Jul 2008 21:31:57 +0000
Subject: [PATCH] 1.0.18.11: Add SB-EXT:*MUFFLED-WARNINGS*, to muffle warnings
 at runtime.

---
 package-data-list.lisp-expr |  3 +++
 src/code/condition.lisp     |  6 +++++-
 src/code/target-error.lisp  | 10 +++++++++-
 src/code/target-thread.lisp |  2 +-
 version.lisp-expr           |  2 +-
 5 files changed, 19 insertions(+), 4 deletions(-)

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 9174aca08..37513088e 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -645,6 +645,9 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                ;; and a mechanism for controlling same at compile time
                "MUFFLE-CONDITIONS" "UNMUFFLE-CONDITIONS"
 
+               ;; and one for controlling same at runtime
+               "*MUFFLED-WARNINGS*"
+
                ;; extended declarations..
                "FREEZE-TYPE" "INHIBIT-WARNINGS"
                "MAYBE-INLINE"
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 594b3ac33..a512b023b 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -1273,7 +1273,11 @@ the values returned by the form as a list. No associated restarts."))
      (format stream "Returning from STEP")))
   #!+sb-doc
   (:documentation "Condition signaled when STEP returns."))
-
+
+;;; A knob for muffling warnings, mostly for use while loading files.
+(defvar *muffled-warnings* nil
+  "A type that ought to specify a subtype of WARNING.  Whenever a warning
+is signaled, if the warning if of this type, it will be muffled.")
 
 ;;;; restart definitions
 
diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index 2f6d3fc13..d5025a507 100644
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -19,7 +19,15 @@
 ;;; associated with Condition
 (defvar *condition-restarts* ())
 
-(defvar *handler-clusters* nil)
+(defun initial-handler-clusters ()
+  `(((warning . ,#'(lambda (warning)
+                     (when (typep warning
+                                  (locally
+                                      (declare (special sb!ext:*muffled-warnings*))
+                                    sb!ext:*muffled-warnings*))
+                       (muffle-warning warning)))))))
+
+(defvar *handler-clusters* (initial-handler-clusters))
 
 (defstruct (restart (:copier nil) (:predicate nil))
   (name (missing-arg) :type symbol :read-only t)
diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 61ea1af1e..c37afefa5 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -702,7 +702,7 @@ around and can be retrieved by JOIN-THREAD."
             ;;   --njf, 2006-07-15
             (let* ((*current-thread* thread)
                    (*restart-clusters* nil)
-                   (*handler-clusters* nil)
+                   (*handler-clusters* (sb!kernel::initial-handler-clusters))
                    (*condition-restarts* nil)
                    (sb!impl::*deadline* nil)
                    (sb!impl::*step-out* nil)
diff --git a/version.lisp-expr b/version.lisp-expr
index c4c1bc4d5..4fb7061fa 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.18.10"
+"1.0.18.11"
-- 
2.11.4.GIT