fix(lib): add &allow-other-keys in fn! sub-arglists
Before this fix: (fn! (x &key y z)) ;; implies (fn! (&key x &allow-other-keys)). But (fn! (x (&key y) &key z)) ;; would not imply (fn! (x (&key y &allow-other-keys) &key z &allow-other-keys)).
This commit is contained in:
parent
db09cb001f
commit
0112319c04
1 changed files with 22 additions and 12 deletions
|
@ -316,18 +316,28 @@ The closure is wrapped in `cl-function', meaning ARGLIST will accept anything
|
||||||
`cl-defun' will. Implicitly adds `&allow-other-keys' if `&key' is present in
|
`cl-defun' will. Implicitly adds `&allow-other-keys' if `&key' is present in
|
||||||
ARGLIST."
|
ARGLIST."
|
||||||
(declare (indent defun) (doc-string 1) (pure t) (side-effect-free t))
|
(declare (indent defun) (doc-string 1) (pure t) (side-effect-free t))
|
||||||
;; Don't complain about undeclared keys.
|
`(cl-function
|
||||||
(when (memq '&key arglist)
|
(lambda
|
||||||
(if (memq '&aux arglist)
|
,(letf! (defun* allow-other-keys (args)
|
||||||
(let (newarglist arg)
|
(mapcar
|
||||||
(while arglist
|
(lambda (arg)
|
||||||
(setq arg (pop arglist))
|
(if (listp arg)
|
||||||
(when (eq arg '&aux)
|
(allow-other-keys arg)
|
||||||
(push '&allow-other-keys newarglist))
|
arg))
|
||||||
(push arg newarglist))
|
(if (and (memq '&key args)
|
||||||
(setq arglist (nreverse newarglist)))
|
(not (memq '&allow-other-keys args)))
|
||||||
(setq arglist (append arglist (list '&allow-other-keys)))))
|
(if (memq '&aux args)
|
||||||
`(cl-function (lambda ,arglist ,@body)))
|
(let (newargs arg)
|
||||||
|
(while args
|
||||||
|
(setq arg (pop args))
|
||||||
|
(when (eq arg '&aux)
|
||||||
|
(push '&allow-other-keys newargs))
|
||||||
|
(push arg newargs))
|
||||||
|
(nreverse newargs))
|
||||||
|
(append args (list '&allow-other-keys)))
|
||||||
|
args)))
|
||||||
|
(allow-other-keys arglist))
|
||||||
|
,@body)))
|
||||||
|
|
||||||
(defmacro cmd! (&rest body)
|
(defmacro cmd! (&rest body)
|
||||||
"Returns (lambda () (interactive) ,@body)
|
"Returns (lambda () (interactive) ,@body)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue