unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Manuel Giraud via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: 74111@debbugs.gnu.org
Subject: bug#74111: [PATCH] New `tmm-menubar' shortcut display style
Date: Thu, 31 Oct 2024 10:46:37 +0100	[thread overview]
Message-ID: <87r07wiozm.fsf@ledu-giraud.fr> (raw)
In-Reply-To: <87r07xtuot.fsf@ledu-giraud.fr> (Manuel Giraud via's message of "Wed, 30 Oct 2024 17:35:46 +0100")

[-- Attachment #1: Type: text/plain, Size: 103 bytes --]

Sorry, my previous patch misses a lots of cases to correctly match a
shortcut.  This new one fixes it.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-tmm-menubar-shortcut-display-style.patch --]
[-- Type: text/x-patch, Size: 5467 bytes --]

From 2cc969daae5505e2bd13fa6ef978325cd312ff89 Mon Sep 17 00:00:00 2001
From: Manuel Giraud <manuel@ledu-giraud.fr>
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    |  6 ++++++
 lisp/tmm.el | 54 +++++++++++++++++++++++++++++++++++++++--------------
 2 files changed, 46 insertions(+), 14 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index d1c7303f976..c3fc8d46062 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -584,6 +584,12 @@ 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, insert the character shortcut of a menu entry inside its
+string.  This character is highlighted with a different face to help
+identifying it.
+
 ** Foldout
 
 ---
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 252c1e45afa..fa6afbf4baf 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -108,6 +108,13 @@ tmm-shortcut-words
 specify nil for this variable."
   :type '(choice integer (const nil)))
 
+(defcustom tmm-shortcut-inside-entry nil
+  "Place the shortcut character into the menu entry's string.
+When non-nil, the shortcut character will be inserted into its menu
+entry string with a different 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)
@@ -406,13 +429,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


[-- Attachment #3: Type: text/plain, Size: 18 bytes --]

-- 
Manuel Giraud

  reply	other threads:[~2024-10-31  9:46 UTC|newest]

Thread overview: 9+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2024-10-30 16:35 bug#74111: [PATCH] New `tmm-menubar' shortcut display style Manuel Giraud via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-31  9:46 ` Manuel Giraud via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2024-10-31 10:04 ` Eli Zaretskii
2024-10-31 10:28   ` Manuel Giraud via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-31 10:50     ` Eli Zaretskii
2024-10-31 11:48       ` Manuel Giraud via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-31 14:25         ` Eli Zaretskii
2024-10-31 16:04           ` Manuel Giraud via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-31 16:57             ` Eli Zaretskii

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87r07wiozm.fsf@ledu-giraud.fr \
    --to=bug-gnu-emacs@gnu.org \
    --cc=74111@debbugs.gnu.org \
    --cc=manuel@ledu-giraud.fr \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).