master 0db604a914 3/3: Use icons in warnings buffers

[Lars Ingebrigtsen]

branch: master
commit 0db604a91499496b8f39d9b19e6eadb06f52cb0f
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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).
---
 lisp/emacs-lisp/warnings.el | 55 ++++++++++++++++++++++++---------------------
 1 file changed, 30 insertions(+), 25 deletions(-)

diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 23e20c3b10..516fdeb10e 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))