branch: elpa/llama
commit a5fb525684260dee7c3381740e61421f7bb0ecc3
Author: Jonas Bernoulli <jo...@bernoul.li>
Commit: Jonas Bernoulli <jo...@bernoul.li>
Add special handling of backquote
---
llama-test.el | 11 +++++++++++
llama.el | 18 ++++++++++++++----
2 files changed, 25 insertions(+), 4 deletions(-)
diff --git a/llama-test.el b/llama-test.el
index e06719d0e7..6650c61e6f 100644
--- a/llama-test.el
+++ b/llama-test.el
@@ -355,6 +355,17 @@
(cons %1 '(%2)))))
)
+(ert-deftest llama-test-504-backquoted nil
+
+ (should (equal (##list `(,%1 %2 ,%3))
+ (lambda (%1 _%2 %3)
+ (list `(,%1 %2 ,%3)))))
+
+ (should (equal (##list `(,%1 %2 (,%3) ,%4 . ,%5))
+ (lambda (%1 _%2 %3 %4 %5)
+ (list `(,%1 %2 (,%3) ,%4 . ,%5)))))
+ )
+
(ert-deftest llama-test-901-errors-first nil
(should-error (##list %1 &1))
(should-error (##list &1 %1))
diff --git a/llama.el b/llama.el
index 7d58ba9d11..44a66c0a95 100644
--- a/llama.el
+++ b/llama.el
@@ -176,9 +176,16 @@ this trickery, you can alternatively use this macro under
the name
(defconst llama--unused-argument (make-symbol "llama--unused-argument"))
-(defun llama--collect (expr args &optional fnpos)
+(defun llama--collect (expr args &optional fnpos backquoted)
(cond
((memq (car-safe expr) '(## quote)) expr)
+ ((and backquoted (symbolp expr)) expr)
+ ((and backquoted (eq (car-safe expr) backquote-unquote-symbol))
+ (cons backquote-unquote-symbol
+ (llama--collect (cdr expr) args)))
+ ((eq (car-safe expr) backquote-backquote-symbol)
+ (cons backquote-backquote-symbol
+ (llama--collect (cdr expr) args nil t)))
((symbolp expr)
(let ((name (symbol-name expr)))
(save-match-data
@@ -202,20 +209,23 @@ this trickery, you can alternatively use this macro under
the name
(let* ((vectorp (vectorp expr))
(expr (if vectorp (append expr ()) expr))
(fnpos (and (not vectorp)
+ (not backquoted)
(ignore-errors (length expr)))) ;proper-list-p
(ret ()))
(catch t
(while t
- (let ((elt (llama--collect (car expr) args fnpos)))
+ (let ((elt (llama--collect (car expr) args fnpos backquoted)))
(unless (eq elt llama--unused-argument)
(push elt ret)))
(setq fnpos nil)
(setq expr (cdr expr))
- (unless (and expr (listp expr))
+ (unless (and expr
+ (listp expr)
+ (not (eq (car expr) backquote-unquote-symbol)))
(throw t nil))))
(setq ret (nreverse ret))
(when expr
- (setcdr (last ret) (llama--collect expr args)))
+ (setcdr (last ret) (llama--collect expr args nil backquoted)))
(if vectorp (vconcat ret) ret)))
(expr)))
