[elpa] externals/eglot 76971e53e1: Enable LSP project-wide diagnostics via Flymake

[ELPA Syncer]

branch: externals/eglot
commit 76971e53e16d6debecc21efe1d96c2d42c68a705
Author: Theodor Thornhill <theo@thornhill.no>
Commit: GitHub <noreply@github.com>

    Enable LSP project-wide diagnostics via Flymake
    
    * eglot.el (eglot-handle-notification): Pass on diagnostics from
    unvisited files to flymake.  Enables project-wide-diagnostics, so that
    we can view all diagnostics in a given workspace.  Uses new
    functionality from flymake 1.2.1, hence the version bump.
    
    * eglot-tests.el (project-wide-diagnostics-typescript): New tests
    showcasing the possibility to see all related diagnostics in a
    workspace.
    
    * eglot-tests.el (project-wide-diagnostics-rust-analyzer): New tests
    showcasing the possibility to see all related diagnostics in a
    workspace.
    
    * NEWS.md: Mention the new functionality
    * README.md: Mention the new functionality
---
 NEWS.md        |   7 ++++
 README.md      |   3 +-
 eglot-tests.el |  71 +++++++++++++++++++++++++++++++++++---
 eglot.el       | 105 +++++++++++++++++++++++++++++++++------------------------
 4 files changed, 137 insertions(+), 49 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index c17e039e55..c080c43b92 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,12 @@
 # (upcoming)
 
+##### Show project wide diagnosics ([#810][github#810])
+Some LSP servers report diagnostics for all files in the current
+workspace.  Flymake has as of version 1.2.1 the option to show
+diagnostics from buffers other than the currently visited one.  The
+command `M-x flymake-show-project-diagnostics` will now show all
+diagnostics relevant to a workspace.
+
 ##### Support optional diagnostic tags ([#794][github#794])
 A [diagnostic tag][diagnostictag] can indicate either "unused or
 unnecessary code" or "deprecated or obsolete code".  Following the
diff --git a/README.md b/README.md
index 05bf78bf04..182c6d92f0 100644
--- a/README.md
+++ b/README.md
@@ -357,7 +357,8 @@ primarily with Emacs' built-in libraries and _not_ with 
third-party
 replacements for those facilities.
 
 * definitions can be found via `xref-find-definitions`;
-* on-the-fly diagnostics are given by `flymake-mode`;
+* on-the-fly diagnostics for the buffer or project are given by
+  `flymake-mode`;
 * function signature hints are given by `eldoc-mode`;
 * completion can be summoned with `completion-at-point`.
 * projects are discovered via `project.el`'s API;
diff --git a/eglot-tests.el b/eglot-tests.el
index ae8a2bb080..255072f7d7 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -33,6 +33,7 @@
 (require 'python) ; python-mode-hook
 (require 'company nil t)
 (require 'subr-x)
+(require 'flymake) ; project-diagnostics
 
 ;;; Helpers
 
@@ -250,11 +251,17 @@ Pass TIMEOUT to `eglot--with-timeout'."
        (eglot--message "Event detected:\n%s"
                        (pp-to-string (car event))))))
 
-;; `rust-mode' is not a part of emacs. So define these two shims which
-;; should be more than enough for testing
+;; `rust-mode' is not a part of Emacs, so we define these two shims
+;; which should be more than enough for testing.
 (unless (functionp 'rust-mode)
-  (define-derived-mode rust-mode prog-mode "Rust"))
-(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-mode))
+  (define-derived-mode rust-mode prog-mode "Rust")
+  (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-mode)))
+
+;; `typescript-mode' is not a part of Emacs, so we define these two
+;; shims which should be more than enough for testing.
+(unless (functionp 'typescript-mode)
+  (define-derived-mode typescript-mode prog-mode "TypeScript")
+  (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-mode)))
 
 (defun eglot--tests-connect (&optional timeout)
   (let* ((timeout (or timeout 10))
@@ -726,6 +733,62 @@ pyls prefers autopep over yafp, despite its README stating 
the contrary."
                                  (= severity 1))
                                diagnostics)))))))))
 
+(ert-deftest project-wide-diagnostics-typescript ()
+  "Test diagnostics through multiple files in a TypeScript LSP."
+  (skip-unless (executable-find "typescript-language-server"))
+  (eglot--with-fixture
+      '(("project" . (("hello.ts" . "const thing = 5;\nexport { thin }")
+                      ("hello2.ts" . "import { thing } from './hello'"))))
+    (eglot--make-file-or-dir '(".git"))
+    (let ((eglot-server-programs
+           '((typescript-mode . ("typescript-language-server" "--stdio")))))
+      ;; Check both files because typescript-language-server doesn't
+      ;; report all errors on startup, at least not with such a simple
+      ;; setup.
+      (with-current-buffer (eglot--find-file-noselect "project/hello2.ts")
+        (eglot--sniffing (:server-notifications s-notifs)
+          (eglot--tests-connect)
+          (flymake-start)
+          (eglot--wait-for (s-notifs 10)
+              (&key _id method &allow-other-keys)
+            (string= method "textDocument/publishDiagnostics"))
+          (should (= 2 (length (flymake--project-diagnostics)))))
+        (with-current-buffer (eglot--find-file-noselect "hello.ts")
+          (eglot--sniffing (:server-notifications s-notifs)
+            (flymake-start)
+            (eglot--wait-for (s-notifs 10)
+                (&key _id method &allow-other-keys)
+              (string= method "textDocument/publishDiagnostics"))
+            (should (= 4 (length (flymake--project-diagnostics))))))))))
+
+(ert-deftest project-wide-diagnostics-rust-analyzer ()
+  "Test diagnostics through multiple files in a TypeScript LSP."
+  (skip-unless (executable-find "rust-analyzer"))
+  (eglot--with-fixture
+      '(("project" .
+         (("main.rs" .
+           "fn main() -> () { let test=3; }")
+          ("other-file.rs" .
+           "fn foo() -> () { let hi=3; }"))))
+    (eglot--make-file-or-dir '(".git"))
+    (let ((eglot-server-programs '((rust-mode . ("rust-analyzer")))))
+      ;; Open other-file, and see diagnostics arrive for main.rs
+      (with-current-buffer (eglot--find-file-noselect "project/other-file.rs")
+        (should (zerop (shell-command "cargo init")))
+        (eglot--sniffing (:server-notifications s-notifs)
+          (eglot--tests-connect)
+          (flymake-start)
+          (eglot--wait-for (s-notifs 10)
+              (&key _id method &allow-other-keys)
+            (string= method "textDocument/publishDiagnostics"))
+          (let ((diags (flymake--project-diagnostics)))
+            (should (= 2 (length diags)))
+            ;; Check that we really get a diagnostic from main.rs, and
+            ;; not from other-file.rs
+            (should (string-suffix-p
+                     "main.rs"
+                     (flymake-diagnostic-buffer (car diags))))))))))
+
 (ert-deftest json-basic ()
   "Test basic autocompletion in vscode-json-languageserver."
   (skip-unless (executable-find "vscode-json-languageserver"))
diff --git a/eglot.el b/eglot.el
index 10e1616274..e27ddd7f94 100644
--- a/eglot.el
+++ b/eglot.el
@@ -7,7 +7,7 @@
 ;; Maintainer: João Távora <joaotavora@gmail.com>
 ;; URL: https://github.com/joaotavora/eglot
 ;; Keywords: convenience, languages
-;; Package-Requires: ((emacs "26.1") (jsonrpc "1.0.14") (flymake "1.0.9") 
(project "0.3.0") (xref "1.0.1") (eldoc "1.11.0"))
+;; Package-Requires: ((emacs "26.1") (jsonrpc "1.0.14") (flymake "1.2.1") 
(project "0.3.0") (xref "1.0.1") (eldoc "1.11.0"))
 
 ;; This file is part of GNU Emacs.
 
@@ -1825,49 +1825,66 @@ COMMAND is a symbol naming the command."
   (server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics
           &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
   "Handle notification publishDiagnostics."
-  (if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri))))
-      (with-current-buffer buffer
-        (cl-loop
-         for diag-spec across diagnostics
-         collect (eglot--dbind ((Diagnostic) range message severity source 
tags)
-                     diag-spec
-                   (setq message (concat source ": " message))
-                   (pcase-let
-                       ((sev severity)
-                        (`(,beg . ,end) (eglot--range-region range)))
-                     ;; Fallback to `flymake-diag-region' if server
-                     ;; botched the range
-                     (when (= beg end)
-                       (if-let* ((st (plist-get range :start))
-                                 (diag-region
-                                  (flymake-diag-region
-                                   (current-buffer) (1+ (plist-get st :line))
-                                   (plist-get st :character))))
-                           (setq beg (car diag-region) end (cdr diag-region))
-                         (eglot--widening
-                          (goto-char (point-min))
-                          (setq beg
-                                (point-at-bol
-                                 (1+ (plist-get (plist-get range :start) 
:line))))
-                          (setq end
-                                (point-at-eol
-                                 (1+ (plist-get (plist-get range :end) 
:line)))))))
-                     (eglot--make-diag (current-buffer) beg end
-                                       (cond ((null sev) 'eglot-error)
-                                            ((<= sev 1) 'eglot-error)
-                                             ((= sev 2)  'eglot-warning)
-                                             (t          'eglot-note))
-                                       message `((eglot-lsp-diag . ,diag-spec))
-                                       (and tags
-                                            `((face . ,(mapcar (lambda (tag)
-                                                                 (alist-get 
tag eglot--tag-faces))
-                                                               tags)))))))
-         into diags
-         finally (cond (eglot--current-flymake-report-fn
-                        (eglot--report-to-flymake diags))
-                       (t
-                        (setq eglot--unreported-diagnostics (cons t diags))))))
-    (jsonrpc--debug server "Diagnostics received for unvisited %s" uri)))
+  (cl-flet ((eglot--diag-type (sev)
+              (cond ((null sev) 'eglot-error)
+                    ((<= sev 1) 'eglot-error)
+                    ((= sev 2)  'eglot-warning)
+                    (t          'eglot-note))))
+    (if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri))))
+        (with-current-buffer buffer
+          (cl-loop
+           for diag-spec across diagnostics
+           collect (eglot--dbind ((Diagnostic) range message severity source 
tags)
+                       diag-spec
+                     (setq message (concat source ": " message))
+                     (pcase-let
+                         ((`(,beg . ,end) (eglot--range-region range)))
+                       ;; Fallback to `flymake-diag-region' if server
+                       ;; botched the range
+                       (when (= beg end)
+                         (if-let* ((st (plist-get range :start))
+                                   (diag-region
+                                    (flymake-diag-region
+                                     (current-buffer) (1+ (plist-get st :line))
+                                     (plist-get st :character))))
+                             (setq beg (car diag-region) end (cdr diag-region))
+                           (eglot--widening
+                            (goto-char (point-min))
+                            (setq beg
+                                  (point-at-bol
+                                   (1+ (plist-get (plist-get range :start) 
:line))))
+                            (setq end
+                                  (point-at-eol
+                                   (1+ (plist-get (plist-get range :end) 
:line)))))))
+                       (eglot--make-diag
+                        (current-buffer) beg end
+                        (eglot--diag-type severity)
+                        message `((eglot-lsp-diag . ,diag-spec))
+                        (and tags
+                             `((face
+                                . ,(mapcar (lambda (tag)
+                                             (alist-get tag eglot--tag-faces))
+                                           tags)))))))
+           into diags
+           finally (cond (eglot--current-flymake-report-fn
+                          (eglot--report-to-flymake diags))
+                         (t
+                          (setq eglot--unreported-diagnostics (cons t 
diags))))))
+      (cl-loop
+       with path = (expand-file-name (eglot--uri-to-path uri))
+       for diag-spec across diagnostics
+       collect (eglot--dbind ((Diagnostic) range message severity source) 
diag-spec
+                 (setq message (concat source ": " message))
+                 (let* ((start (plist-get range :start))
+                        (line (1+ (plist-get start :line)))
+                        (char (1+ (plist-get start :character))))
+                   (eglot--make-diag
+                    path (cons line char) nil (eglot--diag-type severity) 
message)))
+       into diags
+       finally
+       (setq flymake-list-only-diagnostics
+             (assoc-delete-all path flymake-list-only-diagnostics #'string=))
+       (push (cons path diags) flymake-list-only-diagnostics)))))
 
 (cl-defun eglot--register-unregister (server things how)
   "Helper for `registerCapability'.