* lisp/emacs-lisp/cl-macs.el (cl--do-arglist): Understand _ on &key args.

(cl--make-usage-args): Strip _ from argument names.

Fixes: debbugs:12367

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1e09fe0850d9e043282c08e24c9a909aa836800c..37064b6680b30b4dce4c1ce65a4e4cb40d92e4e4 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2012-09-06  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * emacs-lisp/cl-macs.el (cl--do-arglist): Understand _ on &key args
+       (bug#12367).
+       (cl--make-usage-args): Strip _ from argument names.
+
 2012-09-06  Rüdiger Sonderfeld  <ruediger@c-plusplus.de>
 
        * progmodes/vhdl-mode.el (vhdl-speedbar-initialize): Don't use

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index aba412cc8f5e095270bca871c4add2cedd571237..312c37261e280b0175d79489bdf92a65b0188d94 100644 (file)
--- 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)))))