unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Allen Li <darkfeline@felesatra.moe>
To: Juri Linkov <juri@linkov.net>
Cc: 46884@debbugs.gnu.org
Subject: bug#46884: [PATCH] 27.1; Cannot run find-dired with -maxdepth
Date: Sun, 14 Mar 2021 00:40:36 +0000	[thread overview]
Message-ID: <CADbSrJws3txfOi0XyxTPbmci5dgBZTauWit+_ucmxZuLQt9Y3w@mail.gmail.com> (raw)
In-Reply-To: <87v99u90vq.fsf@mail.linkov.net>

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

On Sat, Mar 13, 2021 at 9:53 PM Juri Linkov <juri@linkov.net> wrote:
>
> > Sorry, I attached the wrong patch, here's the one for the rgrep approach.
>
> Thanks, I tried it, but for some reason 'C-u C-u find-dired RET'
> doesn't work.  Maybe because it uses 'grep-find-command' that is nil?

First patch was to outline intent to Eli; I didn't test it which was
an oversight on my part.

Here's a second patch which I've tested by running once each for zero,
one, and two prefix args.
If the approach looks good, I will test more, cleanup, update the
NEWS, docs, etc.

>
> > +With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'.
> > ...
> > +    ((and grep-find-command (equal current-prefix-arg '(16)))

[-- Attachment #2: 0001-find-dired-Add-command-editing-like-rgrep.patch --]
[-- Type: text/x-patch, Size: 10268 bytes --]

From be97868f05c2bda95ab3c2d6348478d5d0306014 Mon Sep 17 00:00:00 2001
From: Allen Li <darkfeline@felesatra.moe>
Date: Fri, 12 Mar 2021 00:07:22 -0800
Subject: [PATCH] find-dired: Add command editing like rgrep

The original find-dired does not allow for constructing queries like

 find . -maxdepth 3 \( OTHER-ARGS \) -ls

* lisp/find-dired.el (find-dired): Added command editing and
confirmation.
---
 lisp/find-dired.el | 211 ++++++++++++++++++++++++++-------------------
 1 file changed, 121 insertions(+), 90 deletions(-)

diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index adc5672eca..e4d2a5ba11 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -151,13 +151,16 @@ find-dired-refine-function
 (defvar find-args nil
   "Last arguments given to `find' by \\[find-dired].")
 
-;; History of find-args values entered in the minibuffer.
-(defvar find-args-history nil)
+(defvar find-args-history nil
+  "History list for args provided to `find-dired'.")
+
+(defvar find-dired-history nil
+  "History list for `find-dired'.")
 
 (defvar dired-sort-inhibit)
 
 ;;;###autoload
-(defun find-dired (dir args)
+(defun find-dired (dir &optional args confirm)
   "Run `find' and go into Dired mode on a buffer of the output.
 The command run (after changing into DIR) is essentially
 
@@ -166,93 +169,121 @@ find-dired
 except that the car of the variable `find-ls-option' specifies what to
 use in place of \"-ls\" as the final argument.
 
+With \\[universal-argument] prefix, you can edit the constructed shell command line
+before it is executed.
+With two \\[universal-argument] prefixes, directly edit and run `grep-find-command'.
+
 Collect output in the \"*Find*\" buffer.  To kill the job before
-it finishes, type \\[kill-find]."
-  (interactive (list (read-directory-name "Run find in directory: " nil "" t)
-		     (read-string "Run find (with args): " find-args
-				  '(find-args-history . 1))))
-  (let ((dired-buffers dired-buffers))
-    ;; Expand DIR ("" means default-directory), and make sure it has a
-    ;; trailing slash.
-    (setq dir (file-name-as-directory (expand-file-name dir)))
-    ;; Check that it's really a directory.
-    (or (file-directory-p dir)
-	(error "find-dired needs a directory: %s" dir))
-    (pop-to-buffer-same-window (get-buffer-create "*Find*"))
-
-    ;; See if there's still a `find' running, and offer to kill
-    ;; it first, if it is.
-    (let ((find (get-buffer-process (current-buffer))))
-      (when find
-	(if (or (not (eq (process-status find) 'run))
-		(yes-or-no-p
-		 (format-message "A `find' process is running; kill it? ")))
-	    (condition-case nil
-		(progn
-		  (interrupt-process find)
-		  (sit-for 1)
-		  (delete-process find))
-	      (error nil))
-	  (error "Cannot have two processes in `%s' at once" (buffer-name)))))
-
-    (widen)
-    (kill-all-local-variables)
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (setq default-directory dir
-	  find-args args	      ; save for next interactive call
-	  args (concat find-program " . "
-		       (if (string= args "")
-			   ""
-			 (concat
-			  (shell-quote-argument "(")
-			  " " args " "
-			  (shell-quote-argument ")")
-			  " "))
-		       (if (string-match "\\`\\(.*\\) {} \\(\\\\;\\|\\+\\)\\'"
-					 (car find-ls-option))
-			   (format "%s %s %s"
-				   (match-string 1 (car find-ls-option))
-				   (shell-quote-argument "{}")
-				   find-exec-terminator)
-			 (car find-ls-option))))
-    ;; Start the find process.
-    (shell-command (concat args "&") (current-buffer))
-    (dired-mode dir (cdr find-ls-option))
-    (let ((map (make-sparse-keymap)))
-      (set-keymap-parent map (current-local-map))
-      (define-key map "\C-c\C-k" 'kill-find)
-      (use-local-map map))
-    (setq-local dired-sort-inhibit t)
-    (setq-local revert-buffer-function
-                `(lambda (ignore-auto noconfirm)
-                   (find-dired ,dir ,find-args)))
-    ;; Set subdir-alist so that Tree Dired will work:
-    (if (fboundp 'dired-simple-subdir-alist)
-	;; will work even with nested dired format (dired-nstd.el,v 1.15
-	;; and later)
-	(dired-simple-subdir-alist)
-      ;; else we have an ancient tree dired (or classic dired, where
-      ;; this does no harm)
-      (setq-local dired-subdir-alist
-                  (list (cons default-directory (point-min-marker)))))
-    (setq-local dired-subdir-switches find-ls-subdir-switches)
-    (setq buffer-read-only nil)
-    ;; Subdir headlerline must come first because the first marker in
-    ;; subdir-alist points there.
-    (insert "  " dir ":\n")
-    ;; Make second line a ``find'' line in analogy to the ``total'' or
-    ;; ``wildcard'' line.
-    (let ((point (point)))
-      (insert "  " args "\n")
-      (dired-insert-set-properties point (point)))
-    (setq buffer-read-only t)
-    (let ((proc (get-buffer-process (current-buffer))))
-      (set-process-filter proc #'find-dired-filter)
-      (set-process-sentinel proc #'find-dired-sentinel)
-      ;; Initialize the process marker; it is used by the filter.
-      (move-marker (process-mark proc) (point) (current-buffer)))
-    (setq mode-line-process '(":%s"))))
+it finishes, type \\[kill-find].
+
+When called programmatically and ARGS is nil, DIR is expected to
+specify a command to run.
+
+If CONFIRM is non-nil, the user will be given an opportunity to edit the
+command before it's run."
+  (interactive
+   (cond
+    ((equal current-prefix-arg '(16))
+     (list (read-from-minibuffer "Run: " (cons (format "%s . -ls" find-program)
+                                               (+ (length find-program) 3))
+				 nil nil 'find-dired-history)))
+    (t (let* ((dir (read-directory-name "Run find in directory: " nil "" t))
+              (args (read-string "Run find (with args): " find-args
+                                 '(find-args-history . 1)))
+	      (confirm (equal current-prefix-arg '(4))))
+	 (list dir args confirm)))))
+  (let (command)
+    (if (null args)
+        (setq command dir
+              dir default-directory)
+      (setq find-args args	      ; save for next interactive call
+            command (concat find-program " . "
+		            (if (string= args "")
+		                ""
+		              (concat
+		               (shell-quote-argument "(")
+		               " " args " "
+		               (shell-quote-argument ")")
+		               " "))
+		            (if (string-match "\\`\\(.*\\) {} \\(\\\\;\\|\\+\\)\\'"
+				              (car find-ls-option))
+		                (format "%s %s %s"
+			                (match-string 1 (car find-ls-option))
+			                (shell-quote-argument "{}")
+			                find-exec-terminator)
+		              (car find-ls-option)))))
+    (if confirm
+        (setq command
+              (read-from-minibuffer "Confirm: "
+			            command nil nil 'find-dired-history))
+      (add-to-history 'find-dired-history command))
+    (let ((dired-buffers dired-buffers))
+      ;; Expand DIR ("" means default-directory), and make sure it has a
+      ;; trailing slash.
+      (setq dir (file-name-as-directory (expand-file-name dir)))
+      ;; Check that it's really a directory.
+      (or (file-directory-p dir)
+	  (error "find-dired needs a directory: %s" dir))
+      (pop-to-buffer-same-window (get-buffer-create "*Find*"))
+
+      ;; See if there's still a `find' running, and offer to kill
+      ;; it first, if it is.
+      (let ((find (get-buffer-process (current-buffer))))
+        (when find
+	  (if (or (not (eq (process-status find) 'run))
+		  (yes-or-no-p
+		   (format-message "A `find' process is running; kill it? ")))
+	      (condition-case nil
+		  (progn
+		    (interrupt-process find)
+		    (sit-for 1)
+		    (delete-process find))
+	        (error nil))
+	    (error "Cannot have two processes in `%s' at once" (buffer-name)))))
+
+      (widen)
+      (kill-all-local-variables)
+      (setq buffer-read-only nil)
+      (erase-buffer)
+      (setq default-directory dir)
+
+      ;; Start the find process.
+      (shell-command (concat command "&") (current-buffer))
+      (dired-mode dir (cdr find-ls-option))
+      (let ((map (make-sparse-keymap)))
+        (set-keymap-parent map (current-local-map))
+        (define-key map "\C-c\C-k" 'kill-find)
+        (use-local-map map))
+      (setq-local dired-sort-inhibit t)
+      (setq-local revert-buffer-function
+                  `(lambda (ignore-auto noconfirm)
+                     (find-dired ,dir ,find-args)))
+      ;; Set subdir-alist so that Tree Dired will work:
+      (if (fboundp 'dired-simple-subdir-alist)
+	  ;; will work even with nested dired format (dired-nstd.el,v 1.15
+	  ;; and later)
+	  (dired-simple-subdir-alist)
+        ;; else we have an ancient tree dired (or classic dired, where
+        ;; this does no harm)
+        (setq-local dired-subdir-alist
+                    (list (cons default-directory (point-min-marker)))))
+      (setq-local dired-subdir-switches find-ls-subdir-switches)
+      (setq buffer-read-only nil)
+      ;; Subdir headlerline must come first because the first marker in
+      ;; subdir-alist points there.
+      (insert "  " dir ":\n")
+      ;; Make second line a ``find'' line in analogy to the ``total'' or
+      ;; ``wildcard'' line.
+      (let ((point (point)))
+        (insert "  " command "\n")
+        (dired-insert-set-properties point (point)))
+      (setq buffer-read-only t)
+      (let ((proc (get-buffer-process (current-buffer))))
+        (set-process-filter proc #'find-dired-filter)
+        (set-process-sentinel proc #'find-dired-sentinel)
+        ;; Initialize the process marker; it is used by the filter.
+        (move-marker (process-mark proc) (point) (current-buffer)))
+      (setq mode-line-process '(":%s")))))
 
 (defun kill-find ()
   "Kill the `find' process running in the current buffer."
@@ -393,7 +424,7 @@ find-dired-sentinel
 	      ;; will stay around until M-x `list-processes'.
 	      (delete-process proc)
 	      (force-mode-line-update))))
-	  (message "find-dired %s finished." buf))))
+      (message "find-dired %s finished." buf))))
 
 (defun find-dired-sort-by-filename ()
   "Sort entries in *Find* buffer by file name lexicographically."
-- 
2.30.2


  reply	other threads:[~2021-03-14  0:40 UTC|newest]

Thread overview: 29+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-03-03  1:12 bug#46884: 27.1; Cannot run find-dired with -maxdepth Allen Li
2021-03-03  1:20 ` bug#46884: [PATCH] " Allen Li
2021-03-03  3:38   ` Allen Li
2021-03-03  6:28     ` Eli Zaretskii
2021-03-03  8:22       ` Allen Li
2021-03-03  8:55         ` Eli Zaretskii
2021-03-04  4:50           ` Allen Li
2021-03-04  9:35             ` Juri Linkov
2021-03-05  3:21               ` Allen Li
2021-03-05  7:27                 ` Eli Zaretskii
2021-03-12  8:08                   ` Allen Li
2021-03-12 15:49                     ` bug#46884: [External] : " Drew Adams
2021-03-13  0:42                       ` Allen Li
2021-03-13  1:09                         ` Drew Adams
2021-03-13  9:46                     ` Eli Zaretskii
2021-03-13  9:58                       ` Andreas Schwab
2021-03-13 21:38                       ` Allen Li
2021-03-13 21:53                         ` Juri Linkov
2021-03-14  0:40                           ` Allen Li [this message]
2021-03-18 18:52                             ` Juri Linkov
2022-06-19 23:55                               ` bug#46884: " Lars Ingebrigtsen
2022-06-26  3:54                                 ` Allen Li
2022-06-27  7:46                                   ` Lars Ingebrigtsen
2021-03-04 13:53             ` bug#46884: [PATCH] " Eli Zaretskii
2021-03-03  9:03         ` Juri Linkov
2021-03-03 15:42         ` bug#46884: [External] : " Drew Adams
2021-03-03 16:20           ` Eli Zaretskii
2021-03-03  6:15   ` Eli Zaretskii
2021-03-03  1:34 ` bug#46884: [External] : bug#46884: " Drew Adams

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=CADbSrJws3txfOi0XyxTPbmci5dgBZTauWit+_ucmxZuLQt9Y3w@mail.gmail.com \
    --to=darkfeline@felesatra.moe \
    --cc=46884@debbugs.gnu.org \
    --cc=juri@linkov.net \
    /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).