From 66d01012ba61a364fe92cdc1728bfa135a90626a Mon Sep 17 00:00:00 2001
From: Robert Pluim <rpluim@gmail.com>
Date: Fri, 4 Sep 2020 06:28:21 +0200
Subject: [PATCH] Show log suppression buttons in display-warning buffer

* etc/NEWS: Describe 'display-warning' button change (bug#30757).
* lisp/emacs-lisp/warnings.el (warning-suppress-warning):
Define button.
(warning-suppress-action): New function.
(warning-suppress-log-warning): Define button.
(warning-suppress-log-action): New function.
(display-warning): Show buttons to allow permanent
modification of warning-suppress-types and
warning-suppress-log-types per warning.
---
 etc/NEWS                    |  8 ++++++++
 lisp/emacs-lisp/warnings.el | 30 +++++++++++++++++++++++++++++-
 2 files changed, 37 insertions(+), 1 deletion(-)

diff --git a/etc/NEWS b/etc/NEWS
index 1ae24d946dd..e88eaa7167c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -167,6 +167,14 @@ same for a button.
 
 * Changes in Specialized Modes and Packages in Emacs 28.1
 
+---
+** Specific warnings can now be disabled from the warning buffer.
+When a warning is displayed to the user, the resulting buffer now has
+buttons which allow making permanent changes to the treatment of that
+warning.  Automatic showing of the warning can be disabled (although
+it is still logged to the *Messages* buffer), or the warning can be
+disabled entirely.
+
 ** mspool.el
 ---
 *** Autoload the main entry point 'mspool-show'
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index b1fd6ed80ad..3a568cb834c 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -200,6 +200,21 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress."
     ;; we return t.
     some-match))
 
+(define-button-type 'warning-suppress-warning
+  'action #'warning-suppress-action
+  'help-echo "mouse-2, RET: Don't display this warning automatically")
+(defun warning-suppress-action (button)
+  (customize-save-variable 'warning-suppress-types
+                           (cons (list (button-get button 'warning-type))
+                                 warning-suppress-types)))
+(define-button-type 'warning-suppress-log-warning
+  'action #'warning-suppress-log-action
+  'help-echo "mouse-2, RET: Don't log this warning")
+(defun warning-suppress-log-action (button)
+  (customize-save-variable 'warning-suppress-log-types
+                           (cons (list (button-get button 'warning-type))
+                                 warning-suppress-types)))
+
 ;;;###autoload
 (defun display-warning (type message &optional level buffer-name)
   "Display a warning message, MESSAGE.
@@ -227,7 +242,12 @@ See the `warnings' custom group for user customization features.
 
 See also `warning-series', `warning-prefix-function',
 `warning-fill-prefix', and `warning-fill-column' for additional
-programming features."
+programming features.
+
+This will also display buttons allowing the user to permanently
+disable automatic display of the warning or disable the warning
+entirely by setting `warning-suppress-types' or
+`warning-suppress-log-types' on their behalf."
   (if (not (or after-init-time noninteractive (daemonp)))
       ;; Ensure warnings that happen early in the startup sequence
       ;; are visible when startup completes (bug#20792).
@@ -272,6 +292,14 @@ programming features."
 	      (insert (format (nth 1 level-info)
 			      (format warning-type-format typename))
 		      message)
+              (insert " ")
+              (insert-button "Disable showing"
+                             'type 'warning-suppress-warning
+                             'warning-type type)
+              (insert " ")
+              (insert-button "Disable logging"
+                             'type 'warning-suppress-log-warning
+                             'warning-type type)
               (funcall newline)
 	      (when (and warning-fill-prefix (not (string-match "\n" message)))
 		(let ((fill-prefix warning-fill-prefix)
-- 
2.39.2