* lisp/help-fns.el (help-fns--key-bindings, help-fns--signature)

(help-fns--parent-mode, help-fns--obsolete): New funs, extracted from
describe-function-1.
(describe-function-1): Use them.  Move compiler macro after sig.
(help-fns--compiler-macro): Use function-get.  Assume we're already in
standard-output.  Adjust layout to new call order.

2 files changed, 134 insertions, 122 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 23f8b3ec831..ebaea892a19 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,12 @@
 2012-08-06  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        * help-fns.el (help-fns--key-bindings, help-fns--signature)
+        (help-fns--parent-mode, help-fns--obsolete): New funs, extracted from
+        describe-function-1.
+        (describe-function-1): Use them.  Move compiler macro after sig.
+        (help-fns--compiler-macro): Use function-get.  Assume we're already in
+        standard-output.  Adjust layout to new call order.
+
         * emacs-lisp/cl-macs.el (cl--sm-macroexpand): Fix handling of
         re-binding a symbol that has a symbol-macro (bug#12119).
 
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 495063fb17c..4b1480444c2 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -380,26 +380,125 @@ suitable file is found, return nil."
 
 (declare-function ad-get-advice-info "advice" (function))
 
+(defun help-fns--key-bindings (function)
+  (when (commandp function)
+    (let ((pt2 (with-current-buffer standard-output (point)))
+          (remapped (command-remapping function)))
+      (unless (memq remapped '(ignore undefined))
+        (let ((keys (where-is-internal
+                     (or remapped function) overriding-local-map nil nil))
+              non-modified-keys)
+          (if (and (eq function 'self-insert-command)
+                   (vectorp (car-safe keys))
+                   (consp (aref (car keys) 0)))
+              (princ "It is bound to many ordinary text characters.\n")
+            ;; Which non-control non-meta keys run this command?
+            (dolist (key keys)
+              (if (member (event-modifiers (aref key 0)) '(nil (shift)))
+                  (push key non-modified-keys)))
+            (when remapped
+              (princ "Its keys are remapped to `")
+              (princ (symbol-name remapped))
+              (princ "'.\n"))
+
+            (when keys
+              (princ (if remapped
+                         "Without this remapping, it would be bound to "
+                       "It is bound to "))
+              ;; If lots of ordinary text characters run this command,
+              ;; don't mention them one by one.
+              (if (< (length non-modified-keys) 10)
+                  (princ (mapconcat 'key-description keys ", "))
+                (dolist (key non-modified-keys)
+                  (setq keys (delq key keys)))
+                (if keys
+                    (progn
+                      (princ (mapconcat 'key-description keys ", "))
+                      (princ ", and many ordinary text characters"))
+                  (princ "many ordinary text characters"))))
+            (when (or remapped keys non-modified-keys)
+              (princ ".")
+              (terpri)))))
+
+      (with-current-buffer standard-output
+        (fill-region-as-paragraph pt2 (point))
+        (unless (looking-back "\n\n")
+          (terpri))))))
+
 (defun help-fns--compiler-macro (function)
-  (let ((handler nil))
-    ;; FIXME: Copied from macroexp.el.
-    (while (and (symbolp function)
-                (not (setq handler (get function 'compiler-macro)))
-                (fboundp function))
-      ;; Follow the sequence of aliases.
-      (setq function (symbol-function function)))
+  (let ((handler (function-get function 'compiler-macro)))
     (when handler
-      (princ "This function has a compiler macro")
+      (insert "\nThis function has a compiler macro")
       (let ((lib (get function 'compiler-macro-file)))
         ;; FIXME: rather than look at the compiler-macro-file property,
         ;; just look at `handler' itself.
         (when (stringp lib)
-          (princ (format " in `%s'" lib))
-          (with-current-buffer standard-output
-            (save-excursion
-              (re-search-backward "`\\([^`']+\\)'" nil t)
-              (help-xref-button 1 'help-function-cmacro function lib)))))
-      (princ ".\n\n"))))
+          (insert (format " in `%s'" lib))
+          (save-excursion
+            (re-search-backward "`\\([^`']+\\)'" nil t)
+            (help-xref-button 1 'help-function-cmacro function lib))))
+      (insert ".\n"))))
+
+(defun help-fns--signature (function doc real-def real-function)
+  (unless (keymapp function)    ; If definition is a keymap, skip arglist note.
+    (let* ((advertised (gethash real-def advertised-signature-table t))
+           (arglist (if (listp advertised)
+                        advertised (help-function-arglist real-def)))
+           (usage (help-split-fundoc doc function)))
+      (if usage (setq doc (cdr usage)))
+      (let* ((use (cond
+                   ((and usage (not (listp advertised))) (car usage))
+                   ((listp arglist)
+                    (format "%S" (help-make-usage function arglist)))
+                   ((stringp arglist) arglist)
+                   ;; Maybe the arglist is in the docstring of a symbol
+                   ;; this one is aliased to.
+                   ((let ((fun real-function))
+                      (while (and (symbolp fun)
+                                  (setq fun (symbol-function fun))
+                                  (not (setq usage (help-split-fundoc
+                                                    (documentation fun)
+                                                    function)))))
+                      usage)
+                    (car usage))
+                   ((or (stringp real-def)
+                        (vectorp real-def))
+                    (format "\nMacro: %s" (format-kbd-macro real-def)))
+                   (t "[Missing arglist.  Please make a bug report.]")))
+             (high (help-highlight-arguments use doc)))
+        (let ((fill-begin (point)))
+          (insert (car high) "\n")
+          (fill-region fill-begin (point)))
+        (cdr high)))))
+
+(defun help-fns--parent-mode (function)
+  ;; If this is a derived mode, link to the parent.
+  (let ((parent-mode (and (symbolp function)
+                          (get function
+                               'derived-mode-parent))))
+    (when parent-mode
+      (insert "\nParent mode: `")
+      (let ((beg (point)))
+        (insert (format "%s" parent-mode))
+        (make-text-button beg (point)
+                          'type 'help-function
+                          'help-args (list parent-mode)))
+      (insert "'.\n"))))
+
+(defun help-fns--obsolete (function)
+  (let* ((obsolete (and
+                    ;; `function' might be a lambda construct.
+                    (symbolp function)
+                    (get function 'byte-obsolete-info)))
+         (use (car obsolete)))
+    (when obsolete
+      (insert "\nThis function is obsolete")
+      (when (nth 2 obsolete)
+        (insert (format " since %s" (nth 2 obsolete))))
+      (insert (cond ((stringp use) (concat ";\n" use))
+                    (use (format ";\nuse `%s' instead." use))
+                    (t "."))
+              "\n"))))
 
 ;; We could use `symbol-file' but this is a wee bit more efficient.
 (defun help-fns--autoloaded-p (function file)
@@ -510,54 +609,8 @@ FILE is the file where FUNCTION was probably defined."
         (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
                                   (point)))
       (terpri)(terpri)
-      (when (commandp function)
-        (let ((pt2 (with-current-buffer (help-buffer) (point)))
-              (remapped (command-remapping function)))
-          (unless (memq remapped '(ignore undefined))
-            (let ((keys (where-is-internal
-                         (or remapped function) overriding-local-map nil nil))
-                  non-modified-keys)
-              (if (and (eq function 'self-insert-command)
-                       (vectorp (car-safe keys))
-                       (consp (aref (car keys) 0)))
-                  (princ "It is bound to many ordinary text characters.\n")
-                ;; Which non-control non-meta keys run this command?
-                (dolist (key keys)
-                  (if (member (event-modifiers (aref key 0)) '(nil (shift)))
-                      (push key non-modified-keys)))
-                (when remapped
-                  (princ "Its keys are remapped to `")
-                  (princ (symbol-name remapped))
-                  (princ "'.\n"))
-
-                (when keys
-                  (princ (if remapped
-                             "Without this remapping, it would be bound to "
-                           "It is bound to "))
-                  ;; If lots of ordinary text characters run this command,
-                  ;; don't mention them one by one.
-                  (if (< (length non-modified-keys) 10)
-                      (princ (mapconcat 'key-description keys ", "))
-                    (dolist (key non-modified-keys)
-                      (setq keys (delq key keys)))
-                    (if keys
-                        (progn
-                          (princ (mapconcat 'key-description keys ", "))
-                          (princ ", and many ordinary text characters"))
-                      (princ "many ordinary text characters"))))
-                (when (or remapped keys non-modified-keys)
-                  (princ ".")
-                  (terpri)))))
-
-          (with-current-buffer (help-buffer)
-            (fill-region-as-paragraph pt2 (point))
-            (unless (looking-back "\n\n")
-              (terpri)))))
-      (help-fns--compiler-macro function)
-      (let* ((advertised (gethash real-def advertised-signature-table t))
-             (arglist (if (listp advertised)
-                          advertised (help-function-arglist real-def)))
-             (doc-raw (condition-case err
+      
+      (let* ((doc-raw (condition-case err
                           (documentation function t)
                         (error (format "No Doc! %S" err))))
              ;; If the function is autoloaded, and its docstring has
@@ -568,66 +621,18 @@ FILE is the file where FUNCTION was probably defined."
                          (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]"
                                        doc-raw)
                          (load (cadr real-def) t))
-                    (substitute-command-keys doc-raw)))
-             (usage (help-split-fundoc doc function)))
-        (with-current-buffer standard-output
-          ;; If definition is a keymap, skip arglist note.
-          (unless (keymapp function)
-            (if usage (setq doc (cdr usage)))
-            (let* ((use (cond
-                         ((and usage (not (listp advertised))) (car usage))
-                         ((listp arglist)
-                          (format "%S" (help-make-usage function arglist)))
-                         ((stringp arglist) arglist)
-                         ;; Maybe the arglist is in the docstring of a symbol
-                         ;; this one is aliased to.
-                         ((let ((fun real-function))
-                            (while (and (symbolp fun)
-                                        (setq fun (symbol-function fun))
-                                        (not (setq usage (help-split-fundoc
-                                                          (documentation fun)
-                                                          function)))))
-                            usage)
-                          (car usage))
-                         ((or (stringp real-def)
-                              (vectorp real-def))
-                          (format "\nMacro: %s" (format-kbd-macro real-def)))
-                         (t "[Missing arglist.  Please make a bug report.]")))
-                   (high (help-highlight-arguments use doc)))
-              (let ((fill-begin (point)))
-                (insert (car high) "\n")
-                (fill-region fill-begin (point)))
-              (setq doc (cdr high))))
-
-          ;; If this is a derived mode, link to the parent.
-          (let ((parent-mode (and (symbolp real-function)
-                                  (get real-function
-                                       'derived-mode-parent))))
-            (when parent-mode
-              (with-current-buffer standard-output
-                (insert "\nParent mode: `")
-                (let ((beg (point)))
-                  (insert (format "%s" parent-mode))
-                  (make-text-button beg (point)
-                                    'type 'help-function
-                                    'help-args (list parent-mode))))
-              (princ "'.\n")))
-
-          (let* ((obsolete (and
-                            ;; function might be a lambda construct.
-                            (symbolp function)
-                            (get function 'byte-obsolete-info)))
-                 (use (car obsolete)))
-            (when obsolete
-              (princ "\nThis function is obsolete")
-              (when (nth 2 obsolete)
-                (insert (format " since %s" (nth 2 obsolete))))
-              (insert (cond ((stringp use) (concat ";\n" use))
-                            (use (format ";\nuse `%s' instead." use))
-                            (t "."))
-                      "\n"))
-            (insert "\n"
-                    (or doc "Not documented."))))))))
+                    (substitute-command-keys doc-raw))))
+
+        (help-fns--key-bindings function)
+        (with-current-buffer standard-output
+          (setq doc (help-fns--signature function doc real-def real-function))
+
+          (help-fns--compiler-macro function)
+          (help-fns--parent-mode function)
+          (help-fns--obsolete function)
+
+          (insert "\n"
+                  (or doc "Not documented.")))))))
 
 
 ;; Variables