master 6d55d93379f: Apply quote substitution to popup choice menus

[Stephen Berman]

branch: master
commit 6d55d93379fa531f81327be6e506610474846758
Author: Stephen Berman <stephen.berman@gmx.net>
Commit: Stephen Berman <stephen.berman@gmx.net>

    Apply quote substitution to popup choice menus
    
    * lisp/wid-edit.el (widget-choose): Iteratively apply
    substitute-command-keys to choice item text before building popup
    or text buffer menu.  Also fix two unnecessary uses of let*.
---
 lisp/wid-edit.el | 138 +++++++++++++++++++++++++++++--------------------------
 1 file changed, 73 insertions(+), 65 deletions(-)

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index cafd0ad0a4d..234f3d9b74d 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -281,71 +281,79 @@ The user is asked to choose between each NAME from ITEMS.
 If ITEMS has simple item definitions, then this function returns the VALUE of
 the chosen element.  If ITEMS is a keymap, then the return value is the symbol
 in the key vector, as in the argument of `define-key'."
-  (cond ((and (< (length items) widget-menu-max-size)
-             event (display-popup-menus-p))
-        ;; Mouse click.
-         (if (keymapp items)
-             ;; Modify the keymap prompt, and then restore the old one, if any.
-             (let ((prompt (keymap-prompt items)))
-               (unwind-protect
-                   (progn
-                     (setq items (delete prompt items))
-                     (push title (cdr items))
-                     ;; Return just the first element of the list of events.
-                     (car (x-popup-menu event items)))
-                 (setq items (delete title items))
-                 (when prompt
-                   (push prompt (cdr items)))))
-          (x-popup-menu event (list title (cons "" items)))))
-       ((or widget-menu-minibuffer-flag
-            (> (length items) widget-menu-max-shortcuts))
-         (when (keymapp items)
-           (setq items (widget--simplify-menu items)))
-        ;; Read the choice of name from the minibuffer.
-        (setq items (cl-remove-if 'stringp items))
-        (let ((val (completing-read (concat title ": ") items nil t)))
-          (if (stringp val)
-              (let ((try (try-completion val items)))
-                (when (stringp try)
-                  (setq val try))
-                (cdr (assoc val items))))))
-       (t
-         (when (keymapp items)
-           (setq items (widget--simplify-menu items)))
-        ;; Construct a menu of the choices
-        ;; and then use it for prompting for a single character.
-        (let* ((next-digit ?0)
-               alist choice some-choice-enabled value)
-          (with-current-buffer (get-buffer-create " widget-choose")
-            (erase-buffer)
-            (insert "Available choices:\n\n")
-            (while items
-              (setq choice (pop items))
-              (when (consp choice)
-                 (let* ((name (substitute-command-keys (car choice)))
-                        (function (cdr choice)))
-                   (insert (format "%c = %s\n" next-digit name))
-                   (push (cons next-digit function) alist)
-                   (setq some-choice-enabled t)))
-              ;; Allocate digits to disabled alternatives
-              ;; so that the digit of a given alternative never varies.
-              (setq next-digit (1+ next-digit)))
-            (insert "\nC-g = Quit")
-            (goto-char (point-min))
-            (forward-line))
-          (or some-choice-enabled
-              (error "None of the choices is currently meaningful"))
-          (save-window-excursion
-             ;; Select window to be able to scroll it from minibuffer
-             (with-selected-window
-                 (display-buffer (get-buffer " widget-choose")
-                                 '(display-buffer-in-direction
-                                   (direction . bottom)
-                                   (window-height . fit-window-to-buffer)))
-               (setq value (read-char-choice
-                            (format "%s: " title)
-                            (mapcar #'car alist)))))
-          (cdr (assoc value alist))))))
+  ;; Apply quote substitution to customize choice menu item text,
+  ;; whether it occurs in a widget buffer or in a popup menu.
+  (let ((items (mapc (lambda (x)
+                       (when (consp x)
+                         (dotimes (i (1- (length x)))
+                           (when (char-or-string-p (nth i x))
+                             (setcar (nthcdr i x)
+                                     (substitute-command-keys
+                                      (car (nthcdr i x))))))))
+                    items)))
+    (cond ((and (< (length items) widget-menu-max-size)
+               event (display-popup-menus-p))
+          ;; Mouse click.
+           (if (keymapp items)
+               ;; Modify the keymap prompt, and then restore the old one, if 
any.
+               (let ((prompt (keymap-prompt items)))
+                 (unwind-protect
+                     (progn
+                       (setq items (delete prompt items))
+                       (push title (cdr items))
+                       ;; Return just the first element of the list of events.
+                       (car (x-popup-menu event items)))
+                   (setq items (delete title items))
+                   (when prompt
+                     (push prompt (cdr items)))))
+            (x-popup-menu event (list title (cons "" items)))))
+         ((or widget-menu-minibuffer-flag
+              (> (length items) widget-menu-max-shortcuts))
+           (when (keymapp items)
+             (setq items (widget--simplify-menu items)))
+          ;; Read the choice of name from the minibuffer.
+          (setq items (cl-remove-if 'stringp items))
+          (let ((val (completing-read (concat title ": ") items nil t)))
+            (if (stringp val)
+                (let ((try (try-completion val items)))
+                  (when (stringp try)
+                    (setq val try))
+                  (cdr (assoc val items))))))
+         (t
+           (when (keymapp items)
+             (setq items (widget--simplify-menu items)))
+          ;; Construct a menu of the choices
+          ;; and then use it for prompting for a single character.
+          (let ((next-digit ?0)
+                alist choice some-choice-enabled value)
+            (with-current-buffer (get-buffer-create " widget-choose")
+              (erase-buffer)
+              (insert "Available choices:\n\n")
+              (while items
+                (setq choice (pop items))
+                (when (consp choice)
+                   (insert (format "%c = %s\n" next-digit (car choice)))
+                   (push (cons next-digit (cdr choice)) alist)
+                   (setq some-choice-enabled t))
+                ;; Allocate digits to disabled alternatives
+                ;; so that the digit of a given alternative never varies.
+                (setq next-digit (1+ next-digit)))
+              (insert "\nC-g = Quit")
+              (goto-char (point-min))
+              (forward-line))
+            (or some-choice-enabled
+                (error "None of the choices is currently meaningful"))
+            (save-window-excursion
+               ;; Select window to be able to scroll it from minibuffer
+               (with-selected-window
+                   (display-buffer (get-buffer " widget-choose")
+                                   '(display-buffer-in-direction
+                                     (direction . bottom)
+                                     (window-height . fit-window-to-buffer)))
+                 (setq value (read-char-choice
+                              (format "%s: " title)
+                              (mapcar #'car alist)))))
+            (cdr (assoc value alist)))))))
 
 ;;; Widget text specifications.
 ;;