eglot.el (143708B)
1 ;;; eglot.el --- Client for Language Server Protocol (LSP) servers -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2018-2022 Free Software Foundation, Inc. 4 5 ;; Version: 1.8 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.1") (jsonrpc "1.0.14") (flymake "1.0.9") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0")) 11 12 ;; This file is part of GNU Emacs. 13 14 ;; GNU Emacs is free software: you can redistribute it and/or modify 15 ;; it under the terms of the GNU General Public License as published by 16 ;; the Free Software Foundation, either version 3 of the License, or 17 ;; (at your option) any later version. 18 19 ;; GNU Emacs is distributed in the hope that it will be useful, 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 ;; GNU General Public License for more details. 23 24 ;; You should have received a copy of the GNU General Public License 25 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 26 27 ;;; Commentary: 28 29 ;; Simply M-x eglot should be enough to get you started, but here's a 30 ;; little info (see the accompanying README.md or the URL for more). 31 ;; 32 ;; M-x eglot starts a server via a shell-command guessed from 33 ;; `eglot-server-programs', using the current major-mode (for whatever 34 ;; language you're programming in) as a hint. If it can't guess, it 35 ;; prompts you in the mini-buffer for these things. Actually, the 36 ;; server needen't be locally started: you can connect to a running 37 ;; server via TCP by entering a <host:port> syntax. 38 ;; 39 ;; Anyway, if the connection is successful, you should see an `eglot' 40 ;; indicator pop up in your mode-line. More importantly, this means 41 ;; current *and future* file buffers of that major mode *inside your 42 ;; current project* automatically become \"managed\" by the LSP 43 ;; server, i.e. information about their contents is exchanged 44 ;; periodically to provide enhanced code analysis via 45 ;; `xref-find-definitions', `flymake-mode', `eldoc-mode', 46 ;; `completion-at-point', among others. 47 ;; 48 ;; To "unmanage" these buffers, shutdown the server with M-x 49 ;; eglot-shutdown. 50 ;; 51 ;; You can also do: 52 ;; 53 ;; (add-hook 'foo-mode-hook 'eglot-ensure) 54 ;; 55 ;; To attempt to start an eglot session automatically every time a 56 ;; foo-mode buffer is visited. 57 ;; 58 ;;; Code: 59 60 (require 'json) 61 (require 'imenu) 62 (require 'cl-lib) 63 (require 'project) 64 (require 'seq) 65 (require 'url-parse) 66 (require 'url-util) 67 (require 'pcase) 68 (require 'compile) ; for some faces 69 (require 'warnings) 70 (require 'flymake) 71 (require 'xref) 72 (eval-when-compile 73 (require 'subr-x)) 74 (require 'jsonrpc) 75 (require 'filenotify) 76 (require 'ert) 77 (require 'array) 78 79 ;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are 80 ;; using the latest version from GNU Elpa when we load eglot.el. Use an 81 ;; heuristic to see if we need to `load' it in Emacs < 28. 82 (if (and (< emacs-major-version 28) 83 (not (boundp 'eldoc-documentation-strategy))) 84 (load "eldoc") 85 (require 'eldoc)) 86 87 ;; forward-declare, but don't require (Emacs 28 doesn't seem to care) 88 (defvar markdown-fontify-code-blocks-natively) 89 (defvar company-backends) 90 (defvar company-tooltip-align-annotations) 91 92 93 94 ;;; User tweakable stuff 95 (defgroup eglot nil 96 "Interaction with Language Server Protocol servers." 97 :prefix "eglot-" 98 :group 'applications) 99 100 (defun eglot-alternatives (alternatives) 101 "Compute server-choosing function for `eglot-server-programs'. 102 Each element of ALTERNATIVES is a string PROGRAM or a list of 103 strings (PROGRAM ARGS...) where program names an LSP server 104 program to start with ARGS. Returns a function of one argument. 105 When invoked, that function will return a list (ABSPATH ARGS), 106 where ABSPATH is the absolute path of the PROGRAM that was 107 chosen (interactively or automatically)." 108 (lambda (&optional interactive) 109 ;; JT@2021-06-13: This function is way more complicated than it 110 ;; could be because it accounts for the fact that 111 ;; `eglot--executable-find' may take much longer to execute on 112 ;; remote files. 113 (let* ((listified (cl-loop for a in alternatives 114 collect (if (listp a) a (list a)))) 115 (err (lambda () 116 (error "None of '%s' are valid executables" 117 (mapconcat #'car listified ", "))))) 118 (cond (interactive 119 (let* ((augmented (mapcar (lambda (a) 120 (let ((found (eglot--executable-find 121 (car a) t))) 122 (and found 123 (cons (car a) (cons found (cdr a)))))) 124 listified)) 125 (available (remove nil augmented))) 126 (cond ((cdr available) 127 (cdr (assoc 128 (completing-read 129 "[eglot] More than one server executable available:" 130 (mapcar #'car available) 131 nil t nil nil (car (car available))) 132 available #'equal))) 133 ((cdr (car available))) 134 (t 135 ;; Don't error when used interactively, let the 136 ;; Eglot prompt the user for alternative (github#719) 137 nil)))) 138 (t 139 (cl-loop for (p . args) in listified 140 for probe = (eglot--executable-find p t) 141 when probe return (cons probe args) 142 finally (funcall err))))))) 143 144 (defvar eglot-server-programs `((rust-mode . (eglot-rls "rls")) 145 (cmake-mode . ("cmake-language-server")) 146 (vimrc-mode . ("vim-language-server" "--stdio")) 147 (python-mode 148 . ,(eglot-alternatives 149 '("pylsp" "pyls" ("pyright-langserver" "--stdio")))) 150 ((js-mode typescript-mode) 151 . ("typescript-language-server" "--stdio")) 152 (sh-mode . ("bash-language-server" "start")) 153 ((php-mode phps-mode) 154 . ("php" "vendor/felixfbecker/\ 155 language-server/bin/php-language-server.php")) 156 ((c++-mode c-mode) . ,(eglot-alternatives 157 '("clangd" "ccls"))) 158 (((caml-mode :language-id "ocaml") 159 (tuareg-mode :language-id "ocaml") reason-mode) 160 . ("ocamllsp")) 161 (ruby-mode 162 . ("solargraph" "socket" "--port" :autoport)) 163 (haskell-mode 164 . ("haskell-language-server-wrapper" "--lsp")) 165 (elm-mode . ("elm-language-server")) 166 (mint-mode . ("mint" "ls")) 167 (kotlin-mode . ("kotlin-language-server")) 168 (go-mode . ("gopls")) 169 ((R-mode ess-r-mode) . ("R" "--slave" "-e" 170 "languageserver::run()")) 171 (java-mode . eglot--eclipse-jdt-contact) 172 (dart-mode . ("dart_language_server")) 173 (elixir-mode . ("language_server.sh")) 174 (ada-mode . ("ada_language_server")) 175 (scala-mode . ("metals-emacs")) 176 ((tex-mode context-mode texinfo-mode bibtex-mode) 177 . ("digestif")) 178 (erlang-mode . ("erlang_ls" "--transport" "stdio")) 179 (yaml-mode . ("yaml-language-server" "--stdio")) 180 (nix-mode . ("rnix-lsp")) 181 (gdscript-mode . ("localhost" 6008)) 182 ((fortran-mode f90-mode) . ("fortls")) 183 (lua-mode . ("lua-lsp")) 184 (zig-mode . ("zls")) 185 (css-mode . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") ("css-languageserver" "--stdio")))) 186 (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) 187 (json-mode . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") ("json-languageserver" "--stdio")))) 188 (dockerfile-mode . ("docker-langserver" "--stdio"))) 189 "How the command `eglot' guesses the server to start. 190 An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE 191 identifies the buffers that are to be managed by a specific 192 language server. The associated CONTACT specifies how to connect 193 to a server for those buffers. 194 195 MAJOR-MODE can be: 196 197 * In the most common case, a symbol such as `c-mode'; 198 199 * A list (MAJOR-MODE-SYMBOL :LANGUAGE-ID ID) where 200 MAJOR-MODE-SYMBOL is the aforementioned symbol and ID is a 201 string identifying the language to the server; 202 203 * A list combining the previous two alternatives, meaning 204 multiple major modes will be associated with a single server 205 program. 206 207 CONTACT can be: 208 209 * In the most common case, a list of strings (PROGRAM [ARGS...]). 210 PROGRAM is called with ARGS and is expected to serve LSP requests 211 over the standard input/output channels. 212 213 * A list (HOST PORT [TCP-ARGS...]) where HOST is a string and 214 PORT is a positive integer for connecting to a server via TCP. 215 Remaining ARGS are passed to `open-network-stream' for 216 upgrading the connection with encryption or other capabilities. 217 218 * A list (PROGRAM [ARGS...] :autoport [MOREARGS...]), whereupon a 219 combination of the two previous options is used. First, an 220 attempt is made to find an available server port, then PROGRAM 221 is launched with ARGS; the `:autoport' keyword substituted for 222 that number; and MOREARGS. Eglot then attempts to establish a 223 TCP connection to that port number on the localhost. 224 225 * A cons (CLASS-NAME . INITARGS) where CLASS-NAME is a symbol 226 designating a subclass of `eglot-lsp-server', for representing 227 experimental LSP servers. INITARGS is a keyword-value plist 228 used to initialize the object of CLASS-NAME, or a plain list 229 interpreted as the previous descriptions of CONTACT. In the 230 latter case that plain list is used to produce a plist with a 231 suitable :PROCESS initarg to CLASS-NAME. The class 232 `eglot-lsp-server' descends from `jsonrpc-process-connection', 233 which you should see for the semantics of the mandatory 234 :PROCESS argument. 235 236 * A function of a single argument producing any of the above 237 values for CONTACT. The argument's value is non-nil if the 238 connection was requested interactively (e.g. from the `eglot' 239 command), and nil if it wasn't (e.g. from `eglot-ensure'). If 240 the call is interactive, the function can ask the user for 241 hints on finding the required programs, etc. Otherwise, it 242 should not ask the user for any input, and return nil or signal 243 an error if it can't produce a valid CONTACT.") 244 245 (defface eglot-highlight-symbol-face 246 '((t (:inherit bold))) 247 "Face used to highlight the symbol at point.") 248 249 (defface eglot-mode-line 250 '((t (:inherit font-lock-constant-face :weight bold))) 251 "Face for package-name in EGLOT's mode line.") 252 253 (defcustom eglot-autoreconnect 3 254 "Control ability to reconnect automatically to the LSP server. 255 If t, always reconnect automatically (not recommended). If nil, 256 never reconnect automatically after unexpected server shutdowns, 257 crashes or network failures. A positive integer number says to 258 only autoreconnect if the previous successful connection attempt 259 lasted more than that many seconds." 260 :type '(choice (boolean :tag "Whether to inhibit autoreconnection") 261 (integer :tag "Number of seconds"))) 262 263 (defcustom eglot-connect-timeout 30 264 "Number of seconds before timing out LSP connection attempts. 265 If nil, never time out." 266 :type 'number) 267 268 (defcustom eglot-sync-connect 3 269 "Control blocking of LSP connection attempts. 270 If t, block for `eglot-connect-timeout' seconds. A positive 271 integer number means block for that many seconds, and then wait 272 for the connection in the background. nil has the same meaning 273 as 0, i.e. don't block at all." 274 :type '(choice (boolean :tag "Whether to inhibit autoreconnection") 275 (integer :tag "Number of seconds"))) 276 277 (defcustom eglot-autoshutdown nil 278 "If non-nil, shut down server after killing last managed buffer." 279 :type 'boolean) 280 281 (defcustom eglot-send-changes-idle-time 0.5 282 "Don't tell server of changes before Emacs's been idle for this many seconds." 283 :type 'number) 284 285 (defcustom eglot-events-buffer-size 2000000 286 "Control the size of the Eglot events buffer. 287 If a number, don't let the buffer grow larger than that many 288 characters. If 0, don't use an event's buffer at all. If nil, 289 let the buffer grow forever." 290 :type '(choice (const :tag "No limit" nil) 291 (integer :tag "Number of characters"))) 292 293 (defcustom eglot-confirm-server-initiated-edits 'confirm 294 "Non-nil if server-initiated edits should be confirmed with user." 295 :type '(choice (const :tag "Don't show confirmation prompt" nil) 296 (symbol :tag "Show confirmation prompt" 'confirm))) 297 298 (defcustom eglot-extend-to-xref nil 299 "If non-nil, activate Eglot in cross-referenced non-project files." 300 :type 'boolean) 301 302 (defvar eglot-withhold-process-id nil 303 "If non-nil, Eglot will not send the Emacs process id to the language server. 304 This can be useful when using docker to run a language server.") 305 306 ;; Customizable via `completion-category-overrides'. 307 (when (assoc 'flex completion-styles-alist) 308 (add-to-list 'completion-category-defaults '(eglot (styles flex basic)))) 309 310 311 ;;; Constants 312 ;;; 313 (defconst eglot--symbol-kind-names 314 `((1 . "File") (2 . "Module") 315 (3 . "Namespace") (4 . "Package") (5 . "Class") 316 (6 . "Method") (7 . "Property") (8 . "Field") 317 (9 . "Constructor") (10 . "Enum") (11 . "Interface") 318 (12 . "Function") (13 . "Variable") (14 . "Constant") 319 (15 . "String") (16 . "Number") (17 . "Boolean") 320 (18 . "Array") (19 . "Object") (20 . "Key") 321 (21 . "Null") (22 . "EnumMember") (23 . "Struct") 322 (24 . "Event") (25 . "Operator") (26 . "TypeParameter"))) 323 324 (defconst eglot--kind-names 325 `((1 . "Text") (2 . "Method") (3 . "Function") (4 . "Constructor") 326 (5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface") 327 (9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value") 328 (13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color") 329 (17 . "File") (18 . "Reference") (19 . "Folder") (20 . "EnumMember") 330 (21 . "Constant") (22 . "Struct") (23 . "Event") (24 . "Operator") 331 (25 . "TypeParameter"))) 332 333 (defconst eglot--{} (make-hash-table) "The empty JSON object.") 334 335 (defun eglot--executable-find (command &optional remote) 336 "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26." 337 (if (>= emacs-major-version 27) (executable-find command remote) 338 (executable-find command))) 339 340 341 ;;; Message verification helpers 342 ;;; 343 (eval-and-compile 344 (defvar eglot--lsp-interface-alist 345 `( 346 (CodeAction (:title) (:kind :diagnostics :edit :command :isPreferred)) 347 (ConfigurationItem () (:scopeUri :section)) 348 (Command ((:title . string) (:command . string)) (:arguments)) 349 (CompletionItem (:label) 350 (:kind :detail :documentation :deprecated :preselect 351 :sortText :filterText :insertText :insertTextFormat 352 :textEdit :additionalTextEdits :commitCharacters 353 :command :data)) 354 (Diagnostic (:range :message) (:severity :code :source :relatedInformation :codeDescription)) 355 (DocumentHighlight (:range) (:kind)) 356 (FileSystemWatcher (:globPattern) (:kind)) 357 (Hover (:contents) (:range)) 358 (InitializeResult (:capabilities) (:serverInfo)) 359 (Location (:uri :range)) 360 (LocationLink (:targetUri :targetRange :targetSelectionRange) (:originSelectionRange)) 361 (LogMessageParams (:type :message)) 362 (MarkupContent (:kind :value)) 363 (ParameterInformation (:label) (:documentation)) 364 (Position (:line :character)) 365 (Range (:start :end)) 366 (Registration (:id :method) (:registerOptions)) 367 (ResponseError (:code :message) (:data)) 368 (ShowMessageParams (:type :message)) 369 (ShowMessageRequestParams (:type :message) (:actions)) 370 (SignatureHelp (:signatures) (:activeSignature :activeParameter)) 371 (SignatureInformation (:label) (:documentation :parameters :activeParameter)) 372 (SymbolInformation (:name :kind :location) 373 (:deprecated :containerName)) 374 (DocumentSymbol (:name :range :selectionRange :kind) 375 ;; `:containerName' isn't really allowed , but 376 ;; it simplifies the impl of `eglot-imenu'. 377 (:detail :deprecated :children :containerName)) 378 (TextDocumentEdit (:textDocument :edits) ()) 379 (TextEdit (:range :newText)) 380 (VersionedTextDocumentIdentifier (:uri :version) ()) 381 (WorkspaceEdit () (:changes :documentChanges)) 382 ) 383 "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces. 384 385 INTERFACE-NAME is a symbol designated by the spec as 386 \"interface\". INTERFACE is a list (REQUIRED OPTIONAL) where 387 REQUIRED and OPTIONAL are lists of KEYWORD designating field 388 names that must be, or may be, respectively, present in a message 389 adhering to that interface. KEY can be a keyword or a cons (SYM 390 TYPE), where type is used by `cl-typep' to check types at 391 runtime. 392 393 Here's what an element of this alist might look like: 394 395 (Command ((:title . string) (:command . string)) (:arguments))")) 396 397 (eval-and-compile 398 (defvar eglot-strict-mode (if load-file-name '() 399 '(disallow-non-standard-keys 400 ;; Uncomment these two for fun at 401 ;; compile-time or with flymake-mode. 402 ;; 403 ;; enforce-required-keys 404 ;; enforce-optional-keys 405 )) 406 "How strictly to check LSP interfaces at compile- and run-time. 407 408 Value is a list of symbols (if the list is empty, no checks are 409 performed). 410 411 If the symbol `disallow-non-standard-keys' is present, an error 412 is raised if any extraneous fields are sent by the server. At 413 compile-time, a warning is raised if a destructuring spec 414 includes such a field. 415 416 If the symbol `enforce-required-keys' is present, an error is 417 raised if any required fields are missing from the message sent 418 from the server. At compile-time, a warning is raised if a 419 destructuring spec doesn't use such a field. 420 421 If the symbol `enforce-optional-keys' is present, nothing special 422 happens at run-time. At compile-time, a warning is raised if a 423 destructuring spec doesn't use all optional fields. 424 425 If the symbol `disallow-unknown-methods' is present, Eglot warns 426 on unknown notifications and errors on unknown requests. 427 ")) 428 429 (defun eglot--plist-keys (plist) 430 (cl-loop for (k _v) on plist by #'cddr collect k)) 431 432 (cl-defun eglot--check-object (interface-name 433 object 434 &optional 435 (enforce-required t) 436 (disallow-non-standard t) 437 (check-types t)) 438 "Check that OBJECT conforms to INTERFACE. Error otherwise." 439 (cl-destructuring-bind 440 (&key types required-keys optional-keys &allow-other-keys) 441 (eglot--interface interface-name) 442 (when-let ((missing (and enforce-required 443 (cl-set-difference required-keys 444 (eglot--plist-keys object))))) 445 (eglot--error "A `%s' must have %s" interface-name missing)) 446 (when-let ((excess (and disallow-non-standard 447 (cl-set-difference 448 (eglot--plist-keys object) 449 (append required-keys optional-keys))))) 450 (eglot--error "A `%s' mustn't have %s" interface-name excess)) 451 (when check-types 452 (cl-loop 453 for (k v) on object by #'cddr 454 for type = (or (cdr (assoc k types)) t) ;; FIXME: enforce nil type? 455 unless (cl-typep v type) 456 do (eglot--error "A `%s' must have a %s as %s, but has %s" 457 interface-name ))) 458 t)) 459 460 (eval-and-compile 461 (defun eglot--keywordize-vars (vars) 462 (mapcar (lambda (var) (intern (format ":%s" var))) vars)) 463 464 (defun eglot--ensure-type (k) (if (consp k) k (cons k t))) 465 466 (defun eglot--interface (interface-name) 467 (let* ((interface (assoc interface-name eglot--lsp-interface-alist)) 468 (required (mapcar #'eglot--ensure-type (car (cdr interface)))) 469 (optional (mapcar #'eglot--ensure-type (cadr (cdr interface))))) 470 (list :types (append required optional) 471 :required-keys (mapcar #'car required) 472 :optional-keys (mapcar #'car optional)))) 473 474 (defun eglot--check-dspec (interface-name dspec) 475 "Check destructuring spec DSPEC against INTERFACE-NAME." 476 (cl-destructuring-bind (&key required-keys optional-keys &allow-other-keys) 477 (eglot--interface interface-name) 478 (cond ((or required-keys optional-keys) 479 (let ((too-many 480 (and 481 (memq 'disallow-non-standard-keys eglot-strict-mode) 482 (cl-set-difference 483 (eglot--keywordize-vars dspec) 484 (append required-keys optional-keys)))) 485 (ignored-required 486 (and 487 (memq 'enforce-required-keys eglot-strict-mode) 488 (cl-set-difference 489 required-keys (eglot--keywordize-vars dspec)))) 490 (missing-out 491 (and 492 (memq 'enforce-optional-keys eglot-strict-mode) 493 (cl-set-difference 494 optional-keys (eglot--keywordize-vars dspec))))) 495 (when too-many (byte-compile-warn 496 "Destructuring for %s has extraneous %s" 497 interface-name too-many)) 498 (when ignored-required (byte-compile-warn 499 "Destructuring for %s ignores required %s" 500 interface-name ignored-required)) 501 (when missing-out (byte-compile-warn 502 "Destructuring for %s is missing out on %s" 503 interface-name missing-out)))) 504 (t 505 (byte-compile-warn "Unknown LSP interface %s" interface-name)))))) 506 507 (cl-defmacro eglot--dbind (vars object &body body) 508 "Destructure OBJECT, binding VARS in BODY. 509 VARS is ([(INTERFACE)] SYMS...) 510 Honour `eglot-strict-mode'." 511 (declare (indent 2) (debug (sexp sexp &rest form))) 512 (let ((interface-name (if (consp (car vars)) 513 (car (pop vars)))) 514 (object-once (make-symbol "object-once")) 515 (fn-once (make-symbol "fn-once"))) 516 (cond (interface-name 517 (eglot--check-dspec interface-name vars) 518 `(let ((,object-once ,object)) 519 (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once 520 (eglot--check-object ',interface-name ,object-once 521 (memq 'enforce-required-keys eglot-strict-mode) 522 (memq 'disallow-non-standard-keys eglot-strict-mode) 523 (memq 'check-types eglot-strict-mode)) 524 ,@body))) 525 (t 526 `(let ((,object-once ,object) 527 (,fn-once (lambda (,@vars) ,@body))) 528 (if (memq 'disallow-non-standard-keys eglot-strict-mode) 529 (cl-destructuring-bind (&key ,@vars) ,object-once 530 (funcall ,fn-once ,@vars)) 531 (cl-destructuring-bind (&key ,@vars &allow-other-keys) ,object-once 532 (funcall ,fn-once ,@vars)))))))) 533 534 535 (cl-defmacro eglot--lambda (cl-lambda-list &body body) 536 "Function of args CL-LAMBDA-LIST for processing INTERFACE objects. 537 Honour `eglot-strict-mode'." 538 (declare (indent 1) (debug (sexp &rest form))) 539 (let ((e (cl-gensym "jsonrpc-lambda-elem"))) 540 `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body)))) 541 542 (cl-defmacro eglot--dcase (obj &rest clauses) 543 "Like `pcase', but for the LSP object OBJ. 544 CLAUSES is a list (DESTRUCTURE FORMS...) where DESTRUCTURE is 545 treated as in `eglot-dbind'." 546 (declare (indent 1) (debug (sexp &rest (sexp &rest form)))) 547 (let ((obj-once (make-symbol "obj-once"))) 548 `(let ((,obj-once ,obj)) 549 (cond 550 ,@(cl-loop 551 for (vars . body) in clauses 552 for vars-as-keywords = (eglot--keywordize-vars vars) 553 for interface-name = (if (consp (car vars)) 554 (car (pop vars))) 555 for condition = 556 (cond (interface-name 557 (eglot--check-dspec interface-name vars) 558 ;; In this mode, in runtime, we assume 559 ;; `eglot-strict-mode' is partially on, otherwise we 560 ;; can't disambiguate between certain types. 561 `(ignore-errors 562 (eglot--check-object 563 ',interface-name ,obj-once 564 t 565 (memq 'disallow-non-standard-keys eglot-strict-mode) 566 t))) 567 (t 568 ;; In this interface-less mode we don't check 569 ;; `eglot-strict-mode' at all: just check that the object 570 ;; has all the keys the user wants to destructure. 571 `(null (cl-set-difference 572 ',vars-as-keywords 573 (eglot--plist-keys ,obj-once))))) 574 collect `(,condition 575 (cl-destructuring-bind (&key ,@vars &allow-other-keys) 576 ,obj-once 577 ,@body))) 578 (t 579 (eglot--error "%S didn't match any of %S" 580 ,obj-once 581 ',(mapcar #'car clauses))))))) 582 583 584 ;;; API (WORK-IN-PROGRESS!) 585 ;;; 586 (cl-defmacro eglot--when-live-buffer (buf &rest body) 587 "Check BUF live, then do BODY in it." (declare (indent 1) (debug t)) 588 (let ((b (cl-gensym))) 589 `(let ((,b ,buf)) (if (buffer-live-p ,b) (with-current-buffer ,b ,@body))))) 590 591 (cl-defmacro eglot--when-buffer-window (buf &body body) 592 "Check BUF showing somewhere, then do BODY in it." (declare (indent 1) (debug t)) 593 (let ((b (cl-gensym))) 594 `(let ((,b ,buf)) 595 ;;notice the exception when testing with `ert' 596 (when (or (get-buffer-window ,b) (ert-running-test)) 597 (with-current-buffer ,b ,@body))))) 598 599 (cl-defmacro eglot--widening (&rest body) 600 "Save excursion and restriction. Widen. Then run BODY." (declare (debug t)) 601 `(save-excursion (save-restriction (widen) ,@body))) 602 603 (cl-defgeneric eglot-handle-request (server method &rest params) 604 "Handle SERVER's METHOD request with PARAMS.") 605 606 (cl-defgeneric eglot-handle-notification (server method &rest params) 607 "Handle SERVER's METHOD notification with PARAMS.") 608 609 (cl-defgeneric eglot-execute-command (server command arguments) 610 "Ask SERVER to execute COMMAND with ARGUMENTS.") 611 612 (cl-defgeneric eglot-initialization-options (server) 613 "JSON object to send under `initializationOptions'." 614 (:method (_s) eglot--{})) ; blank default 615 616 (cl-defgeneric eglot-register-capability (server method id &rest params) 617 "Ask SERVER to register capability METHOD marked with ID." 618 (:method 619 (_s method _id &rest _params) 620 (eglot--warn "Server tried to register unsupported capability `%s'" 621 method))) 622 623 (cl-defgeneric eglot-unregister-capability (server method id &rest params) 624 "Ask SERVER to register capability METHOD marked with ID." 625 (:method 626 (_s method _id &rest _params) 627 (eglot--warn "Server tried to unregister unsupported capability `%s'" 628 method))) 629 630 (cl-defgeneric eglot-client-capabilities (server) 631 "What the EGLOT LSP client supports for SERVER." 632 (:method (_s) 633 (list 634 :workspace (list 635 :applyEdit t 636 :executeCommand `(:dynamicRegistration :json-false) 637 :workspaceEdit `(:documentChanges :json-false) 638 :didChangeWatchedFiles `(:dynamicRegistration t) 639 :symbol `(:dynamicRegistration :json-false) 640 :configuration t) 641 :textDocument 642 (list 643 :synchronization (list 644 :dynamicRegistration :json-false 645 :willSave t :willSaveWaitUntil t :didSave t) 646 :completion (list :dynamicRegistration :json-false 647 :completionItem 648 `(:snippetSupport 649 ,(if (eglot--snippet-expansion-fn) 650 t 651 :json-false)) 652 :contextSupport t) 653 :hover (list :dynamicRegistration :json-false 654 :contentFormat 655 (if (fboundp 'gfm-view-mode) 656 ["markdown" "plaintext"] 657 ["plaintext"])) 658 :signatureHelp (list :dynamicRegistration :json-false 659 :signatureInformation 660 `(:parameterInformation 661 (:labelOffsetSupport t) 662 :activeParameterSupport t)) 663 :references `(:dynamicRegistration :json-false) 664 :definition (list :dynamicRegistration :json-false 665 :linkSupport t) 666 :declaration (list :dynamicRegistration :json-false 667 :linkSupport t) 668 :implementation (list :dynamicRegistration :json-false 669 :linkSupport t) 670 :typeDefinition (list :dynamicRegistration :json-false 671 :linkSupport t) 672 :documentSymbol (list 673 :dynamicRegistration :json-false 674 :hierarchicalDocumentSymbolSupport t 675 :symbolKind `(:valueSet 676 [,@(mapcar 677 #'car eglot--symbol-kind-names)])) 678 :documentHighlight `(:dynamicRegistration :json-false) 679 :codeAction (list 680 :dynamicRegistration :json-false 681 :codeActionLiteralSupport 682 '(:codeActionKind 683 (:valueSet 684 ["quickfix" 685 "refactor" "refactor.extract" 686 "refactor.inline" "refactor.rewrite" 687 "source" "source.organizeImports"])) 688 :isPreferredSupport t) 689 :formatting `(:dynamicRegistration :json-false) 690 :rangeFormatting `(:dynamicRegistration :json-false) 691 :rename `(:dynamicRegistration :json-false) 692 :publishDiagnostics (list :relatedInformation :json-false 693 ;; TODO: We can support :codeDescription after 694 ;; adding an appropriate UI to 695 ;; Flymake. 696 :codeDescriptionSupport :json-false)) 697 :experimental eglot--{}))) 698 699 (defclass eglot-lsp-server (jsonrpc-process-connection) 700 ((project-nickname 701 :documentation "Short nickname for the associated project." 702 :accessor eglot--project-nickname 703 :reader eglot-project-nickname) 704 (major-mode 705 :documentation "Major mode symbol." 706 :accessor eglot--major-mode) 707 (language-id 708 :documentation "Language ID string for the mode." 709 :accessor eglot--language-id) 710 (capabilities 711 :documentation "JSON object containing server capabilities." 712 :accessor eglot--capabilities) 713 (server-info 714 :documentation "JSON object containing server info." 715 :accessor eglot--server-info) 716 (shutdown-requested 717 :documentation "Flag set when server is shutting down." 718 :accessor eglot--shutdown-requested) 719 (project 720 :documentation "Project associated with server." 721 :accessor eglot--project) 722 (spinner 723 :documentation "List (ID DOING-WHAT DONE-P) representing server progress." 724 :initform `(nil nil t) :accessor eglot--spinner) 725 (inhibit-autoreconnect 726 :initform t 727 :documentation "Generalized boolean inhibiting auto-reconnection if true." 728 :accessor eglot--inhibit-autoreconnect) 729 (file-watches 730 :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'." 731 :initform (make-hash-table :test #'equal) :accessor eglot--file-watches) 732 (managed-buffers 733 :documentation "List of buffers managed by server." 734 :accessor eglot--managed-buffers) 735 (saved-initargs 736 :documentation "Saved initargs for reconnection purposes." 737 :accessor eglot--saved-initargs) 738 (inferior-process 739 :documentation "Server subprocess started automatically." 740 :accessor eglot--inferior-process)) 741 :documentation 742 "Represents a server. Wraps a process for LSP communication.") 743 744 745 ;;; Process management 746 (defvar eglot--servers-by-project (make-hash-table :test #'equal) 747 "Keys are projects. Values are lists of processes.") 748 749 (defun eglot-shutdown (server &optional _interactive timeout preserve-buffers) 750 "Politely ask SERVER to quit. 751 Interactively, read SERVER from the minibuffer unless there is 752 only one and it's managing the current buffer. 753 754 Forcefully quit it if it doesn't respond within TIMEOUT seconds. 755 TIMEOUT defaults to 1.5 seconds. Don't leave this function with 756 the server still running. 757 758 If PRESERVE-BUFFERS is non-nil (interactively, when called with a 759 prefix argument), do not kill events and output buffers of 760 SERVER." 761 (interactive (list (eglot--read-server "Shutdown which server" 762 (eglot-current-server)) 763 t nil current-prefix-arg)) 764 (eglot--message "Asking %s politely to terminate" (jsonrpc-name server)) 765 (unwind-protect 766 (progn 767 (setf (eglot--shutdown-requested server) t) 768 (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5)) 769 (jsonrpc-notify server :exit nil)) 770 ;; Now ask jsonrpc.el to shut down the server. 771 (jsonrpc-shutdown server (not preserve-buffers)) 772 (unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server))))) 773 774 (defun eglot-shutdown-all (&optional preserve-buffers) 775 "Politely ask all language servers to quit, in order. 776 PRESERVE-BUFFERS as in `eglot-shutdown', which see." 777 (interactive (list current-prefix-arg)) 778 (cl-loop for ss being the hash-values of eglot--servers-by-project 779 do (cl-loop for s in ss do (eglot-shutdown s nil preserve-buffers)))) 780 781 (defun eglot--on-shutdown (server) 782 "Called by jsonrpc.el when SERVER is already dead." 783 ;; Turn off `eglot--managed-mode' where appropriate. 784 (dolist (buffer (eglot--managed-buffers server)) 785 (let (;; Avoid duplicate shutdowns (github#389) 786 (eglot-autoshutdown nil)) 787 (eglot--when-live-buffer buffer (eglot--managed-mode-off)))) 788 ;; Kill any expensive watches 789 (maphash (lambda (_id watches) 790 (mapcar #'file-notify-rm-watch watches)) 791 (eglot--file-watches server)) 792 ;; Kill any autostarted inferior processes 793 (when-let (proc (eglot--inferior-process server)) 794 (delete-process proc)) 795 ;; Sever the project/server relationship for `server' 796 (setf (gethash (eglot--project server) eglot--servers-by-project) 797 (delq server 798 (gethash (eglot--project server) eglot--servers-by-project))) 799 (cond ((eglot--shutdown-requested server) 800 t) 801 ((not (eglot--inhibit-autoreconnect server)) 802 (eglot--warn "Reconnecting after unexpected server exit.") 803 (eglot-reconnect server)) 804 ((timerp (eglot--inhibit-autoreconnect server)) 805 (eglot--warn "Not auto-reconnecting, last one didn't last long.")))) 806 807 (defun eglot--all-major-modes () 808 "Return all known major modes." 809 (let ((retval)) 810 (mapatoms (lambda (sym) 811 (when (plist-member (symbol-plist sym) 'derived-mode-parent) 812 (push sym retval)))) 813 retval)) 814 815 (defvar eglot--command-history nil 816 "History of CONTACT arguments to `eglot'.") 817 818 (defun eglot--lookup-mode (mode) 819 "Lookup `eglot-server-programs' for MODE. 820 Return (LANGUAGE-ID . CONTACT-PROXY). If not specified, 821 LANGUAGE-ID is determined from MODE." 822 (cl-loop 823 for (modes . contact) in eglot-server-programs 824 thereis (cl-some 825 (lambda (spec) 826 (cl-destructuring-bind (probe &key language-id &allow-other-keys) 827 (if (consp spec) spec (list spec)) 828 (and (provided-mode-derived-p mode probe) 829 (cons 830 (or language-id 831 (or (get mode 'eglot-language-id) 832 (get spec 'eglot-language-id) 833 (string-remove-suffix "-mode" (symbol-name mode)))) 834 contact)))) 835 (if (or (symbolp modes) (keywordp (cadr modes))) 836 (list modes) modes)))) 837 838 (defun eglot--guess-contact (&optional interactive) 839 "Helper for `eglot'. 840 Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID). If INTERACTIVE is 841 non-nil, maybe prompt user, else error as soon as something can't 842 be guessed." 843 (let* ((guessed-mode (if buffer-file-name major-mode)) 844 (managed-mode 845 (cond 846 ((and interactive 847 (or (>= (prefix-numeric-value current-prefix-arg) 16) 848 (not guessed-mode))) 849 (intern 850 (completing-read 851 "[eglot] Start a server to manage buffers of what major mode? " 852 (mapcar #'symbol-name (eglot--all-major-modes)) nil t 853 (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil))) 854 ((not guessed-mode) 855 (eglot--error "Can't guess mode to manage for `%s'" (current-buffer))) 856 (t guessed-mode))) 857 (lang-id-and-guess (eglot--lookup-mode guessed-mode)) 858 (language-id (car lang-id-and-guess)) 859 (guess (cdr lang-id-and-guess)) 860 (guess (if (functionp guess) 861 (funcall guess interactive) 862 guess)) 863 (class (or (and (consp guess) (symbolp (car guess)) 864 (prog1 (unless current-prefix-arg (car guess)) 865 (setq guess (cdr guess)))) 866 'eglot-lsp-server)) 867 (program (and (listp guess) 868 (stringp (car guess)) 869 ;; A second element might be the port of a (host, port) 870 ;; pair, but in that case it is not a string. 871 (or (null (cdr guess)) (stringp (cadr guess))) 872 (car guess))) 873 (base-prompt 874 (and interactive 875 "Enter program to execute (or <host>:<port>): ")) 876 (program-guess 877 (and program 878 (combine-and-quote-strings (cl-subst ":autoport:" 879 :autoport guess)))) 880 (prompt 881 (and base-prompt 882 (cond (current-prefix-arg base-prompt) 883 ((null guess) 884 (format "[eglot] Sorry, couldn't guess for `%s'!\n%s" 885 managed-mode base-prompt)) 886 ((and program 887 (not (file-name-absolute-p program)) 888 (not (eglot--executable-find program t))) 889 (concat (format "[eglot] I guess you want to run `%s'" 890 program-guess) 891 (format ", but I can't find `%s' in PATH!" program) 892 "\n" base-prompt))))) 893 (contact 894 (or (and prompt 895 (let ((s (read-shell-command 896 prompt 897 program-guess 898 'eglot-command-history))) 899 (if (string-match "^\\([^\s\t]+\\):\\([[:digit:]]+\\)$" 900 (string-trim s)) 901 (list (match-string 1 s) 902 (string-to-number (match-string 2 s))) 903 (cl-subst 904 :autoport ":autoport:" (split-string-and-unquote s) 905 :test #'equal)))) 906 guess 907 (eglot--error "Couldn't guess for `%s'!" managed-mode)))) 908 (list managed-mode (eglot--current-project) class contact language-id))) 909 910 (defvar eglot-lsp-context) 911 (put 'eglot-lsp-context 'variable-documentation 912 "Dynamically non-nil when searching for projects in LSP context.") 913 914 (defvar eglot--servers-by-xrefed-file 915 (make-hash-table :test 'equal :weakness 'value)) 916 917 (defun eglot--current-project () 918 "Return a project object for Eglot's LSP purposes. 919 This relies on `project-current' and thus on 920 `project-find-functions'. Functions in the latter 921 variable (which see) can query the value `eglot-lsp-context' to 922 decide whether a given directory is a project containing a 923 suitable root directory for a given LSP server's purposes." 924 (let ((eglot-lsp-context t)) 925 (or (project-current) `(transient . ,default-directory)))) 926 927 ;;;###autoload 928 (defun eglot (managed-major-mode project class contact language-id 929 &optional interactive) 930 "Manage a project with a Language Server Protocol (LSP) server. 931 932 The LSP server of CLASS is started (or contacted) via CONTACT. 933 If this operation is successful, current *and future* file 934 buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\" 935 by the LSP server, meaning information about their contents is 936 exchanged periodically to provide enhanced code-analysis via 937 `xref-find-definitions', `flymake-mode', `eldoc-mode', 938 `completion-at-point', among others. 939 940 Interactively, the command attempts to guess MANAGED-MAJOR-MODE 941 from current buffer, CLASS and CONTACT from 942 `eglot-server-programs' and PROJECT from 943 `project-find-functions'. The search for active projects in this 944 context binds `eglot-lsp-context' (which see). 945 946 If it can't guess, the user is prompted. With a single 947 \\[universal-argument] prefix arg, it always prompt for COMMAND. 948 With two \\[universal-argument] prefix args, also prompts for 949 MANAGED-MAJOR-MODE. 950 951 PROJECT is a project object as returned by `project-current'. 952 953 CLASS is a subclass of `eglot-lsp-server'. 954 955 CONTACT specifies how to contact the server. It is a 956 keyword-value plist used to initialize CLASS or a plain list as 957 described in `eglot-server-programs', which see. 958 959 LANGUAGE-ID is the language ID string to send to the server for 960 MANAGED-MAJOR-MODE, which matters to a minority of servers. 961 962 INTERACTIVE is t if called interactively." 963 (interactive (append (eglot--guess-contact t) '(t))) 964 (let* ((current-server (eglot-current-server)) 965 (live-p (and current-server (jsonrpc-running-p current-server)))) 966 (if (and live-p 967 interactive 968 (y-or-n-p "[eglot] Live process found, reconnect instead? ")) 969 (eglot-reconnect current-server interactive) 970 (when live-p (ignore-errors (eglot-shutdown current-server))) 971 (eglot--connect managed-major-mode project class contact language-id)))) 972 973 (defun eglot-reconnect (server &optional interactive) 974 "Reconnect to SERVER. 975 INTERACTIVE is t if called interactively." 976 (interactive (list (eglot--current-server-or-lose) t)) 977 (when (jsonrpc-running-p server) 978 (ignore-errors (eglot-shutdown server interactive nil 'preserve-buffers))) 979 (eglot--connect (eglot--major-mode server) 980 (eglot--project server) 981 (eieio-object-class-name server) 982 (eglot--saved-initargs server) 983 (eglot--language-id server)) 984 (eglot--message "Reconnected!")) 985 986 (defvar eglot--managed-mode) ; forward decl 987 988 ;;;###autoload 989 (defun eglot-ensure () 990 "Start Eglot session for current buffer if there isn't one." 991 (let ((buffer (current-buffer))) 992 (cl-labels 993 ((maybe-connect 994 () 995 (remove-hook 'post-command-hook #'maybe-connect nil) 996 (eglot--when-live-buffer buffer 997 (unless eglot--managed-mode 998 (apply #'eglot--connect (eglot--guess-contact)))))) 999 (when buffer-file-name 1000 (add-hook 'post-command-hook #'maybe-connect 'append nil))))) 1001 1002 (defun eglot-events-buffer (server) 1003 "Display events buffer for SERVER. 1004 Use current server's or first available Eglot events buffer." 1005 (interactive (list (eglot-current-server))) 1006 (let ((buffer (if server (jsonrpc-events-buffer server) 1007 (cl-find "\\*EGLOT.*events\\*" 1008 (buffer-list) 1009 :key #'buffer-name :test #'string-match)))) 1010 (if buffer (display-buffer buffer) 1011 (eglot--error "Can't find an Eglot events buffer!")))) 1012 1013 (defun eglot-stderr-buffer (server) 1014 "Display stderr buffer for SERVER." 1015 (interactive (list (eglot--current-server-or-lose))) 1016 (display-buffer (jsonrpc-stderr-buffer server))) 1017 1018 (defun eglot-forget-pending-continuations (server) 1019 "Forget pending requests for SERVER." 1020 (interactive (list (eglot--current-server-or-lose))) 1021 (jsonrpc-forget-pending-continuations server)) 1022 1023 (defvar eglot-connect-hook 1024 '(eglot-signal-didChangeConfiguration) 1025 "Hook run after connecting in `eglot--connect'.") 1026 1027 (defvar eglot-server-initialized-hook 1028 '() 1029 "Hook run after a `eglot-lsp-server' instance is created. 1030 1031 That is before a connection was established. Use 1032 `eglot-connect-hook' to hook into when a connection was 1033 successfully established and the server on the other side has 1034 received the initializing configuration. 1035 1036 Each function is passed the server as an argument") 1037 1038 (defun eglot--cmd (contact) 1039 "Helper for `eglot--connect'." 1040 (if (file-remote-p default-directory) 1041 ;; TODO: this seems like a bug, although it’s everywhere. For 1042 ;; some reason, for remote connections only, over a pipe, we 1043 ;; need to turn off line buffering on the tty. 1044 ;; 1045 ;; Not only does this seem like there should be a better way, 1046 ;; but it almost certainly doesn’t work on non-unix systems. 1047 (list "sh" "-c" 1048 (string-join (cons "stty raw > /dev/null;" 1049 (mapcar #'shell-quote-argument contact)) 1050 " ")) 1051 contact)) 1052 1053 (defvar-local eglot--cached-server nil 1054 "A cached reference to the current EGLOT server.") 1055 1056 (defun eglot--connect (managed-major-mode project class contact language-id) 1057 "Connect to MANAGED-MAJOR-MODE, LANGUAGE-ID, PROJECT, CLASS and CONTACT. 1058 This docstring appeases checkdoc, that's all." 1059 (let* ((default-directory (project-root project)) 1060 (nickname (file-name-base (directory-file-name default-directory))) 1061 (readable-name (format "EGLOT (%s/%s)" nickname managed-major-mode)) 1062 autostart-inferior-process 1063 (contact (if (functionp contact) (funcall contact) contact)) 1064 (initargs 1065 (cond ((keywordp (car contact)) contact) 1066 ((integerp (cadr contact)) 1067 `(:process ,(lambda () 1068 (apply #'open-network-stream 1069 readable-name nil 1070 (car contact) (cadr contact) 1071 (cddr contact))))) 1072 ((and (stringp (car contact)) (memq :autoport contact)) 1073 `(:process ,(lambda () 1074 (pcase-let ((`(,connection . ,inferior) 1075 (eglot--inferior-bootstrap 1076 readable-name 1077 contact))) 1078 (setq autostart-inferior-process inferior) 1079 connection)))) 1080 ((stringp (car contact)) 1081 `(:process 1082 ,(lambda () 1083 (let ((default-directory default-directory)) 1084 (make-process 1085 :name readable-name 1086 :command (eglot--cmd contact) 1087 :connection-type 'pipe 1088 :coding 'utf-8-emacs-unix 1089 :noquery t 1090 :stderr (get-buffer-create 1091 (format "*%s stderr*" readable-name)) 1092 :file-handler t))))))) 1093 (spread (lambda (fn) (lambda (server method params) 1094 (let ((eglot--cached-server server)) 1095 (apply fn server method (append params nil)))))) 1096 (server 1097 (apply 1098 #'make-instance class 1099 :name readable-name 1100 :events-buffer-scrollback-size eglot-events-buffer-size 1101 :notification-dispatcher (funcall spread #'eglot-handle-notification) 1102 :request-dispatcher (funcall spread #'eglot-handle-request) 1103 :on-shutdown #'eglot--on-shutdown 1104 initargs)) 1105 (cancelled nil) 1106 (tag (make-symbol "connected-catch-tag"))) 1107 (setf (eglot--saved-initargs server) initargs) 1108 (setf (eglot--project server) project) 1109 (setf (eglot--project-nickname server) nickname) 1110 (setf (eglot--major-mode server) managed-major-mode) 1111 (setf (eglot--language-id server) language-id) 1112 (setf (eglot--inferior-process server) autostart-inferior-process) 1113 (run-hook-with-args 'eglot-server-initialized-hook server) 1114 ;; Now start the handshake. To honour `eglot-sync-connect' 1115 ;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request' 1116 ;; and mimic most of `jsonrpc-request'. 1117 (unwind-protect 1118 (condition-case _quit 1119 (let ((retval 1120 (catch tag 1121 (jsonrpc-async-request 1122 server 1123 :initialize 1124 (list :processId 1125 (unless (or eglot-withhold-process-id 1126 (file-remote-p default-directory) 1127 (eq (jsonrpc-process-type server) 1128 'network)) 1129 (emacs-pid)) 1130 ;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py' 1131 ;; into `/path/to/baz.py', so LSP groks it. 1132 :rootPath (file-local-name 1133 (expand-file-name default-directory)) 1134 :rootUri (eglot--path-to-uri default-directory) 1135 :initializationOptions (eglot-initialization-options 1136 server) 1137 :capabilities (eglot-client-capabilities server)) 1138 :success-fn 1139 (eglot--lambda ((InitializeResult) capabilities serverInfo) 1140 (unless cancelled 1141 (push server 1142 (gethash project eglot--servers-by-project)) 1143 (setf (eglot--capabilities server) capabilities) 1144 (setf (eglot--server-info server) serverInfo) 1145 (jsonrpc-notify server :initialized eglot--{}) 1146 (dolist (buffer (buffer-list)) 1147 (with-current-buffer buffer 1148 ;; No need to pass SERVER as an argument: it has 1149 ;; been registered in `eglot--servers-by-project', 1150 ;; so that it can be found (and cached) from 1151 ;; `eglot--maybe-activate-editing-mode' in any 1152 ;; managed buffer. 1153 (eglot--maybe-activate-editing-mode))) 1154 (setf (eglot--inhibit-autoreconnect server) 1155 (cond 1156 ((booleanp eglot-autoreconnect) 1157 (not eglot-autoreconnect)) 1158 ((cl-plusp eglot-autoreconnect) 1159 (run-with-timer 1160 eglot-autoreconnect nil 1161 (lambda () 1162 (setf (eglot--inhibit-autoreconnect server) 1163 (null eglot-autoreconnect))))))) 1164 (let ((default-directory (project-root project)) 1165 (major-mode managed-major-mode)) 1166 (hack-dir-local-variables-non-file-buffer) 1167 (run-hook-with-args 'eglot-connect-hook server)) 1168 (eglot--message 1169 "Connected! Server `%s' now managing `%s' buffers \ 1170 in project `%s'." 1171 (or (plist-get serverInfo :name) 1172 (jsonrpc-name server)) 1173 managed-major-mode 1174 (eglot-project-nickname server)) 1175 (when tag (throw tag t)))) 1176 :timeout eglot-connect-timeout 1177 :error-fn (eglot--lambda ((ResponseError) code message) 1178 (unless cancelled 1179 (jsonrpc-shutdown server) 1180 (let ((msg (format "%s: %s" code message))) 1181 (if tag (throw tag `(error . ,msg)) 1182 (eglot--error msg))))) 1183 :timeout-fn (lambda () 1184 (unless cancelled 1185 (jsonrpc-shutdown server) 1186 (let ((msg (format "Timed out"))) 1187 (if tag (throw tag `(error . ,msg)) 1188 (eglot--error msg)))))) 1189 (cond ((numberp eglot-sync-connect) 1190 (accept-process-output nil eglot-sync-connect)) 1191 (eglot-sync-connect 1192 (while t (accept-process-output nil 30))))))) 1193 (pcase retval 1194 (`(error . ,msg) (eglot--error msg)) 1195 (`nil (eglot--message "Waiting in background for server `%s'" 1196 (jsonrpc-name server)) 1197 nil) 1198 (_ server))) 1199 (quit (jsonrpc-shutdown server) (setq cancelled 'quit))) 1200 (setq tag nil)))) 1201 1202 (defun eglot--inferior-bootstrap (name contact &optional connect-args) 1203 "Use CONTACT to start a server, then connect to it. 1204 Return a cons of two process objects (CONNECTION . INFERIOR). 1205 Name both based on NAME. 1206 CONNECT-ARGS are passed as additional arguments to 1207 `open-network-stream'." 1208 (let* ((port-probe (make-network-process :name "eglot-port-probe-dummy" 1209 :server t 1210 :host "localhost" 1211 :service 0)) 1212 (port-number (unwind-protect 1213 (process-contact port-probe :service) 1214 (delete-process port-probe))) 1215 inferior connection) 1216 (unwind-protect 1217 (progn 1218 (setq inferior 1219 (make-process 1220 :name (format "autostart-inferior-%s" name) 1221 :stderr (format "*%s stderr*" name) 1222 :noquery t 1223 :command (cl-subst 1224 (format "%s" port-number) :autoport contact))) 1225 (setq connection 1226 (cl-loop 1227 repeat 10 for i from 1 1228 do (accept-process-output nil 0.5) 1229 while (process-live-p inferior) 1230 do (eglot--message 1231 "Trying to connect to localhost and port %s (attempt %s)" 1232 port-number i) 1233 thereis (ignore-errors 1234 (apply #'open-network-stream 1235 (format "autoconnect-%s" name) 1236 nil 1237 "localhost" port-number connect-args)))) 1238 (cons connection inferior)) 1239 (cond ((and (process-live-p connection) 1240 (process-live-p inferior)) 1241 (eglot--message "Done, connected to %s!" port-number)) 1242 (t 1243 (when inferior (delete-process inferior)) 1244 (when connection (delete-process connection)) 1245 (eglot--error "Could not start and connect to server%s" 1246 (if inferior 1247 (format " started with %s" 1248 (process-command inferior)) 1249 "!"))))))) 1250 1251 1252 ;;; Helpers (move these to API?) 1253 ;;; 1254 (defun eglot--error (format &rest args) 1255 "Error out with FORMAT with ARGS." 1256 (error "[eglot] %s" (apply #'format format args))) 1257 1258 (defun eglot--message (format &rest args) 1259 "Message out with FORMAT with ARGS." 1260 (message "[eglot] %s" (apply #'format format args))) 1261 1262 (defun eglot--warn (format &rest args) 1263 "Warning message with FORMAT and ARGS." 1264 (apply #'eglot--message (concat "(warning) " format) args) 1265 (let ((warning-minimum-level :error)) 1266 (display-warning 'eglot (apply #'format format args) :warning))) 1267 1268 (defun eglot-current-column () (- (point) (point-at-bol))) 1269 1270 (defvar eglot-current-column-function #'eglot-lsp-abiding-column 1271 "Function to calculate the current column. 1272 1273 This is the inverse operation of 1274 `eglot-move-to-column-function' (which see). It is a function of 1275 no arguments returning a column number. For buffers managed by 1276 fully LSP-compliant servers, this should be set to 1277 `eglot-lsp-abiding-column' (the default), and 1278 `eglot-current-column' for all others.") 1279 1280 (defun eglot-lsp-abiding-column (&optional lbp) 1281 "Calculate current COLUMN as defined by the LSP spec. 1282 LBP defaults to `line-beginning-position'." 1283 (/ (- (length (encode-coding-region (or lbp (line-beginning-position)) 1284 (point) 'utf-16 t)) 1285 2) 1286 2)) 1287 1288 (defun eglot--pos-to-lsp-position (&optional pos) 1289 "Convert point POS to LSP position." 1290 (eglot--widening 1291 (list :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE 1292 :character (progn (when pos (goto-char pos)) 1293 (funcall eglot-current-column-function))))) 1294 1295 (defvar eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column 1296 "Function to move to a column reported by the LSP server. 1297 1298 According to the standard, LSP column/character offsets are based 1299 on a count of UTF-16 code units, not actual visual columns. So 1300 when LSP says position 3 of a line containing just \"aXbc\", 1301 where X is a multi-byte character, it actually means `b', not 1302 `c'. However, many servers don't follow the spec this closely. 1303 1304 For buffers managed by fully LSP-compliant servers, this should 1305 be set to `eglot-move-to-lsp-abiding-column' (the default), and 1306 `eglot-move-to-column' for all others.") 1307 1308 (defun eglot-move-to-column (column) 1309 "Move to COLUMN without closely following the LSP spec." 1310 ;; We cannot use `move-to-column' here, because it moves to *visual* 1311 ;; columns, which can be different from LSP columns in case of 1312 ;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296, 1313 ;; github#297) 1314 (goto-char (min (+ (line-beginning-position) column) 1315 (line-end-position)))) 1316 1317 (defun eglot-move-to-lsp-abiding-column (column) 1318 "Move to COLUMN abiding by the LSP spec." 1319 (save-restriction 1320 (cl-loop 1321 with lbp = (line-beginning-position) 1322 initially 1323 (narrow-to-region lbp (line-end-position)) 1324 (move-to-column column) 1325 for diff = (- column 1326 (eglot-lsp-abiding-column lbp)) 1327 until (zerop diff) 1328 do (condition-case eob-err 1329 (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2)) 1330 (end-of-buffer (cl-return eob-err)))))) 1331 1332 (defun eglot--lsp-position-to-point (pos-plist &optional marker) 1333 "Convert LSP position POS-PLIST to Emacs point. 1334 If optional MARKER, return a marker instead" 1335 (save-excursion 1336 (save-restriction 1337 (widen) 1338 (goto-char (point-min)) 1339 (forward-line (min most-positive-fixnum 1340 (plist-get pos-plist :line))) 1341 (unless (eobp) ;; if line was excessive leave point at eob 1342 (let ((tab-width 1) 1343 (col (plist-get pos-plist :character))) 1344 (unless (wholenump col) 1345 (eglot--warn 1346 "Caution: LSP server sent invalid character position %s. Using 0 instead." 1347 col) 1348 (setq col 0)) 1349 (funcall eglot-move-to-column-function col))) 1350 (if marker (copy-marker (point-marker)) (point))))) 1351 1352 (defconst eglot--uri-path-allowed-chars 1353 (let ((vec (copy-sequence url-path-allowed-chars))) 1354 (aset vec ?: nil) ;; see github#639 1355 vec) 1356 "Like `url-path-allows-chars' but more restrictive.") 1357 1358 (defun eglot--path-to-uri (path) 1359 "URIfy PATH." 1360 (let ((truepath (file-truename path))) 1361 (concat "file://" 1362 ;; Add a leading "/" for local MS Windows-style paths. 1363 (if (and (eq system-type 'windows-nt) 1364 (not (file-remote-p truepath))) 1365 "/") 1366 (url-hexify-string 1367 ;; Again watch out for trampy paths. 1368 (directory-file-name (file-local-name truepath)) 1369 eglot--uri-path-allowed-chars)))) 1370 1371 (defun eglot--uri-to-path (uri) 1372 "Convert URI to file path, helped by `eglot--current-server'." 1373 (when (keywordp uri) (setq uri (substring (symbol-name uri) 1))) 1374 (let* ((server (eglot-current-server)) 1375 (remote-prefix (and server 1376 (file-remote-p 1377 (project-root (eglot--project server))))) 1378 (retval (url-filename (url-generic-parse-url (url-unhex-string uri)))) 1379 ;; Remove the leading "/" for local MS Windows-style paths. 1380 (normalized (if (and (not remote-prefix) 1381 (eq system-type 'windows-nt) 1382 (cl-plusp (length retval))) 1383 (substring retval 1) 1384 retval))) 1385 (concat remote-prefix normalized))) 1386 1387 (defun eglot--snippet-expansion-fn () 1388 "Compute a function to expand snippets. 1389 Doubles as an indicator of snippet support." 1390 (and (boundp 'yas-minor-mode) 1391 (symbol-value 'yas-minor-mode) 1392 'yas-expand-snippet)) 1393 1394 (defun eglot--format-markup (markup) 1395 "Format MARKUP according to LSP's spec." 1396 (pcase-let ((`(,string ,mode) 1397 (if (stringp markup) (list markup 'gfm-view-mode) 1398 (list (plist-get markup :value) 1399 (pcase (plist-get markup :kind) 1400 ("markdown" 'gfm-view-mode) 1401 ("plaintext" 'text-mode) 1402 (_ major-mode)))))) 1403 (with-temp-buffer 1404 (setq-local markdown-fontify-code-blocks-natively t) 1405 (insert string) 1406 (let ((inhibit-message t) 1407 (message-log-max nil)) 1408 (ignore-errors (delay-mode-hooks (funcall mode)))) 1409 (font-lock-ensure) 1410 (string-trim (filter-buffer-substring (point-min) (point-max)))))) 1411 1412 (define-obsolete-variable-alias 'eglot-ignored-server-capabilites 1413 'eglot-ignored-server-capabilities "1.8") 1414 1415 (defcustom eglot-ignored-server-capabilities (list) 1416 "LSP server capabilities that Eglot could use, but won't. 1417 You could add, for instance, the symbol 1418 `:documentHighlightProvider' to prevent automatic highlighting 1419 under cursor." 1420 :type '(set 1421 :tag "Tick the ones you're not interested in" 1422 (const :tag "Documentation on hover" :hoverProvider) 1423 (const :tag "Code completion" :completionProvider) 1424 (const :tag "Function signature help" :signatureHelpProvider) 1425 (const :tag "Go to definition" :definitionProvider) 1426 (const :tag "Go to type definition" :typeDefinitionProvider) 1427 (const :tag "Go to implementation" :implementationProvider) 1428 (const :tag "Go to declaration" :implementationProvider) 1429 (const :tag "Find references" :referencesProvider) 1430 (const :tag "Highlight symbols automatically" :documentHighlightProvider) 1431 (const :tag "List symbols in buffer" :documentSymbolProvider) 1432 (const :tag "List symbols in workspace" :workspaceSymbolProvider) 1433 (const :tag "Execute code actions" :codeActionProvider) 1434 (const :tag "Code lens" :codeLensProvider) 1435 (const :tag "Format buffer" :documentFormattingProvider) 1436 (const :tag "Format portion of buffer" :documentRangeFormattingProvider) 1437 (const :tag "On-type formatting" :documentOnTypeFormattingProvider) 1438 (const :tag "Rename symbol" :renameProvider) 1439 (const :tag "Highlight links in document" :documentLinkProvider) 1440 (const :tag "Decorate color references" :colorProvider) 1441 (const :tag "Fold regions of buffer" :foldingRangeProvider) 1442 (const :tag "Execute custom commands" :executeCommandProvider))) 1443 1444 (defun eglot--server-capable (&rest feats) 1445 "Determine if current server is capable of FEATS." 1446 (unless (cl-some (lambda (feat) 1447 (memq feat eglot-ignored-server-capabilites)) 1448 feats) 1449 (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose)) 1450 then (cadr probe) 1451 for (feat . more) on feats 1452 for probe = (plist-member caps feat) 1453 if (not probe) do (cl-return nil) 1454 if (eq (cadr probe) :json-false) do (cl-return nil) 1455 if (not (listp (cadr probe))) do (cl-return (if more nil (cadr probe))) 1456 finally (cl-return (or (cadr probe) t))))) 1457 1458 (defun eglot--range-region (range &optional markers) 1459 "Return region (BEG . END) that represents LSP RANGE. 1460 If optional MARKERS, make markers." 1461 (let* ((st (plist-get range :start)) 1462 (beg (eglot--lsp-position-to-point st markers)) 1463 (end (eglot--lsp-position-to-point (plist-get range :end) markers))) 1464 (cons beg end))) 1465 1466 (defun eglot--read-server (prompt &optional dont-if-just-the-one) 1467 "Read a running Eglot server from minibuffer using PROMPT. 1468 If DONT-IF-JUST-THE-ONE and there's only one server, don't prompt 1469 and just return it. PROMPT shouldn't end with a question mark." 1470 (let ((servers (cl-loop for servers 1471 being hash-values of eglot--servers-by-project 1472 append servers)) 1473 (name (lambda (srv) 1474 (format "%s/%s" (eglot-project-nickname srv) 1475 (eglot--major-mode srv))))) 1476 (cond ((null servers) 1477 (eglot--error "No servers!")) 1478 ((or (cdr servers) (not dont-if-just-the-one)) 1479 (let* ((default (when-let ((current (eglot-current-server))) 1480 (funcall name current))) 1481 (read (completing-read 1482 (if default 1483 (format "%s (default %s)? " prompt default) 1484 (concat prompt "? ")) 1485 (mapcar name servers) 1486 nil t 1487 nil nil 1488 default))) 1489 (cl-find read servers :key name :test #'equal))) 1490 (t (car servers))))) 1491 1492 1493 ;;; Minor modes 1494 ;;; 1495 (defvar eglot-mode-map 1496 (let ((map (make-sparse-keymap))) 1497 (define-key map [remap display-local-help] 'eldoc-doc-buffer) 1498 map)) 1499 1500 (defvar-local eglot--current-flymake-report-fn nil 1501 "Current flymake report function for this buffer.") 1502 1503 (defvar-local eglot--saved-bindings nil 1504 "Bindings saved by `eglot--setq-saving'.") 1505 1506 (defvar eglot-stay-out-of '() 1507 "List of Emacs things that Eglot should try to stay of. 1508 Each element is a string, a symbol, or a regexp which is matched 1509 against a variable's name. Examples include the string 1510 \"company\" or the symbol `xref'. 1511 1512 Before Eglot starts \"managing\" a particular buffer, it 1513 opinionatedly sets some peripheral Emacs facilities, such as 1514 Flymake, Xref and Company. These overriding settings help ensure 1515 consistent Eglot behaviour and only stay in place until 1516 \"managing\" stops (usually via `eglot-shutdown'), whereupon the 1517 previous settings are restored. 1518 1519 However, if you wish for Eglot to stay out of a particular Emacs 1520 facility that you'd like to keep control of add an element to 1521 this list and Eglot will refrain from setting it. 1522 1523 For example, to keep your Company customization use 1524 1525 (add-to-list 'eglot-stay-out-of 'company)") 1526 1527 (defun eglot--stay-out-of-p (symbol) 1528 "Tell if EGLOT should stay of of SYMBOL." 1529 (cl-find (symbol-name symbol) eglot-stay-out-of 1530 :test (lambda (s thing) 1531 (let ((re (if (symbolp thing) (symbol-name thing) thing))) 1532 (string-match re s))))) 1533 1534 (defmacro eglot--setq-saving (symbol binding) 1535 `(unless (or (not (boundp ',symbol)) (eglot--stay-out-of-p ',symbol)) 1536 (push (cons ',symbol (symbol-value ',symbol)) eglot--saved-bindings) 1537 (setq-local ,symbol ,binding))) 1538 1539 (defun eglot-managed-p () 1540 "Tell if current buffer is managed by EGLOT." 1541 eglot--managed-mode) 1542 1543 (make-obsolete-variable 1544 'eglot--managed-mode-hook 'eglot-managed-mode-hook "1.6") 1545 1546 (defvar eglot-managed-mode-hook nil 1547 "A hook run by EGLOT after it started/stopped managing a buffer. 1548 Use `eglot-managed-p' to determine if current buffer is managed.") 1549 1550 (define-minor-mode eglot--managed-mode 1551 "Mode for source buffers managed by some EGLOT project." 1552 :init-value nil :lighter nil :keymap eglot-mode-map 1553 (cond 1554 (eglot--managed-mode 1555 (add-hook 'after-change-functions 'eglot--after-change nil t) 1556 (add-hook 'before-change-functions 'eglot--before-change nil t) 1557 (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t) 1558 ;; Prepend "didClose" to the hook after the "nonoff", so it will run first 1559 (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t) 1560 (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t) 1561 (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t) 1562 (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t) 1563 (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t) 1564 (unless (eglot--stay-out-of-p 'xref) 1565 (add-hook 'xref-backend-functions 'eglot-xref-backend nil t)) 1566 (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t) 1567 (add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t) 1568 (add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t) 1569 (add-hook 'pre-command-hook 'eglot--pre-command-hook nil t) 1570 (eglot--setq-saving eldoc-documentation-functions 1571 '(eglot-signature-eldoc-function 1572 eglot-hover-eldoc-function)) 1573 (eglot--setq-saving eldoc-documentation-strategy 1574 #'eldoc-documentation-enthusiast) 1575 (eglot--setq-saving xref-prompt-for-identifier nil) 1576 (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend)) 1577 (eglot--setq-saving company-backends '(company-capf)) 1578 (eglot--setq-saving company-tooltip-align-annotations t) 1579 (unless (eglot--stay-out-of-p 'imenu) 1580 (add-function :before-until (local 'imenu-create-index-function) 1581 #'eglot-imenu)) 1582 (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1)) 1583 (unless (eglot--stay-out-of-p 'eldoc) (eldoc-mode 1)) 1584 (cl-pushnew (current-buffer) (eglot--managed-buffers (eglot-current-server)))) 1585 (t 1586 (remove-hook 'after-change-functions 'eglot--after-change t) 1587 (remove-hook 'before-change-functions 'eglot--before-change t) 1588 (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t) 1589 (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t) 1590 (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t) 1591 (remove-hook 'after-revert-hook 'eglot--after-revert-hook t) 1592 (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t) 1593 (remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t) 1594 (remove-hook 'xref-backend-functions 'eglot-xref-backend t) 1595 (remove-hook 'completion-at-point-functions #'eglot-completion-at-point t) 1596 (remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t) 1597 (remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t) 1598 (remove-hook 'pre-command-hook 'eglot--pre-command-hook t) 1599 (cl-loop for (var . saved-binding) in eglot--saved-bindings 1600 do (set (make-local-variable var) saved-binding)) 1601 (remove-function (local 'imenu-create-index-function) #'eglot-imenu) 1602 (when eglot--current-flymake-report-fn 1603 (eglot--report-to-flymake nil) 1604 (setq eglot--current-flymake-report-fn nil)) 1605 (let ((server eglot--cached-server)) 1606 (setq eglot--cached-server nil) 1607 (when server 1608 (setf (eglot--managed-buffers server) 1609 (delq (current-buffer) (eglot--managed-buffers server))) 1610 (when (and eglot-autoshutdown 1611 (null (eglot--managed-buffers server))) 1612 (eglot-shutdown server)))))) 1613 ;; Note: the public hook runs before the internal eglot--managed-mode-hook. 1614 (run-hooks 'eglot-managed-mode-hook)) 1615 1616 (defun eglot--managed-mode-off () 1617 "Turn off `eglot--managed-mode' unconditionally." 1618 (eglot--managed-mode -1)) 1619 1620 (defun eglot-current-server () 1621 "Return logical EGLOT server for current buffer, nil if none." 1622 (setq eglot--cached-server 1623 (or eglot--cached-server 1624 (cl-find major-mode 1625 (gethash (eglot--current-project) eglot--servers-by-project) 1626 :key #'eglot--major-mode) 1627 (and eglot-extend-to-xref 1628 buffer-file-name 1629 (gethash (expand-file-name buffer-file-name) 1630 eglot--servers-by-xrefed-file))))) 1631 1632 (defun eglot--current-server-or-lose () 1633 "Return current logical EGLOT server connection or error." 1634 (or (eglot-current-server) 1635 (jsonrpc-error "No current JSON-RPC connection"))) 1636 1637 (defvar-local eglot--unreported-diagnostics nil 1638 "Unreported Flymake diagnostics for this buffer.") 1639 1640 (defvar revert-buffer-preserve-modes) 1641 (defun eglot--after-revert-hook () 1642 "Eglot's `after-revert-hook'." 1643 (when revert-buffer-preserve-modes (eglot--signal-textDocument/didOpen))) 1644 1645 (defun eglot--maybe-activate-editing-mode () 1646 "Maybe activate `eglot--managed-mode'. 1647 1648 If it is activated, also signal textDocument/didOpen." 1649 (unless eglot--managed-mode 1650 ;; Called when `revert-buffer-in-progress-p' is t but 1651 ;; `revert-buffer-preserve-modes' is nil. 1652 (when (and buffer-file-name (eglot-current-server)) 1653 (setq eglot--unreported-diagnostics `(:just-opened . nil)) 1654 (eglot--managed-mode) 1655 (eglot--signal-textDocument/didOpen)))) 1656 1657 (add-hook 'find-file-hook 'eglot--maybe-activate-editing-mode) 1658 (add-hook 'after-change-major-mode-hook 'eglot--maybe-activate-editing-mode) 1659 1660 (defun eglot-clear-status (server) 1661 "Clear the last JSONRPC error for SERVER." 1662 (interactive (list (eglot--current-server-or-lose))) 1663 (setf (jsonrpc-last-error server) nil)) 1664 1665 1666 ;;; Mode-line, menu and other sugar 1667 ;;; 1668 (defvar eglot--mode-line-format `(:eval (eglot--mode-line-format))) 1669 1670 (put 'eglot--mode-line-format 'risky-local-variable t) 1671 1672 (defun eglot--mouse-call (what) 1673 "Make an interactive lambda for calling WHAT from mode-line." 1674 (lambda (event) 1675 (interactive "e") 1676 (let ((start (event-start event))) (with-selected-window (posn-window start) 1677 (save-excursion 1678 (goto-char (or (posn-point start) 1679 (point))) 1680 (call-interactively what) 1681 (force-mode-line-update t)))))) 1682 1683 (defun eglot--mode-line-props (thing face defs &optional prepend) 1684 "Helper for function `eglot--mode-line-format'. 1685 Uses THING, FACE, DEFS and PREPEND." 1686 (cl-loop with map = (make-sparse-keymap) 1687 for (elem . rest) on defs 1688 for (key def help) = elem 1689 do (define-key map `[mode-line ,key] (eglot--mouse-call def)) 1690 concat (format "%s: %s" key help) into blurb 1691 when rest concat "\n" into blurb 1692 finally (return `(:propertize ,thing 1693 face ,face 1694 keymap ,map help-echo ,(concat prepend blurb) 1695 mouse-face mode-line-highlight)))) 1696 1697 (defun eglot--mode-line-format () 1698 "Compose the EGLOT's mode-line." 1699 (pcase-let* ((server (eglot-current-server)) 1700 (nick (and server (eglot-project-nickname server))) 1701 (pending (and server (hash-table-count 1702 (jsonrpc--request-continuations server)))) 1703 (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner server))) 1704 (last-error (and server (jsonrpc-last-error server)))) 1705 (append 1706 `(,(eglot--mode-line-props "eglot" 'eglot-mode-line nil)) 1707 (when nick 1708 `(":" ,(eglot--mode-line-props 1709 nick 'eglot-mode-line 1710 '((C-mouse-1 eglot-stderr-buffer "go to stderr buffer") 1711 (mouse-1 eglot-events-buffer "go to events buffer") 1712 (mouse-2 eglot-shutdown "quit server") 1713 (mouse-3 eglot-reconnect "reconnect to server"))) 1714 ,@(when last-error 1715 `("/" ,(eglot--mode-line-props 1716 "error" 'compilation-mode-line-fail 1717 '((mouse-3 eglot-clear-status "clear this status")) 1718 (format "An error occurred: %s\n" (plist-get last-error 1719 :message))))) 1720 ,@(when (and doing (not done-p)) 1721 `("/" ,(eglot--mode-line-props doing 1722 'compilation-mode-line-run '()))) 1723 ,@(when (cl-plusp pending) 1724 `("/" ,(eglot--mode-line-props 1725 (format "%d" pending) 'warning 1726 '((mouse-3 eglot-forget-pending-continuations 1727 "forget pending continuations")) 1728 "Number of outgoing, \ 1729 still unanswered LSP requests to the server")))))))) 1730 1731 (add-to-list 'mode-line-misc-info 1732 `(eglot--managed-mode (" [" eglot--mode-line-format "] "))) 1733 1734 (put 'eglot-note 'flymake-category 'flymake-note) 1735 (put 'eglot-warning 'flymake-category 'flymake-warning) 1736 (put 'eglot-error 'flymake-category 'flymake-error) 1737 1738 (defalias 'eglot--make-diag 'flymake-make-diagnostic) 1739 (defalias 'eglot--diag-data 'flymake-diagnostic-data) 1740 1741 (cl-loop for i from 1 1742 for type in '(eglot-note eglot-warning eglot-error ) 1743 do (put type 'flymake-overlay-control 1744 `((mouse-face . highlight) 1745 (priority . ,(+ 50 i)) 1746 (keymap . ,(let ((map (make-sparse-keymap))) 1747 (define-key map [mouse-1] 1748 (eglot--mouse-call 'eglot-code-actions)) 1749 map))))) 1750 1751 1752 ;;; Protocol implementation (Requests, notifications, etc) 1753 ;;; 1754 (cl-defmethod eglot-handle-notification 1755 (_server method &key &allow-other-keys) 1756 "Handle unknown notification." 1757 (unless (or (string-prefix-p "$" (format "%s" method)) 1758 (not (memq 'disallow-unknown-methods eglot-strict-mode))) 1759 (eglot--warn "Server sent unknown notification method `%s'" method))) 1760 1761 (cl-defmethod eglot-handle-request 1762 (_server method &key &allow-other-keys) 1763 "Handle unknown request." 1764 (when (memq 'disallow-unknown-methods eglot-strict-mode) 1765 (jsonrpc-error "Unknown request method `%s'" method))) 1766 1767 (cl-defmethod eglot-execute-command 1768 (server command arguments) 1769 "Execute COMMAND on SERVER with `:workspace/executeCommand'. 1770 COMMAND is a symbol naming the command." 1771 (jsonrpc-request server :workspace/executeCommand 1772 `(:command ,(format "%s" command) :arguments ,arguments))) 1773 1774 (cl-defmethod eglot-handle-notification 1775 (_server (_method (eql window/showMessage)) &key type message) 1776 "Handle notification window/showMessage." 1777 (eglot--message (propertize "Server reports (type=%s): %s" 1778 'face (if (<= type 1) 'error)) 1779 type message)) 1780 1781 (cl-defmethod eglot-handle-request 1782 (_server (_method (eql window/showMessageRequest)) &key type message actions) 1783 "Handle server request window/showMessageRequest." 1784 (let* ((actions (append actions nil)) ;; gh#627 1785 (label (completing-read 1786 (concat 1787 (format (propertize "[eglot] Server reports (type=%s): %s" 1788 'face (if (<= type 1) 'error)) 1789 type message) 1790 "\nChoose an option: ") 1791 (or (mapcar (lambda (obj) (plist-get obj :title)) actions) 1792 '("OK")) 1793 nil t (plist-get (elt actions 0) :title)))) 1794 (if label `(:title ,label) :null))) 1795 1796 (cl-defmethod eglot-handle-notification 1797 (_server (_method (eql window/logMessage)) &key _type _message) 1798 "Handle notification window/logMessage.") ;; noop, use events buffer 1799 1800 (cl-defmethod eglot-handle-notification 1801 (_server (_method (eql telemetry/event)) &rest _any) 1802 "Handle notification telemetry/event.") ;; noop, use events buffer 1803 1804 (cl-defmethod eglot-handle-notification 1805 (server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics 1806 &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode' 1807 "Handle notification publishDiagnostics." 1808 (if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri)))) 1809 (with-current-buffer buffer 1810 (cl-loop 1811 for diag-spec across diagnostics 1812 collect (eglot--dbind ((Diagnostic) range message severity source) 1813 diag-spec 1814 (setq message (concat source ": " message)) 1815 (pcase-let 1816 ((sev severity) 1817 (`(,beg . ,end) (eglot--range-region range))) 1818 ;; Fallback to `flymake-diag-region' if server 1819 ;; botched the range 1820 (when (= beg end) 1821 (if-let* ((st (plist-get range :start)) 1822 (diag-region 1823 (flymake-diag-region 1824 (current-buffer) (1+ (plist-get st :line)) 1825 (plist-get st :character)))) 1826 (setq beg (car diag-region) end (cdr diag-region)) 1827 (eglot--widening 1828 (goto-char (point-min)) 1829 (setq beg 1830 (point-at-bol 1831 (1+ (plist-get (plist-get range :start) :line)))) 1832 (setq end 1833 (point-at-eol 1834 (1+ (plist-get (plist-get range :end) :line))))))) 1835 (eglot--make-diag (current-buffer) beg end 1836 (cond ((null sev) 'eglot-error) 1837 ((<= sev 1) 'eglot-error) 1838 ((= sev 2) 'eglot-warning) 1839 (t 'eglot-note)) 1840 message `((eglot-lsp-diag . ,diag-spec))))) 1841 into diags 1842 finally (cond (eglot--current-flymake-report-fn 1843 (eglot--report-to-flymake diags)) 1844 (t 1845 (setq eglot--unreported-diagnostics (cons t diags)))))) 1846 (jsonrpc--debug server "Diagnostics received for unvisited %s" uri))) 1847 1848 (cl-defun eglot--register-unregister (server things how) 1849 "Helper for `registerCapability'. 1850 THINGS are either registrations or unregisterations (sic)." 1851 (cl-loop 1852 for thing in (cl-coerce things 'list) 1853 do (eglot--dbind ((Registration) id method registerOptions) thing 1854 (apply (cl-ecase how 1855 (register 'eglot-register-capability) 1856 (unregister 'eglot-unregister-capability)) 1857 server (intern method) id registerOptions)))) 1858 1859 (cl-defmethod eglot-handle-request 1860 (server (_method (eql client/registerCapability)) &key registrations) 1861 "Handle server request client/registerCapability." 1862 (eglot--register-unregister server registrations 'register)) 1863 1864 (cl-defmethod eglot-handle-request 1865 (server (_method (eql client/unregisterCapability)) 1866 &key unregisterations) ;; XXX: "unregisterations" (sic) 1867 "Handle server request client/unregisterCapability." 1868 (eglot--register-unregister server unregisterations 'unregister)) 1869 1870 (cl-defmethod eglot-handle-request 1871 (_server (_method (eql workspace/applyEdit)) &key _label edit) 1872 "Handle server request workspace/applyEdit." 1873 (eglot--apply-workspace-edit edit eglot-confirm-server-initiated-edits)) 1874 1875 (defun eglot--TextDocumentIdentifier () 1876 "Compute TextDocumentIdentifier object for current buffer." 1877 `(:uri ,(eglot--path-to-uri (or buffer-file-name 1878 (ignore-errors 1879 (buffer-file-name 1880 (buffer-base-buffer))))))) 1881 1882 (defvar-local eglot--versioned-identifier 0) 1883 1884 (defun eglot--VersionedTextDocumentIdentifier () 1885 "Compute VersionedTextDocumentIdentifier object for current buffer." 1886 (append (eglot--TextDocumentIdentifier) 1887 `(:version ,eglot--versioned-identifier))) 1888 1889 (defun eglot--TextDocumentItem () 1890 "Compute TextDocumentItem object for current buffer." 1891 (append 1892 (eglot--VersionedTextDocumentIdentifier) 1893 (list :languageId 1894 (eglot--language-id (eglot--current-server-or-lose)) 1895 :text 1896 (eglot--widening 1897 (buffer-substring-no-properties (point-min) (point-max)))))) 1898 1899 (defun eglot--TextDocumentPositionParams () 1900 "Compute TextDocumentPositionParams." 1901 (list :textDocument (eglot--TextDocumentIdentifier) 1902 :position (eglot--pos-to-lsp-position))) 1903 1904 (defvar-local eglot--last-inserted-char nil 1905 "If non-nil, value of the last inserted character in buffer.") 1906 1907 (defun eglot--post-self-insert-hook () 1908 "Set `eglot--last-inserted-char'." 1909 (setq eglot--last-inserted-char last-input-event)) 1910 1911 (defun eglot--pre-command-hook () 1912 "Reset `eglot--last-inserted-char'." 1913 (setq eglot--last-inserted-char nil)) 1914 1915 (defun eglot--CompletionParams () 1916 (append 1917 (eglot--TextDocumentPositionParams) 1918 `(:context 1919 ,(if-let (trigger (and (characterp eglot--last-inserted-char) 1920 (cl-find eglot--last-inserted-char 1921 (eglot--server-capable :completionProvider 1922 :triggerCharacters) 1923 :key (lambda (str) (aref str 0)) 1924 :test #'char-equal))) 1925 `(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1))))) 1926 1927 (defvar-local eglot--recent-changes nil 1928 "Recent buffer changes as collected by `eglot--before-change'.") 1929 1930 (cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what) 1931 "Tell if SERVER is ready for WHAT in current buffer." 1932 (and (cl-call-next-method) (not eglot--recent-changes))) 1933 1934 (defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.") 1935 1936 (defun eglot--before-change (beg end) 1937 "Hook onto `before-change-functions' with BEG and END." 1938 (when (listp eglot--recent-changes) 1939 ;; Records BEG and END, crucially convert them into LSP 1940 ;; (line/char) positions before that information is lost (because 1941 ;; the after-change thingy doesn't know if newlines were 1942 ;; deleted/added). Also record markers of BEG and END 1943 ;; (github#259) 1944 (push `(,(eglot--pos-to-lsp-position beg) 1945 ,(eglot--pos-to-lsp-position end) 1946 (,beg . ,(copy-marker beg nil)) 1947 (,end . ,(copy-marker end t))) 1948 eglot--recent-changes))) 1949 1950 (defun eglot--after-change (beg end pre-change-length) 1951 "Hook onto `after-change-functions'. 1952 Records BEG, END and PRE-CHANGE-LENGTH locally." 1953 (cl-incf eglot--versioned-identifier) 1954 (pcase (and (listp eglot--recent-changes) 1955 (car eglot--recent-changes)) 1956 (`(,lsp-beg ,lsp-end 1957 (,b-beg . ,b-beg-marker) 1958 (,b-end . ,b-end-marker)) 1959 ;; github#259 and github#367: With `capitalize-word' or somesuch, 1960 ;; `before-change-functions' always records the whole word's 1961 ;; `b-beg' and `b-end'. Similarly, when coalescing two lines 1962 ;; into one, `fill-paragraph' they mark the end of the first line 1963 ;; up to the end of the second line. In both situations, args 1964 ;; received here contradict that information: `beg' and `end' 1965 ;; will differ by 1 and will likely only encompass the letter 1966 ;; that was capitalized or, in the sentence-joining situation, 1967 ;; the replacement of the newline with a space. That's we keep 1968 ;; markers _and_ positions so we're able to detect and correct 1969 ;; this. We ignore `beg', `len' and `pre-change-len' and send 1970 ;; "fuller" information about the region from the markers. I've 1971 ;; also experimented with doing this unconditionally but it seems 1972 ;; to break when newlines are added. 1973 (if (and (= b-end b-end-marker) (= b-beg b-beg-marker) 1974 (or (/= beg b-beg) (/= end b-end))) 1975 (setcar eglot--recent-changes 1976 `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker) 1977 ,(buffer-substring-no-properties b-beg-marker 1978 b-end-marker))) 1979 (setcar eglot--recent-changes 1980 `(,lsp-beg ,lsp-end ,pre-change-length 1981 ,(buffer-substring-no-properties beg end))))) 1982 (_ (setf eglot--recent-changes :emacs-messup))) 1983 (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer)) 1984 (let ((buf (current-buffer))) 1985 (setq eglot--change-idle-timer 1986 (run-with-idle-timer 1987 eglot-send-changes-idle-time 1988 nil (lambda () (eglot--when-live-buffer buf 1989 (when eglot--managed-mode 1990 (eglot--signal-textDocument/didChange) 1991 (setq eglot--change-idle-timer nil)))))))) 1992 1993 ;; HACK! Launching a deferred sync request with outstanding changes is a 1994 ;; bad idea, since that might lead to the request never having a 1995 ;; chance to run, because `jsonrpc-connection-ready-p'. 1996 (advice-add #'jsonrpc-request :before 1997 (cl-function (lambda (_proc _method _params &key 1998 deferred &allow-other-keys) 1999 (when (and eglot--managed-mode deferred) 2000 (eglot--signal-textDocument/didChange)))) 2001 '((name . eglot--signal-textDocument/didChange))) 2002 2003 (defvar-local eglot-workspace-configuration () 2004 "Alist of (SECTION . VALUE) entries configuring the LSP server. 2005 SECTION should be a keyword or a string, value can be anything 2006 that can be converted to JSON.") 2007 2008 ;;;###autoload 2009 (put 'eglot-workspace-configuration 'safe-local-variable 'listp) 2010 2011 (defun eglot-signal-didChangeConfiguration (server) 2012 "Send a `:workspace/didChangeConfiguration' signal to SERVER. 2013 When called interactively, use the currently active server" 2014 (interactive (list (eglot--current-server-or-lose))) 2015 (jsonrpc-notify 2016 server :workspace/didChangeConfiguration 2017 (list 2018 :settings 2019 (cl-loop for (section . v) in eglot-workspace-configuration 2020 collect (if (keywordp section) 2021 section 2022 (intern (format ":%s" section))) 2023 collect v)))) 2024 2025 (cl-defmethod eglot-handle-request 2026 (server (_method (eql workspace/configuration)) &key items) 2027 "Handle server request workspace/configuration." 2028 (apply #'vector 2029 (mapcar 2030 (eglot--lambda ((ConfigurationItem) scopeUri section) 2031 (with-temp-buffer 2032 (let* ((uri-path (eglot--uri-to-path scopeUri)) 2033 (default-directory 2034 (if (and (not (string-empty-p uri-path)) 2035 (file-directory-p uri-path)) 2036 (file-name-as-directory uri-path) 2037 (project-root (eglot--project server))))) 2038 (setq-local major-mode (eglot--major-mode server)) 2039 (hack-dir-local-variables-non-file-buffer) 2040 (alist-get section eglot-workspace-configuration 2041 nil nil 2042 (lambda (wsection section) 2043 (string= 2044 (if (keywordp wsection) 2045 (substring (symbol-name wsection) 1) 2046 wsection) 2047 section)))))) 2048 items))) 2049 2050 (defun eglot--signal-textDocument/didChange () 2051 "Send textDocument/didChange to server." 2052 (when eglot--recent-changes 2053 (let* ((server (eglot--current-server-or-lose)) 2054 (sync-capability (eglot--server-capable :textDocumentSync)) 2055 (sync-kind (if (numberp sync-capability) sync-capability 2056 (plist-get sync-capability :change))) 2057 (full-sync-p (or (eq sync-kind 1) 2058 (eq :emacs-messup eglot--recent-changes)))) 2059 (jsonrpc-notify 2060 server :textDocument/didChange 2061 (list 2062 :textDocument (eglot--VersionedTextDocumentIdentifier) 2063 :contentChanges 2064 (if full-sync-p 2065 (vector `(:text ,(eglot--widening 2066 (buffer-substring-no-properties (point-min) 2067 (point-max))))) 2068 (cl-loop for (beg end len text) in (reverse eglot--recent-changes) 2069 ;; github#259: `capitalize-word' and commands based 2070 ;; on `casify_region' will cause multiple duplicate 2071 ;; empty entries in `eglot--before-change' calls 2072 ;; without an `eglot--after-change' reciprocal. 2073 ;; Weed them out here. 2074 when (numberp len) 2075 vconcat `[,(list :range `(:start ,beg :end ,end) 2076 :rangeLength len :text text)])))) 2077 (setq eglot--recent-changes nil) 2078 (setf (eglot--spinner server) (list nil :textDocument/didChange t)) 2079 (jsonrpc--call-deferred server)))) 2080 2081 (defun eglot--signal-textDocument/didOpen () 2082 "Send textDocument/didOpen to server." 2083 (setq eglot--recent-changes nil eglot--versioned-identifier 0) 2084 (jsonrpc-notify 2085 (eglot--current-server-or-lose) 2086 :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem)))) 2087 2088 (defun eglot--signal-textDocument/didClose () 2089 "Send textDocument/didClose to server." 2090 (with-demoted-errors 2091 "[eglot] error sending textDocument/didClose: %s" 2092 (jsonrpc-notify 2093 (eglot--current-server-or-lose) 2094 :textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier))))) 2095 2096 (defun eglot--signal-textDocument/willSave () 2097 "Send textDocument/willSave to server." 2098 (let ((server (eglot--current-server-or-lose)) 2099 (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier)))) 2100 (jsonrpc-notify server :textDocument/willSave params) 2101 (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil) 2102 (ignore-errors 2103 (eglot--apply-text-edits 2104 (jsonrpc-request server :textDocument/willSaveWaitUntil params 2105 :timeout 0.5)))))) 2106 2107 (defun eglot--signal-textDocument/didSave () 2108 "Send textDocument/didSave to server." 2109 (eglot--signal-textDocument/didChange) 2110 (jsonrpc-notify 2111 (eglot--current-server-or-lose) 2112 :textDocument/didSave 2113 (list 2114 ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this. 2115 :text (buffer-substring-no-properties (point-min) (point-max)) 2116 :textDocument (eglot--TextDocumentIdentifier)))) 2117 2118 (defun eglot-flymake-backend (report-fn &rest _more) 2119 "A Flymake backend for Eglot. 2120 Calls REPORT-FN (or arranges for it to be called) when the server 2121 publishes diagnostics. Between calls to this function, REPORT-FN 2122 may be called multiple times (respecting the protocol of 2123 `flymake-backend-functions')." 2124 (cond (eglot--managed-mode 2125 (setq eglot--current-flymake-report-fn report-fn) 2126 ;; Report anything unreported 2127 (when eglot--unreported-diagnostics 2128 (eglot--report-to-flymake (cdr eglot--unreported-diagnostics)))) 2129 (t 2130 (funcall report-fn nil)))) 2131 2132 (defun eglot--report-to-flymake (diags) 2133 "Internal helper for `eglot-flymake-backend'." 2134 (save-restriction 2135 (widen) 2136 (funcall eglot--current-flymake-report-fn diags 2137 ;; If the buffer hasn't changed since last 2138 ;; call to the report function, flymake won't 2139 ;; delete old diagnostics. Using :region 2140 ;; keyword forces flymake to delete 2141 ;; them (github#159). 2142 :region (cons (point-min) (point-max)))) 2143 (setq eglot--unreported-diagnostics nil)) 2144 2145 (defun eglot-xref-backend () "EGLOT xref backend." 'eglot) 2146 2147 (defvar eglot--temp-location-buffers (make-hash-table :test #'equal) 2148 "Helper variable for `eglot--handling-xrefs'.") 2149 2150 (defvar eglot-xref-lessp-function #'ignore 2151 "Compare two `xref-item' objects for sorting.") 2152 2153 (cl-defmacro eglot--collecting-xrefs ((collector) &rest body) 2154 "Sort and handle xrefs collected with COLLECTOR in BODY." 2155 (declare (indent 1) (debug (sexp &rest form))) 2156 (let ((collected (cl-gensym "collected"))) 2157 `(unwind-protect 2158 (let (,collected) 2159 (cl-flet ((,collector (xref) (push xref ,collected))) 2160 ,@body) 2161 (setq ,collected (nreverse ,collected)) 2162 (sort ,collected eglot-xref-lessp-function)) 2163 (maphash (lambda (_uri buf) (kill-buffer buf)) eglot--temp-location-buffers) 2164 (clrhash eglot--temp-location-buffers)))) 2165 2166 (defun eglot--xref-make-match (name uri range) 2167 "Like `xref-make-match' but with LSP's NAME, URI and RANGE. 2168 Try to visit the target file for a richer summary line." 2169 (pcase-let* 2170 ((file (eglot--uri-to-path uri)) 2171 (visiting (or (find-buffer-visiting file) 2172 (gethash uri eglot--temp-location-buffers))) 2173 (collect (lambda () 2174 (eglot--widening 2175 (pcase-let* ((`(,beg . ,end) (eglot--range-region range)) 2176 (bol (progn (goto-char beg) (point-at-bol))) 2177 (substring (buffer-substring bol (point-at-eol))) 2178 (hi-beg (- beg bol)) 2179 (hi-end (- (min (point-at-eol) end) bol))) 2180 (add-face-text-property hi-beg hi-end 'xref-match 2181 t substring) 2182 (list substring (1+ (current-line)) (eglot-current-column) 2183 (- end beg)))))) 2184 (`(,summary ,line ,column ,length) 2185 (cond 2186 (visiting (with-current-buffer visiting (funcall collect))) 2187 ((file-readable-p file) (with-current-buffer 2188 (puthash uri (generate-new-buffer " *temp*") 2189 eglot--temp-location-buffers) 2190 (insert-file-contents file) 2191 (funcall collect))) 2192 (t ;; fall back to the "dumb strategy" 2193 (let* ((start (cl-getf range :start)) 2194 (line (1+ (cl-getf start :line))) 2195 (start-pos (cl-getf start :character)) 2196 (end-pos (cl-getf (cl-getf range :end) :character))) 2197 (list name line start-pos (- end-pos start-pos))))))) 2198 (setf (gethash (expand-file-name file) eglot--servers-by-xrefed-file) 2199 (eglot--current-server-or-lose)) 2200 (xref-make-match summary (xref-make-file-location file line column) length))) 2201 2202 (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot))) 2203 (eglot--error "Cannot (yet) provide reliable completion table for LSP symbols")) 2204 2205 (cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot))) 2206 ;; JT@19/10/09: This is a totally dummy identifier that isn't even 2207 ;; passed to LSP. The reason for this particular wording is to 2208 ;; construct a readable message "No references for LSP identifier at 2209 ;; point.". See https://github.com/joaotavora/eglot/issues/314 2210 "LSP identifier at point.") 2211 2212 (defvar eglot--lsp-xref-refs nil 2213 "`xref' objects for overriding `xref-backend-references''s.") 2214 2215 (cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability) 2216 "Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY." 2217 (unless (eglot--server-capable 2218 (or capability 2219 (intern 2220 (format ":%sProvider" 2221 (cadr (split-string (symbol-name method) 2222 "/")))))) 2223 (eglot--error "Sorry, this server doesn't do %s" method)) 2224 (let ((response 2225 (jsonrpc-request 2226 (eglot--current-server-or-lose) 2227 method (append (eglot--TextDocumentPositionParams) extra-params)))) 2228 (eglot--collecting-xrefs (collect) 2229 (mapc 2230 (lambda (loc-or-loc-link) 2231 (let ((sym-name (symbol-name (symbol-at-point)))) 2232 (eglot--dcase loc-or-loc-link 2233 (((LocationLink) targetUri targetSelectionRange) 2234 (collect (eglot--xref-make-match sym-name 2235 targetUri targetSelectionRange))) 2236 (((Location) uri range) 2237 (collect (eglot--xref-make-match sym-name 2238 uri range)))))) 2239 (if (vectorp response) response (and response (list response))))))) 2240 2241 (cl-defun eglot--lsp-xref-helper (method &key extra-params capability ) 2242 "Helper for `eglot-find-declaration' & friends." 2243 (let ((eglot--lsp-xref-refs (eglot--lsp-xrefs-for-method 2244 method 2245 :extra-params extra-params 2246 :capability capability))) 2247 (if eglot--lsp-xref-refs 2248 (xref-find-references "LSP identifier at point.") 2249 (eglot--message "%s returned no references" method)))) 2250 2251 (defun eglot-find-declaration () 2252 "Find declaration for SYM, the identifier at point." 2253 (interactive) 2254 (eglot--lsp-xref-helper :textDocument/declaration)) 2255 2256 (defun eglot-find-implementation () 2257 "Find implementation for SYM, the identifier at point." 2258 (interactive) 2259 (eglot--lsp-xref-helper :textDocument/implementation)) 2260 2261 (defun eglot-find-typeDefinition () 2262 "Find type definition for SYM, the identifier at point." 2263 (interactive) 2264 (eglot--lsp-xref-helper :textDocument/typeDefinition)) 2265 2266 (cl-defmethod xref-backend-definitions ((_backend (eql eglot)) _identifier) 2267 (eglot--lsp-xrefs-for-method :textDocument/definition)) 2268 2269 (cl-defmethod xref-backend-references ((_backend (eql eglot)) _identifier) 2270 (or 2271 eglot--lsp-xref-refs 2272 (eglot--lsp-xrefs-for-method 2273 :textDocument/references :extra-params `(:context (:includeDeclaration t))))) 2274 2275 (cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern) 2276 (when (eglot--server-capable :workspaceSymbolProvider) 2277 (eglot--collecting-xrefs (collect) 2278 (mapc 2279 (eglot--lambda ((SymbolInformation) name location) 2280 (eglot--dbind ((Location) uri range) location 2281 (collect (eglot--xref-make-match name uri range)))) 2282 (jsonrpc-request (eglot--current-server-or-lose) 2283 :workspace/symbol 2284 `(:query ,pattern)))))) 2285 2286 (defun eglot-format-buffer () 2287 "Format contents of current buffer." 2288 (interactive) 2289 (eglot-format nil nil)) 2290 2291 (defun eglot-format (&optional beg end) 2292 "Format region BEG END. 2293 If either BEG or END is nil, format entire buffer. 2294 Interactively, format active region, or entire buffer if region 2295 is not active." 2296 (interactive (and (region-active-p) (list (region-beginning) (region-end)))) 2297 (pcase-let ((`(,method ,cap ,args) 2298 (cond 2299 ((and beg end) 2300 `(:textDocument/rangeFormatting 2301 :documentRangeFormattingProvider 2302 (:range ,(list :start (eglot--pos-to-lsp-position beg) 2303 :end (eglot--pos-to-lsp-position end))))) 2304 (t 2305 '(:textDocument/formatting :documentFormattingProvider nil))))) 2306 (unless (eglot--server-capable cap) 2307 (eglot--error "Server can't format!")) 2308 (eglot--apply-text-edits 2309 (jsonrpc-request 2310 (eglot--current-server-or-lose) 2311 method 2312 (cl-list* 2313 :textDocument (eglot--TextDocumentIdentifier) 2314 :options (list :tabSize tab-width 2315 :insertSpaces (if indent-tabs-mode :json-false t)) 2316 args) 2317 :deferred method)))) 2318 2319 (defun eglot-completion-at-point () 2320 "EGLOT's `completion-at-point' function." 2321 ;; Commit logs for this function help understand what's going on. 2322 (when-let (completion-capability (eglot--server-capable :completionProvider)) 2323 (let* ((server (eglot--current-server-or-lose)) 2324 (sort-completions 2325 (lambda (completions) 2326 (cl-sort completions 2327 #'string-lessp 2328 :key (lambda (c) 2329 (or (plist-get 2330 (get-text-property 0 'eglot--lsp-item c) 2331 :sortText) 2332 ""))))) 2333 (metadata `(metadata (category . eglot) 2334 (display-sort-function . ,sort-completions))) 2335 resp items (cached-proxies :none) 2336 (proxies 2337 (lambda () 2338 (if (listp cached-proxies) cached-proxies 2339 (setq resp 2340 (jsonrpc-request server 2341 :textDocument/completion 2342 (eglot--CompletionParams) 2343 :deferred :textDocument/completion 2344 :cancel-on-input t)) 2345 (setq items (append 2346 (if (vectorp resp) resp (plist-get resp :items)) 2347 nil)) 2348 (setq cached-proxies 2349 (mapcar 2350 (jsonrpc-lambda 2351 (&rest item &key label insertText insertTextFormat 2352 &allow-other-keys) 2353 (let ((proxy 2354 (cond ((and (eql insertTextFormat 2) 2355 (eglot--snippet-expansion-fn)) 2356 (string-trim-left label)) 2357 ((and insertText 2358 (not (string-empty-p insertText))) 2359 insertText) 2360 (t 2361 (string-trim-left label))))) 2362 (unless (zerop (length proxy)) 2363 (put-text-property 0 1 'eglot--lsp-item item proxy)) 2364 proxy)) 2365 items))))) 2366 (resolved (make-hash-table)) 2367 (resolve-maybe 2368 ;; Maybe completion/resolve JSON object `lsp-comp' into 2369 ;; another JSON object, if at all possible. Otherwise, 2370 ;; just return lsp-comp. 2371 (lambda (lsp-comp) 2372 (or (gethash lsp-comp resolved) 2373 (setf (gethash lsp-comp resolved) 2374 (if (and (eglot--server-capable :completionProvider 2375 :resolveProvider) 2376 (plist-get lsp-comp :data)) 2377 (jsonrpc-request server :completionItem/resolve 2378 lsp-comp :cancel-on-input t) 2379 lsp-comp))))) 2380 (bounds (bounds-of-thing-at-point 'symbol))) 2381 (list 2382 (or (car bounds) (point)) 2383 (or (cdr bounds) (point)) 2384 (lambda (probe pred action) 2385 (cond 2386 ((eq action 'metadata) metadata) ; metadata 2387 ((eq action 'lambda) ; test-completion 2388 (test-completion probe (funcall proxies))) 2389 ((eq (car-safe action) 'boundaries) nil) ; boundaries 2390 ((null action) ; try-completion 2391 (try-completion probe (funcall proxies))) 2392 ((eq action t) ; all-completions 2393 (all-completions 2394 "" 2395 (funcall proxies) 2396 (lambda (proxy) 2397 (let* ((item (get-text-property 0 'eglot--lsp-item proxy)) 2398 (filterText (plist-get item :filterText))) 2399 (and (or (null pred) (funcall pred proxy)) 2400 (string-prefix-p 2401 probe (or filterText proxy) completion-ignore-case)))))))) 2402 :annotation-function 2403 (lambda (proxy) 2404 (eglot--dbind ((CompletionItem) detail kind) 2405 (get-text-property 0 'eglot--lsp-item proxy) 2406 (let* ((detail (and (stringp detail) 2407 (not (string= detail "")) 2408 detail)) 2409 (annotation 2410 (or detail 2411 (cdr (assoc kind eglot--kind-names))))) 2412 (when annotation 2413 (concat " " 2414 (propertize annotation 2415 'face 'font-lock-function-name-face)))))) 2416 :company-kind 2417 ;; Associate each lsp-item with a lsp-kind symbol. 2418 (lambda (proxy) 2419 (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy)) 2420 (kind (alist-get (plist-get lsp-item :kind) 2421 eglot--kind-names))) 2422 (intern (downcase kind)))) 2423 :company-docsig 2424 ;; FIXME: autoImportText is specific to the pyright language server 2425 (lambda (proxy) 2426 (when-let* ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)) 2427 (data (plist-get (funcall resolve-maybe lsp-comp) :data)) 2428 (import-text (plist-get data :autoImportText))) 2429 import-text)) 2430 :company-doc-buffer 2431 (lambda (proxy) 2432 (let* ((documentation 2433 (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy))) 2434 (plist-get (funcall resolve-maybe lsp-comp) :documentation))) 2435 (formatted (and documentation 2436 (eglot--format-markup documentation)))) 2437 (when formatted 2438 (with-current-buffer (get-buffer-create " *eglot doc*") 2439 (erase-buffer) 2440 (insert formatted) 2441 (current-buffer))))) 2442 :company-require-match 'never 2443 :company-prefix-length 2444 (save-excursion 2445 (when (car bounds) (goto-char (car bounds))) 2446 (when (listp completion-capability) 2447 (looking-back 2448 (regexp-opt 2449 (cl-coerce (cl-getf completion-capability :triggerCharacters) 'list)) 2450 (line-beginning-position)))) 2451 :exclusive 'no 2452 :exit-function 2453 (lambda (proxy status) 2454 (when (eq status 'finished) 2455 ;; To assist in using this whole `completion-at-point' 2456 ;; function inside `completion-in-region', ensure the exit 2457 ;; function runs in the buffer where the completion was 2458 ;; triggered from. This should probably be in Emacs itself. 2459 ;; (github#505) 2460 (with-current-buffer (if (minibufferp) 2461 (window-buffer (minibuffer-selected-window)) 2462 (current-buffer)) 2463 (eglot--dbind ((CompletionItem) insertTextFormat 2464 insertText textEdit additionalTextEdits label) 2465 (funcall 2466 resolve-maybe 2467 (or (get-text-property 0 'eglot--lsp-item proxy) 2468 ;; When selecting from the *Completions* 2469 ;; buffer, `proxy' won't have any properties. 2470 ;; A lookup should fix that (github#148) 2471 (get-text-property 2472 0 'eglot--lsp-item 2473 (cl-find proxy (funcall proxies) :test #'string=)))) 2474 (let ((snippet-fn (and (eql insertTextFormat 2) 2475 (eglot--snippet-expansion-fn)))) 2476 (cond (textEdit 2477 ;; Undo (yes, undo) the newly inserted completion. 2478 ;; If before completion the buffer was "foo.b" and 2479 ;; now is "foo.bar", `proxy' will be "bar". We 2480 ;; want to delete only "ar" (`proxy' minus the 2481 ;; symbol whose bounds we've calculated before) 2482 ;; (github#160). 2483 (delete-region (+ (- (point) (length proxy)) 2484 (if bounds 2485 (- (cdr bounds) (car bounds)) 2486 0)) 2487 (point)) 2488 (eglot--dbind ((TextEdit) range newText) textEdit 2489 (pcase-let ((`(,beg . ,end) 2490 (eglot--range-region range))) 2491 (delete-region beg end) 2492 (goto-char beg) 2493 (funcall (or snippet-fn #'insert) newText))) 2494 (when (cl-plusp (length additionalTextEdits)) 2495 (eglot--apply-text-edits additionalTextEdits))) 2496 (snippet-fn 2497 ;; A snippet should be inserted, but using plain 2498 ;; `insertText'. This requires us to delete the 2499 ;; whole completion, since `insertText' is the full 2500 ;; completion's text. 2501 (delete-region (- (point) (length proxy)) (point)) 2502 (funcall snippet-fn (or insertText label))))) 2503 (eglot--signal-textDocument/didChange) 2504 (eldoc))))))))) 2505 2506 (defun eglot--hover-info (contents &optional range) 2507 (let ((heading (and range (pcase-let ((`(,beg . ,end) (eglot--range-region range))) 2508 (concat (buffer-substring beg end) ": ")))) 2509 (body (mapconcat #'eglot--format-markup 2510 (if (vectorp contents) contents (list contents)) "\n"))) 2511 (when (or heading (cl-plusp (length body))) (concat heading body)))) 2512 2513 (defun eglot--sig-info (sigs active-sig sig-help-active-param) 2514 (cl-loop 2515 for (sig . moresigs) on (append sigs nil) for i from 0 2516 concat 2517 (eglot--dbind ((SignatureInformation) label documentation parameters activeParameter) sig 2518 (with-temp-buffer 2519 (save-excursion (insert label)) 2520 (let ((active-param (or activeParameter sig-help-active-param)) 2521 params-start params-end) 2522 ;; Ad-hoc attempt to parse label as <name>(<params>) 2523 (when (looking-at "\\([^(]+\\)(\\([^)]+\\))") 2524 (setq params-start (match-beginning 2) params-end (match-end 2)) 2525 (add-face-text-property (match-beginning 1) (match-end 1) 2526 'font-lock-function-name-face)) 2527 (when (eql i active-sig) 2528 ;; Decide whether to add one-line-summary to signature line 2529 (when (and (stringp documentation) 2530 (string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)" 2531 documentation)) 2532 (setq documentation (match-string 1 documentation)) 2533 (unless (string-prefix-p (string-trim documentation) label) 2534 (goto-char (point-max)) 2535 (insert ": " (eglot--format-markup documentation)))) 2536 ;; Decide what to do with the active parameter... 2537 (when (and (eql i active-sig) active-param 2538 (< -1 active-param (length parameters))) 2539 (eglot--dbind ((ParameterInformation) label documentation) 2540 (aref parameters active-param) 2541 ;; ...perhaps highlight it in the formals list 2542 (when params-start 2543 (goto-char params-start) 2544 (pcase-let 2545 ((`(,beg ,end) 2546 (if (stringp label) 2547 (let ((case-fold-search nil)) 2548 (and (re-search-forward 2549 (concat "\\<" (regexp-quote label) "\\>") 2550 params-end t) 2551 (list (match-beginning 0) (match-end 0)))) 2552 (mapcar #'1+ (append label nil))))) 2553 (if (and beg end) 2554 (add-face-text-property 2555 beg end 2556 'eldoc-highlight-function-argument)))) 2557 ;; ...and/or maybe add its doc on a line by its own. 2558 (when documentation 2559 (goto-char (point-max)) 2560 (insert "\n" 2561 (propertize 2562 (if (stringp label) 2563 label 2564 (apply #'buffer-substring (mapcar #'1+ label))) 2565 'face 'eldoc-highlight-function-argument) 2566 ": " (eglot--format-markup documentation)))))) 2567 (buffer-string)))) 2568 when moresigs concat "\n")) 2569 2570 (defun eglot-signature-eldoc-function (cb) 2571 "A member of `eldoc-documentation-functions', for signatures." 2572 (when (eglot--server-capable :signatureHelpProvider) 2573 (let ((buf (current-buffer))) 2574 (jsonrpc-async-request 2575 (eglot--current-server-or-lose) 2576 :textDocument/signatureHelp (eglot--TextDocumentPositionParams) 2577 :success-fn 2578 (eglot--lambda ((SignatureHelp) 2579 signatures activeSignature activeParameter) 2580 (eglot--when-buffer-window buf 2581 (funcall cb 2582 (unless (seq-empty-p signatures) 2583 (eglot--sig-info signatures 2584 activeSignature 2585 activeParameter))))) 2586 :deferred :textDocument/signatureHelp)) 2587 t)) 2588 2589 (defun eglot-hover-eldoc-function (cb) 2590 "A member of `eldoc-documentation-functions', for hover." 2591 (when (eglot--server-capable :hoverProvider) 2592 (let ((buf (current-buffer))) 2593 (jsonrpc-async-request 2594 (eglot--current-server-or-lose) 2595 :textDocument/hover (eglot--TextDocumentPositionParams) 2596 :success-fn (eglot--lambda ((Hover) contents range) 2597 (eglot--when-buffer-window buf 2598 (let ((info (unless (seq-empty-p contents) 2599 (eglot--hover-info contents range)))) 2600 (funcall cb info :buffer t)))) 2601 :deferred :textDocument/hover)) 2602 (eglot--highlight-piggyback cb) 2603 t)) 2604 2605 (defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.") 2606 2607 (defun eglot--highlight-piggyback (_cb) 2608 "Request and handle `:textDocument/documentHighlight'." 2609 ;; FIXME: Obviously, this is just piggy backing on eldoc's calls for 2610 ;; convenience, as shown by the fact that we just ignore cb. 2611 (let ((buf (current-buffer))) 2612 (when (eglot--server-capable :documentHighlightProvider) 2613 (jsonrpc-async-request 2614 (eglot--current-server-or-lose) 2615 :textDocument/documentHighlight (eglot--TextDocumentPositionParams) 2616 :success-fn 2617 (lambda (highlights) 2618 (mapc #'delete-overlay eglot--highlights) 2619 (setq eglot--highlights 2620 (eglot--when-buffer-window buf 2621 (mapcar 2622 (eglot--lambda ((DocumentHighlight) range) 2623 (pcase-let ((`(,beg . ,end) 2624 (eglot--range-region range))) 2625 (let ((ov (make-overlay beg end))) 2626 (overlay-put ov 'face 'eglot-highlight-symbol-face) 2627 (overlay-put ov 'modification-hooks 2628 `(,(lambda (o &rest _) (delete-overlay o)))) 2629 ov))) 2630 highlights)))) 2631 :deferred :textDocument/documentHighlight) 2632 nil))) 2633 2634 (defun eglot-imenu () 2635 "EGLOT's `imenu-create-index-function'." 2636 (cl-labels 2637 ((visit (_name one-obj-array) 2638 (imenu-default-goto-function 2639 nil (car (eglot--range-region 2640 (eglot--dcase (aref one-obj-array 0) 2641 (((SymbolInformation) location) 2642 (plist-get location :range)) 2643 (((DocumentSymbol) selectionRange) 2644 selectionRange)))))) 2645 (unfurl (obj) 2646 (eglot--dcase obj 2647 (((SymbolInformation)) (list obj)) 2648 (((DocumentSymbol) name children) 2649 (cons obj 2650 (mapcar 2651 (lambda (c) 2652 (plist-put 2653 c :containerName 2654 (let ((existing (plist-get c :containerName))) 2655 (if existing (format "%s::%s" name existing) 2656 name)))) 2657 (mapcan #'unfurl children))))))) 2658 (mapcar 2659 (pcase-lambda (`(,kind . ,objs)) 2660 (cons 2661 (alist-get kind eglot--symbol-kind-names "Unknown") 2662 (mapcan (pcase-lambda (`(,container . ,objs)) 2663 (let ((elems (mapcar (lambda (obj) 2664 (list (plist-get obj :name) 2665 `[,obj] ;; trick 2666 #'visit)) 2667 objs))) 2668 (if container (list (cons container elems)) elems))) 2669 (seq-group-by 2670 (lambda (e) (plist-get e :containerName)) objs)))) 2671 (seq-group-by 2672 (lambda (obj) (plist-get obj :kind)) 2673 (mapcan #'unfurl 2674 (jsonrpc-request (eglot--current-server-or-lose) 2675 :textDocument/documentSymbol 2676 `(:textDocument 2677 ,(eglot--TextDocumentIdentifier)) 2678 :cancel-on-input non-essential)))))) 2679 2680 (defun eglot--apply-text-edits (edits &optional version) 2681 "Apply EDITS for current buffer if at VERSION, or if it's nil." 2682 (unless (or (not version) (equal version eglot--versioned-identifier)) 2683 (jsonrpc-error "Edits on `%s' require version %d, you have %d" 2684 (current-buffer) version eglot--versioned-identifier)) 2685 (atomic-change-group 2686 (let* ((change-group (prepare-change-group)) 2687 (howmany (length edits)) 2688 (reporter (make-progress-reporter 2689 (format "[eglot] applying %s edits to `%s'..." 2690 howmany (current-buffer)) 2691 0 howmany)) 2692 (done 0)) 2693 (mapc (pcase-lambda (`(,newText ,beg . ,end)) 2694 (let ((source (current-buffer))) 2695 (with-temp-buffer 2696 (insert newText) 2697 (let ((temp (current-buffer))) 2698 (with-current-buffer source 2699 (save-excursion 2700 (save-restriction 2701 (narrow-to-region beg end) 2702 2703 ;; On emacs versions < 26.2, 2704 ;; `replace-buffer-contents' is buggy - it calls 2705 ;; change functions with invalid arguments - so we 2706 ;; manually call the change functions here. 2707 ;; 2708 ;; See emacs bugs #32237, #32278: 2709 ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237 2710 ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278 2711 (let ((inhibit-modification-hooks t) 2712 (length (- end beg)) 2713 (beg (marker-position beg)) 2714 (end (marker-position end))) 2715 (run-hook-with-args 'before-change-functions 2716 beg end) 2717 (replace-buffer-contents temp) 2718 (run-hook-with-args 'after-change-functions 2719 beg (+ beg (length newText)) 2720 length)))) 2721 (progress-reporter-update reporter (cl-incf done))))))) 2722 (mapcar (eglot--lambda ((TextEdit) range newText) 2723 (cons newText (eglot--range-region range 'markers))) 2724 (reverse edits))) 2725 (undo-amalgamate-change-group change-group) 2726 (progress-reporter-done reporter)))) 2727 2728 (defun eglot--apply-workspace-edit (wedit &optional confirm) 2729 "Apply the workspace edit WEDIT. If CONFIRM, ask user first." 2730 (eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit 2731 (let ((prepared 2732 (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits) 2733 (eglot--dbind ((VersionedTextDocumentIdentifier) uri version) 2734 textDocument 2735 (list (eglot--uri-to-path uri) edits version))) 2736 documentChanges))) 2737 (cl-loop for (uri edits) on changes by #'cddr 2738 do (push (list (eglot--uri-to-path uri) edits) prepared)) 2739 (if (or confirm 2740 (cl-notevery #'find-buffer-visiting 2741 (mapcar #'car prepared))) 2742 (unless (y-or-n-p 2743 (format "[eglot] Server wants to edit:\n %s\n Proceed? " 2744 (mapconcat #'identity (mapcar #'car prepared) "\n "))) 2745 (eglot--error "User cancelled server edit"))) 2746 (cl-loop for edit in prepared 2747 for (path edits version) = edit 2748 do (with-current-buffer (find-file-noselect path) 2749 (eglot--apply-text-edits edits version)) 2750 finally (eldoc) (eglot--message "Edit successful!"))))) 2751 2752 (defun eglot-rename (newname) 2753 "Rename the current symbol to NEWNAME." 2754 (interactive 2755 (list (read-from-minibuffer (format "Rename `%s' to: " (symbol-at-point)) 2756 nil nil nil nil 2757 (symbol-name (symbol-at-point))))) 2758 (unless (eglot--server-capable :renameProvider) 2759 (eglot--error "Server can't rename!")) 2760 (eglot--apply-workspace-edit 2761 (jsonrpc-request (eglot--current-server-or-lose) 2762 :textDocument/rename `(,@(eglot--TextDocumentPositionParams) 2763 :newName ,newname)) 2764 current-prefix-arg)) 2765 2766 (defun eglot--region-bounds () "Region bounds if active, else point and nil." 2767 (if (use-region-p) `(,(region-beginning) ,(region-end)) `(,(point) nil))) 2768 2769 (defun eglot-code-actions (beg &optional end action-kind) 2770 "Offer to execute actions of ACTION-KIND between BEG and END. 2771 If ACTION-KIND is nil, consider all kinds of actions. 2772 Interactively, default BEG and END to region's bounds else BEG is 2773 point and END is nil, which results in a request for code actions 2774 at point. With prefix argument, prompt for ACTION-KIND." 2775 (interactive 2776 `(,@(eglot--region-bounds) 2777 ,(and current-prefix-arg 2778 (completing-read "[eglot] Action kind: " 2779 '("quickfix" "refactor.extract" "refactor.inline" 2780 "refactor.rewrite" "source.organizeImports"))))) 2781 (unless (eglot--server-capable :codeActionProvider) 2782 (eglot--error "Server can't execute code actions!")) 2783 (let* ((server (eglot--current-server-or-lose)) 2784 (actions 2785 (jsonrpc-request 2786 server 2787 :textDocument/codeAction 2788 (list :textDocument (eglot--TextDocumentIdentifier) 2789 :range (list :start (eglot--pos-to-lsp-position beg) 2790 :end (eglot--pos-to-lsp-position end)) 2791 :context 2792 `(:diagnostics 2793 [,@(cl-loop for diag in (flymake-diagnostics beg end) 2794 when (cdr (assoc 'eglot-lsp-diag 2795 (eglot--diag-data diag))) 2796 collect it)] 2797 ,@(when action-kind `(:only [,action-kind])))) 2798 :deferred t)) 2799 (menu-items 2800 (or (cl-loop for action across actions 2801 ;; Do filtering ourselves, in case the `:only' 2802 ;; didn't go through. 2803 when (or (not action-kind) 2804 (equal action-kind (plist-get action :kind))) 2805 collect (cons (plist-get action :title) action)) 2806 (apply #'eglot--error 2807 (if action-kind `("No \"%s\" code actions here" ,action-kind) 2808 `("No code actions here"))))) 2809 (preferred-action (cl-find-if 2810 (lambda (menu-item) 2811 (plist-get (cdr menu-item) :isPreferred)) 2812 menu-items)) 2813 (default-action (car (or preferred-action (car menu-items)))) 2814 (action (if (and action-kind (null (cadr menu-items))) 2815 (cdr (car menu-items)) 2816 (if (listp last-nonmenu-event) 2817 (x-popup-menu last-nonmenu-event `("Eglot code actions:" 2818 ("dummy" ,@menu-items))) 2819 (cdr (assoc (completing-read 2820 (format "[eglot] Pick an action (default %s): " 2821 default-action) 2822 menu-items nil t nil nil default-action) 2823 menu-items)))))) 2824 (eglot--dcase action 2825 (((Command) command arguments) 2826 (eglot-execute-command server (intern command) arguments)) 2827 (((CodeAction) edit command) 2828 (when edit (eglot--apply-workspace-edit edit)) 2829 (when command 2830 (eglot--dbind ((Command) command arguments) command 2831 (eglot-execute-command server (intern command) arguments))))))) 2832 2833 (defmacro eglot--code-action (name kind) 2834 "Define NAME to execute KIND code action." 2835 `(defun ,name (beg &optional end) 2836 ,(format "Execute '%s' code actions between BEG and END." kind) 2837 (interactive (eglot--region-bounds)) 2838 (eglot-code-actions beg end ,kind))) 2839 2840 (eglot--code-action eglot-code-action-organize-imports "source.organizeImports") 2841 (eglot--code-action eglot-code-action-extract "refactor.extract") 2842 (eglot--code-action eglot-code-action-inline "refactor.inline") 2843 (eglot--code-action eglot-code-action-rewrite "refactor.rewrite") 2844 (eglot--code-action eglot-code-action-quickfix "quickfix") 2845 2846 2847 ;;; Dynamic registration 2848 ;;; 2849 (cl-defmethod eglot-register-capability 2850 (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers) 2851 "Handle dynamic registration of workspace/didChangeWatchedFiles." 2852 (eglot-unregister-capability server method id) 2853 (let* (success 2854 (globs (mapcar 2855 (eglot--lambda ((FileSystemWatcher) globPattern) 2856 (eglot--glob-compile globPattern t t)) 2857 watchers)) 2858 (dirs-to-watch 2859 (delete-dups (mapcar #'file-name-directory 2860 (project-files 2861 (eglot--project server)))))) 2862 (cl-labels 2863 ((handle-event 2864 (event) 2865 (pcase-let ((`(,desc ,action ,file ,file1) event)) 2866 (cond 2867 ((and (memq action '(created changed deleted)) 2868 (cl-find file globs :test (lambda (f g) (funcall g f)))) 2869 (jsonrpc-notify 2870 server :workspace/didChangeWatchedFiles 2871 `(:changes ,(vector `(:uri ,(eglot--path-to-uri file) 2872 :type ,(cl-case action 2873 (created 1) 2874 (changed 2) 2875 (deleted 3))))))) 2876 ((eq action 'renamed) 2877 (handle-event `(,desc 'deleted ,file)) 2878 (handle-event `(,desc 'created ,file1))))))) 2879 (unwind-protect 2880 (progn 2881 (dolist (dir dirs-to-watch) 2882 (push (file-notify-add-watch dir '(change) #'handle-event) 2883 (gethash id (eglot--file-watches server)))) 2884 (setq 2885 success 2886 `(:message ,(format "OK, watching %s directories in %s watchers" 2887 (length dirs-to-watch) (length watchers))))) 2888 (unless success 2889 (eglot-unregister-capability server method id)))))) 2890 2891 (cl-defmethod eglot-unregister-capability 2892 (server (_method (eql workspace/didChangeWatchedFiles)) id) 2893 "Handle dynamic unregistration of workspace/didChangeWatchedFiles." 2894 (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches server))) 2895 (remhash id (eglot--file-watches server)) 2896 (list t "OK")) 2897 2898 2899 ;;; Glob heroics 2900 ;;; 2901 (defun eglot--glob-parse (glob) 2902 "Compute list of (STATE-SYM EMITTER-FN PATTERN)." 2903 (with-temp-buffer 2904 (save-excursion (insert glob)) 2905 (cl-loop 2906 with grammar = '((:** "\\*\\*/?" eglot--glob-emit-**) 2907 (:* "\\*" eglot--glob-emit-*) 2908 (:? "\\?" eglot--glob-emit-?) 2909 (:{} "{[^][*{}]+}" eglot--glob-emit-{}) 2910 (:range "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range) 2911 (:literal "[^][,*?{}]+" eglot--glob-emit-self)) 2912 until (eobp) 2913 collect (cl-loop 2914 for (_token regexp emitter) in grammar 2915 thereis (and (re-search-forward (concat "\\=" regexp) nil t) 2916 (list (cl-gensym "state-") emitter (match-string 0))) 2917 finally (error "Glob '%s' invalid at %s" (buffer-string) (point)))))) 2918 2919 (defun eglot--glob-compile (glob &optional byte-compile noerror) 2920 "Convert GLOB into Elisp function. Maybe BYTE-COMPILE it. 2921 If NOERROR, return predicate, else erroring function." 2922 (let* ((states (eglot--glob-parse glob)) 2923 (body `(with-current-buffer (get-buffer-create " *eglot-glob-matcher*") 2924 (erase-buffer) 2925 (save-excursion (insert string)) 2926 (cl-labels ,(cl-loop for (this that) on states 2927 for (self emit text) = this 2928 for next = (or (car that) 'eobp) 2929 collect (funcall emit text self next)) 2930 (or (,(caar states)) 2931 (error "Glob done but more unmatched text: '%s'" 2932 (buffer-substring (point) (point-max))))))) 2933 (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body)))) 2934 (if byte-compile (byte-compile form) form))) 2935 2936 (defun eglot--glob-emit-self (text self next) 2937 `(,self () (re-search-forward ,(concat "\\=" (regexp-quote text))) (,next))) 2938 2939 (defun eglot--glob-emit-** (_ self next) 2940 `(,self () (or (ignore-errors (save-excursion (,next))) 2941 (and (re-search-forward "\\=/?[^/]+/?") (,self))))) 2942 2943 (defun eglot--glob-emit-* (_ self next) 2944 `(,self () (re-search-forward "\\=[^/]") 2945 (or (ignore-errors (save-excursion (,next))) (,self)))) 2946 2947 (defun eglot--glob-emit-? (_ self next) 2948 `(,self () (re-search-forward "\\=[^/]") (,next))) 2949 2950 (defun eglot--glob-emit-{} (arg self next) 2951 (let ((alternatives (split-string (substring arg 1 (1- (length arg))) ","))) 2952 `(,self () 2953 (or ,@(cl-loop for alt in alternatives 2954 collect `(re-search-forward ,(concat "\\=" alt) nil t)) 2955 (error "Failed matching any of %s" ',alternatives)) 2956 (,next)))) 2957 2958 (defun eglot--glob-emit-range (arg self next) 2959 (when (eq ?! (aref arg 1)) (aset arg 1 ?^)) 2960 `(,self () (re-search-forward ,(concat "\\=" arg)) (,next))) 2961 2962 2963 ;;; Rust-specific 2964 ;;; 2965 (defclass eglot-rls (eglot-lsp-server) () :documentation "Rustlang's RLS.") 2966 2967 (cl-defmethod jsonrpc-connection-ready-p ((server eglot-rls) what) 2968 "Except for :completion, RLS isn't ready until Indexing done." 2969 (and (cl-call-next-method) 2970 (or ;; RLS normally ready for this, even if building. 2971 (eq :textDocument/completion what) 2972 (pcase-let ((`(,_id ,what ,done ,_detail) (eglot--spinner server))) 2973 (and (equal "Indexing" what) done))))) 2974 2975 (cl-defmethod eglot-handle-notification 2976 ((server eglot-rls) (_method (eql window/progress)) 2977 &key id done title message &allow-other-keys) 2978 "Handle notification window/progress." 2979 (setf (eglot--spinner server) (list id title done message))) 2980 2981 2982 ;;; eclipse-jdt-specific 2983 ;;; 2984 (defclass eglot-eclipse-jdt (eglot-lsp-server) () 2985 :documentation "Eclipse's Java Development Tools Language Server.") 2986 2987 (cl-defmethod eglot-initialization-options ((server eglot-eclipse-jdt)) 2988 "Passes through required jdt initialization options." 2989 `(:workspaceFolders 2990 [,@(cl-delete-duplicates 2991 (mapcar #'eglot--path-to-uri 2992 (let* ((root (project-root (eglot--project server)))) 2993 (cons root 2994 (mapcar 2995 #'file-name-directory 2996 (append 2997 (file-expand-wildcards (concat root "*/pom.xml")) 2998 (file-expand-wildcards (concat root "*/build.gradle")) 2999 (file-expand-wildcards (concat root "*/.project"))))))) 3000 :test #'string=)] 3001 ,@(if-let ((home (or (getenv "JAVA_HOME") 3002 (ignore-errors 3003 (expand-file-name 3004 ".." 3005 (file-name-directory 3006 (file-chase-links (executable-find "javac")))))))) 3007 `(:settings (:java (:home ,home))) 3008 (ignore (eglot--warn "JAVA_HOME env var not set"))))) 3009 3010 (defun eglot--eclipse-jdt-contact (interactive) 3011 "Return a contact for connecting to eclipse.jdt.ls server, as a cons cell. 3012 If INTERACTIVE, prompt user for details." 3013 (cl-labels 3014 ((is-the-jar 3015 (path) 3016 (and (string-match-p 3017 "org\\.eclipse\\.equinox\\.launcher_.*\\.jar$" 3018 (file-name-nondirectory path)) 3019 (file-exists-p path)))) 3020 (let* ((classpath (or (getenv "CLASSPATH") path-separator)) 3021 (cp-jar (cl-find-if #'is-the-jar (split-string classpath path-separator))) 3022 (jar cp-jar) 3023 (dir 3024 (cond 3025 (jar (file-name-as-directory 3026 (expand-file-name ".." (file-name-directory jar)))) 3027 (interactive 3028 (expand-file-name 3029 (read-directory-name 3030 (concat "Path to eclipse.jdt.ls directory (could not" 3031 " find it in CLASSPATH): ") 3032 nil nil t))) 3033 (t (error "Could not find eclipse.jdt.ls jar in CLASSPATH")))) 3034 (repodir 3035 (concat dir 3036 "org.eclipse.jdt.ls.product/target/repository/")) 3037 (repodir (if (file-directory-p repodir) repodir dir)) 3038 (config 3039 (concat 3040 repodir 3041 (cond 3042 ((string= system-type "darwin") "config_mac") 3043 ((string= system-type "windows-nt") "config_win") 3044 (t "config_linux")))) 3045 (workspace 3046 (expand-file-name (md5 (project-root (eglot--current-project))) 3047 (locate-user-emacs-file 3048 "eglot-eclipse-jdt-cache")))) 3049 (unless jar 3050 (setq jar 3051 (cl-find-if #'is-the-jar 3052 (directory-files (concat repodir "plugins") t)))) 3053 (unless (and jar (file-exists-p jar) (file-directory-p config)) 3054 (error "Could not find required eclipse.jdt.ls files (build required?)")) 3055 (when (and interactive (not cp-jar) 3056 (y-or-n-p (concat "Add path to the server program " 3057 "to CLASSPATH environment variable?"))) 3058 (setenv "CLASSPATH" (concat (getenv "CLASSPATH") path-separator jar))) 3059 (unless (file-directory-p workspace) 3060 (make-directory workspace t)) 3061 (cons 'eglot-eclipse-jdt 3062 (list (executable-find "java") 3063 "-Declipse.application=org.eclipse.jdt.ls.core.id1" 3064 "-Dosgi.bundles.defaultStartLevel=4" 3065 "-Declipse.product=org.eclipse.jdt.ls.core.product" 3066 "-jar" jar 3067 "-configuration" config 3068 "-data" workspace))))) 3069 3070 (cl-defmethod eglot-execute-command 3071 ((_server eglot-eclipse-jdt) (_cmd (eql java.apply.workspaceEdit)) arguments) 3072 "Eclipse JDT breaks spec and replies with edits as arguments." 3073 (mapc #'eglot--apply-workspace-edit arguments)) 3074 3075 (provide 'eglot) 3076 ;;; eglot.el ends here 3077 3078 ;; Local Variables: 3079 ;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)" 3080 ;; bug-reference-url-format: "https://github.com/joaotavora/eglot/issues/%s" 3081 ;; checkdoc-force-docstrings-flag: nil 3082 ;; End: