[elpa] externals/elpa da04fdc 14/71: Close #303: support hierarchical DocumentSymbol in eglot-imenu

[João Távora]

branch: externals/elpa
commit da04fdcf62b622f7d7e6ddba0ea3e95e9143270f
Author: Ingo Lohmar <ingo.lohmar@github.com>
Commit: João Távora <joaotavora@gmail.com>

    Close #303: support hierarchical DocumentSymbol in eglot-imenu
    
    A reworking of an original implementation by Ingo Lohmar
    <ingo.lohmar@github.com>
    
    * eglot.el (eglot-client-capabilities, defvar): Add
    DocumentSymbol.
    (eglot-client-capabilities): Add
    :hierarchicalDocumentSymbolSupport.
    (eglot--parse-DocumentSymbol): Remove.
    (eglot-imenu): Rewrite.
    
    * NEWS.md (1.7): Mention new feature
---
 NEWS.md  |  9 +++++++-
 eglot.el | 79 ++++++++++++++++++++++++++++++++++++++++------------------------
 2 files changed, 57 insertions(+), 31 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 2d2ae3c..9be8588 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,4 +1,10 @@
-# 1.6 (16/20/2020)
+# 1.7 (upcoming)
+
+##### Support hierarchical symbols in Imenu ([#303][github#303])
+
+Thanks to Ingo Lohmar for the original implementation.
+
+# 1.6 (16/04/2020)
 
 ##### Column offset calculation is now LSP-conform ([#361][github#361])
 
@@ -207,6 +213,7 @@ and now said bunch of references-->
 [github#270]: https://github.com/joaotavora/eglot/issues/270
 [github#279]: https://github.com/joaotavora/eglot/issues/279
 [github#302]: https://github.com/joaotavora/eglot/issues/302
+[github#303]: https://github.com/joaotavora/eglot/issues/303
 [github#304]: https://github.com/joaotavora/eglot/issues/304
 [github#311]: https://github.com/joaotavora/eglot/issues/311
 [github#313]: https://github.com/joaotavora/eglot/issues/313
diff --git a/eglot.el b/eglot.el
index 42fca9b..afb7063c 100644
--- a/eglot.el
+++ b/eglot.el
@@ -56,6 +56,7 @@
 ;;; Code:
 
 (require 'json)
+(require 'imenu)
 (require 'cl-lib)
 (require 'project)
 (require 'url-parse)
@@ -255,7 +256,12 @@ let the buffer grow forever."
       (ShowMessageRequestParams (:type :message) (:actions))
       (SignatureHelp (:signatures) (:activeSignature :activeParameter))
       (SignatureInformation (:label) (:documentation :parameters))
-      (SymbolInformation (:name :kind :location) (:deprecated :containerName))
+      (SymbolInformation (:name :kind :location)
+                         (:deprecated :containerName))
+      (DocumentSymbol (:name :range :selectionRange :kind)
+                      ;; `:containerName' isn't really allowed , but
+                      ;; it simplifies the impl of `eglot-imenu'.
+                      (:detail :deprecated :children :containerName))
       (TextDocumentEdit (:textDocument :edits) ())
       (TextEdit (:range :newText))
       (VersionedTextDocumentIdentifier (:uri :version) ())
@@ -532,6 +538,7 @@ treated as in `eglot-dbind'."
              :typeDefinition     `(:dynamicRegistration :json-false)
              :documentSymbol     (list
                                   :dynamicRegistration :json-false
+                                  :hierarchicalDocumentSymbolSupport t
                                   :symbolKind `(:valueSet
                                                 [,@(mapcar
                                                     #'car 
eglot--symbol-kind-names)]))
@@ -2361,36 +2368,48 @@ echo area cleared of any previous documentation."
 
 (defun eglot-imenu ()
   "EGLOT's `imenu-create-index-function'."
-  (let ((entries
-         (and
-          (eglot--server-capable :documentSymbolProvider)
-          (mapcar
-           (eglot--lambda
-               ((SymbolInformation) name kind location containerName)
-             (cons (propertize
-                    name
-                    :kind (alist-get kind eglot--symbol-kind-names
-                                     "Unknown")
-                    :containerName (and (stringp containerName)
-                                        (not (string-empty-p containerName))
-                                        containerName))
-                   (eglot--lsp-position-to-point
-                    (plist-get (plist-get location :range) :start))))
-           (jsonrpc-request (eglot--current-server-or-lose)
-                            :textDocument/documentSymbol
-                            `(:textDocument 
,(eglot--TextDocumentIdentifier)))))))
+  (cl-labels
+      ((visit (_name one-obj-array)
+              (imenu-default-goto-function
+               nil (car (eglot--range-region
+                         (eglot--dcase (aref one-obj-array 0)
+                           (((SymbolInformation) location)
+                            (plist-get location :range))
+                           (((DocumentSymbol) selectionRange)
+                            selectionRange))))))
+       (unfurl (obj)
+               (eglot--dcase obj
+                 (((SymbolInformation)) (list obj))
+                 (((DocumentSymbol) name children)
+                  (cons obj
+                        (mapcar
+                         (lambda (c)
+                           (plist-put
+                            c :containerName
+                            (let ((existing (plist-get c :containerName)))
+                              (if existing (format "%s::%s" name existing)
+                                name))))
+                         (mapcan #'unfurl children)))))))
     (mapcar
-     (pcase-lambda (`(,kind . ,syms))
-       (let ((syms-by-scope (seq-group-by
-                             (lambda (e)
-                               (get-text-property 0 :containerName (car e)))
-                             syms)))
-         (cons kind (cl-loop for (scope . elems) in syms-by-scope
-                             append (if scope
-                                        (list (cons scope elems))
-                                      elems)))))
-     (seq-group-by (lambda (e) (get-text-property 0 :kind (car e)))
-                   entries))))
+     (pcase-lambda (`(,kind . ,objs))
+       (cons
+        (alist-get kind eglot--symbol-kind-names "Unknown")
+        (mapcan (pcase-lambda (`(,container . ,objs))
+                  (let ((elems (mapcar (lambda (obj)
+                                         (list (plist-get obj :name)
+                                               `[,obj] ;; trick
+                                               #'visit))
+                                       objs)))
+                    (if container (list (cons container elems)) elems)))
+                (seq-group-by
+                 (lambda (e) (plist-get e :containerName)) objs))))
+     (seq-group-by
+      (lambda (obj) (plist-get obj :kind))
+      (mapcan #'unfurl
+              (jsonrpc-request (eglot--current-server-or-lose)
+                               :textDocument/documentSymbol
+                               `(:textDocument
+                                 ,(eglot--TextDocumentIdentifier))))))))
 
 (defun eglot--apply-text-edits (edits &optional version)
   "Apply EDITS for current buffer if at VERSION, or if it's nil."