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#28969: 27.0.50; dired: Confirmation prompt for wildcard not surrounded by whitespace Date: Mon, 15 Jul 2019 21:19:05 +0200 Message-ID: <87blxvp0ly.fsf@gmail.com> References: <87she833e1.fsf@web.de> <877e8kwbsn.fsf@mouse.gnus.org> <87o91wgjxj.fsf@web.de> 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="12982"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: Lars Ingebrigtsen , 28969@debbugs.gnu.org, Noam Postavsky To: Michael Heerdegen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Mon Jul 15 21:20:11 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 1hn6WA-0003Eu-T0 for geb-bug-gnu-emacs@m.gmane.org; Mon, 15 Jul 2019 21:20:11 +0200 Original-Received: from localhost ([::1]:42174 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hn6W9-00041e-7B for geb-bug-gnu-emacs@m.gmane.org; Mon, 15 Jul 2019 15:20:09 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:41773) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hn6W5-00041T-00 for bug-gnu-emacs@gnu.org; Mon, 15 Jul 2019 15:20:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hn6W2-0006m2-Tk for bug-gnu-emacs@gnu.org; Mon, 15 Jul 2019 15:20:04 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:40319) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hn6W2-0006lv-Ml for bug-gnu-emacs@gnu.org; Mon, 15 Jul 2019 15:20:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hn6W2-0005Cp-A4 for bug-gnu-emacs@gnu.org; Mon, 15 Jul 2019 15:20: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: Mon, 15 Jul 2019 19:20:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 28969 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 28969-submit@debbugs.gnu.org id=B28969.156321836119914 (code B ref 28969); Mon, 15 Jul 2019 19:20:02 +0000 Original-Received: (at 28969) by debbugs.gnu.org; 15 Jul 2019 19:19:21 +0000 Original-Received: from localhost ([127.0.0.1]:49139 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hn6VM-0005B7-C1 for submit@debbugs.gnu.org; Mon, 15 Jul 2019 15:19:20 -0400 Original-Received: from mail-wr1-f49.google.com ([209.85.221.49]:33291) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hn6VK-0005Ar-4i for 28969@debbugs.gnu.org; Mon, 15 Jul 2019 15:19:18 -0400 Original-Received: by mail-wr1-f49.google.com with SMTP id n9so18365222wru.0 for <28969@debbugs.gnu.org>; Mon, 15 Jul 2019 12:19:18 -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=69mGZ4EpGfYlGtW8FMMOof/VW6Xd+xOKI+GYh4m1Egc=; b=UMsRQiyXpach8Oo2gIayncSQZaA8gHRK9hvaXEHUDX1Ah1HjLRr2ZHqvVZxdRH+W7+ Z93C1VQ+c6dxf/S+L88WLfRCJLtZjc0biaRTvwR0Bx90kSCBlDZYXHRPyUY0KHJAiQCI IctaKRpZDbLSyNJpexZofWMgTGdz9DMdn482S5RAU3cM5Ow++J+t9aeRf7+UuKgwVOXu 6Y0dHW75Oh0c7sDwhGDy/Ii/UF5QbFLsNTzG/0ibxqsABSSoAh4RElm98g4wXnQXV9kE QUhCqRoZ6NRtmXdmFAwpNnIRqij49D7oQ3pBcxt8uMAX3f67vRpdWyKMZzf6SaYXC0KG /gGQ== 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=69mGZ4EpGfYlGtW8FMMOof/VW6Xd+xOKI+GYh4m1Egc=; b=PUsTGj2XtiBg6GMfZqR7MvdVM3Y7ZAwXlaZFsC/MHqObqIXl+QmhdbODjO19Gge1BO BQKsQCC/kUPqptFnyulk4S/aj/Gt9casSy04QPZC3VSvi/Hv5SYjMW3S38QEy6mleg/P QrnxjeZwmA0Iu57wYSkeqtTmv0W42/Shhx+C1C/7XGt5/CdMevFb8t+CqNCjrFnOnW2h MPy+XSPZQNZhgwij2asm53WGa6iA0e35fvpqboURV3dfJwT/HC9ia7eUyxvMvjVh+tOz +86eOSH94wK0TxU6bLo1cBhCMqly/+Fj8wKvRjDwnuVXc45zAs6++7cSMHFicivXxKq4 Gq8Q== X-Gm-Message-State: APjAAAWCb4CneILuMa1FFM57GZ4GVf/iiBbMooRyHYQJTN1tLGnDwA72 qEQ52tLmPZJ8CLracMiA5YA= X-Google-Smtp-Source: APXvYqxC+SBgacGZEIGbZtxULbfxwiF8bAQlROwOCKyZGGrHAWkryNER6T/PLm4JPdEUyhSLkvJoww== X-Received: by 2002:a5d:6408:: with SMTP id z8mr15785205wru.246.1563218352310; Mon, 15 Jul 2019 12:19:12 -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 f70sm19895404wme.22.2019.07.15.12.19.07 (version=TLS1_3 cipher=AEAD-AES256-GCM-SHA384 bits=256/256); Mon, 15 Jul 2019 12:19:09 -0700 (PDT) In-Reply-To: <87o91wgjxj.fsf@web.de> (Michael Heerdegen's message of "Mon, 15 Jul 2019 03:34:16 +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:163162 Archived-At: --=-=-= Content-Type: text/plain Michael Heerdegen writes: > In my example (in my > initial report), also the shell did not interpret it as wildcard, but I > had to say "y" to get it executed. This is very confusing. It would be > better to ask "confirm - pass literal `*' to the shell?" or so. Yup, that's what I set out to do in bug#35564. Here is the patch series, condensed into a single patch for convenience. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Tweak-dired-warning-about-wildcard-characters.patch >From 593096b329a65466c075599697fdaccd64b3ada4 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] 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/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. * 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--no-subst-prompt): New functions. (dired-do-shell-command): Use them to display the command and highlight the non-isolated chars. Underline these chars with '^' markers if the minibuffer window is wide enough to show the command without line-wrapping it. * test/lisp/dired-aux-tests.el (dired-test--check-highlighting): New tests. Co-authored-by: Noam Postavsky (bug#28969, bug#35564) --- lisp/dired-aux.el | 100 ++++++++++++++++++++++++++--------- lisp/subr.el | 15 +++--- test/lisp/dired-aux-tests.el | 46 ++++++++++++++++ 3 files changed, 129 insertions(+), 32 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 6a1ebcced9..cc3903ab15 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,24 +60,77 @@ 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--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)) + ;; `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) @@ -745,28 +798,23 @@ 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) + (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")) - ((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 "*")) + (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 + short-enough))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -777,7 +825,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/lisp/subr.el b/lisp/subr.el index 4a1649f601..c59f13b24c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2338,6 +2338,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. @@ -2675,14 +2678,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) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index ccd3192792..ba10c54332 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,52 @@ 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 " ^ ^") + (prompt (dired--no-subst-prompt + (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))) + ;; 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 + 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))) + (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)) + (dired-test--check-highlighting highlit-command '(8)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.22.0 --=-=-= Content-Type: text/plain It is a bit more involved than a simple rewording, mainly because I could not find a concise sentence that sounded 100%-unambiguous (e.g. "literal" might be taken to mean "suitably backslash-escaped or quoted"). > BTW, I had several use cases where * or ?, don't remember, was not > isolated, and I wanted to answer "n" to still get the substitution by > the command and was disappointed that Emacs just canceled. Maybe one of > the suggested patches also improves that, I haven't checked yet. Allowing the user to substitute non-isolated characters is something Drew also suggested in bug#35564. I haven't tackled that yet (haven't met the use-case). What would a good UI look like? Successive prompting for each non-isolated character? Something like: > Substitute highlighted occurrence of `?'? ([y]es, [n]o, [a]bort) Although note that you can already tell Dired that your '?' is meant to be substituted, by surrounding it with backquotes. E.g. try to mark some files, then ! echo 'foo`?`bar' It's not implemented for '*' though. --=-=-=--