371 lines
15 KiB
EmacsLisp
371 lines
15 KiB
EmacsLisp
;;; lsp-diagnostics.el --- LSP diagnostics integration -*- lexical-binding: t; -*-
|
||
;;
|
||
;; Copyright (C) 2020 emacs-lsp maintainers
|
||
;;
|
||
;; 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 <https://www.gnu.org/licenses/>.
|
||
;;
|
||
;;; Commentary:
|
||
;;
|
||
;; LSP diagnostics integration
|
||
;;
|
||
;;; Code:
|
||
|
||
(require 'lsp-mode)
|
||
|
||
(defgroup lsp-diagnostics nil
|
||
"LSP support for diagnostics"
|
||
:prefix "lsp-disagnostics-"
|
||
:group 'lsp-mode
|
||
:tag "LSP Diagnostics")
|
||
|
||
;;;###autoload
|
||
(define-obsolete-variable-alias 'lsp-diagnostic-package
|
||
'lsp-diagnostics-provider "lsp-mode 7.0.1")
|
||
|
||
(defcustom lsp-diagnostics-provider :auto
|
||
"The checker backend provider."
|
||
:type
|
||
'(choice
|
||
(const :tag "Pick flycheck if present and fallback to flymake" :auto)
|
||
(const :tag "Pick flycheck" :flycheck)
|
||
(const :tag "Pick flymake" :flymake)
|
||
(const :tag "Use neither flymake nor lsp" :none)
|
||
(const :tag "Prefer flymake" t)
|
||
(const :tag "Prefer flycheck" nil))
|
||
:group 'lsp-diagnostics
|
||
:package-version '(lsp-mode . "6.3"))
|
||
|
||
;;;###autoload
|
||
(define-obsolete-variable-alias 'lsp-flycheck-default-level
|
||
'lsp-diagnostics-flycheck-default-level "lsp-mode 7.0.1")
|
||
|
||
(defcustom lsp-diagnostics-flycheck-default-level 'error
|
||
"Error level to use when the server does not report back a diagnostic level."
|
||
:type '(choice
|
||
(const error)
|
||
(const warning)
|
||
(const info))
|
||
:group 'lsp-diagnostics)
|
||
|
||
(defcustom lsp-diagnostics-attributes
|
||
`((unnecessary :foreground "gray")
|
||
(deprecated :strike-through t))
|
||
"The Attributes used on the diagnostics.
|
||
List containing (tag attributes) where tag is the LSP diagnostic tag and
|
||
attributes is a `plist' containing face attributes which will be applied
|
||
on top the flycheck face for that error level."
|
||
:type '(repeat list)
|
||
:group 'lsp-diagnostics)
|
||
|
||
(defcustom lsp-diagnostics-disabled-modes nil
|
||
"A list of major models for which `lsp-diagnostics-mode' should be disabled."
|
||
:type '(repeat symbol)
|
||
:group 'lsp-diagnostics
|
||
:package-version '(lsp-mode . "8.0.0"))
|
||
|
||
;; Flycheck integration
|
||
|
||
(declare-function flycheck-mode "ext:flycheck")
|
||
(declare-function flycheck-define-generic-checker
|
||
"ext:flycheck" (symbol docstring &rest properties))
|
||
(declare-function flycheck-error-new "ext:flycheck" t t)
|
||
(declare-function flycheck-error-message "ext:flycheck" (err) t)
|
||
(declare-function flycheck-define-error-level "ext:flycheck" (level &rest properties))
|
||
(declare-function flycheck-buffer "ext:flycheck")
|
||
(declare-function flycheck-valid-checker-p "ext:flycheck")
|
||
(declare-function flycheck-stop "ext:flycheck")
|
||
|
||
(defvar flycheck-mode)
|
||
(defvar flycheck-check-syntax-automatically)
|
||
(defvar flycheck-checker)
|
||
(defvar flycheck-checkers)
|
||
|
||
|
||
(defvar-local lsp-diagnostics--flycheck-enabled nil
|
||
"True when lsp diagnostics flycheck integration has been enabled in this buffer.")
|
||
|
||
(defvar-local lsp-diagnostics--flycheck-checker nil
|
||
"The value of flycheck-checker before lsp diagnostics was activated.")
|
||
|
||
(defun lsp-diagnostics--flycheck-level (flycheck-level tags)
|
||
"Generate flycheck level from the original FLYCHECK-LEVEL (e.
|
||
g. `error', `warning') and list of LSP TAGS."
|
||
(let ((name (format "lsp-flycheck-%s-%s"
|
||
flycheck-level
|
||
(mapconcat #'symbol-name tags "-"))))
|
||
(or (intern-soft name)
|
||
(let* ((face (--doto (intern (format "%s-face" name))
|
||
(copy-face (-> flycheck-level
|
||
(get 'flycheck-overlay-category)
|
||
(get 'face))
|
||
it)
|
||
(mapc (lambda (tag)
|
||
(apply #'set-face-attribute it nil
|
||
(cl-rest (assoc tag lsp-diagnostics-attributes))))
|
||
tags)))
|
||
(category (--doto (intern (format "%s-category" name))
|
||
(setf (get it 'face) face
|
||
(get it 'priority) 100)))
|
||
(new-level (intern name))
|
||
(bitmap (or (get flycheck-level 'flycheck-fringe-bitmaps)
|
||
(get flycheck-level 'flycheck-fringe-bitmap-double-arrow))))
|
||
(flycheck-define-error-level new-level
|
||
:severity (get flycheck-level 'flycheck-error-severity)
|
||
:compilation-level (get flycheck-level 'flycheck-compilation-level)
|
||
:overlay-category category
|
||
:fringe-bitmap bitmap
|
||
:fringe-face (get flycheck-level 'flycheck-fringe-face)
|
||
:error-list-face face)
|
||
new-level))))
|
||
|
||
(defun lsp-diagnostics--flycheck-calculate-level (severity tags)
|
||
"Calculate flycheck level by SEVERITY and TAGS."
|
||
(let ((level (pcase severity
|
||
(1 'error)
|
||
(2 'warning)
|
||
(3 'info)
|
||
(4 'info)
|
||
(_ lsp-flycheck-default-level)))
|
||
;; materialize only first tag.
|
||
(tags (seq-map (lambda (tag)
|
||
(cond
|
||
((= tag lsp/diagnostic-tag-unnecessary) 'unnecessary)
|
||
((= tag lsp/diagnostic-tag-deprecated) 'deprecated)))
|
||
tags)))
|
||
(if tags
|
||
(lsp-diagnostics--flycheck-level level tags)
|
||
level)))
|
||
|
||
(defun lsp-diagnostics--flycheck-start (checker callback)
|
||
"Start an LSP syntax check with CHECKER.
|
||
|
||
CALLBACK is the status callback passed by Flycheck."
|
||
|
||
(remove-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer t)
|
||
|
||
(->> (lsp--get-buffer-diagnostics)
|
||
(-map (-lambda ((&Diagnostic :message :severity? :tags? :code? :source?
|
||
:range (&Range :start (&Position :line start-line
|
||
:character start-character)
|
||
:end (&Position :line end-line
|
||
:character end-character))))
|
||
(flycheck-error-new
|
||
:buffer (current-buffer)
|
||
:checker checker
|
||
:filename buffer-file-name
|
||
:message message
|
||
:level (lsp-diagnostics--flycheck-calculate-level severity? tags?)
|
||
:id code?
|
||
:group source?
|
||
:line (lsp-translate-line (1+ start-line))
|
||
:column (1+ (lsp-translate-column start-character))
|
||
:end-line (lsp-translate-line (1+ end-line))
|
||
:end-column (1+ (lsp-translate-column end-character)))))
|
||
(funcall callback 'finished)))
|
||
|
||
(defun lsp-diagnostics--flycheck-buffer ()
|
||
"Trigger flyckeck on buffer."
|
||
(remove-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer t)
|
||
(when (bound-and-true-p flycheck-mode)
|
||
(flycheck-buffer)))
|
||
|
||
(defun lsp-diagnostics--flycheck-report ()
|
||
"Report flycheck.
|
||
This callback is invoked when new diagnostics are received
|
||
from the language server."
|
||
(when (and (or (memq 'idle-change flycheck-check-syntax-automatically)
|
||
(and (memq 'save flycheck-check-syntax-automatically)
|
||
(not (buffer-modified-p))))
|
||
lsp--cur-workspace)
|
||
;; make sure diagnostics are published even if the diagnostics
|
||
;; have been received after idle-change has been triggered
|
||
(->> lsp--cur-workspace
|
||
(lsp--workspace-buffers)
|
||
(mapc (lambda (buffer)
|
||
(when (and (lsp-buffer-live-p buffer)
|
||
(or
|
||
(not (bufferp buffer))
|
||
(and (get-buffer-window buffer)
|
||
(not (-contains? (buffer-local-value 'lsp-on-idle-hook buffer)
|
||
'lsp-diagnostics--flycheck-buffer)))))
|
||
(lsp-with-current-buffer buffer
|
||
(add-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer nil t)
|
||
(lsp--idle-reschedule (current-buffer)))))))))
|
||
|
||
(cl-defgeneric lsp-diagnostics-flycheck-error-explainer (e _server-id)
|
||
"Explain a `flycheck-error' E in a generic way depending on the SERVER-ID."
|
||
(flycheck-error-message e))
|
||
|
||
(defvar lsp-diagnostics-mode) ;; properly defined by define-minor-mode below
|
||
|
||
;;;###autoload
|
||
(defun lsp-diagnostics-lsp-checker-if-needed ()
|
||
(unless (flycheck-valid-checker-p 'lsp)
|
||
(flycheck-define-generic-checker 'lsp
|
||
"A syntax checker using the Language Server Protocol (LSP)
|
||
provided by lsp-mode.
|
||
See https://github.com/emacs-lsp/lsp-mode."
|
||
:start #'lsp-diagnostics--flycheck-start
|
||
:modes '(lsp-placeholder-mode) ;; placeholder
|
||
:predicate (lambda () lsp-diagnostics-mode)
|
||
:error-explainer (lambda (e)
|
||
(lsp-diagnostics-flycheck-error-explainer
|
||
e (lsp--workspace-server-id (car-safe (lsp-workspaces))))))))
|
||
|
||
(defun lsp-diagnostics-flycheck-enable (&rest _)
|
||
"Enable flycheck integration for the current buffer."
|
||
(require 'flycheck)
|
||
(lsp-diagnostics-lsp-checker-if-needed)
|
||
(and (not lsp-diagnostics--flycheck-enabled)
|
||
(not (eq flycheck-checker 'lsp))
|
||
(setq lsp-diagnostics--flycheck-checker flycheck-checker))
|
||
(setq-local lsp-diagnostics--flycheck-enabled t)
|
||
(flycheck-mode 1)
|
||
(flycheck-stop)
|
||
(setq-local flycheck-checker 'lsp)
|
||
(lsp-flycheck-add-mode major-mode)
|
||
(add-to-list 'flycheck-checkers 'lsp)
|
||
(add-hook 'lsp-diagnostics-updated-hook #'lsp-diagnostics--flycheck-report nil t)
|
||
(add-hook 'lsp-managed-mode-hook #'lsp-diagnostics--flycheck-report nil t))
|
||
|
||
(defun lsp-diagnostics-flycheck-disable ()
|
||
"Disable flycheck integration for the current buffer is it was enabled."
|
||
(when lsp-diagnostics--flycheck-enabled
|
||
(flycheck-stop)
|
||
(when (eq flycheck-checker 'lsp)
|
||
(setq-local flycheck-checker lsp-diagnostics--flycheck-checker))
|
||
(setq lsp-diagnostics--flycheck-checker nil)
|
||
(setq-local lsp-diagnostics--flycheck-enabled nil)
|
||
(when flycheck-mode
|
||
(flycheck-mode 1))))
|
||
|
||
;; Flymake integration
|
||
|
||
(declare-function flymake-mode "ext:flymake")
|
||
(declare-function flymake-make-diagnostic "ext:flymake")
|
||
(declare-function flymake-diag-region "ext:flymake")
|
||
|
||
(defvar flymake-diagnostic-functions)
|
||
(defvar flymake-mode)
|
||
(defvar-local lsp-diagnostics--flymake-report-fn nil)
|
||
|
||
(defun lsp-diagnostics--flymake-setup ()
|
||
"Setup flymake."
|
||
(setq lsp-diagnostics--flymake-report-fn nil)
|
||
(add-hook 'flymake-diagnostic-functions 'lsp-diagnostics--flymake-backend nil t)
|
||
(add-hook 'lsp-diagnostics-updated-hook 'lsp-diagnostics--flymake-after-diagnostics nil t)
|
||
(flymake-mode 1))
|
||
|
||
(defun lsp-diagnostics--flymake-after-diagnostics ()
|
||
"Handler for `lsp-diagnostics-updated-hook'."
|
||
(cond
|
||
((and lsp-diagnostics--flymake-report-fn flymake-mode)
|
||
(lsp-diagnostics--flymake-update-diagnostics))
|
||
((not flymake-mode)
|
||
(setq lsp-diagnostics--flymake-report-fn nil))))
|
||
|
||
(defun lsp-diagnostics--flymake-backend (report-fn &rest _args)
|
||
"Flymake backend using REPORT-FN."
|
||
(let ((first-run (null lsp-diagnostics--flymake-report-fn)))
|
||
(setq lsp-diagnostics--flymake-report-fn report-fn)
|
||
(when first-run
|
||
(lsp-diagnostics--flymake-update-diagnostics))))
|
||
|
||
(defun lsp-diagnostics--flymake-update-diagnostics ()
|
||
"Report new diagnostics to flymake."
|
||
(funcall lsp-diagnostics--flymake-report-fn
|
||
(-some->> (lsp-diagnostics t)
|
||
(gethash (lsp--fix-path-casing buffer-file-name))
|
||
(--map (-let* (((&Diagnostic :message :severity?
|
||
:range (range &as &Range
|
||
:start (&Position :line start-line :character)
|
||
:end (&Position :line end-line))) it)
|
||
((start . end) (lsp--range-to-region range)))
|
||
(when (= start end)
|
||
(if-let ((region (flymake-diag-region (current-buffer)
|
||
(1+ start-line)
|
||
character)))
|
||
(setq start (car region)
|
||
end (cdr region))
|
||
(lsp-save-restriction-and-excursion
|
||
(goto-char (point-min))
|
||
(setq start (line-beginning-position (1+ start-line))
|
||
end (line-end-position (1+ end-line))))))
|
||
(flymake-make-diagnostic (current-buffer)
|
||
start
|
||
end
|
||
(cl-case severity?
|
||
(1 :error)
|
||
(2 :warning)
|
||
(t :note))
|
||
message))))
|
||
;; This :region keyword forces flymake to delete old diagnostics in
|
||
;; case the buffer hasn't changed since the last call to the report
|
||
;; function. See https://github.com/joaotavora/eglot/issues/159
|
||
:region (cons (point-min) (point-max))))
|
||
|
||
|
||
|
||
;;;###autoload
|
||
(defun lsp-diagnostics--enable ()
|
||
"Enable LSP checker support."
|
||
(when (and (member lsp-diagnostics-provider '(:auto :none :flycheck :flymake t nil))
|
||
(not (member major-mode lsp-diagnostics-disabled-modes)))
|
||
(lsp-diagnostics-mode 1)))
|
||
|
||
(defun lsp-diagnostics--disable ()
|
||
"Disable LSP checker support."
|
||
(lsp-diagnostics-mode -1))
|
||
|
||
;;;###autoload
|
||
(define-minor-mode lsp-diagnostics-mode
|
||
"Toggle LSP diagnostics integration."
|
||
:group 'lsp-diagnostics
|
||
:global nil
|
||
:lighter ""
|
||
(cond
|
||
(lsp-diagnostics-mode
|
||
(cond
|
||
((and (or
|
||
(and (eq lsp-diagnostics-provider :auto)
|
||
(functionp 'flycheck-mode))
|
||
(and (eq lsp-diagnostics-provider :flycheck)
|
||
(or (functionp 'flycheck-mode)
|
||
(user-error "The lsp-diagnostics-provider is set to :flycheck but flycheck is not installed?")))
|
||
;; legacy
|
||
(null lsp-diagnostics-provider))
|
||
(require 'flycheck nil t))
|
||
(lsp-diagnostics-flycheck-enable))
|
||
((or (eq lsp-diagnostics-provider :auto)
|
||
(eq lsp-diagnostics-provider :flymake)
|
||
(eq lsp-diagnostics-provider t))
|
||
(require 'flymake)
|
||
(lsp-diagnostics--flymake-setup))
|
||
((not (eq lsp-diagnostics-provider :none))
|
||
(lsp--warn "Unable to autoconfigure flycheck/flymake. The diagnostics won't be rendered.")))
|
||
|
||
(add-hook 'lsp-unconfigure-hook #'lsp-diagnostics--disable nil t))
|
||
(t (lsp-diagnostics-flycheck-disable)
|
||
(remove-hook 'lsp-unconfigure-hook #'lsp-diagnostics--disable t))))
|
||
|
||
;;;###autoload
|
||
(add-hook 'lsp-configure-hook (lambda ()
|
||
(when lsp-auto-configure
|
||
(lsp-diagnostics--enable))))
|
||
|
||
(lsp-consistency-check lsp-diagnostics)
|
||
|
||
(provide 'lsp-diagnostics)
|
||
;;; lsp-diagnostics.el ends here
|