Simplify 'read-multiple-choice' prompt formatting

diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index e743038a778b840412b0d8976c3990d34c0ffa39..b632e5e45ea31212f4a922b60ac26a2820fd6065 100644 (file)
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -3676,8 +3676,8 @@ The return value is the matching value from @var{choices}.
    (?n "no" "Refuse to use certificate, close connection.")))
 @end lisp
 
-The @code{read-multiple-choice-face} face is used to highlight the
-matching characters in the name string on graphical terminals.
+The @code{read-multiple-choice} face is used to highlight the matching
+characters in the name string on graphical terminals.
 
 @end defun
 

diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el
index b776f12671ef4d251a099db447677324c47c5639..34c187288afcdd4b840e2b48b3654d9a78830372 100644 (file)
--- a/etc/themes/modus-themes.el
+++ b/etc/themes/modus-themes.el
@@ -1642,7 +1642,7 @@ FG and BG are the main colors."
     `(mm-uu-extract ((,c :foreground ,mail-part)))
     `(next-error ((,c :inherit modus-themes-prominent-error :extend t)))
     `(pgtk-im-0 ((,c :inherit modus-themes-prominent-note)))
-    `(read-multiple-choice-face ((,c :inherit modus-themes-mark-sel)))
+    `(read-multiple-choice ((,c :inherit modus-themes-mark-sel)))
     `(rectangle-preview ((,c :inherit secondary-selection)))
     `(region ((,c :background ,bg-region :foreground ,fg-region)))
     `(secondary-selection ((,c :background ,bg-hover-secondary :foreground ,fg-main)))

diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 3dc8a0af0149d0b70f15e50ec9f9b0489e64d057..568faf3580dd38274c4b4646084fba18f3842fcd 100644 (file)
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -27,41 +27,30 @@
   "Customizations for `read-multiple-choice'."
   :group 'minibuffer)
 
+(defun rmc-format-key-label (key &optional label)
+  "Format KEY with optional LABEL for display as part of a prompt."
+  (let ((pos (seq-position label key))
+        (desc (key-description (vector key))))
+    (if (or (not pos) (member desc '("ESC" "TAB" "RET" "DEL" "SPC")))
+        ;; Not in the label string, or a special character.
+        (format "%s %s" (propertize desc 'face 'read-multiple-choice) label)
+      (setq label (copy-sequence label))
+      (put-text-property pos (1+ pos) 'face 'read-multiple-choice label)
+      label)))
+
 (defun rmc--add-key-description (elem)
-  (let* ((char (car elem))
-         (name (cadr elem))
-         (pos (seq-position name char))
-         (desc (key-description (char-to-string char)))
-         (graphical-terminal
-          (display-supports-face-attributes-p
-           '(:underline t) (window-frame)))
-         (altered-name
-          (cond
-           ;; Not in the name string, or a special character.
-           ((or (not pos)
-                (member desc '("ESC" "TAB" "RET" "DEL" "SPC")))
-            (format "%s %s"
-                    (if graphical-terminal
-                        (propertize desc 'face 'read-multiple-choice-face)
-                      (propertize desc 'face 'help-key-binding))
-                    name))
-           ;; The prompt character is in the name, so highlight
-           ;; it on graphical terminals.
-           (graphical-terminal
-            (setq name (copy-sequence name))
-            (put-text-property pos (1+ pos)
-                               'face 'read-multiple-choice-face
-                               name)
-            name)
-           ;; And put it in [bracket] on non-graphical terminals.
-           (t
-            (concat
-             (substring name 0 pos)
-             "["
-             (upcase (substring name pos (1+ pos)))
-             "]"
-             (substring name (1+ pos)))))))
-    (cons char altered-name)))
+  (let ((char (car elem)))
+    (cons char (rmc-format-key-label char (cadr elem)))))
+
+(defun rmc-key-description (key name)
+  (let ((pos (seq-position name key))
+        (desc (key-description (vector key))))
+    (if (or (not pos) (member desc '("ESC" "TAB" "RET" "DEL" "SPC")))
+        ;; Not in the name string, or a special character.
+        (format "%s %s" (propertize desc 'face 'read-multiple-choice) name)
+      (setq name (copy-sequence name))
+      (put-text-property pos (1+ pos) 'face 'read-multiple-choice name)
+      name)))
 
 (defcustom read-multiple-choice-help-buffer-name "*Multiple Choice Help*"
   "Name of the buffer showing help during `read-multiple-choice'."
@@ -298,13 +287,13 @@ Usage example:
                  (setq invalid-choice
                        (concat "Invalid choice "
                                (propertize (key-description (vector tchar))
-                                           'face 'read-multiple-choice-face)
+                                           'face 'read-multiple-choice)
                                ", choose one of the following ("
-                               (propertize "C-h" 'face 'read-multiple-choice-face)
+                               (propertize "C-h" 'face 'read-multiple-choice)
                                " for help, "
-                               (propertize "C-g" 'face 'read-multiple-choice-face)
+                               (propertize "C-g" 'face 'read-multiple-choice)
                                " to quit, "
-                               (propertize "C-r" 'face 'read-multiple-choice-face)
+                               (propertize "C-r" 'face 'read-multiple-choice)
                                " to pause):\n")))))
             (message (concat invalid-choice full-prompt))
             (setq tchar
@@ -320,7 +309,7 @@ Usage example:
           (mapcar (lambda (elem)
                     (concat (propertize (key-description (char-to-string
                                                           (car elem)))
-                                        'face 'read-multiple-choice-face)
+                                        'face 'read-multiple-choice)
                             " " (cadr elem)))
                   choices))
          (answer

diff --git a/lisp/faces.el b/lisp/faces.el
index e9f2cb42a567df713b8772bb49fcc570f13da8bb..d88d9885c0178f17e81bb0ddc68ff0447f0200e0 100644 (file)
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -3109,13 +3109,14 @@ It is used for characters of no fonts too."
   :version "24.1"
   :group 'basic-faces)
 
-(defface read-multiple-choice-face
-  '((t (:inherit (help-key-binding underline)
-        :weight bold)))
+(defface read-multiple-choice
+  '((t :inherit (help-key-binding underline) :weight bold))
   "Face for the symbol name in `read-multiple-choice' output."
   :group 'basic-faces
   :version "26.1")
 
+(put 'read-multiple-choice-face 'face-alias 'read-multiple-choice)
+
 ;; Faces for TTY menus.
 (defface tty-menu-enabled-face
   '((((class color))

diff --git a/lisp/repeat.el b/lisp/repeat.el
index 412afc35ba73197cda74fbb4237d3972f5fb5128..34cef51906777aa288fb2734e90fbacb187c3743 100644 (file)
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -558,14 +558,13 @@ This function can be used to force exit of repetition while it's active."
     (format-message
      "Repeat with %s%s"
      (mapconcat (lambda (key-cmd)
-                  (let* ((key (car key-cmd))
-                         (cmd (cdr key-cmd))
-                         (hint (when (symbolp cmd)
-                                 (get cmd 'repeat-hint))))
-                    (substitute-command-keys
-                     (format "\\`%s'%s"
-                             (key-description (vector key))
-                             (if hint (format ":%s" hint) "")))))
+                  (let ((key (car key-cmd))
+                        (cmd (cdr key-cmd)))
+                    (if-let ((hint (and (symbolp cmd)
+                                        (get cmd 'repeat-hint))))
+                        (rmc-key-description key hint)
+                      (propertize (key-description (vector key))
+                                  'face 'read-multiple-choice))))
                 keys ", ")
      (if repeat-exit-key
          (substitute-command-keys

diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el
index 9b494918d7ce741dff689e3fab93b6729d4d6067..de57011a4a25ff11b67e1306dc57503011e34684 100644 (file)
--- a/test/lisp/emacs-lisp/rmc-tests.el
+++ b/test/lisp/emacs-lisp/rmc-tests.el
@@ -42,13 +42,13 @@
   (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) t)))
     (should (equal-including-properties
              (rmc--add-key-description '(?y "yes"))
-             `(?y . ,(concat (propertize "y" 'face 'read-multiple-choice-face) "es"))))
+             `(?y . ,(concat (propertize "y" 'face 'read-multiple-choice) "es"))))
     (should (equal-including-properties
              (rmc--add-key-description '(?n "foo"))
-             `(?n . ,(concat (propertize "n" 'face 'read-multiple-choice-face) " foo"))))
+             `(?n . ,(concat (propertize "n" 'face 'read-multiple-choice) " foo"))))
     (should (equal-including-properties
              (rmc--add-key-description '(?\s "foo bar"))
-             `(?\s . ,(concat (propertize "SPC" 'face 'read-multiple-choice-face) " foo bar"))))))
+             `(?\s . ,(concat (propertize "SPC" 'face 'read-multiple-choice) " foo bar"))))))
 
 (ert-deftest test-rmc--add-key-description/non-graphical-display ()
   (cl-letf (((symbol-function 'display-supports-face-attributes-p) (lambda (_ _) nil)))