@@ -127,7 +127,21 @@ and a string describing how the process finished.")
127
127
(defvar compilation-arguments nil
128
128
" Arguments that were given to `compilation-start' ." )
129
129
130
- (defvar compilation-num-errors-found )
130
+ (defvar compilation-num-errors-found 0 )
131
+ (defvar compilation-num-warnings-found 0 )
132
+ (defvar compilation-num-infos-found 0 )
133
+
134
+ (defconst compilation-mode-line-errors
135
+ '(" [" (:propertize (:eval (int-to-string compilation-num-errors-found))
136
+ face compilation-error
137
+ help-echo " Number of errors so far" )
138
+ " " (:propertize (:eval (int-to-string compilation-num-warnings-found))
139
+ face compilation-warning
140
+ help-echo " Number of warnings so far" )
141
+ " " (:propertize (:eval (int-to-string compilation-num-infos-found))
142
+ face compilation-info
143
+ help-echo " Number of informational messages so far" )
144
+ " ]" ))
131
145
132
146
; ; If you make any changes to `compilation-error-regexp-alist-alist' ,
133
147
; ; be sure to run the ERT test in test/lisp/progmodes/compile-tests.el.
@@ -886,10 +900,10 @@ from a different message."
886
900
:group 'compilation
887
901
:version " 22.1" )
888
902
889
- (defun compilation-face (type )
890
- (or (and (car type) (match-end (car type)) compilation-warning-face )
891
- (and (cdr type) (match-end (cdr type)) compilation-info-face )
892
- compilation-error-face ))
903
+ (defun compilation-type (type )
904
+ (or (and (car type) (match-end (car type)) 1 )
905
+ (and (cdr type) (match-end (cdr type)) 0 )
906
+ 2 ))
893
907
894
908
; ; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil)
895
909
@@ -1334,6 +1348,14 @@ FMTS is a list of format specs for transforming the file name.
1334
1348
1335
1349
(compilation-parse-errors start end)))
1336
1350
1351
+ (defun compilation--note-type (type )
1352
+ " Note that a new message with severity TYPE was seen.
1353
+ This updates the appropriate variable used by the mode-line."
1354
+ (cl-case type
1355
+ (0 (cl-incf compilation-num-infos-found))
1356
+ (1 (cl-incf compilation-num-warnings-found))
1357
+ (2 (cl-incf compilation-num-errors-found))))
1358
+
1337
1359
(defun compilation-parse-errors (start end &rest rules )
1338
1360
" Parse errors between START and END.
1339
1361
The errors recognized are the ones specified in RULES which default
@@ -1397,14 +1419,17 @@ to `compilation-error-regexp-alist' if RULES is nil."
1397
1419
file line end-line col end-col (or type 2 ) fmt))
1398
1420
1399
1421
(when (integerp file)
1422
+ (setq type (if (consp type)
1423
+ (compilation-type type)
1424
+ (or type 2 )))
1425
+ (compilation--note-type type)
1426
+
1400
1427
(compilation--put-prop
1401
1428
file 'font-lock-face
1402
- (if (consp type)
1403
- (compilation-face type)
1404
- (symbol-value (aref [compilation-info-face
1405
- compilation-warning-face
1406
- compilation-error-face]
1407
- (or type 2 ))))))
1429
+ (symbol-value (aref [compilation-info-face
1430
+ compilation-warning-face
1431
+ compilation-error-face]
1432
+ type))))
1408
1433
1409
1434
(compilation--put-prop
1410
1435
line 'font-lock-face compilation-line-face)
@@ -1768,7 +1793,8 @@ Returns the compilation buffer created."
1768
1793
outbuf command))))
1769
1794
; ; Make the buffer's mode line show process state.
1770
1795
(setq mode-line-process
1771
- '(:propertize " :%s" face compilation-mode-line-run ))
1796
+ '((:propertize " :%s" face compilation-mode-line-run )
1797
+ compilation-mode-line-errors))
1772
1798
1773
1799
; ; Set the process as killable without query by default.
1774
1800
; ; This allows us to start a new compilation without
@@ -1797,7 +1823,8 @@ Returns the compilation buffer created."
1797
1823
(message " Executing `%s' ... " command)
1798
1824
; ; Fake mode line display as if `start-process' were run.
1799
1825
(setq mode-line-process
1800
- '(:propertize " :run" face compilation-mode-line-run ))
1826
+ '((:propertize " :run" face compilation-mode-line-run )
1827
+ compilation-mode-line-errors))
1801
1828
(force-mode-line-update )
1802
1829
(sit-for 0 ) ; Force redisplay
1803
1830
(save-excursion
@@ -2106,6 +2133,9 @@ Optional argument MINOR indicates this is called from
2106
2133
(make-local-variable 'compilation-messages-start )
2107
2134
(make-local-variable 'compilation-error-screen-columns )
2108
2135
(make-local-variable 'overlay-arrow-position )
2136
+ (setq-local compilation-num-errors-found 0 )
2137
+ (setq-local compilation-num-warnings-found 0 )
2138
+ (setq-local compilation-num-infos-found 0 )
2109
2139
(set (make-local-variable 'overlay-arrow-string ) " " )
2110
2140
(setq next-error-overlay-arrow-position nil )
2111
2141
(add-hook 'kill-buffer-hook
@@ -2195,16 +2225,18 @@ commands of Compilation major mode are available. See
2195
2225
(add-text-properties omax (point )
2196
2226
(append '(compilation-handle-exit t ) nil ))
2197
2227
(setq mode-line-process
2198
- (let ((out-string (format " :%s [%s ] " process-status (cdr status)))
2199
- (msg (format " %s %s " mode-name
2200
- (replace-regexp-in-string " \n ?$" " "
2201
- (car status)))))
2202
- (message " %s " msg)
2203
- (propertize out-string
2204
- 'help-echo msg
2205
- 'face (if (> exit-status 0 )
2206
- 'compilation-mode-line-fail
2207
- 'compilation-mode-line-exit ))))
2228
+ (list
2229
+ (let ((out-string (format " :%s [%s ] " process-status (cdr status)))
2230
+ (msg (format " %s %s " mode-name
2231
+ (replace-regexp-in-string " \n ?$" " "
2232
+ (car status)))))
2233
+ (message " %s " msg)
2234
+ (propertize out-string
2235
+ 'help-echo msg
2236
+ 'face (if (> exit-status 0 )
2237
+ 'compilation-mode-line-fail
2238
+ 'compilation-mode-line-exit )))
2239
+ compilation-mode-line-errors))
2208
2240
; ; Force mode line redisplay soon.
2209
2241
(force-mode-line-update )
2210
2242
(if (and opoint (< opoint omax))
0 commit comments