commit 0b9197ba7d79fef88781b097086e188c356e22a0 Author: Tom Tromey Date: Sun Mar 5 10:48:41 2017 -0700 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. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index d35388e..6520ea4 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -127,7 +127,21 @@ compilation-error (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. @@ -884,10 +898,10 @@ compilation-skip-visited :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) @@ -1332,6 +1346,14 @@ compilation--parse-region (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 @@ -1395,14 +1417,17 @@ compilation-parse-errors 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) @@ -1766,7 +1791,8 @@ compilation-start 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 @@ -1795,7 +1821,8 @@ compilation-start (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 @@ -2104,6 +2131,9 @@ compilation-setup (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 @@ -2193,16 +2223,18 @@ compilation-handle-exit (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))