Preserve arg names for advice of subr and lexical functions.

* lisp/help-fns.el (help-function-arglist): Consolidate the subr and
new-byte-code cases.  Add argument `preserve-names' to extract names
from the docstring when needed.
* lisp/emacs-lisp/advice.el (ad-define-subr-args, ad-undefine-subr-args)
(ad-subr-args-defined-p, ad-get-subr-args, ad-subr-arglist): Remove.
(ad-arglist): Use help-function-arglist's new arg.
(ad-definition-type): Use cond.

Fixes: debbugs:8457

1 files changed, 42 insertions, 33 deletions

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 206a9af3a90..97ce7ca44ef 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -99,46 +99,55 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
 	      (format "%S" (help-make-usage 'fn arglist))))))
 
 ;; FIXME: Move to subr.el?
-(defun help-function-arglist (def)
+(defun help-function-arglist (def &optional preserve-names)
+  "Return a formal argument list for the function DEF.
+IF PRESERVE-NAMES is non-nil, return a formal arglist that uses
+the same names as used in the original source code, when possible."
   ;; Handle symbols aliased to other symbols.
   (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
   ;; If definition is a macro, find the function inside it.
   (if (eq (car-safe def) 'macro) (setq def (cdr def)))
   (cond
-   ((and (byte-code-function-p def) (integerp (aref def 0)))
-    (let* ((args-desc (aref def 0))
-           (max (lsh args-desc -8))
-           (min (logand args-desc 127))
-           (rest (logand args-desc 128))
-           (arglist ()))
-      (dotimes (i min)
-        (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
-      (when (> max min)
-        (push '&optional arglist)
-        (dotimes (i (- max min))
-          (push (intern (concat "arg" (number-to-string (+ 1 i min))))
-                arglist)))
-      (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
-      (nreverse arglist)))
-   ((byte-code-function-p def) (aref def 0))
+   ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
    ((eq (car-safe def) 'lambda) (nth 1 def))
    ((eq (car-safe def) 'closure) (nth 2 def))
-   ((subrp def)
-    (let ((arity (subr-arity def))
-          (arglist ()))
-      (dotimes (i (car arity))
-        (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
-      (cond
-       ((not (numberp (cdr arglist)))
-        (push '&rest arglist)
-        (push 'rest arglist))
-       ((< (car arity) (cdr arity))
-        (push '&optional arglist)
-        (dotimes (i (- (cdr arity) (car arity)))
-          (push (intern (concat "arg" (number-to-string
-                                       (+ 1 i (car arity)))))
-                arglist))))
-      (nreverse arglist)))
+   ((or (and (byte-code-function-p def) (integerp (aref def 0)))
+        (subrp def))
+    (or (when preserve-names
+          (let* ((doc (condition-case nil (documentation def) (error nil)))
+                 (docargs (if doc (car (help-split-fundoc doc nil))))
+                 (arglist (if docargs
+                              (cdar (read-from-string (downcase docargs)))))
+                 (valid t))
+            ;; Check validity.
+            (dolist (arg arglist)
+              (unless (and (symbolp arg)
+                           (let ((name (symbol-name arg)))
+                             (if (eq (aref name 0) ?&)
+                                 (memq arg '(&rest &optional))
+                               (not (string-match "\\." name)))))
+                (setq valid nil)))
+            (when valid arglist)))
+        (let* ((args-desc (if (not (subrp def))
+                              (aref def 0)
+                            (let ((a (subr-arity def)))
+                              (logior (car a)
+                                      (if (numberp (cdr a))
+                                          (lsh (cdr a) 8)
+                                        (lsh 1 7))))))
+               (max (lsh args-desc -8))
+               (min (logand args-desc 127))
+               (rest (logand args-desc 128))
+               (arglist ()))
+          (dotimes (i min)
+            (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
+          (when (> max min)
+            (push '&optional arglist)
+            (dotimes (i (- max min))
+              (push (intern (concat "arg" (number-to-string (+ 1 i min))))
+                    arglist)))
+          (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
+          (nreverse arglist))))
    ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap)))
     "[Arg list not available until function definition is loaded.]")
    (t t)))