forked from emacs-helm/helm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
helm-find.el
170 lines (147 loc) · 6.63 KB
/
helm-find.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
;;; helm-find.el --- helm interface for find command. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2020 Thierry Volpiatto <thierry.volpiatto@gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; Code:
(require 'helm-files)
(require 'helm-external)
(defcustom helm-findutils-skip-boring-files t
"Ignore boring files in find command results."
:group 'helm-files
:type 'boolean)
(defcustom helm-findutils-search-full-path nil
"Search in full path with shell command find when non-nil.
I.e. use the -path/ipath arguments of find instead of
-name/iname."
:group 'helm-files
:type 'boolean)
(defcustom helm-find-noerrors nil
"Prevent showing error messages in helm buffer when non nil."
:group 'helm-files
:type 'boolean)
(defvar helm-find-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-generic-files-map)
(define-key map (kbd "DEL") 'helm-delete-backward-no-update)
map))
(defvar helm-source-findutils
(helm-build-async-source "Find"
:header-name (lambda (name)
(concat name " in [" (helm-default-directory) "]"))
:candidates-process 'helm-find-shell-command-fn
:filtered-candidate-transformer 'helm-findutils-transformer
:action-transformer 'helm-transform-file-load-el
:persistent-action 'helm-ff-kill-or-find-buffer-fname
:action 'helm-type-file-actions
:help-message 'helm-generic-file-help-message
:keymap helm-find-map
:candidate-number-limit 9999
:requires-pattern 3))
(defun helm-findutils-transformer (candidates _source)
(let (non-essential
(default-directory (helm-default-directory)))
(cl-loop for i in candidates
for abs = (expand-file-name
(helm-aif (file-remote-p default-directory)
(concat it i) i))
for type = (car (file-attributes abs))
for disp = (if (and helm-ff-transformer-show-only-basename
(not (string-match "[.]\\{1,2\\}$" i)))
(helm-basename abs) abs)
collect (cond ((eq t type)
(cons (propertize disp 'face 'helm-ff-directory)
abs))
((stringp type)
(cons (propertize disp 'face 'helm-ff-symlink)
abs))
(t (cons (propertize disp 'face 'helm-ff-file)
abs))))))
(defun helm-find--build-cmd-line ()
(require 'find-cmd)
(let* ((default-directory (or (file-remote-p default-directory 'localname)
default-directory))
(patterns+options (split-string helm-pattern "\\(\\`\\| +\\)\\* +"))
(fold-case (helm-set-case-fold-search (car patterns+options)))
(patterns (split-string (car patterns+options)))
(additional-options (and (cdr patterns+options)
(list (concat (cadr patterns+options) " "))))
(ignored-dirs ())
(ignored-files (when helm-findutils-skip-boring-files
(cl-loop for f in completion-ignored-extensions
if (string-match "/$" f)
do (push (replace-match "" nil t f)
ignored-dirs)
else collect (concat "*" f))))
(path-or-name (if helm-findutils-search-full-path
'(ipath path) '(iname name)))
(name-or-iname (if fold-case
(car path-or-name) (cadr path-or-name))))
(find-cmd (and ignored-dirs
`(prune (name ,@ignored-dirs)))
(and ignored-files
`(not (name ,@ignored-files)))
`(and ,@(mapcar
(lambda (pattern)
`(,name-or-iname ,(concat "*" pattern "*")))
patterns)
,@additional-options))))
(defun helm-find-shell-command-fn ()
"Asynchronously fetch candidates for `helm-find'.
Additional find options can be specified after a \"*\"
separator."
(let* (process-connection-type
non-essential
(cmd (concat (helm-find--build-cmd-line)
(if helm-find-noerrors "2> /dev/null" "")))
(proc (start-file-process-shell-command "hfind" helm-buffer cmd)))
(helm-log "Find command:\n%s" cmd)
(prog1 proc
(set-process-sentinel
proc
(lambda (process event)
(helm-process-deferred-sentinel-hook
process event (helm-default-directory))
(if (string= event "finished\n")
(helm-locate-update-mode-line "Find")
(helm-log "Error: Find %s"
(replace-regexp-in-string "\n" "" event))))))))
(defun helm-find-1 (dir)
(let ((default-directory (file-name-as-directory dir)))
(helm :sources 'helm-source-findutils
:buffer "*helm find*"
:ff-transformer-show-only-basename nil
:case-fold-search helm-file-name-case-fold-search)))
;;; Preconfigured commands
;;
;;
;;;###autoload
(defun helm-find (arg)
"Preconfigured `helm' for the find shell command.
Recursively find files whose names are matched by all specified
globbing PATTERNs under the current directory using the external
program specified in `find-program' (usually \"find\"). Every
input PATTERN is silently wrapped into two stars: *PATTERN*.
With prefix argument, prompt for a directory to search.
When user option `helm-findutils-search-full-path' is non-nil,
match against complete paths, otherwise, against file names
without directory part.
The (possibly empty) list of globbing PATTERNs can be followed by
the separator \"*\" plus any number of additional arguments that
are passed to \"find\" literally."
(interactive "P")
(let ((directory
(if arg
(file-name-as-directory
(read-directory-name "DefaultDirectory: "))
default-directory)))
(helm-find-1 directory)))
(provide 'helm-find)
;;; helm-find.el ends here