[elpa] externals/eglot 37b7329 098/139: Reasonable textDocument/documentHighlight support

[João Távora]

branch: externals/eglot
commit 37b73290e881df071efb6fb44854b05d57d758bf
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    Reasonable textDocument/documentHighlight support
    
    * README.md: Update.
    
    * eglot.el (eglot--current-buffer-TextDocumentPositionParams): New
    helper.
    (xref-backend-identifier-completion-table): Refactor a bit.
    (xref-backend-identifier-at-point): Use when-let and
    eglot--current-buffer-TextDocumentPositionParams
    (xref-backend-definitions, xref-backend-references): Refactor a
    bit.
    (eglot-completion-at-point): Use
    eglot--current-buffer-TextDocumentPositionParams
    (eglot-eldoc-function): Rewrite to handle
    textDocument/documentHighlight.
    (eglot--highlights): New variable.
    (eglot--client-capabilities): Update with support for documentHighlight.
---
 README.md |  13 +++----
 eglot.el  | 117 +++++++++++++++++++++++++++++++++++---------------------------
 2 files changed, 74 insertions(+), 56 deletions(-)

diff --git a/README.md b/README.md
index fef2d16..5838bc5 100644
--- a/README.md
+++ b/README.md
@@ -34,7 +34,7 @@ server. To skip the guess and always be prompted use `C-u M-x 
eglot`.
 - [x] textDocument/completion
 - [ ] completionItem/resolve
 - [x] textDocument/definition
-- [ ] textDocument/documentHighlight
+- [x] textDocument/documentHighlight
 - [x] textDocument/documentSymbol
 - [ ] textDocument/executeCommand
 - [ ] textDocument/format
@@ -46,17 +46,18 @@ server. To skip the guess and always be prompted use `C-u 
M-x eglot`.
 
 # Differences to lsp-mode.el
 
-This is really beta and currently does less than
-[lsp-mode.el][emacs-lsp] which is more
-mature. Though I think `eglot.el` will eventually beat it, you could
-be better served with `lsp-mode.el` for now.
+This is really beta and currently does a little less than
+[lsp-mode.el][emacs-lsp] which is more mature. Though I think
+`eglot.el` will eventually beat it, you could be better served with
+`lsp-mode.el` for now.
 
 User-visible differences:
 
 - Single entry point, `M-x eglot` to enable LSP in a project.
   Automatically detects current and future opened files under that
   project and syncs with server.
-- Easy way to restart a server
+- Easy way to quit/restart a server, just middle/right click on the
+  connection name.
 - Pretty interactive mode-line section for live tracking of server
   communication.
    
diff --git a/eglot.el b/eglot.el
index 807df98..c5c99f2 100644
--- a/eglot.el
+++ b/eglot.el
@@ -193,11 +193,12 @@ CONTACT is as `eglot--contact'.  Returns a process 
object."
                                     :willSave t
                                     :willSaveWaitUntil :json-false
                                     :didSave t)
-                  :completion     `(:dynamicRegistration :json-false)
-                  :hover          `(:dynamicRegistration :json-false)
-                  :references     `(:dynamicRegistration :json-false)
-                  :definition     `(:dynamicRegistration :json-false)
-                  :documentSymbol `(:dynamicRegistration :json-false)
+                  :completion         `(:dynamicRegistration :json-false)
+                  :hover              `(:dynamicRegistration :json-false)
+                  :references         `(:dynamicRegistration :json-false)
+                  :definition         `(:dynamicRegistration :json-false)
+                  :documentSymbol     `(:dynamicRegistration :json-false)
+                  :documentHighlight  `(:dynamicRegistration :json-false)
                   :publishDiagnostics `(:relatedInformation :json-false))
    :experimental (eglot--obj)))
 
@@ -1057,6 +1058,11 @@ running.  INTERACTIVE is t if called interactively."
                  (widen)
                  (buffer-substring-no-properties (point-min) (point-max))))))
 
+(defun eglot--current-buffer-TextDocumentPositionParams ()
+  "Compute TextDocumentPositionParams."
+  (eglot--obj :textDocument (eglot--current-buffer-TextDocumentIdentifier)
+              :position (eglot--pos-to-lsp-position)))
+
 (defun eglot--before-change (start end)
   "Hook onto `before-change-functions'.
 Records START and END, crucially convert them into
@@ -1206,11 +1212,12 @@ DUMMY is ignored"
                (eglot--mapply
                 (eglot--lambda (&key name kind location containerName)
                   (propertize name
-                              :position (plist-get
-                                         (plist-get location :range)
-                                         :start)
+                              :textDocumentPositionParams
+                              (eglot--obj :textDocument text-id
+                                          :position (plist-get
+                                                     (plist-get location 
:range)
+                                                     :start))
                               :locations (list location)
-                              :textDocument text-id
                               :kind kind
                               :containerName containerName))
                 (eglot--sync-request proc
@@ -1220,11 +1227,10 @@ DUMMY is ignored"
          (all-completions string eglot--xref-known-symbols))))))
 
 (cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
-  (let ((symatpt (symbol-at-point)))
-    (when symatpt
-      (propertize (symbol-name symatpt)
-                  :textDocument (eglot--current-buffer-TextDocumentIdentifier)
-                  :position (eglot--pos-to-lsp-position)))))
+  (when-let ((symatpt (symbol-at-point)))
+    (propertize (symbol-name symatpt)
+                :textDocumentPositionParams
+                (eglot--current-buffer-TextDocumentPositionParams))))
 
 (cl-defmethod xref-backend-definitions ((_backend (eql eglot)) identifier)
   (let* ((rich-identifier
@@ -1234,11 +1240,8 @@ DUMMY is ignored"
               (get-text-property 0 :locations rich-identifier)
             (eglot--sync-request (eglot--current-process-or-lose)
                                  :textDocument/definition
-                                 (eglot--obj
-                                  :textDocument
-                                  (get-text-property 0 :textDocument 
identifier)
-                                  :position
-                                  (get-text-property 0 :position 
identifier))))))
+                                 (get-text-property
+                                  0 :textDocumentPositionParams identifier)))))
     (eglot--mapply
      (eglot--lambda (&key uri range)
        (eglot--xref-make identifier uri (plist-get range :start)))
@@ -1246,26 +1249,21 @@ DUMMY is ignored"
 
 (cl-defmethod xref-backend-references ((_backend (eql eglot)) identifier)
   (unless (eglot--server-capable :referencesProvider) (cl-return nil))
-  (let* ((identifier (if (get-text-property 0 :position identifier)
-                         identifier
-                       (car (member identifier eglot--xref-known-symbols))))
-         (position
-          (and identifier (get-text-property 0 :position identifier)))
-         (textDocument
-          (and identifier (get-text-property 0 :textDocument identifier))))
-    (unless (and position textDocument)
-      (eglot--error "Don't know where %s is in the workspace" identifier))
+  (let ((params
+         (or (get-text-property 0 :textDocumentPositionParams identifier)
+             (let ((rich (car (member identifier eglot--xref-known-symbols))))
+               (and rich (get-text-property 0 :textDocumentPositionParams 
rich))))))
+    (unless params
+      (eglot--error "Don' know where %s is in the workspace!" identifier))
     (eglot--mapply
      (eglot--lambda (&key uri range)
        (eglot--xref-make identifier uri (plist-get range :start)))
      (eglot--sync-request (eglot--current-process-or-lose)
                           :textDocument/references
-                          (eglot--obj
-                           :textDocument
-                           textDocument
-                           :position
-                           position
-                           :context (eglot--obj :includeDeclaration t))))))
+                          (append
+                           params
+                           (eglot--obj :context
+                                       (eglot--obj :includeDeclaration t)))))))
 
 (cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
   (when (eglot--server-capable :workspaceSymbolProvider)
@@ -1291,9 +1289,7 @@ DUMMY is ignored"
           (let* ((resp (eglot--sync-request
                         proc
                         :textDocument/completion
-                        (eglot--obj
-                         :textDocument 
(eglot--current-buffer-TextDocumentIdentifier)
-                         :position (eglot--pos-to-lsp-position))))
+                        (eglot--current-buffer-TextDocumentPositionParams)))
                  (items (if (vectorp resp) resp (plist-get resp :items))))
             (eglot--mapply
              (eglot--lambda (&key insertText label kind detail
@@ -1314,21 +1310,42 @@ DUMMY is ignored"
                                       (get-text-property 0 :sortText a)
                                       (get-text-property 0 :sortText b)))))))))
 
+(defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.")
+
 (defun eglot-eldoc-function ()
   "EGLOT's `eldoc-documentation-function' function."
-  (when (eglot--server-capable :hoverProvider)
-    (eglot--request (eglot--current-process-or-lose)
-                    :textDocument/hover
-                    (eglot--obj
-                     :textDocument 
(eglot--current-buffer-TextDocumentIdentifier)
-                     :position (eglot--pos-to-lsp-position))
-                    :success-fn (eglot--lambda (&key contents _range)
-                                  (eldoc-message
-                                   (mapconcat #'eglot--format-markup
-                                              (if (vectorp contents)
-                                                  contents
-                                                (list contents))
-                                              "\n")))))
+  (let ((buffer (current-buffer))
+        (proc (eglot--current-process-or-lose))
+        (position-params (eglot--current-buffer-TextDocumentPositionParams)))
+    (when (eglot--server-capable :hoverProvider)
+      (eglot--request proc :textDocument/hover position-params
+                      :success-fn (eglot--lambda (&key contents _range)
+                                    (eldoc-message
+                                     (mapconcat #'eglot--format-markup
+                                                (if (vectorp contents)
+                                                    contents
+                                                  (list contents))
+                                                "\n")))))
+    (when (eglot--server-capable :documentHighlightProvider)
+      (eglot--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
+                               (eglot--mapply
+                                (eglot--lambda (&key range kind)
+                                  (cl-destructuring-bind (&key start end) range
+                                    (let ((ov (make-overlay
+                                               (eglot--lsp-position-to-point 
start)
+                                               (eglot--lsp-position-to-point 
end)
+                                               buffer)))
+                                      (overlay-put ov 'face 'highlight)
+                                      (overlay-put ov 'evaporate t)
+                                      (overlay-put ov :kind kind)
+                                      ov)))
+                                highlights))))))))
   nil)
 
 (defun eglot-imenu (oldfun)