(help-split-fundoc, help-function-arglist)

(help-make-usage): New funs, extracted from describe-function-1.
(describe-function-1): Use them.

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index f07510ee2052df325f8f18332d7cc790b69e4c78..c79aa356b78352c45bdfc7866268d688fac70703 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -165,6 +165,38 @@ and the file name is displayed in the echo area."
          ;; Return the text we displayed.
          (buffer-string))))))
 
+(defun help-split-fundoc (doc &optional def)
+  "Split a function docstring DOC into the actual doc and the usage info.
+Return (USAGE . DOC) or nil if there's no usage info."
+  ;; Builtins get the calling sequence at the end of the doc string.
+  ;; In cases where `function' has been fset to a subr we can't search for
+  ;; function's name in the doc string.  Kluge round that using the printed
+  ;; representation.  The arg list then shows the wrong function name, but
+  ;; that might be a useful hint.
+  (let* ((rep (prin1-to-string def))
+        (name (if (string-match " \\([^ ]+\\)>$" rep)
+                  (match-string 1 rep) "fun")))
+    (if (string-match (format "^(%s[ )].*\\'" (regexp-quote name)) doc)
+       (cons (match-string 0 doc)
+             (substring doc 0 (match-beginning 0))))))
+
+(defun help-function-arglist (def)
+  (cond
+   ((byte-code-function-p def) (aref def 0))
+   ((eq (car-safe def) 'lambda) (nth 1 def))
+   ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap)))
+    "[Arg list not available until function definition is loaded.]")
+   (t t)))
+
+(defun help-make-usage (function arglist)
+  (cons (if (symbolp function) function 'anonymous)
+       (mapcar (lambda (arg)
+                 (if (not (symbolp arg)) arg
+                   (let ((name (symbol-name arg)))
+                     (if (string-match "\\`&" name) arg
+                       (intern (upcase name))))))
+               arglist)))
+
 ;;;###autoload
 (defun describe-function-1 (function)
   (let* ((def (if (symbolp function)
@@ -248,7 +280,7 @@ and the file name is displayed in the echo area."
     (when (commandp function)
       (let* ((remapped (remap-command function))
             (keys (where-is-internal
-                  (or remapped function) overriding-local-map nil nil)))
+                   (or remapped function) overriding-local-map nil nil)))
        (when remapped
          (princ "It is remapped to `")
          (princ (symbol-name remapped))
@@ -265,68 +297,27 @@ and the file name is displayed in the echo area."
     ;; If definition is a macro, find the function inside it.
     (if (eq (car-safe def) 'macro)
        (setq def (cdr def)))
-    (let ((arglist (cond ((byte-code-function-p def)
-                         (car (append def nil)))
-                        ((eq (car-safe def) 'lambda)
-                         (nth 1 def))
-                        ((and (eq (car-safe def) 'autoload)
-                              (not (eq (nth 4 def) 'keymap)))
-                         (concat "[Arg list not available until "
-                                 "function definition is loaded.]"))
-                        (t t))))
-      (cond ((listp arglist)
-            (princ (cons (if (symbolp function) function "anonymous")
-                         (mapcar (lambda (arg)
-                                   (if (memq arg '(&optional &rest))
-                                       arg
-                                     (intern (upcase (symbol-name arg)))))
-                                 arglist)))
-            (terpri))
-           ((stringp arglist)
-            (princ arglist)
-            (terpri))))
-    (let ((obsolete (get function 'byte-obsolete-info)))
-      (when obsolete
-        (terpri)
-        (princ "This function is obsolete")
-        (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete))))
-        (princ ";") (terpri)
-        (princ (if (stringp (car obsolete)) (car obsolete)
-                 (format "use `%s' instead." (car obsolete))))
-        (terpri)))
-    (let ((doc (documentation function)))
+    (let* ((arglist (help-function-arglist def))
+          (doc (documentation function))
+          usage)
+      (princ (cond
+             ((listp arglist) (help-make-usage function arglist))
+             ((stringp arglist) arglist)
+             ((and doc (subrp def) (setq usage (help-split-fundoc doc def)))
+              (setq doc (cdr usage)) (car usage))
+             (t "[Missing arglist.  Please make a bug report.]")))
+      (terpri)
+      (let ((obsolete (get function 'byte-obsolete-info)))
+       (when obsolete
+         (terpri)
+         (princ "This function is obsolete")
+         (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete))))
+         (princ ";") (terpri)
+         (princ (if (stringp (car obsolete)) (car obsolete)
+                  (format "use `%s' instead." (car obsolete))))
+         (terpri)))
       (if doc
-         (progn (terpri)
-                (princ doc)
-                (if (subrp def)
-                    (with-current-buffer standard-output
-                      (beginning-of-line)
-                      ;; Builtins get the calling sequence at the end of
-                      ;; the doc string.  Move it to the same place as
-                      ;; for other functions.
-
-                      ;; In cases where `function' has been fset to a
-                      ;; subr we can't search for function's name in
-                      ;; the doc string.  Kluge round that using the
-                      ;; printed representation.  The arg list then
-                      ;; shows the wrong function name, but that
-                      ;; might be a useful hint.
-                      (let* ((rep (prin1-to-string def))
-                             (name (progn
-                                     (string-match " \\([^ ]+\\)>$" rep)
-                                     (match-string 1 rep))))
-                        (if (looking-at (format "(%s[ )]" (regexp-quote name)))
-                            (let ((start (point-marker)))
-                              (goto-char (point-min))
-                              (forward-paragraph)
-                              (insert-buffer-substring (current-buffer) start)
-                              (insert ?\n)
-                              (delete-region (1- start) (point-max)))
-                          (goto-char (point-min))
-                          (forward-paragraph)
-                          (insert
-                           "[Missing arglist.  Please make a bug report.]\n")))
-                      (goto-char (point-max)))))
+         (progn (terpri) (princ doc))
        (princ "Not documented.")))))
 
 \f