unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#64046: 30.0.50; Quoting in customize choice tags
@ 2023-06-13 14:02 Stephen Berman
  2023-06-13 15:56 ` Eli Zaretskii
  2023-07-15 13:20 ` Mauro Aranda
  0 siblings, 2 replies; 51+ messages in thread
From: Stephen Berman @ 2023-06-13 14:02 UTC (permalink / raw)
  To: 64046

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

0. emacs -Q
1. Evaluate the following defcustom:
   (defcustom my-test "a"
     "Test."
     :type '(choice (string :tag "Use `a'" "a")
   		    (string :tag "Use `b'" "b")))
2. M-x customize-option RET my-test RET
3. In the buffer *Customize Option: My Test* note that in the string
   "Use ‘a’" following the "Value Menu" button the quote marks are in
   the "curve" style (‘’).
4. Put point on the "Value Menu" button and type RET.
5. The buffer " widget-choose" contains these lines:
   0 = Use ‘a’
   1 = Use ‘b’
   Note that the quote marks in this buffer are also in the "curve"
   style.
6. With the mouse pointer over the "Value Menu" button press mouse-1,
   popping up a menu titled "Choice" containing these items:
   Use `a'
   Use `b'
   Note that the quote marks in this menu are in the "grave" style (`')
   instead of the "curve" style.

The use of the "curve" style in the " widget-choose" buffer is due to
commit bd3b426ebb7a60045839e97c9da9bfd249fab1f1, but that commit did not
take popup menus into account.  The attached patch does so.  Since the
status quo ante long predates emacs-29 and this is just a stylistic bug,
I made the patch against master.

In this patch I chose to apply substitute-command-keys just once at the
beginning of the function `widget-choose', rather than several times
within the function, but I restricted its application to item tags, so
other uses of the ITEMS argument should not be affected (and my brief
testing hasn't found any problem with the patch).

The patch also takes the opportunity to replace two unnecessary uses of
`let*' in `widget-choose', in one case by `let' and in the other by
foregoing let-bound variables altogether and just using the values in
place, since they occur only once each in the lines immediately
following the eliminated `let*'.


In GNU Emacs 30.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version
 3.24.38, cairo version 1.17.6) of 2023-06-13 built on strobelfssd
Repository revision: ba349aa32e98a53146794197c316f4765598ddbd
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12101008
System Description: Linux From Scratch r11.3-100-systemd

Configured using:
 'configure -C --with-xwidgets 'CFLAGS=-Og -g3'
 PKG_CONFIG_PATH=/opt/qt5/lib/pkgconfig'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBSYSTEMD LIBXML2 MODULES NOTIFY INOTIFY PDUMPER PNG RSVG
SECCOMP SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM
XINPUT2 XPM XWIDGETS GTK3 ZLIB


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: widget-choose patch --]
[-- Type: text/x-patch, Size: 6789 bytes --]

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index cafd0ad0a4d..bc070c9933f 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -281,71 +281,75 @@ widget-choose
 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 all customize choice tags, whether
+  ;; they occur in a widget buffer or in a popup menu.
+  (let ((items (mapc (lambda (x)
+                       (when (and (consp x) (char-or-string-p (car x)))
+                         (setcar x (substitute-command-keys (car 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.
 ;;

^ permalink raw reply related	[flat|nested] 51+ messages in thread

end of thread, other threads:[~2023-09-02 21:25 UTC | newest]

Thread overview: 51+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-06-13 14:02 bug#64046: 30.0.50; Quoting in customize choice tags Stephen Berman
2023-06-13 15:56 ` Eli Zaretskii
2023-06-14 19:51   ` Mauro Aranda
2023-06-14 20:05   ` Mauro Aranda
2023-06-15 11:39     ` Stephen Berman
2023-06-22 20:07       ` Stephen Berman
2023-06-22 22:59         ` Mauro Aranda
2023-06-23 22:18           ` Stephen Berman
2023-06-24  6:37             ` Eli Zaretskii
2023-06-24  8:50               ` Stephen Berman
2023-07-15 13:20 ` Mauro Aranda
2023-07-20 15:48   ` Stephen Berman
2023-07-20 19:11     ` Mauro Aranda
2023-07-20 19:53       ` Stephen Berman
2023-08-21 12:04         ` Ola x Nilsson
2023-08-21 14:51           ` Mauro Aranda
2023-08-24 12:51             ` Stephen Berman
2023-08-24 13:19               ` Stephen Berman
2023-08-24 20:14                 ` Mauro Aranda
2023-08-24 20:54                   ` Stephen Berman
2023-08-24 21:58                     ` Mauro Aranda
2023-08-25  8:02                       ` Ola x Nilsson
2023-08-25 21:50                         ` Stephen Berman
2023-08-28  9:33                           ` Ola x Nilsson
2023-08-28 13:50                             ` Stephen Berman
2023-08-30 15:29                               ` Mauro Aranda
2023-08-30 16:29                                 ` Stephen Berman
2023-08-30 22:33                                   ` Mauro Aranda
2023-08-30 22:51                                     ` Stephen Berman
2023-08-30 22:58                                       ` Mauro Aranda
2023-08-31  5:41                                         ` Eli Zaretskii
2023-08-31  6:43                                           ` Stefan Kangas
2023-08-31 15:43                                             ` Drew Adams
2023-08-31 20:52                                               ` Stefan Kangas
2023-08-31 22:10                                                 ` Drew Adams
2023-08-31 22:59                                                   ` Stefan Kangas
2023-09-01  1:08                                                     ` Drew Adams
2023-09-01  6:34                                                       ` Eli Zaretskii
2023-09-01 16:17                                                         ` Drew Adams
2023-09-01 23:29                                                           ` Stephen Berman
2023-09-01 23:38                                                             ` Stefan Kangas
2023-09-02  9:49                                                               ` Stephen Berman
2023-09-02 18:59                                                                 ` Stefan Kangas
2023-09-02 21:25                                                                   ` Stephen Berman
2023-09-02  2:12                                                             ` Drew Adams
2023-09-01  6:16                                                     ` Eli Zaretskii
2023-09-01 16:32                                                       ` Drew Adams
2023-08-24 20:53                 ` Stefan Kangas
2023-08-24 21:10                   ` Stephen Berman
2023-08-24 21:14                     ` Stefan Kangas
2023-08-24 21:41                       ` Stephen Berman

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).