dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

consult-flymake.el (4123B)


      1 ;;; consult-flymake.el --- Provides the command `consult-flymake' -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2021, 2022  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 <http://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 ()
     37   "Return Flymake errors as alist."
     38   (consult--forbid-minibuffer)
     39   (let* ((raw-diags (or (flymake-diagnostics)
     40                         (user-error "No flymake errors (Status: %s)"
     41                                     (if (seq-difference (flymake-running-backends)
     42                                                         (flymake-reporting-backends))
     43                                         'running 'finished))))
     44          (diags
     45           (mapcar
     46            (lambda (diag)
     47              (let ((buffer (flymake-diagnostic-buffer diag))
     48                    (type (flymake-diagnostic-type diag)))
     49                (with-current-buffer buffer
     50                  (save-excursion
     51                    (save-restriction
     52                      (widen)
     53                      (goto-char (flymake-diagnostic-beg diag))
     54                      (list (buffer-name buffer)
     55                            (line-number-at-pos)
     56                            type
     57                            (flymake-diagnostic-text diag)
     58                            (point-marker)
     59                            (pcase (flymake--lookup-type-property type 'flymake-category)
     60                               ('flymake-error ?e)
     61                               ('flymake-warning ?w)
     62                               (_ ?n))))))))
     63            raw-diags))
     64          (buffer-width (apply #'max (mapcar (lambda (x) (length (nth 0 x))) diags)))
     65          (line-width (apply #'max (mapcar (lambda (x) (length (number-to-string (nth 1 x)))) diags)))
     66          (fmt (format "%%-%ds %%-%dd %%-7s %%s" buffer-width line-width)))
     67     (mapcar
     68      (pcase-lambda (`(,buffer ,line ,type ,text ,marker ,narrow))
     69        (propertize (format fmt buffer line
     70                            (propertize (format "%s" (flymake--lookup-type-property
     71                                                      type 'flymake-type-name type))
     72                                        'face (flymake--lookup-type-property
     73                                               type 'mode-line-face 'flymake-error))
     74                            text)
     75                    'consult--candidate marker
     76                    'consult--type narrow))
     77      (sort diags
     78            (pcase-lambda (`(_ _ ,t1 _ ,m1 _) `(_ _ ,t2 _ ,m2 _))
     79              (let ((s1 (flymake--severity t1))
     80                    (s2 (flymake--severity t2)))
     81                (or (> s1 s2) (and (= s1 s2) (< m1 m2)))))))))
     82 
     83 ;;;###autoload
     84 (defun consult-flymake ()
     85   "Jump to Flymake diagnostic."
     86   (interactive)
     87   (consult--read
     88    (consult--with-increased-gc (consult-flymake--candidates))
     89    :prompt "Flymake diagnostic: "
     90    :category 'consult-flymake-error
     91    :history t ;; disable history
     92    :require-match t
     93    :sort nil
     94    :group (consult--type-group consult-flymake--narrow)
     95    :narrow (consult--type-narrow consult-flymake--narrow)
     96    :lookup #'consult--lookup-candidate
     97    :state (consult--jump-state 'consult-preview-error)))
     98 
     99 (provide 'consult-flymake)
    100 ;;; consult-flymake.el ends here