master a74403adda0 2/3: Eglot: fix LSP "languageId" detection

[João Távora]

branch: master
commit a74403adda0d67b6f0430d1c038a7c96579f3450
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Eglot: fix LSP "languageId" detection
    
    This sweeping fix has been planned for a while, but a user recently
    hit this bug as described in
    https://github.com/joaotavora/eglot/discussions/1206.
    
    More and more servers today are "multi-language", meaning can handle
    more than one file type.  This relies on the ':languageId' string
    being set to the correct value for every buffer managed by Eglot
    (TextDocumentItem in LSP parlance).
    
    Previously this string was calculated based on an imperfect heuristic
    and was wrong quite often.  Many servers don't even care but some
    others do, so we have to fix it.
    
    * lisp/progmodes/eglot.el (eglot-lsp-server): Remove slots
    'major-modes' and 'language-id'.  Add slot 'languages'.
    (eglot--major-modes, eglot--language-ids): New helpers.
    (eglot--lookup-mode): Simplify or maybe complicate.
    (eglot--guess-contact): Use new eglot--looup-mode.  Change return
    value.
    (eglot): Rework docstring.
    (eglot-reconnect): Use eglot--language-ids, not id.
    (eglot--connect): Setup eglot--languages slot in server.
    (eglot--TextDocumentItem): Finally, get correct language id.
    
    * test/lisp/progmodes/eglot-tests.el (eglot--guessing-contact):
    Enhance macro.
    (eglot-test-server-programs-guess-lang): Update test.
---
 lisp/progmodes/eglot.el            | 129 +++++++++++++++++++------------------
 test/lisp/progmodes/eglot-tests.el |  29 +++++----
 2 files changed, 84 insertions(+), 74 deletions(-)

diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 3f00281e155..c4f773c8426 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -844,12 +844,9 @@ treated as in `eglot--dbind'."
     :documentation "Short nickname for the associated project."
     :accessor eglot--project-nickname
     :reader eglot-project-nickname)
-   (major-modes
-    :documentation "Major modes server is responsible for in a given project."
-    :accessor eglot--major-modes)
-   (language-id
-    :documentation "Language ID string for the mode."
-    :accessor eglot--language-id)
+   (languages
+    :documentation "Alist ((MODE . LANGUAGE-ID-STRING)...) of managed 
languages."
+    :accessor eglot--languages)
    (capabilities
     :documentation "JSON object containing server capabilities."
     :accessor eglot--capabilities)
@@ -884,6 +881,12 @@ treated as in `eglot--dbind'."
   :documentation
   "Represents a server. Wraps a process for LSP communication.")
 
+(defun eglot--major-modes (s) "Major modes server S is responsible for."
+  (mapcar #'car (eglot--languages s)))
+
+(defun eglot--language-ids (s) "LSP Language ID strings for server S's modes."
+  (mapcar #'cdr (eglot--languages s)))
+
 (cl-defmethod initialize-instance :before ((_server eglot-lsp-server) 
&optional args)
   (cl-remf args :initializationOptions))
 
@@ -969,42 +972,44 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
 
 (defun eglot--lookup-mode (mode)
   "Lookup `eglot-server-programs' for MODE.
-Return (MANAGED-MODES LANGUAGE-ID CONTACT-PROXY).
+Return (LANGUAGES . CONTACT-PROXY).
 
 MANAGED-MODES is a list with MODE as its first element.
 Subsequent elements are other major modes also potentially
 managed by the server that is to manage MODE.
 
-If not specified in `eglot-server-programs' (which see),
-LANGUAGE-ID is determined from MODE's name.
+LANGUAGE-IDS is a list of the same length as MANAGED-MODES.  Each
+elem is derived from the corresponding mode name, if not
+specified in `eglot-server-programs' (which see).
 
 CONTACT-PROXY is the value of the corresponding
 `eglot-server-programs' entry."
-  (cl-loop
-   for (modes . contact) in eglot-server-programs
-   for mode-symbols = (cons mode
-                            (delete mode
-                                    (mapcar #'car
-                                            (mapcar #'eglot--ensure-list
-                                                    (eglot--ensure-list 
modes)))))
-   thereis (cl-some
-            (lambda (spec)
-              (cl-destructuring-bind (probe &key language-id &allow-other-keys)
-                  (eglot--ensure-list spec)
-                (and (provided-mode-derived-p mode probe)
-                     (list
-                      mode-symbols
-                      (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))))
+  (cl-flet ((languages (main-mode-sym specs)
+              (let* ((res
+                      (mapcar (jsonrpc-lambda (sym &key language-id 
&allow-other-keys)
+                                (cons sym
+                                      (or language-id
+                                          (or (get sym 'eglot-language-id)
+                                              (replace-regexp-in-string
+                                               "\\(?:-ts\\)?-mode$" ""
+                                               (symbol-name sym))))))
+                              specs))
+                     (head (cl-find main-mode-sym res :key #'car)))
+                (cons head (delq head res)))))
+    (cl-loop
+     for (modes . contact) in eglot-server-programs
+     for specs = (mapcar #'eglot--ensure-list
+                         (if (or (symbolp modes) (keywordp (cadr modes)))
+                             (list modes) modes))
+     thereis (cl-some (lambda (spec)
+                        (cl-destructuring-bind (sym &key &allow-other-keys) 
spec
+                          (and (provided-mode-derived-p mode sym)
+                               (cons (languages sym specs) contact))))
+                      specs))))
 
 (defun eglot--guess-contact (&optional interactive)
   "Helper for `eglot'.
-Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID).  If INTERACTIVE is
+Return (MANAGED-MODES PROJECT CLASS CONTACT LANG-IDS).  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))
@@ -1022,11 +1027,10 @@ be guessed."
            ((not guessed-mode)
             (eglot--error "Can't guess mode to manage for `%s'" 
(current-buffer)))
            (t guessed-mode)))
-         (triplet (eglot--lookup-mode main-mode))
-         (managed-modes (car triplet))
-         (language-id (or (cadr triplet)
-                          (string-remove-suffix "-mode" (symbol-name 
guessed-mode))))
-         (guess (caddr triplet))
+         (languages-and-contact (eglot--lookup-mode main-mode))
+         (managed-modes (mapcar #'car (car languages-and-contact)))
+         (language-ids (mapcar #'cdr (car languages-and-contact)))
+         (guess (cdr languages-and-contact))
          (guess (if (functionp guess)
                     (funcall guess interactive)
                   guess))
@@ -1074,7 +1078,7 @@ be guessed."
                      full-program-invocation
                      'eglot-command-history)))
               guess)))
-    (list managed-modes (eglot--current-project) class contact language-id)))
+    (list managed-modes (eglot--current-project) class contact language-ids)))
 
 (defvar eglot-lsp-context)
 (put 'eglot-lsp-context 'variable-documentation
@@ -1092,24 +1096,25 @@ suitable root directory for a given LSP server's 
purposes."
         `(transient . ,(expand-file-name default-directory)))))
 
 ;;;###autoload
-(defun eglot (managed-major-mode project class contact language-id
+(defun eglot (managed-major-modes project class contact language-ids
                                  &optional _interactive)
-  "Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE.
+  "Start LSP server for PROJECT's buffers under MANAGED-MAJOR-MODES.
 
-This starts a Language Server Protocol (LSP) server suitable for the
-buffers of PROJECT whose `major-mode' is MANAGED-MAJOR-MODE.
-CLASS is the class of the LSP server to start and CONTACT specifies
-how to connect to the server.
+This starts a Language Server Protocol (LSP) server suitable for
+the buffers of PROJECT whose `major-mode' is among
+MANAGED-MAJOR-MODES.  CLASS is the class of the LSP server to
+start and CONTACT specifies how to connect to the server.
 
-Interactively, the command attempts to guess MANAGED-MAJOR-MODE
-from the current buffer's `major-mode', CLASS and CONTACT from
-`eglot-server-programs' looked up by the major mode, and PROJECT from
-`project-find-functions'.  The search for active projects in this
-context binds `eglot-lsp-context' (which see).
+Interactively, the command attempts to guess MANAGED-MAJOR-MODES,
+CLASS, CONTACT, and LANGUAGE-IDS from `eglot-server-programs',
+according to the current buffer's `major-mode'.  PROJECT is
+guessed from `project-find-functions'.  The search for active
+projects in this context binds `eglot-lsp-context' (which see).
 
-If it can't guess, it prompts the user for the mode and the server.
-With a single \\[universal-argument] prefix arg, it always prompts for COMMAND.
-With two \\[universal-argument], it also always prompts for MANAGED-MAJOR-MODE.
+If it can't guess, it prompts the user for the mode and the
+server.  With a single \\[universal-argument] prefix arg, it
+always prompts for COMMAND.  With two \\[universal-argument], it
+also always prompts for MANAGED-MAJOR-MODE.
 
 The LSP server of CLASS is started (or contacted) via CONTACT.
 If this operation is successful, current *and future* file
@@ -1127,8 +1132,8 @@ 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.
+LANGUAGE-IDS is a list of language ID string to send to the
+server for each element in MANAGED-MAJOR-MODES.
 
 INTERACTIVE is ignored and provided for backward compatibility."
   (interactive
@@ -1139,8 +1144,9 @@ INTERACTIVE is ignored and provided for backward 
compatibility."
        (user-error "[eglot] Connection attempt aborted by user."))
      (prog1 (append (eglot--guess-contact t) '(t))
        (when current-server (ignore-errors (eglot-shutdown current-server))))))
-  (eglot--connect (eglot--ensure-list managed-major-mode)
-                  project class contact language-id))
+  (eglot--connect (eglot--ensure-list managed-major-modes)
+                  project class contact
+                  (eglot--ensure-list language-ids)))
 
 (defun eglot-reconnect (server &optional interactive)
   "Reconnect to SERVER.
@@ -1152,7 +1158,7 @@ INTERACTIVE is t if called interactively."
                   (eglot--project server)
                   (eieio-object-class-name server)
                   (eglot--saved-initargs server)
-                  (eglot--language-id server))
+                  (eglot--language-ids server))
   (eglot--message "Reconnected!"))
 
 (defvar eglot--managed-mode) ; forward decl
@@ -1225,8 +1231,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-modes project class contact language-id)
-  "Connect to MANAGED-MODES, LANGUAGE-ID, PROJECT, CLASS and CONTACT.
+(defun eglot--connect (managed-modes project class contact language-ids)
+  "Connect to MANAGED-MODES, LANGUAGE-IDS, PROJECT, CLASS and CONTACT.
 This docstring appeases checkdoc, that's all."
   (let* ((default-directory (project-root project))
          (nickname (project-name project))
@@ -1299,8 +1305,9 @@ This docstring appeases checkdoc, that's all."
     (setf (eglot--saved-initargs server) initargs)
     (setf (eglot--project server) project)
     (setf (eglot--project-nickname server) nickname)
-    (setf (eglot--major-modes server) (eglot--ensure-list managed-modes))
-    (setf (eglot--language-id server) language-id)
+    (setf (eglot--languages server)
+          (cl-loop for m in managed-modes for l in language-ids
+                   collect (cons m l)))
     (setf (eglot--inferior-process server) autostart-inferior-process)
     (run-hook-with-args 'eglot-server-initialized-hook server)
     ;; Now start the handshake.  To honor `eglot-sync-connect'
@@ -2354,7 +2361,7 @@ THINGS are either registrations or unregisterations 
(sic)."
   (append
    (eglot--VersionedTextDocumentIdentifier)
    (list :languageId
-         (eglot--language-id (eglot--current-server-or-lose))
+         (alist-get major-mode (eglot--languages 
(eglot--current-server-or-lose)))
          :text
          (eglot--widening
           (buffer-substring-no-properties (point-min) (point-max))))))
diff --git a/test/lisp/progmodes/eglot-tests.el 
b/test/lisp/progmodes/eglot-tests.el
index efb0f4d8844..d96ba2ebf07 100644
--- a/test/lisp/progmodes/eglot-tests.el
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -1041,7 +1041,8 @@ int main() {
 (cl-defmacro eglot--guessing-contact ((interactive-sym
                                        prompt-args-sym
                                        guessed-class-sym guessed-contact-sym
-                                       &optional guessed-lang-id-sym)
+                                       &optional guessed-major-modes-sym
+                                       guessed-lang-ids-sym)
                                       &body body)
   "Guess LSP contact with `eglot--guessing-contact', evaluate BODY.
 
@@ -1051,10 +1052,10 @@ BODY is evaluated twice, with INTERACTIVE bound to the 
boolean passed to
 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,
-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."
+GUESSED-CONTACT-SYM, GUESSED-LANG-IDS-SYM and
+GUESSED-MAJOR-MODES-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))
@@ -1070,8 +1071,9 @@ macro will assume it exists."
                          `(lambda (&rest args) (setq ,prompt-args-sym args) "")
                        `(lambda (&rest _dummy) ""))))
            (cl-destructuring-bind
-               (_ _ ,guessed-class-sym ,guessed-contact-sym
-                  ,(or guessed-lang-id-sym '_))
+               (,(or guessed-major-modes-sym '_)
+                _ ,guessed-class-sym ,guessed-contact-sym
+                  ,(or guessed-lang-ids-sym '_))
                (eglot--guess-contact ,i-sym)
              ,@body))))))
 
@@ -1166,16 +1168,17 @@ macro will assume it exists."
 (ert-deftest eglot-test-server-programs-guess-lang ()
   (let ((major-mode 'foo-mode))
     (let ((eglot-server-programs '((foo-mode . ("prog-executable")))))
-      (eglot--guessing-contact (_ nil _ _ guessed-lang)
-        (should (equal guessed-lang "foo"))))
+      (eglot--guessing-contact (_ nil _ _ _ guessed-langs)
+        (should (equal guessed-langs '("foo")))))
     (let ((eglot-server-programs '(((foo-mode :language-id "bar")
                                     . ("prog-executable")))))
-      (eglot--guessing-contact (_ nil _ _ guessed-lang)
-        (should (equal guessed-lang "bar"))))
+      (eglot--guessing-contact (_ nil _ _ _ guessed-langs)
+        (should (equal guessed-langs '("bar")))))
     (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar"))
                                     . ("prog-executable")))))
-      (eglot--guessing-contact (_ nil _ _ guessed-lang)
-        (should (equal guessed-lang "bar"))))))
+      (eglot--guessing-contact (_ nil _ _ modes guessed-langs)
+        (should (equal guessed-langs '("bar" "baz")))
+        (should (equal modes '(foo-mode baz-mode)))))))
 
 (defun eglot--glob-match (glob str)
   (funcall (eglot--glob-compile glob t t) str))