config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

consult-flymake.el (4871B)


      1 ;;; consult-flymake.el --- Provides the command `consult-flymake' -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2021-2024 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 (eval-when-compile (require 'cl-lib))
     31 
     32 (defconst consult-flymake--narrow
     33   '((?e . "Error")
     34     (?w . "Warning")
     35     (?n . "Note")))
     36 
     37 (defun consult-flymake--candidates (diags)
     38   "Return Flymake errors from DIAGS as formatted candidates.
     39 DIAGS should be a list of diagnostics as returned from `flymake-diagnostics'."
     40   (let* ((diags
     41           (mapcar
     42            (lambda (diag)
     43              (let ((buffer (flymake-diagnostic-buffer diag))
     44                    (type (flymake-diagnostic-type diag)))
     45                (when (buffer-live-p buffer)
     46                  (with-current-buffer buffer
     47                    (save-excursion
     48                      (without-restriction
     49                        (goto-char (flymake-diagnostic-beg diag))
     50                        (list (buffer-name buffer)
     51                              (line-number-at-pos)
     52                              type
     53                              (flymake-diagnostic-text diag)
     54                              (point-marker)
     55                              (flymake-diagnostic-end diag)
     56                              (pcase (flymake--lookup-type-property type 'flymake-category)
     57                                ('flymake-error ?e)
     58                                ('flymake-warning ?w)
     59                                (_ ?n)))))))))
     60            diags))
     61          (diags (or (delq nil diags)
     62                     (user-error "No flymake errors (Status: %s)"
     63                                 (if (seq-difference (flymake-running-backends)
     64                                                     (flymake-reporting-backends))
     65                                     'running 'finished))))
     66          (buffer-width (cl-loop for x in diags maximize (length (nth 0 x))))
     67          (line-width (cl-loop for x in diags maximize (length (number-to-string (nth 1 x)))))
     68          (fmt (format "%%-%ds %%-%dd %%-7s %%s" buffer-width line-width)))
     69     (mapcar
     70      (pcase-lambda (`(,buffer ,line ,type ,text ,beg ,end ,narrow))
     71        (propertize (format fmt buffer line
     72                            (propertize (format "%s" (flymake--lookup-type-property
     73                                                      type 'flymake-type-name type))
     74                                        'face (flymake--lookup-type-property
     75                                               type 'mode-line-face 'flymake-error))
     76                            text)
     77                    'consult--candidate (list beg (cons 0 (- end beg)))
     78                    'consult--type narrow))
     79      ;; Sort by buffer, severity and position.
     80      (sort diags
     81            (pcase-lambda (`(,b1 _ ,t1 _ ,m1 _) `(,b2 _ ,t2 _ ,m2 _))
     82              (let ((s1 (flymake--severity t1))
     83                    (s2 (flymake--severity t2)))
     84                (or
     85                 (string-lessp b1 b2)
     86                 (and (string-equal b1 b2)
     87                      (or
     88                       (> s1 s2)
     89                       (and (= s1 s2)
     90                            (< m1 m2)))))))))))
     91 
     92 ;;;###autoload
     93 (defun consult-flymake (&optional project)
     94   "Jump to Flymake diagnostic.
     95 When PROJECT is non-nil then prompt with diagnostics from all
     96 buffers in the current project instead of just the current buffer."
     97   (interactive "P")
     98   (consult--forbid-minibuffer)
     99   (consult--read
    100    (consult-flymake--candidates
    101      (if-let (((and project (fboundp 'flymake--project-diagnostics)))
    102               (project (project-current)))
    103          (flymake--project-diagnostics project)
    104        (flymake-diagnostics)))
    105    :prompt "Flymake diagnostic: "
    106    :category 'consult-flymake-error
    107    :history t ;; disable history
    108    :require-match t
    109    :sort nil
    110    :group (consult--type-group consult-flymake--narrow)
    111    :narrow (consult--type-narrow consult-flymake--narrow)
    112    :lookup #'consult--lookup-candidate
    113    :state (consult--jump-state)))
    114 
    115 (provide 'consult-flymake)
    116 ;;; consult-flymake.el ends here