From: Stephen Berman Date: Sat, 24 Jun 2023 08:45:10 +0000 (+0200) Subject: Apply quote substitution to popup choice menus X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6d55d93379fa531f81327be6e506610474846758;p=emacs.git 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*. --- 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. ;;