|
|
- ;;; helm-for-files.el --- helm-for-files and related. -*- lexical-binding: t -*-
-
- ;; Copyright (C) 2012 ~ 2019 Thierry Volpiatto <thierry.volpiatto@gmail.com>
-
- ;; This program is free software; you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
-
- ;; This program is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
-
- ;; You should have received a copy of the GNU General Public License
- ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
- ;;; Code:
-
- (require 'helm-files)
- (require 'helm-external)
- (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)))
-
- (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 helm-recentf-fuzzy-match)))))
-
- ;;; 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-dir-is-dot 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. (Issue #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 (cons (propertize disp
- 'face 'helm-ff-file
- 'match-part (funcall mp-fn disp)
- 'help-echo (expand-file-name i))
- 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 avoid launching needlessly locate when what you search 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)
-
- ;; Local Variables:
- ;; byte-compile-warnings: (not obsolete)
- ;; coding: utf-8
- ;; indent-tabs-mode: nil
- ;; End:
-
- ;;; helm-for-files.el ends here
|