Add new face 'help-key-binding' for keybindings in help

* lisp/faces.el (help-key-binding): New face.
* lisp/help.el
(help-for-help): Rename from 'help-for-help-internal'.  Use
'substitute-command-keys' syntax.
(help): Make into alias for 'help-for-help'.
(help-for-help-internal): Make into obsolete alias for
'help-for-help'.
(help--key-description-fontified): New function to add the
'help-key-binding' face.
(help-key-description, substitute-command-keys)
(describe-map-tree, help--describe-command)
(help--describe-translation, describe-map):
* lisp/help-fns.el (help-fns--key-bindings, describe-mode):
Use above new function.
* lisp/isearch.el (isearch-help-for-help-internal): Use
`substitute-command-keys' syntax.
* lisp/help-macro.el (make-help-screen): Use
'substitute-command-keys' and 'help--key-description-fontified'.
Simplify.
* src/keymap.c (describe_key_maybe_fontify): New function to add
the 'help-key-binding' face to keybindings.
(describe_vector): Use above new keybinding.
(syms_of_keymap) <Qfont_lock_face, Qhelp_key_binding>: New
DEFSYMs.
(fontify_key_properties): New static variable.
* lisp/tooltip.el (tooltip-show): Avoid overriding faces in
specified tooltip text.
* test/lisp/help-tests.el (with-substitute-command-keys-test):
Don't test for text properties.
(help-tests-substitute-command-keys/add-key-face)
(help-tests-substitute-command-keys/add-key-face-listing):
New tests.

9 files changed, 289 insertions, 199 deletions

diff --git a/etc/NEWS b/etc/NEWS
index cf21a7b0f18..3d94a0325d4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -920,6 +920,15 @@ skipped.
 ** Help
 
 ---
+*** Keybindings in 'help-mode' use the new 'help-key-binding' face.
+This face is added by 'substitute-command-keys' to any "\[command]"
+substitution.  The return value of that function should consequently
+be assumed to be a propertized string.
+
+Note that the new face will also be used in tooltips.  When using the
+GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t.
+
+---
 *** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation.
 
 +++
diff --git a/lisp/faces.el b/lisp/faces.el
index 90f11bbe3bb..b2d47edca0f 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2815,6 +2815,23 @@ Note: Other faces cannot inherit from the cursor face."
   "Face to highlight argument names in *Help* buffers."
   :group 'help)
 
+(defface help-key-binding
+  '((((class color) (min-colors 88) (background light)) :foreground "ForestGreen")
+    (((class color) (min-colors 88) (background dark)) :foreground "#44bc44")
+    (((class color grayscale) (background light)) :foreground "grey15")
+    (((class color grayscale) (background dark)) :foreground "grey85")
+    (t :foreground "ForestGreen"))
+  "Face for keybindings in *Help* buffers.
+
+This face is added by `substitute-command-keys', which see.
+
+Note that this face will also be used for key bindings in
+tooltips.  This means that, for example, changing the :height of
+this face will increase the height of any tooltip containing key
+bindings.  See also the face `tooltip'."
+  :version "28.1"
+  :group 'help)
+
 (defface glyphless-char
   '((((type tty)) :inherit underline)
     (((type pc)) :inherit escape-glyph)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 01d3756bf0c..c27cdb5aa45 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -466,13 +466,16 @@ suitable file is found, return nil."
               ;; 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 ", "))
+                  (with-current-buffer standard-output
+                    (insert (mapconcat #'help--key-description-fontified
+                                       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"))
+                    (with-current-buffer standard-output
+                      (insert (mapconcat #'help--key-description-fontified
+                                        keys ", "))
+                      (insert ", and many ordinary text characters"))
                   (princ "many ordinary text characters"))))
             (when (or remapped keys non-modified-keys)
               (princ ".")
@@ -1824,10 +1827,12 @@ documentation for the major and minor modes of that buffer."
               (save-excursion
                 (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
                                     nil t)
-                (help-xref-button 1 'help-function-def mode file-name)))))
-        (princ ":\n")
-        (princ (help-split-fundoc (documentation major-mode) nil 'doc))
-        (princ (help-fns--list-local-commands)))))
+                (help-xref-button 1 'help-function-def mode file-name)))))
+        (let ((fundoc (help-split-fundoc (documentation major-mode) nil 'doc)))
+          (with-current-buffer standard-output
+            (insert ":\n")
+            (insert fundoc)
+            (insert (help-fns--list-local-commands)))))))
   ;; For the sake of IELM and maybe others
   nil)
 
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 791b10a878f..72371a87278 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -92,119 +92,117 @@ If HELP-TEXT contains the sequence `%THIS-KEY%', that is replaced
 with the key sequence that invoked FNAME.
 When FNAME finally does get a command, it executes that command
 and then returns."
-  (let ((doc-fn (intern (concat (symbol-name fname) "-doc"))))
-    `(progn
-       (defun ,doc-fn () ,help-text nil)
-       (defun ,fname ()
-         "Help command."
-         (interactive)
-         (let ((line-prompt
-                (substitute-command-keys ,help-line)))
-           (when three-step-help
-             (message "%s" line-prompt))
-           (let* ((help-screen (documentation (quote ,doc-fn)))
-                  ;; We bind overriding-local-map for very small
-                  ;; sections, *excluding* where we switch buffers
-                  ;; and where we execute the chosen help command.
-                  (local-map (make-sparse-keymap))
-                  (new-minor-mode-map-alist minor-mode-map-alist)
-                  (prev-frame (selected-frame))
-                  config new-frame key char)
-             (when (string-match "%THIS-KEY%" help-screen)
-               (setq help-screen
-                     (replace-match (key-description
-                                     (substring (this-command-keys) 0 -1))
-                                    t t help-screen)))
-             (unwind-protect
-                 (let ((minor-mode-map-alist nil))
-                   (setcdr local-map ,helped-map)
-                   (define-key local-map [t] 'undefined)
-                   ;; Make the scroll bar keep working normally.
-                   (define-key local-map [vertical-scroll-bar]
-                     (lookup-key global-map [vertical-scroll-bar]))
-                   (if three-step-help
-                       (progn
-                         (setq key (let ((overriding-local-map local-map))
-                                     (read-key-sequence nil)))
-                         ;; Make the HELP key translate to C-h.
-                         (if (lookup-key function-key-map key)
-                             (setq key (lookup-key function-key-map key)))
-                         (setq char (aref key 0)))
-                     (setq char ??))
-                   (when (or (eq char ??) (eq char help-char)
-                             (memq char help-event-list))
-                     (setq config (current-window-configuration))
-                     (pop-to-buffer " *Metahelp*" nil t)
-                     (and (fboundp 'make-frame)
-                          (not (eq (window-frame)
-                                   prev-frame))
-                          (setq new-frame (window-frame)
-                                config nil))
-                     (setq buffer-read-only nil)
-                     (let ((inhibit-read-only t))
-                       (erase-buffer)
-                       (insert help-screen))
-                     (let ((minor-mode-map-alist new-minor-mode-map-alist))
-                       (help-mode)
-                       (setq new-minor-mode-map-alist minor-mode-map-alist))
-                     (goto-char (point-min))
-                     (while (or (memq char (append help-event-list
-                                                   (cons help-char '(?? ?\C-v ?\s ?\177 delete backspace vertical-scroll-bar ?\M-v))))
-                                (eq (car-safe char) 'switch-frame)
-                                (equal key "\M-v"))
-                       (condition-case nil
-                           (cond
-                            ((eq (car-safe char) 'switch-frame)
-                             (handle-switch-frame char))
-                            ((memq char '(?\C-v ?\s))
-                             (scroll-up))
-                            ((or (memq char '(?\177 ?\M-v delete backspace))
-                                 (equal key "\M-v"))
-                             (scroll-down)))
-                         (error nil))
-                       (let ((cursor-in-echo-area t)
-                             (overriding-local-map local-map))
-                         (setq key (read-key-sequence
-                                    (format "Type one of the options listed%s: "
-                                            (if (pos-visible-in-window-p
-                                                 (point-max))
-                                                "" ", or SPACE or DEL to scroll")))
-                               char (aref key 0)))
-
-                       ;; If this is a scroll bar command, just run it.
-                       (when (eq char 'vertical-scroll-bar)
-                         (command-execute (lookup-key local-map key) nil key))))
-                   ;; We don't need the prompt any more.
-                   (message "")
-                   ;; Mouse clicks are not part of the help feature,
-                   ;; so reexecute them in the standard environment.
-                   (if (listp char)
-                       (setq unread-command-events
-                             (cons char unread-command-events)
-                             config nil)
-                     (let ((defn (lookup-key local-map key)))
-                       (if defn
-                           (progn
-                             (when config
-                               (set-window-configuration config)
-                               (setq config nil))
-                             ;; Temporarily rebind `minor-mode-map-alist'
-                             ;; to `new-minor-mode-map-alist' (Bug#10454).
-                             (let ((minor-mode-map-alist new-minor-mode-map-alist))
-                               ;; `defn' must make sure that its frame is
-                               ;; selected, so we won't iconify it below.
-                               (call-interactively defn))
-                             (when new-frame
-                               ;; Do not iconify the selected frame.
-                               (unless (eq new-frame (selected-frame))
-                                 (iconify-frame new-frame))
-                               (setq new-frame nil)))
-                         (ding)))))
-               (when config
-                 (set-window-configuration config))
-               (when new-frame
-                 (iconify-frame new-frame))
-               (setq minor-mode-map-alist new-minor-mode-map-alist))))))))
+  (declare (indent defun))
+  `(defun ,fname ()
+     "Help command."
+     (interactive)
+     (let ((line-prompt
+            (substitute-command-keys ,help-line)))
+       (when three-step-help
+         (message "%s" line-prompt))
+       (let* ((help-screen ,help-text)
+              ;; We bind overriding-local-map for very small
+              ;; sections, *excluding* where we switch buffers
+              ;; and where we execute the chosen help command.
+              (local-map (make-sparse-keymap))
+              (new-minor-mode-map-alist minor-mode-map-alist)
+              (prev-frame (selected-frame))
+              config new-frame key char)
+         (when (string-match "%THIS-KEY%" help-screen)
+           (setq help-screen
+                 (replace-match (help--key-description-fontified
+                                 (substring (this-command-keys) 0 -1))
+                                t t help-screen)))
+         (unwind-protect
+             (let ((minor-mode-map-alist nil))
+               (setcdr local-map ,helped-map)
+               (define-key local-map [t] 'undefined)
+               ;; Make the scroll bar keep working normally.
+               (define-key local-map [vertical-scroll-bar]
+                 (lookup-key global-map [vertical-scroll-bar]))
+               (if three-step-help
+                   (progn
+                     (setq key (let ((overriding-local-map local-map))
+                                 (read-key-sequence nil)))
+                     ;; Make the HELP key translate to C-h.
+                     (if (lookup-key function-key-map key)
+                         (setq key (lookup-key function-key-map key)))
+                     (setq char (aref key 0)))
+                 (setq char ??))
+               (when (or (eq char ??) (eq char help-char)
+                         (memq char help-event-list))
+                 (setq config (current-window-configuration))
+                 (pop-to-buffer " *Metahelp*" nil t)
+                 (and (fboundp 'make-frame)
+                      (not (eq (window-frame)
+                               prev-frame))
+                      (setq new-frame (window-frame)
+                            config nil))
+                 (setq buffer-read-only nil)
+                 (let ((inhibit-read-only t))
+                   (erase-buffer)
+                   (insert (substitute-command-keys help-screen)))
+                 (let ((minor-mode-map-alist new-minor-mode-map-alist))
+                   (help-mode)
+                   (setq new-minor-mode-map-alist minor-mode-map-alist))
+                 (goto-char (point-min))
+                 (while (or (memq char (append help-event-list
+                                               (cons help-char '(?? ?\C-v ?\s ?\177 delete backspace vertical-scroll-bar ?\M-v))))
+                            (eq (car-safe char) 'switch-frame)
+                            (equal key "\M-v"))
+                   (condition-case nil
+                       (cond
+                        ((eq (car-safe char) 'switch-frame)
+                         (handle-switch-frame char))
+                        ((memq char '(?\C-v ?\s))
+                         (scroll-up))
+                        ((or (memq char '(?\177 ?\M-v delete backspace))
+                             (equal key "\M-v"))
+                         (scroll-down)))
+                     (error nil))
+                   (let ((cursor-in-echo-area t)
+                         (overriding-local-map local-map))
+                     (setq key (read-key-sequence
+                                (format "Type one of the options listed%s: "
+                                        (if (pos-visible-in-window-p
+                                             (point-max))
+                                            "" ", or SPACE or DEL to scroll")))
+                           char (aref key 0)))
+
+                   ;; If this is a scroll bar command, just run it.
+                   (when (eq char 'vertical-scroll-bar)
+                     (command-execute (lookup-key local-map key) nil key))))
+               ;; We don't need the prompt any more.
+               (message "")
+               ;; Mouse clicks are not part of the help feature,
+               ;; so reexecute them in the standard environment.
+               (if (listp char)
+                   (setq unread-command-events
+                         (cons char unread-command-events)
+                         config nil)
+                 (let ((defn (lookup-key local-map key)))
+                   (if defn
+                       (progn
+                         (when config
+                           (set-window-configuration config)
+                           (setq config nil))
+                         ;; Temporarily rebind `minor-mode-map-alist'
+                         ;; to `new-minor-mode-map-alist' (Bug#10454).
+                         (let ((minor-mode-map-alist new-minor-mode-map-alist))
+                           ;; `defn' must make sure that its frame is
+                           ;; selected, so we won't iconify it below.
+                           (call-interactively defn))
+                         (when new-frame
+                           ;; Do not iconify the selected frame.
+                           (unless (eq new-frame (selected-frame))
+                             (iconify-frame new-frame))
+                           (setq new-frame nil)))
+                     (ding)))))
+           (when config
+             (set-window-configuration config))
+           (when new-frame
+             (iconify-frame new-frame))
+           (setq minor-mode-map-alist new-minor-mode-map-alist))))))
 
 (provide 'help-macro)
 
diff --git a/lisp/help.el b/lisp/help.el
index 084e941549e..94073e5730a 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -104,8 +104,8 @@
     (define-key map "R" 'info-display-manual)
     (define-key map "s" 'describe-syntax)
     (define-key map "t" 'help-with-tutorial)
-    (define-key map "w" 'where-is)
     (define-key map "v" 'describe-variable)
+    (define-key map "w" 'where-is)
     (define-key map "q" 'help-quit)
     map)
   "Keymap for characters following the Help key.")
@@ -187,64 +187,58 @@ Do not call this in the scope of `with-help-window'."
 ;; So keyboard macro definitions are documented correctly
 (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
 
-(defalias 'help 'help-for-help-internal)
-;; find-function can find this.
-(defalias 'help-for-help 'help-for-help-internal)
-;; It can't find this, but nobody will look.
-(make-help-screen help-for-help-internal
+(defalias 'help 'help-for-help)
+(make-help-screen help-for-help
   (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?")
-  ;; Don't purecopy this one, because it's not evaluated (it's
-  ;; directly used as a docstring in a function definition, so it'll
-  ;; be moved to the DOC file anyway: no need for purecopying it).
   "You have typed %THIS-KEY%, the help character.  Type a Help option:
 \(Use SPC or DEL to scroll through this text.  Type \\<help-map>\\[help-quit] to exit the Help command.)
 
-a PATTERN   Show commands whose name matches the PATTERN (a list of words
-              or a regexp).  See also the `apropos' command.
-b           Display all key bindings.
-c KEYS      Display the command name run by the given key sequence.
-C CODING    Describe the given coding system, or RET for current ones.
-d PATTERN   Show a list of functions, variables, and other items whose
+\\[apropos-command] PATTERN   Show commands whose name matches the PATTERN (a list of words
+              or a regexp).  See also \\[apropos].
+\\[describe-bindings]           Display all key bindings.
+\\[describe-key-briefly] KEYS      Display the command name run by the given key sequence.
+\\[describe-coding-system] CODING    Describe the given coding system, or RET for current ones.
+\\[apropos-documentation] PATTERN   Show a list of functions, variables, and other items whose
               documentation matches the PATTERN (a list of words or a regexp).
-e           Go to the *Messages* buffer which logs echo-area messages.
-f FUNCTION  Display documentation for the given function.
-F COMMAND   Show the Emacs manual's section that describes the command.
-g           Display information about the GNU project.
-h           Display the HELLO file which illustrates various scripts.
-i           Start the Info documentation reader: read included manuals.
-I METHOD    Describe a specific input method, or RET for current.
-k KEYS      Display the full documentation for the key sequence.
-K KEYS      Show the Emacs manual's section for the command bound to KEYS.
-l           Show last 300 input keystrokes (lossage).
-L LANG-ENV  Describes a specific language environment, or RET for current.
-m           Display documentation of current minor modes and current major mode,
-              including their special commands.
-n           Display news of recent Emacs changes.
-o SYMBOL    Display the given function or variable's documentation and value.
-p TOPIC     Find packages matching a given topic keyword.
-P PACKAGE   Describe the given Emacs Lisp package.
-r           Display the Emacs manual in Info mode.
-R           Prompt for a manual and then display it in Info mode.
-s           Display contents of current syntax table, plus explanations.
-S SYMBOL    Show the section for the given symbol in the Info manual
+\\[view-echo-area-messages]           Go to the *Messages* buffer which logs echo-area messages.
+\\[describe-function] FUNCTION  Display documentation for the given function.
+\\[Info-goto-emacs-command-node] COMMAND   Show the Emacs manual's section that describes the command.
+\\[describe-gnu-project]           Display information about the GNU project.
+\\[view-hello-file]           Display the HELLO file which illustrates various scripts.
+\\[info]           Start the Info documentation reader: read included manuals.
+\\[describe-input-method] METHOD    Describe a specific input method, or RET for current.
+\\[describe-key] KEYS      Display the full documentation for the key sequence.
+\\[Info-goto-emacs-key-command-node] KEYS      Show the Emacs manual's section for the command bound to KEYS.
+\\[view-lossage]           Show last 300 input keystrokes (lossage).
+\\[describe-language-environment] LANG-ENV  Describes a specific language environment, or RET for current.
+\\[describe-mode]           Display documentation of current minor modes and current major mode,
+             including their special commands.
+\\[view-emacs-news]           Display news of recent Emacs changes.
+\\[describe-symbol] SYMBOL    Display the given function or variable's documentation and value.
+\\[finder-by-keyword] TOPIC     Find packages matching a given topic keyword.
+\\[describe-package] PACKAGE   Describe the given Emacs Lisp package.
+\\[info-emacs-manual]           Display the Emacs manual in Info mode.
+\\[info-display-manual]           Prompt for a manual and then display it in Info mode.
+\\[describe-syntax]           Display contents of current syntax table, plus explanations.
+\\[info-lookup-symbol] SYMBOL    Show the section for the given symbol in the Info manual
               for the programming language used in this buffer.
-t           Start the Emacs learn-by-doing tutorial.
-v VARIABLE  Display the given variable's documentation and value.
-w COMMAND   Display which keystrokes invoke the given command (where-is).
-.           Display any available local help at point in the echo area.
-
-C-a         Information about Emacs.
-C-c         Emacs copying permission (GNU General Public License).
-C-d         Instructions for debugging GNU Emacs.
-C-e         External packages and information about Emacs.
-C-f         Emacs FAQ.
+\\[help-with-tutorial]           Start the Emacs learn-by-doing tutorial.
+\\[describe-variable] VARIABLE  Display the given variable's documentation and value.
+\\[where-is] COMMAND   Display which keystrokes invoke the given command (where-is).
+\\[display-local-help]           Display any available local help at point in the echo area.
+
+\\[about-emacs]         Information about Emacs.
+\\[describe-copying]         Emacs copying permission (GNU General Public License).
+\\[view-emacs-debugging]         Instructions for debugging GNU Emacs.
+\\[view-external-packages]         External packages and information about Emacs.
+\\[view-emacs-FAQ]         Emacs FAQ.
 C-m         How to order printed Emacs manuals.
 C-n         News of recent Emacs changes.
-C-o         Emacs ordering and distribution information.
-C-p         Info about known Emacs problems.
-C-s         Search forward \"help window\".
-C-t         Emacs TODO list.
-C-w         Information on absence of warranty for GNU Emacs."
+\\[describe-distribution]         Emacs ordering and distribution information.
+\\[view-emacs-problems]         Info about known Emacs problems.
+\\[search-forward-help-for-help]         Search forward \"help window\".
+\\[view-emacs-todo]         Emacs TODO list.
+\\[describe-no-warranty]         Information on absence of warranty for GNU Emacs."
   help-map)
 
 
@@ -492,6 +486,15 @@ To record all your input, use `open-dribble-file'."
 
 ;; Key bindings
 
+(defun help--key-description-fontified (keys &optional prefix)
+  "Like `key-description' but add face for \"*Help*\" buffers."
+  ;; We add both the `font-lock-face' and `face' properties here, as this
+  ;; seems to be the only way to get this to work reliably in any
+  ;; buffer.
+  (propertize (key-description keys prefix)
+              'font-lock-face 'help-key-binding
+              'face 'help-key-binding))
+
 (defun describe-bindings (&optional prefix buffer)
   "Display a buffer showing a list of all defined keys, and their definitions.
 The keys are displayed in order of precedence.
@@ -511,7 +514,6 @@ or a buffer name."
     (with-current-buffer (help-buffer)
       (describe-buffer-bindings buffer prefix))))
 
-;; This function used to be in keymap.c.
 (defun describe-bindings-internal (&optional menus prefix)
   "Show a list of all defined keys, and their definitions.
 We put that list in a buffer, and display the buffer.
@@ -559,7 +561,8 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
       (let* ((remapped (command-remapping symbol))
              (keys (where-is-internal
                     symbol overriding-local-map nil nil remapped))
-             (keys (mapconcat 'key-description keys ", "))
+             (keys (mapconcat #'help--key-description-fontified
+                              keys ", "))
              string)
         (setq string
               (if insert
@@ -587,11 +590,11 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
   nil)
 
 (defun help-key-description (key untranslated)
-  (let ((string (key-description key)))
+  (let ((string (help--key-description-fontified key)))
     (if (or (not untranslated)
             (and (eq (aref untranslated 0) ?\e) (not (eq (aref key 0) ?\e))))
         string
-      (let ((otherstring (key-description untranslated)))
+      (let ((otherstring (help--key-description-fontified untranslated)))
         (if (equal string otherstring)
             string
           (format "%s (translated from %s)" string otherstring))))))
@@ -979,7 +982,7 @@ is currently activated with completion."
   "Substitute key descriptions for command names in STRING.
 Each substring of the form \\\\=[COMMAND] is replaced by either a
 keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
-is not on any keys.
+is not on any keys.  Keybindings will use the face `help-key-binding'.
 
 Each substring of the form \\\\={MAPVAR} is replaced by a summary of
 the value of MAPVAR as a keymap.  This summary is similar to the one
@@ -999,7 +1002,7 @@ into the output, \\\\==\\[ puts \\[ into the output, and \\\\==\\=` puts \\=` in
 output.
 
 Return the original STRING if no substitutions are made.
-Otherwise, return a new string (without any text properties)."
+Otherwise, return a new string."
   (when (not (null string))
     ;; KEYMAP is either nil (which means search all the active
     ;; keymaps) or a specified local map (which means search just that
@@ -1053,12 +1056,16 @@ Otherwise, return a new string (without any text properties)."
                                 (where-is-internal fun keymap t))))
                   (if (not key)
                       ;; Function is not on any key.
-                      (progn (insert "M-x ")
-                             (goto-char (+ end-point 3))
-                             (delete-char 1))
+                      (let ((op (point)))
+                        (insert "M-x ")
+                        (goto-char (+ end-point 3))
+                        (add-text-properties op (point)
+                                             '( face help-key-binding
+                                                font-lock-face help-key-binding))
+                        (delete-char 1))
                     ;; Function is on a key.
                     (delete-char (- end-point (point)))
-                    (insert (key-description key)))))
+                    (insert (help--key-description-fontified key)))))
                ;; 1D. \{foo} is replaced with a summary of the keymap
                ;;            (symbol-value foo).
                ;;     \<foo> just sets the keymap used for \[cmd].
@@ -1172,7 +1179,7 @@ Any inserted text ends in two newlines (used by
                           (concat title
                                   (if prefix
                                       (concat " Starting With "
-                                              (key-description prefix)))
+                                              (help--key-description-fontified prefix)))
                                   ":\n"))
                       "key             binding\n"
                       "---             -------\n")))
@@ -1228,7 +1235,11 @@ Return nil if the key sequence is too long."
                                              (= help--previous-description-column 32)))
                                     32)
                                    (t 16))))
-    (indent-to description-column 1)
+    ;; Avoid using the `help-keymap' face.
+    (let ((op (point)))
+      (indent-to description-column 1)
+      (set-text-properties op (point) '( face nil
+                                         font-lock-face nil)))
     (setq help--previous-description-column description-column)
     (cond ((symbolp definition)
            (insert (symbol-name definition) "\n"))
@@ -1240,7 +1251,11 @@ Return nil if the key sequence is too long."
 
 (defun help--describe-translation (definition)
   ;; Converted from describe_translation in keymap.c.
-  (indent-to 16 1)
+  ;; Avoid using the `help-keymap' face.
+  (let ((op (point)))
+    (indent-to 16)
+    (set-text-properties op (point) '( face nil
+                                      font-lock-face nil)))
   (cond ((symbolp definition)
          (insert (symbol-name definition) "\n"))
         ((or (stringp definition) (vectorp definition))
@@ -1351,9 +1366,9 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
               (setq end (caar vect))))
           ;; Now START .. END is the range to describe next.
           ;; Insert the string to describe the event START.
-          (insert (key-description (vector start) prefix))
+          (insert (help--key-description-fontified (vector start) prefix))
           (when (not (eq start end))
-            (insert " .. " (key-description (vector end) prefix)))
+            (insert " .. " (help--key-description-fontified (vector end) prefix)))
           ;; Print a description of the definition of this character.
           ;; Called function will take care of spacing out far enough
           ;; for alignment purposes.
@@ -1420,7 +1435,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
 ;;             (setq first nil))
 ;;           (when (and prefix (> (length prefix) 0))
 ;;             (insert (format "%s" prefix)))
-;;           (insert (key-description (vector start-idx) prefix))
+;;           (insert (help--key-description-fontified (vector start-idx) prefix))
 ;;           ;; Find all consecutive characters or rows that have the
 ;;           ;; same definition.
 ;;           (while (equal (keymap--get-keyelt (aref vector (1+ idx)) nil)
@@ -1433,7 +1448,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
 ;;             (insert " .. ")
 ;;             (when (and prefix (> (length prefix) 0))
 ;;               (insert (format "%s" prefix)))
-;;             (insert (key-description (vector idx) prefix)))
+;;             (insert (help--key-description-fontified (vector idx) prefix)))
 ;;           (if transl
 ;;               (help--describe-translation definition)
 ;;             (help--describe-command definition))
@@ -1924,6 +1939,8 @@ the suggested string to use instead.  See
 (add-function :after command-error-function
               #'help-command-error-confusable-suggestions)
 
+(define-obsolete-function-alias 'help-for-help-internal #'help-for-help "28.1")
+
 
 (provide 'help)
 
diff --git a/lisp/isearch.el b/lisp/isearch.el
index e7926ac08ce..943e24aa563 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -460,11 +460,11 @@ and doesn't remove full-buffer highlighting after a search."
 (make-help-screen isearch-help-for-help-internal
   (purecopy "Type a help option: [bkm] or ?")
   "You have typed %THIS-KEY%, the help character.  Type a Help option:
-\(Type \\<help-map>\\[help-quit] to exit the Help command.)
+\(Type \\<isearch-help-map>\\[help-quit] to exit the Help command.)
 
-b           Display all Isearch key bindings.
-k KEYS      Display full documentation of Isearch key sequence.
-m           Display documentation of Isearch mode.
+\\[isearch-describe-bindings]           Display all Isearch key bindings.
+\\[isearch-describe-key] KEYS      Display full documentation of Isearch key sequence.
+\\[isearch-describe-mode]           Display documentation of Isearch mode.
 
 You can't type here other help keys available in the global help map,
 but outside of this help window when you type them in Isearch mode,
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 8e00aa5c2a9..af3b86bba71 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -248,7 +248,12 @@ in echo area."
             (setf (alist-get 'border-color params) fg))
           (when (stringp bg)
             (setf (alist-get 'background-color params) bg))
-          (x-show-tip (propertize text 'face 'tooltip)
+          ;; Use non-nil APPEND argument below to avoid overriding any
+          ;; faces used in our TEXT.  Among other things, this allows
+          ;; tooltips to use the `help-key-binding' face used in
+          ;; `substitute-command-keys' substitutions.
+          (add-face-text-property 0 (length text) 'tooltip t text)
+          (x-show-tip text
                       (selected-frame)
                       params
                       tooltip-hide-delay
diff --git a/src/keymap.c b/src/keymap.c
index 782931fadff..bb26b6389d4 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -2846,6 +2846,21 @@ DESCRIBER is the output function used; nil means use `princ'.  */)
   return unbind_to (count, Qnil);
 }
 
+static Lisp_Object fontify_key_properties;
+
+static Lisp_Object
+describe_key_maybe_fontify (Lisp_Object str, Lisp_Object prefix,
+                                   bool keymap_p)
+{
+  Lisp_Object key_desc = Fkey_description (str, prefix);
+  if (keymap_p)
+    Fadd_text_properties (make_fixnum (0),
+                          make_fixnum (SCHARS (key_desc)),
+                          fontify_key_properties,
+                          key_desc);
+  return key_desc;
+}
+
 DEFUN ("help--describe-vector", Fhelp__describe_vector, Shelp__describe_vector, 7, 7, 0,
        doc: /* Insert in the current buffer a description of the contents of VECTOR.
 Call DESCRIBER to insert the description of one value found in VECTOR.
@@ -3021,7 +3036,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
       if (!NILP (elt_prefix))
         insert1 (elt_prefix);
 
-      insert1 (Fkey_description (kludge, prefix));
+      insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p));
 
       /* Find all consecutive characters or rows that have the same
          definition.  But, if VECTOR is a char-table, we had better
@@ -3071,7 +3086,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
           if (!NILP (elt_prefix))
             insert1 (elt_prefix);
 
-          insert1 (Fkey_description (kludge, prefix));
+          insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p));
         }
 
       /* Print a description of the definition of this character.
@@ -3200,6 +3215,12 @@ be preferred.  */);
   staticpro (&where_is_cache);
   staticpro (&where_is_cache_keymaps);
 
+  DEFSYM (Qfont_lock_face, "font-lock-face");
+  DEFSYM (Qhelp_key_binding, "help-key-binding");
+  staticpro (&fontify_key_properties);
+  fontify_key_properties = Fcons (Qfont_lock_face,
+                                  Fcons (Qhelp_key_binding, Qnil));
+
   defsubr (&Skeymapp);
   defsubr (&Skeymap_parent);
   defsubr (&Skeymap_prompt);
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 8034764741c..b2fec5c1bde 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -26,6 +26,7 @@
 
 (require 'ert)
 (eval-when-compile (require 'cl-lib))
+(require 'text-property-search) ; for `text-property-search-forward'
 
 (ert-deftest help-split-fundoc-SECTION ()
   "Test new optional arg SECTION."
@@ -60,9 +61,8 @@
 (defmacro with-substitute-command-keys-test (&rest body)
   `(cl-flet* ((test
                (lambda (orig result)
-                 (should (equal-including-properties
-                          (substitute-command-keys orig)
-                          result))))
+                 (should (equal (substitute-command-keys orig)
+                                result))))
               (test-re
                (lambda (orig regexp)
                  (should (string-match (concat "^" regexp "$")
@@ -222,6 +222,24 @@ M-s		next-matching-history-element
 (define-minor-mode help-tests-minor-mode
   "Minor mode for testing shadowing.")
 
+(ert-deftest help-tests-substitute-command-keys/add-key-face ()
+  (should (equal (substitute-command-keys "\\[next-line]")
+                 (propertize "C-n"
+                             'face 'help-key-binding
+                             'font-lock-face 'help-key-binding))))
+
+(ert-deftest help-tests-substitute-command-keys/add-key-face-listing ()
+  (with-temp-buffer
+    (insert (substitute-command-keys "\\{help-tests-minor-mode-map}"))
+    (goto-char (point-min))
+    (text-property-search-forward 'face 'help-key-binding)
+    (should (looking-at "C-e"))
+    ;; Don't fontify trailing whitespace.
+    (should-not (get-text-property (+ (point) 3) 'face))
+    (text-property-search-forward 'face 'help-key-binding)
+    (should (looking-at "x"))
+    (should-not (get-text-property (+ (point) 1) 'face))))
+
 (ert-deftest help-tests-substitute-command-keys/test-mode ()
   (with-substitute-command-keys-test
    (with-temp-buffer