eglot.el (179857B)
1 ;;; eglot.el --- The Emacs Client for LSP servers -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2018-2023 Free Software Foundation, Inc. 4 5 ;; Version: 1.15 6 ;; Author: João Távora <joaotavora@gmail.com> 7 ;; Maintainer: João Távora <joaotavora@gmail.com> 8 ;; URL: https://github.com/joaotavora/eglot 9 ;; Keywords: convenience, languages 10 ;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) 11 12 ;; This is a GNU ELPA :core package. Avoid adding functionality 13 ;; that is not available in the version of Emacs recorded above or any 14 ;; of the package dependencies. 15 16 ;; This file is part of GNU Emacs. 17 18 ;; GNU Emacs is free software: you can redistribute it and/or modify 19 ;; it under the terms of the GNU General Public License as published by 20 ;; the Free Software Foundation, either version 3 of the License, or 21 ;; (at your option) any later version. 22 23 ;; GNU Emacs is distributed in the hope that it will be useful, 24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 26 ;; GNU General Public License for more details. 27 28 ;; You should have received a copy of the GNU General Public License 29 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 30 31 ;;; Commentary: 32 33 ;; Eglot ("Emacs Polyglot") is an Emacs LSP client that stays out of 34 ;; your way. 35 ;; 36 ;; Typing M-x eglot in some source file is often enough to get you 37 ;; started, if the language server you're looking to use is installed 38 ;; in your system. Please refer to the manual, available from 39 ;; https://joaotavora.github.io/eglot/ or from M-x info for more usage 40 ;; instructions. 41 ;; 42 ;; If you wish to contribute changes to Eglot, please do read the user 43 ;; manual first. Additionally, take the following in consideration: 44 45 ;; * Eglot's main job is to hook up the information that language 46 ;; servers offer via LSP to Emacs's UI facilities: Xref for 47 ;; definition-chasing, Flymake for diagnostics, Eldoc for at-point 48 ;; documentation, etc. Eglot's job is generally *not* to provide 49 ;; such a UI itself, though a small number of simple 50 ;; counter-examples do exist, e.g. in the `eglot-rename' command or 51 ;; the `eglot-inlay-hints-mode' minor mode. When a new UI is 52 ;; evidently needed, consider adding a new package to Emacs, or 53 ;; extending an existing one. 54 ;; 55 ;; * Eglot was designed to function with just the UI facilities found 56 ;; in the latest Emacs core, as long as those facilities are also 57 ;; available as GNU ELPA :core packages. Historically, a number of 58 ;; :core packages were added or reworked in Emacs to make this 59 ;; possible. This principle should be upheld when adding new LSP 60 ;; features or tweaking existing ones. Design any new facilities in 61 ;; a way that they could work in the absence of LSP or using some 62 ;; different protocol, then make sure Eglot can link up LSP 63 ;; information to it. 64 65 ;; * There are few Eglot configuration variables. This principle 66 ;; should also be upheld. If Eglot had these variables, it could be 67 ;; duplicating configuration found elsewhere, bloating itself up, 68 ;; and making it generally hard to integrate with the ever growing 69 ;; set of LSP features and Emacs packages. For instance, this is 70 ;; why one finds a single variable 71 ;; `eglot-ignored-server-capabilities' instead of a number of 72 ;; capability-specific flags, or why customizing the display of 73 ;; LSP-provided documentation is done via ElDoc's variables, not 74 ;; Eglot's. 75 ;; 76 ;; * Linking up LSP information to other libraries is generally done 77 ;; in the `eglot--managed-mode' minor mode function, by 78 ;; buffer-locally setting the other library's variables to 79 ;; Eglot-specific versions. When deciding what to set the variable 80 ;; to, the general idea is to choose a good default for beginners 81 ;; that doesn't clash with Emacs's defaults. The settings are only 82 ;; in place during Eglot's LSP-enriched tenure over a project. Even 83 ;; so, some of those decisions will invariably aggravate a minority 84 ;; of Emacs power users, but these users can use `eglot-stay-out-of' 85 ;; and `eglot-managed-mode-hook' to adjust things to their 86 ;; preferences. 87 ;; 88 ;; * On occasion, to enable new features, Eglot can have soft 89 ;; dependencies on popular libraries that are not in Emacs core. 90 ;; "Soft" means that the dependency doesn't impair any other use of 91 ;; Eglot beyond that feature. Such is the case of the snippet 92 ;; functionality, via the Yasnippet package, Markdown formatting of 93 ;; at-point documentation via the markdown-mode package, and nicer 94 ;; looking completions when the Company package is used. 95 96 ;;; Code: 97 98 (require 'imenu) 99 (require 'cl-lib) 100 101 (require 'url-parse) 102 (require 'url-util) 103 (require 'pcase) 104 (require 'compile) ; for some faces 105 (require 'warnings) 106 (eval-when-compile 107 (require 'subr-x)) 108 (require 'filenotify) 109 (require 'ert) 110 (require 'text-property-search nil t) 111 112 ;; These dependencies are also GNU ELPA core packages. Because of 113 ;; bug#62576, since there is a risk that M-x package-install, despite 114 ;; having installed them, didn't correctly re-load them over the 115 ;; built-in versions. 116 (eval-and-compile 117 (load "project") 118 (load "eldoc") 119 (load "seq") 120 (load "flymake") 121 (load "xref") 122 (load "jsonrpc") 123 (load "external-completion")) 124 125 ;; forward-declare, but don't require (Emacs 28 doesn't seem to care) 126 (defvar markdown-fontify-code-blocks-natively) 127 (defvar company-backends) 128 (defvar company-tooltip-align-annotations) 129 (defvar tramp-ssh-controlmaster-options) 130 (defvar tramp-use-ssh-controlmaster-options) 131 132 133 ;;; User tweakable stuff 134 (defgroup eglot nil 135 "Interaction with Language Server Protocol servers." 136 :prefix "eglot-" 137 :group 'applications) 138 139 (defun eglot-alternatives (alternatives) 140 "Compute server-choosing function for `eglot-server-programs'. 141 Each element of ALTERNATIVES is a string PROGRAM or a list of 142 strings (PROGRAM ARGS...) where program names an LSP server 143 program to start with ARGS. Returns a function of one argument. 144 When invoked, that function will return a list (ABSPATH ARGS), 145 where ABSPATH is the absolute path of the PROGRAM that was 146 chosen (interactively or automatically)." 147 (lambda (&optional interactive) 148 ;; JT@2021-06-13: This function is way more complicated than it 149 ;; could be because it accounts for the fact that 150 ;; `eglot--executable-find' may take much longer to execute on 151 ;; remote files. 152 (let* ((listified (cl-loop for a in alternatives 153 collect (if (listp a) a (list a)))) 154 (err (lambda () 155 (error "None of '%s' are valid executables" 156 (mapconcat #'car listified ", "))))) 157 (cond (interactive 158 (let* ((augmented (mapcar (lambda (a) 159 (let ((found (eglot--executable-find 160 (car a) t))) 161 (and found 162 (cons (car a) (cons found (cdr a)))))) 163 listified)) 164 (available (remove nil augmented))) 165 (cond ((cdr available) 166 (cdr (assoc 167 (completing-read 168 "[eglot] More than one server executable available: " 169 (mapcar #'car available) 170 nil t nil nil (car (car available))) 171 available #'equal))) 172 ((cdr (car available))) 173 (t 174 ;; Don't error when used interactively, let the 175 ;; Eglot prompt the user for alternative (github#719) 176 nil)))) 177 (t 178 (cl-loop for (p . args) in listified 179 for probe = (eglot--executable-find p t) 180 when probe return (cons probe args) 181 finally (funcall err))))))) 182 183 (defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ("rust-analyzer")) 184 ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) 185 (vimrc-mode . ("vim-language-server" "--stdio")) 186 ((python-mode python-ts-mode) 187 . ,(eglot-alternatives 188 '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server"))) 189 ((js-json-mode json-mode json-ts-mode) 190 . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") 191 ("vscode-json-languageserver" "--stdio") 192 ("json-languageserver" "--stdio")))) 193 ((js-mode js-ts-mode tsx-ts-mode typescript-ts-mode typescript-mode) 194 . ("typescript-language-server" "--stdio")) 195 ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) 196 ((php-mode phps-mode) 197 . ,(eglot-alternatives 198 '(("phpactor" "language-server") 199 ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) 200 ((c-mode c-ts-mode c++-mode c++-ts-mode) 201 . ,(eglot-alternatives 202 '("clangd" "ccls"))) 203 (((caml-mode :language-id "ocaml") 204 (tuareg-mode :language-id "ocaml") reason-mode) 205 . ("ocamllsp")) 206 ((ruby-mode ruby-ts-mode) 207 . ("solargraph" "socket" "--port" :autoport)) 208 (haskell-mode 209 . ("haskell-language-server-wrapper" "--lsp")) 210 (elm-mode . ("elm-language-server")) 211 (mint-mode . ("mint" "ls")) 212 (kotlin-mode . ("kotlin-language-server")) 213 ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) 214 . ("gopls")) 215 ((R-mode ess-r-mode) . ("R" "--slave" "-e" 216 "languageserver::run()")) 217 ((java-mode java-ts-mode) . ("jdtls")) 218 ((dart-mode dart-ts-mode) 219 . ("dart" "language-server" 220 "--client-id" "emacs.eglot-dart")) 221 ((elixir-mode elixir-ts-mode heex-ts-mode) 222 . ,(if (and (fboundp 'w32-shell-dos-semantics) (w32-shell-dos-semantics)) 223 '("language_server.bat") 224 '("language_server.sh"))) 225 (ada-mode . ("ada_language_server")) 226 (scala-mode . ,(eglot-alternatives 227 '("metals" "metals-emacs"))) 228 (racket-mode . ("racket" "-l" "racket-langserver")) 229 ((tex-mode context-mode texinfo-mode bibtex-mode) 230 . ,(eglot-alternatives '("digestif" "texlab"))) 231 (erlang-mode . ("erlang_ls" "--transport" "stdio")) 232 ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) 233 (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp"))) 234 (gdscript-mode . ("localhost" 6008)) 235 ((fortran-mode f90-mode) . ("fortls")) 236 (futhark-mode . ("futhark" "lsp")) 237 (lua-mode . ,(eglot-alternatives 238 '("lua-language-server" "lua-lsp"))) 239 (zig-mode . ("zls")) 240 ((css-mode css-ts-mode) 241 . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") 242 ("css-languageserver" "--stdio")))) 243 (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) 244 ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) 245 ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) 246 . ("clojure-lsp")) 247 ((csharp-mode csharp-ts-mode) 248 . ,(eglot-alternatives 249 '(("omnisharp" "-lsp") 250 ("csharp-ls")))) 251 (purescript-mode . ("purescript-language-server" "--stdio")) 252 ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) 253 (markdown-mode 254 . ,(eglot-alternatives 255 '(("marksman" "server") 256 ("vscode-markdown-language-server" "--stdio")))) 257 (graphviz-dot-mode . ("dot-language-server" "--stdio"))) 258 "How the command `eglot' guesses the server to start. 259 An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE 260 identifies the buffers that are to be managed by a specific 261 language server. The associated CONTACT specifies how to connect 262 to a server for those buffers. 263 264 MAJOR-MODE can be: 265 266 * In the most common case, a symbol such as `c-mode'; 267 268 * A list (MAJOR-MODE-SYMBOL :LANGUAGE-ID ID) where 269 MAJOR-MODE-SYMBOL is the aforementioned symbol and ID is a 270 string identifying the language to the server; 271 272 * A list combining the previous two alternatives, meaning 273 multiple major modes will be associated with a single server 274 program. This association is such that the same resulting 275 server process will manage buffers of different major modes. 276 277 CONTACT can be: 278 279 * In the most common case, a list of strings (PROGRAM [ARGS...]). 280 PROGRAM is called with ARGS and is expected to serve LSP requests 281 over the standard input/output channels. 282 283 * A list (PROGRAM [ARGS...] :initializationOptions OPTIONS), 284 whereupon PROGRAM is called with ARGS as in the first option, 285 and the LSP \"initializationOptions\" JSON object is 286 constructed from OPTIONS. If OPTIONS is a unary function, it 287 is called with the server instance and should return a JSON 288 object. 289 290 * A list (HOST PORT [TCP-ARGS...]) where HOST is a string and 291 PORT is a positive integer for connecting to a server via TCP. 292 Remaining ARGS are passed to `open-network-stream' for 293 upgrading the connection with encryption or other capabilities. 294 295 * A list (PROGRAM [ARGS...] :autoport [MOREARGS...]), whereupon a 296 combination of previous options is used. First, an attempt is 297 made to find an available server port, then PROGRAM is launched 298 with ARGS; the `:autoport' keyword substituted for that number; 299 and MOREARGS. Eglot then attempts to establish a TCP 300 connection to that port number on the localhost. 301 302 * A cons (CLASS-NAME . INITARGS) where CLASS-NAME is a symbol 303 designating a subclass of `eglot-lsp-server', for representing 304 experimental LSP servers. INITARGS is a keyword-value plist 305 used to initialize the object of CLASS-NAME, or a plain list 306 interpreted as the previous descriptions of CONTACT. In the 307 latter case that plain list is used to produce a plist with a 308 suitable :PROCESS initarg to CLASS-NAME. The class 309 `eglot-lsp-server' descends from `jsonrpc-process-connection', 310 which you should see for the semantics of the mandatory 311 :PROCESS argument. 312 313 * A function of a single argument producing any of the above 314 values for CONTACT. The argument's value is non-nil if the 315 connection was requested interactively (e.g. from the `eglot' 316 command), and nil if it wasn't (e.g. from `eglot-ensure'). If 317 the call is interactive, the function can ask the user for 318 hints on finding the required programs, etc. Otherwise, it 319 should not ask the user for any input, and return nil or signal 320 an error if it can't produce a valid CONTACT. The helper 321 function `eglot-alternatives' (which see) can be used to 322 produce a function that offers more than one server for a given 323 MAJOR-MODE.") 324 325 (defface eglot-highlight-symbol-face 326 '((t (:inherit bold))) 327 "Face used to highlight the symbol at point.") 328 329 (defface eglot-mode-line 330 '((t (:inherit font-lock-constant-face :weight bold))) 331 "Face for package-name in Eglot's mode line.") 332 333 (defface eglot-diagnostic-tag-unnecessary-face 334 '((t (:inherit shadow))) 335 "Face used to render unused or unnecessary code.") 336 337 (defface eglot-diagnostic-tag-deprecated-face 338 '((t . (:inherit shadow :strike-through t))) 339 "Face used to render deprecated or obsolete code.") 340 341 (defcustom eglot-autoreconnect 3 342 "Control ability to reconnect automatically to the LSP server. 343 If t, always reconnect automatically (not recommended). If nil, 344 never reconnect automatically after unexpected server shutdowns, 345 crashes or network failures. A positive integer number says to 346 only autoreconnect if the previous successful connection attempt 347 lasted more than that many seconds." 348 :type '(choice (const :tag "Reconnect automatically" t) 349 (const :tag "Never reconnect" nil) 350 (integer :tag "Number of seconds"))) 351 352 (defcustom eglot-connect-timeout 30 353 "Number of seconds before timing out LSP connection attempts. 354 If nil, never time out." 355 :type '(choice (number :tag "Number of seconds") 356 (const :tag "Never time out" nil))) 357 358 (defcustom eglot-sync-connect 3 359 "Control blocking of LSP connection attempts. 360 If t, block for `eglot-connect-timeout' seconds. A positive 361 integer number means block for that many seconds, and then wait 362 for the connection in the background. nil has the same meaning 363 as 0, i.e. don't block at all." 364 :type '(choice (const :tag "Block for `eglot-connect-timeout' seconds" t) 365 (const :tag "Never block" nil) 366 (integer :tag "Number of seconds to block"))) 367 368 (defcustom eglot-autoshutdown nil 369 "If non-nil, shut down server after killing last managed buffer." 370 :type 'boolean) 371 372 (defcustom eglot-send-changes-idle-time 0.5 373 "Don't tell server of changes before Emacs's been idle for this many seconds." 374 :type 'number) 375 376 (defcustom eglot-events-buffer-size 2000000 377 "Control the size of the Eglot events buffer. 378 If a number, don't let the buffer grow larger than that many 379 characters. If 0, don't use an event's buffer at all. If nil, 380 let the buffer grow forever. 381 382 For changes on this variable to take effect on a connection 383 already started, you need to restart the connection. That can be 384 done by `eglot-reconnect'." 385 :type '(choice (const :tag "No limit" nil) 386 (integer :tag "Number of characters"))) 387 388 (defcustom eglot-confirm-server-initiated-edits 'confirm 389 "Non-nil if server-initiated edits should be confirmed with user." 390 :type '(choice (const :tag "Don't show confirmation prompt" nil) 391 (const :tag "Show confirmation prompt" confirm))) 392 393 (defcustom eglot-extend-to-xref nil 394 "If non-nil, activate Eglot in cross-referenced non-project files." 395 :type 'boolean) 396 397 (defcustom eglot-prefer-plaintext nil 398 "If non-nil, always request plaintext responses to hover requests." 399 :type 'boolean) 400 401 (defcustom eglot-menu-string "eglot" 402 "String displayed in mode line when Eglot is active." 403 :type 'string) 404 405 (defcustom eglot-report-progress t 406 "If non-nil, show progress of long running LSP server work. 407 If set to `messages', use *Messages* buffer, else use Eglot's 408 mode line indicator." 409 :type 'boolean 410 :version "1.10") 411 412 (defvar eglot-withhold-process-id nil 413 "If non-nil, Eglot will not send the Emacs process id to the language server. 414 This can be useful when using docker to run a language server.") 415 416 ;; Customizable via `completion-category-overrides'. 417 (when (assoc 'flex completion-styles-alist) 418 (add-to-list 'completion-category-defaults '(eglot (styles flex basic)))) 419 420 421 ;;; Constants 422 ;;; 423 (defconst eglot--symbol-kind-names 424 `((1 . "File") (2 . "Module") 425 (3 . "Namespace") (4 . "Package") (5 . "Class") 426 (6 . "Method") (7 . "Property") (8 . "Field") 427 (9 . "Constructor") (10 . "Enum") (11 . "Interface") 428 (12 . "Function") (13 . "Variable") (14 . "Constant") 429 (15 . "String") (16 . "Number") (17 . "Boolean") 430 (18 . "Array") (19 . "Object") (20 . "Key") 431 (21 . "Null") (22 . "EnumMember") (23 . "Struct") 432 (24 . "Event") (25 . "Operator") (26 . "TypeParameter"))) 433 434 (defconst eglot--kind-names 435 `((1 . "Text") (2 . "Method") (3 . "Function") (4 . "Constructor") 436 (5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface") 437 (9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value") 438 (13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color") 439 (17 . "File") (18 . "Reference") (19 . "Folder") (20 . "EnumMember") 440 (21 . "Constant") (22 . "Struct") (23 . "Event") (24 . "Operator") 441 (25 . "TypeParameter"))) 442 443 (defconst eglot--tag-faces 444 `((1 . eglot-diagnostic-tag-unnecessary-face) 445 (2 . eglot-diagnostic-tag-deprecated-face))) 446 447 (defvaralias 'eglot-{} 'eglot--{}) 448 (defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.") 449 450 (defun eglot--executable-find (command &optional remote) 451 "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26." 452 (if (>= emacs-major-version 27) (executable-find command remote) 453 (executable-find command))) 454 455 (defun eglot--accepted-formats () 456 (if (and (not eglot-prefer-plaintext) (fboundp 'gfm-view-mode)) 457 ["markdown" "plaintext"] ["plaintext"])) 458 459 460 ;;; Message verification helpers 461 ;;; 462 (eval-and-compile 463 (defvar eglot--lsp-interface-alist 464 `( 465 (CodeAction (:title) (:kind :diagnostics :edit :command :isPreferred)) 466 (ConfigurationItem () (:scopeUri :section)) 467 (Command ((:title . string) (:command . string)) (:arguments)) 468 (CompletionItem (:label) 469 (:kind :detail :documentation :deprecated :preselect 470 :sortText :filterText :insertText :insertTextFormat 471 :textEdit :additionalTextEdits :commitCharacters 472 :command :data :tags)) 473 (Diagnostic (:range :message) (:severity :code :source :relatedInformation :codeDescription :tags)) 474 (DocumentHighlight (:range) (:kind)) 475 (FileSystemWatcher (:globPattern) (:kind)) 476 (Hover (:contents) (:range)) 477 (InitializeResult (:capabilities) (:serverInfo)) 478 (Location (:uri :range)) 479 (LocationLink (:targetUri :targetRange :targetSelectionRange) (:originSelectionRange)) 480 (LogMessageParams (:type :message)) 481 (MarkupContent (:kind :value)) 482 (ParameterInformation (:label) (:documentation)) 483 (Position (:line :character)) 484 (Range (:start :end)) 485 (Registration (:id :method) (:registerOptions)) 486 (ResponseError (:code :message) (:data)) 487 (ShowMessageParams (:type :message)) 488 (ShowMessageRequestParams (:type :message) (:actions)) 489 (SignatureHelp (:signatures) (:activeSignature :activeParameter)) 490 (SignatureInformation (:label) (:documentation :parameters :activeParameter)) 491 (SymbolInformation (:name :kind :location) 492 (:deprecated :containerName)) 493 (DocumentSymbol (:name :range :selectionRange :kind) 494 (:detail :deprecated :children)) 495 (TextDocumentEdit (:textDocument :edits) ()) 496 (TextEdit (:range :newText)) 497 (VersionedTextDocumentIdentifier (:uri :version) ()) 498 (WorkDoneProgress (:kind) (:title :message :percentage :cancellable)) 499 (WorkspaceEdit () (:changes :documentChanges)) 500 (WorkspaceSymbol (:name :kind) (:containerName :location :data)) 501 (InlayHint (:position :label) (:kind :textEdits :tooltip :paddingLeft 502 :paddingRight :data)) 503 (InlayHintLabelPart (:value) (:tooltip :location :command))) 504 "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces. 505 506 INTERFACE-NAME is a symbol designated by the spec as 507 \"interface\". INTERFACE is a list (REQUIRED OPTIONAL) where 508 REQUIRED and OPTIONAL are lists of KEYWORD designating field 509 names that must be, or may be, respectively, present in a message 510 adhering to that interface. KEY can be a keyword or a cons (SYM 511 TYPE), where type is used by `cl-typep' to check types at 512 runtime. 513 514 Here's what an element of this alist might look like: 515 516 (Command ((:title . string) (:command . string)) (:arguments))")) 517 518 (eval-and-compile 519 (defvar eglot-strict-mode 520 '(;; Uncomment next lines for fun and debugging 521 ;; disallow-non-standard-keys 522 ;; enforce-required-keys 523 ;; enforce-optional-keys 524 no-unknown-interfaces) 525 "How strictly to check LSP interfaces at compile- and run-time. 526 527 Value is a list of symbols (if the list is empty, no checks are 528 performed). 529 530 If the symbol `disallow-non-standard-keys' is present, an error 531 is raised if any extraneous fields are sent by the server. At 532 compile-time, a warning is raised if a destructuring spec 533 includes such a field. 534 535 If the symbol `enforce-required-keys' is present, an error is 536 raised if any required fields are missing from the message sent 537 from the server. At compile-time, a warning is raised if a 538 destructuring spec doesn't use such a field. 539 540 If the symbol `enforce-optional-keys' is present, nothing special 541 happens at run-time. At compile-time, a warning is raised if a 542 destructuring spec doesn't use all optional fields. 543 544 If the symbol `disallow-unknown-methods' is present, Eglot warns 545 on unknown notifications and errors on unknown requests. 546 547 If the symbol `no-unknown-interfaces' is present, Eglot warns at 548 compile time if an undeclared LSP interface is used.")) 549 550 (cl-defun eglot--check-object (interface-name 551 object 552 &optional 553 (enforce-required t) 554 (disallow-non-standard t) 555 (check-types t)) 556 "Check that OBJECT conforms to INTERFACE. Error otherwise." 557 (cl-destructuring-bind 558 (&key types required-keys optional-keys &allow-other-keys) 559 (eglot--interface interface-name) 560 (when-let ((missing (and enforce-required 561 (cl-set-difference required-keys 562 (eglot--plist-keys object))))) 563 (eglot--error "A `%s' must have %s" interface-name missing)) 564 (when-let ((excess (and disallow-non-standard 565 (cl-set-difference 566 (eglot--plist-keys object) 567 (append required-keys optional-keys))))) 568 (eglot--error "A `%s' mustn't have %s" interface-name excess)) 569 (when check-types 570 (cl-loop 571 for (k v) on object by #'cddr 572 for type = (or (cdr (assoc k types)) t) ;; FIXME: enforce nil type? 573 unless (cl-typep v type) 574 do (eglot--error "A `%s' must have a %s as %s, but has %s" 575 interface-name))) 576 t)) 577 578 (eval-and-compile 579 (defun eglot--keywordize-vars (vars) 580 (mapcar (lambda (var) (intern (format ":%s" var))) vars)) 581 582 (defun eglot--ensure-type (k) (if (consp k) k (cons k t))) 583 584 (defun eglot--interface (interface-name) 585 (let* ((interface (assoc interface-name eglot--lsp-interface-alist)) 586 (required (mapcar #'eglot--ensure-type (car (cdr interface)))) 587 (optional (mapcar #'eglot--ensure-type (cadr (cdr interface))))) 588 (list :types (append required optional) 589 :required-keys (mapcar #'car required) 590 :optional-keys (mapcar #'car optional)))) 591 592 (defun eglot--check-dspec (interface-name dspec) 593 "Check destructuring spec DSPEC against INTERFACE-NAME." 594 (cl-destructuring-bind (&key required-keys optional-keys &allow-other-keys) 595 (eglot--interface interface-name) 596 (cond ((or required-keys optional-keys) 597 (let ((too-many 598 (and 599 (memq 'disallow-non-standard-keys eglot-strict-mode) 600 (cl-set-difference 601 (eglot--keywordize-vars dspec) 602 (append required-keys optional-keys)))) 603 (ignored-required 604 (and 605 (memq 'enforce-required-keys eglot-strict-mode) 606 (cl-set-difference 607 required-keys (eglot--keywordize-vars dspec)))) 608 (missing-out 609 (and 610 (memq 'enforce-optional-keys eglot-strict-mode) 611 (cl-set-difference 612 optional-keys (eglot--keywordize-vars dspec))))) 613 (when too-many (byte-compile-warn 614 "Destructuring for %s has extraneous %s" 615 interface-name too-many)) 616 (when ignored-required (byte-compile-warn 617 "Destructuring for %s ignores required %s" 618 interface-name ignored-required)) 619 (when missing-out (byte-compile-warn 620 "Destructuring for %s is missing out on %s" 621 interface-name missing-out)))) 622 ((memq 'no-unknown-interfaces eglot-strict-mode) 623 (byte-compile-warn "Unknown LSP interface %s" interface-name)))))) 624 625 (cl-defmacro eglot--dbind (vars object &body body) 626 "Destructure OBJECT, binding VARS in BODY. 627 VARS is ([(INTERFACE)] SYMS...) 628 Honor `eglot-strict-mode'." 629 (declare (indent 2) (debug (sexp sexp &rest form))) 630 (let ((interface-name (if (consp (car vars)) 631 (car (pop vars)))) 632 (object-once (make-symbol "object-once")) 633 (fn-once (make-symbol "fn-once"))) 634 (cond (interface-name 635 (eglot--check-dspec interface-name vars) 636 `(let ((,object-once ,object)) 637 (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once 638 (eglot--check-object ',interface-name ,object-once 639 (memq 'enforce-required-keys eglot-strict-mode) 640 (memq 'disallow-non-standard-keys eglot-strict-mode) 641 (memq 'check-types eglot-strict-mode)) 642 ,@body))) 643 (t 644 `(let ((,object-once ,object) 645 (,fn-once (lambda (,@vars) ,@body))) 646 (if (memq 'disallow-non-standard-keys eglot-strict-mode) 647 (cl-destructuring-bind (&key ,@vars) ,object-once 648 (funcall ,fn-once ,@vars)) 649 (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once 650 (funcall ,fn-once ,@vars)))))))) 651 652 653 (cl-defmacro eglot--lambda (cl-lambda-list &body body) 654 "Function of args CL-LAMBDA-LIST for processing INTERFACE objects. 655 Honor `eglot-strict-mode'." 656 (declare (indent 1) (debug (sexp &rest form))) 657 (let ((e (cl-gensym "jsonrpc-lambda-elem"))) 658 `(lambda (,e) (cl-block nil (eglot--dbind ,cl-lambda-list ,e ,@body))))) 659 660 (cl-defmacro eglot--dcase (obj &rest clauses) 661 "Like `pcase', but for the LSP object OBJ. 662 CLAUSES is a list (DESTRUCTURE FORMS...) where DESTRUCTURE is 663 treated as in `eglot--dbind'." 664 (declare (indent 1) (debug (sexp &rest (sexp &rest form)))) 665 (let ((obj-once (make-symbol "obj-once"))) 666 `(let ((,obj-once ,obj)) 667 (cond 668 ,@(cl-loop 669 for (vars . body) in clauses 670 for vars-as-keywords = (eglot--keywordize-vars vars) 671 for interface-name = (if (consp (car vars)) 672 (car (pop vars))) 673 for condition = 674 (cond (interface-name 675 (eglot--check-dspec interface-name vars) 676 ;; In this mode, in runtime, we assume 677 ;; `eglot-strict-mode' is partially on, otherwise we 678 ;; can't disambiguate between certain types. 679 `(ignore-errors 680 (eglot--check-object 681 ',interface-name ,obj-once 682 t 683 (memq 'disallow-non-standard-keys eglot-strict-mode) 684 t))) 685 (t 686 ;; In this interface-less mode we don't check 687 ;; `eglot-strict-mode' at all: just check that the object 688 ;; has all the keys the user wants to destructure. 689 `(null (cl-set-difference 690 ',vars-as-keywords 691 (eglot--plist-keys ,obj-once))))) 692 collect `(,condition 693 (cl-destructuring-bind (&key ,@vars &allow-other-keys) 694 ,obj-once 695 ,@body))) 696 (t 697 (eglot--error "%S didn't match any of %S" 698 ,obj-once 699 ',(mapcar #'car clauses))))))) 700 701 702 ;;; API (WORK-IN-PROGRESS!) 703 ;;; 704 (cl-defmacro eglot--when-live-buffer (buf &rest body) 705 "Check BUF live, then do BODY in it." (declare (indent 1) (debug t)) 706 (let ((b (cl-gensym))) 707 `(let ((,b ,buf)) (if (buffer-live-p ,b) (with-current-buffer ,b ,@body))))) 708 709 (cl-defmacro eglot--when-buffer-window (buf &body body) 710 "Check BUF showing somewhere, then do BODY in it." (declare (indent 1) (debug t)) 711 (let ((b (cl-gensym))) 712 `(let ((,b ,buf)) 713 ;;notice the exception when testing with `ert' 714 (when (or (get-buffer-window ,b) (ert-running-test)) 715 (with-current-buffer ,b ,@body))))) 716 717 (cl-defmacro eglot--widening (&rest body) 718 "Save excursion and restriction. Widen. Then run BODY." (declare (debug t)) 719 `(save-excursion (save-restriction (widen) ,@body))) 720 721 (cl-defgeneric eglot-handle-request (server method &rest params) 722 "Handle SERVER's METHOD request with PARAMS.") 723 724 (cl-defgeneric eglot-handle-notification (server method &rest params) 725 "Handle SERVER's METHOD notification with PARAMS.") 726 727 (cl-defgeneric eglot-execute-command (server command arguments) 728 "Ask SERVER to execute COMMAND with ARGUMENTS.") 729 730 (cl-defgeneric eglot-initialization-options (server) 731 "JSON object to send under `initializationOptions'." 732 (:method (s) 733 (let ((probe (plist-get (eglot--saved-initargs s) :initializationOptions))) 734 (cond ((functionp probe) (funcall probe s)) 735 (probe) 736 (t eglot--{}))))) 737 738 (cl-defgeneric eglot-register-capability (server method id &rest params) 739 "Ask SERVER to register capability METHOD marked with ID." 740 (:method 741 (_s method _id &rest _params) 742 (eglot--warn "Server tried to register unsupported capability `%s'" 743 method))) 744 745 (cl-defgeneric eglot-unregister-capability (server method id &rest params) 746 "Ask SERVER to register capability METHOD marked with ID." 747 (:method 748 (_s method _id &rest _params) 749 (eglot--warn "Server tried to unregister unsupported capability `%s'" 750 method))) 751 752 (cl-defgeneric eglot-client-capabilities (server) 753 "What the Eglot LSP client supports for SERVER." 754 (:method (s) 755 (list 756 :workspace (list 757 :applyEdit t 758 :executeCommand `(:dynamicRegistration :json-false) 759 :workspaceEdit `(:documentChanges t) 760 :didChangeWatchedFiles 761 `(:dynamicRegistration 762 ,(if (eglot--trampish-p s) :json-false t)) 763 :symbol `(:dynamicRegistration :json-false) 764 :configuration t 765 :workspaceFolders t) 766 :textDocument 767 (list 768 :synchronization (list 769 :dynamicRegistration :json-false 770 :willSave t :willSaveWaitUntil t :didSave t) 771 :completion (list :dynamicRegistration :json-false 772 :completionItem 773 `(:snippetSupport 774 ,(if (and 775 (not (eglot--stay-out-of-p 'yasnippet)) 776 (eglot--snippet-expansion-fn)) 777 t 778 :json-false) 779 :deprecatedSupport t 780 :resolveSupport (:properties 781 ["documentation" 782 "details" 783 "additionalTextEdits"]) 784 :tagSupport (:valueSet [1])) 785 :contextSupport t) 786 :hover (list :dynamicRegistration :json-false 787 :contentFormat (eglot--accepted-formats)) 788 :signatureHelp (list :dynamicRegistration :json-false 789 :signatureInformation 790 `(:parameterInformation 791 (:labelOffsetSupport t) 792 :documentationFormat ,(eglot--accepted-formats) 793 :activeParameterSupport t)) 794 :references `(:dynamicRegistration :json-false) 795 :definition (list :dynamicRegistration :json-false 796 :linkSupport t) 797 :declaration (list :dynamicRegistration :json-false 798 :linkSupport t) 799 :implementation (list :dynamicRegistration :json-false 800 :linkSupport t) 801 :typeDefinition (list :dynamicRegistration :json-false 802 :linkSupport t) 803 :documentSymbol (list 804 :dynamicRegistration :json-false 805 :hierarchicalDocumentSymbolSupport t 806 :symbolKind `(:valueSet 807 [,@(mapcar 808 #'car eglot--symbol-kind-names)])) 809 :documentHighlight `(:dynamicRegistration :json-false) 810 :codeAction (list 811 :dynamicRegistration :json-false 812 :codeActionLiteralSupport 813 '(:codeActionKind 814 (:valueSet 815 ["quickfix" 816 "refactor" "refactor.extract" 817 "refactor.inline" "refactor.rewrite" 818 "source" "source.organizeImports"])) 819 :isPreferredSupport t) 820 :formatting `(:dynamicRegistration :json-false) 821 :rangeFormatting `(:dynamicRegistration :json-false) 822 :rename `(:dynamicRegistration :json-false) 823 :inlayHint `(:dynamicRegistration :json-false) 824 :publishDiagnostics (list :relatedInformation :json-false 825 ;; TODO: We can support :codeDescription after 826 ;; adding an appropriate UI to 827 ;; Flymake. 828 :codeDescriptionSupport :json-false 829 :tagSupport 830 `(:valueSet 831 [,@(mapcar 832 #'car eglot--tag-faces)]))) 833 :window `(:workDoneProgress t) 834 :general (list :positionEncodings ["utf-32" "utf-8" "utf-16"]) 835 :experimental eglot--{}))) 836 837 (cl-defgeneric eglot-workspace-folders (server) 838 "Return workspaceFolders for SERVER." 839 (let ((project (eglot--project server))) 840 (vconcat 841 (mapcar (lambda (dir) 842 (list :uri (eglot--path-to-uri dir) 843 :name (abbreviate-file-name dir))) 844 `(,(project-root project) ,@(project-external-roots project)))))) 845 846 (defclass eglot-lsp-server (jsonrpc-process-connection) 847 ((project-nickname 848 :documentation "Short nickname for the associated project." 849 :accessor eglot--project-nickname 850 :reader eglot-project-nickname) 851 (languages 852 :documentation "Alist ((MODE . LANGUAGE-ID-STRING)...) of managed languages." 853 :accessor eglot--languages) 854 (capabilities 855 :documentation "JSON object containing server capabilities." 856 :accessor eglot--capabilities) 857 (server-info 858 :documentation "JSON object containing server info." 859 :accessor eglot--server-info) 860 (shutdown-requested 861 :documentation "Flag set when server is shutting down." 862 :accessor eglot--shutdown-requested) 863 (project 864 :documentation "Project associated with server." 865 :accessor eglot--project) 866 (progress-reporters 867 :initform (make-hash-table :test #'equal) :accessor eglot--progress-reporters 868 :documentation "Maps LSP progress tokens to progress reporters.") 869 (inhibit-autoreconnect 870 :initform t 871 :documentation "Generalized boolean inhibiting auto-reconnection if true." 872 :accessor eglot--inhibit-autoreconnect) 873 (file-watches 874 :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'." 875 :initform (make-hash-table :test #'equal) :accessor eglot--file-watches) 876 (managed-buffers 877 :documentation "List of buffers managed by server." 878 :accessor eglot--managed-buffers) 879 (saved-initargs 880 :documentation "Saved initargs for reconnection purposes." 881 :accessor eglot--saved-initargs) 882 (inferior-process 883 :documentation "Server subprocess started automatically." 884 :accessor eglot--inferior-process)) 885 :documentation 886 "Represents a server. Wraps a process for LSP communication.") 887 888 (defun eglot--major-modes (s) "Major modes server S is responsible for." 889 (mapcar #'car (eglot--languages s))) 890 891 (defun eglot--language-ids (s) "LSP Language ID strings for server S's modes." 892 (mapcar #'cdr (eglot--languages s))) 893 894 (cl-defmethod initialize-instance :before ((_server eglot-lsp-server) &optional args) 895 (cl-remf args :initializationOptions)) 896 897 898 ;;; Process management 899 (defvar eglot--servers-by-project (make-hash-table :test #'equal) 900 "Keys are projects. Values are lists of processes.") 901 902 (defun eglot-shutdown (server &optional _interactive timeout preserve-buffers) 903 "Politely ask SERVER to quit. 904 Interactively, read SERVER from the minibuffer unless there is 905 only one and it's managing the current buffer. 906 907 Forcefully quit it if it doesn't respond within TIMEOUT seconds. 908 TIMEOUT defaults to 1.5 seconds. Don't leave this function with 909 the server still running. 910 911 If PRESERVE-BUFFERS is non-nil (interactively, when called with a 912 prefix argument), do not kill events and output buffers of 913 SERVER." 914 (interactive (list (eglot--read-server "Shutdown which server" 915 (eglot-current-server)) 916 t nil current-prefix-arg)) 917 (eglot--message "Asking %s politely to terminate" (jsonrpc-name server)) 918 (unwind-protect 919 (progn 920 (setf (eglot--shutdown-requested server) t) 921 (eglot--request server :shutdown nil :timeout (or timeout 1.5)) 922 (jsonrpc-notify server :exit nil)) 923 ;; Now ask jsonrpc.el to shut down the server. 924 (jsonrpc-shutdown server (not preserve-buffers)) 925 (unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server))))) 926 927 (defun eglot-shutdown-all (&optional preserve-buffers) 928 "Politely ask all language servers to quit, in order. 929 PRESERVE-BUFFERS as in `eglot-shutdown', which see." 930 (interactive (list current-prefix-arg)) 931 (cl-loop for ss being the hash-values of eglot--servers-by-project 932 do (with-demoted-errors "[eglot] shutdown all: %s" 933 (cl-loop for s in ss do (eglot-shutdown s nil nil preserve-buffers))))) 934 935 (defvar eglot--servers-by-xrefed-file (make-hash-table :test 'equal)) 936 937 (defun eglot--on-shutdown (server) 938 "Called by jsonrpc.el when SERVER is already dead." 939 ;; Turn off `eglot--managed-mode' where appropriate. 940 (dolist (buffer (eglot--managed-buffers server)) 941 (let (;; Avoid duplicate shutdowns (github#389) 942 (eglot-autoshutdown nil)) 943 (eglot--when-live-buffer buffer (eglot--managed-mode-off)))) 944 ;; Kill any expensive watches 945 (maphash (lambda (_id watches) 946 (mapcar #'file-notify-rm-watch watches)) 947 (eglot--file-watches server)) 948 ;; Kill any autostarted inferior processes 949 (when-let (proc (eglot--inferior-process server)) 950 (delete-process proc)) 951 ;; Sever the project/server relationship for `server' 952 (setf (gethash (eglot--project server) eglot--servers-by-project) 953 (delq server 954 (gethash (eglot--project server) eglot--servers-by-project))) 955 (maphash (lambda (f s) 956 (when (eq s server) (remhash f eglot--servers-by-xrefed-file))) 957 eglot--servers-by-xrefed-file) 958 (cond ((eglot--shutdown-requested server) 959 t) 960 ((not (eglot--inhibit-autoreconnect server)) 961 (eglot--warn "Reconnecting after unexpected server exit.") 962 (eglot-reconnect server)) 963 ((timerp (eglot--inhibit-autoreconnect server)) 964 (eglot--warn "Not auto-reconnecting, last one didn't last long.")))) 965 966 (defun eglot--all-major-modes () 967 "Return all known major modes." 968 (let ((retval)) 969 (mapatoms (lambda (sym) 970 (when (plist-member (symbol-plist sym) 'derived-mode-parent) 971 (push sym retval)))) 972 retval)) 973 974 (defvar eglot-command-history nil 975 "History of CONTACT arguments to `eglot'.") 976 977 (defun eglot--lookup-mode (mode) 978 "Lookup `eglot-server-programs' for MODE. 979 Return (LANGUAGES . CONTACT-PROXY). 980 981 MANAGED-MODES is a list with MODE as its first element. 982 Subsequent elements are other major modes also potentially 983 managed by the server that is to manage MODE. 984 985 LANGUAGE-IDS is a list of the same length as MANAGED-MODES. Each 986 elem is derived from the corresponding mode name, if not 987 specified in `eglot-server-programs' (which see). 988 989 CONTACT-PROXY is the value of the corresponding 990 `eglot-server-programs' entry." 991 (cl-flet ((languages (main-mode-sym specs) 992 (let* ((res 993 (mapcar (jsonrpc-lambda (sym &key language-id &allow-other-keys) 994 (cons sym 995 (or language-id 996 (or (get sym 'eglot-language-id) 997 (replace-regexp-in-string 998 "\\(?:-ts\\)?-mode$" "" 999 (symbol-name sym)))))) 1000 specs)) 1001 (head (cl-find main-mode-sym res :key #'car))) 1002 (cons head (delq head res))))) 1003 (cl-loop 1004 for (modes . contact) in eglot-server-programs 1005 for specs = (mapcar #'eglot--ensure-list 1006 (if (or (symbolp modes) (keywordp (cadr modes))) 1007 (list modes) modes)) 1008 thereis (cl-some (lambda (spec) 1009 (cl-destructuring-bind (sym &key &allow-other-keys) spec 1010 (and (provided-mode-derived-p mode sym) 1011 (cons (languages sym specs) contact)))) 1012 specs)))) 1013 1014 (defun eglot--guess-contact (&optional interactive) 1015 "Helper for `eglot'. 1016 Return (MANAGED-MODES PROJECT CLASS CONTACT LANG-IDS). If INTERACTIVE is 1017 non-nil, maybe prompt user, else error as soon as something can't 1018 be guessed." 1019 (let* ((guessed-mode (if buffer-file-name major-mode)) 1020 (guessed-mode-name (and guessed-mode (symbol-name guessed-mode))) 1021 (main-mode 1022 (cond 1023 ((and interactive 1024 (or (>= (prefix-numeric-value current-prefix-arg) 16) 1025 (not guessed-mode))) 1026 (intern 1027 (completing-read 1028 "[eglot] Start a server to manage buffers of what major mode? " 1029 (mapcar #'symbol-name (eglot--all-major-modes)) nil t 1030 guessed-mode-name nil guessed-mode-name nil))) 1031 ((not guessed-mode) 1032 (eglot--error "Can't guess mode to manage for `%s'" (current-buffer))) 1033 (t guessed-mode))) 1034 (languages-and-contact (eglot--lookup-mode main-mode)) 1035 (managed-modes (mapcar #'car (car languages-and-contact))) 1036 (language-ids (mapcar #'cdr (car languages-and-contact))) 1037 (guess (cdr languages-and-contact)) 1038 (guess (if (functionp guess) 1039 (funcall guess interactive) 1040 guess)) 1041 (class (or (and (consp guess) (symbolp (car guess)) 1042 (prog1 (unless current-prefix-arg (car guess)) 1043 (setq guess (cdr guess)))) 1044 'eglot-lsp-server)) 1045 (program (and (listp guess) 1046 (stringp (car guess)) 1047 ;; A second element might be the port of a (host, port) 1048 ;; pair, but in that case it is not a string. 1049 (or (null (cdr guess)) (stringp (cadr guess))) 1050 (car guess))) 1051 (base-prompt 1052 (and interactive 1053 "Enter program to execute (or <host>:<port>): ")) 1054 (full-program-invocation 1055 (and program 1056 (cl-every #'stringp guess) 1057 (combine-and-quote-strings guess))) 1058 (prompt 1059 (and base-prompt 1060 (cond (current-prefix-arg base-prompt) 1061 ((null guess) 1062 (format "[eglot] Couldn't guess LSP server for `%s'\n%s" 1063 main-mode base-prompt)) 1064 ((and program 1065 (not (file-name-absolute-p program)) 1066 (not (eglot--executable-find program t))) 1067 (if full-program-invocation 1068 (concat (format "[eglot] I guess you want to run `%s'" 1069 full-program-invocation) 1070 (format ", but I can't find `%s' in PATH!" 1071 program) 1072 "\n" base-prompt) 1073 (eglot--error 1074 (concat "`%s' not found in PATH, but can't form" 1075 " an interactive prompt for to fix %s!") 1076 program guess)))))) 1077 (contact 1078 (or (and prompt 1079 (split-string-and-unquote 1080 (read-shell-command 1081 prompt 1082 full-program-invocation 1083 'eglot-command-history))) 1084 guess))) 1085 (list managed-modes (eglot--current-project) class contact language-ids))) 1086 1087 (defvar eglot-lsp-context) 1088 (put 'eglot-lsp-context 'variable-documentation 1089 "Dynamically non-nil when searching for projects in LSP context.") 1090 1091 (defun eglot--current-project () 1092 "Return a project object for Eglot's LSP purposes. 1093 This relies on `project-current' and thus on 1094 `project-find-functions'. Functions in the latter 1095 variable (which see) can query the value `eglot-lsp-context' to 1096 decide whether a given directory is a project containing a 1097 suitable root directory for a given LSP server's purposes." 1098 (let ((eglot-lsp-context t)) 1099 (or (project-current) 1100 `(transient . ,(expand-file-name default-directory))))) 1101 1102 ;;;###autoload 1103 (defun eglot (managed-major-modes project class contact language-ids 1104 &optional _interactive) 1105 "Start LSP server for PROJECT's buffers under MANAGED-MAJOR-MODES. 1106 1107 This starts a Language Server Protocol (LSP) server suitable for 1108 the buffers of PROJECT whose `major-mode' is among 1109 MANAGED-MAJOR-MODES. CLASS is the class of the LSP server to 1110 start and CONTACT specifies how to connect to the server. 1111 1112 Interactively, the command attempts to guess MANAGED-MAJOR-MODES, 1113 CLASS, CONTACT, and LANGUAGE-IDS from `eglot-server-programs', 1114 according to the current buffer's `major-mode'. PROJECT is 1115 guessed from `project-find-functions'. The search for active 1116 projects in this context binds `eglot-lsp-context' (which see). 1117 1118 If it can't guess, it prompts the user for the mode and the 1119 server. With a single \\[universal-argument] prefix arg, it 1120 always prompts for COMMAND. With two \\[universal-argument], it 1121 also always prompts for MANAGED-MAJOR-MODE. 1122 1123 The LSP server of CLASS is started (or contacted) via CONTACT. 1124 If this operation is successful, current *and future* file 1125 buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\" 1126 by the LSP server, meaning the information about their contents is 1127 exchanged periodically with the server to provide enhanced 1128 code-analysis via `xref-find-definitions', `flymake-mode', 1129 `eldoc-mode', and `completion-at-point', among others. 1130 1131 PROJECT is a project object as returned by `project-current'. 1132 1133 CLASS is a subclass of `eglot-lsp-server'. 1134 1135 CONTACT specifies how to contact the server. It is a 1136 keyword-value plist used to initialize CLASS or a plain list as 1137 described in `eglot-server-programs', which see. 1138 1139 LANGUAGE-IDS is a list of language ID string to send to the 1140 server for each element in MANAGED-MAJOR-MODES. 1141 1142 INTERACTIVE is ignored and provided for backward compatibility." 1143 (interactive 1144 (let ((current-server (eglot-current-server))) 1145 (unless (or (null current-server) 1146 (y-or-n-p "\ 1147 [eglot] Shut down current connection before attempting new one?")) 1148 (user-error "[eglot] Connection attempt aborted by user.")) 1149 (prog1 (append (eglot--guess-contact t) '(t)) 1150 (when current-server (ignore-errors (eglot-shutdown current-server)))))) 1151 (eglot--connect (eglot--ensure-list managed-major-modes) 1152 project class contact 1153 (eglot--ensure-list language-ids))) 1154 1155 (defun eglot-reconnect (server &optional interactive) 1156 "Reconnect to SERVER. 1157 INTERACTIVE is t if called interactively." 1158 (interactive (list (eglot--current-server-or-lose) t)) 1159 (when (jsonrpc-running-p server) 1160 (ignore-errors (eglot-shutdown server interactive nil 'preserve-buffers))) 1161 (eglot--connect (eglot--major-modes server) 1162 (eglot--project server) 1163 (eieio-object-class-name server) 1164 (eglot--saved-initargs server) 1165 (eglot--language-ids server)) 1166 (eglot--message "Reconnected!")) 1167 1168 (defvar eglot--managed-mode) ; forward decl 1169 1170 ;;;###autoload 1171 (defun eglot-ensure () 1172 "Start Eglot session for current buffer if there isn't one." 1173 (let ((buffer (current-buffer))) 1174 (cl-labels 1175 ((maybe-connect 1176 () 1177 (eglot--when-live-buffer buffer 1178 (remove-hook 'post-command-hook #'maybe-connect t) 1179 (unless eglot--managed-mode 1180 (apply #'eglot--connect (eglot--guess-contact)))))) 1181 (when buffer-file-name 1182 (add-hook 'post-command-hook #'maybe-connect 'append t))))) 1183 1184 (defun eglot-events-buffer (server) 1185 "Display events buffer for SERVER. 1186 Use current server's or first available Eglot events buffer." 1187 (interactive (list (eglot-current-server))) 1188 (let ((buffer (if server (jsonrpc-events-buffer server) 1189 (cl-find "\\*EGLOT.*events\\*" 1190 (buffer-list) 1191 :key #'buffer-name :test #'string-match)))) 1192 (if buffer (display-buffer buffer) 1193 (eglot--error "Can't find an Eglot events buffer!")))) 1194 1195 (defun eglot-stderr-buffer (server) 1196 "Display stderr buffer for SERVER." 1197 (interactive (list (eglot--current-server-or-lose))) 1198 (display-buffer (jsonrpc-stderr-buffer server))) 1199 1200 (defun eglot-forget-pending-continuations (server) 1201 "Forget pending requests for SERVER." 1202 (interactive (list (eglot--current-server-or-lose))) 1203 (jsonrpc-forget-pending-continuations server)) 1204 1205 (defvar eglot-connect-hook 1206 '(eglot-signal-didChangeConfiguration) 1207 "Hook run after connecting in `eglot--connect'.") 1208 1209 (defvar eglot-server-initialized-hook 1210 '() 1211 "Hook run after a `eglot-lsp-server' instance is created. 1212 1213 That is before a connection was established. Use 1214 `eglot-connect-hook' to hook into when a connection was 1215 successfully established and the server on the other side has 1216 received the initializing configuration. 1217 1218 Each function is passed the server as an argument") 1219 1220 (defun eglot--cmd (contact) 1221 "Helper for `eglot--connect'." 1222 (if (file-remote-p default-directory) 1223 ;; TODO: this seems like a bug, although it’s everywhere. For 1224 ;; some reason, for remote connections only, over a pipe, we 1225 ;; need to turn off line buffering on the tty. 1226 ;; 1227 ;; Not only does this seem like there should be a better way, 1228 ;; but it almost certainly doesn’t work on non-unix systems. 1229 (list shell-file-name "-c" 1230 (string-join (cons "stty raw > /dev/null;" 1231 (mapcar #'shell-quote-argument contact)) 1232 " ")) 1233 contact)) 1234 1235 (defvar-local eglot--cached-server nil 1236 "A cached reference to the current Eglot server.") 1237 1238 (defun eglot--connect (managed-modes project class contact language-ids) 1239 "Connect to MANAGED-MODES, LANGUAGE-IDS, PROJECT, CLASS and CONTACT. 1240 This docstring appeases checkdoc, that's all." 1241 (let* ((default-directory (project-root project)) 1242 (nickname (project-name project)) 1243 (readable-name (format "EGLOT (%s/%s)" nickname managed-modes)) 1244 autostart-inferior-process 1245 server-info 1246 (contact (if (functionp contact) (funcall contact) contact)) 1247 (initargs 1248 (cond ((keywordp (car contact)) contact) 1249 ((integerp (cadr contact)) 1250 (setq server-info (list (format "%s:%s" (car contact) 1251 (cadr contact)))) 1252 `(:process ,(lambda () 1253 (apply #'open-network-stream 1254 readable-name nil 1255 (car contact) (cadr contact) 1256 (cddr contact))))) 1257 ((and (stringp (car contact)) (memq :autoport contact)) 1258 (setq server-info (list "<inferior process>")) 1259 `(:process ,(lambda () 1260 (pcase-let ((`(,connection . ,inferior) 1261 (eglot--inferior-bootstrap 1262 readable-name 1263 contact 1264 '(:noquery t)))) 1265 (setq autostart-inferior-process inferior) 1266 connection)))) 1267 ((stringp (car contact)) 1268 (let* ((probe (cl-position-if #'keywordp contact)) 1269 (more-initargs (and probe (cl-subseq contact probe))) 1270 (contact (cl-subseq contact 0 probe))) 1271 `(:process 1272 ,(lambda () 1273 (let ((default-directory default-directory) 1274 ;; bug#61350: Tramp turns on a feature 1275 ;; by default that can't (yet) handle 1276 ;; very much data so we turn it off 1277 ;; unconditionally -- just for our 1278 ;; process. 1279 (tramp-use-ssh-controlmaster-options 'suppress) 1280 (tramp-ssh-controlmaster-options 1281 "-o ControlMaster=no -o ControlPath=none")) 1282 (make-process 1283 :name readable-name 1284 :command (setq server-info (eglot--cmd contact)) 1285 :connection-type 'pipe 1286 :coding 'utf-8-emacs-unix 1287 :noquery t 1288 :stderr (get-buffer-create 1289 (format "*%s stderr*" readable-name)) 1290 :file-handler t))) 1291 ,@more-initargs))))) 1292 (spread (lambda (fn) (lambda (server method params) 1293 (let ((eglot--cached-server server)) 1294 (apply fn server method (append params nil)))))) 1295 (server 1296 (apply 1297 #'make-instance class 1298 :name readable-name 1299 :events-buffer-scrollback-size eglot-events-buffer-size 1300 :notification-dispatcher (funcall spread #'eglot-handle-notification) 1301 :request-dispatcher (funcall spread #'eglot-handle-request) 1302 :on-shutdown #'eglot--on-shutdown 1303 initargs)) 1304 (canceled nil) 1305 (tag (make-symbol "connected-catch-tag"))) 1306 (when server-info 1307 (jsonrpc--debug server "Running language server: %s" 1308 (string-join server-info " "))) 1309 (setf (eglot--saved-initargs server) initargs) 1310 (setf (eglot--project server) project) 1311 (setf (eglot--project-nickname server) nickname) 1312 (setf (eglot--languages server) 1313 (cl-loop for m in managed-modes for l in language-ids 1314 collect (cons m l))) 1315 (setf (eglot--inferior-process server) autostart-inferior-process) 1316 (run-hook-with-args 'eglot-server-initialized-hook server) 1317 ;; Now start the handshake. To honor `eglot-sync-connect' 1318 ;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request' 1319 ;; and mimic most of `jsonrpc-request'. 1320 (unwind-protect 1321 (condition-case _quit 1322 (let ((retval 1323 (catch tag 1324 (jsonrpc-async-request 1325 server 1326 :initialize 1327 (list :processId 1328 (unless (or eglot-withhold-process-id 1329 (file-remote-p default-directory) 1330 (eq (jsonrpc-process-type server) 1331 'network)) 1332 (emacs-pid)) 1333 :clientInfo '(:name "Eglot") 1334 ;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py' 1335 ;; into `/path/to/baz.py', so LSP groks it. 1336 :rootPath (file-local-name 1337 (expand-file-name default-directory)) 1338 :rootUri (eglot--path-to-uri default-directory) 1339 :initializationOptions (eglot-initialization-options 1340 server) 1341 :capabilities (eglot-client-capabilities server) 1342 :workspaceFolders (eglot-workspace-folders server)) 1343 :success-fn 1344 (eglot--lambda ((InitializeResult) capabilities serverInfo) 1345 (unless canceled 1346 (push server 1347 (gethash project eglot--servers-by-project)) 1348 (setf (eglot--capabilities server) capabilities) 1349 (setf (eglot--server-info server) serverInfo) 1350 (jsonrpc-notify server :initialized eglot--{}) 1351 (dolist (buffer (buffer-list)) 1352 (with-current-buffer buffer 1353 ;; No need to pass SERVER as an argument: it has 1354 ;; been registered in `eglot--servers-by-project', 1355 ;; so that it can be found (and cached) from 1356 ;; `eglot--maybe-activate-editing-mode' in any 1357 ;; managed buffer. 1358 (eglot--maybe-activate-editing-mode))) 1359 (setf (eglot--inhibit-autoreconnect server) 1360 (cond 1361 ((booleanp eglot-autoreconnect) 1362 (not eglot-autoreconnect)) 1363 ((cl-plusp eglot-autoreconnect) 1364 (run-with-timer 1365 eglot-autoreconnect nil 1366 (lambda () 1367 (setf (eglot--inhibit-autoreconnect server) 1368 (null eglot-autoreconnect))))))) 1369 (run-hook-with-args 'eglot-connect-hook server) 1370 (eglot--message 1371 "Connected! Server `%s' now managing `%s' buffers \ 1372 in project `%s'." 1373 (or (plist-get serverInfo :name) 1374 (jsonrpc-name server)) 1375 managed-modes 1376 (eglot-project-nickname server)) 1377 (when tag (throw tag t)))) 1378 :timeout eglot-connect-timeout 1379 :error-fn (eglot--lambda ((ResponseError) code message) 1380 (unless canceled 1381 (jsonrpc-shutdown server) 1382 (let ((msg (format "%s: %s" code message))) 1383 (if tag (throw tag `(error . ,msg)) 1384 (eglot--error msg))))) 1385 :timeout-fn (lambda () 1386 (unless canceled 1387 (jsonrpc-shutdown server) 1388 (let ((msg (format "Timed out after %s seconds" 1389 eglot-connect-timeout))) 1390 (if tag (throw tag `(error . ,msg)) 1391 (eglot--error msg)))))) 1392 (cond ((numberp eglot-sync-connect) 1393 (accept-process-output nil eglot-sync-connect)) 1394 (eglot-sync-connect 1395 (while t (accept-process-output 1396 nil eglot-connect-timeout))))))) 1397 (pcase retval 1398 (`(error . ,msg) (eglot--error msg)) 1399 (`nil (eglot--message "Waiting in background for server `%s'" 1400 (jsonrpc-name server)) 1401 nil) 1402 (_ server))) 1403 (quit (jsonrpc-shutdown server) (setq canceled 'quit))) 1404 (setq tag nil)))) 1405 1406 (defun eglot--inferior-bootstrap (name contact &optional connect-args) 1407 "Use CONTACT to start a server, then connect to it. 1408 Return a cons of two process objects (CONNECTION . INFERIOR). 1409 Name both based on NAME. 1410 CONNECT-ARGS are passed as additional arguments to 1411 `open-network-stream'." 1412 (let* ((port-probe (make-network-process :name "eglot-port-probe-dummy" 1413 :server t 1414 :host "localhost" 1415 :service 0)) 1416 (port-number (unwind-protect 1417 (process-contact port-probe :service) 1418 (delete-process port-probe))) 1419 inferior connection) 1420 (unwind-protect 1421 (progn 1422 (setq inferior 1423 (make-process 1424 :name (format "autostart-inferior-%s" name) 1425 :stderr (format "*%s stderr*" name) 1426 :noquery t 1427 :command (cl-subst 1428 (format "%s" port-number) :autoport contact))) 1429 (setq connection 1430 (cl-loop 1431 repeat 10 for i from 1 1432 do (accept-process-output nil 0.5) 1433 while (process-live-p inferior) 1434 do (eglot--message 1435 "Trying to connect to localhost and port %s (attempt %s)" 1436 port-number i) 1437 thereis (ignore-errors 1438 (apply #'open-network-stream 1439 (format "autoconnect-%s" name) 1440 nil 1441 "localhost" port-number connect-args)))) 1442 (cons connection inferior)) 1443 (cond ((and (process-live-p connection) 1444 (process-live-p inferior)) 1445 (eglot--message "Done, connected to %s!" port-number)) 1446 (t 1447 (when inferior (delete-process inferior)) 1448 (when connection (delete-process connection)) 1449 (eglot--error "Could not start and connect to server%s" 1450 (if inferior 1451 (format " started with %s" 1452 (process-command inferior)) 1453 "!"))))))) 1454 1455 1456 ;;; Helpers (move these to API?) 1457 ;;; 1458 (defun eglot--error (format &rest args) 1459 "Error out with FORMAT with ARGS." 1460 (error "[eglot] %s" (apply #'format format args))) 1461 1462 (defun eglot--message (format &rest args) 1463 "Message out with FORMAT with ARGS." 1464 (message "[eglot] %s" (apply #'format format args))) 1465 1466 (defun eglot--warn (format &rest args) 1467 "Warning message with FORMAT and ARGS." 1468 (apply #'eglot--message (concat "(warning) " format) args) 1469 (let ((warning-minimum-level :error)) 1470 (display-warning 'eglot (apply #'format format args) :warning))) 1471 1472 (defalias 'eglot--bol 1473 (if (fboundp 'pos-bol) #'pos-bol 1474 (lambda (&optional n) (let ((inhibit-field-text-motion t)) 1475 (line-beginning-position n)))) 1476 "Return position of first character in current line.") 1477 1478 (cl-defun eglot--request (server method params &key 1479 immediate 1480 timeout cancel-on-input 1481 cancel-on-input-retval) 1482 "Like `jsonrpc-request', but for Eglot LSP requests. 1483 Unless IMMEDIATE, send pending changes before making request." 1484 (unless immediate (eglot--signal-textDocument/didChange)) 1485 (jsonrpc-request server method params 1486 :timeout timeout 1487 :cancel-on-input cancel-on-input 1488 :cancel-on-input-retval cancel-on-input-retval)) 1489 1490 1491 ;;; Encoding fever 1492 ;;; 1493 (define-obsolete-function-alias 1494 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "1.12") 1495 (define-obsolete-function-alias 1496 'eglot-current-column 'eglot-utf-32-linepos "1.12") 1497 (define-obsolete-variable-alias 1498 'eglot-current-column-function 'eglot-current-linepos-function "1.12") 1499 1500 (defvar eglot-current-linepos-function #'eglot-utf-16-linepos 1501 "Function calculating position relative to line beginning. 1502 1503 It is a function of no arguments considering the text from line 1504 beginning up to current point. The return value is the number of 1505 UTF code units needed to encode that text from the LSP server's 1506 perspective. This may be a number of octets, 16-bit words or 1507 Unicode code points, depending on whether the LSP server's 1508 `positionEncoding' capability is UTF-8, UTF-16 or UTF-32, 1509 respectively. Position of point should remain unaltered if that 1510 return value is fed through the corresponding inverse function 1511 `eglot-move-to-linepos-function' (which see).") 1512 1513 (defun eglot-utf-8-linepos () 1514 "Calculate number of UTF-8 bytes from line beginning." 1515 (length (encode-coding-region (eglot--bol) (point) 'utf-8-unix t))) 1516 1517 (defun eglot-utf-16-linepos (&optional lbp) 1518 "Calculate number of UTF-16 code units from position given by LBP. 1519 LBP defaults to `eglot--bol'." 1520 (/ (- (length (encode-coding-region (or lbp (eglot--bol)) 1521 ;; Fix github#860 1522 (min (point) (point-max)) 'utf-16 t)) 1523 2) 1524 2)) 1525 1526 (defun eglot-utf-32-linepos () 1527 "Calculate number of Unicode codepoints from line beginning." 1528 (- (point) (eglot--bol))) 1529 1530 (defun eglot--pos-to-lsp-position (&optional pos) 1531 "Convert point POS to LSP position." 1532 (eglot--widening 1533 ;; LSP line is zero-origin; emacs is one-origin. 1534 (list :line (1- (line-number-at-pos pos t)) 1535 :character (progn (when pos (goto-char pos)) 1536 (funcall eglot-current-linepos-function))))) 1537 1538 (define-obsolete-function-alias 1539 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "1.12") 1540 (define-obsolete-function-alias 1541 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "1.12") 1542 (define-obsolete-variable-alias 1543 'eglot-move-to-column-function 'eglot-move-to-linepos-function "1.12") 1544 1545 (defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos 1546 "Function to move to a position within a line reported by the LSP server. 1547 1548 Per the LSP spec, character offsets in LSP Position objects count 1549 UTF-16 code units, not actual code points. So when LSP says 1550 position 3 of a line containing just \"aXbc\", where X is a funny 1551 looking character in the UTF-16 \"supplementary plane\", it 1552 actually means `b', not `c'. The default value 1553 `eglot-move-to-utf-16-linepos' accounts for this. 1554 1555 This variable can also be set to `eglot-move-to-utf-8-linepos' or 1556 `eglot-move-to-utf-32-linepos' for servers not closely following 1557 the spec. Also, since LSP 3.17 server and client may agree on an 1558 encoding and Eglot will set this variable automatically.") 1559 1560 (defun eglot-move-to-utf-8-linepos (n) 1561 "Move to line's Nth byte as computed by LSP's UTF-8 criterion." 1562 (let* ((bol (eglot--bol)) 1563 (goal-byte (+ (position-bytes bol) n)) 1564 (eol (line-end-position))) 1565 (goto-char bol) 1566 (while (and (< (position-bytes (point)) goal-byte) (< (point) eol)) 1567 ;; raw bytes take 2 bytes in the buffer 1568 (when (>= (char-after) #x3fff80) (setq goal-byte (1+ goal-byte))) 1569 (forward-char 1)))) 1570 1571 (defun eglot-move-to-utf-16-linepos (n) 1572 "Move to line's Nth code unit as computed by LSP's UTF-16 criterion." 1573 (let* ((bol (eglot--bol)) 1574 (goal-char (+ bol n)) 1575 (eol (line-end-position))) 1576 (goto-char bol) 1577 (while (and (< (point) goal-char) (< (point) eol)) 1578 ;; code points in the "supplementary place" use two code units 1579 (when (<= #x010000 (char-after) #x10ffff) (setq goal-char (1- goal-char))) 1580 (forward-char 1)))) 1581 1582 (defun eglot-move-to-utf-32-linepos (n) 1583 "Move to line's Nth codepoint as computed by LSP's UTF-32 criterion." 1584 ;; We cannot use `move-to-column' here, because it moves to *visual* 1585 ;; columns, which can be different from LSP characters in case of 1586 ;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296, 1587 ;; github#297) 1588 (goto-char (min (+ (eglot--bol) n) (line-end-position)))) 1589 1590 (defun eglot--lsp-position-to-point (pos-plist &optional marker) 1591 "Convert LSP position POS-PLIST to Emacs point. 1592 If optional MARKER, return a marker instead" 1593 (save-excursion 1594 (save-restriction 1595 (widen) 1596 (goto-char (point-min)) 1597 (forward-line (min most-positive-fixnum 1598 (plist-get pos-plist :line))) 1599 (unless (eobp) ;; if line was excessive leave point at eob 1600 (let ((col (plist-get pos-plist :character))) 1601 (unless (wholenump col) 1602 (eglot--warn 1603 "Caution: LSP server sent invalid character position %s. Using 0 instead." 1604 col) 1605 (setq col 0)) 1606 (funcall eglot-move-to-linepos-function col))) 1607 (if marker (copy-marker (point-marker)) (point))))) 1608 1609 1610 ;;; More helpers 1611 (defconst eglot--uri-path-allowed-chars 1612 (let ((vec (copy-sequence url-path-allowed-chars))) 1613 (aset vec ?: nil) ;; see github#639 1614 vec) 1615 "Like `url-path-allows-chars' but more restrictive.") 1616 1617 (defun eglot--path-to-uri (path) 1618 "URIfy PATH." 1619 (let ((truepath (file-truename path))) 1620 (if (and (url-type (url-generic-parse-url path)) 1621 ;; It might be MS Windows path which includes a drive 1622 ;; letter that looks like a URL scheme (bug#59338) 1623 (not (and (eq system-type 'windows-nt) 1624 (file-name-absolute-p truepath)))) 1625 ;; Path is already a URI, so forward it to the LSP server 1626 ;; untouched. The server should be able to handle it, since 1627 ;; it provided this URI to clients in the first place. 1628 path 1629 (concat "file://" 1630 ;; Add a leading "/" for local MS Windows-style paths. 1631 (if (and (eq system-type 'windows-nt) 1632 (not (file-remote-p truepath))) 1633 "/") 1634 (url-hexify-string 1635 ;; Again watch out for trampy paths. 1636 (directory-file-name (file-local-name truepath)) 1637 eglot--uri-path-allowed-chars))))) 1638 1639 (declare-function w32-long-file-name "w32proc.c" (fn)) 1640 (defun eglot--uri-to-path (uri) 1641 "Convert URI to file path, helped by `eglot--current-server'." 1642 (when (keywordp uri) (setq uri (substring (symbol-name uri) 1))) 1643 (let* ((server (eglot-current-server)) 1644 (remote-prefix (and server (eglot--trampish-p server))) 1645 (url (url-generic-parse-url uri))) 1646 ;; Only parse file:// URIs, leave other URI untouched as 1647 ;; `file-name-handler-alist' should know how to handle them 1648 ;; (bug#58790). 1649 (if (string= "file" (url-type url)) 1650 (let* ((retval (url-unhex-string (url-filename url))) 1651 ;; Remove the leading "/" for local MS Windows-style paths. 1652 (normalized (if (and (not remote-prefix) 1653 (eq system-type 'windows-nt) 1654 (cl-plusp (length retval))) 1655 (w32-long-file-name (substring retval 1)) 1656 retval))) 1657 (concat remote-prefix normalized)) 1658 uri))) 1659 1660 (defun eglot--snippet-expansion-fn () 1661 "Compute a function to expand snippets. 1662 Doubles as an indicator of snippet support." 1663 (and (fboundp 'yas-minor-mode) 1664 (lambda (&rest args) 1665 (with-no-warnings 1666 (unless (bound-and-true-p yas-minor-mode) (yas-minor-mode 1)) 1667 (apply #'yas-expand-snippet args))))) 1668 1669 (defun eglot--format-markup (markup) 1670 "Format MARKUP according to LSP's spec." 1671 (pcase-let ((`(,string ,mode) 1672 (if (stringp markup) (list markup 'gfm-view-mode) 1673 (list (plist-get markup :value) 1674 (pcase (plist-get markup :kind) 1675 ("markdown" 'gfm-view-mode) 1676 ("plaintext" 'text-mode) 1677 (_ major-mode)))))) 1678 (with-temp-buffer 1679 (setq-local markdown-fontify-code-blocks-natively t) 1680 (insert string) 1681 (let ((inhibit-message t) 1682 (message-log-max nil) 1683 match) 1684 (ignore-errors (delay-mode-hooks (funcall mode))) 1685 (font-lock-ensure) 1686 (goto-char (point-min)) 1687 (let ((inhibit-read-only t)) 1688 (when (fboundp 'text-property-search-forward) ;; FIXME: use compat 1689 (while (setq match (text-property-search-forward 'invisible)) 1690 (delete-region (prop-match-beginning match) 1691 (prop-match-end match))))) 1692 (string-trim (buffer-string)))))) 1693 1694 (define-obsolete-variable-alias 'eglot-ignored-server-capabilites 1695 'eglot-ignored-server-capabilities "1.8") 1696 1697 (defcustom eglot-ignored-server-capabilities (list) 1698 "LSP server capabilities that Eglot could use, but won't. 1699 You could add, for instance, the symbol 1700 `:documentHighlightProvider' to prevent automatic highlighting 1701 under cursor." 1702 :type '(set 1703 :tag "Tick the ones you're not interested in" 1704 (const :tag "Documentation on hover" :hoverProvider) 1705 (const :tag "Code completion" :completionProvider) 1706 (const :tag "Function signature help" :signatureHelpProvider) 1707 (const :tag "Go to definition" :definitionProvider) 1708 (const :tag "Go to type definition" :typeDefinitionProvider) 1709 (const :tag "Go to implementation" :implementationProvider) 1710 (const :tag "Go to declaration" :declarationProvider) 1711 (const :tag "Find references" :referencesProvider) 1712 (const :tag "Highlight symbols automatically" :documentHighlightProvider) 1713 (const :tag "List symbols in buffer" :documentSymbolProvider) 1714 (const :tag "List symbols in workspace" :workspaceSymbolProvider) 1715 (const :tag "Execute code actions" :codeActionProvider) 1716 (const :tag "Code lens" :codeLensProvider) 1717 (const :tag "Format buffer" :documentFormattingProvider) 1718 (const :tag "Format portion of buffer" :documentRangeFormattingProvider) 1719 (const :tag "On-type formatting" :documentOnTypeFormattingProvider) 1720 (const :tag "Rename symbol" :renameProvider) 1721 (const :tag "Highlight links in document" :documentLinkProvider) 1722 (const :tag "Decorate color references" :colorProvider) 1723 (const :tag "Fold regions of buffer" :foldingRangeProvider) 1724 (const :tag "Execute custom commands" :executeCommandProvider) 1725 (const :tag "Inlay hints" :inlayHintProvider))) 1726 1727 (defun eglot--server-capable (&rest feats) 1728 "Determine if current server is capable of FEATS." 1729 (unless (cl-some (lambda (feat) 1730 (memq feat eglot-ignored-server-capabilities)) 1731 feats) 1732 (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose)) 1733 then (cadr probe) 1734 for (feat . more) on feats 1735 for probe = (plist-member caps feat) 1736 if (not probe) do (cl-return nil) 1737 if (eq (cadr probe) :json-false) do (cl-return nil) 1738 if (not (listp (cadr probe))) do (cl-return (if more nil (cadr probe))) 1739 finally (cl-return (or (cadr probe) t))))) 1740 1741 (defun eglot--server-capable-or-lose (&rest feats) 1742 "Like `eglot--server-capable', but maybe error out." 1743 (let ((retval (apply #'eglot--server-capable feats))) 1744 (unless retval 1745 (eglot--error "Unsupported or ignored LSP capability `%s'" 1746 (mapconcat #'symbol-name feats " "))) 1747 retval)) 1748 1749 (defun eglot--range-region (range &optional markers) 1750 "Return region (BEG . END) that represents LSP RANGE. 1751 If optional MARKERS, make markers." 1752 (let* ((st (plist-get range :start)) 1753 (beg (eglot--lsp-position-to-point st markers)) 1754 (end (eglot--lsp-position-to-point (plist-get range :end) markers))) 1755 (cons beg end))) 1756 1757 (defun eglot--read-server (prompt &optional dont-if-just-the-one) 1758 "Read a running Eglot server from minibuffer using PROMPT. 1759 If DONT-IF-JUST-THE-ONE and there's only one server, don't prompt 1760 and just return it. PROMPT shouldn't end with a question mark." 1761 (let ((servers (cl-loop for servers 1762 being hash-values of eglot--servers-by-project 1763 append servers)) 1764 (name (lambda (srv) 1765 (format "%s %s" (eglot-project-nickname srv) 1766 (eglot--major-modes srv))))) 1767 (cond ((null servers) 1768 (eglot--error "No servers!")) 1769 ((or (cdr servers) (not dont-if-just-the-one)) 1770 (let* ((default (when-let ((current (eglot-current-server))) 1771 (funcall name current))) 1772 (read (completing-read 1773 (if default 1774 (format "%s (default %s)? " prompt default) 1775 (concat prompt "? ")) 1776 (mapcar name servers) 1777 nil t 1778 nil nil 1779 default))) 1780 (cl-find read servers :key name :test #'equal))) 1781 (t (car servers))))) 1782 1783 (defun eglot--trampish-p (server) 1784 "Tell if SERVER's project root is `file-remote-p'." 1785 (file-remote-p (project-root (eglot--project server)))) 1786 1787 (defun eglot--plist-keys (plist) "Get keys of a plist." 1788 (cl-loop for (k _v) on plist by #'cddr collect k)) 1789 1790 (defalias 'eglot--ensure-list 1791 (if (fboundp 'ensure-list) #'ensure-list 1792 (lambda (x) (if (listp x) x (list x))))) 1793 1794 1795 ;;; Minor modes 1796 ;;; 1797 (defvar eglot-mode-map 1798 (let ((map (make-sparse-keymap))) 1799 (define-key map [remap display-local-help] #'eldoc-doc-buffer) 1800 map)) 1801 1802 (defvar-local eglot--current-flymake-report-fn nil 1803 "Current flymake report function for this buffer.") 1804 1805 (defvar-local eglot--saved-bindings nil 1806 "Bindings saved by `eglot--setq-saving'.") 1807 1808 (defvar eglot-stay-out-of '() 1809 "List of Emacs things that Eglot should try to stay of. 1810 Each element is a string, a symbol, or a regexp which is matched 1811 against a variable's name. Examples include the string 1812 \"company\" or the symbol `xref'. 1813 1814 Before Eglot starts \"managing\" a particular buffer, it 1815 opinionatedly sets some peripheral Emacs facilities, such as 1816 Flymake, Xref and Company. These overriding settings help ensure 1817 consistent Eglot behavior and only stay in place until 1818 \"managing\" stops (usually via `eglot-shutdown'), whereupon the 1819 previous settings are restored. 1820 1821 However, if you wish for Eglot to stay out of a particular Emacs 1822 facility that you'd like to keep control of add an element to 1823 this list and Eglot will refrain from setting it. 1824 1825 For example, to keep your Company customization, add the symbol 1826 `company' to this variable.") 1827 1828 (defun eglot--stay-out-of-p (symbol) 1829 "Tell if Eglot should stay out of SYMBOL." 1830 (cl-find (symbol-name symbol) eglot-stay-out-of 1831 :test (lambda (s thing) 1832 (let ((re (if (symbolp thing) (symbol-name thing) thing))) 1833 (string-match re s))))) 1834 1835 (defmacro eglot--setq-saving (symbol binding) 1836 `(unless (or (not (boundp ',symbol)) (eglot--stay-out-of-p ',symbol)) 1837 (push (cons ',symbol (symbol-value ',symbol)) eglot--saved-bindings) 1838 (setq-local ,symbol ,binding))) 1839 1840 (defun eglot-managed-p () 1841 "Tell if current buffer is managed by Eglot." 1842 eglot--managed-mode) 1843 1844 (defvar eglot-managed-mode-hook nil 1845 "A hook run by Eglot after it started/stopped managing a buffer. 1846 Use `eglot-managed-p' to determine if current buffer is managed.") 1847 1848 (define-minor-mode eglot--managed-mode 1849 "Mode for source buffers managed by some Eglot project." 1850 :init-value nil :lighter nil :keymap eglot-mode-map 1851 (cond 1852 (eglot--managed-mode 1853 (pcase (plist-get (eglot--capabilities (eglot-current-server)) 1854 :positionEncoding) 1855 ("utf-32" 1856 (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-32-linepos) 1857 (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-32-linepos)) 1858 ("utf-8" 1859 (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-8-linepos) 1860 (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-8-linepos))) 1861 (add-hook 'after-change-functions 'eglot--after-change nil t) 1862 (add-hook 'before-change-functions 'eglot--before-change nil t) 1863 (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t) 1864 ;; Prepend "didClose" to the hook after the "nonoff", so it will run first 1865 (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t) 1866 (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t) 1867 (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t) 1868 (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t) 1869 (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t) 1870 (unless (eglot--stay-out-of-p 'xref) 1871 (add-hook 'xref-backend-functions 'eglot-xref-backend nil t)) 1872 (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t) 1873 (add-hook 'completion-in-region-mode-hook #'eglot--capf-session-flush nil t) 1874 (add-hook 'company-after-completion-hook #'eglot--capf-session-flush nil t) 1875 (add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t) 1876 (add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t) 1877 (add-hook 'pre-command-hook 'eglot--pre-command-hook nil t) 1878 (eglot--setq-saving xref-prompt-for-identifier nil) 1879 (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend)) 1880 (eglot--setq-saving company-backends '(company-capf)) 1881 (eglot--setq-saving company-tooltip-align-annotations t) 1882 (eglot--setq-saving eldoc-documentation-strategy 1883 #'eldoc-documentation-compose) 1884 (unless (eglot--stay-out-of-p 'imenu) 1885 (add-function :before-until (local 'imenu-create-index-function) 1886 #'eglot-imenu)) 1887 (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1)) 1888 (unless (eglot--stay-out-of-p 'eldoc) 1889 (add-hook 'eldoc-documentation-functions #'eglot-hover-eldoc-function 1890 nil t) 1891 (add-hook 'eldoc-documentation-functions #'eglot-signature-eldoc-function 1892 nil t) 1893 (eldoc-mode 1)) 1894 (cl-pushnew (current-buffer) (eglot--managed-buffers (eglot-current-server)))) 1895 (t 1896 (remove-hook 'after-change-functions 'eglot--after-change t) 1897 (remove-hook 'before-change-functions 'eglot--before-change t) 1898 (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t) 1899 (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t) 1900 (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t) 1901 (remove-hook 'after-revert-hook 'eglot--after-revert-hook t) 1902 (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t) 1903 (remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t) 1904 (remove-hook 'xref-backend-functions 'eglot-xref-backend t) 1905 (remove-hook 'completion-at-point-functions #'eglot-completion-at-point t) 1906 (remove-hook 'completion-in-region-mode-hook #'eglot--capf-session-flush t) 1907 (remove-hook 'company-after-completion-hook #'eglot--capf-session-flush t) 1908 (remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t) 1909 (remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t) 1910 (remove-hook 'pre-command-hook 'eglot--pre-command-hook t) 1911 (remove-hook 'eldoc-documentation-functions #'eglot-hover-eldoc-function t) 1912 (remove-hook 'eldoc-documentation-functions #'eglot-signature-eldoc-function t) 1913 (cl-loop for (var . saved-binding) in eglot--saved-bindings 1914 do (set (make-local-variable var) saved-binding)) 1915 (remove-function (local 'imenu-create-index-function) #'eglot-imenu) 1916 (when eglot--current-flymake-report-fn 1917 (eglot--report-to-flymake nil) 1918 (setq eglot--current-flymake-report-fn nil)) 1919 (let ((server eglot--cached-server)) 1920 (setq eglot--cached-server nil) 1921 (when server 1922 (setf (eglot--managed-buffers server) 1923 (delq (current-buffer) (eglot--managed-buffers server))) 1924 (when (and eglot-autoshutdown 1925 (null (eglot--managed-buffers server))) 1926 (eglot-shutdown server))))))) 1927 1928 (defun eglot--managed-mode-off () 1929 "Turn off `eglot--managed-mode' unconditionally." 1930 (remove-overlays nil nil 'eglot--overlay t) 1931 (eglot-inlay-hints-mode -1) 1932 (eglot--managed-mode -1)) 1933 1934 (defun eglot-current-server () 1935 "Return logical Eglot server for current buffer, nil if none." 1936 (setq eglot--cached-server 1937 (or eglot--cached-server 1938 (cl-find-if #'eglot--languageId 1939 (gethash (eglot--current-project) 1940 eglot--servers-by-project)) 1941 (and eglot-extend-to-xref 1942 buffer-file-name 1943 (gethash (expand-file-name buffer-file-name) 1944 eglot--servers-by-xrefed-file))))) 1945 1946 (defun eglot--current-server-or-lose () 1947 "Return current logical Eglot server connection or error." 1948 (or (eglot-current-server) 1949 (jsonrpc-error "No current JSON-RPC connection"))) 1950 1951 (defvar-local eglot--diagnostics nil 1952 "Flymake diagnostics for this buffer.") 1953 1954 (defvar revert-buffer-preserve-modes) 1955 (defun eglot--after-revert-hook () 1956 "Eglot's `after-revert-hook'." 1957 (when revert-buffer-preserve-modes (eglot--signal-textDocument/didOpen))) 1958 1959 (defun eglot--maybe-activate-editing-mode () 1960 "Maybe activate `eglot--managed-mode'. 1961 1962 If it is activated, also signal textDocument/didOpen." 1963 (unless eglot--managed-mode 1964 ;; Called when `revert-buffer-in-progress-p' is t but 1965 ;; `revert-buffer-preserve-modes' is nil. 1966 (when (and buffer-file-name (eglot-current-server)) 1967 (setq eglot--diagnostics nil) 1968 (eglot--managed-mode) 1969 (eglot--signal-textDocument/didOpen) 1970 ;; Run user hook after 'textDocument/didOpen' so server knows 1971 ;; about the buffer. 1972 (eglot-inlay-hints-mode 1) 1973 (run-hooks 'eglot-managed-mode-hook)))) 1974 1975 (add-hook 'after-change-major-mode-hook 'eglot--maybe-activate-editing-mode) 1976 1977 (defun eglot-clear-status (server) 1978 "Clear the last JSONRPC error for SERVER." 1979 (interactive (list (eglot--current-server-or-lose))) 1980 (setf (jsonrpc-last-error server) nil)) 1981 1982 1983 ;;; Mode-line, menu and other sugar 1984 ;;; 1985 (defvar eglot--mode-line-format `(:eval (eglot--mode-line-format))) 1986 1987 (put 'eglot--mode-line-format 'risky-local-variable t) 1988 1989 (defun eglot--mouse-call (what &optional update-mode-line) 1990 "Make an interactive lambda for calling WHAT with the mouse." 1991 (lambda (event) 1992 (interactive "e") 1993 (let ((start (event-start event))) (with-selected-window (posn-window start) 1994 (save-excursion 1995 (goto-char (or (posn-point start) 1996 (point))) 1997 (call-interactively what) 1998 (when update-mode-line 1999 (force-mode-line-update t))))))) 2000 2001 (defun eglot-manual () "Read Eglot's manual." 2002 (declare (obsolete info "1.10")) 2003 (interactive) (info "(eglot)")) 2004 2005 ;;;###autoload 2006 (defun eglot-update (&rest _) "Update Eglot." 2007 (interactive) 2008 (with-no-warnings 2009 (require 'package) 2010 (unless package-archive-contents (package-refresh-contents)) 2011 (when-let ((existing (cadr (assoc 'eglot package-alist)))) 2012 (package-delete existing t)) 2013 (package-install (cadr (assoc 'eglot package-archive-contents))))) 2014 2015 (easy-menu-define eglot-menu nil "Eglot" 2016 `("Eglot" 2017 ;; Commands for getting information and customization. 2018 ["Customize Eglot" (lambda () (interactive) (customize-group "eglot"))] 2019 "--" 2020 ;; xref like commands. 2021 ["Find definitions" xref-find-definitions 2022 :help "Find definitions of identifier at point" 2023 :active (eglot--server-capable :definitionProvider)] 2024 ["Find references" xref-find-references 2025 :help "Find references to identifier at point" 2026 :active (eglot--server-capable :referencesProvider)] 2027 ["Find symbols in workspace (apropos)" xref-find-apropos 2028 :help "Find symbols matching a query" 2029 :active (eglot--server-capable :workspaceSymbolProvider)] 2030 ["Find declaration" eglot-find-declaration 2031 :help "Find declaration for identifier at point" 2032 :active (eglot--server-capable :declarationProvider)] 2033 ["Find implementation" eglot-find-implementation 2034 :help "Find implementation for identifier at point" 2035 :active (eglot--server-capable :implementationProvider)] 2036 ["Find type definition" eglot-find-typeDefinition 2037 :help "Find type definition for identifier at point" 2038 :active (eglot--server-capable :typeDefinitionProvider)] 2039 "--" 2040 ;; LSP-related commands (mostly Eglot's own commands). 2041 ["Rename symbol" eglot-rename 2042 :active (eglot--server-capable :renameProvider)] 2043 ["Format buffer" eglot-format-buffer 2044 :active (eglot--server-capable :documentFormattingProvider)] 2045 ["Format active region" eglot-format 2046 :active (and (region-active-p) 2047 (eglot--server-capable :documentRangeFormattingProvider))] 2048 ["Show Flymake diagnostics for buffer" flymake-show-buffer-diagnostics] 2049 ["Show Flymake diagnostics for project" flymake-show-project-diagnostics] 2050 ["Show Eldoc documentation at point" eldoc-doc-buffer] 2051 "--" 2052 ["All possible code actions" eglot-code-actions 2053 :active (eglot--server-capable :codeActionProvider)] 2054 ["Organize imports" eglot-code-action-organize-imports 2055 :visible (eglot--server-capable :codeActionProvider)] 2056 ["Extract" eglot-code-action-extract 2057 :visible (eglot--server-capable :codeActionProvider)] 2058 ["Inline" eglot-code-action-inline 2059 :visible (eglot--server-capable :codeActionProvider)] 2060 ["Rewrite" eglot-code-action-rewrite 2061 :visible (eglot--server-capable :codeActionProvider)] 2062 ["Quickfix" eglot-code-action-quickfix 2063 :visible (eglot--server-capable :codeActionProvider)])) 2064 2065 (easy-menu-define eglot-server-menu nil "Monitor server communication" 2066 '("Debugging the server communication" 2067 ["Reconnect to server" eglot-reconnect] 2068 ["Quit server" eglot-shutdown] 2069 "--" 2070 ["LSP events buffer" eglot-events-buffer] 2071 ["Server stderr buffer" eglot-stderr-buffer] 2072 ["Customize event buffer size" 2073 (lambda () 2074 (interactive) 2075 (customize-variable 'eglot-events-buffer-size))])) 2076 2077 (defun eglot--mode-line-props (thing face defs &optional prepend) 2078 "Helper for function `eglot--mode-line-format'. 2079 Uses THING, FACE, DEFS and PREPEND." 2080 (cl-loop with map = (make-sparse-keymap) 2081 for (elem . rest) on defs 2082 for (key def help) = elem 2083 do (define-key map `[mode-line ,key] (eglot--mouse-call def t)) 2084 concat (format "%s: %s" key help) into blurb 2085 when rest concat "\n" into blurb 2086 finally (return `(:propertize ,thing 2087 face ,face 2088 keymap ,map help-echo ,(concat prepend blurb) 2089 mouse-face mode-line-highlight)))) 2090 2091 (defun eglot--mode-line-format () 2092 "Compose Eglot's mode-line." 2093 (let* ((server (eglot-current-server)) 2094 (nick (and server (eglot-project-nickname server))) 2095 (pending (and server (hash-table-count 2096 (jsonrpc--request-continuations server)))) 2097 (last-error (and server (jsonrpc-last-error server)))) 2098 (append 2099 `(,(propertize 2100 eglot-menu-string 2101 'face 'eglot-mode-line 2102 'mouse-face 'mode-line-highlight 2103 'help-echo "Eglot: Emacs LSP client\nmouse-1: Display minor mode menu" 2104 'keymap (let ((map (make-sparse-keymap))) 2105 (define-key map [mode-line down-mouse-1] eglot-menu) 2106 map))) 2107 (when nick 2108 `(":" 2109 ,(propertize 2110 nick 2111 'face 'eglot-mode-line 2112 'mouse-face 'mode-line-highlight 2113 'help-echo (format "Project '%s'\nmouse-1: LSP server control menu" nick) 2114 'keymap (let ((map (make-sparse-keymap))) 2115 (define-key map [mode-line down-mouse-1] eglot-server-menu) 2116 map)) 2117 ,@(when last-error 2118 `("/" ,(eglot--mode-line-props 2119 "error" 'compilation-mode-line-fail 2120 '((mouse-3 eglot-clear-status "Clear this status")) 2121 (format "An error occurred: %s\n" (plist-get last-error 2122 :message))))) 2123 ,@(when (cl-plusp pending) 2124 `("/" ,(eglot--mode-line-props 2125 (format "%d" pending) 'warning 2126 '((mouse-3 eglot-forget-pending-continuations 2127 "Forget pending continuations")) 2128 "Number of outgoing, \ 2129 still unanswered LSP requests to the server\n"))) 2130 ,@(cl-loop for pr hash-values of (eglot--progress-reporters server) 2131 when (eq (car pr) 'eglot--mode-line-reporter) 2132 append `("/" ,(eglot--mode-line-props 2133 (format "%s%%%%" (or (nth 4 pr) "?")) 2134 'eglot-mode-line 2135 nil 2136 (format "(%s) %s %s" (nth 1 pr) 2137 (nth 2 pr) (nth 3 pr)))))))))) 2138 2139 (add-to-list 'mode-line-misc-info 2140 `(eglot--managed-mode (" [" eglot--mode-line-format "] "))) 2141 2142 2143 ;;; Flymake customization 2144 ;;; 2145 (put 'eglot-note 'flymake-category 'flymake-note) 2146 (put 'eglot-warning 'flymake-category 'flymake-warning) 2147 (put 'eglot-error 'flymake-category 'flymake-error) 2148 2149 (defalias 'eglot--make-diag 'flymake-make-diagnostic) 2150 (defalias 'eglot--diag-data 'flymake-diagnostic-data) 2151 2152 (defvar eglot-diagnostics-map 2153 (let ((map (make-sparse-keymap))) 2154 (define-key map [mouse-2] 'eglot-code-actions-at-mouse) 2155 map) 2156 "Keymap active in Eglot-backed Flymake diagnostic overlays.") 2157 2158 (cl-loop for i from 1 2159 for type in '(eglot-note eglot-warning eglot-error) 2160 do (put type 'flymake-overlay-control 2161 `((mouse-face . highlight) 2162 (priority . ,(+ 50 i)) 2163 (keymap . ,eglot-diagnostics-map)))) 2164 2165 2166 ;;; Protocol implementation (Requests, notifications, etc) 2167 ;;; 2168 (cl-defmethod eglot-handle-notification 2169 (_server method &key &allow-other-keys) 2170 "Handle unknown notification." 2171 (unless (or (string-prefix-p "$" (format "%s" method)) 2172 (not (memq 'disallow-unknown-methods eglot-strict-mode))) 2173 (eglot--warn "Server sent unknown notification method `%s'" method))) 2174 2175 (cl-defmethod eglot-handle-request 2176 (_server method &key &allow-other-keys) 2177 "Handle unknown request." 2178 (when (memq 'disallow-unknown-methods eglot-strict-mode) 2179 (jsonrpc-error "Unknown request method `%s'" method))) 2180 2181 (cl-defmethod eglot-execute-command 2182 (server command arguments) 2183 "Execute COMMAND on SERVER with `:workspace/executeCommand'. 2184 COMMAND is a symbol naming the command." 2185 (eglot--request server :workspace/executeCommand 2186 `(:command ,(format "%s" command) :arguments ,arguments))) 2187 2188 (cl-defmethod eglot-handle-notification 2189 (_server (_method (eql window/showMessage)) &key type message) 2190 "Handle notification window/showMessage." 2191 (eglot--message (propertize "Server reports (type=%s): %s" 2192 'face (if (<= type 1) 'error)) 2193 type message)) 2194 2195 (cl-defmethod eglot-handle-request 2196 (_server (_method (eql window/showMessageRequest)) 2197 &key type message actions &allow-other-keys) 2198 "Handle server request window/showMessageRequest." 2199 (let* ((actions (append actions nil)) ;; gh#627 2200 (label (completing-read 2201 (concat 2202 (format (propertize "[eglot] Server reports (type=%s): %s" 2203 'face (if (or (not type) (<= type 1)) 'error)) 2204 type message) 2205 "\nChoose an option: ") 2206 (or (mapcar (lambda (obj) (plist-get obj :title)) actions) 2207 '("OK")) 2208 nil t (plist-get (elt actions 0) :title)))) 2209 (if label `(:title ,label) :null))) 2210 2211 (cl-defmethod eglot-handle-notification 2212 (_server (_method (eql window/logMessage)) &key _type _message) 2213 "Handle notification window/logMessage.") ;; noop, use events buffer 2214 2215 (cl-defmethod eglot-handle-notification 2216 (_server (_method (eql telemetry/event)) &rest _any) 2217 "Handle notification telemetry/event.") ;; noop, use events buffer 2218 2219 (defalias 'eglot--reporter-update 2220 (if (> emacs-major-version 26) #'progress-reporter-update 2221 (lambda (a b &optional _c) (progress-reporter-update a b)))) 2222 2223 (cl-defmethod eglot-handle-notification 2224 (server (_method (eql $/progress)) &key token value) 2225 "Handle $/progress notification identified by TOKEN from SERVER." 2226 (when eglot-report-progress 2227 (cl-flet ((fmt (&rest args) (mapconcat #'identity args " ")) 2228 (mkpr (title) 2229 (if (eq eglot-report-progress 'messages) 2230 (make-progress-reporter 2231 (format "[eglot] %s %s: %s" 2232 (eglot-project-nickname server) token title)) 2233 (list 'eglot--mode-line-reporter token title))) 2234 (upd (pcnt msg &optional 2235 (pr (gethash token (eglot--progress-reporters server)))) 2236 (cond 2237 ((eq (car pr) 'eglot--mode-line-reporter) 2238 (setcdr (cddr pr) (list msg pcnt)) 2239 (force-mode-line-update t)) 2240 (pr (eglot--reporter-update pr pcnt msg))))) 2241 (eglot--dbind ((WorkDoneProgress) kind title percentage message) value 2242 (pcase kind 2243 ("begin" 2244 (upd percentage (fmt title message) 2245 (puthash token (mkpr title) 2246 (eglot--progress-reporters server)))) 2247 ("report" (upd percentage message)) 2248 ("end" (upd (or percentage 100) message) 2249 (run-at-time 2 nil 2250 (lambda () 2251 (remhash token (eglot--progress-reporters server)))))))))) 2252 2253 (cl-defmethod eglot-handle-notification 2254 (_server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics 2255 &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode' 2256 "Handle notification publishDiagnostics." 2257 (cl-flet ((eglot--diag-type (sev) 2258 (cond ((null sev) 'eglot-error) 2259 ((<= sev 1) 'eglot-error) 2260 ((= sev 2) 'eglot-warning) 2261 (t 'eglot-note))) 2262 (mess (source code message) 2263 (concat source (and code (format " [%s]" code)) ": " message))) 2264 (if-let* ((path (expand-file-name (eglot--uri-to-path uri))) 2265 (buffer (find-buffer-visiting path))) 2266 (with-current-buffer buffer 2267 (cl-loop 2268 initially (assoc-delete-all path flymake-list-only-diagnostics) 2269 for diag-spec across diagnostics 2270 collect (eglot--dbind ((Diagnostic) range code message severity source tags) 2271 diag-spec 2272 (setq message (mess source code message)) 2273 (pcase-let 2274 ((`(,beg . ,end) (eglot--range-region range))) 2275 ;; Fallback to `flymake-diag-region' if server 2276 ;; botched the range 2277 (when (= beg end) 2278 (if-let* ((st (plist-get range :start)) 2279 (diag-region 2280 (flymake-diag-region 2281 (current-buffer) (1+ (plist-get st :line)) 2282 (plist-get st :character)))) 2283 (setq beg (car diag-region) end (cdr diag-region)) 2284 (eglot--widening 2285 (goto-char (point-min)) 2286 (setq beg 2287 (eglot--bol 2288 (1+ (plist-get (plist-get range :start) :line)))) 2289 (setq end 2290 (line-end-position 2291 (1+ (plist-get (plist-get range :end) :line))))))) 2292 (eglot--make-diag 2293 (current-buffer) beg end 2294 (eglot--diag-type severity) 2295 message `((eglot-lsp-diag . ,diag-spec)) 2296 (when-let ((faces 2297 (cl-loop for tag across tags 2298 when (alist-get tag eglot--tag-faces) 2299 collect it))) 2300 `((face . ,faces)))))) 2301 into diags 2302 finally (cond ((and 2303 ;; only add to current report if Flymake 2304 ;; starts on idle-timer (github#958) 2305 (not (null flymake-no-changes-timeout)) 2306 eglot--current-flymake-report-fn) 2307 (eglot--report-to-flymake diags)) 2308 (t 2309 (setq eglot--diagnostics diags))))) 2310 (cl-loop 2311 for diag-spec across diagnostics 2312 collect (eglot--dbind ((Diagnostic) code range message severity source) diag-spec 2313 (setq message (mess source code message)) 2314 (let* ((start (plist-get range :start)) 2315 (line (1+ (plist-get start :line))) 2316 (char (1+ (plist-get start :character)))) 2317 (eglot--make-diag 2318 path (cons line char) nil (eglot--diag-type severity) message))) 2319 into diags 2320 finally 2321 (setq flymake-list-only-diagnostics 2322 (assoc-delete-all path flymake-list-only-diagnostics)) 2323 (push (cons path diags) flymake-list-only-diagnostics))))) 2324 2325 (cl-defun eglot--register-unregister (server things how) 2326 "Helper for `registerCapability'. 2327 THINGS are either registrations or unregisterations (sic)." 2328 (cl-loop 2329 for thing in (cl-coerce things 'list) 2330 do (eglot--dbind ((Registration) id method registerOptions) thing 2331 (apply (cl-ecase how 2332 (register 'eglot-register-capability) 2333 (unregister 'eglot-unregister-capability)) 2334 server (intern method) id registerOptions)))) 2335 2336 (cl-defmethod eglot-handle-request 2337 (server (_method (eql client/registerCapability)) &key registrations) 2338 "Handle server request client/registerCapability." 2339 (eglot--register-unregister server registrations 'register)) 2340 2341 (cl-defmethod eglot-handle-request 2342 (server (_method (eql client/unregisterCapability)) 2343 &key unregisterations) ;; XXX: "unregisterations" (sic) 2344 "Handle server request client/unregisterCapability." 2345 (eglot--register-unregister server unregisterations 'unregister)) 2346 2347 (cl-defmethod eglot-handle-request 2348 (_server (_method (eql workspace/applyEdit)) &key _label edit) 2349 "Handle server request workspace/applyEdit." 2350 (eglot--apply-workspace-edit edit eglot-confirm-server-initiated-edits) 2351 `(:applied t)) 2352 2353 (cl-defmethod eglot-handle-request 2354 (server (_method (eql workspace/workspaceFolders))) 2355 "Handle server request workspace/workspaceFolders." 2356 (eglot-workspace-folders server)) 2357 2358 (defun eglot--TextDocumentIdentifier () 2359 "Compute TextDocumentIdentifier object for current buffer." 2360 `(:uri ,(eglot--path-to-uri (or buffer-file-name 2361 (ignore-errors 2362 (buffer-file-name 2363 (buffer-base-buffer))))))) 2364 2365 (defvar-local eglot--versioned-identifier 0) 2366 2367 (defun eglot--VersionedTextDocumentIdentifier () 2368 "Compute VersionedTextDocumentIdentifier object for current buffer." 2369 (append (eglot--TextDocumentIdentifier) 2370 `(:version ,eglot--versioned-identifier))) 2371 2372 (cl-defun eglot--languageId (&optional (server (eglot--current-server-or-lose))) 2373 "Compute LSP \\='languageId\\=' string for current buffer. 2374 Doubles as an predicate telling if SERVER can manage current 2375 buffer." 2376 (cl-loop for (mode . languageid) in 2377 (eglot--languages server) 2378 when (provided-mode-derived-p major-mode mode) 2379 return languageid)) 2380 2381 (defun eglot--TextDocumentItem () 2382 "Compute TextDocumentItem object for current buffer." 2383 (append 2384 (eglot--VersionedTextDocumentIdentifier) 2385 (list :languageId (eglot--languageId) 2386 :text 2387 (eglot--widening 2388 (buffer-substring-no-properties (point-min) (point-max)))))) 2389 2390 (defun eglot--TextDocumentPositionParams () 2391 "Compute TextDocumentPositionParams." 2392 (list :textDocument (eglot--TextDocumentIdentifier) 2393 :position (eglot--pos-to-lsp-position))) 2394 2395 (defvar-local eglot--last-inserted-char nil 2396 "If non-nil, value of the last inserted character in buffer.") 2397 2398 (defun eglot--post-self-insert-hook () 2399 "Set `eglot--last-inserted-char', maybe call on-type-formatting." 2400 (setq eglot--last-inserted-char last-input-event) 2401 (let ((ot-provider (eglot--server-capable :documentOnTypeFormattingProvider))) 2402 (when (and ot-provider 2403 (ignore-errors ; github#906, some LS's send empty strings 2404 (or (eq last-input-event 2405 (seq-first (plist-get ot-provider :firstTriggerCharacter))) 2406 (cl-find last-input-event 2407 (plist-get ot-provider :moreTriggerCharacter) 2408 :key #'seq-first)))) 2409 (eglot-format (point) nil last-input-event)))) 2410 2411 (defvar eglot--workspace-symbols-cache (make-hash-table :test #'equal) 2412 "Cache of `workspace/Symbol' results used by `xref-find-definitions'.") 2413 2414 (defun eglot--pre-command-hook () 2415 "Reset some temporary variables." 2416 (clrhash eglot--workspace-symbols-cache) 2417 (setq eglot--last-inserted-char nil)) 2418 2419 (defun eglot--CompletionParams () 2420 (append 2421 (eglot--TextDocumentPositionParams) 2422 `(:context 2423 ,(if-let (trigger (and (characterp eglot--last-inserted-char) 2424 (cl-find eglot--last-inserted-char 2425 (eglot--server-capable :completionProvider 2426 :triggerCharacters) 2427 :key (lambda (str) (aref str 0)) 2428 :test #'char-equal))) 2429 `(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1))))) 2430 2431 (defvar-local eglot--recent-changes nil 2432 "Recent buffer changes as collected by `eglot--before-change'.") 2433 2434 (cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what) 2435 "Tell if SERVER is ready for WHAT in current buffer." 2436 (and (cl-call-next-method) (not eglot--recent-changes))) 2437 2438 (defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.") 2439 2440 (defun eglot--before-change (beg end) 2441 "Hook onto `before-change-functions' with BEG and END." 2442 (when (listp eglot--recent-changes) 2443 ;; Records BEG and END, crucially convert them into LSP 2444 ;; (line/char) positions before that information is lost (because 2445 ;; the after-change thingy doesn't know if newlines were 2446 ;; deleted/added). Also record markers of BEG and END 2447 ;; (github#259) 2448 (push `(,(eglot--pos-to-lsp-position beg) 2449 ,(eglot--pos-to-lsp-position end) 2450 (,beg . ,(copy-marker beg nil)) 2451 (,end . ,(copy-marker end t))) 2452 eglot--recent-changes))) 2453 2454 (defvar eglot--document-changed-hook '(eglot--signal-textDocument/didChange) 2455 "Internal hook for doing things when the document changes.") 2456 2457 (defun eglot--after-change (beg end pre-change-length) 2458 "Hook onto `after-change-functions'. 2459 Records BEG, END and PRE-CHANGE-LENGTH locally." 2460 (cl-incf eglot--versioned-identifier) 2461 (pcase (car-safe eglot--recent-changes) 2462 (`(,lsp-beg ,lsp-end 2463 (,b-beg . ,b-beg-marker) 2464 (,b-end . ,b-end-marker)) 2465 ;; github#259 and github#367: with `capitalize-word' & friends, 2466 ;; `before-change-functions' records the whole word's `b-beg' and 2467 ;; `b-end'. Similarly, when `fill-paragraph' coalesces two 2468 ;; lines, `b-beg' and `b-end' mark end of first line and end of 2469 ;; second line, resp. In both situations, `beg' and `end' 2470 ;; received here seemingly contradict that: they will differ by 1 2471 ;; and encompass the capitalized character or, in the coalescing 2472 ;; case, the replacement of the newline with a space. We keep 2473 ;; both markers and positions to detect and correct this. In 2474 ;; this specific case, we ignore `beg', `len' and 2475 ;; `pre-change-len' and send richer information about the region 2476 ;; from the markers. I've also experimented with doing this 2477 ;; unconditionally but it seems to break when newlines are added. 2478 (if (and (= b-end b-end-marker) (= b-beg b-beg-marker) 2479 (or (/= beg b-beg) (/= end b-end))) 2480 (setcar eglot--recent-changes 2481 `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker) 2482 ,(buffer-substring-no-properties b-beg-marker 2483 b-end-marker))) 2484 (setcar eglot--recent-changes 2485 `(,lsp-beg ,lsp-end ,pre-change-length 2486 ,(buffer-substring-no-properties beg end))))) 2487 (_ (setf eglot--recent-changes :emacs-messup))) 2488 (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer)) 2489 (let ((buf (current-buffer))) 2490 (setq eglot--change-idle-timer 2491 (run-with-idle-timer 2492 eglot-send-changes-idle-time 2493 nil (lambda () (eglot--when-live-buffer buf 2494 (when eglot--managed-mode 2495 (run-hooks 'eglot--document-changed-hook) 2496 (setq eglot--change-idle-timer nil)))))))) 2497 2498 (defvar-local eglot-workspace-configuration () 2499 "Configure LSP servers specifically for a given project. 2500 2501 This variable's value should be a plist (SECTION VALUE ...). 2502 SECTION is a keyword naming a parameter section relevant to a 2503 particular server. VALUE is a plist or a primitive type 2504 converted to JSON also understood by that server. 2505 2506 Instead of a plist, an alist ((SECTION . VALUE) ...) can be used 2507 instead, but this variant is less reliable and not recommended. 2508 2509 This variable should be set as a directory-local variable. See 2510 info node `(emacs)Directory Variables' for various ways to do that. 2511 2512 Here's an example value that establishes two sections relevant to 2513 the Pylsp and Gopls LSP servers: 2514 2515 (:pylsp (:plugins (:jedi_completion (:include_params t 2516 :fuzzy t) 2517 :pylint (:enabled :json-false))) 2518 :gopls (:usePlaceholders t)) 2519 2520 The value of this variable can also be a unary function of a 2521 single argument, which will be a connected `eglot-lsp-server' 2522 instance. The function runs with `default-directory' set to the 2523 root of the current project. It should return an object of the 2524 format described above.") 2525 2526 ;;;###autoload 2527 (put 'eglot-workspace-configuration 'safe-local-variable 'listp) 2528 2529 (defun eglot-show-workspace-configuration (&optional server) 2530 "Dump `eglot-workspace-configuration' as JSON for debugging." 2531 (interactive (list (eglot--read-server "Show workspace configuration for" t))) 2532 (let ((conf (eglot--workspace-configuration-plist server))) 2533 (with-current-buffer (get-buffer-create "*EGLOT workspace configuration*") 2534 (erase-buffer) 2535 (insert (jsonrpc--json-encode conf)) 2536 (with-no-warnings 2537 (require 'json) 2538 (when (require 'json-mode nil t) (json-mode)) 2539 (json-pretty-print-buffer)) 2540 (pop-to-buffer (current-buffer))))) 2541 2542 (defun eglot--workspace-configuration-plist (server &optional path) 2543 "Returns SERVER's workspace configuration as a plist. 2544 If PATH consider that file's `file-name-directory' to get the 2545 local value of the `eglot-workspace-configuration' variable, else 2546 use the root of SERVER's `eglot--project'." 2547 (let ((val (with-temp-buffer 2548 (setq default-directory 2549 (if path 2550 (file-name-directory path) 2551 (project-root (eglot--project server)))) 2552 ;; Set the major mode to be the first of the managed 2553 ;; modes. This is the one the user started eglot in. 2554 (setq major-mode (car (eglot--major-modes server))) 2555 (hack-dir-local-variables-non-file-buffer) 2556 (if (functionp eglot-workspace-configuration) 2557 (funcall eglot-workspace-configuration server) 2558 eglot-workspace-configuration)))) 2559 (or (and (consp (car val)) 2560 (cl-loop for (section . v) in val 2561 collect (if (keywordp section) section 2562 (intern (format ":%s" section))) 2563 collect v)) 2564 val))) 2565 2566 (defun eglot-signal-didChangeConfiguration (server) 2567 "Send a `:workspace/didChangeConfiguration' signal to SERVER. 2568 When called interactively, use the currently active server" 2569 (interactive (list (eglot--current-server-or-lose))) 2570 (jsonrpc-notify 2571 server :workspace/didChangeConfiguration 2572 (list 2573 :settings 2574 (or (eglot--workspace-configuration-plist server) 2575 eglot--{})))) 2576 2577 (cl-defmethod eglot-handle-request 2578 (server (_method (eql workspace/configuration)) &key items) 2579 "Handle server request workspace/configuration." 2580 (apply #'vector 2581 (mapcar 2582 (eglot--lambda ((ConfigurationItem) scopeUri section) 2583 (cl-loop 2584 with scope-uri-path = (and scopeUri (eglot--uri-to-path scopeUri)) 2585 for (wsection o) 2586 on (eglot--workspace-configuration-plist server scope-uri-path) 2587 by #'cddr 2588 when (string= 2589 (if (keywordp wsection) 2590 (substring (symbol-name wsection) 1) 2591 wsection) 2592 section) 2593 return o)) 2594 items))) 2595 2596 (defun eglot--signal-textDocument/didChange () 2597 "Send textDocument/didChange to server." 2598 (when eglot--recent-changes 2599 (let* ((server (eglot--current-server-or-lose)) 2600 (sync-capability (eglot--server-capable :textDocumentSync)) 2601 (sync-kind (if (numberp sync-capability) sync-capability 2602 (plist-get sync-capability :change))) 2603 (full-sync-p (or (eq sync-kind 1) 2604 (eq :emacs-messup eglot--recent-changes)))) 2605 (jsonrpc-notify 2606 server :textDocument/didChange 2607 (list 2608 :textDocument (eglot--VersionedTextDocumentIdentifier) 2609 :contentChanges 2610 (if full-sync-p 2611 (vector `(:text ,(eglot--widening 2612 (buffer-substring-no-properties (point-min) 2613 (point-max))))) 2614 (cl-loop for (beg end len text) in (reverse eglot--recent-changes) 2615 ;; github#259: `capitalize-word' and commands based 2616 ;; on `casify_region' will cause multiple duplicate 2617 ;; empty entries in `eglot--before-change' calls 2618 ;; without an `eglot--after-change' reciprocal. 2619 ;; Weed them out here. 2620 when (numberp len) 2621 vconcat `[,(list :range `(:start ,beg :end ,end) 2622 :rangeLength len :text text)])))) 2623 (setq eglot--recent-changes nil) 2624 (jsonrpc--call-deferred server)))) 2625 2626 (defun eglot--signal-textDocument/didOpen () 2627 "Send textDocument/didOpen to server." 2628 (setq eglot--recent-changes nil eglot--versioned-identifier 0) 2629 (jsonrpc-notify 2630 (eglot--current-server-or-lose) 2631 :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem)))) 2632 2633 (defun eglot--signal-textDocument/didClose () 2634 "Send textDocument/didClose to server." 2635 (with-demoted-errors 2636 "[eglot] error sending textDocument/didClose: %s" 2637 (jsonrpc-notify 2638 (eglot--current-server-or-lose) 2639 :textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier))))) 2640 2641 (defun eglot--signal-textDocument/willSave () 2642 "Maybe send textDocument/willSave to server." 2643 (let ((server (eglot--current-server-or-lose)) 2644 (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier)))) 2645 (when (eglot--server-capable :textDocumentSync :willSave) 2646 (jsonrpc-notify server :textDocument/willSave params)) 2647 (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil) 2648 (ignore-errors 2649 (eglot--apply-text-edits 2650 (eglot--request server :textDocument/willSaveWaitUntil params 2651 :timeout 0.5)))))) 2652 2653 (defun eglot--signal-textDocument/didSave () 2654 "Maybe send textDocument/didSave to server." 2655 (eglot--signal-textDocument/didChange) 2656 (when (eglot--server-capable :textDocumentSync :save) 2657 (jsonrpc-notify 2658 (eglot--current-server-or-lose) 2659 :textDocument/didSave 2660 (list 2661 ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this. 2662 :text (buffer-substring-no-properties (point-min) (point-max)) 2663 :textDocument (eglot--TextDocumentIdentifier))))) 2664 2665 (defun eglot-flymake-backend (report-fn &rest _more) 2666 "A Flymake backend for Eglot. 2667 Calls REPORT-FN (or arranges for it to be called) when the server 2668 publishes diagnostics. Between calls to this function, REPORT-FN 2669 may be called multiple times (respecting the protocol of 2670 `flymake-diagnostic-functions')." 2671 (cond (eglot--managed-mode 2672 (setq eglot--current-flymake-report-fn report-fn) 2673 (eglot--report-to-flymake eglot--diagnostics)) 2674 (t 2675 (funcall report-fn nil)))) 2676 2677 (defun eglot--report-to-flymake (diags) 2678 "Internal helper for `eglot-flymake-backend'." 2679 (save-restriction 2680 (widen) 2681 (funcall eglot--current-flymake-report-fn diags 2682 ;; If the buffer hasn't changed since last 2683 ;; call to the report function, flymake won't 2684 ;; delete old diagnostics. Using :region 2685 ;; keyword forces flymake to delete 2686 ;; them (github#159). 2687 :region (cons (point-min) (point-max)))) 2688 (setq eglot--diagnostics diags)) 2689 2690 (defun eglot-xref-backend () "Eglot xref backend." 'eglot) 2691 2692 (defvar eglot--temp-location-buffers (make-hash-table :test #'equal) 2693 "Helper variable for `eglot--collecting-xrefs'.") 2694 2695 (defvar eglot-xref-lessp-function #'ignore 2696 "Compare two `xref-item' objects for sorting.") 2697 2698 (cl-defmacro eglot--collecting-xrefs ((collector) &rest body) 2699 "Sort and handle xrefs collected with COLLECTOR in BODY." 2700 (declare (indent 1) (debug (sexp &rest form))) 2701 (let ((collected (cl-gensym "collected"))) 2702 `(unwind-protect 2703 (let (,collected) 2704 (cl-flet ((,collector (xref) (push xref ,collected))) 2705 ,@body) 2706 (setq ,collected (nreverse ,collected)) 2707 (sort ,collected eglot-xref-lessp-function)) 2708 (maphash (lambda (_uri buf) (kill-buffer buf)) eglot--temp-location-buffers) 2709 (clrhash eglot--temp-location-buffers)))) 2710 2711 (defun eglot--xref-make-match (name uri range) 2712 "Like `xref-make-match' but with LSP's NAME, URI and RANGE. 2713 Try to visit the target file for a richer summary line." 2714 (pcase-let* 2715 ((file (eglot--uri-to-path uri)) 2716 (visiting (or (find-buffer-visiting file) 2717 (gethash uri eglot--temp-location-buffers))) 2718 (collect (lambda () 2719 (eglot--widening 2720 (pcase-let* ((`(,beg . ,end) (eglot--range-region range)) 2721 (bol (progn (goto-char beg) (eglot--bol))) 2722 (substring (buffer-substring bol (line-end-position))) 2723 (hi-beg (- beg bol)) 2724 (hi-end (- (min (line-end-position) end) bol))) 2725 (add-face-text-property hi-beg hi-end 'xref-match 2726 t substring) 2727 (list substring (line-number-at-pos (point) t) 2728 (eglot-utf-32-linepos) (- end beg)))))) 2729 (`(,summary ,line ,column ,length) 2730 (cond 2731 (visiting (with-current-buffer visiting (funcall collect))) 2732 ((file-readable-p file) (with-current-buffer 2733 (puthash uri (generate-new-buffer " *temp*") 2734 eglot--temp-location-buffers) 2735 (insert-file-contents file) 2736 (funcall collect))) 2737 (t ;; fall back to the "dumb strategy" 2738 (let* ((start (cl-getf range :start)) 2739 (line (1+ (cl-getf start :line))) 2740 (start-pos (cl-getf start :character)) 2741 (end-pos (cl-getf (cl-getf range :end) :character))) 2742 (list name line start-pos (- end-pos start-pos))))))) 2743 (setf (gethash (expand-file-name file) eglot--servers-by-xrefed-file) 2744 (eglot--current-server-or-lose)) 2745 (xref-make-match summary (xref-make-file-location file line column) length))) 2746 2747 (defun eglot--workspace-symbols (pat &optional buffer) 2748 "Ask for :workspace/symbol on PAT, return list of formatted strings. 2749 If BUFFER, switch to it before." 2750 (with-current-buffer (or buffer (current-buffer)) 2751 (eglot--server-capable-or-lose :workspaceSymbolProvider) 2752 (mapcar 2753 (lambda (wss) 2754 (eglot--dbind ((WorkspaceSymbol) name containerName kind) wss 2755 (propertize 2756 (format "%s%s %s" 2757 (if (zerop (length containerName)) "" 2758 (concat (propertize containerName 'face 'shadow) " ")) 2759 name 2760 (propertize (alist-get kind eglot--symbol-kind-names "Unknown") 2761 'face 'shadow)) 2762 'eglot--lsp-workspaceSymbol wss))) 2763 (eglot--request (eglot--current-server-or-lose) :workspace/symbol 2764 `(:query ,pat))))) 2765 2766 (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot))) 2767 "Yet another tricky connection between LSP and Elisp completion semantics." 2768 (let ((buf (current-buffer)) (cache eglot--workspace-symbols-cache)) 2769 (cl-labels ((refresh (pat) (eglot--workspace-symbols pat buf)) 2770 (lookup-1 (pat) ;; check cache, else refresh 2771 (let ((probe (gethash pat cache :missing))) 2772 (if (eq probe :missing) (puthash pat (refresh pat) cache) 2773 probe))) 2774 (lookup (pat _point) 2775 (let ((res (lookup-1 pat)) 2776 (def (and (string= pat "") (gethash :default cache)))) 2777 (append def res nil))) 2778 (score (c) 2779 (cl-getf (get-text-property 2780 0 'eglot--lsp-workspaceSymbol c) 2781 :score 0))) 2782 (external-completion-table 2783 'eglot-indirection-joy 2784 #'lookup 2785 `((cycle-sort-function 2786 . ,(lambda (completions) 2787 (cl-sort completions #'> :key #'score)))))))) 2788 2789 (defun eglot--recover-workspace-symbol-meta (string) 2790 "Search `eglot--workspace-symbols-cache' for rich entry of STRING." 2791 (catch 'found 2792 (maphash (lambda (_k v) 2793 (while (consp v) 2794 ;; Like mess? Ask minibuffer.el about improper lists. 2795 (when (equal (car v) string) (throw 'found (car v))) 2796 (setq v (cdr v)))) 2797 eglot--workspace-symbols-cache))) 2798 2799 (cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot))) 2800 (let ((attempt 2801 (and (xref--prompt-p this-command) 2802 (puthash :default 2803 (ignore-errors 2804 (eglot--workspace-symbols (symbol-name (symbol-at-point)))) 2805 eglot--workspace-symbols-cache)))) 2806 (if attempt (car attempt) "LSP identifier at point"))) 2807 2808 (defvar eglot--lsp-xref-refs nil 2809 "`xref' objects for overriding `xref-backend-references''s.") 2810 2811 (cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability) 2812 "Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY." 2813 (eglot--server-capable-or-lose 2814 (or capability 2815 (intern 2816 (format ":%sProvider" 2817 (cadr (split-string (symbol-name method) 2818 "/")))))) 2819 (let ((response 2820 (eglot--request 2821 (eglot--current-server-or-lose) 2822 method (append (eglot--TextDocumentPositionParams) extra-params)))) 2823 (eglot--collecting-xrefs (collect) 2824 (mapc 2825 (lambda (loc-or-loc-link) 2826 (let ((sym-name (symbol-name (symbol-at-point)))) 2827 (eglot--dcase loc-or-loc-link 2828 (((LocationLink) targetUri targetSelectionRange) 2829 (collect (eglot--xref-make-match sym-name 2830 targetUri targetSelectionRange))) 2831 (((Location) uri range) 2832 (collect (eglot--xref-make-match sym-name 2833 uri range)))))) 2834 (if (vectorp response) response (and response (list response))))))) 2835 2836 (cl-defun eglot--lsp-xref-helper (method &key extra-params capability) 2837 "Helper for `eglot-find-declaration' & friends." 2838 (let ((eglot--lsp-xref-refs (eglot--lsp-xrefs-for-method 2839 method 2840 :extra-params extra-params 2841 :capability capability))) 2842 (if eglot--lsp-xref-refs 2843 (xref-find-references "LSP identifier at point.") 2844 (eglot--message "%s returned no references" method)))) 2845 2846 (defun eglot-find-declaration () 2847 "Find declaration for SYM, the identifier at point." 2848 (interactive) 2849 (eglot--lsp-xref-helper :textDocument/declaration)) 2850 2851 (defun eglot-find-implementation () 2852 "Find implementation for SYM, the identifier at point." 2853 (interactive) 2854 (eglot--lsp-xref-helper :textDocument/implementation)) 2855 2856 (defun eglot-find-typeDefinition () 2857 "Find type definition for SYM, the identifier at point." 2858 (interactive) 2859 (eglot--lsp-xref-helper :textDocument/typeDefinition)) 2860 2861 (cl-defmethod xref-backend-definitions ((_backend (eql eglot)) id) 2862 (let ((probe (eglot--recover-workspace-symbol-meta id))) 2863 (if probe 2864 (eglot--dbind ((WorkspaceSymbol) name location) 2865 (get-text-property 0 'eglot--lsp-workspaceSymbol probe) 2866 (eglot--dbind ((Location) uri range) location 2867 (list (eglot--xref-make-match name uri range)))) 2868 (eglot--lsp-xrefs-for-method :textDocument/definition)))) 2869 2870 (cl-defmethod xref-backend-references ((_backend (eql eglot)) _identifier) 2871 (or 2872 eglot--lsp-xref-refs 2873 (eglot--lsp-xrefs-for-method 2874 :textDocument/references :extra-params `(:context (:includeDeclaration t))))) 2875 2876 (cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern) 2877 (when (eglot--server-capable :workspaceSymbolProvider) 2878 (eglot--collecting-xrefs (collect) 2879 (mapc 2880 (eglot--lambda ((SymbolInformation) name location) 2881 (eglot--dbind ((Location) uri range) location 2882 (collect (eglot--xref-make-match name uri range)))) 2883 (eglot--request (eglot--current-server-or-lose) 2884 :workspace/symbol 2885 `(:query ,pattern)))))) 2886 2887 (defun eglot-format-buffer () 2888 "Format contents of current buffer." 2889 (interactive) 2890 (eglot-format nil nil)) 2891 2892 (defun eglot-format (&optional beg end on-type-format) 2893 "Format region BEG END. 2894 If either BEG or END is nil, format entire buffer. 2895 Interactively, format active region, or entire buffer if region 2896 is not active. 2897 2898 If non-nil, ON-TYPE-FORMAT is a character just inserted at BEG 2899 for which LSP on-type-formatting should be requested." 2900 (interactive (and (region-active-p) (list (region-beginning) (region-end)))) 2901 (pcase-let ((`(,method ,cap ,args) 2902 (cond 2903 ((and beg on-type-format) 2904 `(:textDocument/onTypeFormatting 2905 :documentOnTypeFormattingProvider 2906 ,`(:position ,(eglot--pos-to-lsp-position beg) 2907 :ch ,(string on-type-format)))) 2908 ((and beg end) 2909 `(:textDocument/rangeFormatting 2910 :documentRangeFormattingProvider 2911 (:range ,(list :start (eglot--pos-to-lsp-position beg) 2912 :end (eglot--pos-to-lsp-position end))))) 2913 (t 2914 '(:textDocument/formatting :documentFormattingProvider nil))))) 2915 (eglot--server-capable-or-lose cap) 2916 (eglot--apply-text-edits 2917 (eglot--request 2918 (eglot--current-server-or-lose) 2919 method 2920 (cl-list* 2921 :textDocument (eglot--TextDocumentIdentifier) 2922 :options (list :tabSize tab-width 2923 :insertSpaces (if indent-tabs-mode :json-false t) 2924 :insertFinalNewline (if require-final-newline t :json-false) 2925 :trimFinalNewlines (if delete-trailing-lines t :json-false)) 2926 args))))) 2927 2928 (defvar eglot-cache-session-completions t 2929 "If non-nil Eglot caches data during completion sessions.") 2930 2931 (defvar eglot--capf-session :none "A cache used by `eglot-completion-at-point'.") 2932 2933 (defun eglot--capf-session-flush (&optional _) (setq eglot--capf-session :none)) 2934 2935 (defun eglot-completion-at-point () 2936 "Eglot's `completion-at-point' function." 2937 ;; Commit logs for this function help understand what's going on. 2938 (when-let (completion-capability (eglot--server-capable :completionProvider)) 2939 (let* ((server (eglot--current-server-or-lose)) 2940 (sort-completions 2941 (lambda (completions) 2942 (cl-sort completions 2943 #'string-lessp 2944 :key (lambda (c) 2945 (plist-get 2946 (get-text-property 0 'eglot--lsp-item c) 2947 :sortText))))) 2948 (metadata `(metadata (category . eglot) 2949 (display-sort-function . ,sort-completions))) 2950 (local-cache :none) 2951 (bounds (bounds-of-thing-at-point 'symbol)) 2952 (orig-pos (point)) 2953 (resolved (make-hash-table)) 2954 (proxies 2955 (lambda () 2956 (if (listp local-cache) local-cache 2957 (let* ((resp (eglot--request server 2958 :textDocument/completion 2959 (eglot--CompletionParams) 2960 :cancel-on-input t)) 2961 (items (append 2962 (if (vectorp resp) resp (plist-get resp :items)) 2963 nil)) 2964 (cachep (and (listp resp) items 2965 eglot-cache-session-completions 2966 (eq (plist-get resp :isIncomplete) :json-false))) 2967 (bounds (or bounds 2968 (cons (point) (point)))) 2969 (proxies 2970 (mapcar 2971 (jsonrpc-lambda 2972 (&rest item &key label insertText insertTextFormat 2973 textEdit &allow-other-keys) 2974 (let ((proxy 2975 ;; Snippet or textEdit, it's safe to 2976 ;; display/insert the label since 2977 ;; it'll be adjusted. If no usable 2978 ;; insertText at all, label is best, 2979 ;; too. 2980 (cond ((or (eql insertTextFormat 2) 2981 textEdit 2982 (null insertText) 2983 (string-empty-p insertText)) 2984 (string-trim-left label)) 2985 (t insertText)))) 2986 (unless (zerop (length proxy)) 2987 (put-text-property 0 1 'eglot--lsp-item item proxy)) 2988 proxy)) 2989 items))) 2990 ;; (trace-values "Requested" (length proxies) cachep bounds) 2991 (setq eglot--capf-session 2992 (if cachep (list bounds proxies resolved orig-pos) :none)) 2993 (setq local-cache proxies))))) 2994 (resolve-maybe 2995 ;; Maybe completion/resolve JSON object `lsp-comp' into 2996 ;; another JSON object, if at all possible. Otherwise, 2997 ;; just return lsp-comp. 2998 (lambda (lsp-comp) 2999 (or (gethash lsp-comp resolved) 3000 (setf (gethash lsp-comp resolved) 3001 (if (and (eglot--server-capable :completionProvider 3002 :resolveProvider) 3003 (plist-get lsp-comp :data)) 3004 (eglot--request server :completionItem/resolve 3005 lsp-comp :cancel-on-input t) 3006 lsp-comp)))))) 3007 (unless bounds (setq bounds (cons (point) (point)))) 3008 (when (and (consp eglot--capf-session) 3009 (= (car bounds) (car (nth 0 eglot--capf-session))) 3010 (>= (cdr bounds) (cdr (nth 0 eglot--capf-session)))) 3011 (setq local-cache (nth 1 eglot--capf-session) 3012 resolved (nth 2 eglot--capf-session) 3013 orig-pos (nth 3 eglot--capf-session)) 3014 ;; (trace-values "Recalling cache" (length local-cache) bounds orig-pos) 3015 ) 3016 (list 3017 (car bounds) 3018 (cdr bounds) 3019 (lambda (probe pred action) 3020 (cond 3021 ((eq action 'metadata) metadata) ; metadata 3022 ((eq action 'lambda) ; test-completion 3023 (test-completion probe (funcall proxies))) 3024 ((eq (car-safe action) 'boundaries) nil) ; boundaries 3025 ((null action) ; try-completion 3026 (try-completion probe (funcall proxies))) 3027 ((eq action t) ; all-completions 3028 (all-completions 3029 "" 3030 (funcall proxies) 3031 (lambda (proxy) 3032 (let* ((item (get-text-property 0 'eglot--lsp-item proxy)) 3033 (filterText (plist-get item :filterText))) 3034 (and (or (null pred) (funcall pred proxy)) 3035 (string-prefix-p 3036 probe (or filterText proxy) completion-ignore-case)))))))) 3037 :annotation-function 3038 (lambda (proxy) 3039 (eglot--dbind ((CompletionItem) detail kind) 3040 (get-text-property 0 'eglot--lsp-item proxy) 3041 (let* ((detail (and (stringp detail) 3042 (not (string= detail "")) 3043 detail)) 3044 (annotation 3045 (or detail 3046 (cdr (assoc kind eglot--kind-names))))) 3047 (when annotation 3048 (concat " " 3049 (propertize annotation 3050 'face 'font-lock-function-name-face)))))) 3051 :company-kind 3052 ;; Associate each lsp-item with a lsp-kind symbol. 3053 (lambda (proxy) 3054 (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy)) 3055 (kind (alist-get (plist-get lsp-item :kind) 3056 eglot--kind-names))) 3057 (pcase kind 3058 ("EnumMember" 'enum-member) 3059 ("TypeParameter" 'type-parameter) 3060 (_ (intern (downcase kind)))))) 3061 :company-deprecated 3062 (lambda (proxy) 3063 (when-let ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))) 3064 (or (seq-contains-p (plist-get lsp-item :tags) 3065 1) 3066 (eq t (plist-get lsp-item :deprecated))))) 3067 :company-docsig 3068 ;; FIXME: autoImportText is specific to the pyright language server 3069 (lambda (proxy) 3070 (when-let* ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)) 3071 (data (plist-get (funcall resolve-maybe lsp-comp) :data)) 3072 (import-text (plist-get data :autoImportText))) 3073 import-text)) 3074 :company-doc-buffer 3075 (lambda (proxy) 3076 (let* ((documentation 3077 (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy))) 3078 (plist-get (funcall resolve-maybe lsp-comp) :documentation))) 3079 (formatted (and documentation 3080 (eglot--format-markup documentation)))) 3081 (when formatted 3082 (with-current-buffer (get-buffer-create " *eglot doc*") 3083 (erase-buffer) 3084 (insert formatted) 3085 (current-buffer))))) 3086 :company-require-match 'never 3087 :company-prefix-length 3088 (save-excursion 3089 (goto-char (car bounds)) 3090 (when (listp completion-capability) 3091 (looking-back 3092 (regexp-opt 3093 (cl-coerce (cl-getf completion-capability :triggerCharacters) 'list)) 3094 (eglot--bol)))) 3095 :exit-function 3096 (lambda (proxy status) 3097 (eglot--capf-session-flush) 3098 (when (memq status '(finished exact)) 3099 ;; To assist in using this whole `completion-at-point' 3100 ;; function inside `completion-in-region', ensure the exit 3101 ;; function runs in the buffer where the completion was 3102 ;; triggered from. This should probably be in Emacs itself. 3103 ;; (github#505) 3104 (with-current-buffer (if (minibufferp) 3105 (window-buffer (minibuffer-selected-window)) 3106 (current-buffer)) 3107 (eglot--dbind ((CompletionItem) insertTextFormat 3108 insertText textEdit additionalTextEdits label) 3109 (funcall 3110 resolve-maybe 3111 (or (get-text-property 0 'eglot--lsp-item proxy) 3112 ;; When selecting from the *Completions* 3113 ;; buffer, `proxy' won't have any properties. 3114 ;; A lookup should fix that (github#148) 3115 (get-text-property 3116 0 'eglot--lsp-item 3117 (cl-find proxy (funcall proxies) :test #'string=)))) 3118 (let ((snippet-fn (and (eql insertTextFormat 2) 3119 (eglot--snippet-expansion-fn)))) 3120 (cond (textEdit 3121 ;; Revert buffer back to state when the edit 3122 ;; was obtained from server. If a `proxy' 3123 ;; "bar" was obtained from a buffer with 3124 ;; "foo.b", the LSP edit applies to that' 3125 ;; state, _not_ the current "foo.bar". 3126 (delete-region orig-pos (point)) 3127 (eglot--dbind ((TextEdit) range newText) textEdit 3128 (pcase-let ((`(,beg . ,end) 3129 (eglot--range-region range))) 3130 (delete-region beg end) 3131 (goto-char beg) 3132 (funcall (or snippet-fn #'insert) newText)))) 3133 (snippet-fn 3134 ;; A snippet should be inserted, but using plain 3135 ;; `insertText'. This requires us to delete the 3136 ;; whole completion, since `insertText' is the full 3137 ;; completion's text. 3138 (delete-region (- (point) (length proxy)) (point)) 3139 (funcall snippet-fn (or insertText label)))) 3140 (when (cl-plusp (length additionalTextEdits)) 3141 (eglot--apply-text-edits additionalTextEdits))) 3142 (eglot--signal-textDocument/didChange))))))))) 3143 3144 (defun eglot--hover-info (contents &optional _range) 3145 (mapconcat #'eglot--format-markup 3146 (if (vectorp contents) contents (list contents)) "\n")) 3147 3148 (defun eglot--sig-info (sig &optional sig-active briefp) 3149 (eglot--dbind ((SignatureInformation) 3150 ((:label siglabel)) 3151 ((:documentation sigdoc)) parameters activeParameter) 3152 sig 3153 (with-temp-buffer 3154 (save-excursion (insert siglabel)) 3155 ;; Ad-hoc attempt to parse label as <name>(<params>) 3156 (when (looking-at "\\([^(]*\\)(\\([^)]+\\))") 3157 (add-face-text-property (match-beginning 1) (match-end 1) 3158 'font-lock-function-name-face)) 3159 ;; Add documentation, indented so we can distinguish multiple signatures 3160 (when-let (doc (and (not briefp) sigdoc (eglot--format-markup sigdoc))) 3161 (goto-char (point-max)) 3162 (insert "\n" (replace-regexp-in-string "^" " " doc))) 3163 ;; Now to the parameters 3164 (cl-loop 3165 with active-param = (or sig-active activeParameter) 3166 for i from 0 for parameter across parameters do 3167 (eglot--dbind ((ParameterInformation) 3168 ((:label parlabel)) 3169 ((:documentation pardoc))) 3170 parameter 3171 ;; ...perhaps highlight it in the formals list 3172 (when (and (eq i active-param)) 3173 (save-excursion 3174 (goto-char (point-min)) 3175 (pcase-let 3176 ((`(,beg ,end) 3177 (if (stringp parlabel) 3178 (let ((case-fold-search nil)) 3179 (and (search-forward parlabel (line-end-position) t) 3180 (list (match-beginning 0) (match-end 0)))) 3181 (mapcar #'1+ (append parlabel nil))))) 3182 (if (and beg end) 3183 (add-face-text-property 3184 beg end 3185 'eldoc-highlight-function-argument))))) 3186 ;; ...and/or maybe add its doc on a line by its own. 3187 (let (fpardoc) 3188 (when (and pardoc (not briefp) 3189 (not (string-empty-p 3190 (setq fpardoc (eglot--format-markup pardoc))))) 3191 (insert "\n " 3192 (propertize 3193 (if (stringp parlabel) parlabel 3194 (apply #'substring siglabel (mapcar #'1+ parlabel))) 3195 'face (and (eq i active-param) 'eldoc-highlight-function-argument)) 3196 ": " fpardoc))))) 3197 (buffer-string)))) 3198 3199 (defun eglot-signature-eldoc-function (cb) 3200 "A member of `eldoc-documentation-functions', for signatures." 3201 (when (eglot--server-capable :signatureHelpProvider) 3202 (let ((buf (current-buffer))) 3203 (jsonrpc-async-request 3204 (eglot--current-server-or-lose) 3205 :textDocument/signatureHelp (eglot--TextDocumentPositionParams) 3206 :success-fn 3207 (eglot--lambda ((SignatureHelp) 3208 signatures activeSignature (activeParameter 0)) 3209 (eglot--when-buffer-window buf 3210 (let ((active-sig (and (cl-plusp (length signatures)) 3211 (aref signatures (or activeSignature 0))))) 3212 (if (not active-sig) (funcall cb nil) 3213 (funcall 3214 cb (mapconcat (lambda (s) 3215 (eglot--sig-info s (and (eq s active-sig) 3216 activeParameter) 3217 nil)) 3218 signatures "\n") 3219 :echo (eglot--sig-info active-sig activeParameter t)))))) 3220 :deferred :textDocument/signatureHelp)) 3221 t)) 3222 3223 (defun eglot-hover-eldoc-function (cb) 3224 "A member of `eldoc-documentation-functions', for hover." 3225 (when (eglot--server-capable :hoverProvider) 3226 (let ((buf (current-buffer))) 3227 (jsonrpc-async-request 3228 (eglot--current-server-or-lose) 3229 :textDocument/hover (eglot--TextDocumentPositionParams) 3230 :success-fn (eglot--lambda ((Hover) contents range) 3231 (eglot--when-buffer-window buf 3232 (let ((info (unless (seq-empty-p contents) 3233 (eglot--hover-info contents range)))) 3234 (funcall cb info 3235 :echo (and info (string-match "\n" info)))))) 3236 :deferred :textDocument/hover)) 3237 (eglot--highlight-piggyback cb) 3238 t)) 3239 3240 (defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.") 3241 3242 (defun eglot--highlight-piggyback (_cb) 3243 "Request and handle `:textDocument/documentHighlight'." 3244 ;; FIXME: Obviously, this is just piggy backing on eldoc's calls for 3245 ;; convenience, as shown by the fact that we just ignore cb. 3246 (let ((buf (current-buffer))) 3247 (when (eglot--server-capable :documentHighlightProvider) 3248 (jsonrpc-async-request 3249 (eglot--current-server-or-lose) 3250 :textDocument/documentHighlight (eglot--TextDocumentPositionParams) 3251 :success-fn 3252 (lambda (highlights) 3253 (mapc #'delete-overlay eglot--highlights) 3254 (setq eglot--highlights 3255 (eglot--when-buffer-window buf 3256 (mapcar 3257 (eglot--lambda ((DocumentHighlight) range) 3258 (pcase-let ((`(,beg . ,end) 3259 (eglot--range-region range))) 3260 (let ((ov (make-overlay beg end))) 3261 (overlay-put ov 'face 'eglot-highlight-symbol-face) 3262 (overlay-put ov 'modification-hooks 3263 `(,(lambda (o &rest _) (delete-overlay o)))) 3264 ov))) 3265 highlights)))) 3266 :deferred :textDocument/documentHighlight) 3267 nil))) 3268 3269 (defun eglot--imenu-SymbolInformation (res) 3270 "Compute `imenu--index-alist' for RES vector of SymbolInformation." 3271 (mapcar 3272 (pcase-lambda (`(,kind . ,objs)) 3273 (cons 3274 (alist-get kind eglot--symbol-kind-names "Unknown") 3275 (mapcan 3276 (pcase-lambda (`(,container . ,objs)) 3277 (let ((elems (mapcar 3278 (eglot--lambda ((SymbolInformation) kind name location) 3279 (let ((reg (eglot--range-region 3280 (plist-get location :range))) 3281 (kind (alist-get kind eglot--symbol-kind-names))) 3282 (cons (propertize name 3283 'breadcrumb-region reg 3284 'breadcrumb-kind kind) 3285 (car reg)))) 3286 objs))) 3287 (if container (list (cons container elems)) elems))) 3288 (seq-group-by 3289 (eglot--lambda ((SymbolInformation) containerName) containerName) objs)))) 3290 (seq-group-by (eglot--lambda ((SymbolInformation) kind) kind) res))) 3291 3292 (defun eglot--imenu-DocumentSymbol (res) 3293 "Compute `imenu--index-alist' for RES vector of DocumentSymbol." 3294 (cl-labels ((dfs (&key name children range kind &allow-other-keys) 3295 (let* ((reg (eglot--range-region range)) 3296 (kind (alist-get kind eglot--symbol-kind-names)) 3297 (name (propertize name 3298 'breadcrumb-region reg 3299 'breadcrumb-kind kind))) 3300 (if (seq-empty-p children) 3301 (cons name (car reg)) 3302 (cons name 3303 (mapcar (lambda (c) (apply #'dfs c)) children)))))) 3304 (mapcar (lambda (s) (apply #'dfs s)) res))) 3305 3306 (defun eglot-imenu () 3307 "Eglot's `imenu-create-index-function'. 3308 Returns a list as described in docstring of `imenu--index-alist'." 3309 (let* ((res (eglot--request (eglot--current-server-or-lose) 3310 :textDocument/documentSymbol 3311 `(:textDocument 3312 ,(eglot--TextDocumentIdentifier)) 3313 :cancel-on-input non-essential)) 3314 (head (and (cl-plusp (length res)) (elt res 0)))) 3315 (when head 3316 (eglot--dcase head 3317 (((SymbolInformation)) (eglot--imenu-SymbolInformation res)) 3318 (((DocumentSymbol)) (eglot--imenu-DocumentSymbol res)))))) 3319 3320 (cl-defun eglot--apply-text-edits (edits &optional version) 3321 "Apply EDITS for current buffer if at VERSION, or if it's nil." 3322 (unless edits (cl-return-from eglot--apply-text-edits)) 3323 (unless (or (not version) (equal version eglot--versioned-identifier)) 3324 (jsonrpc-error "Edits on `%s' require version %d, you have %d" 3325 (current-buffer) version eglot--versioned-identifier)) 3326 (atomic-change-group 3327 (let* ((change-group (prepare-change-group)) 3328 (howmany (length edits)) 3329 (reporter (make-progress-reporter 3330 (format "[eglot] applying %s edits to `%s'..." 3331 howmany (current-buffer)) 3332 0 howmany)) 3333 (done 0)) 3334 (mapc (pcase-lambda (`(,newText ,beg . ,end)) 3335 (let ((source (current-buffer))) 3336 (with-temp-buffer 3337 (insert newText) 3338 (let ((temp (current-buffer))) 3339 (with-current-buffer source 3340 (save-excursion 3341 (save-restriction 3342 (narrow-to-region beg end) 3343 (replace-buffer-contents temp))) 3344 (eglot--reporter-update reporter (cl-incf done))))))) 3345 (mapcar (eglot--lambda ((TextEdit) range newText) 3346 (cons newText (eglot--range-region range 'markers))) 3347 (reverse edits))) 3348 (undo-amalgamate-change-group change-group) 3349 (progress-reporter-done reporter)))) 3350 3351 (defun eglot--apply-workspace-edit (wedit &optional confirm) 3352 "Apply the workspace edit WEDIT. If CONFIRM, ask user first." 3353 (eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit 3354 (let ((prepared 3355 (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits) 3356 (eglot--dbind ((VersionedTextDocumentIdentifier) uri version) 3357 textDocument 3358 (list (eglot--uri-to-path uri) edits version))) 3359 documentChanges))) 3360 (unless (and changes documentChanges) 3361 ;; We don't want double edits, and some servers send both 3362 ;; changes and documentChanges. This unless ensures that we 3363 ;; prefer documentChanges over changes. 3364 (cl-loop for (uri edits) on changes by #'cddr 3365 do (push (list (eglot--uri-to-path uri) edits) prepared))) 3366 (if (or confirm 3367 (cl-notevery #'find-buffer-visiting 3368 (mapcar #'car prepared))) 3369 (unless (y-or-n-p 3370 (format "[eglot] Server wants to edit:\n %s\n Proceed? " 3371 (mapconcat #'identity (mapcar #'car prepared) "\n "))) 3372 (jsonrpc-error "User canceled server edit"))) 3373 (cl-loop for edit in prepared 3374 for (path edits version) = edit 3375 do (with-current-buffer (find-file-noselect path) 3376 (eglot--apply-text-edits edits version)) 3377 finally (eldoc) (eglot--message "Edit successful!"))))) 3378 3379 (defun eglot-rename (newname) 3380 "Rename the current symbol to NEWNAME." 3381 (interactive 3382 (list (read-from-minibuffer 3383 (format "Rename `%s' to: " (or (thing-at-point 'symbol t) 3384 "unknown symbol")) 3385 nil nil nil nil 3386 (symbol-name (symbol-at-point))))) 3387 (eglot--server-capable-or-lose :renameProvider) 3388 (eglot--apply-workspace-edit 3389 (eglot--request (eglot--current-server-or-lose) 3390 :textDocument/rename `(,@(eglot--TextDocumentPositionParams) 3391 :newName ,newname)) 3392 current-prefix-arg)) 3393 3394 (defun eglot--region-bounds () 3395 "Region bounds if active, else bounds of things at point." 3396 (if (use-region-p) `(,(region-beginning) ,(region-end)) 3397 (let ((boftap (bounds-of-thing-at-point 'sexp))) 3398 (list (car boftap) (cdr boftap))))) 3399 3400 (defun eglot-code-actions (beg &optional end action-kind interactive) 3401 "Find LSP code actions of type ACTION-KIND between BEG and END. 3402 Interactively, offer to execute them. 3403 If ACTION-KIND is nil, consider all kinds of actions. 3404 Interactively, default BEG and END to region's bounds else BEG is 3405 point and END is nil, which results in a request for code actions 3406 at point. With prefix argument, prompt for ACTION-KIND." 3407 (interactive 3408 `(,@(eglot--region-bounds) 3409 ,(and current-prefix-arg 3410 (completing-read "[eglot] Action kind: " 3411 '("quickfix" "refactor.extract" "refactor.inline" 3412 "refactor.rewrite" "source.organizeImports"))) 3413 t)) 3414 (eglot--server-capable-or-lose :codeActionProvider) 3415 (let* ((server (eglot--current-server-or-lose)) 3416 (actions 3417 (eglot--request 3418 server 3419 :textDocument/codeAction 3420 (list :textDocument (eglot--TextDocumentIdentifier) 3421 :range (list :start (eglot--pos-to-lsp-position beg) 3422 :end (eglot--pos-to-lsp-position end)) 3423 :context 3424 `(:diagnostics 3425 [,@(cl-loop for diag in (flymake-diagnostics beg end) 3426 when (cdr (assoc 'eglot-lsp-diag 3427 (eglot--diag-data diag))) 3428 collect it)] 3429 ,@(when action-kind `(:only [,action-kind])))))) 3430 ;; Redo filtering, in case the `:only' didn't go through. 3431 (actions (cl-loop for a across actions 3432 when (or (not action-kind) 3433 (equal action-kind (plist-get a :kind))) 3434 collect a))) 3435 (if interactive 3436 (eglot--read-execute-code-action actions server action-kind) 3437 actions))) 3438 3439 (defalias 'eglot-code-actions-at-mouse (eglot--mouse-call 'eglot-code-actions) 3440 "Like `eglot-code-actions', but intended for mouse events.") 3441 3442 (defun eglot--read-execute-code-action (actions server &optional action-kind) 3443 "Helper for interactive calls to `eglot-code-actions'." 3444 (let* ((menu-items 3445 (or (cl-loop for a in actions 3446 collect (cons (plist-get a :title) a)) 3447 (apply #'eglot--error 3448 (if action-kind `("No \"%s\" code actions here" ,action-kind) 3449 `("No code actions here"))))) 3450 (preferred-action (cl-find-if 3451 (lambda (menu-item) 3452 (plist-get (cdr menu-item) :isPreferred)) 3453 menu-items)) 3454 (default-action (car (or preferred-action (car menu-items)))) 3455 (chosen (if (and action-kind (null (cadr menu-items))) 3456 (cdr (car menu-items)) 3457 (if (listp last-nonmenu-event) 3458 (x-popup-menu last-nonmenu-event `("Eglot code actions:" 3459 ("dummy" ,@menu-items))) 3460 (cdr (assoc (completing-read 3461 (format "[eglot] Pick an action (default %s): " 3462 default-action) 3463 menu-items nil t nil nil default-action) 3464 menu-items)))))) 3465 (eglot--dcase chosen 3466 (((Command) command arguments) 3467 (eglot-execute-command server (intern command) arguments)) 3468 (((CodeAction) edit command) 3469 (when edit (eglot--apply-workspace-edit edit)) 3470 (when command 3471 (eglot--dbind ((Command) command arguments) command 3472 (eglot-execute-command server (intern command) arguments))))))) 3473 3474 (defmacro eglot--code-action (name kind) 3475 "Define NAME to execute KIND code action." 3476 `(defun ,name (beg &optional end) 3477 ,(format "Execute `%s' code actions between BEG and END." kind) 3478 (interactive (eglot--region-bounds)) 3479 (eglot-code-actions beg end ,kind t))) 3480 3481 (eglot--code-action eglot-code-action-organize-imports "source.organizeImports") 3482 (eglot--code-action eglot-code-action-extract "refactor.extract") 3483 (eglot--code-action eglot-code-action-inline "refactor.inline") 3484 (eglot--code-action eglot-code-action-rewrite "refactor.rewrite") 3485 (eglot--code-action eglot-code-action-quickfix "quickfix") 3486 3487 3488 ;;; Dynamic registration 3489 ;;; 3490 (cl-defmethod eglot-register-capability 3491 (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers) 3492 "Handle dynamic registration of workspace/didChangeWatchedFiles." 3493 (eglot-unregister-capability server method id) 3494 (let* (success 3495 (globs (mapcar 3496 (eglot--lambda ((FileSystemWatcher) globPattern kind) 3497 (cons (eglot--glob-compile globPattern t t) 3498 ;; the default "7" means bitwise OR of 3499 ;; WatchKind.Create (1), WatchKind.Change 3500 ;; (2), WatchKind.Delete (4) 3501 (or kind 7))) 3502 watchers)) 3503 (dirs-to-watch 3504 (delete-dups (mapcar #'file-name-directory 3505 (project-files 3506 (eglot--project server)))))) 3507 (cl-labels 3508 ((handle-event 3509 (event) 3510 (pcase-let* ((`(,desc ,action ,file ,file1) event) 3511 (action-type (cl-case action 3512 (created 1) (changed 2) (deleted 3))) 3513 (action-bit (when action-type 3514 (ash 1 (1- action-type))))) 3515 (cond 3516 ((and (memq action '(created changed deleted)) 3517 (cl-loop for (glob . kind-bitmask) in globs 3518 thereis (and (> (logand kind-bitmask action-bit) 0) 3519 (funcall glob file)))) 3520 (jsonrpc-notify 3521 server :workspace/didChangeWatchedFiles 3522 `(:changes ,(vector `(:uri ,(eglot--path-to-uri file) 3523 :type ,action-type))))) 3524 ((eq action 'renamed) 3525 (handle-event `(,desc 'deleted ,file)) 3526 (handle-event `(,desc 'created ,file1))))))) 3527 (unwind-protect 3528 (progn 3529 (dolist (dir dirs-to-watch) 3530 (when (file-readable-p dir) 3531 (push (file-notify-add-watch dir '(change) #'handle-event) 3532 (gethash id (eglot--file-watches server))))) 3533 (setq 3534 success 3535 `(:message ,(format "OK, watching %s directories in %s watchers" 3536 (length dirs-to-watch) (length watchers))))) 3537 (unless success 3538 (eglot-unregister-capability server method id)))))) 3539 3540 (cl-defmethod eglot-unregister-capability 3541 (server (_method (eql workspace/didChangeWatchedFiles)) id) 3542 "Handle dynamic unregistration of workspace/didChangeWatchedFiles." 3543 (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches server))) 3544 (remhash id (eglot--file-watches server)) 3545 (list t "OK")) 3546 3547 3548 ;;; Glob heroics 3549 ;;; 3550 (defun eglot--glob-parse (glob) 3551 "Compute list of (STATE-SYM EMITTER-FN PATTERN)." 3552 (with-temp-buffer 3553 (save-excursion (insert glob)) 3554 (cl-loop 3555 with grammar = '((:** "\\*\\*/?" eglot--glob-emit-**) 3556 (:* "\\*" eglot--glob-emit-*) 3557 (:? "\\?" eglot--glob-emit-?) 3558 (:{} "{[^][*{}]+}" eglot--glob-emit-{}) 3559 (:range "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range) 3560 (:literal "[^][,*?{}]+" eglot--glob-emit-self)) 3561 until (eobp) 3562 collect (cl-loop 3563 for (_token regexp emitter) in grammar 3564 thereis (and (re-search-forward (concat "\\=" regexp) nil t) 3565 (list (cl-gensym "state-") emitter (match-string 0))) 3566 finally (error "Glob '%s' invalid at %s" (buffer-string) (point)))))) 3567 3568 (defun eglot--glob-compile (glob &optional byte-compile noerror) 3569 "Convert GLOB into Elisp function. Maybe BYTE-COMPILE it. 3570 If NOERROR, return predicate, else erroring function." 3571 (let* ((states (eglot--glob-parse glob)) 3572 (body `(with-current-buffer (get-buffer-create " *eglot-glob-matcher*") 3573 (erase-buffer) 3574 (save-excursion (insert string)) 3575 (cl-labels ,(cl-loop for (this that) on states 3576 for (self emit text) = this 3577 for next = (or (car that) 'eobp) 3578 collect (funcall emit text self next)) 3579 (or (,(caar states)) 3580 (error "Glob done but more unmatched text: '%s'" 3581 (buffer-substring (point) (point-max))))))) 3582 (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body)))) 3583 (if byte-compile (byte-compile form) form))) 3584 3585 (defun eglot--glob-emit-self (text self next) 3586 `(,self () (re-search-forward ,(concat "\\=" (regexp-quote text))) (,next))) 3587 3588 (defun eglot--glob-emit-** (_ self next) 3589 `(,self () (or (ignore-errors (save-excursion (,next))) 3590 (and (re-search-forward "\\=/?[^/]+/?") (,self))))) 3591 3592 (defun eglot--glob-emit-* (_ self next) 3593 `(,self () (re-search-forward "\\=[^/]") 3594 (or (ignore-errors (save-excursion (,next))) (,self)))) 3595 3596 (defun eglot--glob-emit-? (_ self next) 3597 `(,self () (re-search-forward "\\=[^/]") (,next))) 3598 3599 (defun eglot--glob-emit-{} (arg self next) 3600 (let ((alternatives (split-string (substring arg 1 (1- (length arg))) ","))) 3601 `(,self () 3602 (or (re-search-forward ,(concat "\\=" (regexp-opt alternatives)) nil t) 3603 (error "Failed matching any of %s" ',alternatives)) 3604 (,next)))) 3605 3606 (defun eglot--glob-emit-range (arg self next) 3607 (when (eq ?! (aref arg 1)) (aset arg 1 ?^)) 3608 `(,self () (re-search-forward ,(concat "\\=" arg)) (,next))) 3609 3610 3611 ;;; List connections mode 3612 3613 (define-derived-mode eglot-list-connections-mode tabulated-list-mode 3614 "" "Eglot mode for listing server connections 3615 \\{eglot-list-connections-mode-map}" 3616 (setq-local tabulated-list-format 3617 `[("Language server" 16) ("Project name" 16) ("Modes handled" 16)]) 3618 (tabulated-list-init-header)) 3619 3620 (defun eglot-list-connections () 3621 "List currently active Eglot connections." 3622 (interactive) 3623 (with-current-buffer 3624 (get-buffer-create "*EGLOT connections*") 3625 (let ((inhibit-read-only t)) 3626 (erase-buffer) 3627 (eglot-list-connections-mode) 3628 (setq-local tabulated-list-entries 3629 (mapcar 3630 (lambda (server) 3631 (list server 3632 `[,(or (plist-get (eglot--server-info server) :name) 3633 (jsonrpc-name server)) 3634 ,(eglot-project-nickname server) 3635 ,(mapconcat #'symbol-name 3636 (eglot--major-modes server) 3637 ", ")])) 3638 (cl-reduce #'append 3639 (hash-table-values eglot--servers-by-project)))) 3640 (revert-buffer) 3641 (pop-to-buffer (current-buffer))))) 3642 3643 3644 ;;; Inlay hints 3645 (defface eglot-inlay-hint-face '((t (:height 0.8 :inherit shadow))) 3646 "Face used for inlay hint overlays.") 3647 3648 (defface eglot-type-hint-face '((t (:inherit eglot-inlay-hint-face))) 3649 "Face used for type inlay hint overlays.") 3650 3651 (defface eglot-parameter-hint-face '((t (:inherit eglot-inlay-hint-face))) 3652 "Face used for parameter inlay hint overlays.") 3653 3654 (defvar-local eglot--outstanding-inlay-hints-region (cons nil nil) 3655 "Jit-lock-calculated (FROM . TO) region with potentially outdated hints") 3656 3657 (defvar-local eglot--outstanding-inlay-hints-last-region nil) 3658 3659 (defvar-local eglot--outstanding-inlay-regions-timer nil 3660 "Helper timer for `eglot--update-hints'") 3661 3662 (defun eglot--update-hints (from to) 3663 "Jit-lock function for Eglot inlay hints." 3664 (cl-symbol-macrolet ((region eglot--outstanding-inlay-hints-region) 3665 (last-region eglot--outstanding-inlay-hints-last-region) 3666 (timer eglot--outstanding-inlay-regions-timer)) 3667 (setcar region (min (or (car region) (point-max)) from)) 3668 (setcdr region (max (or (cdr region) (point-min)) to)) 3669 ;; HACK: We're relying on knowledge of jit-lock internals here. The 3670 ;; condition comparing `jit-lock-context-unfontify-pos' to 3671 ;; `point-max' is a heuristic for telling whether this call to 3672 ;; `jit-lock-functions' happens after `jit-lock-context-timer' has 3673 ;; just run. Only after this delay should we start the smoothing 3674 ;; timer that will eventually call `eglot--update-hints-1' with the 3675 ;; coalesced region. I wish we didn't need the timer, but sometimes 3676 ;; a lot of "non-contextual" calls come in all at once and do verify 3677 ;; the condition. Notice it is a 0 second timer though, so we're 3678 ;; not introducing any more delay over jit-lock's timers. 3679 (when (= jit-lock-context-unfontify-pos (point-max)) 3680 (if timer (cancel-timer timer)) 3681 (let ((buf (current-buffer))) 3682 (setq timer (run-at-time 3683 0 nil 3684 (lambda () 3685 (eglot--when-live-buffer buf 3686 ;; HACK: In some pathological situations 3687 ;; (Emacs's own coding.c, for example), 3688 ;; jit-lock is calling `eglot--update-hints' 3689 ;; repeatedly with same sequence of 3690 ;; arguments, which leads to 3691 ;; `eglot--update-hints-1' being called with 3692 ;; the same region repeatedly. This happens 3693 ;; even if the hint-painting code does 3694 ;; nothing else other than widen, narrow, 3695 ;; move point then restore these things. 3696 ;; Possible Emacs bug, but this fixes it. 3697 (unless (equal last-region region) 3698 (eglot--update-hints-1 (max (car region) (point-min)) 3699 (min (cdr region) (point-max))) 3700 (setq last-region region)) 3701 (setq region (cons nil nil) 3702 timer nil))))))))) 3703 3704 (defun eglot--update-hints-1 (from to) 3705 "Do most work for `eglot--update-hints', including LSP request." 3706 (let* ((buf (current-buffer)) 3707 (paint-hint 3708 (eglot--lambda ((InlayHint) position kind label paddingLeft paddingRight) 3709 (goto-char (eglot--lsp-position-to-point position)) 3710 (when (or (> (point) to) (< (point) from)) (cl-return)) 3711 (let* ((left-pad (and paddingLeft 3712 (not (eq paddingLeft :json-false)) 3713 (not (memq (char-before) '(32 9))) " ")) 3714 (right-pad (and paddingRight 3715 (not (eq paddingRight :json-false)) 3716 (not (memq (char-after) '(32 9))) " ")) 3717 (peg-after-p (eql kind 1))) 3718 (cl-labels 3719 ((make-ov () 3720 (if peg-after-p 3721 (make-overlay (point) (1+ (point)) nil t) 3722 (make-overlay (1- (point)) (point) nil nil nil))) 3723 (do-it (label lpad rpad firstp) 3724 (let* ((tweak-cursor-p (and firstp peg-after-p)) 3725 (ov (make-ov)) 3726 (text (concat lpad label rpad))) 3727 (when tweak-cursor-p (put-text-property 0 1 'cursor 1 text)) 3728 (overlay-put ov (if peg-after-p 'before-string 'after-string) 3729 (propertize 3730 text 3731 'face (pcase kind 3732 (1 'eglot-type-hint-face) 3733 (2 'eglot-parameter-hint-face) 3734 (_ 'eglot-inlay-hint-face)))) 3735 (overlay-put ov 'eglot--inlay-hint t) 3736 (overlay-put ov 'evaporate t) 3737 (overlay-put ov 'eglot--overlay t)))) 3738 (if (stringp label) (do-it label left-pad right-pad t) 3739 (cl-loop 3740 for i from 0 for ldetail across label 3741 do (eglot--dbind ((InlayHintLabelPart) value) ldetail 3742 (do-it value 3743 (and (zerop i) left-pad) 3744 (and (= i (1- (length label))) right-pad) 3745 (zerop i)))))))))) 3746 (jsonrpc-async-request 3747 (eglot--current-server-or-lose) 3748 :textDocument/inlayHint 3749 (list :textDocument (eglot--TextDocumentIdentifier) 3750 :range (list :start (eglot--pos-to-lsp-position from) 3751 :end (eglot--pos-to-lsp-position to))) 3752 :success-fn (lambda (hints) 3753 (eglot--when-live-buffer buf 3754 (eglot--widening 3755 ;; Overlays ending right at FROM with an 3756 ;; `after-string' property logically belong to 3757 ;; the (FROM TO) region. Likewise, such 3758 ;; overlays ending at TO don't logically belong 3759 ;; to it. 3760 (dolist (o (overlays-in (1- from) to)) 3761 (when (and (overlay-get o 'eglot--inlay-hint) 3762 (cond ((eq (overlay-end o) from) 3763 (overlay-get o 'after-string)) 3764 ((eq (overlay-end o) to) 3765 (overlay-get o 'before-string)) 3766 (t))) 3767 (delete-overlay o))) 3768 (mapc paint-hint hints)))) 3769 :deferred 'eglot--update-hints-1))) 3770 3771 (define-minor-mode eglot-inlay-hints-mode 3772 "Minor mode for annotating buffers with LSP server's inlay hints." 3773 :global nil 3774 (cond (eglot-inlay-hints-mode 3775 (if (eglot--server-capable :inlayHintProvider) 3776 (jit-lock-register #'eglot--update-hints 'contextual) 3777 (eglot-inlay-hints-mode -1))) 3778 (t 3779 (jit-lock-unregister #'eglot--update-hints) 3780 (remove-overlays nil nil 'eglot--inlay-hint t)))) 3781 3782 3783 ;;; Hacks 3784 ;;; 3785 ;; Emacs bug#56407, the optimal solution is in desktop.el, but that's 3786 ;; harder. For now, use `with-eval-after-load'. See also github#1183. 3787 (with-eval-after-load 'desktop 3788 (add-to-list 'desktop-minor-mode-handlers '(eglot--managed-mode . ignore)) 3789 (add-to-list 'desktop-minor-mode-handlers '(eglot-inlay-hints-mode . ignore))) 3790 3791 3792 ;;; Misc 3793 ;;; 3794 ;;;###autoload 3795 (progn 3796 (put 'eglot--debbugs-or-github-bug-uri 'bug-reference-url-format t) 3797 (defun eglot--debbugs-or-github-bug-uri () 3798 (format (if (string= (match-string 2) "github") 3799 "https://github.com/joaotavora/eglot/issues/%s" 3800 "https://debbugs.gnu.org/%s") 3801 (match-string 3)))) 3802 ;;; Obsolete 3803 ;;; 3804 3805 (make-obsolete-variable 'eglot--managed-mode-hook 3806 'eglot-managed-mode-hook "1.6") 3807 (provide 'eglot) 3808 3809 3810 ;; Local Variables: 3811 ;; bug-reference-bug-regexp: "\\(\\(github\\|bug\\)#\\([0-9]+\\)\\)" 3812 ;; bug-reference-url-format: eglot--debbugs-or-github-bug-uri 3813 ;; checkdoc-force-docstrings-flag: nil 3814 ;; End: 3815 3816 ;;; eglot.el ends here