New `tmm-menubar' shortcut display style

Bug#74111
* lisp/tmm.el (tmm-shortcut-inside-entry): New user option to
control if the shortcut character is highlighted inside the menu
entry's string.
(tmm-add-one-shortcut): Compute the new shortcut style.
(tmm-add-prompt, tmm-completion-prompt): Adapt the completion
prompt according to the shortcut display style.
(tmm-prompt): Adapt the prompt regexp.
(tmm-shortcut): Simplify default case and make it work with this
change.
* etc/NEWS: Announce the option.

2 files changed, 58 insertions, 20 deletions

diff --git a/etc/NEWS b/etc/NEWS
index dceece0a8c0..4aba4b17055 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -592,6 +592,11 @@ instead.
 *** A new shortcut to navigate to previous menu.
 The hardcoded '^' shortcut gets you back to the previous menu.
 
+---
+*** New user option 'tmm-shortcut-inside-entry'.
+When non-nil, highlight the character shortcut in the menu entry's
+string instead of preprending it and `tmm-mid-prompt' to said entry.
+
 ** Foldout
 
 ---
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 252c1e45afa..80991b246b6 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -83,11 +83,11 @@ or else the correct item might not be found in the `*Completions*' buffer."
                  string))
 
 (defcustom tmm-completion-prompt
-  "Press PageUp key to reach this buffer from the minibuffer.
-Alternatively, you can use Up/Down keys (or your History keys) to change
+  "Press M-v/PageUp key to reach this buffer from the minibuffer.
+Alternatively, You can use Up/Down keys (or your History keys) to change
 the item in the minibuffer, and press RET when you are done, or press
-the marked letters to pick up your choice.  Type ^ to go to the parent
-menu.  Type C-g or ESC ESC ESC to cancel.
+the %s to pick up your choice.
+Type ^ to go to the parent menu.  Type C-g or ESC ESC ESC to cancel.
 "
   "Help text to insert on the top of the completion buffer.
 To save space, you can set this to nil,
@@ -108,6 +108,13 @@ If you use only one of `downcase' or `upcase' for `tmm-shortcut-style',
 specify nil for this variable."
   :type '(choice integer (const nil)))
 
+(defcustom tmm-shortcut-inside-entry nil
+  "Highlight the shortcut character in the menu entry's string.
+When non-nil, the first menu-entry's character that acts as a shortcut
+will be highlighted with the `highlight' face to help identifying it.
+The `tmm-mid-prompt' string is not used then."
+  :type 'boolean)
+
 (defface tmm-inactive
   '((t :inherit shadow))
   "Face used for inactive menu items.")
@@ -198,7 +205,8 @@ is used to go back through those sub-menus."
                      (setq tail (cdr tail)))))
              (let ((prompt
                     (concat "^"
-                            (if (stringp tmm-mid-prompt)
+                            (if (and (stringp tmm-mid-prompt)
+                                     (not tmm-shortcut-inside-entry))
                                 (concat "."
                                         (regexp-quote tmm-mid-prompt))))))
                (setq tmm--history
@@ -283,7 +291,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
    (t
     (let* ((str (car elt))
            (paren (string-search "(" str))
-           (pos 0) (word 0) char)
+           (word 0) pos char)
       (catch 'done                             ; ??? is this slow?
         (while (and (or (not tmm-shortcut-words)   ; no limit on words
                         (< word tmm-shortcut-words)) ; try n words
@@ -299,17 +307,34 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
                 (if (not (memq char tmm-short-cuts)) (throw 'done char))))
           (setq word (1+ word))
           (setq pos (match-end 0)))
+        ;; A nil value for pos means that the shortcut is not inside the
+        ;; string of the menu entry.
+        (setq pos nil)
         (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit
           (setq char tmm-next-shortcut-digit)
           (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit))
           (if (not (memq char tmm-short-cuts)) (throw 'done char)))
         (setq char nil))
       (if char (setq tmm-short-cuts (cons char tmm-short-cuts)))
-      (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt)
-                      ;; keep them lined up in columns
-                      (make-string (1+ (length tmm-mid-prompt)) ?\s))
-                    str)
-            (cdr elt))))))
+      (cons
+       (if tmm-shortcut-inside-entry
+           (if char
+               (if pos
+                   ;; A character inside the menu entry.
+                   (let ((res (copy-sequence str)))
+                     (aset res pos char)
+                     (add-text-properties pos (1+ pos) '(face highlight) res)
+                     res)
+                 ;; A fallback digit character: place it in front of the
+                 ;; menu entry.
+                 (concat (propertize (char-to-string char) 'face 'highlight)
+                         " " str))
+             (make-string 2 ?\s))
+         (concat (if char (concat (char-to-string char) tmm-mid-prompt)
+                   ;; Keep them lined up in columns.
+                   (make-string (1+ (length tmm-mid-prompt)) ?\s))
+                 str))
+       (cdr elt))))))
 
 ;; This returns the old map.
 (defun tmm-define-keys (minibuffer)
@@ -328,7 +353,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
       (define-key map "\ev" 'tmm-goto-completions)
       (define-key map "\C-n" 'next-history-element)
       (define-key map "\C-p" 'previous-history-element)
-      ;; Previous menu shortcut (see `tmm-prompt')
+      ;; Previous menu shortcut (see `tmm-prompt').
       (define-key map "^" 'self-insert-and-exit))
     (prog1 (current-local-map)
       (use-local-map (append map (current-local-map))))))
@@ -384,7 +409,12 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
       (let ((inhibit-read-only t)
             (window (get-buffer-window "*Completions*")))
         (goto-char (point-min))
-        (insert tmm-completion-prompt)
+        (insert
+         (if tmm-shortcut-inside-entry
+             (format tmm-completion-prompt
+                     (concat (propertize "highlighted" 'face 'highlight) " character"))
+           (format tmm-completion-prompt
+                   (concat "character right before '" tmm-mid-prompt "' "))))
         (when window
           ;; Try to show everything just inserted and preserve height of
           ;; *Completions* window.  This should fix a behavior described
@@ -406,13 +436,16 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
               (choose-completion))
           ;; In minibuffer
           (delete-region (minibuffer-prompt-end) (point-max))
-          (dolist (elt tmm-km-list)
-            (if (string=
-                 (substring (car elt) 0
-                            (min (1+ (length tmm-mid-prompt))
-                                 (length (car elt))))
-                 (concat (char-to-string c) tmm-mid-prompt))
-                (setq s (car elt))))
+          (dolist (elt tmm-km-list)
+            (let ((str (car elt))
+                  (index 0))
+              (when tmm-shortcut-inside-entry
+                (if (get-char-property 0 'face str)
+                    (setq index 0)
+                  (let ((next (next-single-char-property-change 0 'face str)))
+                    (setq index (if (= (length str) next) 0 next)))))
+              (if (= (aref str index) c)
+                  (setq s str))))
           (insert s)
           (exit-minibuffer)))))