dotemacs

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

eglot.el (179857B)


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