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