[elpa] externals/eglot 7918fac 43/49: Close #637: Add TRAMP support

[Stefan Monnier]

branch: externals/eglot
commit 7918fac6be9d3545d0ed969a7248d51ceba14bea
Author: Brian Cully <bjc@kublai.com>
Commit: João Távora <joaotavora@gmail.com>

    Close #637: Add TRAMP support
    
    Also close #463, close #84.
    
    Thanks to Brian Cully for the original simple idea.  The basic
    technique is to pass :file-handler t to make-process, then tweak
    eglot--uri-to-path and eglot--path-to-uri, along with some other
    functions, to be aware of "trampy" paths".
    
    Crucially, a "stty hack" was needed.  It has been encapsulated in a
    new a new eglot--cmd helper, which contains a comment explaining the
    hack.
    
    Co-authored-by: João Távora <joaotavora@gmail.com>
    
    * eglot.el (eglot--executable-find): Shim two-arg executable-find
    function only available on Emacs 27.
    (eglot--guess-contact): Use eglot--executable-find.
    (eglot--cmd): New helper.
    (eglot--connect): Use eglot--cmd.  Use :file-handler arg to
    make-process.
    (eglot--connect, eglot--path-to-uri): Be aware of trampy file
    names.
    
    * eglot-tests.el (eglot-tests--auto-detect-running-server-1): New helper.
    (eglot--guessing-contact): Better mock for executable-find.
    (eglot--tramp-test): New test.
    
    * NEWS.md: mention TRAMP support.
    
    * README.md: mention TRAMP support.
---
 NEWS.md        | 10 ++++++++++
 README.md      |  7 +++++++
 eglot-tests.el | 57 ++++++++++++++++++++++++++++++++++++++-------------------
 eglot.el       | 57 +++++++++++++++++++++++++++++++++++++++++++++------------
 4 files changed, 100 insertions(+), 31 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 1b373bc..ced91b6 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,12 @@
 # (upcoming)
 
+##### TRAMP support ([#637][github#637], ([#463][github#463], 
([#84][github#84])
+
+Thanks to Brian Cully for the minimalist approach.
+
+(also thanks to Felipe Lema who conducted many early experiments in
+#463)
+
 ##### Code action shortcuts ([#411][github#411])
 
 `M-x eglot-code-actions` accepts an optional `action-kind` argument,
@@ -209,6 +216,7 @@ and now said bunch of references-->
 [github#81]: https://github.com/joaotavora/eglot/issues/81
 [github#82]: https://github.com/joaotavora/eglot/issues/82
 [github#83]: https://github.com/joaotavora/eglot/issues/83
+[github#84]: https://github.com/joaotavora/eglot/issues/84
 [github#86]: https://github.com/joaotavora/eglot/issues/86
 [github#87]: https://github.com/joaotavora/eglot/issues/87
 [github#93]: https://github.com/joaotavora/eglot/issues/93
@@ -248,5 +256,7 @@ and now said bunch of references-->
 [github#411]: https://github.com/joaotavora/eglot/issues/411
 [github#439]: https://github.com/joaotavora/eglot/issues/439
 [github#454]: https://github.com/joaotavora/eglot/issues/454
+[github#463]: https://github.com/joaotavora/eglot/issues/463
 [github#481]: https://github.com/joaotavora/eglot/issues/481
 [github#494]: https://github.com/joaotavora/eglot/issues/494
+[github#637]: https://github.com/joaotavora/eglot/issues/637
diff --git a/README.md b/README.md
index e9202cc..bb0225a 100644
--- a/README.md
+++ b/README.md
@@ -180,6 +180,13 @@ See `eglot.el`'s section on Java's JDT server for an even 
more
 sophisticated example.
 
 <a name="reporting bugs"></a>
+
+## TRAMP support
+
+Should just work.  Try `M-x eglot` in a buffer visiting a remote file
+on a server where you've also installed the language server.  Only
+supported on Emacs 27.1.
+
 # Reporting bugs
 
 Having trouble connecting to a server?  Expected to have a certain
diff --git a/eglot-tests.el b/eglot-tests.el
index f081afa..9f9b428 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -303,25 +303,28 @@ Pass TIMEOUT to `eglot--with-timeout'."
                  (cl-find (eglot--path-to-uri "project/sub2/") folders :test 
#'equal)
                  (= 3 (length folders)))))))))))
 
+(defun eglot-tests--auto-detect-running-server-1 ()
+  (let (server)
+    (eglot--with-fixture
+     `(("project" . (("coiso.py" . "bla")
+                     ("merdix.py" . "bla")))
+       ("anotherproject" . (("cena.py" . "bla"))))
+     (with-current-buffer
+         (eglot--find-file-noselect "project/coiso.py")
+       (should (setq server (eglot--tests-connect)))
+       (should (eglot-current-server)))
+     (with-current-buffer
+         (eglot--find-file-noselect "project/merdix.py")
+       (should (eglot-current-server))
+       (should (eq (eglot-current-server) server)))
+     (with-current-buffer
+         (eglot--find-file-noselect "anotherproject/cena.py")
+       (should-error (eglot--current-server-or-lose))))))
+
 (ert-deftest auto-detect-running-server ()
   "Visit a file and M-x eglot, then visit a neighbour. "
   (skip-unless (executable-find "pyls"))
-  (let (server)
-    (eglot--with-fixture
-        `(("project" . (("coiso.py" . "bla")
-                        ("merdix.py" . "bla")))
-          ("anotherproject" . (("cena.py" . "bla"))))
-      (with-current-buffer
-          (eglot--find-file-noselect "project/coiso.py")
-        (should (setq server (eglot--tests-connect)))
-        (should (eglot-current-server)))
-      (with-current-buffer
-          (eglot--find-file-noselect "project/merdix.py")
-        (should (eglot-current-server))
-        (should (eq (eglot-current-server) server)))
-      (with-current-buffer
-          (eglot--find-file-noselect "anotherproject/cena.py")
-        (should-error (eglot--current-server-or-lose))))))
+  (eglot-tests--auto-detect-running-server-1))
 
 (ert-deftest auto-shutdown ()
   "Visit a file and M-x eglot, then kill buffer. "
@@ -947,9 +950,9 @@ will assume it exists."
              (buffer-file-name "_")
              (,prompt-args-sym nil))
          (cl-letf (((symbol-function 'executable-find)
-                    (lambda (name) (unless (string-equal
-                                            name "a-missing-executable.exe")
-                                     (format "/totally-mock-bin/%s" name))))
+                    (lambda (name &optional _remote)
+                      (unless (string-equal name "a-missing-executable.exe")
+                        (format "/totally-mock-bin/%s" name))))
                    ((symbol-function 'read-shell-command)
                     (lambda (&rest args) (setq ,prompt-args-sym args) "")))
            (cl-destructuring-bind
@@ -1098,6 +1101,22 @@ will assume it exists."
   ;; (should (eglot--glob-match "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}" 
"prefix/foo.8"))
   )
 
+(ert-deftest eglot--tramp-test ()
+  "Ensure LSP servers can be used over TRAMP."
+  (skip-unless (or (>= emacs-major-version 27) (executable-find "pyls")))
+  ;; Set up a loopback TRAMP method that’s just a shell so the remote
+  ;; host is really just the local host.
+  (let ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path))
+       (tramp-methods '(("loopback"
+                          (tramp-login-program "/bin/sh")
+                          (tramp-remote-shell "/bin/sh")
+                          (tramp-remote-shell-login ("-l"))
+                          (tramp-remote-shell-args ("-c")))))
+        (temporary-file-directory (concat "/loopback::"
+                                          temporary-file-directory)))
+    ;; With ‘temporary-file-directory’ bound to the ‘loopback’ TRAMP
+    ;; method, fixtures will be automatically made “remote".
+    (eglot-tests--auto-detect-running-server-1)))
 
 (provide 'eglot-tests)
 ;;; eglot-tests.el ends here
diff --git a/eglot.el b/eglot.el
index 610e57b..e0896c8 100644
--- a/eglot.el
+++ b/eglot.el
@@ -244,6 +244,10 @@ let the buffer grow forever."
 
 (defconst eglot--{} (make-hash-table) "The empty JSON object.")
 
+(defun eglot--executable-find (command &optional remote)
+  "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26."
+  (if (>= emacs-major-version 27) (executable-find command remote)
+    (executable-find command)))
 
 
 ;;; Message verification helpers
@@ -753,7 +757,7 @@ be guessed."
                      ((null guess)
                       (format "[eglot] Sorry, couldn't guess for `%s'!\n%s"
                               managed-mode base-prompt))
-                     ((and program (not (executable-find program)))
+                     ((and program (not (eglot--executable-find program t)))
                       (concat (format "[eglot] I guess you want to run `%s'"
                                       program-guess)
                               (format ", but I can't find `%s' in PATH!" 
program)
@@ -878,6 +882,21 @@ received the initializing configuration.
 
 Each function is passed the server as an argument")
 
+(defun eglot--cmd (contact)
+  "Helper for `eglot--connect'."
+  (if (file-remote-p default-directory)
+      ;; TODO: this seems like a bug, although it’s everywhere. For
+      ;; some reason, for remote connections only, over a pipe, we
+      ;; need to turn off line buffering on the tty.
+      ;;
+      ;; Not only does this seem like there should be a better way,
+      ;; but it almost certainly doesn’t work on non-unix systems.
+      (list "sh" "-c"
+            (string-join (cons "stty raw > /dev/null;"
+                               (mapcar #'shell-quote-argument contact))
+             " "))
+    contact))
+
 (defun eglot--connect (managed-major-mode project class contact)
   "Connect to MANAGED-MAJOR-MODE, PROJECT, CLASS and CONTACT.
 This docstring appeases checkdoc, that's all."
@@ -908,12 +927,13 @@ This docstring appeases checkdoc, that's all."
                       (let ((default-directory default-directory))
                         (make-process
                          :name readable-name
-                         :command contact
+                         :command (eglot--cmd contact)
                          :connection-type 'pipe
                          :coding 'utf-8-emacs-unix
                          :noquery t
                          :stderr (get-buffer-create
-                                  (format "*%s stderr*" readable-name)))))))))
+                                  (format "*%s stderr*" readable-name))
+                         :file-handler t)))))))
          (spread (lambda (fn) (lambda (server method params)
                                 (apply fn server method (append params nil)))))
          (server
@@ -943,10 +963,15 @@ This docstring appeases checkdoc, that's all."
                      (jsonrpc-async-request
                       server
                       :initialize
-                      (list :processId (unless (eq (jsonrpc-process-type 
server)
-                                                   'network)
-                                         (emacs-pid))
-                            :rootPath (expand-file-name default-directory)
+                      (list :processId
+                            (unless (or (file-remote-p default-directory)
+                                        (eq (jsonrpc-process-type server)
+                                            'network))
+                              (emacs-pid))
+                            ;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py'
+                            ;; into `/path/to/baz.py', so LSP groks it.
+                            :rootPath (expand-file-name
+                                       (file-local-name default-directory))
                             :rootUri (eglot--path-to-uri default-directory)
                             :initializationOptions 
(eglot-initialization-options
                                                     server)
@@ -1169,15 +1194,23 @@ If optional MARKER, return a marker instead"
   "URIfy PATH."
   (url-hexify-string
    (concat "file://" (if (eq system-type 'windows-nt) "/")
-           (directory-file-name (file-truename path)))
+           ;; Again watch out for trampy paths.
+           (directory-file-name (file-local-name (file-truename path))))
    url-path-allowed-chars))
 
 (defun eglot--uri-to-path (uri)
-  "Convert URI to a file path."
+  "Convert URI to file path, helped by `eglot--current-server'."
   (when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
-  (let ((retval (url-filename (url-generic-parse-url (url-unhex-string uri)))))
-    (if (and (eq system-type 'windows-nt) (cl-plusp (length retval)))
-        (substring retval 1) retval)))
+  (let* ((retval (url-filename (url-generic-parse-url (url-unhex-string uri))))
+         (normalized (if (and (eq system-type 'windows-nt)
+                              (cl-plusp (length retval)))
+                         (substring retval 1)
+                       retval))
+         (server (eglot-current-server))
+         (remote-prefix (and server
+                             (file-remote-p
+                              (project-root (eglot--project server))))))
+    (concat remote-prefix normalized)))
 
 (defun eglot--snippet-expansion-fn ()
   "Compute a function to expand snippets.