Proper help support for EIEIO classes and methods.

4 files changed, 268 insertions, 336 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8d36ae9911f..b7b5c621e40 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,33 @@
+2014-01-08  David Engster  <deng@randomsample.de>
+
+        * help-fns.el (help-fns-describe-function-functions): New
+        variable to call functions for augmenting help buffers.
+        (describe-function-1): Remove explicit calls to
+        `help-fns--compiler-macro', `help-fns--parent-mode' and
+        `help-fns--obsolete'.  Put them in above new variable instead, and
+        call them through `run-hook-with-args'.
+        * emacs-lisp/eieio-opt.el (eieio-help-class): Rename from
+        `eieio-describe-class'.  Not meant for interactive use anymore,
+        but to augment existing help buffers.  Remove optional second
+        argument.  Create proper button for file location.  Rewrite
+        function to use `insert' instead of `princ' and `prin1' where
+        possible.
+        (eieio-help-class-slots): Rename from `eieio-describe-class-slots'.
+        (eieio-method-def, eieio-class-def): Move further up.
+        (describe-method, describe-generic, eieio-describe-method): Remove
+        aliases.
+        (eieio-help-constructor, eieio-help-generic): Rename from
+        `eieio-describe-constructor' and `eieio-describe-generic', resp.
+        Rewrite to use `insert' in the current buffer and use proper help
+        buttons.
+        (eieio-help-find-method-definition)
+        (eieio-help-find-class-definition): Also accept symbols as
+        arguments.
+        (eieio-help-mode-augmentation-maybee): Remove.
+        (eieio-describe-class-sb): Use `describe-function'.
+        * emacs-lisp/eieio.el (help-fns-describe-function-functions): Add
+        `eieio-help-generic' and `eieio-help-constructor'.
+
 2014-01-08  Paul Eggert  <eggert@cs.ucla.edu>
 
         Spelling fixes.
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 647bbb344b1..9269c744b9f 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -74,108 +74,81 @@ Argument CH-PREFIX is another character prefix to display."
 
 ;;; CLASS COMPLETION / DOCUMENTATION
 
-;;;###autoload(defalias 'describe-class 'eieio-describe-class)
-
 ;;;###autoload
-(defun eieio-describe-class (class &optional headerfcn)
-  "Describe a CLASS defined by a string or symbol.
-If CLASS is actually an object, then also display current values of that object.
-Optional HEADERFCN should be called to insert a few bits of info first."
-  (interactive (list (eieio-read-class "Class: ")))
-  (with-output-to-temp-buffer (help-buffer) ;"*Help*"
-    (help-setup-xref (list #'eieio-describe-class class headerfcn)
-                     (called-interactively-p 'interactive))
-
-    (when headerfcn (funcall headerfcn))
-    (prin1 class)
-    (princ " is a")
-    (if (class-option class :abstract)
-        (princ "n abstract"))
-    (princ " class")
-    ;; Print file location
-    (when (get class 'class-location)
-      (princ " in `")
-      (princ (file-name-nondirectory (get class 'class-location)))
-      (princ "'"))
-    (terpri)
-    ;; Inheritance tree information
-    (let ((pl (eieio-class-parents class)))
-      (when pl
-        (princ " Inherits from ")
-        (while pl
-          (princ "`") (prin1 (car pl)) (princ "'")
-          (setq pl (cdr pl))
-          (if pl (princ ", ")))
-        (terpri)))
-    (let ((ch (eieio-class-children class)))
-      (when ch
-        (princ " Children ")
-        (while ch
-          (princ "`") (prin1 (car ch)) (princ "'")
-          (setq ch (cdr ch))
-          (if ch (princ ", ")))
-        (terpri)))
-    (terpri)
-    ;; System documentation
-    (let ((doc (documentation-property class 'variable-documentation)))
-      (when doc
-        (princ "Documentation:")
-        (terpri)
-        (princ doc)
-        (terpri)
-        (terpri)))
-    ;; Describe all the slots in this class
-    (eieio-describe-class-slots class)
-    ;; Describe all the methods specific to this class.
-    (let ((methods (eieio-all-generic-functions class))
-          (doc nil))
-      (if (not methods) nil
-        (princ "Specialized Methods:")
-        (terpri)
-        (terpri)
-        (while methods
-          (setq doc (eieio-method-documentation (car methods) class))
-          (princ "`")
-          (prin1 (car methods))
-          (princ "'")
-          (if (not doc)
-              (princ "  Undocumented")
-            (if (car doc)
-                (progn
-                  (princ "  :STATIC ")
-                  (prin1 (car (car doc)))
-                  (terpri)
-                  (princ (cdr (car doc)))))
-            (setq doc (cdr doc))
-            (if (car doc)
-                (progn
-                  (princ "  :BEFORE ")
-                  (prin1 (car (car doc)))
-                  (terpri)
-                  (princ (cdr (car doc)))))
-            (setq doc (cdr doc))
-            (if (car doc)
-                (progn
-                  (princ "  :PRIMARY ")
-                  (prin1 (car (car doc)))
-                  (terpri)
-                  (princ (cdr (car doc)))))
-            (setq doc (cdr doc))
-            (if (car doc)
-                (progn
-                  (princ "  :AFTER ")
-                  (prin1 (car (car doc)))
-                  (terpri)
-                  (princ (cdr (car doc)))))
-            (terpri)
-            (terpri))
-          (setq methods (cdr methods))))))
-  (with-current-buffer (help-buffer)
-    (buffer-string)))
-
-(defun eieio-describe-class-slots (class)
-  "Describe the slots in CLASS.
-Outputs to the standard output."
+(defun eieio-help-class (class)
+  "Print help description for CLASS.
+If CLASS is actually an object, then also display current values of that object."
+  ;; Header line
+  (prin1 class)
+  (insert " is a"
+          (if (class-option class :abstract)
+              "n abstract"
+            "")
+          " class")
+  (let ((location (get class 'class-location)))
+    (when location
+      (insert " in `")
+      (help-insert-xref-button
+       (file-name-nondirectory location)
+       'eieio-class-def class location)
+      (insert "'")))
+  (insert ".\n")
+  ;; Parents
+  (let ((pl (eieio-class-parents class))
+        cur)
+    (when pl
+      (insert " Inherits from ")
+      (while (setq cur (pop pl))
+        (insert "`")
+        (help-insert-xref-button (symbol-name cur)
+                                 'help-function cur)
+        (insert (if pl "', " "'")))
+      (insert ".\n")))
+  ;; Children
+  (let ((ch (eieio-class-children class))
+        cur)
+    (when ch
+      (insert " Children ")
+      (while (setq cur (pop ch))
+        (insert "`")
+        (help-insert-xref-button (symbol-name cur)
+                                 'help-function cur)
+        (insert (if ch "', " "'")))
+      (insert ".\n")))
+  ;; System documentation
+  (let ((doc (documentation-property class 'variable-documentation)))
+    (when doc
+      (insert "\n" doc "\n\n")))
+  ;; Describe all the slots in this class.
+  (eieio-help-class-slots class)
+  ;; Describe all the methods specific to this class.
+  (let ((methods (eieio-all-generic-functions class))
+        (type [":STATIC" ":BEFORE" ":PRIMARY" ":AFTER"])
+        counter doc argshl dochl)
+    (when methods
+      (insert (propertize "Specialized Methods:\n\n" 'face 'bold))
+      (while methods
+        (setq doc (eieio-method-documentation (car methods) class))
+        (insert "`")
+        (help-insert-xref-button (symbol-name (car methods))
+                                 'help-function (car methods))
+        (insert "'")
+        (if (not doc)
+            (insert "  Undocumented")
+          (setq counter 0)
+          (dolist (cur doc)
+            (when cur
+              (insert " " (aref type counter) " "
+                      (prin1-to-string (car cur) (current-buffer))
+                      "\n"
+                      (cdr cur)))
+            (setq counter (1+ counter))))
+        (insert "\n\n")
+        (setq methods (cdr methods))))))
+
+(defun eieio-help-class-slots (class)
+  "Print help description for the slots in CLASS.
+Outputs to the current buffer."
   (let* ((cv (class-v class))
          (docs   (eieio--class-public-doc cv))
          (names  (eieio--class-public-a cv))
@@ -185,28 +158,27 @@ Outputs to the standard output."
          (i      0)
          (prot   (eieio--class-protection cv))
          )
-    (princ "Instance Allocated Slots:")
-    (terpri)
-    (terpri)
+    (insert (propertize "Instance Allocated Slots:\n\n"
+                        'face 'bold))
     (while names
-      (if (car prot) (princ "Private "))
-      (princ "Slot: ")
-      (prin1 (car names))
-      (when (not (eq (aref types i) t))
-        (princ "    type = ")
-        (prin1 (aref types i)))
-      (unless (eq (car deflt) eieio-unbound)
-        (princ "    default = ")
-        (prin1 (car deflt)))
-      (when (car publp)
-        (princ "    printer = ")
-        (prin1 (car publp)))
-      (when (car docs)
-        (terpri)
-        (princ "  ")
-        (princ (car docs))
-        (terpri))
-      (terpri)
+      (insert
+       (concat
+        (when (car prot)
+          (propertize "Private " 'face 'bold))
+        (propertize "Slot: " 'face 'bold)
+        (prin1-to-string (car names))
+        (unless (eq (aref types i) t)
+          (concat "    type = "
+                  (prin1-to-string (aref types i))))
+        (unless (eq (car deflt) eieio-unbound)
+          (concat "    default = "
+                  (prin1-to-string (car deflt))))
+        (when (car publp)
+          (concat "    printer = "
+                  (prin1-to-string (car publp))))
+        (when (car docs)
+          (concat "\n  " (car docs) "\n"))
+        "\n"))
       (setq names (cdr names)
             docs (cdr docs)
             deflt (cdr deflt)
@@ -219,61 +191,30 @@ Outputs to the standard output."
           i     0
           prot  (eieio--class-class-allocation-protection cv))
     (when names
-        (terpri)
-        (princ "Class Allocated Slots:"))
-        (terpri)
-        (terpri)
+      (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold)))
     (while names
-      (when (car prot)
-        (princ "Private "))
-      (princ "Slot: ")
-      (prin1 (car names))
-      (unless (eq (aref types i) t)
-        (princ "    type = ")
-        (prin1 (aref types i)))
-      (condition-case nil
-          (let ((value (eieio-oref class (car names))))
-            (princ "   value = ")
-            (prin1 value))
+      (insert
+       (concat
+        (when (car prot)
+          "Private ")
+        "Slot: "
+        (prin1-to-string (car names))
+        (unless (eq (aref types i) t)
+          (concat "    type = "
+                  (prin1-to-string (aref types i))))
+        (condition-case nil
+            (let ((value (eieio-oref class (car names))))
+              (concat "   value = "
+                      (prin1-to-string value)))
           (error nil))
-      (when (car docs)
-        (terpri)
-        (princ "  ")
-        (princ (car docs))
-        (terpri))
-      (terpri)
+        (when (car docs)
+          (concat "\n\n " (car docs) "\n"))
+        "\n"))
       (setq names (cdr names)
             docs (cdr docs)
             prot (cdr prot)
             i (1+ i)))))
 
-;;;###autoload
-(defun eieio-describe-constructor (fcn)
-  "Describe the constructor function FCN.
-Uses `eieio-describe-class' to describe the class being constructed."
-  (interactive
-   ;; Use eieio-read-class since all constructors have the same name as
-   ;; the class they create.
-   (list (eieio-read-class "Class: ")))
-  (eieio-describe-class
-   fcn (lambda ()
-         ;; Describe the constructor part.
-         (prin1 fcn)
-         (princ " is an object constructor function")
-         ;; Print file location
-         (when (get fcn 'class-location)
-           (princ " in `")
-           (princ (file-name-nondirectory (get fcn 'class-location)))
-           (princ "'"))
-         (terpri)
-         (princ "Creates an object of class ")
-         (prin1 fcn)
-         (princ ".")
-         (terpri)
-         (terpri)
-         ))
-  )
-
 (defun eieio-build-class-list (class)
   "Return a list of all classes that inherit from CLASS."
   (if (class-p class)
@@ -326,91 +267,112 @@ are not abstract."
 
 ;;; METHOD COMPLETION / DOC
 
-(defalias 'describe-method 'eieio-describe-generic)
-;;;###autoload(defalias 'describe-generic 'eieio-describe-generic)
-(defalias 'eieio-describe-method 'eieio-describe-generic)
+(define-button-type 'eieio-method-def
+  :supertype 'help-xref
+  'help-function (lambda (class method file)
+                   (eieio-help-find-method-definition class method file))
+  'help-echo (purecopy "mouse-2, RET: find method's definition"))
+
+(define-button-type 'eieio-class-def
+  :supertype 'help-xref
+  'help-function (lambda (class file)
+                   (eieio-help-find-class-definition class file))
+  'help-echo (purecopy "mouse-2, RET: find class definition"))
 
 ;;;###autoload
-(defun eieio-describe-generic (generic)
-  "Describe the generic function GENERIC.
-Also extracts information about all methods specific to this generic."
-  (interactive (list (eieio-read-generic "Generic Method: ")))
-  (eieio--check-type generic-p generic)
-  (with-output-to-temp-buffer (help-buffer) ; "*Help*"
-    (help-setup-xref (list #'eieio-describe-generic generic)
-                     (called-interactively-p 'interactive))
-
-    (prin1 generic)
-    (princ " is a generic function")
-    (when (generic-primary-only-p generic)
-      (princ " with only ")
-      (when (generic-primary-only-one-p generic)
-        (princ "one "))
-      (princ "primary method")
-      (when (not (generic-primary-only-one-p generic))
-        (princ "s"))
-      )
-    (princ ".")
-    (terpri)
-    (terpri)
-    (let ((d (documentation generic)))
-      (if (not d)
-          (princ "The generic is not documented.\n")
-        (princ "Documentation:")
-        (terpri)
-        (princ d)
-        (terpri)
-        (terpri)))
-    (princ "Implementations:")
-    (terpri)
-    (terpri)
-    (let ((i 4)
-          (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] ))
-      ;; Loop over fanciful generics
-      (while (< i 7)
-        (let ((gm (aref (get generic 'eieio-method-tree) i)))
-          (when gm
-            (princ "Generic ")
-            (princ (aref prefix (- i 3)))
-            (terpri)
-            (princ (or (nth 2 gm) "Undocumented"))
-            (terpri)
-            (terpri)))
-        (setq i (1+ i)))
-      (setq i 0)
-      ;; Loop over defined class-specific methods
-      (while (< i 4)
-        (let ((gm (reverse (aref (get generic 'eieio-method-tree) i)))
-              location)
-          (while gm
-            (princ "`")
-            (prin1 (car (car gm)))
-            (princ "'")
-            ;; prefix type
-            (princ " ")
-            (princ (aref prefix i))
-            (princ " ")
-            ;; argument list
-            (let* ((func (cdr (car gm)))
-                   (arglst (eieio-lambda-arglist func)))
-              (prin1 arglst))
-            (terpri)
-            ;; 3 because of cdr
-            (princ (or (documentation (cdr (car gm)))
-                       "Undocumented"))
-            ;; Print file location if available
-            (when (and (setq location (get generic 'method-locations))
-                       (setq location (assoc (caar gm) location)))
-              (setq location (cadr location))
-              (princ "\n\nDefined in `")
-              (princ (file-name-nondirectory location))
-              (princ "'\n"))
-            (setq gm (cdr gm))
-            (terpri)
-            (terpri)))
-        (setq i (1+ i)))))
-  (with-current-buffer (help-buffer)
-    (buffer-string)))
+(defun eieio-help-constructor (ctr)
+  "Describe CTR if it is a class constructor."
+  (when (class-p ctr)
+    (erase-buffer)
+    (let ((location (get ctr 'class-location))
+          (def (symbol-function ctr)))
+      (goto-char (point-min))
+      (prin1 ctr)
+      (insert (format " is an %s object constructor function"
+                      (if (autoloadp def)
+                          "autoloaded"
+                        "")))
+      (when (and (autoloadp def)
+                 (null location))
+        (setq location
+              (find-lisp-object-file-name ctr def)))
+      (when location
+        (insert " in `")
+        (help-insert-xref-button
+         (file-name-nondirectory location)
+         'eieio-class-def ctr location)
+        (insert "'"))
+      (insert ".\nCreates an object of class " (symbol-name ctr) ".")
+      (goto-char (point-max))
+      (if (autoloadp def)
+          (insert "\n\n[Class description not available until class definition is loaded.]\n")
+        (save-excursion
+          (insert (propertize "\n\nClass description:\n" 'face 'bold))
+          (eieio-help-class ctr))
+        ))))
+
+
+;;;###autoload
+(defun eieio-help-generic (generic)
+  "Describe GENERIC if it is a generic function."
+  (when (generic-p generic)
+    (save-excursion
+      (goto-char (point-min))
+      (when (re-search-forward " in `.+'.$" nil t)
+        (replace-match ".")))
+    (save-excursion
+      (insert "\n\nThis is a generic function"
+              (cond
+               ((and (generic-primary-only-p generic)
+                     (generic-primary-only-one-p generic))
+                " with only one primary method")
+               ((generic-primary-only-p generic)
+                " with only primary methods")
+               (t ""))
+              ".\n\n")
+      (insert (propertize "Implementations:\n\n" 'face 'bold))
+      (let ((i 4)
+            (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] ))
+        ;; Loop over fanciful generics
+        (while (< i 7)
+          (let ((gm (aref (get generic 'eieio-method-tree) i)))
+            (when gm
+              (insert "Generic "
+                      (aref prefix (- i 3))
+                      "\n"
+                      (or (nth 2 gm) "Undocumented")
+                      "\n\n")))
+          (setq i (1+ i)))
+        (setq i 0)
+        ;; Loop over defined class-specific methods
+        (while (< i 4)
+          (let* ((gm (reverse (aref (get generic 'eieio-method-tree) i)))
+                 cname location)
+            (while gm
+              (setq cname (caar gm))
+              (insert "`")
+              (help-insert-xref-button (symbol-name cname)
+                                       'help-variable cname)
+              (insert "' " (aref prefix i) " ")
+              ;; argument list
+              (let* ((func (cdr (car gm)))
+                     (arglst (eieio-lambda-arglist func)))
+                (prin1 arglst (current-buffer)))
+              (insert "\n"
+                      (or (documentation (cdr (car gm)))
+                          "Undocumented"))
+              ;; Print file location if available
+              (when (and (setq location (get generic 'method-locations))
+                         (setq location (assoc cname location)))
+                (setq location (cadr location))
+                (insert "\n\nDefined in `")
+                (help-insert-xref-button
+                 (file-name-nondirectory location)
+                 'eieio-method-def cname generic location)
+                (insert "'\n"))
+              (setq gm (cdr gm))
+              (insert "\n")))
+          (setq i (1+ i)))))))
 
 (defun eieio-lambda-arglist (func)
   "Return the argument list of FUNC, a function body."
@@ -584,21 +546,13 @@ Optional argument HISTORYVAR is the variable to use as history."
 
 ;;; HELP AUGMENTATION
 ;;
-(define-button-type 'eieio-method-def
-  :supertype 'help-xref
-  'help-function (lambda (class method file)
-                   (eieio-help-find-method-definition class method file))
-  'help-echo (purecopy "mouse-2, RET: find method's definition"))
-
-(define-button-type 'eieio-class-def
-  :supertype 'help-xref
-  'help-function (lambda (class file)
-                   (eieio-help-find-class-definition class file))
-  'help-echo (purecopy "mouse-2, RET: find class definition"))
-
 (defun eieio-help-find-method-definition (class method file)
   (let ((filename (find-library-name file))
         location buf)
+    (when (symbolp class)
+      (setq class (symbol-name class)))
+    (when (symbolp method)
+      (setq method (symbol-name method)))
     (when (null filename)
       (error "Cannot find library %s" file))
     (setq buf (find-file-noselect filename))
@@ -622,6 +576,8 @@ Optional argument HISTORYVAR is the variable to use as history."
       (beginning-of-line))))
 
 (defun eieio-help-find-class-definition (class file)
+  (when (symbolp class)
+    (setq class (symbol-name class)))
   (let ((filename (find-library-name file))
         location buf)
     (when (null filename)
@@ -642,71 +598,6 @@ Optional argument HISTORYVAR is the variable to use as history."
       (recenter)
       (beginning-of-line))))
 
-
-(defun eieio-help-mode-augmentation-maybee (&rest unused)
-  "For buffers thrown into help mode, augment for EIEIO.
-Arguments UNUSED are not used."
-  ;; Scan created buttons so far if we are in help mode.
-  (when (eq major-mode 'help-mode)
-    (save-excursion
-      (goto-char (point-min))
-      (let ((pos t) (inhibit-read-only t))
-        (while pos
-          (if (get-text-property (point) 'help-xref) ; move off reference
-              (goto-char
-               (or (next-single-property-change (point) 'help-xref)
-                   (point))))
-          (setq pos (next-single-property-change (point) 'help-xref))
-          (when pos
-            (goto-char pos)
-            (let* ((help-data (get-text-property (point) 'help-xref))
-                   ;(method (car help-data))
-                   (args (cdr help-data)))
-              (when (symbolp (car args))
-                (cond ((class-p (car args))
-                       (setcar help-data 'eieio-describe-class))
-                      ((generic-p (car args))
-                       (setcar help-data 'eieio-describe-generic))
-                      (t nil))
-                ))))
-        ;; start back at the beginning, and highlight some sections
-        (goto-char (point-min))
-        (while (re-search-forward "^\\(Documentation\\|Implementations\\):$" nil t)
-            (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
-        (goto-char (point-min))
-        (if (re-search-forward "^Specialized Methods:$" nil t)
-            (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
-        (goto-char (point-min))
-        (while (re-search-forward "^\\(Instance\\|Class\\) Allocated Slots:$" nil t)
-            (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
-        (goto-char (point-min))
-        (while (re-search-forward ":\\(STATIC\\|BEFORE\\|AFTER\\|PRIMARY\\)" nil t)
-            (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
-        (goto-char (point-min))
-        (while (re-search-forward "^\\(Private \\)?Slot:" nil t)
-            (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
-        (goto-char (point-min))
-        (cond
-         ((looking-at "\\(.+\\) is a generic function")
-          (let ((mname (match-string 1))
-                cname)
-            (while (re-search-forward "^`\\(.+\\)'[^\0]+?Defined in `\\(.+\\)'" nil t)
-              (setq cname (match-string-no-properties 1))
-              (help-xref-button 2 'eieio-method-def cname
-                                mname
-                                (cadr (assoc (intern cname)
-                                             (get (intern mname)
-                                                  'method-locations)))))))
-         ((looking-at "\\(.+\\) is an object constructor function in `\\(.+\\)'")
-          (let ((cname (match-string-no-properties 1)))
-            (help-xref-button 2 'eieio-class-def cname
-                              (get (intern cname) 'class-location))))
-         ((looking-at "\\(.+\\) is a\\(n abstract\\)? class in `\\(.+\\)'")
-          (let ((cname (match-string-no-properties 1)))
-            (help-xref-button 3 'eieio-class-def cname
-                              (get (intern cname) 'class-location)))))
-        ))))
-
 ;;; SPEEDBAR SUPPORT
 ;;
 
@@ -796,7 +687,7 @@ Argument INDENT is the depth of indentation."
   "Describe the class TEXT in TOKEN.
 INDENT is the current indentation level."
   (dframe-with-attached-buffer
-   (eieio-describe-class token))
+   (describe-function token))
   (dframe-maybee-jump-to-attached-frame))
 
 (provide 'eieio-opt)
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 3b1ba003d94..4d572601243 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -865,6 +865,10 @@ This may create or delete slots, but does not affect the return value
 of `eq'."
   (error "EIEIO: `change-class' is unimplemented"))
 
+;; Hook ourselves into help system for describing classes and methods.
+(add-hook 'help-fns-describe-function-functions 'eieio-help-generic)
+(add-hook 'help-fns-describe-function-functions 'eieio-help-constructor)
+
 ;;; Interfacing with edebug
 ;;
 (defun eieio-edebug-prin1-to-string (object &optional noescape)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 7b9e1783bad..2252c700fea 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -32,6 +32,12 @@
 
 ;;; Code:
 
+(defvar help-fns-describe-function-functions nil
+  "List of functions to run in help buffer in `describe-function'.
+Those functions will be run after the header line and argument
+list was inserted, and before the documentation will be inserted.
+The functions will receive the function name as argument.")
+
 ;; Functions
 
 ;;;###autoload
@@ -649,14 +655,15 @@ FILE is the file where FUNCTION was probably defined."
         (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)
-
+          (run-hook-with-args 'help-fns-describe-function-functions function)
           (insert "\n"
                   (or doc "Not documented.")))))))
 
+;; Add defaults to `help-fns-describe-function-functions'.
+(add-hook 'help-fns-describe-function-functions 'help-fns--obsolete)
+(add-hook 'help-fns-describe-function-functions 'help-fns--parent-mode)
+(add-hook 'help-fns-describe-function-functions 'help-fns--compiler-macro)
+
 
 ;; Variables