unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Noam Postavsky <npostavs@gmail.com>
To: "Kévin Le Gouguec" <kevin.legouguec@gmail.com>
Cc: 35564@debbugs.gnu.org, Stefan Monnier <monnier@iro.umontreal.ca>
Subject: bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters
Date: Thu, 27 Jun 2019 19:31:34 -0400	[thread overview]
Message-ID: <87a7e27gh5.fsf@gmail.com> (raw)
In-Reply-To: <87h88cvpkj.fsf_-_@gmail.com> ("Kévin Le Gouguec"'s message of "Wed, 26 Jun 2019 08:16:44 +0200")

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

Kévin Le Gouguec <kevin.legouguec@gmail.com> writes:

>> 2. dired-aux.el already contains some logic to detect isolated
>>    characters

Yes, this was kind of bugging me, so here's a patch to reuse that logic
(it applies on top of yours).  While doing this I noticed that we
earlier missed that `*` is not considered isolated, unlike `?`.

Assuming no problems, I'll just push your two patches followed by mine
(I considered squashing, but probably that makes things harder to
follow in this case).


[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 10740 bytes --]

From 52af7efc5e0c673b24e09991db275112212f3fbf 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/3] Dedup dired-aux isolated char searching

* 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.
(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            | 108 +++++++++++++++++++------------------------
 test/lisp/dired-aux-tests.el |  31 ++++++-------
 2 files changed, 62 insertions(+), 77 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 079e4f102f..e716b2b42c 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -60,60 +60,55 @@ (defun dired-isolated-string-re (string)
 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 (command char-positions)
+  (let ((highlighted (substring-no-properties command)))
+    (dolist (pos char-positions)
+      (add-face-text-property pos (1+ pos) 'warning nil highlighted))
+    (format-message "\
+Confirm--the highlighted characters will not be substituted:\n%s
+Proceed?" highlighted)))
 
 ;;;###autoload
 (defun dired-diff (file &optional switches)
@@ -779,26 +774,19 @@ (defun dired-do-shell-command (command &optional arg file-list)
       (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 command confirmations)))
+              (t))))
     (cond ((not ok) (message "Command canceled"))
           (t
            (if on-each
@@ -809,7 +797,7 @@ (defun dired-do-shell-command (command &optional arg file-list)
 	                          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 @@ (ert-deftest 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.11.0


  parent reply	other threads:[~2019-06-27 23:31 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 [this message]
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
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=87a7e27gh5.fsf@gmail.com \
    --to=npostavs@gmail.com \
    --cc=35564@debbugs.gnu.org \
    --cc=kevin.legouguec@gmail.com \
    --cc=monnier@iro.umontreal.ca \
    /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).