[elpa] externals/eglot a46f003 17/26: Fix #164: handle CodeAction/Command polymorphism with eglot--dcase

[João Távora]

branch: externals/eglot
commit a46f0032ec4bb6d5e7faea1c5c8d1592649703cc
Author: João Távora <address@hidden>
Commit: Michał Krzywkowski <address@hidden>

    Fix #164: handle CodeAction/Command polymorphism with eglot--dcase
    
    * eglot-tests.el (eglot-dcase): Augment test.
    
    * eglot.el (eglot--lsp-interface-alist): Add Command interface.
    (eglot--dcase): Fix indentation.  When given interface, always
    assume strict mode.
    (eglot-code-actions): Use eglot--dcase.
---
 eglot-tests.el | 25 ++++++++++++++++++++++---
 eglot.el       | 40 ++++++++++++++++++++++------------------
 2 files changed, 44 insertions(+), 21 deletions(-)

diff --git a/eglot-tests.el b/eglot-tests.el
index 37184d0..8a9aba6 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -648,13 +648,31 @@ Pass TIMEOUT to `eglot--with-timeout'."
 
 (ert-deftest eglot-dcase ()
   (let ((eglot--lsp-interface-alist
-         `((FooObject . ((:foo :bar) (:baz))))))
+         `((FooObject . ((:foo :bar) (:baz)))
+           (CodeAction (:title) (:kind :diagnostics :edit :command))
+           (Command (:title :command) (:arguments)))))
     (should
      (equal
       "foo"
       (eglot--dcase `(:foo "foo" :bar "bar")
-          (((FooObject) foo)
-           foo))))))
+        (((FooObject) foo)
+         foo))))
+    (should
+     (equal
+      (list "foo" "some command" "some edit")
+      (eglot--dcase '(:title "foo" :command "some command" :edit "some edit")
+        (((Command) _title _command _arguments)
+         (ert-fail "Shouldn't have destructured this object as a Command"))
+        (((CodeAction) title edit command)
+         (list title command edit)))))
+    (should
+     (equal
+      (list "foo" "some command" nil)
+      (eglot--dcase '(:title "foo" :command "some command")
+        (((Command) title command arguments)
+         (list title command arguments))
+        (((CodeAction) _title _edit _command)
+         (ert-fail "Shouldn't have destructured this object as a 
CodeAction")))))))
 
 (provide 'eglot-tests)
 ;;; eglot-tests.el ends here
@@ -662,3 +680,4 @@ Pass TIMEOUT to `eglot--with-timeout'."
 ;; Local Variables:
 ;; checkdoc-force-docstrings-flag: nil
 ;; End:
+
diff --git a/eglot.el b/eglot.el
index e4547c5..578a90d 100644
--- a/eglot.el
+++ b/eglot.el
@@ -204,13 +204,12 @@ let the buffer grow forever."
 ;;; Message verification helpers
 ;;;
 (defvar eglot--lsp-interface-alist
-  `(
-    (CodeAction (:title) (:kind :diagnostics :edit :command))
+  `((CodeAction (:title) (:kind :diagnostics :edit :command))
+    (Command (:title :command) (:arguments))
     (FileSystemWatcher (:globPattern) (:kind))
     (Registration (:id :method) (:registerOptions))
     (TextDocumentEdit (:textDocument :edits) ())
-    (WorkspaceEdit () (:changes :documentChanges))
-    )
+    (WorkspaceEdit () (:changes :documentChanges)))
   "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
 
 INTERFACE-NAME is a symbol designated by the spec as
@@ -294,6 +293,7 @@ Honour `eglot-strict-mode'."
   "Like `pcase', but for the LSP object OBJ.
 CLAUSES is a list (DESTRUCTURE FORMS...) where DESTRUCTURE is
 treated as in `eglot-dbind'."
+  (declare (indent 1))
   (let ((obj-once (make-symbol "obj-once")))
     `(let ((,obj-once ,obj))
        (cond
@@ -306,19 +306,21 @@ treated as in `eglot-dbind'."
                                     (car (pop vars)))
            for condition =
            (if interface-name
+               ;; In this mode, we assume `eglot-strict-mode' is fully
+               ;; on, otherwise we can't disambiguate between certain
+               ;; types.
                `(let* ((interface
                         (or (assoc ',interface-name eglot--lsp-interface-alist)
                             (eglot--error "Unknown interface %s")))
                        (object-keys (eglot--plist-keys ,obj-once))
                        (required-keys (car (cdr interface))))
                   (and (null (cl-set-difference required-keys object-keys))
-                       (or (null (memq 'disallow-non-standard-keys
-                                       eglot-strict-mode))
-                           (null (cl-set-difference
-                                  (cl-set-difference object-keys required-keys)
-                                  (cadr (cdr interface)))))))
+                       (null (cl-set-difference
+                              (cl-set-difference object-keys required-keys)
+                              (cadr (cdr interface))))))
              ;; In this interface-less mode we don't check
-             ;; `eglot-strict-mode' at all.
+             ;; `eglot-strict-mode' at all: just check that the object
+             ;; has all the keys the user wants to destructure.
              `(null (cl-set-difference
                      ',vars-as-keywords
                      (eglot--plist-keys ,obj-once))))
@@ -2100,9 +2102,8 @@ If SKIP-SIGNATURE, don't try to send 
textDocument/signatureHelp."
                                             (eglot--diag-data diag))))
                               (flymake-diagnostics beg end))]))))
          (menu-items
-          (or (mapcar (eglot--lambda ((CodeAction) title edit command 
arguments)
-                        `(,title . (:command ,command :arguments ,arguments
-                                             :edit ,edit)))
+          (or (mapcar (jsonrpc-lambda (&rest all &key title &allow-other-keys)
+                        (cons title all))
                       actions)
               (eglot--error "No code actions here")))
          (menu `("Eglot code actions:" ("dummy" ,@menu-items)))
@@ -2114,11 +2115,14 @@ If SKIP-SIGNATURE, don't try to send 
textDocument/signatureHelp."
                      (if (eq (setq retval (tmm-prompt menu)) never-mind)
                          (keyboard-quit)
                        retval)))))
-    (cl-destructuring-bind (&key _title command arguments edit) action
-      (when edit
-        (eglot--apply-workspace-edit edit))
-      (when command
-        (eglot-execute-command server (intern command) arguments)))))
+    (eglot--dcase action
+      (((Command) command arguments)
+       (eglot-execute-command server (intern command) arguments))
+      (((CodeAction) edit command)
+       (when edit (eglot--apply-workspace-edit edit))
+       (when command
+         (eglot--dbind ((Command) command arguments) command
+           (eglot-execute-command server (intern command) arguments)))))))