master 66d0101: Show log suppression buttons in display-warning buffer

[Lars Ingebrigtsen]

branch: master
commit 66d01012ba61a364fe92cdc1728bfa135a90626a
Author: Robert Pluim <rpluim@gmail.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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 1ae24d9..e88eaa7 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 b1fd6ed..3a568cb 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)