bug#30285: dired-do-chmod vs. top line of dired

[Tino Calancha <tino.calancha@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 16578 bytes --]



On Wed, 31 Jan 2018, Juri Linkov wrote:

>>> I propose to add a new predicate
>>> `dired-marked-files-or-file-at-point-p', and used it in all those
>>> commands.
>>
>> Please don't do any such thing.
>>
>> Yes, it makes sense for such commands to do nothing or to show an
>> error message when on the "top line of dired", as described in the
>> bug report.
>
> Instead of doing nothing or showing an error message, how about
> doing a more useful thing: when on the top line, ‘dired-do-chmod’
> could do chmod on all files in the dir.
>
> This is exactly what other Dired commands already do: e.g. typing ‘m’
> on the top line or on any other subdir headerline, they perform
> their actions on all files.
>
> For example, see the docstring of ‘dired-mark’:
>
>  “If on a subdir headerline, mark all its files except `.' and `..'.”
Yeah, that's another possibility (not my preference).

IMO marking commands are at at different level than commands that operate
on marked files; we don't need to mimic such feature of the `dired-mark'. 
Indeed, if the user want to operate on all files, she can easily do 
`dired-mark' followed by the command in question;  I tend to think calling 
`dired-do...' things without marked files from the top line as an user mistake.

I would like all `dired-do...' commands behave the same under the
'X condition':
* called from the top line
** no marked files.


>> No, we don't need a function `dired-marked-files-or-file-at-point-p',
>> for that or anything else.  The `dired-do-*' commands already DTRT
>> wrt the marked-files-or-file-at-point.
>
> I agree that it's better to check the ‘files’ returned from
> ‘dired-get-marked-files’.

Today I took a deeper look in the train and I saw there are several more
commands that don't protect against X.  Some even breaks
(e.g., dired-do-shell-command, dired-do-async-shell-command).

Below patch introduce a macro to systematically handle the 'X condition',
what do you think?

--8<-----------------------------cut here---------------start------------->8---
commit 193ba8fe6225093a0fc96e4bea7eec21a1643d4b
Author: tino calancha <tino.calancha@gmail.com>
Date:   Thu Feb 1 10:32:30 2018 +0900

     dired-do-chmod: Avoid unecessary prompt

     Prompt user only if there are any marked files or a
     file at point (Bug#30285).
     * lisp/dired.el (dired-marked-files-or-file-at-point-p): New defun.
     (dired-with-dired-do): New macro.

     * lisp/dired-aux.el (dired-do-chmod)
     (dired-do-chmod, dired-do-chgrp, dired-do-chown)
     (dired-do-touch, dired-do-print, dired-do-async-shell-command)
     (dired-do-shell-command, dired-query, dired-byte-compile)
     (dired-load, dired-do-copy, dired-do-symlink, dired-do-hardlink)
     (dired-do-rename, dired-isearch-filenames-regexp, dired-do-find-regexp)
     (dired-do-find-regexp-and-replace)
     * lisp/dired-x.el (dired-do-relsymlink, dired-do-find-marked-files):
     Use it.

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 55b68a372e..f5f3311ead 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -361,40 +361,41 @@ dired-do-chmod
  Type M-n to pull the file attributes of the file at point
  into the minibuffer."
    (interactive "P")
-  (let* ((files (dired-get-marked-files t arg))
-	 ;; The source of default file attributes is the file at point.
-	 (default-file (dired-get-filename t t))
-	 (modestr (when default-file
-		    (nth 8 (file-attributes default-file))))
-	 (default
-	   (and (stringp modestr)
-		(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
-		(replace-regexp-in-string
-		 "-" ""
-		 (format "u=%s,g=%s,o=%s"
-			 (match-string 1 modestr)
-			 (match-string 2 modestr)
-			 (match-string 3 modestr)))))
-	 (modes (dired-mark-read-string
-		 "Change mode of %s to: "
-		 nil 'chmod arg files default))
-	 num-modes)
-    (cond ((or (equal modes "")
-	       ;; Use `eq' instead of `equal'
-	       ;; to detect empty input (bug#12399).
-	       (eq modes default))
-	   ;; We used to treat empty input as DEFAULT, but that is not
-	   ;; such a good idea (Bug#9361).
-	   (error "No file mode specified"))
-	  ((string-match-p "^[0-7]+" modes)
-	   (setq num-modes (string-to-number modes 8))))
-
-    (dolist (file files)
-      (set-file-modes
-       file
-       (if num-modes num-modes
-	 (file-modes-symbolic-to-number modes (file-modes file)))))
-    (dired-do-redisplay arg)))
+  (dired-with-dired-do
+    (let* ((files (dired-get-marked-files t arg))
+	   ;; The source of default file attributes is the file at point.
+	   (default-file (dired-get-filename t t))
+	   (modestr (when default-file
+		      (nth 8 (file-attributes default-file))))
+	   (default
+	     (and (stringp modestr)
+		  (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
+		  (replace-regexp-in-string
+		   "-" ""
+		   (format "u=%s,g=%s,o=%s"
+			   (match-string 1 modestr)
+			   (match-string 2 modestr)
+			   (match-string 3 modestr)))))
+	   (modes (dired-mark-read-string
+		   "Change mode of %s to: "
+		   nil 'chmod arg files default))
+	   num-modes)
+      (cond ((or (equal modes "")
+	         ;; Use `eq' instead of `equal'
+	         ;; to detect empty input (bug#12399).
+	         (eq modes default))
+	     ;; We used to treat empty input as DEFAULT, but that is not
+	     ;; such a good idea (Bug#9361).
+	     (error "No file mode specified"))
+	    ((string-match-p "^[0-7]+" modes)
+	     (setq num-modes (string-to-number modes 8))))
+
+      (dolist (file files)
+        (set-file-modes
+         file
+         (if num-modes num-modes
+	   (file-modes-symbolic-to-number modes (file-modes file)))))
+      (dired-do-redisplay arg))))

  ;;;###autoload
  (defun dired-do-chgrp (&optional arg)
@@ -404,7 +405,8 @@ dired-do-chgrp
    (interactive "P")
    (if (memq system-type '(ms-dos windows-nt))
        (error "chgrp not supported on this system"))
-  (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
+  (dired-with-dired-do
+    (dired-do-chxxx "Group" "chgrp" 'chgrp arg)))

  ;;;###autoload
  (defun dired-do-chown (&optional arg)
@@ -414,7 +416,8 @@ dired-do-chown
    (interactive "P")
    (if (memq system-type '(ms-dos windows-nt))
        (error "chown not supported on this system"))
-  (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
+  (dired-with-dired-do
+    (dired-do-chxxx "Owner" dired-chown-program 'chown arg)))

  ;;;###autoload
  (defun dired-do-touch (&optional arg)
@@ -423,7 +426,8 @@ dired-do-touch
  Type M-n to pull the file attributes of the file at point
  into the minibuffer."
    (interactive "P")
-  (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
+  (dired-with-dired-do
+    (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg)))

  ;; Process all the files in FILES in batches of a convenient size,
  ;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...).
@@ -476,23 +480,24 @@ dired-do-print
  `lpr-switches' as default."
    (interactive "P")
    (require 'lpr)
-  (let* ((file-list (dired-get-marked-files t arg))
-	 (lpr-switches
-	  (if (and (stringp printer-name)
-		   (string< "" printer-name))
-	      (cons (concat lpr-printer-switch printer-name)
-		    lpr-switches)
-	    lpr-switches))
-	 (command (dired-mark-read-string
-		   "Print %s with: "
- 		   (mapconcat 'identity
-			      (cons lpr-command
-				    (if (stringp lpr-switches)
-					(list lpr-switches)
-				      lpr-switches))
-			      " ")
-		   'print arg file-list)))
-    (dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
+  (dired-with-dired-do
+    (let* ((file-list (dired-get-marked-files t arg))
+	   (lpr-switches
+	    (if (and (stringp printer-name)
+		     (string< "" printer-name))
+	        (cons (concat lpr-printer-switch printer-name)
+		      lpr-switches)
+	      lpr-switches))
+	   (command (dired-mark-read-string
+		     "Print %s with: "
+		     (mapconcat 'identity
+			        (cons lpr-command
+				      (if (stringp lpr-switches)
+					  (list lpr-switches)
+				        lpr-switches))
+			        " ")
+		     'print arg file-list)))
+      (dired-run-shell-command (dired-shell-stuff-it command file-list nil)))))

  (defun dired-mark-read-string (prompt initial op-symbol arg files
  			       &optional default-value collection)
@@ -666,7 +671,7 @@ dired-do-async-shell-command

  The output appears in the buffer `*Async Shell Command*'."
    (interactive
-   (let ((files (dired-get-marked-files t current-prefix-arg)))
+   (dired-with-dired-do
       (list
        ;; Want to give feedback whether this file or marked files are used:
        (dired-read-shell-command "& on %s: " current-prefix-arg files)
@@ -727,7 +732,7 @@ dired-do-shell-command
  ;;Functions dired-run-shell-command and dired-shell-stuff-it do the
  ;;actual work and can be redefined for customization.
    (interactive
-   (let ((files (dired-get-marked-files t current-prefix-arg)))
+   (dired-with-dired-do
       (list
        ;; Want to give feedback whether this file or marked files are used:
        (dired-read-shell-command "! on %s: " current-prefix-arg files)
@@ -1224,7 +1229,8 @@ dired-query
  (defun dired-do-compress (&optional arg)
    "Compress or uncompress marked (or next ARG) files."
    (interactive "P")
-  (dired-map-over-marks-check #'dired-compress arg 'compress t))
+  (dired-with-dired-do
+    (dired-map-over-marks-check #'dired-compress arg 'compress t)))

  ;; Commands for Emacs Lisp files - load and byte compile

@@ -1252,7 +1258,8 @@ dired-byte-compile
  (defun dired-do-byte-compile (&optional arg)
    "Byte compile marked (or next ARG) Emacs Lisp files."
    (interactive "P")
-  (dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile t))
+  (dired-with-dired-do
+    (dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile t)))

  (defun dired-load ()
    ;; Return nil for success, offending file name else.
@@ -1269,7 +1276,8 @@ dired-load
  (defun dired-do-load (&optional arg)
    "Load the marked (or next ARG) Emacs Lisp files."
    (interactive "P")
-  (dired-map-over-marks-check #'dired-load arg 'load t))
+  (dired-with-dired-do
+    (dired-map-over-marks-check #'dired-load arg 'load t)))

  ;;;###autoload
  (defun dired-do-redisplay (&optional arg test-for-subdir)
@@ -2042,11 +2050,12 @@ dired-do-copy
  This command copies symbolic links by creating new ones, similar
  to the \"-d\" option for the \"cp\" shell command."
    (interactive "P")
-  (let ((dired-recursive-copies dired-recursive-copies))
-    (dired-do-create-files 'copy #'dired-copy-file
-			   "Copy"
-			   arg dired-keep-marker-copy
-			   nil dired-copy-how-to-fn)))
+  (dired-with-dired-do
+    (let ((dired-recursive-copies dired-recursive-copies))
+      (dired-do-create-files 'copy #'dired-copy-file
+			     "Copy"
+			     arg dired-keep-marker-copy
+			     nil dired-copy-how-to-fn))))

  ;;;###autoload
  (defun dired-do-symlink (&optional arg)
@@ -2060,8 +2069,9 @@ dired-do-symlink

  For relative symlinks, use \\[dired-do-relsymlink]."
    (interactive "P")
-  (dired-do-create-files 'symlink #'make-symbolic-link
-			   "Symlink" arg dired-keep-marker-symlink))
+  (dired-with-dired-do
+    (dired-do-create-files 'symlink #'make-symbolic-link
+			   "Symlink" arg dired-keep-marker-symlink)))

  ;;;###autoload
  (defun dired-do-hardlink (&optional arg)
@@ -2073,8 +2083,9 @@ dired-do-hardlink
  suggested for the target directory depends on the value of
  `dired-dwim-target', which see."
    (interactive "P")
-  (dired-do-create-files 'hardlink #'dired-hardlink
-			   "Hardlink" arg dired-keep-marker-hardlink))
+  (dired-with-dired-do
+    (dired-do-create-files 'hardlink #'dired-hardlink
+			   "Hardlink" arg dired-keep-marker-hardlink)))

  (defun dired-hardlink (file newname &optional ok-if-already-exists)
    (dired-handle-overwrite newname)
@@ -2092,8 +2103,9 @@ dired-do-rename
  The default suggested for the target directory depends on the value
  of `dired-dwim-target', which see."
    (interactive "P")
-  (dired-do-create-files 'move #'dired-rename-file
-			 "Move" arg dired-keep-marker-rename "Rename"))
+  (dired-with-dired-do
+    (dired-do-create-files 'move #'dired-rename-file
+			   "Move" arg dired-keep-marker-rename "Rename")))
  ;;;###end dired-cp.el

  ;;; 5K
@@ -2798,15 +2810,17 @@ dired-isearch-filenames-regexp
  (defun dired-do-isearch ()
    "Search for a string through all marked files using Isearch."
    (interactive)
-  (multi-isearch-files
-   (dired-get-marked-files nil nil 'dired-nondirectory-p)))
+  (dired-with-dired-do
+    (multi-isearch-files
+     (dired-get-marked-files nil nil 'dired-nondirectory-p))))

  ;;;###autoload
  (defun dired-do-isearch-regexp ()
    "Search for a regexp through all marked files using Isearch."
    (interactive)
-  (multi-isearch-files-regexp
-   (dired-get-marked-files nil nil 'dired-nondirectory-p)))
+  (dired-with-dired-do
+    (multi-isearch-files-regexp
+     (dired-get-marked-files nil nil 'dired-nondirectory-p))))

  ;;;###autoload
  (defun dired-do-search (regexp)
@@ -2847,7 +2861,9 @@ dired-do-find-regexp
  directories.

  REGEXP should use constructs supported by your local `grep' command."
-  (interactive "sSearch marked files (regexp): ")
+  ;; (interactive "sSearch marked files (regexp): ")
+  (interactive
+   (dired-with-dired-do (list (read-string "Search marked files (regexp): "))))
    (require 'grep)
    (defvar grep-find-ignored-files)
    (defvar grep-find-ignored-directories)
@@ -2877,8 +2893,9 @@ dired-do-find-regexp-and-replace
  REGEXP should use constructs supported by your local `grep' command."
    (interactive
     (let ((common
-          (query-replace-read-args
-           "Query replace regexp in marked files" t t)))
+          (dired-with-dired-do
+            (query-replace-read-args
+             "Query replace regexp in marked files" t t))))
       (list (nth 0 common) (nth 1 common))))
    (with-current-buffer (dired-do-find-regexp from)
      (xref-query-replace-in-results from to)))
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index a90f1f4adc..f9aacc97b3 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1282,8 +1282,9 @@ dired-do-relsymlink

  For absolute symlinks, use \\[dired-do-symlink]."
    (interactive "P")
-  (dired-do-create-files 'relsymlink #'dired-make-relative-symlink
-                           "RelSymLink" arg dired-keep-marker-relsymlink))
+  (dired-with-dired-do
+    (dired-do-create-files 'relsymlink #'dired-make-relative-symlink
+                           "RelSymLink" arg dired-keep-marker-relsymlink)))

  (autoload 'dired-mark-read-regexp "dired-aux")
  (autoload 'dired-do-create-files-regexp "dired-aux")
@@ -1335,7 +1336,8 @@ dired-do-find-marked-files
  To keep Dired buffer displayed, type \\[split-window-below] first.
  To display just marked files, type \\[delete-other-windows] first."
    (interactive "P")
-  (dired-simultaneous-find-file (dired-get-marked-files) noselect))
+  (dired-with-dired-do
+    (dired-simultaneous-find-file (dired-get-marked-files) noselect)))

  (defun dired-simultaneous-find-file (file-list noselect)
    "Visit all files in FILE-LIST and display them simultaneously.
diff --git a/lisp/dired.el b/lisp/dired.el
index eade11bc7f..649214612b 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2385,6 +2385,22 @@ dired-get-filename
       (t
        (concat (dired-current-directory localp) file)))))

+(defun dired-marked-files-or-file-at-point-p ()
+  "Return non-nil if there are marked files or a file at point."
+  (and (or (cdr (dired-get-marked-files nil nil nil 'distinguish-1-marked))
+           (dired-get-filename nil 'no-error)) t))
+
+;; Use this macro on `dired-do-' commands that accept as
+;; input the marked file or the file at point.
+(defmacro dired-with-dired-do (&rest body)
+  "Run BODY if there are marked files or a file at point.
+Signal an error if there is neither marked files nor a file at point.
+Return value of the last evaluated form in BODY."
+  (declare (debug (&body)) (indent 0))
+  `(if (null (dired-marked-files-or-file-at-point-p))
+       (user-error "No file on this line")
+     ,@body))
+
  (defun dired-string-replace-match (regexp string newtext
                                     &optional literal global)
    "Replace first match of REGEXP in STRING with NEWTEXT.
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 27.0.50 (build 17, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
  of 2018-01-30 built on calancha-pc
Repository revision: 29abae3572090a86beedb66822ccf34356c8a00c