Re: Escaping a string for substitute-command-keys

[Basil L. Contovounesios]

Eli Zaretskii <address@hidden> writes:

>> From: "Basil L. Contovounesios" <address@hidden>
>> Cc: Clément Pit-Claudel <address@hidden>,  Eli
>>  Zaretskii
>>  <address@hidden>,  address@hidden
>> Date: Sat, 05 Oct 2019 16:40:35 +0100
>> 
>> Another source of inconsistency is {forward,backward}-button, which
>> display help-echo values in the echo area when called interactively.
>> Currently, they perform no command name substitution.  Should they?
>
> IMO, all displays of help-echo should look the same way.

So, would something like the following be acceptable?  Clément, do you
envision this working against any of your planned changes?

>From 745a68d371d20fa3a98e3ea0e270e477d85a11d0 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <address@hidden>
Date: Sat, 5 Oct 2019 19:51:38 +0100
Subject: [PATCH] Substitute command keys in button help-echo values

For consistency with tooltips displayed via show-help-function, make
forward-button also substitute command keys in the help-echo values
it displays in the echo area.
For discussion, see the following thread:
https://lists.gnu.org/archive/html/emacs-devel/2019-10/msg00090.html
* lisp/button.el (button--help-echo): Pass resulting string through
substitute-command-keys for consistency with show-help-function.
* test/lisp/button-tests.el (button-tests--map): New test keymap.
(button--help-echo-string, button--help-echo-form)
(button--help-echo-function): Use it to test command key
substitution in help-echo strings.
---
 lisp/button.el            | 18 ++++++++++++------
 test/lisp/button-tests.el | 35 ++++++++++++++++++++++-------------
 2 files changed, 34 insertions(+), 19 deletions(-)

diff --git a/lisp/button.el b/lisp/button.el
index 04e77ca904..8d073aaceb 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -468,12 +468,18 @@ push-button
        t))))
 
 (defun button--help-echo (button)
-  "Evaluate BUTTON's `help-echo' property and return its value."
-  (let ((help (button-get button 'help-echo)))
-    (if (functionp help)
-        (let ((obj (if (overlayp button) button (current-buffer))))
-          (funcall help (selected-window) obj (button-start button)))
-      (eval help lexical-binding))))
+  "Evaluate BUTTON's `help-echo' property and return its value.
+If the result is non-nil, pass it through
+`substitute-command-keys' before returning it, as is done for
+`show-help-function'."
+  (let* ((help (button-get button 'help-echo))
+         (help (if (functionp help)
+                   (funcall help
+                            (selected-window)
+                            (if (overlayp button) button (current-buffer))
+                            (button-start button))
+                 (eval help lexical-binding))))
+    (and help (substitute-command-keys help))))
 
 (defun forward-button (n &optional wrap display-message no-error)
   "Move to the Nth next button, or Nth previous button if N is negative.
diff --git a/test/lisp/button-tests.el b/test/lisp/button-tests.el
index 44a7ea6f6e..73e3a764b3 100644
--- a/test/lisp/button-tests.el
+++ b/test/lisp/button-tests.el
@@ -21,6 +21,12 @@
 
 (require 'ert)
 
+(defvar button-tests--map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "x" #'ignore)
+    map)
+  "Keymap for testing command substitution.")
+
 (ert-deftest button-at ()
   "Test `button-at' behavior."
   (with-temp-buffer
@@ -41,11 +47,13 @@ button--help-echo-string
   "Test `button--help-echo' with strings."
   (with-temp-buffer
     ;; Text property buttons.
-    (let ((button (insert-text-button "text" 'help-echo "text help")))
-      (should (equal (button--help-echo button) "text help")))
+    (let ((button (insert-text-button
+                   "text" 'help-echo "text: \\<button-tests--map>\\[ignore]")))
+      (should (equal (button--help-echo button) "text: x")))
     ;; Overlay buttons.
-    (let ((button (insert-button "overlay" 'help-echo "overlay help")))
-      (should (equal (button--help-echo button) "overlay help")))))
+    (let ((button (insert-button "overlay" 'help-echo
+                                 "overlay: \\<button-tests--map>\\[ignore]")))
+      (should (equal (button--help-echo button) "overlay: x")))))
 
 (ert-deftest button--help-echo-form ()
   "Test `button--help-echo' with forms."
@@ -55,16 +63,17 @@ button--help-echo-form
            (form   `(funcall (let ((,help "lexical form"))
                                (lambda () ,help))))
            (button (insert-text-button "text" 'help-echo form)))
-      (set help "dynamic form")
-      (should (equal (button--help-echo button) "dynamic form")))
+      (set help "dynamic: \\<button-tests--map>\\[ignore]")
+      (should (equal (button--help-echo button) "dynamic: x")))
     ;; Test overlay buttons with lexical scoping.
     (setq lexical-binding t)
     (let* ((help   (make-symbol "help"))
-           (form   `(funcall (let ((,help "lexical form"))
-                               (lambda () ,help))))
+           (form   `(funcall
+                     (let ((,help "lexical: \\<button-tests--map>\\[ignore]"))
+                       (lambda () ,help))))
            (button (insert-button "overlay" 'help-echo form)))
       (set help "dynamic form")
-      (should (equal (button--help-echo button) "lexical form")))))
+      (should (equal (button--help-echo button) "lexical: x")))))
 
 (ert-deftest button--help-echo-function ()
   "Test `button--help-echo' with functions."
@@ -77,9 +86,9 @@ button--help-echo-function
                      (should (eq win owin))
                      (should (eq obj obuf))
                      (should (=  pos opos))
-                     "text function"))
+                     "text: \\<button-tests--map>\\[ignore]"))
            (button (insert-text-button "text" 'help-echo help)))
-      (should (equal (button--help-echo button) "text function"))
+      (should (equal (button--help-echo button) "text: x"))
       ;; Overlay buttons.
       (setq help (lambda (win obj pos)
                    (should (eq win owin))
@@ -88,9 +97,9 @@ button--help-echo-function
                    (should (eq (overlay-buffer obj) obuf))
                    (should (= (overlay-start obj) opos))
                    (should (= pos opos))
-                   "overlay function"))
+                   "overlay: \\<button-tests--map>\\[ignore]"))
       (setq opos (point))
       (setq button (insert-button "overlay" 'help-echo help))
-      (should (equal (button--help-echo button) "overlay function")))))
+      (should (equal (button--help-echo button) "overlay: x")))))
 
 ;;; button-tests.el ends here
-- 
2.23.0

Thanks,

-- 
Basil