]> git.eshelyaron.com Git - emacs.git/commitdiff
Substitute command keys in button help-echo values
authorBasil L. Contovounesios <contovob@tcd.ie>
Fri, 16 Oct 2020 07:32:48 +0000 (09:32 +0200)
committerLars Ingebrigtsen <larsi@gnus.org>
Fri, 16 Oct 2020 07:32:48 +0000 (09:32 +0200)
* 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 (bug#43070).

lisp/button.el
test/lisp/button-tests.el

index 11317605ceea9506c86e96bc19fa14295eee6795..ba0682348df55a17345d9354f868a8368d77de07 100644 (file)
@@ -493,12 +493,17 @@ butting, use the `button-describe' command."
        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.
index 11cc14042c677fa01e8a9eafcf803916d01d7762..b463366c33bb78668893b2ca76a0b8b52a5aa462 100644 (file)
 
 (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
   "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."
            (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 @@
                      (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 @@
                    (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