From e0df7b9699539a6831dd7d72d6845d2995fb619e Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 27 Sep 2017 02:31:58 +0100 Subject: [PATCH] Fancy Flymake mode-line construct displays status Imitates compilation-mode's mode-line a bit, and uses its faces. * lisp/progmodes/flymake.el (flymake-error, flymake-warning, flymake-note): Add mode-line-face to these flymake error types. (flymake-note): Notes don't need a noisy fringe bitmap. (flymake-lighter): Delete. (flymake--update-lighter): Delete. (flymake--mode-line-format): New function and variable. (flymake--diagnostics-table): New buffer-local variable. (flymake--handle-report): Don't update "lighters". Affect flymake--diagnostics-table. (flymake--run-backend): Init flymake--diagnostics-table for backend. (flymake-mode): Use flymake--mode-line-format. (flymake-mode): Don't update lighter. (flymake--highlight-line): Be more careful when overriding a nil default overlay property. --- lisp/progmodes/flymake.el | 134 +++++++++++++++++++++++++++++++------- 1 file changed, 112 insertions(+), 22 deletions(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index f136e14ec19..03b319f8715 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -35,7 +35,8 @@ (require 'cl-lib) (require 'thingatpt) ; end-of-thing (require 'warnings) ; warning-numeric-level, display-warning -(eval-when-compile (require 'subr-x)) ; when-let*, if-let* +(require 'compile) ; for some faces +(eval-when-compile (require 'subr-x)) ; when-let*, if-let*, hash-table-keys (defgroup flymake nil "Universal on-the-fly syntax checker." @@ -362,20 +363,23 @@ the diagnostics of each type. The recognized properties are: (put 'flymake-error 'face 'flymake-error) (put 'flymake-error 'bitmap flymake-error-bitmap) (put 'flymake-error 'severity (warning-numeric-level :error)) +(put 'flymake-error 'mode-line-face 'compilation-error) (put 'flymake-warning 'face 'flymake-warning) (put 'flymake-warning 'bitmap flymake-warning-bitmap) (put 'flymake-warning 'severity (warning-numeric-level :warning)) +(put 'flymake-warning 'mode-line-face 'compilation-warning) (put 'flymake-note 'face 'flymake-note) -(put 'flymake-note 'bitmap flymake-warning-bitmap) +(put 'flymake-note 'bitmap nil) (put 'flymake-note 'severity (warning-numeric-level :debug)) +(put 'flymake-note 'mode-line-face 'compilation-info) (defun flymake--lookup-type-property (type prop &optional default) "Look up PROP for TYPE in `flymake-diagnostic-types-alist'. If TYPE doesn't declare PROP in either -`flymake-diagnostic-types-alist' or its associated -`flymake-category', return DEFAULT." +`flymake-diagnostic-types-alist' or in the symbol of its +associated `flymake-category' return DEFAULT." (let ((alist-probe (assoc type flymake-diagnostic-types-alist))) (cond (alist-probe (let* ((alist (cdr alist-probe)) @@ -496,16 +500,6 @@ If TYPE doesn't declare PROP in either ;; (when choice (goto-char (overlay-start choice))))) -;; flymake minor mode declarations -(defvar-local flymake-lighter nil) - -(defun flymake--update-lighter (info &optional extended) - "Update Flymake’s \"lighter\" with INFO and EXTENDED." - (setq flymake-lighter (format " Flymake(%s%s)" - info - (if extended - (format ",%s" extended) - "")))) ;; Nothing in flymake uses this at all any more, so this is just for ;; third-party compatibility. @@ -520,6 +514,9 @@ that has been invoked but hasn't reported any final status yet.") "List of currently disabled flymake backends. A backend is disabled if it reported `:panic'.") +(defvar-local flymake--diagnostics-table nil + "Hash table of all diagnostics indexed by backend.") + (defun flymake-is-running () "Tell if flymake has running backends in this buffer" flymake--running-backends) @@ -547,6 +544,7 @@ A backend is disabled if it reported `:panic'.") (eq backend (flymake--diag-backend (overlay-get ov 'flymake--diagnostic))))) + (puthash backend diagnostics flymake--diagnostics-table) (mapc (lambda (diag) (flymake--highlight-line diag) (setf (flymake--diag-backend diag) backend)) @@ -557,11 +555,7 @@ A backend is disabled if it reported `:panic'.") (when flymake-check-start-time (flymake-log 2 "%d error(s), %d other(s) in %.2f second(s)" err-count warn-count - (- (float-time) flymake-check-start-time))) - (if (null diagnostics) - (flymake--update-lighter "[ok]") - (flymake--update-lighter - (format "%d/%d" err-count warn-count))))))) + (- (float-time) flymake-check-start-time))))))) (t (flymake--disable-backend "?" :strange @@ -584,6 +578,7 @@ sources." (defun flymake--run-backend (backend) "Run the backend BACKEND." (push backend flymake--running-backends) + (remhash backend flymake--diagnostics-table) ;; FIXME: Should use `condition-case-unless-debug' ;; here, but that won't let me catch errors during ;; testing where `debug-on-error' is always t @@ -621,7 +616,7 @@ non-nil." ;;;###autoload (define-minor-mode flymake-mode nil - :group 'flymake :lighter flymake-lighter + :group 'flymake :lighter flymake--mode-line-format (setq flymake--running-backends nil flymake--disabled-backends nil) (cond @@ -635,10 +630,9 @@ non-nil." (add-hook 'after-save-hook 'flymake-after-save-hook nil t) (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) - (flymake--update-lighter "*" "*") - (setq flymake-timer (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) + (setq flymake--diagnostics-table (make-hash-table)) (when flymake-start-syntax-check-on-find-file (flymake--start-syntax-check))))) @@ -757,6 +751,102 @@ diagnostics of type `:error' and `:warning'." t)) (flymake-goto-next-error (- (or n 1)) filter interactive)) + +;;; Mode-line fanciness +;;; +(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 ((running flymake--running-backends) + (reported (hash-table-keys flymake--diagnostics-table))) + `((:propertize " Flymake" + mouse-face mode-line-highlight + ,@(when (not reported) + `(face compilation-mode-line-fail)) + help-echo + ,(concat (format "%s registered backends\n" + (length flymake-diagnostic-functions)) + (format "%s running\n" + (length running)) + (format "%s disabled\n" + (length flymake--disabled-backends)) + "mouse-1: go to log buffer ") + keymap + ,(let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + (lambda (_event) + (interactive "e") + (switch-to-buffer "*Flymake log*"))) + map)) + ,@(when running + `(":" (:propertize "Run" + face compilation-mode-line-run + help-echo + ,(format "%s running backends" + (length running))))) + ,@(when reported + (let ((by-type (make-hash-table))) + (maphash (lambda (_backend diags) + (mapc (lambda (diag) + (push diag + (gethash (flymake--diag-type diag) + by-type))) + diags)) + flymake--diagnostics-table) + (cl-loop + for (type . severity) + in (cl-sort (mapcar (lambda (type) + (cons type (flymake--lookup-type-property + type + 'severity + (warning-numeric-level :error)))) + (cl-union (hash-table-keys by-type) + '(:error :warning))) + #'> + :key #'cdr) + for diags = (gethash type by-type) + for face = (flymake--lookup-type-property type + 'mode-line-face + 'compilation-error) + when (or diags + (>= severity (warning-numeric-level :warning))) + collect `(:propertize + ,(format "%d" (length diags)) + face ,face + mouse-face mode-line-highlight + keymap + ,(let ((map (make-sparse-keymap)) + (type type)) + (define-key map [mode-line mouse-4] + (lambda (_event) + (interactive "e") + (flymake-goto-prev-error 1 (list type) t))) + (define-key map [mode-line mouse-5] + (lambda (_event) + (interactive "e") + (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)) + "mouse-4/mouse-5: previous/next of this type\n")) + into forms + finally return + `((:propertize "[") + ,@(cl-loop for (a . rest) on forms by #'cdr + collect a when rest collect + '(:propertize " ")) + (:propertize "]")))))))) + + + (provide 'flymake) -- 2.39.5