master 2e6fbb0 2/3: Make Flymake mode-line indicator customizable (bug#33740)

[João Távora]

branch: master
commit 2e6fbb05b6c17a1481fd6b73491cfa9c66c0c84f
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Make Flymake mode-line indicator customizable (bug#33740)
    
    * lisp/progmodes/flymake.el (flymake-mode): Use
    flymake-mode-line-format.
    (flymake--mode-line-format): Remove.
    (flymake-mode-line-counter-format, flymake-mode-line-format): New
    defcustom.
    (flymake-mode-line-title, flymake-mode-line-exception)
    (flymake-mode-line-counters, flymake-error-counter)
    (flymake-warning-counter, flymake-note-counter): New variables.
    (flymake--mode-line-title, flymake--mode-line-exception)
    (flymake--mode-line-counters, flymake--mode-line-counter): New
    helpers.
    
    * doc/misc/flymake.texi (Customizable variables): Mention
    flymake-mode-line-format and flymake-mode-line-counter-format
    
    * etc/NEWS: Mention Flymake's customizable mode-line.
---
 doc/misc/flymake.texi     |   7 ++
 etc/NEWS                  |  13 +++
 lisp/progmodes/flymake.el | 248 +++++++++++++++++++++++++---------------------
 3 files changed, 153 insertions(+), 115 deletions(-)

diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index 8f2954b..704e961 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -213,6 +213,13 @@ This section summarizes customization variables used for 
the
 configuration of the Flymake user interface.
 
 @vtable @code
+@item flymake-mode-line-format
+Format to use for the Flymake mode line indicator.
+
+@item flymake-mode-line-counter-format
+Mode-line construct for formatting Flymake diagnostic counters inside
+the Flymake mode line indicator.
+
 @item flymake-no-changes-timeout
 If any changes are made to the buffer, syntax check is automatically
 started after this many seconds, unless the user makes another change,
diff --git a/etc/NEWS b/etc/NEWS
index 865dbdf..62907a6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1747,6 +1747,19 @@ height of lines or width of chars.
 When non-nil, use a new xwidget webkit session after bookmark jump.
 Otherwise, it will use 'xwidget-webkit-last-session'.
 
+** Flymake mode
+
++++
+*** New user options to customize Flymake's mode-line.
+
+The new customization variable 'flymake-mode-line-format' is a mix of
+strings and symbols like 'flymake-mode-line-title' ,
+'flymake-mode-line-exception' and 'flymake-mode-line-counters'.  The
+new customization variable 'flymake-mode-line-counter-format' is a mix
+of strings and symbols like 'flymake-mode-line-error-counter',
+'flymake-mode-line-warning-counter' and
+'flymake-mode-line-note-counter'.
+
 ** Flyspell mode
 
 +++
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 40bb90d..32f4135 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -997,7 +997,7 @@ suitable for the current buffer.  The commands
 `flymake-running-backends', `flymake-disabled-backends' and
 `flymake-reporting-backends' summarize the situation, as does the
 special *Flymake log* buffer."  :group 'flymake :lighter
-  flymake--mode-line-format :keymap flymake-mode-map
+  flymake-mode-line-format :keymap flymake-mode-map
   (cond
    ;; Turning the mode ON.
    (flymake-mode
@@ -1186,123 +1186,141 @@ default) no filter is applied."
     [ "Go to log buffer"        flymake-switch-to-log-buffer t ]
     [ "Turn off Flymake"        flymake-mode t ]))
 
-(defvar flymake--mode-line-format '(:eval (flymake--mode-line-format)))
-
-(put 'flymake--mode-line-format 'risky-local-variable t)
-
-
-(defun flymake--mode-line-format ()
-  "Produce a pretty minor mode indicator."
-  (let* ((known (hash-table-keys flymake--backend-state))
-         (running (flymake-running-backends))
-         (disabled (flymake-disabled-backends))
-         (reported (flymake-reporting-backends))
-         (diags-by-type (make-hash-table))
-         (all-disabled (and disabled (null running)))
-         (some-waiting (cl-set-difference running reported)))
-    (maphash (lambda (_b state)
-               (mapc (lambda (diag)
-                       (push diag
-                             (gethash (flymake--diag-type diag)
-                                      diags-by-type)))
-                     (flymake--backend-state-diags state)))
-             flymake--backend-state)
-    `((:propertize " Flymake"
-                   mouse-face mode-line-highlight
-                   help-echo
-                   ,(concat (format "%s known backends\n" (length known))
-                            (format "%s running\n" (length running))
-                            (format "%s disabled\n" (length disabled))
-                            "mouse-1: Display minor mode menu\n"
-                            "mouse-2: Show help for minor mode")
-                   keymap
-                   ,(let ((map (make-sparse-keymap)))
-                      (define-key map [mode-line down-mouse-1]
-                        flymake-menu)
-                      (define-key map [mode-line mouse-2]
-                        (lambda ()
-                          (interactive)
-                          (describe-function 'flymake-mode)))
-                      map))
-      ,@(pcase-let ((`(,ind ,face ,explain)
-                     (cond ((null known)
-                            '("?" nil "No known backends"))
-                           (some-waiting
-                            `("Wait" compilation-mode-line-run
-                              ,(format "Waiting for %s running backend(s)"
-                                       (length some-waiting))))
-                           (all-disabled
-                            '("!" compilation-mode-line-run
-                              "All backends disabled"))
-                           (t
-                            '(nil nil nil)))))
-          (when ind
-            `((":"
-               (:propertize ,ind
-                            face ,face
-                            help-echo ,explain
-                            keymap
-                            ,(let ((map (make-sparse-keymap)))
+(defcustom flymake-mode-line-format
+  '(" " flymake-mode-line-title flymake-mode-line-exception
+    flymake-mode-line-counters)
+  "Mode line construct for customizing Flymake information."
+  :group 'flymake
+  :type '(list string symbol))
+
+(defcustom flymake-mode-line-counter-format
+  '("["
+    flymake-mode-line-error-counter
+    flymake-mode-line-warning-counter
+    flymake-mode-line-note-counter "]")
+  "Mode-line construct for formatting Flymake diagnostic counters.
+This is a suitable place for placing the `flymake-error-counter',
+`flymake-warning-counter' and `flymake-note-counter' constructs.
+Separating each of these with space is not necessary."
+  :group 'flymake
+  :type '(list string symbol))
+
+(defvar flymake-mode-line-title '(:eval (flymake--mode-line-title))
+  "Mode-line construct to show Flymake's mode name and menu.")
+
+(defvar flymake-mode-line-exception '(:eval (flymake--mode-line-exception))
+  "Mode-line construct to report on exceptional Flymake status.")
+
+(defvar flymake-mode-line-counters '(:eval (flymake--mode-line-counters))
+  "Mode-line construct for counting Flymake diagnostics.
+The counters are only placed if some Flymake backend initialized
+correctly.")
+
+(defvar flymake-mode-line-error-counter
+  `(:eval (flymake--mode-line-counter :error t)))
+(defvar flymake-mode-line-warning-counter
+  `(:eval (flymake--mode-line-counter :warning)))
+(defvar flymake-mode-line-note-counter
+  `(:eval (flymake--mode-line-counter :note)))
+
+(put 'flymake-mode-line-format 'risky-local-variable t)
+(put 'flymake-mode-line-title 'risky-local-variable t)
+(put 'flymake-mode-line-exception 'risky-local-variable t)
+(put 'flymake-mode-line-counters 'risky-local-variable t)
+(put 'flymake-mode-line-error-counter 'risky-local-variable t)
+(put 'flymake-mode-line-warning-counter 'risky-local-variable t)
+(put 'flymake-mode-line-note-counter 'risky-local-variable t)
+
+(defun flymake--mode-line-title ()
+  `(:propertize
+    "Flymake"
+    mouse-face mode-line-highlight
+    help-echo
+    (lambda (&rest whatever)
+      (concat
+       (format "%s known backends\n" (hash-table-count flymake--backend-state))
+       (format "%s running\n" (length (flymake-running-backends)))
+       (format "%s disabled\n" (length (flymake-disabled-backends)))
+       "mouse-1: Display minor mode menu\n"
+       "mouse-2: Show help for minor mode"))
+    keymap
+    ,(let ((map (make-sparse-keymap)))
+       (define-key map [mode-line down-mouse-1]
+         flymake-menu)
+       (define-key map [mode-line mouse-2]
+         (lambda ()
+           (interactive)
+           (describe-function 'flymake-mode)))
+       map)))
+
+(defun flymake--mode-line-exception ()
+  "Helper for `flymake-mode-line-exception'."
+  (pcase-let* ((running) (reported)
+               (`(,ind ,face ,explain)
+                (cond ((zerop (hash-table-count flymake--backend-state))
+                       '("?" nil "No known backends"))
+                      ((cl-set-difference
+                        (setq running (flymake-running-backends))
+                        (setq reported (flymake-reporting-backends)))
+                       `("Wait" compilation-mode-line-run
+                         ,(format "Waiting for %s running backend(s)"
+                                  (length (cl-set-difference running 
reported)))))
+                      ((and (flymake-disabled-backends) (null running))
+                       '("!" compilation-mode-line-run
+                         "All backends disabled"))
+                      (t
+                       '(nil nil nil)))))
+    (when ind
+      `(":"
+        (:propertize ,ind face ,face
+                     help-echo ,explain
+                     keymap ,(let ((map (make-sparse-keymap)))
                                (define-key map [mode-line mouse-1]
                                  'flymake-switch-to-log-buffer)
                                map))))))
-      ,@(unless (or all-disabled
-                    (null known))
-          (cl-loop
-           with types = (hash-table-keys diags-by-type)
-           with _augmented = (cl-loop for extra in '(:error :warning)
-                                      do (cl-pushnew extra types
-                                                     :key #'flymake--severity))
-           for type in (cl-sort types #'> :key #'flymake--severity)
-           for diags = (gethash type diags-by-type)
-           for face = (flymake--lookup-type-property type
-                                                     'mode-line-face
-                                                     'compilation-error)
-           when (or diags
-                    (cond ((eq flymake-suppress-zero-counters t)
-                           nil)
-                          (flymake-suppress-zero-counters
-                           (>= (flymake--severity type)
-                               (warning-numeric-level
-                                flymake-suppress-zero-counters)))
-                          (t t)))
-           collect `(:propertize
-                     ,(format "%d" (length diags))
-                     face ,face
-                     mouse-face mode-line-highlight
-                     keymap
-                     ,(let ((map (make-sparse-keymap))
-                            (type type))
-                        (define-key map (vector 'mode-line
-                                                mouse-wheel-down-event)
-                          (lambda (event)
-                            (interactive "e")
-                            (with-selected-window (posn-window (event-start 
event))
-                              (flymake-goto-prev-error 1 (list type) t))))
-                        (define-key map (vector 'mode-line
-                                                mouse-wheel-up-event)
-                          (lambda (event)
-                            (interactive "e")
-                            (with-selected-window (posn-window (event-start 
event))
-                              (flymake-goto-next-error 1 (list type) t))))
-                        map)
-                     help-echo
-                     ,(concat (format "%s diagnostics of type %s\n"
-                                      (propertize (format "%d"
-                                                          (length diags))
-                                                  'face face)
-                                      (propertize (format "%s" type)
-                                                  'face face))
-                              (format "%s/%s: previous/next of this type"
-                                      mouse-wheel-down-event
-                                      mouse-wheel-up-event)))
-           into forms
-           finally return
-           `((:propertize "[")
-             ,@(cl-loop for (a . rest) on forms by #'cdr
-                        collect a when rest collect
-                        '(:propertize " "))
-             (:propertize "]")))))))
+
+(defun flymake--mode-line-counters ()
+  (when (flymake-running-backends) flymake-mode-line-counter-format))
+
+(defun flymake--mode-line-counter (type &optional no-space)
+  (let ((count 0)
+        (face (flymake--lookup-type-property type
+                                             'mode-line-face
+                                             'compilation-error)))
+    (maphash (lambda
+               (_b state)
+               (dolist (d (flymake--backend-state-diags state))
+                 (when (eq type (flymake--diag-type d))
+                   (cl-incf count))))
+             flymake--backend-state)
+    (when (or (cl-plusp count)
+              (cond ((eq flymake-suppress-zero-counters t)
+                     nil)
+                    (flymake-suppress-zero-counters
+                     (>= (flymake--severity type)
+                         (warning-numeric-level
+                          flymake-suppress-zero-counters)))
+                    (t t)))
+      `(,(if no-space "" " ")
+        (:propertize
+         ,(format "%d" count)
+         face ,face
+         mouse-face mode-line-highlight
+         keymap
+         ,(let ((map (make-sparse-keymap)))
+            (define-key map (vector 'mode-line
+                                    mouse-wheel-down-event)
+              (lambda (event)
+                (interactive "e")
+                (with-selected-window (posn-window (event-start event))
+                  (flymake-goto-prev-error 1 (list type) t))))
+            (define-key map (vector 'mode-line
+                                    mouse-wheel-up-event)
+              (lambda (event)
+                (interactive "e")
+                (with-selected-window (posn-window (event-start event))
+                  (flymake-goto-next-error 1 (list type) t))))
+            map))))))
 
 ;;; Diagnostics buffer