]> git.eshelyaron.com Git - emacs.git/commitdiff
Allow refining the *Find* buffer of find-dired. (Bug#29513)
authorRoland Winkler <winkler@gnu.org>
Tue, 11 Jun 2019 21:04:45 +0000 (16:04 -0500)
committerRoland Winkler <winkler@gnu.org>
Tue, 11 Jun 2019 21:04:45 +0000 (16:04 -0500)
* find-dired.el (find-dired-refine-function): New user variable.
(find-dired-sentinel): Use it.  Simplify.
(find-dired-sort-by-filename): New function.

etc/NEWS
lisp/find-dired.el

index c9da98b0adcaea98f54a12ef71f28b108c95be11..6efa7642f85924e57f38843f0182b39cd7eddc02 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -580,6 +580,11 @@ remapped to these, respectively.
 +++
 *** New command 'dired-create-empty-file'.
 
+** Find-Dired
+
+*** New customizable variable 'find-dired-refine-function'.
+The default value is 'find-dired-sort-by-filename'.
+
 ** Change Logs and VC
 
 *** Recording ChangeLog entries doesn't require an actual file.
index ef137be9bbf9122a1b7b51e8e14e89ba7f53e5ee..6e5abe2f13446a296b954d9a08faac79720cb615 100644 (file)
@@ -117,6 +117,14 @@ find also ignores case.  Otherwise, -name is used."
   :group 'find-dired
   :version "22.2")
 
+(defcustom find-dired-refine-function #'find-dired-sort-by-filename
+  "If non-nil, a function for refining the *Find* buffer of `find-dired'.
+This function takes no arguments.  The *Find* buffer is narrowed to the
+output of `find' (one file per line) when this function is called."
+  :version "27.1"
+  :group 'find-dired
+  :type 'function)
+
 (defvar find-args nil
   "Last arguments given to `find' by \\[find-dired].")
 
@@ -334,28 +342,43 @@ specifies what to use in place of \"-ls\" as the final argument."
       (delete-process proc))))
 
 (defun find-dired-sentinel (proc state)
-  ;; Sentinel for \\[find-dired] processes.
-  (let ((buf (process-buffer proc))
-       (inhibit-read-only t))
+  "Sentinel for \\[find-dired] processes."
+  (let ((buf (process-buffer proc)))
     (if (buffer-name buf)
        (with-current-buffer buf
-         (let ((buffer-read-only nil))
+         (let ((inhibit-read-only t))
            (save-excursion
-             (goto-char (point-max))
-             (let ((point (point)))
-               (insert "\n  find " state)
-               (forward-char -1)               ;Back up before \n at end of STATE.
-               (insert " at " (substring (current-time-string) 0 19))
-               (dired-insert-set-properties point (point)))
-             (setq mode-line-process
-                   (concat ":"
-                           (symbol-name (process-status proc))))
+              (save-restriction
+                (widen)
+                (when (boundp 'find-dired-refine-function)
+                  ;; `find-dired-filter' puts two whitespace characters
+                  ;; at the beginning of every line.
+                  (narrow-to-region (point) (- (point-max) 2))
+                  (funcall find-dired-refine-function)
+                  (widen))
+                (let ((point (point-max)))
+                  (goto-char point)
+                  (insert "\n  find "
+                          (substring state 0 -1) ; omit \n at end of STATE.
+                          " at " (substring (current-time-string) 0 19))
+                  (dired-insert-set-properties point (point))))
+              (setq mode-line-process
+                   (format ":%s" (process-status proc)))
              ;; Since the buffer and mode line will show that the
              ;; process is dead, we can delete it now.  Otherwise it
-             ;; will stay around until M-x list-processes.
+             ;; will stay around until M-x `list-processes'.
              (delete-process proc)
-             (force-mode-line-update)))
-         (message "find-dired %s finished." (current-buffer))))))
+             (force-mode-line-update))))
+         (message "find-dired %s finished." buf))))
+
+(defun find-dired-sort-by-filename ()
+  "Sort entries in *Find* buffer by file name lexicographically."
+  (sort-subr nil 'forward-line 'end-of-line
+             (lambda ()
+               (buffer-substring-no-properties
+                (next-single-property-change
+                 (point) 'dired-filename)
+                (line-end-position)))))
 
 \f
 (provide 'find-dired)