[nongnu] elpa/consult-flycheck 44e7528d3a 01/18: Import consult-flycheck

[ELPA Syncer]

branch: elpa/consult-flycheck
commit 44e7528d3a536755e731688c9ad9b5480b0eb880
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    Import consult-flycheck
---
 README.org          |   9 +++++
 consult-flycheck.el | 112 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 121 insertions(+)

diff --git a/README.org b/README.org
new file mode 100644
index 0000000000..6f3505b9c4
--- /dev/null
+++ b/README.org
@@ -0,0 +1,9 @@
+#+title: consult-flycheck.el - Consult integration for Flycheck
+#+author: Daniel Mendler
+#+language: en
+
+#+html: <a href="https://melpa.org/#/consult-flycheck";><img alt="MELPA" 
src="https://melpa.org/packages/consult-flycheck-badge.svg"/></a>
+#+html: <a href="https://stable.melpa.org/#/consult-flycheck";><img alt="MELPA 
Stable" src="https://stable.melpa.org/packages/consult-flycheck-badge.svg"/></a>
+
+This package provides the =consult-flycheck= command, which integrates 
[[https://github.com/minad/consult][Consult]]
+with [[https://github.com/flycheck/flycheck][Flycheck]]. Take a look at the 
[[https://github.com/minad/consult/blob/main/README.org][Consult README]] for 
an extensive documentation.
diff --git a/consult-flycheck.el b/consult-flycheck.el
new file mode 100644
index 0000000000..3eb643ee3a
--- /dev/null
+++ b/consult-flycheck.el
@@ -0,0 +1,112 @@
+;;; consult-flycheck.el --- Provides the command `consult-flycheck' -*- 
lexical-binding: t -*-
+
+;; Author: Daniel Mendler and Consult contributors
+;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
+;; Created: 2020
+;; License: GPL-3.0-or-later
+;; Version: 0.7
+;; Package-Requires: ((consult "0.7") (flycheck "31") (emacs "26.1"))
+;; Homepage: https://github.com/minad/consult
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Provides the command `consult-flycheck'. This is an extra package,
+;; since the consult.el package only depends on Emacs core components.
+
+;;; Code:
+
+(require 'consult)
+(require 'flycheck)
+
+(defconst consult-flycheck--narrow
+  '((?e . "Error")
+    (?w . "Warning")
+    (?i . "Info")))
+
+(defun consult-flycheck--sort-predicate (x y)
+  "Compare X and Y first by severity, then by location.
+In contrast to `flycheck-error-level-<' sort errors first."
+  (let* ((lx (flycheck-error-level x))
+         (ly (flycheck-error-level y))
+         (sx (flycheck-error-level-severity lx))
+         (sy (flycheck-error-level-severity ly)))
+    (if (= sx sy)
+        (if (string= lx ly)
+            (flycheck-error-< x y)
+          (string< lx ly))
+      (> sx sy))))
+
+(defun consult-flycheck--candidates ()
+  "Return flycheck errors as alist."
+  (consult--forbid-minibuffer)
+  (unless flycheck-current-errors
+    (user-error "No flycheck errors (Status: %s)" flycheck-last-status-change))
+  (let* ((errors (mapcar
+                  (lambda (err)
+                    (list
+                     (if-let (file (flycheck-error-filename err))
+                         (file-name-nondirectory file)
+                       (buffer-name (flycheck-error-buffer err)))
+                     (number-to-string (flycheck-error-line err))
+                     err))
+                  (seq-sort #'consult-flycheck--sort-predicate 
flycheck-current-errors)))
+         (file-width (apply #'max (mapcar (lambda (x) (length (car x))) 
errors)))
+         (line-width (apply #'max (mapcar (lambda (x) (length (cadr x))) 
errors)))
+         (fmt (format "%%-%ds %%-%ds %%-7s %%s (%%s)" file-width line-width)))
+    (mapcar
+     (pcase-lambda (`(,file ,line ,err))
+       (let ((level (flycheck-error-level err)))
+         (format fmt
+                 (propertize file
+                             'face 'flycheck-error-list-filename
+                             'consult--candidate
+                             (set-marker (make-marker)
+                                         (flycheck-error-pos err)
+                                         (if (flycheck-error-filename err)
+                                             (find-file-noselect 
(flycheck-error-filename err) 'nowarn)
+                                           (flycheck-error-buffer err)))
+                             'consult--type
+                             (pcase level
+                               ('error ?e)
+                               ('warning ?w)
+                               (_ ?i)))
+                 (propertize line 'face 'flycheck-error-list-line-number)
+                 (propertize (symbol-name level) 'face 
(flycheck-error-level-error-list-face level))
+                 (propertize (flycheck-error-message err) 'face 
'flycheck-error-list-error-message)
+                 (propertize (symbol-name (flycheck-error-checker err))
+                             'face 'flycheck-error-list-checker-name))))
+     errors)))
+
+;;;###autoload
+(defun consult-flycheck ()
+  "Jump to flycheck error."
+  (interactive)
+  (consult--read
+   (consult--with-increased-gc (consult-flycheck--candidates))
+   :prompt "Flycheck error: "
+   :category 'consult-flycheck-error
+   :history t ;; disable history
+   :require-match t
+   :sort nil
+   :group (consult--type-group consult-flycheck--narrow)
+   :narrow (consult--type-narrow consult-flycheck--narrow)
+   :lookup #'consult--lookup-candidate
+   :state (consult--jump-state 'consult-preview-error)))
+
+(provide 'consult-flycheck)
+;;; consult-flycheck.el ends here