unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#27496: 26.0.50; dired-do-shell-command just checks the first wildcard
@ 2017-06-26 10:45 Tino Calancha
  2017-07-02 13:13 ` Tino Calancha
  0 siblings, 1 reply; 2+ messages in thread
From: Tino Calancha @ 2017-06-26 10:45 UTC (permalink / raw)
  To: 27496

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





^ permalink raw reply related	[flat|nested] 2+ messages in thread

* bug#27496: 26.0.50; dired-do-shell-command just checks the first wildcard
  2017-06-26 10:45 bug#27496: 26.0.50; dired-do-shell-command just checks the first wildcard Tino Calancha
@ 2017-07-02 13:13 ` Tino Calancha
  0 siblings, 0 replies; 2+ messages in thread
From: Tino Calancha @ 2017-07-02 13:13 UTC (permalink / raw)
  To: 27496-done

Tino Calancha <tino.calancha@gmail.com> writes:

> 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 "./?".
Fixed in master branch as commit
6e39940adba7b96dfe520caa52a1b92a1a84a84f





^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2017-07-02 13:13 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-06-26 10:45 bug#27496: 26.0.50; dired-do-shell-command just checks the first wildcard Tino Calancha
2017-07-02 13:13 ` Tino Calancha

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).