(help-fns-function-name): New function

Consolidate code used in profiler and help--describe-command,
and improve it while we're at it.
Also use #' to quote a few function names along the way.

* lisp/help-fns.el (help-fns--function-numbers, help-fns--function-names):
New vars.
(help-fns--display-function): New aux function.
(help-fns-function-name): New function, inspired from
`help--describe-command`.

* lisp/help.el (help--describe-command): Use `help-fns-function-name`.
(help--for-help-make-sections): Remove redundant "" arg to `mapconcat`.

* lisp/profiler.el (profiler-format-entry, profiler-fixup-entry):
Delete functions.
(profiler-report-make-entry-part): Use `help-fns-function-name` instead.
(profiler-report-find-entry): Use `push-button`.

* lisp/transient.el (transient--debug): Use `help-fns-function-name`
when available.

6 files changed, 127 insertions, 88 deletions

diff --git a/etc/NEWS b/etc/NEWS
index ba0e4c80fa0..eda84d588a8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1647,6 +1647,12 @@ values.
 
 * Lisp Changes in Emacs 30.1
 
+** New function 'help-fns-function-name'.
+For named functions, it just returns the name and otherwise
+it returns a short "unique" string that identifies the function.
+In either case, the string is propertized so clicking on it gives
+further details.
+
 ** New function 'cl-type-of'.
 This function is like 'type-of' except that it sometimes returns
 a more precise type.  For example, for nil and t it returns 'null'
diff --git a/lisp/bind-key.el b/lisp/bind-key.el
index 1e59c75566a..780314fecbd 100644
--- a/lisp/bind-key.el
+++ b/lisp/bind-key.el
@@ -468,6 +468,7 @@ other modes.  See `override-global-mode'."
      ((and bind-key-describe-special-forms (functionp elem)
            (stringp (setq doc (documentation elem))))
       doc) ;;FIXME: Keep only the first line?
+     ;; FIXME: Use `help-fns-function-name'?
      ((consp elem)
       (if (symbolp (car elem))
           (format "#<%s>" (car elem))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 15d87f9925c..422f6e9dddf 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -2448,6 +2448,74 @@ one of them returns non-nil."
     (setq buffer-undo-list nil)
     (texinfo-mode)))
 
+(defconst help-fns--function-numbers
+  (make-hash-table :test 'equal :weakness 'value))
+(defconst help-fns--function-names (make-hash-table :weakness 'key))
+
+(defun help-fns--display-function (function)
+  (cond
+   ((subr-primitive-p function)
+    (describe-function function))
+   ((and (compiled-function-p function)
+         (not (and (fboundp 'kmacro-p) (kmacro-p function))))
+    (disassemble function))
+   (t
+    ;; FIXME: Use cl-print!
+    (pp-display-expression function "*Help Source*" (consp function)))))
+
+;;;###autoload
+(defun help-fns-function-name (function)
+  "Return a short string representing FUNCTION."
+  ;; FIXME: For kmacros, should we print the key-sequence?
+  (cond
+   ((symbolp function)
+    (let ((name (if (eq (intern-soft (symbol-name function)) function)
+                    (symbol-name function)
+                  (concat "#:" (symbol-name function)))))
+      (if (not (fboundp function))
+          name
+        (make-text-button name nil
+                          'type 'help-function
+                          'help-args (list function)))))
+   ((gethash function help-fns--function-names))
+   ((subrp function)
+    (let ((name (subr-name function)))
+      ;; FIXME: For native-elisp-functions, should we use `help-function'
+      ;; or `disassemble'?
+      (format "#<%s %s>"
+              (cl-type-of function)
+              (make-text-button name nil
+                                'type 'help-function
+                                ;; Let's hope the subr hasn't been redefined!
+                                'help-args (list (intern name))))))
+   (t
+    (let ((type (or (oclosure-type function)
+                    (if (consp function)
+                        (car function) (cl-type-of function))))
+          (hash (sxhash-eq function))
+          ;; Use 3 digits minimum.
+          (mask #xfff)
+          name)
+      (while
+          (let* ((hex (format (concat "%0"
+                                      (number-to-string (1+ (/ (logb mask) 4)))
+                                      "X")
+                              (logand mask hash)))
+                 ;; FIXME: For kmacros, we don't want to `disassemble'!
+                 (button (buttonize
+                          hex #'help-fns--display-function function
+                          ;; FIXME: Shouldn't `buttonize' add
+                          ;; the "mouse-2, RET:" prefix?
+                          "mouse-2, RET: Display the function's body")))
+            (setq name (format "#<%s %s>" type button))
+            (and (< mask (abs hash))    ; We can add more digits.
+                 (gethash name help-fns--function-numbers)))
+        ;; Add a digit.
+        (setq mask (+ (ash mask 4) #x0f)))
+      (puthash name function help-fns--function-numbers)
+      (puthash function name help-fns--function-names)
+      name))))
+
 (provide 'help-fns)
 
 ;;; help-fns.el ends here
diff --git a/lisp/help.el b/lisp/help.el
index c6a1e3c6bd9..4171d0c57c7 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -301,6 +301,8 @@ Do not call this in the scope of `with-help-window'."
        (let ((first-message
               (cond ((or
                       pop-up-frames
+                      ;; FIXME: `special-display-p' is obsolete since
+                      ;; the vars on which it depends are obsolete!
                       (special-display-p (buffer-name standard-output)))
                      (setq help-return-method (cons (selected-window) t))
                      ;; If the help output buffer is a special display buffer,
@@ -382,9 +384,9 @@ Do not call this in the scope of `with-help-window'."
         (propertize title 'face 'help-for-help-header)
         "\n\n"
         (help--for-help-make-commands commands))))
-   sections ""))
+   sections))
 
-(defalias 'help 'help-for-help)
+(defalias 'help #'help-for-help)
 (make-help-screen help-for-help
   (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?")
   (concat
@@ -876,7 +878,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
           (format "%s (translated from %s)" string otherstring))))))
 
 (defun help--binding-undefined-p (defn)
-  (or (null defn) (integerp defn) (equal defn 'undefined)))
+  (or (null defn) (integerp defn) (equal defn #'undefined)))
 
 (defun help--analyze-key (key untranslated &optional buffer)
   "Get information about KEY its corresponding UNTRANSLATED events.
@@ -1221,7 +1223,7 @@ appeared on the mode-line."
 (defun describe-minor-mode-completion-table-for-symbol ()
   ;; In order to list up all minor modes, minor-mode-list
   ;; is used here instead of minor-mode-alist.
-  (delq nil (mapcar 'symbol-name minor-mode-list)))
+  (delq nil (mapcar #'symbol-name minor-mode-list)))
 
 (defun describe-minor-mode-from-symbol (symbol)
   "Display documentation of a minor mode given as a symbol, SYMBOL."
@@ -1644,34 +1646,14 @@ Return nil if the key sequence is too long."
           (t value))))
 
 (defun help--describe-command (definition &optional translation)
-  (cond ((symbolp definition)
-         (if (and (fboundp definition)
-                  help-buffer-under-preparation)
-             (insert-text-button (symbol-name definition)
-                                 'type 'help-function
-                                 'help-args (list definition))
-           (insert (symbol-name definition)))
-         (insert "\n"))
-        ((or (stringp definition) (vectorp definition))
+  (cond ((or (stringp definition) (vectorp definition))
          (if translation
              (insert (key-description definition nil) "\n")
+           ;; These should be rare nowadays, replaced by `kmacro's.
            (insert "Keyboard Macro\n")))
         ((keymapp definition)
          (insert "Prefix Command\n"))
-        ((byte-code-function-p definition)
-         (insert (format "[%s]\n"
-                         (buttonize "byte-code" #'disassemble definition))))
-        ((and (consp definition)
-              (memq (car definition) '(closure lambda)))
-         (insert (format "[%s]\n"
-                         (buttonize
-                          (symbol-name (car definition))
-                          (lambda (_)
-                            (pp-display-expression
-                             definition "*Help Source*" t))
-                          nil "View definition"))))
-        (t
-         (insert "??\n"))))
+        (t (insert (help-fns-function-name definition) "\n"))))
 
 (define-obsolete-function-alias 'help--describe-translation
   #'help--describe-command "29.1")
@@ -2011,8 +1993,8 @@ and some others."
   (if temp-buffer-resize-mode
       ;; `help-make-xrefs' may add a `back' button and thus increase the
       ;; text size, so `resize-temp-buffer-window' must be run *after* it.
-      (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
-    (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
+      (add-hook 'temp-buffer-show-hook #'resize-temp-buffer-window 'append)
+    (remove-hook 'temp-buffer-show-hook #'resize-temp-buffer-window)))
 
 (defvar resize-temp-buffer-window-inhibit nil
   "Non-nil means `resize-temp-buffer-window' should not resize.")
@@ -2256,7 +2238,7 @@ The `temp-buffer-window-setup-hook' hook is called."
 ;; Don't print to *Help*; that would clobber Help history.
 (defun help-form-show ()
   "Display the output of a non-nil `help-form'."
-  (let ((msg (eval help-form)))
+  (let ((msg (eval help-form t)))
     (if (stringp msg)
         (with-output-to-temp-buffer " *Char Help*"
           (princ msg)))))
@@ -2421,7 +2403,7 @@ the same names as used in the original source code, when possible."
                    (t arg)))
                 arglist)))
 
-(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1")
+(define-obsolete-function-alias 'help-make-usage #'help--make-usage "25.1")
 
 (defun help--make-usage-docstring (fn arglist)
   (let ((print-escape-newlines t))
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 80f84037a63..4e02cd1d890 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -38,8 +38,7 @@
 
 (defcustom profiler-sampling-interval 1000000
   "Default sampling interval in nanoseconds."
-  :type 'natnum
-  :group 'profiler)
+  :type 'natnum)
 
 
 ;;; Utilities
@@ -68,7 +67,7 @@
                collect c into s
                do (cl-decf i)
                finally return
-               (apply 'string (if (eq (car s) ?,) (cdr s) s)))
+               (apply #'string (if (eq (car s) ?,) (cdr s) s)))
     (profiler-ensure-string number)))
 
 (defun profiler-format (fmt &rest args)
@@ -76,7 +75,7 @@
            for arg in args
            for str = (cond
                       ((consp subfmt)
-                       (apply 'profiler-format subfmt arg))
+                       (apply #'profiler-format subfmt arg))
                       ((stringp subfmt)
                        (format subfmt arg))
                       ((and (symbolp subfmt)
@@ -91,7 +90,8 @@
            if (< width len)
            collect (progn (put-text-property (max 0 (- width 2)) len
                                              'invisible 'profiler str)
-                          str) into frags
+                          str)
+           into frags
            else
            collect
            (let ((padding (make-string (max 0 (- width len)) ?\s)))
@@ -100,32 +100,11 @@
                (right (concat padding str))))
            into frags
            finally return (apply #'concat frags)))
-
-
-;;; Entries
-
-(defun profiler-format-entry (entry)
-  "Format ENTRY in human readable string.
-ENTRY would be a function name of a function itself."
-  (cond ((memq (car-safe entry) '(closure lambda))
-         (format "#<lambda %#x>" (sxhash entry)))
-        ((byte-code-function-p entry)
-         (format "#<compiled %#x>" (sxhash entry)))
-        ((or (subrp entry) (symbolp entry) (stringp entry))
-         (format "%s" entry))
-        (t
-         (format "#<unknown %#x>" (sxhash entry)))))
-
-(defun profiler-fixup-entry (entry)
-  (if (symbolp entry)
-      entry
-    (profiler-format-entry entry)))
-
 
 ;;; Backtraces
 
 (defun profiler-fixup-backtrace (backtrace)
-  (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
+  (apply #'vector (mapcar #'help-fns-function-name backtrace)))
 
 
 ;;; Logs
@@ -434,18 +413,15 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
 
 (defcustom profiler-report-closed-mark "+"
   "An indicator of closed calltrees."
-  :type 'string
-  :group 'profiler)
+  :type 'string)
 
 (defcustom profiler-report-open-mark "-"
   "An indicator of open calltrees."
-  :type 'string
-  :group 'profiler)
+  :type 'string)
 
 (defcustom profiler-report-leaf-mark " "
   "An indicator of calltree leaves."
-  :type 'string
-  :group 'profiler)
+  :type 'string)
 
 (defvar profiler-report-cpu-line-format
   '((17 right ((12 right)
@@ -474,17 +450,18 @@ Do not touch this variable directly.")
   (let ((string (cond
                  ((eq entry t)
                   "Others")
-                 ((and (symbolp entry)
-                       (fboundp entry))
-                  (propertize (symbol-name entry)
-                              'face 'link
-                              'follow-link "\r"
-                              'mouse-face 'highlight
-                              'help-echo "\
+                 (t (propertize (help-fns-function-name entry)
+                                ;; Override the `button-map' which
+                                ;; otherwise adds RET, mouse-1, and TAB
+                                ;; bindings we don't want.  :-(
+                                'keymap '(make-sparse-keymap)
+                                'follow-link "\r"
+                                ;; FIXME: The help-echo code gets confused
+                                ;; by the `follow-link' property and rewrites
+                                ;; `mouse-2' to `mouse-1' :-(
+                                'help-echo "\
 mouse-2: jump to definition\n\
-RET: expand or collapse"))
-                 (t
-                  (profiler-format-entry entry)))))
+RET: expand or collapse")))))
     (propertize string 'profiler-entry entry)))
 
 (defun profiler-report-make-name-part (tree)
@@ -719,10 +696,13 @@ point."
         (current-buffer))
     (and event (setq event (event-end event))
          (posn-set-point event))
-    (let ((tree (profiler-report-calltree-at-point)))
-      (when tree
-        (let ((entry (profiler-calltree-entry tree)))
-          (find-function entry))))))
+    (save-excursion
+      (forward-line 0)
+      (let ((eol (pos-eol)))
+        (forward-button 1)
+        (if (> (point) eol)
+            (error "No entry found")
+          (push-button))))))
 
 (defun profiler-report-describe-entry ()
   "Describe entry at point."
diff --git a/lisp/transient.el b/lisp/transient.el
index 2d8566a3ac4..c3b9448e2c4 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -1249,7 +1249,7 @@ symbol property.")
 (when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1
            (not read-extended-command-predicate))
   (setq read-extended-command-predicate
-        'transient-command-completion-not-suffix-only-p))
+        #'transient-command-completion-not-suffix-only-p))
 
 (defun transient-parse-suffix (prefix suffix)
   "Parse SUFFIX, to be added to PREFIX.
@@ -1258,7 +1258,7 @@ SUFFIX is a suffix command or a group specification (of
   the same forms as expected by `transient-define-prefix').
 Intended for use in a group's `:setup-children' function."
   (cl-assert (and prefix (symbolp prefix)))
-  (eval (car (transient--parse-child prefix suffix))))
+  (eval (car (transient--parse-child prefix suffix)) t))
 
 (defun transient-parse-suffixes (prefix suffixes)
   "Parse SUFFIXES, to be added to PREFIX.
@@ -1278,7 +1278,7 @@ Intended for use in a group's `:setup-children' function."
                 (string suffix)))
          (mem (transient--layout-member loc prefix))
          (elt (car mem)))
-    (setq suf (eval suf))
+    (setq suf (eval suf t))
     (cond
      ((not mem)
       (message "Cannot insert %S into %s; %s not found"
@@ -1736,7 +1736,8 @@ to `transient-predicate-map'.  Also see `transient-base-map'."
                            "Hide common commands"
                          "Show common permanently")))
                (list "C-x l" "Show/hide suffixes" #'transient-set-level)
-               (list "C-x a" #'transient-toggle-level-limit))))))))
+               (list "C-x a" #'transient-toggle-level-limit)))))
+       t)))
 
 (defvar-keymap transient-popup-navigation-map
   :doc "One of the keymaps used when popup navigation is enabled.
@@ -2574,10 +2575,11 @@ value.  Otherwise return CHILDREN as is."
       (if (symbolp arg)
           (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
                    arg
-                   (or (and (symbolp this-command) this-command)
-                       (if (byte-code-function-p this-command)
-                           "#[...]"
-                         this-command))
+                   (if (fboundp 'help-fns-function-name)
+                       (help-fns-function-name this-command)
+                     (if (byte-code-function-p this-command)
+                         "#[...]"
+                       this-command))
                    (key-description (this-command-keys-vector))
                    transient--exitp
                    (cond ((keywordp (car args))
@@ -2982,7 +2984,7 @@ transient is active."
   (interactive)
   (transient-set-value (transient-prefix-object)))
 
-(defalias 'transient-set-and-exit 'transient-set
+(defalias 'transient-set-and-exit #'transient-set
   "Set active transient's value for this Emacs session and exit.")
 
 (defun transient-save ()
@@ -2990,7 +2992,7 @@ transient is active."
   (interactive)
   (transient-save-value (transient-prefix-object)))
 
-(defalias 'transient-save-and-exit 'transient-save
+(defalias 'transient-save-and-exit #'transient-save
   "Save active transient's value for this and future Emacs sessions and exit.")
 
 (defun transient-reset ()