[elpa] externals/eglot 6f27bc1 06/10: Allow LSP languageId to be overridden via eglot-server-programs

[Stefan Monnier]

branch: externals/eglot
commit 6f27bc18ebfb9449d3254f852e84c1cf139f3a85
Author: Steve Purcell <steve@sanityinc.com>
Commit: GitHub <noreply@github.com>

    Allow LSP languageId to be overridden via eglot-server-programs
    
    Close #678. Per #677
    
    * eglot-tests.el (eglot--guessing-contact): Add
    GUESSED-LANG-ID-SYM param.
    (eglot-server-programs-guess-lang): New test.
    
    * eglot.el (eglot-server-programs): Augment entries for caml-mode
    and tuareg-mode. Enhance docstring.
    (eglot--lookup-mode): New helper.
    (eglot--guess-contact): Call eglot--lookup-mode.
    (eglot, eglot-reconnect): Pass language-id to eglot--connect
    (eglot--connect): Receive LANGUAGE-ID
    (eglot--TextDocumentItem): Simplify.  Use
    `eglot--current-server-or-lose'
    
    * README.md (Handling quirky servers): Mention new feature.
    
    Co-authored-by: João Távora <joaotavora@gmail.com>
---
 README.md      |  7 +++++
 eglot-tests.el | 28 +++++++++++++++-----
 eglot.el       | 80 +++++++++++++++++++++++++++++++++++++++++++---------------
 3 files changed, 88 insertions(+), 27 deletions(-)

diff --git a/README.md b/README.md
index 2927ab8..0ad6d46 100644
--- a/README.md
+++ b/README.md
@@ -180,6 +180,13 @@ get [cquery][cquery] working:
 See `eglot.el`'s section on Java's JDT server for an even more
 sophisticated example.
 
+Similarly, some servers require the language identifier strings they
+are sent by `eglot` to match the exact strings used by VSCode. `eglot`
+usually guesses these identifiers from the major mode name
+(e.g. `elm-mode` → `"elm"`), but the mapping can be overridden using
+the `:LANGUAGE-ID` element in the syntax of `eglot-server-programs` if
+necessary.
+
 <a name="reporting bugs"></a>
 
 ## TRAMP support
diff --git a/eglot-tests.el b/eglot-tests.el
index 6e9ceeb..1309f87 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -935,7 +935,8 @@ pyls prefers autopep over yafp, despite its README stating 
the contrary."
 
 (cl-defmacro eglot--guessing-contact ((interactive-sym
                                        prompt-args-sym
-                                       guessed-class-sym guessed-contact-sym)
+                                       guessed-class-sym guessed-contact-sym
+                                       &optional guessed-lang-id-sym)
                                       &body body)
   "Evaluate BODY twice, binding results of `eglot--guess-contact'.
 
@@ -943,10 +944,10 @@ INTERACTIVE-SYM is bound to the boolean passed to
 `eglot--guess-contact' each time. If the user would have been
 prompted, PROMPT-ARGS-SYM is bound to the list of arguments that
 would have been passed to `read-shell-command', else nil.
-GUESSED-CLASS-SYM and GUESSED-CONTACT-SYM are bound to the useful
-return values of `eglot--guess-contact'. Unless the server
-program evaluates to \"a-missing-executable.exe\", this macro
-will assume it exists."
+GUESSED-CLASS-SYM, GUESSED-CONTACT-SYM and GUESSED-LANG-ID-SYM
+are bound to the useful return values of
+`eglot--guess-contact'. Unless the server program evaluates to
+\"a-missing-executable.exe\", this macro will assume it exists."
   (declare (indent 1) (debug t))
   (let ((i-sym (cl-gensym)))
     `(dolist (,i-sym '(nil t))
@@ -960,7 +961,8 @@ will assume it exists."
                    ((symbol-function 'read-shell-command)
                     (lambda (&rest args) (setq ,prompt-args-sym args) "")))
            (cl-destructuring-bind
-               (_ _ ,guessed-class-sym ,guessed-contact-sym)
+               (_ _ ,guessed-class-sym ,guessed-contact-sym
+                  ,(or guessed-lang-id-sym '_))
                (eglot--guess-contact ,i-sym)
              ,@body))))))
 
@@ -1051,6 +1053,20 @@ will assume it exists."
       (should (equal guessed-class 'eglot-lsp-server))
       (should (equal guessed-contact '("some-executable"))))))
 
+(ert-deftest eglot-server-programs-guess-lang ()
+  (let ((major-mode 'foo-mode))
+    (let ((eglot-server-programs '((foo-mode . ("prog-executable")))))
+      (eglot--guessing-contact (_ _ _ _ guessed-lang)
+        (should (equal guessed-lang "foo"))))
+    (let ((eglot-server-programs '(((foo-mode :language-id "bar")
+                                    . ("prog-executable")))))
+      (eglot--guessing-contact (_ _ _ _ guessed-lang)
+        (should (equal guessed-lang "bar"))))
+    (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar"))
+                                    . ("prog-executable")))))
+      (eglot--guessing-contact (_ _ _ _ guessed-lang)
+        (should (equal guessed-lang "bar"))))))
+
 (defun eglot--glob-match (glob str)
   (funcall (eglot--glob-compile glob t t) str))
 
diff --git a/eglot.el b/eglot.el
index 122a76b..b191763 100644
--- a/eglot.el
+++ b/eglot.el
@@ -104,7 +104,8 @@
                                  . ("php" "vendor/felixfbecker/\
 language-server/bin/php-language-server.php"))
                                 ((c++-mode c-mode) . ("ccls"))
-                                ((caml-mode tuareg-mode reason-mode)
+                                (((caml-mode :language-id "ocaml")
+                                  (tuareg-mode :language-id "ocaml") 
reason-mode)
                                  . ("ocamllsp"))
                                 (ruby-mode
                                  . ("solargraph" "socket" "--port" :autoport))
@@ -129,9 +130,23 @@ language-server/bin/php-language-server.php"))
                                 (zig-mode . ("zls")))
   "How the command `eglot' guesses the server to start.
 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 connect to a server for managing buffers
-of those modes.  CONTACT can be:
+identifies the buffers that are to be managed by a specific
+language server.  The associated CONTACT specifies how to connect
+to a server for those buffers.
+
+MAJOR-MODE can be:
+
+* In the most common case, a symbol such as `c-mode';
+
+* A list (MAJOR-MODE-SYMBOL :LANGUAGE-ID ID) where
+  MAJOR-MODE-SYMBOL is the aforementioned symbol and ID is a
+  string identifying the language to the server;
+
+* A list combining the previous two alternatives, meaning
+  multiple major modes will be associated with a single server
+  program.
+
+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
@@ -612,6 +627,9 @@ treated as in `eglot-dbind'."
    (major-mode
     :documentation "Major mode symbol."
     :accessor eglot--major-mode)
+   (language-id
+    :documentation "Language ID string for the mode."
+    :accessor eglot--language-id)
    (capabilities
     :documentation "JSON object containing server capabilities."
     :accessor eglot--capabilities)
@@ -720,9 +738,29 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
 (defvar eglot--command-history nil
   "History of CONTACT arguments to `eglot'.")
 
+(defun eglot--lookup-mode (mode)
+  "Lookup `eglot-server-programs' for MODE.
+Return (LANGUAGE-ID . CONTACT-PROXY).  If not specified,
+LANGUAGE-ID is determined from MODE."
+  (cl-loop
+   for (modes . contact) in eglot-server-programs
+   thereis (cl-some
+            (lambda (spec)
+              (cl-destructuring-bind (probe &key language-id &allow-other-keys)
+                  (if (consp spec) spec (list spec))
+                (and (provided-mode-derived-p mode probe)
+                     (cons
+                      (or language-id
+                          (or (get mode 'eglot-language-id)
+                              (get spec 'eglot-language-id)
+                              (string-remove-suffix "-mode" (symbol-name 
mode))))
+                      contact))))
+            (if (or (symbolp modes) (keywordp (cadr modes)))
+                (list modes) modes))))
+
 (defun eglot--guess-contact (&optional interactive)
   "Helper for `eglot'.
-Return (MANAGED-MODE PROJECT CLASS CONTACT).  If INTERACTIVE is
+Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID).  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))
@@ -740,11 +778,9 @@ be guessed."
             (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
-                            (lambda (m1 m2)
-                              (cl-find
-                               m2 (if (listp m1) m1 (list m1))
-                               :test #'provided-mode-derived-p)))))
+         (lang-id-and-guess (eglot--lookup-mode guessed-mode))
+         (language-id (car lang-id-and-guess))
+         (guess (cdr lang-id-and-guess))
          (guess (if (functionp guess)
                     (funcall guess interactive)
                   guess))
@@ -791,10 +827,11 @@ be guessed."
                         :test #'equal))))
               guess
               (eglot--error "Couldn't guess for `%s'!" managed-mode))))
-    (list managed-mode project class contact)))
+    (list managed-mode project class contact language-id)))
 
 ;;;###autoload
-(defun eglot (managed-major-mode project class contact &optional interactive)
+(defun eglot (managed-major-mode project class contact language-id
+                                 &optional interactive)
   "Manage a project with a Language Server Protocol (LSP) server.
 
 The LSP server of CLASS is started (or contacted) via CONTACT.
@@ -821,6 +858,9 @@ CONTACT specifies how to contact the server.  It is a
 keyword-value plist used to initialize CLASS or a plain list as
 described in `eglot-server-programs', which see.
 
+LANGUAGE-ID is the language ID string to send to the server for
+MANAGED-MAJOR-MODE, which matters to a minority of servers.
+
 INTERACTIVE is t if called interactively."
   (interactive (append (eglot--guess-contact t) '(t)))
   (let* ((current-server (eglot-current-server))
@@ -830,7 +870,7 @@ INTERACTIVE is t if called interactively."
              (y-or-n-p "[eglot] Live process found, reconnect instead? "))
         (eglot-reconnect current-server interactive)
       (when live-p (ignore-errors (eglot-shutdown current-server)))
-      (eglot--connect managed-major-mode project class contact))))
+      (eglot--connect managed-major-mode project class contact language-id))))
 
 (defun eglot-reconnect (server &optional interactive)
   "Reconnect to SERVER.
@@ -841,7 +881,8 @@ INTERACTIVE is t if called interactively."
   (eglot--connect (eglot--major-mode server)
                   (eglot--project server)
                   (eieio-object-class-name server)
-                  (eglot--saved-initargs server))
+                  (eglot--saved-initargs server)
+                  (eglot--language-id server))
   (eglot--message "Reconnected!"))
 
 (defvar eglot--managed-mode) ; forward decl
@@ -914,8 +955,8 @@ Each function is passed the server as an argument")
 (defvar-local eglot--cached-server nil
   "A cached reference to the current EGLOT server.")
 
-(defun eglot--connect (managed-major-mode project class contact)
-  "Connect to MANAGED-MAJOR-MODE, PROJECT, CLASS and CONTACT.
+(defun eglot--connect (managed-major-mode project class contact language-id)
+  "Connect to MANAGED-MAJOR-MODE, LANGUAGE-ID, PROJECT, CLASS and CONTACT.
 This docstring appeases checkdoc, that's all."
   (let* ((default-directory (project-root project))
          (nickname (file-name-base (directory-file-name default-directory)))
@@ -969,6 +1010,7 @@ This docstring appeases checkdoc, that's all."
     (setf (eglot--project server) project)
     (setf (eglot--project-nickname server) nickname)
     (setf (eglot--major-mode server) managed-major-mode)
+    (setf (eglot--language-id server) language-id)
     (setf (eglot--inferior-process server) autostart-inferior-process)
     (run-hook-with-args 'eglot-server-initialized-hook server)
     ;; Now start the handshake.  To honour `eglot-sync-connect'
@@ -1737,11 +1779,7 @@ THINGS are either registrations or unregisterations 
(sic)."
   (append
    (eglot--VersionedTextDocumentIdentifier)
    (list :languageId
-        (cond
-           ((get major-mode 'eglot-language-id))
-           ((string-match "\\(.*\\)-mode" (symbol-name major-mode))
-            (match-string 1 (symbol-name major-mode)))
-           (t "unknown"))
+        (eglot--language-id (eglot--current-server-or-lose))
          :text
          (eglot--widening
           (buffer-substring-no-properties (point-min) (point-max))))))