lsp-diagnostics.el (15950B)
1 ;;; lsp-diagnostics.el --- LSP diagnostics integration -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2020 emacs-lsp maintainers 4 ;; 5 ;; This program is free software; you can redistribute it and/or modify 6 ;; it under the terms of the GNU General Public License as published by 7 ;; the Free Software Foundation, either version 3 of the License, or 8 ;; (at your option) any later version. 9 10 ;; This program is distributed in the hope that it will be useful, 11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ;; GNU General Public License for more details. 14 15 ;; You should have received a copy of the GNU General Public License 16 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 17 ;; 18 ;;; Commentary: 19 ;; 20 ;; LSP diagnostics integration 21 ;; 22 ;;; Code: 23 24 (require 'lsp-mode) 25 26 (defgroup lsp-diagnostics nil 27 "LSP support for diagnostics" 28 :prefix "lsp-disagnostics-" 29 :group 'lsp-mode 30 :tag "LSP Diagnostics") 31 32 ;;;###autoload 33 (define-obsolete-variable-alias 'lsp-diagnostic-package 34 'lsp-diagnostics-provider "lsp-mode 7.0.1") 35 36 (defcustom lsp-diagnostics-provider :auto 37 "The checker backend provider." 38 :type 39 '(choice 40 (const :tag "Pick flycheck if present and fallback to flymake" :auto) 41 (const :tag "Pick flycheck" :flycheck) 42 (const :tag "Pick flymake" :flymake) 43 (const :tag "Use neither flymake nor lsp" :none) 44 (const :tag "Prefer flymake" t) 45 (const :tag "Prefer flycheck" nil)) 46 :group 'lsp-diagnostics 47 :package-version '(lsp-mode . "6.3")) 48 49 ;;;###autoload 50 (define-obsolete-variable-alias 'lsp-flycheck-default-level 51 'lsp-diagnostics-flycheck-default-level "lsp-mode 7.0.1") 52 53 (defcustom lsp-diagnostics-flycheck-default-level 'error 54 "Error level to use when the server does not report back a diagnostic level." 55 :type '(choice 56 (const error) 57 (const warning) 58 (const info)) 59 :group 'lsp-diagnostics) 60 61 (defcustom lsp-diagnostics-attributes 62 `((unnecessary :foreground "gray") 63 (deprecated :strike-through t)) 64 "The Attributes used on the diagnostics. 65 List containing (tag attributes) where tag is the LSP diagnostic tag and 66 attributes is a `plist' containing face attributes which will be applied 67 on top the flycheck face for that error level." 68 :type '(repeat (list symbol plist)) 69 :group 'lsp-diagnostics) 70 71 (defcustom lsp-diagnostics-disabled-modes nil 72 "A list of major models for which `lsp-diagnostics-mode' should be disabled." 73 :type '(repeat symbol) 74 :group 'lsp-diagnostics 75 :package-version '(lsp-mode . "8.0.0")) 76 77 ;; Flycheck integration 78 79 (declare-function flycheck-mode "ext:flycheck") 80 (declare-function flycheck-define-generic-checker 81 "ext:flycheck" (symbol docstring &rest properties)) 82 (declare-function flycheck-error-new "ext:flycheck" t t) 83 (declare-function flycheck-error-message "ext:flycheck" (err) t) 84 (declare-function flycheck-define-error-level "ext:flycheck" (level &rest properties)) 85 (declare-function flycheck-buffer "ext:flycheck") 86 (declare-function flycheck-valid-checker-p "ext:flycheck") 87 (declare-function flycheck-stop "ext:flycheck") 88 89 (defvar flycheck-mode) 90 (defvar flycheck-check-syntax-automatically) 91 (defvar flycheck-checker) 92 (defvar flycheck-checkers) 93 94 95 (defvar-local lsp-diagnostics--flycheck-enabled nil 96 "True when lsp diagnostics flycheck integration has been enabled in this buffer.") 97 98 (defvar-local lsp-diagnostics--flycheck-checker nil 99 "The value of flycheck-checker before lsp diagnostics was activated.") 100 101 (defun lsp-diagnostics--flycheck-level (flycheck-level tags) 102 "Generate flycheck level from the original FLYCHECK-LEVEL (e. 103 g. `error', `warning') and list of LSP TAGS." 104 (let ((name (format "lsp-flycheck-%s-%s" 105 flycheck-level 106 (mapconcat #'symbol-name tags "-")))) 107 (or (intern-soft name) 108 (let* ((face (--doto (intern (format "%s-face" name)) 109 (copy-face (-> flycheck-level 110 (get 'flycheck-overlay-category) 111 (get 'face)) 112 it) 113 (mapc (lambda (tag) 114 (apply #'set-face-attribute it nil 115 (cl-rest (assoc tag lsp-diagnostics-attributes)))) 116 tags))) 117 (category (--doto (intern (format "%s-category" name)) 118 (setf (get it 'face) face 119 (get it 'priority) 100))) 120 (new-level (intern name)) 121 (bitmap (or (get flycheck-level 'flycheck-fringe-bitmaps) 122 (get flycheck-level 'flycheck-fringe-bitmap-double-arrow)))) 123 (flycheck-define-error-level new-level 124 :severity (get flycheck-level 'flycheck-error-severity) 125 :compilation-level (get flycheck-level 'flycheck-compilation-level) 126 :overlay-category category 127 :fringe-bitmap bitmap 128 :fringe-face (get flycheck-level 'flycheck-fringe-face) 129 :error-list-face face) 130 new-level)))) 131 132 (defun lsp-diagnostics--flycheck-calculate-level (severity tags) 133 "Calculate flycheck level by SEVERITY and TAGS." 134 (let ((level (pcase severity 135 (1 'error) 136 (2 'warning) 137 (3 'info) 138 (4 'info) 139 (_ lsp-flycheck-default-level))) 140 ;; materialize only first tag. 141 (tags (seq-map (lambda (tag) 142 (cond 143 ((= tag lsp/diagnostic-tag-unnecessary) 'unnecessary) 144 ((= tag lsp/diagnostic-tag-deprecated) 'deprecated))) 145 tags))) 146 (if tags 147 (lsp-diagnostics--flycheck-level level tags) 148 level))) 149 150 (defun lsp-diagnostics--flycheck-start (checker callback) 151 "Start an LSP syntax check with CHECKER. 152 153 CALLBACK is the status callback passed by Flycheck." 154 155 (remove-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer t) 156 157 (->> (lsp--get-buffer-diagnostics) 158 (-map (-lambda ((&Diagnostic :message :severity? :tags? :code? :source? 159 :range (&Range :start (start &as &Position 160 :line start-line 161 :character start-character) 162 :end (end &as &Position 163 :line end-line 164 :character end-character)))) 165 (flycheck-error-new 166 :buffer (current-buffer) 167 :checker checker 168 :filename buffer-file-name 169 :message message 170 :level (lsp-diagnostics--flycheck-calculate-level severity? tags?) 171 :id code? 172 :group source? 173 :line (lsp-translate-line (1+ start-line)) 174 :column (1+ (lsp-translate-column start-character)) 175 :end-line (lsp-translate-line (1+ end-line)) 176 :end-column (unless (lsp--position-equal start end) 177 (1+ (lsp-translate-column end-character)))))) 178 (funcall callback 'finished))) 179 180 (defun lsp-diagnostics--flycheck-buffer () 181 "Trigger flyckeck on buffer." 182 (remove-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer t) 183 (when (bound-and-true-p flycheck-mode) 184 (flycheck-buffer))) 185 186 (defun lsp-diagnostics--flycheck-report () 187 "Report flycheck. 188 This callback is invoked when new diagnostics are received 189 from the language server." 190 (when (and (or (memq 'idle-change flycheck-check-syntax-automatically) 191 (and (memq 'save flycheck-check-syntax-automatically) 192 (not (buffer-modified-p)))) 193 lsp--cur-workspace) 194 ;; make sure diagnostics are published even if the diagnostics 195 ;; have been received after idle-change has been triggered 196 (->> lsp--cur-workspace 197 (lsp--workspace-buffers) 198 (mapc (lambda (buffer) 199 (when (and (lsp-buffer-live-p buffer) 200 (or 201 (not (bufferp buffer)) 202 (and (get-buffer-window buffer) 203 (not (-contains? (buffer-local-value 'lsp-on-idle-hook buffer) 204 'lsp-diagnostics--flycheck-buffer))))) 205 (lsp-with-current-buffer buffer 206 (add-hook 'lsp-on-idle-hook #'lsp-diagnostics--flycheck-buffer nil t) 207 (lsp--idle-reschedule (current-buffer))))))))) 208 209 (cl-defgeneric lsp-diagnostics-flycheck-error-explainer (e _server-id) 210 "Explain a `flycheck-error' E in a generic way depending on the SERVER-ID." 211 (flycheck-error-message e)) 212 213 (defvar lsp-diagnostics-mode) ;; properly defined by define-minor-mode below 214 215 ;;;###autoload 216 (defun lsp-diagnostics-lsp-checker-if-needed () 217 (unless (flycheck-valid-checker-p 'lsp) 218 (flycheck-define-generic-checker 'lsp 219 "A syntax checker using the Language Server Protocol (LSP) 220 provided by lsp-mode. 221 See https://github.com/emacs-lsp/lsp-mode." 222 :start #'lsp-diagnostics--flycheck-start 223 :modes '(lsp-placeholder-mode) ;; placeholder 224 :predicate (lambda () lsp-diagnostics-mode) 225 :error-explainer (lambda (e) 226 (lsp-diagnostics-flycheck-error-explainer 227 e (lsp--workspace-server-id (car-safe (lsp-workspaces)))))))) 228 229 (defun lsp-diagnostics-flycheck-enable (&rest _) 230 "Enable flycheck integration for the current buffer." 231 (require 'flycheck) 232 (lsp-diagnostics-lsp-checker-if-needed) 233 (and (not lsp-diagnostics--flycheck-enabled) 234 (not (eq flycheck-checker 'lsp)) 235 (setq lsp-diagnostics--flycheck-checker flycheck-checker)) 236 (setq-local lsp-diagnostics--flycheck-enabled t) 237 (flycheck-mode 1) 238 (flycheck-stop) 239 (setq-local flycheck-checker 'lsp) 240 (lsp-flycheck-add-mode major-mode) 241 (add-to-list 'flycheck-checkers 'lsp) 242 (add-hook 'lsp-diagnostics-updated-hook #'lsp-diagnostics--flycheck-report nil t) 243 (add-hook 'lsp-managed-mode-hook #'lsp-diagnostics--flycheck-report nil t)) 244 245 (defun lsp-diagnostics-flycheck-disable () 246 "Disable flycheck integration for the current buffer is it was enabled." 247 (when lsp-diagnostics--flycheck-enabled 248 (flycheck-stop) 249 (when (eq flycheck-checker 'lsp) 250 (setq-local flycheck-checker lsp-diagnostics--flycheck-checker)) 251 (setq lsp-diagnostics--flycheck-checker nil) 252 (setq-local lsp-diagnostics--flycheck-enabled nil) 253 (when flycheck-mode 254 (flycheck-mode 1)))) 255 256 ;; Flymake integration 257 258 (declare-function flymake-mode "ext:flymake") 259 (declare-function flymake-make-diagnostic "ext:flymake") 260 (declare-function flymake-diag-region "ext:flymake") 261 262 (defvar flymake-diagnostic-functions) 263 (defvar flymake-mode) 264 (defvar-local lsp-diagnostics--flymake-report-fn nil) 265 266 (defun lsp-diagnostics--flymake-setup () 267 "Setup flymake." 268 (setq lsp-diagnostics--flymake-report-fn nil) 269 (add-hook 'flymake-diagnostic-functions 'lsp-diagnostics--flymake-backend nil t) 270 (add-hook 'lsp-diagnostics-updated-hook 'lsp-diagnostics--flymake-after-diagnostics nil t) 271 (flymake-mode 1)) 272 273 (defun lsp-diagnostics--flymake-after-diagnostics () 274 "Handler for `lsp-diagnostics-updated-hook'." 275 (cond 276 ((and lsp-diagnostics--flymake-report-fn flymake-mode) 277 (lsp-diagnostics--flymake-update-diagnostics)) 278 ((not flymake-mode) 279 (setq lsp-diagnostics--flymake-report-fn nil)))) 280 281 (defun lsp-diagnostics--flymake-backend (report-fn &rest _args) 282 "Flymake backend using REPORT-FN." 283 (let ((first-run (null lsp-diagnostics--flymake-report-fn))) 284 (setq lsp-diagnostics--flymake-report-fn report-fn) 285 (when first-run 286 (lsp-diagnostics--flymake-update-diagnostics)))) 287 288 (defun lsp-diagnostics--flymake-update-diagnostics () 289 "Report new diagnostics to flymake." 290 (funcall lsp-diagnostics--flymake-report-fn 291 (-some->> (lsp-diagnostics t) 292 (gethash (lsp--fix-path-casing buffer-file-name)) 293 (--map (-let* (((&Diagnostic :message :severity? 294 :range (range &as &Range 295 :start (&Position :line start-line :character) 296 :end (&Position :line end-line))) it) 297 ((start . end) (lsp--range-to-region range))) 298 (when (= start end) 299 (if-let ((region (flymake-diag-region (current-buffer) 300 (1+ start-line) 301 character))) 302 (setq start (car region) 303 end (cdr region)) 304 (lsp-save-restriction-and-excursion 305 (goto-char (point-min)) 306 (setq start (line-beginning-position (1+ start-line)) 307 end (line-end-position (1+ end-line)))))) 308 (flymake-make-diagnostic (current-buffer) 309 start 310 end 311 (cl-case severity? 312 (1 :error) 313 (2 :warning) 314 (t :note)) 315 message)))) 316 ;; This :region keyword forces flymake to delete old diagnostics in 317 ;; case the buffer hasn't changed since the last call to the report 318 ;; function. See https://github.com/joaotavora/eglot/issues/159 319 :region (cons (point-min) (point-max)))) 320 321 322 323 ;;;###autoload 324 (defun lsp-diagnostics--enable () 325 "Enable LSP checker support." 326 (when (and (member lsp-diagnostics-provider '(:auto :none :flycheck :flymake t nil)) 327 (not (member major-mode lsp-diagnostics-disabled-modes))) 328 (lsp-diagnostics-mode 1))) 329 330 (defun lsp-diagnostics--disable () 331 "Disable LSP checker support." 332 (lsp-diagnostics-mode -1)) 333 334 ;;;###autoload 335 (define-minor-mode lsp-diagnostics-mode 336 "Toggle LSP diagnostics integration." 337 :group 'lsp-diagnostics 338 :global nil 339 :lighter "" 340 (cond 341 (lsp-diagnostics-mode 342 (cond 343 ((and (or 344 (and (eq lsp-diagnostics-provider :auto) 345 (functionp 'flycheck-mode)) 346 (and (eq lsp-diagnostics-provider :flycheck) 347 (or (functionp 'flycheck-mode) 348 (user-error "The lsp-diagnostics-provider is set to :flycheck but flycheck is not installed?"))) 349 ;; legacy 350 (null lsp-diagnostics-provider)) 351 (require 'flycheck nil t)) 352 (lsp-diagnostics-flycheck-enable)) 353 ((or (eq lsp-diagnostics-provider :auto) 354 (eq lsp-diagnostics-provider :flymake) 355 (eq lsp-diagnostics-provider t)) 356 (require 'flymake) 357 (lsp-diagnostics--flymake-setup)) 358 ((not (eq lsp-diagnostics-provider :none)) 359 (lsp--warn "Unable to autoconfigure flycheck/flymake. The diagnostics won't be rendered."))) 360 361 (add-hook 'lsp-unconfigure-hook #'lsp-diagnostics--disable nil t)) 362 (t (lsp-diagnostics-flycheck-disable) 363 (remove-hook 'lsp-unconfigure-hook #'lsp-diagnostics--disable t)))) 364 365 ;;;###autoload 366 (add-hook 'lsp-configure-hook (lambda () 367 (when lsp-auto-configure 368 (lsp-diagnostics--enable)))) 369 370 (lsp-consistency-check lsp-diagnostics) 371 372 (provide 'lsp-diagnostics) 373 ;;; lsp-diagnostics.el ends here