From: "Kévin Le Gouguec" <kevin.legouguec@gmail.com>
To: Lars Ingebrigtsen <larsi@gnus.org>
Cc: michael_heerdegen@web.de, 35564@debbugs.gnu.org,
npostavs@gmail.com, juri@linkov.net, monnier@iro.umontreal.ca
Subject: bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters
Date: Sun, 20 Sep 2020 14:04:44 +0200 [thread overview]
Message-ID: <87o8m04psz.fsf@gmail.com> (raw)
In-Reply-To: <87ft7coeru.fsf@gnus.org> (Lars Ingebrigtsen's message of "Sun, 20 Sep 2020 13:42:45 +0200")
[-- Attachment #1: Type: text/plain, Size: 604 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Kévin, skimming this thread, there seemed to be a general consensus that
> your patch series should be applied. Could you work up a single
> squashed patch to apply? There's so many patches with different
> variations that it's difficult to tell which ones should be applied.
Thanks for following up on this! I was planning to do so after the
release of 27.1, but somehow never found the time.
Here is the squashed patch using read-char-from-minibuffer (which unless
I messed something up should be the same as the one from December[1]).
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Tweak-dired-warning-about-wildcard-characters.patch --]
[-- Type: text/x-diff, Size: 12298 bytes --]
From 135465cb28a8cfc2059754b7ab2c188864eb891d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Wed, 18 Dec 2019 07:54:01 +0100
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 offer to highlight the characters so
that the user sees exactly what we are talking about.
* 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--highlight-no-subst-chars, dired--no-subst-explain)
(dired--no-subst-ask, dired--no-subst-confirm): New functions.
(dired-do-shell-command): Use them.
* test/lisp/dired-aux-tests.el (dired-test-bug27496): Adapt to
new prompt.
(dired-test--check-highlighting): New test helper.
(dired-test-highlight-metachar): New tests.
Co-authored-by: Noam Postavsky <npostavs@gmail.com>
(bug#28969, bug#35564)
---
lisp/dired-aux.el | 151 +++++++++++++++++++++++++++++------
test/lisp/dired-aux-tests.el | 45 ++++++++++-
2 files changed, 169 insertions(+), 27 deletions(-)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index cf2926ad37..df25a6418f 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -60,24 +60,132 @@ 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--highlight-no-subst-chars (positions command mark)
+ (cl-callf substring-no-properties command)
+ (dolist (pos positions)
+ (add-face-text-property pos (1+ pos) 'warning nil command))
+ (if mark
+ (concat command "\n" (dired--mark-positions positions))
+ command))
+
+(defun dired--no-subst-explain (buf char-positions command mark-positions)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert
+ (format-message "\
+If your command contains occurrences of `*' surrounded by
+whitespace, `dired-do-shell-command' substitutes them for the
+entire file list to process. Otherwise, if your command contains
+occurrences of `?' surrounded by whitespace or `%s', Dired will
+run the command once for each file, substituting `?' for each
+file name.
+
+Your command contains occurrences of `%s' that will not be
+substituted, and will be passed through normally to the shell.
+
+%s
+
+(Press ^ to %s markers below these occurrences.)
+"
+ "`"
+ (string (aref command (car char-positions)))
+ (dired--highlight-no-subst-chars char-positions command mark-positions)
+ (if mark-positions "remove" "add")))))
+
+(defun dired--no-subst-ask (char nb-occur details)
+ (let ((hilit-char (propertize (string char) 'face 'warning))
+ (choices `(?y ?n ?? ,@(when details '(?^)))))
+ (read-char-from-minibuffer
+ (format-message
+ (ngettext
+ "%d occurrence of `%s' will not be substituted. Proceed? (%s) "
+ "%d occurrences of `%s' will not be substituted. Proceed? (%s) "
+ nb-occur)
+ nb-occur hilit-char (mapconcat #'string choices ", "))
+ choices)))
+
+(defun dired--no-subst-confirm (char-positions command)
+ (let ((help-buf (get-buffer-create "*Dired help*"))
+ (char (aref command (car char-positions)))
+ (nb-occur (length char-positions))
+ (done nil)
+ (details nil)
+ (markers nil)
+ proceed)
+ (unwind-protect
+ (save-window-excursion
+ (while (not done)
+ (cl-case (dired--no-subst-ask char nb-occur details)
+ (?y
+ (setq done t
+ proceed t))
+ (?n
+ (setq done t
+ proceed nil))
+ (??
+ (if details
+ (progn
+ (quit-window nil details)
+ (setq details nil))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)
+ (setq details (display-buffer help-buf))))
+ (?^
+ (setq markers (not markers))
+ (dired--no-subst-explain
+ help-buf char-positions command markers)))))
+ (kill-buffer help-buf))
+ proceed))
;;;###autoload
(defun dired-diff (file &optional switches)
@@ -772,28 +880,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 (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 "*"))
+ (dired--no-subst-confirm confirmations command))
+ ((setq confirmations (dired--need-confirm-positions command "?"))
+ (dired--no-subst-confirm confirmations command))
+ (t))))
(cond ((not ok) (message "Command canceled"))
(t
(if on-each
@@ -804,7 +903,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 1fe155718d..54ec5d673c 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -28,7 +28,7 @@ dired-test-bug27496
(let* ((foo (make-temp-file "foo"))
(files (list foo)))
(unwind-protect
- (cl-letf (((symbol-function 'y-or-n-p) 'error))
+ (cl-letf (((symbol-function 'read-char-from-minibuffer) 'error))
(dired temporary-file-directory)
(dired-goto-file foo)
;; `dired-do-shell-command' returns nil on success.
@@ -114,6 +114,49 @@ 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 " ^ ^")
+ (result (dired--highlight-no-subst-chars
+ (dired--need-confirm-positions command "?")
+ command
+ t))
+ (lines (split-string result "\n")))
+ (should (= (length lines) 2))
+ (should (string-match (regexp-quote command) (nth 0 lines)))
+ (should (string-match (regexp-quote markers) (nth 1 lines)))
+ (dired-test--check-highlighting (nth 0 lines) '(15 29)))
+ ;; Note that `?` is considered isolated, but `*` is not.
+ (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'")
+ (markers " ^ ^")
+ (result (dired--highlight-no-subst-chars
+ (dired--need-confirm-positions command "*")
+ command
+ t))
+ (lines (split-string result "\n")))
+ (should (= (length lines) 2))
+ (should (string-match (regexp-quote command) (nth 0 lines)))
+ (should (string-match (regexp-quote markers) (nth 1 lines)))
+ (dired-test--check-highlighting (nth 0 lines) '(11 25)))
+ (let* ((command "sed 's/\\?/!/'")
+ (result (dired--highlight-no-subst-chars
+ (dired--need-confirm-positions command "?")
+ command
+ nil))
+ (lines (split-string result "\n")))
+ (should (= (length lines) 1))
+ (should (string-match (regexp-quote command) (nth 0 lines)))
+ (dired-test--check-highlighting (nth 0 lines) '(8))))
(provide 'dired-aux-tests)
;; dired-aux-tests.el ends here
--
2.20.1
[-- Attachment #3: Type: text/plain, Size: 155 bytes --]
[1] <https://debbugs.gnu.org/cgi/bugreport.cgi?filename=0001-Tweak-dired-warning-about-wildcard-characters-rcfm-squashed.patch;att=11;msg=202;bug=35564>
next prev parent reply other threads:[~2020-09-20 12:04 UTC|newest]
Thread overview: 76+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-05-04 18:01 bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters Kévin Le Gouguec
2019-05-05 8:44 ` martin rudalics
2019-05-06 19:40 ` Kévin Le Gouguec
2019-05-07 8:15 ` martin rudalics
2019-05-07 13:19 ` Drew Adams
2019-05-08 20:42 ` Kévin Le Gouguec
2019-05-08 22:39 ` Drew Adams
2019-05-09 8:13 ` martin rudalics
2019-05-09 14:17 ` Drew Adams
2019-05-09 17:51 ` martin rudalics
2019-05-09 20:04 ` Drew Adams
2019-06-09 11:08 ` bug#35564: [PATCH v2] Tweak dired " Kévin Le Gouguec
2019-06-12 12:23 ` Noam Postavsky
2019-06-12 14:29 ` Stefan Monnier
2019-06-13 6:19 ` Kévin Le Gouguec
2019-06-13 7:58 ` Stefan Monnier
2019-06-13 16:53 ` npostavs
2019-06-18 8:52 ` Kévin Le Gouguec
2019-06-19 0:12 ` Noam Postavsky
2019-06-26 6:16 ` bug#35564: [PATCH v3] " Kévin Le Gouguec
2019-06-26 13:27 ` Drew Adams
2019-06-27 5:58 ` Kévin Le Gouguec
2019-06-26 14:33 ` Stefan Monnier
2019-06-27 6:15 ` Kévin Le Gouguec
2019-06-27 23:31 ` Noam Postavsky
2019-06-28 6:15 ` Kévin Le Gouguec
2019-06-28 15:35 ` Drew Adams
2019-06-28 17:58 ` Kévin Le Gouguec
2019-06-28 18:43 ` Drew Adams
2019-06-29 13:48 ` Noam Postavsky
2019-06-29 14:30 ` Drew Adams
2019-06-29 14:13 ` Eli Zaretskii
2019-07-03 19:47 ` bug#35564: [PATCH v4] " Kévin Le Gouguec
2019-07-12 15:10 ` Kévin Le Gouguec
2019-07-27 11:20 ` Eli Zaretskii
2019-07-27 17:26 ` Kévin Le Gouguec
2019-07-27 22:22 ` Michael Heerdegen
2019-07-29 3:29 ` Michael Heerdegen
2019-07-29 18:11 ` Juri Linkov
2019-07-29 19:01 ` Kévin Le Gouguec
2019-08-02 5:26 ` Michael Heerdegen
2019-08-08 10:40 ` Kévin Le Gouguec
2019-08-08 21:06 ` Juri Linkov
2019-08-09 12:43 ` Kévin Le Gouguec
2019-08-09 18:03 ` Juri Linkov
2019-08-15 20:56 ` Juri Linkov
2019-08-19 4:55 ` Kévin Le Gouguec
2019-07-27 22:03 ` Basil L. Contovounesios
2019-07-27 23:32 ` Kévin Le Gouguec
2019-07-27 23:41 ` Basil L. Contovounesios
2019-10-10 18:45 ` bug#35564: [PATCH v5] " Kévin Le Gouguec
2019-10-22 15:10 ` Kévin Le Gouguec
2019-10-22 16:58 ` Michael Heerdegen
2019-10-22 21:32 ` Kévin Le Gouguec
2019-11-10 20:29 ` Juri Linkov
2019-11-14 7:02 ` Kévin Le Gouguec
2019-11-16 20:23 ` Juri Linkov
2019-10-22 20:43 ` Juri Linkov
2019-10-22 21:11 ` Kévin Le Gouguec
2019-10-27 21:40 ` Juri Linkov
2019-10-30 21:59 ` Juri Linkov
2019-11-04 6:36 ` Kévin Le Gouguec
2019-11-05 22:22 ` Juri Linkov
2019-11-07 22:17 ` Juri Linkov
2019-11-10 20:18 ` Juri Linkov
2019-12-18 7:11 ` Kévin Le Gouguec
2019-12-19 22:01 ` Juri Linkov
2019-12-20 8:53 ` Eli Zaretskii
2019-12-20 20:34 ` Kévin Le Gouguec
2019-12-21 7:08 ` Eli Zaretskii
2019-12-22 16:02 ` Kévin Le Gouguec
2019-12-20 20:43 ` Kévin Le Gouguec
2019-12-21 7:08 ` Eli Zaretskii
2020-09-20 11:42 ` Lars Ingebrigtsen
2020-09-20 12:04 ` Kévin Le Gouguec [this message]
2020-09-20 12:18 ` Lars Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87o8m04psz.fsf@gmail.com \
--to=kevin.legouguec@gmail.com \
--cc=35564@debbugs.gnu.org \
--cc=juri@linkov.net \
--cc=larsi@gnus.org \
--cc=michael_heerdegen@web.de \
--cc=monnier@iro.umontreal.ca \
--cc=npostavs@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).