emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/eglot 870c60a 04/69: Merge master into jsonrpc-refactor


From: João Távora
Subject: [elpa] externals/eglot 870c60a 04/69: Merge master into jsonrpc-refactor (using imerge)
Date: Fri, 22 Jun 2018 11:54:53 -0400 (EDT)

branch: externals/eglot
commit 870c60a581f07a2d25f8fde369e1f2d1c81d21d3
Merge: 2f1d76d 4c0bfc3
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]