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

[-- 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))


  parent reply	other threads:[~2019-06-26  6:16 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   ` Kévin Le Gouguec [this message]
2019-06-26 13:27     ` bug#35564: [PATCH v3] " 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
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=87h88cvpkj.fsf_-_@gmail.com \
    --to=kevin.legouguec@gmail.com \
    --cc=35564@debbugs.gnu.org \
    --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).