diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2012-09-06 11:35:08 -0400 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2012-09-06 11:35:08 -0400 |
| commit | d458ef98df8da78f9f102da5f4a066df400ca8cd (patch) | |
| tree | 79aa8d1e0b647f9ff634452cf17a7c348b5bc5c3 /lisp/emacs-lisp/cl-macs.el | |
| parent | fcbfbdea93bf0a9ba7bc0ab3e4e3f37e3d089588 (diff) | |
| download | emacs-d458ef98df8da78f9f102da5f4a066df400ca8cd.tar.gz emacs-d458ef98df8da78f9f102da5f4a066df400ca8cd.tar.bz2 emacs-d458ef98df8da78f9f102da5f4a066df400ca8cd.zip | |
* lisp/emacs-lisp/cl-macs.el (cl--do-arglist): Understand _ on &key args.
(cl--make-usage-args): Strip _ from argument names.
Fixes: debbugs:12367
Diffstat (limited to 'lisp/emacs-lisp/cl-macs.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 19 |
1 files changed, 15 insertions, 4 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index aba412cc8f5..312c37261e2 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -393,9 +393,14 @@ its argument list allows full Common Lisp conventions." (mapcar (lambda (x) (cond ((symbolp x) - (if (eq ?\& (aref (symbol-name x) 0)) - (setq state x) - (make-symbol (upcase (symbol-name x))))) + (let ((first (aref (symbol-name x) 0))) + (if (eq ?\& first) + (setq state x) + ;; Strip a leading underscore, since it only + ;; means that this argument is unused. + (make-symbol (upcase (if (eq ?_ first) + (substring (symbol-name x) 1) + (symbol-name x))))))) ((not (consp x)) x) ((memq state '(nil &rest)) (cl--make-usage-args x)) (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR). @@ -479,7 +484,13 @@ its argument list allows full Common Lisp conventions." (let ((arg (pop args))) (or (consp arg) (setq arg (list arg))) (let* ((karg (if (consp (car arg)) (caar arg) - (intern (format ":%s" (car arg))))) + (let ((name (symbol-name (car arg)))) + ;; Strip a leading underscore, since it only + ;; means that this argument is unused, but + ;; shouldn't affect the key's name (bug#12367). + (if (eq ?_ (aref name 0)) + (setq name (substring name 1))) + (intern (format ":%s" name))))) (varg (if (consp (car arg)) (cl-cadar arg) (car arg))) (def (if (cdr arg) (cadr arg) (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs))))) |