branch: externals/eglot
commit 870c60a581f07a2d25f8fde369e1f2d1c81d21d3
Merge: 2f1d76d 4c0bfc3
Author: João Távora <joaotav...@gmail.com>
Commit: João Távora <joaotav...@gmail.com>
Merge master into jsonrpc-refactor (using imerge)
---
.travis.yml | 9 +-
README.md | 28 +++---
eglot-tests.el | 129 +++++++++++++++++++++++++
eglot.el | 301 +++++++++++++++++++++++++++++++++++----------------------
jrpc.el | 10 +-
5 files changed, 344 insertions(+), 133 deletions(-)
diff --git a/.travis.yml b/.travis.yml
index 7a89327..2f0db4c 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -1,5 +1,7 @@
-language: generic
+language: rust
sudo: false
+rust:
+ - stable
env:
global:
@@ -13,7 +15,10 @@ install:
# Configure $PATH: Emacs installed to /tmp/emacs
- export PATH=/tmp/emacs/bin:${PATH}
- emacs --version
-
+ # Install RLS
+ - rustup update
+ - rustup component add rls-preview rust-analysis rust-src
+
script:
- make check
diff --git a/README.md b/README.md
index 4dfe0a6..7550a30 100644
--- a/README.md
+++ b/README.md
@@ -8,12 +8,12 @@ Eglot
(add-to-list 'load-path "/path/to/eglot")
(require 'eglot) ; Requires emacs 26!
-;; Now find some project file inside some Git-controlled dir
+;; Now find some source file, any source file
M-x eglot
```
*That's it*. If you're lucky, this guesses the LSP executable to start
-for the language of your choice, or it prompts you to enter one:
+for the language of your choice. Otherwise, it prompts you to enter one:
`M-x eglot` currently guesses and works out-of-the-box with:
@@ -29,9 +29,9 @@ customize `eglot-server-programs`:
(add-to-list 'eglot-server-programs '(fancy-mode . ("fancy-language-server"
"--args"")))
```
-Let me know how well it works and I'll add it to the list, or submit a
-PR. You can also enter a `server:port` pattern to connect to an LSP
-server. To skip the guess and always be prompted use `C-u M-x eglot`.
+Let me know how well it works and we can add it to the list. You can
+also enter a `server:port` pattern to connect to an LSP server. To
+skip the guess and always be prompted use `C-u M-x eglot`.
# Commands and keybindings
@@ -60,7 +60,7 @@ either:
(define-key eglot-mode-map (kbd "<f6>") 'xref-find-definitions)
```
-# Supported Protocol features
+# Supported Protocol features (3.6)
## General
- [x] initialize
@@ -76,23 +76,24 @@ either:
- [x] telemetry/event
## Client
-- [ ] client/registerCapability
-- [ ] client/unregisterCapability
+- [x] client/registerCapability (but only
+ `workspace/didChangeWatchedFiles`, like RLS asks)
+- [x] client/unregisterCapability (ditto)
## Workspace
- [ ] workspace/workspaceFolders (3.6.0)
- [ ] workspace/didChangeWorkspaceFolders (3.6.0)
- [ ] workspace/didChangeConfiguration
- [ ] workspace/configuration (3.6.0)
-- [ ] workspace/didChangeWatchedFiles
-- [x] workspace/symbol
+- [x] workspace/didChangeWatchedFiles
+- [x] workspace/symbol is
- [x] workspace/applyEdit
## Text Synchronization
- [x] textDocument/didOpen
- [x] textDocument/didChange (incremental or full)
- [x] textDocument/willSave
-- [ ] textDocument/willSaveWaitUntil
+- [x] textDocument/willSaveWaitUntil
- [x] textDocument/didSave
- [x] textDocument/didClose
@@ -103,7 +104,7 @@ either:
- [x] textDocument/completion
- [x] completionItem/resolve (works quite well with
[company-mode][company-mode])
- [x] textDocument/hover
-- [ ] textDocument/signatureHelp
+- [x] textDocument/signatureHelp (fancy stuff with Python's [pyls[pyls]])
- [x] textDocument/definition
- [ ] textDocument/typeDefinition (3.6.0)
- [ ] textDocument/implementation (3.6.0)
@@ -162,7 +163,8 @@ Under the hood:
- Project support doesn't need `projectile.el`, uses Emacs's `project.el`
- Requires the upcoming Emacs 26
- Contained in one file
-- Its missing tests! This is *not good*
+- Has automated tests that check against actual LSP servers
+
[lsp]: https://microsoft.github.io/language-server-protocol/
[rls]: https://github.com/rust-lang-nursery/rls
diff --git a/eglot-tests.el b/eglot-tests.el
index 0f29519..e0ed324 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -24,9 +24,138 @@
;;; Code:
(require 'eglot)
+(require 'cl-lib)
(require 'ert)
+;; Helpers
+
+(defmacro eglot--with-dirs-and-files (dirs &rest body)
+ (declare (indent defun) (debug t))
+ `(eglot--call-with-dirs-and-files
+ ,dirs #'(lambda () ,@body)))
+
+(defun eglot--make-file-or-dirs (ass)
+ (let ((file-or-dir-name (car ass))
+ (content (cdr ass)))
+ (cond ((listp content)
+ (make-directory file-or-dir-name 'parents)
+ (let ((default-directory (concat default-directory "/"
file-or-dir-name)))
+ (mapc #'eglot--make-file-or-dirs content)))
+ ((stringp content)
+ (with-temp-buffer
+ (insert content)
+ (write-region nil nil file-or-dir-name nil 'nomessage)))
+ (t
+ (message "[yas] oops don't know this content")))))
+
+(defun eglot--call-with-dirs-and-files (dirs fn)
+ (let* ((default-directory (make-temp-file "eglot--fixture" t))
+ new-buffers new-processes)
+ (with-temp-message ""
+ (unwind-protect
+ (let ((find-file-hook
+ (cons (lambda () (push (current-buffer) new-buffers))
+ find-file-hook))
+ (eglot-connect-hook
+ (lambda (proc) (push proc new-processes))))
+ (mapc #'eglot--make-file-or-dirs dirs)
+ (funcall fn))
+ (eglot--message "Killing buffers %s, deleting %s, killing %s"
+ (mapconcat #'buffer-name new-buffers ", ")
+ default-directory
+ new-processes)
+ (delete-directory default-directory 'recursive)
+ (let ((eglot-autoreconnect nil))
+ (mapc #'eglot-shutdown
+ (cl-remove-if-not #'process-live-p new-processes)))
+ (mapc #'kill-buffer new-buffers)))))
+
+(cl-defmacro eglot--with-test-timeout (timeout &body body)
+ (declare (indent 1) (debug t))
+ `(eglot--call-with-test-timeout ,timeout (lambda () ,@body)))
+
+(defun eglot--call-with-test-timeout (timeout fn)
+ (let* ((tag (make-symbol "tag"))
+ (timed-out (make-symbol "timeout"))
+ (timer )
+ (jrpc-request-timeout 1)
+ (retval))
+ (unwind-protect
+ (setq retval
+ (catch tag
+ (setq timer
+ (run-with-timer timeout nil
+ (lambda () ;; (throw tag timed-out)
+ )))
+ (funcall fn)))
+ (cancel-timer timer)
+ (when (eq retval timed-out)
+ (error "Test timeout!")))))
+
+(defun eglot--find-file-noselect (file &optional noerror)
+ (unless (or noerror
+ (file-readable-p file)) (error "%s does not exist" file))
+ (find-file-noselect file))
+
+
+;; `rust-mode' is not a part of emacs. So define these two shims which
+;; should be more than enough for testing
+(unless (functionp 'rust-mode)
+ (define-derived-mode rust-mode prog-mode "Rust"))
+(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-mode))
+
+
(ert-deftest dummy () "A dummy test" (should t))
+(ert-deftest auto-detect-running-server ()
+ "Visit a file and M-x eglot, then visit a neighbour. "
+ (let (proc)
+ (eglot--with-test-timeout 2
+ (eglot--with-dirs-and-files
+ '(("project" . (("coiso.rs" . "bla")
+ ("merdix.rs" . "bla")))
+ ("anotherproject" . (("cena.rs" . "bla"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/coiso.rs")
+ (setq proc
+ (eglot 'rust-mode `(transient . ,default-directory)
+ '("rls")))
+ (should (jrpc-current-process)))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/merdix.rs")
+ (should (jrpc-current-process))
+ (should (eq (jrpc-current-process) proc)))
+ (with-current-buffer
+ (eglot--find-file-noselect "anotherproject/cena.rs")
+ (should-error (jrpc-current-process-or-lose)))))))
+
+(ert-deftest auto-reconnect ()
+ "Start a server. Kill it. Watch it reconnect."
+ (let (proc
+ (eglot-autoreconnect 1))
+ (eglot--with-test-timeout 3
+ (eglot--with-dirs-and-files
+ '(("project" . (("coiso.rs" . "bla")
+ ("merdix.rs" . "bla"))))
+ (with-current-buffer
+ (eglot--find-file-noselect "project/coiso.rs")
+ (setq proc
+ (eglot 'rust-mode `(transient . ,default-directory)
+ '("rls")))
+ ;; In 1.2 seconds > `eglot-autoreconnect' kill servers. We
+ ;; should have a automatic reconnection.
+ (run-with-timer 1.2 nil (lambda () (delete-process proc)))
+ (while (process-live-p proc) (accept-process-output nil 0.5))
+ (should (jrpc-current-process))
+ ;; Now try again too quickly
+ (setq proc (jrpc-current-process))
+ (run-with-timer 0.5 nil (lambda () (delete-process proc)))
+ (while (process-live-p proc) (accept-process-output nil 0.5))
+ (should (not (jrpc-current-process))))))))
+
(provide 'eglot-tests)
;;; eglot-tests.el ends here
+
+;; Local Variables:
+;; checkdoc-force-docstrings-flag: nil
+;; End:
diff --git a/eglot.el b/eglot.el
index f33a851..879972d 100644
--- a/eglot.el
+++ b/eglot.el
@@ -24,8 +24,7 @@
;;; Commentary:
-;; M-x eglot in some file under some .git controlled dir should get
-;; you started, but see README.md.
+;; Simply M-x eglot should be enough to get you started, but see README.md.
;;; Code:
@@ -41,6 +40,7 @@
(require 'xref)
(require 'subr-x)
(require 'jrpc)
+(require 'filenotify)
;;; User tweakable stuff
@@ -93,12 +93,19 @@ A list (ID WHAT DONE-P).")
(jrpc-define-process-var eglot--inhibit-autoreconnect eglot-autoreconnect
"If non-nil, don't autoreconnect on unexpected quit.")
+(jrpc-define-process-var eglot--file-watches (make-hash-table :test #'equal)
+ "File system watches for the didChangeWatchedfiles thingy.")
+
(defun eglot--on-shutdown (proc)
;; Turn off `eglot--managed-mode' where appropriate.
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (eglot--buffer-managed-p proc)
(eglot--managed-mode -1))))
+ ;; Kill any expensive watches
+ (maphash (lambda (_id watches)
+ (mapcar #'file-notify-rm-watch watches))
+ (eglot--file-watches proc))
;; Sever the project/process relationship for proc
(setf (gethash (eglot--project proc) eglot--processes-by-project)
(delq proc
@@ -129,9 +136,9 @@ called interactively."
(defun eglot--find-current-process ()
"The current logical EGLOT process."
- (let* ((cur (project-current))
- (processes (and cur (gethash cur eglot--processes-by-project))))
- (cl-find major-mode processes :key #'eglot--major-mode)))
+ (let* ((probe (or (project-current) (cons 'transient default-directory))))
+ (cl-find major-mode (gethash probe eglot--processes-by-project)
+ :key #'eglot--major-mode)))
(defun eglot--project-short-name (project)
"Give PROJECT a short name."
@@ -149,15 +156,17 @@ called interactively."
"What the EGLOT LSP client supports."
(jrpc-obj
:workspace (jrpc-obj
+ :applyEdit t
+ :workspaceEdit `(:documentChanges :json-false)
+ :didChangeWatchesFiles `(:dynamicRegistration t)
:symbol `(:dynamicRegistration :json-false))
:textDocument (jrpc-obj
:synchronization (jrpc-obj
:dynamicRegistration :json-false
- :willSave t
- :willSaveWaitUntil :json-false
- :didSave t)
+ :willSave t :willSaveWaitUntil t :didSave
t)
:completion `(:dynamicRegistration :json-false)
:hover `(:dynamicRegistration :json-false)
+ :signatureHelp `(:dynamicRegistration :json-false)
:references `(:dynamicRegistration :json-false)
:definition `(:dynamicRegistration :json-false)
:documentSymbol `(:dynamicRegistration :json-false)
@@ -199,6 +208,7 @@ called interactively."
"\n" base-prompt)))))
(list
managed-mode
+ (or (project-current) `(transient . default-directory))
(if prompt
(split-string-and-unquote
(read-shell-command prompt
@@ -209,11 +219,13 @@ called interactively."
t)))
;;;###autoload
-(defun eglot (managed-major-mode command &optional interactive)
+(defun eglot (managed-major-mode project command &optional interactive)
"Start a Language Server Protocol server.
Server is started with COMMAND and manages buffers of
MANAGED-MAJOR-MODE for the current project.
+PROJECT is a project instance as returned by `project-current'.
+
COMMAND is a list of strings, an executable program and
optionally its arguments. If the first and only string in the
list is of the form \"<host>:<port>\" it is taken as an
@@ -230,11 +242,7 @@ MANAGED-MAJOR-MODE.
INTERACTIVE is t if called interactively."
(interactive (eglot--interactive))
- (let* ((project (project-current))
- (short-name (eglot--project-short-name project)))
- (unless project (eglot--error "Cannot work without a current project!"))
- (unless command (eglot--error "Don't know how to start EGLOT for %s
buffers"
- major-mode))
+ (let* ((short-name (eglot--project-short-name project)))
(let ((current-process (jrpc-current-process)))
(if (and (process-live-p current-process)
interactive
@@ -249,7 +257,8 @@ INTERACTIVE is t if called interactively."
interactive)))
(eglot--message "Connected! Process `%s' now \
managing `%s' buffers in project `%s'."
- proc managed-major-mode short-name))))))
+ proc managed-major-mode short-name)
+ proc)))))
(defun eglot-reconnect (process &optional interactive)
"Reconnect to PROCESS.
@@ -266,12 +275,15 @@ INTERACTIVE is t if called interactively."
(defalias 'eglot-events-buffer 'jrpc-events-buffer)
+(defvar eglot-connect-hook nil "Hook run after connecting in
`eglot--connect'.")
+
(defun eglot--connect (project managed-major-mode name command
dont-inhibit)
(let ((proc (jrpc-connect name command "eglot--server-"
#'eglot--on-shutdown)))
(setf (eglot--project proc) project)
(setf (eglot--major-mode proc)managed-major-mode)
(push proc (gethash project eglot--processes-by-project))
+ (run-hook-with-args 'eglot-connect-hook proc)
(cl-destructuring-bind (&key capabilities)
(jrpc-request
proc
@@ -461,10 +473,6 @@ that case, also signal textDocument/didOpen."
;;; Mode-line, menu and other sugar
;;;
-(defvar eglot-menu)
-
-(easy-menu-define eglot-menu eglot-mode-map "EGLOT" `("EGLOT" ))
-
(defvar eglot--mode-line-format `(:eval (eglot--mode-line-format)))
(put 'eglot--mode-line-format 'risky-local-variable t)
@@ -498,8 +506,7 @@ Uses THING, FACE, DEFS and PREPEND."
(`(,_id ,doing ,done-p ,detail) (and proc (eglot--spinner
proc)))
(`(,status ,serious-p) (and proc (jrpc-status proc))))
(append
- `(,(eglot--mode-line-props "eglot" 'eglot-mode-line
- '((down-mouse-1 eglot-menu "pop up EGLOT
menu"))))
+ `(,(eglot--mode-line-props "eglot" 'eglot-mode-line nil))
(when name
`(":" ,(eglot--mode-line-props
name 'eglot-mode-line
@@ -597,36 +604,35 @@ Uses THING, FACE, DEFS and PREPEND."
(t
(eglot--message "OK so %s isn't visited" filename)))))
+(cl-defun eglot--register-unregister (proc jsonrpc-id things how)
+ "Helper for `eglot--server-client/registerCapability'.
+THINGS are either registrations or unregisterations."
+ (dolist (thing (cl-coerce things 'list))
+ (cl-destructuring-bind (&key id method registerOptions) thing
+ (let (retval)
+ (unwind-protect
+ (setq retval (apply (intern (format "eglot--%s-%s" how method))
+ proc :id id registerOptions))
+ (unless (eq t (car retval))
+ (cl-return-from eglot--register-unregister
+ (jrpc-reply
+ proc jsonrpc-id
+ :error `(:code -32601 :message ,(or (cadr retval)
"sorry")))))))))
+ (jrpc-reply proc jsonrpc-id :result (jrpc-obj :message "OK")))
+
(cl-defun eglot--server-client/registerCapability
(proc &key id registrations)
- "Handle notification client/registerCapability"
- (let ((jrpc-id id)
- (done (make-symbol "done")))
- (catch done
- (mapc
- (lambda (reg)
- (apply
- (cl-function
- (lambda (&key id method registerOptions)
- (pcase-let*
- ((handler-sym (intern (concat "eglot--register-"
- method)))
- (`(,ok ,message)
- (and (functionp handler-sym)
- (apply handler-sym proc :id id registerOptions))))
- (unless ok
- (throw done
- (jrpc-reply proc jrpc-id
- :error (jrpc-obj
- :code -32601
- :message (or message "sorry
:-("))))))))
- reg))
- registrations)
- (jrpc-reply proc id :result (jrpc-obj :message "OK")))))
+ "Handle server request client/registerCapability"
+ (eglot--register-unregister proc id registrations 'register))
+
+(cl-defun eglot--server-client/unregisterCapability
+ (proc &key id unregisterations) ;; XXX: Yeah, typo and all.. See spec...
+ "Handle server request client/unregisterCapability"
+ (eglot--register-unregister proc id unregisterations 'unregister))
(cl-defun eglot--server-workspace/applyEdit
(proc &key id _label edit)
- "Handle notification client/registerCapability"
+ "Handle server request workspace/applyEdit"
(condition-case err
(progn
(eglot--apply-workspace-edit edit 'confirm)
@@ -737,26 +743,27 @@ Records START, END and PRE-CHANGE-LENGTH locally."
(defun eglot--signal-textDocument/didOpen ()
"Send textDocument/didOpen to server."
(setq eglot--recent-changes (cons [] []))
- (jrpc-notify (jrpc-current-process-or-lose)
- :textDocument/didOpen
- (jrpc-obj :textDocument
- (eglot--TextDocumentItem))))
+ (jrpc-notify
+ (jrpc-current-process-or-lose)
+ :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
(defun eglot--signal-textDocument/didClose ()
"Send textDocument/didClose to server."
- (jrpc-notify (jrpc-current-process-or-lose)
- :textDocument/didClose
- (jrpc-obj :textDocument
- (eglot--TextDocumentIdentifier))))
+ (jrpc-notify
+ (jrpc-current-process-or-lose)
+ :textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier))))
(defun eglot--signal-textDocument/willSave ()
"Send textDocument/willSave to server."
- (jrpc-notify
- (jrpc-current-process-or-lose)
- :textDocument/willSave
- (jrpc-obj
- :reason 1 ; Manual, emacs laughs in the face of auto-save muahahahaha
- :textDocument (eglot--TextDocumentIdentifier))))
+ (let ((proc (jrpc-current-process-or-lose))
+ (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
+ (jrpc-notify proc :textDocument/willSave params)
+ (ignore-errors
+ (let ((jrpc-request-timeout 0.5))
+ (when (plist-get :willSaveWaitUntil
+ (eglot--server-capable :textDocumentSync))
+ (eglot--apply-text-edits
+ (jrpc-request proc :textDocument/willSaveWaituntil params)))))))
(defun eglot--signal-textDocument/didSave ()
"Send textDocument/didSave to server."
@@ -936,6 +943,28 @@ DUMMY is ignored"
(contents
(list contents)))) "\n")))
+(defun eglot--sig-info (sigs active-sig active-param)
+ (cl-loop
+ for (sig . moresigs) on (append sigs nil) for i from 0
+ concat (cl-destructuring-bind (&key label _documentation parameters) sig
+ (let (active-doc)
+ (concat
+ (propertize (replace-regexp-in-string "(.*$" "(" label)
+ 'face 'font-lock-function-name-face)
+ (cl-loop
+ for (param . moreparams) on (append parameters nil) for j from 0
+ concat (cl-destructuring-bind (&key label documentation) param
+ (when (and (eql j active-param) (eql i active-sig))
+ (setq label (propertize
+ label
+ 'face
'eldoc-highlight-function-argument))
+ (when documentation
+ (setq active-doc (concat label ": "
documentation))))
+ label)
+ if moreparams concat ", " else concat ")")
+ (when active-doc (concat "\n" active-doc)))))
+ when moresigs concat "\n"))
+
(defun eglot-help-at-point ()
"Request \"hover\" information for the thing at point."
(interactive)
@@ -948,35 +977,51 @@ DUMMY is ignored"
(insert (eglot--hover-info contents range))))))
(defun eglot-eldoc-function ()
- "EGLOT's `eldoc-documentation-function' function."
- (let ((buffer (current-buffer))
- (proc (jrpc-current-process-or-lose))
- (position-params (eglot--TextDocumentPositionParams)))
- (when (eglot--server-capable :hoverProvider)
- (jrpc-async-request
- proc :textDocument/hover position-params
- :success-fn (jrpc-lambda (&key contents range)
- (when (get-buffer-window buffer)
- (with-current-buffer buffer
- (eldoc-message (eglot--hover-info contents range)))))
- :deferred :textDocument/hover))
- (when (eglot--server-capable :documentHighlightProvider)
- (jrpc-async-request
- proc :textDocument/documentHighlight position-params
- :success-fn (lambda (highlights)
- (mapc #'delete-overlay eglot--highlights)
- (setq eglot--highlights
- (when (get-buffer-window buffer)
- (with-current-buffer buffer
- (jrpc-mapply
- (jrpc-lambda (&key range _kind)
- (eglot--with-lsp-range (beg end) range
- (let ((ov (make-overlay beg end)))
- (overlay-put ov 'face 'highlight)
- (overlay-put ov 'evaporate t)
- ov)))
- highlights)))))
- :deferred :textDocument/documentHighlight)))
+ "EGLOT's `eldoc-documentation-function' function.
+If SKIP-SIGNATURE, don't try to send textDocument/signatureHelp."
+ (let* ((buffer (current-buffer))
+ (proc (jrpc-current-process-or-lose))
+ (position-params (eglot--TextDocumentPositionParams))
+ sig-showing)
+ (cl-macrolet ((when-buffer-window
+ (&body body) `(when (get-buffer-window buffer)
+ (with-current-buffer buffer ,@body))))
+ (when (eglot--server-capable :signatureHelpProvider)
+ (jrpc-async-request
+ proc :textDocument/signatureHelp position-params
+ :success-fn (jrpc-lambda (&key signatures activeSignature
+ activeParameter)
+ (when-buffer-window
+ (when (cl-plusp (length signatures))
+ (setq sig-showing t)
+ (eldoc-message (eglot--sig-info signatures
+ activeSignature
+ activeParameter)))))
+ :deferred :textDocument/signatureHelp))
+ (when (eglot--server-capable :hoverProvider)
+ (jrpc-async-request
+ proc :textDocument/hover position-params
+ :success-fn (jrpc-lambda (&key contents range)
+ (unless sig-showing
+ (when-buffer-window
+ (eldoc-message (eglot--hover-info contents range)))))
+ :deferred :textDocument/hover))
+ (when (eglot--server-capable :documentHighlightProvider)
+ (jrpc-async-request
+ proc :textDocument/documentHighlight position-params
+ :success-fn (lambda (highlights)
+ (mapc #'delete-overlay eglot--highlights)
+ (setq eglot--highlights
+ (when-buffer-window
+ (jrpc-mapply
+ (jrpc-lambda (&key range _kind)
+ (eglot--with-lsp-range (beg end) range
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face 'highlight)
+ (overlay-put ov 'evaporate t)
+ ov)))
+ highlights))))
+ :deferred :textDocument/documentHighlight))))
nil)
(defun eglot-imenu (oldfun)
@@ -998,22 +1043,20 @@ DUMMY is ignored"
entries))
(funcall oldfun)))
-(defun eglot--apply-text-edits (buffer edits &optional version)
- "Apply the EDITS for BUFFER."
- (with-current-buffer buffer
- (unless (or (not version)
- (equal version eglot--versioned-identifier))
- (eglot--error "Edits on `%s' require version %d, you have %d"
- buffer version eglot--versioned-identifier))
- (jrpc-mapply
- (jrpc-lambda (&key range newText)
- (save-restriction
- (widen)
- (save-excursion
- (eglot--with-lsp-range (beg end) range
- (goto-char beg) (delete-region beg end) (insert newText)))))
- edits)
- (eglot--message "%s: Performed %s edits" (current-buffer) (length edits))))
+(defun eglot--apply-text-edits (edits &optional version)
+ "Apply EDITS for current buffer if at VERSION, or if it's nil."
+ (unless (or (not version) (equal version eglot--versioned-identifier))
+ (eglot--error "Edits on `%s' require version %d, you have %d"
+ (current-buffer) version eglot--versioned-identifier))
+ (jrpc-mapply
+ (jrpc-lambda (&key range newText)
+ (save-restriction
+ (widen)
+ (save-excursion
+ (eglot--with-lsp-range (beg end) range
+ (goto-char beg) (delete-region beg end) (insert newText)))))
+ edits)
+ (eglot--message "%s: Performed %s edits" (current-buffer) (length edits)))
(defun eglot--apply-workspace-edit (wedit &optional confirm)
"Apply the workspace edit WEDIT. If CONFIRM, ask user first."
@@ -1043,9 +1086,8 @@ Proceed? "
(let (edit)
(while (setq edit (car prepared))
(cl-destructuring-bind (path edits &optional version) edit
- (eglot--apply-text-edits (find-file-noselect path)
- edits
- version)
+ (with-current-buffer (find-file-noselect path)
+ (eglot--apply-text-edits edits version))
(pop prepared))))
(if prepared
(eglot--warn "Caution: edits of files %s failed."
@@ -1067,12 +1109,45 @@ Proceed? "
;;; Dynamic registration
;;;
-(cl-defun eglot--register-workspace/didChangeWatchedFiles
- (_proc &key _id _watchers)
+(cl-defun eglot--register-workspace/didChangeWatchedFiles (proc &key id
watchers)
"Handle dynamic registration of workspace/didChangeWatchedFiles"
- ;; TODO: file-notify-add-watch and
- ;; file-notify-rm-watch can probably handle this
- (list nil "Sorry, can't do this yet"))
+ (eglot--unregister-workspace/didChangeWatchedFiles proc :id id)
+ (let* (success
+ (globs (mapcar (lambda (w) (plist-get w :globPattern)) watchers)))
+ (cl-labels
+ ((handle-event
+ (event)
+ (cl-destructuring-bind (desc action file &optional file1) event
+ (cond
+ ((and (memq action '(created changed deleted))
+ (cl-find file globs
+ :test (lambda (f glob)
+ (string-match (wildcard-to-regexp
+ (expand-file-name glob))
+ f))))
+ (jrpc-notify
+ proc :workspace/didChangeWatchedFiles
+ `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
+ :type ,(cl-case action
+ (created 1)
+ (changed 2)
+ (deleted 3)))))))
+ ((eq action 'renamed)
+ (handle-event desc 'deleted file)
+ (handle-event desc 'created file1))))))
+ (unwind-protect
+ (progn (dolist (dir (delete-dups (mapcar #'file-name-directory
globs)))
+ (push (file-notify-add-watch dir '(change) #'handle-event)
+ (gethash id (eglot--file-watches proc))))
+ (setq success `(t "OK")))
+ (unless success
+ (eglot--unregister-workspace/didChangeWatchedFiles proc :id id))))))
+
+(cl-defun eglot--unregister-workspace/didChangeWatchedFiles (proc &key id)
+ "Handle dynamic unregistration of workspace/didChangeWatchedFiles"
+ (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches proc)))
+ (remhash id (eglot--file-watches proc))
+ (list t "OK"))
;;; Rust-specific
diff --git a/jrpc.el b/jrpc.el
index 876f236..973e901 100644
--- a/jrpc.el
+++ b/jrpc.el
@@ -117,10 +117,10 @@ A list (WHAT SERIOUS-P).")
(jrpc-define-process-var jrpc-contact nil
"Method used to contact a server.")
-(jrpc-define-process-var jrpc--shutdown-hook nil
- "Hook run when JSON-RPC server is dying.
+(jrpc-define-process-var jrpc--on-shutdown nil
+ "Function run when JSON-RPC server is dying.
Run after running any error handlers for outstanding requests.
-Each hook function is passed the process object for the server.")
+A function passed the process object for the server.")
(jrpc-define-process-var jrpc--deferred-actions
(make-hash-table :test #'equal)
@@ -188,7 +188,7 @@ Returns a process object representing the server."
(setf (jrpc-contact proc) contact
(jrpc-name proc) name
(jrpc--method-prefix proc) prefix
- (jrpc--shutdown-hook proc) on-shutdown)
+ (jrpc--on-shutdown proc) on-shutdown)
(with-current-buffer buffer
(let ((inhibit-read-only t))
(erase-buffer)
@@ -214,7 +214,7 @@ Returns a process object representing the server."
(funcall error :code -1 :message (format "Server died"))))
(jrpc--pending-continuations proc))
(jrpc-message "Server exited with status %s" (process-exit-status proc))
- (funcall (or (jrpc--shutdown-hook proc) #'identity) proc)
+ (funcall (or (jrpc--on-shutdown proc) #'identity) proc)
(delete-process proc))))
(defun jrpc--process-filter (proc string)
