From dbaf9698dc176b8eb64c3373808943cede2b4bce Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Wed, 30 Oct 2024 17:24:24 +0100 Subject: [PATCH] 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 placed inside the menu entry's string. (tmm-add-one-shortcut): Compute the new shortcut style. (tmm-prompt): Adapt the prompt regexp. (tmm-shortcut): Simplify and make it work with this change. * etc/NEWS: Announce the option. --- etc/NEWS | 5 ++++ lisp/tmm.el | 69 ++++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 55 insertions(+), 19 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index d1c7303f976..db13a1dd971 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -584,6 +584,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..1992ff0f73c 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -83,11 +83,11 @@ tmm-mid-prompt 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 @@ tmm-shortcut-words 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 shortcut character will be highlighted into its menu +entry's string 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 @@ tmm-prompt (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 @@ tmm-add-one-shortcut (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,32 @@ tmm-add-one-shortcut (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) @@ -384,7 +407,12 @@ tmm-add-prompt (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 +434,16 @@ tmm-shortcut (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))))) -- 2.47.0