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
|