dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

eglot.el (191744B)


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