[elpa] externals/eglot 8fda30c 67/69: Merge master into jsonrpc-refactor (using imerge)

[João Távora]

branch: externals/eglot
commit 8fda30c8e2d4e44dfb40e91109893277ca683d25
Merge: 61d1276 04ef055
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    Merge master into jsonrpc-refactor (using imerge)
---
 README.md      |  18 +++++--
 eglot-tests.el |  84 +++++++++++++++++++++++++--------
 eglot.el       | 145 +++++++++++++++++++++++++++++++++++++++------------------
 3 files changed, 179 insertions(+), 68 deletions(-)

diff --git a/README.md b/README.md
index 2ced833..a56d750 100644
--- a/README.md
+++ b/README.md
@@ -35,13 +35,22 @@ I'll add to this list as I test more servers. In the 
meantime you can
 customize `eglot-server-programs`:
 
 ```lisp
-(add-to-list 'eglot-server-programs '(fancy-mode . ("fancy-language-server" 
"--args"")))
+(add-to-list 'eglot-server-programs '(foo-mode . ("foo-language-server" 
"--args"")))
 ```
 
 Let me know how well it works and we can add it to the list.  You can
 also enter a `server:port` pattern to connect to an LSP server. To
 skip the guess and always be prompted use `C-u M-x eglot`.
 
+You can also do:
+
+```lisp
+  (add-hook 'foo-mode-hook 'eglot-ensure)
+```
+
+To attempt to start an eglot session automatically everytime a
+`foo-mode` buffer is visited.
+
 # Commands and keybindings
 
 Here's a summary of available commands:
@@ -52,7 +61,10 @@ Here's a summary of available commands:
 
 - `M-x eglot-shutdown` says bye-bye to the server;
 
-- `M-x eglot-rename` asks the server to rename the symbol at point;
+- `M-x eglot-rename` ask the server to rename the symbol at point;
+
+- `M-x eglot-format-buffer` ask the server to reformat the current
+  buffer.
 
 - `M-x eglot-code-actions` asks the server for any code actions at
   point. These may tipically be simple fixes, like deleting an unused
@@ -155,7 +167,7 @@ eglot-shutdown`.
 - [ ] documentLink/resolve
 - [ ] textDocument/documentColor
 - [ ] textDocument/colorPresentation (3.6.0)
-- [ ] textDocument/formatting 
+- [x] textDocument/formatting 
 - [ ] textDocument/rangeFormatting
 - [ ] textDocument/onTypeFormatting
 - [x] textDocument/rename
diff --git a/eglot-tests.el b/eglot-tests.el
index b57b949..048b1d3 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -158,6 +158,12 @@ Pass TIMEOUT to `eglot--with-timeout'."
                                        (format "waiting for:\n%s" 
(pp-to-string body))))
      (let ((event
             (cl-loop thereis (cl-loop for json in ,events-sym
+                                      for method = (plist-get json :method)
+                                      when (keywordp method)
+                                      do (plist-put json :method
+                                                    (substring
+                                                     (symbol-name method)
+                                                     1))
                                       when (funcall
                                             (jsonrpc-lambda ,args ,@body) json)
                                       return (cons json before)
@@ -252,7 +258,7 @@ Pass TIMEOUT to `eglot--with-timeout'."
               (eglot--wait-for (s-requests 1)
                   (&key id method &allow-other-keys)
                 (setq register-id id)
-                (string= method 'client/registerCapability))
+                (string= method "client/registerCapability"))
               (eglot--wait-for (c-replies 1)
                   (&key id error &allow-other-keys)
                 (and (eq id register-id) (null error))))
@@ -260,7 +266,7 @@ Pass TIMEOUT to `eglot--with-timeout'."
             (eglot--wait-for
                 (c-notifs 3 "waiting for didChangeWatchedFiles notification")
                 (&key method params &allow-other-keys)
-              (and (string= method 'workspace/didChangeWatchedFiles)
+              (and (string= method "workspace/didChangeWatchedFiles")
                    (cl-destructuring-bind (&key uri type)
                        (elt (plist-get params :changes) 0)
                      (and (string= (eglot--path-to-uri "Cargo.toml") uri)
@@ -280,7 +286,7 @@ Pass TIMEOUT to `eglot--with-timeout'."
           (eglot--tests-connect)
           (eglot--wait-for (s-notifs 1)
               (&key _id method &allow-other-keys)
-            (string= method 'textDocument/publishDiagnostics))
+            (string= method "textDocument/publishDiagnostics"))
           (flymake-start)
           (goto-char (point-min))
           (flymake-goto-next-error 1 '() t)
@@ -300,11 +306,7 @@ Pass TIMEOUT to `eglot--with-timeout'."
           (eglot--find-file-noselect "hover-project/main.rs")
         (should (zerop (shell-command "cargo init")))
         (eglot--sniffing (
-                          :server-notifications s-notifs
-                          :server-requests s-requests
                           :server-replies s-replies
-                          :client-notifications c-notifs
-                          :client-replies c-replies
                           :client-requests c-reqs
                           )
           (eglot--tests-connect)
@@ -320,7 +322,7 @@ Pass TIMEOUT to `eglot--with-timeout'."
             (eglot--wait-for (c-reqs)
                 (&key id method &allow-other-keys)
               (setq pending-id id)
-              (string= method 'textDocument/documentHighlight))
+              (string= method "textDocument/documentHighlight"))
             (eglot--wait-for (s-replies)
                 (&key id &allow-other-keys)
               (eq id pending-id))))))))
@@ -337,18 +339,10 @@ Pass TIMEOUT to `eglot--with-timeout'."
       (with-current-buffer
           (eglot--find-file-noselect "rename-project/main.rs")
         (should (zerop (shell-command "cargo init")))
-        (eglot--sniffing (
-                          :server-notifications s-notifs
-                          :server-requests s-requests
-                          :server-replies s-replies
-                          :client-notifications c-notifs
-                          :client-replies c-replies
-                          :client-requests c-reqs
-                          )
-          (eglot--tests-connect)
-          (goto-char (point-min)) (search-forward "return te")
-          (eglot-rename "bla")
-          (should (equal (buffer-string) "fn test() -> i32 { let bla=3; return 
bla; }")))))))
+        (eglot--tests-connect)
+        (goto-char (point-min)) (search-forward "return te")
+        (eglot-rename "bla")
+        (should (equal (buffer-string) "fn test() -> i32 { let bla=3; return 
bla; }"))))))
 
 (ert-deftest basic-completions ()
   "Test basic autocompletion in a python LSP"
@@ -379,6 +373,56 @@ Pass TIMEOUT to `eglot--with-timeout'."
         (while (not eldoc-last-message) (accept-process-output nil 0.1))
         (should (string-match "^exit" eldoc-last-message))))))
 
+(ert-deftest formatting ()
+  "Test document formatting in a python LSP"
+  (skip-unless (and (executable-find "pyls")
+                    (or (executable-find "yapf")
+                        (executable-find "autopep8"))))
+  (eglot--with-dirs-and-files
+      '(("project" . (("something.py" . "def foo():pass"))))
+    (eglot--with-timeout 4
+      (with-current-buffer
+          (eglot--find-file-noselect "project/something.py")
+        (should (eglot--tests-connect))
+        (search-forward ":pa")
+        (eglot-format-buffer)
+        (should (looking-at "ss"))
+        (should (or
+                 ;; yapf
+                 (string= (buffer-string) "def foo():\n    pass\n")
+                 ;; autopep8
+                 (string= (buffer-string) "def foo(): pass\n")))))))
+
+(ert-deftest javascript-basic ()
+  "Test basic autocompletion in a python LSP"
+  (skip-unless (executable-find "~/.yarn/bin/javascript-typescript-stdio"))
+  (eglot--with-dirs-and-files
+      '(("project" . (("hello.js" . "console.log('Hello world!');"))))
+    (eglot--with-timeout 4
+      (with-current-buffer
+          (eglot--find-file-noselect "project/hello.js")
+        (let ((eglot-server-programs
+               '((js-mode . ("~/.yarn/bin/javascript-typescript-stdio")))))
+          (goto-char (point-max))
+          (eglot--sniffing (:server-notifications
+                            s-notifs
+                            :client-notifications
+                            c-notifs)
+            (should (eglot--tests-connect))
+            (eglot--wait-for (s-notifs 1) (&key method &allow-other-keys)
+              (string= method "textDocument/publishDiagnostics"))
+            (should (not (eq 'flymake-error (face-at-point))))
+            (insert "{")
+            (eglot--signal-textDocument/didChange)
+            (eglot--wait-for (c-notifs 1) (&key method &allow-other-keys)
+              (string= method "textDocument/didChange"))
+            (eglot--wait-for (s-notifs 1) (&key params method 
&allow-other-keys)
+              (and (string= method "textDocument/publishDiagnostics")
+                   (cl-destructuring-bind (&key _uri diagnostics) params
+                     (cl-find-if (jsonrpc-lambda (&key severity 
&allow-other-keys)
+                                   (= severity 1))
+                                 diagnostics))))))))))
+
 (provide 'eglot-tests)
 ;;; eglot-tests.el ends here
 
diff --git a/eglot.el b/eglot.el
index 0a060a5..290e80b 100644
--- a/eglot.el
+++ b/eglot.el
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2018 Free Software Foundation, Inc.
 
-;; Version: 0.8
+;; Version: 0.10
 ;; Author: João Távora <address@hidden>
 ;; Maintainer: João Távora <address@hidden>
 ;; URL: https://github.com/joaotavora/eglot
@@ -79,15 +79,19 @@
 
 (defvar eglot-server-programs '((rust-mode . (eglot-rls "rls"))
                                 (python-mode . ("pyls"))
-                                (js-mode . ("javascript-typescript-stdio"))
+                                ((js-mode
+                                  js2-mode
+                                  rjsx-mode) . ("javascript-typescript-stdio"))
                                 (sh-mode . ("bash-language-server" "start"))
-                                (c++-mode . (eglot-cquery "cquery"))
-                                (c-mode . (eglot-cquery "cquery"))
+                                ((c++-mode
+                                  c-mode) . (eglot-cquery "cquery"))
                                 (php-mode . ("php" "vendor/felixfbecker/\
 language-server/bin/php-language-server.php")))
   "How the command `eglot' guesses the server to start.
-An association list of (MAJOR-MODE . CONTACT) pair.  MAJOR-MODE
-is a mode symbol.  CONTACT is:
+An association list of (MAJOR-MODE . CONTACT) pairs.  MAJOR-MODE
+is a mode symbol, or a list of mode symbols.  The associated
+CONTACT specifies how to start a server for managing buffers of
+those modes.  CONTACT can be:
 
 * In the most common case, a list of strings (PROGRAM [ARGS...]).
 PROGRAM is called with ARGS and is expected to serve LSP requests
@@ -151,7 +155,6 @@ lasted more than that many seconds."
             :workspace (list
                         :applyEdit t
                         :executeCommand `(:dynamicRegistration :json-false)
-                        :codeAction `(:dynamicRegistration :json-false)
                         :workspaceEdit `(:documentChanges :json-false)
                         :didChangeWatchesFiles `(:dynamicRegistration t)
                         :symbol `(:dynamicRegistration :json-false))
@@ -167,6 +170,8 @@ lasted more than that many seconds."
              :definition         `(:dynamicRegistration :json-false)
              :documentSymbol     `(:dynamicRegistration :json-false)
              :documentHighlight  `(:dynamicRegistration :json-false)
+             :codeAction         `(:dynamicRegistration :json-false)
+             :formatting         `(:dynamicRegistration :json-false)
              :rename             `(:dynamicRegistration :json-false)
              :publishDiagnostics `(:relatedInformation :json-false))
             :experimental (list))))
@@ -210,16 +215,16 @@ lasted more than that many seconds."
 (defvar eglot--servers-by-project (make-hash-table :test #'equal)
   "Keys are projects.  Values are lists of processes.")
 
-(defun eglot-shutdown (server &optional _interactive)
+(defun eglot-shutdown (server &optional _interactive timeout)
   "Politely ask SERVER to quit.
-Forcefully quit it if it doesn't respond.  Don't leave this
-function with the server still running."
+Forcefully quit it if it doesn't respond within TIMEOUT seconds.
+Don't leave this function with the server still running."
   (interactive (list (eglot--current-server-or-lose) t))
   (eglot--message "Asking %s politely to terminate" (jsonrpc-name server))
   (unwind-protect
       (progn
         (setf (eglot--shutdown-requested server) t)
-        (jsonrpc-request server :shutdown nil :timeout 3)
+        (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5))
         ;; this one is supposed to always fail, because it asks the
         ;; server to exit itself. Hence ignore-errors.
         (ignore-errors (jsonrpc-request server :exit nil :timeout 1)))
@@ -264,24 +269,31 @@ function with the server still running."
 
 (defun eglot--guess-contact (&optional interactive)
   "Helper for `eglot'.
-Return (MANAGED-MODE PROJECT CONTACT CLASS).
-If INTERACTIVE, maybe prompt user."
+Return (MANAGED-MODE PROJECT CLASS CONTACT).  If INTERACTIVE is
+non-nil, maybe prompt user, else error as soon as something can't
+be guessed."
   (let* ((guessed-mode (if buffer-file-name major-mode))
          (managed-mode
           (cond
-           ((or (>= (prefix-numeric-value current-prefix-arg) 16)
-                (not guessed-mode))
+           ((and interactive
+                 (or (>= (prefix-numeric-value current-prefix-arg) 16)
+                     (not guessed-mode)))
             (intern
              (completing-read
               "[eglot] Start a server to manage buffers of what major mode? "
               (mapcar #'symbol-name (eglot--all-major-modes)) nil t
               (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
+           ((not guessed-mode)
+            (eglot--error "Can't guess mode to manage for `%s'" 
(current-buffer)))
            (t guessed-mode)))
          (project (or (project-current) `(transient . ,default-directory)))
-         (guess (cdr (assoc managed-mode eglot-server-programs)))
-         (class (if (and (consp guess) (symbolp (car guess)))
-                    (prog1 (car guess) (setq guess (cdr guess)))
-                  'eglot-lsp-server))
+         (guess (cdr (assoc managed-mode eglot-server-programs
+                            (lambda (m1 m2)
+                              (or (eq m1 m2)
+                                  (and (listp m1) (memq m2 m1)))))))
+         (class (or (and (consp guess) (symbolp (car guess))
+                         (prog1 (car guess) (setq guess (cdr guess))))
+                    'eglot-lsp-server))
          (program (and (listp guess) (stringp (car guess)) (car guess)))
          (base-prompt
           (and interactive
@@ -298,16 +310,18 @@ If INTERACTIVE, maybe prompt user."
                               (format ", but I can't find `%s' in PATH!" 
program)
                               "\n" base-prompt)))))
          (contact
-          (if prompt
-              (let ((s (read-shell-command
-                        prompt
-                        (if program (combine-and-quote-strings guess))
-                        'eglot-command-history)))
-                (if (string-match "^\\([^\s\t]+\\):\\([[:digit:]]+\\)$"
-                                  (string-trim s))
-                    (list (match-string 1 s) (string-to-number (match-string 2 
s)))
-                  (split-string-and-unquote s)))
-            guess)))
+          (or (and prompt
+                   (let ((s (read-shell-command
+                             prompt
+                             (if program (combine-and-quote-strings guess))
+                             'eglot-command-history)))
+                     (if (string-match "^\\([^\s\t]+\\):\\([[:digit:]]+\\)$"
+                                       (string-trim s))
+                         (list (match-string 1 s)
+                               (string-to-number (match-string 2 s)))
+                       (split-string-and-unquote s))))
+              guess
+              (eglot--error "Couldn't guess for `%s'!" managed-mode))))
     (list managed-mode project class contact)))
 
 ;;;###autoload
@@ -389,7 +403,8 @@ INTERACTIVE is t if called interactively."
                  (eglot--project-nickname server)
                  major-mode
                  (eglot--project-nickname server)))))))
-      (add-hook 'post-command-hook #'maybe-connect 'append nil))))
+      (when buffer-file-name
+        (add-hook 'post-command-hook #'maybe-connect 'append nil)))))
 
 (defun eglot-events-buffer (server)
   "Display events buffer for SERVER."
@@ -537,7 +552,7 @@ If optional MARKER, return a marker instead"
   "Format MARKUP according to LSP's spec."
   (pcase-let ((`(,string ,mode)
                (if (stringp markup) (list (string-trim markup)
-                                          (intern "markdown-mode"))
+                                          (intern "gfm-mode"))
                  (list (plist-get markup :value)
                        (intern (concat (plist-get markup :language) "-mode" 
))))))
     (with-temp-buffer
@@ -561,8 +576,8 @@ under cursor."
              for feat in feats
              for probe = (plist-member caps feat)
              if (not probe) do (cl-return nil)
-             if (eq (cadr probe) t) do (cl-return t)
              if (eq (cadr probe) :json-false) do (cl-return nil)
+             if (not (listp (cadr probe))) do (cl-return (cadr probe))
              finally (cl-return (or probe t)))))
 
 (defun eglot--range-region (range &optional markers)
@@ -571,10 +586,7 @@ If optional MARKERS, make markers."
   (let* ((st (plist-get range :start))
          (beg (eglot--lsp-position-to-point st markers))
          (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
-    ;; Fallback to `flymake-diag-region' if server botched the range
-    (if (/= beg end) (cons beg end) (flymake-diag-region
-                                     (current-buffer) (plist-get st :line)
-                                     (1- (plist-get st :character))))))
+    (cons beg end)))
 
 
 ;;; Minor modes
@@ -788,7 +800,18 @@ Uses THING, FACE, DEFS and PREPEND."
                                               _code source message)
                      diag-spec
                    (setq message (concat source ": " message))
-                   (pcase-let ((`(,beg . ,end) (eglot--range-region range)))
+                   (pcase-let
+                       ((`(,beg . ,end) (eglot--range-region range)))
+                     ;; Fallback to `flymake-diag-region' if server
+                     ;; botched the range
+                     (if (= beg end)
+                         (let* ((st (plist-get range :start))
+                                (diag-region
+                                 (flymake-diag-region
+                                  (current-buffer) (plist-get st :line)
+                                  (1- (plist-get st :character)))))
+                           (setq beg (car diag-region)
+                                 end (cdr diag-region))))
                      (eglot--make-diag (current-buffer) beg end
                                        (cond ((<= sev 1) 'eglot-error)
                                              ((= sev 2)  'eglot-warning)
@@ -1065,6 +1088,21 @@ DUMMY is ignored."
                       :workspace/symbol
                       `(:query ,pattern)))))
 
+(defun eglot-format-buffer ()
+  "Format contents of current buffer."
+  (interactive)
+  (unless (eglot--server-capable :documentFormattingProvider)
+    (eglot--error "Server can't format!"))
+  (eglot--apply-text-edits
+   (jsonrpc-request
+    (eglot--current-server-or-lose)
+    :textDocument/formatting
+    (list :textDocument (eglot--TextDocumentIdentifier)
+          :options (list :tabSize tab-width
+                         :insertSpaces
+                         (if indent-tabs-mode :json-false t)))
+    :deferred :textDocument/formatting)))
+
 (defun eglot-completion-at-point ()
   "EGLOT's `completion-at-point' function."
   (let ((bounds (bounds-of-thing-at-point 'symbol))
@@ -1239,15 +1277,32 @@ If SKIP-SIGNATURE, don't try to send 
textDocument/signatureHelp."
 (defun eglot--apply-text-edits (edits &optional version)
   "Apply EDITS for current buffer if at VERSION, or if it's nil."
   (unless (or (not version) (equal version eglot--versioned-identifier))
-    (jsonrpc-error "Edits on `%s' require version %d, we have %d"
+    (jsonrpc-error "Edits on `%s' require version %d, you have %d"
                    (current-buffer) version eglot--versioned-identifier))
-  (eglot--widening
-   (mapc (pcase-lambda (`(,newText ,beg . ,end))
-           (goto-char beg) (delete-region beg end) (insert newText))
-         (mapcar (jsonrpc-lambda (&key range newText)
-                   (cons newText (eglot--range-region range 'markers)))
-                 edits)))
-  (eglot--message "%s: Performed %s edits" (current-buffer) (length edits)))
+  (atomic-change-group
+    (let* ((change-group (prepare-change-group))
+           (howmany (length edits))
+           (reporter (make-progress-reporter
+                      (format "[eglot] applying %s edits to `%s'..."
+                              howmany (current-buffer))
+                      0 howmany))
+           (done 0))
+      (mapc (pcase-lambda (`(,newText ,beg . ,end))
+              (let ((source (current-buffer)))
+                (with-temp-buffer
+                  (insert newText)
+                  (let ((temp (current-buffer)))
+                    (with-current-buffer source
+                      (save-excursion
+                        (save-restriction
+                          (narrow-to-region beg end)
+                          (replace-buffer-contents temp)))
+                      (progress-reporter-update reporter (cl-incf done)))))))
+            (mapcar (jsonrpc-lambda (&key range newText)
+                      (cons newText (eglot--range-region range 'markers)))
+                    edits))
+      (undo-amalgamate-change-group change-group)
+      (progress-reporter-done reporter))))
 
 (defun eglot--apply-workspace-edit (wedit &optional confirm)
   "Apply the workspace edit WEDIT.  If CONFIRM, ask user first."