diff options
Diffstat (limited to 'lisp/progmodes/eglot.el')
| -rw-r--r-- | lisp/progmodes/eglot.el | 706 |
1 files changed, 391 insertions, 315 deletions
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index fe9bc510049..24f2fda5ae5 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2023 Free Software Foundation, Inc. -;; Version: 1.13 +;; Version: 1.14 ;; Author: João Távora <joaotavora@gmail.com> ;; Maintainer: João Távora <joaotavora@gmail.com> ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.11.0") (seq "2.23") (external-completion "0.1")) +;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any @@ -97,34 +97,30 @@ (require 'imenu) (require 'cl-lib) -(require 'project) + (require 'url-parse) (require 'url-util) (require 'pcase) (require 'compile) ; for some faces (require 'warnings) -(require 'flymake) -(require 'xref) (eval-when-compile (require 'subr-x)) -(require 'jsonrpc) (require 'filenotify) (require 'ert) -(require 'array) -(require 'external-completion) - -;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are -;; using the latest version from GNU Elpa when we load eglot.el. Use an -;; heuristic to see if we need to `load' it in Emacs < 28. -(if (and (< emacs-major-version 28) - (not (boundp 'eldoc-documentation-strategy))) - (load "eldoc") - (require 'eldoc)) - -;; Similar issue as above for Emacs 26.3 and seq.el. -(if (< emacs-major-version 27) - (load "seq") - (require 'seq)) +(require 'text-property-search nil t) + +;; These dependencies are also GNU ELPA core packages. Because of +;; bug#62576, since there is a risk that M-x package-install, despite +;; having installed them, didn't correctly re-load them over the +;; built-in versions. +(eval-and-compile + (load "project") + (load "eldoc") + (load "seq") + (load "flymake") + (load "xref") + (load "jsonrpc") + (load "external-completion")) ;; forward-declare, but don't require (Emacs 28 doesn't seem to care) (defvar markdown-fontify-code-blocks-natively) @@ -221,7 +217,11 @@ chosen (interactively or automatically)." ((java-mode java-ts-mode) . ("jdtls")) (dart-mode . ("dart" "language-server" "--client-id" "emacs.eglot-dart")) - ((elixir-ts-mode elixir-mode) . ("language_server.sh")) + ((elixir-mode elixir-ts-mode heex-ts-mode) + . ,(if (and (fboundp 'w32-shell-dos-semantics) + (w32-shell-dos-semantics)) + '("language_server.bat") + '("language_server.sh"))) (ada-mode . ("ada_language_server")) (scala-mode . ,(eglot-alternatives '("metals" "metals-emacs"))) @@ -242,7 +242,7 @@ chosen (interactively or automatically)." ("css-languageserver" "--stdio")))) (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) - ((clojure-mode clojurescript-mode clojurec-mode) + ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) . ("clojure-lsp")) ((csharp-mode csharp-ts-mode) . ,(eglot-alternatives @@ -250,7 +250,11 @@ chosen (interactively or automatically)." ("csharp-ls")))) (purescript-mode . ("purescript-language-server" "--stdio")) ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) - (markdown-mode . ("marksman" "server"))) + (markdown-mode + . ,(eglot-alternatives + '(("marksman" "server") + ("vscode-markdown-language-server" "--stdio")))) + (graphviz-dot-mode . ("dot-language-server" "--stdio"))) "How the command `eglot' guesses the server to start. An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE identifies the buffers that are to be managed by a specific @@ -390,14 +394,20 @@ done by `eglot-reconnect'." "If non-nil, activate Eglot in cross-referenced non-project files." :type 'boolean) +(defcustom eglot-prefer-plaintext nil + "If non-nil, always request plaintext responses to hover requests." + :type 'boolean) + (defcustom eglot-menu-string "eglot" "String displayed in mode line when Eglot is active." :type 'string) (defcustom eglot-report-progress t - "If non-nil, show progress of long running LSP server work" + "If non-nil, show progress of long running LSP server work. +If set to `messages', use *Messages* buffer, else use Eglot's +mode line indicator." :type 'boolean - :version "29.1") + :version "1.10") (defvar eglot-withhold-process-id nil "If non-nil, Eglot will not send the Emacs process id to the language server. @@ -442,6 +452,10 @@ This can be useful when using docker to run a language server.") (if (>= emacs-major-version 27) (executable-find command remote) (executable-find command))) +(defun eglot--accepted-formats () + (if (and (not eglot-prefer-plaintext) (fboundp 'gfm-view-mode)) + ["markdown" "plaintext"] ["plaintext"])) + ;;; Message verification helpers ;;; @@ -477,9 +491,7 @@ This can be useful when using docker to run a language server.") (SymbolInformation (:name :kind :location) (:deprecated :containerName)) (DocumentSymbol (:name :range :selectionRange :kind) - ;; `:containerName' isn't really allowed , but - ;; it simplifies the impl of `eglot-imenu'. - (:detail :deprecated :children :containerName)) + (:detail :deprecated :children)) (TextDocumentEdit (:textDocument :edits) ()) (TextEdit (:range :newText)) (VersionedTextDocumentIdentifier (:uri :version) ()) @@ -772,14 +784,12 @@ treated as in `eglot--dbind'." :tagSupport (:valueSet [1])) :contextSupport t) :hover (list :dynamicRegistration :json-false - :contentFormat - (if (fboundp 'gfm-view-mode) - ["markdown" "plaintext"] - ["plaintext"])) + :contentFormat (eglot--accepted-formats)) :signatureHelp (list :dynamicRegistration :json-false :signatureInformation `(:parameterInformation (:labelOffsetSupport t) + :documentationFormat ,(eglot--accepted-formats) :activeParameterSupport t)) :references `(:dynamicRegistration :json-false) :definition (list :dynamicRegistration :json-false @@ -820,6 +830,7 @@ treated as in `eglot--dbind'." `(:valueSet [,@(mapcar #'car eglot--tag-faces)]))) + :window `(:workDoneProgress t) :general (list :positionEncodings ["utf-32" "utf-8" "utf-16"]) :experimental eglot--{}))) @@ -837,12 +848,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) @@ -877,6 +885,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)) @@ -904,7 +918,7 @@ SERVER." (unwind-protect (progn (setf (eglot--shutdown-requested server) t) - (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5)) + (eglot--request server :shutdown nil :timeout (or timeout 1.5)) (jsonrpc-notify server :exit nil)) ;; Now ask jsonrpc.el to shut down the server. (jsonrpc-shutdown server (not preserve-buffers)) @@ -962,42 +976,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)) @@ -1015,11 +1031,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)) @@ -1067,7 +1082,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 @@ -1085,24 +1100,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 @@ -1120,8 +1136,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 @@ -1132,8 +1148,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. @@ -1145,7 +1162,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 @@ -1218,8 +1235,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)) @@ -1292,8 +1309,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' @@ -1312,6 +1330,7 @@ This docstring appeases checkdoc, that's all." (eq (jsonrpc-process-type server) 'network)) (emacs-pid)) + :clientInfo '(:name "Eglot") ;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py' ;; into `/path/to/baz.py', so LSP groks it. :rootPath (file-local-name @@ -1456,15 +1475,27 @@ CONNECT-ARGS are passed as additional arguments to (line-beginning-position n)))) "Return position of first character in current line.") +(cl-defun eglot--request (server method params &key + immediate + timeout cancel-on-input + cancel-on-input-retval) + "Like `jsonrpc-request', but for Eglot LSP requests. +Unless IMMEDIATE, send pending changes before making request." + (unless immediate (eglot--signal-textDocument/didChange)) + (jsonrpc-request server method params + :timeout timeout + :cancel-on-input cancel-on-input + :cancel-on-input-retval cancel-on-input-retval)) + ;;; Encoding fever ;;; (define-obsolete-function-alias - 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "29.1") + 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "1.12") (define-obsolete-function-alias - 'eglot-current-column 'eglot-utf-32-linepos "29.1") + 'eglot-current-column 'eglot-utf-32-linepos "1.12") (define-obsolete-variable-alias - 'eglot-current-column-function 'eglot-current-linepos-function "29.1") + 'eglot-current-column-function 'eglot-current-linepos-function "1.12") (defvar eglot-current-linepos-function #'eglot-utf-16-linepos "Function calculating position relative to line beginning. @@ -1505,11 +1536,11 @@ LBP defaults to `eglot--bol'." (funcall eglot-current-linepos-function))))) (define-obsolete-function-alias - 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "29.1") + 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "1.12") (define-obsolete-function-alias - 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "29.1") + 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "1.12") (define-obsolete-variable-alias -'eglot-move-to-column-function 'eglot-move-to-linepos-function "29.1") +'eglot-move-to-column-function 'eglot-move-to-linepos-function "1.12") (defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos "Function to move to a position within a line reported by the LSP server. @@ -1605,6 +1636,7 @@ If optional MARKER, return a marker instead" (directory-file-name (file-local-name truepath)) eglot--uri-path-allowed-chars))))) +(declare-function w32-long-file-name "w32proc.c" (fn)) (defun eglot--uri-to-path (uri) "Convert URI to file path, helped by `eglot--current-server'." (when (keywordp uri) (setq uri (substring (symbol-name uri) 1))) @@ -1620,10 +1652,9 @@ If optional MARKER, return a marker instead" (normalized (if (and (not remote-prefix) (eq system-type 'windows-nt) (cl-plusp (length retval))) - (substring retval 1) + (w32-long-file-name (substring retval 1)) retval))) (concat remote-prefix normalized)) - uri))) (defun eglot--snippet-expansion-fn () @@ -1648,10 +1679,17 @@ Doubles as an indicator of snippet support." (setq-local markdown-fontify-code-blocks-natively t) (insert string) (let ((inhibit-message t) - (message-log-max nil)) - (ignore-errors (delay-mode-hooks (funcall mode)))) - (font-lock-ensure) - (string-trim (buffer-string))))) + (message-log-max nil) + match) + (ignore-errors (delay-mode-hooks (funcall mode))) + (font-lock-ensure) + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (when (fboundp 'text-property-search-forward) ;; FIXME: use compat + (while (setq match (text-property-search-forward 'invisible)) + (delete-region (prop-match-beginning match) + (prop-match-end match))))) + (string-trim (buffer-string)))))) (define-obsolete-variable-alias 'eglot-ignored-server-capabilites 'eglot-ignored-server-capabilities "1.8") @@ -1749,9 +1787,9 @@ and just return it. PROMPT shouldn't end with a question mark." (defun eglot--plist-keys (plist) "Get keys of a plist." (cl-loop for (k _v) on plist by #'cddr collect k)) -(defun eglot--ensure-list (x) (if (listp x) x (list x))) -(when (fboundp 'ensure-list) ; Emacs 28 or later - (define-obsolete-function-alias 'eglot--ensure-list #'ensure-list "29.1")) +(defalias 'eglot--ensure-list + (if (fboundp 'ensure-list) #'ensure-list + (lambda (x) (if (listp x) x (list x))))) ;;; Minor modes @@ -1832,6 +1870,8 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (unless (eglot--stay-out-of-p 'xref) (add-hook 'xref-backend-functions 'eglot-xref-backend nil t)) (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t) + (add-hook 'completion-in-region-mode-hook #'eglot--capf-session-flush nil t) + (add-hook 'company-after-completion-hook #'eglot--capf-session-flush nil t) (add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t) (add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t) (add-hook 'pre-command-hook 'eglot--pre-command-hook nil t) @@ -1863,6 +1903,8 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t) (remove-hook 'xref-backend-functions 'eglot-xref-backend t) (remove-hook 'completion-at-point-functions #'eglot-completion-at-point t) + (remove-hook 'completion-in-region-mode-hook #'eglot--capf-session-flush t) + (remove-hook 'company-after-completion-hook #'eglot--capf-session-flush t) (remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t) (remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t) (remove-hook 'pre-command-hook 'eglot--pre-command-hook t) @@ -1886,6 +1928,7 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (defun eglot--managed-mode-off () "Turn off `eglot--managed-mode' unconditionally." (remove-overlays nil nil 'eglot--overlay t) + (eglot-inlay-hints-mode -1) (eglot--managed-mode -1)) (defun eglot-current-server () @@ -1956,8 +1999,8 @@ If it is activated, also signal textDocument/didOpen." (when update-mode-line (force-mode-line-update t))))))) -(defun eglot-manual () "Open documentation." - (declare (obsolete info "29.1")) +(defun eglot-manual () "Read Eglot's manual." + (declare (obsolete info "1.10")) (interactive) (info "(eglot)")) (easy-menu-define eglot-menu nil "Eglot" @@ -2037,7 +2080,7 @@ Uses THING, FACE, DEFS and PREPEND." mouse-face mode-line-highlight)))) (defun eglot--mode-line-format () - "Compose the Eglot's mode-line." + "Compose Eglot's mode-line." (let* ((server (eglot-current-server)) (nick (and server (eglot-project-nickname server))) (pending (and server (hash-table-count @@ -2074,7 +2117,15 @@ Uses THING, FACE, DEFS and PREPEND." '((mouse-3 eglot-forget-pending-continuations "Forget pending continuations")) "Number of outgoing, \ -still unanswered LSP requests to the server\n")))))))) +still unanswered LSP requests to the server\n"))) + ,@(cl-loop for pr hash-values of (eglot--progress-reporters server) + when (eq (car pr) 'eglot--mode-line-reporter) + append `("/" ,(eglot--mode-line-props + (format "%s%%%%" (or (nth 4 pr) "?")) + 'eglot-mode-line + nil + (format "(%s) %s %s" (nth 1 pr) + (nth 2 pr) (nth 3 pr)))))))))) (add-to-list 'mode-line-misc-info `(eglot--managed-mode (" [" eglot--mode-line-format "] "))) @@ -2122,8 +2173,8 @@ still unanswered LSP requests to the server\n")))))))) (server command arguments) "Execute COMMAND on SERVER with `:workspace/executeCommand'. COMMAND is a symbol naming the command." - (jsonrpc-request server :workspace/executeCommand - `(:command ,(format "%s" command) :arguments ,arguments))) + (eglot--request server :workspace/executeCommand + `(:command ,(format "%s" command) :arguments ,arguments))) (cl-defmethod eglot-handle-notification (_server (_method (eql window/showMessage)) &key type message) @@ -2133,13 +2184,14 @@ COMMAND is a symbol naming the command." type message)) (cl-defmethod eglot-handle-request - (_server (_method (eql window/showMessageRequest)) &key type message actions) + (_server (_method (eql window/showMessageRequest)) + &key type message actions &allow-other-keys) "Handle server request window/showMessageRequest." (let* ((actions (append actions nil)) ;; gh#627 (label (completing-read (concat (format (propertize "[eglot] Server reports (type=%s): %s" - 'face (if (<= type 1) 'error)) + 'face (if (or (not type) (<= type 1)) 'error)) type message) "\nChoose an option: ") (or (mapcar (lambda (obj) (plist-get obj :title)) actions) @@ -2163,22 +2215,31 @@ COMMAND is a symbol naming the command." (server (_method (eql $/progress)) &key token value) "Handle $/progress notification identified by TOKEN from SERVER." (when eglot-report-progress - (cl-flet ((fmt (&rest args) (mapconcat #'identity args " "))) + (cl-flet ((fmt (&rest args) (mapconcat #'identity args " ")) + (mkpr (title) + (if (eq eglot-report-progress 'messages) + (make-progress-reporter + (format "[eglot] %s %s: %s" + (eglot-project-nickname server) token title)) + (list 'eglot--mode-line-reporter token title))) + (upd (pcnt msg &optional + (pr (gethash token (eglot--progress-reporters server)))) + (cond + ((eq (car pr) 'eglot--mode-line-reporter) + (setcdr (cddr pr) (list msg pcnt)) + (force-mode-line-update t)) + (pr (progress-reporter-update pr pcnt msg))))) (eglot--dbind ((WorkDoneProgress) kind title percentage message) value (pcase kind ("begin" - (let* ((prefix (format (concat "[eglot] %s %s:" (when percentage " ")) - (eglot-project-nickname server) token)) - (pr (puthash token - (if percentage - (make-progress-reporter prefix 0 100 percentage 1 0) - (make-progress-reporter prefix nil nil nil 1 0)) - (eglot--progress-reporters server)))) - (eglot--reporter-update pr percentage (fmt title message)))) - ("report" - (when-let ((pr (gethash token (eglot--progress-reporters server)))) - (eglot--reporter-update pr percentage (fmt title message)))) - ("end" (remhash token (eglot--progress-reporters server)))))))) + (upd percentage (fmt title message) + (puthash token (mkpr title) + (eglot--progress-reporters server)))) + ("report" (upd percentage message)) + ("end" (upd (or percentage 100) message) + (run-at-time 2 nil + (lambda () + (remhash token (eglot--progress-reporters server)))))))))) (cl-defmethod eglot-handle-notification (_server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics @@ -2304,7 +2365,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)))))) @@ -2417,16 +2478,6 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." (run-hooks 'eglot--document-changed-hook) (setq eglot--change-idle-timer nil)))))))) -;; HACK! Launching a deferred sync request with outstanding changes is a -;; bad idea, since that might lead to the request never having a -;; chance to run, because `jsonrpc-connection-ready-p'. -(advice-add #'jsonrpc-request :before - (cl-function (lambda (_proc _method _params &key - deferred &allow-other-keys) - (when (and eglot--managed-mode deferred) - (eglot--signal-textDocument/didChange)))) - '((name . eglot--signal-textDocument/didChange))) - (defvar-local eglot-workspace-configuration () "Configure LSP servers specifically for a given project. @@ -2484,7 +2535,7 @@ use the root of SERVER's `eglot--project'." ;; Set the major mode to be the first of the managed ;; modes. This is the one the user started eglot in. (setq major-mode (car (eglot--major-modes server))) - (hack-dir-local-variables-non-file-buffer)() + (hack-dir-local-variables-non-file-buffer) (if (functionp eglot-workspace-configuration) (funcall eglot-workspace-configuration server) eglot-workspace-configuration)))) @@ -2579,8 +2630,8 @@ When called interactively, use the currently active server" (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil) (ignore-errors (eglot--apply-text-edits - (jsonrpc-request server :textDocument/willSaveWaitUntil params - :timeout 0.5)))))) + (eglot--request server :textDocument/willSaveWaitUntil params + :timeout 0.5)))))) (defun eglot--signal-textDocument/didSave () "Maybe send textDocument/didSave to server." @@ -2692,8 +2743,8 @@ If BUFFER, switch to it before." (propertize (alist-get kind eglot--symbol-kind-names "Unknown") 'face 'shadow)) 'eglot--lsp-workspaceSymbol wss))) - (jsonrpc-request (eglot--current-server-or-lose) :workspace/symbol - `(:query ,pat))))) + (eglot--request (eglot--current-server-or-lose) :workspace/symbol + `(:query ,pat))))) (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot))) "Yet another tricky connection between LSP and Elisp completion semantics." @@ -2749,7 +2800,7 @@ If BUFFER, switch to it before." (cadr (split-string (symbol-name method) "/")))))) (let ((response - (jsonrpc-request + (eglot--request (eglot--current-server-or-lose) method (append (eglot--TextDocumentPositionParams) extra-params)))) (eglot--collecting-xrefs (collect) @@ -2812,9 +2863,9 @@ If BUFFER, switch to it before." (eglot--lambda ((SymbolInformation) name location) (eglot--dbind ((Location) uri range) location (collect (eglot--xref-make-match name uri range)))) - (jsonrpc-request (eglot--current-server-or-lose) - :workspace/symbol - `(:query ,pattern)))))) + (eglot--request (eglot--current-server-or-lose) + :workspace/symbol + `(:query ,pattern)))))) (defun eglot-format-buffer () "Format contents of current buffer." @@ -2846,7 +2897,7 @@ for which LSP on-type-formatting should be requested." '(:textDocument/formatting :documentFormattingProvider nil))))) (eglot--server-capable-or-lose cap) (eglot--apply-text-edits - (jsonrpc-request + (eglot--request (eglot--current-server-or-lose) method (cl-list* @@ -2855,8 +2906,14 @@ for which LSP on-type-formatting should be requested." :insertSpaces (if indent-tabs-mode :json-false t) :insertFinalNewline (if require-final-newline t :json-false) :trimFinalNewlines (if delete-trailing-lines t :json-false)) - args) - :deferred method)))) + args))))) + +(defvar eglot-cache-session-completions t + "If non-nil Eglot caches data during completion sessions.") + +(defvar eglot--capf-session :none "A cache used by `eglot-completion-at-point'.") + +(defun eglot--capf-session-flush (&optional _) (setq eglot--capf-session :none)) (defun eglot-completion-at-point () "Eglot's `completion-at-point' function." @@ -2873,41 +2930,50 @@ for which LSP on-type-formatting should be requested." :sortText))))) (metadata `(metadata (category . eglot) (display-sort-function . ,sort-completions))) - resp items (cached-proxies :none) + (local-cache :none) + (bounds (bounds-of-thing-at-point 'symbol)) + (orig-pos (point)) + (resolved (make-hash-table)) (proxies (lambda () - (if (listp cached-proxies) cached-proxies - (setq resp - (jsonrpc-request server - :textDocument/completion - (eglot--CompletionParams) - :deferred :textDocument/completion - :cancel-on-input t)) - (setq items (append - (if (vectorp resp) resp (plist-get resp :items)) - nil)) - (setq cached-proxies - (mapcar - (jsonrpc-lambda - (&rest item &key label insertText insertTextFormat - textEdit &allow-other-keys) - (let ((proxy - ;; Snippet or textEdit, it's safe to - ;; display/insert the label since - ;; it'll be adjusted. If no usable - ;; insertText at all, label is best, - ;; too. - (cond ((or (eql insertTextFormat 2) - textEdit - (null insertText) - (string-empty-p insertText)) - (string-trim-left label)) - (t insertText)))) - (unless (zerop (length proxy)) - (put-text-property 0 1 'eglot--lsp-item item proxy)) - proxy)) - items))))) - (resolved (make-hash-table)) + (if (listp local-cache) local-cache + (let* ((resp (eglot--request server + :textDocument/completion + (eglot--CompletionParams) + :cancel-on-input t)) + (items (append + (if (vectorp resp) resp (plist-get resp :items)) + nil)) + (cachep (and (listp resp) items + eglot-cache-session-completions + (eq (plist-get resp :isIncomplete) :json-false))) + (bounds (or bounds + (cons (point) (point)))) + (proxies + (mapcar + (jsonrpc-lambda + (&rest item &key label insertText insertTextFormat + textEdit &allow-other-keys) + (let ((proxy + ;; Snippet or textEdit, it's safe to + ;; display/insert the label since + ;; it'll be adjusted. If no usable + ;; insertText at all, label is best, + ;; too. + (cond ((or (eql insertTextFormat 2) + textEdit + (null insertText) + (string-empty-p insertText)) + (string-trim-left label)) + (t insertText)))) + (unless (zerop (length proxy)) + (put-text-property 0 1 'eglot--lsp-item item proxy)) + proxy)) + items))) + ;; (trace-values "Requested" (length proxies) cachep bounds) + (setq eglot--capf-session + (if cachep (list bounds proxies resolved orig-pos) :none)) + (setq local-cache proxies))))) (resolve-maybe ;; Maybe completion/resolve JSON object `lsp-comp' into ;; another JSON object, if at all possible. Otherwise, @@ -2918,13 +2984,21 @@ for which LSP on-type-formatting should be requested." (if (and (eglot--server-capable :completionProvider :resolveProvider) (plist-get lsp-comp :data)) - (jsonrpc-request server :completionItem/resolve - lsp-comp :cancel-on-input t) - lsp-comp))))) - (bounds (bounds-of-thing-at-point 'symbol))) + (eglot--request server :completionItem/resolve + lsp-comp :cancel-on-input t) + lsp-comp)))))) + (unless bounds (setq bounds (cons (point) (point)))) + (when (and (consp eglot--capf-session) + (= (car bounds) (car (nth 0 eglot--capf-session))) + (>= (cdr bounds) (cdr (nth 0 eglot--capf-session)))) + (setq local-cache (nth 1 eglot--capf-session) + resolved (nth 2 eglot--capf-session) + orig-pos (nth 3 eglot--capf-session)) + ;; (trace-values "Recalling cache" (length local-cache) bounds orig-pos) + ) (list - (or (car bounds) (point)) - (or (cdr bounds) (point)) + (car bounds) + (cdr bounds) (lambda (probe pred action) (cond ((eq action 'metadata) metadata) ; metadata @@ -2995,7 +3069,7 @@ for which LSP on-type-formatting should be requested." :company-require-match 'never :company-prefix-length (save-excursion - (when (car bounds) (goto-char (car bounds))) + (goto-char (car bounds)) (when (listp completion-capability) (looking-back (regexp-opt @@ -3003,6 +3077,7 @@ for which LSP on-type-formatting should be requested." (eglot--bol)))) :exit-function (lambda (proxy status) + (eglot--capf-session-flush) (when (memq status '(finished exact)) ;; To assist in using this whole `completion-at-point' ;; function inside `completion-in-region', ensure the exit @@ -3026,17 +3101,12 @@ for which LSP on-type-formatting should be requested." (let ((snippet-fn (and (eql insertTextFormat 2) (eglot--snippet-expansion-fn)))) (cond (textEdit - ;; Undo (yes, undo) the newly inserted completion. - ;; If before completion the buffer was "foo.b" and - ;; now is "foo.bar", `proxy' will be "bar". We - ;; want to delete only "ar" (`proxy' minus the - ;; symbol whose bounds we've calculated before) - ;; (github#160). - (delete-region (+ (- (point) (length proxy)) - (if bounds - (- (cdr bounds) (car bounds)) - 0)) - (point)) + ;; Revert buffer back to state when the edit + ;; was obtained from server. If a `proxy' + ;; "bar" was obtained from a buffer with + ;; "foo.b", the LSP edit applies to that' + ;; state, _not_ the current "foo.bar". + (delete-region orig-pos (point)) (eglot--dbind ((TextEdit) range newText) textEdit (pcase-let ((`(,beg . ,end) (eglot--range-region range))) @@ -3059,62 +3129,56 @@ for which LSP on-type-formatting should be requested." (mapconcat #'eglot--format-markup (if (vectorp contents) contents (list contents)) "\n")) -(defun eglot--sig-info (sigs active-sig sig-help-active-param) - (cl-loop - for (sig . moresigs) on (append sigs nil) for i from 0 - concat - (eglot--dbind ((SignatureInformation) label documentation parameters activeParameter) sig - (with-temp-buffer - (save-excursion (insert label)) - (let ((active-param (or activeParameter sig-help-active-param)) - params-start params-end) - ;; Ad-hoc attempt to parse label as <name>(<params>) - (when (looking-at "\\([^(]*\\)(\\([^)]+\\))") - (setq params-start (match-beginning 2) params-end (match-end 2)) - (add-face-text-property (match-beginning 1) (match-end 1) - 'font-lock-function-name-face)) - (when (eql i active-sig) - ;; Decide whether to add one-line-summary to signature line - (when (and (stringp documentation) - (string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)" - documentation)) - (setq documentation (match-string 1 documentation)) - (unless (string-prefix-p (string-trim documentation) label) - (goto-char (point-max)) - (insert ": " (eglot--format-markup documentation)))) - ;; Decide what to do with the active parameter... - (when (and (eql i active-sig) active-param - (< -1 active-param (length parameters))) - (eglot--dbind ((ParameterInformation) label documentation) - (aref parameters active-param) - ;; ...perhaps highlight it in the formals list - (when params-start - (goto-char params-start) - (pcase-let - ((`(,beg ,end) - (if (stringp label) - (let ((case-fold-search nil)) - (and (re-search-forward - (concat "\\<" (regexp-quote label) "\\>") - params-end t) - (list (match-beginning 0) (match-end 0)))) - (mapcar #'1+ (append label nil))))) - (if (and beg end) - (add-face-text-property - beg end - 'eldoc-highlight-function-argument)))) - ;; ...and/or maybe add its doc on a line by its own. - (when documentation - (goto-char (point-max)) - (insert "\n" - (propertize - (if (stringp label) - label - (apply #'buffer-substring (mapcar #'1+ label))) - 'face 'eldoc-highlight-function-argument) - ": " (eglot--format-markup documentation)))))) - (buffer-string)))) - when moresigs concat "\n")) +(defun eglot--sig-info (sig &optional sig-active briefp) + (eglot--dbind ((SignatureInformation) + ((:label siglabel)) + ((:documentation sigdoc)) parameters activeParameter) + sig + (with-temp-buffer + (save-excursion (insert siglabel)) + ;; Ad-hoc attempt to parse label as <name>(<params>) + (when (looking-at "\\([^(]*\\)(\\([^)]+\\))") + (add-face-text-property (match-beginning 1) (match-end 1) + 'font-lock-function-name-face)) + ;; Add documentation, indented so we can distinguish multiple signatures + (when-let (doc (and (not briefp) sigdoc (eglot--format-markup sigdoc))) + (goto-char (point-max)) + (insert "\n" (replace-regexp-in-string "^" " " doc))) + ;; Now to the parameters + (cl-loop + with active-param = (or sig-active activeParameter) + for i from 0 for parameter across parameters do + (eglot--dbind ((ParameterInformation) + ((:label parlabel)) + ((:documentation pardoc))) + parameter + ;; ...perhaps highlight it in the formals list + (when (and (eq i active-param)) + (save-excursion + (goto-char (point-min)) + (pcase-let + ((`(,beg ,end) + (if (stringp parlabel) + (let ((case-fold-search nil)) + (and (search-forward parlabel (line-end-position) t) + (list (match-beginning 0) (match-end 0)))) + (mapcar #'1+ (append parlabel nil))))) + (if (and beg end) + (add-face-text-property + beg end + 'eldoc-highlight-function-argument))))) + ;; ...and/or maybe add its doc on a line by its own. + (let (fpardoc) + (when (and pardoc (not briefp) + (not (string-empty-p + (setq fpardoc (eglot--format-markup pardoc))))) + (insert "\n " + (propertize + (if (stringp parlabel) parlabel + (apply #'substring siglabel (mapcar #'1+ parlabel))) + 'face (and (eq i active-param) 'eldoc-highlight-function-argument)) + ": " fpardoc))))) + (buffer-string)))) (defun eglot-signature-eldoc-function (cb) "A member of `eldoc-documentation-functions', for signatures." @@ -3125,13 +3189,18 @@ for which LSP on-type-formatting should be requested." :textDocument/signatureHelp (eglot--TextDocumentPositionParams) :success-fn (eglot--lambda ((SignatureHelp) - signatures activeSignature activeParameter) + signatures activeSignature (activeParameter 0)) (eglot--when-buffer-window buf - (funcall cb - (unless (seq-empty-p signatures) - (eglot--sig-info signatures - activeSignature - activeParameter))))) + (let ((active-sig (and (cl-plusp (length signatures)) + (aref signatures (or activeSignature 0))))) + (if (not active-sig) (funcall cb nil) + (funcall + cb (mapconcat (lambda (s) + (eglot--sig-info s (and (eq s active-sig) + activeParameter) + nil)) + signatures "\n") + :echo (eglot--sig-info active-sig activeParameter t)))))) :deferred :textDocument/signatureHelp)) t)) @@ -3146,7 +3215,8 @@ for which LSP on-type-formatting should be requested." (eglot--when-buffer-window buf (let ((info (unless (seq-empty-p contents) (eglot--hover-info contents range)))) - (funcall cb info :buffer t)))) + (funcall cb info + :echo (and info (string-match "\n" info)))))) :deferred :textDocument/hover)) (eglot--highlight-piggyback cb) t)) @@ -3180,49 +3250,55 @@ for which LSP on-type-formatting should be requested." :deferred :textDocument/documentHighlight) nil))) +(defun eglot--imenu-SymbolInformation (res) + "Compute `imenu--index-alist' for RES vector of SymbolInformation." + (mapcar + (pcase-lambda (`(,kind . ,objs)) + (cons + (alist-get kind eglot--symbol-kind-names "Unknown") + (mapcan + (pcase-lambda (`(,container . ,objs)) + (let ((elems (mapcar + (eglot--lambda ((SymbolInformation) kind name location) + (let ((reg (eglot--range-region + (plist-get location :range))) + (kind (alist-get kind eglot--symbol-kind-names))) + (cons (propertize name + 'breadcrumb-region reg + 'breadcrumb-kind kind) + (car reg)))) + objs))) + (if container (list (cons container elems)) elems))) + (seq-group-by + (eglot--lambda ((SymbolInformation) containerName) containerName) objs)))) + (seq-group-by (eglot--lambda ((SymbolInformation) kind) kind) res))) + +(defun eglot--imenu-DocumentSymbol (res) + "Compute `imenu--index-alist' for RES vector of DocumentSymbol." + (cl-labels ((dfs (&key name children range kind &allow-other-keys) + (let* ((reg (eglot--range-region range)) + (kind (alist-get kind eglot--symbol-kind-names)) + (name (propertize name + 'breadcrumb-region reg + 'breadcrumb-kind kind))) + (if (seq-empty-p children) + (cons name (car reg)) + (cons name + (mapcar (lambda (c) (apply #'dfs c)) children)))))) + (mapcar (lambda (s) (apply #'dfs s)) res))) + (defun eglot-imenu () "Eglot's `imenu-create-index-function'. Returns a list as described in docstring of `imenu--index-alist'." - (cl-labels - ((unfurl (obj) - (eglot--dcase obj - (((SymbolInformation)) (list obj)) - (((DocumentSymbol) name children) - (cons obj - (mapcar - (lambda (c) - (plist-put - c :containerName - (let ((existing (plist-get c :containerName))) - (if existing (format "%s::%s" name existing) - name)))) - (mapcan #'unfurl children))))))) - (mapcar - (pcase-lambda (`(,kind . ,objs)) - (cons - (alist-get kind eglot--symbol-kind-names "Unknown") - (mapcan (pcase-lambda (`(,container . ,objs)) - (let ((elems (mapcar - (lambda (obj) - (cons (plist-get obj :name) - (car (eglot--range-region - (eglot--dcase obj - (((SymbolInformation) location) - (plist-get location :range)) - (((DocumentSymbol) selectionRange) - selectionRange)))))) - objs))) - (if container (list (cons container elems)) elems))) - (seq-group-by - (lambda (e) (plist-get e :containerName)) objs)))) - (seq-group-by - (lambda (obj) (plist-get obj :kind)) - (mapcan #'unfurl - (jsonrpc-request (eglot--current-server-or-lose) - :textDocument/documentSymbol - `(:textDocument - ,(eglot--TextDocumentIdentifier)) - :cancel-on-input non-essential)))))) + (let* ((res (eglot--request (eglot--current-server-or-lose) + :textDocument/documentSymbol + `(:textDocument + ,(eglot--TextDocumentIdentifier)) + :cancel-on-input non-essential)) + (head (and res (elt res 0)))) + (eglot--dcase head + (((SymbolInformation)) (eglot--imenu-SymbolInformation res)) + (((DocumentSymbol)) (eglot--imenu-DocumentSymbol res))))) (cl-defun eglot--apply-text-edits (edits &optional version) "Apply EDITS for current buffer if at VERSION, or if it's nil." @@ -3293,9 +3369,9 @@ Returns a list as described in docstring of `imenu--index-alist'." (symbol-name (symbol-at-point))))) (eglot--server-capable-or-lose :renameProvider) (eglot--apply-workspace-edit - (jsonrpc-request (eglot--current-server-or-lose) - :textDocument/rename `(,@(eglot--TextDocumentPositionParams) - :newName ,newname)) + (eglot--request (eglot--current-server-or-lose) + :textDocument/rename `(,@(eglot--TextDocumentPositionParams) + :newName ,newname)) current-prefix-arg)) (defun eglot--region-bounds () @@ -3321,7 +3397,7 @@ at point. With prefix argument, prompt for ACTION-KIND." (eglot--server-capable-or-lose :codeActionProvider) (let* ((server (eglot--current-server-or-lose)) (actions - (jsonrpc-request + (eglot--request server :textDocument/codeAction (list :textDocument (eglot--TextDocumentIdentifier) @@ -3333,8 +3409,7 @@ at point. With prefix argument, prompt for ACTION-KIND." when (cdr (assoc 'eglot-lsp-diag (eglot--diag-data diag))) collect it)] - ,@(when action-kind `(:only [,action-kind])))) - :deferred t)) + ,@(when action-kind `(:only [,action-kind])))))) ;; Redo filtering, in case the `:only' didn't go through. (actions (cl-loop for a across actions when (or (not action-kind) @@ -3435,8 +3510,9 @@ at point. With prefix argument, prompt for ACTION-KIND." (unwind-protect (progn (dolist (dir dirs-to-watch) - (push (file-notify-add-watch dir '(change) #'handle-event) - (gethash id (eglot--file-watches server)))) + (when (file-readable-p dir) + (push (file-notify-add-watch dir '(change) #'handle-event) + (gethash id (eglot--file-watches server))))) (setq success `(:message ,(format "OK, watching %s directories in %s watchers" |