* 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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 23f8b3ec8319ed4d441b1ff262dd50ad27d9d3d4..ebaea892a192dbf40578e2f99e8609310e4c6a1f 100644 (file)
--- 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 495063fb17ceb2d4fd43522c4427d32a8805b99f..4b1480444c2e3fd41ab1061b06e7d178deb64760 100644 (file)
--- 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.")))))))
 
 \f
 ;; Variables