consult-flymake.el (4713B)
1 ;;; consult-flymake.el --- Provides the command `consult-flymake' -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2021-2023 Free Software Foundation, Inc. 4 5 ;; This file is part of GNU Emacs. 6 7 ;; This program is free software: you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 12 ;; This program is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 16 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 19 20 ;;; Commentary: 21 22 ;; Provides the command `consult-flymake'. This is an extra package, 23 ;; to allow lazy loading of flymake.el. The `consult-flymake' command 24 ;; is autoloaded. 25 26 ;;; Code: 27 28 (require 'consult) 29 (require 'flymake) 30 31 (defconst consult-flymake--narrow 32 '((?e . "Error") 33 (?w . "Warning") 34 (?n . "Note"))) 35 36 (defun consult-flymake--candidates (diags) 37 "Return Flymake errors from DIAGS as formatted candidates. 38 DIAGS should be a list of diagnostics as returned from `flymake-diagnostics'." 39 (let* ((diags 40 (mapcar 41 (lambda (diag) 42 (let ((buffer (flymake-diagnostic-buffer diag)) 43 (type (flymake-diagnostic-type diag))) 44 (with-current-buffer buffer 45 (save-excursion 46 (save-restriction 47 (widen) 48 (goto-char (flymake-diagnostic-beg diag)) 49 (list (buffer-name buffer) 50 (line-number-at-pos) 51 type 52 (flymake-diagnostic-text diag) 53 (point-marker) 54 (flymake-diagnostic-end diag) 55 (pcase (flymake--lookup-type-property type 'flymake-category) 56 ('flymake-error ?e) 57 ('flymake-warning ?w) 58 (_ ?n)))))))) 59 diags)) 60 (buffer-width (apply #'max (mapcar (lambda (x) (length (nth 0 x))) diags))) 61 (line-width (apply #'max (mapcar (lambda (x) (length (number-to-string (nth 1 x)))) diags))) 62 (fmt (format "%%-%ds %%-%dd %%-7s %%s" buffer-width line-width))) 63 (mapcar 64 (pcase-lambda (`(,buffer ,line ,type ,text ,beg ,end ,narrow)) 65 (propertize (format fmt buffer line 66 (propertize (format "%s" (flymake--lookup-type-property 67 type 'flymake-type-name type)) 68 'face (flymake--lookup-type-property 69 type 'mode-line-face 'flymake-error)) 70 text) 71 'consult--candidate (list beg (cons 0 (- end beg))) 72 'consult--type narrow)) 73 ;; Sort by buffer, severity and position. 74 (sort diags 75 (pcase-lambda (`(,b1 _ ,t1 _ ,m1 _) `(,b2 _ ,t2 _ ,m2 _)) 76 (let ((s1 (flymake--severity t1)) 77 (s2 (flymake--severity t2))) 78 (or 79 (string-lessp b1 b2) 80 (and (string-equal b1 b2) 81 (or 82 (> s1 s2) 83 (and (= s1 s2) 84 (< m1 m2))))))))))) 85 86 ;;;###autoload 87 (defun consult-flymake (&optional project) 88 "Jump to Flymake diagnostic. 89 When PROJECT is non-nil then prompt with diagnostics from all 90 buffers in the current project instead of just the current buffer." 91 (interactive "P") 92 (consult--forbid-minibuffer) 93 (consult--read 94 (consult-flymake--candidates 95 (or 96 (if-let (((and project (fboundp 'flymake--project-diagnostics))) 97 (project (project-current))) 98 (flymake--project-diagnostics project) 99 (flymake-diagnostics)) 100 (user-error "No flymake errors (Status: %s)" 101 (if (seq-difference (flymake-running-backends) 102 (flymake-reporting-backends)) 103 'running 'finished)))) 104 :prompt "Flymake diagnostic: " 105 :category 'consult-flymake-error 106 :history t ;; disable history 107 :require-match t 108 :sort nil 109 :group (consult--type-group consult-flymake--narrow) 110 :narrow (consult--type-narrow consult-flymake--narrow) 111 :lookup #'consult--lookup-candidate 112 :state (consult--jump-state))) 113 114 (provide 'consult-flymake) 115 ;;; consult-flymake.el ends here