dotemacs

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

consult-flymake.el (4653B)


      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 (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                            (pcase (flymake--lookup-type-property type 'flymake-category)
     55                               ('flymake-error ?e)
     56                               ('flymake-warning ?w)
     57                               (_ ?n))))))))
     58            diags))
     59          (buffer-width (apply #'max (mapcar (lambda (x) (length (nth 0 x))) diags)))
     60          (line-width (apply #'max (mapcar (lambda (x) (length (number-to-string (nth 1 x)))) diags)))
     61          (fmt (format "%%-%ds %%-%dd %%-7s %%s" buffer-width line-width)))
     62     (mapcar
     63      (pcase-lambda (`(,buffer ,line ,type ,text ,marker ,narrow))
     64        (propertize (format fmt buffer line
     65                            (propertize (format "%s" (flymake--lookup-type-property
     66                                                      type 'flymake-type-name type))
     67                                        'face (flymake--lookup-type-property
     68                                               type 'mode-line-face 'flymake-error))
     69                            text)
     70                    'consult--candidate marker
     71                    'consult--type narrow))
     72      ;; Sort by buffer, severity and position.
     73      (sort diags
     74            (pcase-lambda (`(,b1 _ ,t1 _ ,m1 _) `(,b2 _ ,t2 _ ,m2 _))
     75              (let ((s1 (flymake--severity t1))
     76                    (s2 (flymake--severity t2)))
     77                (or
     78                 (string-lessp b1 b2)
     79                 (and (string-equal b1 b2)
     80                      (or
     81                       (> s1 s2)
     82                       (and (= s1 s2)
     83                            (< m1 m2)))))))))))
     84 
     85 ;;;###autoload
     86 (defun consult-flymake (&optional project)
     87   "Jump to Flymake diagnostic.
     88 When PROJECT is non-nil then prompt with diagnostics from all
     89 buffers in the current project instead of just the current buffer."
     90   (interactive "P")
     91   (consult--forbid-minibuffer)
     92   (consult--read
     93    (consult-flymake--candidates
     94     (or
     95      (if-let (((and project (fboundp 'flymake--project-diagnostics)))
     96               (project (project-current)))
     97          (flymake--project-diagnostics project)
     98        (flymake-diagnostics))
     99      (user-error "No flymake errors (Status: %s)"
    100                  (if (seq-difference (flymake-running-backends)
    101                                      (flymake-reporting-backends))
    102                      'running 'finished))))
    103    :prompt "Flymake diagnostic: "
    104    :category 'consult-flymake-error
    105    :history t ;; disable history
    106    :require-match t
    107    :sort nil
    108    :group (consult--type-group consult-flymake--narrow)
    109    :narrow (consult--type-narrow consult-flymake--narrow)
    110    :lookup #'consult--lookup-candidate
    111    :state (consult--jump-state 'consult-preview-error)))
    112 
    113 (provide 'consult-flymake)
    114 ;;; consult-flymake.el ends here