bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#25354: patch for this bug


From: Tom Tromey
Subject: bug#25354: patch for this bug
Date: Sun, 05 Mar 2017 10:50:18 -0700

This implements the feature requested here: it counts errors, warnings,
and informational messages as they are parsed, and then updates the mode
line with this information.

Let me know what you think.

Tom

commit 0b9197ba7d79fef88781b097086e188c356e22a0
Author: Tom Tromey <address@hidden>
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))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]