Subject: bug#69935: [PATCH] (help-fns-function-description-header): Print functions' type

From: Stefan Monnier <[email-masked]>
Date: Thu, 21 Mar 2024 21:22:39 -0400

Tags: patch

The patch below changes the first line of `C-h f` from something like:

    car is a built-in function in ‘C source code’.

to

    car is a primitive-function in ‘C source code’.

i.e. print the actual type rather than an English description.
The type is buttonized so users can click on it to see a description of
the type (and its super/subtypes).

Beside exposing those types (and their related information), another
advantage is that it simplifies the code since we don't need to
enumerate all the different kinds of functions we may have (well, we
still do for those "function-like objects" which don't have a dedicated
type such as macros, keymaps, aliases, keyboard macros, yadda yadda, but
a single case covers all of special forms, primitive functions,
byte-code functions, module functions, and native-compiled functions).

Any comment/objection?

        Stefan

 In GNU Emacs 30.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version
 3.24.38, cairo version 1.16.0) of 2024-02-23 built on pastel
Repository revision: 831e094a09f70a15e4b4b83c5158dbeb8d9daede
Repository branch: work
Windowing system distributor 'The X.Org Foundation', version 11.0.12101007
System Description: Debian GNU/Linux 12 (bookworm)

Configured using:
 'configure -C --enable-checking --enable-check-lisp-object-type --with-modules --with-cairo --with-tiff=ifavailable
 'CFLAGS=-Wall -g3 -Og -Wno-pointer-sign' --without-native-compilation
 PKG_CONFIG_PATH=/home/monnier/lib/pkgconfig'

>From 8169ad959bfca252fa4ef824f7ee10005f922431 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <[email-masked]>
Date: Thu, 21 Mar 2024 21:08:58 -0400
Subject: [PATCH] (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 @@ cl--typedef-regexp
   (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 @@ cl--describe-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 @@ cl--describe-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 @@ cl--describe-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 422f6e9dddf..79a39c3d639 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1061,10 +1061,10 @@ help-fns-function-description-header
                         (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 @@ help-fns-function-description-header
 		 ;; 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 @@ help-fns-function-description-header
 		      ;; 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 @@ help-fns-function-description-header
 				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 @@ 'help-variable
   '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
-- 
2.43.0