diff --git a/eglot.el b/eglot.el index f267d089..424331c7 100644 --- a/eglot.el +++ b/eglot.el @@ -1,13 +1,13 @@ ;;; eglot.el --- The Emacs Client for LSP servers -*- lexical-binding: t; -*- -;; Copyright (C) 2018-2023 Free Software Foundation, Inc. +;; Copyright (C) 2018-2024 Free Software Foundation, Inc. -;; Version: 1.16 +;; Version: 1.17 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.23") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) +;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.24") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1") (compat "27.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any @@ -110,19 +110,30 @@ (require 'text-property-search nil t) (require 'diff-mode) (require 'diff) +(require 'track-changes nil t) +(require 'compat) ;; These dependencies are also GNU ELPA core packages. Because of ;; bug#62576, since there is a risk that M-x package-install, despite ;; having installed them, didn't correctly re-load them over the ;; built-in versions. (eval-and-compile - (load "project") - (load "eldoc") - (load "seq") - (load "flymake") - (load "xref") - (load "jsonrpc") - (load "external-completion")) + ;; For those packages that are preloaded, reload them if needed, + ;; since that's the best we can do anyway. + ;; FIXME: Maybe the ELPA packages for those preloaded packages should + ;; force-reload themselves eagerly when the package is activated! + (let ((reload (if (fboundp 'require-with-check) ;Emacs≥30 + #'require-with-check + (lambda (feature &rest _) + ;; Just blindly reload like we used to do before + ;; `require-with-check'. + (load (symbol-name feature) nil 'nomessage))))) + + (funcall reload 'eldoc nil 'reload) + (funcall reload 'seq nil 'reload) + ;; For those packages which are not preloaded OTOH, signal an error if + ;; the loaded file is not the one that should have been loaded. + (mapc reload '(project flymake xref jsonrpc external-completion)))) ;; forward-declare, but don't require (Emacs 28 doesn't seem to care) (defvar markdown-fontify-code-blocks-natively) @@ -140,27 +151,27 @@ 'eglot-confirm-server-edits "1.16") (make-obsolete-variable 'eglot-events-buffer-size 'eglot-events-buffer-config "1.16") -(define-obsolete-function-alias 'eglot--uri-to-path 'eglot-uri-to-path "1.16") -(define-obsolete-function-alias 'eglot--path-to-uri 'eglot-path-to-uri "1.16") -(define-obsolete-function-alias 'eglot--range-region 'eglot-range-region "1.16") -(define-obsolete-function-alias 'eglot--server-capable 'eglot-server-capable "1.16") -(define-obsolete-function-alias 'eglot--server-capable-or-lose 'eglot-server-capable-or-lose "1.16") +(define-obsolete-function-alias 'eglot--uri-to-path #'eglot-uri-to-path "1.16") +(define-obsolete-function-alias 'eglot--path-to-uri #'eglot-path-to-uri "1.16") +(define-obsolete-function-alias 'eglot--range-region #'eglot-range-region "1.16") +(define-obsolete-function-alias 'eglot--server-capable #'eglot-server-capable "1.16") +(define-obsolete-function-alias 'eglot--server-capable-or-lose #'eglot-server-capable-or-lose "1.16") (define-obsolete-function-alias - 'eglot-lsp-abiding-column 'eglot-utf-16-linepos "1.12") + 'eglot-lsp-abiding-column #'eglot-utf-16-linepos "1.12") (define-obsolete-function-alias - 'eglot-current-column 'eglot-utf-32-linepos "1.12") + 'eglot-current-column #'eglot-utf-32-linepos "1.12") (define-obsolete-variable-alias 'eglot-current-column-function 'eglot-current-linepos-function "1.12") (define-obsolete-function-alias - 'eglot-move-to-current-column 'eglot-move-to-utf-32-linepos "1.12") + 'eglot-move-to-current-column #'eglot-move-to-utf-32-linepos "1.12") (define-obsolete-function-alias - 'eglot-move-to-lsp-abiding-column 'eglot-move-to-utf-16-linepos "1.12") + 'eglot-move-to-lsp-abiding-column #'eglot-move-to-utf-16-linepos "1.12") (define-obsolete-variable-alias -'eglot-move-to-column-function 'eglot-move-to-linepos-function "1.12") + 'eglot-move-to-column-function 'eglot-move-to-linepos-function "1.12") (define-obsolete-variable-alias 'eglot-ignored-server-capabilites 'eglot-ignored-server-capabilities "1.8") ;;;###autoload -(define-obsolete-function-alias 'eglot-update 'eglot-upgrade-eglot "29.1") +(define-obsolete-function-alias 'eglot-update #'eglot-upgrade-eglot "29.1") ;;; User tweakable stuff @@ -193,7 +204,7 @@ automatically)." nil) (interactive (let* ((augmented (mapcar (lambda (a) - (let ((found (eglot--executable-find + (let ((found (compat-call executable-find (car a) t))) (and found (cons (car a) (cons found (cdr a)))))) @@ -213,94 +224,113 @@ automatically)." nil)))) (t (cl-loop for (p . args) in listified - for probe = (eglot--executable-find p t) + for probe = (compat-call executable-find p t) when probe return (cons probe args) finally (funcall err))))))) -(defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ("rust-analyzer")) - ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) - (vimrc-mode . ("vim-language-server" "--stdio")) - ((python-mode python-ts-mode) - . ,(eglot-alternatives - '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server" "ruff-lsp"))) - ((js-json-mode json-mode json-ts-mode) - . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") - ("vscode-json-languageserver" "--stdio") - ("json-languageserver" "--stdio")))) - (((js-mode :language-id "javascript") - (js-ts-mode :language-id "javascript") - (tsx-ts-mode :language-id "typescriptreact") - (typescript-ts-mode :language-id "typescript") - (typescript-mode :language-id "typescript")) - . ("typescript-language-server" "--stdio")) - ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) - ((php-mode phps-mode) - . ,(eglot-alternatives - '(("phpactor" "language-server") - ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) - ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode) - . ,(eglot-alternatives - '("clangd" "ccls"))) - (((caml-mode :language-id "ocaml") - (tuareg-mode :language-id "ocaml") reason-mode) - . ("ocamllsp")) - ((ruby-mode ruby-ts-mode) - . ("solargraph" "socket" "--port" :autoport)) - (haskell-mode - . ("haskell-language-server-wrapper" "--lsp")) - (elm-mode . ("elm-language-server")) - (mint-mode . ("mint" "ls")) - (kotlin-mode . ("kotlin-language-server")) - ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) - . ("gopls")) - ((R-mode ess-r-mode) . ("R" "--slave" "-e" - "languageserver::run()")) - ((java-mode java-ts-mode) . ("jdtls")) - ((dart-mode dart-ts-mode) - . ("dart" "language-server" - "--client-id" "emacs.eglot-dart")) - ((elixir-mode elixir-ts-mode heex-ts-mode) - . ,(if (and (fboundp 'w32-shell-dos-semantics) - (w32-shell-dos-semantics)) - '("language_server.bat") - (eglot-alternatives - '("language_server.sh" "start_lexical.sh")))) - (ada-mode . ("ada_language_server")) - (scala-mode . ,(eglot-alternatives - '("metals" "metals-emacs"))) - (racket-mode . ("racket" "-l" "racket-langserver")) - ((tex-mode context-mode texinfo-mode bibtex-mode) - . ,(eglot-alternatives '("digestif" "texlab"))) - (erlang-mode . ("erlang_ls" "--transport" "stdio")) - ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) - (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) - (nickel-mode . ("nls")) - (gdscript-mode . ("localhost" 6008)) - ((fortran-mode f90-mode) . ("fortls")) - (futhark-mode . ("futhark" "lsp")) - ((lua-mode lua-ts-mode) . ,(eglot-alternatives - '("lua-language-server" "lua-lsp"))) - (zig-mode . ("zls")) - ((css-mode css-ts-mode) - . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") - ("css-languageserver" "--stdio")))) - (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) - ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) - ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) - . ("clojure-lsp")) - ((csharp-mode csharp-ts-mode) - . ,(eglot-alternatives - '(("omnisharp" "-lsp") - ("csharp-ls")))) - (purescript-mode . ("purescript-language-server" "--stdio")) - ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) - (markdown-mode - . ,(eglot-alternatives - '(("marksman" "server") - ("vscode-markdown-language-server" "--stdio")))) - (graphviz-dot-mode . ("dot-language-server" "--stdio")) - (terraform-mode . ("terraform-ls" "serve")) - ((uiua-ts-mode uiua-mode) . ("uiua" "lsp"))) +(defvar eglot-server-programs + ;; FIXME: Maybe this info should be distributed into the major modes + ;; themselves where they could set a buffer-local `eglot-server-program' + ;; instead of keeping this database centralized. + ;; FIXME: With `derived-mode-add-parents' in Emacs≥30, some of + ;; those entries can be simplified, but we keep them for when + ;; `eglot.el' is installed via GNU ELPA in an older Emacs. + `(((rust-ts-mode rust-mode) . ("rust-analyzer")) + ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) + (vimrc-mode . ("vim-language-server" "--stdio")) + ((python-mode python-ts-mode) + . ,(eglot-alternatives + '("pylsp" "pyls" ("basedpyright-langserver" "--stdio") + ("pyright-langserver" "--stdio") + "jedi-language-server" "ruff-lsp"))) + ((js-json-mode json-mode json-ts-mode jsonc-mode) + . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") + ("vscode-json-languageserver" "--stdio") + ("json-languageserver" "--stdio")))) + (((js-mode :language-id "javascript") + (js-ts-mode :language-id "javascript") + (tsx-ts-mode :language-id "typescriptreact") + (typescript-ts-mode :language-id "typescript") + (typescript-mode :language-id "typescript")) + . ("typescript-language-server" "--stdio")) + ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) + ((php-mode phps-mode php-ts-mode) + . ,(eglot-alternatives + '(("phpactor" "language-server") + ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) + ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode) + . ,(eglot-alternatives + '("clangd" "ccls"))) + (((caml-mode :language-id "ocaml") + (tuareg-mode :language-id "ocaml") reason-mode) + . ("ocamllsp")) + ((ruby-mode ruby-ts-mode) + . ("solargraph" "socket" "--port" :autoport)) + (haskell-mode + . ("haskell-language-server-wrapper" "--lsp")) + (elm-mode . ("elm-language-server")) + (mint-mode . ("mint" "ls")) + ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) + ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) + . ("gopls")) + ((R-mode ess-r-mode) . ("R" "--slave" "-e" + "languageserver::run()")) + ((java-mode java-ts-mode) . ("jdtls")) + ((dart-mode dart-ts-mode) + . ("dart" "language-server" + "--client-id" "emacs.eglot-dart")) + ((elixir-mode elixir-ts-mode heex-ts-mode) + . ,(if (and (fboundp 'w32-shell-dos-semantics) + (w32-shell-dos-semantics)) + '("language_server.bat") + (eglot-alternatives + '("language_server.sh" "start_lexical.sh")))) + (ada-mode . ("ada_language_server")) + (scala-mode . ,(eglot-alternatives + '("metals" "metals-emacs"))) + (racket-mode . ("racket" "-l" "racket-langserver")) + ((tex-mode context-mode texinfo-mode bibtex-mode) + . ,(eglot-alternatives '("digestif" "texlab"))) + (erlang-mode . ("erlang_ls" "--transport" "stdio")) + ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) + (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) + (nickel-mode . ("nls")) + ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) + (gdscript-mode . ("localhost" 6008)) + (fennel-mode . ("fennel-ls")) + (move-mode . ("move-analyzer")) + ((fortran-mode f90-mode) . ("fortls")) + (futhark-mode . ("futhark" "lsp")) + ((lua-mode lua-ts-mode) . ,(eglot-alternatives + '("lua-language-server" "lua-lsp"))) + (yang-mode . ("yang-language-server")) + (zig-mode . ("zls")) + ((css-mode css-ts-mode) + . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") + ("css-languageserver" "--stdio")))) + (html-mode . ,(eglot-alternatives + '(("vscode-html-language-server" "--stdio") + ("html-languageserver" "--stdio")))) + ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) + ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) + . ("clojure-lsp")) + ((csharp-mode csharp-ts-mode) + . ,(eglot-alternatives + '(("omnisharp" "-lsp") + ("csharp-ls")))) + (purescript-mode . ("purescript-language-server" "--stdio")) + ((perl-mode cperl-mode) + . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) + (markdown-mode + . ,(eglot-alternatives + '(("marksman" "server") + ("vscode-markdown-language-server" "--stdio")))) + (graphviz-dot-mode . ("dot-language-server" "--stdio")) + (terraform-mode . ("terraform-ls" "serve")) + ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) + (sml-mode + . ,(lambda (_interactive project) + (list "millet-ls" (project-root project))))) "How the command `eglot' guesses the server to start. An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE identifies the buffers that are to be managed by a specific @@ -489,7 +519,10 @@ ACTION is the default value for commands not in the alist." (defcustom eglot-report-progress t "If non-nil, show progress of long running LSP server work. If set to `messages', use *Messages* buffer, else use Eglot's -mode line indicator." +mode line indicator. + +For changes on this variable to take effect, you need to restart +the LSP connection. That can be done by `eglot-reconnect'." :type '(choice (const :tag "Don't show progress" nil) (const :tag "Show progress in *Messages*" messages) (const :tag "Show progress in Eglot's mode line indicator" t)) @@ -566,12 +599,7 @@ It is nil if Eglot is not byte-complied.") (defvaralias 'eglot-{} 'eglot--{}) -(defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.") - -(defun eglot--executable-find (command &optional remote) - "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26." - (if (>= emacs-major-version 27) (executable-find command remote) - (executable-find command))) +(defconst eglot--{} (make-hash-table :size 0) "The empty JSON object.") (defun eglot--accepted-formats () (if (and (not eglot-prefer-plaintext) (fboundp 'gfm-view-mode)) @@ -581,7 +609,7 @@ It is nil if Eglot is not byte-complied.") (let ((vec (copy-sequence url-path-allowed-chars))) (aset vec ?: nil) ;; see github#639 vec) - "Like `url-path-allows-chars' but more restrictive.") + "Like `url-path-allowed-chars' but more restrictive.") ;;; Message verification helpers @@ -977,7 +1005,7 @@ ACTION is an LSP object of either `CodeAction' or `Command' type." [,@(mapcar #'car eglot--tag-faces)]))) :window `(:showDocument (:support t) - :workDoneProgress t) + :workDoneProgress ,(if eglot-report-progress t :json-false)) :general (list :positionEncodings ["utf-32" "utf-8" "utf-16"]) :experimental eglot--{}))) @@ -1037,7 +1065,7 @@ ACTION is an LSP object of either `CodeAction' or `Command' type." (declare-function w32-long-file-name "w32proc.c" (fn)) (defun eglot-uri-to-path (uri) - "Convert URI to file path, helped by `eglot--current-server'." + "Convert URI to file path, helped by `eglot-current-server'." (when (keywordp uri) (setq uri (substring (symbol-name uri) 1))) (let* ((server (eglot-current-server)) (remote-prefix (and server (eglot--trampish-p server))) @@ -1056,15 +1084,21 @@ ACTION is an LSP object of either `CodeAction' or `Command' type." (concat remote-prefix normalized)) uri))) -(defun eglot-path-to-uri (path) - "Convert PATH, a file name, to LSP URI string and return it." - (let ((truepath (file-truename path))) +(cl-defun eglot-path-to-uri (path &key truenamep) + "Convert PATH, a file name, to LSP URI string and return it. +TRUENAMEP indicated PATH is already a truename." + ;; LSP servers should not be expected to access the filesystem, and + ;; therefore are generally oblivious that some filenames are + ;; different, but point to the same file, like a symlink and its + ;; target. Make sure we hand the server the true name of a file by + ;; calling file-truename. + (let ((truepath (if truenamep path (file-truename path)))) (if (and (url-type (url-generic-parse-url path)) - ;; It might be MS Windows path which includes a drive - ;; letter that looks like a URL scheme (bug#59338) + ;; PATH might be MS Windows file name which includes a + ;; drive letter that looks like a URL scheme (bug#59338). (not (and (eq system-type 'windows-nt) (file-name-absolute-p truepath)))) - ;; Path is already a URI, so forward it to the LSP server + ;; PATH is already a URI, so forward it to the LSP server ;; untouched. The server should be able to handle it, since ;; it provided this URI to clients in the first place. path @@ -1705,6 +1739,9 @@ return value is fed through the corresponding inverse function "Calculate number of UTF-16 code units from position given by LBP. LBP defaults to `eglot--bol'." (/ (- (length (encode-coding-region (or lbp (eglot--bol)) + ;; FIXME: How could `point' ever be + ;; larger than `point-max' (sounds like + ;; a bug in Emacs). ;; Fix github#860 (min (point) (point-max)) 'utf-16 t)) 2) @@ -1722,6 +1759,24 @@ LBP defaults to `eglot--bol'." :character (progn (when pos (goto-char pos)) (funcall eglot-current-linepos-function))))) +(defun eglot--virtual-pos-to-lsp-position (pos string) + "Return the LSP position at the end of STRING if it were inserted at POS." + (eglot--widening + (goto-char pos) + (forward-line 0) + ;; LSP line is zero-origin; Emacs is one-origin. + (let ((posline (1- (line-number-at-pos nil t))) + (linebeg (buffer-substring (point) pos)) + (colfun eglot-current-linepos-function)) + ;; Use a temp buffer because: + ;; - I don't know of a fast way to count newlines in a string. + ;; - We currently don't have `eglot-current-linepos-function' for strings. + (with-temp-buffer + (insert linebeg string) + (goto-char (point-max)) + (list :line (+ posline (1- (line-number-at-pos nil t))) + :character (funcall colfun)))))) + (defvar eglot-move-to-linepos-function #'eglot-move-to-utf-16-linepos "Function to move to a position within a line reported by the LSP server. @@ -1788,6 +1843,12 @@ If optional MARKER, return a marker instead" ;;; More helpers +(defconst eglot--uri-path-allowed-chars + (let ((vec (copy-sequence url-path-allowed-chars))) + (aset vec ?: nil) ;; see github#639 + vec) + "Like `url-path-allowed-chars' but more restrictive.") + (defun eglot--snippet-expansion-fn () "Compute a function to expand snippets. Doubles as an indicator of snippet support." @@ -1816,10 +1877,9 @@ Doubles as an indicator of snippet support." (font-lock-ensure) (goto-char (point-min)) (let ((inhibit-read-only t)) - (when (fboundp 'text-property-search-forward) ;; FIXME: use compat - (while (setq match (text-property-search-forward 'invisible)) - (delete-region (prop-match-beginning match) - (prop-match-end match))))) + (while (setq match (text-property-search-forward 'invisible)) + (delete-region (prop-match-beginning match) + (prop-match-end match)))) (string-trim (buffer-string)))))) (defun eglot--read-server (prompt &optional dont-if-just-the-one) @@ -1913,6 +1973,8 @@ For example, to keep your Company customization, add the symbol "A hook run by Eglot after it started/stopped managing a buffer. Use `eglot-managed-p' to determine if current buffer is managed.") +(defvar-local eglot--track-changes nil) + (define-minor-mode eglot--managed-mode "Mode for source buffers managed by some Eglot project." :init-value nil :lighter nil :keymap eglot-mode-map @@ -1926,23 +1988,28 @@ Use `eglot-managed-p' to determine if current buffer is managed.") ("utf-8" (eglot--setq-saving eglot-current-linepos-function #'eglot-utf-8-linepos) (eglot--setq-saving eglot-move-to-linepos-function #'eglot-move-to-utf-8-linepos))) - (add-hook 'after-change-functions 'eglot--after-change nil t) - (add-hook 'before-change-functions 'eglot--before-change nil t) + (if (fboundp 'track-changes-register) + (unless eglot--track-changes + (setq eglot--track-changes + (track-changes-register + #'eglot--track-changes-signal :disjoint t))) + (add-hook 'after-change-functions #'eglot--after-change nil t) + (add-hook 'before-change-functions #'eglot--before-change nil t)) (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t) ;; Prepend "didClose" to the hook after the "nonoff", so it will run first - (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t) - (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t) - (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t) - (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t) - (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t) + (add-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose nil t) + (add-hook 'before-revert-hook #'eglot--signal-textDocument/didClose nil t) + (add-hook 'after-revert-hook #'eglot--after-revert-hook nil t) + (add-hook 'before-save-hook #'eglot--signal-textDocument/willSave nil t) + (add-hook 'after-save-hook #'eglot--signal-textDocument/didSave nil t) (unless (eglot--stay-out-of-p 'xref) - (add-hook 'xref-backend-functions 'eglot-xref-backend nil t)) + (add-hook 'xref-backend-functions #'eglot-xref-backend nil t)) (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t) (add-hook 'completion-in-region-mode-hook #'eglot--capf-session-flush nil t) (add-hook 'company-after-completion-hook #'eglot--capf-session-flush nil t) (add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t) - (add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t) - (add-hook 'pre-command-hook 'eglot--pre-command-hook nil t) + (add-hook 'post-self-insert-hook #'eglot--post-self-insert-hook nil t) + (add-hook 'pre-command-hook #'eglot--pre-command-hook nil t) (eglot--setq-saving xref-prompt-for-identifier nil) (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend)) (eglot--setq-saving company-backends '(company-capf)) @@ -1961,21 +2028,24 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (eldoc-mode 1)) (cl-pushnew (current-buffer) (eglot--managed-buffers (eglot-current-server)))) (t - (remove-hook 'after-change-functions 'eglot--after-change t) - (remove-hook 'before-change-functions 'eglot--before-change t) + (when eglot--track-changes + (track-changes-unregister eglot--track-changes) + (setq eglot--track-changes nil)) + (remove-hook 'after-change-functions #'eglot--after-change t) + (remove-hook 'before-change-functions #'eglot--before-change t) (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t) - (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t) - (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t) - (remove-hook 'after-revert-hook 'eglot--after-revert-hook t) - (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t) - (remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t) - (remove-hook 'xref-backend-functions 'eglot-xref-backend t) + (remove-hook 'kill-buffer-hook #'eglot--signal-textDocument/didClose t) + (remove-hook 'before-revert-hook #'eglot--signal-textDocument/didClose t) + (remove-hook 'after-revert-hook #'eglot--after-revert-hook t) + (remove-hook 'before-save-hook #'eglot--signal-textDocument/willSave t) + (remove-hook 'after-save-hook #'eglot--signal-textDocument/didSave t) + (remove-hook 'xref-backend-functions #'eglot-xref-backend t) (remove-hook 'completion-at-point-functions #'eglot-completion-at-point t) (remove-hook 'completion-in-region-mode-hook #'eglot--capf-session-flush t) (remove-hook 'company-after-completion-hook #'eglot--capf-session-flush t) (remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t) - (remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t) - (remove-hook 'pre-command-hook 'eglot--pre-command-hook t) + (remove-hook 'post-self-insert-hook #'eglot--post-self-insert-hook t) + (remove-hook 'pre-command-hook #'eglot--pre-command-hook t) (remove-hook 'eldoc-documentation-functions #'eglot-hover-eldoc-function t) (remove-hook 'eldoc-documentation-functions #'eglot-signature-eldoc-function t) (cl-loop for (var . saved-binding) in eglot--saved-bindings @@ -2042,7 +2112,7 @@ If it is activated, also signal textDocument/didOpen." (eglot-inlay-hints-mode 1) (run-hooks 'eglot-managed-mode-hook)))) -(add-hook 'after-change-major-mode-hook 'eglot--maybe-activate-editing-mode) +(add-hook 'after-change-major-mode-hook #'eglot--maybe-activate-editing-mode) (defun eglot-clear-status (server) "Clear the last JSONRPC error for SERVER." @@ -2215,12 +2285,12 @@ still unanswered LSP requests to the server\n"))) (put 'eglot-warning 'flymake-category 'flymake-warning) (put 'eglot-error 'flymake-category 'flymake-error) -(defalias 'eglot--make-diag 'flymake-make-diagnostic) -(defalias 'eglot--diag-data 'flymake-diagnostic-data) +(defalias 'eglot--make-diag #'flymake-make-diagnostic) +(defalias 'eglot--diag-data #'flymake-diagnostic-data) (defvar eglot-diagnostics-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'eglot-code-actions-at-mouse) + (define-key map [mouse-2] #'eglot-code-actions-at-mouse) map) "Keymap active in Eglot-backed Flymake diagnostic overlays.") @@ -2312,8 +2382,14 @@ still unanswered LSP requests to the server\n"))) (lambda () (remhash token (eglot--progress-reporters server)))))))))) +(defvar-local eglot--TextDocumentIdentifier-cache nil + "LSP TextDocumentIdentifier-related cached info for current buffer. +Value is (TRUENAME . (:uri STR)), where STR is what is sent to the +server on textDocument/didOpen and similar calls. TRUENAME is the +expensive cached value of `file-truename'.") + (cl-defmethod eglot-handle-notification - (_server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics + (server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode' "Handle notification publishDiagnostics." (cl-flet ((eglot--diag-type (sev) @@ -2322,9 +2398,17 @@ still unanswered LSP requests to the server\n"))) ((= sev 2) 'eglot-warning) (t 'eglot-note))) (mess (source code message) - (concat source (and code (format " [%s]" code)) ": " message))) + (concat source (and code (format " [%s]" code)) ": " message)) + (find-it (abspath) + ;; `find-buffer-visiting' would be natural, but calls the + ;; potentially slow `file-truename' (bug#70036). + (cl-loop for b in (eglot--managed-buffers server) + when (with-current-buffer b + (equal (car eglot--TextDocumentIdentifier-cache) + abspath)) + return b))) (if-let* ((path (expand-file-name (eglot-uri-to-path uri))) - (buffer (find-buffer-visiting path))) + (buffer (find-it path))) (with-current-buffer buffer (cl-loop initially @@ -2450,11 +2534,16 @@ THINGS are either registrations or unregisterations (sic)." `(:success ,success))) (defun eglot--TextDocumentIdentifier () - "Compute TextDocumentIdentifier object for current buffer." - `(:uri ,(eglot-path-to-uri (or buffer-file-name - (ignore-errors - (buffer-file-name - (buffer-base-buffer))))))) + "Compute TextDocumentIdentifier object for current buffer. +Sets `eglot--TextDocumentIdentifier-uri' (which see) as a side effect." + (unless eglot--TextDocumentIdentifier-cache + (let ((truename (file-truename (or buffer-file-name + (ignore-errors + (buffer-file-name + (buffer-base-buffer))))))) + (setq eglot--TextDocumentIdentifier-cache + `(,truename . (:uri ,(eglot-path-to-uri truename :truenamep t)))))) + (cdr eglot--TextDocumentIdentifier-cache)) (defvar-local eglot--versioned-identifier 0) @@ -2579,6 +2668,31 @@ Records BEG, END and PRE-CHANGE-LENGTH locally." `(,lsp-beg ,lsp-end ,pre-change-length ,(buffer-substring-no-properties beg end))))) (_ (setf eglot--recent-changes :emacs-messup))) + (eglot--track-changes-signal nil)) + +(defun eglot--track-changes-fetch (id) + (if (eq eglot--recent-changes :pending) (setq eglot--recent-changes nil)) + (track-changes-fetch + id (lambda (beg end before) + (cl-incf eglot--versioned-identifier) + (cond + ((eq eglot--recent-changes :emacs-messup) nil) + ((eq before 'error) (setf eglot--recent-changes :emacs-messup)) + (t (push `(,(eglot--pos-to-lsp-position beg) + ,(eglot--virtual-pos-to-lsp-position beg before) + ,(length before) + ,(buffer-substring-no-properties beg end)) + eglot--recent-changes)))))) + +(defun eglot--track-changes-signal (id &optional distance) + (cond + (distance + ;; When distance is <100, we may as well coalesce the changes. + (when (> distance 100) (eglot--track-changes-fetch id))) + (eglot--recent-changes nil) + ;; Note that there are pending changes, for the benefit of those + ;; who check it as a boolean. + (t (setq eglot--recent-changes :pending))) (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer)) (let ((buf (current-buffer))) (setq eglot--change-idle-timer @@ -2618,7 +2732,7 @@ root of the current project. It should return an object of the format described above.") ;;;###autoload -(put 'eglot-workspace-configuration 'safe-local-variable 'listp) +(put 'eglot-workspace-configuration 'safe-local-variable #'listp) (defun eglot-show-workspace-configuration (&optional server) "Dump `eglot-workspace-configuration' as JSON for debugging." @@ -2691,6 +2805,8 @@ When called interactively, use the currently active server" (defun eglot--signal-textDocument/didChange () "Send textDocument/didChange to server." + (when eglot--track-changes + (eglot--track-changes-fetch eglot--track-changes)) (when eglot--recent-changes (let* ((server (eglot--current-server-or-lose)) (sync-capability (eglot-server-capable :textDocumentSync)) @@ -2713,7 +2829,7 @@ When called interactively, use the currently active server" ;; empty entries in `eglot--before-change' calls ;; without an `eglot--after-change' reciprocal. ;; Weed them out here. - when (numberp len) + when (numberp len) ;FIXME: Not needed with `track-changes'. vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) (setq eglot--recent-changes nil) @@ -2721,7 +2837,9 @@ When called interactively, use the currently active server" (defun eglot--signal-textDocument/didOpen () "Send textDocument/didOpen to server." - (setq eglot--recent-changes nil eglot--versioned-identifier 0) + (setq eglot--recent-changes nil + eglot--versioned-identifier 0 + eglot--TextDocumentIdentifier-cache nil) (jsonrpc-notify (eglot--current-server-or-lose) :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem)))) @@ -3045,9 +3163,14 @@ for which LSP on-type-formatting should be requested." finally (cl-return comp))) (defun eglot--dumb-allc (pat table pred _point) (funcall table pat pred t)) +(defun eglot--dumb-tryc (pat table pred point) + (let ((probe (funcall table pat pred nil))) + (cond ((eq probe t) t) + (probe (cons probe (length probe))) + (t (cons pat point))))) (add-to-list 'completion-category-defaults '(eglot-capf (styles eglot--dumb-flex))) -(add-to-list 'completion-styles-alist '(eglot--dumb-flex ignore eglot--dumb-allc)) +(add-to-list 'completion-styles-alist '(eglot--dumb-flex eglot--dumb-tryc eglot--dumb-allc)) (defun eglot-completion-at-point () "Eglot's `completion-at-point' function." @@ -3106,7 +3229,8 @@ for which LSP on-type-formatting should be requested." items))) ;; (trace-values "Requested" (length proxies) cachep bounds) (setq eglot--capf-session - (if cachep (list bounds retval resolved orig-pos) :none)) + (if cachep (list bounds retval resolved orig-pos + bounds-string) :none)) (setq local-cache retval))))) (resolve-maybe ;; Maybe completion/resolve JSON object `lsp-comp' into @@ -3126,7 +3250,8 @@ for which LSP on-type-formatting should be requested." (>= (cdr bounds) (cdr (nth 0 eglot--capf-session)))) (setq local-cache (nth 1 eglot--capf-session) resolved (nth 2 eglot--capf-session) - orig-pos (nth 3 eglot--capf-session)) + orig-pos (nth 3 eglot--capf-session) + bounds-string (nth 4 eglot--capf-session)) ;; (trace-values "Recalling cache" (length local-cache) bounds orig-pos) ) (list @@ -3596,16 +3721,17 @@ edit proposed by the server." (defun eglot--code-action-bounds () "Calculate appropriate bounds depending on region and point." - (let (diags) + (let (diags boftap) (cond ((use-region-p) `(,(region-beginning) ,(region-end))) ((setq diags (flymake-diagnostics (point))) (cl-loop for d in diags minimizing (flymake-diagnostic-beg d) into beg maximizing (flymake-diagnostic-end d) into end finally (cl-return (list beg end)))) + ((setq boftap (bounds-of-thing-at-point 'sexp)) + (list (car boftap) (cdr boftap))) (t - (let ((boftap (bounds-of-thing-at-point 'sexp))) - (list (car boftap) (cdr boftap))))))) + (list (point) (point)))))) (defun eglot-code-actions (beg &optional end action-kind interactive) "Find LSP code actions of type ACTION-KIND between BEG and END. @@ -3640,7 +3766,8 @@ at point. With prefix argument, prompt for ACTION-KIND." ;; Redo filtering, in case the `:only' didn't go through. (actions (cl-loop for a across actions when (or (not action-kind) - (equal action-kind (plist-get a :kind))) + ;; github#847 + (string-prefix-p action-kind (plist-get a :kind))) collect a))) (if interactive (eglot--read-execute-code-action actions server action-kind)