master accd79c9393 1/2: (help-fns-function-description-header): Print functions' type

[Stefan Monnier]

branch: master
commit accd79c93935b50dddfcd6fe7fb6912c80bcddb1
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    (help-fns-function-description-header): Print functions' type
    
    Instead of choosing English words to describe the kind of function,
    use the actual type of the function object (from `cl-type-of`)
    directly, and make it a button to display info about that type.
    
    * lisp/help-fns.el (help-fns-function-description-header): Use the
    function's type name in the description instead of "prose".
    Use `insert` instead of `princ`, so as to preserve the text-properties
    of the button.
    
    * lisp/emacs-lisp/cl-extra.el (cl-help-type): Move to `help-mode.el`
    and rename to `help-type`.
    (cl--describe-class): Adjust accordingly.
    
    * lisp/help-mode.el (help-type): New type, moved and renamed from
    `cl-extra.el`.
---
 lisp/emacs-lisp/cl-extra.el | 11 +++--------
 lisp/help-fns.el            | 31 ++++++++++++++-----------------
 lisp/help-mode.el           |  5 +++++
 3 files changed, 22 insertions(+), 25 deletions(-)

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index d43c21d3eb9..437dea2d6a9 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -720,11 +720,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
   (add-to-list 'find-function-regexp-alist
                '(define-type . cl--typedef-regexp)))
 
-(define-button-type 'cl-help-type
-  :supertype 'help-function-def
-  'help-function #'cl-describe-type
-  'help-echo (purecopy "mouse-2, RET: describe this type"))
-
 (define-button-type 'cl-type-definition
   :supertype 'help-function-def
   'help-echo (purecopy "mouse-2, RET: find type definition"))
@@ -777,7 +772,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
     (insert (symbol-name type)
             (substitute-command-keys " is a type (of kind `"))
     (help-insert-xref-button (symbol-name metatype)
-                             'cl-help-type metatype)
+                             'help-type metatype)
     (insert (substitute-command-keys "')"))
     (when location
       (insert (substitute-command-keys " in `"))
@@ -796,7 +791,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
           (setq cur (cl--class-name cur))
           (insert (substitute-quotes "`"))
           (help-insert-xref-button (symbol-name cur)
-                                   'cl-help-type cur)
+                                   'help-type cur)
           (insert (substitute-command-keys (if pl "', " "'"))))
         (insert ".\n")))
 
@@ -808,7 +803,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
         (while (setq cur (pop ch))
           (insert (substitute-quotes "`"))
           (help-insert-xref-button (symbol-name cur)
-                                   'cl-help-type cur)
+                                   'help-type cur)
           (insert (substitute-command-keys (if ch "', " "'"))))
         (insert ".\n")))
 
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 638af81ded8..a291893e9a2 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1061,10 +1061,10 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED 
REAL-DEF)."
                         (concat
                          "an autoloaded " (if (commandp def)
                                               "interactive "))
-                      (if (commandp def) "an interactive " "a "))))
-
-    ;; Print what kind of function-like object FUNCTION is.
-    (princ (cond ((or (stringp def) (vectorp def))
+                      (if (commandp def) "an interactive " "a ")))
+               ;; Print what kind of function-like object FUNCTION is.
+               (description
+               (cond ((or (stringp def) (vectorp def))
                  "a keyboard macro")
                 ((and (symbolp function)
                        (get function 'reader-construct))
@@ -1073,12 +1073,6 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED 
REAL-DEF)."
                 ;; aliases before functions.
                 (aliased
                  (format-message "an alias for `%s'" real-def))
-                 ((subr-native-elisp-p def)
-                  (concat beg "native-compiled Lisp function"))
-                ((subrp def)
-                 (concat beg (if (eq 'unevalled (cdr (subr-arity def)))
-                                 "special form"
-                                "built-in function")))
                 ((autoloadp def)
                  (format "an autoloaded %s"
                           (cond
@@ -1092,12 +1086,13 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED 
REAL-DEF)."
                      ;; need to check macros before functions.
                      (macrop function))
                  (concat beg "Lisp macro"))
-                ((byte-code-function-p def)
-                 (concat beg "byte-compiled Lisp function"))
-                 ((module-function-p def)
-                  (concat beg "module function"))
-                ((memq (car-safe def) '(lambda closure))
-                 (concat beg "Lisp function"))
+                ((atom def)
+                 (let ((type (or (oclosure-type def) (cl-type-of def))))
+                   (concat beg (format "%s"
+                                       (make-text-button
+                                        (symbol-name type) nil
+                                        'type 'help-type
+                                        'help-args (list type))))))
                 ((keymapp def)
                  (let ((is-full nil)
                        (elts (cdr-safe def)))
@@ -1107,7 +1102,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED 
REAL-DEF)."
                                elts nil))
                      (setq elts (cdr-safe elts)))
                    (concat beg (if is-full "keymap" "sparse keymap"))))
-                (t "")))
+                (t ""))))
+    (with-current-buffer standard-output
+      (insert description))
 
     (if (and aliased (not (fboundp real-def)))
        (princ ",\nwhich is not defined.")
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index dd78342ace7..48433d899ab 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -177,6 +177,11 @@ The format is (FUNCTION ARGS...).")
   'help-function 'describe-variable
   'help-echo (purecopy "mouse-2, RET: describe this variable"))
 
+(define-button-type 'help-type
+  :supertype 'help-xref
+  'help-function #'cl-describe-type
+  'help-echo (purecopy "mouse-2, RET: describe this type"))
+
 (define-button-type 'help-face
   :supertype 'help-xref
   'help-function 'describe-face