Show number of errors in compilation-mode mode-line

Bug#25354
* lisp/progmodes/compile.el (compilation-num-errors-found): Provide
default value.
(compilation-num-warnings-found, compilation-num-infos-found): New
defvars.
(compilation-mode-line-errors): New defconst.
(compilation-face): Remove.
(compilation-type, compilation--note-type): New functions.
(compilation-parse-errors): Call compilation--note-type.
(compilation-start): Include compilation-mode-line-errors in
mode-line-process.
(compilation-setup): Initialize compilation-num-* variables to 0.
(compilation-handle-exit): Include compilation-mode-line-errors in
mode-line-process.
* doc/emacs/building.texi (Compilation): Document new feature.

1 files changed, 55 insertions, 23 deletions

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 31ec5a67d03..f0935cd2add 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -127,7 +127,21 @@ and a string describing how the process finished.")
 (defvar compilation-arguments nil
   "Arguments that were given to `compilation-start'.")
 
-(defvar compilation-num-errors-found)
+(defvar compilation-num-errors-found 0)
+(defvar compilation-num-warnings-found 0)
+(defvar compilation-num-infos-found 0)
+
+(defconst compilation-mode-line-errors
+  '(" [" (:propertize (:eval (int-to-string compilation-num-errors-found))
+                      face compilation-error
+                      help-echo "Number of errors so far")
+    " " (:propertize (:eval (int-to-string compilation-num-warnings-found))
+                     face compilation-warning
+                     help-echo "Number of warnings so far")
+    " " (:propertize (:eval (int-to-string compilation-num-infos-found))
+                     face compilation-info
+                     help-echo "Number of informational messages so far")
+    "]"))
 
 ;; If you make any changes to `compilation-error-regexp-alist-alist',
 ;; be sure to run the ERT test in test/lisp/progmodes/compile-tests.el.
@@ -886,10 +900,10 @@ from a different message."
   :group 'compilation
   :version "22.1")
 
-(defun compilation-face (type)
-  (or (and (car type) (match-end (car type)) compilation-warning-face)
-      (and (cdr type) (match-end (cdr type)) compilation-info-face)
-      compilation-error-face))
+(defun compilation-type (type)
+  (or (and (car type) (match-end (car type)) 1)
+      (and (cdr type) (match-end (cdr type)) 0)
+      2))
 
 ;;   LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil)
 
@@ -1334,6 +1348,14 @@ FMTS is a list of format specs for transforming the file name.
 
     (compilation-parse-errors start end)))
 
+(defun compilation--note-type (type)
+  "Note that a new message with severity TYPE was seen.
+This updates the appropriate variable used by the mode-line."
+  (cl-case type
+    (0 (cl-incf compilation-num-infos-found))
+    (1 (cl-incf compilation-num-warnings-found))
+    (2 (cl-incf compilation-num-errors-found))))
+
 (defun compilation-parse-errors (start end &rest rules)
   "Parse errors between START and END.
 The errors recognized are the ones specified in RULES which default
@@ -1397,14 +1419,17 @@ to `compilation-error-regexp-alist' if RULES is nil."
                              file line end-line col end-col (or type 2) fmt))
 
             (when (integerp file)
+              (setq type (if (consp type)
+                             (compilation-type type)
+                           (or type 2)))
+              (compilation--note-type type)
+
               (compilation--put-prop
                file 'font-lock-face
-               (if (consp type)
-                   (compilation-face type)
-                 (symbol-value (aref [compilation-info-face
-                                      compilation-warning-face
-                                      compilation-error-face]
-                                     (or type 2))))))
+               (symbol-value (aref [compilation-info-face
+                                    compilation-warning-face
+                                    compilation-error-face]
+                                   type))))
 
             (compilation--put-prop
              line 'font-lock-face compilation-line-face)
@@ -1768,7 +1793,8 @@ Returns the compilation buffer created."
 						       outbuf command))))
               ;; Make the buffer's mode line show process state.
               (setq mode-line-process
-                    '(:propertize ":%s" face compilation-mode-line-run))
+                    '((:propertize ":%s" face compilation-mode-line-run)
+                      compilation-mode-line-errors))
 
               ;; Set the process as killable without query by default.
               ;; This allows us to start a new compilation without
@@ -1797,7 +1823,8 @@ Returns the compilation buffer created."
 	  (message "Executing `%s'..." command)
 	  ;; Fake mode line display as if `start-process' were run.
 	  (setq mode-line-process
-		'(:propertize ":run" face compilation-mode-line-run))
+		'((:propertize ":run" face compilation-mode-line-run)
+                  compilation-mode-line-errors))
 	  (force-mode-line-update)
 	  (sit-for 0)			; Force redisplay
 	  (save-excursion
@@ -2106,6 +2133,9 @@ Optional argument MINOR indicates this is called from
   (make-local-variable 'compilation-messages-start)
   (make-local-variable 'compilation-error-screen-columns)
   (make-local-variable 'overlay-arrow-position)
+  (setq-local compilation-num-errors-found 0)
+  (setq-local compilation-num-warnings-found 0)
+  (setq-local compilation-num-infos-found 0)
   (set (make-local-variable 'overlay-arrow-string) "")
   (setq next-error-overlay-arrow-position nil)
   (add-hook 'kill-buffer-hook
@@ -2195,16 +2225,18 @@ commands of Compilation major mode are available.  See
     (add-text-properties omax (point)
 			 (append '(compilation-handle-exit t) nil))
     (setq mode-line-process
-	  (let ((out-string (format ":%s [%s]" process-status (cdr status)))
-		(msg (format "%s %s" mode-name
-			     (replace-regexp-in-string "\n?$" ""
-                                                       (car status)))))
-	    (message "%s" msg)
-	    (propertize out-string
-			'help-echo msg
-			'face (if (> exit-status 0)
-				  'compilation-mode-line-fail
-				'compilation-mode-line-exit))))
+          (list
+           (let ((out-string (format ":%s [%s]" process-status (cdr status)))
+                 (msg (format "%s %s" mode-name
+                              (replace-regexp-in-string "\n?$" ""
+                                                        (car status)))))
+             (message "%s" msg)
+             (propertize out-string
+                         'help-echo msg
+                         'face (if (> exit-status 0)
+                                   'compilation-mode-line-fail
+                                 'compilation-mode-line-exit)))
+           compilation-mode-line-errors))
     ;; Force mode line redisplay soon.
     (force-mode-line-update)
     (if (and opoint (< opoint omax))