Subject: bug#28969: 27.0.50; dired: Confirmation prompt for wildcard not surrounded by whitespace

From: Kévin Le Gouguec <[email-masked]>
Date: Mon, 15 Jul 2019 21:19:05 +0200

Michael Heerdegen <[email-masked]> writes:

> In my example (in my
> initial report), also the shell did not interpret it as wildcard, but I
> had to say "y" to get it executed.  This is very confusing.  It would be
> better to ask "confirm - pass literal `*' to the shell?" or so.

Yup, that's what I set out to do in bug#35564.  Here is the patch
series, condensed into a single patch for convenience.

>From 593096b329a65466c075599697fdaccd64b3ada4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <[email-masked]>
Date: Fri, 7 Jun 2019 17:03:59 +0200
Subject: [PATCH] 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/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/dired-aux.el (dired-isolated-string-re): Use explicitly
numbered groups.
(dired--star-or-qmark-p): Add START parameter.  Make sure to
return the first isolated match.
(dired--need-confirm-positions, dired--mark-positions)
(dired--no-subst-prompt): New functions.
(dired-do-shell-command): Use them to display the command and
highlight the non-isolated chars.  Underline these chars with '^'
markers if the minibuffer window is wide enough to show the
command without line-wrapping it.

* test/lisp/dired-aux-tests.el (dired-test--check-highlighting):
New tests.

Co-authored-by: Noam Postavsky <[email-masked]>

(bug#28969, bug#35564)
---
 lisp/dired-aux.el            | 100 ++++++++++++++++++++++++++---------
 lisp/subr.el                 |  15 +++---
 test/lisp/dired-aux-tests.el |  46 ++++++++++++++++
 3 files changed, 129 insertions(+), 32 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 6a1ebcced9..cc3903ab15 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -60,24 +60,77 @@ dired-isolated-string-re
 of a string followed/prefixed with an space.
 The regexp capture the preceding blank, STRING and the following blank as
 the groups 1, 2 and 3 respectively."
-  (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string))
+  (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string))
 
-(defun dired--star-or-qmark-p (string match &optional keep)
+(defun dired--star-or-qmark-p (string match &optional keep start)
   "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'.
 MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil.  The latter
 means STRING contains either \"?\" or `\\=`?\\=`' or \"*\".
 If optional arg KEEP is non-nil, then preserve the match data.  Otherwise,
 this function changes it and saves MATCH as the second match group.
+START is the position to start matching from.
 
 Isolated means that MATCH is surrounded by spaces or at the beginning/end
 of STRING followed/prefixed with an space.  A match to `\\=`?\\=`',
 isolated or not, is also valid."
-  (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))))
+  (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))
     (when (or (null match) (equal match "?"))
-      (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps)))
-    (cl-some (lambda (x)
-               (funcall (if keep #'string-match-p #'string-match) x string))
-             regexps)))
+      (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)"))
+    (funcall (if keep #'string-match-p #'string-match) regexp string start)))
+
+(defun dired--need-confirm-positions (command string)
+  "Search for non-isolated matches of STRING in COMMAND.
+Return a list of positions that match STRING, but would not be
+considered \"isolated\" by `dired--star-or-qmark-p'."
+  (cl-assert (= (length string) 1))
+  (let ((start 0)
+        (isolated-char-positions nil)
+        (confirm-positions nil)
+        (regexp (regexp-quote string)))
+    ;; Collect all ? and * surrounded by spaces and `?`.
+    (while (dired--star-or-qmark-p command string nil start)
+      (push (cons (match-beginning 2) (match-end 2))
+            isolated-char-positions)
+      (setq start (match-end 2)))
+    ;; Now collect any remaining ? and *.
+    (setq start 0)
+    (while (string-match regexp command start)
+      (unless (cl-member (match-beginning 0) isolated-char-positions
+                         :test (lambda (pos match)
+                                 (<= (car match) pos (cdr match))))
+        (push (match-beginning 0) confirm-positions))
+      (setq start (match-end 0)))
+    confirm-positions))
+
+(defun dired--mark-positions (positions)
+  (let ((markers (make-string
+                  (1+ (apply #'max positions))
+                  ?\s)))
+    (dolist (pos positions)
+      (setf (aref markers pos) ?^))
+    markers))
+
+(defun dired--no-subst-prompt (char-positions command add-markers)
+  (cl-callf substring-no-properties command)
+  (dolist (pos char-positions)
+    (add-face-text-property pos (1+ pos) 'warning nil command))
+  ;; `y-or-n-p' adds some text to the beginning of the prompt when the
+  ;; user fails to answer 'y' or 'n'.  The highlighted command thus
+  ;; cannot be put on the first line of the prompt, since the added
+  ;; text will shove the command to the right, and the '^' markers
+  ;; will become misaligned.
+  (apply #'concat
+         `("Confirm:\n"
+           ,command "\n"
+           ,@(when add-markers
+               (list (dired--mark-positions char-positions) "\n"))
+           ,(format-message
+             (ngettext "Send %d occurrence of `%s' as-is to shell?"
+                       "Send %d occurrences of `%s' as-is to shell?"
+                       (length char-positions))
+             (length char-positions)
+             (propertize (string (aref command (car char-positions)))
+                         'face 'warning)))))
 
 ;;;###autoload
 (defun dired-diff (file &optional switches)
@@ -745,28 +798,23 @@ dired-do-shell-command
       (dired-read-shell-command "! on %s: " current-prefix-arg files)
       current-prefix-arg
       files)))
-  (cl-flet ((need-confirm-p
-             (cmd str)
-             (let ((res cmd)
-                   (regexp (regexp-quote str)))
-               ;; Drop all ? and * surrounded by spaces and `?`.
-               (while (and (string-match regexp res)
-                           (dired--star-or-qmark-p res str))
-                 (setq res (replace-match "" t t res 2)))
-               (string-match regexp res))))
   (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
 	 (no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
+         (confirmations nil)
+         (short-enough (< (length command)
+                          (window-width (minibuffer-window))))
          ;; Get confirmation for wildcards that may have been meant
          ;; to control substitution of a file name or the file name list.
-         (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? ")))
-	           ((need-confirm-p command "?")
-	            (y-or-n-p (format-message
-			       "Confirm--do you mean to use `?' as a wildcard? ")))
-	           (t))))
+         (ok (cond
+              ((not (or on-each no-subst))
+               (error "You can not combine `*' and `?' substitution marks"))
+              ((setq confirmations (dired--need-confirm-positions command "*"))
+               (y-or-n-p (dired--no-subst-prompt confirmations command
+                                                 short-enough)))
+              ((setq confirmations (dired--need-confirm-positions command "?"))
+               (y-or-n-p (dired--no-subst-prompt confirmations command
+                                                 short-enough)))
+              (t))))
     (cond ((not ok) (message "Command canceled"))
           (t
            (if on-each
@@ -777,7 +825,7 @@ dired-do-shell-command
 	                          nil file-list)
 	     ;; execute the shell command
 	     (dired-run-shell-command
-	      (dired-shell-stuff-it command file-list nil arg))))))))
+              (dired-shell-stuff-it command file-list nil arg)))))))
 
 ;; Might use {,} for bash or csh:
 (defvar dired-mark-prefix ""
diff --git a/lisp/subr.el b/lisp/subr.el
index 4a1649f601..c59f13b24c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2338,6 +2338,9 @@ memory-limit
 
 ;;;; 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.
@@ -2675,14 +2678,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)
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index ccd3192792..ba10c54332 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -114,6 +114,52 @@ dired-test-bug30624
         (mapc #'delete-file `(,file1 ,file2))
         (kill-buffer buf)))))
 
+(defun dired-test--check-highlighting (command positions)
+  (let ((start 1))
+    (dolist (pos positions)
+      (should-not (text-property-not-all start (1- pos) 'face nil command))
+      (should (equal 'warning (get-text-property pos 'face command)))
+      (setq start (1+ pos)))
+    (should-not (text-property-not-all
+                 start (length command) 'face nil command))))
+
+(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/' ? `?`")
+         (markers "               ^             ^")
+         (prompt (dired--no-subst-prompt
+                  (dired--need-confirm-positions command "?")
+                  command
+                  t))
+         (lines (split-string prompt "\n"))
+         (highlit-command (nth 1 lines)))
+    (should (= (length lines) 4))
+    (should (string-match (regexp-quote command) highlit-command))
+    (should (string-match (regexp-quote markers) (nth 2 lines)))
+    (dired-test--check-highlighting highlit-command '(15 29)))
+  ;; Note that `?` is considered isolated, but `*` is not.
+  (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'")
+         (markers "           ^             ^")
+         (prompt (dired--no-subst-prompt
+                  (dired--need-confirm-positions command "*")
+                  command
+                  t))
+         (lines (split-string prompt "\n"))
+         (highlit-command (nth 1 lines)))
+    (should (= (length lines) 4))
+    (should (string-match (regexp-quote command) highlit-command))
+    (should (string-match (regexp-quote markers) (nth 2 lines)))
+    (dired-test--check-highlighting highlit-command '(11 25)))
+  (let* ((command "sed 's/\\?/!/'")
+         (prompt (dired--no-subst-prompt
+                  (dired--need-confirm-positions command "?")
+                  command
+                  nil))
+         (lines (split-string prompt "\n"))
+         (highlit-command (nth 1 lines)))
+    (should (= (length lines) 3))
+    (should (string-match (regexp-quote command) highlit-command))
+    (dired-test--check-highlighting highlit-command '(8))))
 
 (provide 'dired-aux-tests)
 ;; dired-aux-tests.el ends here
-- 
2.22.0

It is a bit more involved than a simple rewording, mainly because I
could not find a concise sentence that sounded 100%-unambiguous
(e.g. "literal" might be taken to mean "suitably backslash-escaped or
quoted").

> BTW, I had several use cases where * or ?, don't remember, was not
> isolated, and I wanted to answer "n" to still get the substitution by
> the command and was disappointed that Emacs just canceled.  Maybe one of
> the suggested patches also improves that, I haven't checked yet.

Allowing the user to substitute non-isolated characters is something
Drew also suggested in bug#35564.

I haven't tackled that yet (haven't met the use-case).  What would a
good UI look like?  Successive prompting for each non-isolated
character?  Something like:

> Substitute highlighted occurrence of `?'? ([y]es, [n]o, [a]bort)

Although note that you can already tell Dired that your '?' is meant to
be substituted, by surrounding it with backquotes.  E.g. try to mark
some files, then

    ! echo 'foo`?`bar'

It's not implemented for '*' though.