From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: =?UTF-8?Q?K=C3=A9vin?= Le Gouguec Newsgroups: gmane.emacs.bugs Subject: bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters Date: Thu, 10 Oct 2019 20:45:14 +0200 Message-ID: <87o8yoign9.fsf_-_@gmail.com> References: <87zho2cd4f.fsf@gmail.com> <87wohvf22u.fsf@gmail.com> <87h88cvpkj.fsf_-_@gmail.com> <87imsinbmr.fsf_-_@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="151652"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: Michael Heerdegen , Noam Postavsky , Juri Linkov , Stefan Monnier , 28969@debbugs.gnu.org To: 35564@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Oct 10 20:46:29 2019 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1iIdSG-000dFL-Q8 for geb-bug-gnu-emacs@m.gmane.org; Thu, 10 Oct 2019 20:46:29 +0200 Original-Received: from localhost ([::1]:43154 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iIdSF-0006Sc-Lu for geb-bug-gnu-emacs@m.gmane.org; Thu, 10 Oct 2019 14:46:27 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:59194) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iIdRv-0006SH-UJ for bug-gnu-emacs@gnu.org; Thu, 10 Oct 2019 14:46:12 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iIdRq-0001cH-Mh for bug-gnu-emacs@gnu.org; Thu, 10 Oct 2019 14:46:07 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:48321) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iIdRq-0001c2-Fo for bug-gnu-emacs@gnu.org; Thu, 10 Oct 2019 14:46:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iIdRq-0008Og-DA for bug-gnu-emacs@gnu.org; Thu, 10 Oct 2019 14:46:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: =?UTF-8?Q?K=C3=A9vin?= Le Gouguec Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 10 Oct 2019 18:46:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 35564 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 35564-submit@debbugs.gnu.org id=B35564.157073313432223 (code B ref 35564); Thu, 10 Oct 2019 18:46:02 +0000 Original-Received: (at 35564) by debbugs.gnu.org; 10 Oct 2019 18:45:34 +0000 Original-Received: from localhost ([127.0.0.1]:57141 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iIdRL-0008NT-34 for submit@debbugs.gnu.org; Thu, 10 Oct 2019 14:45:34 -0400 Original-Received: from mail-wr1-f51.google.com ([209.85.221.51]:38828) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iIdRE-0008My-Kn; Thu, 10 Oct 2019 14:45:26 -0400 Original-Received: by mail-wr1-f51.google.com with SMTP id w12so9127645wro.5; Thu, 10 Oct 2019 11:45:24 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=LVRBztbo5TPq2dk6MGtV1MQvuQ0wgV7rFB1h47DB6aQ=; b=XZPvwe44Mb2yJzd7g5ofYcHfJWMIYo1Pg79F0vp4IbiM8adxzxxyZ02cp4jKJdMVZE f9/xrKXYmLTHM8tIQFnTMl+hLN0cQpFFYby5+NsGyzUmlFL2YcVb3DPcAWKfuKJO5HXt zL/Wf294IaeSLBa489l1/svtPp2+f9MJDAS3MJfHgaB0EnPlas0lpgtW6YF6CbhDTNMr eoEiQDa60qSkBFj+Y6I5HPJ/EhwKJjVq9XyIHta74RtS5HU3gImJ5o00wQzxVe5m3EFV a2pNMo8wJDByDG0UlS7xzqAKXVqL2Cg0fspS369hWQuMOvbJHxfnnHMgzQqPC0Cml3vA 8m9Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=LVRBztbo5TPq2dk6MGtV1MQvuQ0wgV7rFB1h47DB6aQ=; b=iCs1wBN/+qIdyWL6WbabTas5fw9Ub7/SAx8aUm1tEBku04u835FlVcDrwroW4AWHK+ Qedg4tbE4qQ01gTauICJ8a9NFFwKyPLd5jm0U0b+OBfH/eA03kn3B0tvt0QKjB47mZrr B8ZuEWTJf8tuHehO+7Z+KReIiQfrNCcm3bcYsWBj86hYez0gAyxAdO1hJm8iwOhco5mv o4sNFvCiLufBM95Ntd23VDVxPM+jPknGgSOfrmwktBzuZIlot9yBFUlINsjnAyafPPMT +GUFMv8XLHnYvUMMTyRxBUaKVFgb0n/5tp0UIYBSDy/Of4fTiSFaQYhdKJXGMO8tax6q K/4Q== X-Gm-Message-State: APjAAAV6sxpkvOu7nFCGHRvLK/TPiAAwimXsYk9d3ztFBpsyWQ9ZXE06 sIIlLEnAUjia5MWu5uyeRFs= X-Google-Smtp-Source: APXvYqw+rBf/HmYmTA7nG0Dgn7aEcJOgZUHttQRc09fB9HAnYp2wQPlLKBRNUJ8s8MEYJ9+a1FYB/Q== X-Received: by 2002:adf:f18a:: with SMTP id h10mr9503634wro.145.1570733118759; Thu, 10 Oct 2019 11:45:18 -0700 (PDT) Original-Received: from my-little-tumbleweed (71.142.13.109.rev.sfr.net. [109.13.142.71]) by smtp.gmail.com with ESMTPSA id m18sm9066657wrg.97.2019.10.10.11.45.16 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 10 Oct 2019 11:45:17 -0700 (PDT) In-Reply-To: <87imsinbmr.fsf_-_@gmail.com> ("=?UTF-8?Q?K=C3=A9vin?= Le Gouguec"'s message of "Wed, 03 Jul 2019 21:47:40 +0200") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:168897 Archived-At: --=-=-= Content-Type: text/plain Finally got around to try out rmc.el. A brief recap of the issue: dired-do-shell-command looks out for any non-isolated metacharacters[1], and prompts the user when it finds some. The problem is that the prompt is downright misleading under some circumstances. E.g. after marking some files in a Dired buffer: ! sed 's/?/!/g' RET => Confirm--do you mean to use `?' as a wildcard? The answer a user must input to proceed is "yes", despite '?' not being a wildcard in this situation; the answer some users may give intuitively is "no" (or, in my case, "whaaa?"). This patch series initially tried to shove the command in the prompt, highlight the non-isolated characters, and re-phrase the prompt to be more accurate (i.e. not talk about wildcards). It went through a several iterations for a few reasons[2]; most recently Michael suggested using read-multiple-choice [bug#35564#136]; I looked at how nsm.el uses it, saw that is was good, and got distracted for two months. Here is the new series: --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Tweak-dired-warning-about-wildcard-characters.patch >From 0c0b1570623a69141ebd31b8e3dffdeef5273c7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= 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 bfc37c5cde..409f028e2b 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,42 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((start (max 0 (1- pos))) + (char (string (aref command pos)))) + (and (string-match + (rx (or (seq (or bos blank) + (group-n 1 (literal char)) + (or eos blank)) + (seq ?` (group-n 1 (literal char)) ?`))) + command start) + (= pos (match-beginning 1))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted:")) + (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -761,11 +797,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "?"))) (t)))) (cond ((not ok) (message "Command canceled")) (t diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index ccd3192792..80b6393931 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,34 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo `bar`?" 9)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.23.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch >From b80d55bf5307cf95ae0804cc1dfe66b40b012ba6 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 409f028e2b..c13cbcf2e3 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) @@ -781,26 +781,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. - (ok (cond ((not (or on-each no-subst)) - (error "You can not combine `*' and `?' substitution marks")) - ((need-confirm-p command "*") - (y-or-n-p (dired--no-subst-prompt command "*"))) - ((need-confirm-p command "?") - (y-or-n-p (dired--no-subst-prompt command "?"))) - (t)))) + (ok (cond + ((not (or on-each no-subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((setq confirmations (dired--need-confirm-positions command "*")) + (y-or-n-p (dired--no-subst-prompt confirmations command))) + ((setq confirmations (dired--need-confirm-positions command "?")) + (y-or-n-p (dired--no-subst-prompt confirmations command))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -811,7 +804,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 80b6393931..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.23.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Add-markers-below-non-isolated-chars-in-dired-prompt.patch >From cd41c96d0631275d1fc24367663cf891a17cad47 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= 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 c13cbcf2e3..01c1b92595 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -102,18 +102,35 @@ dired--need-confirm-positions (setq start (match-end 0))) confirm-positions)) -(defun dired--no-subst-prompt (char-positions command) +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--no-subst-prompt (char-positions command add-markers) (cl-callf substring-no-properties command) (dolist (pos char-positions) (add-face-text-property pos (1+ pos) 'warning nil command)) - (concat command "\n" - (format-message - (ngettext "Send %d occurrence of `%s' as-is to shell?" - "Send %d occurrences of `%s' as-is to shell?" - (length char-positions)) - (length char-positions) - (propertize (string (aref command (car char-positions))) - 'face 'warning)))) + ;; `y-or-n-p' adds some text to the beginning of the prompt when the + ;; user fails to answer 'y' or 'n'. The highlighted command thus + ;; cannot be put on the first line of the prompt, since the added + ;; text will shove the command to the right, and the '^' markers + ;; will become misaligned. + (apply #'concat + `("Confirm:\n" + ,command "\n" + ,@(when add-markers + (list (dired--mark-positions char-positions) "\n")) + ,(format-message + (ngettext "Send %d occurrence of `%s' as-is to shell?" + "Send %d occurrences of `%s' as-is to shell?" + (length char-positions)) + (length char-positions) + (propertize (string (aref command (car char-positions))) + 'face 'warning))))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -784,15 +801,19 @@ dired-do-shell-command (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) (confirmations nil) + (short-enough (< (length command) + (window-width (minibuffer-window)))) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((setq confirmations (dired--need-confirm-positions command "*")) - (y-or-n-p (dired--no-subst-prompt confirmations command))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) ((setq confirmations (dired--need-confirm-positions command "?")) - (y-or-n-p (dired--no-subst-prompt confirmations command))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) (t)))) (cond ((not ok) (message "Command canceled")) (t diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index ff18edddb6..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.23.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Simplify-highlighting-assertions.patch >From 7a884e189fa18cd903c6c684090860cf8ebb7f7f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= 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.23.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-Hide-detailed-explanations-in-a-togglable-help-buffe.patch >From 9fa3a93492c6c4d6553cff163d0203253bdb2eb6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= 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 | 102 ++++++++++++++++++++++++++--------- test/lisp/dired-aux-tests.el | 39 +++++++------- 2 files changed, 95 insertions(+), 46 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 01c1b92595..6b33f4ebfb 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -110,27 +110,83 @@ 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 + "Warning: %d occurrence of `%s' will not be substituted. Proceed?" + "Warning: %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) + (dired--no-subst-explain help-buf char-positions command nil) + (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)) + (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) @@ -801,19 +857,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.23.0 --=-=-= Content-Type: text/plain Highlights: - removed the patch for y-or-n-p, since we don't need it anymore, - (squashed Noam's patch with my fixups,) - the last patch contains the new stuff: - the default prompt is now as concise as the old one, - pressing 'd' toggles a help buffer which highlights occurrences using the warning face, - when the help buffer is enabled, pressing 'm' toggles the '^' markers. Squashed patch for convenience: --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Tweak-dired-warning-about-wildcard-characters.patch >From 8a51df696ef4d1b794ea75d94b1137f1e1ff536f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Thu, 10 Oct 2019 20:20:41 +0200 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 (bug#28969, bug#35564) --- lisp/dired-aux.el | 152 +++++++++++++++++++++++++++++------ test/lisp/dired-aux-tests.el | 45 ++++++++++- 2 files changed, 170 insertions(+), 27 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index bfc37c5cde..6b33f4ebfb 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,24 +60,133 @@ 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 + "Warning: %d occurrence of `%s' will not be substituted. Proceed?" + "Warning: %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) + (dired--no-subst-explain help-buf char-positions command nil) + (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)) + (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) @@ -745,28 +854,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 @@ -777,7 +877,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.23.0 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable To try the changes out, it's enough to reload dired-aux.el, mark a few files in Dired, type e.g. ! sed 's/?/!/g' RET =E2=80=A6 and play with the new prompt. Let me know if this UI looks OK, and how the implementation may be improved. Thank you for your patience. Not addressed in this patch series: - letting the user iterate over non-isolated occurrences and selectively substitute them, - allowing '*' to be substituted when surrounded by backquotes, just like '?'. I do find these features valuable (or at least worthy of discussion), however the current bug reports were motivated merely by an inaccurate warning; I'd like to close this first before considering further changes. [1] '?' when not surrounded by whitespace or backquotes, '*' when not surrounded by whitespace. [2] Trying to find the right balance between concision and accurate explanation, considering that some users may not know about the file-substitution feature; also trying to make the highlighting "accessible", i.e. not just relying on colored faces. --=-=-=--