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.

1 files changed, 111 insertions, 113 deletions

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)