From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.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: Sun, 20 Sep 2020 14:04:44 +0200 Message-ID: <87o8m04psz.fsf@gmail.com> References: <87zho2cd4f.fsf@gmail.com> <87wohvf22u.fsf@gmail.com> <87h88cvpkj.fsf_-_@gmail.com> <87imsinbmr.fsf_-_@gmail.com> <87o8yoign9.fsf_-_@gmail.com> <87a77qhzvm.fsf@gmail.com> <87v9qcf00w.fsf@mail.linkov.net> <875zian2wg.fsf@gmail.com> <8336de17gr.fsf@gnu.org> <87ft7coeru.fsf@gnus.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="26515"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: michael_heerdegen@web.de, 35564@debbugs.gnu.org, npostavs@gmail.com, juri@linkov.net, monnier@iro.umontreal.ca To: Lars Ingebrigtsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Sep 20 14:05:11 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1kJy5f-0006lF-CW for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 20 Sep 2020 14:05:11 +0200 Original-Received: from localhost ([::1]:35400 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kJy5e-0000jx-2q for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 20 Sep 2020 08:05:10 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:49166) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kJy5W-0000jb-Dx for bug-gnu-emacs@gnu.org; Sun, 20 Sep 2020 08:05:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:37539) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kJy5W-0002IK-45 for bug-gnu-emacs@gnu.org; Sun, 20 Sep 2020 08:05:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kJy5V-0002dM-SC for bug-gnu-emacs@gnu.org; Sun, 20 Sep 2020 08:05:01 -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: Sun, 20 Sep 2020 12:05:01 +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 moreinfo Original-Received: via spool by 35564-submit@debbugs.gnu.org id=B35564.160060349610110 (code B ref 35564); Sun, 20 Sep 2020 12:05:01 +0000 Original-Received: (at 35564) by debbugs.gnu.org; 20 Sep 2020 12:04:56 +0000 Original-Received: from localhost ([127.0.0.1]:49085 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kJy5P-0002cz-FX for submit@debbugs.gnu.org; Sun, 20 Sep 2020 08:04:56 -0400 Original-Received: from mail-wr1-f67.google.com ([209.85.221.67]:34885) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kJy5M-0002ci-0B for 35564@debbugs.gnu.org; Sun, 20 Sep 2020 08:04:54 -0400 Original-Received: by mail-wr1-f67.google.com with SMTP id e16so9946859wrm.2 for <35564@debbugs.gnu.org>; Sun, 20 Sep 2020 05:04:51 -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=1FOvW6ZpU8aW+KDDPwQn++1PuFO0/oFLm36JFljcljw=; b=dhFeUL2+GKurYhZeA8VqB8mcrAa5llX8nZv+7vWkWDnIM+9wvbjsfkDnHLvJYJN8Gp cpEJBvWast3MIAHUocZOjq1ZNh+KzmxjEK36Yxazhwmt2p1CWGWooxmwIlkUnIvMyUyJ cCclgAyze6nu7m0QweKCiPVF4tJWzp5OyEFvIQfqDmDyKhQCVPzZ+TqqafnpwpLrw/Rq adVnaChCxdzRaeqlI+Gi/QIfu3NxPLt8V5PdK+fkGC/P4t3kcTqvABA+P1KdLsTRPsXD g/o7M/N046o6E7FXFklqi5fkTlYCTnNT7uSriazkMWGlv2DYFqOVGfrzDLPP8Gwx0+Zy 8jsg== 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=1FOvW6ZpU8aW+KDDPwQn++1PuFO0/oFLm36JFljcljw=; b=Q8o3TTlXNYgCDfjyg6JG1e1G2BTM4ukR83ObNiMhSp4jSm29vaBINmpJahI3h9e6Ch OhFxGVAFRCzvpmjjF2agePyXf1Z89U36+cUwPZ5HMAyJ6DvNWbH+pTj7B9KPjWmilJil vn1PRG2dWAYT/HgT95W5hscsnNRqPKqDqcLqO4FdPBfuU88uWIG6Kjhjx0m6W72Y91sk HgWRY2OdPaHSgtVGM7n0VH92yqezENOZkCtQTvHHWxMvYvRg/t1F4dFwx0Iy7fGG2Po/ NA+FE7exJNzwIQBNkPZ6KDH4PravngdrbDZQ+8mp0XLS/5KfPMcWwqDR2+vDWNpjOKSU X5pQ== X-Gm-Message-State: AOAM532rGO9iWpJSmZIOYGX73OUE2VjbHpZ+8dON/1Uh5EiGYyZ+YMk6 k6T3D5reVi4l0n32VcaP97c= X-Google-Smtp-Source: ABdhPJx4imdIks+AEm7SCZSPfG4TSIGz7skBCvkssJ/t/szFljvRCIIsbgT/9RsxXZNjA4dqhjkouw== X-Received: by 2002:a5d:67d2:: with SMTP id n18mr47188892wrw.223.1600603486215; Sun, 20 Sep 2020 05:04:46 -0700 (PDT) Original-Received: from hirondell (2a01cb040b29800015848624b4c61618.ipv6.abo.wanadoo.fr. [2a01:cb04:b29:8000:1584:8624:b4c6:1618]) by smtp.gmail.com with ESMTPSA id c14sm14639427wrv.12.2020.09.20.05.04.44 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 20 Sep 2020 05:04:45 -0700 (PDT) In-Reply-To: <87ft7coeru.fsf@gnus.org> (Lars Ingebrigtsen's message of "Sun, 20 Sep 2020 13:42:45 +0200") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list 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-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:188501 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Lars Ingebrigtsen writes: > K=C3=A9vin, skimming this thread, there seemed to be a general consensus = that > your patch series should be applied. Could you work up a single > squashed patch to apply? There's so many patches with different > variations that it's difficult to tell which ones should be applied. Thanks for following up on this! I was planning to do so after the release of 27.1, but somehow never found the time. Here is the squashed patch using read-char-from-minibuffer (which unless I messed something up should be the same as the one from December[1]). --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Tweak-dired-warning-about-wildcard-characters.patch >From 135465cb28a8cfc2059754b7ab2c188864eb891d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= 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 (bug#28969, bug#35564) --- lisp/dired-aux.el | 151 +++++++++++++++++++++++++++++------ test/lisp/dired-aux-tests.el | 45 ++++++++++- 2 files changed, 169 insertions(+), 27 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index cf2926ad37..df25a6418f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,24 +60,132 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--highlight-no-subst-chars (positions command mark) + (cl-callf substring-no-properties command) + (dolist (pos positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (if mark + (concat command "\n" (dired--mark-positions positions)) + command)) + +(defun dired--no-subst-explain (buf char-positions command mark-positions) + (with-current-buffer buf + (erase-buffer) + (insert + (format-message "\ +If your command contains occurrences of `*' surrounded by +whitespace, `dired-do-shell-command' substitutes them for the +entire file list to process. Otherwise, if your command contains +occurrences of `?' surrounded by whitespace or `%s', Dired will +run the command once for each file, substituting `?' for each +file name. + +Your command contains occurrences of `%s' that will not be +substituted, and will be passed through normally to the shell. + +%s + +(Press ^ to %s markers below these occurrences.) +" + "`" + (string (aref command (car char-positions))) + (dired--highlight-no-subst-chars char-positions command mark-positions) + (if mark-positions "remove" "add"))))) + +(defun dired--no-subst-ask (char nb-occur details) + (let ((hilit-char (propertize (string char) 'face 'warning)) + (choices `(?y ?n ?? ,@(when details '(?^))))) + (read-char-from-minibuffer + (format-message + (ngettext + "%d occurrence of `%s' will not be substituted. Proceed? (%s) " + "%d occurrences of `%s' will not be substituted. Proceed? (%s) " + nb-occur) + nb-occur hilit-char (mapconcat #'string choices ", ")) + choices))) + +(defun dired--no-subst-confirm (char-positions command) + (let ((help-buf (get-buffer-create "*Dired help*")) + (char (aref command (car char-positions))) + (nb-occur (length char-positions)) + (done nil) + (details nil) + (markers nil) + proceed) + (unwind-protect + (save-window-excursion + (while (not done) + (cl-case (dired--no-subst-ask char nb-occur details) + (?y + (setq done t + proceed t)) + (?n + (setq done t + proceed nil)) + (?? + (if details + (progn + (quit-window nil details) + (setq details nil)) + (dired--no-subst-explain + help-buf char-positions command markers) + (setq details (display-buffer help-buf)))) + (?^ + (setq markers (not markers)) + (dired--no-subst-explain + help-buf char-positions command markers))))) + (kill-buffer help-buf)) + proceed)) ;;;###autoload (defun dired-diff (file &optional switches) @@ -772,28 +880,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. - (ok (cond ((not (or on-each no-subst)) - (error "You can not combine `*' and `?' substitution marks")) - ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) - ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) - (t)))) + (ok (cond + ((not (or on-each no-subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((setq confirmations (dired--need-confirm-positions command "*")) + (dired--no-subst-confirm confirmations command)) + ((setq confirmations (dired--need-confirm-positions command "?")) + (dired--no-subst-confirm confirmations command)) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -804,7 +903,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 1fe155718d..54ec5d673c 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -28,7 +28,7 @@ dired-test-bug27496 (let* ((foo (make-temp-file "foo")) (files (list foo))) (unwind-protect - (cl-letf (((symbol-function 'y-or-n-p) 'error)) + (cl-letf (((symbol-function 'read-char-from-minibuffer) 'error)) (dired temporary-file-directory) (dired-goto-file foo) ;; `dired-do-shell-command' returns nil on success. @@ -114,6 +114,49 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted." + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (markers " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + t)) + (lines (split-string result "\n"))) + (should (= (length lines) 2)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (should (string-match (regexp-quote markers) (nth 1 lines))) + (dired-test--check-highlighting (nth 0 lines) '(15 29))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (markers " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "*") + command + t)) + (lines (split-string result "\n"))) + (should (= (length lines) 2)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (should (string-match (regexp-quote markers) (nth 1 lines))) + (dired-test--check-highlighting (nth 0 lines) '(11 25))) + (let* ((command "sed 's/\\?/!/'") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + nil)) + (lines (split-string result "\n"))) + (should (= (length lines) 1)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (dired-test--check-highlighting (nth 0 lines) '(8)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 --=-=-= Content-Type: text/plain [1] --=-=-=--