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: Sat, 29 Jun 2019 09:48:25 -0400 Message-ID: <87pnmw5wpi.fsf@gmail.com> References: <87zho2cd4f.fsf@gmail.com> <87wohvf22u.fsf@gmail.com> <87h88cvpkj.fsf_-_@gmail.com> <87a7e27gh5.fsf@gmail.com> <8736jujkvj.fsf@gmail.com> <32acf7a4-70d2-4c33-a3f5-18b082903d4a@default> <87ef3dvbgq.fsf@gmail.com> <581e7cf3-a99f-415d-a999-3b2f3f419c8f@default> 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="150864"; 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 , =?UTF-8?Q?K=C3=A9vin?= Le Gouguec To: Drew Adams Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Jun 29 15:49:20 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 1hhDjC-000cyr-Jj for geb-bug-gnu-emacs@m.gmane.org; Sat, 29 Jun 2019 15:49:18 +0200 Original-Received: from localhost ([::1]:39752 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hhDjB-0005p3-Ii for geb-bug-gnu-emacs@m.gmane.org; Sat, 29 Jun 2019 09:49:17 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:49546) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hhDj1-0005nX-IK for bug-gnu-emacs@gnu.org; Sat, 29 Jun 2019 09:49:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hhDix-0001oZ-Ut for bug-gnu-emacs@gnu.org; Sat, 29 Jun 2019 09:49:06 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:58318) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hhDiw-0001j7-7E for bug-gnu-emacs@gnu.org; Sat, 29 Jun 2019 09:49:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hhDiw-000851-3G for bug-gnu-emacs@gnu.org; Sat, 29 Jun 2019 09:49: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: Sat, 29 Jun 2019 13:49: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.156181612131033 (code B ref 35564); Sat, 29 Jun 2019 13:49:02 +0000 Original-Received: (at 35564) by debbugs.gnu.org; 29 Jun 2019 13:48:41 +0000 Original-Received: from localhost ([127.0.0.1]:43629 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hhDia-00084S-Hh for submit@debbugs.gnu.org; Sat, 29 Jun 2019 09:48:41 -0400 Original-Received: from mail-io1-f47.google.com ([209.85.166.47]:34379) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hhDiU-00084B-OJ for 35564@debbugs.gnu.org; Sat, 29 Jun 2019 09:48:38 -0400 Original-Received: by mail-io1-f47.google.com with SMTP id k8so18706870iot.1 for <35564@debbugs.gnu.org>; Sat, 29 Jun 2019 06:48:34 -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=VfZ+cNCpQ0nF+16vSpu/Aw0nhC2BGBqKPU0aLv6AoBM=; b=T4AeQn51ATcGp6rU77cqY5fqGsZ6acvf1jqOtP+EhrO67txmc7qAyRQQ4IdXRloHsw YfCsi2oyR7R85EHUzGzB8Av5Ie83B8wqNbe0PWlL+LGgXO5+xootkuy7kL7NQ2OAlzox 6Kg/sb8AU/aOxRAupanN5wK7s4KtKHH5pJ2TJ9kXSaeUM49U/yMIOmCgqaFN8tJBoeSM kBb0PbkF2xbf0ppK0XoikkRvEAM2jc61k5xnlAvlpCj0gwQ5++565uzz8DcUmKhq6euX nTtLmqovbHH1gNAUJXw2vzzaGKGsuIC9WG1lYGqIGyaaXgJBT0yZvTx0NEa+9ML0iN9u 1h6w== 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=VfZ+cNCpQ0nF+16vSpu/Aw0nhC2BGBqKPU0aLv6AoBM=; b=kOYhgXU7GbcEr0TO8WpPEu3IKRJx5bGXLoLajX4HTJXpIaezfzUAvTQ45CR9VjXX3H EN+IM3aJUVSZ/7FTsV7FiLcVOYJgdN2JTzANrGNKj+sqWC5lik9ZzWUDpxKsoxzZNsjO cMP9x8Slx1BDXri1ffVPJ5X+Unz8ygQ9Xfog7bcEY3GcOwFVk4IS7bmcI2VnCV0C2BKe +225/n7k/6K/hde6hjBGQ9z2An1+VkC3+sgtqaVlse9/mkNm3w+6QL+pNkAgEqS1gGuA P40ghsMqDRrtst3j9lBHzRN/Dl1bIgIJp92izvS3bGiI/+D68rVOUCxz/iPpNq/6Q1eh hD7Q== X-Gm-Message-State: APjAAAVLDHv7GYGQkZs+bFN/xAzRd9unaOo9kr7AlniaI64Uu8+7ZuTo tgLjNDC2aEk0HLEtGLrabBk= X-Google-Smtp-Source: APXvYqyj7Xa+04GWUM24AEKMYTMC0eTLwhFT23QAcLuqvYG37WClvhW6syDeFVVSBnsUvtlxX+WRUw== X-Received: by 2002:a02:3c07:: with SMTP id m7mr18663047jaa.64.1561816107052; Sat, 29 Jun 2019 06:48:27 -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 v13sm4364465ioq.13.2019.06.29.06.48.26 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sat, 29 Jun 2019 06:48:26 -0700 (PDT) In-Reply-To: <581e7cf3-a99f-415d-a999-3b2f3f419c8f@default> (Drew Adams's message of "Fri, 28 Jun 2019 11:43:55 -0700 (PDT)") 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:161831 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Drew Adams writes: >> > A final comment, which I'm not sure is relevant: >> > >> > We should not, in any case, _rely_ on any >> > highlighting to get across meaning (semantics). >> > Highlighting should always be an extra - a >> > nice-to-have. Some users will not see the >> > highlighting - it cannot be the only thing that >> > gets the intended meaning across. >> With the current patches, we absolutely totally completely _would_ rely >> on highlighting to get across semantics. Thank you for spelling it out >> as an accessibility problem; that kind of confirms my nagging feeling >> that the highlighting method has an unfavorable benefit/cost ratio (IOW, >> it's cute, but it might make things worse for some users). > There is likely another way to make those occurrences > stand out (in addition to, not instead of, highlighting). > But I'm no expert on that. Maybe Eli has a suggestion. > > Emacs doesn't jump through zillions of hoops to try > maximize accessibility. But it's good to keep it in > mind and, at least when other things are equal, to DTRT > in this regard. Yes, we should definitely be careful not to make accessibility worse; thank you for bringing this up Drew. >> 1. find a simple rephrasing, >>=20 >> > Confirm--do you mean to send `*' verbatim to the shell? >> (I don't like this one because it sounds like "do you want us to quote >> `*' to make sure the shell does not expand it?") >> 2. keep trying to make a more elaborate prompt, only using some other >> tricks to point out the characters. >>=20 >> > Confirm--do you mean to send these characters as-is to the shell? >> > sed -e 's/foo?/foo!/' -e 's/bar?/bar!' >> > ^ ^ >>=20 >> (I.e. using '^' to denote the non-isolated characters; not sure how >> clear it is that "these" refers to "the caracters underlined by a '^'") I don't know about the '^' trick, if the minibuffer window is narrow enough to cause line wrapping the result won't be very readable. And I doubt a screen reader would handle this kind of thing any better than highlighting (someone please correct me if I'm wrong about that). I like the use of "as-is to shell": short and clear. > Again: drop "Confirm--do you mean to", and use > "these occurrences of `?'", not "these > characters". There is only one char, in perhaps > multiple locations. > > And I do think the char (`?' or whatever) should > be mentioned explicitly in the question, not just > have its occurrences indicated in the command to > be sent. Agreed on both these points. Updated patch is below, it produces prompts like these (still using highlighting): echo foo* Send 1 occurence of =E2=80=98*=E2=80=99 as-is to shell? (y or n) echo foo* bar* * Send 2 occurences of =E2=80=98*=E2=80=99 as-is to shell? (y or n) The last case (where there are both as-is and substituted "*") isn't so great without highlighting (you have to count the "*"s and work out if something unexpected is happening), but I think it's at least not worse than the current situation. --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=0003-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch Content-Description: patch >From e339ad7d83025764645ed9101769467139390432 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 (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 079e4f102f..47e1d38223 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) @@ -779,26 +779,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 @@ -809,7 +802,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.11.0 --=-=-=--