Subject: bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters

From: Kévin Le Gouguec <[email-masked]>
Date: Mon, 06 May 2019 21:40:01 +0200

martin rudalics <[email-masked]> writes:
>> [1] Compare:
>>
>> (let ((prompt "foobar "))
>>    (add-face-text-property 3 6 'warning nil prompt)
>>    (yes-or-no-p prompt))
>>
>> With:
>>
>> (let ((prompt "foobar "))
>>    (add-face-text-property 3 6 'warning nil prompt)
>>    (y-or-n-p prompt))
>
> 'y-or-n-p' propertizes the prompt rigidly as
>
>                     (read-key (propertize (if (memq answer scroll-actions)
>                                               prompt
>                                             (concat "Please answer y or n.  "
>                                                     prompt))
>                                           'face 'minibuffer-prompt)))))
>
> while 'yes-or-no-p' carefully applies 'minibuffer-prompt-properties'
> to any text properties provided with PROMPT.

Well, that's interesting.

I dug into yes-or-no-p until I came across `read_minibuf()'; is this the
code you are referring to?

    if (PT > BEG)
      {
        Fput_text_property (make_fixnum (BEG), make_fixnum (PT),
                            Qfront_sticky, Qt, Qnil);
        Fput_text_property (make_fixnum (BEG), make_fixnum (PT),
                            Qrear_nonsticky, Qt, Qnil);
        Fput_text_property (make_fixnum (BEG), make_fixnum (PT),
                            Qfield, Qt, Qnil);
        if (CONSP (Vminibuffer_prompt_properties))
          {
            /* We want to apply all properties from
               `minibuffer-prompt-properties' to the region normally,
               but if the `face' property is present, add that
               property to the end of the face properties to avoid
               overwriting faces. */
            Lisp_Object list = Vminibuffer_prompt_properties;
            while (CONSP (list))
              {
                Lisp_Object key = XCAR (list);
                list = XCDR (list);
                if (CONSP (list))
                  {
                    Lisp_Object val = XCAR (list);
                    list = XCDR (list);
                    if (EQ (key, Qface))
                      Fadd_face_text_property (make_fixnum (BEG),
                                               make_fixnum (PT), val, Qt, Qnil);
                    else
                      Fput_text_property (make_fixnum (BEG), make_fixnum (PT),
                                          key, val, Qnil);
                  }
              }
          }
      }

If one were to fix the issue of y-or-n-p hardcoding the face property,
what would be the best way to go?

1. Make a C DEFUN out of this snippet, and have it called by
   `read_minibuf()' and `y-or-n-p'.

2. Re-implement this snippet as an Elisp defun, and have it called by
   `read_minibuf()' and `y-or-n-p'.

3. (Re-implement this snippet within `y-or-n-p'.)

(FWIW, the attached patch seems to work as a workaround, but I assume
solutions 1 or 2 would be better, by virtue of reusing code)

>From 9ea712779d725a23fe8f4acd7b934b0a64a1f1ff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <[email-masked]>
Date: Mon, 6 May 2019 21:26:37 +0200
Subject: [PATCH] Make y-or-no-p keep the supplied prompt's face

* lisp/subr.el (y-or-n-p): append the minibuffer-prompt face instead
of overwriting the prompt's face property.
---
 lisp/subr.el | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index f68f9dd419..8d224ff5bb 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2647,11 +2647,15 @@ y-or-n-p
                   (let ((cursor-in-echo-area t))
                     (when minibuffer-auto-raise
                       (raise-frame (window-frame (minibuffer-window))))
-                    (read-key (propertize (if (memq answer scroll-actions)
-                                              prompt
-                                            (concat "Please answer y or n.  "
-                                                    prompt))
-                                          'face 'minibuffer-prompt)))))
+                    (read-key
+                     (let ((prompt-maybe-please
+                            (if (memq answer scroll-actions)
+                                prompt
+                              (concat "Please answer y or n.  " prompt))))
+                       (add-face-text-property
+                        0 (1- (length prompt-maybe-please))
+                        'minibuffer-prompt t prompt-maybe-please)
+                       prompt-maybe-please)))))
             (setq answer (lookup-key query-replace-map (vector key) t))
             (cond
 	     ((memq answer '(skip act)) nil)
-- 
2.21.0

Thanks for your help!

Kévin