[elpa] externals/eglot 2f71de72e3 01/15: Fix #131: Make C-u M-. work half decently

[ELPA Syncer]

branch: externals/eglot
commit 2f71de72e3ff7d7763cca141367af8633ad2b3f2
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Fix #131: Make C-u M-. work half decently
    
    * NEWS.md: Mention change.
    
    * eglot.el (eglot--lsp-interface-alist): Add WorkspaceSymbol
    (eglot--workspace-symbols-cache): New variable.
    (eglot--recover-workspace-meta): New helper.
    (xref-backend-identifier-completion-table): Complicate.
    (xref-backend-definitions): Complicate.
    (completion-category-overrides): Register a category and a style here.
    (completion-styles-alist): Add eglot--lsp-backend-style style
    (eglot--lsp-backend-style-call): New funtion.
    (eglot--lsp-backend-style-all-completions): New function.
    (eglot--lsp-backend-style-try-completion): New function.
---
 NEWS.md  |  5 ++++
 eglot.el | 98 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 98 insertions(+), 5 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 9f77dfc398..156fe761bb 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,10 @@
 # (upcoming)
 
+##### C-u M-. lists and completes arbitrary workspace symbols 
[#131][github#131])
+
+A very old request, now made possible by a relatively recent change to
+the `workspace/symbol` RPC method.
+
 ##### Rework mode-line menus ([#792][github#792])
 
 New menus help discover Eglot's features and show which of them are
diff --git a/eglot.el b/eglot.el
index 1b9c997d25..b17bfd1b5c 100644
--- a/eglot.el
+++ b/eglot.el
@@ -417,7 +417,7 @@ This can be useful when using docker to run a language 
server.")
       (TextEdit (:range :newText))
       (VersionedTextDocumentIdentifier (:uri :version) ())
       (WorkspaceEdit () (:changes :documentChanges))
-      )
+      (WorkspaceSymbol (:name :kind) (:containerName :location :data)))
     "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
 
 INTERFACE-NAME is a symbol designated by the spec as
@@ -2102,7 +2102,7 @@ THINGS are either registrations or unregisterations 
(sic)."
       (eglot-format (point) nil last-input-event))))
 
 (defun eglot--pre-command-hook ()
-  "Reset `eglot--last-inserted-char'."
+  "Reset some temporary variables."
   (setq eglot--last-inserted-char nil))
 
 (defun eglot--CompletionParams ()
@@ -2392,8 +2392,53 @@ Try to visit the target file for a richer summary line."
           (eglot--current-server-or-lose))
     (xref-make-match summary (xref-make-file-location file line column) 
length)))
 
+(defvar eglot--workspace-symbols-cache (make-hash-table :test #'equal)
+  "Cache of `workspace/Symbol' results  used by `xref-find-definitions'.")
+
 (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
-  (eglot--error "Cannot (yet) provide reliable completion table for LSP 
symbols"))
+  (if (eglot--server-capable :workspaceSymbolProvider)
+      (let ((buf (current-buffer)))
+        (clrhash eglot--workspace-symbols-cache)
+        (cl-labels ((refresh (pat)
+                      (mapcar
+                       (lambda (wss)
+                         (eglot--dbind ((WorkspaceSymbol) name containerName) 
wss
+                           (propertize
+                            (concat (and (not (zerop (length containerName)))
+                                         (format "%s::" containerName))
+                                    name)
+                            'eglot--lsp-workspaceSymbol wss)))
+                       (with-current-buffer buf
+                         (jsonrpc-request (eglot--current-server-or-lose)
+                                          :workspace/symbol
+                                          `(:query ,pat)))))
+                    (lookup (pat) ;; check cache, else refresh
+                      (let* ((cache eglot--workspace-symbols-cache)
+                             (probe (gethash pat cache :missing)))
+                        (if (eq probe :missing) (puthash pat (refresh pat) 
cache)
+                          probe))))
+          (lambda (string _pred action)
+            (pcase action
+              (`metadata '(metadata
+                           (display-sort-function . identity)
+                           (category . eglot-indirection-joy)))
+              (`(eglot--lsp-tryc . ,point) `(eglot--lsp-tryc . (,string . 
,point)))
+              (`(eglot--lsp-allc . ,_point) `(eglot--lsp-allc . ,(lookup 
string)))
+              (_ nil)))))
+    (eglot--error "This LSP server isn't a :workspaceSymbolProvider")))
+
+(defun eglot--recover-workspace-symbol-meta (string)
+  "Search `eglot--workspace-symbols-cache' for rich entry of STRING."
+  (catch 'found
+    (maphash (lambda (_k v)
+               (while v
+                 ;; Like mess? Ask minibuffer.el about improper lists.
+                 (when (equal (car v) string) (throw 'found (car v)))
+                 (setq v (and (consp v) (cdr v)))))
+             eglot--workspace-symbols-cache)))
+
+(add-to-list 'completion-category-overrides
+             '(eglot-indirection-joy (styles . (eglot--lsp-backend-style))))
 
 (cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
   ;; JT@19/10/09: This is a totally dummy identifier that isn't even
@@ -2456,8 +2501,14 @@ Try to visit the target file for a richer summary line."
   (interactive)
   (eglot--lsp-xref-helper :textDocument/typeDefinition))
 
-(cl-defmethod xref-backend-definitions ((_backend (eql eglot)) _identifier)
-  (eglot--lsp-xrefs-for-method :textDocument/definition))
+(cl-defmethod xref-backend-definitions ((_backend (eql eglot)) id)
+  (let ((probe (eglot--recover-workspace-symbol-meta id)))
+    (if probe
+        (eglot--dbind ((WorkspaceSymbol) name location)
+            (get-text-property 0 'eglot--lsp-workspaceSymbol probe)
+          (eglot--dbind ((Location) uri range) location
+            (list (eglot--xref-make-match name uri range))))
+        (eglot--lsp-xrefs-for-method :textDocument/definition))))
 
 (cl-defmethod xref-backend-references ((_backend (eql eglot)) _identifier)
   (or
@@ -3188,6 +3239,43 @@ If NOERROR, return predicate, else erroring function."
                         'eglot-managed-mode-hook "1.6")
 (provide 'eglot)
 
+
+;;; Backend completion
+
+;; Written by Stefan Monnier circa 2016.  Something to move to
+;; minibuffer.el "ASAP" (with all the `eglot--lsp-' replaced by
+;; something else. The very same code already in SLY and stable for a
+;; long time.
+
+;; This "completion style" delegates all the work to the "programmable
+;; completion" table which is then free to implement its own
+;; completion style.  Typically this is used to take advantage of some
+;; external tool which already has its own completion system and
+;; doesn't give you efficient access to the prefix completion needed
+;; by other completion styles.  The table should recognize the symbols
+;; 'eglot--lsp-tryc and 'eglot--lsp-allc as ACTION, reply with
+;; (eglot--lsp-tryc COMP...) or (eglot--lsp-allc . (STRING . POINT)),
+;; accordingly.  tryc/allc names made akward/recognizable on purpose.
+
+(add-to-list 'completion-styles-alist
+             '(eglot--lsp-backend-style
+               eglot--lsp-backend-style-try-completion
+               eglot--lsp-backend-style-all-completions
+               "Ad-hoc completion style provided by the completion table."))
+
+(defun eglot--lsp-backend-style-call (op string table pred point)
+  (when (functionp table)
+    (let ((res (funcall table string pred (cons op point))))
+      (when (eq op (car-safe res))
+        (cdr res)))))
+
+(defun eglot--lsp-backend-style-try-completion (string table pred point)
+  (eglot--lsp-backend-style-call 'eglot--lsp-tryc string table pred point))
+
+(defun eglot--lsp-backend-style-all-completions (string table pred point)
+  (eglot--lsp-backend-style-call 'eglot--lsp-allc string table pred point))
+
+
 ;; Local Variables:
 ;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)"
 ;; bug-reference-url-format: "https://github.com/joaotavora/eglot/issues/%s";