From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Noam Postavsky Newsgroups: gmane.emacs.bugs Subject: bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters Date: Thu, 27 Jun 2019 19:31:34 -0400 Message-ID: <87a7e27gh5.fsf@gmail.com> References: <87zho2cd4f.fsf@gmail.com> <87wohvf22u.fsf@gmail.com> <87h88cvpkj.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="119302"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2.90 (gnu/linux) Cc: 35564@debbugs.gnu.org, Stefan Monnier To: =?UTF-8?Q?K=C3=A9vin?= Le Gouguec Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Jun 28 01:32:36 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 1hgdsa-000UuY-Bf for geb-bug-gnu-emacs@m.gmane.org; Fri, 28 Jun 2019 01:32:36 +0200 Original-Received: from localhost ([::1]:55264 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hgdsX-0005UM-Tl for geb-bug-gnu-emacs@m.gmane.org; Thu, 27 Jun 2019 19:32:33 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:55256) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hgds5-0005Ts-Fl for bug-gnu-emacs@gnu.org; Thu, 27 Jun 2019 19:32:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hgds3-0006Sj-HU for bug-gnu-emacs@gnu.org; Thu, 27 Jun 2019 19:32:05 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:54733) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hgds2-0006R9-82 for bug-gnu-emacs@gnu.org; Thu, 27 Jun 2019 19:32:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hgds2-0004vQ-2V for bug-gnu-emacs@gnu.org; Thu, 27 Jun 2019 19:32:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Noam Postavsky Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 27 Jun 2019 23:32: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.156167830518903 (code B ref 35564); Thu, 27 Jun 2019 23:32:02 +0000 Original-Received: (at 35564) by debbugs.gnu.org; 27 Jun 2019 23:31:45 +0000 Original-Received: from localhost ([127.0.0.1]:40044 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hgdrk-0004up-Hq for submit@debbugs.gnu.org; Thu, 27 Jun 2019 19:31:45 -0400 Original-Received: from mail-io1-f48.google.com ([209.85.166.48]:41156) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hgdri-0004uX-0m for 35564@debbugs.gnu.org; Thu, 27 Jun 2019 19:31:42 -0400 Original-Received: by mail-io1-f48.google.com with SMTP id w25so8564150ioc.8 for <35564@debbugs.gnu.org>; Thu, 27 Jun 2019 16:31:41 -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=Pv0cxXyHHBsyDSzRmrIYQ9v0qVxl5w9fg8tTwEvhy6s=; b=IrS+w9Czzba+0kTuNMJbMSTi8MnG83JSoA/Rui8rJWixkjdwFOWW61c3gnKHgq6I0H 0U9n5c5Yw34AflBfFDy3iX3jc2AZCwOcE2P37PlF6XfQDj6sy8TcZNqeyYlr613WfrVe +8Wm0LWo5I+WelFk8PBMfe4WCp4TPcI665DLatKI+93oksFpiturTU5Y9gw2WW4kVSOs cB9JtLoAzKi5OecO1+OyqQ/4wk3KCOiPAyC0iLZaHAVtAiRsejMPOO4tPI4q+wqZykqx N0LcpnABFSNcdJD2UACuZ0b31QSvn4Opdv++Ek3YR/GPesZFyVug0PqOLvjKRw98xRWB xd4w== 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=Pv0cxXyHHBsyDSzRmrIYQ9v0qVxl5w9fg8tTwEvhy6s=; b=IzVN521C7Ps6DM53uqkhJUKum9Dne7avaN+c40g1DNGIRNwT/5U8LM5/uwuyp9UkbL oq7FFxX90Kqr9O1pjEjFjcSC8nWFil6auKgFkjpzjPknkMOE72jZnRgW2sGTB8qpjIEw Dm4wtK85AIne1GSK9xxl1ZfMDekba9qRxm8wq9JBNwLyRRauWpuJLR6ewO0mW9m/J7qv HlroxFz+bHW46OV/pZcn/JxjlcwokSvTpeMs+6TQM6U4c9b8yYNdIlLLLjmtX+qKnJJq WpFPfA3dUkkIsTYjwrCglpXPJOXSseXZ0Rn7XObLziDgkcRV03QL4VHFlwtiknK+n07o se0Q== X-Gm-Message-State: APjAAAUwewbPLlytnmBCt80PE6wLMhCYoFBqx2OqS0sJCmy3bfWUyjZg 4j8B7Nm3PgVNvT0Yi+5P5QY= X-Google-Smtp-Source: APXvYqx6V6UGh8CE5+kDkMKhOf8Op2AlflUCrhZwnADFWMHD+wn1LnHEhcxTdgCsVV5jvF/l8ddV8w== X-Received: by 2002:a6b:1604:: with SMTP id 4mr7161819iow.245.1561678296274; Thu, 27 Jun 2019 16:31:36 -0700 (PDT) Original-Received: from minid (cbl-45-2-119-34.yyz.frontiernetworks.ca. [45.2.119.34]) by smtp.gmail.com with ESMTPSA id a7sm1008761iok.19.2019.06.27.16.31.34 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Thu, 27 Jun 2019 16:31:35 -0700 (PDT) In-Reply-To: <87h88cvpkj.fsf_-_@gmail.com> ("=?UTF-8?Q?K=C3=A9vin?= Le Gouguec"'s message of "Wed, 26 Jun 2019 08:16:44 +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:161668 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable K=C3=A9vin Le Gouguec writes: >> 2. dired-aux.el already contains some logic to detect isolated >> characters Yes, this was kind of bugging me, so here's a patch to reuse that logic (it applies on top of yours). While doing this I noticed that we earlier missed that `*` is not considered isolated, unlike `?`. Assuming no problems, I'll just push your two patches followed by mine (I considered squashing, but probably that makes things harder to follow in this case). --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0003-Dedup-dired-aux-isolated-char-searching.patch Content-Description: patch >From 52af7efc5e0c673b24e09991db275112212f3fbf Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 27 Jun 2019 19:15:56 -0400 Subject: [PATCH 3/3] Dedup dired-aux isolated char searching * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--no-subst-prompt): Operate on a list of positions rather than searching again for isolated chars. (dired--isolated-char-p): Remove. (dired--need-confirm-positions): New function. (dired-do-shell-command): Use it. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p): Remove. (dired-test-highlight-metachar): Adjust to new functions. Make sure that `*` isn't considered isolated. --- lisp/dired-aux.el | 108 +++++++++++++++++++------------------------ test/lisp/dired-aux-tests.el | 31 ++++++------- 2 files changed, 62 insertions(+), 77 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 079e4f102f..e716b2b42c 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,60 +60,55 @@ (defun dired-isolated-string-re (string) of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) - -(defun dired--isolated-char-p (command pos) - "Assert whether the character at POS is isolated within COMMAND. -A character is isolated if: -- it is surrounded by whitespace, the start of the command, or - the end of the command, -- it is surrounded by `\\=`' characters." - (let ((start (max 0 (1- pos))) - (char (string (aref command pos)))) - (and (string-match - (rx (or (seq (or bos blank) - (group-n 1 (literal char)) - (or eos blank)) - (seq ?` (group-n 1 (literal char)) ?`))) - command start) - (= pos (match-beginning 1))))) - -(defun dired--highlight-nosubst-char (command char) - "Highlight occurences of CHAR that are not isolated in COMMAND. -These occurences will not be substituted; they will be sent as-is -to the shell, which may interpret them as wildcards." - (save-match-data - (let ((highlighted (substring-no-properties command)) - (pos 0)) - (while (string-match (regexp-quote char) command pos) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (unless (dired--isolated-char-p command start) - (add-face-text-property start end 'warning nil highlighted)) - (setq pos end))) - highlighted))) - -(defun dired--no-subst-prompt (command char) - (let ((highlighted-command (dired--highlight-nosubst-char command char)) - (prompt "Confirm--the highlighted characters will not be substituted:")) - (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--no-subst-prompt (command char-positions) + (let ((highlighted (substring-no-properties command))) + (dolist (pos char-positions) + (add-face-text-property pos (1+ pos) 'warning nil highlighted)) + (format-message "\ +Confirm--the highlighted characters will not be substituted:\n%s +Proceed?" highlighted))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -779,26 +774,19 @@ (defun dired-do-shell-command (command &optional arg file-list) (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. - (ok (cond ((not (or on-each no-subst)) - (error "You can not combine `*' and `?' substitution marks")) - ((need-confirm-p command "*") - (y-or-n-p (dired--no-subst-prompt command "*"))) - ((need-confirm-p command "?") - (y-or-n-p (dired--no-subst-prompt command "?"))) - (t)))) + (ok (cond + ((not (or on-each no-subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((setq confirmations (dired--need-confirm-positions command "*")) + (y-or-n-p (dired--no-subst-prompt confirmations command))) + ((setq confirmations (dired--need-confirm-positions command "?")) + (y-or-n-p (dired--no-subst-prompt command confirmations))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -809,7 +797,7 @@ (defun dired-do-shell-command (command &optional arg file-list) nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 80b6393931..3f4bfffaf6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,34 +114,31 @@ (ert-deftest dired-test-bug30624 () (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) -(ert-deftest dired-test-isolated-char-p () - (should (dired--isolated-char-p "?" 0)) - (should (dired--isolated-char-p "? " 0)) - (should (dired--isolated-char-p " ?" 1)) - (should (dired--isolated-char-p " ? " 1)) - (should (dired--isolated-char-p "foo bar ? baz" 8)) - (should (dired--isolated-char-p "foo -i`?`" 7)) - (should-not (dired--isolated-char-p "foo `bar`?" 9)) - (should-not (dired--isolated-char-p "foo 'bar?'" 8)) - (should-not (dired--isolated-char-p "foo bar?baz" 7)) - (should-not (dired--isolated-char-p "foo bar?" 7))) - (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") - (result (dired--highlight-nosubst-char command "?"))) + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "?"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) (should (equal 'warning (get-text-property 15 'face result))) (should-not (text-property-not-all 16 28 'face nil result)) (should (equal 'warning (get-text-property 29 'face result))) (should-not (text-property-not-all 30 39 'face nil result))) - (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") - (result (dired--highlight-nosubst-char command "*"))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "*"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) (should (equal 'warning (get-text-property 11 'face result))) (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 24 'face result))) - (should-not (text-property-not-all 25 29 'face nil result)))) + (should (equal 'warning (get-text-property 25 'face result))) + (should-not (text-property-not-all 26 32 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.11.0 --=-=-=--