bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters

["Kévin Le Gouguec" <kevin.legouguec@gmail.com>]

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

And here is the third set of patches.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Preserve-text-properties-in-y-or-n-p-prompts.patch --]
[-- Type: text/x-patch, Size: 2096 bytes --]

From d2892b05f08348bbc3eea770a92f7cf735a88cb3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Fri, 7 Jun 2019 17:03:59 +0200
Subject: [PATCH 1/2] Preserve text properties in y-or-n-p prompts

* lisp/subr.el (read--propertize-prompt): New function to append
the prompt face to a string.
(y-or-n-p): Use it instead of discarding potential text
properties.
---
 lisp/subr.el | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index baff1e909a..67c4f1da3a 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2334,6 +2334,9 @@ memory-limit
 \f
 ;;;; Input and display facilities.
 
+(defun read--propertize-prompt (prompt)
+  (add-face-text-property 0 (length prompt) 'minibuffer-prompt t prompt))
+
 (defconst read-key-empty-map (make-sparse-keymap))
 
 (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
@@ -2671,14 +2674,14 @@ y-or-n-p
           (let* ((scroll-actions '(recenter scroll-up scroll-down
 				   scroll-other-window scroll-other-window-down))
 		 (key
-                  (let ((cursor-in-echo-area t))
+                  (let ((cursor-in-echo-area t)
+                        (prompt (if (memq answer scroll-actions)
+                                    prompt
+                                  (concat "Please answer y or n.  " prompt))))
                     (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--propertize-prompt prompt)
+                    (read-key prompt))))
             (setq answer (lookup-key query-replace-map (vector key) t))
             (cond
 	     ((memq answer '(skip act)) nil)
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Tweak-dired-warning-about-wildcard-characters.patch --]
[-- Type: text/x-patch, Size: 5548 bytes --]

From bf49a90f9bf5c03e159dd2377da079e195258ea0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Fri, 7 Jun 2019 17:19:44 +0200
Subject: [PATCH 2/2] Tweak dired warning about "wildcard" characters

Non-isolated '?' and '*' characters may be quoted, or
backslash-escaped; we do not know for a fact that the shell will
interpret them as wildcards.

Rephrase the prompt and highlight the characters so that the user sees
exactly what we are talking about.

* lisp/dired-aux.el (dired--isolated-char-p)
(dired--highlight-nosubst-char, dired--no-subst-prompt): New
functions.
(dired-do-shell-command): Use them.

* test/lisp/dired-aux-tests.el (dired-test-isolated-char-p)
(dired-test-highlight-metachar): Test the new functions.
---
 lisp/dired-aux.el            | 42 ++++++++++++++++++++++++++++++++----
 test/lisp/dired-aux-tests.el | 28 ++++++++++++++++++++++++
 2 files changed, 66 insertions(+), 4 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 5e4ec4d1ec..079e4f102f 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -79,6 +79,42 @@ dired--star-or-qmark-p
                (funcall (if keep #'string-match-p #'string-match) x string))
              regexps)))
 
+(defun dired--isolated-char-p (command pos)
+  "Assert whether the character at POS is isolated within COMMAND.
+A character is isolated if:
+- it is surrounded by whitespace, the start of the command, or
+  the end of the command,
+- it is surrounded by `\\=`' characters."
+  (let ((start (max 0 (1- pos)))
+        (char (string (aref command pos))))
+    (and (string-match
+          (rx (or (seq (or bos blank)
+                       (group-n 1 (literal char))
+                       (or eos blank))
+                  (seq ?` (group-n 1 (literal char)) ?`)))
+          command start)
+         (= pos (match-beginning 1)))))
+
+(defun dired--highlight-nosubst-char (command char)
+  "Highlight occurences of CHAR that are not isolated in COMMAND.
+These occurences will not be substituted; they will be sent as-is
+to the shell, which may interpret them as wildcards."
+  (save-match-data
+    (let ((highlighted (substring-no-properties command))
+          (pos 0))
+      (while (string-match (regexp-quote char) command pos)
+        (let ((start (match-beginning 0))
+              (end (match-end 0)))
+          (unless (dired--isolated-char-p command start)
+            (add-face-text-property start end 'warning nil highlighted))
+          (setq pos end)))
+      highlighted)))
+
+(defun dired--no-subst-prompt (command char)
+  (let ((highlighted-command (dired--highlight-nosubst-char command char))
+        (prompt "Confirm--the highlighted characters will not be substituted:"))
+    (format-message "%s\n%s\nProceed?" prompt highlighted-command)))
+
 ;;;###autoload
 (defun dired-diff (file &optional switches)
   "Compare file at point with FILE using `diff'.
@@ -759,11 +795,9 @@ dired-do-shell-command
          (ok (cond ((not (or on-each no-subst))
 	            (error "You can not combine `*' and `?' substitution marks"))
 	           ((need-confirm-p command "*")
-	            (y-or-n-p (format-message
-			       "Confirm--do you mean to use `*' as a wildcard? ")))
+	            (y-or-n-p (dired--no-subst-prompt command "*")))
 	           ((need-confirm-p command "?")
-	            (y-or-n-p (format-message
-			       "Confirm--do you mean to use `?' as a wildcard? ")))
+	            (y-or-n-p (dired--no-subst-prompt command "?")))
 	           (t))))
     (cond ((not ok) (message "Command canceled"))
           (t
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index ccd3192792..80b6393931 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -114,6 +114,34 @@ dired-test-bug30624
         (mapc #'delete-file `(,file1 ,file2))
         (kill-buffer buf)))))
 
+(ert-deftest dired-test-isolated-char-p ()
+  (should (dired--isolated-char-p "?" 0))
+  (should (dired--isolated-char-p "? " 0))
+  (should (dired--isolated-char-p " ?" 1))
+  (should (dired--isolated-char-p " ? " 1))
+  (should (dired--isolated-char-p "foo bar ? baz" 8))
+  (should (dired--isolated-char-p "foo -i`?`" 7))
+  (should-not (dired--isolated-char-p "foo `bar`?" 9))
+  (should-not (dired--isolated-char-p "foo 'bar?'" 8))
+  (should-not (dired--isolated-char-p "foo bar?baz" 7))
+  (should-not (dired--isolated-char-p "foo bar?" 7)))
+
+(ert-deftest dired-test-highlight-metachar ()
+  "Check that non-isolated meta-characters are highlighted"
+  (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`")
+         (result (dired--highlight-nosubst-char command "?")))
+    (should-not (text-property-not-all 1 14 'face nil result))
+    (should (equal 'warning (get-text-property 15 'face result)))
+    (should-not (text-property-not-all 16 28 'face nil result))
+    (should (equal 'warning (get-text-property 29 'face result)))
+    (should-not (text-property-not-all 30 39 'face nil result)))
+  (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'")
+         (result (dired--highlight-nosubst-char command "*")))
+    (should-not (text-property-not-all 1 10 'face nil result))
+    (should (equal 'warning (get-text-property 11 'face result)))
+    (should-not (text-property-not-all 12 23 'face nil result))
+    (should (equal 'warning (get-text-property 24 'face result)))
+    (should-not (text-property-not-all 25 29 'face nil result))))
 
 (provide 'dired-aux-tests)
 ;; dired-aux-tests.el ends here
-- 
2.21.0


[-- Attachment #4: Type: text/plain, Size: 1014 bytes --]


The first patch is unchanged (it adjusts y-or-n-p so that the prompt's
text properties are preserved), the second patch uses the new
(literal …) feature from rx and adds a test case for
dired--isolated-char-p[1].

Quoting my previous email:

> Some things I wonder about:
> 
> 1. About read--propertize-prompt…
> 
>     1. Should the function return a copy of its argument instead of
>        propertizing it directly?
> 
>     2. Is it properly named?  Does it fit in subr.el?  I placed it there
>        because I figured other users of read-char in subr.el could use
>        it, e.g. read-char-choice.
> 
> 2. dired-aux.el already contains some logic to detect isolated
>    characters; I could not think of a way to re-use it, so I added my
>    own functions to find *non*-isolated characters.  I added unit tests
>    for these new functions; still, there may be some redundancy there.

Thank you for your time.


[1] (should-not (dired--isolated-char-p "foo `bar`?" 9))