diff options
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 15 |
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 |