From: Dimitri Belopopsky <dimitri@belopopsky.com>
To: "João Távora" <joaotavora@gmail.com>
Cc: Po Lu <luangruo@yahoo.com>,
Chinmay Dalal <dalal.chinmay.0101@gmail.com>,
Eli Zaretskii <eliz@gnu.org>,
61412@debbugs.gnu.org
Subject: bug#61412: Inlay hints implementation
Date: Tue, 21 Feb 2023 19:42:19 +0100 [thread overview]
Message-ID: <CA+46MXbbW60t=JccgKGX39jTkOu+i=GZhzSQsfnqBUPb-mnJWg@mail.gmail.com> (raw)
In-Reply-To: <CALDnm53otfeDQGr0dWWUhxGLTSuiWTstLXJz1HXQgWLiAgsk=A@mail.gmail.com>
[-- Attachment #1.1: Type: text/plain, Size: 2100 bytes --]
Hello,
I thought the point was not to create overlays directly?
I'm sharing what I currently have, using the flymake diagnostics directly.
Maybe something can be salvaged?
In the meantime I'll try out your patches.
On Tue, 21 Feb 2023 at 16:14, João Távora <joaotavora@gmail.com> wrote:
> [Eli, I just noticed that this bug should be merged with 61066,
> but I don't know how to do that]
>
> Hello,
>
> Attached is my implementation of inlay hints for Eglot.
> Two patches are provided, where the first just lays some
> basic groundwork to make the actual inlay hint implementation
> simpler.
>
> Regarding copyright stuff, I did look at Chinmay's patch,
> but I re-started from scratch. While it was a very good
> effort, there were too many idiomatic Elisp and Eglot things
> to change. I did take Chinmay's face definitions, though.
> Not sure how to proceed here and if this counts as "derived
> work" and if we should wait for Chinmay's copyright assignment.
>
> I gave it some light testing and I kind of like it. Quite
> helpful for C++ with clangd (the only server I tested it with).
> You can bind `eglot-inlay-hint-mode` to some keybinding probably.
It's even more helpful in languages like Rust, that rely on type deduction
a lot more.
Clangd has an extension for designator hints that looks interesting too.
> Documentation in the manual is still missing, but shouldn't
> be very hard to do.
>
> Anyway, this is likely not the end of the inlay hint story
> because, as the second patch documents, this is likely a
> very naive implementation that always requests inlay hints
> for the entire buffer even if just a fraction of it is visible.
>
> A better implementation would probably leverage
> window-scroll-functions along with the Eglot-specific
> idle timer. That is probably much, much more tricky to get
> right, but is also more than likely the way to go.
>
> In the meantime, I'd like your opinion on this patch and
> the above topics first.
>
> João
>
> I hope gmail doesn't mess up my attachments...
>
[-- Attachment #1.2: Type: text/html, Size: 2937 bytes --]
[-- Attachment #2: 0001-Add-inlay-hint-functionality.patch --]
[-- Type: text/x-patch, Size: 237198 bytes --]
From ecb08911dcf5b2eae1338ef832640603eaf441b3 Mon Sep 17 00:00:00 2001
From: Dimitri Belopopsky <dimitri@belopopsky.com>
Date: Mon, 2 Jan 2023 22:06:07 +0100
Subject: [PATCH] Add inlay hint functionality
---
eglot.el | 3731 +++++++++++++++++++++++++++++-------------------------
1 file changed, 1985 insertions(+), 1746 deletions(-)
diff --git a/eglot.el b/eglot.el
index 901bf30..9e5a9dd 100644
--- a/eglot.el
+++ b/eglot.el
@@ -114,13 +114,13 @@
;; 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")
+ (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")
+ (load "seq")
(require 'seq))
;; forward-declare, but don't require (Emacs 28 doesn't seem to care)
@@ -150,90 +150,90 @@ chosen (interactively or automatically)."
;; `eglot--executable-find' may take much longer to execute on
;; remote files.
(let* ((listified (cl-loop for a in alternatives
- collect (if (listp a) a (list a))))
- (err (lambda ()
- (error "None of '%s' are valid executables"
- (mapconcat #'car listified ", ")))))
+ collect (if (listp a) a (list a))))
+ (err (lambda ()
+ (error "None of '%s' are valid executables"
+ (mapconcat #'car listified ", ")))))
(cond (interactive
- (let* ((augmented (mapcar (lambda (a)
- (let ((found (eglot--executable-find
- (car a) t)))
- (and found
- (cons (car a) (cons found (cdr a))))))
- listified))
- (available (remove nil augmented)))
- (cond ((cdr available)
- (cdr (assoc
- (completing-read
- "[eglot] More than one server executable available:"
- (mapcar #'car available)
- nil t nil nil (car (car available)))
- available #'equal)))
- ((cdr (car available)))
- (t
- ;; Don't error when used interactively, let the
- ;; Eglot prompt the user for alternative (github#719)
- nil))))
- (t
- (cl-loop for (p . args) in listified
- for probe = (eglot--executable-find p t)
- when probe return (cons probe args)
- finally (funcall err)))))))
+ (let* ((augmented (mapcar (lambda (a)
+ (let ((found (eglot--executable-find
+ (car a) t)))
+ (and found
+ (cons (car a) (cons found (cdr a))))))
+ listified))
+ (available (remove nil augmented)))
+ (cond ((cdr available)
+ (cdr (assoc
+ (completing-read
+ "[eglot] More than one server executable available:"
+ (mapcar #'car available)
+ nil t nil nil (car (car available)))
+ available #'equal)))
+ ((cdr (car available)))
+ (t
+ ;; Don't error when used interactively, let the
+ ;; Eglot prompt the user for alternative (github#719)
+ nil))))
+ (t
+ (cl-loop for (p . args) in listified
+ for probe = (eglot--executable-find p t)
+ when probe return (cons probe args)
+ finally (funcall err)))))))
(defvar eglot-server-programs `((rust-mode . ,(eglot-alternatives '("rust-analyzer" "rls")))
- (cmake-mode . ("cmake-language-server"))
- (vimrc-mode . ("vim-language-server" "--stdio"))
- (python-mode
- . ,(eglot-alternatives
- '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server")))
- ((js-mode typescript-mode)
- . ("typescript-language-server" "--stdio"))
- (sh-mode . ("bash-language-server" "start"))
- ((php-mode phps-mode)
- . ("php" "vendor/felixfbecker/\
+ (cmake-mode . ("cmake-language-server"))
+ (vimrc-mode . ("vim-language-server" "--stdio"))
+ (python-mode
+ . ,(eglot-alternatives
+ '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server")))
+ ((js-mode typescript-mode)
+ . ("typescript-language-server" "--stdio"))
+ (sh-mode . ("bash-language-server" "start"))
+ ((php-mode phps-mode)
+ . ("php" "vendor/felixfbecker/\
language-server/bin/php-language-server.php"))
- ((c++-mode c-mode) . ,(eglot-alternatives
- '("clangd" "ccls")))
- (((caml-mode :language-id "ocaml")
- (tuareg-mode :language-id "ocaml") reason-mode)
- . ("ocamllsp"))
- (ruby-mode
- . ("solargraph" "socket" "--port" :autoport))
- (haskell-mode
- . ("haskell-language-server-wrapper" "--lsp"))
- (elm-mode . ("elm-language-server"))
- (mint-mode . ("mint" "ls"))
- (kotlin-mode . ("kotlin-language-server"))
- (go-mode . ("gopls"))
- ((R-mode ess-r-mode) . ("R" "--slave" "-e"
- "languageserver::run()"))
- (java-mode . ("jdtls"))
- (dart-mode . ("dart" "language-server"
- "--client-id" "emacs.eglot-dart"))
- (elixir-mode . ("language_server.sh"))
- (ada-mode . ("ada_language_server"))
- (scala-mode . ("metals-emacs"))
- (racket-mode . ("racket" "-l" "racket-langserver"))
- ((tex-mode context-mode texinfo-mode bibtex-mode)
- . ("digestif"))
- (erlang-mode . ("erlang_ls" "--transport" "stdio"))
- (yaml-mode . ("yaml-language-server" "--stdio"))
- (nix-mode . ("rnix-lsp"))
- (gdscript-mode . ("localhost" 6008))
- ((fortran-mode f90-mode) . ("fortls"))
- (futhark-mode . ("futhark" "lsp"))
- (lua-mode . ("lua-lsp"))
- (zig-mode . ("zls"))
- (css-mode . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") ("css-languageserver" "--stdio"))))
- (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio"))))
- (json-mode . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio"))))
- (dockerfile-mode . ("docker-langserver" "--stdio"))
- ((clojure-mode clojurescript-mode clojurec-mode)
- . ("clojure-lsp"))
- (csharp-mode . ("omnisharp" "-lsp"))
- (purescript-mode . ("purescript-language-server" "--stdio"))
- (perl-mode . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run"))
- (markdown-mode . ("marksman" "server")))
+ ((c++-mode c-mode) . ,(eglot-alternatives
+ '("clangd" "ccls")))
+ (((caml-mode :language-id "ocaml")
+ (tuareg-mode :language-id "ocaml") reason-mode)
+ . ("ocamllsp"))
+ (ruby-mode
+ . ("solargraph" "socket" "--port" :autoport))
+ (haskell-mode
+ . ("haskell-language-server-wrapper" "--lsp"))
+ (elm-mode . ("elm-language-server"))
+ (mint-mode . ("mint" "ls"))
+ (kotlin-mode . ("kotlin-language-server"))
+ (go-mode . ("gopls"))
+ ((R-mode ess-r-mode) . ("R" "--slave" "-e"
+ "languageserver::run()"))
+ (java-mode . ("jdtls"))
+ (dart-mode . ("dart" "language-server"
+ "--client-id" "emacs.eglot-dart"))
+ (elixir-mode . ("language_server.sh"))
+ (ada-mode . ("ada_language_server"))
+ (scala-mode . ("metals-emacs"))
+ (racket-mode . ("racket" "-l" "racket-langserver"))
+ ((tex-mode context-mode texinfo-mode bibtex-mode)
+ . ("digestif"))
+ (erlang-mode . ("erlang_ls" "--transport" "stdio"))
+ (yaml-mode . ("yaml-language-server" "--stdio"))
+ (nix-mode . ("rnix-lsp"))
+ (gdscript-mode . ("localhost" 6008))
+ ((fortran-mode f90-mode) . ("fortls"))
+ (futhark-mode . ("futhark" "lsp"))
+ (lua-mode . ("lua-lsp"))
+ (zig-mode . ("zls"))
+ (css-mode . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") ("css-languageserver" "--stdio"))))
+ (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio"))))
+ (json-mode . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio"))))
+ (dockerfile-mode . ("docker-langserver" "--stdio"))
+ ((clojure-mode clojurescript-mode clojurec-mode)
+ . ("clojure-lsp"))
+ (csharp-mode . ("omnisharp" "-lsp"))
+ (purescript-mode . ("purescript-language-server" "--stdio"))
+ (perl-mode . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run"))
+ (markdown-mode . ("marksman" "server")))
"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
@@ -314,6 +314,10 @@ CONTACT can be:
'((t . (:inherit shadow :strike-through t)))
"Face used to render deprecated or obsolete code.")
+(defface eglot-flymake-inlay-hint
+ '((t (:inherit shadow :height 0.8)))
+ "Face used for inlay hint overlays in flymake.")
+
(defcustom eglot-autoreconnect 3
"Control ability to reconnect automatically to the LSP server.
If t, always reconnect automatically (not recommended). If nil,
@@ -322,7 +326,7 @@ crashes or network failures. A positive integer number says to
only autoreconnect if the previous successful connection attempt
lasted more than that many seconds."
:type '(choice (boolean :tag "Whether to inhibit autoreconnection")
- (integer :tag "Number of seconds")))
+ (integer :tag "Number of seconds")))
(defcustom eglot-connect-timeout 30
"Number of seconds before timing out LSP connection attempts.
@@ -336,7 +340,7 @@ integer number means block for that many seconds, and then wait
for the connection in the background. nil has the same meaning
as 0, i.e. don't block at all."
:type '(choice (boolean :tag "Whether to inhibit autoreconnection")
- (integer :tag "Number of seconds")))
+ (integer :tag "Number of seconds")))
(defcustom eglot-autoshutdown nil
"If non-nil, shut down server after killing last managed buffer."
@@ -356,12 +360,12 @@ For changes on this variable to take effect on a connection
already started, you need to restart the connection. That can be
done by `eglot-reconnect'."
:type '(choice (const :tag "No limit" nil)
- (integer :tag "Number of characters")))
+ (integer :tag "Number of characters")))
(defcustom eglot-confirm-server-initiated-edits 'confirm
"Non-nil if server-initiated edits should be confirmed with user."
:type '(choice (const :tag "Don't show confirmation prompt" nil)
- (symbol :tag "Show confirmation prompt" 'confirm)))
+ (symbol :tag "Show confirmation prompt" 'confirm)))
(defcustom eglot-extend-to-xref nil
"If non-nil, activate Eglot in cross-referenced non-project files."
@@ -384,27 +388,27 @@ This can be useful when using docker to run a language server.")
;;;
(defconst eglot--symbol-kind-names
`((1 . "File") (2 . "Module")
- (3 . "Namespace") (4 . "Package") (5 . "Class")
- (6 . "Method") (7 . "Property") (8 . "Field")
- (9 . "Constructor") (10 . "Enum") (11 . "Interface")
- (12 . "Function") (13 . "Variable") (14 . "Constant")
- (15 . "String") (16 . "Number") (17 . "Boolean")
- (18 . "Array") (19 . "Object") (20 . "Key")
- (21 . "Null") (22 . "EnumMember") (23 . "Struct")
- (24 . "Event") (25 . "Operator") (26 . "TypeParameter")))
+ (3 . "Namespace") (4 . "Package") (5 . "Class")
+ (6 . "Method") (7 . "Property") (8 . "Field")
+ (9 . "Constructor") (10 . "Enum") (11 . "Interface")
+ (12 . "Function") (13 . "Variable") (14 . "Constant")
+ (15 . "String") (16 . "Number") (17 . "Boolean")
+ (18 . "Array") (19 . "Object") (20 . "Key")
+ (21 . "Null") (22 . "EnumMember") (23 . "Struct")
+ (24 . "Event") (25 . "Operator") (26 . "TypeParameter")))
(defconst eglot--kind-names
`((1 . "Text") (2 . "Method") (3 . "Function") (4 . "Constructor")
- (5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface")
- (9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value")
- (13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color")
- (17 . "File") (18 . "Reference") (19 . "Folder") (20 . "EnumMember")
- (21 . "Constant") (22 . "Struct") (23 . "Event") (24 . "Operator")
- (25 . "TypeParameter")))
+ (5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface")
+ (9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value")
+ (13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color")
+ (17 . "File") (18 . "Reference") (19 . "Folder") (20 . "EnumMember")
+ (21 . "Constant") (22 . "Struct") (23 . "Event") (24 . "Operator")
+ (25 . "TypeParameter")))
(defconst eglot--tag-faces
`((1 . eglot-diagnostic-tag-unnecessary-face)
- (2 . eglot-diagnostic-tag-deprecated-face)))
+ (2 . eglot-diagnostic-tag-deprecated-face)))
(defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.")
(defvaralias 'eglot-{} 'eglot--{})
@@ -420,43 +424,43 @@ This can be useful when using docker to run a language server.")
(eval-and-compile
(defvar eglot--lsp-interface-alist
`(
- (CodeAction (:title) (:kind :diagnostics :edit :command :isPreferred))
- (ConfigurationItem () (:scopeUri :section))
- (Command ((:title . string) (:command . string)) (:arguments))
- (CompletionItem (:label)
- (:kind :detail :documentation :deprecated :preselect
- :sortText :filterText :insertText :insertTextFormat
- :textEdit :additionalTextEdits :commitCharacters
- :command :data :tags))
- (Diagnostic (:range :message) (:severity :code :source :relatedInformation :codeDescription :tags))
- (DocumentHighlight (:range) (:kind))
- (FileSystemWatcher (:globPattern) (:kind))
- (Hover (:contents) (:range))
- (InitializeResult (:capabilities) (:serverInfo))
- (Location (:uri :range))
- (LocationLink (:targetUri :targetRange :targetSelectionRange) (:originSelectionRange))
- (LogMessageParams (:type :message))
- (MarkupContent (:kind :value))
- (ParameterInformation (:label) (:documentation))
- (Position (:line :character))
- (Range (:start :end))
- (Registration (:id :method) (:registerOptions))
- (ResponseError (:code :message) (:data))
- (ShowMessageParams (:type :message))
- (ShowMessageRequestParams (:type :message) (:actions))
- (SignatureHelp (:signatures) (:activeSignature :activeParameter))
- (SignatureInformation (:label) (:documentation :parameters :activeParameter))
- (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))
- (TextDocumentEdit (:textDocument :edits) ())
- (TextEdit (:range :newText))
- (VersionedTextDocumentIdentifier (:uri :version) ())
- (WorkspaceEdit () (:changes :documentChanges))
- (WorkspaceSymbol (:name :kind) (:containerName :location :data)))
+ (CodeAction (:title) (:kind :diagnostics :edit :command :isPreferred))
+ (ConfigurationItem () (:scopeUri :section))
+ (Command ((:title . string) (:command . string)) (:arguments))
+ (CompletionItem (:label)
+ (:kind :detail :documentation :deprecated :preselect
+ :sortText :filterText :insertText :insertTextFormat
+ :textEdit :additionalTextEdits :commitCharacters
+ :command :data :tags))
+ (Diagnostic (:range :message) (:severity :code :source :relatedInformation :codeDescription :tags))
+ (DocumentHighlight (:range) (:kind))
+ (FileSystemWatcher (:globPattern) (:kind))
+ (Hover (:contents) (:range))
+ (InitializeResult (:capabilities) (:serverInfo))
+ (Location (:uri :range))
+ (LocationLink (:targetUri :targetRange :targetSelectionRange) (:originSelectionRange))
+ (LogMessageParams (:type :message))
+ (MarkupContent (:kind :value))
+ (ParameterInformation (:label) (:documentation))
+ (Position (:line :character))
+ (Range (:start :end))
+ (Registration (:id :method) (:registerOptions))
+ (ResponseError (:code :message) (:data))
+ (ShowMessageParams (:type :message))
+ (ShowMessageRequestParams (:type :message) (:actions))
+ (SignatureHelp (:signatures) (:activeSignature :activeParameter))
+ (SignatureInformation (:label) (:documentation :parameters :activeParameter))
+ (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))
+ (TextDocumentEdit (:textDocument :edits) ())
+ (TextEdit (:range :newText))
+ (VersionedTextDocumentIdentifier (:uri :version) ())
+ (WorkspaceEdit () (:changes :documentChanges))
+ (WorkspaceSymbol (:name :kind) (:containerName :location :data)))
"Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
INTERFACE-NAME is a symbol designated by the spec as
@@ -474,10 +478,10 @@ Here's what an element of this alist might look like:
(eval-and-compile
(defvar eglot-strict-mode
'(;; Uncomment next lines for fun and debugging
- ;; disallow-non-standard-keys
- ;; enforce-required-keys
- ;; enforce-optional-keys
- )
+ ;; disallow-non-standard-keys
+ ;; enforce-required-keys
+ ;; enforce-optional-keys
+ )
"How strictly to check LSP interfaces at compile- and run-time.
Value is a list of symbols (if the list is empty, no checks are
@@ -501,31 +505,31 @@ If the symbol `disallow-unknown-methods' is present, Eglot warns
on unknown notifications and errors on unknown requests."))
(cl-defun eglot--check-object (interface-name
- object
- &optional
- (enforce-required t)
- (disallow-non-standard t)
- (check-types t))
+ object
+ &optional
+ (enforce-required t)
+ (disallow-non-standard t)
+ (check-types t))
"Check that OBJECT conforms to INTERFACE. Error otherwise."
(cl-destructuring-bind
- (&key types required-keys optional-keys &allow-other-keys)
- (eglot--interface interface-name)
+ (&key types required-keys optional-keys &allow-other-keys)
+ (eglot--interface interface-name)
(when-let ((missing (and enforce-required
- (cl-set-difference required-keys
- (eglot--plist-keys object)))))
+ (cl-set-difference required-keys
+ (eglot--plist-keys object)))))
(eglot--error "A `%s' must have %s" interface-name missing))
(when-let ((excess (and disallow-non-standard
- (cl-set-difference
- (eglot--plist-keys object)
- (append required-keys optional-keys)))))
+ (cl-set-difference
+ (eglot--plist-keys object)
+ (append required-keys optional-keys)))))
(eglot--error "A `%s' mustn't have %s" interface-name excess))
(when check-types
(cl-loop
- for (k v) on object by #'cddr
- for type = (or (cdr (assoc k types)) t) ;; FIXME: enforce nil type?
- unless (cl-typep v type)
- do (eglot--error "A `%s' must have a %s as %s, but has %s"
- interface-name )))
+ for (k v) on object by #'cddr
+ for type = (or (cdr (assoc k types)) t) ;; FIXME: enforce nil type?
+ unless (cl-typep v type)
+ do (eglot--error "A `%s' must have a %s as %s, but has %s"
+ interface-name )))
t))
(eval-and-compile
@@ -536,44 +540,44 @@ on unknown notifications and errors on unknown requests."))
(defun eglot--interface (interface-name)
(let* ((interface (assoc interface-name eglot--lsp-interface-alist))
- (required (mapcar #'eglot--ensure-type (car (cdr interface))))
- (optional (mapcar #'eglot--ensure-type (cadr (cdr interface)))))
+ (required (mapcar #'eglot--ensure-type (car (cdr interface))))
+ (optional (mapcar #'eglot--ensure-type (cadr (cdr interface)))))
(list :types (append required optional)
- :required-keys (mapcar #'car required)
- :optional-keys (mapcar #'car optional))))
+ :required-keys (mapcar #'car required)
+ :optional-keys (mapcar #'car optional))))
(defun eglot--check-dspec (interface-name dspec)
"Check destructuring spec DSPEC against INTERFACE-NAME."
(cl-destructuring-bind (&key required-keys optional-keys &allow-other-keys)
- (eglot--interface interface-name)
+ (eglot--interface interface-name)
(cond ((or required-keys optional-keys)
- (let ((too-many
- (and
- (memq 'disallow-non-standard-keys eglot-strict-mode)
- (cl-set-difference
- (eglot--keywordize-vars dspec)
- (append required-keys optional-keys))))
- (ignored-required
- (and
- (memq 'enforce-required-keys eglot-strict-mode)
- (cl-set-difference
- required-keys (eglot--keywordize-vars dspec))))
- (missing-out
- (and
- (memq 'enforce-optional-keys eglot-strict-mode)
- (cl-set-difference
- optional-keys (eglot--keywordize-vars dspec)))))
- (when too-many (byte-compile-warn
- "Destructuring for %s has extraneous %s"
- interface-name too-many))
- (when ignored-required (byte-compile-warn
- "Destructuring for %s ignores required %s"
- interface-name ignored-required))
- (when missing-out (byte-compile-warn
- "Destructuring for %s is missing out on %s"
- interface-name missing-out))))
- (t
- (byte-compile-warn "Unknown LSP interface %s" interface-name))))))
+ (let ((too-many
+ (and
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-set-difference
+ (eglot--keywordize-vars dspec)
+ (append required-keys optional-keys))))
+ (ignored-required
+ (and
+ (memq 'enforce-required-keys eglot-strict-mode)
+ (cl-set-difference
+ required-keys (eglot--keywordize-vars dspec))))
+ (missing-out
+ (and
+ (memq 'enforce-optional-keys eglot-strict-mode)
+ (cl-set-difference
+ optional-keys (eglot--keywordize-vars dspec)))))
+ (when too-many (byte-compile-warn
+ "Destructuring for %s has extraneous %s"
+ interface-name too-many))
+ (when ignored-required (byte-compile-warn
+ "Destructuring for %s ignores required %s"
+ interface-name ignored-required))
+ (when missing-out (byte-compile-warn
+ "Destructuring for %s is missing out on %s"
+ interface-name missing-out))))
+ (t
+ (byte-compile-warn "Unknown LSP interface %s" interface-name))))))
(cl-defmacro eglot--dbind (vars object &body body)
"Destructure OBJECT, binding VARS in BODY.
@@ -581,26 +585,26 @@ VARS is ([(INTERFACE)] SYMS...)
Honour `eglot-strict-mode'."
(declare (indent 2) (debug (sexp sexp &rest form)))
(let ((interface-name (if (consp (car vars))
- (car (pop vars))))
- (object-once (make-symbol "object-once"))
- (fn-once (make-symbol "fn-once")))
+ (car (pop vars))))
+ (object-once (make-symbol "object-once"))
+ (fn-once (make-symbol "fn-once")))
(cond (interface-name
- (eglot--check-dspec interface-name vars)
- `(let ((,object-once ,object))
- (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
- (eglot--check-object ',interface-name ,object-once
- (memq 'enforce-required-keys eglot-strict-mode)
- (memq 'disallow-non-standard-keys eglot-strict-mode)
- (memq 'check-types eglot-strict-mode))
- ,@body)))
- (t
- `(let ((,object-once ,object)
- (,fn-once (lambda (,@vars) ,@body)))
- (if (memq 'disallow-non-standard-keys eglot-strict-mode)
- (cl-destructuring-bind (&key ,@vars) ,object-once
- (funcall ,fn-once ,@vars))
- (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
- (funcall ,fn-once ,@vars))))))))
+ (eglot--check-dspec interface-name vars)
+ `(let ((,object-once ,object))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
+ (eglot--check-object ',interface-name ,object-once
+ (memq 'enforce-required-keys eglot-strict-mode)
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (memq 'check-types eglot-strict-mode))
+ ,@body)))
+ (t
+ `(let ((,object-once ,object)
+ (,fn-once (lambda (,@vars) ,@body)))
+ (if (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-destructuring-bind (&key ,@vars) ,object-once
+ (funcall ,fn-once ,@vars))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once
+ (funcall ,fn-once ,@vars))))))))
(cl-defmacro eglot--lambda (cl-lambda-list &body body)
@@ -618,38 +622,38 @@ treated as in `eglot-dbind'."
(let ((obj-once (make-symbol "obj-once")))
`(let ((,obj-once ,obj))
(cond
- ,@(cl-loop
- for (vars . body) in clauses
- for vars-as-keywords = (eglot--keywordize-vars vars)
- for interface-name = (if (consp (car vars))
+ ,@(cl-loop
+ for (vars . body) in clauses
+ for vars-as-keywords = (eglot--keywordize-vars vars)
+ for interface-name = (if (consp (car vars))
(car (pop vars)))
- for condition =
- (cond (interface-name
- (eglot--check-dspec interface-name vars)
- ;; In this mode, in runtime, we assume
- ;; `eglot-strict-mode' is partially on, otherwise we
- ;; can't disambiguate between certain types.
- `(ignore-errors
- (eglot--check-object
- ',interface-name ,obj-once
- t
- (memq 'disallow-non-standard-keys eglot-strict-mode)
- t)))
- (t
- ;; In this interface-less mode we don't check
- ;; `eglot-strict-mode' at all: just check that the object
- ;; has all the keys the user wants to destructure.
- `(null (cl-set-difference
+ for condition =
+ (cond (interface-name
+ (eglot--check-dspec interface-name vars)
+ ;; In this mode, in runtime, we assume
+ ;; `eglot-strict-mode' is partially on, otherwise we
+ ;; can't disambiguate between certain types.
+ `(ignore-errors
+ (eglot--check-object
+ ',interface-name ,obj-once
+ t
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ t)))
+ (t
+ ;; In this interface-less mode we don't check
+ ;; `eglot-strict-mode' at all: just check that the object
+ ;; has all the keys the user wants to destructure.
+ `(null (cl-set-difference
',vars-as-keywords
(eglot--plist-keys ,obj-once)))))
- collect `(,condition
- (cl-destructuring-bind (&key ,@vars &allow-other-keys)
- ,obj-once
- ,@body)))
- (t
- (eglot--error "%S didn't match any of %S"
- ,obj-once
- ',(mapcar #'car clauses)))))))
+ collect `(,condition
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
+ ,obj-once
+ ,@body)))
+ (t
+ (eglot--error "%S didn't match any of %S"
+ ,obj-once
+ ',(mapcar #'car clauses)))))))
\f
;;; API (WORK-IN-PROGRESS!)
@@ -683,154 +687,154 @@ treated as in `eglot-dbind'."
(cl-defgeneric eglot-initialization-options (server)
"JSON object to send under `initializationOptions'."
(:method (s)
- (let ((probe (plist-get (eglot--saved-initargs s) :initializationOptions)))
- (cond ((functionp probe) (funcall probe s))
- (probe)
- (t eglot--{})))))
+ (let ((probe (plist-get (eglot--saved-initargs s) :initializationOptions)))
+ (cond ((functionp probe) (funcall probe s))
+ (probe)
+ (t eglot--{})))))
(cl-defgeneric eglot-register-capability (server method id &rest params)
"Ask SERVER to register capability METHOD marked with ID."
(:method
- (_s method _id &rest _params)
- (eglot--warn "Server tried to register unsupported capability `%s'"
- method)))
+ (_s method _id &rest _params)
+ (eglot--warn "Server tried to register unsupported capability `%s'"
+ method)))
(cl-defgeneric eglot-unregister-capability (server method id &rest params)
"Ask SERVER to register capability METHOD marked with ID."
(:method
- (_s method _id &rest _params)
- (eglot--warn "Server tried to unregister unsupported capability `%s'"
- method)))
+ (_s method _id &rest _params)
+ (eglot--warn "Server tried to unregister unsupported capability `%s'"
+ method)))
(cl-defgeneric eglot-client-capabilities (server)
"What the Eglot LSP client supports for SERVER."
(:method (s)
- (list
- :workspace (list
- :applyEdit t
- :executeCommand `(:dynamicRegistration :json-false)
- :workspaceEdit `(:documentChanges t)
- :didChangeWatchedFiles
- `(:dynamicRegistration
- ,(if (eglot--trampish-p s) :json-false t))
- :symbol `(:dynamicRegistration :json-false)
- :configuration t
- :workspaceFolders t)
- :textDocument
- (list
- :synchronization (list
- :dynamicRegistration :json-false
- :willSave t :willSaveWaitUntil t :didSave t)
- :completion (list :dynamicRegistration :json-false
- :completionItem
- `(:snippetSupport
- ,(if (eglot--snippet-expansion-fn)
- t
- :json-false)
- :deprecatedSupport t
- :tagSupport (:valueSet [1]))
- :contextSupport t)
- :hover (list :dynamicRegistration :json-false
- :contentFormat
- (if (fboundp 'gfm-view-mode)
- ["markdown" "plaintext"]
- ["plaintext"]))
- :signatureHelp (list :dynamicRegistration :json-false
- :signatureInformation
- `(:parameterInformation
- (:labelOffsetSupport t)
- :activeParameterSupport t))
- :references `(:dynamicRegistration :json-false)
- :definition (list :dynamicRegistration :json-false
- :linkSupport t)
- :declaration (list :dynamicRegistration :json-false
- :linkSupport t)
- :implementation (list :dynamicRegistration :json-false
- :linkSupport t)
- :typeDefinition (list :dynamicRegistration :json-false
- :linkSupport t)
- :documentSymbol (list
- :dynamicRegistration :json-false
- :hierarchicalDocumentSymbolSupport t
- :symbolKind `(:valueSet
- [,@(mapcar
- #'car eglot--symbol-kind-names)]))
- :documentHighlight `(:dynamicRegistration :json-false)
- :codeAction (list
- :dynamicRegistration :json-false
- :codeActionLiteralSupport
- '(:codeActionKind
- (:valueSet
- ["quickfix"
- "refactor" "refactor.extract"
- "refactor.inline" "refactor.rewrite"
- "source" "source.organizeImports"]))
- :isPreferredSupport t)
- :formatting `(:dynamicRegistration :json-false)
- :rangeFormatting `(:dynamicRegistration :json-false)
- :rename `(:dynamicRegistration :json-false)
- :publishDiagnostics (list :relatedInformation :json-false
- ;; TODO: We can support :codeDescription after
- ;; adding an appropriate UI to
- ;; Flymake.
- :codeDescriptionSupport :json-false
- :tagSupport
- `(:valueSet
- [,@(mapcar
- #'car eglot--tag-faces)])))
- :experimental eglot--{})))
+ (list
+ :workspace (list
+ :applyEdit t
+ :executeCommand `(:dynamicRegistration :json-false)
+ :workspaceEdit `(:documentChanges t)
+ :didChangeWatchedFiles
+ `(:dynamicRegistration
+ ,(if (eglot--trampish-p s) :json-false t))
+ :symbol `(:dynamicRegistration :json-false)
+ :configuration t
+ :workspaceFolders t)
+ :textDocument
+ (list
+ :synchronization (list
+ :dynamicRegistration :json-false
+ :willSave t :willSaveWaitUntil t :didSave t)
+ :completion (list :dynamicRegistration :json-false
+ :completionItem
+ `(:snippetSupport
+ ,(if (eglot--snippet-expansion-fn)
+ t
+ :json-false)
+ :deprecatedSupport t
+ :tagSupport (:valueSet [1]))
+ :contextSupport t)
+ :hover (list :dynamicRegistration :json-false
+ :contentFormat
+ (if (fboundp 'gfm-view-mode)
+ ["markdown" "plaintext"]
+ ["plaintext"]))
+ :signatureHelp (list :dynamicRegistration :json-false
+ :signatureInformation
+ `(:parameterInformation
+ (:labelOffsetSupport t)
+ :activeParameterSupport t))
+ :references `(:dynamicRegistration :json-false)
+ :definition (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :declaration (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :implementation (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :typeDefinition (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :documentSymbol (list
+ :dynamicRegistration :json-false
+ :hierarchicalDocumentSymbolSupport t
+ :symbolKind `(:valueSet
+ [,@(mapcar
+ #'car eglot--symbol-kind-names)]))
+ :documentHighlight `(:dynamicRegistration :json-false)
+ :codeAction (list
+ :dynamicRegistration :json-false
+ :codeActionLiteralSupport
+ '(:codeActionKind
+ (:valueSet
+ ["quickfix"
+ "refactor" "refactor.extract"
+ "refactor.inline" "refactor.rewrite"
+ "source" "source.organizeImports"]))
+ :isPreferredSupport t)
+ :formatting `(:dynamicRegistration :json-false)
+ :rangeFormatting `(:dynamicRegistration :json-false)
+ :rename `(:dynamicRegistration :json-false)
+ :publishDiagnostics (list :relatedInformation :json-false
+ ;; TODO: We can support :codeDescription after
+ ;; adding an appropriate UI to
+ ;; Flymake.
+ :codeDescriptionSupport :json-false
+ :tagSupport
+ `(:valueSet
+ [,@(mapcar
+ #'car eglot--tag-faces)])))
+ :experimental eglot--{})))
(cl-defgeneric eglot-workspace-folders (server)
"Return workspaceFolders for SERVER."
(let ((project (eglot--project server)))
(vconcat
- (mapcar (lambda (dir)
- (list :uri (eglot--path-to-uri dir)
- :name (abbreviate-file-name dir)))
- `(,(project-root project) ,@(project-external-roots project))))))
+ (mapcar (lambda (dir)
+ (list :uri (eglot--path-to-uri dir)
+ :name (abbreviate-file-name dir)))
+ `(,(project-root project) ,@(project-external-roots project))))))
(defclass eglot-lsp-server (jsonrpc-process-connection)
((project-nickname
- :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)
- (capabilities
- :documentation "JSON object containing server capabilities."
- :accessor eglot--capabilities)
- (server-info
- :documentation "JSON object containing server info."
- :accessor eglot--server-info)
- (shutdown-requested
- :documentation "Flag set when server is shutting down."
- :accessor eglot--shutdown-requested)
- (project
- :documentation "Project associated with server."
- :accessor eglot--project)
- (spinner
- :documentation "List (ID DOING-WHAT DONE-P) representing server progress."
- :initform `(nil nil t) :accessor eglot--spinner)
- (inhibit-autoreconnect
- :initform t
- :documentation "Generalized boolean inhibiting auto-reconnection if true."
- :accessor eglot--inhibit-autoreconnect)
- (file-watches
- :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'."
- :initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
- (managed-buffers
- :documentation "List of buffers managed by server."
- :accessor eglot--managed-buffers)
- (saved-initargs
- :documentation "Saved initargs for reconnection purposes."
- :accessor eglot--saved-initargs)
- (inferior-process
- :documentation "Server subprocess started automatically."
- :accessor eglot--inferior-process))
+ :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)
+ (capabilities
+ :documentation "JSON object containing server capabilities."
+ :accessor eglot--capabilities)
+ (server-info
+ :documentation "JSON object containing server info."
+ :accessor eglot--server-info)
+ (shutdown-requested
+ :documentation "Flag set when server is shutting down."
+ :accessor eglot--shutdown-requested)
+ (project
+ :documentation "Project associated with server."
+ :accessor eglot--project)
+ (spinner
+ :documentation "List (ID DOING-WHAT DONE-P) representing server progress."
+ :initform `(nil nil t) :accessor eglot--spinner)
+ (inhibit-autoreconnect
+ :initform t
+ :documentation "Generalized boolean inhibiting auto-reconnection if true."
+ :accessor eglot--inhibit-autoreconnect)
+ (file-watches
+ :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'."
+ :initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
+ (managed-buffers
+ :documentation "List of buffers managed by server."
+ :accessor eglot--managed-buffers)
+ (saved-initargs
+ :documentation "Saved initargs for reconnection purposes."
+ :accessor eglot--saved-initargs)
+ (inferior-process
+ :documentation "Server subprocess started automatically."
+ :accessor eglot--inferior-process))
:documentation
"Represents a server. Wraps a process for LSP communication.")
@@ -855,14 +859,14 @@ If PRESERVE-BUFFERS is non-nil (interactively, when called with a
prefix argument), do not kill events and output buffers of
SERVER."
(interactive (list (eglot--read-server "Shutdown which server"
- (eglot-current-server))
- t nil current-prefix-arg))
+ (eglot-current-server))
+ t nil current-prefix-arg))
(eglot--message "Asking %s politely to terminate" (jsonrpc-name server))
(unwind-protect
- (progn
- (setf (eglot--shutdown-requested server) t)
- (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5))
- (jsonrpc-notify server :exit nil))
+ (progn
+ (setf (eglot--shutdown-requested server) t)
+ (jsonrpc-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))
(unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server)))))
@@ -872,33 +876,33 @@ SERVER."
PRESERVE-BUFFERS as in `eglot-shutdown', which see."
(interactive (list current-prefix-arg))
(cl-loop for ss being the hash-values of eglot--servers-by-project
- do (cl-loop for s in ss do (eglot-shutdown s nil preserve-buffers))))
+ do (cl-loop for s in ss do (eglot-shutdown s nil preserve-buffers))))
(defun eglot--on-shutdown (server)
"Called by jsonrpc.el when SERVER is already dead."
;; Turn off `eglot--managed-mode' where appropriate.
(dolist (buffer (eglot--managed-buffers server))
(let (;; Avoid duplicate shutdowns (github#389)
- (eglot-autoshutdown nil))
+ (eglot-autoshutdown nil))
(eglot--when-live-buffer buffer (eglot--managed-mode-off))))
;; Kill any expensive watches
(maphash (lambda (_id watches)
(mapcar #'file-notify-rm-watch watches))
- (eglot--file-watches server))
+ (eglot--file-watches server))
;; Kill any autostarted inferior processes
(when-let (proc (eglot--inferior-process server))
(delete-process proc))
;; Sever the project/server relationship for `server'
(setf (gethash (eglot--project server) eglot--servers-by-project)
- (delq server
- (gethash (eglot--project server) eglot--servers-by-project)))
+ (delq server
+ (gethash (eglot--project server) eglot--servers-by-project)))
(cond ((eglot--shutdown-requested server)
- t)
- ((not (eglot--inhibit-autoreconnect server))
- (eglot--warn "Reconnecting after unexpected server exit.")
- (eglot-reconnect server))
- ((timerp (eglot--inhibit-autoreconnect server))
- (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
+ t)
+ ((not (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Reconnecting after unexpected server exit.")
+ (eglot-reconnect server))
+ ((timerp (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
(defun eglot--all-major-modes ()
"Return all known major modes."
@@ -925,25 +929,25 @@ LANGUAGE-ID is determined from MODE's name.
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)
+ 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
+ (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))))
+ (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)))
+ (if (or (symbolp modes) (keywordp (cadr modes)))
(list modes) modes))))
(defun eglot--guess-contact (&optional interactive)
@@ -952,76 +956,76 @@ 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))
- (main-mode
- (cond
- ((and interactive
+ (main-mode
+ (cond
+ ((and interactive
(or (>= (prefix-numeric-value current-prefix-arg) 16)
- (not guessed-mode)))
- (intern
- (completing-read
- "[eglot] Start a server to manage buffers of what major mode? "
- (mapcar #'symbol-name (eglot--all-major-modes)) nil t
- (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
- ((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))
- (guess (if (functionp guess)
- (funcall guess interactive)
- guess))
- (class (or (and (consp guess) (symbolp (car guess))
- (prog1 (unless current-prefix-arg (car guess))
- (setq guess (cdr guess))))
- 'eglot-lsp-server))
- (program (and (listp guess)
- (stringp (car guess))
- ;; A second element might be the port of a (host, port)
- ;; pair, but in that case it is not a string.
- (or (null (cdr guess)) (stringp (cadr guess)))
- (car guess)))
- (base-prompt
- (and interactive
- "Enter program to execute (or <host>:<port>): "))
- (full-program-invocation
- (and program
- (cl-every #'stringp guess)
- (combine-and-quote-strings guess)))
- (prompt
- (and base-prompt
- (cond (current-prefix-arg base-prompt)
- ((null guess)
- (format "[eglot] Sorry, couldn't guess for `%s'!\n%s"
- main-mode base-prompt))
- ((and program
- (not (file-name-absolute-p program))
- (not (eglot--executable-find program t)))
- (if full-program-invocation
- (concat (format "[eglot] I guess you want to run `%s'"
- full-program-invocation)
- (format ", but I can't find `%s' in PATH!"
- program)
- "\n" base-prompt)
- (eglot--error
- (concat "`%s' not found in PATH, but can't form"
- " an interactive prompt for to fix %s!")
- program guess))))))
- (contact
- (or (and prompt
- (split-string-and-unquote
+ (not guessed-mode)))
+ (intern
+ (completing-read
+ "[eglot] Start a server to manage buffers of what major mode? "
+ (mapcar #'symbol-name (eglot--all-major-modes)) nil t
+ (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
+ ((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))
+ (guess (if (functionp guess)
+ (funcall guess interactive)
+ guess))
+ (class (or (and (consp guess) (symbolp (car guess))
+ (prog1 (unless current-prefix-arg (car guess))
+ (setq guess (cdr guess))))
+ 'eglot-lsp-server))
+ (program (and (listp guess)
+ (stringp (car guess))
+ ;; A second element might be the port of a (host, port)
+ ;; pair, but in that case it is not a string.
+ (or (null (cdr guess)) (stringp (cadr guess)))
+ (car guess)))
+ (base-prompt
+ (and interactive
+ "Enter program to execute (or <host>:<port>): "))
+ (full-program-invocation
+ (and program
+ (cl-every #'stringp guess)
+ (combine-and-quote-strings guess)))
+ (prompt
+ (and base-prompt
+ (cond (current-prefix-arg base-prompt)
+ ((null guess)
+ (format "[eglot] Sorry, couldn't guess for `%s'!\n%s"
+ main-mode base-prompt))
+ ((and program
+ (not (file-name-absolute-p program))
+ (not (eglot--executable-find program t)))
+ (if full-program-invocation
+ (concat (format "[eglot] I guess you want to run `%s'"
+ full-program-invocation)
+ (format ", but I can't find `%s' in PATH!"
+ program)
+ "\n" base-prompt)
+ (eglot--error
+ (concat "`%s' not found in PATH, but can't form"
+ " an interactive prompt for to fix %s!")
+ program guess))))))
+ (contact
+ (or (and prompt
+ (split-string-and-unquote
(read-shell-command
- prompt
- full-program-invocation
- 'eglot-command-history)))
+ prompt
+ full-program-invocation
+ 'eglot-command-history)))
guess)))
(list managed-modes (eglot--current-project) class contact language-id)))
(defvar eglot-lsp-context)
(put 'eglot-lsp-context 'variable-documentation
- "Dynamically non-nil when searching for projects in LSP context.")
+ "Dynamically non-nil when searching for projects in LSP context.")
(defvar eglot--servers-by-xrefed-file
(make-hash-table :test 'equal :weakness 'value))
@@ -1038,7 +1042,7 @@ suitable root directory for a given LSP server's purposes."
;;;###autoload
(defun eglot (managed-major-mode project class contact language-id
- &optional interactive)
+ &optional interactive)
"Manage a project with a Language Server Protocol (LSP) server.
The LSP server of CLASS is started (or contacted) via CONTACT.
@@ -1074,11 +1078,11 @@ 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))
- (live-p (and current-server (jsonrpc-running-p current-server))))
+ (live-p (and current-server (jsonrpc-running-p current-server))))
(if (and live-p
- interactive
- (y-or-n-p "[eglot] Live process found, reconnect instead? "))
- (eglot-reconnect current-server interactive)
+ interactive
+ (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 language-id))))
@@ -1089,10 +1093,10 @@ INTERACTIVE is t if called interactively."
(when (jsonrpc-running-p server)
(ignore-errors (eglot-shutdown server interactive nil 'preserve-buffers)))
(eglot--connect (eglot--major-modes server)
- (eglot--project server)
- (eieio-object-class-name server)
- (eglot--saved-initargs server)
- (eglot--language-id server))
+ (eglot--project server)
+ (eieio-object-class-name server)
+ (eglot--saved-initargs server)
+ (eglot--language-id server))
(eglot--message "Reconnected!"))
(defvar eglot--managed-mode) ; forward decl
@@ -1102,12 +1106,12 @@ INTERACTIVE is t if called interactively."
"Start Eglot session for current buffer if there isn't one."
(let ((buffer (current-buffer)))
(cl-labels
- ((maybe-connect
- ()
- (remove-hook 'post-command-hook #'maybe-connect nil)
- (eglot--when-live-buffer buffer
- (unless eglot--managed-mode
- (apply #'eglot--connect (eglot--guess-contact))))))
+ ((maybe-connect
+ ()
+ (remove-hook 'post-command-hook #'maybe-connect nil)
+ (eglot--when-live-buffer buffer
+ (unless eglot--managed-mode
+ (apply #'eglot--connect (eglot--guess-contact))))))
(when buffer-file-name
(add-hook 'post-command-hook #'maybe-connect 'append nil)))))
@@ -1117,8 +1121,8 @@ Use current server's or first available Eglot events buffer."
(interactive (list (eglot-current-server)))
(let ((buffer (if server (jsonrpc-events-buffer server)
(cl-find "\\*EGLOT.*events\\*"
- (buffer-list)
- :key #'buffer-name :test #'string-match))))
+ (buffer-list)
+ :key #'buffer-name :test #'string-match))))
(if buffer (display-buffer buffer)
(eglot--error "Can't find an Eglot events buffer!"))))
@@ -1150,16 +1154,16 @@ 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))
- " "))
+ ;; 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))
(defvar-local eglot--cached-server nil
@@ -1169,64 +1173,64 @@ Each function is passed the server as an argument")
"Connect to MANAGED-MODES, 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)))
- (readable-name (format "EGLOT (%s/%s)" nickname managed-modes))
- autostart-inferior-process
- server-info
- (contact (if (functionp contact) (funcall contact) contact))
- (initargs
- (cond ((keywordp (car contact)) contact)
- ((integerp (cadr contact))
- (setq server-info (list (format "%s:%s" (car contact)
- (cadr contact))))
- `(:process ,(lambda ()
- (apply #'open-network-stream
- readable-name nil
- (car contact) (cadr contact)
- (cddr contact)))))
- ((and (stringp (car contact)) (memq :autoport contact))
- (setq server-info (list "<inferior process>"))
- `(:process ,(lambda ()
- (pcase-let ((`(,connection . ,inferior)
+ (nickname (file-name-base (directory-file-name default-directory)))
+ (readable-name (format "EGLOT (%s/%s)" nickname managed-modes))
+ autostart-inferior-process
+ server-info
+ (contact (if (functionp contact) (funcall contact) contact))
+ (initargs
+ (cond ((keywordp (car contact)) contact)
+ ((integerp (cadr contact))
+ (setq server-info (list (format "%s:%s" (car contact)
+ (cadr contact))))
+ `(:process ,(lambda ()
+ (apply #'open-network-stream
+ readable-name nil
+ (car contact) (cadr contact)
+ (cddr contact)))))
+ ((and (stringp (car contact)) (memq :autoport contact))
+ (setq server-info (list "<inferior process>"))
+ `(:process ,(lambda ()
+ (pcase-let ((`(,connection . ,inferior)
(eglot--inferior-bootstrap
- readable-name
- contact)))
- (setq autostart-inferior-process inferior)
- connection))))
- ((stringp (car contact))
- (let* ((probe (cl-position-if #'keywordp contact))
+ readable-name
+ contact)))
+ (setq autostart-inferior-process inferior)
+ connection))))
+ ((stringp (car contact))
+ (let* ((probe (cl-position-if #'keywordp contact))
(more-initargs (and probe (cl-subseq contact probe)))
(contact (cl-subseq contact 0 probe)))
- `(:process
+ `(:process
,(lambda ()
(let ((default-directory default-directory))
(make-process
- :name readable-name
- :command (setq server-info (eglot--cmd contact))
- :connection-type 'pipe
- :coding 'utf-8-emacs-unix
- :noquery t
- :stderr (get-buffer-create
- (format "*%s stderr*" readable-name))
- :file-handler t)))
+ :name readable-name
+ :command (setq server-info (eglot--cmd contact))
+ :connection-type 'pipe
+ :coding 'utf-8-emacs-unix
+ :noquery t
+ :stderr (get-buffer-create
+ (format "*%s stderr*" readable-name))
+ :file-handler t)))
,@more-initargs)))))
- (spread (lambda (fn) (lambda (server method params)
- (let ((eglot--cached-server server))
- (apply fn server method (append params nil))))))
- (server
- (apply
- #'make-instance class
- :name readable-name
- :events-buffer-scrollback-size eglot-events-buffer-size
- :notification-dispatcher (funcall spread #'eglot-handle-notification)
- :request-dispatcher (funcall spread #'eglot-handle-request)
- :on-shutdown #'eglot--on-shutdown
- initargs))
- (cancelled nil)
- (tag (make-symbol "connected-catch-tag")))
+ (spread (lambda (fn) (lambda (server method params)
+ (let ((eglot--cached-server server))
+ (apply fn server method (append params nil))))))
+ (server
+ (apply
+ #'make-instance class
+ :name readable-name
+ :events-buffer-scrollback-size eglot-events-buffer-size
+ :notification-dispatcher (funcall spread #'eglot-handle-notification)
+ :request-dispatcher (funcall spread #'eglot-handle-request)
+ :on-shutdown #'eglot--on-shutdown
+ initargs))
+ (cancelled nil)
+ (tag (make-symbol "connected-catch-tag")))
(when server-info
(jsonrpc--debug server "Running language server: %s"
- (string-join server-info " ")))
+ (string-join server-info " ")))
(setf (eglot--saved-initargs server) initargs)
(setf (eglot--project server) project)
(setf (eglot--project-nickname server) nickname)
@@ -1238,91 +1242,91 @@ This docstring appeases checkdoc, that's all."
;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
;; and mimic most of `jsonrpc-request'.
(unwind-protect
- (condition-case _quit
- (let ((retval
- (catch tag
- (jsonrpc-async-request
- server
- :initialize
- (list :processId
- (unless (or eglot-withhold-process-id
- (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 (file-local-name
- (expand-file-name default-directory))
- :rootUri (eglot--path-to-uri default-directory)
- :initializationOptions (eglot-initialization-options
- server)
- :capabilities (eglot-client-capabilities server)
- :workspaceFolders (eglot-workspace-folders server))
- :success-fn
- (eglot--lambda ((InitializeResult) capabilities serverInfo)
- (unless cancelled
- (push server
- (gethash project eglot--servers-by-project))
- (setf (eglot--capabilities server) capabilities)
- (setf (eglot--server-info server) serverInfo)
- (jsonrpc-notify server :initialized eglot--{})
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- ;; No need to pass SERVER as an argument: it has
- ;; been registered in `eglot--servers-by-project',
- ;; so that it can be found (and cached) from
- ;; `eglot--maybe-activate-editing-mode' in any
- ;; managed buffer.
- (eglot--maybe-activate-editing-mode)))
- (setf (eglot--inhibit-autoreconnect server)
- (cond
- ((booleanp eglot-autoreconnect)
- (not eglot-autoreconnect))
- ((cl-plusp eglot-autoreconnect)
- (run-with-timer
- eglot-autoreconnect nil
- (lambda ()
- (setf (eglot--inhibit-autoreconnect server)
- (null eglot-autoreconnect)))))))
- (let ((default-directory (project-root project))
- (major-mode (car managed-modes)))
- (hack-dir-local-variables-non-file-buffer)
- (run-hook-with-args 'eglot-connect-hook server))
- (eglot--message
- "Connected! Server `%s' now managing `%s' buffers \
+ (condition-case _quit
+ (let ((retval
+ (catch tag
+ (jsonrpc-async-request
+ server
+ :initialize
+ (list :processId
+ (unless (or eglot-withhold-process-id
+ (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 (file-local-name
+ (expand-file-name default-directory))
+ :rootUri (eglot--path-to-uri default-directory)
+ :initializationOptions (eglot-initialization-options
+ server)
+ :capabilities (eglot-client-capabilities server)
+ :workspaceFolders (eglot-workspace-folders server))
+ :success-fn
+ (eglot--lambda ((InitializeResult) capabilities serverInfo)
+ (unless cancelled
+ (push server
+ (gethash project eglot--servers-by-project))
+ (setf (eglot--capabilities server) capabilities)
+ (setf (eglot--server-info server) serverInfo)
+ (jsonrpc-notify server :initialized eglot--{})
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ ;; No need to pass SERVER as an argument: it has
+ ;; been registered in `eglot--servers-by-project',
+ ;; so that it can be found (and cached) from
+ ;; `eglot--maybe-activate-editing-mode' in any
+ ;; managed buffer.
+ (eglot--maybe-activate-editing-mode)))
+ (setf (eglot--inhibit-autoreconnect server)
+ (cond
+ ((booleanp eglot-autoreconnect)
+ (not eglot-autoreconnect))
+ ((cl-plusp eglot-autoreconnect)
+ (run-with-timer
+ eglot-autoreconnect nil
+ (lambda ()
+ (setf (eglot--inhibit-autoreconnect server)
+ (null eglot-autoreconnect)))))))
+ (let ((default-directory (project-root project))
+ (major-mode (car managed-modes)))
+ (hack-dir-local-variables-non-file-buffer)
+ (run-hook-with-args 'eglot-connect-hook server))
+ (eglot--message
+ "Connected! Server `%s' now managing `%s' buffers \
in project `%s'."
- (or (plist-get serverInfo :name)
- (jsonrpc-name server))
- managed-modes
- (eglot-project-nickname server))
- (when tag (throw tag t))))
- :timeout eglot-connect-timeout
- :error-fn (eglot--lambda ((ResponseError) code message)
+ (or (plist-get serverInfo :name)
+ (jsonrpc-name server))
+ managed-modes
+ (eglot-project-nickname server))
+ (when tag (throw tag t))))
+ :timeout eglot-connect-timeout
+ :error-fn (eglot--lambda ((ResponseError) code message)
+ (unless cancelled
+ (jsonrpc-shutdown server)
+ (let ((msg (format "%s: %s" code message)))
+ (if tag (throw tag `(error . ,msg))
+ (eglot--error msg)))))
+ :timeout-fn (lambda ()
(unless cancelled
(jsonrpc-shutdown server)
- (let ((msg (format "%s: %s" code message)))
+ (let ((msg (format "Timed out after %s seconds"
+ eglot-connect-timeout)))
(if tag (throw tag `(error . ,msg))
- (eglot--error msg)))))
- :timeout-fn (lambda ()
- (unless cancelled
- (jsonrpc-shutdown server)
- (let ((msg (format "Timed out after %s seconds"
- eglot-connect-timeout)))
- (if tag (throw tag `(error . ,msg))
- (eglot--error msg))))))
- (cond ((numberp eglot-sync-connect)
- (accept-process-output nil eglot-sync-connect))
- (eglot-sync-connect
- (while t (accept-process-output
- nil eglot-connect-timeout)))))))
- (pcase retval
- (`(error . ,msg) (eglot--error msg))
- (`nil (eglot--message "Waiting in background for server `%s'"
- (jsonrpc-name server))
- nil)
- (_ server)))
- (quit (jsonrpc-shutdown server) (setq cancelled 'quit)))
+ (eglot--error msg))))))
+ (cond ((numberp eglot-sync-connect)
+ (accept-process-output nil eglot-sync-connect))
+ (eglot-sync-connect
+ (while t (accept-process-output
+ nil eglot-connect-timeout)))))))
+ (pcase retval
+ (`(error . ,msg) (eglot--error msg))
+ (`nil (eglot--message "Waiting in background for server `%s'"
+ (jsonrpc-name server))
+ nil)
+ (_ server)))
+ (quit (jsonrpc-shutdown server) (setq cancelled 'quit)))
(setq tag nil))))
(defun eglot--inferior-bootstrap (name contact &optional connect-args)
@@ -1332,47 +1336,47 @@ Name both based on NAME.
CONNECT-ARGS are passed as additional arguments to
`open-network-stream'."
(let* ((port-probe (make-network-process :name "eglot-port-probe-dummy"
- :server t
- :host "localhost"
- :service 0))
- (port-number (unwind-protect
- (process-contact port-probe :service)
- (delete-process port-probe)))
- inferior connection)
+ :server t
+ :host "localhost"
+ :service 0))
+ (port-number (unwind-protect
+ (process-contact port-probe :service)
+ (delete-process port-probe)))
+ inferior connection)
(unwind-protect
- (progn
- (setq inferior
- (make-process
- :name (format "autostart-inferior-%s" name)
- :stderr (format "*%s stderr*" name)
- :noquery t
- :command (cl-subst
- (format "%s" port-number) :autoport contact)))
- (setq connection
- (cl-loop
- repeat 10 for i from 1
- do (accept-process-output nil 0.5)
- while (process-live-p inferior)
- do (eglot--message
- "Trying to connect to localhost and port %s (attempt %s)"
- port-number i)
- thereis (ignore-errors
- (apply #'open-network-stream
- (format "autoconnect-%s" name)
- nil
- "localhost" port-number connect-args))))
- (cons connection inferior))
+ (progn
+ (setq inferior
+ (make-process
+ :name (format "autostart-inferior-%s" name)
+ :stderr (format "*%s stderr*" name)
+ :noquery t
+ :command (cl-subst
+ (format "%s" port-number) :autoport contact)))
+ (setq connection
+ (cl-loop
+ repeat 10 for i from 1
+ do (accept-process-output nil 0.5)
+ while (process-live-p inferior)
+ do (eglot--message
+ "Trying to connect to localhost and port %s (attempt %s)"
+ port-number i)
+ thereis (ignore-errors
+ (apply #'open-network-stream
+ (format "autoconnect-%s" name)
+ nil
+ "localhost" port-number connect-args))))
+ (cons connection inferior))
(cond ((and (process-live-p connection)
- (process-live-p inferior))
- (eglot--message "Done, connected to %s!" port-number))
- (t
- (when inferior (delete-process inferior))
- (when connection (delete-process connection))
- (eglot--error "Could not start and connect to server%s"
- (if inferior
- (format " started with %s"
- (process-command inferior))
- "!")))))))
+ (process-live-p inferior))
+ (eglot--message "Done, connected to %s!" port-number))
+ (t
+ (when inferior (delete-process inferior))
+ (when connection (delete-process connection))
+ (eglot--error "Could not start and connect to server%s"
+ (if inferior
+ (format " started with %s"
+ (process-command inferior))
+ "!")))))))
\f
;;; Helpers (move these to API?)
@@ -1407,17 +1411,17 @@ fully LSP-compliant servers, this should be set to
"Calculate current COLUMN as defined by the LSP spec.
LBP defaults to `line-beginning-position'."
(/ (- (length (encode-coding-region (or lbp (line-beginning-position))
- ;; Fix github#860
- (min (point) (point-max)) 'utf-16 t))
- 2)
- 2))
+ ;; Fix github#860
+ (min (point) (point-max)) 'utf-16 t))
+ 2)
+ 2))
(defun eglot--pos-to-lsp-position (&optional pos)
"Convert point POS to LSP position."
(eglot--widening
- (list :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE
- :character (progn (when pos (goto-char pos))
- (funcall eglot-current-column-function)))))
+ (list :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE
+ :character (progn (when pos (goto-char pos))
+ (funcall eglot-current-column-function)))))
(defvar eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column
"Function to move to a column reported by the LSP server.
@@ -1439,22 +1443,22 @@ be set to `eglot-move-to-lsp-abiding-column' (the default), and
;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296,
;; github#297)
(goto-char (min (+ (line-beginning-position) column)
- (line-end-position))))
+ (line-end-position))))
(defun eglot-move-to-lsp-abiding-column (column)
"Move to COLUMN abiding by the LSP spec."
(save-restriction
(cl-loop
- with lbp = (line-beginning-position)
- initially
- (narrow-to-region lbp (line-end-position))
- (move-to-column column)
- for diff = (- column
+ with lbp = (line-beginning-position)
+ initially
+ (narrow-to-region lbp (line-end-position))
+ (move-to-column column)
+ for diff = (- column
(eglot-lsp-abiding-column lbp))
- until (zerop diff)
- do (condition-case eob-err
- (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2))
- (end-of-buffer (cl-return eob-err))))))
+ until (zerop diff)
+ do (condition-case eob-err
+ (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2))
+ (end-of-buffer (cl-return eob-err))))))
(defun eglot--lsp-position-to-point (pos-plist &optional marker)
"Convert LSP position POS-PLIST to Emacs point.
@@ -1464,14 +1468,14 @@ If optional MARKER, return a marker instead"
(widen)
(goto-char (point-min))
(forward-line (min most-positive-fixnum
- (plist-get pos-plist :line)))
+ (plist-get pos-plist :line)))
(unless (eobp) ;; if line was excessive leave point at eob
(let ((tab-width 1)
- (col (plist-get pos-plist :character)))
+ (col (plist-get pos-plist :character)))
(unless (wholenump col)
(eglot--warn
- "Caution: LSP server sent invalid character position %s. Using 0 instead."
- col)
+ "Caution: LSP server sent invalid character position %s. Using 0 instead."
+ col)
(setq col 0))
(funcall eglot-move-to-column-function col)))
(if marker (copy-marker (point-marker)) (point)))))
@@ -1486,50 +1490,50 @@ If optional MARKER, return a marker instead"
"URIfy PATH."
(let ((truepath (file-truename path)))
(concat "file://"
- ;; Add a leading "/" for local MS Windows-style paths.
- (if (and (eq system-type 'windows-nt)
- (not (file-remote-p truepath)))
- "/")
- (url-hexify-string
- ;; Again watch out for trampy paths.
- (directory-file-name (file-local-name truepath))
- eglot--uri-path-allowed-chars))))
+ ;; Add a leading "/" for local MS Windows-style paths.
+ (if (and (eq system-type 'windows-nt)
+ (not (file-remote-p truepath)))
+ "/")
+ (url-hexify-string
+ ;; Again watch out for trampy paths.
+ (directory-file-name (file-local-name truepath))
+ eglot--uri-path-allowed-chars))))
(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)))
(let* ((server (eglot-current-server))
- (remote-prefix (and server (eglot--trampish-p server)))
- (retval (url-unhex-string (url-filename (url-generic-parse-url uri))))
- ;; Remove the leading "/" for local MS Windows-style paths.
- (normalized (if (and (not remote-prefix)
- (eq system-type 'windows-nt)
- (cl-plusp (length retval)))
- (substring retval 1)
- retval)))
+ (remote-prefix (and server (eglot--trampish-p server)))
+ (retval (url-unhex-string (url-filename (url-generic-parse-url uri))))
+ ;; Remove the leading "/" for local MS Windows-style paths.
+ (normalized (if (and (not remote-prefix)
+ (eq system-type 'windows-nt)
+ (cl-plusp (length retval)))
+ (substring retval 1)
+ retval)))
(concat remote-prefix normalized)))
(defun eglot--snippet-expansion-fn ()
"Compute a function to expand snippets.
Doubles as an indicator of snippet support."
(and (boundp 'yas-minor-mode)
- (symbol-value 'yas-minor-mode)
- 'yas-expand-snippet))
+ (symbol-value 'yas-minor-mode)
+ 'yas-expand-snippet))
(defun eglot--format-markup (markup)
"Format MARKUP according to LSP's spec."
(pcase-let ((`(,string ,mode)
- (if (stringp markup) (list markup 'gfm-view-mode)
- (list (plist-get markup :value)
- (pcase (plist-get markup :kind)
- ("markdown" 'gfm-view-mode)
- ("plaintext" 'text-mode)
- (_ major-mode))))))
+ (if (stringp markup) (list markup 'gfm-view-mode)
+ (list (plist-get markup :value)
+ (pcase (plist-get markup :kind)
+ ("markdown" 'gfm-view-mode)
+ ("plaintext" 'text-mode)
+ (_ major-mode))))))
(with-temp-buffer
(setq-local markdown-fontify-code-blocks-natively t)
(insert string)
(let ((inhibit-message t)
- (message-log-max nil))
+ (message-log-max nil))
(ignore-errors (delay-mode-hooks (funcall mode))))
(font-lock-ensure)
(string-trim (buffer-string)))))
@@ -1543,49 +1547,50 @@ You could add, for instance, the symbol
`:documentHighlightProvider' to prevent automatic highlighting
under cursor."
:type '(set
- :tag "Tick the ones you're not interested in"
- (const :tag "Documentation on hover" :hoverProvider)
- (const :tag "Code completion" :completionProvider)
- (const :tag "Function signature help" :signatureHelpProvider)
- (const :tag "Go to definition" :definitionProvider)
- (const :tag "Go to type definition" :typeDefinitionProvider)
- (const :tag "Go to implementation" :implementationProvider)
- (const :tag "Go to declaration" :implementationProvider)
- (const :tag "Find references" :referencesProvider)
- (const :tag "Highlight symbols automatically" :documentHighlightProvider)
- (const :tag "List symbols in buffer" :documentSymbolProvider)
- (const :tag "List symbols in workspace" :workspaceSymbolProvider)
- (const :tag "Execute code actions" :codeActionProvider)
- (const :tag "Code lens" :codeLensProvider)
- (const :tag "Format buffer" :documentFormattingProvider)
- (const :tag "Format portion of buffer" :documentRangeFormattingProvider)
- (const :tag "On-type formatting" :documentOnTypeFormattingProvider)
- (const :tag "Rename symbol" :renameProvider)
- (const :tag "Highlight links in document" :documentLinkProvider)
- (const :tag "Decorate color references" :colorProvider)
- (const :tag "Fold regions of buffer" :foldingRangeProvider)
- (const :tag "Execute custom commands" :executeCommandProvider)))
+ :tag "Tick the ones you're not interested in"
+ (const :tag "Documentation on hover" :hoverProvider)
+ (const :tag "Code completion" :completionProvider)
+ (const :tag "Function signature help" :signatureHelpProvider)
+ (const :tag "Go to definition" :definitionProvider)
+ (const :tag "Go to type definition" :typeDefinitionProvider)
+ (const :tag "Go to implementation" :implementationProvider)
+ (const :tag "Go to declaration" :implementationProvider)
+ (const :tag "Find references" :referencesProvider)
+ (const :tag "Highlight symbols automatically" :documentHighlightProvider)
+ (const :tag "List symbols in buffer" :documentSymbolProvider)
+ (const :tag "List symbols in workspace" :workspaceSymbolProvider)
+ (const :tag "Execute code actions" :codeActionProvider)
+ (const :tag "Code lens" :codeLensProvider)
+ (const :tag "Inlay Hint" :inlayHintProvider)
+ (const :tag "Format buffer" :documentFormattingProvider)
+ (const :tag "Format portion of buffer" :documentRangeFormattingProvider)
+ (const :tag "On-type formatting" :documentOnTypeFormattingProvider)
+ (const :tag "Rename symbol" :renameProvider)
+ (const :tag "Highlight links in document" :documentLinkProvider)
+ (const :tag "Decorate color references" :colorProvider)
+ (const :tag "Fold regions of buffer" :foldingRangeProvider)
+ (const :tag "Execute custom commands" :executeCommandProvider)))
(defun eglot--server-capable (&rest feats)
"Determine if current server is capable of FEATS."
(unless (cl-some (lambda (feat)
(memq feat eglot-ignored-server-capabilities))
- feats)
+ feats)
(cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose))
- then (cadr probe)
- for (feat . more) on feats
- for probe = (plist-member caps feat)
- if (not probe) do (cl-return nil)
- if (eq (cadr probe) :json-false) do (cl-return nil)
- if (not (listp (cadr probe))) do (cl-return (if more nil (cadr probe)))
- finally (cl-return (or (cadr probe) t)))))
+ then (cadr probe)
+ for (feat . more) on feats
+ for probe = (plist-member caps feat)
+ if (not probe) do (cl-return nil)
+ if (eq (cadr probe) :json-false) do (cl-return nil)
+ if (not (listp (cadr probe))) do (cl-return (if more nil (cadr probe)))
+ finally (cl-return (or (cadr probe) t)))))
(defun eglot--range-region (range &optional markers)
"Return region (BEG . END) that represents LSP RANGE.
If optional MARKERS, make markers."
(let* ((st (plist-get range :start))
- (beg (eglot--lsp-position-to-point st markers))
- (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
+ (beg (eglot--lsp-position-to-point st markers))
+ (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
(cons beg end)))
(defun eglot--read-server (prompt &optional dont-if-just-the-one)
@@ -1593,26 +1598,26 @@ If optional MARKERS, make markers."
If DONT-IF-JUST-THE-ONE and there's only one server, don't prompt
and just return it. PROMPT shouldn't end with a question mark."
(let ((servers (cl-loop for servers
- being hash-values of eglot--servers-by-project
- append servers))
- (name (lambda (srv)
- (format "%s %s" (eglot-project-nickname srv)
- (eglot--major-modes srv)))))
+ being hash-values of eglot--servers-by-project
+ append servers))
+ (name (lambda (srv)
+ (format "%s %s" (eglot-project-nickname srv)
+ (eglot--major-modes srv)))))
(cond ((null servers)
- (eglot--error "No servers!"))
- ((or (cdr servers) (not dont-if-just-the-one))
- (let* ((default (when-let ((current (eglot-current-server)))
- (funcall name current)))
- (read (completing-read
- (if default
- (format "%s (default %s)? " prompt default)
- (concat prompt "? "))
- (mapcar name servers)
- nil t
- nil nil
- default)))
- (cl-find read servers :key name :test #'equal)))
- (t (car servers)))))
+ (eglot--error "No servers!"))
+ ((or (cdr servers) (not dont-if-just-the-one))
+ (let* ((default (when-let ((current (eglot-current-server)))
+ (funcall name current)))
+ (read (completing-read
+ (if default
+ (format "%s (default %s)? " prompt default)
+ (concat prompt "? "))
+ (mapcar name servers)
+ nil t
+ nil nil
+ default)))
+ (cl-find read servers :key name :test #'equal)))
+ (t (car servers)))))
(defun eglot--trampish-p (server)
"Tell if SERVER's project root is `file-remote-p'."
@@ -1660,9 +1665,9 @@ For example, to keep your Company customization, add the symbol
(defun eglot--stay-out-of-p (symbol)
"Tell if Eglot should stay of of SYMBOL."
(cl-find (symbol-name symbol) eglot-stay-out-of
- :test (lambda (s thing)
- (let ((re (if (symbolp thing) (symbol-name thing) thing)))
- (string-match re s)))))
+ :test (lambda (s thing)
+ (let ((re (if (symbolp thing) (symbol-name thing) thing)))
+ (string-match re s)))))
(defmacro eglot--setq-saving (symbol binding)
`(unless (or (not (boundp ',symbol)) (eglot--stay-out-of-p ',symbol))
@@ -1681,65 +1686,65 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
"Mode for source buffers managed by some Eglot project."
:init-value nil :lighter nil :keymap eglot-mode-map
(cond
- (eglot--managed-mode
- (add-hook 'after-change-functions 'eglot--after-change nil t)
- (add-hook 'before-change-functions 'eglot--before-change nil t)
- (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
- ;; Prepend "didClose" to the hook after the "nonoff", so it will run first
- (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t)
- (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t)
- (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t)
- (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t)
- (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t)
- (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 '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)
- (eglot--setq-saving eldoc-documentation-functions
- '(eglot-signature-eldoc-function
- eglot-hover-eldoc-function))
- (eglot--setq-saving eldoc-documentation-strategy
- #'eldoc-documentation-enthusiast)
- (eglot--setq-saving xref-prompt-for-identifier nil)
- (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend))
- (eglot--setq-saving company-backends '(company-capf))
- (eglot--setq-saving company-tooltip-align-annotations t)
- (unless (eglot--stay-out-of-p 'imenu)
- (add-function :before-until (local 'imenu-create-index-function)
- #'eglot-imenu))
- (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1))
- (unless (eglot--stay-out-of-p 'eldoc) (eldoc-mode 1))
- (cl-pushnew (current-buffer) (eglot--managed-buffers (eglot-current-server))))
- (t
- (remove-hook 'after-change-functions 'eglot--after-change t)
- (remove-hook 'before-change-functions 'eglot--before-change t)
- (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
- (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t)
- (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t)
- (remove-hook 'after-revert-hook 'eglot--after-revert-hook t)
- (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t)
- (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 '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)
- (cl-loop for (var . saved-binding) in eglot--saved-bindings
- do (set (make-local-variable var) saved-binding))
- (remove-function (local 'imenu-create-index-function) #'eglot-imenu)
- (when eglot--current-flymake-report-fn
- (eglot--report-to-flymake nil)
- (setq eglot--current-flymake-report-fn nil))
- (let ((server eglot--cached-server))
- (setq eglot--cached-server nil)
- (when server
- (setf (eglot--managed-buffers server)
- (delq (current-buffer) (eglot--managed-buffers server)))
- (when (and eglot-autoshutdown
- (null (eglot--managed-buffers server)))
- (eglot-shutdown server))))))
+ (eglot--managed-mode
+ (add-hook 'after-change-functions 'eglot--after-change nil t)
+ (add-hook 'before-change-functions 'eglot--before-change nil t)
+ (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
+ ;; Prepend "didClose" to the hook after the "nonoff", so it will run first
+ (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t)
+ (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t)
+ (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t)
+ (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t)
+ (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t)
+ (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 '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)
+ (eglot--setq-saving eldoc-documentation-functions
+ '(eglot-signature-eldoc-function
+ eglot-hover-eldoc-function))
+ (eglot--setq-saving eldoc-documentation-strategy
+ #'eldoc-documentation-enthusiast)
+ (eglot--setq-saving xref-prompt-for-identifier nil)
+ (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend))
+ (eglot--setq-saving company-backends '(company-capf))
+ (eglot--setq-saving company-tooltip-align-annotations t)
+ (unless (eglot--stay-out-of-p 'imenu)
+ (add-function :before-until (local 'imenu-create-index-function)
+ #'eglot-imenu))
+ (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1))
+ (unless (eglot--stay-out-of-p 'eldoc) (eldoc-mode 1))
+ (cl-pushnew (current-buffer) (eglot--managed-buffers (eglot-current-server))))
+ (t
+ (remove-hook 'after-change-functions 'eglot--after-change t)
+ (remove-hook 'before-change-functions 'eglot--before-change t)
+ (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
+ (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t)
+ (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t)
+ (remove-hook 'after-revert-hook 'eglot--after-revert-hook t)
+ (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t)
+ (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 '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)
+ (cl-loop for (var . saved-binding) in eglot--saved-bindings
+ do (set (make-local-variable var) saved-binding))
+ (remove-function (local 'imenu-create-index-function) #'eglot-imenu)
+ (when eglot--current-flymake-report-fn
+ (eglot--report-to-flymake nil)
+ (setq eglot--current-flymake-report-fn nil))
+ (let ((server eglot--cached-server))
+ (setq eglot--cached-server nil)
+ (when server
+ (setf (eglot--managed-buffers server)
+ (delq (current-buffer) (eglot--managed-buffers server)))
+ (when (and eglot-autoshutdown
+ (null (eglot--managed-buffers server)))
+ (eglot-shutdown server))))))
;; Note: the public hook runs before the internal eglot--managed-mode-hook.
(run-hooks 'eglot-managed-mode-hook))
@@ -1750,20 +1755,20 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
(defun eglot-current-server ()
"Return logical Eglot server for current buffer, nil if none."
(setq eglot--cached-server
- (or eglot--cached-server
- (cl-find major-mode
- (gethash (eglot--current-project) eglot--servers-by-project)
- :key #'eglot--major-modes
- :test #'memq)
- (and eglot-extend-to-xref
- buffer-file-name
- (gethash (expand-file-name buffer-file-name)
- eglot--servers-by-xrefed-file)))))
+ (or eglot--cached-server
+ (cl-find major-mode
+ (gethash (eglot--current-project) eglot--servers-by-project)
+ :key #'eglot--major-modes
+ :test #'memq)
+ (and eglot-extend-to-xref
+ buffer-file-name
+ (gethash (expand-file-name buffer-file-name)
+ eglot--servers-by-xrefed-file)))))
(defun eglot--current-server-or-lose ()
"Return current logical Eglot server connection or error."
(or (eglot-current-server)
- (jsonrpc-error "No current JSON-RPC connection")))
+ (jsonrpc-error "No current JSON-RPC connection")))
(defvar-local eglot--diagnostics nil
"Flymake diagnostics for this buffer.")
@@ -1807,7 +1812,7 @@ If it is activated, also signal textDocument/didOpen."
(let ((start (event-start event))) (with-selected-window (posn-window start)
(save-excursion
(goto-char (or (posn-point start)
- (point)))
+ (point)))
(call-interactively what)
(force-mode-line-update t))))))
@@ -1816,131 +1821,138 @@ If it is activated, also signal textDocument/didOpen."
(easy-menu-define eglot-menu nil "Eglot"
`("Eglot"
- ;; Commands for getting information and customization.
- ["Read manual" eglot-manual]
- ["Customize Eglot" (lambda () (interactive) (customize-group "eglot"))]
- "--"
- ;; xref like commands.
- ["Find definitions" xref-find-definitions
- :help "Find definitions of identifier at point"
- :active (eglot--server-capable :definitionProvider)]
- ["Find references" xref-find-references
- :help "Find references to identifier at point"
- :active (eglot--server-capable :referencesProvider)]
- ["Find symbols in workspace (apropos)" xref-find-apropos
- :help "Find symbols matching a query"
- :active (eglot--server-capable :workspaceSymbolProvider)]
- ["Find declaration" eglot-find-declaration
- :help "Find declaration for identifier at point"
- :active (eglot--server-capable :declarationProvider)]
- ["Find implementation" eglot-find-implementation
- :help "Find implementation for identifier at point"
- :active (eglot--server-capable :implementationProvider)]
- ["Find type definition" eglot-find-typeDefinition
- :help "Find type definition for identifier at point"
- :active (eglot--server-capable :typeDefinitionProvider)]
- "--"
- ;; LSP-related commands (mostly Eglot's own commands).
- ["Rename symbol" eglot-rename
- :active (eglot--server-capable :renameProvider)]
- ["Format buffer" eglot-format-buffer
- :active (eglot--server-capable :documentFormattingProvider)]
- ["Format active region" eglot-format
- :active (and (region-active-p)
- (eglot--server-capable :documentRangeFormattingProvider))]
- ["Show Flymake diagnostics for buffer" flymake-show-buffer-diagnostics]
- ["Show Flymake diagnostics for project" flymake-show-project-diagnostics]
- ["Show Eldoc documentation at point" eldoc-doc-buffer]
- "--"
- ["All possible code actions" eglot-code-actions
- :active (eglot--server-capable :codeActionProvider)]
- ["Organize imports" eglot-code-action-organize-imports
- :visible (eglot--server-capable :codeActionProvider)]
- ["Extract" eglot-code-action-extract
- :visible (eglot--server-capable :codeActionProvider)]
- ["Inline" eglot-code-action-inline
- :visible (eglot--server-capable :codeActionProvider)]
- ["Rewrite" eglot-code-action-rewrite
- :visible (eglot--server-capable :codeActionProvider)]
- ["Quickfix" eglot-code-action-quickfix
- :visible (eglot--server-capable :codeActionProvider)]))
+ ;; Commands for getting information and customization.
+ ["Read manual" eglot-manual]
+ ["Customize Eglot" (lambda () (interactive) (customize-group "eglot"))]
+ "--"
+ ;; xref like commands.
+ ["Find definitions" xref-find-definitions
+ :help "Find definitions of identifier at point"
+ :active (eglot--server-capable :definitionProvider)]
+ ["Find references" xref-find-references
+ :help "Find references to identifier at point"
+ :active (eglot--server-capable :referencesProvider)]
+ ["Find symbols in workspace (apropos)" xref-find-apropos
+ :help "Find symbols matching a query"
+ :active (eglot--server-capable :workspaceSymbolProvider)]
+ ["Find declaration" eglot-find-declaration
+ :help "Find declaration for identifier at point"
+ :active (eglot--server-capable :declarationProvider)]
+ ["Find implementation" eglot-find-implementation
+ :help "Find implementation for identifier at point"
+ :active (eglot--server-capable :implementationProvider)]
+ ["Find type definition" eglot-find-typeDefinition
+ :help "Find type definition for identifier at point"
+ :active (eglot--server-capable :typeDefinitionProvider)]
+ "--"
+ ;; LSP-related commands (mostly Eglot's own commands).
+ ["Rename symbol" eglot-rename
+ :active (eglot--server-capable :renameProvider)]
+ ["Format buffer" eglot-format-buffer
+ :active (eglot--server-capable :documentFormattingProvider)]
+ ["Format active region" eglot-format
+ :active (and (region-active-p)
+ (eglot--server-capable :documentRangeFormattingProvider))]
+ ["Show Flymake diagnostics for buffer" flymake-show-buffer-diagnostics]
+ ["Show Flymake diagnostics for project" flymake-show-project-diagnostics]
+ ["Show Eldoc documentation at point" eldoc-doc-buffer]
+ "--"
+ ["All possible code actions" eglot-code-actions
+ :active (eglot--server-capable :codeActionProvider)]
+ ["Organize imports" eglot-code-action-organize-imports
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Extract" eglot-code-action-extract
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Inline" eglot-code-action-inline
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Rewrite" eglot-code-action-rewrite
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Quickfix" eglot-code-action-quickfix
+ :visible (eglot--server-capable :codeActionProvider)]))
(easy-menu-define eglot-server-menu nil "Monitor server communication"
'("Debugging the server communication"
- ["Reconnect to server" eglot-reconnect]
- ["Quit server" eglot-shutdown]
- "--"
- ["LSP events buffer" eglot-events-buffer]
- ["Server stderr buffer" eglot-stderr-buffer]
- ["Customize event buffer size"
- (lambda ()
- (interactive)
- (customize-variable 'eglot-events-buffer-size))]))
+ ["Reconnect to server" eglot-reconnect]
+ ["Quit server" eglot-shutdown]
+ "--"
+ ["LSP events buffer" eglot-events-buffer]
+ ["Server stderr buffer" eglot-stderr-buffer]
+ ["Customize event buffer size"
+ (lambda ()
+ (interactive)
+ (customize-variable 'eglot-events-buffer-size))]))
(defun eglot--mode-line-props (thing face defs &optional prepend)
"Helper for function `eglot--mode-line-format'.
Uses THING, FACE, DEFS and PREPEND."
(cl-loop with map = (make-sparse-keymap)
- for (elem . rest) on defs
- for (key def help) = elem
- do (define-key map `[mode-line ,key] (eglot--mouse-call def))
- concat (format "%s: %s" key help) into blurb
- when rest concat "\n" into blurb
- finally (return `(:propertize ,thing
- face ,face
- keymap ,map help-echo ,(concat prepend blurb)
- mouse-face mode-line-highlight))))
+ for (elem . rest) on defs
+ for (key def help) = elem
+ do (define-key map `[mode-line ,key] (eglot--mouse-call def))
+ concat (format "%s: %s" key help) into blurb
+ when rest concat "\n" into blurb
+ finally (return `(:propertize ,thing
+ face ,face
+ keymap ,map help-echo ,(concat prepend blurb)
+ mouse-face mode-line-highlight))))
(defun eglot--mode-line-format ()
"Compose the Eglot's mode-line."
(pcase-let* ((server (eglot-current-server))
- (nick (and server (eglot-project-nickname server)))
- (pending (and server (hash-table-count
- (jsonrpc--request-continuations server))))
- (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner server)))
- (last-error (and server (jsonrpc-last-error server))))
+ (nick (and server (eglot-project-nickname server)))
+ (pending (and server (hash-table-count
+ (jsonrpc--request-continuations server))))
+ (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner server)))
+ (last-error (and server (jsonrpc-last-error server))))
(append
- `(,(propertize
- eglot-menu-string
- 'face 'eglot-mode-line
- 'mouse-face 'mode-line-highlight
- 'help-echo "Eglot: Emacs LSP client\nmouse-1: Display minor mode menu"
- 'keymap (let ((map (make-sparse-keymap)))
- (define-key map [mode-line down-mouse-1] eglot-menu)
- map)))
- (when nick
- `(":"
- ,(propertize
- nick
+ `(,(propertize
+ eglot-menu-string
'face 'eglot-mode-line
'mouse-face 'mode-line-highlight
- 'help-echo (format "Project '%s'\nmouse-1: LSP server control menu" nick)
+ 'help-echo "Eglot: Emacs LSP client\nmouse-1: Display minor mode menu"
'keymap (let ((map (make-sparse-keymap)))
- (define-key map [mode-line down-mouse-1] eglot-server-menu)
- map))
- ,@(when last-error
- `("/" ,(eglot--mode-line-props
- "error" 'compilation-mode-line-fail
- '((mouse-3 eglot-clear-status "Clear this status"))
- (format "An error occurred: %s\n" (plist-get last-error
- :message)))))
- ,@(when (and doing (not done-p))
- `("/" ,(eglot--mode-line-props doing
- 'compilation-mode-line-run '())))
- ,@(when (cl-plusp pending)
- `("/" ,(eglot--mode-line-props
- (format "%d" pending) 'warning
- '((mouse-3 eglot-forget-pending-continuations
- "Forget pending continuations"))
- "Number of outgoing, \
+ (define-key map [mode-line down-mouse-1] eglot-menu)
+ map)))
+ (when nick
+ `(":"
+ ,(propertize
+ nick
+ 'face 'eglot-mode-line
+ 'mouse-face 'mode-line-highlight
+ 'help-echo (format "Project '%s'\nmouse-1: LSP server control menu" nick)
+ 'keymap (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line down-mouse-1] eglot-server-menu)
+ map))
+ ,@(when last-error
+ `("/" ,(eglot--mode-line-props
+ "error" 'compilation-mode-line-fail
+ '((mouse-3 eglot-clear-status "Clear this status"))
+ (format "An error occurred: %s\n" (plist-get last-error
+ :message)))))
+ ,@(when (and doing (not done-p))
+ `("/" ,(eglot--mode-line-props doing
+ 'compilation-mode-line-run '())))
+ ,@(when (cl-plusp pending)
+ `("/" ,(eglot--mode-line-props
+ (format "%d" pending) 'warning
+ '((mouse-3 eglot-forget-pending-continuations
+ "Forget pending continuations"))
+ "Number of outgoing, \
still unanswered LSP requests to the server\n"))))))))
(add-to-list 'mode-line-misc-info
- `(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
+ `(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
\f
;;; Flymake customization
;;;
+;; TODO: type hint and different signature hint? (and future proof generic hint?)
+;;(put 'eglot-hint 'flymake-bitmap nil)
+;;(put 'eglot-hint 'severity (warning-numeric-level :debug))
+;;(put 'eglot-hint 'flymake-type-name "hint")
+;;(put 'eglot-hint 'face nil)
+(put 'eglot-hint 'flymake-category 'flymake-note)
+
(put 'eglot-note 'flymake-category 'flymake-note)
(put 'eglot-warning 'flymake-category 'flymake-warning)
(put 'eglot-error 'flymake-category 'flymake-error)
@@ -1949,14 +1961,14 @@ still unanswered LSP requests to the server\n"))))))))
(defalias 'eglot--diag-data 'flymake-diagnostic-data)
(cl-loop for i from 1
- for type in '(eglot-note eglot-warning eglot-error )
- do (put type 'flymake-overlay-control
- `((mouse-face . highlight)
- (priority . ,(+ 50 i))
- (keymap . ,(let ((map (make-sparse-keymap)))
- (define-key map [mouse-1]
- (eglot--mouse-call 'eglot-code-actions))
- map)))))
+ for type in '(eglot-note eglot-warning eglot-error )
+ do (put type 'flymake-overlay-control
+ `((mouse-face . highlight)
+ (priority . ,(+ 50 i))
+ (keymap . ,(let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1]
+ (eglot--mouse-call 'eglot-code-actions))
+ map)))))
\f
;;; Protocol implementation (Requests, notifications, etc)
@@ -1965,7 +1977,7 @@ still unanswered LSP requests to the server\n"))))))))
(_server method &key &allow-other-keys)
"Handle unknown notification."
(unless (or (string-prefix-p "$" (format "%s" method))
- (not (memq 'disallow-unknown-methods eglot-strict-mode)))
+ (not (memq 'disallow-unknown-methods eglot-strict-mode)))
(eglot--warn "Server sent unknown notification method `%s'" method)))
(cl-defmethod eglot-handle-request
@@ -1979,28 +1991,28 @@ still unanswered LSP requests to the server\n"))))))))
"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)))
+ `(:command ,(format "%s" command) :arguments ,arguments)))
(cl-defmethod eglot-handle-notification
(_server (_method (eql window/showMessage)) &key type message)
"Handle notification window/showMessage."
(eglot--message (propertize "Server reports (type=%s): %s"
- 'face (if (<= type 1) 'error))
- type message))
+ 'face (if (<= type 1) 'error))
+ type message))
(cl-defmethod eglot-handle-request
(_server (_method (eql window/showMessageRequest)) &key type message actions)
"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))
- type message)
- "\nChoose an option: ")
- (or (mapcar (lambda (obj) (plist-get obj :title)) actions)
+ (label (completing-read
+ (concat
+ (format (propertize "[eglot] Server reports (type=%s): %s"
+ 'face (if (<= type 1) 'error))
+ type message)
+ "\nChoose an option: ")
+ (or (mapcar (lambda (obj) (plist-get obj :title)) actions)
'("OK"))
- nil t (plist-get (elt actions 0) :title))))
+ nil t (plist-get (elt actions 0) :title))))
(if label `(:title ,label) :null)))
(cl-defmethod eglot-handle-notification
@@ -2013,85 +2025,85 @@ COMMAND is a symbol naming the command."
(cl-defmethod eglot-handle-notification
(_server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics
- &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
+ &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
"Handle notification publishDiagnostics."
(cl-flet ((eglot--diag-type (sev)
(cond ((null sev) 'eglot-error)
- ((<= sev 1) 'eglot-error)
- ((= sev 2) 'eglot-warning)
- (t 'eglot-note)))
- (mess (source code message)
- (concat source (and code (format " [%s]" code)) ": " message)))
+ ((<= sev 1) 'eglot-error)
+ ((= sev 2) 'eglot-warning)
+ (t 'eglot-note)))
+ (mess (source code message)
+ (concat source (and code (format " [%s]" code)) ": " message)))
(if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri))))
- (with-current-buffer buffer
- (cl-loop
- for diag-spec across diagnostics
- collect (eglot--dbind ((Diagnostic) range code message severity source tags)
- diag-spec
- (setq message (mess source code message))
- (pcase-let
- ((`(,beg . ,end) (eglot--range-region range)))
- ;; Fallback to `flymake-diag-region' if server
- ;; botched the range
- (when (= beg end)
- (if-let* ((st (plist-get range :start))
+ (with-current-buffer buffer
+ (cl-loop
+ for diag-spec across diagnostics
+ collect (eglot--dbind ((Diagnostic) range code message severity source tags)
+ diag-spec
+ (setq message (mess source code message))
+ (pcase-let
+ ((`(,beg . ,end) (eglot--range-region range)))
+ ;; Fallback to `flymake-diag-region' if server
+ ;; botched the range
+ (when (= beg end)
+ (if-let* ((st (plist-get range :start))
(diag-region
- (flymake-diag-region
- (current-buffer) (1+ (plist-get st :line))
- (plist-get st :character))))
- (setq beg (car diag-region) end (cdr diag-region))
- (eglot--widening
+ (flymake-diag-region
+ (current-buffer) (1+ (plist-get st :line))
+ (plist-get st :character))))
+ (setq beg (car diag-region) end (cdr diag-region))
+ (eglot--widening
(goto-char (point-min))
(setq beg
- (line-beginning-position
- (1+ (plist-get (plist-get range :start) :line))))
+ (line-beginning-position
+ (1+ (plist-get (plist-get range :start) :line))))
(setq end
- (line-end-position
- (1+ (plist-get (plist-get range :end) :line)))))))
- (eglot--make-diag
+ (line-end-position
+ (1+ (plist-get (plist-get range :end) :line)))))))
+ (eglot--make-diag
(current-buffer) beg end
(eglot--diag-type severity)
message `((eglot-lsp-diag . ,diag-spec))
(when-let ((faces
- (cl-loop for tag across tags
- when (alist-get tag eglot--tag-faces)
- collect it)))
+ (cl-loop for tag across tags
+ when (alist-get tag eglot--tag-faces)
+ collect it)))
`((face . ,faces))))))
- into diags
- finally (cond ((and
+ into diags
+ finally (cond ((and
;; only add to current report if Flymake
;; starts on idle-timer (github#958)
(not (null flymake-no-changes-timeout))
eglot--current-flymake-report-fn)
(eglot--report-to-flymake diags))
- (t
- (setq eglot--diagnostics diags)))))
+ (t
+ (setq eglot--diagnostics diags)))))
(cl-loop
- with path = (expand-file-name (eglot--uri-to-path uri))
- for diag-spec across diagnostics
- collect (eglot--dbind ((Diagnostic) code range message severity source) diag-spec
- (setq message (mess source code message))
- (let* ((start (plist-get range :start))
- (line (1+ (plist-get start :line)))
- (char (1+ (plist-get start :character))))
- (eglot--make-diag
- path (cons line char) nil (eglot--diag-type severity) message)))
- into diags
- finally
- (setq flymake-list-only-diagnostics
- (assoc-delete-all path flymake-list-only-diagnostics #'string=))
- (push (cons path diags) flymake-list-only-diagnostics)))))
+ with path = (expand-file-name (eglot--uri-to-path uri))
+ for diag-spec across diagnostics
+ collect (eglot--dbind ((Diagnostic) code range message severity source) diag-spec
+ (setq message (mess source code message))
+ (let* ((start (plist-get range :start))
+ (line (1+ (plist-get start :line)))
+ (char (1+ (plist-get start :character))))
+ (eglot--make-diag
+ path (cons line char) nil (eglot--diag-type severity) message)))
+ into diags
+ finally
+ (setq flymake-list-only-diagnostics
+ (assoc-delete-all path flymake-list-only-diagnostics #'string=))
+ (push (cons path diags) flymake-list-only-diagnostics)))))
(cl-defun eglot--register-unregister (server things how)
"Helper for `registerCapability'.
THINGS are either registrations or unregisterations (sic)."
(cl-loop
- for thing in (cl-coerce things 'list)
- do (eglot--dbind ((Registration) id method registerOptions) thing
- (apply (cl-ecase how
- (register 'eglot-register-capability)
- (unregister 'eglot-unregister-capability))
- server (intern method) id registerOptions))))
+ for thing in (cl-coerce things 'list)
+ do (eglot--dbind ((Registration) id method registerOptions) thing
+ (apply (cl-ecase how
+ (register 'eglot-register-capability)
+ (unregister 'eglot-unregister-capability))
+ server (intern method) id registerOptions))))
(cl-defmethod eglot-handle-request
(server (_method (eql client/registerCapability)) &key registrations)
@@ -2100,7 +2112,7 @@ THINGS are either registrations or unregisterations (sic)."
(cl-defmethod eglot-handle-request
(server (_method (eql client/unregisterCapability))
- &key unregisterations) ;; XXX: "unregisterations" (sic)
+ &key unregisterations) ;; XXX: "unregisterations" (sic)
"Handle server request client/unregisterCapability."
(eglot--register-unregister server unregisterations 'unregister))
@@ -2118,31 +2130,31 @@ THINGS are either registrations or unregisterations (sic)."
(defun eglot--TextDocumentIdentifier ()
"Compute TextDocumentIdentifier object for current buffer."
`(:uri ,(eglot--path-to-uri (or buffer-file-name
- (ignore-errors
- (buffer-file-name
- (buffer-base-buffer)))))))
+ (ignore-errors
+ (buffer-file-name
+ (buffer-base-buffer)))))))
(defvar-local eglot--versioned-identifier 0)
(defun eglot--VersionedTextDocumentIdentifier ()
"Compute VersionedTextDocumentIdentifier object for current buffer."
(append (eglot--TextDocumentIdentifier)
- `(:version ,eglot--versioned-identifier)))
+ `(:version ,eglot--versioned-identifier)))
(defun eglot--TextDocumentItem ()
"Compute TextDocumentItem object for current buffer."
(append
- (eglot--VersionedTextDocumentIdentifier)
- (list :languageId
- (eglot--language-id (eglot--current-server-or-lose))
- :text
- (eglot--widening
- (buffer-substring-no-properties (point-min) (point-max))))))
+ (eglot--VersionedTextDocumentIdentifier)
+ (list :languageId
+ (eglot--language-id (eglot--current-server-or-lose))
+ :text
+ (eglot--widening
+ (buffer-substring-no-properties (point-min) (point-max))))))
(defun eglot--TextDocumentPositionParams ()
"Compute TextDocumentPositionParams."
(list :textDocument (eglot--TextDocumentIdentifier)
- :position (eglot--pos-to-lsp-position)))
+ :position (eglot--pos-to-lsp-position)))
(defvar-local eglot--last-inserted-char nil
"If non-nil, value of the last inserted character in buffer.")
@@ -2152,12 +2164,12 @@ THINGS are either registrations or unregisterations (sic)."
(setq eglot--last-inserted-char last-input-event)
(let ((ot-provider (eglot--server-capable :documentOnTypeFormattingProvider)))
(when (and ot-provider
- (ignore-errors ; github#906, some LS's send empty strings
- (or (eq last-input-event
- (seq-first (plist-get ot-provider :firstTriggerCharacter)))
- (cl-find last-input-event
- (plist-get ot-provider :moreTriggerCharacter)
- :key #'seq-first))))
+ (ignore-errors ; github#906, some LS's send empty strings
+ (or (eq last-input-event
+ (seq-first (plist-get ot-provider :firstTriggerCharacter)))
+ (cl-find last-input-event
+ (plist-get ot-provider :moreTriggerCharacter)
+ :key #'seq-first))))
(eglot-format (point) nil last-input-event))))
(defvar eglot--workspace-symbols-cache (make-hash-table :test #'equal)
@@ -2170,14 +2182,14 @@ THINGS are either registrations or unregisterations (sic)."
(defun eglot--CompletionParams ()
(append
- (eglot--TextDocumentPositionParams)
- `(:context
- ,(if-let (trigger (and (characterp eglot--last-inserted-char)
- (cl-find eglot--last-inserted-char
- (eglot--server-capable :completionProvider
- :triggerCharacters)
- :key (lambda (str) (aref str 0))
- :test #'char-equal)))
+ (eglot--TextDocumentPositionParams)
+ `(:context
+ ,(if-let (trigger (and (characterp eglot--last-inserted-char)
+ (cl-find eglot--last-inserted-char
+ (eglot--server-capable :completionProvider
+ :triggerCharacters)
+ :key (lambda (str) (aref str 0))
+ :test #'char-equal)))
`(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1)))))
(defvar-local eglot--recent-changes nil
@@ -2198,63 +2210,63 @@ THINGS are either registrations or unregisterations (sic)."
;; deleted/added). Also record markers of BEG and END
;; (github#259)
(push `(,(eglot--pos-to-lsp-position beg)
- ,(eglot--pos-to-lsp-position end)
- (,beg . ,(copy-marker beg nil))
- (,end . ,(copy-marker end t)))
- eglot--recent-changes)))
+ ,(eglot--pos-to-lsp-position end)
+ (,beg . ,(copy-marker beg nil))
+ (,end . ,(copy-marker end t)))
+ eglot--recent-changes)))
(defun eglot--after-change (beg end pre-change-length)
"Hook onto `after-change-functions'.
Records BEG, END and PRE-CHANGE-LENGTH locally."
(cl-incf eglot--versioned-identifier)
(pcase (and (listp eglot--recent-changes)
- (car eglot--recent-changes))
+ (car eglot--recent-changes))
(`(,lsp-beg ,lsp-end
- (,b-beg . ,b-beg-marker)
- (,b-end . ,b-end-marker))
- ;; github#259 and github#367: With `capitalize-word' or somesuch,
- ;; `before-change-functions' always records the whole word's
- ;; `b-beg' and `b-end'. Similarly, when coalescing two lines
- ;; into one, `fill-paragraph' they mark the end of the first line
- ;; up to the end of the second line. In both situations, args
- ;; received here contradict that information: `beg' and `end'
- ;; will differ by 1 and will likely only encompass the letter
- ;; that was capitalized or, in the sentence-joining situation,
- ;; the replacement of the newline with a space. That's we keep
- ;; markers _and_ positions so we're able to detect and correct
- ;; this. We ignore `beg', `len' and `pre-change-len' and send
- ;; "fuller" information about the region from the markers. I've
- ;; also experimented with doing this unconditionally but it seems
- ;; to break when newlines are added.
- (if (and (= b-end b-end-marker) (= b-beg b-beg-marker)
- (or (/= beg b-beg) (/= end b-end)))
- (setcar eglot--recent-changes
- `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker)
- ,(buffer-substring-no-properties b-beg-marker
- b-end-marker)))
- (setcar eglot--recent-changes
- `(,lsp-beg ,lsp-end ,pre-change-length
- ,(buffer-substring-no-properties beg end)))))
+ (,b-beg . ,b-beg-marker)
+ (,b-end . ,b-end-marker))
+ ;; github#259 and github#367: With `capitalize-word' or somesuch,
+ ;; `before-change-functions' always records the whole word's
+ ;; `b-beg' and `b-end'. Similarly, when coalescing two lines
+ ;; into one, `fill-paragraph' they mark the end of the first line
+ ;; up to the end of the second line. In both situations, args
+ ;; received here contradict that information: `beg' and `end'
+ ;; will differ by 1 and will likely only encompass the letter
+ ;; that was capitalized or, in the sentence-joining situation,
+ ;; the replacement of the newline with a space. That's we keep
+ ;; markers _and_ positions so we're able to detect and correct
+ ;; this. We ignore `beg', `len' and `pre-change-len' and send
+ ;; "fuller" information about the region from the markers. I've
+ ;; also experimented with doing this unconditionally but it seems
+ ;; to break when newlines are added.
+ (if (and (= b-end b-end-marker) (= b-beg b-beg-marker)
+ (or (/= beg b-beg) (/= end b-end)))
+ (setcar eglot--recent-changes
+ `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker)
+ ,(buffer-substring-no-properties b-beg-marker
+ b-end-marker)))
+ (setcar eglot--recent-changes
+ `(,lsp-beg ,lsp-end ,pre-change-length
+ ,(buffer-substring-no-properties beg end)))))
(_ (setf eglot--recent-changes :emacs-messup)))
(when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer))
(let ((buf (current-buffer)))
(setq eglot--change-idle-timer
- (run-with-idle-timer
- eglot-send-changes-idle-time
- nil (lambda () (eglot--when-live-buffer buf
- (when eglot--managed-mode
- (eglot--signal-textDocument/didChange)
- (setq eglot--change-idle-timer nil))))))))
+ (run-with-idle-timer
+ eglot-send-changes-idle-time
+ nil (lambda () (eglot--when-live-buffer buf
+ (when eglot--managed-mode
+ (eglot--signal-textDocument/didChange)
+ (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)))
+ (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.
@@ -2291,8 +2303,8 @@ format described above.")
(defun eglot-show-workspace-configuration (&optional server)
"Dump `eglot-workspace-configuration' as JSON for debugging."
(interactive (list (and (eglot-current-server)
- (eglot--read-server "Server configuration"
- (eglot-current-server)))))
+ (eglot--read-server "Server configuration"
+ (eglot-current-server)))))
(let ((conf (eglot--workspace-configuration-plist server)))
(with-current-buffer (get-buffer-create "*EGLOT workspace configuration*")
(erase-buffer)
@@ -2305,83 +2317,83 @@ format described above.")
(defun eglot--workspace-configuration (server)
(if (functionp eglot-workspace-configuration)
- (funcall eglot-workspace-configuration server)
+ (funcall eglot-workspace-configuration server)
eglot-workspace-configuration))
(defun eglot--workspace-configuration-plist (server)
"Returns `eglot-workspace-configuration' suitable for serialization."
(let ((val (eglot--workspace-configuration server)))
(or (and (consp (car val))
- (cl-loop for (section . v) in val
- collect (if (keywordp section) section
- (intern (format ":%s" section)))
- collect v))
- val)))
+ (cl-loop for (section . v) in val
+ collect (if (keywordp section) section
+ (intern (format ":%s" section)))
+ collect v))
+ val)))
(defun eglot-signal-didChangeConfiguration (server)
"Send a `:workspace/didChangeConfiguration' signal to SERVER.
When called interactively, use the currently active server"
(interactive (list (eglot--current-server-or-lose)))
(jsonrpc-notify
- server :workspace/didChangeConfiguration
- (list
- :settings
- (or (eglot--workspace-configuration-plist server)
+ server :workspace/didChangeConfiguration
+ (list
+ :settings
+ (or (eglot--workspace-configuration-plist server)
eglot--{}))))
(cl-defmethod eglot-handle-request
(server (_method (eql workspace/configuration)) &key items)
"Handle server request workspace/configuration."
(apply #'vector
- (mapcar
- (eglot--lambda ((ConfigurationItem) scopeUri section)
- (with-temp-buffer
- (let* ((uri-path (eglot--uri-to-path scopeUri))
- (default-directory
- (if (and (not (string-empty-p uri-path))
- (file-directory-p uri-path))
- (file-name-as-directory uri-path)
- (project-root (eglot--project server)))))
- (setq-local major-mode (car (eglot--major-modes server)))
- (hack-dir-local-variables-non-file-buffer)
- (cl-loop for (wsection o)
- on (eglot--workspace-configuration-plist server)
- by #'cddr
- when (string=
- (if (keywordp wsection)
- (substring (symbol-name wsection) 1)
- wsection)
- section)
- return o))))
- items)))
+ (mapcar
+ (eglot--lambda ((ConfigurationItem) scopeUri section)
+ (with-temp-buffer
+ (let* ((uri-path (eglot--uri-to-path scopeUri))
+ (default-directory
+ (if (and (not (string-empty-p uri-path))
+ (file-directory-p uri-path))
+ (file-name-as-directory uri-path)
+ (project-root (eglot--project server)))))
+ (setq-local major-mode (car (eglot--major-modes server)))
+ (hack-dir-local-variables-non-file-buffer)
+ (cl-loop for (wsection o)
+ on (eglot--workspace-configuration-plist server)
+ by #'cddr
+ when (string=
+ (if (keywordp wsection)
+ (substring (symbol-name wsection) 1)
+ wsection)
+ section)
+ return o))))
+ items)))
(defun eglot--signal-textDocument/didChange ()
"Send textDocument/didChange to server."
(when eglot--recent-changes
(let* ((server (eglot--current-server-or-lose))
- (sync-capability (eglot--server-capable :textDocumentSync))
- (sync-kind (if (numberp sync-capability) sync-capability
- (plist-get sync-capability :change)))
- (full-sync-p (or (eq sync-kind 1)
- (eq :emacs-messup eglot--recent-changes))))
+ (sync-capability (eglot--server-capable :textDocumentSync))
+ (sync-kind (if (numberp sync-capability) sync-capability
+ (plist-get sync-capability :change)))
+ (full-sync-p (or (eq sync-kind 1)
+ (eq :emacs-messup eglot--recent-changes))))
(jsonrpc-notify
- server :textDocument/didChange
- (list
- :textDocument (eglot--VersionedTextDocumentIdentifier)
- :contentChanges
- (if full-sync-p
+ server :textDocument/didChange
+ (list
+ :textDocument (eglot--VersionedTextDocumentIdentifier)
+ :contentChanges
+ (if full-sync-p
(vector `(:text ,(eglot--widening
- (buffer-substring-no-properties (point-min)
- (point-max)))))
- (cl-loop for (beg end len text) in (reverse eglot--recent-changes)
- ;; github#259: `capitalize-word' and commands based
- ;; on `casify_region' will cause multiple duplicate
- ;; empty entries in `eglot--before-change' calls
- ;; without an `eglot--after-change' reciprocal.
- ;; Weed them out here.
- when (numberp len)
- vconcat `[,(list :range `(:start ,beg :end ,end)
- :rangeLength len :text text)]))))
+ (buffer-substring-no-properties (point-min)
+ (point-max)))))
+ (cl-loop for (beg end len text) in (reverse eglot--recent-changes)
+ ;; github#259: `capitalize-word' and commands based
+ ;; on `casify_region' will cause multiple duplicate
+ ;; empty entries in `eglot--before-change' calls
+ ;; without an `eglot--after-change' reciprocal.
+ ;; Weed them out here.
+ when (numberp len)
+ vconcat `[,(list :range `(:start ,beg :end ,end)
+ :rangeLength len :text text)]))))
(setq eglot--recent-changes nil)
(setf (eglot--spinner server) (list nil :textDocument/didChange t))
(jsonrpc--call-deferred server))))
@@ -2390,39 +2402,129 @@ When called interactively, use the currently active server"
"Send textDocument/didOpen to server."
(setq eglot--recent-changes nil eglot--versioned-identifier 0)
(jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
+ (eglot--current-server-or-lose)
+ :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
(defun eglot--signal-textDocument/didClose ()
"Send textDocument/didClose to server."
(with-demoted-errors
- "[eglot] error sending textDocument/didClose: %s"
+ "[eglot] error sending textDocument/didClose: %s"
(jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier)))))
+ (eglot--current-server-or-lose)
+ :textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier)))))
(defun eglot--signal-textDocument/willSave ()
"Send textDocument/willSave to server."
(let ((server (eglot--current-server-or-lose))
- (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
+ (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
(when (eglot--server-capable :textDocumentSync :willSave)
(jsonrpc-notify server :textDocument/willSave params))
(when (eglot--server-capable :textDocumentSync :willSaveWaitUntil)
(ignore-errors
(eglot--apply-text-edits
- (jsonrpc-request server :textDocument/willSaveWaitUntil params
- :timeout 0.5))))))
+ (jsonrpc-request server :textDocument/willSaveWaitUntil params
+ :timeout 0.5))))))
(defun eglot--signal-textDocument/didSave ()
"Send textDocument/didSave to server."
(eglot--signal-textDocument/didChange)
(jsonrpc-notify
- (eglot--current-server-or-lose)
- :textDocument/didSave
- (list
- ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
- :text (buffer-substring-no-properties (point-min) (point-max))
- :textDocument (eglot--TextDocumentIdentifier))))
+ (eglot--current-server-or-lose)
+ :textDocument/didSave
+ (list
+ ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
+ :text (buffer-substring-no-properties (point-min) (point-max))
+ :textDocument (eglot--TextDocumentIdentifier))))
+
+(defun eglot--inlay-hint-handler (buffer hints report-fn)
+ (print report-fn)
+ ;; Make overlays for them.
+ (let (diags nil)
+ (seq-doseq (value hints)
+ (cl-loop for val being the elements of
+ (if (stringp (plist-get value :label))
+ (list (plist-get value :label))
+ (plist-get value :label))
+ do
+ (eglot--widening
+ (let (
+ (line (plist-get (plist-get value :position) :line))
+ (col (plist-get (plist-get value :position) :character))
+ (source (if (stringp (plist-get value :label))
+ (plist-get (plist-get (plist-get value :data) :text_document) :uri)
+ (plist-get (plist-get (plist-get (car value) :label) :location) :uri)))
+ (text
+ (propertize
+ (concat
+ (when (plist-get value :paddingLeft) " ")
+ (if (stringp val) val (plist-get val :value))
+ (when (plist-get value :paddingRight) " "))
+ 'face 'eglot-inlay-hint)
+ )
+ )
+ (print "source")
+ (print source)
+ (with-current-buffer buffer
+ (print (plist-get value :position))
+ (print (eglot--lsp-position-to-point (plist-get value :position)))
+ (print (eglot--uri-to-path source))
+ (push (eglot--make-diag
+ (expand-file-name (eglot--uri-to-path source))
+ ;; FIXME: wrong coordinates?
+ ;; TODO: check diag correctly updates
+ (cons (1+ line) (1+ col))
+ ;;(eglot--lsp-position-to-point (plist-get value :position))
+ nil
+ 'eglot-inlay-hint
+ text
+ nil
+ `((before-string . ,text)
+ ))
+ diags)
+ )
+ )
+ )
+ )
+ )
+ (funcall report-fn diags)
+ )
+ )
+
+(defun eglot-get-inlay-hints (report-fn buffer)
+ ;; (let ((lens-table (make-hash-table)))
+ ;; ;; Get the inlay hint objects.
+ ;; (mapc (lambda (inlayHint)
+ ;; (when (and (eglot--server-capable
+ ;; :inlayHintProvider :resolveProvider)
+ ;; (not (plist-member inlayHint :command)))
+ ;; (setq inlayHint
+ ;; (jsonrpc-request (eglot--current-server-or-lose)
+ ;; :inlayHint/resolve inlayHint)))
+ ;; (let ((line (thread-first inlayHint
+ ;; (plist-get :position)
+ ;; (plist-get :line))))
+ ;; (puthash line
+ ;; (append (gethash line lens-table) (list inlayHint))
+ ;; lens-table)))
+ ;; (jsonrpc-request
+ ;; (eglot--current-server-or-lose)
+ ;; :textDocument/inlayHint
+ ;; (list :textDocument (eglot--TextDocumentIdentifier) :range (list :start (list :line 0 :character 0) :end (list :line (count-lines (point-min) (point-max)) :character 0)))
+ ;; :deferred :textDocument/inlayHint))
+ ;; lens-table
+ ;; )
+ (print "toto")
+(print (eglot--TextDocumentIdentifier))
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/inlayHint
+ (list
+ :textDocument (eglot--TextDocumentIdentifier)
+ :range (list :start (list :line 0 :character 0) :end (list :line (count-lines (point-min) (point-max)) :character 0)))
+ :deferred t
+ :success-fn (lambda (hints) (eglot--inlay-hint-handler buffer hints report-fn))
+ )
+ )
(defun eglot-flymake-backend (report-fn &rest _more)
"A Flymake backend for Eglot.
@@ -2431,22 +2533,76 @@ publishes diagnostics. Between calls to this function, REPORT-FN
may be called multiple times (respecting the protocol of
`flymake-backend-functions')."
(cond (eglot--managed-mode
- (setq eglot--current-flymake-report-fn report-fn)
- (eglot--report-to-flymake eglot--diagnostics))
- (t
- (funcall report-fn nil))))
+ (setq eglot--current-flymake-report-fn report-fn)
+ (print "more")
+ (print _more)
+ (print "buffer")
+ (print (current-buffer))
+
+ (when (eglot--server-capable :inlayHintProvider)
+ (print eglot--current-flymake-report-fn)
+ (eglot-get-inlay-hints eglot--current-flymake-report-fn (current-buffer))
+ )
+ ;; (when (eglot--server-capable :inlayHintProvider)
+ ;; (let ((source (current-buffer))
+ ;; (hints (eglot-get-inlay-hints)))
+ ;; ;; Make overlays for them.
+ ;; (maphash
+ ;; (lambda (line values)
+ ;; (cl-loop for value in values
+ ;; do
+ ;; (print value)
+ ;; (cl-loop for val being the elements of
+ ;; (if (stringp (plist-get value :label))
+ ;; (list (plist-get value :label))
+ ;; (plist-get value :label))
+ ;; do
+ ;; (print val)
+ ;; (eglot--widening
+ ;; (let ((col (plist-get (plist-get value :position) :character))
+ ;; (text
+ ;; (propertize
+ ;; (concat
+ ;; (when (plist-get value :paddingLeft) " ")
+ ;; (if (stringp val) val (plist-get val :value))
+ ;; (when (plist-get value :paddingRight) " "))
+ ;; 'face 'eglot-inlay-hint)
+ ;; )
+ ;; )
+ ;; (print text)
+ ;; (push (eglot--make-diag
+ ;; source
+ ;; (cons (+ line 1) (+ col 1))
+ ;; nil
+ ;; 'eglot-inlay-hint
+ ;; text
+ ;; nil
+ ;; `((before-string . ,text)
+ ;; ))
+ ;; eglot--diagnostics)
+ ;; )
+ ;; )
+ ;; )
+ ;; )
+ ;; )
+ ;; hints)
+ ;; ))
+ (eglot--report-to-flymake eglot--diagnostics))
+ (t
+ (funcall report-fn diags)
+ )))
(defun eglot--report-to-flymake (diags)
"Internal helper for `eglot-flymake-backend'."
(save-restriction
(widen)
(funcall eglot--current-flymake-report-fn diags
- ;; If the buffer hasn't changed since last
- ;; call to the report function, flymake won't
- ;; delete old diagnostics. Using :region
- ;; keyword forces flymake to delete
- ;; them (github#159).
- :region (cons (point-min) (point-max))))
+ ;; If the buffer hasn't changed since last
+ ;; call to the report function, flymake won't
+ ;; delete old diagnostics. Using :region
+ ;; keyword forces flymake to delete
+ ;; them (github#159).
+ :region (cons (point-min) (point-max))))
(setq eglot--diagnostics diags))
(defun eglot-xref-backend () "Eglot xref backend." 'eglot)
@@ -2462,11 +2618,11 @@ may be called multiple times (respecting the protocol of
(declare (indent 1) (debug (sexp &rest form)))
(let ((collected (cl-gensym "collected")))
`(unwind-protect
- (let (,collected)
- (cl-flet ((,collector (xref) (push xref ,collected)))
- ,@body)
- (setq ,collected (nreverse ,collected))
- (sort ,collected eglot-xref-lessp-function))
+ (let (,collected)
+ (cl-flet ((,collector (xref) (push xref ,collected)))
+ ,@body)
+ (setq ,collected (nreverse ,collected))
+ (sort ,collected eglot-xref-lessp-function))
(maphash (lambda (_uri buf) (kill-buffer buf)) eglot--temp-location-buffers)
(clrhash eglot--temp-location-buffers))))
@@ -2474,36 +2630,36 @@ may be called multiple times (respecting the protocol of
"Like `xref-make-match' but with LSP's NAME, URI and RANGE.
Try to visit the target file for a richer summary line."
(pcase-let*
- ((file (eglot--uri-to-path uri))
- (visiting (or (find-buffer-visiting file)
- (gethash uri eglot--temp-location-buffers)))
- (collect (lambda ()
- (eglot--widening
+ ((file (eglot--uri-to-path uri))
+ (visiting (or (find-buffer-visiting file)
+ (gethash uri eglot--temp-location-buffers)))
+ (collect (lambda ()
+ (eglot--widening
(pcase-let* ((`(,beg . ,end) (eglot--range-region range))
- (bol (progn (goto-char beg) (line-beginning-position)))
- (substring (buffer-substring bol (line-end-position)))
- (hi-beg (- beg bol))
- (hi-end (- (min (line-end-position) end) bol)))
+ (bol (progn (goto-char beg) (line-beginning-position)))
+ (substring (buffer-substring bol (line-end-position)))
+ (hi-beg (- beg bol))
+ (hi-end (- (min (line-end-position) end) bol)))
(add-face-text-property hi-beg hi-end 'xref-match
- t substring)
+ t substring)
(list substring (line-number-at-pos (point) t)
- (eglot-current-column) (- end beg))))))
- (`(,summary ,line ,column ,length)
+ (eglot-current-column) (- end beg))))))
+ (`(,summary ,line ,column ,length)
(cond
- (visiting (with-current-buffer visiting (funcall collect)))
- ((file-readable-p file) (with-current-buffer
- (puthash uri (generate-new-buffer " *temp*")
- eglot--temp-location-buffers)
- (insert-file-contents file)
- (funcall collect)))
- (t ;; fall back to the "dumb strategy"
- (let* ((start (cl-getf range :start))
- (line (1+ (cl-getf start :line)))
- (start-pos (cl-getf start :character))
- (end-pos (cl-getf (cl-getf range :end) :character)))
- (list name line start-pos (- end-pos start-pos)))))))
+ (visiting (with-current-buffer visiting (funcall collect)))
+ ((file-readable-p file) (with-current-buffer
+ (puthash uri (generate-new-buffer " *temp*")
+ eglot--temp-location-buffers)
+ (insert-file-contents file)
+ (funcall collect)))
+ (t ;; fall back to the "dumb strategy"
+ (let* ((start (cl-getf range :start))
+ (line (1+ (cl-getf start :line)))
+ (start-pos (cl-getf start :character))
+ (end-pos (cl-getf (cl-getf range :end) :character)))
+ (list name line start-pos (- end-pos start-pos)))))))
(setf (gethash (expand-file-name file) eglot--servers-by-xrefed-file)
- (eglot--current-server-or-lose))
+ (eglot--current-server-or-lose))
(xref-make-match summary (xref-make-file-location file line column) length)))
(defun eglot--workspace-symbols (pat &optional buffer)
@@ -2513,42 +2669,42 @@ If BUFFER, switch to it before."
(unless (eglot--server-capable :workspaceSymbolProvider)
(eglot--error "This LSP server isn't a :workspaceSymbolProvider"))
(mapcar
- (lambda (wss)
- (eglot--dbind ((WorkspaceSymbol) name containerName kind) wss
- (propertize
- (format "%s%s %s"
- (if (zerop (length containerName)) ""
- (concat (propertize containerName 'face 'shadow) " "))
- name
- (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)))))
+ (lambda (wss)
+ (eglot--dbind ((WorkspaceSymbol) name containerName kind) wss
+ (propertize
+ (format "%s%s %s"
+ (if (zerop (length containerName)) ""
+ (concat (propertize containerName 'face 'shadow) " "))
+ name
+ (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)))))
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
"Yet another tricky connection between LSP and Elisp completion semantics."
(let ((buf (current-buffer)) (cache eglot--workspace-symbols-cache))
(cl-labels ((refresh (pat) (eglot--workspace-symbols pat buf))
- (lookup-1 (pat) ;; check cache, else refresh
- (let ((probe (gethash pat cache :missing)))
- (if (eq probe :missing) (puthash pat (refresh pat) cache)
- probe)))
- (lookup (pat)
- (let ((res (lookup-1 pat))
- (def (and (string= pat "") (gethash :default cache))))
- (append def res nil)))
- (score (c)
- (cl-getf (get-text-property
- 0 'eglot--lsp-workspaceSymbol c)
- :score 0)))
+ (lookup-1 (pat) ;; check cache, else refresh
+ (let ((probe (gethash pat cache :missing)))
+ (if (eq probe :missing) (puthash pat (refresh pat) cache)
+ probe)))
+ (lookup (pat)
+ (let ((res (lookup-1 pat))
+ (def (and (string= pat "") (gethash :default cache))))
+ (append def res nil)))
+ (score (c)
+ (cl-getf (get-text-property
+ 0 'eglot--lsp-workspaceSymbol c)
+ :score 0)))
(lambda (string _pred action)
(pcase action
(`metadata `(metadata
- (cycle-sort-function
- . ,(lambda (completions)
- (cl-sort completions #'> :key #'score)))
- (category . eglot-indirection-joy)))
+ (cycle-sort-function
+ . ,(lambda (completions)
+ (cl-sort completions #'> :key #'score)))
+ (category . eglot-indirection-joy)))
(`(eglot--lsp-tryc . ,point) `(eglot--lsp-tryc . (,string . ,point)))
(`(eglot--lsp-allc . ,_point) `(eglot--lsp-allc . ,(lookup string)))
(_ nil))))))
@@ -2561,18 +2717,18 @@ If BUFFER, switch to it before."
;; Like mess? Ask minibuffer.el about improper lists.
(when (equal (car v) string) (throw 'found (car v)))
(setq v (cdr v))))
- eglot--workspace-symbols-cache)))
+ eglot--workspace-symbols-cache)))
(add-to-list 'completion-category-overrides
- '(eglot-indirection-joy (styles . (eglot--lsp-backend-style))))
+ '(eglot-indirection-joy (styles . (eglot--lsp-backend-style))))
(cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
(let ((attempt
- (and (xref--prompt-p this-command)
- (puthash :default
- (ignore-errors
- (eglot--workspace-symbols (symbol-name (symbol-at-point))))
- eglot--workspace-symbols-cache))))
+ (and (xref--prompt-p this-command)
+ (puthash :default
+ (ignore-errors
+ (eglot--workspace-symbols (symbol-name (symbol-at-point))))
+ eglot--workspace-symbols-cache))))
(if attempt (car attempt) "LSP identifier at point")))
(defvar eglot--lsp-xref-refs nil
@@ -2581,37 +2737,37 @@ If BUFFER, switch to it before."
(cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability)
"Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY."
(unless (eglot--server-capable
- (or capability
- (intern
+ (or capability
+ (intern
(format ":%sProvider"
- (cadr (split-string (symbol-name method)
- "/"))))))
+ (cadr (split-string (symbol-name method)
+ "/"))))))
(eglot--error "Sorry, this server doesn't do %s" method))
(let ((response
- (jsonrpc-request
- (eglot--current-server-or-lose)
- method (append (eglot--TextDocumentPositionParams) extra-params))))
+ (jsonrpc-request
+ (eglot--current-server-or-lose)
+ method (append (eglot--TextDocumentPositionParams) extra-params))))
(eglot--collecting-xrefs (collect)
(mapc
- (lambda (loc-or-loc-link)
- (let ((sym-name (symbol-name (symbol-at-point))))
- (eglot--dcase loc-or-loc-link
- (((LocationLink) targetUri targetSelectionRange)
- (collect (eglot--xref-make-match sym-name
- targetUri targetSelectionRange)))
- (((Location) uri range)
- (collect (eglot--xref-make-match sym-name
- uri range))))))
- (if (vectorp response) response (and response (list response)))))))
+ (lambda (loc-or-loc-link)
+ (let ((sym-name (symbol-name (symbol-at-point))))
+ (eglot--dcase loc-or-loc-link
+ (((LocationLink) targetUri targetSelectionRange)
+ (collect (eglot--xref-make-match sym-name
+ targetUri targetSelectionRange)))
+ (((Location) uri range)
+ (collect (eglot--xref-make-match sym-name
+ uri range))))))
+ (if (vectorp response) response (and response (list response)))))))
(cl-defun eglot--lsp-xref-helper (method &key extra-params capability )
"Helper for `eglot-find-declaration' & friends."
(let ((eglot--lsp-xref-refs (eglot--lsp-xrefs-for-method
- method
- :extra-params extra-params
- :capability capability)))
+ method
+ :extra-params extra-params
+ :capability capability)))
(if eglot--lsp-xref-refs
- (xref-find-references "LSP identifier at point.")
+ (xref-find-references "LSP identifier at point.")
(eglot--message "%s returned no references" method))))
(defun eglot-find-declaration ()
@@ -2632,28 +2788,28 @@ If BUFFER, switch to it before."
(cl-defmethod xref-backend-definitions ((_backend (eql eglot)) id)
(let ((probe (eglot--recover-workspace-symbol-meta id)))
(if probe
- (eglot--dbind ((WorkspaceSymbol) name location)
- (get-text-property 0 'eglot--lsp-workspaceSymbol probe)
- (eglot--dbind ((Location) uri range) location
- (list (eglot--xref-make-match name uri range))))
- (eglot--lsp-xrefs-for-method :textDocument/definition))))
+ (eglot--dbind ((WorkspaceSymbol) name location)
+ (get-text-property 0 'eglot--lsp-workspaceSymbol probe)
+ (eglot--dbind ((Location) uri range) location
+ (list (eglot--xref-make-match name uri range))))
+ (eglot--lsp-xrefs-for-method :textDocument/definition))))
(cl-defmethod xref-backend-references ((_backend (eql eglot)) _identifier)
(or
- eglot--lsp-xref-refs
- (eglot--lsp-xrefs-for-method
- :textDocument/references :extra-params `(:context (:includeDeclaration t)))))
+ eglot--lsp-xref-refs
+ (eglot--lsp-xrefs-for-method
+ :textDocument/references :extra-params `(:context (:includeDeclaration t)))))
(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
(when (eglot--server-capable :workspaceSymbolProvider)
(eglot--collecting-xrefs (collect)
(mapc
- (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--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))))))
(defun eglot-format-buffer ()
"Format contents of current buffer."
@@ -2670,304 +2826,304 @@ If non-nil, ON-TYPE-FORMAT is a character just inserted at BEG
for which LSP on-type-formatting should be requested."
(interactive (and (region-active-p) (list (region-beginning) (region-end))))
(pcase-let ((`(,method ,cap ,args)
- (cond
- ((and beg on-type-format)
- `(:textDocument/onTypeFormatting
- :documentOnTypeFormattingProvider
- ,`(:position ,(eglot--pos-to-lsp-position beg)
- :ch ,(string on-type-format))))
- ((and beg end)
- `(:textDocument/rangeFormatting
- :documentRangeFormattingProvider
- (:range ,(list :start (eglot--pos-to-lsp-position beg)
+ (cond
+ ((and beg on-type-format)
+ `(:textDocument/onTypeFormatting
+ :documentOnTypeFormattingProvider
+ ,`(:position ,(eglot--pos-to-lsp-position beg)
+ :ch ,(string on-type-format))))
+ ((and beg end)
+ `(:textDocument/rangeFormatting
+ :documentRangeFormattingProvider
+ (:range ,(list :start (eglot--pos-to-lsp-position beg)
:end (eglot--pos-to-lsp-position end)))))
- (t
- '(:textDocument/formatting :documentFormattingProvider nil)))))
+ (t
+ '(:textDocument/formatting :documentFormattingProvider nil)))))
(unless (eglot--server-capable cap)
(eglot--error "Server can't format!"))
(eglot--apply-text-edits
- (jsonrpc-request
- (eglot--current-server-or-lose)
- method
- (cl-list*
- :textDocument (eglot--TextDocumentIdentifier)
- :options (list :tabSize tab-width
- :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))))
+ (jsonrpc-request
+ (eglot--current-server-or-lose)
+ method
+ (cl-list*
+ :textDocument (eglot--TextDocumentIdentifier)
+ :options (list :tabSize tab-width
+ :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))))
(defun eglot-completion-at-point ()
"Eglot's `completion-at-point' function."
;; Commit logs for this function help understand what's going on.
(when-let (completion-capability (eglot--server-capable :completionProvider))
(let* ((server (eglot--current-server-or-lose))
- (sort-completions
- (lambda (completions)
- (cl-sort completions
- #'string-lessp
- :key (lambda (c)
- (or (plist-get
- (get-text-property 0 'eglot--lsp-item c)
- :sortText)
- "")))))
- (metadata `(metadata (category . eglot)
- (display-sort-function . ,sort-completions)))
- resp items (cached-proxies :none)
- (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
- &allow-other-keys)
- (let ((proxy
+ (sort-completions
+ (lambda (completions)
+ (cl-sort completions
+ #'string-lessp
+ :key (lambda (c)
+ (or (plist-get
+ (get-text-property 0 'eglot--lsp-item c)
+ :sortText)
+ "")))))
+ (metadata `(metadata (category . eglot)
+ (display-sort-function . ,sort-completions)))
+ resp items (cached-proxies :none)
+ (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
+ &allow-other-keys)
+ (let ((proxy
(cond ((and (eql insertTextFormat 2)
- (eglot--snippet-expansion-fn))
- (string-trim-left label))
- ((and insertText
- (not (string-empty-p insertText)))
- insertText)
- (t
- (string-trim-left label)))))
- (unless (zerop (length proxy))
- (put-text-property 0 1 'eglot--lsp-item item proxy))
- proxy))
- items)))))
- (resolved (make-hash-table))
- (resolve-maybe
- ;; Maybe completion/resolve JSON object `lsp-comp' into
- ;; another JSON object, if at all possible. Otherwise,
- ;; just return lsp-comp.
- (lambda (lsp-comp)
- (or (gethash lsp-comp resolved)
+ (eglot--snippet-expansion-fn))
+ (string-trim-left label))
+ ((and insertText
+ (not (string-empty-p insertText)))
+ insertText)
+ (t
+ (string-trim-left label)))))
+ (unless (zerop (length proxy))
+ (put-text-property 0 1 'eglot--lsp-item item proxy))
+ proxy))
+ items)))))
+ (resolved (make-hash-table))
+ (resolve-maybe
+ ;; Maybe completion/resolve JSON object `lsp-comp' into
+ ;; another JSON object, if at all possible. Otherwise,
+ ;; just return lsp-comp.
+ (lambda (lsp-comp)
+ (or (gethash lsp-comp resolved)
(setf (gethash lsp-comp resolved)
- (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)))
+ (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)))
(list
- (or (car bounds) (point))
- (or (cdr bounds) (point))
- (lambda (probe pred action)
- (cond
- ((eq action 'metadata) metadata) ; metadata
- ((eq action 'lambda) ; test-completion
- (test-completion probe (funcall proxies)))
- ((eq (car-safe action) 'boundaries) nil) ; boundaries
- ((null action) ; try-completion
- (try-completion probe (funcall proxies)))
- ((eq action t) ; all-completions
- (all-completions
- ""
- (funcall proxies)
- (lambda (proxy)
- (let* ((item (get-text-property 0 'eglot--lsp-item proxy))
- (filterText (plist-get item :filterText)))
- (and (or (null pred) (funcall pred proxy))
- (string-prefix-p
- probe (or filterText proxy) completion-ignore-case))))))))
- :annotation-function
- (lambda (proxy)
- (eglot--dbind ((CompletionItem) detail kind)
- (get-text-property 0 'eglot--lsp-item proxy)
- (let* ((detail (and (stringp detail)
- (not (string= detail ""))
- detail))
- (annotation
- (or detail
- (cdr (assoc kind eglot--kind-names)))))
- (when annotation
- (concat " "
- (propertize annotation
- 'face 'font-lock-function-name-face))))))
- :company-kind
- ;; Associate each lsp-item with a lsp-kind symbol.
- (lambda (proxy)
- (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))
- (kind (alist-get (plist-get lsp-item :kind)
- eglot--kind-names)))
- (intern (downcase kind))))
- :company-deprecated
- (lambda (proxy)
- (when-let ((lsp-item (get-text-property 0 'eglot--lsp-item proxy)))
- (or (seq-contains-p (plist-get lsp-item :tags)
- 1)
- (eq t (plist-get lsp-item :deprecated)))))
- :company-docsig
- ;; FIXME: autoImportText is specific to the pyright language server
- (lambda (proxy)
- (when-let* ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy))
- (data (plist-get (funcall resolve-maybe lsp-comp) :data))
- (import-text (plist-get data :autoImportText)))
- import-text))
- :company-doc-buffer
- (lambda (proxy)
- (let* ((documentation
- (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)))
- (plist-get (funcall resolve-maybe lsp-comp) :documentation)))
- (formatted (and documentation
- (eglot--format-markup documentation))))
- (when formatted
- (with-current-buffer (get-buffer-create " *eglot doc*")
- (erase-buffer)
- (insert formatted)
- (current-buffer)))))
- :company-require-match 'never
- :company-prefix-length
- (save-excursion
- (when (car bounds) (goto-char (car bounds)))
- (when (listp completion-capability)
- (looking-back
- (regexp-opt
- (cl-coerce (cl-getf completion-capability :triggerCharacters) 'list))
- (line-beginning-position))))
- :exit-function
- (lambda (proxy status)
- (when (memq status '(finished exact))
- ;; To assist in using this whole `completion-at-point'
- ;; function inside `completion-in-region', ensure the exit
- ;; function runs in the buffer where the completion was
- ;; triggered from. This should probably be in Emacs itself.
- ;; (github#505)
- (with-current-buffer (if (minibufferp)
- (window-buffer (minibuffer-selected-window))
- (current-buffer))
- (eglot--dbind ((CompletionItem) insertTextFormat
- insertText textEdit additionalTextEdits label)
- (funcall
+ (or (car bounds) (point))
+ (or (cdr bounds) (point))
+ (lambda (probe pred action)
+ (cond
+ ((eq action 'metadata) metadata) ; metadata
+ ((eq action 'lambda) ; test-completion
+ (test-completion probe (funcall proxies)))
+ ((eq (car-safe action) 'boundaries) nil) ; boundaries
+ ((null action) ; try-completion
+ (try-completion probe (funcall proxies)))
+ ((eq action t) ; all-completions
+ (all-completions
+ ""
+ (funcall proxies)
+ (lambda (proxy)
+ (let* ((item (get-text-property 0 'eglot--lsp-item proxy))
+ (filterText (plist-get item :filterText)))
+ (and (or (null pred) (funcall pred proxy))
+ (string-prefix-p
+ probe (or filterText proxy) completion-ignore-case))))))))
+ :annotation-function
+ (lambda (proxy)
+ (eglot--dbind ((CompletionItem) detail kind)
+ (get-text-property 0 'eglot--lsp-item proxy)
+ (let* ((detail (and (stringp detail)
+ (not (string= detail ""))
+ detail))
+ (annotation
+ (or detail
+ (cdr (assoc kind eglot--kind-names)))))
+ (when annotation
+ (concat " "
+ (propertize annotation
+ 'face 'font-lock-function-name-face))))))
+ :company-kind
+ ;; Associate each lsp-item with a lsp-kind symbol.
+ (lambda (proxy)
+ (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))
+ (kind (alist-get (plist-get lsp-item :kind)
+ eglot--kind-names)))
+ (intern (downcase kind))))
+ :company-deprecated
+ (lambda (proxy)
+ (when-let ((lsp-item (get-text-property 0 'eglot--lsp-item proxy)))
+ (or (seq-contains-p (plist-get lsp-item :tags)
+ 1)
+ (eq t (plist-get lsp-item :deprecated)))))
+ :company-docsig
+ ;; FIXME: autoImportText is specific to the pyright language server
+ (lambda (proxy)
+ (when-let* ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy))
+ (data (plist-get (funcall resolve-maybe lsp-comp) :data))
+ (import-text (plist-get data :autoImportText)))
+ import-text))
+ :company-doc-buffer
+ (lambda (proxy)
+ (let* ((documentation
+ (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)))
+ (plist-get (funcall resolve-maybe lsp-comp) :documentation)))
+ (formatted (and documentation
+ (eglot--format-markup documentation))))
+ (when formatted
+ (with-current-buffer (get-buffer-create " *eglot doc*")
+ (erase-buffer)
+ (insert formatted)
+ (current-buffer)))))
+ :company-require-match 'never
+ :company-prefix-length
+ (save-excursion
+ (when (car bounds) (goto-char (car bounds)))
+ (when (listp completion-capability)
+ (looking-back
+ (regexp-opt
+ (cl-coerce (cl-getf completion-capability :triggerCharacters) 'list))
+ (line-beginning-position))))
+ :exit-function
+ (lambda (proxy status)
+ (when (memq status '(finished exact))
+ ;; To assist in using this whole `completion-at-point'
+ ;; function inside `completion-in-region', ensure the exit
+ ;; function runs in the buffer where the completion was
+ ;; triggered from. This should probably be in Emacs itself.
+ ;; (github#505)
+ (with-current-buffer (if (minibufferp)
+ (window-buffer (minibuffer-selected-window))
+ (current-buffer))
+ (eglot--dbind ((CompletionItem) insertTextFormat
+ insertText textEdit additionalTextEdits label)
+ (funcall
resolve-maybe
(or (get-text-property 0 'eglot--lsp-item proxy)
- ;; When selecting from the *Completions*
- ;; buffer, `proxy' won't have any properties.
- ;; A lookup should fix that (github#148)
- (get-text-property
- 0 'eglot--lsp-item
- (cl-find proxy (funcall proxies) :test #'string=))))
- (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))
- (eglot--dbind ((TextEdit) range newText) textEdit
- (pcase-let ((`(,beg . ,end)
- (eglot--range-region range)))
- (delete-region beg end)
- (goto-char beg)
- (funcall (or snippet-fn #'insert) newText))))
- (snippet-fn
- ;; A snippet should be inserted, but using plain
- ;; `insertText'. This requires us to delete the
- ;; whole completion, since `insertText' is the full
- ;; completion's text.
- (delete-region (- (point) (length proxy)) (point))
- (funcall snippet-fn (or insertText label))))
- (when (cl-plusp (length additionalTextEdits))
- (eglot--apply-text-edits additionalTextEdits)))
- (eglot--signal-textDocument/didChange)
- (eldoc)))))))))
+ ;; When selecting from the *Completions*
+ ;; buffer, `proxy' won't have any properties.
+ ;; A lookup should fix that (github#148)
+ (get-text-property
+ 0 'eglot--lsp-item
+ (cl-find proxy (funcall proxies) :test #'string=))))
+ (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))
+ (eglot--dbind ((TextEdit) range newText) textEdit
+ (pcase-let ((`(,beg . ,end)
+ (eglot--range-region range)))
+ (delete-region beg end)
+ (goto-char beg)
+ (funcall (or snippet-fn #'insert) newText))))
+ (snippet-fn
+ ;; A snippet should be inserted, but using plain
+ ;; `insertText'. This requires us to delete the
+ ;; whole completion, since `insertText' is the full
+ ;; completion's text.
+ (delete-region (- (point) (length proxy)) (point))
+ (funcall snippet-fn (or insertText label))))
+ (when (cl-plusp (length additionalTextEdits))
+ (eglot--apply-text-edits additionalTextEdits)))
+ (eglot--signal-textDocument/didChange)
+ (eldoc)))))))))
(defun eglot--hover-info (contents &optional _range)
(mapconcat #'eglot--format-markup
- (if (vectorp contents) contents (list contents)) "\n"))
-
+ (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)
+ 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))))
+ (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
+ (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"))
+ ;; ...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-signature-eldoc-function (cb)
"A member of `eldoc-documentation-functions', for signatures."
(when (eglot--server-capable :signatureHelpProvider)
(let ((buf (current-buffer)))
(jsonrpc-async-request
- (eglot--current-server-or-lose)
- :textDocument/signatureHelp (eglot--TextDocumentPositionParams)
- :success-fn
- (eglot--lambda ((SignatureHelp)
- signatures activeSignature activeParameter)
- (eglot--when-buffer-window buf
- (funcall cb
- (unless (seq-empty-p signatures)
- (eglot--sig-info signatures
- activeSignature
- activeParameter)))))
- :deferred :textDocument/signatureHelp))
+ (eglot--current-server-or-lose)
+ :textDocument/signatureHelp (eglot--TextDocumentPositionParams)
+ :success-fn
+ (eglot--lambda ((SignatureHelp)
+ signatures activeSignature activeParameter)
+ (eglot--when-buffer-window buf
+ (funcall cb
+ (unless (seq-empty-p signatures)
+ (eglot--sig-info signatures
+ activeSignature
+ activeParameter)))))
+ :deferred :textDocument/signatureHelp))
t))
(defun eglot-hover-eldoc-function (cb)
@@ -2975,14 +3131,14 @@ for which LSP on-type-formatting should be requested."
(when (eglot--server-capable :hoverProvider)
(let ((buf (current-buffer)))
(jsonrpc-async-request
- (eglot--current-server-or-lose)
- :textDocument/hover (eglot--TextDocumentPositionParams)
- :success-fn (eglot--lambda ((Hover) contents range)
- (eglot--when-buffer-window buf
- (let ((info (unless (seq-empty-p contents)
- (eglot--hover-info contents range))))
- (funcall cb info :buffer t))))
- :deferred :textDocument/hover))
+ (eglot--current-server-or-lose)
+ :textDocument/hover (eglot--TextDocumentPositionParams)
+ :success-fn (eglot--lambda ((Hover) contents range)
+ (eglot--when-buffer-window buf
+ (let ((info (unless (seq-empty-p contents)
+ (eglot--hover-info contents range))))
+ (funcall cb info :buffer t))))
+ :deferred :textDocument/hover))
(eglot--highlight-piggyback cb)
t))
@@ -2995,83 +3151,83 @@ for which LSP on-type-formatting should be requested."
(let ((buf (current-buffer)))
(when (eglot--server-capable :documentHighlightProvider)
(jsonrpc-async-request
- (eglot--current-server-or-lose)
- :textDocument/documentHighlight (eglot--TextDocumentPositionParams)
- :success-fn
- (lambda (highlights)
- (mapc #'delete-overlay eglot--highlights)
- (setq eglot--highlights
- (eglot--when-buffer-window buf
- (mapcar
- (eglot--lambda ((DocumentHighlight) range)
- (pcase-let ((`(,beg . ,end)
- (eglot--range-region range)))
- (let ((ov (make-overlay beg end)))
- (overlay-put ov 'face 'eglot-highlight-symbol-face)
- (overlay-put ov 'modification-hooks
- `(,(lambda (o &rest _) (delete-overlay o))))
- ov)))
- highlights))))
- :deferred :textDocument/documentHighlight)
+ (eglot--current-server-or-lose)
+ :textDocument/documentHighlight (eglot--TextDocumentPositionParams)
+ :success-fn
+ (lambda (highlights)
+ (mapc #'delete-overlay eglot--highlights)
+ (setq eglot--highlights
+ (eglot--when-buffer-window buf
+ (mapcar
+ (eglot--lambda ((DocumentHighlight) range)
+ (pcase-let ((`(,beg . ,end)
+ (eglot--range-region range)))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face 'eglot-highlight-symbol-face)
+ (overlay-put ov 'modification-hooks
+ `(,(lambda (o &rest _) (delete-overlay o))))
+ ov)))
+ highlights))))
+ :deferred :textDocument/documentHighlight)
nil)))
(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)))))))
+ ((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
+ (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))
+ (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))))))
+ 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))))))
(defun eglot--apply-text-edits (edits &optional version)
"Apply EDITS for current buffer if at VERSION, or if it's nil."
(unless (or (not version) (equal version eglot--versioned-identifier))
(jsonrpc-error "Edits on `%s' require version %d, you have %d"
- (current-buffer) version eglot--versioned-identifier))
+ (current-buffer) version eglot--versioned-identifier))
(atomic-change-group
(let* ((change-group (prepare-change-group))
- (howmany (length edits))
- (reporter (make-progress-reporter
- (format "[eglot] applying %s edits to `%s'..."
- howmany (current-buffer))
- 0 howmany))
- (done 0))
+ (howmany (length edits))
+ (reporter (make-progress-reporter
+ (format "[eglot] applying %s edits to `%s'..."
+ howmany (current-buffer))
+ 0 howmany))
+ (done 0))
(mapc (pcase-lambda (`(,newText ,beg . ,end))
(let ((source (current-buffer)))
(with-temp-buffer
@@ -3091,19 +3247,19 @@ Returns a list as described in docstring of `imenu--index-alist'."
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278
(let ((inhibit-modification-hooks t)
- (length (- end beg))
- (beg (marker-position beg))
- (end (marker-position end)))
+ (length (- end beg))
+ (beg (marker-position beg))
+ (end (marker-position end)))
(run-hook-with-args 'before-change-functions
- beg end)
+ beg end)
(replace-buffer-contents temp)
(run-hook-with-args 'after-change-functions
- beg (+ beg (length newText))
- length))))
+ beg (+ beg (length newText))
+ length))))
(progress-reporter-update reporter (cl-incf done)))))))
- (mapcar (eglot--lambda ((TextEdit) range newText)
- (cons newText (eglot--range-region range 'markers)))
- (reverse edits)))
+ (mapcar (eglot--lambda ((TextEdit) range newText)
+ (cons newText (eglot--range-region range 'markers)))
+ (reverse edits)))
(undo-amalgamate-change-group change-group)
(progress-reporter-done reporter))))
@@ -3111,45 +3267,45 @@ Returns a list as described in docstring of `imenu--index-alist'."
"Apply the workspace edit WEDIT. If CONFIRM, ask user first."
(eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit
(let ((prepared
- (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits)
- (eglot--dbind ((VersionedTextDocumentIdentifier) uri version)
- textDocument
- (list (eglot--uri-to-path uri) edits version)))
- documentChanges)))
+ (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits)
+ (eglot--dbind ((VersionedTextDocumentIdentifier) uri version)
+ textDocument
+ (list (eglot--uri-to-path uri) edits version)))
+ documentChanges)))
(unless (and changes documentChanges)
;; We don't want double edits, and some servers send both
;; changes and documentChanges. This unless ensures that we
;; prefer documentChanges over changes.
(cl-loop for (uri edits) on changes by #'cddr
- do (push (list (eglot--uri-to-path uri) edits) prepared)))
+ do (push (list (eglot--uri-to-path uri) edits) prepared)))
(if (or confirm
- (cl-notevery #'find-buffer-visiting
- (mapcar #'car prepared)))
- (unless (y-or-n-p
- (format "[eglot] Server wants to edit:\n %s\n Proceed? "
- (mapconcat #'identity (mapcar #'car prepared) "\n ")))
- (jsonrpc-error "User cancelled server edit")))
+ (cl-notevery #'find-buffer-visiting
+ (mapcar #'car prepared)))
+ (unless (y-or-n-p
+ (format "[eglot] Server wants to edit:\n %s\n Proceed? "
+ (mapconcat #'identity (mapcar #'car prepared) "\n ")))
+ (jsonrpc-error "User cancelled server edit")))
(cl-loop for edit in prepared
- for (path edits version) = edit
- do (with-current-buffer (find-file-noselect path)
- (eglot--apply-text-edits edits version))
- finally (eldoc) (eglot--message "Edit successful!")))))
+ for (path edits version) = edit
+ do (with-current-buffer (find-file-noselect path)
+ (eglot--apply-text-edits edits version))
+ finally (eldoc) (eglot--message "Edit successful!")))))
(defun eglot-rename (newname)
"Rename the current symbol to NEWNAME."
(interactive
- (list (read-from-minibuffer
- (format "Rename `%s' to: " (or (thing-at-point 'symbol t)
+ (list (read-from-minibuffer
+ (format "Rename `%s' to: " (or (thing-at-point 'symbol t)
"unknown symbol"))
- nil nil nil nil
- (symbol-name (symbol-at-point)))))
+ nil nil nil nil
+ (symbol-name (symbol-at-point)))))
(unless (eglot--server-capable :renameProvider)
(eglot--error "Server can't rename!"))
(eglot--apply-workspace-edit
- (jsonrpc-request (eglot--current-server-or-lose)
- :textDocument/rename `(,@(eglot--TextDocumentPositionParams)
- :newName ,newname))
- current-prefix-arg))
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :textDocument/rename `(,@(eglot--TextDocumentPositionParams)
+ :newName ,newname))
+ current-prefix-arg))
(defun eglot--region-bounds ()
"Region bounds if active, else bounds of things at point."
@@ -3165,71 +3321,71 @@ Interactively, default BEG and END to region's bounds else BEG is
point and END is nil, which results in a request for code actions
at point. With prefix argument, prompt for ACTION-KIND."
(interactive
- `(,@(eglot--region-bounds)
- ,(and current-prefix-arg
- (completing-read "[eglot] Action kind: "
- '("quickfix" "refactor.extract" "refactor.inline"
- "refactor.rewrite" "source.organizeImports")))
- t))
+ `(,@(eglot--region-bounds)
+ ,(and current-prefix-arg
+ (completing-read "[eglot] Action kind: "
+ '("quickfix" "refactor.extract" "refactor.inline"
+ "refactor.rewrite" "source.organizeImports")))
+ t))
(unless (or (not interactive)
- (eglot--server-capable :codeActionProvider))
+ (eglot--server-capable :codeActionProvider))
(eglot--error "Server can't execute code actions!"))
(let* ((server (eglot--current-server-or-lose))
- (actions
- (jsonrpc-request
- server
- :textDocument/codeAction
- (list :textDocument (eglot--TextDocumentIdentifier)
- :range (list :start (eglot--pos-to-lsp-position beg)
- :end (eglot--pos-to-lsp-position end))
- :context
- `(:diagnostics
+ (actions
+ (jsonrpc-request
+ server
+ :textDocument/codeAction
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :range (list :start (eglot--pos-to-lsp-position beg)
+ :end (eglot--pos-to-lsp-position end))
+ :context
+ `(:diagnostics
[,@(cl-loop for diag in (flymake-diagnostics beg end)
- when (cdr (assoc 'eglot-lsp-diag
- (eglot--diag-data diag)))
- collect it)]
+ when (cdr (assoc 'eglot-lsp-diag
+ (eglot--diag-data diag)))
+ collect it)]
,@(when action-kind `(:only [,action-kind]))))
- :deferred t))
- ;; Redo filtering, in case the `:only' didn't go through.
- (actions (cl-loop for a across actions
- when (or (not action-kind)
- (equal action-kind (plist-get a :kind)))
- collect a)))
+ :deferred t))
+ ;; Redo filtering, in case the `:only' didn't go through.
+ (actions (cl-loop for a across actions
+ when (or (not action-kind)
+ (equal action-kind (plist-get a :kind)))
+ collect a)))
(if interactive
- (eglot--read-execute-code-action actions server action-kind)
+ (eglot--read-execute-code-action actions server action-kind)
actions)))
(defun eglot--read-execute-code-action (actions server &optional action-kind)
"Helper for interactive calls to `eglot-code-actions'"
(let* ((menu-items
- (or (cl-loop for a in actions
- collect (cons (plist-get a :title) a))
- (apply #'eglot--error
- (if action-kind `("No \"%s\" code actions here" ,action-kind)
- `("No code actions here")))))
- (preferred-action (cl-find-if
- (lambda (menu-item)
- (plist-get (cdr menu-item) :isPreferred))
- menu-items))
- (default-action (car (or preferred-action (car menu-items))))
- (chosen (if (and action-kind (null (cadr menu-items)))
- (cdr (car menu-items))
- (if (listp last-nonmenu-event)
- (x-popup-menu last-nonmenu-event `("Eglot code actions:"
+ (or (cl-loop for a in actions
+ collect (cons (plist-get a :title) a))
+ (apply #'eglot--error
+ (if action-kind `("No \"%s\" code actions here" ,action-kind)
+ `("No code actions here")))))
+ (preferred-action (cl-find-if
+ (lambda (menu-item)
+ (plist-get (cdr menu-item) :isPreferred))
+ menu-items))
+ (default-action (car (or preferred-action (car menu-items))))
+ (chosen (if (and action-kind (null (cadr menu-items)))
+ (cdr (car menu-items))
+ (if (listp last-nonmenu-event)
+ (x-popup-menu last-nonmenu-event `("Eglot code actions:"
("dummy" ,@menu-items)))
- (cdr (assoc (completing-read
- (format "[eglot] Pick an action (default %s): "
- default-action)
- menu-items nil t nil nil default-action)
- menu-items))))))
+ (cdr (assoc (completing-read
+ (format "[eglot] Pick an action (default %s): "
+ default-action)
+ menu-items nil t nil nil default-action)
+ menu-items))))))
(eglot--dcase chosen
(((Command) command arguments)
- (eglot-execute-command server (intern command) arguments))
+ (eglot-execute-command server (intern command) arguments))
(((CodeAction) edit command)
- (when edit (eglot--apply-workspace-edit edit))
- (when command
- (eglot--dbind ((Command) command arguments) command
- (eglot-execute-command server (intern command) arguments)))))))
+ (when edit (eglot--apply-workspace-edit edit))
+ (when command
+ (eglot--dbind ((Command) command arguments) command
+ (eglot-execute-command server (intern command) arguments)))))))
(defmacro eglot--code-action (name kind)
"Define NAME to execute KIND code action."
@@ -3252,40 +3408,40 @@ at point. With prefix argument, prompt for ACTION-KIND."
"Handle dynamic registration of workspace/didChangeWatchedFiles."
(eglot-unregister-capability server method id)
(let* (success
- (globs (mapcar
- (eglot--lambda ((FileSystemWatcher) globPattern)
- (eglot--glob-compile globPattern t t))
- watchers))
- (dirs-to-watch
- (delete-dups (mapcar #'file-name-directory
- (project-files
- (eglot--project server))))))
+ (globs (mapcar
+ (eglot--lambda ((FileSystemWatcher) globPattern)
+ (eglot--glob-compile globPattern t t))
+ watchers))
+ (dirs-to-watch
+ (delete-dups (mapcar #'file-name-directory
+ (project-files
+ (eglot--project server))))))
(cl-labels
- ((handle-event
- (event)
- (pcase-let ((`(,desc ,action ,file ,file1) event))
- (cond
+ ((handle-event
+ (event)
+ (pcase-let ((`(,desc ,action ,file ,file1) event))
+ (cond
((and (memq action '(created changed deleted))
- (cl-find file globs :test (lambda (f g) (funcall g f))))
- (jsonrpc-notify
- server :workspace/didChangeWatchedFiles
- `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
- :type ,(cl-case action
- (created 1)
- (changed 2)
- (deleted 3)))))))
+ (cl-find file globs :test (lambda (f g) (funcall g f))))
+ (jsonrpc-notify
+ server :workspace/didChangeWatchedFiles
+ `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
+ :type ,(cl-case action
+ (created 1)
+ (changed 2)
+ (deleted 3)))))))
((eq action 'renamed)
- (handle-event `(,desc 'deleted ,file))
- (handle-event `(,desc 'created ,file1)))))))
+ (handle-event `(,desc 'deleted ,file))
+ (handle-event `(,desc 'created ,file1)))))))
(unwind-protect
- (progn
- (dolist (dir dirs-to-watch)
- (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"
- (length dirs-to-watch) (length watchers)))))
+ (progn
+ (dolist (dir dirs-to-watch)
+ (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"
+ (length dirs-to-watch) (length watchers)))))
(unless success
(eglot-unregister-capability server method id))))))
@@ -3304,34 +3460,34 @@ at point. With prefix argument, prompt for ACTION-KIND."
(with-temp-buffer
(save-excursion (insert glob))
(cl-loop
- with grammar = '((:** "\\*\\*/?" eglot--glob-emit-**)
- (:* "\\*" eglot--glob-emit-*)
- (:? "\\?" eglot--glob-emit-?)
- (:{} "{[^][*{}]+}" eglot--glob-emit-{})
- (:range "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range)
- (:literal "[^][,*?{}]+" eglot--glob-emit-self))
- until (eobp)
- collect (cl-loop
- for (_token regexp emitter) in grammar
- thereis (and (re-search-forward (concat "\\=" regexp) nil t)
- (list (cl-gensym "state-") emitter (match-string 0)))
- finally (error "Glob '%s' invalid at %s" (buffer-string) (point))))))
+ with grammar = '((:** "\\*\\*/?" eglot--glob-emit-**)
+ (:* "\\*" eglot--glob-emit-*)
+ (:? "\\?" eglot--glob-emit-?)
+ (:{} "{[^][*{}]+}" eglot--glob-emit-{})
+ (:range "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range)
+ (:literal "[^][,*?{}]+" eglot--glob-emit-self))
+ until (eobp)
+ collect (cl-loop
+ for (_token regexp emitter) in grammar
+ thereis (and (re-search-forward (concat "\\=" regexp) nil t)
+ (list (cl-gensym "state-") emitter (match-string 0)))
+ finally (error "Glob '%s' invalid at %s" (buffer-string) (point))))))
(defun eglot--glob-compile (glob &optional byte-compile noerror)
"Convert GLOB into Elisp function. Maybe BYTE-COMPILE it.
If NOERROR, return predicate, else erroring function."
(let* ((states (eglot--glob-parse glob))
- (body `(with-current-buffer (get-buffer-create " *eglot-glob-matcher*")
- (erase-buffer)
- (save-excursion (insert string))
- (cl-labels ,(cl-loop for (this that) on states
- for (self emit text) = this
- for next = (or (car that) 'eobp)
- collect (funcall emit text self next))
- (or (,(caar states))
- (error "Glob done but more unmatched text: '%s'"
- (buffer-substring (point) (point-max)))))))
- (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body))))
+ (body `(with-current-buffer (get-buffer-create " *eglot-glob-matcher*")
+ (erase-buffer)
+ (save-excursion (insert string))
+ (cl-labels ,(cl-loop for (this that) on states
+ for (self emit text) = this
+ for next = (or (car that) 'eobp)
+ collect (funcall emit text self next))
+ (or (,(caar states))
+ (error "Glob done but more unmatched text: '%s'"
+ (buffer-substring (point) (point-max)))))))
+ (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body))))
(if byte-compile (byte-compile form) form)))
(defun eglot--glob-emit-self (text self next)
@@ -3339,11 +3495,11 @@ If NOERROR, return predicate, else erroring function."
(defun eglot--glob-emit-** (_ self next)
`(,self () (or (ignore-errors (save-excursion (,next)))
- (and (re-search-forward "\\=/?[^/]+/?") (,self)))))
+ (and (re-search-forward "\\=/?[^/]+/?") (,self)))))
(defun eglot--glob-emit-* (_ self next)
`(,self () (re-search-forward "\\=[^/]")
- (or (ignore-errors (save-excursion (,next))) (,self))))
+ (or (ignore-errors (save-excursion (,next))) (,self))))
(defun eglot--glob-emit-? (_ self next)
`(,self () (re-search-forward "\\=[^/]") (,next)))
@@ -3351,9 +3507,9 @@ If NOERROR, return predicate, else erroring function."
(defun eglot--glob-emit-{} (arg self next)
(let ((alternatives (split-string (substring arg 1 (1- (length arg))) ",")))
`(,self ()
- (or (re-search-forward ,(concat "\\=" (regexp-opt alternatives)) nil t)
- (error "Failed matching any of %s" ',alternatives))
- (,next))))
+ (or (re-search-forward ,(concat "\\=" (regexp-opt alternatives)) nil t)
+ (error "Failed matching any of %s" ',alternatives))
+ (,next))))
(defun eglot--glob-emit-range (arg self next)
(when (eq ?! (aref arg 1)) (aset arg 1 ?^))
@@ -3366,32 +3522,115 @@ If NOERROR, return predicate, else erroring function."
"" "Eglot mode for listing server connections
\\{eglot-list-connections-mode-map}"
(setq-local tabulated-list-format
- `[("Language server" 16) ("Project name" 16) ("Modes handled" 16)])
+ `[("Language server" 16) ("Project name" 16) ("Modes handled" 16)])
(tabulated-list-init-header))
(defun eglot-list-connections ()
"List currently active Eglot connections."
(interactive)
(with-current-buffer
- (get-buffer-create "*EGLOT connections*")
+ (get-buffer-create "*EGLOT connections*")
(let ((inhibit-read-only t))
(erase-buffer)
(eglot-list-connections-mode)
(setq-local tabulated-list-entries
- (mapcar
- (lambda (server)
- (list server
- `[,(or (plist-get (eglot--server-info server) :name)
- (jsonrpc-name server))
- ,(eglot-project-nickname server)
- ,(mapconcat #'symbol-name
- (eglot--major-modes server)
- ", ")]))
- (cl-reduce #'append
- (hash-table-values eglot--servers-by-project))))
+ (mapcar
+ (lambda (server)
+ (list server
+ `[,(or (plist-get (eglot--server-info server) :name)
+ (jsonrpc-name server))
+ ,(eglot-project-nickname server)
+ ,(mapconcat #'symbol-name
+ (eglot--major-modes server)
+ ", ")]))
+ (cl-reduce #'append
+ (hash-table-values eglot--servers-by-project))))
(revert-buffer)
(pop-to-buffer (current-buffer)))))
+(defface eglot-inlay-hint
+ '((t (:inherit shadow :height 0.8)))
+ "Face used for inlay hint overlays.")
+
+;; (define-minor-mode eglot--inlay-mode
+;; "Mode for displaying inlay hint."
+;; :lighter " inlay"
+;; )
+
+;; (defun eglot--update-hints()
+;; "Refresh inlay hints from LSP server."
+;; (mapc #'delete-overlay (overlays-in (point-min) (point-max)))
+;; (let ((read-only-p buffer-read-only)
+;; overlays)
+;; (condition-case err
+;; (let ((lens-table (make-hash-table)))
+;; ;; Get the inlay hint objects.
+;; (mapc (lambda (inlayHint)
+;; (when (and (eglot--server-capable
+;; :inlayHintProvider :resolveProvider)
+;; (not (plist-member inlayHint :command)))
+;; (setq inlayHint
+;; (jsonrpc-request (eglot--current-server-or-lose)
+;; :inlayHint/resolve inlayHint)))
+;; (let ((line (thread-first inlayHint
+;; (plist-get :position)
+;; (plist-get :line))))
+;; (puthash line
+;; (append (gethash line lens-table) (list inlayHint))
+;; lens-table)))
+;; (jsonrpc-request
+;; (eglot--current-server-or-lose)
+;; :textDocument/inlayHint
+;; (list :textDocument (eglot--TextDocumentIdentifier) :range (list :start (list :line 0 :character 0) :end (list :line (count-lines (point-min) (point-max)) :character 0)))
+;; :deferred :textDocument/inlayHint))
+
+;; ;; Make overlays for them.
+;; (maphash
+;; (lambda (line values)
+;; ;; TODO: manage InlayHintLabelPart[]
+;; (eglot--widening
+;; (let ((c (plist-get (plist-get (car values) :position) :character))
+;; (label-text (propertize (if (and (plist-member (car values) :label) (stringp (plist-get (car values) :label))) (plist-get (car values) :label) "")))
+;; (text label-text 'mouse-face 'highlight)
+;; )
+;; (goto-char (point-min))
+;; (forward-line line)
+;; (eglot-move-to-column c)
+;; (let ((ov (make-overlay (point) (point))))
+;; (push ov overlays)
+;; (overlay-put ov 'eglot-inlay-hint values)
+;; (overlay-put ov 'before-string (propertize text 'face 'eglot-inlay-hint))
+;; ))))
+;; lens-table)
+;; )
+;; (error
+;; (mapc #'delete-overlay overlays)
+;; (setq buffer-read-only read-only-p)
+;; (eglot--inlay-mode -1)
+;; (signal (car err) (cdr err))))))
+
+;; (defun eglot-inlay-hint ()
+;; "Ask the server for inlay hint and show them in the current buffer."
+;; (interactive)
+;; (unless (eglot--server-capable :inlayHintProvider)
+;; (error "Server does not support inlay hint."))
+
+;; ;; Setup minor mode which will clean them up and provide keybindings.
+;; (eglot--inlay-mode 1)
+;; (eglot--update-hints)
+;; (add-hook 'after-save-hook #'eglot--update-hints nil t)
+
+;; (cl-labels
+;; ((cleanup
+;; ()
+;; (remove-hook 'eglot--inlay-mode-hook #'cleanup t)
+;; (remove-hook 'after-save-hook 'eglot--update-hints t)
+;; (unless eglot--inlay-mode
+;; (mapc #'delete-overlay overlays)
+;; (setq buffer-read-only read-only-p))))
+;; (add-hook 'eglot--inlay-mode-hook #'cleanup nil t))
+;; )
+
\f
;;; Hacks
;;;
@@ -3408,7 +3647,7 @@ If NOERROR, return predicate, else erroring function."
;;;
(make-obsolete-variable 'eglot--managed-mode-hook
- 'eglot-managed-mode-hook "1.6")
+ 'eglot-managed-mode-hook "1.6")
(provide 'eglot)
\f
@@ -3430,10 +3669,10 @@ If NOERROR, return predicate, else erroring function."
;; accordingly. tryc/allc names made akward/recognizable on purpose.
(add-to-list 'completion-styles-alist
- '(eglot--lsp-backend-style
- eglot--lsp-backend-style-try-completion
- eglot--lsp-backend-style-all-completions
- "Ad-hoc completion style provided by the completion table."))
+ '(eglot--lsp-backend-style
+ eglot--lsp-backend-style-try-completion
+ eglot--lsp-backend-style-all-completions
+ "Ad-hoc completion style provided by the completion table."))
(defun eglot--lsp-backend-style-call (op string table pred point)
(when (functionp table)
--
2.34.1
next prev parent reply other threads:[~2023-02-21 18:42 UTC|newest]
Thread overview: 28+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-02-11 8:13 bug#61412: [PATCH] Add inlay hints to eglot Chinmay Dalal
2023-02-11 11:50 ` Chinmay Dalal
2023-02-11 15:23 ` bug#61412: Question about implementation Chinmay Dalal
2023-02-13 15:35 ` bug#61412: Hover github discussion Chinmay Dalal
2023-02-15 13:58 ` Eli Zaretskii
2023-02-15 15:05 ` João Távora
2023-02-15 15:38 ` Eli Zaretskii
2023-02-15 12:56 ` bug#61412: [PATCH v2] Add inlay hints to eglot Chinmay Dalal
2023-02-15 13:08 ` bug#61412: [PATCH v3] " Chinmay Dalal
2023-02-15 16:24 ` bug#61412: Inlay activation Chinmay Dalal
2023-02-15 18:09 ` Eli Zaretskii
2023-02-15 18:48 ` Chinmay Dalal
2023-02-15 19:01 ` João Távora
2023-02-15 19:17 ` Chinmay Dalal
2023-02-15 19:41 ` Eli Zaretskii
2023-02-15 20:17 ` Chinmay Dalal
2023-02-21 15:13 ` bug#61412: Inlay hints implementation João Távora
2023-02-21 15:21 ` Eli Zaretskii
2023-02-21 18:42 ` Dimitri Belopopsky [this message]
2023-02-21 21:26 ` João Távora
2023-02-25 0:21 ` João Távora
2023-02-25 7:59 ` Eli Zaretskii
2023-02-25 10:19 ` João Távora
2023-02-21 15:33 ` Chinmay Dalal
2023-02-21 15:57 ` Chinmay Dalal
2023-02-22 15:26 ` Chinmay Dalal
2023-02-22 16:51 ` Chinmay Dalal
2023-02-22 23:17 ` João Távora
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CA+46MXbbW60t=JccgKGX39jTkOu+i=GZhzSQsfnqBUPb-mnJWg@mail.gmail.com' \
--to=dimitri@belopopsky.com \
--cc=61412@debbugs.gnu.org \
--cc=dalal.chinmay.0101@gmail.com \
--cc=eliz@gnu.org \
--cc=joaotavora@gmail.com \
--cc=luangruo@yahoo.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).