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:
Henrik Lissner 2021-10-18 00:44:51 +02:00
parent db09cb001f
commit 0112319c04

View file

@ -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)