From: "Kévin Le Gouguec" <kevin.legouguec@gmail.com>
To: 35564@debbugs.gnu.org
Cc: Michael Heerdegen <michael_heerdegen@web.de>,
Noam Postavsky <npostavs@gmail.com>,
Juri Linkov <juri@linkov.net>,
Stefan Monnier <monnier@iro.umontreal.ca>
Subject: bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters
Date: Wed, 18 Dec 2019 08:11:25 +0100 [thread overview]
Message-ID: <87a77qhzvm.fsf@gmail.com> (raw)
In-Reply-To: <87o8yoign9.fsf_-_@gmail.com> ("Kévin Le Gouguec"'s message of "Thu, 10 Oct 2019 20:45:14 +0200")
[-- Attachment #1: Type: text/plain, Size: 966 bytes --]
Hello,
Here is a new revision of this patch series, which aims to rephrase
dired-do-shell-command's warning about occurrences of '?' and '*' that
will not be substituted for filenames, with the following goals in mind:
1. cease to call these characters "wildcards" since they may be quoted
or escaped,
2. cater to users who do not know about the substitution feature,
3. keep the default prompt as concise as the current one.
The first revisions[1][2][3][4] focused on goals 1 and 2, to the
detriment of 3. The last revision[5] hid the verbosity behind an
optional explanatory buffer, using read-multiple-choice. Since this
function already generates a help buffer bound to '?', I bound the
explanatory buffer to 'd' for "details", a la nsm-query-user.
Juri suggested[6] that read-char-from-minibuffer might fit the bill
better. Since I feel kind of torn between these options, I'm putting
them both forward.
First, the scaffolding patches (same as v5):
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Tweak-dired-warning-about-wildcard-characters.patch --]
[-- Type: text/x-patch, Size: 5561 bytes --]
From 179fd2765e53c838d89a80ff3f680dccd4414293 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 1/5] 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 fb1ad6266d..1c2a9d1555 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'.
@@ -773,11 +809,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.24.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch --]
[-- Type: text/x-patch, Size: 11062 bytes --]
From 064ec112fae60b9914b635965c5ab54b151da3b8 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 27 Jun 2019 19:15:56 -0400
Subject: [PATCH 2/5] 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 1c2a9d1555..6766c620f6 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 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)
@@ -793,26 +793,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
@@ -823,7 +816,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..ff18edddb6 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
+ (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)))
- (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
+ (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 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.24.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Add-markers-below-non-isolated-chars-in-dired-prompt.patch --]
[-- Type: text/x-patch, Size: 7845 bytes --]
From 2475254565c798725d724ee89e5d699342b6c818 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 3/5] 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 6766c620f6..038e1dbbed 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)
@@ -796,15 +813,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..174c27052e 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.24.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-Simplify-highlighting-assertions.patch --]
[-- Type: text/x-patch, Size: 3417 bytes --]
From 853ac332fffab69523e02a6ca4957e63d9cf3544 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 4/5] 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 174c27052e..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.24.0
[-- Attachment #6: Type: text/plain, Size: 71 bytes --]
Then, the patch adding read-multiple-choice (mostly the same as v5):
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #7: 0005-Hide-detailed-explanations-in-a-togglable-help-buffe-rmc.patch --]
[-- Type: text/x-patch, Size: 9723 bytes --]
From 9851fc4f223e4d2a8880aa479f10b75c75100e29 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Wed, 2 Oct 2019 22:04:01 +0200
Subject: [PATCH 5/5] Hide detailed explanations in a togglable help buffer
* test/lisp/dired-aux-tests.el (dired-test-bug27496):
(dired-test-highlight-metachar): Adapt to new prompt.
* lisp/dired-aux.el (dired--no-subst-prompt): Split into...
(dired--highlight-no-subst-chars): add warning face and possibly
'^' markers to command,
(dired--no-subst-explain): fill in help buffer with detailed
explanations,
(dired--no-subst-ask): setup read-multiple-choice,
(dired--no-subst-confirm): loop until we know what to do.
(dired-do-shell-command): Call new function
'dired--no-subst-confirm.'
(bug#28969, bug#35564)
---
lisp/dired-aux.el | 103 ++++++++++++++++++++++++++---------
test/lisp/dired-aux-tests.el | 39 ++++++-------
2 files changed, 96 insertions(+), 46 deletions(-)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 038e1dbbed..564c6931b5 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -110,27 +110,84 @@ dired--mark-positions
(setf (aref markers pos) ?^))
markers))
-(defun dired--no-subst-prompt (char-positions command add-markers)
+(defun dired--highlight-no-subst-chars (positions command mark)
(cl-callf substring-no-properties command)
- (dolist (pos char-positions)
+ (dolist (pos 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)))))
+ (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
+"
+ "`"
+ (string (aref command (car char-positions)))
+ (dired--highlight-no-subst-chars char-positions command mark-positions)))))
+
+(defun dired--no-subst-ask (char nb-occur details)
+ (let ((hilit-char (propertize (string char) 'face 'warning)))
+ (car
+ (read-multiple-choice
+ (format-message
+ (ngettext
+ "%d occurrence of `%s' will not be substituted. Proceed?"
+ "%d occurrences of `%s' will not be substituted. Proceed?"
+ nb-occur)
+ nb-occur hilit-char)
+ `((?y "yes" "Send shell command without substituting.")
+ (?n "no" "Abort.")
+ (?d "toggle details" ,(format-message
+ "Show/hide occurrences of `%s'." hilit-char))
+ ,@(when details
+ '((?m "toggle markers" "Show/hide `^' markers."))))))))
+
+(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))
+ (?d
+ (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))))
+ (?m
+ (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)
@@ -813,19 +870,15 @@ 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
- short-enough)))
+ (dired--no-subst-confirm confirmations command))
((setq confirmations (dired--need-confirm-positions command "?"))
- (y-or-n-p (dired--no-subst-prompt confirmations command
- short-enough)))
+ (dired--no-subst-confirm confirmations 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 ba10c54332..e1d9eefbea 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-multiple-choice) 'error))
(dired temporary-file-directory)
(dired-goto-file foo)
;; `dired-do-shell-command' returns nil on success.
@@ -127,39 +127,36 @@ 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
+ (result (dired--highlight-no-subst-chars
(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)))
+ (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 " ^ ^")
- (prompt (dired--no-subst-prompt
+ (result (dired--highlight-no-subst-chars
(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)))
+ (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/\\?/!/'")
- (prompt (dired--no-subst-prompt
+ (result (dired--highlight-no-subst-chars
(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))))
+ (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.24.0
[-- Attachment #8: Type: text/plain, Size: 50 bytes --]
Or, the patch adding read-char-from-minibuffer:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #9: 0005-Hide-detailed-explanations-in-a-togglable-help-buffe-rcfm.patch --]
[-- Type: text/x-patch, Size: 9620 bytes --]
From fabee1c28f5a8fbfc41c2646478b8224f63fbfe8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Wed, 2 Oct 2019 22:04:01 +0200
Subject: [PATCH 5/5] Hide detailed explanations in a togglable help buffer
* test/lisp/dired-aux-tests.el (dired-test-bug27496):
(dired-test-highlight-metachar): Adapt to new prompt.
* lisp/dired-aux.el (dired--no-subst-prompt): Split into...
(dired--highlight-no-subst-chars): add warning face and possibly
'^' markers to command,
(dired--no-subst-explain): fill in help buffer with detailed
explanations,
(dired--no-subst-ask): setup read-char-from-minibuffer,
(dired--no-subst-confirm): loop until we know what to do.
(dired-do-shell-command): Call new function
'dired--no-subst-confirm.'
(bug#28969, bug#35564)
---
lisp/dired-aux.el | 101 ++++++++++++++++++++++++++---------
test/lisp/dired-aux-tests.el | 39 +++++++-------
2 files changed, 94 insertions(+), 46 deletions(-)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 038e1dbbed..20b056e9f1 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -110,27 +110,82 @@ dired--mark-positions
(setf (aref markers pos) ?^))
markers))
-(defun dired--no-subst-prompt (char-positions command add-markers)
+(defun dired--highlight-no-subst-chars (positions command mark)
(cl-callf substring-no-properties command)
- (dolist (pos char-positions)
+ (dolist (pos 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)))))
+ (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)
@@ -813,19 +868,15 @@ 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
- short-enough)))
+ (dired--no-subst-confirm confirmations command))
((setq confirmations (dired--need-confirm-positions command "?"))
- (y-or-n-p (dired--no-subst-prompt confirmations command
- short-enough)))
+ (dired--no-subst-confirm confirmations 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 ba10c54332..64a8a035da 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.
@@ -127,39 +127,36 @@ 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
+ (result (dired--highlight-no-subst-chars
(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)))
+ (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 " ^ ^")
- (prompt (dired--no-subst-prompt
+ (result (dired--highlight-no-subst-chars
(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)))
+ (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/\\?/!/'")
- (prompt (dired--no-subst-prompt
+ (result (dired--highlight-no-subst-chars
(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))))
+ (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.24.0
[-- Attachment #10: Type: text/plain, Size: 20 bytes --]
Squashed patches:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #11: 0001-Tweak-dired-warning-about-wildcard-characters-rmc-squashed.patch --]
[-- Type: text/x-patch, Size: 12407 bytes --]
From e0024d156a7668a3829d451a7cc3b382860662ab 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:02 +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 | 153 +++++++++++++++++++++++++++++------
test/lisp/dired-aux-tests.el | 45 ++++++++++-
2 files changed, 171 insertions(+), 27 deletions(-)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index fb1ad6266d..564c6931b5 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -60,24 +60,134 @@ 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
+"
+ "`"
+ (string (aref command (car char-positions)))
+ (dired--highlight-no-subst-chars char-positions command mark-positions)))))
+
+(defun dired--no-subst-ask (char nb-occur details)
+ (let ((hilit-char (propertize (string char) 'face 'warning)))
+ (car
+ (read-multiple-choice
+ (format-message
+ (ngettext
+ "%d occurrence of `%s' will not be substituted. Proceed?"
+ "%d occurrences of `%s' will not be substituted. Proceed?"
+ nb-occur)
+ nb-occur hilit-char)
+ `((?y "yes" "Send shell command without substituting.")
+ (?n "no" "Abort.")
+ (?d "toggle details" ,(format-message
+ "Show/hide occurrences of `%s'." hilit-char))
+ ,@(when details
+ '((?m "toggle markers" "Show/hide `^' markers."))))))))
+
+(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))
+ (?d
+ (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))))
+ (?m
+ (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)
@@ -757,28 +867,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
@@ -789,7 +890,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 ccd3192792..e1d9eefbea 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-multiple-choice) '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.24.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #12: 0001-Tweak-dired-warning-about-wildcard-characters-rcfm-squashed.patch --]
[-- Type: text/x-patch, Size: 12298 bytes --]
From 2b6d4fda6bbe2cae2d77d099f65c77bdb5ebc161 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 fb1ad6266d..20b056e9f1 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)
@@ -757,28 +865,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
@@ -789,7 +888,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 ccd3192792..64a8a035da 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.24.0
[-- Attachment #13: Type: text/plain, Size: 115 bytes --]
For reference, here is the diff between both the read-multiple-choice
and the read-char-from-minibuffer options:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #14: rmc-vs-rcfm.patch --]
[-- Type: text/x-patch, Size: 3056 bytes --]
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 564c6931b5..20b056e9f1 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -134,27 +134,25 @@ dired--no-subst-explain
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)))))
+ (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)))
- (car
- (read-multiple-choice
- (format-message
- (ngettext
- "%d occurrence of `%s' will not be substituted. Proceed?"
- "%d occurrences of `%s' will not be substituted. Proceed?"
- nb-occur)
- nb-occur hilit-char)
- `((?y "yes" "Send shell command without substituting.")
- (?n "no" "Abort.")
- (?d "toggle details" ,(format-message
- "Show/hide occurrences of `%s'." hilit-char))
- ,@(when details
- '((?m "toggle markers" "Show/hide `^' markers."))))))))
+ (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*"))
@@ -174,7 +172,7 @@ dired--no-subst-confirm
(?n
(setq done t
proceed nil))
- (?d
+ (??
(if details
(progn
(quit-window nil details)
@@ -182,7 +180,7 @@ dired--no-subst-confirm
(dired--no-subst-explain
help-buf char-positions command markers)
(setq details (display-buffer help-buf))))
- (?m
+ (?^
(setq markers (not markers))
(dired--no-subst-explain
help-buf char-positions command markers)))))
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index e1d9eefbea..64a8a035da 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 'read-multiple-choice) '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.
[-- Attachment #15: Type: text/plain, Size: 263 bytes --]
Once applied, the patches can be tried out by
- opening a Dired buffer,
- hitting '!',
- inputting e.g. "sed 's/?/!/'".
WDYT?
Thank you for your time.
[1] bug#35564#5
[2] bug#35564#38
[3] bug#35564#62
[4] bug#35564#101
[5] bug#35564#157
[6] bug#35564#187
next prev parent reply other threads:[~2019-12-18 7:11 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 [this message]
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=87a77qhzvm.fsf@gmail.com \
--to=kevin.legouguec@gmail.com \
--cc=35564@debbugs.gnu.org \
--cc=juri@linkov.net \
--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).