mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 8f6f2705a38e2515b6c57fda12c5be29fb9a798f
commit | author | age
5cb5f7 1 ;;; helm-files.el --- helm file browser and related. -*- lexical-binding: t -*-
C 2
3 ;; Copyright (C) 2012 ~ 2018 Thierry Volpiatto <thierry.volpiatto@gmail.com>
4
5 ;; This program is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation, either version 3 of the License, or
8 ;; (at your option) any later version.
9
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 ;; GNU General Public License for more details.
14
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
17
18 ;;; Code:
19
20 (require 'cl-lib)
21 (require 'helm)
22 (require 'helm-types)
23 (require 'helm-utils)
24 (require 'helm-grep)
25 (require 'helm-help)
26 (require 'helm-locate)
27 (require 'helm-tags)
28 (require 'helm-buffers)
29 (eval-when-compile
30   (require 'thingatpt)
31   (require 'ffap)
32   (require 'dired-aux)
33   (require 'dired-x)
34   (require 'tramp)
35   (require 'image-dired))
36
37 (declare-function find-library-name "find-func.el" (library))
38 (declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag))
39 (declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
40 (declare-function image-dired-display-image "image-dired.el" (file &optional original-size))
41 (declare-function image-dired-update-property "image-dired.el" (prop value))
42 (declare-function eshell-read-aliases-list "em-alias")
43 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
44 (declare-function eshell-kill-input "esh-mode")
45 (declare-function eshell-bol "esh-mode")
46 (declare-function eshell-reset "esh-mode.el")
47 (declare-function eshell/cd "em-dirs.el")
48 (declare-function eshell-next-prompt "em-prompt.el")
49 (declare-function eshell-quote-argument "esh-arg.el")
50 (declare-function helm-ls-git-ls "ext:helm-ls-git")
51 (declare-function helm-hg-find-files-in-project "ext:helm-ls-hg")
52 (declare-function helm-gid "helm-id-utils.el")
53 (declare-function helm-find-1 "helm-find")
54 (declare-function helm-get-default-program-for-file "helm-external")
55 (declare-function helm-open-file-externally "helm-external")
56
57 (defvar recentf-list)
58 (defvar helm-mm-matching-method)
59 (defvar dired-async-mode)
60 (defvar org-directory)
61
62 (defgroup helm-files nil
63   "Files applications and libraries for Helm."
64   :group 'helm)
65
66 (defcustom helm-tramp-verbose 0
67   "Just like `tramp-verbose' but specific to helm.
68 When set to 0 don't show tramp messages in helm.
69 If you want to have the default tramp messages set it to 3."
70   :type 'integer
71   :group 'helm-files)
72
73 (defcustom helm-ff-auto-update-initial-value nil
74   "Auto update when only one candidate directory is matched.
75 Default value when starting `helm-find-files' is nil because
76 it prevent using <backspace> to delete char backward and by the way
77 confuse beginners.
78 For a better experience with `helm-find-files' set this to non--nil
79 and use C-<backspace> to toggle it."
80   :group 'helm-files
81   :type  'boolean)
82
83 (defcustom helm-ff-lynx-style-map t
84   "Use arrow keys to navigate with `helm-find-files'.
85 You will have to restart Emacs or reeval `helm-find-files-map'
86 and `helm-read-file-map' for this take effect."
87   :group 'helm-files
88   :type 'boolean)
89
90 (defcustom helm-ff-history-max-length 100
91   "Number of elements shown in `helm-find-files' history."
92   :group 'helm-files
93   :type 'integer)
94
95 (defcustom helm-ff-fuzzy-matching t
96   "Enable fuzzy matching for `helm-find-files' when non--nil.
97 See `helm-ff--transform-pattern-for-completion' for more info."
98   :group 'helm-files
99   :type 'boolean)
100
101 (defcustom helm-ff-exif-data-program "exiftran"
102   "Program used to extract exif data of an image file."
103   :group 'helm-files
104   :type 'string)
105
106 (defcustom helm-ff-exif-data-program-args "-d"
107   "Arguments used for `helm-ff-exif-data-program'."
108   :group 'helm-files
109   :type 'string)
110
111 (defcustom helm-ff-newfile-prompt-p t
112   "Whether Prompt or not when creating new file.
113 This set `ffap-newfile-prompt'."
114   :type  'boolean
115   :group 'helm-files)
116
117 (defcustom helm-ff-avfs-directory "~/.avfs"
118   "The default avfs directory, usually '~/.avfs'.
119 When this is set you will be able to expand archive filenames with `C-j'
120 inside an avfs directory mounted with mountavfs.
121 See <http://sourceforge.net/projects/avf/>."
122   :type  'string
123   :group 'helm-files)
124
125 (defcustom helm-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
126   "Minimal list of compressed files extension."
127   :type  '(repeat (choice string))
128   :group 'helm-files)
129
130 (defcustom helm-ff-printer-list nil
131   "A list of available printers on your system.
132 When non--nil let you choose a printer to print file.
133 Otherwise when nil the variable `printer-name' will be used.
134 On Unix based systems (lpstat command needed) you don't need to set this,
135 `helm-ff-find-printers' will find a list of available printers for you."
136   :type '(repeat (choice string))
137   :group 'helm-files)
138
139 (defcustom helm-ff-transformer-show-only-basename t
140   "Show only basename of candidates in `helm-find-files'.
141 This can be toggled at anytime from `helm-find-files' with \
142 \\<helm-find-files-map>\\[helm-ff-run-toggle-basename]."
143   :type 'boolean
144   :group 'helm-files)
145
146 (defcustom helm-ff-signal-error-on-dot-files t
147   "Signal error when file is `.' or `..' on file deletion when non--nil.
148 Default is non--nil.
149 WARNING: Setting this to nil is unsafe and can cause deletion of a whole tree."
150   :group 'helm-files
151   :type  'boolean)
152
153 (defcustom helm-ff-search-library-in-sexp nil
154   "Search for library in `require' and `declare-function' sexp."
155   :group 'helm-files
156   :type  'boolean)
157
158 (defcustom helm-tooltip-hide-delay 25
159   "Hide tooltips automatically after this many seconds."
160   :group 'helm-files
161   :type 'integer)
162
163 (defcustom helm-ff-file-name-history-use-recentf nil
164   "Use `recentf-list' instead of `file-name-history' in `helm-find-files'."
165   :group 'helm-files
166   :type 'boolean)
167
168 (defcustom helm-ff-skip-boring-files nil
169   "Non--nil to skip files matching regexps in
170 `helm-boring-file-regexp-list'.
171
172 This take effect in `helm-find-files' and file completion used by `helm-mode'
173 i.e `helm-read-file-name'.
174 Note that when non-nil this will slow down slightly `helm-find-files'."
175   :group 'helm-files
176   :type  'boolean)
177
178 (defcustom helm-ff-candidate-number-limit 5000
179   "The `helm-candidate-number-limit' for `helm-find-files' and friends.
180 Note that when going one level up with `\\<helm-find-files-map>\\[helm-find-files-up-one-level]'
181 The length of directory will be used instead if it is higher than this
182 value, this to avoid failing to preselect the previous directory/file if
183 this one is situated lower than `helm-ff-candidate-number-limit' num
184 candidate."
185   :group 'helm-files
186   :type 'integer)
187
188 (defcustom helm-ff-up-one-level-preselect t
189   "Always preselect previous directory when going one level up.
190
191 When non nil `candidate-number-limit' source value is modified
192 dynamically when going one level up if the position of previous
193 candidate in its directory is > to `helm-ff-candidate-number-limit'.
194
195 This can be helpful to disable this and reduce
196 `helm-ff-candidate-number-limit' if you often navigate across very
197 large directories."
198   :group 'helm-files
199   :type 'boolean)
200
201 (defcustom helm-files-save-history-extra-sources
202   '("Find" "Locate" "Recentf"
203     "Files from Current Directory" "File Cache")
204   "Extras source that save candidate to `file-name-history'."
205   :group 'helm-files
206   :type '(repeat (choice string)))
207
208 (defcustom helm-find-files-before-init-hook nil
209   "Hook that run before initialization of `helm-find-files'."
210   :group 'helm-files
211   :type 'hook)
212
213 (defcustom helm-find-files-after-init-hook nil
214   "Hook that run after initialization of `helm-find-files'."
215   :group 'helm-files
216   :type 'hook)
217
218 (defcustom helm-find-files-bookmark-prefix "Helm-find-files: "
219   "bookmark name prefix of `helm-find-files' sessions."
220   :group 'helm-files
221   :type 'string)
222
223 (defcustom helm-ff-guess-ffap-filenames nil
224   "Use ffap to guess local filenames at point in `helm-find-files'.
225 This doesn't disable url or mail at point, see
226 `helm-ff-guess-ffap-urls' for this."
227   :group 'helm-files
228   :type 'boolean)
229
230 (defcustom helm-ff-guess-ffap-urls t
231   "Use ffap to guess local urls at point in `helm-find-files'.
232 This doesn't disable guessing filenames at point,
233 see `helm-ff-guess-ffap-filenames' for this.
234 See also `ffap-url-unwrap-remote' that may override this variable."
235   :group 'helm-files
236   :type 'boolean)
237
238 (defcustom helm-ff-no-preselect nil
239   "When non--nil `helm-find-files' starts at root of current directory."
240   :group 'helm-files
241   :type 'boolean)
242
243 (defcustom helm-find-files-ignore-thing-at-point nil
244   "Use only `default-directory' as default input in `helm-find-files'.
245 I.e text under cursor in `current-buffer' is ignored.
246 Note that when non-nil you will be unable to complete filename at point
247 in `current-buffer'."
248   :group 'helm-files
249   :type 'boolean)
250
251 (defcustom helm-substitute-in-filename-stay-on-remote nil
252   "Don't switch back to local filesystem when expanding pattern with / or ~/."
253   :group 'helm-files
254   :type 'boolean)
255
256 (defcustom helm-ff-goto-first-real-dired-exceptions '(dired-goto-file)
257   "Dired commands that are allowed moving to first real candidate."
258   :group 'helm-files
259   :type '(repeat (choice symbol)))
260
261 (defcustom helm-mounted-network-directories nil
262   "A list of directories used for mounting remotes filesystem.
263
264 When nil `helm-file-on-mounted-network-p' always return nil otherwise
265 it checks if a file is in one of these directories.
266
267 Remote filesystem are generally mounted with sshfs."
268   :group 'helm-files
269   :type '(repeat string))
270
271 (defcustom helm-browse-project-default-find-files-fn
272   #'helm-browse-project-walk-directory
273   "The default function to retrieve files in a non-vc directory.
274
275 A function that takes a directory name as only arg."
276   :group 'helm-files
277   :type 'function)
278
279 (defcustom helm-ff-kill-or-find-buffer-fname-fn
280   #'helm-ff-kill-or-find-buffer-fname
281   "Default function used to expand non-directory filenames in `helm-find-files'.
282
283 This variable will take effect only in `helm-find-files', it affects
284 the behavior of persistent-action on filenames and non-existing
285 filenames.
286
287 The default is to expand filename on first hit on
288 \\<helm-map>\\[helm-execute-persistent-action], pop buffer in other
289 window on second hit and finally kill this buffer on third hit, this
290 is very handy to create several new buffers, or when navigating, show
291 quickly the buffer of file to see its contents briefly before killing
292 it and continue navigating.
293
294 However some users may not want this, so to disable this behavior just
295 set this to `ignore' function.
296
297 Of course you can also write your own function to do something else."
298   :group 'helm-files
299   :type 'function)
300
301 (defcustom helm-modes-using-escaped-strings
302   '(eshell-mode shell-mode term-mode)
303   "Modes that requires string's insertion to be escaped."
304   :group 'helm-files
305   :type '(repeat symbol))
306
307 (defcustom helm-ff-allow-recursive-deletes nil
308   "when 'always don't prompt for recursive deletion of directories.
309 When nil, will ask for recursive deletion.
310 Note that when deleting multiple directories you can answer ! when
311 prompted to avoid beeing asked for next directories, so it is probably
312 better to not modify this variable."
313   :group 'helm-files
314   :type '(choice
315           (const :tag "Delete non-empty directories" t)
316           (const :tag "Confirm for each directory" nil)))
317
318 (defcustom helm-ff-delete-files-function #'helm-delete-marked-files
319   "The function to use by default to delete files.
320
321 Default is to delete files synchronously, other choice is to delete
322 files asynchronously.
323
324 BE AWARE that when deleting async you will not be warned about
325 recursive deletion of directories, IOW non empty directories will be
326 deleted with no warnings in background!!!
327
328 It is the function that will be used when using `\\<helm-find-files-map>\\[helm-ff-run-delete-file]'
329 from `helm-find-files'."
330   :group 'helm-files
331   :type '(choice (function :tag "Delete files synchronously."
332                   helm-delete-marked-files)
333                  (function :tag "Delete files asynchronously."
334                   helm-delete-marked-files-async)))
335
336 (defcustom helm-trash-remote-files nil
337   "Allow trashing remote files when non-nil.
338
339 Deleting remote files with tramp doesn't work out of the box, it is
340 why it is disabled by default.
341
342 Following is NOT documented in tramp AFAIK but tramp is using
343 external trash command in its `delete-file' and `delete-directory'
344 handlers.
345
346 If you want to enable this you will have to install the 'trash' command
347 on remote (or locally if you want to trash as root), the package on
348 Ubuntu based distribution is 'trash-cli'."
349   :group 'helm-files
350   :type 'boolean)
351
352 (defcustom helm-list-directory-function
353   (cl-case system-type
354     (gnu/linux #'helm-list-dir-external)
355     (berkeley-unix #'helm-list-dir-external)
356     (windows-nt #'helm-list-dir-lisp)
357     (t #'helm-list-dir-lisp))
358   "The function used in `helm-find-files' to list remote directories.
359
360 Actually helm provides two functions to do this: `helm-list-dir-lisp'
361 and `helm-list-dir-external'.
362
363 Using `helm-list-dir-external' will provides a similar display to what
364 provided with local files i.e. colorized symlinks, executables files
365 etc... whereas using `helm-list-dir-lisp' will allow colorizing only
366 directories but is more portable.
367
368 NOTE that `helm-list-dir-external' needs ls and awk as dependencies."
369   :type 'function
370   :group 'helm-files)
371
372 ;;; Faces
373 ;;
374 ;;
375 (defgroup helm-files-faces nil
376   "Customize the appearance of helm-files."
377   :prefix "helm-"
378   :group 'helm-files
379   :group 'helm-faces)
380
381 (defface helm-ff-prefix
382     '((t (:background "yellow" :foreground "black")))
383   "Face used to prefix new file or url paths in `helm-find-files'."
384   :group 'helm-files-faces)
385
386 (defface helm-ff-executable
387     '((t (:foreground "green")))
388   "Face used for executable files in `helm-find-files'."
389   :group 'helm-files-faces)
390
391 (defface helm-ff-suid
392     '((t (:background "red" :foreground "white")))
393   "Face used for suid files in `helm-find-files'."
394   :group 'helm-files-faces)
395
396 (defface helm-ff-directory
397     '((t (:foreground "DarkRed" :background "LightGray")))
398   "Face used for directories in `helm-find-files'."
399   :group 'helm-files-faces)
400
401 (defface helm-ff-dotted-directory
402     '((t (:foreground "black" :background "DimGray")))
403   "Face used for dotted directories in `helm-find-files'."
404   :group 'helm-files-faces)
405
406 (defface helm-ff-dotted-symlink-directory
407     '((t (:foreground "DarkOrange" :background "DimGray")))
408   "Face used for dotted symlinked directories in `helm-find-files'."
409   :group 'helm-files-faces)
410
411 (defface helm-ff-symlink
412     '((t :inherit font-lock-comment-face))
413   "Face used for symlinks in `helm-find-files'."
414   :group 'helm-files-faces)
415
416 (defface helm-ff-invalid-symlink
417     '((t (:foreground "black" :background "red")))
418   "Face used for invalid symlinks in `helm-find-files'."
419   :group 'helm-files-faces)
420
421 (defface helm-ff-denied
422     '((t (:foreground "red" :background "black")))
423   "Face used for non accessible files in `helm-find-files'."
424   :group 'helm-files-faces)
425
426 (defface helm-ff-file
427     '((t (:inherit font-lock-builtin-face)))
428   "Face used for file names in `helm-find-files'."
429   :group 'helm-files-faces)
430
431 (defface helm-ff-truename
432     '((t (:inherit font-lock-string-face)))
433   "Face used for symlink truenames in `helm-find-files'."
434   :group 'helm-files-faces)
435
436 (defface helm-ff-dirs
437     '((t (:inherit font-lock-function-name-face)))
438   "Face used for file names in recursive dirs completion in `helm-find-files'."
439   :group 'helm-files-faces)
440
441 (defface helm-ff-socket
442     '((t (:foreground "DeepPink")))
443   "Face used for socket files in `helm-find-files'."
444   :group 'helm-files-faces)
445
446 (defface helm-ff-pipe
447     '((t (:foreground "yellow" :background "black")))
448   "Face used for named pipes and character device files in `helm-find-files'."
449   :group 'helm-files-faces)
450
451 (defface helm-history-deleted
452     '((t (:inherit helm-ff-invalid-symlink)))
453   "Face used for deleted files in `file-name-history'."
454   :group 'helm-files-faces)
455
456 (defface helm-history-remote
457     '((t (:foreground "Indianred1")))
458   "Face used for remote files in `file-name-history'."
459   :group 'helm-files-faces)
460
461 (defface helm-delete-async-message
462     '((t (:foreground "yellow")))
463   "Face used for mode-line message."
464   :group 'helm-files-faces)
465
466 ;;; Helm-find-files - The helm file browser.
467 ;;
468 ;; Keymaps
469 (defvar helm-find-files-map
470   (let ((map (make-sparse-keymap)))
471     (set-keymap-parent map helm-map)
472     (define-key map (kbd "RET")           'helm-ff-RET)
473     (define-key map (kbd "C-]")           'helm-ff-run-toggle-basename)
474     (define-key map (kbd "C-x C-f")       'helm-ff-run-locate)
475     (define-key map (kbd "C-x C-d")       'helm-ff-run-browse-project)
476     (define-key map (kbd "C-x r m")       'helm-ff-bookmark-set)
477     (define-key map (kbd "C-x r b")       'helm-find-files-toggle-to-bookmark)
478     (define-key map (kbd "C-x C-q")       'helm-ff-run-marked-files-in-dired)
479     (define-key map (kbd "C-s")           'helm-ff-run-grep)
480     (define-key map (kbd "M-g s")         'helm-ff-run-grep)
481     (define-key map (kbd "M-g p")         'helm-ff-run-pdfgrep)
482     (define-key map (kbd "M-g z")         'helm-ff-run-zgrep)
483     (define-key map (kbd "M-g a")         'helm-ff-run-grep-ag)
484     (define-key map (kbd "M-g g")         'helm-ff-run-git-grep)
485     (define-key map (kbd "M-g i")         'helm-ff-run-gid)
486     (define-key map (kbd "M-.")           'helm-ff-run-etags)
487     (define-key map (kbd "M-R")           'helm-ff-run-rename-file)
488     (define-key map (kbd "M-C")           'helm-ff-run-copy-file)
489     (define-key map (kbd "M-B")           'helm-ff-run-byte-compile-file)
490     (define-key map (kbd "M-L")           'helm-ff-run-load-file)
491     (define-key map (kbd "M-S")           'helm-ff-run-symlink-file)
492     (define-key map (kbd "M-Y")           'helm-ff-run-relsymlink-file)
493     (define-key map (kbd "M-H")           'helm-ff-run-hardlink-file)
494     (define-key map (kbd "M-D")           'helm-ff-run-delete-file)
495     (define-key map (kbd "M-K")           'helm-ff-run-kill-buffer-persistent)
496     (define-key map (kbd "M-T")           'helm-ff-run-touch-files)
497     (define-key map (kbd "C-c d")         'helm-ff-persistent-delete)
498     (define-key map (kbd "M-e")           'helm-ff-run-switch-to-eshell)
499     (define-key map (kbd "C-c i")         'helm-ff-run-complete-fn-at-point)
500     (define-key map (kbd "C-c o")         'helm-ff-run-switch-other-window)
501     (define-key map (kbd "C-c C-o")       'helm-ff-run-switch-other-frame)
502     (define-key map (kbd "C-c C-x")       'helm-ff-run-open-file-externally)
503     (define-key map (kbd "C-c C-v")       'helm-ff-run-preview-file-externally)
504     (define-key map (kbd "C-c X")         'helm-ff-run-open-file-with-default-tool)
505     (define-key map (kbd "M-!")           'helm-ff-run-eshell-command-on-file)
506     (define-key map (kbd "M-@")           'helm-ff-run-query-replace-fnames-on-marked)
507     (define-key map (kbd "M-%")           'helm-ff-run-query-replace)
508     (define-key map (kbd "C-M-%")         'helm-ff-run-query-replace-regexp)
509     (define-key map (kbd "C-c =")         'helm-ff-run-ediff-file)
510     (define-key map (kbd "M-=")           'helm-ff-run-ediff-merge-file)
511     (define-key map (kbd "M-p")           'helm-find-files-history)
512     (define-key map (kbd "C-c h")         'helm-ff-file-name-history)
513     (define-key map (kbd "M-i")           'helm-ff-properties-persistent)
514     (define-key map (kbd "C-}")           'helm-narrow-window)
515     (define-key map (kbd "C-{")           'helm-enlarge-window)
516     (define-key map (kbd "C-<backspace>") 'helm-ff-run-toggle-auto-update)
517     (define-key map (kbd "C-c <DEL>")     'helm-ff-run-toggle-auto-update)
518     (define-key map (kbd "C-c C-a")       'helm-ff-run-mail-attach-files)
519     (define-key map (kbd "C-c p")         'helm-ff-run-print-file)
520     (define-key map (kbd "C-c /")         'helm-ff-run-find-sh-command)
521     ;; Next 2 have no effect if candidate is not an image file.
522     (define-key map (kbd "M-l")           'helm-ff-rotate-left-persistent)
523     (define-key map (kbd "M-r")           'helm-ff-rotate-right-persistent)
524     (define-key map (kbd "C-l")           'helm-find-files-up-one-level)
525     (define-key map (kbd "C-r")           'helm-find-files-down-last-level)
526     (define-key map (kbd "C-c r")         'helm-ff-run-find-file-as-root)
527     (define-key map (kbd "C-x C-v")       'helm-ff-run-find-alternate-file)
528     (define-key map (kbd "C-c @")         'helm-ff-run-insert-org-link)
529     (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward
530                                   '((C-backspace . helm-ff-run-toggle-auto-update)
531                                     ([C-c DEL] . helm-ff-run-toggle-auto-update))
532                                   nil 'helm-ff-delete-char-backward--exit-fn)
533     (when helm-ff-lynx-style-map
534       (define-key map (kbd "<left>")      'helm-find-files-up-one-level)
535       (define-key map (kbd "<right>")     'helm-execute-persistent-action))
536     (delq nil map))
537   "Keymap for `helm-find-files'.")
538
539 (defvar helm-read-file-map
540   (let ((map (make-sparse-keymap)))
541     (set-keymap-parent map helm-map)
542     (define-key map (kbd "<C-return>")    'helm-cr-empty-string)
543     (define-key map (kbd "M-RET")         'helm-cr-empty-string)
544     (define-key map (kbd "C-]")           'helm-ff-run-toggle-basename)
545     (define-key map (kbd "C-.")           'helm-find-files-up-one-level)
546     (define-key map (kbd "C-l")           'helm-find-files-up-one-level)
547     (define-key map (kbd "C-r")           'helm-find-files-down-last-level)
548     (define-key map (kbd "C-c h")         'helm-ff-file-name-history)
549     (define-key map (kbd "C-<backspace>") 'helm-ff-run-toggle-auto-update)
550     (define-key map (kbd "C-c <DEL>")     'helm-ff-run-toggle-auto-update)
551     (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward
552                                   '((C-backspace . helm-ff-run-toggle-auto-update)
553                                     ([C-c DEL] . helm-ff-run-toggle-auto-update))
554                                   nil 'helm-ff-delete-char-backward--exit-fn)
555     (when helm-ff-lynx-style-map
556       (define-key map (kbd "<left>")      'helm-find-files-up-one-level)
557       (define-key map (kbd "<right>")     'helm-execute-persistent-action)
558       (define-key map (kbd "<M-left>")    'helm-previous-source)
559       (define-key map (kbd "<M-right>")   'helm-next-source))
560     (delq nil map))
561   "Keymap for `helm-read-file-name'.")
562
563
564 ;; Internal.
565 (defvar helm-find-files-doc-header " (\\<helm-find-files-map>\\[helm-find-files-up-one-level]: Go up one level)"
566   "*The doc that is inserted in the Name header of a find-files or dired source.")
567 (defvar helm-ff-auto-update-flag nil
568   "Internal, flag to turn on/off auto-update in `helm-find-files'.
569 Don't set it directly, use instead `helm-ff-auto-update-initial-value'.")
570 (defvar helm-ff-last-expanded nil
571   "Store last expanded directory or file.")
572 (defvar helm-ff-default-directory nil)
573 (defvar helm-ff-history nil)
574 (defvar helm-ff-cand-to-mark nil)
575 (defvar helm-ff-url-regexp
576   "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*"
577   "Same as `ffap-url-regexp' but match earlier possible url.")
578 ;; helm-tramp-file-name-regexp is based on old version of
579 ;; tramp-file-name-regexp i.e. "\\`/\\([^[/:]+\\|[^/]+]\\):" but it
580 ;; seems it is wrong and a simpler regexp is enough, let's try it and
581 ;; watch out!
582 (defvar helm-tramp-file-name-regexp "\\`/\\([^/:|]+\\):")
583 (defvar helm-marked-buffer-name "*helm marked*")
584 (defvar helm-ff--auto-update-state nil)
585 (defvar helm-ff--deleting-char-backward nil)
586 (defvar helm-multi-files--toggle-locate nil)
587 (defvar helm-ff--move-to-first-real-candidate t)
588 (defvar helm-find-files--toggle-bookmark nil)
589 (defvar helm-ff--tramp-methods nil)
590 (defvar helm-ff--directory-files-hash (make-hash-table :test 'equal))
591 (defvar helm-ff-history-buffer-name "*helm-find-files history*")
592
593 ;;; Helm-find-files
594 ;;
595 ;;
596 (defcustom helm-find-files-actions
597   (helm-make-actions
598    "Find File" 'helm-find-file-or-marked
599    "Find file in Dired" 'helm-point-file-in-dired
600    "View file" 'view-file
601    "Query replace fnames on marked `M-@'" 'helm-ff-query-replace-fnames-on-marked
602    "Marked files in dired `C-x C-q, C-u wdired'" 'helm-marked-files-in-dired
603    "Query replace contents on marked `M-%'" 'helm-ff-query-replace
604    "Query replace regexp contents on marked `C-M-%'" 'helm-ff-query-replace-regexp
605    "Attach file(s) to mail buffer `C-c C-a'" 'helm-ff-mail-attach-files
606    "Serial rename files" 'helm-ff-serial-rename
607    "Serial rename by symlinking files" 'helm-ff-serial-rename-by-symlink
608    "Serial rename by copying files" 'helm-ff-serial-rename-by-copying
609    "Open file with default tool" 'helm-open-file-with-default-tool
610    "Find file in hex dump" 'hexl-find-file
611    "Browse project `C-x C-d'" 'helm-ff-browse-project
612    "Complete at point `C-c i'" 'helm-insert-file-name-completion-at-point
613    "Insert as org link `C-c @'" 'helm-files-insert-as-org-link
614    "Find shell command `C-c /'" 'helm-ff-find-sh-command
615    "Add marked files to file-cache" 'helm-ff-cache-add-file
616    "Open file externally `C-c C-x, C-u to choose'" 'helm-open-file-externally
617    "Grep File(s) `C-s, C-u Recurse'" 'helm-find-files-grep
618    "Grep current directory with AG `M-g a, C-u select type'" 'helm-find-files-ag
619    "Git grep `M-g g, C-u from root'" 'helm-ff-git-grep
620    "Zgrep File(s) `M-g z, C-u Recurse'" 'helm-ff-zgrep
621    "Gid `M-g i'" 'helm-ff-gid
622    "Switch to Eshell `M-e'" 'helm-ff-switch-to-eshell
623    "Etags `M-., C-u reload tag file'" 'helm-ff-etags-select
624    "Eshell command on file(s) `M-!, C-u take all marked as arguments.'"
625    'helm-find-files-eshell-command-on-file
626    "Find file as root `C-c r'" 'helm-find-file-as-root
627    "Find alternate file `C-x C-v'" 'find-alternate-file
628    "Ediff File `C-c ='" 'helm-find-files-ediff-files
629    "Ediff Merge File `M-='" 'helm-find-files-ediff-merge-files
630    (lambda () (format "Delete File(s)%s `M-D' (C-u reverse trash)"
631                       (if (eq helm-ff-delete-files-function
632                               'helm-delete-marked-files-async)
633                           " async" "")))
634    'helm-ff-delete-files
635    "Touch File(s) `M-T'" 'helm-ff-touch-files
636    "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy
637    "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename
638    "Backup files" 'helm-find-files-backup
639    "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink
640    "Relsymlink file(s) `M-Y, C-u to follow'" 'helm-find-files-relsymlink
641    "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink
642    "Find file other window `C-c o'" 'helm-find-files-other-window
643    "Find file other frame `C-c C-o'" 'find-file-other-frame
644    "Print File `C-c p, C-u to refresh'" 'helm-ff-print
645    "Locate `C-x C-f, C-u to specify locate db'" 'helm-ff-locate)
646   "Actions for `helm-find-files'."
647   :group 'helm-files
648   :type '(alist :key-type string :value-type function))
649
650 (defvar helm-source-find-files nil
651   "The main source to browse files.
652 Should not be used among other sources.")
653
654 (defclass helm-source-ffiles (helm-source-sync)
655   ((header-name
656     :initform (lambda (name)
657                 (concat name (substitute-command-keys
658                               helm-find-files-doc-header))))
659    (init
660     :initform (lambda ()
661                 (setq helm-ff-auto-update-flag
662                       helm-ff-auto-update-initial-value)
663                 (setq helm-ff--auto-update-state
664                       helm-ff-auto-update-flag)
665                 (helm-set-local-variable 'bookmark-make-record-function
666                                          #'helm-ff-make-bookmark-record)
667                 (require 'helm-external)))
668    (candidates :initform 'helm-find-files-get-candidates)
669    (filtered-candidate-transformer
670     :initform '(helm-ff-sort-candidates
671                 (lambda (candidates _source)
672                   (cl-loop for f in candidates
673                            for ff = (helm-ff-filter-candidate-one-by-one f)
674                            when ff collect ff))))
675    (persistent-action-if :initform 'helm-find-files-persistent-action-if)
676    (persistent-help :initform "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
677    (help-message :initform 'helm-ff-help-message)
678    (mode-line :initform (list "File(s)" helm-mode-line-string))
679    (volatile :initform t)
680    (cleanup :initform 'helm-find-files-cleanup)
681    (migemo :initform t)
682    (nohighlight :initform t)
683    (keymap :initform helm-find-files-map)
684    (candidate-number-limit :initform 'helm-ff-candidate-number-limit)
685    (action-transformer
686     :initform 'helm-find-files-action-transformer)
687    (action :initform 'helm-find-files-actions)
688    (before-init-hook :initform 'helm-find-files-before-init-hook)
689    (after-init-hook :initform 'helm-find-files-after-init-hook)
690    (group :initform 'helm-files)))
691
692 ;; Bookmark handlers.
693 ;;
694 (defun helm-ff-make-bookmark-record ()
695   "The `bookmark-make-record-function' for `helm-find-files'."
696   (with-helm-buffer
697     `((filename . ,helm-ff-default-directory)
698       (presel . ,(helm-get-selection))
699       (handler . helm-ff-bookmark-jump))))
700
701 (defun helm-ff-bookmark-jump (bookmark)
702   "bookmark handler for `helm-find-files'."
703   (let ((fname (bookmark-prop-get bookmark 'filename))
704         (presel (bookmark-prop-get bookmark 'presel)))
705     ;; Force tramp connection with `file-directory-p' before lauching
706     ;; hff otherwise the directory name is inserted on top before
707     ;; tramp starts and display candidates.  FNAME is here always a
708     ;; directory.
709     (when (file-directory-p fname)
710       (helm-find-files-1 fname (if helm-ff-transformer-show-only-basename
711                                    (helm-basename presel)
712                                  presel)))))
713
714 (defun helm-ff-bookmark-set ()
715   "Record `helm-find-files' session in bookmarks."
716   (interactive)
717   (with-helm-alive-p
718     (with-helm-buffer
719       (bookmark-set
720        (concat helm-find-files-bookmark-prefix
721                (abbreviate-file-name helm-ff-default-directory))))
722     (message "Helm find files session bookmarked! ")))
723 (put 'helm-ff-bookmark-set 'helm-only t)
724
725 (defcustom helm-dwim-target nil
726   "Default target directory for file actions.
727
728 Define the directory where you want to start navigating for the target
729 directory when copying, renaming etc... You can use the
730 `default-directory' of `next-window', the current
731 `default-directory' or have completion on all the directories
732 belonging to each window."
733   :group 'helm-files
734   :type '(radio :tag "Define default target directory for file actions."
735           (const :tag "Directory belonging to next window" next-window)
736           (const :tag "Completion on directories belonging to each window" completion)
737           (const :tag "Use initial directory or `default-directory'" nil)))
738
739 (defun helm-dwim-target-directory ()
740   "Try to return a suitable directory according to `helm-dwim-target'."
741   (with-helm-current-buffer
742     (let* ((wins (remove (get-buffer-window helm-marked-buffer-name)
743                          (window-list)))
744            (num-windows (length wins)))
745       (expand-file-name
746        (cond ((and (> num-windows 1)
747                    (eq helm-dwim-target 'completion))
748               (helm-comp-read "Browse target starting from: "
749                               (append (list (or (car-safe helm-ff-history)
750                                                 default-directory)
751                                             default-directory)
752                                       (cl-loop for w in wins collect
753                                                (with-selected-window w
754                                                  default-directory)))))
755              ((and (> num-windows 1)
756                    (eq helm-dwim-target 'next-window))
757               (with-selected-window (next-window)
758                 default-directory))
759              ((or (= num-windows 1)
760                   (null helm-dwim-target))
761               ;; Using the car of *ff-history allow
762               ;; staying in the directory visited instead of
763               ;; current.
764               (or (car-safe helm-ff-history) default-directory)))))))
765
766 (defun helm-ff--count-and-collect-dups (files)
767   (cl-loop with dups = (make-hash-table :test 'equal)
768            for f in files
769            for file = (if (file-directory-p f)
770                           (concat (helm-basename f) "/")
771                           (helm-basename f))
772            for count = (gethash file dups)
773            if count do (puthash file (1+ count) dups)
774            else do (puthash file 1 dups)
775            finally return (cl-loop for k being the hash-keys in dups
776                                    using (hash-value v)
777                                    if (> v 1)
778                                    collect (format "%s(%s)" k v)
779                                    else
780                                    collect k)))
781
782 (defun helm-find-files-do-action (action)
783   "Generic function for creating actions from `helm-source-find-files'.
784 ACTION must be an action supported by `helm-dired-action'."
785   (require 'dired-async)
786   (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
787                          (helm-marked-candidates :with-wildcard t)))
788          (cand   (helm-get-selection)) ; Target
789          (prefarg helm-current-prefix-arg)
790          (prompt (format "%s %s file(s) to: "
791                          (if (and (and (fboundp 'dired-async-mode)
792                                        dired-async-mode)
793                                   (null prefarg))
794                              (concat "Async " (symbol-name action))
795                            (capitalize (symbol-name action)))
796                          (length ifiles)))
797          helm-ff--move-to-first-real-candidate
798          helm-display-source-at-screen-top ; prevent setting window-start.
799          helm-ff-auto-update-initial-value
800          ;; It is not possible to rename a file to a boring name when
801          ;; helm-ff-skip-boring-files is enabled
802          helm-ff-skip-boring-files
803          ;; If HFF is using a frame use a frame as well.
804          (helm-actions-inherit-frame-settings t)
805          helm-use-frame-when-more-than-two-windows
806          (dest   (with-helm-display-marked-candidates
807                    helm-marked-buffer-name
808                    (helm-ff--count-and-collect-dups ifiles)
809                    (with-helm-current-buffer
810                      (helm-read-file-name
811                       prompt
812                       :preselect (unless (cdr ifiles)
813                                    (concat
814                                     "^"
815                                     (regexp-quote
816                                      (if helm-ff-transformer-show-only-basename
817                                          (helm-basename cand) cand))))
818                       :initial-input (helm-dwim-target-directory)
819                       :history (helm-find-files-history nil :comp-read nil)))))
820          (dest-dir-p (file-directory-p dest))
821          (dest-dir   (helm-basedir dest)))
822     (unless (or dest-dir-p (file-directory-p dest-dir))
823       (when (y-or-n-p (format "Create directory `%s'? " dest-dir))
824         (make-directory dest-dir t)))
825     (helm-dired-action
826      dest :files ifiles :action action :follow prefarg)))
827
828 (defun helm-find-files-copy (_candidate)
829   "Copy files from `helm-find-files'."
830   (helm-find-files-do-action 'copy))
831
832 (defun helm-find-files-backup (_candidate)
833   "Backup files from `helm-find-files'.
834 This reproduce the behavior of \"cp --backup=numbered from to\"."
835   (cl-assert (and (fboundp 'dired-async-mode) dired-async-mode) nil
836              "Backup only available when `dired-async-mode' is enabled")
837   (helm-find-files-do-action 'backup))
838
839 (defun helm-find-files-rename (_candidate)
840   "Rename files from `helm-find-files'."
841   (helm-find-files-do-action 'rename))
842
843 (defun helm-find-files-symlink (_candidate)
844   "Symlink files from `helm-find-files'."
845   (helm-find-files-do-action 'symlink))
846
847 (defun helm-find-files-relsymlink (_candidate)
848   "Relsymlink files from `helm-find-files'."
849   (helm-find-files-do-action 'relsymlink))
850
851 (defun helm-find-files-hardlink (_candidate)
852   "Hardlink files from `helm-find-files'."
853   (helm-find-files-do-action 'hardlink))
854
855 (defun helm-find-files-other-window (_candidate)
856   "Keep current-buffer and open files in separate windows.
857 When a prefix arg is detected files are opened in a vertical windows
858 layout."
859   (let* ((files (helm-marked-candidates))
860          (buffers (mapcar 'find-file-noselect files)))
861     (helm-window-show-buffers buffers t)))
862
863 (defun helm-find-files-byte-compile (_candidate)
864   "Byte compile elisp files from `helm-find-files'."
865   (let ((files    (helm-marked-candidates :with-wildcard t))
866         (parg     helm-current-prefix-arg))
867     (cl-loop for fname in files
868           do (byte-compile-file fname parg))))
869
870 (defun helm-find-files-load-files (_candidate)
871   "Load elisp files from `helm-find-files'."
872   (let ((files    (helm-marked-candidates :with-wildcard t)))
873     (cl-loop for fname in files
874           do (load fname))))
875
876 (defun helm-find-files-ediff-files-1 (candidate &optional merge)
877   "Generic function to ediff/merge files in `helm-find-files'."
878   (let* ((helm-dwim-target 'next-window)
879          (bname  (helm-basename candidate))
880          (marked (helm-marked-candidates :with-wildcard t))
881          (prompt (if merge "Ediff Merge `%s' With File: "
882                    "Ediff `%s' With File: "))
883          (fun    (if merge 'ediff-merge-files 'ediff-files))
884          (input  (helm-dwim-target-directory))
885          (presel (if helm-ff-transformer-show-only-basename
886                      (helm-basename candidate)
887                    (expand-file-name
888                     (helm-basename candidate)
889                     input))))
890     (if (= (length marked) 2)
891         (funcall fun (car marked) (cadr marked))
892       (funcall fun candidate (helm-read-file-name
893                               (format prompt bname)
894                               :initial-input input
895                               :preselect presel)))))
896
897 (defun helm-find-files-ediff-files (candidate)
898   (helm-find-files-ediff-files-1 candidate))
899
900 (defun helm-find-files-ediff-merge-files (candidate)
901   (helm-find-files-ediff-files-1 candidate 'merge))
902
903 (defun helm-find-files-grep (_candidate)
904   "Default action to grep files from `helm-find-files'."
905   (helm-do-grep-1 (helm-marked-candidates :with-wildcard t)
906                   helm-current-prefix-arg))
907
908 (defun helm-ff-git-grep (_candidate)
909   "Default action to git-grep `helm-ff-default-directory'."
910   (helm-grep-git-1 helm-ff-default-directory helm-current-prefix-arg))
911
912 (defun helm-find-files-ag (_candidate)
913   (helm-grep-ag helm-ff-default-directory
914                 helm-current-prefix-arg))
915
916 (defun helm-ff-zgrep (_candidate)
917   "Default action to zgrep files from `helm-find-files'."
918   (helm-ff-zgrep-1 (helm-marked-candidates :with-wildcard t) helm-current-prefix-arg))
919
920 (defun helm-ff-pdfgrep (_candidate)
921   "Default action to pdfgrep files from `helm-find-files'."
922   (let* ((recurse nil)
923          (cands (cl-loop for file in (helm-marked-candidates :with-wildcard t)
924                          for dir = (file-directory-p file)
925                          when dir do (setq recurse t)
926                          when (or dir
927                                   (string= (file-name-extension file) "pdf")
928                                   (string= (file-name-extension file) "PDF"))
929                          collect file)))
930     (when cands
931       (helm-do-pdfgrep-1 cands recurse))))
932
933 (defun helm-ff-etags-select (candidate)
934   "Default action to jump to etags from `helm-find-files'."
935   (when (get-buffer helm-action-buffer)
936     (kill-buffer helm-action-buffer))
937   (let* ((source-name (assoc-default 'name (helm-get-current-source)))
938          (default-directory (if (string= source-name "Find Files")
939                                 helm-ff-default-directory
940                               (file-name-directory candidate))))
941     (helm-etags-select helm-current-prefix-arg)))
942
943 (defvar eshell-command-aliases-list nil)
944 (defvar helm-eshell-command-on-file-input-history nil)
945 (defun helm-find-files-eshell-command-on-file-1 (&optional map)
946   "Run `eshell-command' on CANDIDATE or marked candidates.
947 This is done possibly with an eshell alias, if no alias found, you can type in
948 an eshell command.
949
950 Only aliases accepting a file as argument at the end of command line
951 are collected, i.e aliases ending with \"$1\" or \"$*\".
952
953 Basename of CANDIDATE can be a wild-card.
954 e.g you can do \"eshell-command command *.el\"
955 Where \"*.el\" is the CANDIDATE.
956
957 It is possible to do eshell-command command <CANDIDATE> <some more args>
958 like this: \"command %s some more args\".
959
960 If MAP is given run `eshell-command' on all marked files at once,
961 Otherwise, run `eshell-command' on each marked files.
962 In other terms, with a prefix arg do on the three marked files
963 \"foo\" \"bar\" \"baz\":
964
965 \"eshell-command command foo bar baz\"
966
967 otherwise do
968
969 \"eshell-command command foo\"
970 \"eshell-command command bar\"
971 \"eshell-command command baz\"
972
973 Note:
974 You have to setup some aliases in eshell with the `alias' command or
975 by editing yourself the file `eshell-aliases-file' to make this
976 working."
977   (require 'em-alias) (eshell-read-aliases-list)
978   (when (or eshell-command-aliases-list
979             (y-or-n-p "No eshell aliases found, run eshell-command without alias anyway? "))
980     (let* ((cand-list (helm-marked-candidates))
981            (default-directory (or helm-ff-default-directory
982                                   ;; If candidate is an url *-ff-default-directory is nil
983                                   ;; so keep value of default-directory.
984                                   default-directory))
985            (command (helm-comp-read
986                      "Command: "
987                      (cl-loop for (a c) in (eshell-read-aliases-list)
988                               ;; Positional arguments may be double
989                               ;; quoted (Issue #1881).
990                               when (string-match "[\"]?.*\\(\\$1\\|\\$\\*\\)[\"]?\\'" c)
991                               collect (propertize a 'help-echo c) into ls
992                               finally return (sort ls 'string<))
993                      :buffer "*helm eshell on file*"
994                      :name "Eshell command"
995                      :mode-line
996                      '("Eshell alias"
997                        "C-h m: Help, \\[universal-argument]: Insert output at point")
998                      :help-message 'helm-esh-help-message
999                      :input-history
1000                      'helm-eshell-command-on-file-input-history))
1001            (alias-value (car (assoc-default command eshell-command-aliases-list)))
1002            cmd-line)
1003       (if (or (equal helm-current-prefix-arg '(16))
1004               (equal map '(16)))
1005           ;; Two time C-u from `helm-comp-read' mean print to current-buffer.
1006           ;; i.e `eshell-command' will use this value.
1007           (setq current-prefix-arg '(16))
1008           ;; Else reset the value of `current-prefix-arg'
1009           ;; to avoid printing in current-buffer.
1010           (setq current-prefix-arg nil))
1011       (if (and (or
1012                 ;; One prefix-arg have been passed before `helm-comp-read'.
1013                 ;; If map have been set with C-u C-u (value == '(16))
1014                 ;; ignore it.
1015                 (and map (equal map '(4)))
1016                 ;; One C-u from `helm-comp-read'.
1017                 (equal helm-current-prefix-arg '(4))
1018                 ;; An alias that finish with $*
1019                 (and alias-value
1020                      ;; If command is an alias be sure it accept
1021                      ;; more than one arg i.e $*.
1022                      (string-match "\\$\\*$" alias-value)))
1023                (cdr cand-list))
1024
1025           ;; Run eshell-command with ALL marked files as arguments.
1026           ;; This wont work on remote files, because tramp handlers depends
1027           ;; on `default-directory' (limitation).
1028           (let ((mapfiles (mapconcat 'eshell-quote-argument cand-list " ")))
1029             (if (string-match "'%s'\\|\"%s\"\\|%s" command)
1030                 (setq cmd-line (format command mapfiles)) ; See [1]
1031                 (setq cmd-line (format "%s %s" command mapfiles)))
1032             (helm-log "%S" cmd-line)
1033             (eshell-command cmd-line))
1034
1035           ;; Run eshell-command on EACH marked files.
1036           ;; To work with tramp handler we have to call
1037           ;; COMMAND on basename of each file, using
1038           ;; its basedir as `default-directory'.
1039           (cl-loop for f in cand-list
1040                    for dir = (and (not (string-match helm--url-regexp f))
1041                                   (helm-basedir f))
1042                    for file = (eshell-quote-argument
1043                                (format "%s" (if (and dir (file-remote-p dir))
1044                                                 (helm-basename f) f)))
1045                    for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
1046                                  ;; [1] This allow to enter other args AFTER filename
1047                                  ;; i.e <command %s some_more_args>
1048                                  (format command file)
1049                                  (format "%s %s" command file))
1050                    do (let ((default-directory (or dir default-directory)))
1051                         (eshell-command com)))))))
1052
1053 (defun helm-find-files-eshell-command-on-file (_candidate)
1054   "Run `eshell-command' on CANDIDATE or marked candidates.
1055 See `helm-find-files-eshell-command-on-file-1' for more info."
1056   (helm-find-files-eshell-command-on-file-1 helm-current-prefix-arg))
1057
1058 (defun helm-ff-switch-to-eshell (_candidate)
1059   "Switch to eshell and cd to `helm-ff-default-directory'.
1060
1061 With a numeric prefix arg switch to numbered eshell buffer, if no
1062 prefix arg provided and more than one eshell buffer exists, provide
1063 completions on those buffers.  If only one eshell buffer exists,
1064 switch to this one, if no eshell buffer exists or if the numeric
1065 prefix arg eshell buffer doesn't exists, create it and switch to it."
1066   (let ((cd-eshell (lambda ()
1067                      (eshell/cd helm-ff-default-directory)
1068                      (eshell-reset)))
1069         (bufs (cl-loop for b in (mapcar 'buffer-name (buffer-list))
1070                        when (helm-ff--eshell-interactive-buffer-p b)
1071                        collect b)))
1072     (helm-aif (and (null helm-current-prefix-arg)
1073                    (if (cdr bufs)
1074                        (helm-comp-read "Switch to eshell buffer: " bufs
1075                                        :must-match t)
1076                      (car bufs)))
1077         (switch-to-buffer it)
1078       (eshell helm-current-prefix-arg))
1079     (unless (get-buffer-process (current-buffer))
1080       (funcall cd-eshell))))
1081
1082 (defun helm-ff--eshell-interactive-buffer-p (buffer)
1083   (with-current-buffer buffer
1084     (and (eq major-mode 'eshell-mode)
1085          (save-excursion
1086            (goto-char (point-min))
1087            (eshell-next-prompt 1)
1088            (null (eql (point) (point-min)))))))
1089
1090 (defun helm-ff-touch-files (_candidate)
1091   "The touch files action for helm-find-files."
1092   (let* ((files (helm-marked-candidates))
1093          (split (cl-loop for f in files
1094                          for spt = (unless helm-current-prefix-arg
1095                                      (cons (helm-basedir f)
1096                                            (split-string f ", ?")))
1097                          if spt
1098                          append (cl-loop with dir = (car spt)
1099                                          for ff in (cdr spt)
1100                                          collect (expand-file-name ff dir))
1101                          else collect f))
1102          (timestamp (helm-comp-read
1103                      "Timestamp (default Now): "
1104                      (cl-loop for f in split
1105                               for time = (file-attributes f)
1106                               for date = (and time
1107                                               (format-time-string
1108                                                "%Y-%m-%d %H:%M:%S"
1109                                                (nth 5 time)))
1110                               when date
1111                               collect (cons (format "%s: %s"
1112                                                     (helm-basename f) date)
1113                                             date))
1114                      :default
1115                      (format-time-string "%Y-%m-%d %H:%M:%S"
1116                                          (current-time))))
1117          (failures
1118           (cl-loop with default-directory = helm-ff-default-directory
1119                    for f in split
1120                    for file = (or (file-remote-p f 'localname) f)
1121                    when (> (process-file
1122                             "touch" nil nil nil "-d" timestamp file)
1123                            0)
1124                    collect f)))
1125     (when failures
1126       (message "Failed to touch *%s files:\n%s"
1127                (length failures)
1128                (mapconcat (lambda (f) (format "- %s\n" f)) failures "")))))
1129
1130 (defun helm-ff-run-touch-files ()
1131   "Used to interactively run touch file action from keyboard."
1132   (interactive)
1133   (with-helm-alive-p
1134     (helm-exit-and-execute-action 'helm-ff-touch-files)))
1135 (put 'helm-ff-run-touch-files 'helm-only t)
1136
1137 (defun helm-ff-serial-rename-action (method)
1138   "Rename all marked files in `helm-ff-default-directory' with METHOD.
1139 See `helm-ff-serial-rename-1'."
1140   (let* ((helm--reading-passwd-or-string t)
1141          (cands     (helm-marked-candidates :with-wildcard t))
1142          (def-name  (car cands))
1143          (name      (helm-read-string "NewName: "
1144                                       (replace-regexp-in-string
1145                                        "[0-9]+$" ""
1146                                        (helm-basename
1147                                         def-name
1148                                         (file-name-extension def-name)))))
1149          (start     (read-number "StartAtNumber: "))
1150          (extension (helm-read-string "Extension: "
1151                                       (file-name-extension (car cands))))
1152          (dir       (expand-file-name
1153                      (helm-read-file-name
1154                       "Serial Rename to directory: "
1155                       :initial-input
1156                       (expand-file-name helm-ff-default-directory)
1157                       :test 'file-directory-p
1158                       :must-match t)))
1159          done)
1160     (with-helm-display-marked-candidates
1161       helm-marked-buffer-name (helm-ff--count-and-collect-dups cands)
1162       (if (y-or-n-p
1163            (format "Rename %s file(s) to <%s> like this ?\n%s "
1164                    (length cands) dir (format "%s <-> %s%s.%s"
1165                                               (helm-basename (car cands))
1166                                               name start extension)))
1167           (progn
1168             (helm-ff-serial-rename-1
1169              dir cands name start extension :method method)
1170             (setq done t)
1171             (message nil))))
1172     (if done
1173         (with-helm-current-buffer (helm-find-files-1 dir))
1174       (message "Operation aborted"))))
1175
1176 (defun helm-ff-member-directory-p (file directory)
1177   (let ((dir-file (expand-file-name
1178                    (file-name-as-directory (file-name-directory file))))
1179         (cur-dir  (expand-file-name (file-name-as-directory directory))))
1180     (string= dir-file cur-dir)))
1181
1182 (cl-defun helm-ff-serial-rename-1
1183     (directory collection new-name start-at-num extension &key (method 'rename))
1184   "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
1185 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
1186 EXTENSION is the file extension to use, in empty prompt,
1187 reuse the original extension of file.
1188 METHOD can be one of rename, copy or symlink.
1189 Files will be renamed if they are files of current directory, otherwise they
1190 will be treated with METHOD.
1191 Default METHOD is rename."
1192   ;; Maybe remove directories selected by error in collection.
1193   (setq collection (cl-remove-if 'file-directory-p collection))
1194   (let* ((tmp-dir  (file-name-as-directory
1195                     (concat (file-name-as-directory directory)
1196                             (symbol-name (cl-gensym "tmp")))))
1197          (fn       (cl-case method
1198                      (copy    'copy-file)
1199                      (symlink 'make-symbolic-link)
1200                      (rename  'rename-file)
1201                      (t (error "Error: Unknown method %s" method)))))
1202     (make-directory tmp-dir)
1203     (unwind-protect
1204          (progn
1205            ;; Rename all files to tmp-dir with new-name.
1206            ;; If files are not from start directory, use method
1207            ;; to move files to tmp-dir.
1208            (cl-loop for i in collection
1209                  for count from start-at-num
1210                  for fnum = (if (< count 10) "0%s" "%s")
1211                  for nname = (concat tmp-dir new-name (format fnum count)
1212                                      (if (not (string= extension ""))
1213                                          (format ".%s" (replace-regexp-in-string
1214                                                         "[.]" "" extension))
1215                                        (file-name-extension i 'dot)))
1216                  do (if (helm-ff-member-directory-p i directory)
1217                         (rename-file i nname)
1218                       (funcall fn i nname)))
1219            ;; Now move all from tmp-dir to destination.
1220            (cl-loop with dirlist = (directory-files
1221                                     tmp-dir t directory-files-no-dot-files-regexp)
1222                  for f in dirlist do
1223                  (if (file-symlink-p f)
1224                      (make-symbolic-link (file-truename f)
1225                                          (concat (file-name-as-directory directory)
1226                                                  (helm-basename f)))
1227                    (rename-file f directory))))
1228       (delete-directory tmp-dir t))))
1229
1230 (defun helm-ff-serial-rename (_candidate)
1231   "Serial rename all marked files to `helm-ff-default-directory'.
1232 Rename only file of current directory, and symlink files coming from
1233 other directories.
1234 See `helm-ff-serial-rename-1'."
1235   (helm-ff-serial-rename-action 'rename))
1236
1237 (defun helm-ff-serial-rename-by-symlink (_candidate)
1238   "Serial rename all marked files to `helm-ff-default-directory'.
1239 Rename only file of current directory, and symlink files coming from
1240 other directories.
1241 See `helm-ff-serial-rename-1'."
1242   (helm-ff-serial-rename-action 'symlink))
1243
1244 (defun helm-ff-serial-rename-by-copying (_candidate)
1245   "Serial rename all marked files to `helm-ff-default-directory'.
1246 Rename only file of current directory, and copy files coming from
1247 other directories.
1248 See `helm-ff-serial-rename-1'."
1249   (helm-ff-serial-rename-action 'copy))
1250
1251 (defvar helm-ff-query-replace-fnames-history-from nil)
1252 (defvar helm-ff-query-replace-fnames-history-to nil)
1253 (defun helm-ff-query-replace-on-filenames (candidates)
1254   "Query replace on filenames of CANDIDATES.
1255 This doesn't replace inside the files, only modify filenames."
1256   (with-helm-display-marked-candidates
1257     helm-marked-buffer-name
1258     (mapcar 'helm-basename candidates)
1259     (let* ((regexp (read-string "Replace regexp on filename(s): "
1260                                 nil 'helm-ff-query-replace-history-from
1261                                 (helm-basename (car candidates))))
1262            (rep    (read-string (format "Replace regexp `%s' with: " regexp)
1263                                 nil 'helm-ff-query-replace-history-to))
1264            subexp)
1265       (cl-loop with query = "y"
1266                with count = 0
1267                with target = nil
1268                for old in candidates
1269                for new = (concat (helm-basedir old)
1270                                  (helm--replace-regexp-in-buffer-string
1271                                   (save-match-data
1272                                     (cond ((string= regexp "%.")
1273                                            (setq subexp 1)
1274                                            (helm-ff--prepare-str-with-regexp
1275                                             (setq target (helm-basename old t))))
1276                                           ((string= regexp ".%")
1277                                            (setq subexp 1)
1278                                            (helm-ff--prepare-str-with-regexp
1279                                             (setq target (file-name-extension old))))
1280                                           ((string= regexp "%")
1281                                            (regexp-quote
1282                                             (setq target (helm-basename old))))
1283                                           ((string-match "%:\\([0-9]+\\):\\([0-9]+\\)" regexp)
1284                                            (setq subexp 1)
1285                                            (let ((beg (match-string 1 regexp))
1286                                                  (end (match-string 2 regexp))
1287                                                  (str (helm-basename old)))
1288                                              (setq target (substring str
1289                                                                      (string-to-number beg)
1290                                                                      (string-to-number end)))
1291                                              (helm-ff--prepare-str-with-regexp str beg end)))
1292                                           (t regexp)))
1293                                   (save-match-data
1294                                     (cond (;; Handle incremental
1295                                            ;; replacement with \# in
1296                                            ;; search and replace
1297                                            ;; feature in placeholder \@.
1298                                            (string-match
1299                                             "\\\\@/\\(.*\\)/\\(\\(?99:.*\\)\\\\#\\)/"
1300                                             rep)
1301                                            (replace-regexp-in-string
1302                                             (match-string 1 rep)
1303                                             (concat (match-string 99 rep)
1304                                                     (format "%03d" (1+ count)))
1305                                             target))
1306                                           ;; Incremental replacement
1307                                           ;; before or after \@.
1308                                           ((and (string-match-p "\\\\#" rep)
1309                                                 (string-match "\\\\@" rep))
1310                                            (replace-regexp-in-string
1311                                             "\\\\#" (format "%03d" (1+ count))
1312                                             (replace-match target t t rep)))
1313                                           ;; Simple incremental replacement.
1314                                           ((string-match "\\\\#" rep)
1315                                            (replace-match
1316                                             (format "%03d" (1+ count)) t t rep))
1317                                           ;; Substring replacement in placeholder.
1318                                           ((string-match
1319                                             "\\\\@:\\([0-9]*\\):\\([0-9]*\\)" rep)
1320                                            (replace-match (substring
1321                                                            target
1322                                                            (string-to-number
1323                                                             (match-string 1 rep))
1324                                                            (pcase (match-string 2 rep)
1325                                                              ((pred (string= ""))
1326                                                               (length target))
1327                                                              (res (string-to-number res))))
1328                                                           t t rep))
1329                                           ;; Search and replace in
1330                                           ;; placeholder. Doesn't
1331                                           ;; handle incremental here.
1332                                           ((string-match "\\\\@/\\(.*\\)/\\(.*\\)/" rep)
1333                                            (replace-match (replace-regexp-in-string
1334                                                            (match-string 1 rep)
1335                                                            (match-string 2 rep)
1336                                                            target t)
1337                                                           t t rep))
1338                                           ;; Simple replacement by placeholder.
1339                                           ((string-match "\\\\@" rep)
1340                                            (replace-match target t t rep))
1341                                           ;; Replacement with
1342                                           ;; upcase, downcase or
1343                                           ;; capitalized text.
1344                                           ((string= rep "%u") #'upcase)
1345                                           ((string= rep "%d") #'downcase)
1346                                           ((string= rep "%c") #'capitalize)
1347                                           ;; Simple replacement with
1348                                           ;; whole replacement regexp.
1349                                           (t rep)))
1350                                   (helm-basename old) t nil subexp))
1351                ;; If `regexp' is not matched in `old'
1352                ;; `replace-regexp-in-string' will
1353                ;; return `old' unmodified.
1354                unless (string= old new)
1355                do (progn
1356                     (when (file-exists-p new)
1357                       (setq new (concat (file-name-sans-extension new)
1358                                         (format "(%s)" count)
1359                                         (file-name-extension new t))))
1360                     (unless (string= query "!")
1361                       (setq query (helm-read-answer (format
1362                                                      "Replace `%s' by `%s' [!,y,n,q]"
1363                                                      old new)
1364                                                     '("y" "n" "!" "q"))))
1365                     (when (string= query "q")
1366                       (cl-return (message "Operation aborted")))
1367                     (unless (string= query "n")
1368                       (rename-file old new)
1369                       (cl-incf count)))
1370                finally (message "%d Files renamed" count))))
1371   ;; This fix the emacs bug where "Emacs-Lisp:" is sent
1372   ;; in minibuffer (not the echo area).
1373   (sit-for 0.1)
1374   (with-current-buffer (window-buffer (minibuffer-window))
1375     (delete-minibuffer-contents)))
1376
1377 (defun helm-ff--prepare-str-with-regexp (str &optional rep1 rep2)
1378   ;; This is used in `helm-ff-query-replace-on-filenames' to prepare
1379   ;; STR when REGEXP is specified as substring e.g %:1:3 in this case
1380   ;; substring from 1 to 3 in STR will be enclosed with parenthesis to
1381   ;; match this substring as a subexp e.g %:1:3 on string "emacs" will
1382   ;; be replaced by "e\\(ma\\)cs" using subexp 1 like this:
1383   ;; (helm--replace-regexp-in-buffer-string "e\\(ma\\)cs" "fo" "emacs" nil t 1)
1384   ;; => "efocs"
1385   ;;      ^^
1386   ;; Where "1" and "3" will be strings extracted with match-string
1387   ;; from regexp and refered respectively in this function as REP1 and
1388   ;; REP2.
1389   (let* ((from   (or (and rep1 (string-to-number rep1)) 0))
1390          (to     (or (and rep2 (string-to-number rep2)) (length str)))
1391          (subexp (concat "\\(" (regexp-quote (substring str from to)) "\\)"))
1392          (before-str (unless (zerop from)
1393                        (regexp-quote (substring str 0 from))))
1394          (after-str (unless (= to (length str))
1395                       (regexp-quote (substring str to (length str))))))
1396     (concat before-str subexp after-str)))
1397
1398 ;; The action.
1399 (defun helm-ff-query-replace-fnames-on-marked (_candidate)
1400   (let ((marked (helm-marked-candidates :with-wildcard t)))
1401     (helm-ff-query-replace-on-filenames marked)))
1402
1403 ;; The command for `helm-find-files-map'.
1404 (defun helm-ff-run-query-replace-fnames-on-marked ()
1405   (interactive)
1406   (with-helm-alive-p
1407     (helm-exit-and-execute-action 'helm-ff-query-replace-fnames-on-marked)))
1408 (put 'helm-ff-run-query-replace-fnames-on-marked 'helm-only t)
1409
1410 (defun helm-ff-query-replace (_candidate)
1411   (let ((bufs (cl-loop for f in (helm-marked-candidates :with-wildcard t)
1412                        collect (buffer-name (find-file-noselect f)))))
1413     (helm-buffer-query-replace-1 nil bufs)))
1414
1415 (defun helm-ff-query-replace-regexp (_candidate)
1416   (let ((bufs (cl-loop for f in (helm-marked-candidates :with-wildcard t)
1417                        collect (buffer-name (find-file-noselect f)))))
1418     (helm-buffer-query-replace-1 'regexp bufs)))
1419
1420 (defun helm-ff-run-query-replace ()
1421   (interactive)
1422   (with-helm-alive-p
1423     (helm-exit-and-execute-action 'helm-ff-query-replace)))
1424 (put 'helm-ff-run-query-replace 'helm-only t)
1425
1426 (defun helm-ff-run-query-replace-regexp ()
1427   (interactive)
1428   (with-helm-alive-p
1429     (helm-exit-and-execute-action 'helm-ff-query-replace-regexp)))
1430 (put 'helm-ff-run-query-replace-regexp 'helm-only t)
1431
1432 (defun helm-ff-toggle-auto-update (_candidate)
1433   (if helm-ff--deleting-char-backward
1434       (progn
1435         (message "[Auto expansion disabled]")
1436         (sit-for 1) (message nil)
1437         (setq helm-ff--auto-update-state nil))
1438     (setq helm-ff-auto-update-flag (not helm-ff-auto-update-flag))
1439     (setq helm-ff--auto-update-state helm-ff-auto-update-flag)
1440     (message "[Auto expansion %s]"
1441              (if helm-ff-auto-update-flag "enabled" "disabled"))))
1442
1443 (defun helm-ff-run-toggle-auto-update ()
1444   (interactive)
1445   (with-helm-alive-p
1446     (helm-attrset 'toggle-auto-update '(helm-ff-toggle-auto-update . never-split))
1447     (helm-execute-persistent-action 'toggle-auto-update)))
1448 (put 'helm-ff-run-toggle-auto-update 'helm-only t)
1449
1450 (defun helm-ff-delete-char-backward ()
1451   "Disable helm find files auto update and delete char backward."
1452   (interactive)
1453   (with-helm-alive-p
1454     (setq helm-ff-auto-update-flag nil)
1455     (setq helm-ff--deleting-char-backward t)
1456     (call-interactively
1457      (lookup-key (current-global-map)
1458                  (read-kbd-macro "DEL")))
1459     (helm--update-header-line)))
1460 (put 'helm-ff-delete-char-backward 'helm-only t)
1461
1462 (defun helm-ff-delete-char-backward--exit-fn ()
1463   (setq helm-ff-auto-update-flag helm-ff--auto-update-state)
1464   (setq helm-ff--deleting-char-backward nil))
1465
1466 (defun helm-ff-RET-1 (&optional must-match)
1467   "Used for RET action in `helm-find-files'.
1468 See `helm-ff-RET' for details.
1469 If MUST-MATCH is specified exit with
1470 `helm-confirm-and-exit-minibuffer' which handle must-match mechanism."
1471   (let ((cands (helm-marked-candidates))
1472         (sel   (helm-get-selection)))
1473     (cl-assert sel nil "Trying to exit with no candidates")
1474     (if (and (not (cdr cands))
1475              (file-directory-p sel)
1476              (not (string= "." (helm-basename sel))))
1477         (helm-execute-persistent-action)
1478       (if must-match
1479           (helm-confirm-and-exit-minibuffer)
1480         (helm-maybe-exit-minibuffer)))))
1481
1482 (defun helm-ff-RET ()
1483   "Default action for RET in `helm-find-files'.
1484
1485 Behave differently depending of `helm-selection':
1486
1487 - candidate basename is \".\" => open it in dired.
1488 - candidate is a directory    => expand it.
1489 - candidate is a file         => open it.
1490 - marked candidates (1+)      => open them with default action."
1491   (interactive)
1492   (helm-ff-RET-1))
1493
1494 (defun helm-ff-RET-must-match ()
1495   "Same as `helm-ff-RET' but used in must-match map."
1496   (interactive)
1497   (helm-ff-RET-1 t))
1498
1499 (defun helm-ff-run-grep ()
1500   "Run Grep action from `helm-source-find-files'."
1501   (interactive)
1502   (with-helm-alive-p
1503     (helm-exit-and-execute-action 'helm-find-files-grep)))
1504 (put 'helm-ff-run-grep 'helm-only t)
1505
1506 (defun helm-ff-run-git-grep ()
1507   "Run git-grep action from `helm-source-find-files'."
1508   (interactive)
1509   (with-helm-alive-p
1510     (helm-exit-and-execute-action 'helm-ff-git-grep)))
1511 (put 'helm-ff-run-git-grep 'helm-only t)
1512
1513 (defun helm-ff-run-grep-ag ()
1514   (interactive)
1515   (with-helm-alive-p
1516     (helm-exit-and-execute-action 'helm-find-files-ag)))
1517 (put 'helm-ff-run-grep-ag 'helm-only t)
1518
1519 (defun helm-ff-run-pdfgrep ()
1520   "Run Pdfgrep action from `helm-source-find-files'."
1521   (interactive)
1522   (with-helm-alive-p
1523     (helm-exit-and-execute-action 'helm-ff-pdfgrep)))
1524 (put 'helm-ff-run-pdfgrep 'helm-only t)
1525
1526 (defun helm-ff-run-zgrep ()
1527   "Run Grep action from `helm-source-find-files'."
1528   (interactive)
1529   (with-helm-alive-p
1530     (helm-exit-and-execute-action 'helm-ff-zgrep)))
1531 (put 'helm-ff-run-zgrep 'helm-only t)
1532
1533 (defun helm-ff-run-copy-file ()
1534   "Run Copy file action from `helm-source-find-files'."
1535   (interactive)
1536   (with-helm-alive-p
1537     (helm-exit-and-execute-action 'helm-find-files-copy)))
1538 (put 'helm-ff-run-copy-file 'helm-only t)
1539
1540 (defun helm-ff-run-rename-file ()
1541   "Run Rename file action from `helm-source-find-files'."
1542   (interactive)
1543   (with-helm-alive-p
1544     (helm-exit-and-execute-action 'helm-find-files-rename)))
1545 (put 'helm-ff-run-rename-file 'helm-only t)
1546
1547 (defun helm-ff-run-byte-compile-file ()
1548   "Run Byte compile file action from `helm-source-find-files'."
1549   (interactive)
1550   (with-helm-alive-p
1551     (helm-exit-and-execute-action 'helm-find-files-byte-compile)))
1552 (put 'helm-ff-run-byte-compile-file 'helm-only t)
1553
1554 (defun helm-ff-run-load-file ()
1555   "Run Load file action from `helm-source-find-files'."
1556   (interactive)
1557   (with-helm-alive-p
1558     (helm-exit-and-execute-action 'helm-find-files-load-files)))
1559 (put 'helm-ff-run-load-file 'helm-only t)
1560
1561 (defun helm-ff-run-eshell-command-on-file ()
1562   "Run eshell command on file action from `helm-source-find-files'."
1563   (interactive)
1564   (with-helm-alive-p
1565     (helm-exit-and-execute-action
1566      'helm-find-files-eshell-command-on-file)))
1567 (put 'helm-ff-run-eshell-command-on-file 'helm-only t)
1568
1569 (defun helm-ff-run-ediff-file ()
1570   "Run Ediff file action from `helm-source-find-files'."
1571   (interactive)
1572   (with-helm-alive-p
1573     (helm-exit-and-execute-action 'helm-find-files-ediff-files)))
1574 (put 'helm-ff-run-ediff-file 'helm-only t)
1575
1576 (defun helm-ff-run-ediff-merge-file ()
1577   "Run Ediff merge file action from `helm-source-find-files'."
1578   (interactive)
1579   (with-helm-alive-p
1580     (helm-exit-and-execute-action
1581      'helm-find-files-ediff-merge-files)))
1582 (put 'helm-ff-run-ediff-merge-file 'helm-only t)
1583
1584 (defun helm-ff-run-symlink-file ()
1585   "Run Symlink file action from `helm-source-find-files'."
1586   (interactive)
1587   (with-helm-alive-p
1588     (helm-exit-and-execute-action 'helm-find-files-symlink)))
1589 (put 'helm-ff-run-symlink-file 'helm-only t)
1590
1591 (defun helm-ff-run-relsymlink-file ()
1592   "Run Symlink file action from `helm-source-find-files'."
1593   (interactive)
1594   (with-helm-alive-p
1595     (helm-exit-and-execute-action 'helm-find-files-relsymlink)))
1596 (put 'helm-ff-run-relsymlink-file 'helm-only t)
1597
1598 (defun helm-ff-run-hardlink-file ()
1599   "Run Hardlink file action from `helm-source-find-files'."
1600   (interactive)
1601   (with-helm-alive-p
1602     (helm-exit-and-execute-action 'helm-find-files-hardlink)))
1603 (put 'helm-ff-run-hardlink-file 'helm-only t)
1604
1605 (defun helm-ff-delete-files (candidate)
1606   "Delete files default action."
1607   (funcall helm-ff-delete-files-function candidate))
1608
1609 (defun helm-ff-run-delete-file ()
1610   "Run Delete file action from `helm-source-find-files'."
1611   (interactive)
1612   (with-helm-alive-p
1613     (helm-exit-and-execute-action #'helm-ff-delete-files)))
1614 (put 'helm-ff-run-delete-file 'helm-only t)
1615
1616 (defun helm-ff-run-complete-fn-at-point ()
1617   "Run complete file name action from `helm-source-find-files'."
1618   (interactive)
1619   (with-helm-alive-p
1620     (helm-exit-and-execute-action
1621      'helm-insert-file-name-completion-at-point)))
1622 (put 'helm-ff-run-complete-fn-at-point 'helm-only t)
1623
1624 (defun helm-ff-run-switch-to-eshell ()
1625   "Run switch to eshell action from `helm-source-find-files'."
1626   (interactive)
1627   (with-helm-alive-p
1628     (helm-exit-and-execute-action 'helm-ff-switch-to-eshell)))
1629 (put 'helm-ff-run-switch-to-eshell 'helm-only t)
1630
1631 (defun helm-ff-run-switch-other-window ()
1632   "Run switch to other window action from `helm-source-find-files'.
1633 When a prefix arg is provided, split is done vertically."
1634   (interactive)
1635   (with-helm-alive-p
1636     (helm-exit-and-execute-action 'helm-find-files-other-window)))
1637 (put 'helm-ff-run-switch-other-window 'helm-only t)
1638
1639 (defun helm-ff-run-switch-other-frame ()
1640   "Run switch to other frame action from `helm-source-find-files'."
1641   (interactive)
1642   (with-helm-alive-p
1643     (helm-exit-and-execute-action 'find-file-other-frame)))
1644 (put 'helm-ff-run-switch-other-frame 'helm-only t)
1645
1646 (defun helm-ff-run-open-file-externally ()
1647   "Run open file externally command action from `helm-source-find-files'."
1648   (interactive)
1649   (with-helm-alive-p
1650     (helm-exit-and-execute-action 'helm-open-file-externally)))
1651 (put 'helm-ff-run-open-file-externally 'helm-only t)
1652
1653 (defun helm-ff-run-open-file-with-default-tool ()
1654   "Run open file externally command action from `helm-source-find-files'."
1655   (interactive)
1656   (with-helm-alive-p
1657     (helm-exit-and-execute-action 'helm-open-file-with-default-tool)))
1658 (put 'helm-ff-run-open-file-with-default-tool 'helm-only t)
1659
1660 (defun helm-ff-locate (candidate)
1661   "Locate action function for `helm-find-files'."
1662   (helm-locate-set-command)
1663   (let ((default (concat (helm-basename
1664                         (expand-file-name
1665                          candidate
1666                          helm-ff-default-directory))
1667                          (unless (or
1668                                   ;; "-b" is already added when fuzzy matching.
1669                                   helm-locate-fuzzy-match
1670                                   ;; The locate '-b' option doesn't exists
1671                                   ;; in everything (es).
1672                                   (and (eq system-type 'windows-nt)
1673                                        (string-match "^es" helm-locate-command)))
1674                            " -b"))))
1675     (helm-locate-1 helm-current-prefix-arg nil 'from-ff default)))
1676
1677 (defun helm-ff-run-locate ()
1678   "Run locate action from `helm-source-find-files'."
1679   (interactive)
1680   (with-helm-alive-p
1681     (helm-exit-and-execute-action 'helm-ff-locate)))
1682 (put 'helm-ff-run-locate 'helm-only t)
1683
1684 (defun helm-files-insert-as-org-link (candidate)
1685   (insert (format "[[%s][]]" candidate))
1686   (goto-char (- (point) 2)))
1687
1688 (defun helm-ff-run-insert-org-link ()
1689   (interactive)
1690   (with-helm-alive-p
1691     (helm-exit-and-execute-action 'helm-files-insert-as-org-link)))
1692 (put 'helm-ff-run-insert-org-link 'helm-only t)
1693
1694 (defun helm-ff-run-find-file-as-root ()
1695   (interactive)
1696   (with-helm-alive-p
1697     (helm-exit-and-execute-action 'helm-find-file-as-root)))
1698 (put 'helm-ff-run-find-file-as-root 'helm-only t)
1699
1700 (defun helm-ff-run-find-alternate-file ()
1701   (interactive)
1702   (with-helm-alive-p
1703     (helm-exit-and-execute-action 'find-alternate-file)))
1704 (put 'helm-ff-run-find-alternate-file 'helm-only t)
1705
1706 (defun helm-ff-run-mail-attach-files ()
1707   "Run mail attach files command action from `helm-source-find-files'."
1708   (interactive)
1709   (with-helm-alive-p
1710     (helm-exit-and-execute-action 'helm-ff-mail-attach-files)))
1711 (put 'helm-ff-run-mail-attach-files 'helm-only t)
1712
1713 (defun helm-ff-run-etags ()
1714   "Run Etags command action from `helm-source-find-files'."
1715   (interactive)
1716   (with-helm-alive-p
1717     (helm-exit-and-execute-action 'helm-ff-etags-select)))
1718 (put 'helm-ff-run-etags 'helm-only t)
1719
1720 (defvar lpr-printer-switch)
1721 (defun helm-ff-print (_candidate)
1722   "Print marked files.
1723
1724 You may to set in order
1725 variables `lpr-command',`lpr-switches' and/or `printer-name',
1726 but with no settings helm should detect your printer(s) and
1727 print with the default `lpr' settings.
1728
1729 NOTE: DO NOT set the \"-P\" flag in `lpr-switches', if you really
1730 have to modify this, do it in `lpr-printer-switch'.
1731
1732 Same as `dired-do-print' but for helm."
1733   (require 'lpr)
1734   (when (or helm-current-prefix-arg
1735             (not helm-ff-printer-list))
1736     (setq helm-ff-printer-list
1737           (helm-ff-find-printers)))
1738   (let* ((file-list (helm-marked-candidates :with-wildcard t))
1739          (len (length file-list))
1740          (printer-name (if helm-ff-printer-list
1741                            (helm-comp-read
1742                             "Printer: " helm-ff-printer-list)
1743                          printer-name))
1744          (lpr-switches
1745       (if (and (stringp printer-name)
1746            (string< "" printer-name))
1747           (cons (concat lpr-printer-switch printer-name)
1748             lpr-switches)
1749               lpr-switches))
1750          (command (helm-read-string
1751                    (format "Print *%s File(s):\n%s with: "
1752                            len
1753                            (mapconcat
1754                             (lambda (f) (format "- %s\n" f))
1755                             file-list ""))
1756                    (when (and lpr-command lpr-switches)
1757                      (mapconcat 'identity
1758                                 (cons lpr-command
1759                                       (if (stringp lpr-switches)
1760                                           (list lpr-switches)
1761                                           lpr-switches))
1762                                 " "))))
1763          (file-args (mapconcat (lambda (x)
1764                                    (format "'%s'" x))
1765                                file-list " "))
1766          (cmd-line (concat command " " file-args)))
1767     (if command
1768         (start-process-shell-command "helm-print" nil cmd-line)
1769       (error "Error: Please verify your printer settings in Emacs."))))
1770
1771 (defun helm-ff-run-print-file ()
1772   "Run Print file action from `helm-source-find-files'."
1773   (interactive)
1774   (with-helm-alive-p
1775     (helm-exit-and-execute-action 'helm-ff-print)))
1776 (put 'helm-ff-run-print-file 'helm-only t)
1777
1778 (defun helm-ff-checksum (file)
1779   "Calculate the checksum of FILE.
1780 The checksum is copied to kill-ring."
1781   (cl-assert (file-regular-p file)
1782              nil "`%s' is not a regular file" file)
1783   (let ((algo (intern (helm-comp-read
1784                        "Algorithm: "
1785                        '(md5 sha1 sha224 sha256 sha384 sha512))))
1786         (bn (helm-basename file)))
1787     (message "Calculating %s checksum for %s..." algo bn)
1788     (async-let ((sum (with-temp-buffer
1789                        (insert-file-contents-literally file)
1790                        (secure-hash algo (current-buffer)))))
1791       (kill-new sum)
1792       (message "Calculating %s checksum for `%s' done and copied to kill-ring" algo bn))))
1793
1794 (defun helm-ff-toggle-basename (_candidate)
1795   (with-helm-buffer
1796     (setq helm-ff-transformer-show-only-basename
1797           (not helm-ff-transformer-show-only-basename))
1798     (let* ((cand   (helm-get-selection nil t))
1799            (target (if helm-ff-transformer-show-only-basename
1800                        (helm-basename cand) cand)))
1801       (helm-force-update (concat (regexp-quote target) "$")))))
1802
1803 (defun helm-ff-run-toggle-basename ()
1804   (interactive)
1805   (with-helm-alive-p
1806     (unless (helm-empty-source-p)
1807       (helm-ff-toggle-basename nil))))
1808 (put 'helm-ff-run-toggle-basename 'helm-only t)
1809
1810 (defun helm-reduce-file-name (fname level)
1811   "Reduce FNAME by number LEVEL from end."
1812   ;; This version comes from issue #2004 (UNC paths) and should fix it.
1813   (while (> level 0)
1814     (unless (or (string= fname "/")
1815                 (string= (file-remote-p fname 'localname) "/"))
1816       (setq fname (expand-file-name
1817                    (concat (expand-file-name fname) "/../"))))
1818     (setq level (1- level)))
1819   fname)
1820
1821 (defvar helm-find-files--level-tree nil)
1822 (defvar helm-find-files--level-tree-iterator nil)
1823 (defun helm-find-files-up-one-level (arg)
1824   "Go up one level like unix command `cd ..'.
1825 If prefix numeric arg is given go ARG level up."
1826   (interactive "p")
1827   (with-helm-alive-p
1828     (let ((src (helm-get-current-source)))
1829       (when (and (helm-file-completion-source-p src)
1830                  (not (helm-ff--invalid-tramp-name-p)))
1831         (with-helm-window
1832           (when (helm-follow-mode-p)
1833             (helm-follow-mode -1) (message nil)))
1834         ;; When going up one level we want to be at the line
1835         ;; corresponding to actual directory, so store this info
1836         ;; in `helm-ff-last-expanded'.
1837         (let ((cur-cand (helm-get-selection nil nil src))
1838               (new-pattern (helm-reduce-file-name helm-pattern arg)))
1839           ;; Ensure visibility on all candidates for preselection.
1840           (helm-attrset 'candidate-number-limit
1841                         (if helm-ff-up-one-level-preselect
1842                             (max (gethash new-pattern
1843                                           helm-ff--directory-files-hash
1844                                           helm-ff-candidate-number-limit)
1845                                  helm-ff-candidate-number-limit)
1846                           helm-ff-candidate-number-limit))
1847           (cond ((file-directory-p helm-pattern)
1848                  (setq helm-ff-last-expanded helm-ff-default-directory))
1849                 ((file-exists-p helm-pattern)
1850                  (setq helm-ff-last-expanded helm-pattern))
1851                 ((and cur-cand (file-exists-p cur-cand))
1852                  (setq helm-ff-last-expanded cur-cand)))
1853           (unless helm-find-files--level-tree
1854             (setq helm-find-files--level-tree
1855                   (cons helm-ff-default-directory
1856                         helm-find-files--level-tree)))
1857           (setq helm-find-files--level-tree-iterator nil)
1858           (push new-pattern helm-find-files--level-tree)
1859           (helm-set-pattern new-pattern helm-suspend-update-flag)
1860           (with-helm-after-update-hook (helm-ff-retrieve-last-expanded)))))))
1861 (put 'helm-find-files-up-one-level 'helm-only t)
1862
1863 (defun helm-find-files-down-last-level ()
1864   "Retrieve previous paths reached by `C-l' in helm-find-files."
1865   (interactive)
1866   (with-helm-alive-p
1867     (when (and (helm-file-completion-source-p)
1868                (not (helm-ff--invalid-tramp-name-p)))
1869       (unless helm-find-files--level-tree-iterator
1870         (setq helm-find-files--level-tree-iterator
1871               (helm-iter-list (cdr helm-find-files--level-tree))))
1872       (setq helm-find-files--level-tree nil)
1873       (helm-aif (helm-iter-next helm-find-files--level-tree-iterator)
1874           (helm-set-pattern it)
1875         (setq helm-find-files--level-tree-iterator nil)))))
1876 (put 'helm-find-files-down-last-level 'helm-only t)
1877
1878 (defun helm-find-files--reset-level-tree ()
1879   (setq helm-find-files--level-tree-iterator nil
1880         helm-find-files--level-tree nil))
1881
1882 (add-hook 'helm-cleanup-hook 'helm-find-files--reset-level-tree)
1883 (add-hook 'post-self-insert-hook 'helm-find-files--reset-level-tree)
1884 (add-hook 'helm-after-persistent-action-hook 'helm-find-files--reset-level-tree)
1885
1886 (defun helm-ff-retrieve-last-expanded ()
1887   "Move overlay to last visited directory `helm-ff-last-expanded'.
1888 This happen after using `helm-find-files-up-one-level',
1889 or hitting C-j on \"..\"."
1890   (when helm-ff-last-expanded
1891     (let ((presel (if helm-ff-transformer-show-only-basename
1892                       (helm-basename
1893                        (directory-file-name helm-ff-last-expanded))
1894                     (directory-file-name helm-ff-last-expanded))))
1895       (with-helm-window
1896         (when (re-search-forward (concat "^" (regexp-quote presel) "$") nil t)
1897           (forward-line 0)
1898           (helm-mark-current-line)))
1899       (setq helm-ff-last-expanded nil))))
1900
1901 (defun helm-ff-move-to-first-real-candidate ()
1902   "When candidate is an incomplete file name move to first real candidate."
1903   (let* ((src (helm-get-current-source))
1904          (name (assoc-default 'name src))
1905          ;; Ensure `helm-file-completion-source-p' returns nil on
1906          ;; `helm-read-file-name' history.
1907          minibuffer-completing-file-name)
1908     (helm-aif (and (helm-file-completion-source-p src)
1909                    (not (helm-empty-source-p))
1910                    ;; Prevent dired commands moving to first real
1911                    ;; (Issue #910).
1912                    (or (memq (intern-soft name)
1913                              helm-ff-goto-first-real-dired-exceptions)
1914                        (not (string-match "\\`[Dd]ired-" name)))
1915                    helm-ff--move-to-first-real-candidate
1916                    (helm-get-selection nil nil src))
1917         (unless (or (not (stringp it))
1918                     (and (string-match helm-tramp-file-name-regexp it)
1919                          (not (file-remote-p it nil t)))
1920                     (file-exists-p it))
1921           (helm-next-line)))))
1922
1923 ;;; Auto-update - helm-find-files auto expansion of directories.
1924 ;;
1925 ;;
1926 (defun helm-ff-update-when-only-one-matched ()
1927   "Expand to directory when sole completion.
1928 When only one candidate is remaining and it is a directory,
1929 expand to this directory.
1930 This happen only when `helm-ff-auto-update-flag' is non--nil
1931 or when `helm-pattern' is equal to \"~/\"."
1932   (let ((src (helm-get-current-source)))
1933     (when (and (helm-file-completion-source-p src)
1934                (not (get-buffer-window helm-action-buffer 'visible))
1935                (not (helm-ff--invalid-tramp-name-p))
1936                (not (string-match-p "\\`[.]\\{2\\}[^/]+"
1937                                     (helm-basename helm-pattern))))
1938       (with-helm-buffer
1939         (let* ((history-p   (string= (assoc-default 'name src)
1940                                      "Read File Name History"))
1941                (pat         (if (string-match helm-tramp-file-name-regexp
1942                                               helm-pattern)
1943                                 (helm-ff--create-tramp-name helm-pattern)
1944                                 helm-pattern))
1945                (completed-p (string= (file-name-as-directory
1946                                       (expand-file-name
1947                                        (substitute-in-file-name pat)))
1948                                      helm-ff-default-directory))
1949                (candnum (helm-get-candidate-number))
1950                (lt2-p   (and (<= candnum 2)
1951                              (>= (string-width (helm-basename helm-pattern)) 2)))
1952                (cur-cand (prog2
1953                              (unless (or completed-p
1954                                          (file-exists-p pat)
1955                                          history-p (null lt2-p))
1956                                ;; Only one non--existing candidate
1957                                ;; and one directory candidate, move to it,
1958                                ;; but not when renaming, copying etc...,
1959                                ;; so for this use
1960                                ;; `helm-ff-move-to-first-real-candidate'
1961                                ;; instead of `helm-next-line' (Issue #910).
1962                                (helm-ff-move-to-first-real-candidate))
1963                              (helm-get-selection nil nil src))))
1964           (when (and (or (and helm-ff-auto-update-flag
1965                               (null helm-ff--deleting-char-backward)
1966                               ;; Issue #295
1967                               ;; File predicates are returning t
1968                               ;; with paths like //home/foo.
1969                               ;; So check it is not the case by regexp
1970                               ;; to allow user to do C-a / to start e.g
1971                               ;; entering a tramp method e.g /sudo::.
1972                               (not (string-match "\\`//" helm-pattern))
1973                               (not (eq last-command 'helm-yank-text-at-point)))
1974                          ;; Fix issue #542.
1975                          (string= helm-pattern "~/")
1976                          ;; Only one remaining directory, expand it.
1977                          (and (= candnum 1)
1978                               helm-ff--auto-update-state
1979                               (file-accessible-directory-p pat)
1980                               (null helm-ff--deleting-char-backward)))
1981                      (or
1982                       ;; Only one candidate remaining
1983                       ;; and at least 2 char in basename.
1984                       lt2-p
1985                       ;; Already completed.
1986                       completed-p)
1987                      (not history-p) ; Don't try to auto complete in history.
1988                      (stringp cur-cand)
1989                      (file-accessible-directory-p cur-cand))
1990             (if (and (not (helm-dir-is-dot cur-cand)) ; [1]
1991                      ;; Maybe we are here because completed-p is true
1992                      ;; but check this again to be sure. (Windows fix)
1993                      (<= candnum 2))    ; [2]
1994                 ;; If after going to next line the candidate
1995                 ;; is not one of "." or ".." [1]
1996                 ;; and only one candidate is remaining [2],
1997                 ;; assume candidate is a new directory to expand, and do it.
1998                 (helm-set-pattern (file-name-as-directory cur-cand))
1999                 ;; The candidate is one of "." or ".."
2000                 ;; that mean we have entered the last letter of the directory name
2001                 ;; in prompt, so expansion is already done, just add the "/" at end
2002                 ;; of name unless helm-pattern ends with "."
2003                 ;; (i.e we are writing something starting with ".")
2004                 (unless (string-match "\\`.*[.]\\{1\\}\\'" helm-pattern)
2005                   (helm-set-pattern
2006                    ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt.
2007                    (expand-file-name (file-name-as-directory helm-pattern)))))
2008             (helm-check-minibuffer-input)))))))
2009
2010 (defun helm-ff-auto-expand-to-home-or-root ()
2011   "Allow expanding to home/user directory or root or text yanked after pattern."
2012   (when (and (helm-file-completion-source-p)
2013              (with-current-buffer (window-buffer (minibuffer-window)) (eolp))
2014              (not (string-match helm-ff-url-regexp helm-pattern)))
2015     (cond ((and (not (file-remote-p helm-pattern))
2016                 (null (file-exists-p helm-pattern))
2017                 (string-match-p
2018                  "\\`\\([.]\\|\\s-\\)\\{2\\}[^/]+"
2019                  (helm-basename helm-pattern))
2020                 (string-match-p "/\\'" helm-pattern))
2021            (helm-ff-recursive-dirs helm-pattern)
2022            (with-helm-window (helm-check-minibuffer-input)))
2023           ((string-match
2024             "\\(?:\\`~/\\)\\|/?\\$.*/\\|/\\./\\|/\\.\\./\\|/~.*/\\|//\\|\\(/[[:alpha:]]:/\\|\\s\\+\\)"
2025             helm-pattern)
2026            (let* ((match (match-string 0 helm-pattern))
2027                   (input (cond ((string= match "/./")
2028                                 (expand-file-name default-directory))
2029                                ((string= helm-pattern "/../") "/")
2030                                ((string-match-p "\\`/\\$" match)
2031                                 (let ((sub (substitute-in-file-name match)))
2032                                   (if (file-directory-p sub)
2033                                       sub (replace-regexp-in-string "/\\'" "" sub))))
2034                                (t (helm-ff--expand-substitued-pattern helm-pattern)))))
2035              ;; `file-directory-p' returns t on "/home/me/." (issue #1844).
2036              (if (and (file-directory-p input)
2037                       (not (string-match-p "[^.]\\.\\'" input)))
2038                  (setq helm-ff-default-directory
2039                        (setq input (file-name-as-directory input)))
2040                  (setq helm-ff-default-directory (file-name-as-directory
2041                                                   (file-name-directory input))))
2042              (with-helm-window
2043                (helm-set-pattern input)
2044                (helm-check-minibuffer-input)))))))
2045
2046 (defun helm-ff--expand-file-name-no-dot (name &optional directory)
2047   "Prevent expanding \"/home/user/.\" to \"/home/user\"."
2048   ;; Issue #1844 - If user enter "~/." to type an hidden filename
2049   ;; don't expand to /home/him e.g.
2050   ;; (expand-file-name "~/.") =>"/home/thierry"
2051   ;; (helm-ff--expand-substitued-pattern "~/.") =>"/home/thierry/."
2052   (concat (expand-file-name name directory)
2053           (and (string-match "[^.]\\.\\'" name) "/.")))
2054
2055 (defun helm-ff--expand-substitued-pattern (pattern)
2056   ;; [Windows] On UNC paths "/" expand to current machine,
2057   ;; so use the root of current Drive. (i.e "C:/")
2058   (let* ((directory (and (memq system-type '(windows-nt ms-dos))
2059                          (getenv "SystemDrive")))
2060          ;; On Windows use a simple call to `expand-file-name' to
2061          ;; avoid Issue #2004.
2062          (expand-fn (if directory
2063                         #'expand-file-name
2064                       #'helm-ff--expand-file-name-no-dot)))
2065     (funcall expand-fn (helm-substitute-in-filename pattern)
2066              ;; directory is nil on Nix.
2067              directory)))
2068
2069 (defun helm-substitute-in-filename (fname)
2070   "Substitute all parts of FNAME from start up to \"~/\" or \"/\".
2071 On windows system substitute from start up to \"/[[:lower:]]:/\".
2072 This function is needed for `helm-ff-auto-expand-to-home-or-root'
2073 and should be used carefully elsewhere, or not at all, using
2074 `substitute-in-file-name' instead."
2075   (cond ((and helm--url-regexp
2076               (string-match-p helm--url-regexp fname))
2077          fname)
2078         ((and (file-remote-p fname)
2079               helm-substitute-in-filename-stay-on-remote)
2080          (let ((sub (substitute-in-file-name fname)))
2081            (if (file-directory-p sub)
2082                sub (replace-regexp-in-string "/\\'" "" sub))))
2083         (t
2084          (with-temp-buffer
2085            (insert fname)
2086            (goto-char (point-min))
2087            (when (memq system-type '(windows-nt ms-dos))
2088              (skip-chars-forward "/")) ;; Avoid infloop in UNC paths Issue #424
2089            (if (re-search-forward "~.*/?\\|//\\|/[[:alpha:]]:/" nil t)
2090                (let ((match (match-string 0)))
2091                  (goto-char (if (or (string= match "//")
2092                                     (string-match-p "/[[:alpha:]]:/" match))
2093                                 (1+ (match-beginning 0))
2094                                 (match-beginning 0)))
2095                  (buffer-substring-no-properties (point) (point-at-eol)))
2096                fname)))))
2097
2098 (defun helm-point-file-in-dired (file)
2099   "Put point on filename FILE in dired buffer."
2100   (unless (and helm--url-regexp
2101                (string-match-p helm--url-regexp file))
2102     (let ((target (expand-file-name (helm-substitute-in-filename file))))
2103       (dired (file-name-directory target))
2104       (dired-goto-file target))))
2105
2106 (defun helm-marked-files-in-dired (_candidate)
2107   "Open a dired buffer with only marked files.
2108
2109 With a prefix arg toggle dired buffer to wdired mode."
2110   (advice-add 'wdired-finish-edit :override #'helm--advice-wdired-finish-edit)
2111   (advice-add 'wdired-get-filename :override #'helm--advice-wdired-get-filename)
2112   (let* ((marked (helm-marked-candidates :with-wildcard t))
2113          (current (car marked)))
2114     (unless (and helm--url-regexp
2115                  (string-match-p helm--url-regexp current))
2116       (let ((target (expand-file-name (helm-substitute-in-filename current))))
2117         (dired (cons helm-ff-default-directory marked))
2118         (dired-goto-file target)
2119         (when (or helm-current-prefix-arg current-prefix-arg)
2120           (call-interactively 'wdired-change-to-wdired-mode))))))
2121
2122 (defun helm-ff-run-marked-files-in-dired ()
2123   "Execute `helm-marked-files-in-dired' interactively."
2124   (interactive)
2125   (with-helm-alive-p
2126     (helm-exit-and-execute-action 'helm-marked-files-in-dired)))
2127 (put 'helm-ff-run-marked-files-in-dired 'helm-only t)
2128
2129 (defun helm-ff--create-tramp-name (fname)
2130   "Build filename from `helm-pattern' like /su:: or /sudo::."
2131   ;; `tramp-make-tramp-file-name' takes 7 args on emacs-26 whereas it
2132   ;; takes only 5 args in emacs-24/25.
2133   (apply #'tramp-make-tramp-file-name
2134          ;; `tramp-dissect-file-name' returns a list in emacs-26
2135          ;; whereas in 24.5 it returns a vector, thus the car is a
2136          ;; symbol (`tramp-file-name') which is not needed as argument
2137          ;; for `tramp-make-tramp-file-name' so transform the cdr in
2138          ;; vector, and for 24.5 use directly the returned value.
2139          (cl-loop with v = (helm-ff--tramp-cons-or-vector
2140                             (tramp-dissect-file-name fname))
2141                   for i across v collect i)))
2142
2143 (defun helm-ff--tramp-cons-or-vector (vector-or-cons)
2144   "Return VECTOR-OR-CONS as a vector."
2145   (pcase vector-or-cons
2146     (`(,_l . ,ll) (vconcat ll))
2147     ((and vec (pred vectorp)) vec)))
2148
2149 (defun helm-ff--get-tramp-methods ()
2150   "Returns a list of the car of `tramp-methods'."
2151   (or helm-ff--tramp-methods
2152       (setq helm-ff--tramp-methods (mapcar 'car tramp-methods))))
2153
2154 (defun helm-ff--previous-mh-tramp-method (str)
2155   (save-match-data
2156     (with-temp-buffer
2157       (insert str)
2158       (when (re-search-backward
2159              (concat "\\([|]\\)\\("
2160                      (mapconcat 'identity (helm-ff--get-tramp-methods) "\\|")
2161                      "\\):")
2162              nil t)
2163         (list
2164          (buffer-substring-no-properties (point-at-bol) (match-beginning 2))
2165          (buffer-substring-no-properties (match-beginning 2) (match-end 2)))))))
2166
2167 (defun helm-ff--get-host-from-tramp-invalid-fname (fname)
2168   "Extract hostname from an incomplete tramp file name.
2169 Return nil on valid file name remote or not."
2170   ;; Check first if whole file is remote (file-remote-p is inefficient
2171   ;; in this case) otherwise we are matching e.g. /home/you/ssh:foo/
2172   ;; which is not a remote name.
2173   ;; FIXME this will not work with a directory or a file named like
2174   ;; "ssh:foo" and located at root (/) but it seems there is no real
2175   ;; solution apart disabling tramp-mode when a file/dir located at /
2176   ;; is matching helm-tramp-file-name-regexp; This would prevent usage
2177   ;; of tramp if one have such a directory at / (who would want to
2178   ;; have such a dir at / ???)  See emacs-bug#31489.
2179   (when (string-match-p helm-tramp-file-name-regexp fname)
2180     (let* ((bn    (helm-basename fname))
2181            (bd    (replace-regexp-in-string (regexp-quote bn) "" fname))
2182            (split (split-string bn ":" t))
2183            (meth  (car (member (car split)
2184                                (helm-ff--get-tramp-methods)))))
2185       (and meth (string= bd "/") (car (last split))))))
2186
2187 (cl-defun helm-ff--tramp-hostnames (&optional (pattern helm-pattern))
2188   "Get a list of hosts for tramp method found in `helm-pattern'.
2189 Argument PATTERN default to `helm-pattern', it is here only for debugging
2190 purpose."
2191   (when (string-match helm-tramp-file-name-regexp pattern)
2192     (let* ((mh-method   (helm-ff--previous-mh-tramp-method pattern))
2193            (method      (or (cadr mh-method) (match-string 1 pattern)))
2194            (current-mh-host (helm-aif (and mh-method
2195                                            (helm-ff--get-host-from-tramp-invalid-fname pattern))
2196                                 (concat (car mh-method) method ":"
2197                                         (car (split-string it "|" t)))))
2198            (all-methods (helm-ff--get-tramp-methods))
2199            (comps (cl-loop for (f . h) in (tramp-get-completion-function method)
2200                            append (cl-loop for e in (funcall f (car h))
2201                                            for host = (and (consp e) (cadr e))
2202                                            when (and host (not (member host all-methods)))
2203                                            collect (concat (or (car mh-method) "/")
2204                                                            method ":" host)))))
2205       (helm-fast-remove-dups
2206        (delq nil (cons current-mh-host comps))
2207        :test 'equal))))
2208
2209 (defun helm-ff-before-action-hook-fn ()
2210   "Exit helm when user try to execute action on an invalid tramp fname."
2211   (let* ((src (helm-get-current-source))
2212          (cand (helm-get-selection nil nil src)))
2213     (when (and (helm-file-completion-source-p src)
2214                (stringp cand)
2215                (helm-ff--invalid-tramp-name-p cand) ; Check candidate.
2216                (helm-ff--invalid-tramp-name-p)) ; check helm-pattern.
2217       (error "Error: Unknown file or directory `%s'" cand))))
2218 (add-hook 'helm-before-action-hook 'helm-ff-before-action-hook-fn)
2219
2220 (cl-defun helm-ff--invalid-tramp-name-p (&optional (pattern helm-pattern))
2221   "Return non--nil when PATTERN is an invalid tramp filename."
2222   (string= (helm-ff-set-pattern pattern)
2223            "Invalid tramp file name"))
2224
2225 (defun helm-ff--tramp-postfixed-p (str)
2226   (let (result)
2227     (save-match-data
2228       (with-temp-buffer
2229         (save-excursion (insert str))
2230         (helm-awhile (search-forward ":" nil t)
2231           (if (save-excursion
2232                 (forward-char -1)
2233                 (looking-back
2234                  (mapconcat 'identity (helm-ff--get-tramp-methods) "\\|")
2235                  (point-at-bol)))
2236               (setq result nil)
2237               (setq result it)))))
2238     result))
2239
2240 (defun helm-ff-set-pattern (pattern)
2241   "Handle tramp filenames in `helm-pattern'."
2242   (let* ((methods (helm-ff--get-tramp-methods))
2243          ;; Returns the position of last ":" entered.
2244          (postfixed (helm-ff--tramp-postfixed-p pattern))
2245          (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
2246          cur-method tramp-name)
2247     ;; In some rare cases tramp can return a nil input,
2248     ;; so be sure pattern is a string for safety (Issue #476).
2249     (unless pattern (setq pattern ""))
2250     (cond ((string-match helm-ff-url-regexp pattern) pattern)
2251           ((string-match "\\`\\$" pattern)
2252            (substitute-in-file-name pattern))
2253           ((string= pattern "") "")
2254           ((string-match "\\`[.]\\{1,2\\}/\\'" pattern)
2255            (expand-file-name pattern))
2256           ;; Directories ending by a dot (issue #1940)
2257           ((string-match "[^/][.]/\\'" pattern)
2258            (expand-file-name pattern))
2259           ((string-match ".*\\(~?/?[.]\\{1\\}/\\)\\'" pattern)
2260            (expand-file-name default-directory))
2261           ((string-match ".*\\(~//\\|//\\)\\'" pattern)
2262            (expand-file-name "/"))      ; Expand to "/" or "c:/"
2263           ((string-match "\\`\\(~/\\|.*/~/\\)\\'" pattern)
2264            (expand-file-name "~/"))
2265           ((string-match "\\`~/" pattern)
2266            (expand-file-name pattern))
2267           ;; Match "/method:maybe_hostname:~"
2268           ((and (string-match (concat reg "~") pattern)
2269                 postfixed
2270                 (setq cur-method (match-string 1 pattern))
2271                 (member cur-method methods))
2272            (setq tramp-name (expand-file-name
2273                              (helm-ff--create-tramp-name
2274                               (match-string 0 pattern))))
2275            (replace-match tramp-name nil t pattern))
2276           ;; Match "/method:maybe_hostname:"
2277           ((and (string-match reg pattern)
2278                 postfixed
2279                 (setq cur-method (match-string 1 pattern))
2280                 (member cur-method methods))
2281            (setq tramp-name (helm-ff--create-tramp-name
2282                              (match-string 0 pattern)))
2283            (replace-match tramp-name nil t pattern))
2284           ;; Match "/hostname:"
2285           ((and (string-match helm-tramp-file-name-regexp pattern)
2286                 postfixed
2287                 (setq cur-method (match-string 1 pattern))
2288                 (and cur-method (not (member cur-method methods))))
2289            (setq tramp-name (helm-ff--create-tramp-name
2290                              (match-string 0 pattern)))
2291            (replace-match tramp-name nil t pattern))
2292           ;; Match "/method:" in this case don't try to connect.
2293           ((and (null postfixed)
2294                 (string-match helm-tramp-file-name-regexp pattern)
2295                 (member (match-string 1 pattern) methods))
2296            "Invalid tramp file name")   ; Write in helm-buffer.
2297           ;; Return PATTERN unchanged.
2298           (t pattern))))
2299
2300 (defun helm-find-files-get-candidates (&optional require-match)
2301   "Create candidate list for `helm-source-find-files'."
2302   (let* ((path          (helm-ff-set-pattern helm-pattern))
2303          (dir-p         (file-accessible-directory-p path))
2304          basedir
2305          invalid-basedir
2306          non-essential
2307          (tramp-verbose helm-tramp-verbose)) ; No tramp message when 0.
2308     ;; Tramp check if path is valid without waiting a valid
2309     ;; connection and may send a file-error.
2310     (setq helm--ignore-errors (file-remote-p path))
2311     (set-text-properties 0 (length path) nil path)
2312     ;; Issue #118 allow creation of newdir+newfile.
2313     (unless (or
2314              ;; A tramp file name not completed.
2315              (string= path "Invalid tramp file name")
2316              ;; An empty pattern
2317              (string= path "")
2318              (and (string-match-p ":\\'" path)
2319                   (helm-ff--tramp-postfixed-p path))
2320              ;; Check if base directory of PATH is valid.
2321              (helm-aif (file-name-directory path)
2322                  ;; If PATH is a valid directory IT=PATH,
2323                  ;; else IT=basedir of PATH.
2324                  (file-directory-p it)))
2325       ;; BASEDIR is invalid, that's mean user is starting
2326       ;; to write a non--existing path in minibuffer
2327       ;; probably to create a 'new_dir' or a 'new_dir+new_file'.
2328       (setq invalid-basedir t))
2329     ;; Don't set now `helm-pattern' if `path' == "Invalid tramp file name"
2330     ;; like that the actual value (e.g /ssh:) is passed to
2331     ;; `helm-ff--tramp-hostnames'.
2332     (unless (or (string= path "Invalid tramp file name")
2333                 invalid-basedir)      ; Leave  helm-pattern unchanged.
2334       (setq helm-ff-auto-update-flag  ; [1]
2335             ;; Unless auto update is disabled start auto updating only
2336             ;; at third char.
2337             (unless (or (null helm-ff--auto-update-state)
2338                         ;; But don't enable auto update when
2339                         ;; deleting backward.
2340                         helm-ff--deleting-char-backward
2341                         (and dir-p (not (string-match-p "/\\'" path))))
2342               (or (>= (length (helm-basename path)) 3) dir-p)))
2343       ;; At this point the tramp connection is triggered.
2344       (helm-log
2345        "Pattern=%S"
2346        (setq helm-pattern (helm-ff--transform-pattern-for-completion path)))
2347       ;; This have to be set after [1] to allow deleting char backward.
2348       (setq basedir (or (helm-aand
2349                          (if (and dir-p helm-ff-auto-update-flag)
2350                              ;; Add the final "/" to path
2351                              ;; when `helm-ff-auto-update-flag' is enabled.
2352                              (file-name-as-directory path)
2353                            (if (string= path "")
2354                                "/" (file-name-directory path)))
2355                          (expand-file-name it))
2356                         default-directory))
2357       (setq helm-ff-default-directory
2358             (if (string= helm-pattern "")
2359                 (expand-file-name "/")  ; Expand to "/" or "c:/"
2360                 ;; If path is an url *default-directory have to be nil.
2361                 (unless (or (string-match helm-ff-url-regexp path)
2362                             (and helm--url-regexp
2363                                  (string-match helm--url-regexp path)))
2364                   basedir))))
2365     (when (and (string-match ":\\'" path)
2366                (file-remote-p basedir nil t))
2367       (setq helm-pattern basedir))
2368     (cond ((string= path "Invalid tramp file name")
2369            (or (helm-ff--tramp-hostnames) ; Hostnames completion.
2370                (prog2
2371                    ;; `helm-pattern' have not been modified yet.
2372                    ;; Set it here to the value of `path' that should be now
2373                    ;; "Invalid tramp file name" and set the candidates list
2374                    ;; to ("Invalid tramp file name") to make `helm-pattern'
2375                    ;; match single candidate "Invalid tramp file name".
2376                    (setq helm-pattern path)
2377                    ;; "Invalid tramp file name" is now printed
2378                    ;; in `helm-buffer'.
2379                    (list path))))
2380           ((or (and (file-regular-p path)
2381                     (eq last-repeatable-command 'helm-execute-persistent-action))
2382                ;; `ffap-url-regexp' don't match until url is complete.
2383                (string-match helm-ff-url-regexp path)
2384                invalid-basedir
2385                (and (not (file-exists-p path)) (string-match "/$" path))
2386                (and helm--url-regexp (string-match helm--url-regexp path)))
2387            (list path))
2388           ((string= path "") (helm-ff-directory-files "/"))
2389           ;; Check here if directory is accessible (not working on Windows).
2390           ((and (file-directory-p path) (not (file-readable-p path)))
2391            (list (format "file-error: Opening directory permission denied `%s'" path)))
2392           ;; A fast expansion of PATH is made only if `helm-ff-auto-update-flag'
2393           ;; is enabled.
2394           ((and dir-p helm-ff-auto-update-flag)
2395            (helm-ff-directory-files path))
2396           (t (append (unless (or require-match
2397                                  ;; When `helm-ff-auto-update-flag' has been
2398                                  ;; disabled, whe don't want PATH to be added on top
2399                                  ;; if it is a directory.
2400                                  dir-p)
2401                        (list path))
2402                      (helm-ff-directory-files basedir))))))
2403
2404 (defun helm-list-directory (directory)
2405   "List directory DIRECTORY.
2406
2407 If DIRECTORY is remote use `helm-list-directory-function' otherwise use
2408 `directory-files'."
2409   (if (file-remote-p directory)
2410       (funcall helm-list-directory-function directory)
2411     (directory-files directory t directory-files-no-dot-files-regexp)))
2412
2413 (defun helm-list-dir-lisp (directory)
2414   "List DIRECTORY with `file-name-all-completions' as backend.
2415
2416 Add a `helm-ff-dir' property on each fname ending with \"/\"."
2417   ;; NOTE: `file-name-all-completions' and `directory-files' and most
2418   ;; tramp file handlers don't handle cntrl characters in fnames, so
2419   ;; the displayed files will be plain wrong in this case, even worst
2420   ;; the filenames will be splitted in two or more filenames.
2421   (cl-loop for f in (sort (file-name-all-completions "" directory)
2422                           'string-lessp)
2423            unless (or (string= f "")
2424                       (member f '("./" "../"))
2425                       ;; Ignore the tramp names from /
2426                       ;; completion, e.g. ssh: scp: etc...
2427                       (char-equal (aref f (1- (length f))) ?:))
2428            if (and (helm--dir-name-p f)
2429                    (helm--dir-file-name f directory))
2430            collect (propertize it 'helm-ff-dir t)
2431            else collect (propertize (expand-file-name f directory)
2432                                     'helm-ff-file t)))
2433
2434 (defun helm-list-dir-external (dir)
2435   "List directory DIR with external shell command as backend.
2436
2437 This function is fast enough to be used for remote files and save the
2438 type of files at the same time in a property for using it later in the
2439 transformer."
2440   (let ((default-directory (file-name-as-directory
2441                             (expand-file-name dir))))
2442     (with-temp-buffer
2443       (when (eq (process-file-shell-command
2444                  (format
2445                   ;; -A remove dot files, -F append [*=@|/>] at eof
2446                   ;; and -Q quote the real filename.  If not using -Q,
2447                   ;; there is no way to distinguish if foo* is a real
2448                   ;; file or if it is foo the executable file so with
2449                   ;; -Q we have "foo"* for the executable file foo and
2450                   ;; "foo*" for the real file foo. The downside is
2451                   ;; that we need an extra step to remove the quotes
2452                   ;; at the end which impact performances.
2453                   "ls -A -1 -F -b -Q | awk -v dir=%s '{print dir $1}'"
2454                   (shell-quote-argument default-directory))
2455                  nil t nil)
2456                 0)
2457         (goto-char (point-min))
2458         (save-excursion
2459           (while (re-search-forward "[*=@|/>]$" nil t)
2460             ;; A line looks like /home/you/"foo"@
2461             (helm-acase (match-string 0)
2462               ("*" (replace-match "")
2463                    (put-text-property
2464                     (point-at-bol) (point-at-eol) 'helm-ff-exe t))
2465               ("@" (replace-match "")
2466                    (put-text-property
2467                     (point-at-bol) (point-at-eol) 'helm-ff-sym t))
2468               ("/" (replace-match "")
2469                    (put-text-property
2470                     (point-at-bol) (point-at-eol) 'helm-ff-dir t))
2471               (("=" "|" ">") (replace-match "")))))
2472         (while (re-search-forward "[\"]" nil t)
2473           (replace-match ""))
2474         (add-text-properties (point-min) (point-max) '(helm-ff-file t))
2475         (split-string (buffer-string) "\n" t)))))
2476
2477 (defun helm-ff-directory-files (directory)
2478   "List contents of DIRECTORY.
2479 Argument FULL mean absolute path.
2480 It is same as `directory-files' but always returns the
2481 dotted filename '.' and '..' even on root directories in Windows
2482 systems."
2483   (setq directory (file-name-as-directory
2484                    (expand-file-name directory)))
2485   (let* (file-error
2486          (ls   (condition-case err
2487                    (helm-list-directory directory)
2488                  ;; Handle file-error from here for Windows
2489                  ;; because predicates like `file-readable-p' and friends
2490                  ;; seem broken on emacs for Windows systems (always returns t).
2491                  ;; This should never be called on GNU/Linux/Unix
2492                  ;; as the error is properly intercepted in
2493                  ;; `helm-find-files-get-candidates' by `file-readable-p'.
2494                  (file-error
2495                   (prog1
2496                       (list (format "%s:%s"
2497                                     (car err)
2498                                     (mapconcat 'identity (cdr err) " ")))
2499                     (setq file-error t)))))
2500         (dot  (concat directory "."))
2501         (dot2 (concat directory "..")))
2502     (puthash directory (+ (length ls) 2) helm-ff--directory-files-hash)
2503     (append (and (not file-error) (list dot dot2)) ls)))
2504
2505 (defun helm-ff-handle-backslash (fname)
2506   ;; Allow creation of filenames containing a backslash.
2507   (cl-loop with bad = '((92 . ""))
2508         for i across fname
2509         if (assq i bad) concat (cdr it)
2510         else concat (string i)))
2511
2512 (defun helm-ff-fuzzy-matching-p ()
2513   (and helm-ff-fuzzy-matching
2514        (not (memq helm-mm-matching-method '(multi1 multi3p)))))
2515
2516 (defun helm-ff--transform-pattern-for-completion (pattern)
2517   "Maybe return PATTERN with it's basename modified as a regexp.
2518 This happen only when `helm-ff-fuzzy-matching' is enabled.
2519 This provide a similar behavior as `ido-enable-flex-matching'.
2520 See also `helm--mapconcat-pattern'.
2521 If PATTERN is an url returns it unmodified.
2522 When PATTERN contain a space fallback to multi-match.
2523 If basename contain one or more space fallback to multi-match.
2524 If PATTERN is a valid directory name,return PATTERN unchanged."
2525   ;; handle bad filenames containing a backslash (no more needed in
2526   ;; emacs-26, also prevent regexp matching with e.g. "\|").
2527   ;; (setq pattern (helm-ff-handle-backslash pattern))
2528   (let ((bn      (helm-basename pattern))
2529         (bd      (or (helm-basedir pattern) ""))
2530         ;; Trigger tramp connection with file-directory-p.
2531         (dir-p   (file-directory-p pattern))
2532         (tramp-p (cl-loop for (m . f) in tramp-methods
2533                        thereis (string-match m pattern))))
2534     ;; Always regexp-quote base directory name to handle
2535     ;; crap dirnames such e.g bookmark+
2536     (cond
2537       ((or (and dir-p tramp-p (string-match ":\\'" pattern))
2538            (string= pattern "")
2539            (and dir-p (<= (length bn) 2))
2540            ;; Fix Issue #541 when BD have a subdir similar
2541            ;; to BN, don't switch to match plugin
2542            ;; which will match both.
2543            (and dir-p (string-match (regexp-quote bn) bd)))
2544        ;; Use full PATTERN on e.g "/ssh:host:".
2545        (regexp-quote pattern))
2546       ;; Prefixing BN with a space call multi-match completion.
2547       ;; This allow showing all files/dirs matching BN (Issue #518).
2548       ;; FIXME: some multi-match methods may not work here.
2549       (dir-p (concat (regexp-quote bd) " " (regexp-quote bn)))
2550       ((or (not (helm-ff-fuzzy-matching-p))
2551            (string-match "\\s-" bn))    ; Fall back to multi-match.
2552        (concat (regexp-quote bd) bn))
2553       ((or (string-match "[*][.]?.*" bn) ; Allow entering wilcard.
2554            (string-match "/$" pattern)     ; Allow mkdir.
2555            (string-match helm-ff-url-regexp pattern)
2556            (and (string= helm-ff-default-directory "/") tramp-p))
2557        ;; Don't treat wildcards ("*") as regexp char.
2558        ;; (e.g ./foo/*.el => ./foo/[*].el)
2559        (concat (regexp-quote bd)
2560                (replace-regexp-in-string "[*]" "[*]" bn)))
2561       (t (concat (regexp-quote bd)
2562                  (if (>= (length bn) 2) ; wait 2nd char before concating.
2563                      (helm--mapconcat-pattern bn)
2564                      (concat ".*" (regexp-quote bn))))))))
2565
2566 (defun helm-dir-is-dot (dir)
2567   (string-match "\\(?:/\\|\\`\\)\\.\\{1,2\\}\\'" dir))
2568
2569 (defun helm-ff-save-history ()
2570   "Store the last value of `helm-ff-default-directory' in `helm-ff-history'.
2571 Note that only existing directories are saved here."
2572   (when (and helm-ff-default-directory
2573              (helm-file-completion-source-p)
2574              (file-directory-p helm-ff-default-directory))
2575     (set-text-properties 0 (length helm-ff-default-directory)
2576                          nil helm-ff-default-directory)
2577     (push helm-ff-default-directory helm-ff-history)))
2578 (add-hook 'helm-cleanup-hook 'helm-ff-save-history)
2579
2580 (defun helm-files-save-file-name-history (&optional force)
2581   "Save marked files to `file-name-history'."
2582   (let* ((src (helm-get-current-source))
2583          (src-name (assoc-default 'name src)))
2584     (when (or force (helm-file-completion-source-p src)
2585               (member src-name helm-files-save-history-extra-sources))
2586       (let ((mkd (helm-marked-candidates :with-wildcard t))
2587             (history-delete-duplicates t))
2588         (cl-loop for sel in mkd
2589               when (and sel
2590                         (stringp sel)
2591                         (file-exists-p sel)
2592                         (not (file-directory-p sel)))
2593               do
2594               ;; we use `abbreviate-file-name' here because
2595               ;; other parts of Emacs seems to,
2596               ;; and we don't want to introduce duplicates.
2597               (add-to-history 'file-name-history
2598                               (abbreviate-file-name sel)))))))
2599 (add-hook 'helm-exit-minibuffer-hook 'helm-files-save-file-name-history)
2600
2601 (defun helm-ff-valid-symlink-p (file)
2602   (helm-aif (condition-case-unless-debug nil
2603                 ;; `file-truename' send error
2604                 ;; on cyclic symlinks (Issue #692).
2605                 (file-truename file)
2606               (error nil))
2607       (file-exists-p it)))
2608
2609 (defun helm-get-default-mode-for-file (filename)
2610   "Return the default mode to open FILENAME."
2611   (let ((mode (cl-loop for (r . m) in auto-mode-alist
2612                     thereis (and (string-match r filename) m))))
2613     (or (and (symbolp mode) mode) "Fundamental")))
2614
2615 (defun helm-ff-properties (candidate)
2616   "Show file properties of CANDIDATE in a tooltip or message."
2617   (require 'helm-external) ; For `helm-get-default-program-for-file'.
2618   (helm-aif (helm-file-attributes candidate)
2619       (let* ((all                it)
2620              (dired-line         (helm-file-attributes
2621                                   candidate :dired t :human-size t))
2622              (type               (cl-getf all :type))
2623              (mode-type          (cl-getf all :mode-type))
2624              (owner              (cl-getf all :uid))
2625              (owner-right        (cl-getf all :user t))
2626              (group              (cl-getf all :gid))
2627              (group-right        (cl-getf all :group))
2628              (other-right        (cl-getf all :other))
2629              (size               (helm-file-human-size (cl-getf all :size)))
2630              (modif              (cl-getf all :modif-time))
2631              (access             (cl-getf all :access-time))
2632              (ext                (helm-get-default-program-for-file candidate))
2633              (tooltip-hide-delay (or helm-tooltip-hide-delay tooltip-hide-delay)))
2634         (if (and (display-graphic-p) tooltip-mode)
2635             (tooltip-show
2636              (concat
2637               (helm-basename candidate) "\n"
2638               dired-line "\n"
2639               (format "Mode: %s\n" (helm-get-default-mode-for-file candidate))
2640               (format "Ext prog: %s\n" (or (and ext (replace-regexp-in-string
2641                                                      " %s" "" ext))
2642                                            "Not defined"))
2643               (format "Type: %s: %s\n" type mode-type)
2644               (when (string= type "symlink")
2645                 (format "True name: '%s'\n"
2646                         (cond ((string-match "^\.#" (helm-basename candidate))
2647                                "Autosave symlink")
2648                               ((helm-ff-valid-symlink-p candidate)
2649                                (file-truename candidate))
2650                               (t "Invalid Symlink"))))
2651               (format "Owner: %s: %s\n" owner owner-right)
2652               (format "Group: %s: %s\n" group group-right)
2653               (format "Others: %s\n" other-right)
2654               (format "Size: %s\n" size)
2655               (format "Modified: %s\n" modif)
2656               (format "Accessed: %s\n" access)))
2657           (message dired-line) (sit-for 5)))
2658     (message "Permission denied, file not readable")))
2659
2660 (defun helm-ff-properties-persistent ()
2661   "Show properties without quitting helm."
2662   (interactive)
2663   (with-helm-alive-p
2664     (helm-attrset 'properties-action '(helm-ff-properties . never-split))
2665     (helm-execute-persistent-action 'properties-action)))
2666 (put 'helm-ff-properties-persistent 'helm-only t)
2667
2668 (defun helm-ff-persistent-delete ()
2669   "Delete current candidate without quitting."
2670   (interactive)
2671   (with-helm-alive-p
2672     (helm-attrset 'quick-delete '(helm-ff-quick-delete . never-split))
2673     (helm-execute-persistent-action 'quick-delete)))
2674 (put 'helm-ff-persistent-delete 'helm-only t)
2675
2676 (defun helm-ff-dot-file-p (file)
2677   "Check if FILE is `.' or `..'."
2678   (member (helm-basename file) '("." "..")))
2679
2680 (defun helm-ff-kill-buffer-fname (candidate)
2681   (let* ((buf      (get-file-buffer candidate))
2682          (buf-name (buffer-name buf)))
2683     (cond ((and buf (eq buf (get-buffer helm-current-buffer)))
2684            (user-error
2685             "Can't kill `helm-current-buffer' without quitting session"))
2686           (buf (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
2687           (t (message "No buffer to kill")))))
2688
2689 (defun helm-ff-kill-or-find-buffer-fname (candidate)
2690   "Find file CANDIDATE or kill it's buffer if it is visible.
2691 Never kill `helm-current-buffer'.
2692 Never kill buffer modified.
2693 This is called normally on third hit of \
2694 \\<helm-map>\\[helm-execute-persistent-action]
2695 in `helm-find-files-persistent-action-if'."
2696   (let* ((buf      (get-file-buffer candidate))
2697          (buf-name (buffer-name buf))
2698          (win (get-buffer-window buf))
2699          (helm--reading-passwd-or-string t))
2700     (cond ((and buf win (eq buf (get-buffer helm-current-buffer)))
2701            (user-error
2702             "Can't kill `helm-current-buffer' without quitting session"))
2703           ((and buf win (buffer-modified-p buf))
2704            (message "Can't kill modified buffer, please save it before"))
2705           ((and buf win)
2706            (kill-buffer buf)
2707            (if (and helm-persistent-action-display-window
2708                     (window-dedicated-p (next-window win 1)))
2709                (delete-window helm-persistent-action-display-window)
2710              (set-window-buffer win helm-current-buffer))
2711            (message "Buffer `%s' killed" buf-name))
2712           (t (find-file candidate)))))
2713
2714 (defun helm-ff-run-kill-buffer-persistent ()
2715   "Execute `helm-ff-kill-buffer-fname' without quitting."
2716   (interactive)
2717   (with-helm-alive-p
2718     (helm-attrset 'kill-buffer-fname 'helm-ff-kill-buffer-fname)
2719     (helm-execute-persistent-action 'kill-buffer-fname)))
2720 (put 'helm-ff-run-kill-buffer-persistent 'helm-only t)
2721
2722 ;; Preview with external tool
2723 (defun helm-ff-persistent-open-file-externally (file)
2724   (require 'helm-external)
2725   (if (helm-get-default-program-for-file file)
2726       (helm-open-file-externally file)
2727     (message "Please configure an external program for `*%s' file in `helm-external-programs-associations'"
2728              (file-name-extension file t))))
2729
2730 (defun helm-ff-run-preview-file-externally ()
2731   (interactive)
2732   (with-helm-alive-p
2733     (helm-attrset 'open-file-externally '(helm-ff-persistent-open-file-externally . never-split))
2734     (helm-execute-persistent-action 'open-file-externally)))
2735 (put 'helm-ff-run-preview-file-externally 'helm-only t)
2736
2737 (defun helm-ff-prefix-filename (fname &optional file-or-symlinkp new-file)
2738   "Return filename FNAME maybe prefixed with [?] or [@].
2739 If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
2740 existing filename or valid symlink and there is no need to test it.
2741 NEW-FILE when non--nil mean FNAME is a non existing file and
2742 return FNAME prefixed with [?]."
2743   (let* ((prefix-new (propertize
2744                       " " 'display
2745                       (propertize "[?]" 'face 'helm-ff-prefix)))
2746          (prefix-url (propertize
2747                       " " 'display
2748                       (propertize "[@]" 'face 'helm-ff-prefix))))
2749     (cond (file-or-symlinkp fname)
2750           ((or (string-match helm-ff-url-regexp fname)
2751                (and helm--url-regexp (string-match helm--url-regexp fname)))
2752            (concat prefix-url " " fname))
2753           (new-file (concat prefix-new " " fname)))))
2754
2755 (defun helm-ff-score-candidate-for-pattern (str pattern)
2756   (if (member str '("." ".."))
2757       200
2758       (helm-score-candidate-for-pattern str pattern)))
2759
2760 (defun helm-ff-sort-candidates-1 (candidates input)
2761   "Sort function for `helm-source-find-files'.
2762 Return candidates prefixed with basename of INPUT first."
2763   (if (or (and (file-directory-p input)
2764                (string-match "/\\'" input))
2765           (string-match "\\`\\$" input)
2766           (null candidates))
2767       candidates
2768       (let* ((c1        (car candidates))
2769              (cand1real (if (consp c1) (cdr c1) c1))
2770              (cand1     (unless (file-exists-p cand1real) c1))
2771              (rest-cand (if cand1 (cdr candidates) candidates))
2772              (memo-src  (make-hash-table :test 'equal))
2773              (all (sort rest-cand
2774                         (lambda (s1 s2)
2775                             (let* ((score (lambda (str)
2776                                             (helm-ff-score-candidate-for-pattern
2777                                              str (helm-basename input))))
2778                                    (bn1 (helm-basename (if (consp s1) (cdr s1) s1)))
2779                                    (bn2 (helm-basename (if (consp s2) (cdr s2) s2)))
2780                                    (sc1 (or (gethash bn1 memo-src)
2781                                             (puthash bn1 (funcall score bn1) memo-src)))
2782                                    (sc2 (or (gethash bn2 memo-src)
2783                                             (puthash bn2 (funcall score bn2) memo-src))))
2784                               (cond ((= sc1 sc2)
2785                                      (< (string-width bn1)
2786                                         (string-width bn2)))
2787                                     ((> sc1 sc2))))))))
2788         (if cand1 (cons cand1 all) all))))
2789
2790 (defun helm-ff-sort-candidates (candidates _source)
2791   "Sort function for `helm-source-find-files'.
2792 Return candidates prefixed with basename of `helm-input' first."
2793   (helm-ff-sort-candidates-1 candidates helm-input))
2794
2795 (defun helm-ff-boring-file-p (file)
2796   ;; Prevent user doing silly thing like
2797   ;; adding the dotted files to boring regexps (#924).
2798   (and (not (string-match "\\.$" file))
2799        (string-match  helm-ff--boring-regexp file)))
2800
2801 (defun helm-ff-filter-candidate-one-by-one (file)
2802   "`filter-one-by-one' Transformer function for `helm-source-find-files'."
2803   ;; Handle boring files
2804   (let ((basename (helm-basename file))
2805         dot)
2806     (unless (and helm-ff-skip-boring-files
2807                  (helm-ff-boring-file-p basename))
2808
2809       ;; Handle tramp files with minimal highlighting.
2810       (if (and (or (string-match-p helm-tramp-file-name-regexp helm-pattern)
2811                    (helm-file-on-mounted-network-p helm-pattern)))
2812           (let* (hostp
2813                  (disp (if (and helm-ff-transformer-show-only-basename
2814                                 (not (setq dot (helm-dir-is-dot file))))
2815                            (or (setq hostp
2816                                      (helm-ff--get-host-from-tramp-invalid-fname
2817                                       file))
2818                                basename)
2819                          file)))
2820             ;; Filename with cntrl chars e.g. foo^J
2821             ;; This will not work as long as most tramp file handlers doesn't
2822             ;; handle such case, e.g. file-name-all-completions,
2823             ;; directory-files, file-name-nondirectory etc...
2824             ;; Keep it though in case they fix this upstream...
2825             (setq disp (replace-regexp-in-string "[[:cntrl:]]" "?" disp))
2826             (cond (;; Dot directories . and ..
2827                    dot (propertize file 'face 'helm-ff-dotted-directory))
2828                   ;; Directories.
2829                   ((get-text-property 1 'helm-ff-dir file)
2830                    (cons (propertize disp 'face 'helm-ff-directory) file))
2831                   ;; Executable files.
2832                   ((get-text-property 1 'helm-ff-exe file)
2833                    (cons (propertize disp 'face 'helm-ff-executable) file))
2834                   ;; Symlinks.
2835                   ((get-text-property 1 'helm-ff-sym file)
2836                    (cons (propertize disp 'face 'helm-ff-symlink) file))
2837                   ;; Regular files.
2838                   ((get-text-property 1 'helm-ff-file file)
2839                    (cons (propertize disp 'face 'helm-ff-file) file))
2840                   ;; non existing files.
2841                   (t (cons (helm-ff-prefix-filename
2842                             (propertize disp 'face 'helm-ff-file)
2843                             hostp (unless hostp 'new-file))
2844                            file))))
2845
2846         ;; Highlight local files showing everything, symlinks, exe,
2847         ;; dirs etc...
2848         (let* ((disp (if (and helm-ff-transformer-show-only-basename
2849                               (not (setq dot (helm-dir-is-dot file)))
2850                               (not (and helm--url-regexp
2851                                         (string-match helm--url-regexp file)))
2852                               (not (string-match helm-ff-url-regexp file)))
2853                          (or (helm-ff--get-host-from-tramp-invalid-fname file)
2854                              basename)
2855                        file))
2856                (attr (file-attributes file))
2857                (type (car attr))
2858                x-bit)
2859           ;; Filename cntrl chars e.g. foo^J
2860           (setq disp (replace-regexp-in-string "[[:cntrl:]]" "?" disp))
2861           (cond ((string-match "file-error" file) file)
2862                 (;; A dead symlink.
2863                  (and (stringp type)
2864                       (not (helm-ff-valid-symlink-p file))
2865                       (not (string-match "^\\.#" basename)))
2866                  (cons (propertize disp 'face 'helm-ff-invalid-symlink)
2867                        file))
2868                 ;; A dotted directory symlinked.
2869                 ((and dot (stringp type))
2870                  (cons (propertize disp 'face 'helm-ff-dotted-symlink-directory)
2871                        file))
2872                 ;; A dotted directory.
2873                 ((helm-ff-dot-file-p file)
2874                  (cons (propertize disp 'face 'helm-ff-dotted-directory)
2875                        file))
2876                 ;; A symlink.
2877                 ((stringp type)
2878                  (cons (propertize disp 'display
2879                                    (concat (propertize disp 'face 'helm-ff-symlink)
2880                                            " -> "
2881                                            (propertize (abbreviate-file-name type)
2882                                                        'face 'helm-ff-truename)))
2883                        file))
2884                 ;; A directory.
2885                 ((eq t type)
2886                  (cons (propertize disp 'face 'helm-ff-directory)
2887                        file))
2888                 ;; A character device file.
2889                 ((and attr (string-match
2890                             "\\`[cp]" (setq x-bit (substring (nth 8 attr) 0 4))))
2891                  (cons (propertize disp 'face 'helm-ff-pipe)
2892                        file))
2893                 ;; A socket file.
2894                 ((and attr (string-match "\\`[s]" x-bit))
2895                  (cons (propertize disp 'face 'helm-ff-socket)
2896                        file))
2897                 ;; An executable file.
2898                 ((and attr
2899                       (string-match
2900                        "x\\'" x-bit))
2901                  (cons (propertize disp 'face 'helm-ff-executable)
2902                        file))
2903                 ;; An executable file with suid
2904                 ((and attr (string-match "s\\'" x-bit))
2905                  (cons (propertize disp 'face 'helm-ff-suid)
2906                        file))
2907                 ;; A file.
2908                 ((and attr (null type))
2909                  (cons (propertize disp 'face 'helm-ff-file)
2910                        file))
2911                 ;; A non--existing file.
2912                 (t (cons (helm-ff-prefix-filename
2913                           (propertize disp 'face 'helm-ff-file) nil 'new-file)
2914                          file))))))))
2915
2916 (defun helm-find-files-action-transformer (actions candidate)
2917   "Action transformer for `helm-source-find-files'."
2918   (let ((str-at-point (with-helm-current-buffer
2919                         (buffer-substring-no-properties
2920                          (point-at-bol) (point-at-eol)))))
2921     (when (file-regular-p candidate)
2922       (setq actions (helm-append-at-nth
2923                      actions '(("Checksum File" . helm-ff-checksum)) 4)))
2924     (cond ((and (string-match "Trash/files/?\\'" (helm-basedir candidate))
2925                 (not (member (helm-basename candidate) '("." "..")))
2926                 (file-exists-p candidate)
2927                 (executable-find "trash"))
2928            (helm-append-at-nth
2929             actions
2930             '(("Restore file(s) from trash" . helm-restore-file-from-trash)
2931               ("Delete file(s) from trash" . helm-ff-trash-rm))
2932             1))
2933           ((and helm--url-regexp
2934                 (not (string-match-p helm--url-regexp str-at-point))
2935                 (not (with-helm-current-buffer (eq major-mode 'dired-mode)))
2936                 (string-match-p ":\\([0-9]+:?\\)" str-at-point))
2937            (append '(("Find file to line number" . helm-ff-goto-linum))
2938                    actions))
2939           ((string-match (image-file-name-regexp) candidate)
2940            (helm-append-at-nth
2941             actions
2942             '(("Rotate image right `M-r'" . helm-ff-rotate-image-right)
2943               ("Rotate image left `M-l'" . helm-ff-rotate-image-left))
2944             3))
2945           ((string-match "\\.el$" (helm-aif (helm-marked-candidates)
2946                                      (car it) candidate))
2947            (helm-append-at-nth
2948             actions
2949             '(("Byte compile lisp file(s) `M-B, C-u to load'"
2950                . helm-find-files-byte-compile)
2951               ("Load File(s) `M-L'" . helm-find-files-load-files))
2952             2))
2953           ((and (string-match "\\.html?$" candidate)
2954                 (file-exists-p candidate))
2955            (helm-append-at-nth
2956             actions '(("Browse url file" . browse-url-of-file)) 2))
2957           ((or (string= (file-name-extension candidate) "pdf")
2958                (string= (file-name-extension candidate) "PDF"))
2959            (helm-append-at-nth
2960             actions '(("Pdfgrep File(s)" . helm-ff-pdfgrep)) 4))
2961           (t actions))))
2962
2963 (defun helm-ff-trash-action (fn names &rest args)
2964   "Execute a trash action FN on marked files.
2965
2966 Arg NAMES is a list of strings to pass to messages
2967 e.g. '(\"delete\" \"deleting\"), ARGS are other args to be passed to FN."
2968   (let ((mkd (helm-marked-candidates))
2969         errors)
2970     (with-helm-display-marked-candidates
2971         helm-marked-buffer-name
2972         (helm-ff--count-and-collect-dups (mapcar 'helm-basename mkd))
2973         (when (y-or-n-p (format "%s %s files from trash? "
2974                                 (capitalize (car names))
2975                                 (length mkd)))
2976           (message "%s files from trash..." (capitalize (cadr names)))
2977           (cl-loop for f in mkd do
2978                    (condition-case err
2979                        (apply fn f args)
2980                      (error (push (format "%s" (cadr err)) errors)
2981                             nil)))))
2982     (if errors
2983         (display-warning 'helm
2984                          (with-temp-buffer
2985                            (insert (format-time-string "%Y-%m-%d %H:%M:%S\n"
2986                                                        (current-time)))
2987                            (insert (format
2988                                     "Failed to %s %s/%s files from trash\n"
2989                                     (car names) (length errors) (length mkd)))
2990                            (insert (mapconcat 'identity errors "\n") "\n ")
2991                            (buffer-string))
2992                          :error
2993                          "*helm restore warnings*")
2994       (message "%s %s files from trash done"
2995                (capitalize (cadr names)) (length mkd)))))
2996
2997 (defun helm-ff-trash-rm (_candidate)
2998   "Delete marked-files from a Trash directory.
2999
3000 The Trash directory should be a directory compliant with
3001 <http://freedesktop.org/wiki/Specifications/trash-spec> and each file
3002 should have its '*.trashinfo' correspondent file in Trash/info
3003 directory."
3004   (helm-ff-trash-action 'helm-ff-trash-rm-1 '("delete" "deleting")))
3005
3006 (defun helm-restore-file-from-trash (_candidate)
3007   "Restore marked-files from a Trash directory.
3008
3009 The Trash directory should be a directory compliant with
3010 <http://freedesktop.org/wiki/Specifications/trash-spec> and each file
3011 should have its '*.trashinfo' correspondent file in Trash/info
3012 directory."
3013   (let* ((default-directory (file-name-as-directory
3014                              helm-ff-default-directory))
3015          (trashed-files (with-temp-buffer
3016                           (process-file "trash-list" nil t nil)
3017                           (split-string (buffer-string) "\n"))))
3018     (helm-ff-trash-action 'helm-restore-file-from-trash-1
3019                           '("restore" "restoring")
3020                           trashed-files)))
3021
3022 (defun helm-ff-trash-rm-1 (file)
3023   (let ((info-file (concat (helm-reduce-file-name file 2)
3024                            "info/" (helm-basename file)
3025                            ".trashinfo")))
3026     (cl-assert (file-exists-p file)
3027                nil (format "No such file or directory `%s'"
3028                            file))
3029     (cl-assert (file-exists-p info-file)
3030                nil (format "No such file or directory `%s'"
3031                            info-file))
3032     (delete-file file)
3033     (delete-file info-file)))
3034
3035 (defun helm-restore-file-from-trash-1 (file trashed-files)
3036   "Restore FILE from a trash directory.
3037 Arg TRASHED-FILES is the list of files in the trash directory obtained
3038 with 'trash-list' command."
3039   (let ((info-file (concat (helm-reduce-file-name file 2)
3040                            "info/"
3041                            (helm-basename file)
3042                            ".trashinfo"))
3043         (dest-file (helm-ff--get-dest-file-from-trash
3044                     trashed-files file)))
3045     (cl-assert (not (file-exists-p dest-file)) nil
3046                (format "File `%s' already exists" dest-file))
3047     (cl-assert dest-file nil "No such file in trash")
3048     (rename-file file dest-file)
3049     (delete-file info-file)))
3050
3051 (defun helm-ff--get-dest-file-from-trash (trashed-files file)
3052   (cl-loop for f in trashed-files
3053            when (string-match
3054                  (concat (regexp-quote (helm-basename file))
3055                          "\\'")
3056                  f)
3057            return
3058            (replace-regexp-in-string
3059             "\\`\\([0-9]\\{2,4\\}[-:][0-9]\\{2\\}[:-][0-9]\\{2\\} \\)\\{2\\}"
3060             "" f)))
3061
3062 (defun helm-ff-goto-linum (candidate)
3063   "Find file CANDIDATE and maybe jump to line number found in fname at point.
3064 line number should be added at end of fname preceded with \":\".
3065 e.g \"foo:12\"."
3066   (let ((linum (with-helm-current-buffer
3067                  (let ((str (buffer-substring-no-properties
3068                              (point-at-bol) (point-at-eol))))
3069                    (when (string-match ":\\([0-9]+:?\\)" str)
3070                      (match-string 1 str))))))
3071     (find-file candidate)
3072     (and linum (not (string= linum ""))
3073          (helm-goto-line (string-to-number linum) t))))
3074
3075 (defun helm-ff-mail-attach-files (_candidate)
3076   "Run `mml-attach-file' on `helm-marked-candidates'."
3077   (require 'mml)
3078   (let ((flist (helm-marked-candidates :with-wildcard t))
3079         (dest-buf (and (derived-mode-p 'message-mode 'mail-mode)
3080                        (current-buffer)))
3081         bufs)
3082     (unless dest-buf
3083       (setq bufs (cl-loop for b in (buffer-list)
3084                           when (with-current-buffer b
3085                                  (derived-mode-p 'message-mode 'mail-mode))
3086                           collect (buffer-name b)))
3087       (if (and bufs (y-or-n-p "Attach files to existing mail composition buffer? "))
3088           (setq dest-buf
3089                 (if (cdr bufs)
3090                     (helm-comp-read "Attach to buffer: " bufs :nomark t)
3091                   (car bufs)))
3092         (compose-mail)
3093         (setq dest-buf (current-buffer))))
3094     (switch-to-buffer dest-buf)
3095     (save-restriction
3096       (widen)
3097       (save-excursion
3098         (goto-char (point-max))
3099         (cl-loop for f in flist
3100                  do (mml-attach-file f (or (mm-default-file-encoding f)
3101                                            "application/octet-stream")))))))
3102
3103 (defvar image-dired-display-image-buffer)
3104 (defun helm-ff-rotate-current-image-1 (file &optional num-arg)
3105   "Rotate current image at NUM-ARG degrees.
3106 This is a destructive operation on FILE made by external tool mogrify."
3107   (setq file (file-truename file)) ; For symlinked images.
3108   ;; When FILE is not an image-file, do nothing.
3109   (when (string-match (image-file-name-regexp) file)
3110     (if (executable-find "mogrify")
3111         (progn
3112           (shell-command (format "mogrify -rotate %s %s"
3113                                  (or num-arg 90)
3114                                  (shell-quote-argument file)))
3115           (when (buffer-live-p image-dired-display-image-buffer)
3116             (kill-buffer image-dired-display-image-buffer))
3117           (image-dired-display-image file)
3118           (message nil)
3119           (display-buffer (get-buffer image-dired-display-image-buffer)))
3120       (error "mogrify not found"))))
3121
3122 (defun helm-ff-rotate-image-left (candidate)
3123   "Rotate image file CANDIDATE left.
3124 This affect directly file CANDIDATE."
3125   (helm-ff-rotate-current-image-1 candidate -90))
3126
3127 (defun helm-ff-rotate-image-right (candidate)
3128   "Rotate image file CANDIDATE right.
3129 This affect directly file CANDIDATE."
3130   (helm-ff-rotate-current-image-1 candidate))
3131
3132 (defun helm-ff-rotate-left-persistent ()
3133   "Rotate image left without quitting helm."
3134   (interactive)
3135   (with-helm-alive-p
3136     (helm-attrset 'image-action1 'helm-ff-rotate-image-left)
3137     (helm-execute-persistent-action 'image-action1)))
3138 (put 'helm-ff-rotate-left-persistent 'helm-only t)
3139
3140 (defun helm-ff-rotate-right-persistent ()
3141   "Rotate image right without quitting helm."
3142   (interactive)
3143   (with-helm-alive-p
3144     (helm-attrset 'image-action2 'helm-ff-rotate-image-right)
3145     (helm-execute-persistent-action 'image-action2)))
3146 (put 'helm-ff-rotate-right-persistent 'helm-only t)
3147
3148 (defun helm-ff-exif-data (candidate)
3149   "Extract exif data from file CANDIDATE using `helm-ff-exif-data-program'."
3150   (if (and helm-ff-exif-data-program
3151            (executable-find helm-ff-exif-data-program))
3152       (shell-command-to-string (format "%s %s %s"
3153                                        helm-ff-exif-data-program
3154                                        helm-ff-exif-data-program-args
3155                                        candidate))
3156     (format "No program %s found to extract exif"
3157             helm-ff-exif-data-program)))
3158
3159 (cl-defun helm-find-files-persistent-action-if (candidate)
3160   "Open subtree CANDIDATE without quitting helm.
3161 If CANDIDATE is not a directory expand CANDIDATE filename.
3162 If CANDIDATE is alone, open file CANDIDATE filename.
3163 That's mean:
3164 First hit on C-j expand CANDIDATE second hit open file.
3165 If a prefix arg is given or `helm-follow-mode' is on open file."
3166   (let* ((follow        (or (helm-follow-mode-p)
3167                             helm--temp-follow-flag))
3168          (image-cand    (string-match-p (image-file-name-regexp) candidate))
3169          (new-pattern   (helm-get-selection))
3170          (num-lines-buf (with-current-buffer helm-buffer
3171                           (count-lines (point-min) (point-max))))
3172          (insert-in-minibuffer (lambda (fname)
3173                                    (with-selected-window (or (active-minibuffer-window)
3174                                                              (minibuffer-window))
3175                                      (unless follow
3176                                        (delete-minibuffer-contents)
3177                                        (set-text-properties 0 (length fname)
3178                                                             nil fname)
3179                                        (insert fname))))))
3180     (helm-attrset 'candidate-number-limit helm-ff-candidate-number-limit)
3181     (unless image-cand
3182       (when follow
3183         (helm-follow-mode -1)
3184         (cl-return-from helm-find-files-persistent-action-if
3185           (message "Helm-follow-mode allowed only on images, disabling"))))
3186     (cond ((and (helm-ff--invalid-tramp-name-p)
3187                 (string-match helm-tramp-file-name-regexp candidate))
3188            (cons (lambda (_candidate)
3189                    ;; First hit insert hostname and
3190                    ;; second hit insert ":" and expand.
3191                    (if (string= candidate helm-pattern)
3192                        (funcall insert-in-minibuffer (concat candidate ":"))
3193                      (funcall insert-in-minibuffer candidate)))
3194                  'never-split))
3195           (;; A symlink directory, expand it but not to its truename
3196            ;; unless a prefix arg is given.
3197            (and (file-directory-p candidate) (file-symlink-p candidate))
3198            (cons (lambda (_candidate)
3199                    (funcall insert-in-minibuffer
3200                             (file-name-as-directory
3201                              (if current-prefix-arg
3202                                  (file-truename (expand-file-name candidate))
3203                                (expand-file-name candidate)))))
3204                  'never-split))
3205           ;; A directory, open it.
3206           ((file-directory-p candidate)
3207            (cons (lambda (_candidate)
3208                    (when (string= (helm-basename candidate) "..")
3209                      (setq helm-ff-last-expanded helm-ff-default-directory))
3210                    (funcall insert-in-minibuffer (file-name-as-directory
3211                                                   (expand-file-name candidate))))
3212                  'never-split))
3213           ;; A symlink file, expand to it's true name. (first hit)
3214           ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
3215            (cons (lambda (_candidate)
3216                    (funcall insert-in-minibuffer (file-truename candidate)))
3217                  'never-split))
3218           ;; A regular file, expand it, (first hit)
3219           ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
3220            (cons (lambda (_candidate)
3221                    (setq helm-pattern "")       ; Force update.
3222                    (funcall insert-in-minibuffer new-pattern))
3223                  'never-split))
3224           ;; An image file and it is the second hit on C-j,
3225           ;; show the file in `image-dired'.
3226           (image-cand
3227            (lambda (_candidate)
3228              (require 'image-dired)
3229              (let* ((win (get-buffer-window
3230                           image-dired-display-image-buffer 'visible))
3231                     (fname (and win
3232                                 (with-selected-window win
3233                                   (get-text-property (point-min)
3234                                                      'original-file-name))))
3235                     (remove-buf-only (and win
3236                                           fname
3237                                           (with-helm-buffer
3238                                             (file-equal-p candidate fname)))))
3239                (when remove-buf-only
3240                  (with-helm-window
3241                    (if (and helm-persistent-action-display-window
3242                             (window-dedicated-p (next-window win 1)))
3243                        (delete-window helm-persistent-action-display-window)
3244                      (set-window-buffer win helm-current-buffer))))
3245                (when (buffer-live-p (get-buffer image-dired-display-image-buffer))
3246                  (kill-buffer image-dired-display-image-buffer))
3247                (unless remove-buf-only
3248                  ;; Fix emacs bug never fixed upstream.
3249                  (unless (file-directory-p image-dired-dir)
3250                    (make-directory image-dired-dir))
3251                  (switch-to-buffer image-dired-display-image-buffer)
3252                  (message "Resizing image...")
3253                  (cl-letf (((symbol-function 'message) #'ignore))
3254                    (image-dired-display-image candidate))
3255                  (message "Resizing image done")
3256                  (with-current-buffer image-dired-display-image-buffer
3257                    (let ((exif-data (helm-ff-exif-data candidate)))
3258                      (setq default-directory helm-ff-default-directory)
3259                      (image-dired-update-property 'help-echo exif-data)))))))
3260           ;; Allow browsing archive on avfs fs.
3261           ;; Assume volume is already mounted with mountavfs.
3262           ((helm-aand helm-ff-avfs-directory
3263                       (file-name-directory candidate)
3264                       (string-match
3265                        (regexp-quote (expand-file-name helm-ff-avfs-directory))
3266                        it)
3267                       (helm-ff-file-compressed-p candidate))
3268            (cons (lambda (_candidate)
3269                    (funcall insert-in-minibuffer (concat candidate "#/")))
3270                  'never-split))
3271           ;; File doesn't exists and basename starts with ".." or "  ",
3272           ;; Start a recursive search for directories.
3273           ((and (not (file-exists-p candidate))
3274                 (not (file-remote-p candidate))
3275                 (string-match-p "\\`\\([.]\\|\\s-\\)\\{2\\}[^/]+"
3276                                 (helm-basename candidate)))
3277            ;; As soon as the final "/" is added the job is passed
3278            ;; to `helm-ff-auto-expand-to-home-or-root'.
3279            (cons (lambda (_candidate)
3280                    (funcall insert-in-minibuffer (concat candidate "/")))
3281                  'never-split))
3282           ;; File is not existing and have no basedir, typically when
3283           ;; user hit C-k (minibuffer is empty) and then write foo and
3284           ;; hit C-j. This make clear that when no basedir, helm will
3285           ;; create the file in default-directory.
3286           ((and (not (file-exists-p candidate))
3287                 (not (helm-basedir candidate)))
3288            (cons (lambda (_candidate)
3289                    (funcall insert-in-minibuffer
3290                             (expand-file-name candidate default-directory)))
3291                  'never-split))
3292           ;; On second hit we open file.
3293           ;; On Third hit we kill it's buffer maybe.
3294           (t
3295            (lambda (_candidate)
3296              (funcall helm-ff-kill-or-find-buffer-fname-fn candidate))))))
3297
3298
3299 ;;; Recursive dirs completion
3300 ;;
3301 (defun helm-find-files-recursive-dirs (directory &optional input)
3302   (when (string-match "\\(\\s-+\\|[.]\\)\\{2\\}" input)
3303     (setq input (replace-match "" nil t input)))
3304   (message "Recursively searching %s from %s ..."
3305            input (abbreviate-file-name directory))
3306   ;; Ensure to not create a new frame
3307   (let (helm-actions-inherit-frame-settings)
3308     (helm :sources
3309           (helm-make-source
3310               "Recursive directories" 'helm-locate-subdirs-source
3311             :basedir (if (string-match-p
3312                           "\\`es" helm-locate-recursive-dirs-command)
3313                          directory
3314                        (shell-quote-argument directory))
3315             :subdir (shell-quote-argument input)
3316             :candidate-transformer
3317             `((lambda (candidates)
3318                 (cl-loop for c in candidates
3319                          when (and (file-directory-p c)
3320                                    (null (helm-boring-directory-p
3321                                           c helm-boring-file-regexp-list))
3322                                    (string-match-p ,(regexp-quote input)
3323                                                    (helm-basename c)))
3324                          collect (propertize c 'face 'helm-ff-dirs)))
3325               helm-w32-pathname-transformer
3326               (lambda (candidates)
3327                 (helm-ff-sort-candidates-1 candidates ,input)))
3328             :persistent-action 'ignore
3329             :action (lambda (c)
3330                       (helm-set-pattern
3331                        (file-name-as-directory (expand-file-name c)))))
3332           :candidate-number-limit 999999
3333           :allow-nest t
3334           :resume 'noresume
3335           :ff-transformer-show-only-basename nil
3336           :buffer "*helm recursive dirs*")))
3337
3338 (defun helm-ff-recursive-dirs (_candidate)
3339   "Launch a recursive search in `helm-ff-default-directory'."
3340   (with-helm-default-directory helm-ff-default-directory
3341       (helm-find-files-recursive-dirs
3342        (helm-current-directory)
3343        (helm-basename (helm-get-selection)))))
3344
3345 (defun helm-ff-file-compressed-p (candidate)
3346   "Whether CANDIDATE is a compressed file or not."
3347   (member (file-name-extension candidate)
3348           helm-ff-file-compressed-list))
3349
3350 (defun helm-ff--fname-at-point ()
3351   "Try to guess fname at point."
3352   (let ((end (point))
3353         (limit (helm-aif (bounds-of-thing-at-point 'filename)
3354                    (car it)
3355                  (point))))
3356     (save-excursion
3357       (while (re-search-backward "\\(~\\|/\\|[[:lower:][:upper:]]:/\\)"
3358                                  limit t))
3359       (buffer-substring-no-properties (point) end))))
3360
3361 (defun helm-insert-file-name-completion-at-point (_candidate)
3362   "Insert file name completion at point.
3363
3364 When completing i.e. there is already something at point, insert
3365 filename abbreviated, relative or full according to initial input,
3366 whereas when inserting i.e. there is nothing at point, insert filename
3367 full, abbreviated or relative according to prefix arg, respectively no
3368 prefix arg, one prefix arg or two prefix arg."
3369   (with-helm-current-buffer
3370     (if buffer-read-only
3371         (error "Error: Buffer `%s' is read-only" (buffer-name))
3372       (let* ((mkds        (helm-marked-candidates :with-wildcard t))
3373              (candidate   (car mkds))
3374              (end         (point))
3375              (tap         (helm-ff--fname-at-point))
3376              (guess       (and (stringp tap)
3377                                (substring-no-properties tap)))
3378              (beg         (if guess (- (point) (length guess)) (point)))
3379              (full-path-p (and (stringp guess)
3380                                (or (string-match-p
3381                                     (concat "^" (getenv "HOME"))
3382                                     guess)
3383                                    (string-match-p
3384                                     "\\`\\(/\\|[[:lower:][:upper:]]:/\\)"
3385                                     guess))))
3386              (escape-fn (with-helm-current-buffer
3387                           (if (memq major-mode
3388                                     helm-modes-using-escaped-strings)
3389                               #'shell-quote-argument #'identity))))
3390         (insert
3391          (funcall escape-fn (helm-ff--insert-fname
3392                              candidate beg end full-path-p guess))
3393          (if (cdr mkds) " " "")
3394          (mapconcat escape-fn
3395                     (cl-loop for f in (cdr mkds)
3396                              collect (helm-ff--insert-fname f))
3397                     " "))))))
3398
3399 (defun helm-ff--insert-fname (candidate &optional beg end full-path guess)
3400   (set-text-properties 0 (length candidate) nil candidate)
3401   (if (and beg end guess (not (string= guess ""))
3402            (or (string-match
3403                 "^\\(~/\\|/\\|[[:lower:][:upper:]]:/\\)"
3404                 guess)
3405                (file-exists-p candidate)))
3406       (prog1
3407           (cond (full-path
3408                  (expand-file-name candidate))
3409                 ((string= (match-string 1 guess) "~/")
3410                  (abbreviate-file-name candidate))
3411                 (t (file-relative-name candidate)))
3412         (delete-region beg end))
3413     (cond ((equal helm-current-prefix-arg '(4))
3414            (abbreviate-file-name candidate))
3415           ((equal helm-current-prefix-arg '(16))
3416            (file-relative-name candidate))
3417           (t candidate))))
3418
3419 (cl-defun helm-find-files-history (arg &key (comp-read t))
3420   "The `helm-find-files' history.
3421 Show the first `helm-ff-history-max-length' elements of
3422 `helm-ff-history' in an `helm-comp-read'."
3423   (interactive "p")
3424   (let ((history (when helm-ff-history
3425                    (helm-fast-remove-dups helm-ff-history
3426                                           :test 'equal))))
3427     (when history
3428       (setq helm-ff-history
3429             (if (>= (length history) helm-ff-history-max-length)
3430                 (cl-subseq history 0 helm-ff-history-max-length)
3431               history))
3432       (if comp-read
3433           (let ((src (helm-build-sync-source "Helm Find Files History"
3434                        :candidates helm-ff-history
3435                        :fuzzy-match (helm-ff-fuzzy-matching-p)
3436                        :persistent-action 'ignore
3437                        :migemo t
3438                        :action (lambda (candidate)
3439                                  (if arg
3440                                      (helm-set-pattern
3441                                       (expand-file-name candidate))
3442                                    (identity candidate))))))
3443             (helm :sources src
3444                   :resume 'noresume
3445                   :buffer helm-ff-history-buffer-name
3446                   :allow-nest t))
3447         helm-ff-history))))
3448 (put 'helm-find-files-history 'helm-only t)
3449
3450 (defun helm-find-files-1 (fname &optional preselect)
3451   "Find FNAME filename with PRESELECT filename preselected.
3452
3453 Use it for non--interactive calls of `helm-find-files'."
3454   (require 'tramp)
3455   ;; Resolve FNAME now outside of helm.
3456   ;; [FIXME] When `helm-find-files-1' is used directly from lisp
3457   ;; and FNAME is an abbreviated path, for some reasons
3458   ;; `helm-update' is called many times before resolving
3459   ;; the abbreviated path (Issue #1939) so be sure to pass a
3460   ;; full path to helm-find-files-1.
3461   (unless (string-match-p helm-ff-url-regexp fname)
3462     (setq fname (expand-file-name (substitute-in-file-name fname))))
3463   (when (get-buffer helm-action-buffer)
3464     (kill-buffer helm-action-buffer))
3465   (setq helm-find-files--toggle-bookmark nil)
3466   (let* ( ;; Be sure we don't erase the precedent minibuffer if some.
3467          (helm-ff-auto-update-initial-value
3468           (and helm-ff-auto-update-initial-value
3469                (not (minibuffer-window-active-p (minibuffer-window)))))
3470          (tap (thing-at-point 'filename))
3471          (def (and tap (or (file-remote-p tap)
3472                            (expand-file-name tap)))))
3473     (helm-set-local-variable 'helm-follow-mode-persistent nil)
3474     (unless helm-source-find-files
3475       (setq helm-source-find-files (helm-make-source
3476                                     "Find Files" 'helm-source-ffiles)))
3477     (when (helm-attr 'follow helm-source-find-files)
3478       (helm-attrset 'follow -1 helm-source-find-files))
3479     (helm-ff-setup-update-hook)
3480     (add-hook 'helm-resume-after-hook 'helm-ff--update-resume-after-hook)
3481     (unwind-protect
3482          (helm :sources 'helm-source-find-files
3483                :input fname
3484                :case-fold-search helm-file-name-case-fold-search
3485                :preselect preselect
3486                :ff-transformer-show-only-basename
3487                helm-ff-transformer-show-only-basename
3488                :default def
3489                :prompt "Find files or url: "
3490                :buffer "*helm find files*")
3491       (helm-ff--update-resume-after-hook nil t)
3492       (setq helm-ff-default-directory nil))))
3493
3494 (defun helm-ff--update-resume-after-hook (sources &optional nohook)
3495   "Meant to be used in `helm-resume-after-hook'.
3496 When NOHOOK is non nil run inconditionally, otherwise only when source
3497 is helm-source-find-files."
3498   (when (or nohook (string= "Find Files"
3499                             (assoc-default 'name (car sources))))
3500     (helm-attrset 'resume `(lambda ()
3501                              (helm-ff-setup-update-hook)
3502                              (setq helm-ff-default-directory
3503                                    ,helm-ff-default-directory
3504                                    helm-ff-last-expanded
3505                                    ,helm-ff-last-expanded))
3506                   helm-source-find-files)))
3507
3508 (defun helm-ff-clean-initial-input ()
3509   ;; When using hff in an external frame initial input is printed in
3510   ;; the minibuffer of initial-frame, delete it.
3511   (with-selected-frame helm-initial-frame
3512     (helm-clean-up-minibuffer)))
3513
3514 (defun helm-ff-setup-update-hook ()
3515   (dolist (hook '(helm-ff-clean-initial-input ; Add to be called first.
3516                   helm-ff-move-to-first-real-candidate
3517                   helm-ff-update-when-only-one-matched
3518                   helm-ff-auto-expand-to-home-or-root))
3519     (add-hook 'helm-after-update-hook hook)))
3520
3521 (defun helm-find-files-cleanup ()
3522   (mapc (lambda (hook)
3523           (remove-hook 'helm-after-update-hook hook))
3524         '(helm-ff-auto-expand-to-home-or-root
3525           helm-ff-update-when-only-one-matched
3526           helm-ff-move-to-first-real-candidate
3527           helm-ff-clean-initial-input)))
3528
3529 (defun helm-find-files-toggle-to-bookmark ()
3530   "Toggle helm-bookmark for `helm-find-files' and `helm-find-files.'"
3531   (interactive)
3532   (require 'helm-bookmark)
3533   (with-helm-alive-p
3534     (with-helm-buffer
3535       (if (setq helm-find-files--toggle-bookmark
3536                 (not helm-find-files--toggle-bookmark))
3537           (progn
3538             (helm-set-pattern "" t)
3539             (helm-set-sources '(helm-source-bookmark-helm-find-files)))
3540           ;; Switch back to helm-find-files.
3541           (helm-set-pattern "./" t) ; Back to initial directory of hff session.
3542           (helm-set-sources '(helm-source-find-files))
3543           (helm--maybe-update-keymap)))))
3544 (put 'helm-find-files-toggle-to-bookmark 'helm-only t)
3545
3546 (defun helm-find-files-initial-input (&optional input)
3547   "Return INPUT if present, otherwise try to guess it."
3548   (unless (eq major-mode 'image-mode)
3549     (or (and input (or (and (file-remote-p input) input)
3550                        (expand-file-name input)))
3551         (helm-find-files-input
3552          (helm-ffap-guesser)
3553          (thing-at-point 'filename)))))
3554
3555 (defun helm-ffap-guesser ()
3556   "Same as `ffap-guesser' but without gopher and machine support."
3557   (require 'ffap)
3558   ;; Avoid "Stack overflow in regexp matcher" error
3559   ;; in evil `ffap-guesser' by removing crap `ffap-gopher-at-point'
3560   ;; (bug fixed in emacs-26 #25391) .
3561   ;; `ffap-machine-at-point' have been removed too as it was anyway
3562   ;; disabled with `ffap-machine-p-known' bound to 'reject.
3563   ;; `ffap-file-at-point' can be neutralized with
3564   ;; `helm-ff-guess-ffap-filenames' and `ffap-url-at-point' with
3565   ;; `helm-ff-guess-ffap-urls'
3566   ;; Note also that `ffap-url-unwrap-remote' can override these
3567   ;; variables.
3568   (let ((ffap-alist (and helm-ff-guess-ffap-filenames ffap-alist))
3569         (ffap-url-regexp helm--url-regexp))
3570     (if (eq major-mode 'dired-mode)
3571         (let ((beg  (save-excursion (dired-move-to-filename)))
3572               (end  (save-excursion (dired-move-to-end-of-filename t))))
3573           (helm-aif (and beg end (member (buffer-substring beg end)
3574                                          '("." "..")))
3575               (concat (file-name-as-directory
3576                        (expand-file-name dired-directory))
3577                       (car it))
3578             (dired-get-filename 'no-dir t)))
3579       (let* ((beg (and (use-region-p) (region-beginning)))
3580              (end (and (use-region-p) (region-end)))
3581              (str (and beg end (buffer-substring-no-properties beg end)))
3582              (ffap (or (and helm-ff-guess-ffap-urls ffap-url-regexp
3583                             (ffap-fixup-url (ffap-url-at-point)))
3584                        (ffap-file-at-point))))
3585         ;; Workaround emacs bugs:
3586         ;; When the region is active and a file is detected
3587         ;; `ffap-string-at-point' returns the region prefixed with
3588         ;; "/", e.g. at a beginning of a patch (first bug) and make
3589         ;; `file-remote-p' returning an error (second bug), so in such
3590         ;; case returns the region itself instead of the region
3591         ;; corrupted by ffap. 
3592         (if (and str ffap) str ffap)))))
3593
3594 (defun helm-find-files-input (file-at-pt thing-at-pt)
3595   "Try to guess a default input for `helm-find-files'."
3596   (let* ((non-essential t)
3597          (remp    (or (and file-at-pt (file-remote-p file-at-pt))
3598                       (and thing-at-pt (file-remote-p thing-at-pt))))
3599          (def-dir (helm-current-directory))
3600          (urlp    (and file-at-pt helm--url-regexp
3601                        (string-match helm--url-regexp file-at-pt)))
3602          (lib     (when helm-ff-search-library-in-sexp
3603                     (helm-find-library-at-point)))
3604          (hlink   (helm-ff-find-url-at-point))
3605          (file-p  (and file-at-pt
3606                        (not (string= file-at-pt ""))
3607                        (not remp)
3608                        (file-exists-p file-at-pt)
3609                        thing-at-pt
3610                        (not (string= thing-at-pt ""))
3611                        (file-exists-p
3612                         (file-name-directory
3613                          (expand-file-name thing-at-pt def-dir))))))
3614     (cond (lib)      ; e.g we are inside a require sexp.
3615           (hlink)    ; String at point is an hyperlink.
3616           (file-p    ; a regular file
3617            (and file-at-pt (if (not (member (helm-basename file-at-pt)
3618                                             '("." "..")))
3619                                (expand-file-name file-at-pt)
3620                              file-at-pt)))
3621           (urlp (helm-html-decode-entities-string file-at-pt)) ; possibly an url or email.
3622           ((and file-at-pt
3623                 (not remp)
3624                 (file-exists-p file-at-pt))
3625            (expand-file-name file-at-pt)))))
3626
3627 (defun helm-ff-find-url-at-point ()
3628   "Try to find link to an url in text-property at point."
3629   (let* ((he      (get-text-property (point) 'help-echo))
3630          (ov      (overlays-at (point)))
3631          (ov-he   (and ov (overlay-get
3632                            (car (overlays-at (point))) 'help-echo)))
3633          (w3m-l   (get-text-property (point) 'w3m-href-anchor))
3634          (nt-prop (get-text-property (point) 'nt-link)))
3635     ;; Org link.
3636     (when (and (stringp he) (string-match "^LINK: " he))
3637       (setq he (replace-match "" t t he)))
3638     (cl-loop for i in (list he ov-he w3m-l nt-prop)
3639           thereis (and (stringp i) helm--url-regexp (string-match helm--url-regexp i) i))))
3640
3641 (defun helm-find-library-at-point ()
3642   "Try to find library path at point.
3643 Find inside `require' and `declare-function' sexp."
3644   (require 'find-func)
3645   (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
3646          (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
3647          (sexp     (and beg-sexp end-sexp
3648                         (buffer-substring-no-properties
3649                          (1+ beg-sexp) (1- end-sexp)))))
3650     (ignore-errors
3651       (cond ((and sexp (string-match "require \'.+[^)]" sexp))
3652              (find-library-name
3653               (replace-regexp-in-string
3654                "'\\|\)\\|\(" ""
3655                ;; If require use third arg, ignore it,
3656                ;; always use library path found in `load-path'.
3657                (cl-second (split-string (match-string 0 sexp))))))
3658             ((and sexp (string-match-p "^declare-function" sexp))
3659              (find-library-name
3660               (replace-regexp-in-string
3661                "\"\\|ext:" ""
3662                (cl-third (split-string sexp)))))
3663             (t nil)))))
3664
3665
3666 ;;; Handle copy, rename, symlink, relsymlink and hardlink from helm.
3667 ;;
3668 ;;
3669 (defun helm-ff--valid-default-directory ()
3670   (with-helm-current-buffer
3671     (cl-loop for b in (buffer-list)
3672              for cd = (with-current-buffer b default-directory)
3673              when (eq (car (file-attributes cd)) t)
3674              return cd)))
3675
3676 (cl-defun helm-dired-action (candidate
3677                              &key action follow (files (dired-get-marked-files)))
3678   "Execute ACTION on FILES to CANDIDATE.
3679 Where ACTION is a symbol that can be one of:
3680 'copy, 'rename, 'symlink,'relsymlink, 'hardlink or 'backup.
3681 Argument FOLLOW when non--nil specify to follow FILES to destination for the actions
3682 copy and rename."
3683   (require 'dired-async)
3684   (require 'dired-x) ; For dired-keep-marker-relsymlink
3685   (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
3686   ;; When default-directory in current-buffer is an invalid directory,
3687   ;; (e.g buffer-file directory have been renamed somewhere else)
3688   ;; be sure to use a valid value to give to dired-create-file.
3689   ;; i.e start-process is creating a process buffer based on default-directory.
3690   (let ((default-directory (helm-ff--valid-default-directory))
3691         (fn     (cl-case action
3692                   (copy       'dired-copy-file)
3693                   (rename     'dired-rename-file)
3694                   (symlink    'make-symbolic-link)
3695                   (relsymlink 'dired-make-relative-symlink)
3696                   (hardlink   'dired-hardlink)
3697                   (backup     'backup-file)))
3698         (marker (cl-case action
3699                   ((copy rename backup) dired-keep-marker-copy)
3700                   (symlink              dired-keep-marker-symlink)
3701                   (relsymlink           dired-keep-marker-relsymlink)
3702                   (hardlink             dired-keep-marker-hardlink)))
3703         (dirflag (and (= (length files) 1)
3704                       (file-directory-p (car files))
3705                       (not (file-directory-p candidate))))
3706         (dired-async-state (if (and (boundp 'dired-async-mode)
3707                                     dired-async-mode)
3708                                1 -1)))
3709     (and follow (fboundp 'dired-async-mode) (dired-async-mode -1))
3710     (when (and (cdr files) (not (file-directory-p candidate)))
3711       (error "%s: target `%s' is not a directory" action candidate))
3712     (unwind-protect
3713          (dired-create-files
3714           fn (symbol-name action) files
3715           ;; CANDIDATE is the destination.
3716           (if (file-directory-p candidate)
3717               ;; When CANDIDATE is a directory, build file-name in this directory.
3718               ;; Else we use CANDIDATE.
3719               (lambda (from)
3720                   (expand-file-name (file-name-nondirectory from) candidate))
3721               (lambda (_from) candidate))
3722           marker)
3723       (and (fboundp 'dired-async-mode)
3724            (dired-async-mode dired-async-state)))
3725     (push (file-name-as-directory
3726            (if (file-directory-p candidate)
3727                (expand-file-name candidate)
3728              (file-name-directory candidate)))
3729           helm-ff-history)
3730     ;; If follow is non--nil we should not be in async mode.
3731     (when (and follow
3732                (not (memq action '(symlink relsymlink hardlink)))
3733                (not (get-buffer dired-log-buffer)))
3734       (let ((target (directory-file-name candidate)))
3735         (unwind-protect
3736              (progn
3737                (setq helm-ff-cand-to-mark
3738                      (helm-get-dest-fnames-from-list files candidate dirflag))
3739                (with-helm-after-update-hook (helm-ff-maybe-mark-candidates))
3740                (if (and dirflag (eq action 'rename))
3741                    (helm-find-files-1 (file-name-directory target)
3742                                       (if helm-ff-transformer-show-only-basename
3743                                           (helm-basename target) target))
3744                  (helm-find-files-1 (file-name-as-directory
3745                                      (expand-file-name candidate)))))
3746           (setq helm-ff-cand-to-mark nil))))))
3747
3748 (defun helm-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
3749   "Transform filenames of FLIST to abs of DEST-CAND.
3750 If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed
3751 members of FLIST."
3752   ;; At this point files have been renamed/copied at destination.
3753   ;; That's mean DEST-CAND exists.
3754   (cl-loop
3755         with dest = (expand-file-name dest-cand)
3756         for src in flist
3757         for basename-src = (helm-basename src)
3758         for fname = (cond (rename-dir-flag (directory-file-name dest))
3759                           ((file-directory-p dest)
3760                            (concat (file-name-as-directory dest) basename-src))
3761                           (t dest))
3762         when (file-exists-p fname)
3763         collect fname into tmp-list
3764         finally return (sort tmp-list 'string<)))
3765
3766 (defun helm-ff-maybe-mark-candidates ()
3767   "Mark all candidates of list `helm-ff-cand-to-mark'.
3768 This is used when copying/renaming/symlinking etc... and
3769 following files to destination."
3770   (when (and (string= (assoc-default 'name (helm-get-current-source))
3771                       (assoc-default 'name helm-source-find-files))
3772              helm-ff-cand-to-mark)
3773     (with-helm-window
3774       (while helm-ff-cand-to-mark
3775         (if (string= (car helm-ff-cand-to-mark) (helm-get-selection))
3776             (progn
3777               (helm-make-visible-mark)
3778               (helm-next-line)
3779               (setq helm-ff-cand-to-mark (cdr helm-ff-cand-to-mark)))
3780           (helm-next-line)))
3781       (unless (helm-this-visible-mark)
3782         (helm-prev-visible-mark)))))
3783
3784
3785 ;;; Routines for files
3786 ;;
3787 ;;
3788 (defun helm-file-buffers (filename)
3789   "Returns a list of buffer names corresponding to FILENAME."
3790   (cl-loop with name = (expand-file-name filename)
3791         for buf in (buffer-list)
3792         for bfn = (buffer-file-name buf)
3793         when (and bfn (string= name bfn))
3794         collect (buffer-name buf)))
3795
3796 (defun helm-ff--delete-by-moving-to-trash (file)
3797   "Decide to trash or delete FILE.
3798 Returns non-nil when FILE needs to be trashed."
3799   (let ((remote (file-remote-p file)))
3800     (or
3801      (and delete-by-moving-to-trash
3802           (null helm-current-prefix-arg)
3803           (null current-prefix-arg)
3804           (or (and remote helm-trash-remote-files)
3805               (null remote)))
3806      (and (null delete-by-moving-to-trash)
3807           (or helm-current-prefix-arg
3808               current-prefix-arg)
3809           (or (and remote helm-trash-remote-files)
3810               (null remote))))))
3811
3812 (defun helm-ff-quick-delete (_candidate)
3813   "Delete file CANDIDATE without quitting.
3814
3815 When a prefix arg is given, meaning of `delete-by-moving-to-trash' is
3816 inversed."
3817   (with-helm-window
3818     (let ((marked (helm-marked-candidates)))
3819       (unwind-protect
3820            (cl-loop with trash = (helm-ff--delete-by-moving-to-trash (car marked))
3821                     for c in marked do
3822                     (progn (helm-preselect
3823                             (concat "^" (regexp-quote
3824                                          (if (and helm-ff-transformer-show-only-basename
3825                                                   (not (helm-ff-dot-file-p c)))
3826                                              (helm-basename c) c))))
3827                            (when (y-or-n-p
3828                                   (format "Really %s file `%s'? "
3829                                           (if trash "Trash" "Delete")
3830                                           (abbreviate-file-name c)))
3831                              (helm-delete-file
3832                               c helm-ff-signal-error-on-dot-files 'synchro trash)
3833                              (helm-delete-current-selection)
3834                              (message nil)
3835                              (helm--remove-marked-and-update-mode-line c))))
3836         (setq helm-marked-candidates nil
3837               helm-visible-mark-overlays nil)
3838         (helm-force-update
3839          (let ((presel (helm-get-selection)))
3840            (concat "^" (regexp-quote (if (and helm-ff-transformer-show-only-basename
3841                                               (not (helm-ff-dot-file-p presel)))
3842                                          (helm-basename presel) presel)))))))))
3843
3844 (defun helm-delete-file (file &optional error-if-dot-file-p synchro trash)
3845   "Delete FILE after querying the user.
3846
3847 When a prefix arg is given, meaning of `delete-by-moving-to-trash' is
3848 inversed.
3849
3850 Return error when ERROR-IF-DOT-FILE-P is non nil and user tries to
3851 delete a dotted file i.e. \".\" or \"..\".
3852
3853 Ask user when directory are not empty to allow recursive deletion
3854 unless `helm-ff-allow-recursive-deletes' is non nil.
3855 When user is asked and reply with \"!\" don't ask for remaining
3856 directories.
3857
3858 Ask to kill buffers associated with that file, too.
3859
3860 When TRASH is non nil, trash FILE even if `delete-by-moving-to-trash'
3861 is nil."
3862   (require 'dired)
3863   (cl-block nil
3864     (when (and error-if-dot-file-p
3865                (helm-ff-dot-file-p file))
3866       (error "Error: Cannot operate on `.' or `..'"))
3867     (let ((buffers (helm-file-buffers file))
3868           (helm--reading-passwd-or-string t)
3869           (file-attrs (file-attributes file))
3870           (trash (or trash (helm-ff--delete-by-moving-to-trash file)))
3871           (delete-by-moving-to-trash trash))
3872       (cond ((and (eq (nth 0 file-attrs) t)
3873                   (directory-files file t dired-re-no-dot))
3874              ;; Synchro means persistent deletion from HFF.
3875              (if synchro
3876                  (when (or helm-ff-allow-recursive-deletes
3877                            trash
3878                            (y-or-n-p (format "Recursive delete of `%s'? "
3879                                              (abbreviate-file-name file))))
3880                    (delete-directory file 'recursive trash))
3881                ;; Avoid using dired-delete-file really annoying in
3882                ;; emacs-26 but allows using ! (instead of all) to not
3883                ;; confirm anymore for recursive deletion of
3884                ;; directory. This is not persistent for all session
3885                ;; like emacs-26 does with dired-delete-file (think it
3886                ;; is a bug).
3887                (if (or helm-ff-allow-recursive-deletes trash)
3888                    (delete-directory file 'recursive trash)
3889                  (helm-acase (helm-read-answer (format "Recursive delete of `%s'? [y,n,!,q]"
3890                                                       (abbreviate-file-name file))
3891                                               '("y" "n" "!" "q"))
3892                    ("y" (delete-directory file 'recursive trash))
3893                    ("!" (setq helm-ff-allow-recursive-deletes t)
3894                          (delete-directory file 'recursive trash))
3895                    ("n" (cl-return 'skip))
3896                    ("q" (throw 'helm-abort-delete-file
3897                            (progn
3898                              (message "Abort file deletion") (sleep-for 1))))))))
3899             ((eq (nth 0 file-attrs) t)
3900              (delete-directory file nil trash))
3901             (t (delete-file file trash)))
3902       (when buffers
3903         (cl-dolist (buf buffers)
3904           (when (y-or-n-p (format "Kill buffer %s, too? " buf))
3905             (kill-buffer buf)))))))
3906
3907 (defun helm-delete-marked-files (_ignore)
3908   "Delete marked files with `helm-delete-file'.
3909
3910 When a prefix arg is given, meaning of `delete-by-moving-to-trash' is
3911 inversed."
3912   (let* ((files (helm-marked-candidates :with-wildcard t))
3913          (len 0)
3914          (trash (helm-ff--delete-by-moving-to-trash (car files)))
3915          (prmt (if trash "Trash" "Delete"))
3916          (old--allow-recursive-deletes helm-ff-allow-recursive-deletes))
3917     (with-helm-display-marked-candidates
3918       helm-marked-buffer-name
3919       (helm-ff--count-and-collect-dups files)
3920       (if (not (y-or-n-p (format "%s *%s File(s)" prmt (length files))))
3921           (message "(No deletions performed)")
3922         (catch 'helm-abort-delete-file
3923           (unwind-protect
3924                (cl-dolist (i files)
3925                  (set-text-properties 0 (length i) nil i)
3926                  (let ((res (helm-delete-file
3927                              i helm-ff-signal-error-on-dot-files nil trash)))
3928                    (if (eq res 'skip)
3929                        (progn (message "Directory is not empty, skipping")
3930                               (sleep-for 1))
3931                      (cl-incf len))))
3932             (setq helm-ff-allow-recursive-deletes old--allow-recursive-deletes)))
3933         (message "%s File(s) %s" len (if trash "trashed" "deleted"))))))
3934
3935 ;;; Delete files async
3936 ;;
3937 ;;
3938 (defvar helm-ff-delete-log-file
3939   (expand-file-name "helm-delete-file.log" user-emacs-directory)
3940   "The file use to communicate with emacs child when deleting files async.")
3941
3942 (defvar helm-ff--trash-flag nil)
3943
3944 (define-minor-mode helm-ff--delete-async-modeline-mode
3945     "Notify mode-line that an async process run."
3946   :group 'dired-async
3947   :global t
3948   ;; FIXME: Handle jobs like in dired-async, needs first to allow
3949   ;; naming properly processes in async, they are actually all named
3950   ;; emacs and running `async-batch-invoke', so if one copy a file and
3951   ;; delete another file at the same time it may clash.
3952   :lighter (:eval (propertize (format " %s file(s) async ..."
3953                                       (if helm-ff--trash-flag
3954                                           "Trashing" "Deleting"))
3955                               'face 'helm-delete-async-message))
3956   (unless helm-ff--delete-async-modeline-mode
3957     (let ((visible-bell t)) (ding))
3958     (setq helm-ff--trash-flag nil)))
3959
3960 (defun helm-delete-async-mode-line-message (text face &rest args)
3961   "Notify end of async operation in `mode-line'."
3962   (message nil)
3963   (let ((mode-line-format (concat
3964                            " " (propertize
3965                                 (if args
3966                                     (apply #'format text args)
3967                                     text)
3968                                 'face face))))
3969     (force-mode-line-update)
3970     (sit-for 3)
3971     (force-mode-line-update)))
3972
3973 (defun helm-delete-marked-files-async (_ignore)
3974   "Same as `helm-delete-marked-files' but async.
3975
3976 When a prefix arg is given, meaning of `delete-by-moving-to-trash' is
3977 inversed.
3978
3979 This function is not using `helm-delete-file' and BTW not asking user
3980 for recursive deletion of directory, be warned that directories are
3981 always deleted with no warnings."
3982   (let* ((files (helm-marked-candidates :with-wildcard t))
3983          (trash (helm-ff--delete-by-moving-to-trash (car files)))
3984          (prmt (if trash "Trash" "Delete"))
3985          (buffers (cl-loop for file in files
3986                            for buf = (helm-file-buffers file)
3987                            when buf append buf))
3988          (callback (lambda (result)
3989                      (helm-ff--delete-async-modeline-mode -1)
3990                      (when (file-exists-p helm-ff-delete-log-file)
3991                        (display-warning 'helm
3992                                         (with-temp-buffer
3993                                           (insert-file-contents
3994                                            helm-ff-delete-log-file)
3995                                           (buffer-string))
3996                                         :error
3997                                         "*helm delete files*")
3998                        (fit-window-to-buffer (get-buffer-window
3999                                               "*helm delete files*"))
4000                        (delete-file helm-ff-delete-log-file))
4001                      (when buffers
4002                        (dolist (buf buffers)
4003                          (let ((last-nonmenu-event t))
4004                            (when (y-or-n-p (format "Kill buffer %s, too? " buf))
4005                              (kill-buffer buf)))))
4006                      (run-with-timer
4007                       0.1 nil
4008                       (lambda ()
4009                         (helm-delete-async-mode-line-message
4010                          "%s (%s/%s) file(s) async done"
4011                          'helm-delete-async-message
4012                          (if trash "Trashing" "Deleting")
4013                          result (length files))))))
4014          ;; Workaround emacs-26 bug with tramp see
4015          ;; https://github.com/jwiegley/emacs-async/issues/80.
4016          (async-quiet-switch "-q"))
4017     (setq helm-ff--trash-flag trash)
4018     (with-helm-display-marked-candidates
4019       helm-marked-buffer-name
4020       (helm-ff--count-and-collect-dups files)
4021       (if (not (y-or-n-p (format "%s *%s File(s)" prmt (length files))))
4022           (message "(No deletions performed)")
4023         (async-start
4024          `(lambda ()
4025             ;; `delete-by-moving-to-trash' have to be set globally,
4026             ;; using the TRASH argument of delete-file or
4027             ;; delete-directory is not enough.
4028             (setq delete-by-moving-to-trash ,trash)
4029             (let ((result 0))
4030               (dolist (file ',files result)
4031                 (condition-case err
4032                     (cond ((eq (nth 0 (file-attributes file)) t)
4033                            (delete-directory file 'recursive ,trash)
4034                            (setq result (1+ result)))
4035                           (t (delete-file file ,trash)
4036                              (setq result (1+ result))))
4037                   (error (with-temp-file ,helm-ff-delete-log-file
4038                            (insert (format-time-string "%x:%H:%M:%S\n"))
4039                            (insert (format "%s:%s\n "
4040                                            (car err)
4041                                            (mapconcat 'identity (cdr err) " ")))))))))
4042          callback)
4043         (helm-ff--delete-async-modeline-mode 1)))))
4044
4045 (defun helm-find-file-or-marked (candidate)
4046   "Open file CANDIDATE or open helm marked files in separate windows.
4047 Called with one prefix arg open files in separate windows in a
4048 vertical split.
4049 Called with two prefix arg open files in background without selecting them."
4050   (let ((marked (helm-marked-candidates :with-wildcard t))
4051         (url-p (and helm--url-regexp ; we should have only one candidate.
4052                     (string-match helm--url-regexp candidate)))
4053         (ffap-newfile-prompt helm-ff-newfile-prompt-p)
4054         (find-file-wildcards nil)
4055         (helm--reading-passwd-or-string t))
4056     (if (cdr marked)
4057         (if (equal helm-current-prefix-arg '(16))
4058             (mapcar 'find-file-noselect marked)
4059           ;; If helm-current-prefix-arg is detected split is done
4060           ;; vertically.
4061           (helm-window-show-buffers (mapcar 'find-file-noselect marked)))
4062       (let ((dir (and (not url-p) (helm-basedir candidate))))
4063         (cond ((and dir (file-directory-p dir))
4064                (find-file (substitute-in-file-name candidate)))
4065               (url-p (find-file-at-point candidate))
4066               ;; A a non--existing filename ending with /
4067               ;; Create a directory and jump to it.
4068               ((and (not (file-exists-p candidate))
4069                     (string-match "/$" candidate))
4070                (helm-ff--mkdir candidate 'helm-ff))
4071               ;; A non--existing filename NOT ending with / or
4072               ;; an existing filename, create or jump to it.
4073               ;; If the basedir of candidate doesn't exists,
4074               ;; ask for creating it.
4075               (dir
4076                (helm-ff--mkdir dir)
4077                (find-file candidate))
4078               ;; Find file at `default-directory' when basedir is
4079               ;; unspecified e.g user hit C-k foo RET.
4080               (t (find-file candidate)))))))
4081
4082 (defun helm-ff--mkdir (dir &optional helm-ff)
4083   (when (or (not confirm-nonexistent-file-or-buffer)
4084             (y-or-n-p (format "Create directory `%s'? "
4085                               (abbreviate-file-name
4086                                (expand-file-name dir)))))
4087     (let ((dirfname (directory-file-name dir)))
4088       (if (file-exists-p dirfname)
4089           (error
4090            "Mkdir: Unable to create directory `%s': file exists."
4091            (helm-basename dirfname))
4092         (make-directory dir 'parent)))
4093     (when helm-ff
4094       ;; Allow having this new dir in history
4095       ;; to be able to retrieve it immediately
4096       ;; if we want to e.g copy a file from somewhere in it.
4097       (setq helm-ff-default-directory
4098             (file-name-as-directory (expand-file-name dir)))
4099       (push helm-ff-default-directory helm-ff-history))
4100     (or (and helm-ff (helm-find-files-1 dir)) t)))
4101
4102 (defun helm-transform-file-load-el (actions candidate)
4103   "Add action to load the file CANDIDATE if it is an emacs lisp
4104 file.  Else return ACTIONS unmodified."
4105   (if (member (file-name-extension candidate) '("el" "elc"))
4106       (append actions '(("Load Emacs Lisp File" . load-file)))
4107     actions))
4108
4109 (defun helm-transform-file-browse-url (actions candidate)
4110   "Add an action to browse the file CANDIDATE if it is a html file or URL.
4111 Else return ACTIONS unmodified."
4112   (let ((browse-action '("Browse with Browser" . browse-url)))
4113     (cond ((string-match "^http\\|^ftp" candidate)
4114            (cons browse-action actions))
4115           ((string-match "\\.html?$" candidate)
4116            (append actions (list browse-action)))
4117           (t actions))))
4118
4119 (defun helm-file-on-mounted-network-p (file)
4120   "Returns non-nil when FILE is part of a mounted remote directory.
4121
4122 This function is checking `helm-mounted-network-directories' list."
4123   (when helm-mounted-network-directories
4124     (cl-loop for dir in helm-mounted-network-directories
4125              thereis (file-in-directory-p file dir))))
4126
4127 ;; helm-find-files bindings for filecache
4128 (defvar file-cache-alist)
4129
4130 (defun helm-ff-cache-add-file (_candidate)
4131   (require 'filecache)
4132   (let ((mkd (helm-marked-candidates :with-wildcard t)))
4133     (mapc 'file-cache-add-file mkd)))
4134
4135 (defun helm-ff-file-cache-remove-file-1 (file)
4136   "Remove FILE from `file-cache-alist'."
4137   (let ((entry (assoc (helm-basename file) file-cache-alist))
4138         (dir   (helm-basedir file))
4139         new-entry)
4140     (setq new-entry (remove dir entry))
4141     (when (= (length entry) 1)
4142       (setq new-entry nil))
4143     (setq file-cache-alist
4144           (cons new-entry (remove entry file-cache-alist)))))
4145
4146 (defun helm-ff-file-cache-remove-file (_file)
4147   "Remove marked files from `file-cache-alist.'"
4148   (let ((mkd (helm-marked-candidates)))
4149     (mapc 'helm-ff-file-cache-remove-file-1 mkd)))
4150
4151
4152 ;;; File name history
4153 ;;
4154 ;;
4155 (defvar helm-source-file-name-history
4156   (helm-build-sync-source "File Name History"
4157     :candidates 'file-name-history
4158     :persistent-action #'ignore
4159     :filtered-candidate-transformer #'helm-file-name-history-transformer
4160     :action 'helm-type-file-actions))
4161
4162 (defvar helm-source--ff-file-name-history nil
4163   "[Internal] This source is build to be used with `helm-find-files'.
4164 Don't use it in your own code unless you know what you are doing.")
4165
4166 (defun helm-file-name-history-transformer (candidates _source)
4167   (cl-loop for c in candidates collect
4168         (cond ((or (file-remote-p c)
4169                    (and (fboundp 'tramp-archive-file-name-p)
4170                         (tramp-archive-file-name-p c)))
4171                (cons (propertize c 'face 'helm-history-remote) c))
4172               ((file-exists-p c)
4173                (cons (propertize c 'face 'helm-ff-file) c))
4174               (t (cons (propertize c 'face 'helm-history-deleted) c)))))
4175
4176 (defun helm-ff-file-name-history ()
4177   "Switch to `file-name-history' without quitting `helm-find-files'."
4178   (interactive)
4179   (unless helm-source--ff-file-name-history
4180     (setq helm-source--ff-file-name-history
4181           (helm-build-sync-source "File name history"
4182             :init (lambda ()
4183                     (with-helm-alive-p
4184                       (require 'tramp-archive nil t)
4185                       (when helm-ff-file-name-history-use-recentf
4186                         (require 'recentf)
4187                         (or recentf-mode (recentf-mode 1)))))
4188             :candidates (lambda ()
4189                           (if helm-ff-file-name-history-use-recentf
4190                               recentf-list
4191                               file-name-history))
4192             :fuzzy-match t
4193             :persistent-action 'ignore
4194             :migemo t
4195             :filtered-candidate-transformer 'helm-file-name-history-transformer
4196             :action (helm-make-actions
4197                      "Find file" (lambda (candidate)
4198                                    (helm-set-pattern
4199                                     (expand-file-name candidate))
4200                                    (with-helm-after-update-hook (helm-exit-minibuffer)))
4201                      "Find file in helm" (lambda (candidate)
4202                                            (helm-set-pattern
4203                                             (expand-file-name candidate)))))))
4204   (with-helm-alive-p
4205     (helm :sources 'helm-source--ff-file-name-history
4206           :buffer "*helm-file-name-history*"
4207           :allow-nest t
4208           :resume 'noresume)))
4209 (put 'helm-ff-file-name-history 'helm-only t)
4210
4211 ;;; Browse project
4212 ;; Need dependencies:
4213 ;; <https://github.com/emacs-helm/helm-ls-git>
4214 ;; <https://github.com/emacs-helm/helm-ls-hg>
4215 ;; Only hg and git are supported for now.
4216 (defvar helm--browse-project-cache (make-hash-table :test 'equal))
4217 (defvar helm-buffers-in-project-p)
4218
4219 (defun helm-browse-project-get-buffers (root-directory)
4220   (cl-loop for b in (helm-buffer-list)
4221            ;; FIXME: Why default-directory is root-directory
4222            ;; for current-buffer when coming from helm-quit-and-find-file.
4223            for cd = (with-current-buffer b default-directory)
4224            for bn = (buffer-file-name (get-buffer b))
4225            if (or (and bn (file-in-directory-p bn root-directory))
4226                   (and (null bn)
4227                        (not (file-remote-p cd))
4228                        (file-in-directory-p cd root-directory)))
4229            collect b))
4230
4231 (defun helm-browse-project-build-buffers-source (directory)
4232   (helm-make-source "Buffers in project" 'helm-source-buffers
4233     :header-name (lambda (name)
4234                    (format
4235                     "%s (%s)"
4236                     name (abbreviate-file-name directory)))
4237     :buffer-list (lambda () (helm-browse-project-get-buffers directory))))
4238
4239 (defun helm-browse-project-walk-directory (directory)
4240   "Default function for `helm-browse-project-default-find-files-fn'."
4241   (helm-walk-directory
4242    directory
4243    :directories nil :path 'full :skip-subdirs t))
4244
4245 (defun helm-browse-project-ag-find-files (directory)
4246   "A suitable function for `helm-browse-project-default-find-files-fn'.
4247
4248 Needs AG as backend."
4249   (with-temp-buffer
4250     (call-process-shell-command
4251      (format "ag --hidden -g '.*' %s" directory)
4252      nil t nil)
4253     (mapcar (lambda (f) (expand-file-name f directory))
4254             (split-string (buffer-string) "\n"))))
4255
4256 (defun helm-browse-project-find-files (directory &optional refresh)
4257   (when refresh (remhash directory helm--browse-project-cache))
4258   (unless (gethash directory helm--browse-project-cache)
4259     (puthash directory (funcall helm-browse-project-default-find-files-fn
4260                                 directory)
4261              helm--browse-project-cache))
4262   (helm :sources `(,(helm-browse-project-build-buffers-source directory)
4263                    ,(helm-build-in-buffer-source "Browse project"
4264                      :data (gethash directory helm--browse-project-cache)
4265                      :header-name (lambda (name)
4266                                     (format
4267                                      "%s (%s)"
4268                                      name (abbreviate-file-name directory)))
4269                      :match-part (lambda (c)
4270                                    (if (with-helm-buffer
4271                                          helm-ff-transformer-show-only-basename)
4272                                        (helm-basename c) c))
4273                      :filter-one-by-one
4274                      (lambda (c)
4275                        (if (with-helm-buffer
4276                              helm-ff-transformer-show-only-basename)
4277                            (cons (propertize (helm-basename c)
4278                                              'face 'helm-ff-file)
4279                                  c)
4280                            (propertize c 'face 'helm-ff-file)))
4281                      :keymap helm-generic-files-map
4282                      :action 'helm-type-file-actions))
4283         :ff-transformer-show-only-basename nil
4284         :buffer "*helm browse project*"))
4285
4286 (defvar helm-browse-project-history nil)
4287
4288 ;;;###autoload
4289 (defun helm-projects-history ()
4290   (interactive)
4291   (helm :sources
4292         (helm-build-sync-source "Project history"
4293           :candidates helm-browse-project-history
4294           :action (lambda (candidate)
4295                     (with-helm-default-directory candidate
4296                         (helm-browse-project nil))))
4297         :buffer "*helm browse project history*"))
4298
4299 ;;;###autoload
4300 (defun helm-browse-project (arg)
4301   "Preconfigured helm to browse projects.
4302 Browse files and see status of project with its vcs.
4303 Only HG and GIT are supported for now.
4304 Fall back to `helm-browse-project-find-files'
4305 if current directory is not under control of one of those vcs.
4306 With a prefix ARG browse files recursively, with two prefix ARG
4307 rebuild the cache.
4308 If the current directory is found in the cache, start
4309 `helm-browse-project-find-files' even with no prefix ARG.
4310 NOTE: The prefix ARG have no effect on the VCS controlled directories.
4311
4312 Needed dependencies for VCS:
4313 <https://github.com/emacs-helm/helm-ls-git>
4314 and
4315 <https://github.com/emacs-helm/helm-ls-hg>."
4316   (interactive "P")
4317   (let ((helm-type-buffer-actions
4318          (remove (assoc "Browse project from buffer"
4319                         helm-type-buffer-actions)
4320                  helm-type-buffer-actions))
4321         (helm-buffers-in-project-p t))
4322     (cl-flet ((push-to-hist (root)
4323                 (setq helm-browse-project-history
4324                       (cons root (delete root helm-browse-project-history)))))
4325       (helm-acond ((and (require 'helm-ls-git nil t)
4326                         (fboundp 'helm-ls-git-root-dir)
4327                         (helm-ls-git-root-dir))
4328                    (push-to-hist it)
4329                    (helm-ls-git-ls))
4330                   ((and (require 'helm-ls-hg nil t)
4331                         (fboundp 'helm-hg-root)
4332                         (helm-hg-root))
4333                    (push-to-hist it)
4334                    (helm-hg-find-files-in-project))
4335                   ((helm-browse-project-get--root-dir (helm-current-directory))
4336                    (if (or arg (gethash it helm--browse-project-cache))
4337                        (progn
4338                          (push-to-hist it)
4339                          (helm-browse-project-find-files it (equal arg '(16))))
4340                        (helm :sources (helm-browse-project-build-buffers-source it)
4341                              :buffer "*helm browse project*")))))))
4342
4343 (defun helm-browse-project-get--root-dir (directory)
4344   (cl-loop with dname = (file-name-as-directory directory)
4345            while (and dname (not (gethash dname helm--browse-project-cache)))
4346            if (file-remote-p dname)
4347            do (setq dname nil) else
4348            do (setq dname (helm-basedir (substring dname 0 (1- (length dname)))))
4349            finally return (or dname (file-name-as-directory directory))))
4350
4351 (defun helm-ff-browse-project (_candidate)
4352   "Browse project in current directory.
4353 See `helm-browse-project'."
4354   (with-helm-default-directory helm-ff-default-directory
4355       (helm-browse-project helm-current-prefix-arg)))
4356
4357 (defun helm-ff-run-browse-project ()
4358   (interactive)
4359   (with-helm-alive-p
4360     (helm-exit-and-execute-action 'helm-ff-browse-project)))
4361 (put 'helm-ff-run-browse-project 'helm-only t)
4362
4363 (defun helm-ff-gid (_candidate)
4364   (with-helm-default-directory helm-ff-default-directory
4365       (helm-gid)))
4366
4367 (defun helm-ff-run-gid ()
4368   (interactive)
4369   (with-helm-alive-p
4370     (helm-exit-and-execute-action 'helm-ff-gid)))
4371 (put 'helm-ff-run-gid 'helm-only t)
4372
4373 ;; helm-find bindings for helm-find-files.
4374 (defun helm-ff-find-sh-command (_candidate)
4375   "Run `helm-find' from `helm-find-files'."
4376   (require 'helm-find)
4377   (helm-find-1 helm-ff-default-directory))
4378
4379 (defun helm-ff-run-find-sh-command ()
4380   "Run find shell command action with key from `helm-find-files'."
4381   (interactive)
4382   (with-helm-alive-p
4383     (helm-exit-and-execute-action 'helm-ff-find-sh-command)))
4384 (put 'helm-ff-run-find-sh-command 'helm-only t)
4385
4386
4387 ;;;###autoload
4388 (defun helm-find-files (arg)
4389   "Preconfigured `helm' for helm implementation of `find-file'.
4390 Called with a prefix arg show history if some.
4391 Don't call it from programs, use `helm-find-files-1' instead.
4392 This is the starting point for nearly all actions you can do on files."
4393   (interactive "P")
4394   (let* ((hist            (and arg helm-ff-history (helm-find-files-history nil)))
4395          (smart-input     (or hist (helm-find-files-initial-input)))
4396          (default-input   (expand-file-name (helm-current-directory)))
4397          (input           (cond ((and (null hist)
4398                                       helm-find-files-ignore-thing-at-point)
4399                                  default-input)
4400                                 ((and (eq major-mode 'org-agenda-mode)
4401                                       org-directory
4402                                       (not smart-input))
4403                                  (expand-file-name org-directory))
4404                                 ((and (eq major-mode 'dired-mode) smart-input)
4405                                  (file-name-directory smart-input))
4406                                 ((and (not (string= smart-input ""))
4407                                       smart-input))
4408                                 (t default-input)))
4409          (input-as-presel (null (nth 0 (file-attributes input))))
4410          (presel          (helm-aif (or hist
4411                                         (and input-as-presel input)
4412                                         (buffer-file-name (current-buffer))
4413                                         (and (eq major-mode 'dired-mode)
4414                                              smart-input))
4415                               (if (and helm-ff-transformer-show-only-basename
4416                                        (null hist)
4417                                        (not (string-match-p "[.]\\{1,2\\}\\'" it)))
4418                                   (helm-basename it) it))))
4419     ;; Continue using the same display function as history which used
4420     ;; probably itself the same display function as inner HFF call,
4421     ;; i.e. if history was using frame use a frame otherwise use a window.
4422     (when (and hist (buffer-live-p (get-buffer helm-ff-history-buffer-name)))
4423       (helm-set-local-variable 'helm-display-function
4424                                (with-current-buffer helm-ff-history-buffer-name
4425                                  helm-display-function)
4426                                'helm--last-frame-parameters
4427                                (with-current-buffer helm-ff-history-buffer-name
4428                                  helm--last-frame-parameters)))
4429     (set-text-properties 0 (length input) nil input)
4430     (setq current-prefix-arg nil)
4431     ;; Allow next helm session to reuse helm--last-frame-parameters as
4432     ;; resume would do.
4433     (let ((helm--executing-helm-action (not (null hist))))
4434       (helm-find-files-1 input (and presel (null helm-ff-no-preselect)
4435                                     (concat "^" (regexp-quote presel)))))))
4436
4437 ;;;###autoload
4438 (defun helm-delete-tramp-connection ()
4439   "Allow deleting tramp connection or marked tramp connections at once.
4440
4441 This replace `tramp-cleanup-connection' which is partially broken in
4442 emacs < to 25.1.50.1 (See Emacs Bug#24432).
4443
4444 It allows additionally to delete more than one connection at once."
4445   (interactive)
4446   (let ((helm-quit-if-no-candidate
4447          (lambda ()
4448            (message "No Tramp connection found"))))
4449     (helm :sources (helm-build-sync-source "Tramp connections"
4450                      :candidates (tramp-list-connections)
4451                      :candidate-transformer (lambda (candidates)
4452                                               (cl-loop for v in candidates
4453                                                        for name = (apply #'tramp-make-tramp-file-name
4454                                                                          (cl-loop with v = (helm-ff--tramp-cons-or-vector v)
4455                                                                                   for i across v collect i))
4456                                                        when (or (processp (tramp-get-connection-process v))
4457                                                                 (buffer-live-p (get-buffer (tramp-buffer-name v))))
4458                                                        collect (cons name v)))
4459                      :action (lambda (_vec)
4460                                (let ((vecs (helm-marked-candidates)))
4461                                  (cl-loop for v in vecs
4462                                           do (progn
4463                                                (tramp-cleanup-connection v)
4464                                                (remhash v tramp-cache-data))))))
4465           :buffer "*helm tramp connections*")))
4466
4467
4468 (provide 'helm-files)
4469
4470 ;; Local Variables:
4471 ;; byte-compile-warnings: (not obsolete)
4472 ;; coding: utf-8
4473 ;; indent-tabs-mode: nil
4474 ;; End:
4475
4476 ;;; helm-files.el ends here