From fe44e01347f292498f2c532c6ef0b1b1dc8587b9 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 16 Feb 2025 18:27:48 +0000 Subject: [PATCH] Eglot: use eglot-advertise-cancellation in more situations The async requests frequently issued by ElDoc are a significant source of request pile-up on the server side (for some servers). With this change, Eglot will issue additional LSP $/cancelRequest notifications for in-flight requests of certain kinds in the pre-command hook. This required a small change to the 'jsonrpc-async-request' entrypoint. This feature is experimental. * lisp/jsonrpc.el (jsonrpc-async-request): No longer returns nil. * lisp/progmodes/eglot.el (eglot--inflight-async-requests): New variable. (eglot--cancel-inflight-async-requests): New function. (eglot--async-request): New function. (eglot--pre-command-hook): Call eglot--cancel-inflight-async-requests. (eglot-signature-eldoc-function, eglot-hover-eldoc-function) (eglot-highlight-eldoc-function, eglot-code-action-suggestion): Use eglot--async-request. (cherry picked from commit e4c911adeaa679a92fab58b196b27c502aaed2f3) --- lisp/jsonrpc.el | 6 ++-- lisp/progmodes/eglot.el | 75 ++++++++++++++++++++++++++++++++++++----- 2 files changed, 69 insertions(+), 12 deletions(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 56017e5f976..669ceba30ef 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -377,9 +377,9 @@ never be sent at all, in case it is overridden in the meantime by a new request with identical DEFERRED and for the same buffer. However, in that situation, the original timeout is kept. -Returns nil." - (apply #'jsonrpc--async-request-1 connection method params args) - nil) +Returns a list whose first element is an integer identifying the request +as specified in the JSONRPC 2.0 spec." + (apply #'jsonrpc--async-request-1 connection method params args)) (cl-defun jsonrpc-request (connection method params &key diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 812a81ef35a..ffab36dbcb3 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1826,6 +1826,62 @@ Unless IMMEDIATE, send pending changes before making request." (cancel-on-input)) :cancel-on-input-retval cancel-on-input-retval)) +(defvar-local eglot--inflight-async-requests nil + "An plist of symbols to lists of JSONRPC ids. +The ids designate in-flight asynchronous requests that may be cancelled +according to `eglot-advertise-cancellation'.") + +(cl-defun eglot--cancel-inflight-async-requests + (&optional (hints '(:textDocument/signatureHelp + :textDocument/hover + :textDocument/documentHighlight + :textDocument/codeAction))) + (when-let* ((server (and hints + eglot-advertise-cancellation + (eglot-current-server)))) + (dolist (hint hints) + (dolist (id (plist-get eglot--inflight-async-requests hint)) + ;; FIXME: in theory, as `jsonrpc-async-request' explains, this + ;; request may never have been sent at all. But that's rare, and + ;; it's only a problem if the server borks on cancellation of + ;; never-sent requests. + (jsonrpc-notify server '$/cancelRequest `(:id ,id))) + (cl-remf eglot--inflight-async-requests hint)))) + +(cl-defun eglot--async-request (server + method + params + &key + (success-fn nil success-fn-supplied-p) + (error-fn nil error-fn-supplied-p) + (timeout-fn nil timeout-fn-supplied-p) + (timeout nil timeout-supplied-p) + hint + &aux moreargs) + "Like `jsonrpc-async-request', but for Eglot LSP requests. +HINT argument is a symbol passed as DEFERRED to `jsonrpc-async-request' +and also used as a hint of the request cancellation mechanism (see +`eglot-advertise-cancellation')." + (cl-labels ((clearing-fn (fn) + (lambda (&rest args) + (when fn (apply fn args)) + (cl-remf eglot--inflight-async-requests hint)))) + (eglot--cancel-inflight-async-requests (list hint)) + (when timeout-supplied-p + (setq moreargs (nconc `(:timeout ,timeout) moreargs))) + (when hint + (setq moreargs (nconc `(:deferred ,hint) moreargs))) + (let ((id + (car (apply #'jsonrpc-async-request + server method params + :success-fn (clearing-fn success-fn) + :error-fn (clearing-fn error-fn) + :timeout-fn (clearing-fn timeout-fn) + moreargs)))) + (when (and hint eglot-advertise-cancellation) + (push id + (plist-get eglot--inflight-async-requests hint)))))) + ;;; Encoding fever ;;; @@ -2833,8 +2889,9 @@ buffer." "Cache of `workspace/Symbol' results used by `xref-find-definitions'.") (defun eglot--pre-command-hook () - "Reset some temporary variables." + "Reset some state." (clrhash eglot--workspace-symbols-cache) + (eglot--cancel-inflight-async-requests) (setq eglot--last-inserted-char nil)) (defun eglot--CompletionParams () @@ -3678,7 +3735,7 @@ for which LSP on-type-formatting should be requested." "A member of `eldoc-documentation-functions', for signatures." (when (eglot-server-capable :signatureHelpProvider) (let ((buf (current-buffer))) - (jsonrpc-async-request + (eglot--async-request (eglot--current-server-or-lose) :textDocument/signatureHelp (eglot--TextDocumentPositionParams) :success-fn @@ -3695,14 +3752,14 @@ for which LSP on-type-formatting should be requested." nil)) signatures "\n") :echo (eglot--sig-info active-sig activeParameter t)))))) - :deferred :textDocument/signatureHelp)) + :hint :textDocument/signatureHelp)) t)) (defun eglot-hover-eldoc-function (cb &rest _ignored) "A member of `eldoc-documentation-functions', for hover." (when (eglot-server-capable :hoverProvider) (let ((buf (current-buffer))) - (jsonrpc-async-request + (eglot--async-request (eglot--current-server-or-lose) :textDocument/hover (eglot--TextDocumentPositionParams) :success-fn (eglot--lambda ((Hover) contents range) @@ -3711,7 +3768,7 @@ for which LSP on-type-formatting should be requested." (eglot--hover-info contents range)))) (funcall cb info :echo (and info (string-match "\n" info)))))) - :deferred :textDocument/hover)) + :hint :textDocument/hover)) t)) (defun eglot-highlight-eldoc-function (_cb &rest _ignored) @@ -3721,7 +3778,7 @@ for which LSP on-type-formatting should be requested." ;; ignore cb and return nil to say "no doc". (when (eglot-server-capable :documentHighlightProvider) (let ((buf (current-buffer))) - (jsonrpc-async-request + (eglot--async-request (eglot--current-server-or-lose) :textDocument/documentHighlight (eglot--TextDocumentPositionParams) :success-fn @@ -3739,7 +3796,7 @@ for which LSP on-type-formatting should be requested." `(,(lambda (o &rest _) (delete-overlay o)))) ov))) highlights)))) - :deferred :textDocument/documentHighlight) + :hint :textDocument/documentHighlight) nil))) (defun eglot--imenu-SymbolInformation (res) @@ -4099,7 +4156,7 @@ at point. With prefix argument, prompt for ACTION-KIND." (bounds (eglot--code-action-bounds)) (use-text-p (memq 'eldoc-hint eglot-code-action-indications)) tooltip blurb) - (jsonrpc-async-request + (eglot--async-request (eglot--current-server-or-lose) :textDocument/codeAction (eglot--code-action-params :beg (car bounds) :end (cadr bounds) @@ -4139,7 +4196,7 @@ at point. With prefix argument, prompt for ACTION-KIND." ,tooltip))))) (setq eglot--suggestion-overlay ov))))) (when use-text-p (funcall cb blurb))) - :deferred :textDocument/codeAction) + :hint :textDocument/codeAction) (and use-text-p t)))) -- 2.39.5