(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."
(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))
;;
(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.
"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)
(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))
(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
(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
;;;###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
(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)))))
t))
(flymake-goto-next-error (- (or n 1)) filter interactive))
+\f
+;;; 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)