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 v4] Tweak dired warning about "wildcard" characters Date: Sun, 28 Jul 2019 01:32:19 +0200 Message-ID: <87lfwjoxz0.fsf@gmail.com> References: <87zho2cd4f.fsf@gmail.com> <87wohvf22u.fsf@gmail.com> <87h88cvpkj.fsf_-_@gmail.com> <87imsinbmr.fsf_-_@gmail.com> <87y313z3tp.fsf@gmail.com> <83wog3lo5c.fsf@gnu.org> <87imrn16fk.fsf@tcd.ie> 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="227552"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: 35564@debbugs.gnu.org, monnier@iro.umontreal.ca, npostavs@gmail.com To: "Basil L. Contovounesios" Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Jul 28 01:33:15 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 1hrWBd-000x0d-AY for geb-bug-gnu-emacs@m.gmane.org; Sun, 28 Jul 2019 01:33:13 +0200 Original-Received: from localhost ([::1]:47602 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hrWBb-0000xk-Kd for geb-bug-gnu-emacs@m.gmane.org; Sat, 27 Jul 2019 19:33:11 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:50447) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hrWBW-0000xb-45 for bug-gnu-emacs@gnu.org; Sat, 27 Jul 2019 19:33:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hrWBS-00070F-Bv for bug-gnu-emacs@gnu.org; Sat, 27 Jul 2019 19:33:06 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:36756) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hrWBS-000701-5A for bug-gnu-emacs@gnu.org; Sat, 27 Jul 2019 19:33:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hrWBR-0004cB-Ub for bug-gnu-emacs@gnu.org; Sat, 27 Jul 2019 19:33: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: Sat, 27 Jul 2019 23:33: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 Original-Received: via spool by 35564-submit@debbugs.gnu.org id=B35564.156427035217695 (code B ref 35564); Sat, 27 Jul 2019 23:33:01 +0000 Original-Received: (at 35564) by debbugs.gnu.org; 27 Jul 2019 23:32:32 +0000 Original-Received: from localhost ([127.0.0.1]:45577 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hrWAw-0004bK-Nd for submit@debbugs.gnu.org; Sat, 27 Jul 2019 19:32:31 -0400 Original-Received: from mail-wr1-f65.google.com ([209.85.221.65]:45791) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hrWAt-0004b4-Nk for 35564@debbugs.gnu.org; Sat, 27 Jul 2019 19:32:29 -0400 Original-Received: by mail-wr1-f65.google.com with SMTP id f9so57925381wre.12 for <35564@debbugs.gnu.org>; Sat, 27 Jul 2019 16:32:27 -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=nAA/Ln4pkw1b+xQEdR2SRFjwKo9QRWMzs/vt2eVrcLk=; b=QPmIFij0Du3dyqw+RPxCn5VtjEdjo6tUibkHw72R1j9YVSx8UYOgjXiD7+mP/L17iV PHw0TByXkoSabcnOLKoEtse1VDDNVhej5pASs/j1PJdrJhK3SXq6mTW5SQWhSTSetEWH dOT25fwAIKwOkmDPOsuT7l9H5OWBRalI0VAAnjq/68RYjD6EXgZpC6D244bQbdfhwmxC f3BDyBwbXT1s/GqyrZ7fITyTo+ZJX9p4hThBu/CDNKQh9RbeGjUXDah1YEZZimXuMbJn kX0YbRYDyGUjCZDtgAWAom+Mspp4CetCuRRAja4GFCHyuOt6Bw30i9h3SHQZQNub5hOH NtzQ== 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=nAA/Ln4pkw1b+xQEdR2SRFjwKo9QRWMzs/vt2eVrcLk=; b=SUS4LoTCfK8FCi0xdTpP/AzZRISgKRXTVXNV789Zb0iSfp3dzIIySqRxpMAvlCT54i M3SpEmXlhpKL27HjKOKRslzpAN5D874PYnmwCn9uemTLtuj5Vgv4fQphC8O1BEZUEvzU 6OYhE1xvEOE5/BOSOxrqvxkLD0h1tEDpkfQJ2SKl+IFJSJJ7nvmha6klBRIdGBRokenp uShmeDPS4sChjDJP6rJ3SvOap3emvrH9yy/1ubL4WzVVxSM75Htg1sxJzdpDIB0R0lBF WZBMsp1YxSGrFK+uWKlY1zDxwgQc73u1jxxXR29DDunUBO7O8Qp8ECwWxbt6ev3xaXP+ NGqw== X-Gm-Message-State: APjAAAXbK3xNSAb5PJfT0F7ghdSqdPd7gz0WW1iFlQmr5GfCJ2mfY9f+ rHboV5ghnRDRMAH7F2NVs8s= X-Google-Smtp-Source: APXvYqy5hyEwsNrPLijfnKxSPDWYchpFu91TWsSjMNmP4lwbUeaBi28o6CFv/PVjd6DdLHx6kl4CmA== X-Received: by 2002:adf:ce07:: with SMTP id p7mr30250649wrn.129.1564270341780; Sat, 27 Jul 2019 16:32:21 -0700 (PDT) Original-Received: from nc10-laptop (2a01cb04010fc800c8771fb97d0446e3.ipv6.abo.wanadoo.fr. [2a01:cb04:10f:c800:c877:1fb9:7d04:46e3]) by smtp.gmail.com with ESMTPSA id b15sm72882550wrt.77.2019.07.27.16.32.20 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sat, 27 Jul 2019 16:32:20 -0700 (PDT) In-Reply-To: <87imrn16fk.fsf@tcd.ie> (Basil L. Contovounesios's message of "Sat, 27 Jul 2019 23:03:27 +0100") 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:163921 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable "Basil L. Contovounesios" writes: >> -(defun dired--no-subst-prompt (char-positions command) >> +(defun dired--mark-positions (positions) >> + (let ((markers (make-string >> + (1+ (apply #'max positions)) > > Is POSITIONS guaranteed to be non-nil? (The max function takes at least > one argument.) AFAICT dired--mark-positions is only called by dired--no-subst-prompt, which is only used when there is at least one ambiguous character to highlight. So as things stand now, POSITIONS will always be non-nil. Nothing prevents someone from attempting to re-use the function with a potentially-nil argument though. I don't know what makes more sense here: adding an assertion? Handling the nil case explicitly for robustness? >> Subject: [PATCH 6/6] Simplify highlighting assertions >> >> * test/lisp/dired-aux-tests.el (dired-test--check-highlighting): >> New function. >> (dired-test-highlight-metachar): Use it. > > Will this simplification hinder debugging of test failures? I don't > have an opinion on the proposed change, it's just something to consider. Mmm. Since the assertion that fails is now nested in a more generic function, the report shown in the ERT-Results buffer might be somewhat less informative; one has to bring up the backtrace to understand the context. I could try my hand at an ERT explainer for these assertions. Or we could just drop the 6th patch=E2=80=A6 I do find the tests easier to read = and write with it though. PS: Looking at this made me realize that patch #5 was borked (missed a parenthesis in dired-test-highlight-metachar, so the tests just plain wouldn't run). Here is the patch series with patches #5 and #6 fixed. The squashed patch[1] remains the same. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Preserve-text-properties-in-y-or-n-p-prompts.patch >From f8f22404a6e0a46cd27149491df781d8c2c4cea8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Fri, 7 Jun 2019 17:03:59 +0200 Subject: [PATCH 1/6] Preserve text properties in y-or-n-p prompts * lisp/subr.el (read--propertize-prompt): New function to append the prompt face to a string. (y-or-n-p): Use it instead of discarding potential text properties. (Bug#35564) --- lisp/subr.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index eea4e045dd..0766530239 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2343,6 +2343,9 @@ memory-limit ;;;; Input and display facilities. +(defun read--propertize-prompt (prompt) + (add-face-text-property 0 (length prompt) 'minibuffer-prompt t prompt)) + (defconst read-key-empty-map (make-sparse-keymap)) (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. @@ -2680,14 +2683,14 @@ y-or-n-p (let* ((scroll-actions '(recenter scroll-up scroll-down scroll-other-window scroll-other-window-down)) (key - (let ((cursor-in-echo-area t)) + (let ((cursor-in-echo-area t) + (prompt (if (memq answer scroll-actions) + prompt + (concat "Please answer y or n. " prompt)))) (when minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) - (read-key (propertize (if (memq answer scroll-actions) - prompt - (concat "Please answer y or n. " - prompt)) - 'face 'minibuffer-prompt))))) + (read--propertize-prompt prompt) + (read-key prompt)))) (setq answer (lookup-key query-replace-map (vector key) t)) (cond ((memq answer '(skip act)) nil) -- 2.20.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Tweak-dired-warning-about-wildcard-characters.patch >From 047a2d355cbd167d93a1bbd25de64e2fb16fd815 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 2/6] 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 30a941c7bb..1e1ebf7552 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.20.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0003-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch >From 83497dc721d098ba089589ec2a5987a3b986c807 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 27 Jun 2019 19:15:56 -0400 Subject: [PATCH 3/6] 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 1e1ebf7552..ca5b8cf801 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 occurence of `%s' as-is to shell?" + "Send %d occurences 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..3f4bfffaf6 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 + 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.20.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0004-fixup-Dedup-dired-aux-isolated-char-searching-Bug-35.patch >From 612e77f1cd0163c383a20b4401bfcf5e299b0aa6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Wed, 3 Jul 2019 21:29:38 +0200 Subject: [PATCH 4/6] fixup! Dedup dired-aux isolated char searching (Bug#35564) --- lisp/dired-aux.el | 4 ++-- test/lisp/dired-aux-tests.el | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index ca5b8cf801..b15a9426dc 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -108,8 +108,8 @@ dired--no-subst-prompt (add-face-text-property pos (1+ pos) 'warning nil command)) (concat command "\n" (format-message - (ngettext "Send %d occurence of `%s' as-is to shell?" - "Send %d occurences of `%s' as-is to shell?" + (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))) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 3f4bfffaf6..ff18edddb6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -118,8 +118,8 @@ dired-test-highlight-metachar "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") (prompt (dired--no-subst-prompt - command - (dired--need-confirm-positions command "?"))) + (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)) @@ -130,8 +130,8 @@ dired-test-highlight-metachar ;; 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 "*"))) + (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)) -- 2.20.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0005-Add-markers-below-non-isolated-chars-in-dired-prompt.patch >From 9ba62e66fcdbba8305821acf690f263e9ccf10a9 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 5/6] 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 b15a9426dc..3887d75356 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.20.1 --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0006-Simplify-highlighting-assertions.patch >From c5729141cda2131a4c72f268bfacf36b6ebca47c 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 6/6] 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.20.1 --=-=-= Content-Type: text/plain Thank you for your review. [1] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28969#19 --=-=-=--