aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/emacs-lisp/cl-macs.el15
1 files changed, 8 insertions, 7 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 3dd84648945..a57a3821564 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -257,13 +257,17 @@ ARGLIST allows full Common Lisp conventions."
257 (while (and (eq (car args) '&key) (cl-pop args)) 257 (while (and (eq (car args) '&key) (cl-pop args))
258 (while (and args (not (memq (car args) lambda-list-keywords))) 258 (while (and args (not (memq (car args) lambda-list-keywords)))
259 (let ((arg (cl-pop args))) 259 (let ((arg (cl-pop args)))
260 (or (consp arg) (setq arg (list arg))) 260 (if (not (consp arg))
261 ;; Simple key arg, we can use plist-get.
262 (let ((karg (intern (format ":%s" arg))))
263 (cl-do-arglist arg `(plist-get ,restarg ,karg))
264 (cl-push karg keys))
261 (let* ((karg (if (consp (car arg)) (caar arg) 265 (let* ((karg (if (consp (car arg)) (caar arg)
262 (intern (format ":%s" (car arg))))) 266 (intern (format ":%s" (car arg)))))
263 (varg (if (consp (car arg)) (cadar arg) (car arg))) 267 (varg (if (consp (car arg)) (cadar arg) (car arg)))
264 (def (if (cdr arg) (cadr arg) 268 (def (if (cdr arg) (cadr arg)
265 (or (car bind-defs) (cadr (assq varg bind-defs))))) 269 (or (car bind-defs) (cadr (assq varg bind-defs)))))
266 (look (list 'memq (list 'quote karg) restarg))) 270 (look (list 'plist-member restarg (list 'quote karg))))
267 (and def bind-enquote (setq def (list 'quote def))) 271 (and def bind-enquote (setq def (list 'quote def)))
268 (if (cddr arg) 272 (if (cddr arg)
269 (let* ((temp (or (nth 2 arg) (gensym))) 273 (let* ((temp (or (nth 2 arg) (gensym)))
@@ -285,7 +289,7 @@ ARGLIST allows full Common Lisp conventions."
285 'quote 289 'quote
286 (list nil (cl-const-expr-val def))) 290 (list nil (cl-const-expr-val def)))
287 (list 'list nil def)))))))) 291 (list 'list nil def))))))))
288 (cl-push karg keys))))) 292 (cl-push karg keys))))))
289 (setq keys (nreverse keys)) 293 (setq keys (nreverse keys))
290 (or (and (eq (car args) '&allow-other-keys) (cl-pop args)) 294 (or (and (eq (car args) '&allow-other-keys) (cl-pop args))
291 (null keys) (= safety 0) 295 (null keys) (= safety 0)
@@ -298,10 +302,7 @@ ARGLIST allows full Common Lisp conventions."
298 (list (list 'memq (list 'car var) 302 (list (list 'memq (list 'car var)
299 (list 'quote (append keys allow))) 303 (list 'quote (append keys allow)))
300 (list 'setq var (list 'cdr (list 'cdr var)))) 304 (list 'setq var (list 'cdr (list 'cdr var))))
301 (list (list 'car 305 (list (list 'plist-get restarg (car allow))
302 (list 'cdr
303 (list 'memq (cons 'quote allow)
304 restarg)))
305 (list 'setq var nil)) 306 (list 'setq var nil))
306 (list t 307 (list t
307 (list 308 (list