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

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

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

Hello,

I have now added '^' markers below the highlighted command, on condition
that the echo area is wide enough not to wrap lines.

Do we want to add some customizability (highlight face, whether or not
to display '^' markers), or is this good enough for now?


The patch series now includes:

- two patches to make y-or-n-p preserve text properties and implement an
  initial version of highlighting,
- Noam's refactoring patch, plus fixups,
- one patch to add '^' markers,
- one last patch to make tests less tedious to maintain.


[-- 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-diff, Size: 2109 bytes --]

From fbd41865515e13e35874e98a8847e1a67a9b956c 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/6] 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.

(Bug#35564)
---
 lisp/subr.el | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

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
 \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.
@@ -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)
-- 
2.20.1


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

From 802f14e186de7a8cf540b8d8c04155da1d983731 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/6] 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.

(Bug#35564)
---
 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 d83e57d58d..d184598b92 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'.
@@ -761,11 +797,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.20.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch --]
[-- Type: text/x-diff, Size: 11060 bytes --]

From e2d8c836bfa221205d7c72f8fc983258d24d02ce Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 27 Jun 2019 19:15:56 -0400
Subject: [PATCH 3/6] Dedup dired-aux isolated char searching (Bug#35564)

* 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--no-subst-prompt): Operate on a list of positions rather than
searching again for isolated chars.  Shorten prompt, and include the
character being asked about in the question (to make it clearer, and
in case the user can't see the fontification for whatever reason,
e.g., screen reader).
(dired--isolated-char-p): Remove.
(dired--need-confirm-positions): New function.
(dired-do-shell-command): Use it.
* test/lisp/dired-aux-tests.el (dired-test-isolated-char-p): Remove.
(dired-test-highlight-metachar): Adjust to new functions.  Make sure
that `*` isn't considered isolated.
---
 lisp/dired-aux.el            | 113 ++++++++++++++++-------------------
 test/lisp/dired-aux-tests.el |  31 +++++-----
 2 files changed, 67 insertions(+), 77 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index d184598b92..32a4988498 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -60,60 +60,60 @@ 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)))
-
-(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)))
+      (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--no-subst-prompt (char-positions command)
+  (cl-callf substring-no-properties command)
+  (dolist (pos char-positions)
+    (add-face-text-property pos (1+ pos) 'warning nil command))
+  (concat command "\n"
+          (format-message
+           (ngettext "Send %d occurence of `%s' as-is to shell?"
+                     "Send %d occurences 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)
@@ -781,26 +781,19 @@ 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)
          ;; 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 (dired--no-subst-prompt command "*")))
-	           ((need-confirm-p command "?")
-	            (y-or-n-p (dired--no-subst-prompt command "?")))
-	           (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)))
+              ((setq confirmations (dired--need-confirm-positions command "?"))
+               (y-or-n-p (dired--no-subst-prompt confirmations command)))
+              (t))))
     (cond ((not ok) (message "Command canceled"))
           (t
            (if on-each
@@ -811,7 +804,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/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index 80b6393931..3f4bfffaf6 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -114,34 +114,31 @@ 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 "?")))
+         (prompt (dired--no-subst-prompt
+                  command
+                  (dired--need-confirm-positions command "?")))
+         (result (and (string-match (regexp-quote command) prompt)
+                      (match-string 0 prompt))))
     (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 "*")))
+  ;; Note that `?` is considered isolated, but `*` is not.
+  (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'")
+         (prompt (dired--no-subst-prompt
+                  command
+                  (dired--need-confirm-positions command "*")))
+         (result (and (string-match (regexp-quote command) prompt)
+                      (match-string 0 prompt))))
     (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))))
+    (should (equal 'warning (get-text-property 25 'face result)))
+    (should-not (text-property-not-all 26 32 'face nil result))))
 
 (provide 'dired-aux-tests)
 ;; dired-aux-tests.el ends here
-- 
2.20.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-fixup-Dedup-dired-aux-isolated-char-searching-Bug-35.patch --]
[-- Type: text/x-diff, Size: 2459 bytes --]

From 2b93d2984cfa6ad9a33376a198707ebeb9d851b4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Wed, 3 Jul 2019 21:29:38 +0200
Subject: [PATCH 4/6] fixup! Dedup dired-aux isolated char searching
 (Bug#35564)

---
 lisp/dired-aux.el            | 4 ++--
 test/lisp/dired-aux-tests.el | 8 ++++----
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 32a4988498..75c3a8952a 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -108,8 +108,8 @@ dired--no-subst-prompt
     (add-face-text-property pos (1+ pos) 'warning nil command))
   (concat command "\n"
           (format-message
-           (ngettext "Send %d occurence of `%s' as-is to shell?"
-                     "Send %d occurences of `%s' as-is to shell?"
+           (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)))
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index 3f4bfffaf6..ff18edddb6 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -118,8 +118,8 @@ dired-test-highlight-metachar
   "Check that non-isolated meta-characters are highlighted"
   (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`")
          (prompt (dired--no-subst-prompt
-                  command
-                  (dired--need-confirm-positions command "?")))
+                  (dired--need-confirm-positions command "?")
+                  command))
          (result (and (string-match (regexp-quote command) prompt)
                       (match-string 0 prompt))))
     (should-not (text-property-not-all 1 14 'face nil result))
@@ -130,8 +130,8 @@ dired-test-highlight-metachar
   ;; Note that `?` is considered isolated, but `*` is not.
   (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'")
          (prompt (dired--no-subst-prompt
-                  command
-                  (dired--need-confirm-positions command "*")))
+                  (dired--need-confirm-positions command "*")
+                  command))
          (result (and (string-match (regexp-quote command) prompt)
                       (match-string 0 prompt))))
     (should-not (text-property-not-all 1 10 'face nil result))
-- 
2.20.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-Add-markers-below-non-isolated-chars-in-dired-prompt.patch --]
[-- Type: text/x-diff, Size: 7844 bytes --]

From 5f4b3ed76a0b89f7a3dc2120cd2f29a3e64037bb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Wed, 3 Jul 2019 21:17:57 +0200
Subject: [PATCH 5/6] Add '^' markers below non-isolated chars in dired prompt

* lisp/dired-aux.el (dired--mark-positions): New function.
(dired--no-subst-prompt): Use it to show chars without overly
relying on highlighting.
(dired-do-shell-command): When the echo area is wide enough to
display the command without wrapping it, add the markers.

* test/lisp/dired-aux-tests.el (dired-test-highlight-metachar):
Add assertion for '^' marker positions.

(Bug#35564)
---
 lisp/dired-aux.el            | 43 +++++++++++++++++++++--------
 test/lisp/dired-aux-tests.el | 53 ++++++++++++++++++++++++------------
 2 files changed, 68 insertions(+), 28 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 75c3a8952a..262ce64938 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -102,18 +102,35 @@ dired--need-confirm-positions
       (setq start (match-end 0)))
     confirm-positions))
 
-(defun dired--no-subst-prompt (char-positions command)
+(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))
-  (concat command "\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))))
+  ;; `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)
@@ -784,15 +801,19 @@ dired-do-shell-command
   (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"))
               ((setq confirmations (dired--need-confirm-positions command "*"))
-               (y-or-n-p (dired--no-subst-prompt confirmations 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)))
+               (y-or-n-p (dired--no-subst-prompt confirmations command
+                                                 short-enough)))
               (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 ff18edddb6..58b3def2f5 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -115,30 +115,49 @@ dired-test-bug30624
         (kill-buffer buf)))))
 
 (ert-deftest dired-test-highlight-metachar ()
-  "Check that non-isolated meta-characters are highlighted"
+  "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))
-         (result (and (string-match (regexp-quote command) prompt)
-                      (match-string 0 prompt))))
-    (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)))
+                  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)))
+    (should-not (text-property-not-all 1 14 'face nil highlit-command))
+    (should (equal 'warning (get-text-property 15 'face highlit-command)))
+    (should-not (text-property-not-all 16 28 'face nil highlit-command))
+    (should (equal 'warning (get-text-property 29 'face highlit-command)))
+    (should-not (text-property-not-all 30 39 'face nil highlit-command)))
   ;; 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))
-         (result (and (string-match (regexp-quote command) prompt)
-                      (match-string 0 prompt))))
-    (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 25 'face result)))
-    (should-not (text-property-not-all 26 32 'face nil result))))
+                  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)))
+    (should-not (text-property-not-all 1 10 'face nil highlit-command))
+    (should (equal 'warning (get-text-property 11 'face highlit-command)))
+    (should-not (text-property-not-all 12 23 'face nil highlit-command))
+    (should (equal 'warning (get-text-property 25 'face highlit-command)))
+    (should-not (text-property-not-all 26 32 'face nil highlit-command))
+  (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))))
 
 (provide 'dired-aux-tests)
 ;; dired-aux-tests.el ends here
-- 
2.20.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0006-Simplify-highlighting-assertions.patch --]
[-- Type: text/x-diff, Size: 3416 bytes --]

From 086937da30b912e8c0f44e3c7e8e2f5545b4f687 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Fri, 12 Jul 2019 16:10:54 +0200
Subject: [PATCH 6/6] Simplify highlighting assertions

* test/lisp/dired-aux-tests.el (dired-test--check-highlighting):
New function.
(dired-test-highlight-metachar): Use it.

(Bug#35564)
---
 test/lisp/dired-aux-tests.el | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index 58b3def2f5..ba10c54332 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -114,6 +114,15 @@ 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/' ? `?`")
@@ -127,11 +136,7 @@ dired-test-highlight-metachar
     (should (= (length lines) 4))
     (should (string-match (regexp-quote command) highlit-command))
     (should (string-match (regexp-quote markers) (nth 2 lines)))
-    (should-not (text-property-not-all 1 14 'face nil highlit-command))
-    (should (equal 'warning (get-text-property 15 'face highlit-command)))
-    (should-not (text-property-not-all 16 28 'face nil highlit-command))
-    (should (equal 'warning (get-text-property 29 'face highlit-command)))
-    (should-not (text-property-not-all 30 39 'face nil highlit-command)))
+    (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 "           ^             ^")
@@ -144,11 +149,7 @@ dired-test-highlight-metachar
     (should (= (length lines) 4))
     (should (string-match (regexp-quote command) highlit-command))
     (should (string-match (regexp-quote markers) (nth 2 lines)))
-    (should-not (text-property-not-all 1 10 'face nil highlit-command))
-    (should (equal 'warning (get-text-property 11 'face highlit-command)))
-    (should-not (text-property-not-all 12 23 'face nil highlit-command))
-    (should (equal 'warning (get-text-property 25 'face highlit-command)))
-    (should-not (text-property-not-all 26 32 'face nil highlit-command))
+    (dired-test--check-highlighting highlit-command '(11 25)))
   (let* ((command "sed 's/\\?/!/'")
          (prompt (dired--no-subst-prompt
                   (dired--need-confirm-positions command "?")
@@ -157,7 +158,8 @@ dired-test-highlight-metachar
          (lines (split-string prompt "\n"))
          (highlit-command (nth 1 lines)))
     (should (= (length lines) 3))
-    (should (string-match (regexp-quote command) highlit-command))))
+    (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.20.1


[-- Attachment #8: Type: text/plain, Size: 764 bytes --]


Again, thank you for your patience and your reviews.


PS: the prompt now looks like this ('?' characters are highlighted with
the warning face):

With markers:

> Confirm:
> sed 's/\?/!/'
>         ^
> Send 1 occurrence of ‘?’ as-is to shell?

Without markers:

> Confirm:
> sed 's/\?/!/'
> Send 1 occurrence of ‘?’ as-is to shell?

I added the "Confirm:" line because

- y-or-n-p adds "Please answer y or n.  " before the prompt when the
  user fails to answer correctly, so the markers would not line up if
  the command remained on the first line,

- y-or-n-p adds " (y or n)" after the prompt; I find it more legible to
  have the question next to this suffix, so I did not want to move the
  question to the first line.