Use icons in warnings buffers

* lisp/emacs-lisp/warnings.el (warning-suppress-action)
(warning-suppress-log-action): Removed.
New icon.
(warnings-suppress): New helper function.
(display-warning): Use it (bug#46025).

1 files changed, 30 insertions, 25 deletions

diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 23e20c3b10c..516fdeb10ea 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -27,6 +27,8 @@
 
 ;;; Code:
 
+(require 'icons)
+
 (defgroup warnings nil
   "Log and display warnings."
   :version "22.1"
@@ -201,20 +203,28 @@ 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)))
+(define-icon warnings-suppress button
+  '((emoji "⛔")
+    (symbol " ■ ")
+    (text " stop "))
+  "Suppress warnings."
+  :version "29.1"
+  :help-echo "Click to supress this warning type")
+
+(defun warnings-suppress (type)
+  (pcase (car
+          (read-multiple-choice
+           (format "Suppress `%s' warnings? " type)
+           `((?y ,(format "yes, ignore `%s' warnings completely" type))
+             (?n "no, just disable showing them")
+             (?q "quit and do nothing"))))
+    (?y
+     (customize-save-variable 'warning-suppress-log-types
+                              (cons type warning-suppress-log-types)))
+    (?n
+     (customize-save-variable 'warning-suppress-types
+                              (cons type warning-suppress-types)))
+    (_ (message "Exiting"))))
 
 ;;;###autoload
 (defun display-warning (type message &optional level buffer-name)
@@ -289,23 +299,18 @@ entirely by setting `warning-suppress-types' or
 	      (unless (bolp)
 		(funcall newline))
 	      (setq start (point))
+              ;; Don't output the button when doing batch compilation
+              ;; and similar.
+              (unless (or noninteractive (eq type 'bytecomp))
+                (insert (buttonize (icon-string 'warnings-suppress)
+                                   #'warnings-suppress type)
+                        " "))
 	      (if warning-prefix-function
 		  (setq level-info (funcall warning-prefix-function
 					    level level-info)))
 	      (insert (format (nth 1 level-info)
 			      (format warning-type-format typename))
 		      message)
-              ;; Don't output the buttons when doing batch compilation
-              ;; and similar.
-              (unless (or noninteractive (eq type 'bytecomp))
-                (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-search "\n" message))