311 lines
12 KiB
EmacsLisp
311 lines
12 KiB
EmacsLisp
;;; helm-for-files.el --- helm-for-files and related. -*- lexical-binding: t -*-
|
||
|
||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Code:
|
||
|
||
(require 'helm-files)
|
||
(require 'helm-external)
|
||
(require 'helm-bookmark)
|
||
|
||
(defcustom helm-multi-files-toggle-locate-binding "C-c p"
|
||
"Default binding to switch back and forth locate in `helm-multi-files'."
|
||
:group 'helm-files
|
||
:type 'string)
|
||
|
||
(defcustom helm-for-files-preferred-list
|
||
'(helm-source-buffers-list
|
||
helm-source-recentf
|
||
helm-source-bookmarks
|
||
helm-source-file-cache
|
||
helm-source-files-in-current-dir
|
||
helm-source-locate)
|
||
"Your preferred sources for `helm-for-files' and `helm-multi-files'.
|
||
|
||
When adding a source here it is up to you to ensure the library
|
||
of this source is accessible and properly loaded."
|
||
:type '(repeat (choice symbol))
|
||
:group 'helm-files)
|
||
|
||
(defcustom helm-for-files-tramp-not-fancy t
|
||
"Colorize remote files when non nil.
|
||
|
||
Be aware that a nil value will make tramp display very slow."
|
||
:group 'helm-files
|
||
:type 'boolean)
|
||
|
||
;;; File Cache
|
||
;;
|
||
;;
|
||
(defvar file-cache-alist)
|
||
|
||
(defclass helm-file-cache (helm-source-in-buffer helm-type-file)
|
||
((init :initform (lambda () (require 'filecache)))))
|
||
|
||
(defun helm-file-cache-get-candidates ()
|
||
(cl-loop for item in file-cache-alist append
|
||
(cl-destructuring-bind (base &rest dirs) item
|
||
(cl-loop for dir in dirs collect
|
||
(concat dir base)))))
|
||
|
||
(defvar helm-source-file-cache nil)
|
||
|
||
(defcustom helm-file-cache-fuzzy-match nil
|
||
"Enable fuzzy matching in `helm-source-file-cache' when non--nil."
|
||
:group 'helm-files
|
||
:type 'boolean
|
||
:set (lambda (var val)
|
||
(set var val)
|
||
(setq helm-source-file-cache
|
||
(helm-make-source "File Cache" 'helm-file-cache
|
||
:fuzzy-match helm-file-cache-fuzzy-match
|
||
:data 'helm-file-cache-get-candidates))))
|
||
|
||
(cl-defun helm-file-cache-add-directory-recursively
|
||
(dir &optional match (ignore-dirs t))
|
||
(require 'filecache)
|
||
(cl-loop for f in (helm-walk-directory
|
||
dir
|
||
:path 'full
|
||
:directories nil
|
||
:match match
|
||
:skip-subdirs ignore-dirs)
|
||
do (file-cache-add-file f)))
|
||
|
||
(defun helm-transform-file-cache (actions _candidate)
|
||
(let ((source (helm-get-current-source)))
|
||
(if (string= (assoc-default 'name source) "File Cache")
|
||
(append actions
|
||
'(("Remove marked files from file-cache"
|
||
. helm-ff-file-cache-remove-file)))
|
||
actions)))
|
||
|
||
;;; Recentf files
|
||
;;
|
||
;;
|
||
(defvar helm-recentf--basename-flag nil)
|
||
|
||
(defun helm-recentf-pattern-transformer (pattern)
|
||
(let ((pattern-no-flag (replace-regexp-in-string " -b" "" pattern)))
|
||
(cond ((and (string-match " " pattern-no-flag)
|
||
(string-match " -b\\'" pattern))
|
||
(setq helm-recentf--basename-flag t)
|
||
pattern-no-flag)
|
||
((string-match "\\([^ ]*\\) -b\\'" pattern)
|
||
(prog1 (match-string 1 pattern)
|
||
(setq helm-recentf--basename-flag t)))
|
||
(t (setq helm-recentf--basename-flag nil)
|
||
pattern))))
|
||
|
||
(defcustom helm-turn-on-recentf t
|
||
"Automatically turn on `recentf-mode' when non-nil."
|
||
:group 'helm-files
|
||
:type 'boolean)
|
||
|
||
(defclass helm-recentf-source (helm-source-sync helm-type-file)
|
||
((init :initform (lambda ()
|
||
(require 'recentf)
|
||
(when helm-turn-on-recentf (recentf-mode 1))))
|
||
(candidates :initform (lambda () recentf-list))
|
||
(pattern-transformer :initform 'helm-recentf-pattern-transformer)
|
||
(match-part :initform (lambda (candidate)
|
||
(if (or helm-ff-transformer-show-only-basename
|
||
helm-recentf--basename-flag)
|
||
(helm-basename candidate) candidate)))
|
||
(migemo :initform t)
|
||
(persistent-action :initform 'helm-ff-kill-or-find-buffer-fname)))
|
||
|
||
(cl-defmethod helm--setup-source :after ((source helm-recentf-source))
|
||
(setf (slot-value source 'action)
|
||
(append (symbol-value (helm-actions-from-type-file))
|
||
'(("Delete file(s) from recentf" .
|
||
(lambda (_candidate)
|
||
(cl-loop for file in (helm-marked-candidates)
|
||
do (setq recentf-list (delete file recentf-list)))))))))
|
||
|
||
(defvar helm-source-recentf nil
|
||
"See (info \"(emacs)File Conveniences\").
|
||
Set `recentf-max-saved-items' to a bigger value if default is too
|
||
small.")
|
||
|
||
(defcustom helm-recentf-fuzzy-match nil
|
||
"Enable fuzzy matching in `helm-source-recentf' when non-nil."
|
||
:group 'helm-files
|
||
:type 'boolean
|
||
:set (lambda (var val)
|
||
(set var val)
|
||
(let ((helm-fuzzy-sort-fn 'helm-fuzzy-matching-sort-fn-preserve-ties-order))
|
||
(setq helm-source-recentf
|
||
(helm-make-source "Recentf" 'helm-recentf-source
|
||
:fuzzy-match val)))))
|
||
|
||
|
||
;;; Files in current dir
|
||
;;
|
||
;;
|
||
(defun helm-highlight-files (files _source)
|
||
"A basic transformer for helm files sources.
|
||
Colorize only symlinks, directories and files."
|
||
(cl-loop with mp-fn = (or (assoc-default
|
||
'match-part (helm-get-current-source))
|
||
'identity)
|
||
for i in files
|
||
for disp = (if (and helm-ff-transformer-show-only-basename
|
||
(not (helm-ff-dot-file-p i))
|
||
(not (and helm--url-regexp
|
||
(string-match helm--url-regexp i)))
|
||
(not (string-match helm-ff-url-regexp i)))
|
||
(helm-basename i) (abbreviate-file-name i))
|
||
for isremote = (or (file-remote-p i)
|
||
(helm-file-on-mounted-network-p i))
|
||
;; Call file-attributes only if:
|
||
;; - file is not remote
|
||
;; - helm-for-files--tramp-not-fancy is nil and file is remote AND
|
||
;; connected. (Bug#1679)
|
||
for type = (and (or (null isremote)
|
||
(and (null helm-for-files-tramp-not-fancy)
|
||
(file-remote-p i nil t)))
|
||
(car (file-attributes i)))
|
||
collect
|
||
(cond ((and (null type) isremote) (cons disp i))
|
||
((stringp type)
|
||
(cons (propertize disp
|
||
'face 'helm-ff-symlink
|
||
'match-part (funcall mp-fn disp)
|
||
'help-echo (expand-file-name i))
|
||
i))
|
||
((eq type t)
|
||
(cons (propertize disp
|
||
'face 'helm-ff-directory
|
||
'match-part (funcall mp-fn disp)
|
||
'help-echo (expand-file-name i))
|
||
i))
|
||
(t (let* ((ext (helm-file-name-extension disp))
|
||
(disp (propertize disp
|
||
'face 'helm-ff-file
|
||
'match-part (funcall mp-fn disp)
|
||
'help-echo (expand-file-name i))))
|
||
(when (condition-case _err
|
||
(string-match (format "\\.\\(%s\\)$" ext) disp)
|
||
(invalid-regexp nil))
|
||
(add-face-text-property
|
||
(match-beginning 1) (match-end 1)
|
||
'helm-ff-file-extension nil disp))
|
||
(cons disp i))))))
|
||
|
||
(defclass helm-files-in-current-dir-source (helm-source-sync helm-type-file)
|
||
((candidates :initform (lambda ()
|
||
(with-helm-current-buffer
|
||
(let ((dir (helm-current-directory)))
|
||
(when (file-accessible-directory-p dir)
|
||
(directory-files dir t))))))
|
||
(pattern-transformer :initform 'helm-recentf-pattern-transformer)
|
||
(match-part :initform (lambda (candidate)
|
||
(if (or helm-ff-transformer-show-only-basename
|
||
helm-recentf--basename-flag)
|
||
(helm-basename candidate) candidate)))
|
||
(fuzzy-match :initform t)
|
||
(migemo :initform t)))
|
||
|
||
(defvar helm-source-files-in-current-dir
|
||
(helm-make-source "Files from Current Directory"
|
||
'helm-files-in-current-dir-source))
|
||
|
||
;;;###autoload
|
||
(defun helm-for-files ()
|
||
"Preconfigured `helm' for opening files.
|
||
Run all sources defined in `helm-for-files-preferred-list'."
|
||
(interactive)
|
||
(require 'helm-x-files)
|
||
(unless helm-source-buffers-list
|
||
(setq helm-source-buffers-list
|
||
(helm-make-source "Buffers" 'helm-source-buffers)))
|
||
(helm :sources helm-for-files-preferred-list
|
||
:ff-transformer-show-only-basename nil
|
||
:buffer "*helm for files*"
|
||
:truncate-lines helm-buffers-truncate-lines))
|
||
|
||
(defun helm-multi-files-toggle-to-locate ()
|
||
(interactive)
|
||
(with-helm-alive-p
|
||
(with-helm-buffer
|
||
(if (setq helm-multi-files--toggle-locate
|
||
(not helm-multi-files--toggle-locate))
|
||
(progn
|
||
(helm-set-sources (unless (memq 'helm-source-locate
|
||
helm-sources)
|
||
(cons 'helm-source-locate helm-sources)))
|
||
(helm-set-source-filter '(helm-source-locate)))
|
||
(helm-kill-async-processes)
|
||
(helm-set-sources (remove 'helm-source-locate
|
||
helm-for-files-preferred-list))
|
||
(helm-set-source-filter nil)))))
|
||
(put 'helm-multi-files-toggle-to-locate 'helm-only t)
|
||
|
||
;;;###autoload
|
||
(defun helm-multi-files ()
|
||
"Preconfigured helm like `helm-for-files' but running locate only on demand.
|
||
|
||
Allow toggling back and forth from locate to others sources with
|
||
`helm-multi-files-toggle-locate-binding' key.
|
||
This avoids launching locate needlessly when what you are
|
||
searching for is already found."
|
||
(interactive)
|
||
(require 'helm-x-files)
|
||
(unless helm-source-buffers-list
|
||
(setq helm-source-buffers-list
|
||
(helm-make-source "Buffers" 'helm-source-buffers)))
|
||
(setq helm-multi-files--toggle-locate nil)
|
||
(helm-locate-set-command)
|
||
(helm-set-local-variable 'helm-async-outer-limit-hook
|
||
(list (lambda ()
|
||
(when (and helm-locate-fuzzy-match
|
||
(not (string-match-p
|
||
"\\s-" helm-pattern)))
|
||
(helm-redisplay-buffer)))))
|
||
(let ((sources (remove 'helm-source-locate helm-for-files-preferred-list))
|
||
(helm-locate-command
|
||
(if helm-locate-fuzzy-match
|
||
(unless (string-match-p "\\`locate -b" helm-locate-command)
|
||
(replace-regexp-in-string
|
||
"\\`locate" "locate -b" helm-locate-command))
|
||
helm-locate-command))
|
||
(old-key (lookup-key
|
||
helm-map
|
||
(read-kbd-macro helm-multi-files-toggle-locate-binding))))
|
||
(with-helm-temp-hook 'helm-after-initialize-hook
|
||
(define-key helm-map (kbd helm-multi-files-toggle-locate-binding)
|
||
'helm-multi-files-toggle-to-locate))
|
||
(unwind-protect
|
||
(helm :sources sources
|
||
:ff-transformer-show-only-basename nil
|
||
:buffer "*helm multi files*"
|
||
:truncate-lines helm-buffers-truncate-lines)
|
||
(define-key helm-map (kbd helm-multi-files-toggle-locate-binding)
|
||
old-key))))
|
||
|
||
;;;###autoload
|
||
(defun helm-recentf ()
|
||
"Preconfigured `helm' for `recentf'."
|
||
(interactive)
|
||
(helm :sources 'helm-source-recentf
|
||
:ff-transformer-show-only-basename nil
|
||
:buffer "*helm recentf*"))
|
||
|
||
(provide 'helm-for-files)
|
||
|
||
;;; helm-for-files.el ends here
|