bytecomp.el fix for bug#8647

[bpt/emacs.git] / lisp / help-fns.el

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 392e894..97ce7ca 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1,4 +1,4 @@
-;;; help-fns.el --- Complex help functions
+;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*-
 
 ;; Copyright (C) 1985-1986, 1993-1994, 1998-2011
 ;;   Free Software Foundation, Inc.
@@ -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)))
@@ -635,8 +644,8 @@ it is displayed along with the global value."
                                  "Describe variable: ")
                                obarray
                                (lambda (vv)
-                                  (or (special-variable-p vv)
-                                      (get vv 'variable-documentation)))
+                                  (or (get vv 'variable-documentation)
+                                      (and (boundp vv) (not (keywordp vv)))))
                                t nil nil
                                (if (symbolp v) (symbol-name v))))
      (list (if (equal val "")
@@ -879,7 +888,7 @@ BUFFER defaults to the current buffer."
   (insert (cond
           ((null value) "default")
           ((char-table-p value) "deeper char-table ...")
-          (t (condition-case err
+          (t (condition-case nil
                  (category-set-mnemonics value)
                (error "invalid"))))))