[elpa] 1.3 8829655 10/26: Per #171,#156: Introduce eglot--dcase

[Christian Johansson]

tag: 1.3
commit 88296552c2395e3e71c67291e2ae8ece84949e16
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Per #171,#156: Introduce eglot--dcase
    
    * eglot.el (eglot--dcase): New macro.
    
    * eglot-tests.el (eglot-dcase-with-interface)
    (eglot-dcase-no-interface): New tests.
---
 eglot-tests.el | 10 ++++++++++
 eglot.el       | 41 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 51 insertions(+)

diff --git a/eglot-tests.el b/eglot-tests.el
index 8b91317..37184d0 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -646,6 +646,16 @@ Pass TIMEOUT to `eglot--with-timeout'."
        (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh)
          (cons foo bar))))))
 
+(ert-deftest eglot-dcase ()
+  (let ((eglot--lsp-interface-alist
+         `((FooObject . ((:foo :bar) (:baz))))))
+    (should
+     (equal
+      "foo"
+      (eglot--dcase `(:foo "foo" :bar "bar")
+          (((FooObject) foo)
+           foo))))))
+
 (provide 'eglot-tests)
 ;;; eglot-tests.el ends here
 
diff --git a/eglot.el b/eglot.el
index 594a638..61f9b70 100644
--- a/eglot.el
+++ b/eglot.el
@@ -281,6 +281,47 @@ Honour `eglot-strict-mode'."
   (let ((e (cl-gensym "jsonrpc-lambda-elem")))
     `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body))))
 
+(cl-defmacro eglot--dcase (obj &rest clauses)
+  "Like `pcase', but for the LSP object OBJ.
+CLAUSES is a list (DESTRUCTURE FORMS...) where DESTRUCTURE is
+treated as in `eglot-dbind'."
+  (let ((obj-once (make-symbol "obj-once")))
+    `(let ((,obj-once ,obj))
+       (cond
+        ,@(cl-loop
+           for (vars . body) in clauses
+           for vars-as-keywords = (mapcar (lambda (var)
+                                            (intern (format ":%s" var)))
+                                          vars)
+           for interface-name = (if (consp (car vars))
+                                    (car (pop vars)))
+           for condition =
+           (if interface-name
+               `(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)))))))
+             ;; In this interface-less mode we don't check
+             ;; `eglot-strict-mode' at all.
+             `(null (cl-set-difference
+                     ',vars-as-keywords
+                     (eglot--plist-keys ,obj-once))))
+           collect `(,condition
+                     (cl-destructuring-bind (&key ,@vars &allow-other-keys)
+                         ,obj-once
+                       ,@body)))
+        (t
+         (eglot--error "%s didn't match any of %s"
+                       ,obj-once
+                       ',(mapcar #'car clauses)))))))
+
 
 ;;; API (WORK-IN-PROGRESS!)
 ;;;