[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/eglot e2200ce 09/26: Simplify interface of eglot--dbind
From: |
João Távora |
Subject: |
[elpa] externals/eglot e2200ce 09/26: Simplify interface of eglot--dbind macro |
Date: |
Sun, 9 Dec 2018 19:11:26 -0500 (EST) |
branch: externals/eglot
commit e2200ce0735155d7f26d09b49569dd5501086826
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>
Simplify interface of eglot--dbind macro
* eglot.el (eglot--dbind): Use new interface.
(eglot--lambda): Use new eglot--dbind interface.
(eglot--lsp-interface-alist): Fix docstring.
(eglot--call-with-interface): Simplify.
(eglot--plist-keys): New helper.
* eglot-tests.el (eglot-strict-interfaces):
Add a new test clause.
---
eglot-tests.el | 22 +++++++++----
eglot.el | 98 ++++++++++++++++++++++++++++------------------------------
2 files changed, 63 insertions(+), 57 deletions(-)
diff --git a/eglot-tests.el b/eglot-tests.el
index 5d69dcf..8b91317 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -608,32 +608,42 @@ Pass TIMEOUT to `eglot--with-timeout'."
(ert-deftest eglot-strict-interfaces ()
(let ((eglot--lsp-interface-alist
`((FooObject . ((:foo :bar) (:baz))))))
+ (should
+ (equal '("foo" . "bar")
+ (let ((eglot-strict-mode nil))
+ (eglot--dbind (foo bar) `(:foo "foo" :bar "bar")
+ (cons foo bar)))))
(should-error
(let ((eglot-strict-mode '(disallow-non-standard-keys)))
- (eglot--dbind nil (&key foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
+ (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
(cons foo bar))))
(should
(equal '("foo" . "bar")
(let ((eglot-strict-mode nil))
- (eglot--dbind nil (&key foo bar) `(:foo "foo" :bar "bar" :fotrix
bargh)
+ (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
(cons foo bar)))))
(should-error
(let ((eglot-strict-mode '(disallow-non-standard-keys)))
- (eglot--dbind FooObject (&key foo bar) `(:foo "foo" :bar "bar" :fotrix
bargh)
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :fotrix
bargh)
(cons foo bar))))
(should
(equal '("foo" . "bar")
(let ((eglot-strict-mode '(disallow-non-standard-keys)))
- (eglot--dbind FooObject (&key foo bar) `(:foo "foo" :bar "bar"
:baz bargh)
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz
bargh)
+ (cons foo bar)))))
+ (should
+ (equal '("foo" . nil)
+ (let ((eglot-strict-mode nil))
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh)
(cons foo bar)))))
(should
(equal '("foo" . "bar")
(let ((eglot-strict-mode '(enforce-required-keys)))
- (eglot--dbind FooObject (&key foo bar) `(:foo "foo" :bar "bar"
:baz bargh)
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz
bargh)
(cons foo bar)))))
(should-error
(let ((eglot-strict-mode '(enforce-required-keys)))
- (eglot--dbind FooObject (&key foo bar) `(:foo "foo" :baz bargh)
+ (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh)
(cons foo bar))))))
(provide 'eglot-tests)
diff --git a/eglot.el b/eglot.el
index 2519189..594a638 100644
--- a/eglot.el
+++ b/eglot.el
@@ -204,8 +204,8 @@ let the buffer grow forever."
(defvar eglot--lsp-interface-alist `()
"Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
-INTERFACE-NAME is a symbol designated by the spec as \"export
-interface\". INTERFACE is a list (REQUIRED OPTIONAL) where
+INTERFACE-NAME is a symbol designated by the spec as
+\"interface\". INTERFACE is a list (REQUIRED OPTIONAL) where
REQUIRED and OPTIONAL are lists of keyword symbols designating
field names that must be, or may be, respectively, present in a
message adhering to that interface.
@@ -230,60 +230,56 @@ If the list is empty, any non-standard fields sent by the
server
and missing required fields are accepted (which may or may not
cause problems in Eglot's functioning later on).")
+(defun eglot--plist-keys (plist)
+ (cl-loop for (k _v) on plist by #'cddr collect k))
+
(defun eglot--call-with-interface (interface object fn)
- "Call FN, but first check that OBJECT conforms to INTERFACE.
-
-INTERFACE is a key to `eglot--lsp-interface-alist' and OBJECT is
- a plist representing an LSP message."
- (let* ((entry (assoc interface eglot--lsp-interface-alist))
- (required (car (cdr entry)))
- (optional (cadr (cdr entry))))
- (when (memq 'enforce-required-keys eglot-strict-mode)
- (cl-loop for req in required
- when (eq 'eglot--not-present
- (cl-getf object req 'eglot--not-present))
- collect req into missing
- finally (when missing
- (eglot--error
- "A `%s' must have %s" interface missing))))
- (when (and entry (memq 'disallow-non-standard-keys eglot-strict-mode))
- (cl-loop
- with allowed = (append required optional)
- for (key _val) on object by #'cddr
- unless (memq key allowed) collect key into disallowed
- finally (when disallowed
- (eglot--error
- "A `%s' mustn't have %s" interface disallowed))))
- (funcall fn)))
-
-(cl-defmacro eglot--dbind (interface lambda-list object &body body)
- "Destructure OBJECT of INTERFACE as CL-LAMBDA-LIST.
+ "Call FN, checking that OBJECT conforms to INTERFACE."
+ (when-let ((missing (and (memq 'enforce-required-keys eglot-strict-mode)
+ (cl-set-difference (car (cdr interface))
+ (eglot--plist-keys object)))))
+ (eglot--error "A `%s' must have %s" (car interface) missing))
+ (when-let ((excess (and (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-set-difference
+ (eglot--plist-keys object)
+ (append (car (cdr interface)) (cadr (cdr
interface)))))))
+ (eglot--error "A `%s' mustn't have %s" (car interface) excess))
+ (funcall fn))
+
+(cl-defmacro eglot--dbind (vars object &body body)
+ "Destructure OBJECT of binding VARS in BODY.
+VARS is ([(INTERFACE)] SYMS...)
Honour `eglot-strict-mode'."
- (declare (indent 3))
- (let ((fn-once `(lambda () ,@body))
- (lax-lambda-list (if (memq '&allow-other-keys lambda-list)
- lambda-list
- (append lambda-list '(&allow-other-keys))))
- (strict-lambda-list (delete '&allow-other-keys lambda-list)))
- (if interface
- `(cl-destructuring-bind ,lax-lambda-list ,object
- (eglot--call-with-interface ',interface ,object ,fn-once))
- (let ((object-once (make-symbol "object-once")))
- `(let ((,object-once ,object))
- (if (memq 'disallow-non-standard-keys eglot-strict-mode)
- (cl-destructuring-bind ,strict-lambda-list ,object-once
- (funcall ,fn-once))
- (cl-destructuring-bind ,lax-lambda-list ,object-once
- (funcall ,fn-once))))))))
-
-(cl-defmacro eglot--lambda (interface cl-lambda-list &body body)
+ (declare (indent 2))
+ (let ((interface-name (if (consp (car vars))
+ (car (pop vars))))
+ (object-once (make-symbol "object-once"))
+ (fn-once (make-symbol "fn-once")))
+ (cond (interface-name
+ ;; address@hidden: maybe we check some things at compile
+ ;; time and use `byte-compiler-warn' here
+ `(let ((,object-once ,object))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
,object-once
+ (eglot--call-with-interface (assoc ',interface-name
+ eglot--lsp-interface-alist)
+ ,object-once (lambda ()
+ ,@body)))))
+ (t
+ `(let ((,object-once ,object)
+ (,fn-once (lambda (,@vars) ,@body)))
+ (if (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-destructuring-bind (&key ,@vars) ,object-once
+ (funcall ,fn-once ,@vars))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
,object-once
+ (funcall ,fn-once ,@vars))))))))
+
+
+(cl-defmacro eglot--lambda (cl-lambda-list &body body)
"Function of args CL-LAMBDA-LIST for processing INTERFACE objects.
Honour `eglot-strict-mode'."
- (declare (indent 2))
+ (declare (indent 1))
(let ((e (cl-gensym "jsonrpc-lambda-elem")))
- `(lambda (,e)
- (eglot--dbind ,interface ,cl-lambda-list ,e
- ,@body))))
+ `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body))))
;;; API (WORK-IN-PROGRESS!)
- [elpa] externals/eglot 96169d8 18/26: Per #173: fix bug introduced by previous fix, (continued)
- [elpa] externals/eglot 96169d8 18/26: Per #173: fix bug introduced by previous fix, João Távora, 2018/12/09
- [elpa] externals/eglot 4874c22 14/26: Use javascript-typescript-langserver for typescript-mode (#174), João Távora, 2018/12/09
- [elpa] externals/eglot 66a1704 22/26: Scratch/use elpa flymake (#178), João Távora, 2018/12/09
- [elpa] externals/eglot f63bedb 20/26: Fix #144: Use eglot--dbind and eglot--lambda throughout, João Távora, 2018/12/09
- [elpa] externals/eglot 3922cf3 01/26: Per #144, #156: control strictness towards incoming LSP messages, João Távora, 2018/12/09
- [elpa] externals/eglot 8140be5 07/26: Touch up last commit, João Távora, 2018/12/09
- [elpa] externals/eglot 95ef9e1 08/26: Robustify tests against (M)ELPA eglot installations, João Távora, 2018/12/09
- [elpa] externals/eglot 38da3d3 15/26: Fix #159: Properly clear old diagnostics when making new ones, João Távora, 2018/12/09
- [elpa] externals/eglot 444a8c3 16/26: Per #173: robustify previous fix against non-standard insertion bindings, João Távora, 2018/12/09
- [elpa] externals/eglot 1d42be4 13/26: Close #173: support completionContext to help servers like ccls, João Távora, 2018/12/09
- [elpa] externals/eglot e2200ce 09/26: Simplify interface of eglot--dbind macro,
João Távora <=
- [elpa] externals/eglot c1848c3 23/26: Handle array params to server notification or requests, João Távora, 2018/12/09
- [elpa] externals/eglot 23accee 26/26: * eglot.el (Version): Bump to 1.3, João Távora, 2018/12/09
- [elpa] externals/eglot 37706af 21/26: Warn about suspicious interface usage at compile-time, João Távora, 2018/12/09
- [elpa] externals/eglot 6de3d9c 10/26: Per #171, #156: Introduce eglot--dcase, João Távora, 2018/12/09
- [elpa] externals/eglot a46f003 17/26: Fix #164: handle CodeAction/Command polymorphism with eglot--dcase, João Távora, 2018/12/09
- [elpa] externals/eglot 6b0b1b7 24/26: Be lenient by default to unknown methods or notifications, João Távora, 2018/12/09
- [elpa] externals/eglot 973cd81 25/26: Close #180: Add preamble to comparison to lsp-mode.el, João Távora, 2018/12/09
- [elpa] externals/eglot a1f2033 12/26: Fix #116, #150: don't break in indirect buffers, João Távora, 2018/12/09