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).
This commit is contained in:
Lars Ingebrigtsen 2022-07-28 14:38:54 +02:00
parent d7e848ccda
commit 0db604a914

View file

@ -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))