unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Tino Calancha <tino.calancha@gmail.com>
To: 27496@debbugs.gnu.org
Subject: bug#27496: 26.0.50; dired-do-shell-command just checks the first wildcard
Date: Mon, 26 Jun 2017 19:45:13 +0900	[thread overview]
Message-ID: <87fuen58p2.fsf@calancha-pc> (raw)

Severity: minor
Tags: patch

emacs -Q:
;; Evaluate following form.
(let ((foo (make-temp-file "foo" 'dir))
      (bar (make-temp-file "bar" 'dir)))
  (dired foo)
  (dired-up-directory)
  (revert-buffer)
  (dired-do-shell-command
   (format "cp -r ? %s/?" bar) nil (dired-get-marked-files t nil)))

;; Should ask confirmation because "/?".

If we change the last line to:
(format "cp -r ./? %s/?" bar) nil (dired-get-marked-files t nil)))
then it asks confirmation because "./?".


--8<-----------------------------cut here---------------start------------->8---
commit dd809606eefea96a034eb4fe8da237003321ffd3
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Mon Jun 26 19:16:57 2017 +0900

    Ask confirmation for all suspicious wildcards
    
    * lisp/dired-aux.el (dired-do-shell-command): Check that all
    the wildcards are right.  Otherwise, ask fo confirmation (Bug#27496).

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 121bebeb65..f257a454f9 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -704,31 +704,41 @@ dired-do-shell-command
       (dired-read-shell-command "! on %s: " current-prefix-arg files)
       current-prefix-arg
       files)))
-  (let* ((on-each (not (string-match-p dired-star-subst-regexp command)))
-	 (no-subst (not (string-match-p dired-quark-subst-regexp command)))
-	 (star (string-match-p "\\*" command))
-	 (qmark (string-match-p "\\?" command))
-         ;; 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"))
-	           ((and star on-each)
-	            (y-or-n-p (format-message
-			       "Confirm--do you mean to use `*' as a wildcard? ")))
-	           ((and qmark no-subst)
-	            (y-or-n-p (format-message
-			       "Confirm--do you mean to use `?' as a wildcard? ")))
-	           (t))))
-    (when ok
-      (if on-each
-	  (dired-bunch-files (- 10000 (length command))
-	                     (lambda (&rest files)
-	                       (dired-run-shell-command
-                                (dired-shell-stuff-it command files t arg)))
-	                     nil file-list)
-	;; execute the shell command
-	(dired-run-shell-command
-	 (dired-shell-stuff-it command file-list nil arg))))))
+  (cl-flet ((need-confirm-p
+             (cmd str)
+             (let ((res cmd)
+                   (str (regexp-quote str))
+                   (regexp (if (string= str "?")
+                               dired-quark-subst-regexp
+                             dired-star-subst-regexp)))
+               ;; Drop all ? and * surrounded by spaces.
+               (while (and (string-match-p str res)
+                           (string-match regexp res))
+                 (setq res (replace-match "" t t res 0)))
+               (string-match-p str res))))
+    (let* ((on-each (not (string-match-p dired-star-subst-regexp command)))
+	   (no-subst (not (string-match-p dired-quark-subst-regexp command)))
+           ;; 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))))
+      (when ok
+        (if on-each
+	    (dired-bunch-files (- 10000 (length command))
+	                       (lambda (&rest files)
+	                         (dired-run-shell-command
+                                  (dired-shell-stuff-it command files t arg)))
+	                       nil file-list)
+	  ;; execute the shell command
+	  (dired-run-shell-command
+	   (dired-shell-stuff-it command file-list nil arg)))))))
 
 ;; Might use {,} for bash or csh:
 (defvar dired-mark-prefix ""
--8<-----------------------------cut here---------------end--------------->8---

In GNU Emacs 26.0.50 (build 9, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2017-06-26 built
Repository revision: 1771d9b8082cf967e3f8b6a436d8766560be9e8d





             reply	other threads:[~2017-06-26 10:45 UTC|newest]

Thread overview: 2+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-06-26 10:45 Tino Calancha [this message]
2017-07-02 13:13 ` bug#27496: 26.0.50; dired-do-shell-command just checks the first wildcard Tino Calancha

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87fuen58p2.fsf@calancha-pc \
    --to=tino.calancha@gmail.com \
    --cc=27496@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).