diff options
Diffstat (limited to 'helm-files.el')
| -rw-r--r-- | helm-files.el | 566 |
1 files changed, 430 insertions, 136 deletions
diff --git a/helm-files.el b/helm-files.el index cb00a5c8..947753b5 100644 --- a/helm-files.el +++ b/helm-files.el @@ -51,6 +51,7 @@ (declare-function helm-gid "helm-id-utils.el") (declare-function helm-find-1 "helm-find") (declare-function helm-get-default-program-for-file "helm-external") +(declare-function helm-open-file-externally "helm-external") (defvar recentf-list) (defvar helm-mm-matching-method) @@ -96,19 +97,6 @@ See `helm-ff--transform-pattern-for-completion' for more info." :group 'helm-files :type 'boolean) -(defcustom helm-ff-tramp-not-fancy 'dirs-only - "Colorize remote files when non nil. - -When 'dirs-only is passed as value (default) only directories are -shown. - -Be aware that a nil value will make tramp display very slow." - :group 'helm-files - :type '(choice - (const :tag "Show directories only" dirs-only) - (const :tag "No colors" t) - (const :tag "Colorize all" nil))) - (defcustom helm-ff-exif-data-program "exiftran" "Program used to extract exif data of an image file." :group 'helm-files @@ -241,7 +229,8 @@ This doesn't disable url or mail at point, see (defcustom helm-ff-guess-ffap-urls t "Use ffap to guess local urls at point in `helm-find-files'. This doesn't disable guessing filenames at point, -see `helm-ff-guess-ffap-filenames' for this." +see `helm-ff-guess-ffap-filenames' for this. +See also `ffap-url-unwrap-remote' that may override this variable." :group 'helm-files :type 'boolean) @@ -324,6 +313,44 @@ better to not modify this variable." :type '(choice (const :tag "Delete non-empty directories" t) (const :tag "Confirm for each directory" nil))) + +(defcustom helm-ff-delete-files-function #'helm-delete-marked-files + "The function to use by default to delete files. + +Default is to delete files synchronously, other choice is to delete +files asynchronously. + +BE AWARE that when deleting async you will not be warned about +recursive deletion of directories, IOW non empty directories will be +deleted with no warnings in background!!! + +It is the function that will be used when using `\\<helm-find-files-map>\\[helm-ff-run-delete-file]' +from `helm-find-files'." + :group 'helm-files + :type '(choice (function :tag "Delete files synchronously." + helm-delete-marked-files) + (function :tag "Delete files asynchronously." + helm-delete-marked-files-async))) + +(defcustom helm-list-directory-function + (cl-case system-type + (gnu/linux #'helm-list-dir-external) + (berkeley-unix #'helm-list-dir-external) + (windows-nt #'helm-list-dir-lisp) + (t #'helm-list-dir-lisp)) + "The function used in `helm-find-files' to list remote directories. + +Actually helm provides two functions to do this: `helm-list-dir-lisp' +and `helm-list-dir-external'. + +Using `helm-list-dir-external' will provides a similar display to what +provided with local files i.e. colorized symlinks, executables files +etc... whereas using `helm-list-dir-lisp' will allow colorizing only +directories but is more portable. + +NOTE that `helm-list-dir-external' needs ls and awk as dependencies." + :type 'function + :group 'helm-files) ;;; Faces ;; @@ -374,16 +401,36 @@ better to not modify this variable." "Face used for invalid symlinks in `helm-find-files'." :group 'helm-files-faces) +(defface helm-ff-denied + '((t (:foreground "red" :background "black"))) + "Face used for non accessible files in `helm-find-files'." + :group 'helm-files-faces) + (defface helm-ff-file '((t (:inherit font-lock-builtin-face))) "Face used for file names in `helm-find-files'." :group 'helm-files-faces) +(defface helm-ff-truename + '((t (:inherit font-lock-string-face))) + "Face used for symlink truenames in `helm-find-files'." + :group 'helm-files-faces) + (defface helm-ff-dirs '((t (:inherit font-lock-function-name-face))) "Face used for file names in recursive dirs completion in `helm-find-files'." :group 'helm-files-faces) +(defface helm-ff-socket + '((t (:foreground "DeepPink"))) + "Face used for socket files in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-pipe + '((t (:foreground "yellow" :background "black"))) + "Face used for named pipes and character device files in `helm-find-files'." + :group 'helm-files-faces) + (defface helm-history-deleted '((t (:inherit helm-ff-invalid-symlink))) "Face used for deleted files in `file-name-history'." @@ -394,6 +441,10 @@ better to not modify this variable." "Face used for remote files in `file-name-history'." :group 'helm-files-faces) +(defface helm-delete-async-message + '((t (:foreground "yellow"))) + "Face used for mode-line message." + :group 'helm-files-faces) ;;; Helm-find-files - The helm file browser. ;; @@ -421,6 +472,7 @@ better to not modify this variable." (define-key map (kbd "M-B") 'helm-ff-run-byte-compile-file) (define-key map (kbd "M-L") 'helm-ff-run-load-file) (define-key map (kbd "M-S") 'helm-ff-run-symlink-file) + (define-key map (kbd "M-Y") 'helm-ff-run-relsymlink-file) (define-key map (kbd "M-H") 'helm-ff-run-hardlink-file) (define-key map (kbd "M-D") 'helm-ff-run-delete-file) (define-key map (kbd "M-K") 'helm-ff-run-kill-buffer-persistent) @@ -431,6 +483,7 @@ better to not modify this variable." (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) + (define-key map (kbd "C-c C-v") 'helm-ff-run-preview-file-externally) (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) (define-key map (kbd "M-!") 'helm-ff-run-eshell-command-on-file) (define-key map (kbd "M-@") 'helm-ff-run-query-replace-fnames-on-marked) @@ -557,13 +610,20 @@ Don't set it directly, use instead `helm-ff-auto-update-initial-value'.") "Find alternate file `C-x C-v'" 'find-alternate-file "Ediff File `C-c ='" 'helm-find-files-ediff-files "Ediff Merge File `M-='" 'helm-find-files-ediff-merge-files - "Delete File(s) `M-D'" 'helm-delete-marked-files + (lambda () (format "Delete File(s)%s (C-u no trash)" (if (eq helm-ff-delete-files-function + 'helm-delete-marked-files) + " `M-D'" ""))) + 'helm-delete-marked-files + (lambda () (format "Delete File(s) async%s (C-u no trash)" (if (eq helm-ff-delete-files-function + 'helm-delete-marked-files-async) + " `M-D'" ""))) + 'helm-delete-marked-files-async "Touch File(s) `M-T'" 'helm-ff-touch-files "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename "Backup files" 'helm-find-files-backup "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink - "Relsymlink file(s) `C-u to follow'" 'helm-find-files-relsymlink + "Relsymlink file(s) `M-Y, C-u to follow'" 'helm-find-files-relsymlink "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink "Find file other window `C-c o'" 'helm-find-files-other-window "Find file other frame `C-c C-o'" 'find-file-other-frame @@ -1505,6 +1565,13 @@ Behave differently depending of `helm-selection': (helm-exit-and-execute-action 'helm-find-files-symlink))) (put 'helm-ff-run-symlink-file 'helm-only t) +(defun helm-ff-run-relsymlink-file () + "Run Symlink file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-relsymlink))) +(put 'helm-ff-run-relsymlink-file 'helm-only t) + (defun helm-ff-run-hardlink-file () "Run Hardlink file action from `helm-source-find-files'." (interactive) @@ -1516,7 +1583,7 @@ Behave differently depending of `helm-selection': "Run Delete file action from `helm-source-find-files'." (interactive) (with-helm-alive-p - (helm-exit-and-execute-action 'helm-delete-marked-files))) + (helm-exit-and-execute-action helm-ff-delete-files-function))) (put 'helm-ff-run-delete-file 'helm-only t) (defun helm-ff-run-complete-fn-at-point () @@ -2311,22 +2378,74 @@ purpose." (defun helm-list-directory (directory) "List directory DIRECTORY. -If DIRECTORY is remote use `file-name-all-completions' and add a -`helm-ff-dir' property on each one ending with \"/\" otherwise use +If DIRECTORY is remote use `helm-list-directory-function' otherwise use `directory-files'." (if (file-remote-p directory) - (cl-loop for f in (sort (file-name-all-completions "" directory) - 'string-lessp) - unless (or (member f '("./" "../")) - ;; Ignore the tramp names from / - ;; completion, e.g. ssh: scp: etc... - (char-equal (aref f (1- (length f))) ?:)) - if (and (helm--dir-name-p f) - (helm--dir-file-name f directory)) - collect (propertize it 'helm-ff-dir t) - else collect (expand-file-name f directory)) + (funcall helm-list-directory-function directory) (directory-files directory t directory-files-no-dot-files-regexp))) +(defun helm-list-dir-lisp (directory) + "List DIRECTORY with `file-name-all-completions' as backend. + +Add a `helm-ff-dir' property on each fname ending with \"/\"." + ;; NOTE: `file-name-all-completions' and `directory-files' and most + ;; tramp file handlers don't handle cntrl characters in fnames, so + ;; the displayed files will be plain wrong in this case, even worst + ;; the filenames will be splitted in two or more filenames. + (cl-loop for f in (sort (file-name-all-completions "" directory) + 'string-lessp) + unless (or (string= f "") + (member f '("./" "../")) + ;; Ignore the tramp names from / + ;; completion, e.g. ssh: scp: etc... + (char-equal (aref f (1- (length f))) ?:)) + if (and (helm--dir-name-p f) + (helm--dir-file-name f directory)) + collect (propertize it 'helm-ff-dir t) + else collect (expand-file-name f directory))) + +(defun helm-list-dir-external (dir) + "List directory DIR with external shell command as backend. + +This function is fast enough to be used for remote files and save the +type of files at the same time in a property for using it later in the +transformer." + (let ((default-directory (file-name-as-directory + (expand-file-name dir)))) + (with-temp-buffer + (when (eq (process-file-shell-command + (format + ;; -A remove dot files, -F append [*=@|/>] at eof + ;; and -Q quote the real filename. If not using -Q, + ;; there is no way to distinguish if foo* is a real + ;; file or if it is foo the executable file so with + ;; -Q we have "foo"* for the executable file foo and + ;; "foo*" for the real file foo. The downside is + ;; that we need an extra step to remove the quotes + ;; at the end which impact performances. + "ls -A -1 -F -b -Q | awk -v a=%s '{print a $1}'" + default-directory) + nil t nil) + 0) + (goto-char (point-min)) + (save-excursion + (while (re-search-forward "[*=@|/>]$" nil t) + ;; A line looks like /home/you/"foo"@ + (pcase (match-string 0) + ("*" (replace-match "") + (put-text-property + (point-at-bol) (point-at-eol) 'helm-ff-exe t)) + ("@" (replace-match "") + (put-text-property + (point-at-bol) (point-at-eol) 'helm-ff-sym t)) + ("/" (replace-match "") + (put-text-property + (point-at-bol) (point-at-eol) 'helm-ff-dir t)) + ((or "=" "|" ">") (replace-match ""))))) + (while (re-search-forward "[\"]" nil t) + (replace-match "")) + (split-string (buffer-string) "\n" t))))) + (defun helm-ff-directory-files (directory) "List contents of DIRECTORY. Argument FULL mean absolute path. @@ -2466,46 +2585,48 @@ Note that only existing directories are saved here." (defun helm-ff-properties (candidate) "Show file properties of CANDIDATE in a tooltip or message." - (require 'helm-external) ; For `helm-get-default-program-for-file'. - (let* ((all (helm-file-attributes candidate)) - (dired-line (helm-file-attributes - candidate :dired t :human-size t)) - (type (cl-getf all :type)) - (mode-type (cl-getf all :mode-type)) - (owner (cl-getf all :uid)) - (owner-right (cl-getf all :user t)) - (group (cl-getf all :gid)) - (group-right (cl-getf all :group)) - (other-right (cl-getf all :other)) - (size (helm-file-human-size (cl-getf all :size))) - (modif (cl-getf all :modif-time)) - (access (cl-getf all :access-time)) - (ext (helm-get-default-program-for-file candidate)) - (tooltip-hide-delay (or helm-tooltip-hide-delay tooltip-hide-delay))) - (if (and (window-system) tooltip-mode) - (tooltip-show - (concat - (helm-basename candidate) "\n" - dired-line "\n" - (format "Mode: %s\n" (helm-get-default-mode-for-file candidate)) - (format "Ext prog: %s\n" (or (and ext (replace-regexp-in-string - " %s" "" ext)) - "Not defined")) - (format "Type: %s: %s\n" type mode-type) - (when (string= type "symlink") - (format "True name: '%s'\n" - (cond ((string-match "^\.#" (helm-basename candidate)) - "Autosave symlink") - ((helm-ff-valid-symlink-p candidate) - (file-truename candidate)) - (t "Invalid Symlink")))) - (format "Owner: %s: %s\n" owner owner-right) - (format "Group: %s: %s\n" group group-right) - (format "Others: %s\n" other-right) - (format "Size: %s\n" size) - (format "Modified: %s\n" modif) - (format "Accessed: %s\n" access))) - (message dired-line) (sit-for 5)))) + (require 'helm-external) ; For `helm-get-default-program-for-file'. + (helm-aif (helm-file-attributes candidate) + (let* ((all it) + (dired-line (helm-file-attributes + candidate :dired t :human-size t)) + (type (cl-getf all :type)) + (mode-type (cl-getf all :mode-type)) + (owner (cl-getf all :uid)) + (owner-right (cl-getf all :user t)) + (group (cl-getf all :gid)) + (group-right (cl-getf all :group)) + (other-right (cl-getf all :other)) + (size (helm-file-human-size (cl-getf all :size))) + (modif (cl-getf all :modif-time)) + (access (cl-getf all :access-time)) + (ext (helm-get-default-program-for-file candidate)) + (tooltip-hide-delay (or helm-tooltip-hide-delay tooltip-hide-delay))) + (if (and (window-system) tooltip-mode) + (tooltip-show + (concat + (helm-basename candidate) "\n" + dired-line "\n" + (format "Mode: %s\n" (helm-get-default-mode-for-file candidate)) + (format "Ext prog: %s\n" (or (and ext (replace-regexp-in-string + " %s" "" ext)) + "Not defined")) + (format "Type: %s: %s\n" type mode-type) + (when (string= type "symlink") + (format "True name: '%s'\n" + (cond ((string-match "^\.#" (helm-basename candidate)) + "Autosave symlink") + ((helm-ff-valid-symlink-p candidate) + (file-truename candidate)) + (t "Invalid Symlink")))) + (format "Owner: %s: %s\n" owner owner-right) + (format "Group: %s: %s\n" group group-right) + (format "Others: %s\n" other-right) + (format "Size: %s\n" size) + (format "Modified: %s\n" modif) + (format "Accessed: %s\n" access))) + (message dired-line) (sit-for 5))) + (message "Permission denied, file not readable"))) (defun helm-ff-properties-persistent () "Show properties without quitting helm." @@ -2528,7 +2649,10 @@ Note that only existing directories are saved here." (member (helm-basename file) '("." ".."))) (defun helm-ff-quick-delete (_candidate) - "Delete file CANDIDATE without quitting." + "Delete file CANDIDATE without quitting. + +When a prefix arg is given, files are deleted and not trashed even if +\`delete-by-moving-to-trash' is non nil." (with-helm-window (let ((marked (helm-marked-candidates))) (unwind-protect @@ -2539,7 +2663,10 @@ Note that only existing directories are saved here." (not (helm-ff-dot-file-p c))) (helm-basename c) c)))) (when (y-or-n-p - (format "Really Delete file `%s'? " + (format "Really %s file `%s'? " + (if (and delete-by-moving-to-trash + (null current-prefix-arg)) + "Trash" "Delete") (abbreviate-file-name c))) (helm-delete-file c helm-ff-signal-error-on-dot-files 'synchro) @@ -2596,6 +2723,21 @@ in `helm-find-files-persistent-action-if'." (helm-execute-persistent-action 'kill-buffer-fname))) (put 'helm-ff-run-kill-buffer-persistent 'helm-only t) +;; Preview with external tool +(defun helm-ff-persistent-open-file-externally (file) + (require 'helm-external) + (if (helm-get-default-program-for-file file) + (helm-open-file-externally file) + (message "Please configure an external program for `*%s' file in `helm-external-programs-associations'" + (file-name-extension file t)))) + +(defun helm-ff-run-preview-file-externally () + (interactive) + (with-helm-alive-p + (helm-attrset 'open-file-externally '(helm-ff-persistent-open-file-externally . never-split)) + (helm-execute-persistent-action 'open-file-externally))) +(put 'helm-ff-run-preview-file-externally 'helm-only t) + (defun helm-ff-prefix-filename (fname &optional file-or-symlinkp new-file) "Return filename FNAME maybe prefixed with [?] or [@]. If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an @@ -2663,32 +2805,43 @@ Return candidates prefixed with basename of `helm-input' first." (defun helm-ff-filter-candidate-one-by-one (file) "`filter-one-by-one' Transformer function for `helm-source-find-files'." ;; Handle boring files - (let ((basename (helm-basename file))) + (let ((basename (helm-basename file)) + dot) (unless (and helm-ff-skip-boring-files (helm-ff-boring-file-p basename)) - ;; Handle tramp files. + + ;; Handle tramp files with minimal highlighting. (if (and (or (string-match-p helm-tramp-file-name-regexp helm-pattern) - (helm-file-on-mounted-network-p helm-pattern)) - helm-ff-tramp-not-fancy) - (if helm-ff-transformer-show-only-basename - (if (helm-dir-is-dot file) - (if (eq helm-ff-tramp-not-fancy 'dirs-only) - (propertize file 'face 'helm-ff-dotted-directory) - file) - (cons (or (helm-ff--get-host-from-tramp-invalid-fname file) - (if (and (get-text-property 1 'helm-ff-dir file) - (eq helm-ff-tramp-not-fancy 'dirs-only)) - (propertize basename 'face 'helm-ff-directory) - basename)) - file)) - (cons (if (and (get-text-property 1 'helm-ff-dir file) - (eq helm-ff-tramp-not-fancy 'dirs-only)) - (propertize file 'face 'helm-ff-directory) - file) - file)) - ;; Now highlight. + (helm-file-on-mounted-network-p helm-pattern))) + (let ((disp (if (and helm-ff-transformer-show-only-basename + (not (setq dot (helm-dir-is-dot file)))) + (or (helm-ff--get-host-from-tramp-invalid-fname file) + basename) + file))) + ;; Filename with cntrl chars e.g. foo^J + ;; This will not work as long as most tramp file handlers doesn't + ;; handle such case, e.g. file-name-all-completions, + ;; directory-files, file-name-nondirectory etc... + ;; Keep it though in case they fix this upstream... + (setq disp (replace-regexp-in-string "[[:cntrl:]]" "?" disp)) + (cond (;; Dot directories . and .. + dot (propertize file 'face 'helm-ff-dotted-directory)) + ;; Directories. + ((get-text-property 1 'helm-ff-dir file) + (cons (propertize disp 'face 'helm-ff-directory) file)) + ;; Executable files. + ((get-text-property 1 'helm-ff-exe file) + (cons (propertize disp 'face 'helm-ff-executable) file)) + ;; Symlinks. + ((get-text-property 1 'helm-ff-sym file) + (cons (propertize disp 'face 'helm-ff-symlink) file)) + ;; Any other files. + (t (cons (propertize disp 'face 'helm-ff-file) file)))) + + ;; Highlight local files showing everything, symlinks, exe, + ;; dirs etc... (let* ((disp (if (and helm-ff-transformer-show-only-basename - (not (helm-dir-is-dot file)) + (not (setq dot (helm-dir-is-dot file))) (not (and helm--url-regexp (string-match helm--url-regexp file))) (not (string-match helm-ff-url-regexp file))) @@ -2698,57 +2851,62 @@ Return candidates prefixed with basename of `helm-input' first." (attr (file-attributes file)) (type (car attr)) x-bit) - + ;; Filename cntrl chars e.g. foo^J + (setq disp (replace-regexp-in-string "[[:cntrl:]]" "?" disp)) (cond ((string-match "file-error" file) file) - ( ;; A not already saved file. + (;; A dead symlink. (and (stringp type) (not (helm-ff-valid-symlink-p file)) - (not (string-match "^\.#" basename))) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-invalid-symlink) t) + (not (string-match "^\\.#" basename))) + (cons (propertize disp 'face 'helm-ff-invalid-symlink) file)) ;; A dotted directory symlinked. - ((and (helm-ff-dot-file-p file) (stringp type)) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-dotted-symlink-directory) t) + ((and dot (stringp type)) + (cons (propertize disp 'face 'helm-ff-dotted-symlink-directory) file)) ;; A dotted directory. ((helm-ff-dot-file-p file) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-dotted-directory) t) + (cons (propertize disp 'face 'helm-ff-dotted-directory) file)) ;; A symlink. ((stringp type) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-symlink) t) + (cons (propertize disp 'display + (concat (propertize disp 'face 'helm-ff-symlink) + " -> " + (propertize (abbreviate-file-name type) + 'face 'helm-ff-truename))) file)) ;; A directory. ((eq t type) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-directory) t) + (cons (propertize disp 'face 'helm-ff-directory) + file)) + ;; A character device file. + ((and attr (string-match + "\\`[cp]" (setq x-bit (substring (nth 8 attr) 0 4)))) + (cons (propertize disp 'face 'helm-ff-pipe) + file)) + ;; A socket file. + ((and attr (string-match "\\`[s]" x-bit)) + (cons (propertize disp 'face 'helm-ff-socket) file)) ;; An executable file. ((and attr (string-match - "x\\'" (setq x-bit (substring (nth 8 attr) 0 4)))) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-executable) t) + "x\\'" x-bit)) + (cons (propertize disp 'face 'helm-ff-executable) file)) ;; An executable file with suid ((and attr (string-match "s\\'" x-bit)) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-suid) t) + (cons (propertize disp 'face 'helm-ff-suid) file)) ;; A file. ((and attr (null type)) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-file) t) + (cons (propertize disp 'face 'helm-ff-file) file)) ;; A non--existing file. - (t - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-file) nil 'new-file) - file)))))))) + (t (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-file) nil 'new-file) + file)))))))) (defun helm-find-files-action-transformer (actions candidate) "Action transformer for `helm-source-find-files'." @@ -3289,7 +3447,9 @@ is helm-source-find-files." ;; disabled with `ffap-machine-p-known' bound to 'reject. ;; `ffap-file-at-point' can be neutralized with ;; `helm-ff-guess-ffap-filenames' and `ffap-url-at-point' with - ;; `helm-ff-guess-ffap-urls'. + ;; `helm-ff-guess-ffap-urls' + ;; Note also that `ffap-url-unwrap-remote' can override these + ;; variables. (let ((ffap-alist (and helm-ff-guess-ffap-filenames ffap-alist)) (ffap-url-regexp helm--url-regexp)) (if (eq major-mode 'dired-mode) @@ -3406,6 +3566,7 @@ Where ACTION is a symbol that can be one of: Argument FOLLOW when non--nil specify to follow FILES to destination for the actions copy and rename." (require 'dired-async) + (require 'dired-x) ; For dired-keep-marker-relsymlink (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer)) ;; When default-directory in current-buffer is an invalid directory, ;; (e.g buffer-file directory have been renamed somewhere else) @@ -3518,7 +3679,19 @@ following files to destination." collect (buffer-name buf))) (defun helm-delete-file (file &optional error-if-dot-file-p synchro) - "Delete the given file after querying the user. + "Delete FILE after querying the user. + +When a prefix arg is given, files are deleted and not trashed even if +\`delete-by-moving-to-trash' is non nil. + +Return error when ERROR-IF-DOT-FILE-P is non nil and user tries to +delete a dotted file i.e. \".\" or \"..\". + +Ask user when directory are not empty to allow recursive deletion +unless `helm-ff-allow-recursive-deletes' is non nil. +When user is asked and reply with \"!\" don't ask for remaining +directories. + Ask to kill buffers associated with that file, too." (require 'dired) (cl-block nil @@ -3526,50 +3699,59 @@ Ask to kill buffers associated with that file, too." (helm-ff-dot-file-p file)) (error "Error: Cannot operate on `.' or `..'")) (let ((buffers (helm-file-buffers file)) - (helm--reading-passwd-or-string t)) - (cond ((and (not (file-symlink-p file)) - (file-directory-p file) + (helm--reading-passwd-or-string t) + (file-attrs (file-attributes file)) + (trash (and delete-by-moving-to-trash + (null helm-current-prefix-arg) + (null current-prefix-arg)))) + (cond ((and (eq (nth 0 file-attrs) t) (directory-files file t dired-re-no-dot)) ;; Synchro means persistent deletion from HFF. (if synchro - (when (y-or-n-p (format "Recursive delete of `%s'? " - (abbreviate-file-name file))) - (delete-directory file 'recursive delete-by-moving-to-trash)) + (when (or helm-ff-allow-recursive-deletes + trash + (y-or-n-p (format "Recursive delete of `%s'? " + (abbreviate-file-name file)))) + (delete-directory file 'recursive trash)) ;; Avoid using dired-delete-file really annoying in ;; emacs-26 but allows using ! (instead of all) to not ;; confirm anymore for recursive deletion of ;; directory. This is not persistent for all session ;; like emacs-26 does with dired-delete-file (think it ;; is a bug). - (if helm-ff-allow-recursive-deletes - (delete-directory file 'recursive delete-by-moving-to-trash) + (if (or helm-ff-allow-recursive-deletes trash) + (delete-directory file 'recursive trash) (pcase (helm-read-answer (format "Recursive delete of `%s'? [y,n,!,q]" (abbreviate-file-name file)) '("y" "n" "!" "q")) - ("y" (delete-directory file 'recursive delete-by-moving-to-trash)) + ("y" (delete-directory file 'recursive trash)) ("!" (setq helm-ff-allow-recursive-deletes t) - (delete-directory file 'recursive delete-by-moving-to-trash)) + (delete-directory file 'recursive trash)) ("n" (cl-return 'skip)) ("q" (throw 'helm-abort-delete-file (progn (message "Abort file deletion") (sleep-for 1)))))))) - ((and (not (file-symlink-p file)) - (file-directory-p file)) - (delete-directory file nil delete-by-moving-to-trash)) - (t (delete-file file delete-by-moving-to-trash))) + ((eq (nth 0 file-attrs) t) + (delete-directory file nil trash)) + (t (delete-file file trash))) (when buffers (cl-dolist (buf buffers) (when (y-or-n-p (format "Kill buffer %s, too? " buf)) (kill-buffer buf))))))) (defun helm-delete-marked-files (_ignore) + "Delete marked files with `helm-delete-file'." (let* ((files (helm-marked-candidates :with-wildcard t)) (len 0) + (trash (and delete-by-moving-to-trash + (null helm-current-prefix-arg) + (null current-prefix-arg))) + (prmt (if trash "Trash" "Delete")) (old--allow-recursive-deletes helm-ff-allow-recursive-deletes)) (with-helm-display-marked-candidates helm-marked-buffer-name (helm-ff--count-and-collect-dups files) - (if (not (y-or-n-p (format "Delete *%s File(s)" (length files)))) + (if (not (y-or-n-p (format "%s *%s File(s)" prmt (length files)))) (message "(No deletions performed)") (catch 'helm-abort-delete-file (unwind-protect @@ -3582,7 +3764,119 @@ Ask to kill buffers associated with that file, too." (sleep-for 1)) (cl-incf len)))) (setq helm-ff-allow-recursive-deletes old--allow-recursive-deletes))) - (message "%s File(s) deleted" len))))) + (message "%s File(s) %s" len (if trash "trashed" "deleted")))))) + +;;; Delete files async +;; +;; +(defvar helm-ff-delete-log-file + (expand-file-name "helm-delete-file.log" user-emacs-directory) + "The file use to communicate with emacs child when deleting files async.") + +(defvar helm-ff--trash-flag nil) + +(define-minor-mode helm-ff--delete-async-modeline-mode + "Notify mode-line that an async process run." + :group 'dired-async + :global t + ;; FIXME: Handle jobs like in dired-async, needs first to allow + ;; naming properly processes in async, they are actually all named + ;; emacs and running `async-batch-invoke', so if one copy a file and + ;; delete another file at the same time it may clash. + :lighter (:eval (propertize (format " %s file(s) async ..." + (if helm-ff--trash-flag + "Trashing" "Deleting")) + 'face 'helm-delete-async-message)) + (unless helm-ff--delete-async-modeline-mode + (let ((visible-bell t)) (ding)) + (setq helm-ff--trash-flag nil))) + +(defun helm-delete-async-mode-line-message (text face &rest args) + "Notify end of async operation in `mode-line'." + (message nil) + (let ((mode-line-format (concat + " " (propertize + (if args + (apply #'format text args) + text) + 'face face)))) + (force-mode-line-update) + (sit-for 3) + (force-mode-line-update))) + +(defun helm-delete-marked-files-async (_ignore) + "Same as `helm-delete-marked-files' but async. + +When a prefix arg is given, files are deleted and NOT trashed even if +\`delete-by-moving-to-trash' is non nil. + +This function is not using `helm-delete-file' and BTW not asking user +for recursive deletion of directory, be warned that directories are +always deleted with no warnings." + (let* ((files (helm-marked-candidates :with-wildcard t)) + (trash (and delete-by-moving-to-trash + (null helm-current-prefix-arg) + (null current-prefix-arg))) + (prmt (if trash "Trash" "Delete")) + (buffers (cl-loop for file in files + for buf = (helm-file-buffers file) + when buf append buf)) + (callback (lambda (result) + (helm-ff--delete-async-modeline-mode -1) + (when (file-exists-p helm-ff-delete-log-file) + (display-warning 'helm + (with-temp-buffer + (insert-file-contents + helm-ff-delete-log-file) + (buffer-string)) + :error + "*helm delete files*") + (fit-window-to-buffer (get-buffer-window + "*helm delete files*")) + (delete-file helm-ff-delete-log-file)) + (when buffers + (dolist (buf buffers) + (let ((last-nonmenu-event t)) + (when (y-or-n-p (format "Kill buffer %s, too? " buf)) + (kill-buffer buf))))) + (run-with-timer + 0.1 nil + (lambda () + (helm-delete-async-mode-line-message + "%s (%s/%s) file(s) async done" + 'helm-delete-async-message + (if trash "Trashing" "Deleting") + result (length files)))))) + ;; Workaround emacs-26 bug with tramp see + ;; https://github.com/jwiegley/emacs-async/issues/80. + (async-quiet-switch "-q")) + (setq helm-ff--trash-flag trash) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (helm-ff--count-and-collect-dups files) + (if (not (y-or-n-p (format "%s *%s File(s)" prmt (length files)))) + (message "(No deletions performed)") + (async-start + `(lambda () + ;; `delete-by-moving-to-trash' have to be set globally, + ;; using the TRASH argument of delete-file or + ;; delete-directory is not enough. + (setq delete-by-moving-to-trash ,delete-by-moving-to-trash) + (let ((result 0)) + (dolist (file ',files result) + (condition-case err + (cond ((eq (nth 0 (file-attributes file)) t) + (delete-directory file 'recursive ,trash) + (setq result (1+ result))) + (t (delete-file file ,trash) + (setq result (1+ result)))) + (error (with-temp-file ,helm-ff-delete-log-file + (insert (format-time-string "%x:%H:%M:%S\n")) + (insert (format "%s:%s\n " + (car err) + (mapconcat 'identity (cdr err) " "))))))))) + callback) + (helm-ff--delete-async-modeline-mode 1))))) (defun helm-find-file-or-marked (candidate) "Open file CANDIDATE or open helm marked files in separate windows. |