-
Notifications
You must be signed in to change notification settings - Fork 10
/
fd-dired.el
259 lines (218 loc) · 10 KB
/
fd-dired.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
;;; fd-dired.el --- find-dired alternative using fd -*- lexical-binding: t; -*-
;; Copyright © 2018, Free Software Foundation, Inc.
;; Version: 0.1.0
;; URL: https://github.com/yqrashawn/fd-dired
;; Package-Requires: ((emacs "25"))
;; Author: Rashawn Zhang <[email protected]>
;; Created: 3 July 2018
;; Keywords: tools, fd, find, dired
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Provide a dired-mode interface for fd's result. Same functionality as
;; find-dired, use fd instead. Depend on find-dired.
;; Just call `fd-dired'.
;;; Code:
(require 'find-dired)
(require 'ibuffer)
(require 'ibuf-ext)
(defvar fd-dired-program "fd"
"The default fd program.")
(defvar fd-grep-dired-program "rg"
"The default fd grep program.")
(defvar fd-dired-input-fd-args ""
"Last used fd arguments.")
(defvar fd-dired-args-history nil
"History list of fd arguments entered in the minibuffer.")
(defgroup fd-dired nil
"fd-dired customize group."
:prefix "fd-dired-"
:group 'fd-dired)
(defcustom fd-dired-display-in-current-window t
"Whether display result"
:type 'boolean
:safe #'booleanp
:group 'fd-dired)
(defcustom fd-dired-pre-fd-args "-0 -c never"
"Fd arguments inserted before user arguments."
:type 'string
:group 'fd-dired)
(defcustom fd-grep-dired-pre-grep-args "--color never --regexp"
"Fd grep arguments inserted before user arguments."
:type 'string
:group 'fd-dired)
(defcustom fd-dired-ls-option
(pcase system-type
('darwin
;; NOTE: here `gls' need to `brew install coreutils'
(if (executable-find "gls")
`(,(concat "| xargs -0 " "gls -ld --quoting-style=literal | uniq") . "-ld")
(warn "macOS system default 'ls' command does not support option --quoting-style=literal.\n Please install with: brew install coreutils")))
(_
`(,(concat "| xargs -0 " insert-directory-program " -ld --quoting-style=literal | uniq") . "-ld")))
"A pair of options to produce and parse an `ls -l'-type list from `fd'.
This is a cons of two strings (FD-ARGUMENTS . LS-SWITCHES).
FD-ARGUMENTS is the option passed to `fd' to produce a file
listing in the desired format. LS-SWITCHES is a set of `ls'
switches that tell dired how to parse the output of `fd'.
For more information, see `FIND-LS-OPTION'."
:type '(cons :tag "Fd arguments pair"
(string :tag "Fd arguments")
(string :tag "Ls Switches"))
:group 'fd-dired)
(defcustom fd-dired-generate-random-buffer nil
"Generate random buffer name.
If this variable is non-nil, new fd-dired buffers will have
random and hidden names."
:type 'boolean
:group 'fd-dired)
;;;###autoload
(defun fd-dired (dir args)
"Run `fd' and go into Dired mode on a buffer of the output.
The command run (after changing into DIR) is essentially
fd . ARGS -ls
except that the car of the variable `fd-dired-ls-option' specifies what to
use in place of \"-ls\" as the final argument."
(interactive (list (read-directory-name "Run fd in directory: " nil "" t)
(read-string "Run fd (with args and search): " fd-dired-input-fd-args
'(fd-dired-args-history . 1))))
(let ((dired-buffers dired-buffers)
(fd-dired-buffer-name (if fd-dired-generate-random-buffer
(format " *%s*" (make-temp-name "Fd "))
"*Fd*")))
;; Expand DIR ("" means default-directory), and make sure it has a
;; trailing slash.
(setq dir (file-name-as-directory (expand-file-name (or dir default-directory))))
;; Check that it's really a directory.
(or (file-directory-p dir)
(error "Fd-dired needs a directory: %s" dir))
(get-buffer-create fd-dired-buffer-name)
(if fd-dired-display-in-current-window
(display-buffer (get-buffer fd-dired-buffer-name) nil)
(display-buffer-below-selected (get-buffer fd-dired-buffer-name) nil)
(select-window (get-buffer-window fd-dired-buffer-name)))
(with-current-buffer (get-buffer fd-dired-buffer-name)
;; prepare buffer
(widen)
(kill-all-local-variables)
(setq buffer-read-only nil)
(erase-buffer)
;; Start the process.
(setq default-directory dir
fd-dired-input-fd-args args ; save for next interactive call
args (concat fd-dired-program " " fd-dired-pre-fd-args
;; " . "
(if (string= args "")
""
(concat
" " args " "
" "))
(if (string-match "\\`\\(.*\\) {} \\(\\\\;\\|+\\)\\'"
(car fd-dired-ls-option))
(format "%s %s %s"
(match-string 1 (car fd-dired-ls-option))
(shell-quote-argument "{}")
find-exec-terminator)
(car fd-dired-ls-option))))
(shell-command (concat args " &") (get-buffer-create fd-dired-buffer-name))
;; enable Dired mode
;; The next statement will bomb in classic dired (no optional arg allowed)
(dired-mode dir (cdr fd-dired-ls-option))
;; provide a keybinding to kill the find process
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
(define-key map "\C-c\C-k" #'kill-find)
(define-key map (kbd "M-S") #'fd-dired-save-search-as-name)
(use-local-map map))
;; disable Dired sort
(make-local-variable 'dired-sort-inhibit)
(setq dired-sort-inhibit t)
(set (make-local-variable 'revert-buffer-function)
`(lambda (ignore-auto noconfirm)
(fd-dired ,dir ,fd-dired-input-fd-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)
(set (make-local-variable 'dired-subdir-alist)
(list (cons default-directory (point-min-marker)))))
(set (make-local-variable '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 (get-buffer fd-dired-buffer-name))))
(set-process-filter proc (function find-dired-filter))
(set-process-sentinel proc (function find-dired-sentinel))
;; Initialize the process marker; it is used by the filter.
(move-marker (process-mark proc) (point) (get-buffer fd-dired-buffer-name)))
(setq mode-line-process '(":%s")))))
;;;###autoload
(defun fd-name-dired (dir pattern)
"Search DIR recursively for files matching the globbing pattern PATTERN,
and run Dired on those files.
PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
The default command run (after changing into DIR) is
fd . ARGS \\='PATTERN\\=' | fd-dired-ls-option"
(interactive
"DFd-name (directory): \nsFd-name (filename regexp): ")
(fd-dired dir (shell-quote-argument pattern)))
;;;###autoload
(defun fd-grep-dired (dir regexp)
"Find files in DIR that contain matches for REGEXP and start Dired on output.
The command run (after changing into DIR) is
fd . ARGS --exec rg --regexp REGEXP -0 -ls | fd-dired-ls-option"
(interactive "DFd-grep (directory): \nsFd-grep (rg regexp): ")
(fd-dired dir (concat "--exec " fd-grep-dired-program
" " fd-grep-dired-pre-grep-args " "
(shell-quote-argument regexp)
" -0 -ls ")))
(defun fd-dired-cleanup ()
"Clean up fd-dired created temp buffers for multiple searching processes."
(mapcar 'kill-buffer
(seq-filter
(lambda (buffer-name)
(string-match-p (rx (seq "*Fd " (zero-or-more nonl) "*")) buffer-name))
(mapcar 'buffer-name (buffer-list)))))
(add-hook 'kill-emacs-hook #'fd-dired-cleanup)
(defun fd-dired-save-search-as-name (newname)
"Save the search result in current result buffer.
NEWNAME will be added to the result buffer name. New searches will use the
standard buffer unless the search is done from a saved buffer in
which case the saved buffer will be reused."
(interactive "sSave search as name: ")
(let ((buffer (current-buffer)))
(when (and (string-match-p (rx bos (? " ") "*Fd") (buffer-name buffer))
(derived-mode-p 'dired-mode))
(with-current-buffer buffer
(rename-buffer (format "*Fd %s*" newname) t)))))
(defun fd-dired-list-searches ()
"List all fd buffers in `ibuffer'."
(interactive)
(let ((buffer-name "*Searches fd*")
(other-window (equal current-prefix-arg '(4))))
(ibuffer other-window buffer-name
`((mode . dired-mode) (name . ,(rx bos "*Fd"))))
(with-current-buffer buffer-name
(ibuffer-auto-mode)
(set (make-local-variable 'ibuffer-use-header-line) nil)
(ibuffer-clear-filter-groups))))
(provide 'fd-dired)
;;; fd-dired.el ends here