.
helm-4.0.3/Makefile 0000664 0000000 0000000 00000006363 15011067617 0014117 0 ustar 00root root 0000000 0000000 # makefile for helm.
# Author: Michael Markert.
# Copyright (C) 2011~2012, Michael Markert, all rights reserved.
## This file is NOT part of GNU Emacs
##
## License
##
## 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, 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; see the file COPYING. If not, write to
## the Free Software Foundation, Inc., 51 Franklin Street, Fifth
## Floor, Boston, MA 02110-1301, USA.
# Emacs invocation
EMACS_COMMAND := emacs
# Use -q to have /usr/local/share/emacs/site-lisp and subdirs in load-path
EMACS := $(EMACS_COMMAND) -q -batch
EVAL := $(EMACS) --eval
PKGDIR := .
# Additional emacs loadpath
LOADPATH := -L $(PKGDIR)
# Prefer emacs config folder in XDG_CONFIG_HOME to ~/.emacs.d
# Assume emacs-user-directory is ~/.emacs.d
# Try to find ELPA directory or STRAIGHT directory.
XDG_ELPA_DIR := $(if $(XDG_CONFIG_HOME), $(XDG_CONFIG_HOME)/emacs/elpa, $(HOME)/.config/emacs/elpa)
ELPA_DIR := $(if $(shell test -d $(XDG_ELPA_DIR)), $(XDG_ELPA_DIR), $(HOME)/.emacs.d/elpa)
XDG_STRAIGHT_DIR := $(if $(XDG_CONFIG_HOME), $(XDG_CONFIG_HOME)/emacs/straight/build, $(HOME)/.config/emacs/straight/build)
STRAIGHT_DIR := $(if $(shell test -d $(XDG_STRAIGHT_DIR)), $(XDG_STRAIGHT_DIR), $(HOME)/.emacs.d/straight/build)
ASYNC_ELPA_DIR = $(shell \
test -d $(ELPA_DIR) && \
find -L $(ELPA_DIR) -maxdepth 1 -regex '.*/async-[.0-9]*' 2> /dev/null | \
sort | tail -n 1)
ifneq "$(ASYNC_ELPA_DIR)" ""
LOADPATH += -L $(ASYNC_ELPA_DIR)
endif
ASYNC_STRAIGHT_DIR = $(shell \
test -d $(STRAIGHT_DIR) && \
find -L $(STRAIGHT_DIR) -maxdepth 1 -regex '.*/async' 2> /dev/null | \
sort | tail -n 1)
ifneq "$(ASYNC_STRAIGHT_DIR)" ""
LOADPATH += -L $(ASYNC_STRAIGHT_DIR)
endif
# Files to compile
EL := $(sort $(wildcard helm*.el))
# Compiled files
ELC := $(EL:.el=.elc)
.PHONY: clean autoloads batch-compile
all: clean autoloads batch-compile
$(ELC): %.elc: %.el
$(EMACS) $(LOADPATH) -f batch-byte-compile $<
# Compile needed files
compile: $(ELC)
# Compile all files at once
batch-compile:
@echo Compiling helm with $(EMACS_COMMAND)
$(EMACS) $(LOADPATH) -f batch-byte-compile $(EL)
# Remove all generated files
clean:
rm -f $(ELC)
# Make autoloads file
autoloads:
$(EVAL) "(progn (setq generated-autoload-file (expand-file-name \"helm-autoloads.el\" \"$(PKGDIR)\")) \
(setq backup-inhibited t) (update-directory-autoloads \"$(PKGDIR)\"))"
PREFIX=/usr/local/
BIN=${PREFIX}bin/
DESTDIR=${PREFIX}share/emacs/site-lisp/helm/
install:
test -d ${DESTDIR} || mkdir ${DESTDIR}
rm -f ${DESTDIR}*.el
rm -f ${DESTDIR}*.elc
cp -f *.el $(DESTDIR)
cp -f *.elc $(DESTDIR)
cp -f helm-autoloads.el $(DESTDIR)
cp -f emacs-helm.sh $(DESTDIR)
ln -fs ${DESTDIR}emacs-helm.sh ${BIN}helm
uninstall:
rm -vf ${DESTDIR}*.elc
rm -vf ${DESTDIR}*.el
rm -vf ${DESTDIR}emacs-helm.sh
rm -vf ${BIN}helm
helm-4.0.3/NEWS.org 0000664 0000000 0000000 00000024046 15011067617 0013742 0 ustar 00root root 0000000 0000000 #+STARTUP:showall
* NEWS
** Version 4.0.3
*** New drag-and-drop support for helm-find-files (only Emacs-29+)
Use now dnd.el for the new drag-and-drop function.
This allows drag-and-drop in external applications in addition to emacs
dired frames and windows. See helm-find-files documentation.
*** Remove old drag-and-drop support for helm-find-files
*** Add a new completion metadata category command-help
Handle helm-M-x prefix arg integration in this category. That's mean
you can have helm-M-x prefix arg in M-X.
*** Allow filtering sources in current session
It is bound to C-M-e in helm-map.
*** Change `helm-current-directory-alist` default value
Now C-x C-f from a Gnus buffer brings to News directory.
*** Exclude commands related to specific modes in helm-M-x
This is available only in Emacs with an interactive version supporting
MODES argument. It is configurable with
`helm-M-x-exclude-unusable-commands-in-mode`, default to t.
*** Fix preselection after persistent killing buffers
*** Improve colors in ttys
*** Add new actions to helm-find-files
*** Fix require-match in completion-in-region
** Version 4.0.2
*** Fix Emacs bug with CRM when using org-set-tags
*** Improve helm-source-files-in-current-dir
*** Fix some compatibility problems with EIEIO in various Emacs
*** Improve helm-projects-history
*** Fix bug in recentf
Properties may corrupt recentf data, prevent this.
*** Fix bug with *-window-side-state no more working
*** Remove the ability of switching to recursive search with C-j in HFF
It was broken and not needed as we can just add the final "/" to expand.
*** Change default value of `helm-locate-recursive-dirs-command'
It is no more using `locate` but `find`, this because locate is not
working anymore out of the box without some tweaks (plocate backend).
It is still anyway the faster alternative once tweaked, see HFF
documentation.
*** Improve position of helm frame
*** Provide icons in find and fdfind
** Version 4.0.1
*** Provide icons in some more places (helm-for-files.el)
*** Package-vc-* commands have now affixations (package category)
*** Show only basename of dot files in helm-find-files
It is now the default, but it can be configured with `helm-ff-show-dot-file-path`.
*** Allow using both all-the-icons and nerd-icons as icon providers
Use the variable `helm-x-icons-provider`.
*** Add affixations to helm-info
Add a description of info file when using `helm-info` or `info-display-manual`.
*** Provide minimal support for eww bookmarks
*** Stop preventing dups when trashing files
*** Add a helm-add-to-list function for user init file settings
*** Drop support for deprecated defadvice management
*** Allow destructuring in helm-acase
*** Popup-info can be provided in metadata and added to any completion
via the vars `helm-completing-read-command-categories` and
`helm-completing-read-extra-metadata`, for example it is now enabled
in M-x man.
*** Maybe provide a popup-info in completion-at-point
If CAPFns provide such information via `completion-extra-properties`,
display it in a popup-info when helm-popup-tip-mode is enabled.
`helm-lisp-completion-at-point` provides this as well.
*** Add completion for Char Classes for regexps
This is available in `helm-lisp-completion-at-point`.
*** Enhance usage of tab-bar-mode from Helm
Previously we were displaying each marked candidate in a tab, now all
marked candidates go in same tab.
Helm-find-files is now using the same functions as helm-buffers to
display its candidates in tab.
helm-imenu-all when jumping to a candidate jump to it in its tab if
possible.
*** Access to helm-find-files bookmarks from helm-read-file-name
That's mean that when copying/renaming etc... you can use bookmarks as
target.
*** Fix a bug in query replace in file names
It is now possible to match counter ("\#") inside the replacement
string and not only before or after as before.
*** Fix a bug with dummy sources in file related sources
It is now possible to mark wildcard candidates from unrelated
directories.
** Version 4.0
*** Enhance helm-finder
Now helm-finder fetchs keywords from all packages, not only built-in
and allows installing from there.
*** helm-popup-tip-mode is now usable in any source having the popup-info attribute
In addition of the various helm-grep-* now =helm-man-woman= and
=helm-find-files= can benefit of this mode.
*** New command helm-outline to navigate buffers according to outline-regexp
*** New helm grep ag action to search results from the helm ag/rg session
This allows filtering the current results to another pattern or to
specific file.
*** New helm grep ag action to launch ag/rg on parent directory of current search
*** Packages can now be (re)installed/upgraded asynchronously from helm-packages
It is now the default, you can customize this with =helm-packages-async=.
*** Helm-find-files persistent delete uses now a read-answer prompt
It is now possible to answer "!" (yes for all) when using marked
candidates, this for the file deletion itself and also for the kill
buffer question.
*** Allow saving selection when deleting minibuffer contents
This is now possible with a prefix arg given when position is at eol
in minibuffer. This allow for example showing all candidates keeping
current selection in helm-ls-git log after a search.
*** Save files opened from etags and fd in file-name-history
*** Provide help in helm-read-answer
*** Disable helm for read-multiple-choice--long-answers
** Version 3.9.9
*** Change prefix arg behavior of helm-show-all-candidates-in-source
With a prefix arg show all candidates, with a numeric prefix arg show
ARG number of candidates, and with no prefix arg show only
helm-candidate-number-limit of candidates.
*** Get rid of popup.el dependency
*** helm-completion-styles-alist accepts commands for completion-in-region
*** Minibuffer-contents change color in HFF when updating
This is controlled by =helm-ff-dim-prompt-on-update= user variable.
*** Now new file and dir have a dummy source in HFF, same for completing-read's
and read-file-name.
*** helm-info-at-point shows index of current page in addition of default
So it can safely be used as a replacement of "i" in Info.
*** Add affixation function for eww (emacs-30 only)
*** Allow toggling auto update in helm-top with a prefix arg
*** Do not use `dired-create-destination-dirs` mechanism for directory creation
as it is not working in some cases (e.g. symlinks).
*** Fix persistent action in helm mark-ring when follow mode is on
*** Fix Imenu preselection when point is on a name with special chars
*** Provide a new progress bar for rsync with a svg widget
Needs svg-lib package but it is not mandatory.
** Version 3.9.8
*** New helm-finder command
*** Make `completions-detailed` working with 'emacs' helm-completion-style
It was already working but was really slow and was not supporting
`helm-completing-read-command-categories` mechanism which provide
`completions-detailed` in much more places than Emacs vanilla.
*** Helm-goto-line save position even when using persistent actions
*** helm-info is now colorized
*** Displaying thumnails is now slighly faster
*** Add a new mode to edit bookmark annotations
When viewing an annotation you had to kill the buffer, restart
helm-bookmarks, and run the edit annotation action, now you can edit
directly from the view buffer.
*** It is now possible to rename marked bookmarks
*** New compress/uncompress/compress-to action in helm-find-files
All actions are asynchronous except the persistent ones.
*** Allow toggling while-no-input for easier edebugging
Use the new `helm-update-edebug` variable to enable this.
*** And various bug fixes as always
** Version 3.9.7
*** Fix package-requires in helm.el
** Version 3.9.6
*** Fix bug with helm-mm-exact-search (bug#2616)
*** Improve locate library fns
*** Fix a old bug with candidate transformer
candidate-transformer functions should behave the same in in-buffer
and sync source: transforming all candidates.
*** Fix kmacro for Emacs-29+
*** Various minor bug fixes
** Version 3.9.5
*** Add compatibility with Emacs-28< for helm-packages
Tested with emacs-27.
*** Add new action package-isolate for helm-packages
Allow launching a new Emacs with only package(s).
*** Packages list can be refreshed with C-c C-u
BTW there is no more option to update from actions with prefix arg.
*** Add more affixations fns for completing-read
Themes, colors etc...
*** Add new var helm-compleions-detailed for emacs-27
This allow using completions-detailed in Emacs-27 with various
describe-* functions.
*** Helm-occur now doesn't hang when trying to match empty lines
With "^$".
*** Highlight matches in M-x highlight only commands
I.e. Items in short documentation are not highlighted.
** Version 3.9.4
*** Add two new alists to allow extending completions-detailed
This allows providing detailed completions in more places, see
`helm-completing-read-extra-metadata` and
`helm-completing-read-command-categories`.
They are not provided as user variables as it may be tricky to provide
the corresponding affixations functions.
As of now we have detailed completions in
describe-function/variable/symbol/command/package,
find-function/variable, switch-to-buffer,
customize-variable/group, package-(vc)install, package-vc-checkout.
*** New helm packages manager
The old helm-elisp-package has been replaced by helm-packages.
The old one was too slow, taking lot of memory and even crashing Emacs
especially with last Emacs-29.
** Version 3.9.3
*** Ensure to use affixation functions provided by caller in helm-mode
** Version 3.9.2
*** New progress bar for Rsync action from helm-find-files
*** Describe-* commands with completions-detailed are now fast
*** Use Wfnames package as dependency to replace Wdired
** Version 3.9.1
*** helm-config file has been removed
Therefore (require 'helm-config) will return an error, don't use this
anymore. If installing from source use instead (require 'helm-autoloads), otherwise from a package install, the autoloads file
will be automatically loaded.
*** Allow using helm-completion-styles-alist by command
*** New mode for editing large vars
Will be used automatically when using the set variable action from
helm-apropos.
*** Improve all-the-icons in many places
helm-4.0.3/README.md 0000664 0000000 0000000 00000004421 15011067617 0013727 0 ustar 00root root 0000000 0000000
Emacs-Helm
***
Helm is an Emacs framework for incremental completions and narrowing
selections. It provides an easy-to-use API for developers wishing to build
their own Helm applications in Emacs, powerful search tools and dozens of
already built-in commands providing completion to almost everything.
It is a must-have for anyone using Emacs as a main work environment.
Helm has been widely adopted by many Emacs power-users.
It is available in Melpa and can be easily installed from the Emacs package manager.
***
Homepage |
Downloads |
Get started |
Helm wiki |
FAQ
***
Helm in action browsing images
[badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg
Maintainance of Helm is a lot of work please consider making a donation, thank you!
[](https://github.com/sponsors/emacs-helm)
helm-4.0.3/emacs-helm.sh 0000775 0000000 0000000 00000026355 15011067617 0015034 0 ustar 00root root 0000000 0000000 #!/usr/bin/env sh
## Copyright (C) 2012 ~ 2025 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 .
## Commentary:
# Preconfigured `emacs -Q' with a basic Helm configuration.
# If TEMP env var exists, use it, otherwise declare it.
test -z "$TEMP" && TEMP="/tmp"
CONF_FILE="$TEMP/helm-cfg.el"
EMACS=emacs
QUICK=-Q
TOOLBARS=-1
LOAD_PACKAGES=
usage () {
cat >&1 < $CONF_FILE <\`helm-find-files'\\n\
;; - \`occur'(M-s o) =>\`helm-occur'\\n\
;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\\n\
;; - \`apropos-command'(C-h a) =>\`helm-apropos'\\n\
;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\\n\
;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\\n\
;; - \`yank-pop'(M-y) =>\`helm-show-kill-ring'\\n\\n
;; \`helm-mode' is enabled which mean that most Emacs commands using completion\\n\
;; will use helm.\\n\
;; To start editing a file or to create a new file, visit it with \`C-x C-f'\\n\
;; and enter text in its buffer, to save your changes hit \`C-x C-s'.
;; Find context help for most Helm commands with \`C-h m' while helm is running.\\n\
;; You can also retrieve the whole user documentation with \`C-x c h h'.\\n\
;; For online documentation see \`https://github.com/emacs-helm/helm/wiki'.\\n\
;; \(Put cursor on url, hit \`C-x C-f' and then RETurn).\\n\
;; To quit this Emacs, hit \'C-x C-c'.\\n\
;; Note about keybindings in Emacs: \`C-' means \'Control-' and \`M-' \'Alt-'.\\n\
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\\n")
(setq load-path (quote $LOAD_PATH))
(defvar default-package-manager nil)
;; /home/you/.emacs.d/.local/straight/build-27.1/helm
(defvar initial-package-directory (file-name-directory (file-truename "$0")))
(defvar bootstrap-version)
(let* ((packages "$LOAD_PACKAGES")
(pkg-list (and packages
(not (equal packages ""))
(split-string packages ",")))
;; /home/you/.emacs.d/.local/straight/build-27.1
(straight-path (file-name-directory (directory-file-name initial-package-directory)))
;; /home/you/.emacs.d/.local/straight/build-27.1/async
(async-path (expand-file-name "async" straight-path))
;; /home/you/.emacs.d/.local/straight/repos/straight.el/bootstrap.el
(bootstrap-file
(expand-file-name "repos/straight.el/bootstrap.el"
(file-name-directory (directory-file-name straight-path))))
(bootstrap-version 5))
(when (file-exists-p bootstrap-file)
(setq default-package-manager 'straight)
(load bootstrap-file nil 'nomessage)
(add-to-list 'load-path async-path)
(when pkg-list
(dolist (pkg pkg-list)
(let* ((pkg-path (expand-file-name pkg straight-path))
(autoload-file (expand-file-name
(format "%s-autoloads.el" pkg)
pkg-path)))
(add-to-list 'load-path pkg-path)
(if (file-exists-p autoload-file)
(load autoload-file nil 'nomessage)
(straight-use-package (intern pkg))))))))
(unless (eq default-package-manager 'straight)
(require 'package)
;; User may be using a non standard \`package-user-dir'.
;; Modify \`package-directory-list' instead of \`package-user-dir'
;; in case the user starts Helm from a non-ELPA installation.
(unless (file-equal-p package-user-dir (locate-user-emacs-file "elpa"))
;; Something like /home/you/.emacs.d/somedir/else/elpa/
;; starting from default-directory is wrong in case helm.sh is a symlink
;; or e.g. helm --chdir foo have been used.
(add-to-list 'package-directory-list (directory-file-name
(file-name-directory
(directory-file-name initial-package-directory)))))
(let* ((str-lst "$LOAD_PACKAGES")
(load-packages (and str-lst
(not (string= str-lst ""))
(split-string str-lst ","))))
(setq package-load-list
(if (equal load-packages '("all"))
'(all)
(append '((helm-core t) (helm t) (async t) (wfnames t))
(mapcar (lambda (p) (list (intern p) t)) load-packages)))))
(package-initialize))
(add-to-list 'load-path initial-package-directory)
(unless (> $TOOLBARS 0)
(setq default-frame-alist '((vertical-scroll-bars . nil)
(tool-bar-lines . 0)
(menu-bar-lines . 0)
(fullscreen . nil))))
(blink-cursor-mode -1)
(load "helm-autoloads" nil t)
(helm-mode 1)
(with-eval-after-load 'tramp-cache (setq tramp-cache-read-persistent-data t))
(with-eval-after-load 'auth-source (setq auth-source-save-behavior nil))
(define-key global-map [remap find-file] 'helm-find-files)
(define-key global-map [remap occur] 'helm-occur)
(define-key global-map [remap list-buffers] 'helm-buffers-list)
(define-key global-map [remap dabbrev-expand] 'helm-dabbrev)
(define-key global-map [remap execute-extended-command] 'helm-M-x)
(define-key global-map [remap apropos-command] 'helm-apropos)
(define-key global-map [remap yank-pop] 'helm-show-kill-ring)
(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$CONF_FILE") (delete-file "$CONF_FILE"))))
EOF
$EMACS "$QUICK" -l "$CONF_FILE" "$@"
helm-4.0.3/helm-adaptive.el 0000664 0000000 0000000 00000032435 15011067617 0015520 0 ustar 00root root 0000000 0000000 ;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*-
;; Original Author: Tamas Patrovics
;; Copyright (C) 2007 Tamas Patrovics
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'helm)
(defgroup helm-adapt nil
"Adaptative sorting of candidates for Helm."
:group 'helm)
(defcustom helm-adaptive-history-file
(locate-user-emacs-file "helm-adaptive-history")
"Path of file where history information is stored.
When nil history is not saved nor restored after Emacs restart
unless you save/restore `helm-adaptive-history' with something
else like psession or desktop."
:type 'string)
(defcustom helm-adaptive-history-length 50
"Maximum number of candidates stored for a source."
:type 'number)
(defcustom helm-adaptive-sort-by-frequent-recent-usage t
"Try to sort on an average of frequent and recent usage when non-nil.
When nil sort on frequency usage only.
Only frequency:
When candidate have low frequency, you have to hit on it many
times to make it going up on top.
Frequency+recent:
Even with a low frequency, candidate go up on top. If a candidate
have a high frequency but it is not used since some time, it goes
down slowly, but as soon you reuse it it go up on top quickly."
:type 'boolean)
;; Internal
(defvar helm-adaptive-done nil
"nil if history information is not yet stored for the current
selection.")
(defvar helm-adaptive-history nil
"Contains the stored history information.
Format: ((SOURCE-NAME
(SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
(defconst helm-adaptive-freq-coefficient 5)
(defconst helm-adaptive-recent-coefficient 2)
(defun helm-adaptive-done-reset ()
(setq helm-adaptive-done nil))
;;;###autoload
(define-minor-mode helm-adaptive-mode
"Toggle adaptive sorting in all sources."
:global t
(if helm-adaptive-mode
(progn
(unless helm-adaptive-history
(helm-adaptive-maybe-load-history))
(add-hook 'kill-emacs-hook #'helm-adaptive-save-history)
;; Should run at beginning of `helm-initial-setup'.
(add-hook 'helm-before-initialize-hook #'helm-adaptive-done-reset)
;; Should run at beginning of `helm-exit-minibuffer'.
(add-hook 'helm-before-action-hook #'helm-adaptive-store-selection)
;; Should run at beginning of `helm-select-action'.
(add-hook 'helm-select-action-hook #'helm-adaptive-store-selection))
(helm-adaptive-save-history)
(setq helm-adaptive-history nil)
(remove-hook 'kill-emacs-hook #'helm-adaptive-save-history)
(remove-hook 'helm-before-initialize-hook #'helm-adaptive-done-reset)
(remove-hook 'helm-before-action-hook #'helm-adaptive-store-selection)
(remove-hook 'helm-select-action-hook #'helm-adaptive-store-selection)))
(defun helm-adapt-use-adaptive-p (&optional source-name)
"Return current source only if it use adaptive history, nil otherwise."
(when helm-adaptive-mode
(let* ((source (or source-name (helm-get-current-source)))
(adapt-source (or (assoc-default 'filtered-candidate-transformer source)
(assoc-default 'candidate-transformer source))))
(if (listp adapt-source)
(and (memq 'helm-adaptive-sort adapt-source) source)
(and (eq adapt-source 'helm-adaptive-sort) source)))))
(defun helm-adaptive-store-selection ()
"Store history information for the selected candidate."
(unless helm-adaptive-done
(setq helm-adaptive-done t)
(let ((source (helm-adapt-use-adaptive-p)))
(when source
(let* ((source-name (assoc-default 'name source))
(source-info (or (assoc source-name helm-adaptive-history)
(progn
(push (list source-name) helm-adaptive-history)
(car helm-adaptive-history))))
(selection (helm-get-selection nil t))
(selection-info (progn
(setcdr source-info
(cons
(let ((found (assoc selection (cdr source-info))))
(if (not found)
;; new entry
(list selection)
;; move entry to the beginning of the
;; list, so that it doesn't get
;; trimmed when the history is
;; truncated
(setcdr source-info
(delete found (cdr source-info)))
found))
(cdr source-info)))
(cadr source-info)))
(pattern-info (progn
(setcdr selection-info
(cons
(let ((found (assoc helm-pattern (cdr selection-info))))
(if (not found)
;; new entry
(cons helm-pattern 0)
;; move entry to the beginning of the
;; list, so if two patterns used the
;; same number of times then the one
;; used last appears first in the list
(setcdr selection-info
(delete found (cdr selection-info)))
found))
(cdr selection-info)))
(cadr selection-info)))
(timestamp-info (helm-aif (assq 'timestamp (cdr selection-info))
it
(setcdr selection-info (cons (cons 'timestamp 0) (cdr selection-info)))
(cadr selection-info))))
;; Increase usage count.
(setcdr pattern-info (1+ (cdr pattern-info)))
;; Update timestamp.
(setcdr timestamp-info (float-time))
;; Truncate history if needed.
(if (> (length (cdr selection-info)) helm-adaptive-history-length)
(setcdr selection-info
(helm-take (cdr selection-info) helm-adaptive-history-length))))))))
(defun helm-adaptive-maybe-load-history ()
"Load `helm-adaptive-history-file' which contain `helm-adaptive-history'.
Returns nil if `helm-adaptive-history-file' doesn't exist."
(when (and helm-adaptive-history-file
(file-readable-p helm-adaptive-history-file))
(load-file helm-adaptive-history-file)))
(defun helm-adaptive-save-history (&optional arg)
"Save history information to the file given by `helm-adaptive-history-file'."
(interactive "p")
(when helm-adaptive-history-file
(with-temp-buffer
(insert
";; -*- mode: emacs-lisp -*-\n"
";; History entries used for helm adaptive display.\n")
(let (print-length print-level)
(prin1 `(setq helm-adaptive-history ',helm-adaptive-history)
(current-buffer)))
(insert ?\n)
(write-region (point-min) (point-max) helm-adaptive-history-file nil
(unless arg 'quiet)))))
(defun helm-adaptive-sort (candidates source)
"Sort the CANDIDATES for SOURCE by usage frequency.
This is a filtered candidate transformer you can use with the
`filtered-candidate-transformer' attribute."
(let* ((source-name (assoc-default 'name source))
(source-info (assoc source-name helm-adaptive-history)))
(if source-info
(let ((usage
;; Loop in the SOURCE entry of `helm-adaptive-history'
;; and assemble a list containing the (CANDIDATE
;; . USAGE-COUNT) pairs.
(cl-loop with cf = (if helm-adaptive-sort-by-frequent-recent-usage
helm-adaptive-freq-coefficient 1)
with cr = helm-adaptive-recent-coefficient
for (src-cand . infos) in (cdr source-info)
for count-freq = 0
for count-rec =
(helm-aif (and helm-adaptive-sort-by-frequent-recent-usage
(assq 'timestamp infos))
(* cr (+ (float-time) (cdr it)))
0)
do (cl-loop for (pattern . score) in
(remove (assq 'timestamp infos) infos)
;; If current pattern is equal to
;; the previously used one then
;; this candidate has priority
;; (that's why its count-freq is
;; boosted by 10000) and it only
;; has to compete with other
;; candidates which were also
;; selected with the same pattern.
if (equal pattern helm-pattern)
return (setq count-freq (+ 10000 score))
else do (cl-incf count-freq score))
and collect (cons src-cand (+ (* count-freq cf) count-rec))
into results
;; Sort the list in descending order, so
;; candidates with highest priority come
;; first.
finally return
(sort results (lambda (first second)
(> (cdr first) (cdr second)))))))
(if (consp usage)
;; Put those candidates first which have the highest usage count.
(cl-loop for (cand . _freq) in usage
for info = (or (and (assq 'multiline source)
(replace-regexp-in-string
"\n\\'" "" cand))
;; Some transformers like in
;; bookmarks may add a leading
;; space to provide additional
;; infos like an icon as a
;; display prop, strip out this
;; leading space for
;; comparison. Same for a
;; trailing space (helm
;; boookmark add bmk location as
;; a display prop when
;; displaying it).
(helm-aand (replace-regexp-in-string "\\` " "" cand)
(replace-regexp-in-string " \\'" "" it)))
when (cl-member info candidates
:test 'helm-adaptive-compare)
collect (car it) into sorted
and do (setq candidates
(cl-remove info candidates
:test 'helm-adaptive-compare))
finally return (append sorted candidates))
(message "Your `%s' is maybe corrupted or too old, \
you should reinitialize it with `helm-reset-adaptive-history'"
helm-adaptive-history-file)
(sit-for 1)
candidates))
;; if there is no information stored for this source then do nothing
candidates)))
;;;###autoload
(defun helm-reset-adaptive-history ()
"Delete all `helm-adaptive-history' and his file.
Useful when you have a old or corrupted
`helm-adaptive-history-file'."
(interactive)
(when (y-or-n-p "Really delete all your `helm-adaptive-history'? ")
(setq helm-adaptive-history nil)
(when (and helm-adaptive-history-file
(file-exists-p helm-adaptive-history-file))
(delete-file helm-adaptive-history-file))))
(defun helm-adaptive-compare (x y)
"Compare display parts if some of candidates X and Y.
Arguments X and Y are cons cell in (DISPLAY . REAL) format or
atoms."
(equal (if (listp x) (car x) x)
(if (listp y) (car y) y)))
(provide 'helm-adaptive)
;;; helm-adaptive.el ends here
helm-4.0.3/helm-bookmark.el 0000664 0000000 0000000 00000117730 15011067617 0015532 0 ustar 00root root 0000000 0000000 ;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'bookmark)
(require 'helm)
(require 'helm-lib)
(require 'helm-help)
(require 'helm-types)
(require 'helm-utils)
(require 'helm-info)
(require 'helm-adaptive)
(require 'helm-net)
(require 'helm-x-icons)
(declare-function helm-browse-project "helm-files" (arg))
(declare-function addressbook-bookmark-edit "ext:addressbook-bookmark.el" (bookmark))
(declare-function eww-read-bookmarks "eww")
(defvar eww-bookmarks)
(defgroup helm-bookmark nil
"Predefined configurations for `helm.el'."
:group 'helm)
(defcustom helm-bookmark-show-location nil
"Show location of bookmark on display."
:type 'boolean)
(defcustom helm-bookmark-default-filtered-sources
(append '(helm-source-bookmark-org
helm-source-bookmark-files&dirs
helm-source-bookmark-helm-find-files
helm-source-bookmark-info
helm-source-bookmark-gnus
helm-source-bookmark-mu4e
helm-source-bookmark-man
helm-source-bookmark-images
helm-source-bookmark-w3m)
(list 'helm-source-bookmark-uncategorized
'helm-source-bookmark-set))
"List of sources to use in `helm-filtered-bookmarks'."
:type '(repeat (choice symbol)))
(defcustom helm-bookmark-use-icon nil
"Display candidates with an icon with `all-the-icons' when non nil.
Don't use `setq' to set this."
:type 'boolean
:set (lambda (var val)
(if (require helm-x-icons-provider nil t)
(set var val)
(set var nil))))
(defcustom helm-bookmark-default-sort-method 'adaptive
"Sort method for `helm-filtered-bookmarks'.
Value can be either \\='native' or \\='adaptive'.
See `helm-adaptive-sort' for infos on \\='native'.
Once you use \\='native' the bookmark variable `bookmark-sort-flag'
will be honored."
:type '(choice
(symbol :tag "Helm adaptive sort method" adaptive)
(symbol :tag "Native bookmark sort method" native))
;; Don't use the :set function until functions and variables below
;; are not loaded i.e. use set-default only for now.
:initialize 'custom-initialize-changed
:set (lambda (var val)
(set var val)
(cl-loop for s in (remove 'helm-source-bookmark-set
helm-bookmark-default-filtered-sources)
for fn = (intern (format "%s-builder" s))
do (set s (funcall fn)))))
(defcustom helm-bookmark-annotation-sign "*"
"Boomarks with annotation are prefixed with this string."
:type 'string)
(defgroup helm-bookmark-faces nil
"Customize the appearance of helm-bookmark."
:prefix "helm-"
:group 'helm-bookmark
:group 'helm-faces)
(defface helm-bookmark-info
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "green"))
"Face used for W3m Emacs bookmarks (not w3m bookmarks)."
:group 'helm-bookmark-faces)
(defface helm-bookmark-w3m
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "yellow"))
"Face used for W3m Emacs bookmarks (not w3m bookmarks)."
:group 'helm-bookmark-faces)
(defface helm-bookmark-gnus
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "magenta"))
"Face used for Gnus bookmarks."
:group 'helm-bookmark-faces)
(defface helm-bookmark-man
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Orange4"))
"Face used for Woman/man bookmarks."
:group 'helm-bookmark-faces)
(defface helm-bookmark-file
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Deepskyblue2"))
"Face used for file bookmarks."
:group 'helm-bookmark-faces)
(defface helm-bookmark-file-not-found
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Slategray4"))
"Face used for file bookmarks."
:group 'helm-bookmark-faces)
(defface helm-bookmark-directory
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit helm-ff-directory))
"Face used for file bookmarks."
:group 'helm-bookmark-faces)
(defface helm-bookmark-addressbook
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "tomato"))
"Face used for addressbook bookmarks."
:group 'helm-bookmark-faces)
(defvar helm-bookmark-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-c o") #'helm-bookmark-run-jump-other-window)
(define-key map (kbd "C-c C-o") #'helm-bookmark-run-jump-other-frame)
(define-key map (kbd "C-c C-t") #'helm-bookmark-run-jump-other-tab)
(define-key map (kbd "C-d") #'helm-bookmark-run-delete)
(define-key map (kbd "C-]") #'helm-bookmark-toggle-filename)
(define-key map (kbd "M-e") #'helm-bookmark-run-edit)
map)
"Generic Keymap for Emacs bookmark sources.")
(defclass helm-source-basic-bookmarks (helm-source-in-buffer helm-type-bookmark)
((init :initform (lambda ()
(bookmark-maybe-load-default-file)
(helm-init-candidates-in-buffer
'global
(if (and (fboundp 'bookmark-maybe-sort-alist)
(fboundp 'bookmark-name-from-full-record))
(mapcar 'bookmark-name-from-full-record
(bookmark-maybe-sort-alist))
(bookmark-all-names)))))
(filtered-candidate-transformer :initform 'helm-bookmark-transformer)
(find-file-target :initform #'helm-bookmarks-quit-an-find-file-fn)))
(defvar helm-source-bookmarks
(helm-make-source "Bookmarks" 'helm-source-basic-bookmarks)
"See (info \"(emacs)Bookmarks\").")
(defun helm-bookmark-transformer (candidates _source)
(cl-loop for i in candidates
for loc = (bookmark-location i)
for len = (string-width i)
for trunc = (if (> len bookmark-bmenu-file-column)
(helm-substring i bookmark-bmenu-file-column)
i)
for sep = (make-string (- (+ bookmark-bmenu-file-column 2)
(length trunc))
? )
if helm-bookmark-show-location
collect (cons (concat trunc sep (if (listp loc) (car loc) loc)) i)
else collect i))
(defun helm-bookmark-toggle-filename-1 (_candidate)
(let* ((real (helm-get-selection helm-buffer))
(trunc (if (> (string-width real) bookmark-bmenu-file-column)
(helm-substring real bookmark-bmenu-file-column)
real)))
(setq helm-bookmark-show-location (not helm-bookmark-show-location))
(helm-update (if helm-bookmark-show-location
(regexp-quote trunc)
(regexp-quote real)))))
(helm-make-persistent-command-from-action helm-bookmark-toggle-filename
"Toggle bookmark location visibility."
'toggle-filename 'helm-bookmark-toggle-filename-1)
(defun helm-bookmark-jump-1 (candidate &optional fn)
(let (;; FIXME Why is prefarg necessary here?
(current-prefix-arg helm-current-prefix-arg)
non-essential)
(bookmark-jump candidate fn)))
(defun helm-bookmark-jump (candidate)
"Jump to bookmark action."
(helm-bookmark-jump-1 candidate))
(defun helm-bookmark-jump-other-frame (candidate)
"Jump to bookmark in other frame action."
(helm-bookmark-jump-1 candidate #'switch-to-buffer-other-frame))
(defun helm-bookmark-jump-other-window (candidate)
"Jump to bookmark in other window action."
(helm-bookmark-jump-1 candidate #'switch-to-buffer-other-window))
(defun helm-bookmark-jump-other-tab (candidate)
"Jump to bookmark action."
(cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available")
(helm-bookmark-jump-1 candidate #'switch-to-buffer-other-tab))
;;; bookmark-set
;;
(defvar helm-source-bookmark-set
(helm-build-dummy-source "Set Bookmark"
:filtered-candidate-transformer
(lambda (_candidates _source)
(list (or (and (not (string= helm-pattern ""))
helm-pattern)
"Enter a bookmark name to record")))
:action `(("Set bookmark" . ,(lambda (candidate)
(if (string= helm-pattern "")
(message "No bookmark name given for record")
(bookmark-set candidate))))))
"See (info \"(emacs)Bookmarks\").")
;;; Predicates
;;
(defconst helm-bookmark--non-file-filename " - no file -"
"Name to use for `filename' entry, for non-file bookmarks.")
(defun helm-bookmark-gnus-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Gnus bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus)
(eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump)
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus)
(eq (bookmark-get-handler bookmark) 'bmkp-jump-gnus)))
(defun helm-bookmark-mu4e-bookmark-p (bookmark)
"Return non nil if BOOKMARK is a mu4e bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(memq (bookmark-get-handler bookmark)
'(mu4e-bookmark-jump mu4e--jump-to-bookmark)))
(defun helm-bookmark-w3m-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a W3m bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m)
(eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump)
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m)
(eq (bookmark-get-handler bookmark) 'bmkp-jump-w3m)))
(defun helm-bookmark-eww-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an Eww bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(eq (bookmark-get-handler bookmark) 'eww-bookmark-jump))
(defun helm-bookmark-woman-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Woman bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman)
(eq (bookmark-get-handler bookmark) 'woman-bookmark-jump)
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman)
(eq (bookmark-get-handler bookmark) 'bmkp-jump-woman)))
(defun helm-bookmark-man-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Man bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man)
(eq (bookmark-get-handler bookmark) 'Man-bookmark-jump)
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man)
(eq (bookmark-get-handler bookmark) 'bmkp-jump-man)))
(defun helm-bookmark-woman-man-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Man or Woman bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(or (helm-bookmark-man-bookmark-p bookmark)
(helm-bookmark-woman-bookmark-p bookmark)))
(defun helm-bookmark-info-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an Info bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(eq (bookmark-get-handler bookmark) 'Info-bookmark-jump))
(defun helm-bookmark-image-bookmark-p (bookmark)
"Return non-nil if BOOKMARK bookmarks an image file."
(if (stringp bookmark)
(assq 'image-type (assq bookmark bookmark-alist))
(assq 'image-type bookmark)))
(defun helm-bookmark-file-p (bookmark)
"Return non-nil if BOOKMARK bookmarks a file or directory.
BOOKMARK is a bookmark name or a bookmark record.
This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)."
(let* ((filename (bookmark-get-filename bookmark))
(isnonfile (equal filename helm-bookmark--non-file-filename)))
(and filename
(not isnonfile)
(not (helm-bookmark-org-file-p bookmark))
(not (bookmark-get-handler bookmark)))))
(defun helm-bookmark-org-file-p (bookmark)
(let* ((filename (bookmark-get-filename bookmark)))
(or (string-suffix-p ".org" filename t)
(string-suffix-p ".org_archive" filename t))))
(defun helm-bookmark-helm-find-files-p (bookmark)
"Return non-nil if BOOKMARK bookmarks a `helm-find-files' session.
BOOKMARK is a bookmark name or a bookmark record."
(eq (bookmark-get-handler bookmark) 'helm-ff-bookmark-jump))
(defun helm-bookmark-addressbook-p (bookmark)
"Return non--nil if BOOKMARK is a contact recorded with addressbook-bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(if (listp bookmark)
(string= (assoc-default 'type bookmark) "addressbook")
(string= (assoc-default
'type (assoc bookmark bookmark-alist)) "addressbook")))
(defun helm-bookmark-uncategorized-bookmark-p (bookmark)
"Return non--nil if BOOKMARK match no known category."
(cl-loop for pred in '(helm-bookmark-org-file-p
helm-bookmark-addressbook-p
helm-bookmark-gnus-bookmark-p
helm-bookmark-mu4e-bookmark-p
helm-bookmark-w3m-bookmark-p
helm-bookmark-woman-man-bookmark-p
helm-bookmark-info-bookmark-p
helm-bookmark-image-bookmark-p
helm-bookmark-file-p
helm-bookmark-helm-find-files-p
helm-bookmark-addressbook-p
helm-bookmark-eww-bookmark-p)
never (funcall pred bookmark)))
(defun helm-bookmark-filter-setup-alist (fn)
"Return a filtered `bookmark-alist' sorted alphabetically."
(cl-loop for b in (if (and (fboundp 'bookmark-maybe-sort-alist)
(eq helm-bookmark-default-sort-method 'native))
(bookmark-maybe-sort-alist)
bookmark-alist)
for name = (car b)
when (funcall fn b) collect
(propertize name 'location (bookmark-location name))))
;;; Bookmark handlers
;;
(defvar w3m-async-exec)
(defun helm-bookmark-jump-w3m (bookmark)
"Jump to W3m bookmark BOOKMARK, setting a new tab.
If `browse-url-browser-function' is set to something else than
`w3m-browse-url' use it."
(require 'helm-net)
(let* ((file (or (bookmark-prop-get bookmark 'filename)
(bookmark-prop-get bookmark 'url)))
(buf (generate-new-buffer-name "*w3m*"))
(w3m-async-exec nil)
;; If user don't have anymore w3m installed let it browse its
;; bookmarks with default browser otherwise assume bookmark
;; have been bookmarked from w3m and use w3m.
(browse-url-browser-function (or (and (fboundp 'w3m-browse-url)
(executable-find "w3m")
'w3m-browse-url)
browse-url-browser-function))
(really-use-w3m (equal browse-url-browser-function 'w3m-browse-url)))
(helm-browse-url file really-use-w3m)
(when really-use-w3m
(bookmark-default-handler
`("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))))
;; All bookmarks recorded with the handler provided with w3m
;; (`bookmark-w3m-bookmark-jump') will use our handler which open
;; the bookmark in a new tab or in an external browser depending
;; on `browse-url-browser-function'.
(defalias 'bookmark-w3m-bookmark-jump #'helm-bookmark-jump-w3m)
;; Provide compatibility with old handlers provided in external
;; packages bookmark-extensions.el and bookmark+.
(defalias 'bmkext-jump-woman #'woman-bookmark-jump)
(defalias 'bmkext-jump-man #'Man-bookmark-jump)
(defalias 'bmkext-jump-w3m #'helm-bookmark-jump-w3m)
(defalias 'bmkext-jump-gnus #'gnus-summary-bookmark-jump)
(defalias 'bookmarkp-jump-gnus #'gnus-summary-bookmark-jump)
(defalias 'bookmarkp-jump-w3m #'helm-bookmark-jump-w3m)
(defalias 'bookmarkp-jump-woman #'woman-bookmark-jump)
(defalias 'bookmarkp-jump-man #'Man-bookmark-jump)
(defalias 'bmkp-jump-gnus #'gnus-summary-bookmark-jump)
(defalias 'bmkp-jump-w3m #'helm-bookmark-jump-w3m)
(defalias 'bmkp-jump-woman #'woman-bookmark-jump)
(defalias 'bmkp-jump-man #'Man-bookmark-jump)
;;;; Filtered bookmark sources
;;
;;
(defclass helm-source-filtered-bookmarks (helm-source-in-buffer helm-type-bookmark)
((filtered-candidate-transformer
:initform (delq nil
`(,(and (eq helm-bookmark-default-sort-method 'adaptive)
'helm-adaptive-sort)
helm-highlight-bookmark)))
(find-file-target :initform #'helm-bookmarks-quit-an-find-file-fn)))
(defun helm-bookmarks-quit-an-find-file-fn (source)
(let* ((sel (helm-get-selection nil nil source))
(bmk (assoc (replace-regexp-in-string "\\`\\*" "" sel)
bookmark-alist)))
(helm-aif (bookmark-get-filename bmk)
(if (and helm--url-regexp
(string-match helm--url-regexp it))
it (expand-file-name it))
(expand-file-name default-directory))))
(defun helm-bookmark-build-source (name buildfn &optional class &rest args)
(apply #'helm-make-source name
(or class 'helm-source-filtered-bookmarks)
:init (lambda ()
(bookmark-maybe-load-default-file)
(helm-init-candidates-in-buffer
'global (funcall buildfn)))
args))
;;; W3m bookmarks.
;;
(defun helm-bookmark-w3m-setup-alist ()
"Specialized filter function for bookmarks w3m."
(helm-bookmark-filter-setup-alist 'helm-bookmark-w3m-bookmark-p))
(defun helm-source-bookmark-w3m-builder ()
(helm-bookmark-build-source "Bookmark W3m" #'helm-bookmark-w3m-setup-alist))
(defvar helm-source-bookmark-w3m (helm-source-bookmark-w3m-builder))
;;; Images
;;
(defun helm-bookmark-images-setup-alist ()
"Specialized filter function for images bookmarks."
(helm-bookmark-filter-setup-alist 'helm-bookmark-image-bookmark-p))
(defun helm-source-bookmark-images-builder ()
(helm-bookmark-build-source "Bookmark Images" #'helm-bookmark-images-setup-alist))
(defvar helm-source-bookmark-images (helm-source-bookmark-images-builder))
;;; EWW bookmarks
;;
(defun helm-bookmark-normalize-eww-bmks ()
(unless eww-bookmarks (eww-read-bookmarks))
(cl-loop for (_url url _title title _time _time) in eww-bookmarks do
(unless (bookmark-get-bookmark title t)
(push (list title (cons 'location url)
'(imported . t)
'(handler . eww-bookmark-jump))
bookmark-alist)
(cl-incf bookmark-alist-modification-count))))
;;;###autoload
(defun helm-bookmark-import-eww-bookmarks ()
"Import EWW bookmarks into bookmark-alist."
(interactive)
(when (y-or-n-p "Really import eww-bookmarks into bookmark-alist?")
(bookmark-maybe-load-default-file)
(helm-bookmark-normalize-eww-bmks)))
(defun helm-bookmark-eww-setup-alist ()
"Specialized filter function for Eww bookmarks."
(helm-bookmark-filter-setup-alist 'helm-bookmark-eww-bookmark-p))
(defun helm-source-bookmark-eww-builder ()
(helm-bookmark-build-source "Bookmark EWW" #'helm-bookmark-eww-setup-alist))
(defvar helm-source-bookmark-eww (helm-source-bookmark-eww-builder))
;;; Woman Man
;;
(defun helm-bookmark-man-setup-alist ()
"Specialized filter function for Man pages bookmarks."
(helm-bookmark-filter-setup-alist 'helm-bookmark-woman-man-bookmark-p))
(defun helm-source-bookmark-man-builder ()
(helm-bookmark-build-source "Bookmark Woman&Man" #'helm-bookmark-man-setup-alist))
(defvar helm-source-bookmark-man (helm-source-bookmark-man-builder))
;;; Org files
;;
(defun helm-bookmark-org-setup-alist ()
"Specialized filter function for Org file bookmarks."
(helm-bookmark-filter-setup-alist 'helm-bookmark-org-file-p))
(defun helm-source-bookmark-org-builder ()
(helm-bookmark-build-source "Bookmark Org files" #'helm-bookmark-org-setup-alist))
(defvar helm-source-bookmark-org (helm-source-bookmark-org-builder))
;;; Gnus
;;
(defun helm-bookmark-gnus-setup-alist ()
"Specialized filter function for bookmarks gnus."
(helm-bookmark-filter-setup-alist 'helm-bookmark-gnus-bookmark-p))
(defun helm-source-bookmark-gnus-builder ()
(helm-bookmark-build-source "Bookmark Gnus" #'helm-bookmark-gnus-setup-alist))
(defvar helm-source-bookmark-gnus (helm-source-bookmark-gnus-builder))
;;; Mu4e
;;
(defun helm-bookmark-mu4e-setup-alist ()
(helm-bookmark-filter-setup-alist 'helm-bookmark-mu4e-bookmark-p))
(defun helm-source-bookmark-mu4e-builder ()
(helm-bookmark-build-source "Bookmark Mu4e" #'helm-bookmark-mu4e-setup-alist))
(defvar helm-source-bookmark-mu4e (helm-source-bookmark-mu4e-builder))
;;; Info
;;
(defun helm-bookmark-info-setup-alist ()
"Specialized filter function for bookmarks info."
(helm-bookmark-filter-setup-alist 'helm-bookmark-info-bookmark-p))
(defun helm-source-bookmark-info-builder ()
(helm-bookmark-build-source "Bookmark Info" #'helm-bookmark-info-setup-alist))
(defvar helm-source-bookmark-info (helm-source-bookmark-info-builder))
;;; Files and directories
;;
(defun helm-bookmark-local-files-setup-alist ()
"Specialized filter function for bookmarks locals files."
(helm-bookmark-filter-setup-alist 'helm-bookmark-file-p))
(defun helm-source-bookmark-files&dirs-builder ()
(helm-bookmark-build-source
"Bookmark Files&Directories" #'helm-bookmark-local-files-setup-alist))
(defvar helm-source-bookmark-files&dirs
(helm-source-bookmark-files&dirs-builder))
;;; Helm find files sessions.
;;
(defun helm-bookmark-helm-find-files-setup-alist ()
"Specialized filter function for `helm-find-files' bookmarks."
(helm-bookmark-filter-setup-alist 'helm-bookmark-helm-find-files-p))
(defun helm-bookmark-browse-project (candidate)
"Run `helm-browse-project' from action."
(with-helm-default-directory
(bookmark-get-filename candidate)
(helm-browse-project nil)))
(helm-make-command-from-action helm-bookmark-run-browse-project
"Run `helm-bookmark-browse-project' from keyboard."
'helm-bookmark-browse-project)
(defvar helm-bookmark-find-files-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-bookmark-map)
(define-key map (kbd "C-x C-d") #'helm-bookmark-run-browse-project)
map))
(defclass helm-bookmark-find-files-class (helm-source-filtered-bookmarks) ())
(cl-defmethod helm--setup-source ((source helm-bookmark-find-files-class))
;; Ensure `helm-source-in-buffer' method is called.
(cl-call-next-method)
(setf (slot-value source 'action)
(helm-append-at-nth
(cl-loop for (name . action) in helm-type-bookmark-actions
;; We don't want those actions in helm-find-files bookmarks.
unless (memq action '(helm-bookmark-jump-other-frame
helm-bookmark-jump-other-window
helm-bookmark-jump-other-tab
bookmark-set))
collect (cons name action))
'(("Browse project" . helm-bookmark-browse-project)) 1))
(setf (slot-value source 'keymap) helm-bookmark-find-files-map))
(defun helm-source-bookmark-helm-find-files-builder ()
(helm-bookmark-build-source
"Bookmark helm-find-files sessions"
#'helm-bookmark-helm-find-files-setup-alist
'helm-bookmark-find-files-class
:persistent-action (lambda (_candidate) (ignore))
:persistent-help "Do nothing"))
(defvar helm-source-bookmark-helm-find-files
(helm-source-bookmark-helm-find-files-builder))
;;; Uncategorized bookmarks
;;
(defun helm-bookmark-uncategorized-setup-alist ()
"Specialized filter function for uncategorized bookmarks."
(helm-bookmark-filter-setup-alist 'helm-bookmark-uncategorized-bookmark-p))
(defun helm-source-bookmark-uncategorized-builder ()
(helm-bookmark-build-source
"Bookmark uncategorized" #'helm-bookmark-uncategorized-setup-alist))
(defvar helm-source-bookmark-uncategorized
(helm-source-bookmark-uncategorized-builder))
;;; Transformer
;;
(defun helm-highlight-bookmark (bookmarks _source)
"Used as `filtered-candidate-transformer' to colorize bookmarks."
(let ((non-essential t))
(cl-loop for i in bookmarks
for isfile = (bookmark-get-filename i)
for hff = (helm-bookmark-helm-find-files-p i)
for handlerp = (and (fboundp 'bookmark-get-handler)
(bookmark-get-handler i))
for isw3m = (and (fboundp 'helm-bookmark-w3m-bookmark-p)
(helm-bookmark-w3m-bookmark-p i))
for isgnus = (and (fboundp 'helm-bookmark-gnus-bookmark-p)
(helm-bookmark-gnus-bookmark-p i))
for ismu4e = (and (fboundp 'helm-bookmark-mu4e-bookmark-p)
(helm-bookmark-mu4e-bookmark-p i))
for isman = (and (fboundp 'helm-bookmark-man-bookmark-p) ; Man
(helm-bookmark-man-bookmark-p i))
for iswoman = (and (fboundp 'helm-bookmark-woman-bookmark-p) ; Woman
(helm-bookmark-woman-bookmark-p i))
for isannotation = (bookmark-get-annotation i)
for isabook = (string= (bookmark-prop-get i 'type)
"addressbook")
for isinfo = (eq handlerp 'Info-bookmark-jump)
for iseww = (eq handlerp 'eww-bookmark-jump)
for loc = (bookmark-location i)
for len = (string-width i)
for trunc = (if (and helm-bookmark-show-location
(> len bookmark-bmenu-file-column))
(helm-substring
i bookmark-bmenu-file-column)
i)
for icon = (when helm-bookmark-use-icon
(cond ((and isfile hff)
(helm-aif (or (helm-x-icons-match-to-alist
(helm-basename (helm-basedir isfile t))
'dir)
(helm-x-icons-match-to-alist
(helm-basename isfile)
'dir))
(apply (car it) (cdr it))
(helm-x-icons-generic "file-directory")))
((or isw3m iseww)
(helm-x-icons-generic "firefox"))
((and isfile isinfo) (helm-x-icons-generic "info"))
((or iswoman isman)
(helm-x-icons-generic "man-page"))
((or isgnus ismu4e)
(helm-x-icons-generic "mail-read"))
(isfile (helm-x-icons-icon-for-file (helm-basename isfile)))))
;; Add a * if bookmark have annotation
if (and isannotation (not (string-equal isannotation "")))
do (setq trunc (concat helm-bookmark-annotation-sign
(if helm-bookmark-show-location trunc i)))
for sep = (and helm-bookmark-show-location
(make-string (- (+ bookmark-bmenu-file-column 2)
(string-width trunc))
? ))
for bmk = (cond ( ;; info buffers
isinfo
(propertize trunc 'face 'helm-bookmark-info
'help-echo isfile))
( ;; w3m buffers
isw3m
(propertize trunc 'face 'helm-bookmark-w3m
'help-echo isfile))
( ;; eww buffers
iseww
(propertize trunc 'face 'helm-bookmark-w3m
'help-echo isfile))
( ;; gnus buffers
isgnus
(propertize trunc 'face 'helm-bookmark-gnus
'help-echo isfile))
( ;; Man Woman
(or iswoman isman)
(propertize trunc 'face 'helm-bookmark-man
'help-echo isfile))
( ;; Addressbook
isabook
(propertize trunc 'face 'helm-bookmark-addressbook))
(;; Directories (helm-find-files)
hff
(if (and (file-remote-p isfile)
(not (file-remote-p isfile nil t)))
(propertize trunc 'face 'helm-bookmark-file-not-found
'help-echo isfile)
(propertize trunc 'face 'helm-bookmark-directory
'help-echo isfile)))
( ;; Directories (dired)
(and isfile
;; This is needed because `non-essential'
;; is not working on Emacs-24.2 and the behavior
;; of tramp seems to have changed since previous
;; versions (Need to reenter password even if a
;; first connection have been established,
;; probably when host is named differently
;; i.e machine/localhost)
(and (not (file-remote-p isfile))
(file-directory-p isfile)))
(propertize trunc 'face 'helm-bookmark-directory
'help-echo isfile))
( ;; Non existing files.
(and isfile
;; Be safe and call `file-exists-p'
;; only if file is not remote or
;; remote but connected.
(or (and (file-remote-p isfile)
(not (file-remote-p isfile nil t)))
(not (file-exists-p isfile))))
(propertize trunc 'face 'helm-bookmark-file-not-found
'help-echo isfile))
( ;; regular files
t
(propertize trunc 'face 'helm-bookmark-file
'help-echo isfile)))
collect (if helm-bookmark-show-location
(cons (concat (and icon (propertize " " 'display (concat icon " ")))
bmk
(propertize
" " 'display
(concat sep (if (listp loc) (car loc) loc))))
i)
(cons (concat (and icon (propertize " " 'display (concat icon " ")))
bmk)
i)))))
;;; Edit/rename/save bookmarks.
;;
;;
(defun helm-bookmark-edit-bookmark (bookmark-name)
"Edit bookmark's name and file name, and maybe save them.
BOOKMARK-NAME is the current (old) name of the bookmark to be
renamed."
(let ((bmk (helm-bookmark-get-bookmark-from-name bookmark-name))
(handler (bookmark-prop-get bookmark-name 'handler)))
(if (eq handler 'addressbook-bookmark-jump)
(addressbook-bookmark-edit
(assoc bmk bookmark-alist))
(helm-bookmark-edit-bookmark-1 bookmark-name handler))))
(defun helm-bookmark-edit-bookmark-1 (bookmark-name handler)
(let* ((helm--reading-passwd-or-string t)
(bookmark-fname (bookmark-get-filename bookmark-name))
(bookmark-loc (bookmark-prop-get bookmark-name 'location))
(message-id (bookmark-prop-get bookmark-name 'message-id))
(new-name (read-from-minibuffer "Name: " bookmark-name))
(new-loc (and (or bookmark-fname bookmark-loc)
(read-from-minibuffer "FileName or Location: "
(or bookmark-fname
(if (consp bookmark-loc)
(car bookmark-loc)
bookmark-loc)))))
(new-message-id (and (memq handler '(mu4e--jump-to-bookmark
mu4e-bookmark-jump))
(read-string "Message-id: " message-id))))
(when (and (not (equal new-name ""))
(or (not (equal new-loc ""))
(not (equal new-message-id "")))
(y-or-n-p "Save changes? "))
(if bookmark-fname
(progn
(helm-bookmark-rename bookmark-name new-name 'batch)
(bookmark-set-filename new-name new-loc))
(bookmark-prop-set
(bookmark-get-bookmark bookmark-name)
(cond (new-loc 'location)
(new-message-id 'message-id))
(or new-loc new-message-id))
(helm-bookmark-rename bookmark-name new-name 'batch))
(helm-bookmark-maybe-save-bookmark)
(list new-name new-loc))))
(defun helm-bookmark-maybe-save-bookmark ()
"Increment save counter and maybe save `bookmark-alist'."
(setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count))
(when (bookmark-time-to-save-p) (bookmark-save)))
(defun helm-bookmark-rename (old &optional new _batch)
"Change bookmark's name from OLD to NEW.
If NEW is nil, then prompt for its string value.
Unused arg _BATCH is kept for backward compatibility.
While the user enters the new name, repeated `C-w' inserts
consecutive words from the buffer into the new bookmark name."
(bookmark-maybe-historicize-string old)
(bookmark-maybe-load-default-file)
(save-excursion
(skip-chars-forward " ") (setq bookmark-yank-point (point)))
(setq bookmark-current-buffer (current-buffer))
(catch 'skip
(let ((newname
(or new (read-from-minibuffer
;; `format-prompt' is not available in old Emacs.
(format "New name [C-RET to skip] (default %s): " old) nil
(let ((now-map (copy-keymap minibuffer-local-map)))
(define-key now-map "\C-w" #'bookmark-yank-word)
(define-key now-map (kbd "C-")
#'(lambda () (interactive) (throw 'skip 'skip)))
now-map)
nil 'bookmark-history old))))
(bookmark-set-name old newname)
(helm-bookmark-maybe-save-bookmark) newname)))
(defun helm-bookmark-rename-marked (_candidate)
"Rename marked bookmarks."
(let* ((bmks (helm-marked-candidates))
(count 0)
(len (length bmks)))
(cl-loop for bmk in bmks
unless (eq (helm-bookmark-rename bmk) 'skip)
do (cl-incf count))
(message "(%s/%s) bookmark(s) renamed" count len)))
(helm-make-command-from-action helm-bookmark-run-edit
"Run `helm-bookmark-edit-bookmark' from keyboard."
'helm-bookmark-edit-bookmark)
(helm-make-command-from-action helm-bookmark-run-jump-other-frame
"Jump to bookmark other frame from keyboard."
'helm-bookmark-jump-other-frame)
(helm-make-command-from-action helm-bookmark-run-jump-other-window
"Jump to bookmark other window from keyboard."
'helm-bookmark-jump-other-window)
(helm-make-command-from-action helm-bookmark-run-jump-other-tab
"Jump to bookmark other tab from keyboard."
'helm-bookmark-jump-other-tab)
(helm-make-command-from-action helm-bookmark-run-delete
"Delete bookmark from keyboard."
'helm-delete-marked-bookmarks)
(defun helm-bookmark-get-bookmark-from-name (bmk)
"Return bookmark name even if it is a bookmark with annotation.
E.g. prepended with *."
(let ((bookmark (replace-regexp-in-string "\\`\\*" "" bmk)))
(if (assoc bookmark bookmark-alist) bookmark bmk)))
(defun helm-delete-marked-bookmarks (_ignore)
"Delete this bookmark or all marked bookmarks."
(dolist (i (helm-marked-candidates))
(bookmark-delete (helm-bookmark-get-bookmark-from-name i)
'batch)))
(defun helm-bookmark-get-defaults ()
"Get default bookmark names at point for `bookmark-set'."
(let* (bookmark-current-bookmark no-defaults
(record (condition-case _err
(bookmark-make-record)
(error (setq no-defaults t)))))
;; Not sure `bookmark-make-record' set 'defaults prop in older Emacs.
(or (bookmark-prop-get record 'defaults)
(unless no-defaults
(list (buffer-name helm-current-buffer))))))
;;; bookmark annotations
;;
(defun helm-bookmark-show-annotation (bookmark-name-or-record)
"Display the annotation for BOOKMARK-NAME-OR-RECORD in a buffer."
(let ((annotation (bookmark-get-annotation bookmark-name-or-record)))
(when (and annotation (not (string-equal annotation "")))
(let ((buf (get-buffer-create "*Bookmark Annotation*")))
(with-current-buffer buf
(let ((inhibit-read-only t))
(erase-buffer)
(insert annotation)
(goto-char (point-min))
(set-buffer-modified-p nil)
(helm-bookmark-annotation-mode)
(insert (substitute-command-keys
"# Edit this buffer with \\[helm-bookmark-edit-annotation]")
(substitute-command-keys
"\n# Quit this buffer with \\[helm-bookmark-quit-annotation]\n"))
(set (make-local-variable 'bookmark-annotation-name)
bookmark-name-or-record)
(put 'bookmark-annotation-name 'permanent-local t)))
(pop-to-buffer buf)))))
(defun helm-bookmark-edit-annotation ()
"Edit bookmark annotation from the show annotation buffer."
(interactive)
(setq buffer-read-only nil)
(bookmark-edit-annotation-mode)
(save-excursion
(goto-char (point-min))
(delete-region
(point) (save-excursion (forward-line 2) (point)))
(insert (funcall bookmark-edit-annotation-text-func
bookmark-annotation-name))))
(put 'helm-bookmark-edit-annotation 'no-helm-mx t)
(defun helm-bookmark-quit-annotation ()
"Quit bookmark annotation buffer."
(interactive)
(quit-window t))
(put 'helm-bookmark-quit-annotation 'no-helm-mx t)
(defvar helm-bookmark-annotation-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map text-mode-map)
(define-key map (kbd "q") #'helm-bookmark-quit-annotation)
(define-key map (kbd "e") #'helm-bookmark-edit-annotation)
map)
"Map used in show annotation bookmark buffer.")
(define-derived-mode helm-bookmark-annotation-mode
text-mode "helm-annotation-mode"
"Mode to display bookmark annotations.
Special commands:
\\{helm-bookmark-annotation-mode-map}"
:interactive nil
(setq-local buffer-read-only t))
;;;###autoload
(defun helm-bookmarks ()
"Preconfigured `helm' for bookmarks."
(interactive)
(helm :sources '(helm-source-bookmarks
helm-source-bookmark-set)
:buffer "*helm bookmarks*"
:default (buffer-name helm-current-buffer)))
;;;###autoload
(defun helm-filtered-bookmarks ()
"Preconfigured `helm' for bookmarks (filtered by category).
Optional source `helm-source-bookmark-addressbook' is loaded only
if external addressbook-bookmark package is installed."
(interactive)
(helm :sources helm-bookmark-default-filtered-sources
:prompt "Search Bookmark: "
:buffer "*helm filtered bookmarks*"
:default (helm-bookmark-get-defaults)))
(provide 'helm-bookmark)
;;; helm-bookmark.el ends here
helm-4.0.3/helm-buffers.el 0000664 0000000 0000000 00000146265 15011067617 0015366 0 ustar 00root root 0000000 0000000 ;;; helm-buffers.el --- helm support for buffers. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-types)
(require 'helm-utils)
(require 'helm-grep)
(require 'helm-regexp)
(require 'helm-help)
(require 'helm-occur)
(require 'helm-x-icons)
(declare-function helm-comp-read "helm-mode")
(declare-function helm-browse-project "helm-files")
(declare-function helm-ff-switch-to-shell "helm-files")
(defvar dired-buffers)
(defvar org-directory)
(defvar helm-ff-default-directory)
(defvar major-mode-remap-alist)
(defgroup helm-buffers nil
"Buffers related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-boring-buffer-regexp-list
'("\\` " "\\`\\*helm" "\\`\\*Echo Area" "\\`\\*Minibuf")
"The regexp list that match boring buffers.
Buffer candidates matching these regular expression will be
filtered from the list of candidates if the
`helm-skip-boring-buffers' candidate transformer is used."
:type '(repeat (choice regexp)))
(defcustom helm-white-buffer-regexp-list nil
"The regexp list of not boring buffers.
These buffers will be displayed even if they match one of
`helm-boring-buffer-regexp-list'."
:type '(repeat (choice regexp)))
(defcustom helm-buffers-favorite-modes '(lisp-interaction-mode
emacs-lisp-mode
text-mode
org-mode)
"List of preferred mode to open new buffers with."
:type '(repeat (choice function)))
(defcustom helm-buffer-max-length 20
"Max length of buffer names before truncate.
When disabled (nil) use the longest `buffer-name' length found."
:type '(choice (const :tag "Disabled" nil)
(integer :tag "Length before truncate")))
(defcustom helm-buffer-details-flag t
"Always show details in buffer list when non-nil."
:type 'boolean)
(defcustom helm-buffers-fuzzy-matching nil
"Fuzzy matching buffer names when non-nil.
Only buffer names are fuzzy matched when this is enabled,
`major-mode' matching is not affected by this."
:type 'boolean)
(defcustom helm-buffer-skip-remote-checking nil
"Ignore checking for `file-exists-p' on remote files."
:type 'boolean)
(defcustom helm-buffers-truncate-lines t
"Truncate lines in `helm-buffers-list' when non-nil."
:type 'boolean)
(defcustom helm-buffers-left-margin-width helm-left-margin-width
"`left-margin-width' value for `helm-mini' and `helm-buffers-list'."
:type 'integer)
(defcustom helm-mini-default-sources '(helm-source-buffers-list
helm-source-recentf
helm-source-buffer-not-found)
"Default sources list used in `helm-mini'.
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)))
(defcustom helm-buffers-end-truncated-string
;; `truncate-string-ellipsis', the function is not available in 27.1
;; See issue#2673.
(if (char-displayable-p ?…) "…" "...")
"The string to display at end of truncated buffer names."
:type 'string)
(defcustom helm-buffers-column-separator " "
"Separator for columns in buffer listing."
:type 'string)
(defcustom helm-buffer--pretty-names '((dired-mode . "Dired")
(lisp-interaction-mode . "Lisp Inter"))
"An alist specifying pretty names for modes.
Most of the time buffer's `mode-name' is a string so no need to
add it here as there is no need to compute it, but sometimes it
may be a mode-line specification which may be costly to compute,
in this case add here the pretty name as a string to avoid this
costly computation. Also if some pretty names are too long you
can add your own abbreviation here."
:type '(alist :key-type symbol :value-type string))
(defcustom helm-buffers-maybe-switch-to-tab nil
"Switch to buffer in its tab when non nil.
Setting this change `tab-bar-tab-name-function' to `tab-bar-tab-name-all'.
Do not use `setq' to set this variable.
This variable takes effect only when `tab-bar-mode' is available (emacs-27.1+)."
:type 'boolean
:set (lambda (var val)
;; We should be able to retrieve all buffers assigned to a tab whatever
;; the value used for `tab-bar-tab-name-function', unfortunately this
;; is not the case, it seems the alist contains the buffer names only
;; when `tab-bar-tab-name-all' is used and set globally. Then when the
;; mode-line/header-line is rebuilded some code (probably C code in
;; `force-mode-line-update' or elsewhare) changes the alist so just
;; let-binding `tab-bar-tab-name-function' is not enough. This is
;; reproductible when we have more than one window visible and we turn
;; on `tab-bar-mode', the alist is showing only the first buffer of
;; window-list omitting the others, however when starting with only one
;; window, calling `tab-bar-mode' and splitting window afterward the
;; alist is updated. Looks it is a bug or a limitation of
;; `tab-bar-mode'.
(set var val)
(if val
(customize-set-variable
'tab-bar-tab-name-function
#'tab-bar-tab-name-all)
(let* ((sym 'tab-bar-tab-name-function)
(standard-value (eval (car (get sym 'standard-value)) t)))
(unless (equal standard-value (symbol-value sym))
(set sym standard-value))))))
(defcustom helm-buffer-list-reorder-fn #'helm-buffers-reorder-buffer-list
"A function in charge of ordering the initial buffer list.
It takes two arguments VISIBLES buffers and OTHERS buffers.
Arg VISIBLES handles the buffers visibles in this frame.
Arg OTHERS handles all the other buffers.
You can write a function that reorder VISIBLES and OTHERS as you
want.
Default function returns OTHERS buffers on top and VISIBLES
buffer at the end. See `helm-buffers-reorder-buffer-list'."
:type 'function)
(defcustom helm-buffers-sort-fn helm-fuzzy-sort-fn
"The sort function to use in `helm-buffers-list'.
Default to `helm-fuzzy-sort-fn' you can use
`helm-fuzzy-matching-sort-fn-preserve-ties-order' as alternative if
you want to keep the recentest order when narrowing candidates."
:type 'function)
(defcustom helm-buffers-show-icons nil
"Prefix buffer names with an icon when non nil.
Don't use `setq' to set this."
:type 'boolean
:set (lambda (var val)
(if (require helm-x-icons-provider nil t)
(set var val)
(set var nil))))
;;; Faces
;;
;;
(defgroup helm-buffers-faces nil
"Customize the appearance of helm-buffers."
:prefix "helm-"
:group 'helm-buffers
:group 'helm-faces)
(defface helm-buffer-saved-out
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "red" :background "black"))
"Face used for buffer files modified outside of emacs."
:group 'helm-buffers-faces)
(defface helm-buffer-not-saved
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Indianred2"))
"Face used for buffer files not already saved on disk."
:group 'helm-buffers-faces)
(defface helm-buffer-modified
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit font-lock-comment-face))
"Face used for modified buffers."
:group 'helm-buffers-faces)
(defface helm-no-file-buffer-modified
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "orange" :background "black"))
"Face used for modified buffers."
:group 'helm-buffers-faces)
(defface helm-indirect-buffer
`((t :foreground "DimGray" :background "black"))
"Face used for indirect buffers."
:group 'helm-buffers-faces)
(defface helm-buffer-size
`((((background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "RosyBrown")
(((background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "SlateGray"))
"Face used for buffer size."
:group 'helm-buffers-faces)
(defface helm-buffer-process
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Sienna3"))
"Face used for process status in buffer."
:group 'helm-buffers-faces)
(defface helm-buffer-directory
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "DarkRed" :background "LightGray"))
"Face used for directories in `helm-buffers-list'."
:group 'helm-buffers-faces)
(defface helm-buffer-file
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit font-lock-builtin-face))
"Face for buffer file names in `helm-buffers-list'."
:group 'helm-buffers-faces)
(defface helm-buffer-archive
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Gold"))
"Face for archive file names in `helm-buffers-list'."
:group 'helm-buffers-faces)
(defface helm-non-file-buffer
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit italic))
"Face used for non-file buffers in `helm-buffers-list'."
:group 'helm-buffers-faces)
(defvar helm-buffers-tick-counter nil
"Allows recording local changes to a non-file buffer.
Typical usage of this var is for modes that want to see if their
buffers have changed since last visit.
Such programs may want to record tick counter after visiting
their buffers like this:
(setq helm-buffers-tick-counter (buffer-modified-tick))
See bug#1917.
Note that this variable is buffer-local.")
(make-variable-buffer-local 'helm-buffers-tick-counter)
;;; Buffers keymap
;;
(defvar helm-buffer-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
;; No need to have separate command for grep and zgrep
;; as we don't use recursivity for buffers.
;; So use zgrep for both as it is capable to handle non--compressed files.
(define-key map (kbd "M-g s") #'helm-buffer-run-zgrep)
(define-key map (kbd "C-s") #'helm-buffers-run-occur)
(define-key map (kbd "C-x C-d") #'helm-buffers-run-browse-project)
(define-key map (kbd "C-c o") #'helm-buffer-switch-other-window)
(define-key map (kbd "C-c C-o") #'helm-buffer-switch-other-frame)
(define-key map (kbd "M-g M-g") #'helm-buffer-run-goto-line)
(define-key map (kbd "C-c =") #'helm-buffer-run-ediff)
(define-key map (kbd "M-=") #'helm-buffer-run-ediff-merge)
(define-key map (kbd "C-=") #'helm-buffer-diff-persistent)
(define-key map (kbd "M-G") #'helm-buffer-revert-persistent)
(define-key map (kbd "C-c d") #'helm-buffer-run-kill-persistent)
(define-key map (kbd "M-D") #'helm-buffer-run-kill-buffers)
(define-key map (kbd "C-x C-s") #'helm-buffer-save-persistent)
(define-key map (kbd "C-x s") #'helm-buffer-run-save-some-buffers)
(define-key map (kbd "C-M-%") #'helm-buffer-run-query-replace-regexp)
(define-key map (kbd "M-%") #'helm-buffer-run-query-replace)
(define-key map (kbd "M-R") #'helm-buffer-run-rename-buffer)
(define-key map (kbd "M-e") #'helm-buffer-run-switch-to-shell)
(define-key map (kbd "C-]") #'helm-toggle-buffers-details)
(define-key map (kbd "C-c a") #'helm-buffers-toggle-show-hidden-buffers)
(define-key map (kbd "C-M-SPC") #'helm-buffers-mark-similar-buffers)
(when (fboundp 'tab-bar-mode)
(define-key map (kbd "C-c C-t") #'helm-buffers-switch-to-buffer-new-tab))
map)
"Keymap for buffer sources in helm.")
(defvar helm-buffer-max-len-mode nil)
(defvar helm-buffers-in-project-p nil)
(defvar helm-source-buffers-list nil)
(defun helm-buffers-list--init ()
(require 'dired)
;; Bug#51 Create the list before `helm-buffer' creation.
;; We were using a global cache in the past and 'candidates was
;; bound to this cache, this was a problem when using more than one
;; source with a different 'buffer-list fn as the same cache was
;; reused in each source (Bug#1907), now 'candidates attr is set
;; directly so that each list of candidates is local to source.
(helm-set-attr 'candidates (funcall (helm-get-attr 'buffer-list)))
(let ((result (cl-loop with allbufs = (memq 'helm-shadow-boring-buffers
(helm-get-attr
'filtered-candidate-transformer
helm-source-buffers-list))
for b in (if allbufs
(helm-get-attr 'candidates)
(helm-skip-boring-buffers
(helm-get-attr 'candidates)
helm-source-buffers-list))
maximize (length b) into len-buf
maximize (length (helm-buffer--format-mode-name b))
into len-mode
finally return (cons len-buf len-mode))))
(unless (default-value 'helm-buffer-max-length)
(helm-set-local-variable 'helm-buffer-max-length (car result)))
(unless (default-value 'helm-buffer-max-len-mode)
(helm-set-local-variable 'helm-buffer-max-len-mode (cdr result)))))
(defclass helm-source-buffers (helm-source-sync helm-type-buffer)
((buffer-list
:initarg :buffer-list
:initform #'helm-buffer-list
:custom function
:documentation
" A function with no arguments to create buffer list.")
(init :initform 'helm-buffers-list--init)
(multimatch :initform nil)
(match :initform 'helm-buffers-match-function)
(persistent-action :initform 'helm-buffers-list-persistent-action)
(keymap :initform 'helm-buffer-map)
(find-file-target :initform #'helm-buffers-quit-and-find-file-fn)
(migemo :initform 'nomultimatch)
(volatile :initform t)
(nohighlight :initform t)
(resume :initform (lambda () (setq helm-buffers-in-project-p nil)))
(help-message :initform 'helm-buffer-help-message)))
(cl-defun helm-buffers-create-new-buffer-1 (candidate &optional (display-func 'switch-to-buffer))
(let ((mjm (or (and helm-current-prefix-arg
(intern-soft (helm-comp-read
"Major-mode: "
helm-buffers-favorite-modes)))
(cl-loop for (r . m) in auto-mode-alist
when (string-match r candidate)
return m)))
(buffer (get-buffer-create candidate)))
(helm-aif (and (boundp 'major-mode-remap-alist)
(cdr (assq mjm major-mode-remap-alist)))
(setq mjm it))
(if mjm
(with-current-buffer buffer (funcall mjm))
(set-buffer-major-mode buffer))
(funcall display-func buffer)))
(defun helm-buffers-create-new-buffer (candidate)
(helm-buffers-create-new-buffer-1 candidate))
(defun helm-buffers-create-new-buffer-ow (candidate)
(helm-buffers-create-new-buffer-1 candidate 'switch-to-buffer-other-window))
(helm-make-command-from-action helm-buffers-not-found-run-switch-ow
"Run create new buffer other window action from keymap."
'helm-buffers-create-new-buffer-ow)
(defun helm-buffers-create-new-buffer-of (candidate)
(helm-buffers-create-new-buffer-1 candidate 'switch-to-buffer-other-frame))
(helm-make-command-from-action helm-buffers-not-found-run-switch-of
"Run create new buffer other frame action from keymap."
'helm-buffers-create-new-buffer-of)
(defvar helm-buffer-not-found-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-c o") #'helm-buffers-not-found-run-switch-ow)
(define-key map (kbd "C-c C-o") #'helm-buffers-not-found-run-switch-of)
map)
"Keymap for `helm-source-buffer-not-found' source.")
(defvar helm-source-buffer-not-found
(helm-build-dummy-source
"Create buffer"
:action (helm-make-actions
"Create buffer (C-u choose mode)"
#'helm-buffers-create-new-buffer
"Create buffer other window (C-u choose mode)"
#'helm-buffers-create-new-buffer-ow
"Create buffer other frame (C-u choose mode)"
#'helm-buffers-create-new-buffer-of)
:keymap helm-buffer-not-found-map))
(defun helm-buffers-get-visible-buffers ()
"Returns buffers visible on visible frames."
(let (result)
(walk-windows
(lambda (x)
(push (buffer-name (window-buffer x)) result))
nil 'visible)
result))
(defun helm-buffer-list-1 (&optional visibles)
"Return list of all buffers except VISIBLES buffers."
(cl-loop for b in (buffer-list)
for bn = (buffer-name b)
unless (member bn visibles)
collect bn))
(defun helm-buffers-reorder-buffer-list (visibles others)
"Default function to reorder buffer-list.
Arg VISIBLES handles the buffers visibles in this frame.
Arg OTHERS handles all the other buffers.
This function returns OTHERS buffers on top and VISIBLES buffer
at the end."
(nconc others visibles))
(defun helm-buffer-list ()
"Return the current list of buffers.
The list is reordered with `helm-buffer-list-reorder-fn'."
(let* ((visibles (helm-buffers-get-visible-buffers))
(others (helm-buffer-list-1 visibles)))
(funcall helm-buffer-list-reorder-fn visibles others)))
(defun helm-buffer-size (buffer)
"Return size of BUFFER."
(with-current-buffer buffer
(save-restriction
(widen)
(helm-file-human-size
(- (position-bytes (point-max))
(position-bytes (point-min)))))))
(defun helm-buffer--show-details (buf-name prefix help-echo
size mode dir face1 face2
proc details type)
(append
(list
(let* ((buf-fname (buffer-file-name (get-buffer buf-name)))
(ext (if buf-fname (helm-file-name-extension buf-fname) ""))
(bmode (with-current-buffer buf-name major-mode))
(icon-alist (helm-x-icons-resolve-alist 'mode))
(icon (when helm-buffers-show-icons
(helm-aif (and (not (eq type 'indirect))
(assq bmode icon-alist))
(and helm-x-icons-provider
(apply (cadr it) (cddr it)))
(cond ((eq type 'dired)
(helm-x-icons-generic "file-directory"))
((eq type 'indirect)
(helm-x-icons-generic "clone"))
(buf-fname
(helm-x-icons-icon-for-file buf-name))
(t (helm-x-icons-generic "star" :v-adjust 0.0))))))
(buf-name (propertize buf-name 'face face1
'help-echo help-echo
'type type)))
(when (condition-case _err
(string-match (format "\\.\\(%s\\)" ext) buf-name)
(invalid-regexp nil))
(add-face-text-property
(match-beginning 1) (match-end 1)
'helm-ff-file-extension nil buf-name))
(if icon
(concat icon " " prefix buf-name)
(concat prefix buf-name))))
(and details
(list size mode
(propertize
(if proc
(format "(%s %s in `%s')"
(process-name proc)
(process-status proc) dir)
(format "`%s'" dir))
'face face2)))))
(defun helm-buffer--format-mode-name (buf)
"Prevent using `format-mode-line' as much as possible."
(with-current-buffer buf
(helm-acond ((assq major-mode helm-buffer--pretty-names)
(cdr it))
((stringp mode-name) mode-name)
(t (format-mode-line mode-name nil nil (get-buffer buf))))))
(defun helm-buffer--details (buffer &optional details)
(require 'dired)
(let* ((mode (helm-buffer--format-mode-name buffer))
(buf (get-buffer buffer))
(size (propertize (helm-buffer-size buf)
'face 'helm-buffer-size))
(proc (get-buffer-process buf))
(dir (with-current-buffer buffer
(helm-aif default-directory (abbreviate-file-name it))))
(file-name (helm-aif (buffer-file-name buf) (abbreviate-file-name it)))
(name (buffer-name buf))
(name-prefix (when (and dir (file-remote-p dir))
(propertize "@ " 'face 'helm-ff-prefix)))
(archive-p (and (fboundp 'tramp-archive-file-name-p)
(tramp-archive-file-name-p dir))))
(when name-prefix
;; Remote tramp buffer names may be hexified, make them more readable.
(setq dir (helm-url-unhex-string dir)
name (helm-url-unhex-string name)))
;; Handle tramp archive buffers specially.
(if archive-p
(helm-buffer--show-details
name name-prefix file-name size mode dir
'helm-buffer-archive 'helm-buffer-process nil details 'filebuf)
;; No fancy things on remote buffers.
(if (and name-prefix helm-buffer-skip-remote-checking)
(helm-buffer--show-details
name name-prefix file-name size mode dir
'helm-buffer-file 'helm-buffer-process nil details 'filebuf)
(helm-acond
(;; A dired buffer.
(rassoc buf dired-buffers)
(helm-buffer--show-details
name name-prefix dir size mode dir
'helm-buffer-directory 'helm-buffer-process nil details 'dired))
;; A buffer file modified somewhere outside of emacs.=>red
((and file-name
(file-exists-p file-name)
(not (verify-visited-file-modtime buf)))
(helm-buffer--show-details
name name-prefix file-name size mode dir
'helm-buffer-saved-out 'helm-buffer-process nil details 'modout))
;; A new buffer file not already saved on disk (or a deleted file) .=>indianred2
((and file-name (not (file-exists-p file-name)))
(helm-buffer--show-details
name name-prefix file-name size mode dir
'helm-buffer-not-saved 'helm-buffer-process nil details 'notsaved))
;; A buffer file modified and not saved on disk.=>orange
((and file-name (buffer-modified-p buf))
(helm-buffer--show-details
name name-prefix file-name size mode dir
'helm-buffer-modified 'helm-buffer-process nil details 'mod))
;; A buffer file not modified and saved on disk.=>green
(file-name
(helm-buffer--show-details
name name-prefix file-name size mode dir
'helm-buffer-file 'helm-buffer-process nil details 'filebuf))
;; Indirect buffer.=>DimGray
((buffer-base-buffer buf)
(let ((face (if (or (buffer-modified-p it)
(with-current-buffer it
(and helm-buffers-tick-counter
(/= helm-buffers-tick-counter
(buffer-modified-tick)))))
'helm-buffer-modified
'helm-indirect-buffer)))
(helm-buffer--show-details
name name-prefix dir size mode dir
face 'helm-buffer-process nil details 'indirect)))
;; A non-file, modified buffer See bug#1917
((with-current-buffer name
(and helm-buffers-tick-counter
(/= helm-buffers-tick-counter (buffer-modified-tick))))
(helm-buffer--show-details
name (and proc name-prefix) dir size mode dir
'helm-no-file-buffer-modified 'helm-buffer-process proc details 'nofile-mod))
;; Any non--file buffer.=>italic
(t
(helm-buffer--show-details
name (and proc name-prefix) dir size mode dir
'helm-non-file-buffer 'helm-buffer-process proc details 'nofile)))))))
(defun helm-highlight-buffers (buffers _source)
"Transformer function to highlight BUFFERS list.
Should be called after others transformers i.e. (boring
buffers)."
(cl-assert helm-fuzzy-matching-highlight-fn nil "Wrong type argument functionp: nil")
(cl-loop for i in buffers
for (name size mode meta) = (if helm-buffer-details-flag
(helm-buffer--details i 'details)
(helm-buffer--details i))
for truncbuf = (if (> (string-width name) helm-buffer-max-length)
(helm-substring-by-width
name helm-buffer-max-length
helm-buffers-end-truncated-string)
(concat name
(make-string
(- (+ helm-buffer-max-length
(length
helm-buffers-end-truncated-string))
(string-width name))
? )))
for len = (length mode)
when (> len helm-buffer-max-len-mode)
do (setq helm-buffer-max-len-mode len)
for fmode = (concat (make-string
(- (max helm-buffer-max-len-mode len) len) ? )
mode)
;; The max length of a number should be 1023.9X where X is the
;; units, this is 7 characters.
for formatted-size = (and size (format "%7s" size))
collect (let ((helm-pattern (helm-buffers--pattern-sans-filters
(and helm-buffers-fuzzy-matching ""))))
(cons (if helm-buffer-details-flag
(concat
(funcall helm-fuzzy-matching-highlight-fn
truncbuf)
helm-buffers-column-separator
formatted-size
helm-buffers-column-separator
fmode
helm-buffers-column-separator
meta)
(funcall helm-fuzzy-matching-highlight-fn name))
(get-buffer i)))))
(defun helm-buffer--get-preselection (buffer)
(let* ((bufname (buffer-name buffer))
(dispbuf (car (helm-buffer--details buffer)))
(len-dispbuf (string-width dispbuf))
(len-prefix (- len-dispbuf (string-width bufname))))
(when (and bufname
(file-remote-p (with-current-buffer bufname
default-directory)))
(setq bufname (concat "@ " (helm-url-unhex-string bufname))))
(concat "^[[:multibyte:] ]*"
(if (and (null helm-buffer-details-flag)
(numberp helm-buffer-max-length)
(> len-dispbuf helm-buffer-max-length))
(regexp-quote
(helm-substring-by-width
bufname
(- helm-buffer-max-length len-prefix)
helm-buffers-end-truncated-string))
(concat (regexp-quote bufname)
(if helm-buffer-details-flag
"$" "[[:blank:]]+"))))))
(defun helm-toggle-buffers-details ()
(interactive)
(with-helm-alive-p
(let* ((buf (helm-get-selection))
(preselect (helm-buffer--get-preselection buf)))
(setq helm-buffer-details-flag (not helm-buffer-details-flag))
(helm-force-update (lambda ()
(helm-awhile (re-search-forward preselect nil t)
(helm-mark-current-line)
(when (equal buf (helm-get-selection))
(cl-return t))))))))
(put 'helm-toggle-buffers-details 'helm-only t)
(defun helm-buffers--pattern-sans-filters (&optional separator)
(cl-loop for p in (helm-mm-split-pattern helm-pattern)
unless (member (substring p 0 1) '("*" "/" "@" "!"))
collect p into lst
finally return (mapconcat #'identity lst (or separator " "))))
(defun helm-buffers-sort-transformer (candidates source)
(cl-assert helm-buffers-sort-fn nil "Wrong type argument functionp: nil")
(if (string= helm-pattern "")
candidates
(let ((helm-pattern (helm-buffers--pattern-sans-filters)))
(funcall helm-buffers-sort-fn candidates source))))
(defun helm-buffers-mark-similar-buffers-1 (&optional type)
(with-helm-window
(let* ((src (helm-get-current-source))
(sel (helm-get-selection nil 'withprop src))
(type (or type (get-text-property
(min 2 (length sel)) 'type sel))))
(helm-map-candidates-in-source src
(lambda (_cand) (helm-make-visible-mark))
(lambda (cand)
(and (not (helm-this-visible-mark))
(eq (get-text-property 2 'type cand) type))))
(helm-mark-current-line)
(helm-display-mode-line src t)
(when helm-marked-candidates
(message "%s candidates marked" (length helm-marked-candidates))
(set-window-margins (selected-window) 1)))))
(defun helm-buffers-mark-similar-buffers ()
"Mark All buffers that have same property `type' than current.
I.e. same color."
(interactive)
(with-helm-alive-p
(let ((marked (helm-marked-candidates)))
(if (and (>= (length marked) 1)
(with-helm-window helm-visible-mark-overlays))
(helm-unmark-all)
(helm-buffers-mark-similar-buffers-1)))))
(put 'helm-buffers-mark-similar-buffers 'helm-only t)
;;; match functions
;;
(defun helm-buffer--match-mjm (pattern mjm)
(when (string-match "\\`\\*" pattern)
(cl-loop with patterns = (split-string (substring pattern 1) ",")
for pat in patterns
if (string-match "\\`!" pat)
collect (string-match (substring pat 1) mjm) into neg
else collect (string-match pat mjm) into pos
finally return
(let ((neg-test (cl-loop for i in neg thereis (numberp i)))
(pos-test (cl-loop for i in pos thereis (numberp i))))
(or
(and neg (not pos) (not neg-test))
(and pos pos-test)
(and neg neg-test (not neg-test)))))))
(defvar helm-buffer--memo-hash (make-hash-table :test 'equal))
(defun helm-buffer--memo-pattern (pattern)
(or (gethash pattern helm-buffer--memo-hash)
(puthash pattern (helm--mapconcat-pattern pattern)
helm-buffer--memo-hash)))
(defun helm-buffer--match-pattern (pattern candidate &optional nofuzzy)
(let ((bfn (if (and helm-buffers-fuzzy-matching
(not nofuzzy)
(not helm-migemo-mode)
(not (string-match "\\`\\^" pattern)))
#'helm-buffer--memo-pattern
#'identity))
(mfn (if helm-migemo-mode
#'helm-mm-migemo-string-match #'string-match)))
(if (string-match "\\`!" pattern)
(not (funcall mfn (funcall bfn (substring pattern 1))
candidate))
(funcall mfn (funcall bfn pattern) candidate))))
(defun helm-buffers--match-from-mjm (candidate)
(let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
(buf (get-buffer cand))
(regexp (cl-loop with pattern = helm-pattern
for p in (helm-mm-split-pattern pattern)
when (string-match "\\`\\*" p)
return p)))
(if regexp
(when buf
(with-current-buffer buf
(let ((mjm (symbol-name major-mode)))
(helm-buffer--match-mjm regexp mjm))))
t)))
(defun helm-buffers--match-from-pat (candidate)
(let* ((regexp-list (cl-loop with pattern = helm-pattern
for p in (helm-mm-split-pattern pattern)
unless (string-match
"\\`\\(\\*\\|/\\|@\\)" p)
collect p))
(nofuzzy (cdr regexp-list)))
(if regexp-list
(cl-loop for re in regexp-list
always (helm-buffer--match-pattern re candidate nofuzzy))
t)))
(defun helm-buffers--match-from-inside (candidate)
(let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
(buf (get-buffer cand))
(pattern (cl-loop with pat = helm-pattern
for p in (helm-mm-split-pattern pat)
when (string-match "\\`@\\(.*\\)" p)
collect (match-string 1 p) into lst
finally return (mapconcat #'identity lst " ")))
(patterns (helm-mm-3-get-patterns pattern)))
(if (and buf patterns)
(with-current-buffer buf
(save-excursion
(goto-char (point-min))
(cl-loop for (pred . regexp) in patterns
always
(save-excursion
(funcall
pred
(if helm-migemo-mode
(helm-mm-migemo-forward regexp nil t)
(re-search-forward regexp nil t)))))))
t)))
(defun helm-buffers--match-from-directory (candidate)
(let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
(buf (get-buffer cand))
(buf-fname (or (buffer-file-name buf)
(car-safe (rassoc buf dired-buffers))))
(regexps (cl-loop with pattern = helm-pattern
for p in (helm-mm-split-pattern pattern)
when (string-match "\\`/" p)
collect p)))
(if regexps
(cl-loop for re in regexps
thereis
(and buf-fname
(string-match
(substring re 1) (helm-basedir buf-fname))))
t)))
(defun helm-buffers-match-function (candidate)
"Default function to match buffers."
(and (helm-buffers--match-from-pat candidate)
(helm-buffers--match-from-mjm candidate)
(helm-buffers--match-from-inside candidate)
(helm-buffers--match-from-directory candidate)))
(defun helm-buffer-query-replace-1 (&optional regexp-flag buffers)
"Query replace in marked buffers.
If REGEXP-FLAG is given use `query-replace-regexp'."
(let ((prompt (if regexp-flag "Query replace regexp" "Query replace"))
(bufs (or buffers (helm-marked-candidates)))
(helm--reading-passwd-or-string t))
(cl-loop with args = (query-replace-read-args prompt regexp-flag t)
for buf in bufs
do
(save-window-excursion
(switch-to-buffer buf)
(save-excursion
(let ((case-fold-search t))
(goto-char (point-min))
(apply #'perform-replace
(list (nth 0 args) (nth 1 args)
t regexp-flag (nth 2 args) nil
multi-query-replace-map))))))))
(defun helm-buffer-query-replace-regexp (_candidate)
(helm-buffer-query-replace-1 'regexp))
(defun helm-buffer-query-replace (_candidate)
(helm-buffer-query-replace-1))
(defun helm-buffer-toggle-diff (candidate)
"Toggle diff buffer CANDIDATE with it's file."
(helm-aif (get-buffer-window "*Diff*" 'visible)
(progn (kill-buffer "*Diff*")
(set-window-buffer it helm-current-buffer))
(let ((buf (get-buffer candidate)))
(if (buffer-file-name buf)
(diff-buffer-with-file buf)
(user-error "Buffer `%s' is not associated to a file"
(buffer-name buf))))))
(helm-make-persistent-command-from-action helm-buffer-diff-persistent
"Toggle diff buffer without quitting helm."
'diff-action 'helm-buffer-toggle-diff)
(defun helm-revert-buffer (candidate)
(with-current-buffer candidate
(helm-aif (or (buffer-file-name)
(buffer-file-name (buffer-base-buffer)))
(and (file-exists-p it) (revert-buffer t t)))))
(defun helm-revert-marked-buffers (_ignore)
(mapc #'helm-revert-buffer (helm-marked-candidates)))
(defun helm-buffer-revert-and-update (_candidate)
(with-helm-buffer
(let ((marked (helm-marked-candidates))
(preselect (helm-buffers--quote-truncated-buffer
(helm-get-selection))))
(cl-loop for buf in marked do (helm-revert-buffer buf))
(when helm-marked-candidates (helm-unmark-all))
(helm-force-update preselect))))
(helm-make-persistent-command-from-action helm-buffer-revert-persistent
"Revert buffer without quitting helm."
'revert-action 'helm-buffer-revert-and-update)
(defun helm-buffer-save-and-update (_candidate)
(with-helm-buffer
(let ((marked (helm-marked-candidates))
(preselect (helm-get-selection nil t))
(enable-recursive-minibuffers t))
(cl-assert marked nil "No buffers need to be saved")
(cl-loop for buf in marked do
(with-current-buffer (get-buffer buf)
(when (or (buffer-file-name)
(buffer-file-name (buffer-base-buffer)))
(save-buffer))))
(when helm-marked-candidates (helm-unmark-all))
(helm-force-update (regexp-quote preselect)))))
(defun helm-buffer-save-some-buffers (_candidate)
(helm-buffers-mark-similar-buffers-1 'mod)
(helm-buffer-save-and-update nil))
(helm-make-persistent-command-from-action helm-buffer-run-save-some-buffers
"Save unsaved file buffers without quitting Helm."
'save-some-action 'helm-buffer-save-some-buffers)
(helm-make-persistent-command-from-action helm-buffer-save-persistent
"Save buffer without quitting Helm."
'save-action 'helm-buffer-save-and-update)
(defun helm-buffers-rename-buffer (candidate)
(with-current-buffer candidate
(rename-buffer (helm-read-string "New name: " (buffer-name)) t)))
(helm-make-command-from-action helm-buffer-run-rename-buffer
"Run rename buffer action from `helm-source-buffers-list'."
'helm-buffers-rename-buffer)
(defun helm-switch-to-buffer-at-linum (candidate)
(let ((linum (read-number
"Line number: "
(with-current-buffer candidate
(line-number-at-pos)))))
(switch-to-buffer candidate)
(goto-char (point-min))
(forward-line (1- linum))))
(helm-make-command-from-action helm-buffer-run-goto-line
"Switch to buffer at line number."
'helm-switch-to-buffer-at-linum)
(helm-make-persistent-command-from-action helm-buffer-run-kill-persistent
"Kill buffer without quitting Helm."
'kill-action 'helm-buffers-persistent-kill)
(defun helm-kill-marked-buffers (_ignore)
(let* ((bufs (helm-marked-candidates))
(killed-bufs (cl-count-if 'kill-buffer bufs)))
(when (buffer-live-p helm-buffer)
(with-helm-buffer
(setq helm-marked-candidates nil
helm-visible-mark-overlays nil)))
(message "Killed %s buffer(s)" killed-bufs)))
(helm-make-command-from-action helm-buffer-run-kill-buffers
"Run kill buffer action from `helm-source-buffers-list'."
'helm-kill-marked-buffers)
(defun helm-buffer-switch-to-shell (candidate)
(require 'helm-files)
(let ((helm-ff-default-directory
(with-current-buffer candidate
default-directory)))
(helm-ff-switch-to-shell nil)))
(helm-make-command-from-action helm-buffer-run-switch-to-shell
"Run switch to shell action from helm-buffers-list."
'helm-buffer-switch-to-shell)
(helm-make-command-from-action helm-buffer-run-grep
"Run Grep action from `helm-source-buffers-list'."
'helm-grep-buffers)
(helm-make-command-from-action helm-buffer-run-zgrep
"Run Zgrep action from `helm-source-buffers-list'."
'helm-zgrep-buffers)
(helm-make-command-from-action helm-buffer-run-query-replace-regexp
"Run Query replace regexp action from `helm-source-buffers-list'."
'helm-buffer-query-replace-regexp)
(helm-make-command-from-action helm-buffer-run-query-replace
"Run Query replace action from `helm-source-buffers-list'."
'helm-buffer-query-replace)
(helm-make-command-from-action helm-buffer-switch-other-window
"Run switch to other window action from `helm-source-buffers-list'."
'helm-buffer-switch-buffers-other-window)
(defun helm-buffer-switch-to-buffer-other-frame (_candidate)
"Display marked buffers in other frame."
(let ((bufs (helm-marked-candidates)))
(select-frame (make-frame))
(helm-window-show-buffers bufs)))
(defun helm-buffers-maybe-raise-buffer-frame (candidate)
"Raise buffer frame handling buffer CANDIDATE and switch to it."
(let ((oframe (window-frame (get-buffer-window candidate 0))))
(unless (eql oframe (selected-frame))
(raise-frame oframe))
(with-selected-frame oframe
(switch-to-buffer candidate))))
(helm-make-command-from-action helm-buffer-switch-other-frame
"Run switch to other frame action from `helm-source-buffers-list'."
'helm-buffer-switch-to-buffer-other-frame)
(defun helm-buffers-switch-buffers-in-tab (_candidate)
"Display marked buffers in a new tab.
See `helm-buffers-switch-buffers-in-tab-1' for more infos."
(helm-buffers-switch-buffers-in-tab-1 (helm-marked-candidates)))
(helm-make-command-from-action helm-buffers-switch-to-buffer-new-tab
"Run switch to buffer in other tab action from `helm-source-buffers-list'."
'helm-buffers-switch-buffers-in-tab
(cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available"))
(defun helm-buffer-switch-buffers (_candidate)
"Switch to buffer candidates and replace current buffer.
If more than one buffer marked switch to these buffers in
separate windows. If a prefix arg is given split windows
vertically."
(let ((buffers (helm-marked-candidates)))
(helm-window-show-buffers buffers)))
(defun helm-buffer-switch-buffers-other-window (_candidate)
"Switch to marked buffers in other windows."
(let ((buffers (helm-marked-candidates)))
(helm-window-show-buffers buffers t)))
(helm-make-command-from-action helm-buffer-run-ediff
"Run ediff action from `helm-source-buffers-list'."
'helm-ediff-marked-buffers)
(helm-make-command-from-action helm-buffer-run-ediff-merge
"Run ediff action from `helm-source-buffers-list'."
'helm-ediff-marked-buffers-merge)
(defun helm-buffers-persistent-kill-1 (buffer-or-name)
"Persistent action to kill buffer."
(let ((buf (get-buffer buffer-or-name)) helm-buf-or-cur)
(if (or (and (eql buf (get-buffer helm-current-buffer))
(setq helm-buf-or-cur "helm-current-buffer"))
(and (eql buf (get-buffer helm-buffer))
(setq helm-buf-or-cur "helm-buffer")))
(progn
(message "Can't kill `%s' without quitting session" helm-buf-or-cur)
(sit-for 1))
(kill-buffer buf)
(helm-delete-current-selection))))
(defun helm-buffers--quote-truncated-buffer (buffer)
"Quote the truncated buffer-name of BUFFER.
buffer-name is truncated according to `helm-buffer-max-length' minus the length
of icon if one."
(let ((bufname (and (bufferp buffer)
(buffer-name buffer)))
(maxlen (if helm-buffers-show-icons
(- helm-buffer-max-length 2)
helm-buffer-max-length)))
(when (and bufname
(file-remote-p (with-current-buffer bufname
default-directory)))
(setq bufname (concat "@ " (helm-url-unhex-string bufname))))
(when bufname
(regexp-quote
(if (and helm-buffer-max-length
helm-buffer-details-flag)
(helm-substring-by-width bufname maxlen "")
bufname)))))
(defun helm-buffers-persistent-kill (_buffer)
(let* ((marked (helm-marked-candidates))
(msg "Buffer `%s' modified, please save it before kill")
;; After marking, selection should be after the last marked unless user
;; has not moved, if deleting current, use current selection after
;; having deleted.
(sel (and (cdr marked) (helm-get-selection))))
(with-helm-buffer
(unwind-protect
(dolist (b marked)
(if (and (buffer-file-name b) (buffer-modified-p b))
(progn (message msg (buffer-name b)) (sit-for 1))
;; We need to preselect each marked because
;; helm-buffers-persistent-kill-1 is deleting
;; current selection.
(helm-preselect
(format "^[[:multibyte:] ]*%s"
(helm-buffers--quote-truncated-buffer b)))
(helm-buffers-persistent-kill-1 b)
(helm--remove-marked-and-update-mode-line b)))
(setq helm-marked-candidates nil
helm-visible-mark-overlays nil))
(helm-force-update (format "^[[:multibyte:] ]*%s"
(helm-buffers--quote-truncated-buffer
;; Ensure user has not moved selection on one
;; of marked.
(or (and (buffer-live-p sel) sel)
(helm-get-selection))))))))
(defun helm-buffers-list-persistent-action (candidate)
(let ((current (window-buffer helm-persistent-action-display-window)))
(if (or (helm-follow-mode-p)
(eql current (get-buffer helm-current-buffer))
(not (eql current (get-buffer candidate))))
(display-buffer candidate)
(if (and helm-persistent-action-display-window
(window-dedicated-p
(next-window helm-persistent-action-display-window 1)))
(delete-window helm-persistent-action-display-window)
(switch-to-buffer helm-current-buffer)))))
(defun helm-ediff-marked-buffers (_candidate &optional merge)
"Ediff 2 marked buffers or CANDIDATE and `helm-current-buffer'.
With optional arg MERGE call `ediff-merge-buffers'."
(let* ((mkd (helm-marked-candidates))
(lg-lst (length mkd))
buf1 buf2)
(cl-case lg-lst
(0
(error "Error:You have to mark at least 1 buffer"))
(1
(setq buf1 helm-current-buffer
buf2 (cl-first mkd)))
(2
(setq buf1 (cl-first mkd)
buf2 (cl-second mkd)))
(t
(error "Error:Too many buffers marked!")))
(if merge
(ediff-merge-buffers buf1 buf2)
(ediff-buffers buf1 buf2))))
(defun helm-ediff-marked-buffers-merge (candidate)
"Ediff merge `helm-current-buffer' with CANDIDATE.
See `helm-ediff-marked-buffers'."
(helm-ediff-marked-buffers candidate t))
(defun helm-multi-occur-as-action (_candidate)
"Multi occur action for `helm-source-buffers-list'.
Can be used by any source that list buffers."
(let ((helm-occur-always-search-in-current
(if helm-current-prefix-arg
(not helm-occur-always-search-in-current)
helm-occur-always-search-in-current))
(buffers (helm-marked-candidates))
(input (cl-loop for i in (split-string (or (buffer-local-value
'helm-input-local
(get-buffer helm-buffer))
helm-pattern)
" " t)
thereis (and (string-match "\\`@\\([^!]*\\)" i)
(match-string 1 i)))))
(helm-multi-occur-1 buffers input)))
(helm-make-command-from-action helm-buffers-run-occur
"Run `helm-multi-occur-as-action' by key."
'helm-multi-occur-as-action)
(defun helm-buffers-toggle-show-hidden-buffers ()
(interactive)
(with-helm-alive-p
(let ((filter-attrs (helm-get-attr 'filtered-candidate-transformer
helm-source-buffers-list))
(sel (helm-get-selection)))
(if (memq 'helm-shadow-boring-buffers filter-attrs)
(helm-set-attr 'filtered-candidate-transformer
(cons 'helm-skip-boring-buffers
(remove 'helm-shadow-boring-buffers
filter-attrs))
helm-source-buffers-list)
(helm-set-attr 'filtered-candidate-transformer
(cons 'helm-shadow-boring-buffers
(remove 'helm-skip-boring-buffers
filter-attrs))
helm-source-buffers-list))
(helm-force-update (helm-buffers--quote-truncated-buffer sel)))))
(put 'helm-buffers-toggle-show-hidden-buffers 'helm-only t)
(defun helm-buffers-browse-project (buf)
"Browse project from buffer BUF."
(with-current-buffer buf
(helm-browse-project helm-current-prefix-arg)))
(helm-make-command-from-action helm-buffers-run-browse-project
"Run `helm-buffers-browse-project' from key."
'helm-buffers-browse-project
(cl-assert (not helm-buffers-in-project-p)
nil "You are already browsing this project"))
;;;###autoload
(defun helm-buffers-quit-and-find-file-fn (source)
(let* ((sel (get-buffer (helm-get-selection nil nil source)))
(bname (and (bufferp sel) (buffer-name sel))))
(when bname
(or (buffer-file-name sel)
(car (rassoc bname dired-buffers))
(and (with-current-buffer bname
(eq major-mode 'org-agenda-mode))
org-directory
(expand-file-name org-directory))
(with-current-buffer bname
(expand-file-name default-directory))))))
;;; Candidate Transformers
;;
;;
(defun helm-skip-boring-buffers (buffers _source)
"Remove buffers matching `helm-boring-buffer-regexp-list' in BUFFERS.
Where BUFFERS is a list of buffer names."
(helm-skip-entries buffers
helm-boring-buffer-regexp-list
helm-white-buffer-regexp-list))
(defun helm-shadow-boring-buffers (buffers _source)
"Buffers matching `helm-boring-buffer-regexp' will be
displayed with the `file-name-shadow' face if available."
(helm-shadow-entries buffers helm-boring-buffer-regexp-list))
;;;###autoload
(defun helm-buffers-list ()
"Preconfigured `helm' to list buffers."
(interactive)
(unless helm-source-buffers-list
(setq helm-source-buffers-list
(helm-make-source "Buffers" 'helm-source-buffers)))
(helm :sources '(helm-source-buffers-list
helm-source-buffer-not-found)
:buffer "*helm buffers*"
:truncate-lines helm-buffers-truncate-lines
:left-margin-width helm-buffers-left-margin-width))
;;;###autoload
(defun helm-mini ()
"Preconfigured `helm' displaying `helm-mini-default-sources'."
(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-mini-default-sources
:buffer "*helm mini*"
:ff-transformer-show-only-basename nil
:truncate-lines helm-buffers-truncate-lines
:left-margin-width helm-buffers-left-margin-width))
(defun helm-quit-and-helm-mini ()
"Drop into `helm-mini' from `helm'."
(interactive)
(with-helm-alive-p
(helm-run-after-exit 'helm-mini)))
(provide 'helm-buffers)
;;; helm-buffers.el ends here
helm-4.0.3/helm-color.el 0000664 0000000 0000000 00000011672 15011067617 0015041 0 ustar 00root root 0000000 0000000 ;;; helm-color.el --- colors and faces -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
(require 'helm-elisp)
(declare-function list-colors-display "facemenu")
;;; Customize Face
;;
;;
(defun helm-custom-faces-init ()
"Initialize buffer for `helm-source-customize-face'."
(unless (helm-candidate-buffer)
(save-selected-window
(list-faces-display)
(message nil))
(helm-init-candidates-in-buffer
'global
(with-current-buffer (get-buffer "*Faces*")
(buffer-substring
(next-single-char-property-change (point-min) 'category)
(point-max))))
(kill-buffer "*Faces*")))
(defvar helm-source-customize-face
(helm-build-in-buffer-source "Customize Face"
:init 'helm-custom-faces-init
:get-line 'buffer-substring
:persistent-action (lambda (candidate)
(helm-elisp--persistent-help
(intern (car (split-string candidate)))
'helm-describe-face))
:persistent-help "Describe face"
:action `(("Customize"
. ,(lambda (line)
(customize-face (intern (car (split-string line))))))
("Copy name"
. ,(lambda (line)
(kill-new (car (split-string line " " t)))))))
"See (info \"(emacs)Faces\")")
;;; Colors browser
;;
;;
(defun helm-colors-init ()
(require 'facemenu)
(unless (helm-candidate-buffer)
(save-selected-window
(list-colors-display)
(message nil))
(helm-init-candidates-in-buffer
'global
(with-current-buffer (get-buffer "*Colors*")
(buffer-string)))
(kill-buffer "*Colors*")))
(defun helm-color-insert-name (candidate)
(with-helm-current-buffer
(insert (helm-colors-get-name candidate))))
(defun helm-color-kill-name (candidate)
(kill-new (helm-colors-get-name candidate)))
(defun helm-color-insert-rgb (candidate)
(with-helm-current-buffer
(insert (helm-colors-get-rgb candidate))))
(defun helm-color-kill-rgb (candidate)
(kill-new (helm-colors-get-rgb candidate)))
(helm-make-command-from-action helm-color-run-insert-name
"Insert name of color from `helm-source-colors'."
'helm-color-insert-name)
(helm-make-command-from-action helm-color-run-kill-name
"Kill name of color from `helm-source-colors'."
'helm-color-kill-name)
(helm-make-command-from-action helm-color-run-insert-rgb
"Insert RGB of color from `helm-source-colors'."
'helm-color-insert-rgb)
(helm-make-command-from-action helm-color-run-kill-rgb
"Kill RGB of color from `helm-source-colors'."
'helm-color-kill-rgb)
(defvar helm-color-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-c n") #'helm-color-run-insert-name)
(define-key map (kbd "C-c N") #'helm-color-run-kill-name)
(define-key map (kbd "C-c r") #'helm-color-run-insert-rgb)
(define-key map (kbd "C-c R") #'helm-color-run-kill-rgb)
map))
(defvar helm-source-colors
(helm-build-in-buffer-source "Colors"
:init 'helm-colors-init
:get-line 'buffer-substring
:keymap helm-color-map
:persistent-help "Kill entry in RGB format."
:persistent-action 'helm-color-kill-rgb
:help-message 'helm-colors-help-message
:action
'(("Copy Name (C-c N)" . helm-color-kill-name)
("Copy RGB (C-c R)" . helm-color-kill-rgb)
("Insert Name (C-c n)" . helm-color-insert-name)
("Insert RGB (C-c r)" . helm-color-insert-rgb))))
(defun helm-colors-get-name (candidate)
"Get color name."
(replace-regexp-in-string
" " ""
(with-temp-buffer
(insert (capitalize candidate))
(goto-char (point-min))
(search-forward-regexp "\\s-\\{2,\\}")
(delete-region (point) (point-max))
(buffer-string))))
(defun helm-colors-get-rgb (candidate)
"Get color RGB."
(replace-regexp-in-string
" " ""
(with-temp-buffer
(insert (capitalize candidate))
(goto-char (point-max))
(search-backward-regexp "\\s-\\{2,\\}")
(delete-region (point) (point-min))
(buffer-string))))
;;;###autoload
(defun helm-colors ()
"Preconfigured `helm' for color."
(interactive)
(helm :sources '(helm-source-colors helm-source-customize-face)
:buffer "*helm colors*"))
(provide 'helm-color)
;;; helm-color.el ends here
helm-4.0.3/helm-command.el 0000664 0000000 0000000 00000046077 15011067617 0015350 0 ustar 00root root 0000000 0000000 ;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
(require 'helm-mode)
(require 'helm-elisp)
(defvar helm-M-x-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-comp-read-map)
(define-key map (kbd "C-u") nil)
(define-key map (kbd "C-u") #'helm-M-x-universal-argument)
(define-key map (kbd "C-]") #'helm-M-x-toggle-short-doc)
map))
(defgroup helm-command nil
"Emacs command related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-M-x-always-save-history nil
"`helm-M-x' save command in `extended-command-history' even when it fails."
:type 'boolean)
(defcustom helm-M-x-reverse-history nil
"The history source of `helm-M-x' appear in second position when non-nil."
:type 'boolean)
(defcustom helm-M-x-fuzzy-match t
"Helm-M-x fuzzy matching when non nil."
:type 'boolean)
(defcustom helm-M-x-show-short-doc nil
"Show short docstring of command when non nil.
This value can be toggled with
\\\\[helm-M-x-toggle-short-doc] while in helm-M-x session."
:type 'boolean)
(defcustom helm-M-x-history-transformer-sort t
"When nil, do not sort helm-M-x's commands history."
:type 'boolean)
(defcustom helm-M-x-exclude-unusable-commands-in-mode t
"When non nil exclude commands not usable in current buffer.
This will exclude only commands defined with `interactive' MODES argument, for
other commands, they will be displayed even if unusable as long as they satisfies
`commandp'.
NOTE: As `interactive' MODES argument is relatively recent, not all commands are
using it when they should, so do not expect ALL unuseful commands to be excluded
in `helm-M-x'. Also in Emacsen with a version of `interactive' not handling
MODES, this will have no effect. Regardless of this Helm commands unrelated to
Helm will never appear in `helm-M-x' whatever the value of this var is."
:type 'boolean)
;;; Faces
;;
;;
(defgroup helm-command-faces nil
"Customize the appearance of helm-command."
:prefix "helm-"
:group 'helm-command
:group 'helm-faces)
(defface helm-M-x-key
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "orange" :box (:line-width -1)))
"Face used in helm-M-x to show keybinding."
:group 'helm-command-faces)
(defface helm-command-active-mode
'((t :inherit font-lock-builtin-face))
"Face used by `helm-M-x' for activated modes."
:group 'helm-command-faces)
(defface helm-M-x-short-doc
'((t :box (:line-width -1) :foreground "DimGray"))
"Face used by `helm-M-x' for short docstring."
:group 'helm-command-faces)
(defvar helm-M-x-input-history nil)
(defvar helm-M-x-prefix-argument nil
"Prefix argument before calling `helm-M-x'.")
(defvar helm-M-x--timer nil)
(defvar helm-M-x--unwind-forms-done nil)
(defun helm-M-x-get-major-mode-command-alist (mode-map)
"Return alist of MODE-MAP."
(when mode-map
(cl-loop for key being the key-seqs of mode-map using (key-bindings com)
for str-key = (key-description key)
for ismenu = (string-match "" str-key)
unless ismenu collect (cons str-key com))))
(defun helm-get-mode-map-from-mode (mode)
"Guess the mode-map name according to MODE.
Some modes don't use conventional mode-map name so we need to
guess mode-map name. E.g. `python-mode' ==> py-mode-map.
Return nil if no mode-map found."
(cl-loop ;; Start with a conventional mode-map name.
with mode-map = (intern-soft (format "%s-map" mode))
with mode-string = (symbol-name mode)
with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
while (not mode-map)
for count downfrom (length mode-name)
;; Return when no result after parsing entire string.
when (eq count 0) return nil
for sub-name = (substring mode-name 0 count)
do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
finally return mode-map))
(defun helm-M-x-current-mode-map-alist ()
"Return mode-map alist of current `major-mode'."
(let ((map-sym (helm-get-mode-map-from-mode major-mode)))
(when (and map-sym (boundp map-sym))
(helm-M-x-get-major-mode-command-alist (symbol-value map-sym)))))
(defun helm-M-x-toggle-short-doc ()
"Toggle short doc display in helm-M-x."
(interactive)
(setq helm-M-x-show-short-doc (not helm-M-x-show-short-doc))
(helm-force-update (concat "^" (helm-get-selection)) (helm-get-current-source)))
(put 'helm-M-x-toggle-short-doc 'no-helm-mx t)
(defun helm-M-x-transformer-1 (candidates &optional sort ignore-props)
"Transformer function to show bindings in emacs commands.
Show global bindings and local bindings according to current
`major-mode'.
If SORT is non nil sort list with `helm-generic-sort-fn'.
Note that SORT should not be used when fuzzy matching because
fuzzy matching is running its own sort function with a different
algorithm."
(with-helm-current-buffer
(cl-loop with local-map = (helm-M-x-current-mode-map-alist)
for cand in candidates
for local-key = (car (rassq cand local-map))
for key = (substitute-command-keys (format "\\[%s]" cand))
for sym = (intern (if (consp cand) (car cand) cand))
for doc = (when helm-M-x-show-short-doc
(helm-get-first-line-documentation (intern-soft cand)))
for disp = (if (or (eq sym major-mode)
(and (memq sym minor-mode-list)
(boundp sym)
(buffer-local-value
sym helm-current-buffer)))
(propertize cand 'face 'helm-command-active-mode)
cand)
unless (and (null ignore-props)
(or (get sym 'helm-only) (get sym 'no-helm-mx)
(eq sym 'helm-M-x)))
collect
(cons (cond ((and (string-match "^M-x" key) local-key)
(propertize
(format "%s%s%s %s"
disp
(if doc (helm-make-separator cand) "")
(if doc
(propertize
doc 'face 'helm-M-x-short-doc)
"")
(propertize
" " 'display
(propertize local-key 'face 'helm-M-x-key)))
'match-part disp))
((and (string-match "^M-x" key)
(not (string= key "M-x")))
(propertize
(format "%s%s%s"
disp
(if doc (helm-make-separator cand) "")
(if doc
(propertize
doc 'face 'helm-M-x-short-doc)
""))
'match-part disp))
(t (propertize
(format "%s%s%s %s"
disp
(if doc (helm-make-separator cand) "")
(if doc
(propertize
doc 'face 'helm-M-x-short-doc)
"")
(propertize
" " 'display
(propertize key 'face 'helm-M-x-key)))
'match-part disp)))
cand)
into ls
finally return
(if sort (sort ls #'helm-generic-sort-fn) ls))))
(defun helm-M-x-transformer (candidates _source)
"Transformer function for `helm-M-x' candidates."
;; Generic sort function is handling helm-flex.
(helm-M-x-transformer-1 candidates (null helm--in-fuzzy)))
(defun helm-M-x-transformer-no-sort (candidates _source)
"Transformer function for `helm-M-x' candidates."
(helm-M-x-transformer-1 candidates))
(defun helm-M-x-transformer-no-sort-no-props (candidates _source)
"Transformer function for `helm-M-x' candidates."
(helm-M-x-transformer-1 candidates nil t))
(defun helm-M-x--notify-prefix-arg ()
;; Notify a prefix-arg set AFTER calling M-x.
(when prefix-arg
(with-helm-window
(helm-display-mode-line (helm-get-current-source) 'force))))
(defun helm-cmd--get-current-function-name ()
(save-excursion
(beginning-of-defun)
(cadr (split-string (buffer-substring-no-properties
(pos-bol) (pos-eol))))))
(defun helm-cmd--get-preconfigured-commands (&optional dir)
(let* ((helm-dir (or dir (helm-basedir (locate-library "helm"))))
(helm-autoload-file (expand-file-name "helm-autoloads.el" helm-dir))
results)
(when (file-exists-p helm-autoload-file)
(with-temp-buffer
(insert-file-contents helm-autoload-file)
(while (re-search-forward "Preconfigured" nil t)
(push (substring (helm-cmd--get-current-function-name) 1) results))))
results))
(defun helm-M-x-universal-argument ()
"Same as `universal-argument' but for `helm-M-x'."
(interactive)
(if helm-M-x-prefix-argument
(progn (setq helm-M-x-prefix-argument nil)
(let ((inhibit-read-only t))
(with-selected-window (minibuffer-window)
(save-excursion
(goto-char (point-min))
(delete-char (- (minibuffer-prompt-width) (length "M-x "))))))
(message "Initial prefix arg disabled"))
(setq prefix-arg (list 4))
(universal-argument--mode)))
(put 'helm-M-x-universal-argument 'helm-only t)
(defun helm-M-x-persistent-action (candidate)
(helm-elisp--persistent-help
candidate 'helm-describe-function))
(defun helm-M-x--move-selection-after-hook ()
(setq current-prefix-arg nil))
(defun helm-M-x--before-action-hook ()
(remove-hook 'helm-move-selection-after-hook
#'helm-M-x--move-selection-after-hook))
(defclass helm-M-x-class (helm-source-in-buffer helm-type-command)
((requires-pattern :initform 0)
(must-match :initform t)
(filtered-candidate-transformer :initform #'helm-M-x-transformer)
(persistent-help :initform "Describe this command")
(help-message :initform 'helm-M-x-help-message)
(nomark :initform t)
(cleanup :initform #'helm-M-x--unwind-forms)
(keymap :initform 'helm-M-x-map)
(resume :initform 'helm-M-x-resume-fn)))
(defun helm-M-x-resume-fn ()
(when (and helm-M-x--timer (timerp helm-M-x--timer))
(cancel-timer helm-M-x--timer)
(setq helm-M-x--timer nil))
(setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg))
(setq helm--mode-line-display-prefarg t)
;; Prevent displaying a wrong prefix arg when helm-resume is called
;; from prefix arg.
(setq current-prefix-arg nil))
(defun helm-M-x-read-extended-command (collection &optional predicate history)
"Read or execute action on command name in COLLECTION or HISTORY.
Helm completion is not provided when executing or defining kbd macros.
Arg COLLECTION should be an `obarray'.
Arg PREDICATE is a function that default to `commandp'.
Arg HISTORY default to `extended-command-history'."
(setq helm--mode-line-display-prefarg t)
(let* ((pred (or predicate #'commandp))
(helm-fuzzy-sort-fn (lambda (candidates _source)
(if helm-M-x-history-transformer-sort
;; Sort on real candidate otherwise
;; "symbol ()" is used when sorting.
(helm-fuzzy-matching-default-sort-fn-1 candidates t)
candidates)))
(sources `(,(helm-make-source "Emacs Commands history" 'helm-M-x-class
:data (lambda ()
(helm-comp-read-get-candidates
;; History should be quoted to
;; force `helm-comp-read-get-candidates'
;; to use predicate against
;; symbol and not string.
(or history 'extended-command-history)
;; Ensure using empty string to
;; not defeat helm matching fns [1]
pred nil nil ""))
:filtered-candidate-transformer
(if helm-M-x-history-transformer-sort
#'helm-M-x-transformer
#'helm-M-x-transformer-no-sort)
:fuzzy-match helm-M-x-fuzzy-match)
,(helm-make-source "Emacs Commands" 'helm-M-x-class
:data (lambda ()
(helm-comp-read-get-candidates
;; [1] Same comment as above.
collection pred nil nil ""))
:fuzzy-match helm-M-x-fuzzy-match)))
(prompt (concat (helm-acase helm-M-x-prefix-argument
(- "-")
((dst* (l &rest args))
(if (eq l 4) "C-u " (format "%d " l)))
((guard* (integerp it)) (format "%d " it)))
"M-x ")))
(setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg))
;; Fix Bug#2250, add `helm-move-selection-after-hook' which
;; reset prefix arg to nil only for this helm session.
(add-hook 'helm-move-selection-after-hook
#'helm-M-x--move-selection-after-hook)
(add-hook 'helm-before-action-hook
#'helm-M-x--before-action-hook)
(when (and sources helm-M-x-reverse-history)
(setq sources (nreverse sources)))
(unwind-protect
(progn
(setq current-prefix-arg nil)
(helm :sources sources
:prompt prompt
:buffer "*helm M-x*"
:history 'helm-M-x-input-history
:truncate-lines t))
(helm-M-x--unwind-forms))))
;; When running a command involving again helm from helm-M-x, the
;; unwind-protect UNWINDS forms are executed only once this helm
;; command exit leaving the helm-M-x timer running and other variables
;; and hooks not unset, so the timer is now in a global var and all
;; the forms that should normally run in unwind-protect are running as
;; well as soon as helm-M-x-execute-command is called.
(defun helm-M-x--unwind-forms (&optional done)
;; helm-M-x--unwind-forms-done is non nil when it have been called
;; once from helm-M-x-execute-command.
(unless helm-M-x--unwind-forms-done
(when (timerp helm-M-x--timer)
(cancel-timer helm-M-x--timer)
(setq helm-M-x--timer nil))
(setq helm--mode-line-display-prefarg nil
helm-fuzzy-sort-fn (default-toplevel-value 'helm-fuzzy-sort-fn))
;; Be sure to remove it here as well in case of quit.
(remove-hook 'helm-move-selection-after-hook
#'helm-M-x--move-selection-after-hook)
(remove-hook 'helm-before-action-hook
#'helm-M-x--before-action-hook))
;; Reset helm-M-x--unwind-forms-done to nil when DONE is
;; unspecified.
(setq helm-M-x--unwind-forms-done done))
(defun helm-M-x-execute-command (command)
"Execute COMMAND as an editor command.
COMMAND must be a symbol that satisfies the `commandp' predicate.
Save COMMAND to `extended-command-history'."
(helm-M-x--unwind-forms t)
(when command
;; Avoid having `this-command' set to *exit-minibuffer.
(setq this-command command
;; Handle C-x z (repeat) Bug#322
real-this-command command)
;; If helm-M-x is called with regular emacs completion (kmacro)
;; use the value of arg otherwise use helm-current-prefix-arg.
(let ((prefix-arg (or helm-current-prefix-arg helm-M-x-prefix-argument))
(command-name (symbol-name command)))
(condition-case-unless-debug err
(progn
(command-execute command 'record)
(add-to-history 'extended-command-history command-name))
(error
(when helm-M-x-always-save-history
(add-to-history 'extended-command-history command-name))
(signal (car err) (cdr err)))))))
(defun helm-M-x--vanilla-M-x ()
(helm-M-x-execute-command
(intern-soft
(if helm-mode
(unwind-protect
(progn
(helm-mode -1)
(read-extended-command))
(helm-mode 1))
(read-extended-command)))))
(defun helm-M-x--mode-predicate (symbol mj-mode lmm-modes)
"Check if SYMBOL is suitable for current buffer.
MJ-MODE is used to pass major-mode and LMM-MODES to pass local-minor-modes.
This predicate honors commands defined with the `interactive' MODES argument."
(let* ((sym (helm-symbolify symbol))
(modes (command-modes sym)))
(and (commandp sym)
(if modes
(or (memq mj-mode modes)
(cl-loop for m in modes thereis
(or (memq m lmm-modes)
(memq m global-minor-modes))))
t))))
;;;###autoload
(defun helm-M-x (_arg)
"Preconfigured `helm' for Emacs commands.
It is `helm' replacement of regular `M-x'
`execute-extended-command'.
Unlike regular `M-x' Emacs vanilla `execute-extended-command'
command, the prefix args if needed, can be passed AFTER starting
`helm-M-x'. When a prefix arg is passed BEFORE starting
`helm-M-x', the first `C-u' while in `helm-M-x' session will
disable it.
You can get help on each command by persistent action."
(interactive
(progn
(setq helm-M-x-prefix-argument current-prefix-arg)
(list current-prefix-arg)))
(if (or defining-kbd-macro executing-kbd-macro)
(helm-M-x--vanilla-M-x)
(let ((lmm-modes (buffer-local-value 'local-minor-modes (current-buffer)))
(mj-mode major-mode))
(helm-M-x-read-extended-command
obarray (if (and (fboundp 'command-modes)
helm-M-x-exclude-unusable-commands-in-mode)
(lambda (sym) (helm-M-x--mode-predicate sym mj-mode lmm-modes))
#'commandp)))))
(put 'helm-M-x 'interactive-only 'command-execute)
(provide 'helm-command)
;;; helm-command.el ends here
helm-4.0.3/helm-core.el 0000664 0000000 0000000 00001273042 15011067617 0014655 0 ustar 00root root 0000000 0000000 ;;; helm-core.el --- Development files for Helm -*- lexical-binding: t -*-
;; Copyright (C) 2022 ~ 2025 Thierry Volpiatto
;; Author: Thierry Volpiatto
;; URL: https://emacs-helm.github.io/helm/
;; Version: 4.0.3
;; Package-Requires: ((emacs "25.1") (async "1.9.9"))
;; 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 .
;;; Commentary:
;; Contains the main code for Helm.
;; As a package helm-core provides the files helm-core.el, helm-lib.el,
;; helm-source.el and helm-multi-match.el.
;;; Code:
(require 'cl-lib)
(require 'async)
(require 'helm-lib)
(require 'helm-multi-match)
(require 'helm-source)
;; Setup completion styles for helm-mode
(helm--setup-completion-styles-alist)
(declare-function helm-comp-read "helm-mode.el")
(declare-function custom-unlispify-tag-name "cus-edit.el")
(declare-function helm-quit-and-find-file "helm-utils.el")
(declare-function linum-mode "linum.el")
(declare-function minibuffer-depth-setup "mb-depth.el")
(declare-function transient--delete-window "ext:transient" ())
(declare-function transient--preserve-window-p "ext:transient"
(&optional nohide))
(defvar helm-marked-buffer-name)
(defvar display-buffer-function)
(defvar minibuffer-follows-selected-frame)
(defvar minibuffer-depth-indicate-mode)
;;; Internal Variables
;;
;;
(defvar helm-source-filter nil
"A list of source names to be displayed.
Other sources won't appear in the search results.
If nil, no filtering is done.
Don't set this directly, use `helm-set-source-filter' during a
Helm session to modify it.")
(defvar helm-saved-action nil
"Saved value of the currently selected action by key.")
(defvar helm-saved-current-source nil
"Value of the current source when the action list is shown.")
(defvar helm-in-persistent-action nil
"Flag whether in persistent-action or not.")
(defvar helm-last-buffer nil
"`helm-buffer' of a previous Helm session.")
(defvar helm-saved-selection nil
"Value of the currently selected object when the action list is shown.")
(defvar helm-sources nil
"[INTERNAL] Value of current sources in use, a list of alists.
The list of sources (symbols or alists) is normalized to alists
in `helm-initialize'.")
(defvar helm-buffer-file-name nil
"Variable `buffer-file-name' when Helm is invoked.")
(defvar helm-candidate-cache (make-hash-table :test 'equal)
"Holds the available candidate within a single Helm invocation.")
(defvar helm--candidate-buffer-alist nil)
(defvar helm-input ""
"The input typed in the candidates panel.")
(defvar helm-input-local nil
"Internal, store locally `helm-pattern' value for later use in `helm-resume'.")
(defvar helm--source-name nil)
(defvar helm-current-source nil)
(defvar helm-issued-errors nil)
(defvar helm--last-log-file nil
"The name of the log file of the last Helm session.")
(defvar helm--local-variables nil)
(defvar helm-split-window-state nil)
(defvar helm--window-side-state nil)
(defvar helm-selection-point nil
"The value of point at selection.")
(defvar helm-alive-p nil)
(defvar helm-visible-mark-overlays nil)
(defvar helm--force-updating-p nil
"[INTERNAL] Don't use this in your programs.")
(defvar helm-exit-status 0
"Flag to inform if Helm did exit or quit.
0 means Helm did exit when executing an action.
1 means Helm did quit with \\[keyboard-quit]
Knowing this exit-status could help restore a window config when
Helm aborts in some special circumstances. See
`helm-exit-minibuffer' and `helm-keyboard-quit'.")
(defvar helm-minibuffer-confirm-state nil)
(defvar helm--quit nil)
(defvar helm-buffers nil
"Helm buffers listed in order of most recently used.")
(defvar helm-current-position nil
"Cons of (point . window-start) when Helm is invoked.
`helm-current-buffer' uses this to restore position after
`helm-keyboard-quit'")
(defvar helm-last-frame-or-window-configuration nil
"Used to store window or frame configuration at Helm start.")
(defvar helm-onewindow-p nil)
(defvar helm-types nil)
(defvar helm--mode-line-string-real nil) ; The string to display in mode-line.
(defvar helm-persistent-action-display-window nil)
(defvar helm-marked-candidates nil
"Marked candidates. List of (source . real) pair.")
(defvar helm--mode-line-display-prefarg nil)
(defvar helm--temp-follow-flag nil
"[INTERNAL] A simple flag to notify persistent action we are following.")
(defvar helm--reading-passwd-or-string nil)
(defvar helm--in-update nil)
(defvar helm--in-fuzzy nil)
(defvar helm-maybe-use-default-as-input nil
"Flag to notify the use of use-default-as-input.
Use only in let-bindings.
Use :default arg of `helm' as input to update display.
Note that if also :input is specified as `helm' arg, it will take
precedence on :default.")
(defvar helm--temp-hooks nil
"Store temporary hooks added by `with-helm-temp-hook'.")
(defvar helm--prompt nil)
(defvar helm--file-completion-sources
'("Find Files" "Read File Name" "New file or directory")
"Sources that use the *find-files mechanism can be added here.
Sources generated by `helm-mode' don't need to be added here
because they are automatically added.
You should not modify this yourself unless you know what you are
doing.")
(defvar helm--completing-file-name nil
"Non nil when `helm-read-file-name' is running.
Used for `helm-file-completion-source-p'.")
;; Same as `ffap-url-regexp' but keep it here to ensure `ffap-url-regexp' is not nil.
(defvar helm--url-regexp "\\`\\(news\\(post\\)?:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://\\)")
(defvar helm--ignore-errors nil
"Flag to prevent Helm popping up errors in candidates functions.
Should be set in candidates functions if needed, and will be
restored at end of session.")
(defvar helm--action-prompt "Select action: ")
(defvar helm--cycle-resume-iterator nil)
(defvar helm--buffer-in-new-frame-p nil)
(defvar helm-initial-frame nil
"[INTERNAL] The selected frame before starting Helm.
Helm use this internally to know in which frame it started, don't
modify this yourself.")
(defvar helm-popup-frame nil
"The frame where Helm is displayed.
This is only used when Helm is using
`helm-display-buffer-in-own-frame' as `helm-display-function' and
`helm-display-buffer-reuse-frame' is non nil.")
(defvar helm--nested nil)
(defconst helm--frame-default-attributes
'(width height tool-bar-lines left top
title undecorated vertical-scroll-bars
visibility fullscreen menu-bar-lines undecorated
alpha foreground-color background-color)
"Frame parameters to save in `helm--last-frame-parameters'.")
(defvar helm--last-frame-parameters nil
"Frame parameters to save for later resuming.
Local to `helm-buffer'.")
(defvar helm--executing-helm-action nil
"Non nil when action is triggering a new helm-session.
This may be let bounded in other places to notify the display
function to reuse the same frame parameters as the previous Helm
session just like resume would do.")
(defvar helm--current-buffer-narrowed nil)
(defvar helm--suspend-update-interactive-flag nil)
(defvar helm-persistent-action-window-buffer nil
"[INTERNAL] Store the buffer where helm is started.
It is generally `helm-current-buffer', but when this one is displayed
in a dedicated buffer, helm can't start in this window and use another
window handling a buffer, it is this one we store.")
(defvar helm--tramp-archive-maybe-loaded nil)
(defvar helm--original-dedicated-windows-alist nil
"[INTERNAL] Store all dedicated windows with their dedicated state on startup")
(defvar helm--deleting-minibuffer-contents-from nil
"[INTERNAL] Recenter when deleting minibuffer-contents and preselecting.
This is a flag used internally.")
(defvar helm--minibuffer-completing-file-name nil
"A flag notifying Helm is in file completion.
It is let-bounded in `helm-read-file-name'. Same as
`minibuffer-completing-file-name' but doesn't affect `file-directory-p'.")
;;; Multi keys
;;
;;
;;;###autoload
(defun helm-define-multi-key (keymap key functions &optional delay)
"In KEYMAP, define key sequence KEY for function list FUNCTIONS.
Each function runs sequentially for each KEY press.
If DELAY is specified, switch back to initial function of FUNCTIONS list
after DELAY seconds.
The functions in FUNCTIONS list take no args.
E.g.
(defun foo ()
(interactive)
(message \"Run foo\"))
(defun bar ()
(interactive)
(message \"Run bar\"))
(defun baz ()
(interactive)
(message \"Run baz\"))
\(helm-define-multi-key global-map (kbd \" q\") \\='(foo bar baz) 2)
Each time \" q\" is pressed, the next function is executed.
Waiting more than 2 seconds between key presses switches back to
executing the first function on the next hit."
(define-key keymap key (helm-make-multi-command functions delay)))
;;;###autoload
(defmacro helm-multi-key-defun (name docstring funs &optional delay)
"Define NAME as a multi-key command running FUNS.
After DELAY seconds, the FUNS list is reinitialized.
See `helm-define-multi-key'."
(declare (indent 2) (doc-string 2))
(setq docstring (if docstring (concat docstring "\n\n")
"This is a helm-ish multi-key command."))
`(defalias (quote ,name) (helm-make-multi-command ,funs ,delay) ,docstring))
(defun helm-make-multi-command (functions &optional delay)
"Return an anonymous multi-key command running FUNCTIONS.
Run each function in the FUNCTIONS list in turn when called within
DELAY seconds."
(declare (indent 1))
(let ((funs functions)
(iter (list nil)) ; ref-cell[1].
(timeout delay))
(lambda ()
(interactive)
(helm-run-multi-key-command funs iter timeout))))
(defun helm-run-multi-key-command (functions iterator delay)
(let ((fn (lambda ()
(cl-loop for count from 1 to (length functions)
collect count)))
next)
;; By passing a list containing a single 'nil' element [1] as ITERATOR we
;; avoid using a global var.
(unless (and (car iterator)
;; Reset iterator when another key is pressed.
(eq this-command real-last-command))
(setcar iterator (helm-iter-circular (funcall fn))))
(setq next (helm-iter-next (car iterator)))
(and next (car iterator)
(call-interactively (nth (1- next) functions)))
(when delay (run-with-idle-timer
delay nil (lambda ()
(setcar iterator nil))))))
(helm-multi-key-defun helm-toggle-resplit-and-swap-windows
"Multi key command to re-split and swap Helm window.
First call runs `helm-toggle-resplit-window',
and second call within 1s runs `helm-swap-windows'."
'(helm-toggle-resplit-window helm-swap-windows) 1)
(put 'helm-toggle-resplit-and-swap-windows 'helm-only t)
(defun helm-command-with-subkeys (map subkey command
&optional other-subkeys prompt exit-fn delay)
"Build a command that run COMMAND when SUBKEY is read.
The command runs a loop reading keys and exit when user stops typing after DELAY
seconds. After this DELAY EXIT-FN run if specified.
Arg OTHER-SUBKEYS should be an alist composed of (command . short-key) where
command is another command than COMMAND bound to short-key.
A PROMPT can be used to describe bindings of COMMAND and OTHER-SUBKEYS.
Return an anonymous interactive command to use with
`helm-define-key-with-subkeys'."
(lambda ()
(interactive)
(let (timer)
(call-interactively command)
(unless (or defining-kbd-macro executing-kbd-macro)
(unwind-protect
(progn
(when delay
(setq timer (run-with-idle-timer
delay nil (lambda () (keyboard-quit)))))
(while (let ((input (read-key prompt)) other kb com)
(setq last-command-event input)
(cond
((eq input subkey)
(call-interactively command)
(setq last-command command)
t)
((setq other (assoc input other-subkeys))
(call-interactively (cdr other))
(setq last-command (cdr other))
t)
(t
(setq kb (vector last-command-event))
(setq com (lookup-key map kb))
(if (commandp com)
(call-interactively com)
(setq unread-command-events
(nconc (mapcar #'identity kb)
unread-command-events)))
nil)))))
(when timer (cancel-timer timer))
(and exit-fn (funcall exit-fn)))))))
;;;###autoload
(defun helm-define-key-with-subkeys (map key subkey command
&optional other-subkeys
prompt exit-fn delay
docstring)
"Define in MAP a KEY and SUBKEY to COMMAND.
This allows typing KEY to call COMMAND the first time and
type only SUBKEY on subsequent calls.
Arg MAP is the keymap to use, SUBKEY is the initial short
key binding to call COMMAND.
Arg OTHER-SUBKEYS is an alist specifying other short key bindings
to use once started, e.g.:
(helm-define-key-with-subkeys global-map
(kbd \"C-x v n\") ?n \\='git-gutter:next-hunk
\\='((?p . git-gutter:previous-hunk)))
In this example, `C-x v n' will run `git-gutter:next-hunk'
subsequent \"n\" will run this command again and subsequent \"p\"
will run `git-gutter:previous-hunk'.
If specified PROMPT can be displayed in minibuffer to describe
SUBKEY and OTHER-SUBKEYS. Arg EXIT-FN specifies a function to run
on exit.
For any other key pressed, run their assigned command as defined
in MAP and then exit the loop running EXIT-FN, if specified.
If DELAY is specified the command expires after DELAY seconds.
NOTE: SUBKEY and OTHER-SUBKEYS bindings support only char syntax
and vectors, so don't use strings to define them. While defining
or executing a kbd macro no SUBKEY or OTHER-SUBKEYS are provided,
i.e. the loop is not entered after running COMMAND."
(declare (indent 1))
(let ((fn (helm-command-with-subkeys
map subkey command other-subkeys prompt exit-fn delay))
(com (intern (format "helm-%s-with-subkeys"
(symbol-name command)))))
(defalias com fn
(or docstring
;; When no DOCSTRING, generate a basic one specifying
;; COMMAND, SUBKEY and OTHER-SUBKEYS.
(concat
(format "Run `%s' and bound it to `%s' for subsequent calls."
command (if (numberp subkey) (single-key-description subkey) subkey))
(if other-subkeys
(helm-basic-docstring-from-alist other-subkeys)
""))))
(define-key map key com)))
(defun helm-basic-docstring-from-alist (alist)
(let* ((len (length alist))
(osk (cl-loop for (k . v) in alist
for count from 1
for sep = (cond ((and (= count len) (> len 1))
" and ")
((> count 1) ",")
(t ""))
for key = (if (numberp k) (single-key-description k) k)
concat (format "%s`%s'" sep key) into ks
concat (format "%s`%s'" sep v) into kv
finally return (list ks kv))))
(format "\nBound as well %s to %s%s."
(car osk) (if (> len 1) "respectively " "") (cadr osk))))
;;; Keymap
;;
;;
(defvar helm-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(define-key map (kbd "") #'helm-next-line)
(define-key map (kbd "") #'helm-previous-line)
(define-key map (kbd "C-n") #'helm-next-line)
(define-key map (kbd "C-p") #'helm-previous-line)
(define-key map (kbd "") #'helm-follow-action-forward)
(define-key map (kbd "") #'helm-follow-action-backward)
(define-key map (kbd "") #'helm-previous-page)
(define-key map (kbd "") #'helm-next-page)
(define-key map (kbd "M-v") #'helm-scroll-up)
(define-key map (kbd "C-v") #'helm-scroll-down)
(define-key map (kbd "M-<") #'helm-beginning-of-buffer)
(define-key map (kbd "M->") #'helm-end-of-buffer)
(define-key map (kbd "C-g") #'helm-keyboard-quit)
(define-key map (kbd "") #'helm-maybe-exit-minibuffer)
(define-key map (kbd "C-i") #'helm-select-action)
(define-key map (kbd "C-j") #'helm-execute-persistent-action)
(define-key map (kbd "C-o") #'helm-next-source)
(define-key map (kbd "M-o") #'helm-previous-source)
(define-key map (kbd "") #'helm-next-source)
(define-key map (kbd "") #'helm-previous-source)
(define-key map (kbd "C-l") #'helm-recenter-top-bottom-other-window)
(define-key map (kbd "M-C-l") #'helm-reposition-window-other-window)
(define-key map (kbd "C-M-v") #'helm-scroll-other-window)
(define-key map (kbd "M-") #'helm-scroll-other-window)
(define-key map (kbd "C-M-y") #'helm-scroll-other-window-down)
(define-key map (kbd "C-M-S-v") #'helm-scroll-other-window-down)
(define-key map (kbd "M-") #'helm-scroll-other-window-down)
(define-key map (kbd "") #'helm-scroll-other-window)
(define-key map (kbd "") #'helm-scroll-other-window-down)
(define-key map (kbd "C-@") #'helm-toggle-visible-mark)
(define-key map (kbd "C-SPC") #'helm-toggle-visible-mark-forward)
(define-key map (kbd "M-SPC") #'helm-toggle-visible-mark-backward)
(define-key map (kbd "M-[") nil)
(define-key map (kbd "M-(") #'helm-prev-visible-mark)
(define-key map (kbd "M-)") #'helm-next-visible-mark)
(define-key map (kbd "C-k") #'helm-delete-minibuffer-contents)
(define-key map (kbd "DEL") #'helm-delete-char-backward)
(define-key map (kbd "C-x C-f") #'helm-quit-and-find-file)
(define-key map (kbd "M-m") #'helm-toggle-all-marks)
(define-key map (kbd "M-a") #'helm-mark-all)
(define-key map (kbd "M-U") #'helm-unmark-all)
(define-key map (kbd "C-M-a") #'helm-show-all-candidates-in-source)
(define-key map (kbd "C-M-f") #'helm-limit-to-sources)
(define-key map (kbd "C-M-e") #'helm-display-all-sources)
(define-key map (kbd "C-s") #'undefined)
(define-key map (kbd "M-s") #'undefined)
(define-key map (kbd "C-r") #'undefined)
(define-key map (kbd "C-M-r") #'undefined)
(define-key map (kbd "C-M-s") #'undefined)
(define-key map (kbd "C-}") #'helm-narrow-window)
(define-key map (kbd "C-{") #'helm-enlarge-window)
(define-key map (kbd "C-c -") #'helm-swap-windows)
(define-key map (kbd "C-c _") #'helm-toggle-full-frame)
(define-key map (kbd "C-z") #'helm-toggle-full-frame)
(define-key map (kbd "C-c %") #'helm-exchange-minibuffer-and-header-line)
(define-key map (kbd "C-c C-y") #'helm-yank-selection)
(define-key map (kbd "C-c C-k") #'helm-kill-selection-and-quit)
(define-key map (kbd "C-c C-i") #'helm-insert-or-copy)
(define-key map (kbd "C-c C-f") #'helm-follow-mode)
(define-key map (kbd "C-c C-u") #'helm-refresh)
(define-key map (kbd "C-c >") #'helm-toggle-truncate-line)
(define-key map (kbd "C-c l") #'helm-display-line-numbers-mode)
(define-key map (kbd "M-p") #'previous-history-element)
(define-key map (kbd "M-n") #'next-history-element)
;; Unbind `previous-matching-history-element' which is non sense for helm.
(define-key map (kbd "M-r") #'undefined)
(define-key map (kbd "C-!") #'helm-toggle-suspend-update)
(define-key map (kbd "C-x b") #'helm-resume-previous-session-after-quit)
(define-key map (kbd "C-x C-b") #'helm-resume-list-buffers-after-quit)
(helm-define-key-with-subkeys map (kbd "C-c n") ?n #'helm-run-cycle-resume)
;; Disable `file-cache-minibuffer-complete'.
(define-key map (kbd "") #'undefined)
;; Multi keys
(define-key map (kbd "C-t") #'helm-toggle-resplit-and-swap-windows)
;; Debugging command
(define-key map (kbd "C-h C-d") #'helm-enable-or-switch-to-debug)
(define-key map (kbd "C-h c") #'helm-customize-group)
(define-key map (kbd "C-h d") #'helm-debug-output)
;; Allow to eval keymap without errors.
(define-key map [f1] nil)
(define-key map (kbd "C-h C-h") #'undefined)
(define-key map (kbd "C-h h") #'undefined)
(helm-define-key-with-subkeys map
(kbd "C-w") ?\C-w #'helm-yank-text-at-point
'((?\C-_ . helm-undo-yank-text-at-point)))
;; Use `describe-mode' key in `global-map'.
(dolist (k (where-is-internal #'describe-mode global-map))
(define-key map k #'helm-help))
;; Bind all actions from f1 to f12, `helm-select-nth-action'
;; counts from 0, i.e. (helm-select-nth-action 0) = action 1.
(dotimes (n 12)
(define-key map (kbd (format "" (1+ n)))
(lambda ()
(interactive)
(helm-select-nth-action n))))
map)
"Keymap for helm.")
(defun helm-customize-group-1 (group)
(require 'cus-edit)
(let ((name (format "*Customize Group: %s*"
(custom-unlispify-tag-name group))))
(if (buffer-live-p (get-buffer name))
(switch-to-buffer name)
(custom-buffer-create
(list (list group 'custom-group))
name
(concat " for group "
(custom-unlispify-tag-name group))))))
(defun helm-customize-group ()
"Jump to customization group of current source.
Default to Helm group when group is not defined in source."
(interactive)
(let ((source (or (helm-get-current-source)
(helm-comp-read
"Customize variables for: "
(cl-loop for src in (with-helm-buffer helm-sources)
collect `(,(assoc-default 'name src) .
,src))
:allow-nest t
:exec-when-only-one t))))
(helm-run-after-exit 'helm-customize-group-1 (helm-get-attr 'group source))))
(put 'helm-customize-group 'helm-only t)
(defun helm--action-at-nth-set-fn-1 (value &optional negative)
(dotimes (n 9)
(let ((key (format value (1+ n)))
(fn (lambda ()
(interactive)
(helm-execute-selection-action-at-nth
(if negative (- (1+ n)) (1+ n))))))
(define-key helm-map (kbd key) nil)
(define-key helm-map (kbd key) fn))))
(defun helm--action-at-nth-set-fn- (var val)
(set var val)
(helm--action-at-nth-set-fn-1 val 'negative))
(defun helm--action-at-nth-set-fn+ (var val)
(set var val)
(helm--action-at-nth-set-fn-1 val))
(defcustom helm-action-at-nth-negative-prefix-key "C-x %d"
"The prefix key to execute default action on nth <-n> candidate.
This is a format spec where %d will be replaced by the candidate
number.
This is useful when `helm-display-line-numbers-mode' is turned on.
NOTE: `setq' have no effect until you restart Emacs, use
customize for immediate effect."
:group 'helm
:type 'string
:set #'helm--action-at-nth-set-fn-)
(defcustom helm-action-at-nth-positive-prefix-key "C-c %d"
"The prefix key to execute default action on nth <+n> candidate.
This is a format spec where %d will be replaced by the candidate
number.
This is useful when `helm-display-line-numbers-mode' is turned on.
NOTE: `setq' have no effect until you restart Emacs, use
customize for immediate effect."
:group 'helm
:type 'string
:set #'helm--action-at-nth-set-fn+)
(defgroup helm nil
"Open Helm."
:prefix "helm-" :group 'convenience)
;; Easy access to customize
;;;###autoload
(defun helm-configuration ()
"Customize Helm."
(interactive)
(customize-group "helm"))
(defcustom helm-completion-window-scroll-margin 5
"`scroll-margin' to use for Helm completion window.
Set to 0 to disable.
NOTE: This has no effect when `helm-display-source-at-screen-top'
id is non-nil."
:group 'helm
:type 'integer)
(defcustom helm-left-margin-width 0
"`left-margin-width' value for the `helm-buffer'."
:group 'helm
:type 'integer)
(defcustom helm-display-source-at-screen-top t
"Display candidates at the top of screen.
This happens with `helm-next-source' and `helm-previous-source'.
NOTE: When non-nil (default), disable
`helm-completion-window-scroll-margin'."
:group 'helm
:type 'boolean)
(defcustom helm-candidate-number-limit 500
"Global limit for number of candidates displayed.
When the pattern is empty, the number of candidates shown will be
as set here instead of the entire list, which may be hundreds or
thousands. Since narrowing and filtering rapidly reduces
available candidates, having a small list will keep the interface
responsive.
Set this value to nil for no limit."
:group 'helm
:type '(choice (const :tag "Disabled" nil) integer))
(defcustom helm-input-idle-delay 0.01
"Idle time before updating, specified in seconds."
:group 'helm
:type 'float)
(defcustom helm-exit-idle-delay 0
"Idle time before exiting minibuffer while Helm is updating.
Has no affect when helm-buffer is up to date (i.e. exit without
delay in this condition)."
:group 'helm
:type 'float)
(defvaralias 'helm-samewindow 'helm-full-frame)
(make-obsolete-variable 'helm-samewindow 'helm-full-frame "1.4.8.1")
(defcustom helm-full-frame nil
"Use current window for showing candidates.
If t, then Helm does not pop-up a new window."
:group 'helm
:type 'boolean)
(defcustom helm-candidate-separator
(if (fontp (char-displayable-p (read "#x2015")))
"――――――――――――――――――――――――――――――――――――――"
"--------------------------------------")
"Candidates separator of `multiline' source."
:group 'helm
:type 'string)
(defcustom helm-save-configuration-functions
'(set-window-configuration . helm-current-window-configuration)
"Functions used to restore or save configurations for frames and windows.
Specified as a pair of functions, where car is the restore
function and cdr is the save function.
To save and restore frame configuration, set this variable to
\\='(set-frame-configuration . helm-current-frame-configuration)
NOTE: This may not work properly with own-frame minibuffer
settings. Older versions saves/restores frame configuration, but
the default has changed now to avoid flickering."
:group 'helm
:type 'sexp)
(defcustom helm-display-function 'helm-default-display-buffer
"Function used to display `helm-buffer'.
Local value in `helm-buffer' will take precedence on this default
value. Commands that are in `helm-commands-using-frame' will have
`helm-buffer' displayed in frame, `helm-display-function' being
ignored.
If no local value is found and current command is not one of
`helm-commands-using-frame' use this default value.
The function in charge of deciding which value use is
`helm-resolve-display-function'.
To set it locally to `helm-buffer' in Helm sources use
`helm-set-local-variable' in init function or use
:display-function slot in `helm' call."
:group 'helm
:type 'symbol)
(defcustom helm-case-fold-search 'smart
"Adds \\='smart' option to `case-fold-search'.
Smart option ignores case for searches as long as there are no
upper case characters in the pattern.
Use nil or t to turn off smart behavior and use
`case-fold-search' behavior.
Default is smart.
NOTE: Case fold search has no effect when searching asynchronous
sources, which relies on customized features implemented directly
into their execution process. See helm-grep.el for an example."
:group 'helm
:type '(choice (const :tag "Ignore case" t)
(const :tag "Respect case" nil)
(other :tag "Smart" smart)))
(defcustom helm-file-name-case-fold-search
(if (memq system-type
'(cygwin windows-nt ms-dos darwin))
t
helm-case-fold-search)
"Local setting of `helm-case-fold-search' for reading filenames.
See `helm-case-fold-search' for more info."
:group 'helm
:type 'symbol)
(defcustom helm-reuse-last-window-split-state nil
"Use the same state of window split, vertical or horizontal.
`helm-toggle-resplit-window' for the next helm session will use
the same window scheme as the previous session unless
`helm-split-window-default-side' is \\='same or \\='other."
:group 'helm
:type 'boolean)
(defcustom helm-split-width-threshold nil
"The value of `split-width-threshold' for helm windows.
This affect the behavior of `helm-split-window-default-fn'.
When the value is an integer, `split-window-sensibly' is used inconditionally
and all the helm variables that affect window splitting are ignored."
:group 'helm
:type '(choice
(const :tag "Maybe use `split-window-sensibly'" nil)
(integer :tag "Inconditionally use `split-window-sensibly'")))
(defcustom helm-split-window-preferred-function 'helm-split-window-default-fn
"Default function used for splitting window."
:group 'helm
:type 'function)
(defcustom helm-split-window-default-side 'below
"The default side to display `helm-buffer'.
Must be one acceptable arg for `split-window' SIDE,
that is `below', `above', `left' or `right'.
Other acceptable values are `same' which always displays
`helm-buffer' in current window and `other' that displays
`helm-buffer' below if only one window or in
`other-window-for-scrolling' when available.
A nil value has same effect as `below'. If `helm-full-frame' is
non-nil, it take precedence over this setting.
See also `helm-split-window-inside-p' and
`helm-always-two-windows' that take precedence over this.
NOTE: this has no effect if
`helm-split-window-preferred-function' is not
`helm-split-window-default-fn' unless this new function can
handle this."
:group 'helm
:type 'symbol)
(defcustom helm-split-window-other-side-when-one-window 'below
"Place for `helm-window' when `helm-split-window-default-side' is \\='other.
The default side to display `helm-buffer' when (1)
`helm-split-window-default-side' is \\='other and (2)
the current frame only has one window. Possible values
are acceptable args for `split-window' SIDE, that is `below',
`above', `left' or `right'.
If `helm-full-frame' is non-nil, it takes precedence over this
setting.
See also `helm-split-window-inside-p' and `helm-always-two-windows' that
takes precedence over this.
NOTE: this has no effect if
`helm-split-window-preferred-function' is not
`helm-split-window-default-fn' unless this new function can
handle this."
:group 'helm
:type 'symbol)
(defcustom helm-display-buffer-default-height nil
"Initial height of `helm-buffer', specified as an integer or a function.
The function should take one arg and be responsible for re-sizing
the window; function's return value is ignored. Note that this
has no effect when the split is vertical. See `display-buffer'
for more info."
:group 'helm
:type '(choice integer function))
(defcustom helm-display-buffer-default-width nil
"Initial width of `helm-buffer', specified as an integer or a function.
The function should take one arg and be responsible for re-sizing
the window; function's return value is ignored. Note that this
have no effect when the split is horizontal. See `display-buffer'
for more info."
:group 'helm
:type '(choice integer function))
(defvaralias 'helm-split-window-in-side-p 'helm-split-window-inside-p)
(make-obsolete-variable 'helm-split-window-in-side-p 'helm-split-window-inside-p "2.8.6")
(defcustom helm-split-window-inside-p nil
"Force split inside selected window when non-nil.
See also `helm-split-window-default-side'.
NOTE: this has no effect if
`helm-split-window-preferred-function' is not
`helm-split-window-default-fn' unless this new function can
handle this."
:group 'helm
:type 'boolean)
(defcustom helm-always-two-windows t
"When non-nil Helm uses two windows in this frame.
I.e. `helm-buffer' in one window and `helm-current-buffer'
in the other.
Note: this has no effect when `helm-split-window-inside-p' is
non-nil, or when `helm-split-window-default-side' is set to
\\='same.
When `helm-autoresize-mode' is enabled, setting this to nil
will have no effect.
Also when non-nil it overrides the effect of
`helm-split-window-default-side' set to `other'."
:group 'helm
:type 'boolean)
(defcustom helm-display-buffer-width 72
"Frame width when displaying helm-buffer in own frame."
:group 'helm
:type 'integer)
(defcustom helm-display-buffer-height 20
"Frame height when displaying helm-buffer in own frame."
:group 'helm
:type 'integer)
(defcustom helm-default-display-buffer-functions nil
"Action functions to pass to `display-buffer'.
See (info \"(elisp) Buffer Display Action Functions\").
It may override others helm window related variables settings like
`helm-always-two-windows', `helm-split-window-inside-p' etc..."
:group 'helm
:type '(repeat symbol))
(defcustom helm-default-display-buffer-alist nil
"Additional alist to pass to `display-buffer' action.
See (info \"(elisp) Action Alists for Buffer Display\").
It may override others helm window related variables settings like
`helm-always-two-windows', `helm-split-window-inside-p' etc...
Note that window-height and window-width have to be configured in
`helm-display-buffer-height' and `helm-display-buffer-width'."
:group 'helm
:type '(alist :key-type symbol :value-type sexp))
(defcustom helm-sources-using-default-as-input '(helm-source-imenu
helm-source-imenu-all
helm-source-info-elisp
helm-source-etags-select
helm-source-man-pages
helm-source-occur
helm-source-moccur
helm-source-grep-ag
helm-source-grep-git
helm-source-grep)
"List of Helm sources that need to use `helm-maybe-use-default-as-input'.
When a source is a member of this list, default `thing-at-point'
will be used as input."
:group 'helm
:type '(repeat (choice symbol)))
(defcustom helm-delete-minibuffer-contents-from-point t
"When non-nil, `helm-delete-minibuffer-contents' deletes region from `point'.
Otherwise it deletes `minibuffer-contents'.
See documentation for `helm-delete-minibuffer-contents'."
:group 'helm
:type 'boolean)
(defcustom helm-follow-mode-persistent nil
"When non-nil, save last state of `helm-follow-mode' for the next Emacs sessions.
Each time you turn on or off `helm-follow-mode', the current
source name will be stored or removed from
`helm-source-names-using-follow'.
Note that this may be disabled in some places where it is unsafe
to use because persistent action is changing according to
context."
:group 'helm
:type 'boolean)
(defcustom helm-source-names-using-follow nil
"A list of source names to have follow enabled.
This list of source names will be used only
when `helm-follow-mode-persistent' is non-nil.
You don't have to customize this yourself unless you really want
and know what you are doing, instead just set
`helm-follow-mode-persistent' to non-nil and as soon as you turn
on or off `helm-follow-mode' (C-c C-f) in a source, Helm will
save or remove source name in this variable."
:group 'helm
:type '(repeat (choice string)))
(defcustom helm-prevent-escaping-from-minibuffer t
"Prevent escaping from minibuffer with `other-window' during the Helm session."
:group 'helm
:type 'boolean)
(defcustom helm-allow-mouse t
"Allow mouse usage during the Helm session when non-nil.
Note that this also allows moving out of minibuffer when clicking
outside of `helm-buffer', so it is up to you to get back to Helm
by clicking back in `helm-buffer' or minibuffer."
:group 'helm
:type 'boolean)
(defcustom helm-move-to-line-cycle-in-source t
"Cycle to the beginning or end of the list after reaching the bottom or top.
This applies when using `helm-next/previous-line'."
:group 'helm
:type 'boolean)
(defcustom helm-fuzzy-match-fn 'helm-fuzzy-match
"The function for fuzzy matching in `helm-source-sync' based sources."
:group 'helm
:type 'function)
(defcustom helm-fuzzy-search-fn 'helm-fuzzy-search
"The function for fuzzy matching in `helm-source-in-buffer' based sources."
:group 'helm
:type 'function)
(defcustom helm-fuzzy-sort-fn 'helm-fuzzy-matching-default-sort-fn
"The sort transformer function used in fuzzy matching."
:group 'helm
:type 'function)
(defcustom helm-fuzzy-matching-highlight-fn #'helm-fuzzy-default-highlight-match
"The function to highlight fuzzy matches.
The function must have the same signature as
`helm-fuzzy-default-highlight-match' which is the default."
:group 'helm
:type 'function)
(defcustom helm-autoresize-max-height 40
"Specify maximum height and defaults to percent of Helm window's frame height.
See `fit-window-to-buffer' for more infos."
:group 'helm
:type 'integer)
(defcustom helm-autoresize-min-height 10
"Specify minimum height and defaults to percent of Helm window's frame height.
If nil, `window-min-height' is used.
See `fit-window-to-buffer' for details."
:group 'helm
:type 'integer)
(defcustom helm-input-method-verbose-flag nil
"The default value for `input-method-verbose-flag' used in Helm minibuffer.
It is nil by default, which does not turn off input method. Helm
updates and exits without interruption -- necessary for complex
methods.
If set to any other value as per `input-method-verbose-flag',
then use `C-\\' to disable the `current-input-method' to exit or
update Helm."
:group 'helm
:type '(radio :tag "A flag to control extra guidance for input methods in helm."
(const :tag "Never provide guidance" nil)
(const :tag "Always provide guidance" t)
(const :tag "Provide guidance only for complex methods" complex-only)))
(defcustom helm-display-header-line t
"Display header-line when non nil.
It has to be non nil when you want to display minibuffer contents in there with
`helm-echo-input-in-header-line'."
:group 'helm
:type 'boolean)
(defcustom helm-inherit-input-method t
"Inherit `current-input-method' from `current-buffer' when non-nil.
The default is to enable this by default and then toggle
`toggle-input-method'."
:group 'helm
:type 'boolean)
(defcustom helm-echo-input-in-header-line nil
"Send current input to header-line when non-nil.
Note that `helm-display-header-line' has to be non nil as well for this to take
effect."
:group 'helm
:type 'boolean)
(defcustom helm-header-line-space-before-prompt 'left-fringe
"Specify the space before prompt in header-line.
This will be used when `helm-echo-input-in-header-line' is
non-nil.
Value can be one of the symbols \\='left-fringe or \\='left-margin or
an integer specifying the number of spaces before prompt. Note
that on input longer that `window-width' the continuation string
will be shown on left side of window without taking care of
this."
:group 'helm
:type '(choice
(symbol
(const :tag "Fringe" left-fringe)
(const :tag "Margin" left-margin))
integer))
(defcustom helm-tramp-connection-min-time-diff 5
"Value of `tramp-connection-min-time-diff' for Helm remote processes.
If set to zero Helm remote processes are not delayed.
Setting this to a value less than 5 or disabling it with a zero
value is risky, however on Emacs versions starting at 24.5 it
seems it is now possible to disable it.
Anyway at any time in Helm you can suspend your processes while
typing by hitting \\ `\\[helm-toggle-suspend-update]'.
Only async sources than use a sentinel calling
`helm-process-deferred-sentinel-hook' are affected by this."
:type 'integer
:group 'helm)
(defcustom helm-show-action-window-other-window 'left
"Show action buffer beside `helm-buffer' when non-nil.
If nil don't split and replace helm-buffer by the action buffer
in same window.
Possible value are left, right, below and above."
:group 'helm
:type '(choice
(const :tag "Split at left" left)
(const :tag "Split at right" right)
(const :tag "Split below" below)
(const :tag "Split above" above)
(const :tag "Don't split" nil)))
(defcustom helm-cycle-resume-delay 1.0
"Delay used before resuming in `helm-run-cycle-resume'."
:type 'float
:group 'helm)
(defcustom helm-display-buffer-reuse-frame nil
"When non nil Helm frame is not deleted and reused in next sessions.
This was used to workaround a bug in Emacs where frames where
popping up slowly, now that the bug have been fixed upstream
\(emacs-27) probably you don't want to use this any more. On
emacs-26 set `x-wait-for-event-timeout' to nil to have your
frames popping up fast."
:group 'helm
:type 'boolean)
(defcustom helm-commands-using-frame nil
"A list of commands where `helm-buffer' is displayed in a frame."
:group 'helm
:type '(repeat symbol))
(defcustom helm-actions-inherit-frame-settings t
"Actions inherit Helm frame settings of initial command when non nil."
:group 'helm
:type 'boolean)
(defcustom helm-use-undecorated-frame-option t
"Display Helm frame undecorated when non nil.
This option has no effect with Emacs versions lower than 26."
:group 'helm
:type 'boolean)
(defcustom helm-frame-background-color nil
"Background color for Helm frames, a string.
Fallback to default face background when nil."
:group 'helm
:type 'string)
(defcustom helm-frame-foreground-color nil
"Foreground color for Helm frames, a string.
Fallback to default face foreground when nil"
:group 'helm
:type 'string)
(defcustom helm-frame-alpha 100
"Alpha parameter for Helm frames, an integer.
Fallback to 100 when nil."
:group 'helm
:type 'integer)
(defcustom helm-use-frame-when-more-than-two-windows nil
"Display Helm buffer in frame when more than two windows."
:group 'helm
:type 'boolean)
(defvaralias 'helm-use-frame-when-dedicated-window
'helm-use-frame-when-no-suitable-window)
(defcustom helm-use-frame-when-no-suitable-window nil
"Display Helm buffer in frame when Helm is started from a dedicated window."
:group 'helm
:type 'boolean)
(make-obsolete-variable 'helm-use-frame-when-dedicated-window
'helm-use-frame-when-no-suitable-window
"3.8.1")
(defcustom helm-default-prompt-display-function
#'helm-set-default-prompt-display
"The function to use to set face of fake cursor in header-line."
:group 'helm
:type 'function)
(defcustom helm-truncate-lines nil
"The value of `truncate-lines' when Helm starts.
You can toggle later `truncate-lines' with
\\\\[helm-toggle-truncate-line]."
:group 'helm
:type 'boolean)
(defcustom helm-visible-mark-prefix "*"
"Prefix used in margin for marked candidates.
Set this to an empty string if you don't want prefix in margin when marking."
:group 'helm
:type 'string)
(defvar helm-update-edebug nil
"Development feature.
If set to true then all functions invoked after `helm-update' can be
instrumented by `edebug' for stepping. `helm--maybe-use-while-no-input'
then doesn't use `while-no-input', because `while-no-input' throws on
`edebug' command key input.")
;;; Faces
;;
;;
(defgroup helm-faces nil
"Customize the appearance of Helm."
:prefix "helm-"
:group 'faces
:group 'helm)
(defface helm-source-header
`((((type tty pc))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "blue"
:foreground "white")
(((background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "#22083397778B"
:foreground "white"
:weight bold :height 1.3 :family "Sans Serif")
(((background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "#abd7f0"
:foreground "black"
:weight bold :height 1.3 :family "Sans Serif"))
"Face for source header in the Helm buffer."
:group 'helm-faces)
(defface helm-visible-mark
`((((min-colors 88) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "green1"
:foreground "black")
(((background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "green"
:foreground "black")
(((background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "#d1f5ea")
(((min-colors 88))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "green1")
(t ,@(and (>= emacs-major-version 27) '(:extend t))
:background "green"))
"Face for visible mark."
:group 'helm-faces)
(defface helm-header
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit header-line))
"Face for header lines in the Helm buffer."
:group 'helm-faces)
(defface helm-candidate-number
`((((background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "yellow" :foreground "black")
(((background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "#faffb5" :foreground "black"))
"Face for candidate number in mode-line."
:group 'helm-faces)
(defface helm-candidate-number-suspended
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit helm-candidate-number :inverse-video t))
"Face for candidate number in mode-line when Helm is suspended."
:group 'helm-faces)
(defface helm-selection
`((((type tty pc))
,@(and (>= emacs-major-version 27) '(:extend t))
:inherit isearch)
(((background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "ForestGreen"
:distant-foreground "black")
(((background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "#b5ffd1"
:distant-foreground "black"))
"Face for currently selected item in the Helm buffer."
:group 'helm-faces)
(defface helm-separator
`((((background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "red")
(((background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "#ffbfb5"))
"Face for multiline source separator."
:group 'helm-faces)
(defface helm-action
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:underline t))
"Face for action lines in the Helm action buffer."
:group 'helm-faces)
(defface helm-prefarg
`((((background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "green")
(((background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "red"))
"Face for showing prefix arg in mode-line."
:group 'helm-faces)
(defface helm-match
`((((background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "#b00000")
(((background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "gold1"))
"Face used to highlight matches."
:group 'helm-faces)
(defface helm-header-line-left-margin
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "black" :background "yellow"))
"Face used to highlight helm-header sign in left-margin.
This face is used only when using `helm-echo-input-in-header-line' and pattern
is wider then screen."
:group 'helm-faces)
(defface helm-minibuffer-prompt
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit minibuffer-prompt))
"Face used for the minibuffer/headline prompt (such as Pattern:) in Helm."
:group 'helm-faces)
(defface helm-eob-line
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit default))
"Face for empty line at end of sources in the Helm buffer.
Allow specifying the height of this line."
:group 'helm-faces)
(defface helm-mark-prefix
`((t :inherit default))
"Face for string `helm-visible-mark-prefix'."
:group 'helm-faces)
(defface helm-dim-prompt
`((((class color) (min-colors 88) (background dark))
:foreground "DimGray")
(t :inherit shadow))
"Face used for shadowing prompt while updating."
:group 'helm-faces)
;;; Variables.
;;
;;
(defvar helm-selection-overlay nil
"Overlay used to highlight the currently selected item.")
(defvar helm-async-processes nil
"List of information about asynchronous processes managed by Helm.")
(defvar helm-before-initialize-hook nil
"Runs before Helm initialization.
This hook runs before init functions in `helm-sources', which is
before creation of `helm-buffer'. Set local variables for
`helm-buffer' that need a value from `current-buffer' with
`helm-set-local-variable'.")
(defvar helm-after-initialize-hook nil
"Runs after Helm initialization.
This hook runs after `helm-buffer' is created but not from
`helm-buffer'. The hook needs to specify in which buffer to
run.")
(defvaralias 'helm-update-hook 'helm-after-update-hook)
(make-obsolete-variable 'helm-update-hook 'helm-after-update-hook "1.9.9")
(defvar helm-after-update-hook nil
"Runs after updating the Helm buffer with the new input pattern.")
(defvar helm-before-update-hook nil
"Runs before updating the Helm buffer with the new input pattern.")
(defvar helm-cleanup-hook nil
"Runs after exiting the minibuffer and before performing an
action.
This hook runs even if Helm exits the minibuffer abnormally (e.g.
via `helm-keyboard-quit').")
(defvar helm-select-action-hook nil
"Runs when opening the action buffer.")
(defvar helm-before-action-hook nil
"Runs before executing action.
Unlike `helm-cleanup-hook', this hook runs before Helm closes the
minibuffer and also before performing an action.")
(defvar helm-after-action-hook nil
"Runs after executing action.")
(defvar helm-exit-minibuffer-hook nil
"Runs just before exiting the minibuffer.
This hook runs when Helm exits the minibuffer normally (e.g., via
candidate selection), but does NOT run if Helm exits the
minibuffer abnormally (e.g. via `helm-keyboard-quit').")
(defvar helm-after-persistent-action-hook nil
"Runs after executing persistent action.")
(defvar helm-move-selection-before-hook nil
"Runs before moving selection in `helm-buffer'.")
(defvar helm-move-selection-after-hook nil
"Runs after moving selection in `helm-buffer'.")
(defvar helm-after-preselection-hook nil
"Runs after pre-selection in `helm-buffer'.")
(defvar helm-window-configuration-hook nil
"Runs when switching to and from the action buffer.
Should run also at end of `helm-display-function'.")
(defvar helm-execute-action-at-once-if-one nil
"When non-nil execute the default action and then exit if only one candidate.
If symbol \\='current-source is given as value exit if only one
candidate in current source. This variable accepts a function
with no args that should returns a boolean value or \\='current-source.")
(defvar helm-quit-if-no-candidate nil
"When non-nil, quit if there are no candidates.
This variable accepts a function.")
(defvar helm-debug-function #'helm-default-debug-function
"A Function that returns a list of values to print in `helm-debug-output' buffer.")
(defvar helm-debug-output-buffer "*Helm Debug*")
(defvar helm-debug-buffer "*Debug Helm Log*")
(defvar helm-debug nil
"If non-nil, write log message to `helm-debug-buffer'.
Default is nil, which disables writing log messages because the
size of `helm-debug-buffer' grows quickly.")
(defvar helm-mode-line-string "\
\\\
\\[helm-help]:Help \
\\[helm-select-action]:Act \
\\[helm-maybe-exit-minibuffer]/\
f1..f12:NthAct \
\\[helm-toggle-suspend-update]:Tog.suspend \
\\[helm-customize-group]:Conf"
"Help string displayed by Helm in the mode-line.
It is either a string or a list of two string arguments where the
first string is the name and the second string is displayed in
the mode-line. When nil, it defaults to `mode-line-format'.")
(defvar helm-minibuffer-set-up-hook '(helm-hide-minibuffer-maybe)
"Hook that runs at minibuffer initialization.
A hook useful for modifying minibuffer settings in Helm.
Uses `helm-hide-minibuffer-maybe' by default which hide minibuffer contents with
header-line contents when `helm-echo-input-in-header-line' is non nil.")
(defvar helm-help-message
"* Helm Generic Help
** Basics
To navigate in this Help buffer see [[Helm help][here]].
Helm narrows down the list of candidates as you type a filter
pattern. See [[Matching in Helm][Matching in Helm]].
Helm accepts multiple space-separated patterns, each pattern can
be negated with \"!\".
Helm also supports fuzzy matching in some places when specified,
you will find several variables to enable fuzzy matching in
diverse [[Helm sources][sources]], see [[https://github.com/emacs-helm/helm/wiki/Fuzzy-matching][fuzzy-matching]] in helm-wiki for more infos.
Helm generally uses familiar Emacs keys to navigate the list.
Here follow some of the less obvious bindings:
- `\\\\[helm-maybe-exit-minibuffer]' selects the
candidate from the list, executes the default action upon exiting
the Helm session.
- `\\\\[helm-execute-persistent-action]' executes the
default action but without exiting the Helm session. Not all
sources support this.
- `\\\\[helm-select-action]' displays a list of actions
available on current candidate or all marked candidates. The
default binding is ordinarily used for completion, but that
would be redundant since Helm completes upon every character
entered in the prompt. See [[https://github.com/emacs-helm/helm/wiki#helm-completion-vs-emacs-completion][Helm wiki]].
Note: In addition to the default actions list, additional actions
appear depending on the type of the selected candidate(s). They
are called filtered actions.
** Helm sources
Helm uses what's called sources to provide different kinds of
completions. Each Helm session can handle one or more source. A
source is an alist object which is build from various classes,
see [[Writing your own Helm sources][here]] and [[https://github.com/emacs-helm/helm/wiki/Developing#creating-a-source][Helm wiki]] for more infos.
*** Configure sources
You will find in Helm sources already built and bound to a
variable called generally `helm-source-'. In this case
it is an alist and you can change the attributes (keys) values
using `helm-set-attr' function in your configuration. Of course
you have to ensure before calling `helm-set-attr' that the file
containing source is loaded, e.g. with `with-eval-after-load'. Of
course you can also completely redefine the source but this is
generally not elegant as it duplicate for its most part code
already defined in Helm.
You will find also sources that are not built and even not bound
to any variables because they are rebuilded at each start of a
Helm session. In this case you can add a defmethod called
`helm-setup-user-source' to your config:
#+begin_src elisp
(cl-defmethod helm-setup-user-source ((source helm-moccur-class))
(setf (slot-value source 'follow) -1))
#+end_src
See
[[https://github.com/emacs-helm/helm/wiki/FAQ#why-is-a-customizable-helm-source-nil][here]]
for more infos, and for more complex examples of configuration
[[https://github.com/thierryvolpiatto/emacs-tv-config/blob/master/init-helm.el#L340][here]].
** Modify keybindings in Helm
Helm main keymap is `helm-map', all keys bound in this map apply
to all Helm sources. However, most sources have their own keymap,
with each binding overriding its counterpart in `helm-map', you
can see all bindings in effect in the [[Commands][Commands]]
section (available only if the source has its own keymap and
documentation of course).
** Matching in Helm
All that you write in minibuffer is interpreted as a regexp or
multiple regexps if separated by a space. This is true for most
sources unless the developer of the source has disabled it or
have choosen to use fuzzy matching. Even if a source has fuzzy
matching enabled, Helm will switch to multi match as soon as it
detects a space in the pattern. It may also switch to multi match
as well if pattern starts with a \"^\" beginning of line sign. In
those cases each pattern separated with space should be a regexp
and not a fuzzy pattern. When using multi match patterns, each
pattern starting with \"!\" is interpreted as a negation i.e.
match everything but this.
** Moving selection to a specific candidate
Once you found the candidate you were searching by narrowing candidates,
you may want to keep the selection on this candidate after deleting
minibuffer contents and showing the whole list of candidates, this is
useful for example when examining and searching git log or similar. To
achieve this, ensure all candidates are shown at startup or at least
enough candidates to be sure your candidate is not beyond candidate-number-limit,
you can use \\\\[helm-show-all-candidates-in-source] for this with a prefix arg or a numeric prefix arg.
Once this is done narrow down your list by typing in minibuffer, once the
selection is on the candidate you want to keep, hit C-u \\\\[helm-delete-minibuffer-contents].
Another way to achieve this is to mark the candidate, then delete minibuffer
contents with \\\\[helm-delete-minibuffer-contents] and reach back the mark with \\\\[helm-next-visible-mark].
*** Completion-styles
UPDATE: At version 3.8.0 Helm default is now to NOT use
`completion-styles' i.e. now `helm-completion-style' default to
'helm and no more to 'emacs.
If you want to use `completion-styles' in Helm customize
`helm-completion-style' to 'emacs.
Helm generally fetches its candidates with the :candidates
function up to `helm-candidate-number-limit' and then applies
match functions to these candidates according to `helm-pattern'.
But Helm allows matching candidates directly from the :candidates
function using its own `completion-styles'.
Helm provides 'helm completion style but also 'helm-flex
completion style for Emacs<27 that don't have 'flex completion
style, otherwise (emacs-27) 'flex completion style is used to
provide fuzzy aka flex completion.
When using helm-fuzzy as `helm-completion-style' helm use its own
fuzzy implementation which have nothing to do with emacs `flex'
style.
Any Helm sources can use `completion-styles'
by using :match-dynamic slot and building their :candidates
function with `helm-dynamic-completion'.
Example:
#+begin_src elisp
(helm :sources (helm-build-sync-source \"test\"
:candidates (helm-dynamic-completion
'(foo bar baz foab)
'symbolp)
:match-dynamic t)
:buffer \"*helm test*\")
#+end_src
By default Helm sets up `completion-styles' and always adds 'helm
to it. However the flex completion styles are not added. This is
up to the user if she wants to have such completion to enable
this.
As specified above use 'flex for emacs-27 and 'helm-flex for
emacs-26. Anyway, 'helm-flex is not provided in
`completion-styles-alist' if 'flex is present.
Finally Helm provides two user variables to control
`completion-styles' usage: `helm-completion-style' and
`helm-completion-styles-alist'. Both variables are customizable.
The former allows retrieving previous Helm behavior if needed, by
setting it to `helm' or `helm-fuzzy', default being `emacs' which
allows dynamic completion and usage of `completion-styles'. The
second allows setting `helm-completion-style' per mode and also
specifying `completion-styles' per mode (see its docstring). Note
that these two variables take effect only in helm-mode i.e. in
all that uses `completion-read' or `completion-in-region', IOW all
helmized commands. File completion in `read-file-name' family
doesn't obey completion-styles and has its own file completion
implementation. Native Helm commands using `completion-styles'
doesn't obey `helm-completion-style' and
`helm-completion-styles-alist' (e.g., helm-M-x).
Also for a better control of styles in native Helm sources (not
helmized by helm-mode) using :match-dynamic,
`helm-dynamic-completion' provides a STYLES argument that allows
specifying explicitely styles for this source.
NOTE: Some old completion styles are not working fine with Helm
and are disabled by default in
`helm-blacklist-completion-styles'. They are anyway not useful in
Helm because 'helm style supersedes these styles.
** Helm mode
`helm-mode' toggles Helm completion in native Emacs functions, so
when you turn `helm-mode' on, commands like `switch-to-buffer'
will use Helm completion instead of the usual Emacs completion
buffer.
*** What gets or does not get \"helmized\" when `helm-mode' is enabled?
Helm provides generic completion on all Emacs functions using
`completing-read', `completion-in-region' and their derivatives,
e.g. `read-file-name'. Helm exposes a user variable to control
which function to use for a specific Emacs command:
`helm-completing-read-handlers-alist'. If the function for a
specific command is nil, it turns off Helm completion. See the
variable documentation for more infos.
*** Helm functions vs helmized Emacs functions
While there are Helm functions that perform the same completion
as other helmized Emacs functions, e.g. `switch-to-buffer' and
`helm-buffers-list', the native Helm functions like
`helm-buffers-list' can receive new features that allow marking
candidates, have several actions, etc. Whereas the helmized Emacs
functions only have Helm completion, Emacs can provide no more
than one action for this function. This is the intended behavior.
Generally you are better off using the native Helm command than
the helmized Emacs equivalent.
*** Completion behavior with Helm and completion-at-point
Helm is NOT completing dynamically. That means that when you are
completing some text at point, completion is done against this
text and subsequent characters you add AFTER this text. This
allows you to use matching methods provided by Helm, that is multi
matching or fuzzy matching (see [[Matching in Helm][Matching in
Helm]]).
Completion is not done dynamically (against `helm-pattern')
because backend functions (i.e. `completion-at-point-functions')
are not aware of Helm matching methods.
By behaving like this, the benefit is that you can fully use Helm
matching methods but you can't start a full completion against a
prefix different than the initial text you have at point. Helm
warns you against this by colorizing the initial input and sends
a user-error message when trying to delete backward text beyond
this limit at first hit on DEL. A second hit on DEL within a
short delay (1s) quits Helm and delete-backward char in
current-buffer.
** Helm help
\\[helm-documentation]: Show all Helm documentations concatenated
in one org file.
From a Helm session, just hit \\\\[helm-help] to have
the documentation for the current source followed by the global
Helm documentation.
While in the help buffer, most of the Emacs regular key bindings
are available; the most important ones are shown in minibuffer.
However, due to implementation restrictions, no regular Emacs
keymap is used (it runs in a loop when reading the help buffer).
Only simple bindings are available and they are defined in
`helm-help-hkmap', which is a simple alist of (key . function).
You can define or redefine bindings in help with
`helm-help-define-key' or by adding/removing entries directly in
`helm-help-hkmap'.
See `helm-help-hkmap' for restrictions on bindings and functions.
The documentation of default bindings are:
| Key | Alternative keys | Command |
|-----------+------------------+---------------------|
| C-v | Space next | Scroll up |
| M-v | b prior | Scroll down |
| C-s | | Isearch forward |
| C-r | | Isearch backward |
| C-a | | Beginning of line |
| C-e | | End of line |
| C-f | right | Forward char |
| C-b | left | Backward char |
| C-n | down | Next line |
| C-p | up | Previous line |
| M-a | | Backward sentence |
| M-e | | Forward sentence |
| M-f | | Forward word |
| M-b | | Backward word |
| M-> | | End of buffer |
| M-< | | Beginning of buffer |
| C- | | Toggle mark |
| C-M-SPACE | | Mark sexp |
| RET | | Follow org link |
| C-% | | Push org mark |
| C-& | | Goto org mark-ring |
| TAB | | Org cycle |
| M- | | Toggle visibility |
| M-w | | Copy region |
| q | | Quit |
** Customize Helm
Helm provides a lot of user variables for extensive customization.
From any Helm session, type \\\\[helm-customize-group]
to jump to the current source `custom' group. Helm also has a
special group for faces you can access via `M-x customize-group
RET helm-faces'.
Note: Some sources may not have their group set and default to
the `helm' group.
** Display Helm in windows and frames
You can display the Helm completion buffer in many different
window configurations, see the custom interface to discover the
different windows configurations available (See [[Customize Helm][Customize Helm]] to jump to custom interface).
When using Emacs in a graphic display (i.e. not in a terminal) you can as
well display your Helm buffers in separated frames globally for
all Helm commands or separately for specific Helm commands.
See `helm-display-function' and `helm-commands-using-frame'.
See also [[https://github.com/emacs-helm/helm/wiki/frame][helm wiki]] for more infos.
There is a variable to allow reusing frame instead of deleting
and creating a new one at each session, see `helm-display-buffer-reuse-frame'.
Normally you don't have to use this, it have been made to workaround
slow frame popup in Emacs-26, to workaround this slowness in Emacs-26 use instead
#+begin_src elisp
(when (= emacs-major-version 26)
(setq x-wait-for-event-timeout nil))
#+end_src
WARNING:
There is a package called Posframe and also one called Helm-posframe,
you DO NOT need these packages to display helm buffers in frames.
Thus Posframe package use child frames which have no minibuffers
and are by the way not compatible with Helm.
** Helm's basic operations and default key bindings
| Key| Command|
|----+--------|
| |
| \\[helm-previous-line]| Previous line |
| \\[helm-next-line]| Next line |
| \\[helm-scroll-up]| Scroll up |
| \\[helm-scroll-down]| Scroll down |
| \\[helm-scroll-other-window]| Scroll up other-window |
| \\[helm-scroll-other-window-down]| Scroll down other-window |
| \\[helm-maybe-exit-minibuffer]| Execute first (default) action / Select [1] |
| \\[helm-beginning-of-buffer]| Goto beginning of buffer |
| \\[helm-end-of-buffer]| Goto end of buffer |
| \\[helm-select-action]| Show actions menu |
| \\[helm-previous-source]| Previous source |
| \\[helm-next-source]| Next source |
| \\[helm-delete-minibuffer-contents]| Delete pattern (with prefix arg delete from point to end or all [2]) |
| \\[helm-execute-persistent-action]| Persistent action (Execute and keep Helm session) |
|\\[helm-toggle-resplit-and-swap-windows]|Rotate or swap windows. |
|\\[helm-exchange-minibuffer-and-header-line]|Exchange minibuffer and header-line. |
|\\[helm-quit-and-find-file]|Drop into `helm-find-files'. |
|\\[helm-kill-selection-and-quit]|Kill display value of candidate and quit (with prefix arg, kill the real value). |
|\\[helm-yank-selection]|Yank current selection into pattern. |
|\\[helm-insert-or-copy]|Insert or copy marked candidates (C-u) . |
|\\[helm-follow-mode]|Toggle automatic execution of persistent action. |
|\\[helm-follow-action-forward]|Run persistent action then select next line. |
|\\[helm-follow-action-backward]|Run persistent action then select previous line. |
|\\[helm-refresh]|Recalculate and redisplay candidates. |
|\\[helm-toggle-suspend-update]|Toggle candidate updates. |
\[1] Behavior may change depending context in some source e.g. `helm-find-files'.
\[2] Delete from point to end or all depending on the value of
`helm-delete-minibuffer-contents-from-point'. When the cursor is at end
of minibuffer and a prefix arg is given, delete the whole contents of
minibuffer and keep selection as well when possible (depends of
candidate-number-limit) when helm update to the whole list of
candidates. This depends also of requires-pattern i.e. you may have a
source that display nothing when there is an input < to requires-pattern.
NOTE: Any of these bindings are from `helm-map' and may be
overriten by the map specific to the current source in use (each
source can have its own keymap).
** The actions menu
You can display the action menu in the same window
as helm candidates (default) or in a side window according to
`helm-show-action-window-other-window' value.
When the action menu popup, the helm prompt is used to narrow
down this menu, no more candidates.
When `helm-allow-mouse' is non nil, you can use as well
mouse-3 (right click) in the candidate zone to select actions
with the mouse once your candidate is selected.
** Action transformers
You may be surprized to see your actions list changing depending
on the context. This happen when a source has an action
transformer function which checks the current selected candidate
and adds specific actions for this candidate.
** Shortcuts for n-th first actions
f1-f12: Execute n-th action where n is 1 to 12.
** Shortcuts for executing the default action on the n-th candidate
Helm does not display line numbers by default, with Emacs-26+ you
can enable it permanently in all helm buffers with:
(add-hook 'helm-after-initialize-hook 'helm-init-relative-display-line-numbers)
You can also toggle line numbers with
\\\\[helm-display-line-numbers-mode] in current Helm
buffer.
Of course when enabling `global-display-line-numbers-mode' Helm
buffers will have line numbers as well. \(Don't forget to
customize `display-line-numbers-type' to relative).
In Emacs versions < to 26 you will have to use
[[https://github.com/coldnew/linum-relative][linum-relative]]
package and `helm-linum-relative-mode'.
Then when line numbers are enabled with one of the methods above
the following keys are available([1]):
C-x : Execute default action on the n-th candidate before
currently selected candidate.
C-c : Execute default action on the n-th candidate after
current selected candidate.
\"n\" is limited to 1-9. For larger jumps use other navigation
keys.
\[1] Note that the key bindings are always available even if line
numbers are not displayed. They are just useless in this case.
** Mouse control in Helm
A basic support for the mouse is provided when the user sets
`helm-allow-mouse' to non-nil.
- mouse-1 selects the candidate.
- mouse-2 executes the default action on selected candidate.
- mouse-3 pops up the action menu.
Note: When mouse control is enabled in Helm, it also lets you
click around and lose the minibuffer focus: you'll have to click
on the Helm buffer or the minibuffer to retrieve control of your
Helm session.
** Marked candidates
You can mark candidates to execute an action on all of them
instead of the current selected candidate only. (See bindings
below.) Most Helm actions operate on marked candidates unless
candidate-marking is explicitely forbidden for a specific source.
- To mark/unmark a candidate, use
\\[helm-toggle-visible-mark]. (See bindings below.) With a
numeric prefix arg mark ARG candidates forward, if ARG is
negative mark ARG candidates backward.
- To mark all visible unmarked candidates at once in current
source use \\[helm-mark-all]. With a prefix argument, mark all
candidates in all sources.
- To unmark all visible marked candidates at once use
\\[helm-unmark-all].
- To mark/unmark all candidates at once use
\\[helm-toggle-all-marks]. With a prefix argument, mark/unmark
all candidates in all sources.
Note: When multiple candidates are selected across different
sources, only the candidates of the current source will be used
when executing most actions (as different sources can have
different actions). Some actions support multi-source marking
however.
** Follow candidates
When `helm-follow-mode' is on (\\\\[helm-follow-mode]
to toggle it), moving up and down Helm session or updating the
list of candidates will automatically execute the
persistent-action as specified for the current source.
If `helm-follow-mode-persistent' is non-nil, the state of the
mode will be restored for the following Helm sessions.
If you just want to follow candidates occasionally without
enabling `helm-follow-mode', you can use
\\\\[helm-follow-action-forward] or
\\[helm-follow-action-backward] instead. Conversely, when
`helm-follow-mode' is enabled, those commands go to previous/next
line without executing the persistent action.
** Special yes, no or yes for all answers
You may be prompted in the minibuffer to answer by [y,n,!,q] in
some places for confirmation.
- y mean yes
- no mean no
- ! mean yes for all
- q mean quit or abort current operation.
When using ! you will not be prompted for the same thing in
current operation any more, e.g. file deletion, file copy etc...
** Moving in `helm-buffer'
You can move in `helm-buffer' with the usual commands used in
Emacs: \(\\\\[helm-next-line],
\\\\[helm-previous-line], etc. See above basic
commands. When `helm-buffer' contains more than one source,
change source with \\\\[helm-next-source] and
\\[helm-previous-source].
Note: When reaching the end of a source,
\\\\[helm-next-line] will *not* go to the next source
when variable `helm-move-to-line-cycle-in-source' is non-nil, so
you will have to use \\\\[helm-next-source] and
\\[helm-previous-source].
** Resume previous session from current Helm session
You can use `C-c n' (`helm-run-cycle-resume') to cycle in
resumables sources. `C-c n' is a special key set with
`helm-define-key-with-subkeys' which, after pressing it, allows
you to keep cycling with further `n'.
Tip: You can bound the same key in `global-map' to
`helm-cycle-resume' with `helm-define-key-with-subkeys' to
let you transparently cycle sessions, Helm fired up or not.
You can also bind the cycling commands to single key
presses (e.g., `S-') this time with a simple
`define-key'. (Note that `S-' is not available in
terminals.)
Note: `helm-define-key-with-subkeys' is available only once Helm
is loaded.
You can also use
\\\\[helm-resume-previous-session-after-quit] to resume
the previous session, or
\\\\[helm-resume-list-buffers-after-quit] to have
completion on all resumable buffers.
** Global commands
*** Resume Helm session from outside Helm
\\\\[helm-resume] revives the last Helm session.
Binding a key to this command will greatly improve Helm
interactivity, e.g. when quitting Helm accidentally.
You can call \\\\[helm-resume] with a prefix argument
to choose \(with completion!) which session you'd like to resume.
You can also cycle in these sources with `helm-cycle-resume' (see
above).
** Debugging Helm
Helm exposes the special variable `helm-debug': setting it to
non-nil will enable Helm logging in a special outline-mode
buffer. Helm resets the variable to nil at the end of each
session.
For convenience, \\\\[helm-enable-or-switch-to-debug]
allows you to turn on debugging for this session only. To avoid
accumulating log entries while you are typing patterns, you can
use \\\\[helm-toggle-suspend-update] to turn off
updating. When you are ready turn it on again to resume logging.
Once you exit your Helm session you can access the debug buffer
with `helm-debug-open-last-log'.
Note: Be aware that Helm log buffers grow really fast, so use
`helm-debug' only when needed.
** Writing your own Helm sources
Writing simple sources for your own usage is easy. When calling
the `helm' function, the sources are added the :sources slot
which can be a symbol or a list of sources. Sources can be built
with different EIEIO classes depending on what you want to do. To
simplify this, several `helm-build-*' macros are provided. Below
there are simple examples to start with.
We will not go further here, see
[[https://github.com/emacs-helm/helm/wiki/Developing][Helm wiki]]
and the source code for more information and more complex
examples.
#+begin_src elisp
;; Candidates are stored in a list.
(helm :sources (helm-build-sync-source \"test\"
;; A function can be used as well
;; to provide candidates.
:candidates '(\"foo\" \"bar\" \"baz\"))
:buffer \"*helm test*\")
;; Candidates are stored in a buffer.
;; Generally faster but doesn't allow a dynamic updating
;; of the candidates list i.e the list is fixed on start.
(helm :sources (helm-build-in-buffer-source \"test\"
:data '(\"foo\" \"bar\" \"baz\"))
:buffer \"*helm test*\")
#+end_src
** Helm Map
\\{helm-map}"
"Message string containing detailed help for `helm'.
It also accepts function or variable symbol.")
(defvar helm-autoresize-mode) ;; Undefined in `helm-default-display-buffer'.
(defvar helm-async-outer-limit-hook nil
"Run in async sources when process output is out of `candidate-number-limit'.
Should be set locally to `helm-buffer' with `helm-set-local-variable'.")
(defvar helm-quit-hook nil
"A hook that runs when quitting Helm.")
(defvar helm-resume-after-hook nil
"A hook that runs after resuming a Helm session.
The hook should takes one arg SOURCES.")
(defvar helm-help-buffer-name "*Helm Help*"
"The name of helm help buffer.")
;; See bug#2503.
(defvar helm-process-output-split-string-separator "\n"
"Separator to use when splitting helm async output.")
(defvar helm-last-query ""
"The value of `helm-pattern' is stored here exit or quit.")
(defvar helm-dim-prompt-on-update nil
"Dim prompt when updating.
Do not set this globally. Do not use this in async sources or in
commands using an async source in their sources.
Use this either let-bounded or helm buffer local.")
;; Utility: logging
(defun helm-log (from format-string &rest args)
"Log message if `helm-debug' is non-nil.
Messages are written to the `helm-debug-buffer' buffer.
FROM is the place from where it is called.
Argument FORMAT-STRING is a string to use with `format'.
Use optional arguments ARGS like in `format'."
(when helm-debug
(with-current-buffer (get-buffer-create helm-debug-buffer)
(outline-mode)
(buffer-disable-undo)
(let ((inhibit-read-only t))
(goto-char (point-max))
(insert (let ((tm (current-time)))
(format (concat (if (string-match "Start session" format-string)
"* " "** ")
"%s.%06d (%s)\n %s\n")
(format-time-string "%H:%M:%S" tm)
(nth 2 tm)
from
(apply #'format (cons format-string args)))))))))
(defun helm-log-run-hook (from hook)
"Run HOOK like `run-hooks' and log these actions to Helm log buffer.
FROM is the place from where it is called."
(helm-log from "Executing %s with value = %S" hook (symbol-value hook))
(helm-log from "Executing %s with global value = %S" hook (default-value hook))
(run-hooks hook)
(helm-log from "executed %s" hook))
(defun helm-log-error (from &rest args)
"Accumulate error messages into `helm-issued-errors'.
FROM is the place from where it is called.
ARGS are args given to `format'.
E.g. (helm-log-error \"Error %s: %s\" (car err) (cdr err))."
(apply 'helm-log from (concat "ERROR: " (car args)) (cdr args))
(let ((msg (apply 'format args)))
(unless (member msg helm-issued-errors)
(cl-pushnew msg helm-issued-errors :test 'equal))))
;;;###autoload
(defun helm-debug-open-last-log ()
"Open Helm log file or buffer of last Helm session."
(interactive)
(if helm--last-log-file
(progn
(find-file helm--last-log-file)
(outline-mode) (view-mode 1) (visual-line-mode 1))
(switch-to-buffer helm-debug-buffer)
(view-mode 1) (visual-line-mode 1)))
(defun helm-print-error-messages ()
"Print error messages in `helm-issued-errors'."
(and helm-issued-errors
(message "Helm issued errors: %s"
(mapconcat 'identity (reverse helm-issued-errors) "\n"))))
;; Test tools
(defmacro with-helm-time-after-update (&rest body)
(helm-with-gensyms (start-time time-elapsed)
`(let ((,start-time (float-time)) ,time-elapsed)
(add-hook 'helm-after-update-hook
(lambda ()
(setq ,time-elapsed (- (float-time) ,start-time))
(keyboard-quit)))
(unwind-protect ,@body
(remove-hook 'helm-after-update-hook
(lambda ()
(setq ,time-elapsed (- (float-time) ,start-time))
(keyboard-quit))))
,time-elapsed)))
;; Helm API
(defmacro with-helm-default-directory (directory &rest body)
(declare (indent 1) (debug t))
`(let ((default-directory (or (and ,directory
(file-name-as-directory ,directory))
default-directory)))
,@body))
(defun helm-default-directory ()
"Return the local value of `default-directory' in `helm-buffer'."
(buffer-local-value 'default-directory (get-buffer helm-buffer)))
(defmacro with-helm-temp-hook (hook &rest body)
"Execute temporarily BODY as a function for HOOK."
(declare (indent 1) (debug t))
`(letrec ((helm--hook (lambda ()
(unwind-protect
(progn ,@body)
(remove-hook ,hook helm--hook)))))
(push (cons helm--hook ,hook) helm--temp-hooks)
(add-hook ,hook helm--hook)))
(defmacro with-helm-after-update-hook (&rest body)
"Execute BODY at end of `helm-update'."
(declare (indent 0) (debug t))
`(with-helm-temp-hook 'helm-after-update-hook ,@body))
(defmacro with-helm-alive-p (&rest body)
"Return error when BODY run outside Helm context."
(declare (indent 0) (debug t))
`(progn
(if helm-alive-p
(progn ,@body)
(error "Running helm command outside of context"))))
(defmacro with-helm-in-frame (&rest body)
"Execute Helm function in BODY displaying `helm-buffer' in separate frame."
(declare (debug t) (indent 0))
`(progn
(helm-set-local-variable
'helm-display-function 'helm-display-buffer-in-own-frame)
,@body))
(defmacro helm-make-command-from-action (symbol doc action &rest body)
"Make a command SYMBOL from ACTION with docstring DOC.
The command SYMBOL will quit helm before execute.
Argument ACTION should be an existing helm action.
BODY form will run before calling action.
Example:
(helm-make-command-from-action foo-command
\"Docstring\"
\\='foo-action
(run body))
will produce a command like this:
(defun foo-command ()
\"docstring\"
(interactive)
(with-helm-alive-p
(run body)
(helm-exit-and-execute-action \\='foo-action)))
And automatically put the symbol \\='helm-only on SYMBOL."
(declare (indent defun) (debug t))
`(progn
(defun ,symbol ()
,doc
(interactive)
(with-helm-alive-p
(progn ,@body)
(helm-exit-and-execute-action ,action)))
(put ',symbol 'helm-only t)))
(defmacro helm-make-persistent-command-from-action (symbol doc psymbol action)
"Make a persistent command SYMBOL bound to PSYMBOL from ACTION."
(declare (indent defun) (debug t))
`(progn
(defun ,symbol ()
,doc
(interactive)
(with-helm-alive-p
(helm-set-attr ,psymbol (cons ,action 'never-split))
(helm-execute-persistent-action ,psymbol)))
(put ',symbol 'helm-only t)))
;;; helm-attributes
;;
(defun helm-get-attr (attribute-name &optional source compute)
"Get the value of ATTRIBUTE-NAME of SRC.
If SRC is omitted, use current source.
If COMPUTE is non-`nil' compute value of ATTRIBUTE-NAME with
`helm-interpret-value'. COMPUTE can have also \\='ignorefn as value,
in this case `helm-interpret-value' will return a function as
value unchanged, but will eval a symbol which is bound.
You can use `setf' to modify value of ATTRIBUTE-NAME unless
COMPUTE is specified, if attribute ATTRIBUTE-NAME is not found in
SOURCE `setf' will create new attribute ATTRIBUTE-NAME with
specified value. You can also use `helm-set-attr' to modify
ATTRIBUTE-NAME."
(declare (gv-setter
(lambda (val)
`(let* ((src (or ,source (helm-get-current-source)))
(attr (assq ,attribute-name src)))
(cl-assert (null ,compute) nil
"`setf' can't set the computed value of attribute `%s'"
,attribute-name)
(if attr
(setcdr attr ,val)
(and (setcdr src (cons (cons ,attribute-name ,val)
(cdr src)))
,val))))))
(let ((src (or source (helm-get-current-source))))
(helm-aif (assq attribute-name src)
(if compute
(helm-interpret-value (cdr it) src compute)
(cdr it)))))
(defalias 'helm-attr 'helm-get-attr)
(make-obsolete 'helm-attr 'helm-get-attr "3.7.0")
(cl-defun helm-set-attr (attribute-name value
&optional
(src (helm-get-current-source)))
"Set the value of ATTRIBUTE-NAME of source SRC to VALUE.
If ATTRIBUTE-NAME doesn't exists in source it is created with
value VALUE. If SRC is omitted, use current source. If operation
succeed, return value, otherwise nil.
Using this function is same as using `setf' on `helm-get-attr'."
(setf (helm-get-attr attribute-name src) value))
(defalias 'helm-attrset 'helm-set-attr)
(make-obsolete 'helm-attrset 'helm-set-attr "3.7.0")
(defun helm-add-action-to-source (name fn source &optional index)
"Add new action NAME linked to function FN to SOURCE.
Function FN should be a valid function that takes one arg i.e.
candidate, argument NAME is a string that will appear in action
menu and SOURCE should be an existing helm source already loaded.
If INDEX is specified, action is added to the action list at INDEX,
otherwise added at end.
This allows users to add specific actions to an existing source
without modifying source code."
(let ((actions (helm-get-attr 'action source 'ignorefn))
(new-action (list (cons name fn))))
(when (functionp actions)
(setq actions (list (cons "Default action" actions))))
(helm-set-attr 'action
(if index
(helm-append-at-nth actions new-action index)
(append actions new-action))
source)))
(defun helm-delete-action-from-source (action-or-name source)
"Delete ACTION-OR-NAME from SOURCE.
ACTION-OR-NAME can either be the name of action or the symbol
function associated to name."
(let* ((actions (helm-get-attr 'action source 'ignorefn))
(del-action (if (symbolp action-or-name)
(rassoc action-or-name actions)
(assoc action-or-name actions))))
(helm-set-attr 'action (delete del-action actions) source)))
(cl-defun helm-add-action-to-source-if (name fn source predicate
&optional (index 4) test-only)
"Add new action NAME linked to function FN to SOURCE.
Action NAME will be available when the current candidate matches
PREDICATE.
This function adds an entry in the `action-transformer' attribute
of SOURCE (or creates one if not found).
Function PREDICATE must take one candidate as arg.
Function FN should be a valid function that takes one arg i.e.
candidate, argument NAME is a string that will appear in action
menu and SOURCE should be an existing Helm source already loaded.
If INDEX is specified, action is added in action list at INDEX.
Value of INDEX should be always >=1, default to 4. This allows
user to add a specific `action-transformer' to an existing source
without modifying source code.
E.g.
Add the action \"Byte compile file async\" linked to function
`async-byte-compile-file' to source `helm-source-find-files' only
when predicate helm-ff-candidates-lisp-p returns non-nil:
\(helm-add-action-to-source-if \"Byte compile file async\"
\\='async-byte-compile-file
helm-source-find-files
\\='helm-ff-candidates-lisp-p)."
(let* ((actions (helm-get-attr 'action source 'ignorefn))
(action-transformers (helm-get-attr 'action-transformer source))
(new-action (list (cons name fn)))
(transformer (lambda (actions _candidate)
(let ((candidate (car (helm-marked-candidates))))
(cond ((funcall predicate candidate)
(helm-append-at-nth
actions new-action index))
(t actions))))))
(when (functionp actions)
(helm-set-attr 'action (list (cons "Default action" actions)) source))
(when (or (symbolp action-transformers) (functionp action-transformers))
(setq action-transformers (list action-transformers)))
(if test-only ; debug
(delq nil (append (list transformer) action-transformers))
(helm-set-attr 'action-transformer
(helm-fast-remove-dups
(delq nil (append (list transformer) action-transformers))
:test 'equal)
source))))
;;; Source filter
;;
(defun helm-set-source-filter (sources)
"Set the value of `helm-source-filter' to SOURCES and update.
This function sets a filter for Helm sources and it may be called
while Helm is running. It can be used to toggle displaying of
sources dynamically. For example, additional keys can be bound
into `helm-map' to display only the file-related results if there
are too many matches from other sources and you're after files
only:
Shift+F shows only file results from some sources:
\(define-key helm-map \"F\" \\='helm-my-show-files-only)
\(defun helm-my-show-files-only ()
(interactive)
(helm-set-source-filter \\='(\"File Name History\"
\"Files from Current Directory\")))
Shift+A shows all results:
\(define-key helm-map \"A\" \\='helm-my-show-all)
\(defun helm-my-show-all ()
(interactive)
(helm-set-source-filter nil))
The -my- part is added to avoid collisions with
existing Helm function names."
(with-helm-buffer
(let ((cur-disp-sel (helm-get-selection nil t)))
(set (make-local-variable 'helm-source-filter)
(helm--normalize-filter-sources sources))
(helm-log "helm-set-source-filter" "helm-source-filter = %S" helm-source-filter)
;; Use force-update to run init/update functions.
(helm-update (and (stringp cur-disp-sel)
(regexp-quote cur-disp-sel))))))
(defun helm--normalize-filter-sources (sources)
(cl-loop for s in sources collect
(cl-typecase s
(symbol (assoc-default 'name (symbol-value s)))
(list (assoc-default 'name s))
(string s))))
(defun helm-set-sources (sources &optional no-init no-update)
"Set SOURCES during `helm' invocation.
If NO-INIT is non-nil, skip executing init functions of SOURCES.
If NO-UPDATE is non-nil, skip executing `helm-update'."
(with-current-buffer helm-buffer
(setq helm-sources (helm-get-sources sources))
(helm-log "helm-set-sources" "helm-sources = %S" helm-sources))
(unless no-init (helm-compute-attr-in-sources 'init))
(unless no-update (helm-update)))
(defun helm-show-all-candidates-in-source (arg)
"Toggle all sources or only current source visibility.
With a prefix arg show all candidates in current source
disregarding candidate-number-limit and with a numeric prefix arg
show ARG number of candidates."
(interactive "P")
(with-helm-alive-p
(with-helm-buffer
(if helm-source-filter
(progn
(setq-local helm-candidate-number-limit
(default-value 'helm-candidate-number-limit))
(helm-set-source-filter nil))
(with-helm-default-directory (helm-default-directory)
(setq-local helm-candidate-number-limit
(helm-acase arg
((guard* (consp arg)) nil)
((guard* (numberp arg)) it)
(t (default-value 'helm-candidate-number-limit))))
(helm-set-source-filter
(list (helm-get-current-source))))))))
(put 'helm-show-all-candidates-in-source 'helm-only t)
(defun helm-display-all-sources ()
"Display all sources previously hidden by `helm-set-source-filter'."
(interactive)
(with-helm-alive-p
(helm-set-source-filter nil)))
(put 'helm-display-all-sources 'helm-only t)
(defun helm-limit-to-sources ()
"Limit sources to display from current session.
This is a toggle command, when hit a second time reset to all sources."
(interactive)
(with-helm-alive-p
(with-helm-buffer
(if (null helm-source-filter)
(when (cdr helm-sources)
(let ((headers (helm-comp-read
"Limit to source(s): "
(mapcar
(lambda (s)
(let* ((name (assoc-default 'name s))
(disp (helm-aif (assoc-default 'header-name s)
(funcall it name) name)))
(cons disp name)))
helm-sources)
:marked-candidates t
:allow-nest t
:buffer "*helm sources*")))
(helm-set-source-filter headers)))
(helm-set-source-filter nil)))))
(put 'helm-limit-to-sources 'helm-only t)
;;; Source infos fns.
;;
(defun helm-get-selection (&optional buffer force-display-part source)
"Return the currently selected candidate from BUFFER.
If BUFFER is nil or unspecified, use `helm-buffer' as default value.
If FORCE-DISPLAY-PART is non-nil, return the display part of candidate.
If FORCE-DISPLAY-PART value is `withprop' the display part of
candidate is returned with its properties.
When FORCE-DISPLAY-PART is nil the real part of candidate is returned.
SOURCE default to current-source when unspecified but it is better to
specify SOURCE when it is already available to avoid to call
`helm-get-current-source' uselessly.
Note that FORCE-DISPLAY-PART when specified takes precedence over
`display-to-real' attribute, that's mean don't use FORCE-DISPLAY-PART
when you want the `display-to-real' function(s) to be applied."
(with-current-buffer (or buffer helm-buffer)
(unless (or (helm-empty-buffer-p (current-buffer))
(helm-pos-header-line-p))
(let* ((beg (overlay-start helm-selection-overlay))
(end (overlay-end helm-selection-overlay))
(disp-fn (if (eq force-display-part 'withprop)
'buffer-substring
'buffer-substring-no-properties))
;; If there is no selection at point, the
;; overlay is at its initial pos, (point-min)
;; (point-min), that's mean the helm-buffer
;; is not empty but have no selection yet,
;; this happen with grep sentinel sending an
;; error message in helm-buffer when no matches.
(disp (unless (= beg end) (funcall disp-fn beg (1- end))))
(src (or source (helm-get-current-source)))
(selection (helm-acond (force-display-part disp)
;; helm-realvalue always takes precedence
;; over display-to-real.
((get-text-property beg 'helm-realvalue) it)
((assoc-default 'display-to-real src)
(helm-apply-functions-from-source source it disp))
(t disp))))
(unless (equal selection "")
(helm-log "helm-get-selection" "selection = %S" selection)
selection)))))
(defun helm-get-actions-from-current-source (&optional source)
"Return the associated action for the selected candidate.
It is a function symbol (sole action) or list
of (action-display . function)."
(unless (helm-empty-buffer-p (helm-buffer-get))
(let* ((src (or source (helm-get-current-source)))
(marked (helm-marked-candidates))
(action-transformer (helm-get-attr 'action-transformer src))
(actions (helm-get-attr 'action src 'ignorefn)))
(if action-transformer
(helm-apply-functions-from-source
src action-transformer actions
;; When there is marked candidates assume the set of
;; candidates user selected contains candidates of the same
;; type so that the actions added by transformer fit with
;; all marked (previously we were looping on each marked
;; but it is too costly for the benefit it brings).
(car marked))
actions))))
(defun helm-get-current-source ()
"Return the source for the current selection.
Return nil when `helm-buffer' is empty."
(or helm-current-source
(with-helm-buffer
(or (get-text-property (point) 'helm-cur-source)
(progn
;; This is needed to not loose selection.
(goto-char (overlay-start helm-selection-overlay))
(let ((header-pos (or (helm-get-previous-header-pos)
(helm-get-next-header-pos))))
;; Return nil when no--candidates.
(when header-pos
(cl-loop with source-name = (save-excursion
(goto-char header-pos)
(helm-current-line-contents))
for source in helm-sources thereis
(and (equal (assoc-default 'name source) source-name)
source)))))))))
(defun helm-run-after-exit (function &rest args)
"Execute FUNCTION with ARGS after exiting Helm.
The action is to call FUNCTION with arguments ARGS.
Unlike `helm-exit-and-execute-action', this can be used
to call non-actions functions with any ARGS or no ARGS at all.
Use this on commands invoked from key bindings, but not on action
functions invoked as action from the action menu, i.e. functions
called with RET."
(helm-kill-async-processes)
(helm-log "helm-run-after-exit" "function = %S" function)
(helm-log "helm-run-after-exit" "args = %S" args)
(helm-exit-and-execute-action
(lambda (_candidate)
(apply function args))))
(defun helm-exit-and-execute-action (action)
"Exit current Helm session and execute ACTION.
Argument ACTION is a function called with one arg (candidate) and
part of the actions of current source.
Use this on commands invoked from key bindings, but not
on action functions invoked as action from the action menu,
i.e. functions called with RET."
;; If ACTION is not an action available in source 'action attribute,
;; return an error. This allow to remove unneeded actions from
;; source that inherit actions from type, note that ACTION have to
;; be bound to a symbol and not to be an anonymous action
;; i.e. lambda or byte-code.
(helm-log "helm-exit-and-execute-action" "Start executing action")
(let ((actions (helm-get-actions-from-current-source)))
(when actions
(cl-assert (or
;; Single actions defined as symbol.
(eq action actions)
;; Compiled lambdas
(byte-code-function-p action)
;; Natively compiled (libgccjit)
(helm-subr-native-elisp-p action)
;; Lambdas (lambdas are no more represented as list in
;; Emacs-29+) Bug#2666.
(and (not (symbolp action)) (functionp action))
;; One of current actions.
(rassq action actions))
nil "No such action `%s' for this source" action)))
(setq helm-saved-action action)
(setq helm-saved-selection (or (helm-get-selection) ""))
(setq helm--executing-helm-action t)
;; When toggling minibuffer and header-line, we want next action
;; inherit this setting.
(helm-set-local-variable 'helm-echo-input-in-header-line
(with-helm-buffer helm-echo-input-in-header-line))
;; Ensure next action use same display function as initial helm-buffer when
;; helm-actions-inherit-frame-settings is non nil.
(when (and helm-actions-inherit-frame-settings
helm--buffer-in-new-frame-p)
(helm-set-local-variable 'helm-display-function
(with-helm-buffer helm-display-function)
'helm--last-frame-parameters
(with-helm-buffer
(helm--get-frame-parameters)))
;; The helm-buffer keeps `helm-display-function' and
;; `helm--get-frame-parameters' values during 0.5 seconds, just
;; the time to execute the possible helm action with those values.
;; If no helm based action run within 0.5 seconds, the next helm
;; session will have to resolve again those variable values.
(run-with-idle-timer 0.5 nil
(lambda () (helm-set-local-variable 'helm-display-function nil
'helm--last-frame-parameters nil))))
(helm-exit-minibuffer))
(defun helm--get-frame-parameters (&optional frame)
(cl-loop with params = (frame-parameters frame)
for p in helm--frame-default-attributes
when (assq p params) collect it))
(defalias 'helm-run-after-quit 'helm-run-after-exit)
(make-obsolete 'helm-run-after-quit 'helm-run-after-exit "1.7.7")
(defalias 'helm-quit-and-execute-action 'helm-exit-and-execute-action)
(make-obsolete 'helm-quit-and-execute-action 'helm-exit-and-execute-action "1.7.7")
(defun helm-interpret-value (value &optional source compute)
"Interpret VALUE as variable, function or literal and return it.
If VALUE is a function, call it with no arguments and return the value
unless COMPUTE value is \\='ignorefn.
If SOURCE compute VALUE for this source.
If VALUE is a variable, return the value.
If VALUE is a symbol, but it is not a function or a variable, cause an error.
Otherwise, return VALUE itself."
(cond ((and source (functionp value) (not (eq compute 'ignorefn)))
(helm-apply-functions-from-source source value))
((and (functionp value) (not (eq compute 'ignorefn)))
(funcall value))
((and (symbolp value) (boundp value))
(symbol-value value))
((and (symbolp value) (not (functionp value)))
(error
"helm-interpret-value: Symbol must be a function or a variable"))
(t
value)))
(defun helm-set-local-variable (&rest args)
"Bind each pair in ARGS locally to `helm-buffer'.
Use this to set local vars before calling helm.
When used from an init or update function
\(i.e. when `helm-force-update' is running) the variables are set
using `make-local-variable' within the `helm-buffer'.
Usage: helm-set-local-variable ([VAR VALUE]...)
Just like `setq' except that the vars are not set sequentially.
IOW Don't use VALUE of previous VAR to set the VALUE of next VAR.
\(fn VAR VALUE ...)"
(if helm--force-updating-p
(with-helm-buffer
(cl-loop for i on args by #'cddr
do (set (make-local-variable (car i)) (cadr i))))
(setq helm--local-variables
(append (cl-loop for i on args by #'cddr
collect (cons (car i) (cadr i)))
helm--local-variables))))
(defun helm--set-local-variables-internal ()
(cl-loop for (var . val) in helm--local-variables
;; If `helm-set-local-variable' is called twice or more
;; on same variable use the last value entered which is
;; the first on stack e.g.
;; (helm-set-local-variable 'helm-foo 1)
;; (helm-set-local-variable 'helm-foo 2)
;; helm--local-variables =>
;; '((helm-foo . 2) (helm-foo. 1))
;; (helm-foo . 2) is retained and (helm-foo . 1)
;; ignored.
unless (memq var computed)
do (set (make-local-variable var) val)
collect var into computed
finally (setq helm--local-variables nil)))
;; API helper
(cl-defun helm-empty-buffer-p (&optional (buffer helm-buffer))
"Check if BUFFER have candidates.
Default value for BUFFER is `helm-buffer'."
(zerop (buffer-size (and buffer (get-buffer buffer)))))
(defun helm-empty-source-p ()
"Check if current source contains candidates.
This could happen when for example the last element of a source
was deleted and the candidates list not updated."
(when (helm-window)
(with-helm-window
(or (helm-empty-buffer-p)
(and (helm-end-of-source-p)
(eq (pos-bol) (pos-eol))
(or
(save-excursion
(forward-line -1)
(helm-pos-header-line-p))
(bobp)))))))
;; Tools
;;
(defun helm-apply-functions-from-source (source functions &rest args)
"From SOURCE apply FUNCTIONS on ARGS.
This function is used to process filter functions. When filter is
a `filtered-candidate-transformer', we pass to ARGS
candidates+source whereas when the filter is
`candidate-transformer' we pass to ARGS candidates only.
This function is also used to process functions called with no
args, e.g. init functions. In this case it is called without
ARGS.
See `helm-process-filtered-candidate-transformer'
`helm-compute-attr-in-sources'
`helm-process-candidate-transformer'.
Arg FUNCTIONS is either a symbol or a list of functions, each
function being applied on ARGS and called on the result of the
precedent function. Return the result of last function call."
(let ((helm--source-name (assoc-default 'name source))
(helm-current-source source)
(funs (if (functionp functions) (list functions) functions)))
(cl-loop with result
for fn in funs
;; In filter functions, ARGS is a list of one or two elements where
;; the first element is the list of candidates and the second
;; a list containing the source.
do (setq result (apply fn args))
when (and args (cdr funs))
;; When more than one fn, set the candidates list to what returns
;; this fn to compute the modified candidates with the next fn
;; and so on.
do (setcar args result)
finally return result)))
(defalias 'helm-funcall-with-source 'helm-apply-functions-from-source)
(make-obsolete 'helm-funcall-with-source 'helm-apply-functions-from-source "2.9.7")
(defun helm-compute-attr-in-sources (attr &optional sources)
"Call the associated function(s) to ATTR for each source if any."
(let ((sources (or (helm-get-sources sources)
;; Fix error no buffer named *helm... by checking
;; if helm-buffer exists.
(and (buffer-live-p (get-buffer (helm-buffer-get)))
;; `helm-sources' are local to helm-buffer.
(with-helm-buffer helm-sources)))))
(when sources
(dolist (source sources)
(helm-aif (assoc-default attr source)
(helm-apply-functions-from-source source it))))))
(defalias 'helm-funcall-foreach 'helm-compute-attr-in-sources)
(make-obsolete 'helm-funcall-foreach 'helm-compute-attr-in-sources "2.9.7")
(defun helm-normalize-sources (sources)
"If SOURCES is only one source, make a list of one element."
(if (or (and sources (symbolp sources))
(and (listp sources) (assq 'name sources)))
(list sources)
sources))
(defun helm-get-candidate-number (&optional in-current-source)
"Return candidates number in `helm-buffer'.
If IN-CURRENT-SOURCE is provided return the number of candidates
of current source only."
(with-helm-buffer
(if (or (helm-empty-buffer-p)
(helm-empty-source-p))
0
(save-excursion
(helm-aif (and in-current-source (helm-get-previous-header-pos))
(goto-char it)
(goto-char (point-min)))
(forward-line 1)
(if (helm-pos-multiline-p)
(cl-loop with count-multi = 1
while (and (not (if in-current-source
(save-excursion
(forward-line 2)
(or (helm-pos-header-line-p) (eobp)))
(eobp)))
(search-forward helm-candidate-separator nil t))
do (cl-incf count-multi)
finally return count-multi)
(cl-loop with ln = 0
while (not (if in-current-source
(or (helm-pos-header-line-p) (eobp))
(eobp)))
;; Don't count empty lines maybe added by popup (bug#1370).
unless (or (eq (pos-bol) (pos-eol))
(helm-pos-header-line-p))
do (cl-incf ln)
do (forward-line 1) finally return ln))))))
;;; Main functions
;;
(defconst helm-argument-keys
;; `:allow-nest' is not in this list because it is treated before.
'(:sources :input :prompt :resume
:preselect :buffer :keymap :default :history))
;;;###autoload
(defun helm (&rest plist)
"Main function to execute helm sources.
PLIST is a list like
\(:key1 val1 :key2 val2 ...)
or
\(&optional sources input prompt resume preselect
buffer keymap default history allow-nest).
** Keywords
Keywords supported:
- :sources
- :input
- :prompt
- :resume
- :preselect
- :buffer
- :keymap
- :default
- :history
- :allow-nest
Extra LOCAL-VARS keywords are supported, see the \"** Other
keywords\" section below.
Basic keywords are the following:
*** :sources
One of the following:
- List of sources
- Symbol whose value is a list of sources
- Alist representing a Helm source.
- In this case the source has no name and is referenced in
`helm-sources' as a whole alist.
*** :input
Initial input of minibuffer (temporary value of `helm-pattern')
*** :prompt
Minibuffer prompt. Default value is `helm--prompt'.
*** :resume
If t, allow resumption of the previous session of this Helm
command, skipping initialization.
If \\='noresume, this instance of `helm' cannot be resumed.
*** :preselect
Initially selected candidate (string or regexp).
*** :buffer
Buffer name for this Helm session. `helm-buffer' will take this value.
*** :keymap
\[Obsolete]
Keymap used at the start of this Helm session.
It is overridden by keymaps specified in sources, and is kept
only for backward compatibility.
Keymaps should be specified in sources using the :keymap slot
instead. See `helm-source'.
This keymap is not restored by `helm-resume'.
*** :default
Default value inserted into the minibuffer \ with
\\\\[next-history-element].
It can be a string or a list of strings, in this case
\\\\[next-history-element] cycles through
the list items, starting with the first.
If nil, `thing-at-point' is used.
If `helm-maybe-use-default-as-input' is non-nil, display is
updated using this value if this value matches, otherwise it is
ignored. If :input is specified, it takes precedence on :default.
*** :history
Minibuffer input, by default, is pushed to `minibuffer-history'.
When an argument HISTORY is provided, input is pushed to
HISTORY. HISTORY should be a valid symbol.
*** :allow-nest
Allow running this Helm command in a running Helm session.
** Other keywords
Other keywords are interpreted as local variables of this Helm
session. The `helm-' prefix can be omitted. For example,
\(helm :sources \\='helm-source-buffers-list
:buffer \"*helm buffers*\"
:candidate-number-limit 10)
Starts a Helm session with the variable
`helm-candidate-number-limit' set to 10.
** Backward compatibility
For backward compatibility, positional parameters are
supported:
\(helm sources input prompt resume preselect
buffer keymap default history allow-nest)
However, the use of non-keyword args is deprecated.
\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)"
(let ((fn (cond ((or (and helm-alive-p (plist-get plist :allow-nest))
(and helm-alive-p (memq 'allow-nest plist)))
#'helm--nest)
((keywordp (car plist))
#'helm)
(t #'helm-internal))))
(if (and helm-alive-p (eq fn #'helm))
(if (helm--alive-p)
;; A helm session is normally running.
(error "Error: Trying to run helm within a running helm session")
;; A helm session is already running and user jump somewhere else
;; without deactivating it.
(with-helm-buffer
(prog1
(message "Aborting an helm session running in background")
;; `helm-alive-p' will be reset in unwind-protect forms.
(helm-keyboard-quit))))
(if (keywordp (car plist))
;; Parse `plist' and move not regular `helm-argument-keys'
;; to `helm--local-variables', then calling helm on itself
;; with normal arguments (the non--arguments-keys removed)
;; will end up in [1].
(progn
(setq helm--local-variables
(append helm--local-variables
;; Vars passed by keyword on helm call
;; take precedence on same vars
;; that may have been passed before helm call.
(helm-parse-keys plist)))
(apply fn (mapcar (lambda (key) (plist-get plist key))
helm-argument-keys)))
(apply fn plist))))) ; [1] fn == helm-internal.
(defun helm--alive-p ()
"[INTERNAL] Check if `helm' is alive.
An Helm session is considered alive if `helm-alive-p' value is
non-nil, the `helm-buffer' is visible, and cursor is in the
minibuffer."
(and helm-alive-p
(get-buffer-window (helm-buffer-get) 'visible)
(minibuffer-window-active-p (minibuffer-window))
(minibufferp (current-buffer))))
(defun helm-parse-keys (keys)
"Parse the KEYS arguments of `helm'.
Return only those keys not in `helm-argument-keys', prefix them
with \"helm\", and then convert them to an alist. This allows
adding arguments that are not part of `helm-argument-keys', but
are valid helm variables nevertheless. For example,
:candidate-number-limit is bound to `helm-candidate-number-limit'
in the source.
(helm-parse-keys \\='(:sources ((name . \"test\")
(candidates . (a b c)))
:buffer \"toto\"
:candidate-number-limit 4))
==> ((helm-candidate-number-limit . 4))."
(cl-loop for (key value) on keys by #'cddr
for symname = (substring (symbol-name key) 1)
for sym = (intern (if (string-match "^helm-" symname)
symname
(concat "helm-" symname)))
unless (memq key helm-argument-keys)
collect (cons sym value)))
(defun helm-internal (&optional
sources input
prompt resume
preselect buffer
keymap default history)
"The internal Helm function called by `helm'.
For SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT and
HISTORY args see `helm'."
(cl-assert (or (stringp input)
(null input))
nil "Error in %S buffer: Initial input should be a string or nil"
buffer)
;; Set all windows NON dedicated to avoid headaches with PA and
;; helm-window (bug#2443)
(cl-loop for win in (window-list nil 1)
for state = (window-dedicated-p win)
when state
do (progn (set-window-dedicated-p win nil)
(push `(,win . ,state) helm--original-dedicated-windows-alist)))
(unless helm--nested (setq helm-initial-frame (selected-frame)))
;; Launch tramp-archive with dbus-event in `while-no-input-ignore-events'.
(helm--maybe-load-tramp-archive)
;; Activate the advices.
;; Advices will be available only in >=emacs-24.4, but
;; allow compiling without errors on lower emacs.
(when (fboundp 'advice-add)
(advice-add 'tramp-read-passwd :around #'helm--suspend-read-passwd)
(advice-add 'ange-ftp-get-passwd :around #'helm--suspend-read-passwd)
(advice-add 'epa-passphrase-callback-function
:around #'helm--suspend-read-passwd)
;; Ensure linum-mode is disabled in Helm buffers to preserve
;; performances (Bug#1894).
(advice-add 'linum-on :override #'helm--advice-linum-on '((depth . 100))))
(helm-log "helm-internal" (concat "[Start session] " (make-string 41 ?+)))
(helm-log "helm-internal" "prompt = %S" prompt)
(helm-log "helm-internal" "preselect = %S" preselect)
(helm-log "helm-internal" "buffer = %S" buffer)
(helm-log "helm-internal" "keymap = %S" keymap)
(helm-log "helm-internal" "default = %S" default)
(helm-log "helm-internal" "history = %S" history)
(setq helm--prompt (or prompt "pattern: "))
(let ((non-essential t)
;; Prevent mouse jumping to the upper-right
;; hand corner of the frame (bug#1538).
mouse-autoselect-window
focus-follows-mouse
mode-line-in-non-selected-windows
minibuffer-completion-confirm
(ori--minibuffer-follows-selected-frame
(and (boundp 'minibuffer-follows-selected-frame)
(default-toplevel-value 'minibuffer-follows-selected-frame)))
(input-method-verbose-flag helm-input-method-verbose-flag)
(helm-maybe-use-default-as-input
(and (null input)
(or helm-maybe-use-default-as-input ; it is let-bounded so use it.
(cl-loop for s in (helm-normalize-sources sources)
thereis (memq s helm-sources-using-default-as-input))))))
(unwind-protect
(condition-case-unless-debug _v
(let ( ;; `helm--source-name' is non-`nil'
;; when `helm' is invoked by action, reset it.
helm--source-name
helm-current-source
helm-in-persistent-action
helm--quit
(helm-buffer (or buffer helm-buffer)))
(helm-initialize
resume input default sources)
;; This allows giving the focus to a nested helm session which use
;; a frame, like completion in
;; `helm-eval-expression'. Unfortunately
;; `minibuffer-follows-selected-frame' is available only in
;; emacs-28+ (bug#2536).
;; When non-nil (the default) the current active
;; minibuffer is used in new frame, which is not what we
;; want in helm when starting from an active minibuffer,
;; either a helm minibuffer or something line M-:.
(and ori--minibuffer-follows-selected-frame
(setq minibuffer-follows-selected-frame
(unless (or helm--nested
;; Allow keeping initial minibuffer visible
;; e.g. completion-at-point from M-:.
(minibufferp helm-current-buffer))
t)))
;; We don't display helm-buffer here to avoid popping
;; up a window or a frame when exiting immediately when
;; only one candidate (this avoid having the helm frame
;; flashing), lets first compute candidates and if more
;; than one display helm-buffer (this is done later in
;; helm-read-from-minibuffer).
(unless helm-execute-action-at-once-if-one
(helm-display-buffer helm-buffer resume)
(select-window (helm-window))
(when (and resume helm-visible-mark-overlays)
(set-window-margins (selected-window)
(+ (string-width helm-visible-mark-prefix)
helm-left-margin-width))))
;; We are now in helm-buffer.
(unless helm-allow-mouse
(helm--remap-mouse-mode 1)) ; Disable mouse bindings.
(add-hook 'post-command-hook 'helm--maybe-update-keymap)
;; Add also to update hook otherwise keymap is not updated
;; until a key is hit (Bug#1670).
(add-hook 'helm-after-update-hook 'helm--maybe-update-keymap)
(add-hook 'post-command-hook 'helm--update-header-line)
(helm-log "helm-internal" "show prompt")
(unwind-protect
(helm-read-from-minibuffer
prompt input preselect
resume keymap default history)
(helm-cleanup))
(prog1
(unless helm--quit (helm-execute-selection-action))
(helm-log "helm-internal" (concat "[End session] " (make-string 41 ?-)))))
(quit
(helm-restore-position-on-quit)
(helm-log-run-hook "helm-internal" 'helm-quit-hook)
(helm-log "helm-internal" (concat "[End session (quit)] " (make-string 34 ?-)))
nil))
(when (fboundp 'advice-remove)
(advice-remove 'tramp-read-passwd #'helm--suspend-read-passwd)
(advice-remove 'ange-ftp-get-passwd #'helm--suspend-read-passwd)
(advice-remove 'epa-passphrase-callback-function #'helm--suspend-read-passwd)
(advice-remove 'linum-on #'helm--advice-linum-on))
(helm-log "helm-internal" "helm-alive-p = %S" (setq helm-alive-p nil))
(helm--remap-mouse-mode -1) ; Reenable mouse bindings.
(setq helm-alive-p nil)
(and ori--minibuffer-follows-selected-frame
(set-default-toplevel-value 'minibuffer-follows-selected-frame
ori--minibuffer-follows-selected-frame))
;; Prevent error "No buffer named *helm*" triggered by
;; `helm-set-local-variable'.
(setq helm--force-updating-p nil)
(setq helm--buffer-in-new-frame-p nil)
;; Reset helm-pattern so that lambda's using it
;; before running helm will not start with its old value.
(setq helm-pattern "")
(setq helm--ignore-errors nil
helm-debug nil))))
(defun helm--maybe-load-tramp-archive ()
;; Should fix bug#2393 and bug#2394. `while-no-input-ignore-events'
;; is also let-bounded in `helm--maybe-use-while-no-input'.
(let ((while-no-input-ignore-events
(and (boundp 'while-no-input-ignore-events)
(cons 'dbus-event while-no-input-ignore-events))))
(unless helm--tramp-archive-maybe-loaded
;; This for Emacs-27 not requiring tramp-archive.
(and (boundp 'tramp-archive-enabled)
(require 'tramp-archive nil t))
(setq helm--tramp-archive-maybe-loaded t))))
(defun helm--advice-linum-on ()
(unless (or (minibufferp)
(string-match "\\`\\*helm" (buffer-name))
(and (daemonp) (null (frame-parameter nil 'client))))
(linum-mode 1)))
;;; Helm resume
;;
;;
(defun helm-resume (arg)
"Resume a previous Helm session.
Call with a prefix arg to choose among existing Helm
buffers (sessions). When calling from Lisp, specify a
`buffer-name' as a string with ARG."
(interactive "P")
(let (buffer
cur-dir
narrow-pos
(helm-full-frame (default-value 'helm-full-frame))
sources)
(if arg
(if (and (stringp arg) (bufferp (get-buffer arg)))
(setq buffer arg)
(setq buffer (helm-resume-select-buffer)))
(setq buffer helm-last-buffer))
(cl-assert buffer nil
"helm-resume: No helm buffers found to resume")
(setq sources (buffer-local-value
'helm-sources (get-buffer buffer)))
;; Reset `cursor-type' to nil as it have been set to t
;; when quitting previous session.
(with-current-buffer buffer (setq cursor-type nil))
(setq helm-full-frame (buffer-local-value
'helm-full-frame (get-buffer buffer)))
(setq cur-dir (buffer-local-value
'default-directory (get-buffer buffer)))
(setq helm-saved-selection nil
helm-saved-action nil)
;; Always resume from current-buffer, if a source needs to resume from a
;; specific buffer it should be specified from this source, not here.
(setq helm-current-buffer (current-buffer))
(helm-aif (with-current-buffer buffer
helm--current-buffer-narrowed)
(progn
(set-buffer (car it))
(setq narrow-pos (cdr it))))
;; This happen when calling C-x b within helm.
(helm-aif (get-buffer-window helm-marked-buffer-name 'visible)
(progn (delete-window it) (kill-buffer helm-marked-buffer-name)))
(save-restriction
(when narrow-pos (apply #'narrow-to-region narrow-pos))
;; Restart with same `default-directory' value this session
;; was initially started with.
(with-helm-default-directory cur-dir
(unwind-protect
(helm
:sources sources
:input (buffer-local-value 'helm-input-local (get-buffer buffer))
:prompt (buffer-local-value 'helm--prompt (get-buffer buffer))
:resume t
:buffer buffer)
(run-hook-with-args 'helm-resume-after-hook sources))))))
(defun helm-resume-previous-session-after-quit ()
"Resume previous Helm session within a running Helm."
(interactive)
(with-helm-alive-p
(let ((arg (if (null (member helm-buffer helm-buffers)) 0 1)))
(cond ((> (minibuffer-depth) 1)
(message "Can't resume from recursive minibuffers"))
((> (length helm-buffers) arg)
(helm-run-after-exit (lambda () (helm-resume (nth arg helm-buffers)))))
(t (message "No previous helm sessions available for resuming"))))))
(put 'helm-resume-previous-session-after-quit 'helm-only t)
(defun helm-resume-list-buffers-after-quit ()
"List Helm buffers that can be resumed within a running Helm."
(interactive)
(with-helm-alive-p
(cond ((> (minibuffer-depth) 1)
(message "Can't resume from recursive minibuffers"))
((> (length helm-buffers) 0)
(helm-run-after-exit (lambda () (helm-resume t))))
(t (message "No previous helm sessions available for resuming")))))
(put 'helm-resume-list-buffers-after-quit 'helm-only t)
(defun helm-resume-p (resume)
"Whether current Helm session is resumed or not."
(eq resume t))
(defun helm-resume-select-buffer ()
"Select an `helm-buffer' in `helm-buffers' list to resume a helm session.
Return nil if no `helm-buffer' found."
(when helm-buffers
(or (helm :sources (helm-build-sync-source "Resume helm buffer"
:candidates helm-buffers)
:resume 'noresume
:buffer "*helm resume*")
(keyboard-quit))))
;;;###autoload
(defun helm-cycle-resume ()
"Cycle in `helm-buffers' list and resume when waiting more than 1.2s."
(interactive)
(cl-assert (and helm-buffers helm-last-buffer)
nil "No helm buffers to resume")
;; Setup a new iterator only on first hit on
;; `helm-run-cycle-resume', subsequents hits should reuse same
;; iterator.
(unless (and (eq last-command 'helm-cycle-resume)
helm--cycle-resume-iterator)
(setq helm--cycle-resume-iterator
(helm-iter-sub-next-circular
helm-buffers helm-last-buffer :test 'equal)))
(helm--resume-or-iter))
(defun helm--resume-or-iter (&optional from-helm)
(message "Resuming helm buffer `%s'" helm-last-buffer)
(if (sit-for helm-cycle-resume-delay)
;; Delay expire, run helm-resume.
(if from-helm
(helm-run-after-exit (lambda () (helm-resume helm-last-buffer)))
(helm-resume helm-last-buffer))
;; key pressed before delay, cycle.
(unless from-helm ; cycling to next item already done.
(message "Resuming helm buffer `%s'"
(setq helm-last-buffer
(helm-iter-next helm--cycle-resume-iterator))))))
(defun helm-run-cycle-resume ()
"Same as `helm-cycle-resume' but intended to be called only from Helm."
(interactive)
(when (cdr helm-buffers) ; only one session registered.
;; Setup a new iterator only on first hit on
;; `helm-run-cycle-resume', subsequents hits should reuse same
;; iterator.
(unless (and (eq last-command 'helm-run-cycle-resume)
helm--cycle-resume-iterator)
(setq helm--cycle-resume-iterator
(helm-iter-sub-next-circular
helm-buffers helm-last-buffer :test 'equal)))
;; start at next buffer as we already are at `helm-last-buffer'.
(setq helm-last-buffer
(helm-iter-next helm--cycle-resume-iterator))
(helm--resume-or-iter 'from-helm)))
(put 'helm-run-cycle-resume 'helm-only t)
;;; Nested sessions
;;
;;
(defun helm--nest (&rest same-as-helm)
"[INTERNAL] Allow calling `helm' within a running Helm session.
Arguments SAME-AS-HELM are the same as `helm'.
Don't use this directly, use instead `helm' with the keyword
:allow-nest.
\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY OTHER-LOCAL-VARS)"
(with-helm-window
(let ((orig-helm-current-buffer helm-current-buffer)
(orig-helm-buffer helm-buffer)
(orig-helm--prompt helm--prompt)
(orig-helm-sources helm-sources)
(orig-helm--in-fuzzy helm--in-fuzzy)
(orig-helm--display-frame helm--buffer-in-new-frame-p)
(orig-helm-last-frame-or-window-configuration
helm-last-frame-or-window-configuration)
(orig-one-window-p helm-onewindow-p)
(helm--nested (if helm--buffer-in-new-frame-p 'share t)))
;; FIXME Using helm-full-frame here allow showing the new
;; helm-buffer in the same window as old helm-buffer, why?
(helm-set-local-variable 'helm-full-frame t)
(unwind-protect
(let (helm-current-position
helm-current-buffer
helm-pattern
(helm-buffer (or (cl-getf same-as-helm :buffer)
(nth 5 same-as-helm)
"*Helm*"))
(enable-recursive-minibuffers t))
(setq helm-sources nil)
(apply #'helm same-as-helm))
(with-current-buffer orig-helm-buffer
(setq helm-sources orig-helm-sources)
(setq helm--nested nil)
(setq helm--buffer-in-new-frame-p orig-helm--display-frame)
(setq helm-alive-p t) ; Nested session set this to nil on exit.
(setq helm-buffer orig-helm-buffer)
(setq helm-full-frame nil)
(setq helm--prompt orig-helm--prompt)
(setq helm--in-fuzzy orig-helm--in-fuzzy)
(helm-initialize-overlays helm-buffer)
(unless (helm-empty-buffer-p) (helm-mark-current-line t))
(setq helm-last-frame-or-window-configuration
orig-helm-last-frame-or-window-configuration)
(setq cursor-type nil)
(setq helm-current-buffer orig-helm-current-buffer)
(setq helm-onewindow-p orig-one-window-p)
;; Be sure advices, hooks, and local modes keep running.
(advice-add 'tramp-read-passwd
:around #'helm--suspend-read-passwd)
(advice-add 'ange-ftp-get-passwd
:around #'helm--suspend-read-passwd)
(advice-add 'epa-passphrase-callback-function
:around #'helm--suspend-read-passwd)
(unless helm-allow-mouse
(helm--remap-mouse-mode 1))
(unless (cl-loop for h in post-command-hook
thereis (memq h '(helm--maybe-update-keymap
helm--update-header-line)))
(add-hook 'post-command-hook 'helm--maybe-update-keymap)
(add-hook 'post-command-hook 'helm--update-header-line))
(helm-display-mode-line (helm-get-current-source)))))))
;;; Windows and frames
;;
;;
(defun helm-frame-or-window-configuration (save-or-restore)
"Save or restore last frame or window configuration.
Argument SAVE-OR-RESTORE is either save or restore of window or
frame configuration as per `helm-save-configuration-functions'."
(helm-log "helm-frame-or-window-configuration" "helm-save-configuration-functions = %S"
helm-save-configuration-functions)
(let ((window-persistent-parameters (append '((no-other-window . t))
window-persistent-parameters)))
(cl-case save-or-restore
(save (setq helm-last-frame-or-window-configuration
(funcall (cdr helm-save-configuration-functions))))
(restore (funcall (car helm-save-configuration-functions)
helm-last-frame-or-window-configuration)
;; Restore dedicated windows (bug#2443).
(when helm--original-dedicated-windows-alist
(cl-loop for (win . state) in helm--original-dedicated-windows-alist
when (window-live-p win)
do (set-window-dedicated-p win state))
(setq helm--original-dedicated-windows-alist nil))
;; Restore frame focus.
;; This is needed for minibuffer own-frame config
;; when recursive minibuffers are in use.
;; e.g M-: + helm-minibuffer-history.
(cl-letf ((frame (if (minibufferp helm-current-buffer)
(selected-frame)
(last-nonminibuffer-frame)))
;; This is a workaround, because the i3 window
;; manager developers are refusing to fix their
;; broken timestamp and event handling.
;;
;; We basically just disable the part of
;; select-frame-set-input-focus that would call
;; XSetInputFocus in Xlib (x-focus-frame), that
;; resets a timestamp in the xserver which the i3
;; developers fail to notice.
;;
;; Since they don't know about the new timestamp,
;; their keyboard handling can break after a helm
;; user quits emacs, as reported in bug#1641.
;;
;; Fortunately for us, we really don't need this
;; XSetInputFocus call, since we already have focus
;; for Emacs, the user is just using helm! We call
;; select-frame-set-input-focus for the other
;; side-effects, not for x-focus-frame.
((symbol-function 'x-focus-frame) #'ignore))
(select-frame-set-input-focus frame))))))
(defun helm-current-window-configuration ()
"Like `current-window-configuration' but deal with Transient incompatibility.
See https://github.com/magit/transient/discussions/361 for details."
(when (and (window-live-p (bound-and-true-p transient--window))
(not (transient--preserve-window-p)))
(transient--delete-window))
(current-window-configuration))
(defun helm-split-window-default-fn (window)
"Default function to split windows before displaying `helm-buffer'.
It is used as default value for
`helm-split-window-preferred-function' which is then the
let-bounded value of `split-window-preferred-function' in
`helm-display-buffer'. When `helm-display-function' which default
to `helm-default-display-buffer' is called from
`helm-display-buffer' the value of
`split-window-preferred-function' will be used by
`display-buffer'."
(let* ((split-width-threshold (and (integerp helm-split-width-threshold)
helm-split-width-threshold))
(win (if (and (fboundp 'window-in-direction)
;; Don't try to split when starting in a minibuffer
;; e.g M-: and try to use helm-show-kill-ring.
(not (minibufferp helm-current-buffer))
(null helm-split-width-threshold))
(if (or (one-window-p t)
helm-split-window-inside-p)
(split-window
(selected-window) nil
(if (eq helm-split-window-default-side 'other)
helm-split-window-other-side-when-one-window
helm-split-window-default-side))
;; If more than one window reuse one of them.
(cl-case helm-split-window-default-side
(left (or (helm-window-in-direction 'left)
(helm-window-in-direction 'above)
(selected-window)))
(above (or (helm-window-in-direction 'above)
(helm-window-in-direction 'left)
(selected-window)))
(right (or (helm-window-in-direction 'right)
(helm-window-in-direction 'below)
(selected-window)))
(below (or (helm-window-in-direction 'below)
(helm-window-in-direction 'right)
(selected-window)))
(same (selected-window))
(other (or (helm-other-window-for-scrolling)
(selected-window)))
(t (or (window-next-sibling) (selected-window)))))
(split-window-sensibly window))))
(setq helm-persistent-action-window-buffer (window-buffer win))
win))
(defun helm-window-in-direction (direction)
"Same as `window-in-direction' but check if window is dedicated.
Return nil when window is dedicated."
(helm-aif (window-in-direction direction)
(and (not (window-dedicated-p it)) it)))
(defun helm-other-window-for-scrolling ()
"Same as `other-window-for-scrolling' but check if window is dedicated.
Returns nil when window is dedicated."
(helm-aif (other-window-for-scrolling)
(and (not (window-dedicated-p it)) it)))
(defun helm-resolve-display-function (com)
"Decide which display function to use according to `helm-commands-using-frame'.
The `helm-display-function' buffer local value takes precedence
on `helm-commands-using-frame'.
If `helm-initial-frame' has no minibuffer, use
`helm-display-buffer-in-own-frame' function.
Fallback to global value of `helm-display-function' when no local
value found and current command is not in
`helm-commands-using-frame'."
(let ((win (get-buffer-window helm-current-buffer)))
(or (with-helm-buffer helm-display-function)
(and (or (memq com helm-commands-using-frame)
(and helm-use-frame-when-no-suitable-window
(or (window-dedicated-p win)
(window-parameter win 'window-side)))
(and helm-use-frame-when-more-than-two-windows
(null helm--nested)
(> (length (window-list)) 2))
;; Frame parameter is unreliable for minibuffer on emacs-26.
(null (member helm-initial-frame (minibuffer-frame-list))))
#'helm-display-buffer-in-own-frame)
(default-value 'helm-display-function))))
(defun helm-display-buffer (buffer &optional resume)
"Display BUFFER.
The function used to display `helm-buffer' by calling
`helm-display-function' which splits window with
`helm-split-window-preferred-function'."
(let ((split-window-preferred-function
helm-split-window-preferred-function)
(helm-split-window-default-side
(if (and (not helm-full-frame)
helm-reuse-last-window-split-state)
(helm-acase helm-split-window-default-side
((same other) it) ; take precedence on *-window-side-state.
((guard* (progn helm--window-side-state)) guard)
(t it))
helm-split-window-default-side))
(disp-fn (with-current-buffer buffer
(helm-resolve-display-function
(if helm-actions-inherit-frame-settings
(helm-this-command) this-command)))))
(prog1
(funcall disp-fn buffer (or (helm-resume-p resume)
(and helm-actions-inherit-frame-settings
helm--executing-helm-action)))
(with-helm-buffer (setq-local helm-display-function disp-fn))
(setq helm-onewindow-p (one-window-p t))
;; Don't allow other-window and friends switching out of minibuffer.
(when helm-prevent-escaping-from-minibuffer
(helm-prevent-switching-other-window)))))
(cl-defun helm-prevent-switching-other-window (&key (enabled t))
"Allow setting `no-other-window' parameter for all windows.
Arg ENABLE is the value of `no-other-window' window property."
(walk-windows
(lambda (w)
(unless (window-dedicated-p w)
(set-window-parameter w 'no-other-window enabled)))
0))
(defun helm-default-display-buffer (buffer &optional _resume)
"Default function to display `helm-buffer' BUFFER.
It is the default value of `helm-display-function'.
It uses `switch-to-buffer' or `display-buffer' depending on the
value of `helm-full-frame' or `helm-split-window-default-side'."
(let (pop-up-frames
(curwin (get-buffer-window helm-current-buffer)))
(if (or (buffer-local-value 'helm-full-frame (get-buffer buffer))
(and (eq helm-split-window-default-side 'same)
(one-window-p t)))
(progn (and (not (minibufferp helm-current-buffer))
;; side-windows can't be the only window in frame,
;; emacs refuse to delete other windows when
;; current is a side-window [1].
(not (window-parameter curwin 'window-side))
(delete-other-windows))
(switch-to-buffer buffer))
(when (and (or helm-always-two-windows helm-autoresize-mode)
(not (eq helm-split-window-default-side 'same))
(not (minibufferp helm-current-buffer))
(not helm-split-window-inside-p)
;; Same comment as in [1].
(not (window-parameter curwin 'window-side)))
(delete-other-windows))
(display-buffer
buffer `(,helm-default-display-buffer-functions
. ,(append helm-default-display-buffer-alist
`((window-height . ,helm-display-buffer-default-height)
(window-width . ,helm-display-buffer-default-width)))))
(helm-log-run-hook "helm-default-display-buffer" 'helm-window-configuration-hook))))
;; Shut up byte-compiler in emacs-26
(defvar tab-bar-mode)
;; No warnings in Emacs built --without-x
(defvar x-display-name)
(defun helm-display-buffer-in-own-frame (buffer &optional resume)
"Display Helm buffer BUFFER in a separate frame.
Function suitable for `helm-display-function',
`helm-completion-in-region-display-function' and/or
`helm-show-completion-default-display-function'.
See `helm-display-buffer-height' and `helm-display-buffer-width'
to configure frame size.
Note that this feature is available only with emacs-25+.
Note also it is not working properly in helm nested session with emacs
version < emacs-28."
(cl-assert (and (fboundp 'window-absolute-pixel-edges)
(fboundp 'frame-geometry))
nil "Helm buffer in own frame is only available starting at emacs-25+")
(if (not (display-graphic-p))
;; Fallback to default when frames are not usable.
(helm-default-display-buffer buffer)
(setq helm--buffer-in-new-frame-p t)
(let* ((pos (window-absolute-pixel-position))
(px (car pos))
(py (cdr pos))
(half-screen-size (/ (display-pixel-height x-display-name) 2))
(frame-info (frame-geometry))
(screen-width (display-pixel-width x-display-name))
(helm-frame-width (* (frame-char-width) (+ 2 helm-display-buffer-width)))
(prmt-size (length helm--prompt))
(prmt-width (* prmt-size (frame-char-width)))
(line-height (frame-char-height))
tab-bar-mode
(new-frame-alist
(if resume
(buffer-local-value 'helm--last-frame-parameters
(get-buffer buffer))
`((width . ,helm-display-buffer-width)
(height . ,helm-display-buffer-height)
(tool-bar-lines . 0)
;; lateral constraint to keep the frame inside of the screen
(left . ,(cond ((> (+ px helm-frame-width) screen-width)
(- screen-width helm-frame-width))
(t (max (- px prmt-width) 0))))
;; Try to put frame at the best possible place.
;; Frame should be below point if enough
;; place, otherwise above point and
;; current line should not be hidden
;; by helm frame.
(top . ,(if (> py half-screen-size)
;; Above point
(- py
;; add 2 lines to make sure there is always a gap
(* (+ helm-display-buffer-height 2) line-height)
;; account for title bar height too
(cddr (assq 'title-bar-size frame-info)))
;; Below point
(+ py line-height)))
(title . "Helm")
(undecorated . ,helm-use-undecorated-frame-option)
(background-color . ,(or helm-frame-background-color
(face-attribute 'default :background)))
(foreground-color . ,(or helm-frame-foreground-color
(face-attribute 'default :foreground)))
(alpha . ,(or helm-frame-alpha 100))
(font . ,(assoc-default 'font (frame-parameters)))
(vertical-scroll-bars . nil)
(menu-bar-lines . 0)
(fullscreen . nil)
(visibility . ,(null helm-display-buffer-reuse-frame))
(minibuffer . t))))
display-buffer-alist)
;; Display minibuffer above or below only in initial session,
;; not on a session triggered by action, this way if user have
;; toggled minibuffer and header-line manually she keeps this
;; setting in next action.
(unless (or helm--executing-helm-action resume)
;; Add the hook inconditionally, if
;; helm-echo-input-in-header-line is nil helm-hide-minibuffer-maybe
;; will have anyway no effect so no need to remove the hook.
(add-hook 'helm-minibuffer-set-up-hook 'helm-hide-minibuffer-maybe)
(with-helm-buffer
(setq-local helm-echo-input-in-header-line
(not (> py half-screen-size)))))
(helm-display-buffer-popup-frame buffer new-frame-alist)
;; When frame size have been modified manually by user restore
;; it to default value unless resuming or not using
;; `helm-display-buffer-reuse-frame'.
;; This have to be done AFTER raising the frame otherwise
;; minibuffer visibility is lost until next session.
(unless (or resume (not helm-display-buffer-reuse-frame))
(set-frame-size helm-popup-frame
helm-display-buffer-width
helm-display-buffer-height)))
(helm-log-run-hook "helm-display-buffer-in-own-frame" 'helm-window-configuration-hook)))
(defun helm-display-buffer-popup-frame (buffer frame-alist)
(if helm-display-buffer-reuse-frame
(let* ((x (cdr (assoc 'left frame-alist)))
(y (cdr (assoc 'top frame-alist)))
(width (cdr (assoc 'width frame-alist)))
(height (cdr (assoc 'height frame-alist))))
(unless (and helm-popup-frame
(frame-live-p helm-popup-frame))
(setq helm-popup-frame (make-frame frame-alist)))
(select-frame helm-popup-frame)
(set-frame-position helm-popup-frame x y)
(set-frame-width helm-popup-frame width)
(set-frame-height helm-popup-frame height)
(switch-to-buffer buffer)
(select-frame-set-input-focus helm-popup-frame t))
;; If user have changed `helm-display-buffer-reuse-frame' to nil
;; maybe kill the frame.
(when (and helm-popup-frame
(frame-live-p helm-popup-frame))
(delete-frame helm-popup-frame))
(display-buffer
buffer `(display-buffer-pop-up-frame
. ((pop-up-frame-parameters . ,frame-alist))))))
;; Ensure to quit helm when user delete helm frame manually.
;; If user deletes another frame keep session running.
(defun helm--delete-frame-function (frame)
(when (and helm-alive-p
;; FRAME is handling helm-buffer
(get-buffer-window helm-buffer frame))
(helm-keyboard-quit)))
(add-hook 'delete-frame-functions 'helm--delete-frame-function)
;;; Initialize
;;
(defun helm-get-sources (sources)
"Transform each element of SOURCES in alist.
Return the resulting list."
(when sources
(mapcar (lambda (source)
(if (listp source)
source (symbol-value source)))
(helm-normalize-sources sources))))
(defun helm-initialize (resume input default sources)
"Start initialization of Helm session.
For RESUME INPUT DEFAULT and SOURCES see `helm'."
(helm-log "helm-initialize" "start initialization: resume=%S input=%S"
resume input)
(helm-frame-or-window-configuration 'save)
(let ((sources-list (helm-get-sources sources)))
(setq helm--in-fuzzy
(cl-loop for s in sources-list
for matchfns = (helm-match-functions s)
for searchfns = (helm-search-functions s)
when (or (memq 'helm-fuzzy-match matchfns)
(memq 'helm-fuzzy-search searchfns))
return t))
(helm-log "helm-initialize" "sources-list = %S" sources-list)
(helm-set-local-variable 'helm-sources sources-list)
;; Once `helm-buffer' is created `helm-sources' will be a local
;; variable which value is a list of alists.
(helm-current-position 'save)
(if (helm-resume-p resume)
(helm-initialize-overlays (helm-buffer-get))
(helm-initial-setup input default sources-list))
(setq helm-alive-p t)
(unless (eq resume 'noresume)
(helm--push-and-remove-dups helm-buffer 'helm-buffers)
(setq helm-last-buffer helm-buffer))
;; If a `resume' attribute is present `helm-compute-attr-in-sources'
;; will run its function.
(when (helm-resume-p resume)
(helm-compute-attr-in-sources 'resume))
(helm-log "helm-initialize" "end initialization")))
(defun helm-current-position (save-or-restore)
"Save or restore current position in `helm-current-buffer'.
Argument SAVE-OR-RESTORE is either save or restore."
(cl-case save-or-restore
(save
(helm-log "helm-current-position" "Save position at %S" (cons (point) (window-start)))
(setq helm-current-position (cons (point) (window-start))))
(restore
;; Maybe `helm-current-buffer' have been deleted
;; during helm session so check if it is here
;; otherwise position in underlying buffer will be lost.
(when (get-buffer-window helm-current-buffer 'visible)
(helm-log "helm-current-position" "Restore position at %S in buffer %s"
helm-current-position
(buffer-name (current-buffer)))
(goto-char (car helm-current-position))
;; Fix this position with the NOFORCE arg of `set-window-start'
;; otherwise, if there is some other buffer than `helm-current-buffer'
;; one, position will be lost.
(set-window-start (selected-window) (cdr helm-current-position) t)))))
(defun helm-initialize-overlays (buffer)
"Initialize Helm overlays in BUFFER."
(helm-log "helm-initialize-overlays" "overlay setup")
(if helm-selection-overlay
;; make sure the overlay belongs to the helm buffer if
;; it's newly created
(move-overlay helm-selection-overlay (point-min) (point-min)
(get-buffer buffer))
(setq helm-selection-overlay
(make-overlay (point-min) (point-min) (get-buffer buffer)))
(overlay-put helm-selection-overlay 'face 'helm-selection)
(overlay-put helm-selection-overlay 'priority 1)))
(defun helm-initial-setup (input default sources)
"Initialize Helm settings and set up the Helm buffer."
;; Run global hook.
(helm-log-run-hook "helm-initial-setup" 'helm-before-initialize-hook)
;; Run local source hook.
(helm--run-init-hooks 'before-init-hook sources)
;; For initialization of helm locals vars that need
;; a value from current buffer, it is here.
(helm-set-local-variable 'current-input-method current-input-method)
(setq helm-current-prefix-arg nil
helm-saved-action nil
helm-saved-selection nil
helm-suspend-update-flag nil
;; Ensure this is called BEFORE selecting helm-window.
helm-current-buffer (helm--current-buffer)
helm-buffer-file-name buffer-file-name
helm-issued-errors nil
helm-saved-current-source nil
helm--suspend-update-interactive-flag nil)
(when (and (with-helm-current-buffer
(and (buffer-narrowed-p)
(use-region-p)))
(not helm--nested))
(helm-set-local-variable 'helm--current-buffer-narrowed
(list (current-buffer)
(region-beginning) (region-end))))
(unless (and (or helm-split-window-state
helm--window-side-state)
helm-reuse-last-window-split-state)
;; `helm-split-window-state' should be the contrary of what we currently
;; have to allow toggling windows with C-t. This was influencing the
;; behavior of `helm-show-action-window-other-window' but we have now
;; removed this limitation, the action buffer beeing displayed 'below' when
;; helm-window is too narrow (vertical split). See bug#2635.
(setq helm-split-window-state
(if (or (null helm-split-window-default-side) ; same as below.
(memq helm-split-window-default-side '(below above))
(null helm-split-width-threshold)
(and (integerp helm-split-width-threshold)
(>= helm-split-width-threshold (+ (frame-width) 4))))
'vertical 'horizontal))
(setq helm--window-side-state
(or helm-split-window-default-side 'below)))
;; Some sources like helm-mu are using input to init their
;; candidates in init function, so setup initial helm-pattern here.
;; See bug#2530 and https://github.com/emacs-helm/helm-mu/issues/54.
;; Input should have precedence on default.
(cond (input
(setq helm-input input
helm-pattern input))
((and default helm-maybe-use-default-as-input)
(setq helm-pattern (if (listp default)
(car default)
default)
;; Even if helm-pattern is set we want the
;; prompt to be empty when using default as input, why
;; helm-input is initialized to "".
helm-input ""))
(helm-maybe-use-default-as-input
(setq helm-pattern (or (with-helm-current-buffer
(thing-at-point 'symbol))
"")
helm-input ""))
(t
(setq helm-pattern ""
helm-input "")))
(helm--fuzzy-match-maybe-set-pattern)
;; Call the init function for sources where appropriate
(helm-compute-attr-in-sources 'init sources)
(clrhash helm-candidate-cache)
(helm-create-helm-buffer)
(helm-clear-visible-mark)
;; Run global hook.
(helm-log-run-hook "helm-initial-setup" 'helm-after-initialize-hook)
;; Run local source hook.
(helm--run-init-hooks 'after-init-hook sources))
(defun helm--run-init-hooks (hook sources)
"Run after and before init hooks local to source.
See :after-init-hook and :before-init-hook in `helm-source'."
;; We handle here incorrect values of hooks to not break packages using such
;; values i.e. lambda's or lists not bound to a symbol. In the future we may
;; use `helm-log-run-hook' directly which allow using add-hook, remove-hook
;; etc...
(dolist (s sources)
(helm-acase (assoc-default hook s)
((guard* (and (functionp it) (not (symbolp it))))
(funcall it))
((guard* (listp it))
(dolist (h it) (funcall h)))
(t (helm-log-run-hook "helm--run-init-hooks" it)))))
(defun helm-restore-position-on-quit ()
"Restore position in `helm-current-buffer' when quitting."
(helm-current-position 'restore))
(defun helm--push-and-remove-dups (elm sym)
"Move ELM of SYM value on top and set SYM to this new value."
(set sym (cons elm (delete elm (symbol-value sym)))))
(defun helm--current-buffer ()
"[INTERNAL] Return `current-buffer' BEFORE `helm-buffer' is initialized.
Note that it returns the minibuffer in use after Helm has started
and is intended for `helm-initial-setup'. To get the buffer where
Helm was started, use `helm-current-buffer' instead."
(if (minibuffer-window-active-p (minibuffer-window))
;; If minibuffer is active be sure to use it's buffer
;; as `helm-current-buffer', this allow to use helm
;; from an already active minibuffer (M-: etc...)
(window-buffer (active-minibuffer-window))
;; Fix Bug#456
;; Use this instead of `current-buffer' to ensure
;; helm session started in helm-mode from a completing-read
;; Use really the buffer where we started and not the one
;; where the completing-read is wrapped. i.e
;; (with-current-buffer SOME-OTHER-BUFFER (completing-read [...])
(window-buffer (with-selected-window (minibuffer-window)
(minibuffer-selected-window)))))
(define-derived-mode helm-major-mode
fundamental-mode "Hmm"
"[INTERNAL] Provide major-mode name in Helm buffers.
Unuseful when used outside Helm, don't use it.")
(put 'helm-major-mode 'mode-class 'special)
(put 'helm-major-mode 'helm-only t)
(defun helm-create-helm-buffer ()
"Create and setup `helm-buffer'."
(let ((root-dir default-directory)
(inhibit-read-only t))
(with-current-buffer (get-buffer-create helm-buffer)
(helm-log "helm-create-helm-buffer" "Enabling major-mode %S" major-mode)
(helm-log "helm-create-helm-buffer" "kill local variables: %S" (buffer-local-variables))
(kill-all-local-variables)
(helm-major-mode)
(set (make-local-variable 'buffer-read-only) nil)
(buffer-disable-undo)
(erase-buffer)
;; Use this instead of setting helm-map local ensure we have all
;; our keys when helm loose minibuffer focus. And the map is
;; made local as well AFAIU.
(use-local-map helm-map)
(set (make-local-variable 'helm-source-filter) nil)
(make-local-variable 'helm-sources)
(set (make-local-variable 'helm-display-function) nil)
(set (make-local-variable 'helm-selection-point) nil)
(set (make-local-variable 'scroll-margin)
(if helm-display-source-at-screen-top
0 helm-completion-window-scroll-margin))
(set (make-local-variable 'default-directory) root-dir)
(set (make-local-variable 'helm-marked-candidates) nil)
(set (make-local-variable 'helm--prompt) helm--prompt)
(helm-initialize-persistent-action)
(helm-log "helm-create-helm-buffer" "helm-display-function = %S" helm-display-function)
(helm-log "helm-create-helm-buffer" "helm--local-variables = %S" helm--local-variables)
(helm--set-local-variables-internal)
(setq truncate-lines helm-truncate-lines) ; already local.
(setq left-margin-width helm-left-margin-width)
(setq cursor-type nil))
(helm-initialize-overlays helm-buffer)
(get-buffer helm-buffer)))
(define-minor-mode helm--minor-mode
"[INTERNAL] Enable keymap in Helm minibuffer.
Since this mode has no effect when run outside of Helm context,
please don't use it outside of Helm.
\\{helm-map}"
:group 'helm
:keymap (and helm-alive-p helm-map)
(unless helm-alive-p (setq helm--minor-mode nil)))
(put 'helm--minor-mode 'helm-only t)
(defun helm--reset-default-pattern ()
(setq helm-pattern "")
(setq helm-maybe-use-default-as-input nil))
(defun helm-read-from-minibuffer (prompt
input preselect resume
keymap default history)
"Read pattern with prompt PROMPT and initial input INPUT.
For PRESELECT RESUME KEYMAP DEFAULT HISTORY, see `helm'."
(with-helm-buffer
(if (and (helm-resume-p resume)
;; When no source, helm-buffer is empty
;; or contain non--candidate lines (e.g grep exit status)
(helm-get-current-source))
(helm-mark-current-line t)
(helm-update preselect))
(let* ((src (helm-get-current-source))
(src-keymap (assoc-default 'keymap src))
(hist (or (and history (symbolp history) history)
;; Needed for resuming.
(assoc-default 'history src)))
(timer nil)
blink-matching-paren
(first-src (car helm-sources))
(source-process-p (or (assq 'candidates-process src)
(assq 'candidates-process first-src)))
;; As we are using `helm-keyboard-quit' for `C-g' we have
;; to prevent emacs command loop redefining `C-g' during
;; helm-session. This happen only on async source with
;; large output after a certain delay. The effect is that
;; the minibuffer is exited but the helm async process
;; continue running, and because minibuffer is lost `C-g'
;; have no more effect. By binding `inhibit-quit' here we
;; prevent this and allow `C-g' (the helm one aka
;; `helm-keyboard-quit') to quit immediately.
(inhibit-quit source-process-p))
(helm-log "helm-read-from-minibuffer" "helm-get-candidate-number => %S"
(helm-get-candidate-number))
(helm-log "helm-read-from-minibuffer" "helm-execute-action-at-once-if-one = %S"
helm-execute-action-at-once-if-one)
(helm-log "helm-read-from-minibuffer"
"helm-quit-if-no-candidate = %S" helm-quit-if-no-candidate)
(when (and src (helm-resume-p resume))
(helm-display-mode-line src)
(setq helm-pattern input))
;; Reset `helm-pattern' and update
;; display if no result found with precedent value of `helm-pattern'
;; unless `helm-quit-if-no-candidate' is non-`nil', in this case
;; Don't force update with an empty pattern.
;; Reset also `helm-maybe-use-default-as-input' as this checking
;; happen only on startup.
(when helm-maybe-use-default-as-input
;; Store value of `default' temporarily here waiting next update
;; to allow actions like helm-moccur-action matching pattern
;; at the place it jump to.
(setq helm-input helm-pattern)
(if source-process-p
;; Reset pattern to next update.
(with-helm-after-update-hook
(helm--reset-default-pattern))
;; Reset pattern right now.
(helm--reset-default-pattern))
;; Ensure force-update when no candidates
;; when we start with an empty pattern.
(and (helm-empty-buffer-p)
(null helm-quit-if-no-candidate)
(helm-force-update preselect)))
;; Handle `helm-execute-action-at-once-if-one' and
;; `helm-quit-if-no-candidate' now.
(cond ((and (if (functionp helm-execute-action-at-once-if-one)
(funcall helm-execute-action-at-once-if-one)
helm-execute-action-at-once-if-one)
(= (helm-get-candidate-number
(eq helm-execute-action-at-once-if-one 'current-source))
1))
(ignore)) ; Don't enter the minibuffer loop.
((and helm-quit-if-no-candidate
(= (helm-get-candidate-number) 0))
(setq helm--quit t)
(and (functionp helm-quit-if-no-candidate)
(funcall helm-quit-if-no-candidate)))
(t ; Enter now minibuffer and wait for input.
(let ((tap (or default
(with-helm-current-buffer
(thing-at-point 'symbol)))))
(when helm-execute-action-at-once-if-one
(helm-display-buffer helm-buffer resume)
(select-window (helm-window)))
(unwind-protect
(minibuffer-with-setup-hook
(lambda ()
;; Start minor-mode with global value of helm-map.
(helm--minor-mode 1)
;; Now override the global value of `helm-map' with
;; the local one which is in this order:
;; - The keymap of current source.
;; - The value passed in KEYMAP
;; - Or fallback to the global value of helm-map.
(helm--maybe-update-keymap
(or src-keymap keymap helm-map))
(helm-log-run-hook "helm-read-from-minibuffer"
'helm-minibuffer-set-up-hook)
(setq timer
(run-with-idle-timer
(max (with-helm-buffer helm-input-idle-delay)
0.001)
'repeat
(lambda ()
;; Stop updating in persistent action
;; or when `helm-suspend-update-flag'
;; is non-`nil'.
(unless (or helm-in-persistent-action
helm-suspend-update-flag)
(save-selected-window
(helm-check-minibuffer-input)
(helm-print-error-messages))))))
;; minibuffer has already been filled here.
(helm--update-header-line))
(read-from-minibuffer (propertize (or prompt "pattern: ")
'face 'helm-minibuffer-prompt)
input helm-map
nil hist tap
helm-inherit-input-method))
(when timer (cancel-timer timer) (setq timer nil)))))))))
(defun helm-toggle-suspend-update ()
"Enable or disable display update in helm.
This can be useful for example for quietly writing a complex
regexp without Helm constantly updating."
(interactive)
(helm-suspend-update (not helm-suspend-update-flag) t)
(setq helm--suspend-update-interactive-flag
(not helm--suspend-update-interactive-flag)))
(put 'helm-toggle-suspend-update 'helm-only t)
(defun helm-suspend-update (arg &optional verbose)
"Enable or disable display update in helm.
If ARG is 1 or non nil suspend update, if it is -1 or nil reenable
updating. When VERBOSE is specified display a message."
(with-helm-buffer
(when (setq helm-suspend-update-flag
(helm-acase arg
(1 t)
(-1 nil)
(t it)))
(helm-kill-async-processes)
(setq helm-pattern ""))
(when verbose
(message (if helm-suspend-update-flag
"Helm update suspended!"
"Helm update re-enabled!")))
(helm-aif (helm-get-current-source)
(helm-display-mode-line it t))))
(defun helm-delete-backward-no-update (arg)
"Disable update and delete ARG chars backward.
Update is reenabled when idle 1s."
(interactive "p")
(with-helm-alive-p
(unless helm--suspend-update-interactive-flag
(helm-suspend-update 1))
(delete-char (- arg))
(run-with-idle-timer
1 nil
(lambda ()
(unless helm--suspend-update-interactive-flag
(helm-suspend-update -1)
(helm-check-minibuffer-input)
(helm-force-update))))))
(put 'helm-delete-backward-no-update 'helm-only t)
(defun helm-delete-char-backward (arg)
"Delete char backward and update when reaching prompt."
(interactive "p")
(condition-case _err
(cond ((and (use-region-p)
delete-active-region
(= arg 1))
;; If a region is active, kill or delete it.
(if (eq delete-active-region 'kill)
(kill-region (region-beginning) (region-end) 'region)
(delete-region (region-beginning) (region-end))))
(t (delete-char (- arg))))
(buffer-read-only
(progn
(helm-update)
(helm-reset-yank-point)))))
(put 'helm-delete-char-backward 'helm-only t)
(defun helm--suspend-read-passwd (old--fn &rest args)
"Suspend Helm while reading password.
This is used to advice `tramp-read-passwd', `ange-ftp-get-passwd'
and `epa-passphrase-callback-function'."
;; Suspend update when prompting for a tramp password.
(setq helm-suspend-update-flag t)
(setq overriding-terminal-local-map nil)
(setq helm--reading-passwd-or-string t)
(unwind-protect
;; No need to suspend timer in emacs-24.4
;; it is fixed upstream.
(apply old--fn args)
(setq helm--reading-passwd-or-string nil)
(setq helm-suspend-update-flag nil)))
(defun helm--maybe-update-keymap (&optional map)
"Handle different keymaps in multiples sources.
Overrides `helm-map' with the local map of current source. If no
map is found in current source, does nothing (keeps previous
map)."
(with-helm-buffer
(helm-aif (or map (assoc-default 'keymap (helm-get-current-source)))
;; We used a timer in the past to leave
;; enough time to helm to setup its keymap
;; when changing source from a recursive minibuffer.
;; e.g C-x C-f M-y C-g
;; => *find-files have now the bindings of *kill-ring.
;; It is no more true now we are using `minor-mode-overriding-map-alist'
;; and `helm--minor-mode' thus it fix Bug#1076 for emacs-24.3
;; where concurrent timers are not supported.
;; i.e update keymap+check input.
(with-current-buffer (window-buffer (minibuffer-window))
(setq minor-mode-overriding-map-alist `((helm--minor-mode . ,it)))))))
;;; Prevent loosing focus when using mouse.
;;
(defvar helm--remap-mouse-mode-map
(let ((map (make-sparse-keymap)))
(cl-loop for k in '([mouse-1] [mouse-2] [mouse-3]
[down-mouse-1] [down-mouse-2] [down-mouse-3]
[drag-mouse-1] [drag-mouse-2] [drag-mouse-3]
[double-mouse-1] [double-mouse-2] [double-mouse-3]
[triple-mouse-1] [triple-mouse-2] [triple-mouse-3])
do (define-key map k 'ignore))
map))
(define-minor-mode helm--remap-mouse-mode
"[INTERNAL] Prevent escaping helm minibuffer with mouse clicks.
Do nothing when used outside of helm context.
WARNING: Do not use this mode yourself, it is internal to Helm."
:group 'helm
:global t
:keymap helm--remap-mouse-mode-map
(unless helm-alive-p
(setq helm--remap-mouse-mode-map nil)))
(put 'helm--remap-mouse-mode 'helm-only t)
;; Clean up
(defun helm-cleanup ()
"Clean up the mess when Helm exit or quit."
(helm-log "helm-cleanup" "start cleanup")
(with-selected-window
;; When exiting with `helm-execute-action-at-once-if-one',
;; `helm-window' may not be created and we endup with an error
;; e.g. in eshell completion when only one candidate to complete
;; so fallback to selected-window in such cases.
(or (get-buffer-window helm-buffer)
(selected-window))
(let ((frame (selected-frame)))
(setq cursor-type (default-value 'cursor-type))
;; Ensure restoring default-value of mode-line to allow user
;; using the mouse when helm is inactive (Bug#1517,Bug#2377).
(setq mode-line-format (default-value 'mode-line-format))
(remove-hook 'post-command-hook 'helm--maybe-update-keymap)
(remove-hook 'post-command-hook 'helm--update-header-line)
;; Be sure we call cleanup functions from helm-buffer.
(helm-compute-attr-in-sources 'cleanup)
;; Delete or make invisible helm frame.
(if (and helm--buffer-in-new-frame-p
;; a helm session running in a frame that runs a nested
;; session share the same frame for both sessions so
;; don't delete the common frame.
;; i.e. helm--nested == t => delete
;; helm--nested == nil => delete
;; helm--nested == share => don't delete
(not (eq helm--nested 'share)))
(progn
(setq-local helm--last-frame-parameters
(helm--get-frame-parameters))
(bury-buffer)
(if helm-display-buffer-reuse-frame
(make-frame-invisible frame) (delete-frame frame)))
;; bury-buffer from this window [1].
;; Do it at end to make sure buffer is still current.
(bury-buffer))))
(helm-kill-async-processes)
;; Remove the temporary hooks added
;; by `with-helm-temp-hook' that
;; may not have been consumed.
(when helm--temp-hooks
(cl-loop for (fn . hook) in helm--temp-hooks
do (remove-hook hook fn))
(setq helm--temp-hooks nil))
;; When running helm from a dedicated frame
;; with no minibuffer, helm will run in the main frame
;; which have a minibuffer, so be sure to disable
;; the `no-other-window' prop there.
(helm-prevent-switching-other-window :enabled nil)
(helm-log-run-hook "helm-cleanup" 'helm-cleanup-hook)
(helm-frame-or-window-configuration 'restore)
;; [1] now bury-buffer from underlying windows otherwise,
;; if this window is killed the underlying buffer will
;; be a helm buffer.
(replace-buffer-in-windows helm-buffer)
(setq helm-alive-p nil)
;; Prevent error "No buffer named *helm*" triggered by
;; `helm-set-local-variable'.
(setq helm--force-updating-p nil)
(setq helm--buffer-in-new-frame-p nil)
;; No need to reinitialize helm-pattern here now it is done only
;; once in init function bug#2530.
(setq helm-last-query helm-pattern)
;; This is needed in some cases where last input
;; is yielded infinitely in minibuffer after helm session.
(helm-clean-up-minibuffer))
(defun helm-clean-up-minibuffer ()
"Remove contents of minibuffer."
(let ((miniwin (minibuffer-window)))
;; Clean only current minibuffer used by helm.
;; i.e The precedent one is active.
(unless (minibuffer-window-active-p miniwin)
(with-current-buffer (window-buffer miniwin)
(delete-minibuffer-contents)))))
;;; Input handling
;;
;;
(defun helm-check-minibuffer-input ()
"Check minibuffer content."
(with-selected-window (or (active-minibuffer-window)
(minibuffer-window))
(helm-check-new-input (minibuffer-contents))))
(defun helm-check-new-input (input)
"Check INPUT string and update the helm buffer if necessary."
(unless (equal input helm-pattern)
(setq helm-pattern input)
(unless (helm-action-window)
(setq helm-input helm-pattern))
(helm-log "helm-check-new-input" "helm-pattern = %S" helm-pattern)
(helm-log "helm-check-new-input" "helm-input = %S" helm-input)
(helm-log-run-hook "helm-check-new-input" 'helm-before-update-hook)
(setq helm--in-update t)
(helm-update)))
(defun helm--reset-update-flag ()
(run-with-idle-timer
helm-exit-idle-delay nil
(lambda () (setq helm--in-update nil))))
;; (add-hook 'helm-after-update-hook #'helm--reset-update-flag)
;; All candidates
(defun helm-get-candidates (source)
"Retrieve and return the list of candidates from SOURCE."
(let* ((candidate-fn (assoc-default 'candidates source))
(candidate-proc (assoc-default 'candidates-process source))
;; See comment in helm-get-cached-candidates (Bug#2113).
(inhibit-quit candidate-proc)
cfn-error
(notify-error
(lambda (&optional e)
(error
"In `%s' source: `%s' %s %s"
(assoc-default 'name source)
(or candidate-fn candidate-proc)
(if e "\n" "must be a list, a symbol bound to a list, or a function returning a list")
(if e (prin1-to-string e) ""))))
(candidates (condition-case-unless-debug err
;; Process candidates-(process) function
;; It may return a process or a list of candidates.
(if candidate-proc
;; Calling `helm-interpret-value' with no
;; SOURCE arg force the use of `funcall'
;; and not `helm-apply-functions-from-source'.
(helm-interpret-value candidate-proc)
(helm-interpret-value candidate-fn source))
(error (helm-log "helm-get-candidates"
"Error: %S" (setq cfn-error err))
nil))))
(cond ((and (processp candidates) (not candidate-proc))
(warn "Candidates function `%s' should be called in a `candidates-process' attribute"
candidate-fn))
((and candidate-proc (not (processp candidates)))
(error "Candidates function `%s' should run a process" candidate-proc)))
(cond ((processp candidates)
;; Candidates will be filtered later in process filter.
candidates)
;; An error occured in candidates function.
(cfn-error (unless helm--ignore-errors
(funcall notify-error cfn-error)))
;; Candidates function returns no candidates.
((or (null candidates)
;; Can happen when the output of a process
;; is empty, and the candidates function call
;; something like (split-string (buffer-string) "\n")
;; which result in a list of one empty string (Bug#938).
;; e.g (completing-read "test: " '(""))
(equal candidates '("")))
nil)
((listp candidates)
;; Transform candidates with `candidate-transformer' functions or
;; `real-to-display' functions if those are found,
;; otherwise return candidates unmodified.
;; `filtered-candidate-transformer' is NOT called here.
(helm-transform-candidates candidates source))
(t (funcall notify-error)))))
(defun helm-get-cached-candidates (source)
"Return the cached value of candidates for SOURCE.
Cache the candidates if there is no cached value yet."
(let* ((name (assoc-default 'name source))
(candidate-cache (gethash name helm-candidate-cache))
;; Bind inhibit-quit to ensure function terminate in case of
;; quit from `helm-while-no-input' and processes are added to
;; helm-async-processes for further deletion (Bug#2113).
;; FIXME: Is this still needed now `helm-while-no-input'
;; handles quit-flag?
(inhibit-quit (assoc-default 'candidates-process source)))
(helm-aif candidate-cache
(prog1 it (helm-log "helm-get-cached-candidates"
"Use cached candidates"))
(helm-log "helm-get-cached-candidates"
"No cached candidates, calculate candidates")
(let ((candidates (helm-get-candidates source)))
(cond ((processp candidates)
(push (cons candidates
(append source
(list (cons 'item-count 0)
(cons 'incomplete-line ""))))
helm-async-processes)
(set-process-filter candidates 'helm-output-filter)
(setq candidates nil))
((not (assq 'volatile source))
(puthash name candidates helm-candidate-cache)))
candidates))))
;;; Candidate transformers
(defun helm-process-candidate-transformer (candidates source)
"Execute `candidate-transformer' function(s) on CANDIDATES in SOURCE."
(helm-aif (assoc-default 'candidate-transformer source)
(helm-apply-functions-from-source source it candidates)
candidates))
(defun helm-process-filtered-candidate-transformer (candidates source)
"Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE."
(helm-aif (assoc-default 'filtered-candidate-transformer source)
(helm-apply-functions-from-source source it candidates source)
candidates))
(defun helm--maybe-process-filter-one-by-one-candidate (candidate source)
"Execute `filter-one-by-one' function(s) on real value of CANDIDATE in SOURCE.
Return CANDIDATE modified by the function(s)."
(helm-aif (assoc-default 'filter-one-by-one source)
(let ((real (if (consp candidate) (cdr candidate) candidate)))
(when real
(if (and (listp it)
(not (functionp it))) ;; Don't treat lambda's as list.
(cl-loop with cand = candidate
for f in it
do (setq cand (funcall f real))
finally return cand)
(funcall it real))))
candidate))
(defun helm--initialize-one-by-one-candidates (candidates source)
"Process CANDIDATES with the `filter-one-by-one' function in SOURCE.
Return CANDIDATES unchanged when pattern is not empty."
(helm-aif (and (string= helm-pattern "")
(assoc-default 'filter-one-by-one source))
(cl-loop for cand in candidates collect
(helm--maybe-process-filter-one-by-one-candidate cand source))
candidates))
(defun helm-process-filtered-candidate-transformer-maybe
(candidates source process-p)
"Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE.
When PROCESS-P is non-nil execute
`filtered-candidate-transformer' functions if some, otherwise
return CANDIDATES."
(if process-p
;; When no filter return CANDIDATES unmodified.
(helm-process-filtered-candidate-transformer candidates source)
candidates))
(defun helm-process-real-to-display (candidates source)
"Execute real-to-display function on all CANDIDATES of SOURCE."
(helm-aif (assoc-default 'real-to-display source)
(setq candidates (helm-apply-functions-from-source
source 'mapcar
(lambda (cand)
(if (consp cand)
;; override DISPLAY from candidate-transformer
(cons (funcall it (cdr cand)) (cdr cand))
(cons (funcall it cand) cand)))
candidates))
candidates))
(defun helm-transform-candidates (candidates source &optional process-p)
"Transform CANDIDATES from SOURCE according to candidate transformers.
When PROCESS-P is non-nil executes the
`filtered-candidate-transformer' functions, otherwise processes
`candidate-transformer' functions only,
`filtered-candidate-transformer' functions being processed later,
after the candidates have been narrowed by
`helm-candidate-number-limit', see `helm-compute-matches'. When
`real-to-display' attribute is present, execute its functions on all
maybe filtered CANDIDATES."
(helm-process-real-to-display
(helm-process-filtered-candidate-transformer-maybe
(helm-process-candidate-transformer
candidates source)
source process-p)
source))
;; Narrowing candidates
(defun helm-candidate-number-limit (source)
"Apply candidate-number-limit attribute value.
This overrides `helm-candidate-number-limit' variable.
E.g.:
If (candidate-number-limit) is in SOURCE, show all candidates in SOURCE.
If (candidate-number-limit . 123) is in SOURCE limit candidate to 123."
(helm-aif (assq 'candidate-number-limit source)
;; When assoc value is nil use by default 99999999 otherwise use
;; the assoc value, when it is a symbol interpret its value (bug#1831).
(or (helm-aand (cdr it) (helm-interpret-value it)) 99999999)
(or helm-candidate-number-limit 99999999)))
(defun helm-candidate-get-display (candidate)
"Get searched display part from CANDIDATE.
CANDIDATE is either a string, a symbol, or a (DISPLAY . REAL)
cons cell."
(helm-acase candidate
((dst* (disp . real)) disp)
((guard* (symbolp candidate))
(symbol-name candidate))
((guard* (numberp candidate))
(number-to-string candidate))
(t candidate)))
(defun helm-process-pattern-transformer (pattern source)
"Execute pattern-transformer attribute function(s) on PATTERN in SOURCE."
(helm-aif (assoc-default 'pattern-transformer source)
(helm-apply-functions-from-source source it pattern)
pattern))
(defun helm-default-match-function (candidate)
"Check if `helm-pattern' match CANDIDATE.
Default function to match candidates according to `helm-pattern'."
(string-match helm-pattern candidate))
;;; Fuzzy matching
;;
;;
(defvar helm--fuzzy-regexp-cache (make-hash-table :test 'eq))
(defun helm--fuzzy-match-maybe-set-pattern ()
;; Computing helm-pattern with helm--mapconcat-pattern
;; is costly, so cache it once time for all and reuse it
;; until pattern change.
(when helm--in-fuzzy
(let ((fun (if (string-match "\\`\\^" helm-pattern)
#'identity
#'helm--mapconcat-pattern)))
(clrhash helm--fuzzy-regexp-cache)
;; FIXME: Splitted part are not handled here,
;; I must compute them in `helm-search-match-part'
;; when negation and in-buffer are used.
(if (string-match "\\`!" helm-pattern)
(puthash 'helm-pattern
(if (> (length helm-pattern) 1)
(list (regexp-quote (substring helm-pattern 1 2))
(funcall fun (substring helm-pattern 1)))
'("" ""))
helm--fuzzy-regexp-cache)
(puthash 'helm-pattern
(if (> (length helm-pattern) 0)
(list (regexp-quote (substring helm-pattern 0 1))
(funcall fun helm-pattern))
'("" ""))
helm--fuzzy-regexp-cache)))))
(defun helm-fuzzy-match (candidate)
"Check if `helm-pattern' fuzzy matches CANDIDATE.
This function is used with sources built with `helm-source-sync'."
(unless (string-match " " helm-pattern)
;; When pattern have one or more spaces, let
;; multi-match doing the job with no fuzzy matching.[1]
(let ((regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache))))
(if (string-match "\\`!" helm-pattern)
(not (string-match regexp candidate))
(string-match regexp candidate)))))
(defun helm-fuzzy-search (pattern)
"Same as `helm-fuzzy-match' but for sources built with
`helm-source-in-buffer'."
(unless (string-match " " helm-pattern)
;; Same as in `helm-fuzzy-match' ref[1].
(let* ((regexps (gethash 'helm-pattern helm--fuzzy-regexp-cache))
(partial-regexp (car regexps))
(regexp (cadr regexps)))
(if (string-match "\\`!" pattern)
;; Don't try to search here, just return
;; the position of line and go ahead,
;; letting `helm-search-match-part' checking if
;; pattern match against this line.
(prog1 (list (pos-bol) (pos-eol))
(forward-line 1))
;; We could use here directly `re-search-forward'
;; on the regexp produced by `helm--mapconcat-pattern',
;; but it is very slow because emacs have to do an incredible
;; amount of loops to match e.g "[^f]*f[^o]*o..." in the whole buffer,
;; more the regexp is long more the amount of loops grow.
;; (Probably leading to a max-lisp-eval-depth error if both
;; regexp and buffer are too big)
;; So just search the first bit of pattern e.g "[^f]*f", and
;; then search the corresponding line with the whole regexp,
;; which increase dramatically the speed of the search.
(cl-loop while (re-search-forward partial-regexp nil t)
for bol = (pos-bol)
for eol = (pos-eol)
if (progn (goto-char bol)
(re-search-forward regexp eol t))
do (goto-char eol) and return t
else do (goto-char eol)
finally return nil)))))
(defvar helm-fuzzy-default-score-fn #'helm-fuzzy-flex-style-score)
(defun helm-score-candidate-for-pattern (candidate pattern)
"Assign score to CANDIDATE according to PATTERN."
;; Unknown candidates always go on top.
(if (helm-candidate-prefixed-p candidate)
200.00
(funcall helm-fuzzy-default-score-fn candidate pattern)))
;; The flex scoring needs a regexp whereas the fuzzy scoring works
;; directly with helm-pattern, so cache the needed regexp for flex
;; scoring to not (re)compute it at each candidate. We could reuse
;; the regexp cached in `helm--fuzzy-regexp-cache' but it is not
;; exactly the same as the one needed for flex and also it is always
;; computed against the whole helm-pattern which is not usable for
;; e.g. file completion.
(defvar helm--fuzzy-flex-regexp-cache (make-hash-table :test 'equal))
(defun helm-fuzzy-flex-style-score (candidate pattern)
"Give a score to CANDIDATE according to PATTERN.
A regexp is generated from PATTERN to calculate score.
Score is calculated with the emacs-27 flex algorithm using
`helm-flex--style-score'."
(let ((regexp (helm-aif (gethash pattern helm--fuzzy-flex-regexp-cache)
it
(clrhash helm--fuzzy-flex-regexp-cache)
(puthash pattern (helm--fuzzy-flex-pattern-to-regexp pattern)
helm--fuzzy-flex-regexp-cache))))
(helm-flex--style-score candidate regexp t)))
(defun helm--fuzzy-flex-pattern-to-regexp (pattern)
"Return a regexp from PATTERN compatible with emacs-27 flex algorithm."
(completion-pcm--pattern->regex
(helm-completion--flex-transform-pattern (list pattern)) 'group))
(defun helm-flex-add-score-as-prop (candidates regexp)
(cl-loop with case-fold-search = (helm-set-case-fold-search)
for cand in candidates
collect (helm-flex--style-score cand regexp)))
(defun helm-completion--flex-transform-pattern (pattern)
;; "fob" => '(prefix "f" any "o" any "b" any point)
(cl-loop for p in pattern
if (stringp p) nconc
(cl-loop for str across p
nconc (list (string str) 'any))
else nconc (list p)))
(defun helm-fuzzy-helm-style-score (candidate pattern)
"Give a score to CANDIDATE according to PATTERN.
Score is calculated for contiguous matches found with PATTERN.
Score is 100 (maximum) if PATTERN is fully matched in CANDIDATE.
One point bonus is added to score when PATTERN prefix matches
CANDIDATE. Contiguous matches get a coefficient of 2."
(let* ((cand (if (stringp candidate)
candidate (helm-stringify candidate)))
(pat-lookup (helm--collect-pairs-in-string pattern))
(str-lookup (helm--collect-pairs-in-string cand))
(inter (cl-nintersection pat-lookup str-lookup :test 'equal))
;; Prefix
(bonus (cond ((or (equal (car pat-lookup) (car str-lookup))
(equal (caar pat-lookup) (caar str-lookup)))
2)
((and (null pat-lookup) ; length = 1
(string= pattern (substring cand 0 1)))
150)
(t 0)))
;; Exact match e.g. foo -> foo == 200
(bonus1 (and (string= cand pattern) 200))
;; Partial match e.g. foo -> aafooaa == 100
;; or foo -> fooaaa
(bonus2 (and (or (string-match
(concat "\\`" (regexp-quote pattern))
cand)
(string-match
(concat "\\<" (regexp-quote pattern) "\\>")
cand))
100)))
(+ bonus
(or bonus1 bonus2
;; Give a coefficient of 2 for contiguous matches.
;; That's mean that "wiaaaki" will not take precedence
;; on "aaawiki" when matching on "wiki" even if "wiaaaki"
;; starts by "wi".
(* (length inter) 2)))))
(defun helm-fuzzy-matching-default-sort-fn-1 (candidates &optional use-real basename preserve-tie-order)
"The transformer for sorting candidates in fuzzy matching.
It sorts on the display part by default.
It sorts CANDIDATES by their scores as calculated by
`helm-score-candidate-for-pattern'. Set USE-REAL to non-nil to
sort on the real part. If BASENAME is non-nil assume we are
completing filenames and sort on basename of candidates. If
PRESERVE-TIE-ORDER is nil, ties in scores are sorted by length of
the candidates."
(if (string= helm-pattern "")
candidates
(let ((table-scr (make-hash-table :test 'equal)))
(sort candidates
(lambda (s1 s2)
;; Score and measure the length on real or display part of candidate
;; according to `use-real'.
(let* ((real-or-disp-fn (if use-real #'cdr #'car))
(cand1 (cond ((and basename (consp s1))
(helm-basename (funcall real-or-disp-fn s1)))
((consp s1) (funcall real-or-disp-fn s1))
(basename (helm-basename s1))
(t s1)))
(cand2 (cond ((and basename (consp s2))
(helm-basename (funcall real-or-disp-fn s2)))
((consp s2) (funcall real-or-disp-fn s2))
(basename (helm-basename s2))
(t s2)))
(data1 (or (gethash cand1 table-scr)
(puthash cand1
(list (helm-score-candidate-for-pattern
cand1 helm-pattern)
(length (helm-stringify cand1)))
table-scr)))
(data2 (or (gethash cand2 table-scr)
(puthash cand2
(list (helm-score-candidate-for-pattern
cand2 helm-pattern)
(length (helm-stringify cand2)))
table-scr)))
(len1 (cadr data1))
(len2 (cadr data2))
(scr1 (car data1))
(scr2 (car data2)))
(cond ((= scr1 scr2)
;; Comparison by length should not be called here most of
;; the time because we use now flex scoring which does
;; such test, however we still use helm fuzzy scoring
;; with preserve-tie-order, so keep testing length here
;; for it.
(unless preserve-tie-order
(< len1 len2)))
((> scr1 scr2)))))))))
(defun helm-fuzzy-matching-default-sort-fn (candidates _source)
"Default `filtered-candidate-transformer' to sort in fuzzy matching."
(helm-fuzzy-matching-default-sort-fn-1 candidates))
(defun helm-fuzzy-matching-sort-fn-preserve-ties-order (candidates _source)
"Same as `helm-fuzzy-matching-default-sort-fn' but preserving order of ties.
The default function, `helm-fuzzy-matching-default-sort-fn',
sorts ties by length, shortest first. This function may be more
useful when the order of the candidates is meaningful, e.g. with
`recentf-list'."
;; Flex scoring is already taking in account length of strings so this
;; function have no effect when flex scoring is in use, force the usage of
;; helm fuzzy scoring to ensure no testing against length is done.
(let ((helm-fuzzy-default-score-fn #'helm-fuzzy-helm-style-score))
(helm-fuzzy-matching-default-sort-fn-1 candidates nil nil t)))
(defun helm--maybe-get-migemo-pattern (pattern &optional diacritics)
(or (and helm-migemo-mode
(assoc-default pattern helm-mm--previous-migemo-info))
(if diacritics
(char-fold-to-regexp pattern)
pattern)))
(defun helm-fuzzy-default-highlight-match-1 (candidate &optional pattern diacritics file-comp)
(let* ((pair (and (consp candidate) candidate))
(display (helm-stringify (if pair (car pair) candidate)))
(real (cdr pair))
(host (and file-comp (get-text-property
(max 0 (1- (length display))) 'host display)))
(regex (helm--maybe-get-migemo-pattern pattern diacritics))
;; Match prop at end, because at 0 we might have an icon.
(mpart (get-text-property (1- (length display)) 'match-part display))
(mp (cond ((and mpart (string= display mpart)) nil)
(mpart)
;; FIXME: This may be wrong when match-on-real
;; is nil, so we should flag match-on-real on
;; top and use it.
(file-comp (file-name-nondirectory
(or host (and (stringp real) real) display)))))
(count 0)
beg-str end-str)
;; Happens when matching empty lines (^$), in this case there is nothing to
;; highlight.
(if (string= mpart "")
candidate
(when host (setq pattern (cadr (split-string pattern ":"))))
;; Extract all parts of display keeping original properties.
(when (and mp (ignore-errors
;; Avoid error when candidate is a huge line.
(string-match (regexp-quote mp) display)))
(setq beg-str (substring display 0 (match-beginning 0))
end-str (substring display (match-end 0) (length display))
mp (substring display (match-beginning 0) (match-end 0))))
(with-temp-buffer
;; Insert the whole display part and remove non--match-part
;; to keep their original face properties.
(insert (propertize (or mp display) 'read-only nil)) ; Fix (bug#1176)
(goto-char (point-min))
(condition-case nil
(progn
;; Try first matching against whole pattern.
(unless (string= pattern "")
(while (helm-re-search-forward regex nil t)
(cl-incf count)
(helm-add-face-text-properties
(match-beginning 0) (match-end 0) 'helm-match)))
;; If no matches start matching against multiples or fuzzy matches.
(when (zerop count)
(cl-loop with multi-match = (string-match-p " " pattern)
with patterns = (if multi-match
(cl-loop for pat in (helm-mm-split-pattern
pattern)
collect
(helm--maybe-get-migemo-pattern
pat diacritics))
(helm-acase (split-string pattern "" t)
((guard* (string= "!" (car it))) nil)
(t it)))
for p in patterns
;; Multi matches (regexps patterns).
if multi-match do
(progn
(while (helm-re-search-forward p nil t)
(helm-add-face-text-properties
(match-beginning 0) (match-end 0) 'helm-match))
(goto-char (point-min)))
;; Fuzzy matches (literal patterns).
else do
(when (search-forward p nil t)
(helm-add-face-text-properties
(match-beginning 0) (match-end 0)
'helm-match)))))
(invalid-regexp nil))
;; Now replace the original match-part with the part
;; with face properties added.
(setq display (if mp (concat beg-str (buffer-string) end-str) (buffer-string))))
(if real (cons display real) display))))
(cl-defun helm-fuzzy-default-highlight-match (candidate
&optional (pattern helm-pattern) diacritics file-comp)
"The default function to highlight matches in fuzzy matching.
Highlight elements in CANDIDATE matching PATTERN according
to the matching method in use. When DIACRITICS is specified, ignore
diacritics, see `char-fold-to-regexp' for more infos."
(if (string= pattern "")
;; Empty pattern, do nothing. This is needed when this function
;; is used outside of helm-fuzzy-highlight-matches like in *buffers-list.
candidate
;; Else start highlighting.
(helm-fuzzy-default-highlight-match-1 candidate pattern diacritics file-comp)))
(defun helm-fuzzy-highlight-matches (candidates source)
"Highlight matches in CANDIDATES for SOURCE.
The filtered-candidate-transformer function to highlight fuzzy matches.
See `helm-fuzzy-default-highlight-match'."
(cl-assert helm-fuzzy-matching-highlight-fn nil "Wrong type argument functionp: nil")
(cl-loop with diac = (helm-get-attr 'diacritics source)
with file-comp-p = (and (not (helm-action-window))
(or minibuffer-completing-file-name
helm--minibuffer-completing-file-name
(helm-get-attr 'completing-file-name source)))
;; helm-pattern may have been modified (fuzzy) so ensure to
;; use helm-input which is the raw pattern.
with pattern = (if file-comp-p
(file-name-nondirectory helm-input)
helm-pattern)
when (string= pattern "") return candidates
for c in candidates
collect (funcall helm-fuzzy-matching-highlight-fn c pattern diac file-comp-p)))
;;; helm-flex style
;;
;; Provide the emacs-27 flex style for emacs<27.
;; Reuse the flex scoring algorithm of flex style in emacs-27.
(defun helm-flex--style-score (str regexp &optional score)
"Score STR candidate according to REGEXP.
REGEXP should be generated from a pattern which is a list like
\\='(point \"f\" any \"o\" any \"b\" any) for \"fob\" as pattern.
Such pattern may be build with
`helm-completion--flex-transform-pattern' function, and the regexp
with `completion-pcm--pattern->regex'. For commodity,
`helm--fuzzy-flex-pattern-to-regexp' is used to build such regexp.
Function extracted from `completion-pcm--hilit-commonality' in
emacs-27 to provide such scoring in emacs<27."
;; Don't modify the string itself.
(setq str (copy-sequence str))
(if (string-match regexp str)
(let* ((md (match-data))
(start (pop md))
(len (length str))
(score-numerator 0)
(score-denominator 0)
(last-b 0)
(update-score
(lambda (a b)
"Update score variables given match range (A B)."
(setq score-numerator (+ score-numerator (- b a)))
(unless (or (= a last-b)
(zerop last-b)
(= a (length str)))
(setq score-denominator (+ score-denominator
1
(expt (- a last-b 1)
(/ 1.0 3)))))
(setq last-b b)))
result)
(funcall update-score start start)
(setq md (cdr md))
(while md
(funcall update-score start (pop md))
(setq start (pop md)))
(funcall update-score len len)
(unless (zerop (length str))
(setq result (/ score-numerator (* len (1+ score-denominator)) 1.0))
(put-text-property 0 1 'completion-score result str))
(if (and score result) result str))
(put-text-property 0 1 'completion-score 0.0 str)
(if score 0.0 str)))
;;; Matching candidates
;;
;;
(defun helm-match-functions (source)
(let ((matchfns (or (assoc-default 'match source)
(assoc-default 'match-strict source)
#'helm-default-match-function)))
(if (and (listp matchfns) (not (functionp matchfns)))
matchfns (list matchfns))))
(defun helm-search-functions (source)
(let ((searchfns (assoc-default 'search source)))
(if (and (listp searchfns) (not (functionp searchfns)))
searchfns (list searchfns))))
(defun helm-match-from-candidates (cands matchfns match-part-fn limit source)
(when cands ; nil in async sources.
(condition-case-unless-debug err
(cl-loop with hash = (make-hash-table :test 'equal)
with allow-dups = (assq 'allow-dups source)
with case-fold-search = (helm-set-case-fold-search)
with count = 0
for iter from 1
for fn in matchfns
when (< count limit) nconc
(cl-loop for c in cands
for dup = (gethash c hash)
for disp = (helm-candidate-get-display c)
while (< count limit)
for target = (if (helm-get-attr 'match-on-real source)
;; Let's fails on error in
;; case next block returns nil.
(or (cdr-safe c)
(get-text-property 0 'helm-realvalue disp))
disp)
for prop-part = (get-text-property 0 'match-part target)
for part = (and match-part-fn
(or prop-part
(funcall match-part-fn target)))
;; When allowing dups check if DUP
;; have been already found in previous loop
;; by comparing its value with ITER.
when (and (or (and allow-dups dup (= dup iter))
(null dup))
(condition-case nil
(funcall fn (or part target))
(invalid-regexp nil)))
do
(progn
;; Give as value the iteration number of
;; inner loop to be able to check if
;; the duplicate have not been found in previous loop.
(puthash c iter hash)
(setq c (helm--maybe-process-filter-one-by-one-candidate c source))
(cl-incf count))
;; Filter out nil candidates maybe returned by
;; `helm--maybe-process-filter-one-by-one-candidate'.
and when c collect
(if (and part (not prop-part))
(if (consp c)
(cons (propertize target 'match-part part) (cdr c))
(propertize c 'match-part part))
c)))
(error (unless (eq (car err) 'invalid-regexp) ; Always ignore regexps errors.
(helm-log-error "helm-match-from-candidates"
"helm-match-from-candidates in source `%s': %s %s"
(assoc-default 'name source) (car err) (cdr err)))
nil))))
(defun helm-compute-matches (source)
"Start computing candidates in SOURCE."
(save-current-buffer
(let ((matchfns (helm-match-functions source))
(matchpartfn (assoc-default 'match-part source))
(helm--source-name (assoc-default 'name source))
(helm-current-source source)
(limit (helm-candidate-number-limit source))
(helm-pattern (helm-process-pattern-transformer
helm-pattern source)))
(helm--fuzzy-match-maybe-set-pattern)
;; If source have a `filtered-candidate-transformer' attr
;; Filter candidates with this func, otherwise just compute
;; candidates.
;; NOTE that this next block of code is returning nil on async sources,
;; the candidates being processed directly in `helm-output-filter'
;; process-filter.
(helm-process-filtered-candidate-transformer
;; When using in-buffer method or helm-pattern is empty or
;; using dynamic completion always compute all candidates.
(if (or (equal helm-pattern "")
(assq 'match-dynamic source)
(helm--candidates-in-buffer-p source))
;; Compute all candidates up to LIMIT.
;; one-by-one are computed here only for sources that
;; display a list of candidates even with an empty
;; pattern.
(helm--initialize-one-by-one-candidates
(helm-take (helm-get-cached-candidates source) limit)
source)
;; Compute candidates according to pattern with their match
;; fns.
;; one-by-one filtered candidates are computed during the
;; execution of next loop in `helm-match-from-candidates'.
(helm-match-from-candidates
(helm-get-cached-candidates source) matchfns matchpartfn limit source))
source))))
(defun helm--candidates-in-buffer-p (source)
(assq 'search source))
(defun helm-render-source (source matches)
"Display MATCHES from SOURCE according to its settings."
(helm-log "helm-render-source" "Source = %S" (remove (assq 'keymap source) source))
(when matches
(helm-insert-header-from-source source)
(cl-loop with separate = nil
with start = (point)
with singleline = (null (assq 'multiline source))
for m in matches
for count from 1
if singleline
do (helm-insert-match m 'insert count source)
else
do (progn
(if separate
(helm-insert-candidate-separator)
(setq separate t))
(helm-insert-match m 'insert count source))
finally (and (null singleline)
(put-text-property start (point)
'helm-multiline t)))))
(defmacro helm-while-no-input (&rest body)
"Same as `while-no-input' but returns either BODY or nil.
Unlike `while-no-input' this macro ensure to not returns `t'."
(declare (debug t) (indent 0))
(let ((catch-sym (make-symbol "input")))
`(with-local-quit
(catch ',catch-sym
(let ((throw-on-input ',catch-sym)
val)
(setq val (progn ,@body))
;; See comments in `while-no-input' about resetting
;; quit-flag.
(cond ((eq quit-flag throw-on-input)
(setq quit-flag nil))
(quit-flag nil)
(t val)))))))
(defmacro helm--maybe-use-while-no-input (&rest body)
"Wrap BODY in `helm-while-no-input' unless initializing a remote connection."
`(progn
(if (or (and (file-remote-p helm-pattern)
(not (file-remote-p helm-pattern nil t)))
helm-update-edebug)
;; Tramp will ask for passwd, don't use `helm-while-no-input'.
,@body
(helm-log "helm--maybe-use-while-no-input"
"Using here `helm-while-no-input'")
;; Emacs bug , unexpected
;; dbus-event is triggered on dbus init.
;; Ignoring the dbus-event work on emacs28+; for emacs27 or older
;; version, require tramp-archive can workaround the issue.
(let ((while-no-input-ignore-events
(and (boundp 'while-no-input-ignore-events)
(cons 'dbus-event while-no-input-ignore-events))))
(helm-while-no-input ,@body)))))
(defun helm--collect-matches (src-list)
"Return a list of matches for each source in SRC-LIST.
The resulting value is a list of lists, e.g. ((a b c) (c d) (e
f)) or (nil nil nil) for three sources when no matches found,
however this function can be interrupted by new input and in this
case returns a plain nil i.e. not (nil), in this case
`helm-update' is not rendering the source, keeping previous
candidates in display."
(let ((matches (helm--maybe-use-while-no-input
(cl-loop for src in src-list
collect (helm-compute-matches src)))))
(unless (eq matches t) matches)))
;;; Case fold search
;;
;;
(cl-defun helm-set-case-fold-search (&optional (pattern helm-pattern))
"Used to set the value of `case-fold-search' in Helm.
Return t or nil depending on the value of `helm-case-fold-search'
and `helm-pattern'."
(if helm-alive-p
(let ((helm-case-fold-search
(helm-aif (assq 'case-fold-search (helm-get-current-source))
(cdr it)
helm-case-fold-search))
;; Only parse basename for filenames
;; to avoid setting case sensitivity
;; when expanded directories contains upcase
;; characters.
(bn-or-pattern (if (string-match "[~/]*" pattern)
(helm-basename pattern)
pattern)))
(helm-set-case-fold-search-1 bn-or-pattern))
case-fold-search))
(defun helm-set-case-fold-search-1 (pattern)
(cl-case helm-case-fold-search
(smart (let ((case-fold-search nil))
(if (string-match "[[:upper:]]" pattern) nil t)))
(t helm-case-fold-search)))
;;; Helm update
;;
(defun helm-update (&optional preselect source candidates)
"Update candidates list in `helm-buffer' based on `helm-pattern'.
Argument PRESELECT is a string or regexp used to move selection
to a particular place after finishing update.
When SOURCE is provided update mode-line for this source, otherwise
the current source will be used.
Argument CANDIDATES when provided is used to redisplay these candidates
without recomputing them, it should be a list of lists."
(helm-log "helm-update" "Start updating")
(helm-kill-async-processes)
;; When persistent action have been called
;; we have two windows even with `helm-full-frame'.
;; So go back to one window when updating if `helm-full-frame'
;; is non-`nil'.
(when (with-helm-buffer
(and helm-onewindow-p
;; We are not displaying helm-buffer in a frame and
;; helm-window is already displayed.
(not helm--buffer-in-new-frame-p)
(helm-window)
(not (helm-action-window))))
(with-helm-window (delete-other-windows)))
(with-current-buffer (helm-buffer-get)
(set (make-local-variable 'helm-input-local) helm-pattern)
(let ((ov '(nil)))
(unwind-protect
(let (sources matches)
;; Collect sources ready to be updated.
(setq sources
(cl-loop for src in helm-sources
when (helm-update-source-p src)
collect src))
;; When no sources to update erase buffer to avoid duplication of
;; header and candidates when next chunk of update will arrive,
;; otherwise the buffer is erased AFTER [1] the results are
;; computed. This is also needed when pattern is quickly deleted
;; backward and we reach requires-pattern limit, in this case the helm
;; buffer is not updated and stays with the results of the last
;; matching pattern.
(unless sources (erase-buffer))
(helm-maybe-dim-prompt-on-update ov)
;; Compute matches without rendering the sources.
;; This prevent the helm-buffer flickering when constantly
;; updating.
(helm-log "helm-update" "Matches: %S"
(setq matches (or candidates (helm--collect-matches sources))))
;; If computing matches finished and is not interrupted
;; erase the helm-buffer and render results (Fix #1157).
(when matches ;; nil only when interrupted by while-no-input.
(erase-buffer)
(cl-loop for src in sources
for mtc in matches
do (helm-render-source src mtc))
;; Move to first line only when there is matches
;; to avoid cursor moving upside down (Bug#1703).
(helm--update-move-first-line)))
;; When there is only one async source, update mode-line and run
;; `helm-after-update-hook' in `helm-output-filter--post-process',
;; when there is more than one source, update mode-line and run
;; `helm-after-update-hook' now even if an async source is
;; present and running in BG.
(let ((src (or source (helm-get-current-source))))
(unless (assq 'candidates-process src)
(helm-display-mode-line src 'force)
(and (car ov) (delete-overlay (car ov)))
(helm-log-run-hook "helm-update" 'helm-after-update-hook)))
(when preselect
(helm-log "helm-update" "Update preselect candidate %s" preselect)
(if (helm-window)
(with-helm-window (helm-preselect preselect source))
(helm-preselect preselect source)))
(setq helm--force-updating-p nil)
(helm--reset-update-flag))
(helm-log "helm-update" "end update"))))
(defun helm-maybe-dim-prompt-on-update (overlay)
"Make minibuffer foreground gray while updating.
Argument OVERLAY is a ref-cell."
(when (and helm-dim-prompt-on-update
;; Avoid an empty window when coming from bookmarks.
(not (helm-empty-buffer-p))
(consp overlay)) ;; Ensure OVERLAY is a ref-cell.
(with-selected-window (minibuffer-window)
(setcar overlay (make-overlay (minibuffer-prompt-end) (point-max)))
(overlay-put (car overlay) 'face 'helm-dim-prompt)
(redisplay))))
(defun helm-update-source-p (source)
"Whether SOURCE needs updating or not."
(let ((len (string-width
(if (assq 'multimatch source)
;; Don't count spaces entered when using
;; multi-match.
(replace-regexp-in-string " " "" helm-pattern)
helm-pattern))))
(and (or (not helm-source-filter)
(member (assoc-default 'name source) helm-source-filter))
(>= len
(helm-aif (assq 'requires-pattern source) (or (cdr it) 1) 0))
;; bugs were mentioned here before: Bug#1802, bug#2423
;; must be fixed already by 'helm-re-search-forward'
;;
;; short patterns that are alone not expected to return any results,
;; ignore in order to not erase Helm buffer on such patterns.
(cl-loop for p in (helm-mm-split-pattern helm-pattern)
never (member p '("!" "!^" "?" "@!"))))))
(defun helm--update-move-first-line ()
"Goto first line of `helm-buffer'."
(goto-char (point-min))
(if (helm-window)
(helm-move-selection-common :where 'line
:direction 'next
:follow t)
(forward-line 1)
(helm-mark-current-line)
;; If we are here, it is because helm-window is not ready, if one of the
;; functions in `helm-move-selection-after-hook' is called with
;; `with-helm-window' (it shouldn't but never know) we will have an error.
(condition-case-unless-debug _err
(helm-log-run-hook "helm--update-move-first-line"
'helm-move-selection-after-hook)
(error nil))
(helm-follow-execute-persistent-action-maybe)))
(cl-defun helm-force-update (&optional (preselect nil spreselect) (recenter t))
"Force recalculation and update of candidates.
Unlike `helm-update', this function re-evaluates `init' and
`update' attributes when present; also `helm-candidate-cache' is
not reinitialized, meaning candidates are not recomputed unless
pattern has changed.
Selection is preserved to current candidate if it still exists after
update or moved to PRESELECT, if specified. If PRESELECT is specified with a
nil value no preselection at all is done.
The helm-window is re-centered at the end when RECENTER is t which
is the default. RECENTER can be also a number in this case it is
passed as argument to `recenter'."
(with-helm-buffer
(let* ((source (helm-get-current-source))
(selection (helm-aif (helm-get-selection nil t source)
(regexp-quote it))))
(setq helm--force-updating-p t)
(mapc 'helm-force-update--reinit helm-sources)
(helm-update (if spreselect preselect selection) source)
(when (and (helm-window) recenter)
(with-helm-window
(recenter (and (numberp recenter) recenter)))))))
(defun helm-refresh ()
"Force recalculation and update of candidates."
(interactive)
(with-helm-alive-p
(helm-force-update)))
(put 'helm-refresh 'helm-only t)
(defun helm-force-update--reinit (source)
"Reinit SOURCE by calling its update and init functions."
;; When using a specific buffer as cache, don't kill it.
(helm-aif (and (null (bufferp (assoc-default
(helm-get-attr 'name source)
helm--candidate-buffer-alist)))
(helm-apply-functions-from-source
source 'helm-candidate-buffer))
(kill-buffer it))
(dolist (attr '(update init))
(helm-aif (assoc-default attr source)
(helm-apply-functions-from-source source it)))
(helm-remove-candidate-cache source))
(defun helm-redisplay-buffer ()
"Redisplay candidates in `helm-buffer'.
Candidates are not recomputed, only redisplayed after modifying
the whole list of candidates in each source with functions found
in `redisplay' attribute of current source. Note that candidates
are redisplayed with their display part with all properties
included only. This function is used in async sources to
transform the whole list of candidates from the sentinel
functions (i.e. when all candidates have been computed) because
other filters like `candidate-transformer' are modifying only
each chunk of candidates from `process-filter' as they come in
and not the whole list. Use this for e.g. sorting the whole list
of async candidates once computed.
Note: To ensure redisplay is done in async sources after Helm
reached `candidate-number-limit' you will have also to redisplay
your candidates from `helm-async-outer-limit-hook'."
(with-helm-buffer
(let ((get-cands (lambda (source)
(let ((fns (assoc-default 'redisplay source))
candidates
helm-move-to-line-cycle-in-source
helm-allow-mouse)
(helm-goto-source source)
(helm-next-line)
(helm-awhile (condition-case-unless-debug nil
(and (not (helm-pos-header-line-p))
(helm-get-selection
nil 'withprop source))
(error nil))
(push it candidates)
(when (save-excursion
(forward-line 1) (helm-end-of-source-p t))
(cl-return nil))
(helm-next-line))
(helm-apply-functions-from-source
source fns (nreverse candidates)))))
(get-sources (lambda ()
(let (sources helm-move-to-line-cycle-in-source)
(helm-awhile (helm-get-current-source)
(push it sources)
(when (save-excursion
(helm-move--end-of-source)
(forward-line 1) (eobp))
(cl-return nil))
(helm-next-source))
(nreverse sources)))))
(goto-char (point-min))
(helm-update nil (helm-get-current-source)
(cl-loop with sources = (funcall get-sources)
for s in helm-sources
for name = (assoc-default 'name s) collect
(when (cl-loop for src in sources thereis
(string= name
(assoc-default 'name src)))
(funcall get-cands s)))))))
(defun helm-remove-candidate-cache (source)
"Remove SOURCE from `helm-candidate-cache'."
(remhash (assoc-default 'name source) helm-candidate-cache))
(defvar helm-drag-mouse-1-fn 'ignore)
(defun helm-insert-match (match insert-function &optional num source)
"Insert MATCH into `helm-buffer' with INSERT-FUNCTION.
If MATCH is a cons cell then insert the car as display with the
cdr stored as real value in a `helm-realvalue' text property.
Args NUM and SOURCE are also stored as text property when
specified as respectively `helm-cand-num' and `helm-cur-source'."
(let ((start (pos-bol (point)))
(dispvalue (helm-candidate-get-display match))
(realvalue (cdr-safe match))
(map (when helm-allow-mouse (make-sparse-keymap)))
(inhibit-read-only t)
end)
(when (and (stringp dispvalue)
(not (zerop (length dispvalue))))
(funcall insert-function dispvalue)
(setq end (pos-eol))
;; Some strings may handle another keymap prop.
(remove-text-properties start end '(keymap nil))
(put-text-property start end 'read-only nil)
;; Some sources with candidates-in-buffer have already added
;; 'helm-realvalue property when creating candidate buffer.
(unless (get-text-property start 'helm-realvalue)
(and realvalue
(put-text-property start end
'helm-realvalue realvalue)))
(when map
(define-key map [drag-mouse-1] 'ignore)
(define-key map [mouse-1] 'helm-mouse-select-candidate)
(define-key map [mouse-2] 'ignore)
(define-key map [mouse-3] 'helm-menu-select-action)
(add-text-properties
start end
`(mouse-face highlight
keymap ,map
;; At 0 we might have an icon, so match at end.
help-echo ,(helm-acase (get-text-property (1- end) 'help-echo)
((guard* (stringp it))
(concat it "\nmouse-1: select candidate\nmouse-3: menu actions"))
(t "mouse-1: select candidate\nmouse-3: menu actions")))))
(when num
(put-text-property start end 'helm-cand-num num))
(when source
(put-text-property start end 'helm-cur-source source))
(funcall insert-function "\n"))))
(defun helm--mouse-reset-selection-help-echo ()
(let* ((inhibit-read-only t)
(start (overlay-start helm-selection-overlay))
(end (overlay-end helm-selection-overlay))
(help-echo (get-text-property start 'help-echo)))
(when (and (stringp help-echo)
(string-match "mouse-2: execute action" help-echo))
(put-text-property
start end
'help-echo (replace-match "mouse-1: select candidate"
t t help-echo)))))
(defun helm--bind-mouse-for-selection (pos)
(let ((inhibit-read-only t)
(map (get-text-property pos 'keymap)))
(when map
(define-key map [down-mouse-1] helm-drag-mouse-1-fn)
(define-key map [mouse-2] 'helm-maybe-exit-minibuffer)
(put-text-property
helm-selection-point
(overlay-end helm-selection-overlay)
'help-echo (helm-aif (get-text-property pos 'help-echo)
(if (and (stringp it)
(string-match "mouse-1: select candidate" it))
(replace-match "mouse-2: execute action" t t it)
"mouse-2: execute action\nmouse-3: menu actions")
"mouse-2: execute action\nmouse-3: menu actions")))))
(defun helm-mouse-select-candidate (event)
(interactive "e")
(let* ((window (posn-window (event-end event)))
(pos (posn-point (event-end event))))
(unwind-protect
(with-current-buffer (window-buffer window)
(if (and (helm-action-window)
(eql window (get-buffer-window helm-buffer)))
(user-error "selection in helm-window not available while selecting action")
(helm--mouse-reset-selection-help-echo)
(goto-char pos)
(when (helm-pos-multiline-p)
(goto-char (or (helm-get-previous-candidate-separator-pos)
(helm-get-previous-header-pos)))
(forward-line 1)))
(helm-mark-current-line)
(when helm-popup-tip-mode
(helm-maybe-show-help-echo))
(helm-follow-execute-persistent-action-maybe))
(select-window (minibuffer-window))
(set-buffer (window-buffer window)))))
(put 'helm-mouse-select-candidate 'helm-only t)
(defun helm-insert-header-from-source (source)
"Insert SOURCE name in `helm-buffer' header.
Maybe insert, by overlay, additional info after the source name
if SOURCE has header-name attribute."
(let ((name (assoc-default 'name source)))
(helm-insert-header
name
(helm-aif (assoc-default 'header-name source)
(helm-apply-functions-from-source source it name)))))
(defun helm-insert-header (name &optional display-string)
"Insert header of source NAME into the helm buffer.
If DISPLAY-STRING is non-nil and a string value then display this
additional info after the source name by overlay."
(unless (bobp)
(let ((start (point)))
(insert (propertize "\n" 'face 'helm-eob-line))
(put-text-property start (point) 'helm-header-separator t)))
(let ((start (point)))
(insert name)
(put-text-property (pos-bol)
(pos-eol) 'helm-header t)
(when display-string
(overlay-put (make-overlay (pos-bol) (pos-eol))
'display display-string))
(insert "\n")
(add-text-properties start (point) '(face helm-source-header
;; Disable line numbers on
;; source headers.
display-line-numbers-disable t))))
(defun helm-insert-candidate-separator ()
"Insert separator of candidates into the Helm buffer."
(insert (propertize helm-candidate-separator 'face 'helm-separator))
(put-text-property (pos-bol)
(pos-eol) 'helm-candidate-separator t)
(insert "\n"))
(defun helm-init-relative-display-line-numbers ()
"Enable `display-line-numbers' for Helm buffers.
This is intended to be added to `helm-after-initialize-hook'.
This will work only in Emacs-26+, i.e. Emacs versions that have
`display-line-numbers-mode'."
(when (boundp 'display-line-numbers)
(with-helm-buffer
(setq display-line-numbers 'relative))))
(define-minor-mode helm-display-line-numbers-mode
"Toggle display of line numbers in current Helm buffer."
:group 'helm
(with-helm-alive-p
(cl-assert (boundp 'display-line-numbers) nil
"`display-line-numbers' not available")
(if helm-display-line-numbers-mode
(with-helm-buffer
(setq display-line-numbers 'relative))
(with-helm-buffer
(setq display-line-numbers nil)))))
(put 'helm-display-line-numbers-mode 'helm-only t)
;;; Async process
;;
(defun helm-output-filter (process output-string)
"The `process-filter' function for Helm async sources."
(with-local-quit
(helm-output-filter-1 (assoc process helm-async-processes) output-string)))
(defun helm-output-filter-1 (process-assoc output-string)
(helm-log "helm-output-filter-1" "output-string = %S" output-string)
(with-current-buffer helm-buffer
(let ((source (cdr process-assoc)))
(save-excursion
(helm-aif (assoc-default 'insertion-marker source)
(goto-char it)
(goto-char (point-max))
(helm-insert-header-from-source source)
(setcdr process-assoc
(append source `((insertion-marker . ,(point-marker))))))
(helm-output-filter--process-source
(car process-assoc) output-string source
(helm-candidate-number-limit source))))
(helm-output-filter--post-process)))
(defun helm-output-filter--process-source (process output-string source limit)
(cl-dolist (candidate (helm-transform-candidates
(helm-output-filter--collect-candidates
(split-string output-string
helm-process-output-split-string-separator)
(assq 'incomplete-line source))
source t))
(setq candidate
(helm--maybe-process-filter-one-by-one-candidate candidate source))
(if (assq 'multiline source)
(let ((start (point)))
(helm-insert-candidate-separator)
(helm-insert-match candidate 'insert-before-markers
(1+ (cdr (assq 'item-count source)))
source)
(put-text-property start (point) 'helm-multiline t))
(helm-insert-match candidate 'insert-before-markers
(1+ (cdr (assq 'item-count source)))
source))
(cl-incf (cdr (assq 'item-count source)))
(when (>= (assoc-default 'item-count source) limit)
(helm-kill-async-process process)
(helm-log-run-hook "helm-output-filter--process-source"
'helm-async-outer-limit-hook)
(cl-return))))
(defun helm-output-filter--collect-candidates (lines incomplete-line-info)
"Collect LINES maybe completing the truncated first and last lines."
;; The output of process may come in chunks of any size, so the last
;; line of LINES could be truncated, this truncated line is stored
;; in INCOMPLETE-LINE-INFO to be concatenated with the first
;; incomplete line of the next arriving chunk. INCOMPLETE-LINE-INFO
;; is an attribute of source; it is created with an empty string
;; when the source is computed => (incomplete-line . "")
(helm-log "helm-output-filter--collect-candidates"
"incomplete-line-info = %S" (cdr incomplete-line-info))
(butlast
(cl-loop for line in lines
;; On start `incomplete-line-info' value is empty string.
for newline = (helm-aif (cdr incomplete-line-info)
(prog1
(concat it line)
(setcdr incomplete-line-info nil))
line)
collect newline
;; Store last incomplete line (last chunk truncated) until
;; new output arrives. Previously storing 'line' in
;; incomplete-line-info assumed output was truncated in
;; only two chunks. But output could be large and
;; truncated in more than two chunks. Therefore store
;; 'newline' to contain the previous chunks (Bug#1187).
finally do (setcdr incomplete-line-info newline))))
(defun helm-output-filter--post-process ()
(helm-aif (get-buffer-window helm-buffer 'visible)
(with-selected-window it
(helm-skip-noncandidate-line 'next)
(helm-mark-current-line nil 'nomouse)
;; FIXME Don't hardcode follow delay.
(helm-follow-execute-persistent-action-maybe 0.5)
(helm-display-mode-line (helm-get-current-source))
(helm-log-run-hook "helm-output-filter--post-process"
'helm-after-update-hook)
(helm--reset-update-flag))))
(defun helm-process-deferred-sentinel-hook (process event file)
"Defer remote processes in sentinels.
Meant to be called at the beginning of a sentinel process
function."
(when (and (not (zerop helm-tramp-connection-min-time-diff))
(string= event "finished\n")
(or (file-remote-p file)
;; `helm-suspend-update-flag'
;; is non-`nil' here only during a
;; running process, this will never be called
;; when user set it explicitly with `C-!'.
helm-suspend-update-flag))
(setq helm-suspend-update-flag t)
;; Kill the process but don't delete entry in
;; `helm-async-processes'.
(helm-kill-async-process process)
;; When tramp opens the same connection twice in less than 5
;; seconds, it throws 'suppress, which calls the real-handler on
;; the main "Emacs". To avoid this [1] helm waits for 5 seconds
;; before updates yet allows user input during this delay. [1] In
;; recent Emacs versions, this has been fixed so tramp returns nil
;; in such conditions. Note: `tramp-connection-min-time-diff' cannot
;; have values less than 5 seconds otherwise the process dies.
(run-at-time helm-tramp-connection-min-time-diff
nil (lambda ()
(when helm-alive-p ; Don't run timer fn after quit.
(setq helm-suspend-update-flag nil)
(helm-check-minibuffer-input))))))
(defun helm-kill-async-processes ()
"Kill all asynchronous processes registered in `helm-async-processes'."
(while helm-async-processes
(helm-kill-async-process (caar helm-async-processes))
(setq helm-async-processes (cdr helm-async-processes))))
(defun helm-kill-async-process (process)
"Stop output from `helm-output-filter' and kill associated PROCESS."
(set-process-filter process nil)
(delete-process process))
;;; Actions
;;
(defun helm-execute-selection-action ()
"Execute current action."
(helm-log-run-hook "helm-execute-selection-action"
'helm-before-action-hook)
;; Position can be change when `helm-current-buffer'
;; is split, so jump to this position before executing action.
(helm-current-position 'restore)
(unwind-protect
(prog1 (helm-execute-selection-action-1)
(helm-log-run-hook "helm-execute-selection-action"
'helm-after-action-hook))
(setq helm--executing-helm-action nil)))
(defun helm-execute-selection-action-1 (&optional
selection action
preserve-saved-action)
"Execute ACTION on current SELECTION.
If PRESERVE-SAVED-ACTION is non-nil, then save the action."
(helm-log "helm-execute-selection-action-1" "executing action")
(setq action (helm-get-default-action
(or action
helm-saved-action
(if (get-buffer helm-action-buffer)
(helm-get-selection helm-action-buffer)
(helm-get-actions-from-current-source)))))
(helm-aif (and (not helm-in-persistent-action)
(get-buffer helm-action-buffer))
(kill-buffer it))
(let ((source (or helm-saved-current-source
(helm-get-current-source)))
non-essential)
(setq selection (helm-coerce-selection
(or selection
helm-saved-selection
(helm-get-selection nil nil source)
(and (assq 'accept-empty source) ""))
source))
(unless preserve-saved-action (setq helm-saved-action nil))
(when (and selection action) (funcall action selection))))
(defun helm-coerce-selection (selection source)
"Apply coerce attribute function to SELECTION in SOURCE.
Coerce source with coerce function."
(helm-aif (assoc-default 'coerce source)
(helm-apply-functions-from-source source it selection)
selection))
(defun helm-get-default-action (action)
"Get the first ACTION value of action list in source."
(if (and (listp action) (not (functionp action)))
(cdar action)
action))
(defun helm--show-action-window-other-window-p ()
"Decide if window layout is suitable for showing action buffer.
Note that the return value is meaningful only at some point in the code,
i.e. before displaying action menu."
(when helm-show-action-window-other-window
;; We were previously checking helm-split-window-state (eq vertical) to
;; decide to show action window, we now show it inconditionally in such case
;; but 'below'.
(if (< (window-width (helm-window))
(or split-width-threshold 160))
'below
helm-show-action-window-other-window)))
(defun helm-select-action ()
"Select an action for the currently selected candidate.
If action buffer is selected, back to the Helm buffer."
(interactive)
(with-helm-alive-p
(let ((src (helm-get-current-source)))
(helm-log-run-hook "helm-select-action" 'helm-select-action-hook)
(setq helm-saved-selection (helm-get-selection nil nil src))
(with-selected-frame (with-helm-window (selected-frame))
(prog1
(helm-acond ((get-buffer-window helm-action-buffer 'visible)
(let ((delta (window-total-height it)))
(set-window-buffer it helm-buffer)
(helm--set-action-prompt 'restore)
;; If `helm-show-action-window-other-window' is non nil
;; we should have now two windows displaying
;; helm-buffer, delete the one that was handling
;; previously action buffer.
(when (helm--show-action-window-other-window-p)
(delete-window it))
;; Resize window on horizontal split, though for some
;; reasons only 'above' needs to be resized.
(when (memq helm-show-action-window-other-window '(below above))
(window-resize (get-buffer-window helm-buffer) delta))
(kill-buffer helm-action-buffer)
(setq helm-saved-selection nil)
(helm-set-pattern helm-input 'noupdate)
;; Maybe hide minibuffer if helm was showing
;; minibuffer in header-line and we are just toggling
;; menu [1].
(helm-hide-minibuffer-maybe)))
(helm-saved-selection
(setq helm-saved-current-source src)
(let ((actions (helm-get-actions-from-current-source src))
helm-onewindow-p)
(if (functionp actions)
(message "Sole action: %s"
;; lambdas are no more represented as list in
;; Emacs-29+ Bug#2666.
(if (or (not (symbolp actions))
(byte-code-function-p actions)
(helm-subr-native-elisp-p actions))
"Anonymous" actions))
(helm-show-action-buffer actions)
;; Be sure the minibuffer is entirely deleted
;; (bug#907). Previously this was done from
;; `helm--delete-minibuffer-contents-from' which
;; was itself force updating, now do it explicitely
;; from here.
(helm-set-pattern "" t)
(helm-force-update nil)
;; Unhide minibuffer to make visible action prompt [1].
(with-selected-window (minibuffer-window)
(remove-overlays) (setq cursor-type t))
(helm--set-action-prompt)
(helm-check-minibuffer-input))))
(t (message "No Actions available")))
(helm-display-mode-line (helm-get-current-source))
(run-hooks 'helm-window-configuration-hook))))))
(put 'helm-select-action 'helm-only t)
(defun helm-menu-select-action (_event)
"Popup action menu from mouse-3."
(interactive "e")
(if (get-buffer-window helm-action-buffer 'visible)
(helm-select-action)
(let ((src (helm-get-current-source)))
(helm-aif (helm-get-actions-from-current-source src)
(progn
(setq helm-saved-current-source src)
(if (functionp it)
(message "Sole action: %s"
;; lambdas are no more represented as list in
;; Emacs-29+ Bug#2666.
(if (or (not (symbolp it))
(byte-code-function-p it)
(helm-subr-native-elisp-p it))
"Anonymous" it))
(setq helm-saved-action
(x-popup-menu
t (list "Available Actions"
(cons "" it))))
(helm-maybe-exit-minibuffer))
(message "No Actions available"))))))
(put 'helm-menu-select-action 'helm-only t)
(defun helm--set-action-prompt (&optional restore)
(with-selected-window (minibuffer-window)
(let ((inhibit-read-only t)
(props '(face minibuffer-prompt
field t
read-only t
rear-nonsticky t
front-sticky t))
(prt (if restore helm--prompt helm--action-prompt)))
(erase-buffer)
(insert (apply #'propertize prt props))
;; Restore minibuffer depth indicator if the mode is enabled.
(when minibuffer-depth-indicate-mode
(minibuffer-depth-setup)))))
(defun helm-show-action-buffer (actions)
(with-current-buffer (get-buffer-create helm-action-buffer)
(erase-buffer)
(buffer-disable-undo)
(setq cursor-type nil)
;; Maybe display action buffer 'below' if window isn't large enough
;; (bug#2635).
(set-window-buffer (helm-aif (helm--show-action-window-other-window-p)
(split-window (get-buffer-window helm-buffer) nil it)
(get-buffer-window helm-buffer))
helm-action-buffer)
(set (make-local-variable 'helm-sources)
(list
(helm-build-sync-source "Actions"
:volatile t
:nomark t
:persistent-action #'ignore
:persistent-help "DoNothing"
:keymap 'helm-map
:candidates actions
:mode-line '("Action(s)" "\\\\[helm-select-action]:BackToCands RET/f1/f2/fn:NthAct")
:candidate-transformer
(lambda (candidates)
(cl-loop for (i . j) in candidates
for count from 1
collect
(cons (concat (cond ((> count 12)
" ")
((< count 10)
(format "[f%s] " count))
(t (format "[f%s] " count)))
(propertize i 'face 'helm-action))
j)))
:candidate-number-limit nil)))
(set (make-local-variable 'helm-source-filter) nil)
(set (make-local-variable 'helm-selection-overlay) nil)
(helm-initialize-overlays helm-action-buffer)))
;; Selection of candidates
(defun helm-display-source-at-screen-top-maybe (unit)
"Display source at the top of screen when UNIT value is \\='source.
Return nil for any other value of UNIT."
(when (and helm-display-source-at-screen-top (eq unit 'source))
(set-window-start (selected-window)
(save-excursion (forward-line -1) (point)))))
(defun helm-skip-noncandidate-line (direction)
"Skip source header or candidates separator when going in DIRECTION.
DIRECTION is either \\='next or \\='previous.
Same as `helm-skip-header-and-separator-line' but ensure point is
moved to the right place when at bob or eob."
(helm-skip-header-and-separator-line direction)
(and (bobp) (forward-line 1)) ; Skip first header.
(and (eobp) (forward-line -1))) ; Avoid last empty line.
(defun helm-skip-header-and-separator-line (direction)
"Skip source header or candidate separator when going to next/previous line.
DIRECTION is either \\='next or \\='previous."
(let ((fn (cl-ecase direction
(next 'eobp)
(previous 'bobp))))
(while (and (not (funcall fn))
(or (helm-pos-header-line-p)
(helm-pos-candidate-separator-p)))
(forward-line (if (and (eq direction 'previous)
(not (eq (pos-bol) (point-min))))
-1 1)))))
(defun helm-display-mode-line (source &optional force)
"Set up mode-line and header-line for `helm-buffer'.
SOURCE is a Helm source object.
Optional argument FORCE forces redisplay of the Helm buffer's
mode and header lines."
(set (make-local-variable 'helm-mode-line-string)
(helm-interpret-value (or (and (listp source) ; Check if source is empty.
(assoc-default 'mode-line source))
(default-value 'helm-mode-line-string))
source))
(let* ((src-name (assoc-default 'name source))
(follow (and (or (helm-follow-mode-p source)
(and helm-follow-mode-persistent
(member src-name helm-source-names-using-follow)))
" (HF)"))
(marked (if (assoc-default 'all-marked source)
helm-marked-candidates
(cl-loop for c in helm-marked-candidates
for name = (assoc-default 'name (car c))
when (string= name src-name)
collect c))))
;; Setup mode-line.
(if helm-mode-line-string
(setq mode-line-format
`(:propertize
(" " mode-line-buffer-identification " "
(:eval (format "L%-3d" (helm-candidate-number-at-point)))
,follow
" "
(:eval ,(and marked
(propertize
(format "M%d" (length marked))
'face 'helm-visible-mark)))
(:eval (when ,helm--mode-line-display-prefarg
(let ((arg (prefix-numeric-value
(or prefix-arg current-prefix-arg))))
(unless (= arg 1)
(propertize (format " [prefarg:%s]" arg)
'face 'helm-prefarg)))))
" "
(:eval (with-helm-buffer
(helm-show-candidate-number
(car-safe helm-mode-line-string))))
" " helm--mode-line-string-real " "
(:eval (make-string (window-width) ? )))
keymap (keymap (mode-line keymap
(mouse-1 . ignore)
(down-mouse-1 . ignore)
(drag-mouse-1 . ignore)
(mouse-2 . ignore)
(down-mouse-2 . ignore)
(drag-mouse-2 . ignore)
(mouse-3 . ignore)
(down-mouse-3 . ignore)
(drag-mouse-3 . ignore))))
helm--mode-line-string-real
(substitute-command-keys (if (listp helm-mode-line-string)
(cadr helm-mode-line-string)
helm-mode-line-string)))
(setq mode-line-format (default-value 'mode-line-format)))
;; Setup header-line.
(cond (helm-echo-input-in-header-line
(setq force t)
(helm--set-header-line))
(helm-display-header-line
(let ((hlstr (helm-interpret-value
(and (listp source)
(assoc-default 'header-line source))
source))
(endstr (make-string (window-width) ? )))
(setq header-line-format
(propertize (concat " " hlstr endstr)
'face 'helm-header))))))
(when force (force-mode-line-update)))
(defun helm--set-header-line (&optional update)
(with-selected-window (minibuffer-window)
(when helm-display-header-line
;; Prevent cursor movement over the overlay displaying
;; persistent-help in minibuffer (Bug#2108).
(setq-local disable-point-adjustment t))
(let* ((beg (save-excursion (vertical-motion 0 (helm-window)) (point)))
(end (save-excursion (end-of-visual-line) (point)))
;; The visual line where the cursor is.
(cont (buffer-substring beg end))
(pref (propertize
" "
'display (if (string-match-p (regexp-opt `(,helm--prompt
,helm--action-prompt))
cont)
`(space :width ,helm-header-line-space-before-prompt)
(propertize
"->"
'face 'helm-header-line-left-margin))))
(pos (- (point) beg)))
;; Increment pos each time we find a "%" up to current-pos (bug#1648).
(cl-loop for c across (buffer-substring-no-properties beg (point))
when (eql c ?%) do (cl-incf pos))
;; Increment pos when cursor is on a "%" to make it visible in header-line
;; i.e "%%|" and not "%|%" (bug#1649).
(when (eql (char-after) ?%) (setq pos (1+ pos)))
(setq cont (replace-regexp-in-string "%" "%%" cont))
(with-helm-buffer
(setq header-line-format (concat pref cont " "))
(funcall helm-default-prompt-display-function pos)
(when update (force-mode-line-update))))))
(defun helm-set-default-prompt-display (pos)
(put-text-property
;; Increment pos to handle the space before prompt (i.e `pref').
(+ 1 pos) (+ 2 pos)
'face
;; Don't just use cursor face, this can hide the current character.
(list :inverse-video t
:foreground (face-background 'cursor)
:background (face-background 'default))
header-line-format))
(defun helm-exchange-minibuffer-and-header-line ()
"Display minibuffer in header-line and vice versa for current Helm session.
This is a toggle command."
(interactive)
(cl-assert (not (eq (helm-get-attr 'echo-input-in-header-line) 'never))
nil "echo-input-in-header-line not allowed in this source")
(with-helm-window
(add-hook 'helm-minibuffer-set-up-hook 'helm-hide-minibuffer-maybe)
(setq-local helm-echo-input-in-header-line
(not helm-echo-input-in-header-line))
(with-selected-window (minibuffer-window)
(if (with-helm-buffer helm-echo-input-in-header-line)
(helm-hide-minibuffer-maybe)
(remove-overlays)
(setq cursor-type t)))
(helm-display-mode-line (helm-get-current-source) t)))
(put 'helm-exchange-minibuffer-and-header-line 'helm-only t)
(defun helm--update-header-line ()
;; This should be used in `post-command-hook',
;; nowhere else.
(when (with-helm-buffer helm-echo-input-in-header-line)
(helm--set-header-line t)))
;; We were previously let-binding `resize-mini-windows' in
;; `helm-read-from-minibuffer', this to prevent minibuffer resizing when
;; inserting multiline string in fake minibuffer (header-line).
;; I seems it had no effect see bug#2638.
(defun helm-hide-minibuffer-maybe ()
"Hide minibuffer contents in a Helm session.
This function should normally go to `helm-minibuffer-set-up-hook'.
It has no effect if `helm-echo-input-in-header-line' is nil."
(when (with-helm-buffer helm-echo-input-in-header-line)
(let ((ov (make-overlay (point-min) (point-max) nil nil t)))
(overlay-put ov 'window (selected-window))
(helm-aif (and helm-display-header-line
(helm-get-attr 'persistent-help))
(progn
(overlay-put ov 'display
(truncate-string-to-width
(substitute-command-keys
(concat "\\\\[helm-execute-persistent-action]: "
(format "%s (keeping session)" it)))
(- (window-width) 1)))
(overlay-put ov 'face 'helm-header))
(overlay-put ov 'face (let ((bg-color (face-background 'default nil)))
`(:background ,bg-color :foreground ,bg-color))))
(setq cursor-type nil))))
(defun helm-show-candidate-number (&optional name)
"Used to display candidate number in mode-line.
You can specify NAME of candidates e.g. \"Buffers\" otherwise it
is \"Candidate(s)\" by default."
(when helm-alive-p
(unless (helm-empty-source-p)
;; Build a fixed width string when candidate-number < 1000
(let* ((cand-name (or name "Candidate(s)"))
(width (length (format "[999 %s]" cand-name))))
(propertize
(format (concat "%-" (number-to-string width) "s")
(format "[%s %s]"
(helm-get-candidate-number 'in-current-source)
cand-name))
'face (if helm-suspend-update-flag
'helm-candidate-number-suspended
'helm-candidate-number))))))
(cl-defun helm-move-selection-common (&key where direction (follow t))
"Move the selection marker to a new position.
Position is determined by WHERE and DIRECTION.
Key arg WHERE can be one of:
- line
- page
- edge
- source
Key arg DIRECTION can be one of:
- previous
- next
- A source or a source name when used with :WHERE \\='source."
(let ((move-func (cl-case where
(line (cl-ecase direction
(previous 'helm-move--previous-line-fn)
(next 'helm-move--next-line-fn)))
(page (cl-ecase direction
(previous 'helm-move--previous-page-fn)
(next 'helm-move--next-page-fn)))
(edge (cl-ecase direction
(previous 'helm-move--beginning-of-buffer-fn)
(next 'helm-move--end-of-buffer-fn)))
(source (cl-case direction
(previous 'helm-move--previous-source-fn)
(next 'helm-move--next-source-fn)
(t (lambda () ; A source is passed as DIRECTION arg.
(helm-move--goto-source-fn direction)))))))
source)
(unless (or (helm-empty-buffer-p (helm-buffer-get))
(not (helm-window)))
(with-helm-window
(when helm-allow-mouse
(helm--mouse-reset-selection-help-echo))
(helm-log-run-hook "helm-move-selection-common"
'helm-move-selection-before-hook)
(funcall move-func)
(and (memq direction '(next previous))
(helm-skip-noncandidate-line direction))
(when (helm-pos-multiline-p)
(helm-move--beginning-of-multiline-candidate))
(helm-display-source-at-screen-top-maybe where)
(helm-mark-current-line)
(when follow
(helm-follow-execute-persistent-action-maybe))
(helm-display-mode-line (setq source (helm-get-current-source)))
(helm-log-run-hook "helm-move-selection-common"
'helm-move-selection-after-hook)
(helm--set-minibuffer-completion-confirm source)))))
(defun helm-move--beginning-of-multiline-candidate ()
(let ((header-pos (helm-get-previous-header-pos))
(separator-pos (helm-get-previous-candidate-separator-pos)))
(when header-pos
(goto-char (if (or (null separator-pos)
(< separator-pos header-pos))
header-pos
separator-pos))
(forward-line 1))))
(defun helm-move--previous-multi-line-fn ()
(forward-line -1)
(unless (helm-pos-header-line-p)
(helm-skip-header-and-separator-line 'previous)
(helm-move--beginning-of-multiline-candidate)))
(defun helm-move--previous-line-fn ()
(if (not (helm-pos-multiline-p))
(forward-line -1)
(helm-move--previous-multi-line-fn))
(when (and helm-move-to-line-cycle-in-source
(helm-pos-header-line-p))
(forward-line 1)
(helm-move--end-of-source)
;; We are at end of helm-buffer
;; check if last candidate is a multiline candidate
;; and jump to it
(when (and (eobp)
(save-excursion (forward-line -1) (helm-pos-multiline-p)))
(helm-move--previous-multi-line-fn))))
(defun helm-move--next-multi-line-fn ()
(let ((header-pos (helm-get-next-header-pos))
(separator-pos (helm-get-next-candidate-separator-pos)))
(cond ((and separator-pos
(or (null header-pos) (< separator-pos header-pos)))
(goto-char separator-pos))
(header-pos
(goto-char header-pos)))))
(defun helm-move--next-line-fn ()
(if (not (helm-pos-multiline-p))
(forward-line 1)
(helm-move--next-multi-line-fn))
(when (and helm-move-to-line-cycle-in-source
(or (save-excursion (and (helm-pos-multiline-p)
(goto-char (overlay-end
helm-selection-overlay))
(helm-end-of-source-p t)))
(helm-end-of-source-p t)))
(helm-move--beginning-of-source)
(helm-display-source-at-screen-top-maybe 'source)))
(defun helm-move--previous-page-fn ()
(condition-case nil
(scroll-down helm-scroll-amount)
(beginning-of-buffer (goto-char (point-min)))))
(defun helm-move--next-page-fn ()
(condition-case nil
(scroll-up helm-scroll-amount)
(end-of-buffer (goto-char (point-max)))))
(defun helm-move--beginning-of-buffer-fn ()
(goto-char (point-min)))
(defun helm-move--end-of-buffer-fn ()
(goto-char (point-max)))
(defun helm-move--end-of-source ()
(helm-aif (helm-get-next-header-pos)
(progn (goto-char it) (forward-line -2))
(goto-char (point-max))))
(defun helm-move--beginning-of-source ()
(helm-aif (helm-get-previous-header-pos)
(progn (goto-char it)
(forward-line 1))
(goto-char (point-min))))
(defun helm-move--previous-source-fn ()
(forward-line -1)
(if (bobp)
(goto-char (point-max))
(helm-skip-header-and-separator-line 'previous))
(goto-char (helm-get-previous-header-pos))
(forward-line 1))
(defun helm-move--next-source-fn ()
(goto-char (or (and (not (save-excursion
(forward-line 1) (eobp)))
;; Empty source at eob are just
;; not displayed unless they are dummy.
;; Bug#1117.
(helm-get-next-header-pos))
(point-min))))
(defun helm-move--goto-source-fn (source-or-name)
(goto-char (point-min))
(let ((name (if (stringp source-or-name)
source-or-name
(assoc-default 'name source-or-name))))
(if (or (null name) (string= name ""))
(forward-line 1)
(condition-case err
(while (not (string= name (helm-current-line-contents)))
(goto-char (helm-get-next-header-pos)))
(error (helm-log "helm-move--goto-source-fn" "%S" err))))))
(defun helm-candidate-number-at-point ()
(if helm-alive-p
(with-helm-buffer
(or (get-text-property (point) 'helm-cand-num) 1))
(or (get-text-property (point) 'helm-cand-num) 1)))
(defun helm--next-or-previous-line (direction &optional arg)
;; Be sure to not use this in non--interactives calls.
(let ((helm-move-to-line-cycle-in-source
(and helm-move-to-line-cycle-in-source arg)))
(if (and arg (> arg 1))
(cl-loop with pos = (helm-candidate-number-at-point)
with cand-num = (helm-get-candidate-number t)
with iter = (min arg (if (eq direction 'next)
(- cand-num pos)
(min arg (1- pos))))
for count from 1
while (<= count iter)
do
(helm-move-selection-common :where 'line :direction direction))
(helm-move-selection-common :where 'line :direction direction))))
(defun helm-previous-line (&optional arg)
"Move selection to the ARG previous line(s).
Same behavior as `helm-next-line' when called with a numeric
prefix arg."
(interactive "p")
(with-helm-alive-p
(helm--next-or-previous-line 'previous arg)))
(put 'helm-previous-line 'helm-only t)
(defun helm-next-line (&optional arg)
"Move selection to the next ARG line(s).
When numeric prefix arg is > than the number of candidates, then
move to the last candidate of current source (i.e. don't move to
next source)."
(interactive "p")
(with-helm-alive-p
(helm--next-or-previous-line 'next arg)))
(put 'helm-next-line 'helm-only t)
(defun helm-scroll-up ()
"Scroll up helm-buffer by `helm-scroll-amount' lines."
(interactive)
(with-helm-alive-p
(helm-move-selection-common :where 'page :direction 'previous)))
(put 'helm-scroll-up 'helm-only t)
(defun helm-previous-page ()
"Move selection back with a pageful."
(interactive)
(with-helm-alive-p
(let (helm-scroll-amount)
(helm-move-selection-common :where 'page :direction 'previous))))
(put 'helm-previous-page 'helm-only t)
(defun helm-scroll-down ()
"Scroll down helm-buffer by `helm-scroll-amount' lines."
(interactive)
(with-helm-alive-p
(helm-move-selection-common :where 'page :direction 'next)))
(put 'helm-scroll-down 'helm-only t)
(defun helm-next-page ()
"Move selection forward with a pageful."
(interactive)
(with-helm-alive-p
(let (helm-scroll-amount)
(helm-move-selection-common :where 'page :direction 'next))))
(put 'helm-next-page 'helm-only t)
(defun helm-beginning-of-buffer ()
"Move selection at the top."
(interactive)
(with-helm-alive-p
(helm-move-selection-common :where 'edge :direction 'previous)))
(put 'helm-beginning-of-buffer 'helm-only t)
(defun helm-end-of-buffer ()
"Move selection at the bottom."
(interactive)
(with-helm-alive-p
(helm-move-selection-common :where 'edge :direction 'next)))
(put 'helm-end-of-buffer 'helm-only t)
(defun helm-previous-source ()
"Move selection to the previous source."
(interactive)
(with-helm-alive-p
(helm-move-selection-common :where 'source :direction 'previous)))
(put 'helm-previous-source 'helm-only t)
(defun helm-next-source ()
"Move selection to the next source."
(interactive)
(with-helm-alive-p
(helm-move-selection-common :where 'source :direction 'next)))
(put 'helm-next-source 'helm-only t)
(defun helm-goto-source (&optional source-or-name)
"Move the selection to the source named SOURCE-OR-NAME.
If SOURCE-OR-NAME is empty string or nil go to the first
candidate of first source."
(helm-move-selection-common :where 'source :direction source-or-name))
(defvar helm-follow-action-white-list-commands
'(helm-ff-decrease-image-size-persistent
helm-ff-increase-image-size-persistent
helm-ff-rotate-left-persistent
helm-ff-rotate-right-persistent)
"Allow `helm-follow-action-forward/backward' switching to next file
when one of these commands is the `last-command'.
For example when browsing files with `C-` and rotate the current file,
hitting `C-` again will not switch to next file but kill its buffer.")
(defun helm--follow-action (arg)
(let ((helm--temp-follow-flag t) ; Needed in HFF.
(in-follow-mode (helm-follow-mode-p)))
;; When follow-mode is already enabled, just go to next or
;; previous line.
(when (or (eq last-command 'helm-follow-action-forward)
(eq last-command 'helm-follow-action-backward)
(eq last-command 'helm-execute-persistent-action)
(memq last-command helm-follow-action-white-list-commands)
in-follow-mode)
(if (> arg 0)
(helm-move-selection-common :where 'line
:direction 'next
:follow nil)
(helm-move-selection-common :where 'line
:direction 'previous
:follow nil)))
(unless in-follow-mode
(helm-execute-persistent-action))))
(defun helm-follow-action-forward ()
"Go to next line and execute persistent action."
(interactive)
(with-helm-alive-p (helm--follow-action 1)))
(put 'helm-follow-action-forward 'helm-only t)
(defun helm-follow-action-backward ()
"Go to previous line and execute persistent action."
(interactive)
(with-helm-alive-p (helm--follow-action -1)))
(put 'helm-follow-action-backward 'helm-only t)
(defun helm-mark-current-line (&optional resumep nomouse)
"Move `helm-selection-overlay' to current line.
When RESUMEP is non nil move overlay to `helm-selection-point'.
When NOMOUSE is specified do not set mouse bindings.
Note that selection is unrelated to visible marks used for
marking candidates."
(with-helm-buffer
(when resumep
(goto-char helm-selection-point))
(move-overlay
helm-selection-overlay (pos-bol)
(if (helm-pos-multiline-p)
(let ((header-pos (helm-get-next-header-pos))
(separator-pos (helm-get-next-candidate-separator-pos)))
(or (and (null header-pos) separator-pos)
(and header-pos separator-pos
(< separator-pos header-pos)
separator-pos)
header-pos
(point-max)))
(1+ (pos-eol))))
(setq helm-selection-point (overlay-start helm-selection-overlay))
(when (and helm-allow-mouse (null nomouse) (not resumep))
(helm--bind-mouse-for-selection helm-selection-point))))
(defun helm-confirm-and-exit-minibuffer ()
"Maybe ask for confirmation when exiting helm.
It is similar to `minibuffer-complete-and-exit' adapted to Helm.
If `minibuffer-completion-confirm' value is \\='confirm, send
minibuffer confirm message and exit on next hit. If
`minibuffer-completion-confirm' value is t, don't exit and send
message \\='no match'."
(interactive)
(with-helm-alive-p
(if (and (helm--updating-p)
(null helm--reading-passwd-or-string))
(progn (message "[Display not ready]")
(sit-for 0.5) (message nil)
(helm-update))
(let* ((src (helm-get-current-source))
(empty-buffer-p (with-current-buffer helm-buffer
(eq (point-min) (point-max))))
(unknown (and (not empty-buffer-p)
;; Now such candidates have a helm-new-file or an
;; unknown text property (we were testing if string
;; match [?] previously).
(helm-candidate-prefixed-p
(helm-get-selection nil 'withprop src)))))
(cond ((and (or empty-buffer-p unknown)
(memq minibuffer-completion-confirm
'(confirm confirm-after-completion)))
(setq helm-minibuffer-confirm-state
'confirm)
(setq minibuffer-completion-confirm nil)
(minibuffer-message " [confirm]"))
;; When require-match is strict (i.e. `t'), buffer
;; should be either empty or in read-file-name have an
;; unknown candidate ([+] prefix), if it's not the case
;; fix it in helm-mode but not here.
;; When `minibuffer-completion-confirm' is set to 'noexit or
;; 'exit, that's mean MUST-MATCH is a function and we use its
;; return value to set `minibuffer-completion-confirm', this is
;; done in `helm--set-minibuffer-completion-confirm'.
((or (eq minibuffer-completion-confirm 'noexit)
(and (or empty-buffer-p unknown)
(eq minibuffer-completion-confirm t)))
(minibuffer-message " [No match]"))
(empty-buffer-p
;; This is used when helm-buffer is totally empty,
;; i.e. the [+] have not been added because must-match
;; is used from outside helm-comp-read i.e. from a helm
;; source built with :must-match.
(setq helm-saved-selection helm-pattern
helm-saved-action (helm-get-default-action
(assoc-default
'action
(car (with-helm-buffer helm-sources))))
helm-minibuffer-confirm-state nil)
(helm-exit-minibuffer))
(t
(setq helm-minibuffer-confirm-state nil)
(helm-exit-minibuffer)))))))
(put 'helm-confirm-and-exit-minibuffer 'helm-only t)
(defun helm-confirm-and-exit-hook ()
"Restore `minibuffer-completion-confirm' when helm update."
(unless (or (eq minibuffer-completion-confirm t)
(not helm-minibuffer-confirm-state))
(setq minibuffer-completion-confirm
helm-minibuffer-confirm-state)))
(add-hook 'helm-after-update-hook 'helm-confirm-and-exit-hook)
(defun helm--set-minibuffer-completion-confirm (src)
"Return the value of a REQUIRE-MATCH arg in a `completing-read'."
;; Set `minibuffer-completion-confirm' to 'noexit or
;; 'exit, according to MUST-MATCH value (possibly a function).
(with-helm-buffer
(setq minibuffer-completion-confirm
(helm-acase (helm-get-attr 'must-match src)
((guard* (and (functionp it)
(helm-get-selection nil nil src)))
(if (funcall it guard) 'exit 'noexit))
(t it)))))
(defun helm-read-string (prompt &optional initial-input history
default-value inherit-input-method)
"Same as `read-string' but for reading string from a helm session."
(let ((helm--reading-passwd-or-string t))
(read-string
prompt initial-input history default-value inherit-input-method)))
(defun helm--updating-p ()
;; helm timer is between two cycles.
;; IOW `helm-check-minibuffer-input' haven't yet compared input
;; and `helm-pattern'.
(or (not (equal (minibuffer-contents) helm-pattern))
;; `helm-check-minibuffer-input' have launched `helm-update'.
helm--in-update))
(defun helm-maybe-exit-minibuffer ()
(interactive)
(with-helm-alive-p
(if (and (helm--updating-p)
(null helm--reading-passwd-or-string))
(progn
(message "[Display not ready]")
(sit-for 0.5) (message nil)
(helm-update))
(helm-exit-minibuffer))))
(put 'helm-maybe-exit-minibuffer 'helm-only t)
(defun helm-exit-minibuffer ()
"Select the current candidate by exiting the minibuffer."
(unless helm-current-prefix-arg
(setq helm-current-prefix-arg current-prefix-arg))
(setq helm-exit-status 0)
(helm-log-run-hook "helm-exit-minibuffer"
'helm-exit-minibuffer-hook)
(exit-minibuffer))
(defun helm-keyboard-quit ()
"Quit minibuffer in helm.
If action buffer is displayed, kill it."
(interactive)
(with-helm-alive-p
(when (get-buffer-window helm-action-buffer 'visible)
(kill-buffer helm-action-buffer))
(setq helm-exit-status 1)
(abort-recursive-edit)))
(put 'helm-keyboard-quit 'helm-only t)
(defun helm-get-next-header-pos ()
"Return the position of the next header from point."
(next-single-property-change (point) 'helm-header))
(defun helm-get-previous-header-pos ()
"Return the position of the previous header from point."
(previous-single-property-change (point) 'helm-header))
(defun helm-pos-multiline-p ()
"Return non-`nil' if the current position is in the multiline source region."
(get-text-property (point) 'helm-multiline))
(defun helm-get-next-candidate-separator-pos ()
"Return the position of the next candidate separator from point."
(let ((hp (helm-get-next-header-pos)))
(helm-aif (next-single-property-change (point) 'helm-candidate-separator)
(or
;; Be sure we don't catch
;; the separator of next source.
(and hp (< it hp) it)
;; The separator found is in next source
;; we are at last cand, so use the header pos.
(and hp (< hp it) hp)
;; A single source, just try next separator.
it))))
(defun helm-get-previous-candidate-separator-pos ()
"Return the position of the previous candidate separator from point."
(previous-single-property-change (point) 'helm-candidate-separator))
(defun helm-pos-header-line-p ()
"Return t if the current line is a header line."
(or (get-text-property (pos-bol) 'helm-header)
(get-text-property (pos-bol) 'helm-header-separator)))
(defun helm-pos-candidate-separator-p ()
"Return t if the current line is a candidate separator."
(get-text-property (pos-bol) 'helm-candidate-separator))
;;; Debugging
;;
;;
(defun helm-debug-output ()
"Show all Helm locals variables and output of `helm-debug-function'."
(interactive)
(with-helm-alive-p
(helm-help-internal helm-debug-output-buffer 'helm-debug-output-function)))
(put 'helm-debug-output 'helm-only t)
(defun helm-default-debug-function ()
"Collect sources of helm current session without their keymap.
This is the default function for `helm-debug-function'."
(cl-loop for source in (with-helm-buffer helm-sources)
collect (remove (assq 'keymap source) source)))
(defun helm-debug-output-function ()
(let ((local-vars (buffer-local-variables (get-buffer helm-buffer)))
(count 1))
(insert (format "* Helm debug from `%s' buffer\n\n" helm-buffer))
(insert "** Local variables\n\n#+begin_src elisp\n"
(pp-to-string (remove (assq 'helm-sources local-vars) local-vars))
"\n#+end_src\n")
(dolist-with-progress-reporter (v (helm-interpret-value helm-debug-function))
"Calculating all helm-related values..."
(insert (format "** Value%s\n" count)
"#+begin_src elisp\n" (pp-to-string v) "\n#+end_src\n")
(cl-incf count))))
(defun helm-enable-or-switch-to-debug ()
"First hit enable helm debugging, second hit switch to debug buffer."
(interactive)
(with-helm-alive-p
(if helm-debug
(helm-run-after-exit
#'helm-debug-open-last-log)
(setq helm-debug t)
(with-helm-buffer (setq truncate-lines nil))
(message "Debugging enabled"))))
(put 'helm-enable-or-switch-to-debug 'helm-only t)
;; Misc
(defun helm-preselect (candidate-or-regexp &optional source)
"Move selection to CANDIDATE-OR-REGEXP.
CANDIDATE-OR-REGEXP can be a:
- String
- Cons cell of two strings
- Nullary function, which moves to a candidate
When CANDIDATE-OR-REGEXP is a cons cell, tries moving to first
element of the cons cell, then the second, and so on. This
allows selection of duplicate candidates after the first.
When SOURCE is specified, move to it and search
CANDIDATE-OR-REGEXP from there."
(with-helm-buffer
(when candidate-or-regexp
(if source
(progn (helm-goto-source source) (forward-line 1))
(goto-char (point-min))
(forward-line 1))
(if (functionp candidate-or-regexp)
(funcall candidate-or-regexp)
(let ((start (point)) mp)
(helm-awhile (if (consp candidate-or-regexp)
(and (re-search-forward (car candidate-or-regexp) nil t)
(re-search-forward (cdr candidate-or-regexp) nil t))
(re-search-forward candidate-or-regexp nil t))
;; If search fall on an header line continue loop
;; until it match or fail (Bug#1509).
(unless (helm-pos-header-line-p) (cl-return (setq mp it))))
(goto-char (or mp start)))))
(forward-line 0) ; Avoid scrolling right on long lines.
(when (helm-pos-multiline-p)
(helm-move--beginning-of-multiline-candidate))
(when (helm-pos-header-line-p) (forward-line 1))
(when helm-allow-mouse
(helm--mouse-reset-selection-help-echo))
(helm-mark-current-line)
(when helm--deleting-minibuffer-contents-from (recenter))
(helm-display-mode-line (or source (helm-get-current-source)))
(helm-log-run-hook "helm-preselect" 'helm-after-preselection-hook)))
(defun helm-delete-current-selection ()
"Delete the currently selected item."
(with-helm-window
(cond ((helm-pos-multiline-p)
(helm-aif (helm-get-next-candidate-separator-pos)
(delete-region (pos-bol)
(1+ (progn (goto-char it) (pos-eol))))
;; last candidate
(goto-char (helm-get-previous-candidate-separator-pos))
(delete-region (pos-bol) (point-max)))
(when (helm-end-of-source-p)
(goto-char (or (helm-get-previous-candidate-separator-pos)
(point-min)))
(forward-line 1)))
(t
(delete-region (pos-bol) (1+ (pos-eol)))
(when (helm-end-of-source-p t)
(let ((headp (save-excursion
(forward-line -1)
(not (helm-pos-header-line-p)))))
(and headp (forward-line -1))))))
(unless (helm-end-of-source-p t)
(helm-mark-current-line))))
(defun helm-end-of-source-1 (n at-point)
(save-excursion
(if (and (helm-pos-multiline-p) (null at-point))
(null (helm-get-next-candidate-separator-pos))
(forward-line (if at-point 0 n))
(or (eq (pos-bol) (pos-eol))
(helm-pos-header-line-p)
(if (< n 0) (bobp) (eobp))))))
(defun helm-end-of-source-p (&optional at-point)
"Return non-nil if we are at EOB or end of source."
(helm-end-of-source-1 1 at-point))
(defun helm-beginning-of-source-p (&optional at-point)
"Return non-nil if we are at BOB or beginning of source."
(helm-end-of-source-1 -1 at-point))
(defun helm--edit-current-selection-internal (func)
(with-helm-window
(forward-line 0)
(let ((realvalue (get-text-property (point) 'helm-realvalue))
(multiline (get-text-property (point) 'helm-multiline)))
(funcall func)
(forward-line 0)
(and realvalue
(put-text-property (point) (pos-eol)
'helm-realvalue realvalue))
(and multiline
(put-text-property (point)
(or (helm-get-next-candidate-separator-pos)
(point-max))
'helm-multiline multiline))
(helm-mark-current-line))))
(defmacro helm-edit-current-selection (&rest forms)
"Evaluate FORMS at current selection in the helm buffer.
Used generally to modify current selection."
(declare (indent 0) (debug t))
`(helm--edit-current-selection-internal
(lambda () ,@forms)))
(defun helm--delete-minibuffer-contents-from (from-str &optional presel)
;; Giving an empty string value to FROM-STR delete all.
(let ((input (minibuffer-contents))
(src (and presel (helm-get-current-source)))
(helm--deleting-minibuffer-contents-from presel)
helm-move-to-line-cycle-in-source)
(helm-reset-yank-point)
(unless (zerop (length input))
;; minibuffer is not empty, delete contents from end
;; of FROM-STR and update.
(helm-set-pattern from-str t)
(helm-update presel src))))
(defun helm-delete-minibuffer-contents (&optional arg)
"Delete minibuffer contents.
When `helm-delete-minibuffer-contents-from-point' is non-nil, delete
minibuffer contents from point instead of deleting all. With a prefix
ARG reverse this behaviour. When at the end of minibuffer, delete all
but if a prefix ARG were given also preselect current selection when
updating if possible (selection may be beyond candidate-number-limit)."
(interactive "P")
(with-helm-alive-p
(let ((str (if helm-delete-minibuffer-contents-from-point
(if (or arg (eobp))
"" (helm-minibuffer-completion-contents))
(if (and arg (not (eobp)))
(helm-minibuffer-completion-contents) "")))
(presel (and arg (eobp)
(concat "^" (regexp-quote (helm-get-selection nil t)) "$"))))
(helm--delete-minibuffer-contents-from str presel))))
(put 'helm-delete-minibuffer-contents 'no-helm-mx t)
;;; helm-source-in-buffer.
;;
(defun helm-candidates-in-buffer (&optional source)
"The top level function used to store candidates with `helm-source-in-buffer'.
Candidates are stored in a buffer generated internally by
`helm-candidate-buffer' function. Each candidate must be placed
in one line.
The buffer is created and fed in the init attribute function of
Helm.
E.g.:
(helm-build-in-buffer-source \"test\"
:init (lambda ()
(helm-init-candidates-in-buffer
\\='global \\='(foo foa fob bar baz))))
A shortcut can be used to simplify:
(helm-build-in-buffer-source \"test\"
:data \\='(foo foa fob bar baz))
By default, Helm makes candidates by evaluating the candidates
function, then narrows them by `string-match' for each candidate.
But this is slow for large number of candidates. The new way is
to store all candidates in a buffer and then narrow with
`re-search-forward'. Search function is customizable by search
attribute. The important point is that buffer processing is MUCH
FASTER than string list processing and is the Emacs way.
The init function writes all candidates to a newly-created
candidate buffer. The candidates buffer is created or specified
by `helm-candidate-buffer'. Candidates are stored in a line.
The candidates function narrows all candidates, IOW creates a
subset of candidates dynamically.
Class `helm-source-in-buffer' is implemented with three attributes:
(candidates . helm-candidates-in-buffer)
(volatile)
(match identity)
The volatile attribute is needed because
`helm-candidates-in-buffer' creates candidates dynamically and
need to be called every time `helm-pattern' changes.
Because `helm-candidates-in-buffer' plays the role of `match'
attribute function, specifying `(match identity)' makes the
source slightly faster.
However if source contains `match-part' attribute, match is
computed only on part of candidate returned by the call of
function provided by this attribute. The function should have one
arg, candidate, and return only a specific part of candidate.
To customize `helm-candidates-in-buffer' behaviour, use `search',
`get-line' and `match-part' attributes."
(let ((src (or source (helm-get-current-source))))
(helm-candidates-in-buffer-1
(helm-candidate-buffer)
helm-pattern
(or (assoc-default 'get-line src)
#'buffer-substring-no-properties)
(or (assoc-default 'search src)
'(helm-candidates-in-buffer-search-default-fn))
;; When candidate-transformer is specified in source ALL candidates should
;; be computed with the candidate-transformer function (in contrast with
;; filtered-candidate-transformer). This to be consistent with what sync
;; sources do. The car of the cons is used for initial fetching of
;; candidates whereas the cdr is used after when searching (in this case
;; the candidate number limit is used).
(if (helm-get-attr 'candidate-transformer src)
(cons 99999999 (helm-candidate-number-limit src))
(helm-candidate-number-limit src))
(helm-get-attr 'match-part)
src)))
(defun helm-candidates-in-buffer-search-default-fn (pattern)
"Search PATTERN with `re-search-forward' with bound and noerror args."
(condition-case _err
;; Use helm-re-search-forward to avoid infloop (bug#2657).
(helm-re-search-forward pattern nil t)
(invalid-regexp nil)))
(defun helm-candidates-in-buffer-1 (buffer pattern get-line-fn
search-fns limit
match-part-fn source)
"Return the list of candidates inserted in BUFFER matching PATTERN."
(with-suppressed-warnings ((obsolete inhibit-point-motion-hooks))
;; buffer == nil when candidates buffer does not exist.
(when buffer
(with-current-buffer buffer
(let ((inhibit-point-motion-hooks t)
(start-point (1- (point-min))))
(goto-char start-point)
(if (string= pattern "")
(helm-initial-candidates-from-candidate-buffer
get-line-fn (if (consp limit) (car limit) limit))
(helm-search-from-candidate-buffer
pattern get-line-fn search-fns
(if (consp limit) (cdr limit) limit)
start-point match-part-fn source)))))))
(defun helm-search-from-candidate-buffer (pattern get-line-fn search-fns
limit start-point match-part-fn source)
(let ((inhibit-read-only t)
(diacritics (assoc-default 'diacritics source)))
(helm--search-from-candidate-buffer-1
(lambda ()
(cl-loop with hash = (make-hash-table :test 'equal)
with allow-dups = (assq 'allow-dups source)
with case-fold-search = (helm-set-case-fold-search)
with count = 0
for iter from 1
for searcher in search-fns
do (progn
(goto-char start-point)
;; The character at start-point is a newline,
;; if pattern match it that's mean we are
;; searching for newline in buffer, in this
;; case skip this false line.
;; See comment >>>[1] in
;; `helm--search-from-candidate-buffer-1'.
(and (condition-case nil
(looking-at pattern)
(invalid-regexp nil))
(forward-line 1)))
nconc
(cl-loop with pos-lst
;; POS-LST is used as a flag to decide if we
;; run `helm-search-match-part' even if
;; MATCH-PART isn't specified on source. This
;; happen when fuzzy matching or using a
;; negation (!) in one of the patterns, in
;; these case the searcher returns a list
;; '(BEG END) instead of an integer like
;; `re-search-forward'.
while (and (setq pos-lst (funcall searcher pattern))
;; We were previously forwarding line from
;; searcher and checking then for eobp, as a
;; result the last candidate was always
;; skipped. See bug#2650.
(if (consp pos-lst)
;; With negation the searcher is not
;; forwarding line, we do it from here.
;; If forward-line doesn't return zero,
;; we are at eob.
(zerop (forward-line 1))
(not (eobp)))
(< count limit))
for cand = (apply get-line-fn
(if (and pos-lst (listp pos-lst))
pos-lst
(list (pos-bol) (pos-eol))))
when (and match-part-fn
(not (get-text-property 0 'match-part cand)))
do (setq cand
(propertize cand 'match-part (funcall match-part-fn cand)))
for dup = (gethash cand hash)
when (and (or (and allow-dups dup (= dup iter))
(null dup))
;; Happens with (buffer-substring 1 1) when
;; setting cand above (bug#2651) and create a
;; ghost candidate on top.
(not (string= cand ""))
(or
;; Always collect when cand is matched
;; by searcher funcs and match-part attr
;; is not present.
(and (not match-part-fn)
(not (consp pos-lst)))
;; If match-part attr is present, or if SEARCHER fn
;; returns a cons cell, collect PATTERN only if it
;; match the part of CAND specified by
;; the match-part func.
(helm-search-match-part cand pattern diacritics)))
do (progn
(puthash cand iter hash)
(setq cand (helm--maybe-process-filter-one-by-one-candidate
cand source))
(cl-incf count))
and collect cand))))))
(defun helm-search-match-part (candidate pattern diacritics)
"Match PATTERN only on match-part property value of CANDIDATE.
Because `helm-search-match-part' may be called even if
unspecified in source (negation or fuzzy), the part to match
falls back to the whole candidate even if match-part hasn't been
computed by match-part-fn and stored in the match-part property."
(let ((part (or (get-text-property 0 'match-part candidate)
candidate))
(fuzzy-regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache)))
(matchfn (cond (helm-migemo-mode 'helm-mm-migemo-string-match)
(diacritics 'helm-mm-diacritics-string-match)
(t 'string-match))))
(condition-case _err
(if (string-match " " pattern)
(cl-loop for i in (helm-mm-split-pattern pattern) always
(if (string-match "\\`!" i)
(not (funcall matchfn (substring i 1) part))
(funcall matchfn i part)))
(if (string-match "\\`!" pattern)
(if helm--in-fuzzy
;; Fuzzy regexp have already been
;; computed with substring 1.
(not (string-match fuzzy-regexp part))
(not (funcall matchfn (substring pattern 1) part)))
(funcall matchfn (if helm--in-fuzzy fuzzy-regexp pattern) part)))
(invalid-regexp nil))))
(defun helm-initial-candidates-from-candidate-buffer (get-line-fn limit)
(cl-loop repeat limit
until (eobp)
for line = (funcall get-line-fn (pos-bol) (pos-eol))
when line collect line
do (forward-line 1)))
(defun helm--search-from-candidate-buffer-1 (search-fn)
;; We are adding a newline at bob and at eol
;; and removing these newlines afterward.
;; This is a bad hack that should be removed.
;; To avoid matching the empty line at first line
;; when searching with e.g occur and "^$" just
;; forward-line before searching (See >>>[1] above).
(goto-char (point-min))
(insert "\n")
(goto-char (point-max))
(insert "\n")
(unwind-protect
(funcall search-fn)
(goto-char (point-min))
(delete-char 1)
(goto-char (1- (point-max)))
(delete-char 1)
(set-buffer-modified-p nil)))
(defun helm-candidate-buffer (&optional buffer-spec)
"Register and return a buffer storing candidates of current source.
This is used to initialize a buffer for storing candidates for a
candidates-in-buffer source, candidates will be searched in this
buffer and displayed in `helm-buffer'. This should be used only
in init functions, don't relay on this in other places unless you
know what you are doing.
This function is still in public API only for backward
compatibility, you should use instead
`helm-init-candidates-in-buffer' for initializing your sources.
Internally, this function is called without argument and returns
the buffer corresponding to current source i.e.
`helm--source-name' which is available in only some places.
Acceptable values of BUFFER-SPEC:
- global (a symbol)
Create a new global candidates buffer,
named \" *helm candidates:SOURCE*\".
This is used by `helm-init-candidates-in-buffer' and it is
the most common usage of BUFFER-SPEC.
The buffer will be killed and recreated at each new
helm-session.
- local (a symbol)
Create a new local candidates buffer,
named \" *helm candidates:SOURCE*HELM-CURRENT-BUFFER\".
You may want to use this when you want to have a different
buffer each time source is used from a different
`helm-current-buffer'.
The buffer is erased and refilled at each new session but not
killed. You probably don't want to use this value for
BUFFER-SPEC.
- nil (omit)
Only return the candidates buffer of current source if found.
- A buffer
Register a buffer as a candidates buffer.
The buffer needs to exists, it is not created.
This allow you to use the buffer as a cache, it is faster
because the buffer is already drawn, but be careful when using
this as you may mangle your buffer depending on what you write
in your init(s) function, IOW don't modify the contents of the
buffer in init(s) function but in a transformer.
The buffer is not erased nor deleted.
Generally it is safer to use a copy of buffer inserted
in a global or local buffer.
If for some reasons a global buffer and a local buffer exist and
are belonging to the same source, the local buffer takes
precedence on the global one and is used instead.
When forcing update only the global and local buffers are killed
before running again the init function."
(let ((global-bname (format " *helm candidates:%s*"
helm--source-name))
(local-bname (format " *helm candidates:%s*%s"
helm--source-name
(buffer-name helm-current-buffer))))
(when buffer-spec
;; Register buffer in `helm--candidate-buffer-alist'.
;; This is used only to retrieve buffer associated to current source
;; when using named buffer as value of BUFFER-SPEC.
(setq helm--candidate-buffer-alist
(cons (cons helm--source-name buffer-spec)
(delete (assoc helm--source-name
helm--candidate-buffer-alist)
helm--candidate-buffer-alist)))
;; When using global or local as value of BUFFER-SPEC
;; create the buffer global-bname or local-bname, otherwise
;; reuse the buffer named BUFFER-SPEC.
(unless (bufferp buffer-spec)
;; Global buffers are killed and recreated.
(and (eq buffer-spec 'global)
(buffer-live-p (get-buffer global-bname))
(kill-buffer global-bname))
;; Create global or local buffer.
;; Local buffer, once created are reused and a new one
;; is created when `helm-current-buffer' change across sessions.
(with-current-buffer (get-buffer-create
(helm-acase buffer-spec
(global global-bname)
(local local-bname)
(t (and (stringp buffer-spec)
buffer-spec))))
;; We need a buffer not read-only to perhaps insert later
;; text coming from read-only buffers (Bug#1176).
(set (make-local-variable 'buffer-read-only) nil)
;; Undo is automatically disabled in buffer names starting
;; with a space, so no need to disable it.
(erase-buffer)
(font-lock-mode -1))))
;; Finally return the candidates buffer.
(helm-acond ((get-buffer local-bname))
((get-buffer global-bname))
((assoc-default helm--source-name helm--candidate-buffer-alist)
(and (or (stringp it) (bufferp it))
(buffer-live-p (get-buffer it))
it)))))
(defvar helm-candidate-buffer-longest-len 0
"May store the longest length of candidates in a in-buffer source.
It is a local variable set from `helm-init-candidates-in-buffer' in
`helm-candidate-buffer'.
Allow getting the longest length of initial candidates in transformers
without looping again through the whole list.
It is useful to align extra informations after candidates in `helm-buffer'.")
(defsubst helm-in-buffer-get-longest-candidate ()
"Return the longest candidate recorded in `helm-candidate-buffer'."
(helm-aif (helm-candidate-buffer)
(buffer-local-value
'helm-candidate-buffer-longest-len
(get-buffer it))
0))
(defun helm-make-separator (cand &optional longest)
"Create a separator to align candidates.
Longest candidate should have been calculated at initialization
of `helm-source-in-buffer' by `helm-init-candidates-in-buffer' , otherwise
LONGEST can be used to specify longest candidate."
(let ((lgst (or longest (helm-in-buffer-get-longest-candidate)))
(len (length cand)))
(if (zerop lgst)
" -- " ; For emacs style.
(make-string (1+ (if (>= lgst len)
(- lgst len)
0))
? ))))
(defun helm-init-candidates-in-buffer (buffer-spec data &optional force-longest)
"Register BUFFER-SPEC with DATA for a helm candidates-in-buffer session.
Arg BUFFER-SPEC can be a `buffer-name' (stringp), a buffer-spec
object (bufferp), or a symbol, either \\='local or \\='global which is
passed to `helm-candidate-buffer'.
The most common usage of BUFFER-SPEC is \\='global.
Arg DATA can be either a list or a plain string.
Returns the resulting buffer.
Use this in your init function to register a buffer for a
`helm-source-in-buffer' session and feed it with DATA. You
probably don't want to bother with this and use the :data slot
when initializing a source with `helm-source-in-buffer' class.
When inserting DATA in `helm-candidate-buffer', if DATA is a list the longest
candidate will be recorded in `helm-candidate-buffer-longest-len' local
variable. If DATA is a string, it is inserted directly in
`helm-candidate-buffer' and `helm-candidate-buffer-longest-len' is not computed
unless FORCE-LONGEST is non nil."
(declare (indent 1))
(let ((caching (and (or (stringp buffer-spec)
(bufferp buffer-spec))
(buffer-live-p (get-buffer buffer-spec))))
(buf (helm-candidate-buffer buffer-spec)))
(unless caching
(with-current-buffer buf
(erase-buffer)
(cond ((listp data)
(insert (mapconcat (lambda (elm)
(let ((cand
(helm-acase elm
((guard* (symbolp it))
(symbol-name it))
((guard* (numberp it))
(number-to-string it))
((dst* (disp . real))
(propertize disp 'helm-realvalue real))
(t it))))
(setq-local helm-candidate-buffer-longest-len
(max helm-candidate-buffer-longest-len
(length cand)))
cand))
data "\n")))
((stringp data)
(insert data)
(when force-longest
(setq-local helm-candidate-buffer-longest-len
(helm--get-longest-len-in-buffer))))))
buf)))
(defun helm--get-longest-len-in-buffer ()
"Return length of the longest line in buffer."
(save-excursion
(goto-char (point-min))
(let ((max 0)
len)
(while (not (eobp))
(setq len (- (pos-eol) (pos-bol)))
(when (> len max)
(setq max len))
(forward-line 1))
max)))
;;; Resplit helm window
;;
;;
(defun helm-toggle-resplit-window ()
"Toggle resplit helm window, vertically or horizontally."
(interactive)
(with-helm-alive-p
(if (and (= (length (window-list nil 1)) 2)
(not (window-dedicated-p
(get-buffer-window helm-current-buffer))))
(progn
(when helm-prevent-escaping-from-minibuffer
(helm-prevent-switching-other-window :enabled nil))
(unwind-protect
(with-helm-window
(cond ((or helm-full-frame (one-window-p t))
(user-error "Attempt to resplit a single window"))
((helm-action-window)
(user-error "Can't resplit while selecting actions"))
(t
(let ((before-height (window-height)))
(delete-window)
(set-window-buffer
(select-window
(if (= (window-height) before-height) ; initial split was horizontal.
;; Split window vertically with `helm-buffer' placed
;; on the good side according to actual value of
;; `helm-split-window-default-side'.
(prog1
(cond ((or (eq helm-split-window-default-side 'above)
(eq helm-split-window-default-side 'left))
(split-window
(selected-window) nil 'above))
(t (split-window-vertically)))
(setq helm-split-window-state 'vertical))
;; Split window vertically, same comment as above.
(setq helm-split-window-state 'horizontal)
(cond ((or (eq helm-split-window-default-side 'left)
(eq helm-split-window-default-side 'above))
(split-window (selected-window) nil 'left))
(t (split-window-horizontally)))))
helm-buffer))))
(setq helm--window-side-state (helm--get-window-side-state)))
(when helm-prevent-escaping-from-minibuffer
(helm-prevent-switching-other-window :enabled t))))
(error "current window configuration not suitable for splitting"))))
(put 'helm-toggle-resplit-window 'helm-only t)
;; Utility: Resize helm window.
(defun helm-enlarge-window-1 (n)
"Enlarge or narrow helm window.
If N is positive enlarge, if negative narrow."
(unless helm-full-frame
(let ((horizontal-p (eq helm-split-window-state 'horizontal)))
(with-helm-window
(enlarge-window n horizontal-p)))))
(defun helm-narrow-window ()
"Narrow helm window."
(interactive)
(with-helm-alive-p
(helm-enlarge-window-1 -1)))
(put 'helm-narrow-window 'helm-only t)
(defun helm-enlarge-window ()
"Enlarge helm window."
(interactive)
(with-helm-alive-p
(helm-enlarge-window-1 1)))
(put 'helm-enlarge-window 'helm-only t)
(defun helm-toggle-full-frame (&optional arg)
"Toggle `helm-buffer' full-frame view."
(interactive "p")
(cl-assert (null (helm-action-window))
nil "Unable to toggle full frame from action window")
(when arg ; Called interactively
(cl-assert (null helm--buffer-in-new-frame-p)
nil "Can't toggle full frame when using helm own frame"))
(if (or helm-onewindow-p
(buffer-local-value 'helm-full-frame (get-buffer helm-buffer)))
(with-helm-window
(setq-local helm-full-frame nil)
(setq helm-onewindow-p nil)
(let ((split-window-preferred-function
helm-split-window-preferred-function))
(switch-to-buffer helm-current-buffer)
(helm-display-buffer helm-buffer)
(select-window (minibuffer-window))))
(with-helm-window
(delete-other-windows)
(setq-local helm-full-frame t)
(setq helm-onewindow-p t))))
(put 'helm-toggle-full-frame 'helm-only t)
(defun helm-swap-windows ()
"Swap window holding `helm-buffer' with other window."
(interactive)
(with-helm-alive-p
(if (= (length (window-list nil 1)) 2)
(cond ((and helm-full-frame (one-window-p t))
(user-error "Can't swap windows in a single window"))
((helm-action-window)
(user-error "Can't resplit while selecting actions"))
(t
(let* ((w1 (helm-window))
(split-state (eq helm-split-window-state 'horizontal))
(w1size (window-total-size w1 split-state))
(b1 (window-buffer w1)) ; helm-buffer
(s1 (window-start w1))
(cur-frame (window-frame w1))
(w2 (with-selected-window (helm-window)
;; Don't try to display helm-buffer
;; in a dedicated window.
(get-window-with-predicate
(lambda (w) (not (window-dedicated-p w)))
1 cur-frame)))
(w2size (window-total-size w2 split-state))
(b2 (window-buffer w2)) ; probably helm-current-buffer
(s2 (window-start w2))
resize)
(with-selected-frame (window-frame w1)
(helm-replace-buffer-in-window w1 b1 b2)
(helm-replace-buffer-in-window w2 b2 b1)
(setq resize
(cond ( ;; helm-window is smaller than other window.
(< w1size w2size)
(- (- (max w2size w1size)
(min w2size w1size))))
( ;; helm-window is larger than other window.
(> w1size w2size)
(- (max w2size w1size)
(min w2size w1size)))
( ;; windows have probably same size.
t nil)))
;; Maybe resize the window holding helm-buffer.
(and resize (window-resize w2 resize split-state))
(set-window-start w1 s2 t)
(set-window-start w2 s1 t))
(setq helm--window-side-state (helm--get-window-side-state)))))
(error "current window configuration not suitable for splitting"))))
(put 'helm-swap-windows 'helm-only t)
(defun helm--get-window-side-state ()
"Return the position of `helm-window' from `helm-current-buffer'.
Possible values are \\='left \\='right \\='below or \\='above."
(let ((side-list '(left right below above)))
(cl-loop for side in side-list
thereis (and (equal (helm-window)
(window-in-direction
side (get-buffer-window helm-current-buffer t)
t))
side))))
(defun helm-replace-buffer-in-window (window buffer1 buffer2)
"Replace BUFFER1 by BUFFER2 in WINDOW registering BUFFER1."
(when (get-buffer-window buffer1)
(unrecord-window-buffer window buffer1)
(set-window-buffer window buffer2)))
;; Utility: select another action by key
(defun helm-select-nth-action (n)
"Select the N nth action for the currently selected candidate."
(let ((src (helm-get-current-source)))
(setq helm-saved-selection (helm-get-selection nil nil src))
(unless helm-saved-selection
(error "Nothing is selected"))
(setq helm-saved-action
(helm-get-nth-action
n
(if (get-buffer-window helm-action-buffer 'visible)
(assoc-default 'candidates src)
(helm-get-actions-from-current-source src))))
(helm-maybe-exit-minibuffer)))
(defun helm-get-nth-action (n action)
"Return the nth N action from ACTION.
Argument ACTION can be a symbol or a list of actions."
(cond ((and (zerop n) (functionp action))
action)
((listp action)
(or (cdr (elt action n))
(error "No such action")))
((and (functionp action) (> n 0))
(error "Sole action"))
(t
(error "Error in `helm-select-nth-action'"))))
(defun helm-execute-selection-action-at-nth (linum)
"Execute default action on candidate at LINUM lines from selection."
(let ((prefarg current-prefix-arg))
(if (>= linum 0)
(helm-next-line linum)
(helm-previous-line (lognot (1- linum))))
(setq current-prefix-arg prefarg)
(helm-exit-minibuffer)))
;;; Persistent Action
;;
(defun helm-initialize-persistent-action ()
(set (make-local-variable 'helm-persistent-action-display-window) nil))
(cl-defun helm-execute-persistent-action (&optional attr split)
"Perform the associated action ATTR without quitting helm.
Arg ATTR default will be `persistent-action' or
`persistent-action-if' if unspecified depending on what's found
in source, but it can be anything else.
In this case you have to add this new attribute to your source.
See `persistent-action' and `persistent-action-if' slot
documentation in `helm-source'.
When `helm-full-frame' is non-nil, and `helm-buffer' is displayed
in only one window, the helm window is split to display
`helm-select-persistent-action-window' in other window to
maintain visibility. The argument SPLIT can be used to force
splitting inconditionally, it is unused currently."
(interactive)
(with-suppressed-warnings ((obsolete special-display-regexps)
(obsolete special-display-buffer-names))
(with-helm-alive-p
(let ((source (helm-get-current-source)))
(unless attr
(setq attr (or (car (assq 'persistent-action source))
(car (assq 'persistent-action-if source)))))
(helm-log "helm-execute-persistent-action" "executing persistent-action")
(let* ((selection (and source (helm-get-selection nil nil source)))
(attr-val (if (eq attr 'persistent-action-if)
(funcall (assoc-default attr source) selection)
(assoc-default attr source)))
;; If attr value is a cons, use its car as persistent function.
(fn (if (and (consp attr-val)
;; maybe a lambda.
(not (functionp attr-val)))
(car attr-val) attr-val))
;; And its cdr to decide if helm window should be splitted.
(no-split (and (consp attr-val)
(not (functionp attr-val))
(cdr attr-val)))
;; Is next-window (from helm-window) a suitable window for PA?
(no-suitable-win
(helm-aand (not helm--buffer-in-new-frame-p)
(get-buffer-window helm-current-buffer)
(or (window-dedicated-p it)
(window-parameter it 'window-side))))
(cursor-in-echo-area t)
mode-line-in-non-selected-windows)
(progn
(when (and helm-onewindow-p (null no-split)
(null helm--buffer-in-new-frame-p))
(helm-toggle-full-frame))
(when (eq fn 'ignore)
(cl-return-from helm-execute-persistent-action nil))
(when source
(with-helm-window
(save-selected-window
;; FIXME: Simplify SPLIT behavior, it is a mess currently.
(if no-split
(helm-select-persistent-action-window :split 'never)
(helm-select-persistent-action-window
:split (or split helm-onewindow-p no-suitable-win)))
(helm-log "helm-execute-persistent-action"
"current-buffer = %S" (current-buffer))
(let ((helm-in-persistent-action t)
(display-buffer-alist '((".*" (display-buffer-same-window))))
display-buffer-function pop-up-windows pop-up-frames
special-display-regexps special-display-buffer-names)
(helm-execute-selection-action-1
selection (or fn (helm-get-actions-from-current-source source)) t)
(unless (helm-action-window)
(helm-log-run-hook "helm-execute-persistent-action"
'helm-after-persistent-action-hook)))
;; A typical case is when a persistent action delete
;; the buffer already displayed in
;; `helm-persistent-action-display-window' and `helm-full-frame'
;; is enabled, we end up with the `helm-buffer'
;; displayed in two windows.
(when (and helm-onewindow-p
(> (length (window-list)) 1)
(equal (buffer-name
(window-buffer
helm-persistent-action-display-window))
(helm-buffer-get)))
(delete-other-windows)))))))))))
(put 'helm-execute-persistent-action 'helm-only t)
(cl-defun helm-persistent-action-display-window (&key split)
"Return the window that will be used for persistent action.
If SPLIT is t window is split in persistent action, if it has the
special symbol `never' don't split, if it is nil don't split either.
The symbol `never' is kept for backward compatibility."
(with-helm-window
(setq helm-persistent-action-display-window
(cond ((and (window-live-p helm-persistent-action-display-window)
(not (member helm-persistent-action-display-window
(get-buffer-window-list helm-buffer))))
helm-persistent-action-display-window)
((and helm--buffer-in-new-frame-p helm-initial-frame)
(with-selected-frame helm-initial-frame
(let ((win (selected-window)))
(if (or (window-dedicated-p win)
(window-parameter win 'window-side))
(next-window win 1)
win))))
((and split (not (eq split 'never)))
(split-window))
((get-buffer-window helm-current-buffer))
(t (previous-window (selected-window) 1))))))
(cl-defun helm-select-persistent-action-window (&key split)
"Select the window that will be used for persistent action.
See `helm-persistent-action-display-window' for how to use SPLIT."
(select-window (get-buffer-window (helm-buffer-get)))
(prog1
(select-window
(setq minibuffer-scroll-window
(helm-persistent-action-display-window :split split))
'norecord)
(helm-log "helm-select-persistent-action-window"
"Selected window is %S" minibuffer-scroll-window)))
;;; Scrolling - recentering
;;
;;
(defun helm-other-window-base (command &optional arg)
(let ((minibuffer-scroll-window
(helm-persistent-action-display-window)))
(funcall command (or arg helm-scroll-amount))))
(defun helm-scroll-other-window (&optional arg)
"Scroll other window upward ARG many lines.
When arg is not provided scroll `helm-scroll-amount' lines.
See `scroll-other-window'."
(interactive "P")
(with-helm-alive-p (helm-other-window-base 'scroll-other-window arg)))
(put 'helm-scroll-other-window 'helm-only t)
(defun helm-scroll-other-window-down (&optional arg)
"Scroll other window downward ARG many lines.
When arg is not provided scroll `helm-scroll-amount' lines.
See `scroll-other-window-down'."
(interactive "P")
(with-helm-alive-p (helm-other-window-base 'scroll-other-window-down arg)))
(put 'helm-scroll-other-window-down 'helm-only t)
(defun helm-recenter-top-bottom-other-window (&optional arg)
"Run `recenter-top-bottom' in other window.
Meaning of prefix ARG is the same as in `recenter-top-bottom'."
(interactive "P")
(with-helm-alive-p
(with-helm-window
(with-selected-window (helm-persistent-action-display-window)
(recenter-top-bottom arg)))))
(put 'helm-recenter-top-bottom-other-window 'helm-only t)
(defun helm-reposition-window-other-window (&optional arg)
"Run `reposition-window' in other window.
Meaning of prefix ARG is the same as in `reposition-window'."
(interactive "P")
(with-helm-alive-p
(with-helm-window
(with-selected-window (helm-persistent-action-display-window)
(reposition-window arg)))))
(put 'helm-reposition-window-other-window 'helm-only t)
;; Utility: Visible Mark
(defun helm-clear-visible-mark ()
(with-current-buffer (helm-buffer-get)
(mapc 'delete-overlay helm-visible-mark-overlays)
(set (make-local-variable 'helm-visible-mark-overlays) nil)))
(defun helm-this-visible-mark ()
(cl-loop for o in (overlays-at (point))
when (overlay-get o 'visible-mark)
return o))
(defun helm-delete-visible-mark (overlay)
(let ((src (helm-get-current-source)))
(setq helm-marked-candidates
(remove
(cons src (helm-get-selection nil nil src))
helm-marked-candidates))
(delete-overlay overlay)
(setq helm-visible-mark-overlays
(delq overlay helm-visible-mark-overlays))))
(defun helm-make-visible-mark (&optional src selection)
(let* ((source (or src (helm-get-current-source)))
(sel (or selection (helm-get-selection
nil (helm-get-attr 'marked-with-props source)
source)))
(selection-end (if (helm-pos-multiline-p)
;; Stays within source
(or (helm-get-next-candidate-separator-pos)
(helm-get-next-header-pos)
(point-max))
;; Not multiline
(1+ (pos-eol))))
(o (make-overlay (pos-bol) selection-end)))
(overlay-put o 'priority 0)
(overlay-put o 'face 'helm-visible-mark)
(overlay-put o 'source source)
(overlay-put o 'string (buffer-substring (overlay-start o) (overlay-end o)))
(overlay-put o 'real sel)
(overlay-put o 'before-string (propertize " " 'display
`((margin left-margin)
,(propertize
helm-visible-mark-prefix
'face 'helm-mark-prefix))))
(overlay-put o 'visible-mark t)
(overlay-put o 'evaporate t)
(cl-pushnew o helm-visible-mark-overlays)
(push (cons source sel) helm-marked-candidates)))
(defun helm-toggle-visible-mark (arg)
"Toggle Helm visible mark at point ARG times.
If ARG is negative toggle backward."
(interactive "p")
(with-helm-alive-p
(with-helm-window
(let ((nomark (assq 'nomark (helm-get-current-source)))
(next-fns (if (< arg 0)
'(helm-beginning-of-source-p . helm-previous-line)
'(helm-end-of-source-p . helm-next-line))))
(if nomark
(message "Marking not allowed in this source")
(cl-loop with n = (if (< arg 0) (* arg -1) arg)
repeat n do
(progn
(helm-aif (helm-this-visible-mark)
(helm-delete-visible-mark it)
(helm-make-visible-mark))
(if (funcall (car next-fns))
(progn
(helm-display-mode-line (helm-get-current-source))
(cl-return nil))
(funcall (cdr next-fns)))))
(set-window-margins (selected-window)
(if helm-visible-mark-overlays
(+ (string-width helm-visible-mark-prefix)
helm-left-margin-width)
helm-left-margin-width)))))))
(put 'helm-toggle-visible-mark 'helm-only t)
(defun helm-toggle-visible-mark-forward ()
(interactive)
(helm-toggle-visible-mark 1))
(defun helm-toggle-visible-mark-backward ()
(interactive)
(helm-toggle-visible-mark -1))
(defun helm-file-completion-source-p (&optional source)
"Return non-nil if current source is a file completion source."
(or helm--completing-file-name ; helm-read-file-name
(let ((cur-source (cdr (assq 'name
(or source (helm-get-current-source))))))
(cl-loop for i in helm--file-completion-sources
thereis (string= cur-source i)))))
(defun helm-mark-all (&optional all)
"Mark all visible unmarked candidates in current source.
With a prefix arg mark all visible unmarked candidates in all
sources."
(interactive "P")
(with-helm-alive-p
(with-helm-window ; Using `with-helm-buffer' for some unknow
; reasons infloop.
(set-window-margins (selected-window)
(+ (string-width helm-visible-mark-prefix)
helm-left-margin-width))
(if (null all)
(helm-mark-all-1 t)
(let ((pos (point)))
(goto-char (point-min))
(helm-awhile (helm-get-next-header-pos)
(goto-char it)
(forward-line 1)
(helm-mark-current-line)
(helm-mark-all-1))
;; `save-excursion' seems confused if used in addition of
;; the one used in `helm-mark-all-1', so save POS and back
;; to it when loop is finished.
(goto-char pos)
(helm-mark-current-line)
(helm-display-mode-line (helm-get-current-source) t))))))
(put 'helm-mark-all 'helm-only t)
(defun helm-mark-all-1 (&optional ensure-beg-of-source)
"Mark all visible unmarked candidates in current source.
Need to be wrapped in `with-helm-window'.
Arg ENSURE-BEG-OF-SOURCE ensure we are at beginning of source
when starting to mark candidates, if handled elsewhere before
starting it is not needed."
(let* ((src (helm-get-current-source))
(follow (if (helm-follow-mode-p src) 1 -1))
(nomark (assq 'nomark src))
(src-name (assoc-default 'name src))
(filecomp-p (or (helm-file-completion-source-p src)
(string= src-name "Files from Current Directory"))))
(helm-follow-mode -1)
(unwind-protect
(if nomark
(user-error "Marking not allowed in this source")
(save-excursion
(when ensure-beg-of-source
(goto-char (helm-get-previous-header-pos))
(forward-line 1))
(let* ((next-head (helm-get-next-header-pos))
(end (and next-head
(save-excursion
(goto-char next-head)
(forward-line -1)
(point))))
(maxpoint (or end (point-max))))
(while (< (point) maxpoint)
(helm-mark-current-line)
(let* ((prefix (or (get-text-property (pos-bol) 'helm-new-file)
(get-text-property (pos-bol) 'unknown)))
(cand (helm-get-selection
nil (helm-get-attr 'marked-with-props src)
src))
(bn (and filecomp-p (helm-basename cand))))
;; Don't mark possibles directories ending with . or ..
;; autosave files/links and non--existent files.
(unless
(or (helm-this-visible-mark)
;; Non existing files in HFF and
;; RFN. Display may be an image. See
;; https://github.com/yyoncho/helm-treemacs-icons/issues/5
;; and also Bug#2296.
prefix
(and filecomp-p (member bn '("." ".."))))
(helm-make-visible-mark src cand)))
(when (helm-pos-multiline-p)
(goto-char
(or (helm-get-next-candidate-separator-pos)
(point-max))))
(forward-line 1))))
(helm-mark-current-line))
(helm-follow-mode follow))))
(defun helm-unmark-all ()
"Unmark all candidates in all sources of current helm session."
(interactive)
(with-helm-alive-p
(with-helm-window
(save-excursion
(helm-clear-visible-mark))
(setq helm-marked-candidates nil)
(helm-mark-current-line)
(helm-display-mode-line (helm-get-current-source))
(set-window-margins (selected-window) helm-left-margin-width))))
(put 'helm-unmark-all 'helm-only t)
(defun helm-toggle-all-marks (&optional all)
"Toggle all marks.
Mark all visible candidates of current source or unmark all
candidates visible or invisible in all sources of current Helm
session.
With a prefix argument mark all candidates in all sources."
(interactive "P")
(with-helm-alive-p
(let ((marked (helm-marked-candidates)))
(if (and (>= (length marked) 1)
(with-helm-window helm-visible-mark-overlays))
(helm-unmark-all)
(helm-mark-all all)))))
(put 'helm-toggle-all-marks 'helm-only t)
(defun helm--compute-marked (real source &optional wildcard)
(let* ((coerced (helm-coerce-selection real source))
(wilds (and wildcard
(condition-case nil
(helm-file-expand-wildcards
coerced t)
(error nil)))))
;; Avoid returning a not expanded wildcard fname.
;; e.g assuming "/tmp" doesn't contain "*.el"
;; return nil when coerced is "/tmp/*.el".
(unless (or wilds (null wildcard)
(string-match-p helm--url-regexp coerced)
(file-exists-p coerced)
(and (stringp coerced)
(null (string-match-p "[[*?]" coerced))))
(setq coerced nil))
(or wilds (and coerced (list coerced)))))
(cl-defun helm-marked-candidates (&key with-wildcard all-sources)
"Return marked candidates of current source, if any.
Otherwise return one element list consisting of the current
selection. When key WITH-WILDCARD is specified, expand it. When
ALL-SOURCES key value is non-nil returns marked candidates of all
sources."
(with-current-buffer helm-buffer
(let* ((current-src (helm-get-current-source))
(candidates
(cl-loop for (source . real) in (reverse helm-marked-candidates)
for use-wc = (and with-wildcard
(string-match-p "\\*" real)
(null (file-exists-p real)))
when (or all-sources
(and
;; Dummy sources use a unique candidate, two same
;; dummy sources (or more) should share their
;; (unique) marked candidate only when
;; :all-marked is non nil.
(not (equal (helm-get-attr 'candidates)
'("dummy")))
(equal (assq 'name source)
(assq 'name current-src))))
nconc (helm--compute-marked real source use-wc) into mkds
finally return
(if (and with-wildcard all-sources)
(helm-fast-remove-dups mkds :test 'equal)
mkds)))
sel)
(unless candidates
(setq sel (helm-get-selection
nil (helm-get-attr 'marked-with-props
current-src)
current-src))
(setq candidates
(helm--compute-marked
sel current-src
(and with-wildcard (null (file-exists-p sel))))))
(helm-log "helm-marked-candidates"
"Marked candidates = %S" candidates)
candidates)))
(defun helm--remove-marked-and-update-mode-line (elm)
(with-helm-buffer
(setq helm-marked-candidates
(delete (rassoc elm helm-marked-candidates)
helm-marked-candidates))
(helm-display-mode-line (helm-get-current-source))))
(defun helm-current-source-name= (name)
(save-excursion
(goto-char (helm-get-previous-header-pos))
(equal name (helm-current-line-contents))))
(defun helm-revive-visible-mark ()
"Restore marked candidates when helm updates display."
(with-current-buffer helm-buffer
(save-excursion
(dolist (o helm-visible-mark-overlays)
(let* ((source (overlay-get o 'source))
(ov-src-name (assoc-default 'name source))
(ov-str (overlay-get o 'string))
(ov-real (overlay-get o 'real))
(ov-ml-str (helm-aif (helm-get-attr 'multiline source)
(if (numberp it)
;; Assume display have been computed
;; against real e.g. kill-ring.
(helm--multiline-get-truncated-candidate
ov-real it)
ov-str)
ov-str))
beg end)
;; Move point to end of source header line.
(goto-char (point-min))
(search-forward ov-src-name nil t)
(while (and (search-forward ov-ml-str nil t)
(cl-loop for ov in (overlays-at (pos-bol 0))
never (overlay-get ov 'visible-mark))
(helm-current-source-name= ov-src-name))
(setq beg (match-beginning 0)
end (if (string= ov-ml-str ov-str)
(match-end 0) (1+ (match-end 0))))
;; Calculate real value of candidate.
;; It can be nil if candidate have only a display value.
(let ((real (get-text-property (pos-bol 0) 'helm-realvalue)))
(if real
;; Check if real value of current candidate is the same
;; than the one stored in overlay.
;; This is needed when some cands have same display names.
;; Using equal allow testing any type of value for real cand.
;; bug#706.
(and (equal ov-real real)
(move-overlay o beg end))
(and (equal ov-str (buffer-substring beg end))
(move-overlay o beg end))))))))))
(add-hook 'helm-after-update-hook 'helm-revive-visible-mark)
(defun helm-next-point-in-list (curpos points &optional prev)
(cond
;; rule out special cases.
((null points) curpos)
((and prev (<= curpos (car points)))
(nth (1- (length points)) points))
((< (car (last points)) curpos)
(if prev (car (last points)) (nth 0 points)))
((and (not prev) (>= curpos (car (last points))))
(nth 0 points))
(t
(nth (if prev
(cl-loop for pt in points
for i from 0
if (<= curpos pt) return (1- i))
(cl-loop for pt in points
for i from 0
if (< curpos pt) return i))
points))))
(defun helm-next-visible-mark (&optional prev)
"Move next Helm visible mark.
If PREV is non-nil move to precedent."
(interactive)
(with-helm-alive-p
(with-helm-window
(ignore-errors
(goto-char (helm-next-point-in-list
(point)
(sort (mapcar 'overlay-start helm-visible-mark-overlays) '<)
prev)))
(helm-mark-current-line))))
(put 'helm-next-visible-mark 'helm-only t)
(defun helm-prev-visible-mark ()
"Move previous helm visible mark."
(interactive)
(with-helm-alive-p
(helm-next-visible-mark t)))
(put 'helm-prev-visible-mark 'helm-only t)
;;; Kill/yank selection
;;
(defun helm-yank-selection (arg)
"Set minibuffer contents to current display selection.
With a prefix arg set to real value of current selection."
(interactive "P")
(with-helm-alive-p
(let ((str (format "%s" (helm-get-selection nil (not arg)))))
(kill-new str)
(helm-set-pattern str))))
(put 'helm-yank-selection 'helm-only t)
(defun helm-kill-selection-and-quit (arg)
"Store display value of current selection to kill ring.
With a prefix arg use real value of current selection.
Display value is shown in `helm-buffer' and real value is used to
perform actions."
(interactive "P")
(with-helm-alive-p
(helm-run-after-exit
(lambda (sel)
(kill-new sel)
;; Return nil to force `helm-mode--keyboard-quit'
;; in `helm-comp-read' otherwise the value "Saved to kill-ring: foo"
;; is used as exit value for `helm-comp-read'.
(prog1 nil (message "Saved to kill-ring: %s" sel) (sit-for 1)))
(format "%s" (helm-get-selection nil (not arg))))))
(put 'helm-kill-selection-and-quit 'helm-only t)
(defun helm-insert-or-copy (&optional arg)
"Insert selection or marked candidates in current buffer.
With a prefix arg copy marked candidates to kill-ring.
The real value of each candidate is used."
(interactive "P")
(with-helm-alive-p
(helm-run-after-exit
(lambda (cands)
(with-helm-current-buffer
(let ((sels (mapconcat (lambda (c)
(format "%s" c))
cands "\n")))
(if arg (kill-new sels) (insert sels)))))
(helm-marked-candidates))))
(put 'helm-insert-or-copy 'helm-only t)
;;; Follow-mode: Automatic execution of persistent-action
;;
;;
(defvar helm-follow-input-idle-delay nil
"`helm-follow-mode' will execute its persistent action after this delay.
Note that if the `follow-delay' attr is present in source, it
will take precedence over this.")
(defun helm-follow-mode (&optional arg)
"Execute persistent action every time the cursor is moved.
This mode is source local, i.e. It applies on current source only.
\\
This mode can be enabled or disabled interactively at anytime during
a helm session with \\[helm-follow-mode].
When enabling interactively `helm-follow-mode' in a source, you
can keep it enabled for next Emacs sessions by setting
`helm-follow-mode-persistent' to a non-nil value.
When `helm-follow-mode' is called with a prefix arg and
`helm-follow-mode-persistent' is non-nil `helm-follow-mode' will
be persistent only for this Emacs session, but not for the next
Emacs sessions, i.e. the current source will not be saved to
`helm-source-names-using-follow'.
A prefix arg with `helm-follow-mode' already enabled will have no
effect.
Note that you can use instead of this mode the commands
`helm-follow-action-forward' and `helm-follow-action-backward' at
anytime in all Helm sessions.
They are bound by default to \\[helm-follow-action-forward] and
\\[helm-follow-action-backward]."
(interactive (list (helm-aif (and current-prefix-arg
(prefix-numeric-value current-prefix-arg))
(unless (helm-follow-mode-p) it))))
(with-helm-alive-p
(with-current-buffer helm-buffer
(let* ((src (helm-get-current-source))
(name (assoc-default 'name src))
(fol-attr (assq 'follow src))
(enabled (or (helm-follow-mode-p src)
(and helm-follow-mode-persistent
(member (assoc-default 'name src)
helm-source-names-using-follow))))
;; No messages when called non interactively.
(set-message-function (lambda (msg)
(if (and (not current-prefix-arg) arg)
1 msg))))
(if src
(progn
(if (eq (cdr fol-attr) 'never)
(message "helm-follow-mode not allowed in this source")
;; Make follow attr persistent for this emacs session.
(helm-follow-mode-set-source
(if (or enabled (and (numberp arg) (< arg 0))) -1 1)
src)
;; When called from lisp (non--interactive) src-name
;; will never be saved.
;; When arg is nil assume the call is interactive and save
;; src-name to `helm-source-names-using-follow'.
;; However if user call helm-follow-mode with a prefix arg,
;; behave like a non--interactive call and
;; DONT save src-name to `helm-source-names-using-follow'.
(when (and helm-follow-mode-persistent (null arg))
(if (null enabled)
(unless (member name helm-source-names-using-follow)
(push name helm-source-names-using-follow)
(customize-save-variable 'helm-source-names-using-follow
helm-source-names-using-follow))
(when (member name helm-source-names-using-follow)
(setq helm-source-names-using-follow
(delete name helm-source-names-using-follow))
(customize-save-variable 'helm-source-names-using-follow
helm-source-names-using-follow))))
(message "helm-follow-mode is %s"
(if (helm-follow-mode-p src)
"enabled" "disabled"))
(helm-display-mode-line src t)))
(message "Not enough candidates for helm-follow-mode"))))))
(put 'helm-follow-mode 'helm-only t)
(defun helm-follow-execute-persistent-action-maybe (&optional delay)
"Execute persistent action in mode `helm-follow-mode'.
This happen after: DELAY or the \\='follow-attr value of current
source or `helm-follow-input-idle-delay' or
`helm-input-idle-delay' secs."
(let* ((src (helm-get-current-source))
(at (or delay
(assoc-default 'follow-delay src)
helm-follow-input-idle-delay
(or (and helm-input-idle-delay
(max helm-input-idle-delay 0.01))
0.01)))
(suspend (and helm--in-update
;; Specific to helm-find-files.
(assoc-default 'suspend-follow-in-update src))))
(when (and (not suspend)
(not (get-buffer-window helm-action-buffer 'visible))
(not (helm-pos-header-line-p))
(or (helm-follow-mode-p src)
(and helm-follow-mode-persistent
(member (assoc-default 'name src)
helm-source-names-using-follow)))
(null (eq (assoc-default 'follow src) 'never))
(helm-get-selection nil nil src))
(helm-follow-mode-set-source 1 src)
(run-with-idle-timer at nil (lambda ()
(when helm-alive-p
(helm-execute-persistent-action)))))))
(defun helm-follow-mode-p (&optional source)
(with-helm-buffer
(eq (helm-get-attr 'follow (or source (helm-get-current-source))) 1)))
(defun helm-follow-mode-set-source (value &optional source)
(with-helm-buffer
(helm-set-attr 'follow value (or source (helm-get-current-source)))))
;;; Auto-resize mode
;;
(defun helm--autoresize-hook (&optional max-height min-height)
(when (if (helm--show-action-window-other-window-p)
(and (helm-window)
(not (get-buffer-window helm-action-buffer 'visible)))
(helm-window))
(with-helm-window
(fit-window-to-buffer nil
(/ (* (frame-height)
(or max-height helm-autoresize-max-height))
100)
(/ (* (frame-height)
(or min-height helm-autoresize-min-height))
100)))))
(define-minor-mode helm-autoresize-mode
"Auto resize helm window when enabled.
Helm window is re-sized according to `helm-autoresize-max-height'
and `helm-autoresize-min-height'. Note that when this mode is
enabled, Helm behaves as if `helm-always-two-windows' is enabled.
See `fit-window-to-buffer' for more infos."
:group 'helm
:global t
(if helm-autoresize-mode
(progn (add-hook 'helm-after-update-hook 'helm--autoresize-hook)
(add-hook 'helm-window-configuration-hook 'helm--autoresize-hook))
(remove-hook 'helm-after-update-hook 'helm--autoresize-hook)
(remove-hook 'helm-window-configuration-hook 'helm--autoresize-hook)))
(defun helm-help ()
"Generate Helm's help according to `help-message' attribute.
If `helm-buffer' is empty, provide completions on `helm-sources'
to choose its local documentation.
If source doesn't have any `help-message' attribute, a generic
message explaining this is added instead.
The global `helm-help-message' is always added after this local
help."
(interactive)
(require 'helm-mode) ; for helm-comp-read.
(with-helm-alive-p
(let ((source (or (helm-get-current-source)
(helm-comp-read
"Help for: "
(cl-loop for src in (with-helm-buffer helm-sources)
collect `(,(assoc-default 'name src) .
,src))
:allow-nest t
:exec-when-only-one t))))
(save-selected-window
(helm-help-internal
helm-help-buffer-name
(lambda ()
(helm-aif (assoc-default 'help-message source)
(insert (substitute-command-keys
(helm-interpret-value it)))
(insert "* No specific help for this source available."))
(insert "\n\n"
(substitute-command-keys
(helm-interpret-value helm-help-message)))))))))
(put 'helm-help 'helm-only t)
(defun helm-toggle-truncate-line ()
"Toggle `truncate-lines' value in `helm-buffer'"
(interactive)
(with-helm-alive-p
(with-helm-buffer
(setq truncate-lines (not truncate-lines))
(when (helm-get-previous-header-pos)
(helm-update (regexp-quote (helm-get-selection nil t))))
(message "%sisplaying continuation lines"
(if truncate-lines "Not D" "D")))))
(put 'helm-toggle-truncate-line 'helm-only t)
;;;###autoload
(defun helm-other-buffer (sources buffer)
"Simplified Helm interface with other `helm-buffer'.
Call `helm' only with SOURCES and BUFFER as args."
(helm :sources sources :buffer buffer))
(make-obsolete 'helm-other-buffer 'helm "4.0.1")
(provide 'helm-core)
;;; helm-core.el ends here
helm-4.0.3/helm-dabbrev.el 0000664 0000000 0000000 00000041162 15011067617 0015325 0 ustar 00root root 0000000 0000000 ;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'helm)
(require 'helm-lib)
(require 'helm-help)
(require 'helm-elisp) ; For show-completion.
(defgroup helm-dabbrev nil
"Dabbrev related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-dabbrev-always-search-all t
"Always search in all buffers when non--nil.
Note that even if nil, a search in all buffers will occur if the
length of candidates is <= than
`helm-dabbrev-max-length-result'."
:type 'boolean)
(defcustom helm-dabbrev-candidates-number-limit 1000
"Maximum number of candidates to collect.
The higher this number is, the slower the computation of
candidates will be. You can use safely a higher value with
emacs-26+.
Note that this have nothing to do with
`helm-candidate-number-limit', this means that computation of
candidates stop when this value is reached but only
`helm-candidate-number-limit' candidates are displayed in the
Helm buffer."
:type 'integer)
(defcustom helm-dabbrev-ignored-buffers-regexps
'("\\*helm" "\\*Messages" "\\*Echo Area" "\\*Buffer List")
"List of regexps matching names of buffers that `helm-dabbrev' should not check."
:type '(repeat regexp))
(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p
"A function that decide if a buffer to search in its related to `current-buffer'.
This is currently determined by comparing `major-mode' of the
buffer to search and the `current-buffer'.
The function take one arg, the buffer which is current, look at
`helm-dabbrev--same-major-mode-p' for an example.
When nil all buffers are considered related to `current-buffer'."
:type 'function)
(defcustom helm-dabbrev-major-mode-assoc nil
"Major mode association alist.
This allow helm-dabbrev searching in buffers with the associated
`major-mode'.
E.g. (emacs-lisp-mode . lisp-interaction-mode)
will allow searching in the lisp-interaction-mode buffer when
`current-buffer' is an `emacs-lisp-mode' buffer and vice versa
i.e. no need to provide (lisp-interaction-mode .
emacs-lisp-mode) association.
When nil check is the searched buffer has same `major-mode' than
the `current-buffer'.
This has no effect when `helm-dabbrev-related-buffer-fn' is nil
or of course bound to a function that doesn't handle this var."
:type '(alist :key-type symbol :value-type symbol))
(defcustom helm-dabbrev-lineno-around 30
"Search first in this number of lines before and after point."
:type 'integer)
(defcustom helm-dabbrev-cycle-threshold 5
"Number of time helm-dabbrev cycle before displaying helm completion.
When nil or 0 disable cycling."
:type '(choice (const :tag "Cycling disabled" nil) integer))
(defcustom helm-dabbrev-case-fold-search 'smart
"Set `case-fold-search' in `helm-dabbrev'.
Same as `helm-case-fold-search' but for `helm-dabbrev'.
Note that this is not affecting searching in Helm buffer, but the
initial search for all candidates in buffer(s)."
:type '(choice (const :tag "Ignore case" t)
(const :tag "Respect case" nil)
(other :tag "Smart" smart)))
(defvaralias 'helm-dabbrev--regexp 'helm-dabbrev-separator-regexp)
(make-obsolete-variable 'helm-dabbrev--regexp
'helm-dabbrev-separator-regexp "2.8.3")
;; Check for beginning of line should happen last (^\n\\|^).
(defvar helm-dabbrev-separator-regexp
"\\s-\\|\t\\|[(\\[\\{\"'`=<>$;,@.#+]\\|\\s\\\\|^\n\\|^"
"Regexp matching the start of a dabbrev candidate.")
(defvar helm-dabbrev-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-/") #'helm-next-line)
(define-key map (kbd "M-:") #'helm-previous-line)
map))
;; Internal
(defvar helm-dabbrev--cache nil)
(defvar helm-dabbrev--data nil)
(cl-defstruct helm-dabbrev-info dabbrev limits iterator)
(defvar helm-dabbrev--already-tried nil)
(defvar helm-dabbrev--computing-cache nil
"[INTERNAL] Flag to notify helm-dabbrev is blocked.
Do nothing when non nil.")
(defun helm-dabbrev--buffer-list ()
(cl-loop for buf in (buffer-list)
unless (cl-loop for r in helm-dabbrev-ignored-buffers-regexps
thereis (string-match r (buffer-name buf)))
collect buf))
(defun helm-dabbrev--same-major-mode-p (start-buffer)
"Decide if current-buffer is related to START-BUFFER."
(helm-same-major-mode-p start-buffer helm-dabbrev-major-mode-assoc))
(defun helm-dabbrev--collect (str limit ignore-case all)
(let* ((case-fold-search ignore-case)
(buffer1 (current-buffer)) ; start buffer.
(minibuf (minibufferp buffer1))
results pos-before pos-after)
(catch 'break
(dolist (buf (if all (helm-dabbrev--buffer-list)
(list (current-buffer))))
(with-current-buffer buf
(when (or minibuf ; check against all buffers when in minibuffer.
(if helm-dabbrev-related-buffer-fn
(funcall helm-dabbrev-related-buffer-fn buffer1)
t))
(save-excursion
;; Start searching before thing before point.
(goto-char (- (point) (length str)))
;; Search the last 30 lines BEFORE point and set POS-BEFORE.
(cl-multiple-value-bind (res _pa pb)
(helm-dabbrev--search-and-store str -2 limit results)
(setq results res
;; No need to set POS-AFTER here.
pos-before pb)))
(save-excursion
;; Search the next 30 lines AFTER point and set POS-AFTER.
(cl-multiple-value-bind (res pa _pb)
(helm-dabbrev--search-and-store str 2 limit results)
(setq results res
;; No need to set POS-BEFORE, we keep the last
;; value found.
pos-after pa)))
(save-excursion
;; Search all BEFORE point maybe starting from
;; POS-BEFORE to not search again what previously found.
;; If limit is reached in previous call of
;; `helm-dabbrev--search-and-store' POS-BEFORE is nil and
;; goto-char will fail, so check it.
(when pos-before (goto-char pos-before))
(cl-multiple-value-bind (res _pa _pb)
(helm-dabbrev--search-and-store str -1 limit results)
;; No need to set POS-BEFORE and POS-AFTER here.
(setq results res)))
(save-excursion
;; Search all AFTER point maybe starting from POS-AFTER.
;; Same comment as above for POS-AFTER.
(when pos-after (goto-char pos-after))
(cl-multiple-value-bind (res _pa _pb)
(helm-dabbrev--search-and-store str 1 limit results)
;; No need to set POS-BEFORE and POS-AFTER here.
(setq results res)))))
(when (>= (length results) limit) (throw 'break nil))))
(nreverse results)))
(defun helm-dabbrev--search-and-store (pattern direction limit results)
"Search words or symbols matching PATTERN in DIRECTION up to LIMIT.
Finally returns all matched candidates appended to RESULTS.
Argument DIRECTION can be:
- (1): Search forward from point.
- (-1): Search backward from point.
- (2): Search forward from the
`helm-dabbrev-lineno-around'
lines after point.
- (-2): Search backward from the
`helm-dabbrev-lineno-around'
lines before point."
(let ((res results)
after before)
(while (and (<= (length res) limit)
(cl-case direction
(1 (search-forward pattern nil t))
(-1 (search-backward pattern nil t))
(2 (let ((pos
(save-excursion
(forward-line
helm-dabbrev-lineno-around)
(point))))
(setq after pos)
(search-forward pattern pos t)))
(-2 (let ((pos
(save-excursion
(forward-line
(- helm-dabbrev-lineno-around))
(point))))
(setq before pos)
(search-backward pattern pos t)))))
(let* ((mb (match-beginning 0))
(replace-regexp (concat "\\(" helm-dabbrev-separator-regexp
"\\)\\'"))
(match-word (helm-dabbrev--search
pattern mb replace-regexp)))
(when (and match-word (not (member match-word res)))
(push match-word res))))
(list res after before)))
(defun helm-dabbrev--search (pattern beg sep-regexp)
"Search word or symbol at point matching PATTERN.
Argument BEG is corresponding to the previous `match-beginning'
search.
The search starts at (1- BEG) with a regexp starting with
`helm-dabbrev-separator-regexp' followed by PATTERN followed by a
regexp matching syntactically any word or symbol.
The possible false positives matching SEP-REGEXP at end are
finally removed."
(let ((eol (pos-eol)))
(save-excursion
(goto-char (1- beg))
(when (re-search-forward
(concat "\\("
helm-dabbrev-separator-regexp
"\\)"
"\\(?99:\\("
(regexp-quote pattern)
"\\(\\sw\\|\\s_\\)+\\)\\)")
eol t)
(replace-regexp-in-string
sep-regexp ""
(match-string-no-properties 99))))))
(defun helm-dabbrev--get-candidates (dabbrev &optional limit)
(cl-assert dabbrev nil "[No Match]")
(helm-dabbrev--collect
dabbrev (or limit helm-dabbrev-candidates-number-limit)
(cl-case helm-dabbrev-case-fold-search
(smart (helm-set-case-fold-search-1 dabbrev))
(t helm-dabbrev-case-fold-search))
helm-dabbrev-always-search-all))
(defun helm-dabbrev-default-action (candidate)
(with-helm-current-buffer
(let* ((limits (helm-bounds-of-thing-before-point
helm-dabbrev-separator-regexp))
(beg (car limits))
(end (point)))
(run-with-timer
0.01 nil
#'helm-insert-completion-at-point
beg end candidate))))
;;;###autoload
(cl-defun helm-dabbrev ()
"Preconfigured helm for dynamic abbreviations."
(interactive)
(unless helm-dabbrev--computing-cache
(let ((dabbrev (helm-thing-before-point
nil helm-dabbrev-separator-regexp))
(limits (helm-bounds-of-thing-before-point
helm-dabbrev-separator-regexp))
(enable-recursive-minibuffers t)
(cycling-disabled-p (or (null helm-dabbrev-cycle-threshold)
(zerop helm-dabbrev-cycle-threshold)))
(helm-execute-action-at-once-if-one t)
(helm-quit-if-no-candidate
(lambda ()
(message "[Helm-dabbrev: No expansion found]"))))
(cl-assert (and (stringp dabbrev) (not (string= dabbrev "")))
nil "[Helm-dabbrev: Nothing found before point]")
(when (and
;; have been called at least once.
(helm-dabbrev-info-p helm-dabbrev--data)
;; But user have moved with some other command
;; in the meaning time.
(not (eq last-command 'helm-dabbrev)))
(setq helm-dabbrev--data nil))
;; When candidates are requested in helm directly without cycling,
;; we need them right now before running helm.
(when cycling-disabled-p
(message "Waiting for helm-dabbrev candidates...")
(setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev)))
(unless (or cycling-disabled-p
(helm-dabbrev-info-p helm-dabbrev--data))
(setq helm-dabbrev--data
(make-helm-dabbrev-info
:dabbrev dabbrev
:limits limits
:iterator
(helm-iter-list
(cl-loop for i in (helm-dabbrev--get-candidates
dabbrev helm-dabbrev-cycle-threshold)
when (string-match-p
(concat "^" (regexp-quote dabbrev)) i)
collect i)))))
(let ((iter (and (helm-dabbrev-info-p helm-dabbrev--data)
(helm-dabbrev-info-iterator helm-dabbrev--data)))
deactivate-mark)
;; Cycle until iterator is consumed.
(helm-aif (and iter (helm-iter-next iter))
(progn
(helm-insert-completion-at-point
(car (helm-dabbrev-info-limits helm-dabbrev--data))
;; END is the end of the previous inserted string, not
;; the end (apart for first insertion) of the initial string.
(cdr limits) it)
;; Move already tried candidates to end of list.
(push it helm-dabbrev--already-tried))
;; Iterator is now empty, or cycling was disabled, maybe
;; reset dabbrev to initial value and start helm completion.
(let* ((old-dabbrev (if (helm-dabbrev-info-p helm-dabbrev--data)
(helm-dabbrev-info-dabbrev helm-dabbrev--data)
dabbrev))
(only-one (eq (length helm-dabbrev--already-tried) 1)))
(unless helm-dabbrev--cache ; Already computed when
; cycling is disabled.
(message "Waiting for helm-dabbrev candidates...")
(setq helm-dabbrev--computing-cache t)
(setq helm-dabbrev--cache
(helm-dabbrev--get-candidates old-dabbrev))
;; If user continues typing M-/ while display is blocked by
;; helm-dabbrev--get-candidates delete these events.
(setq unread-command-events nil))
;; If the length of candidates is only one when computed
;; that's mean the unique matched item have already been
;; inserted by the iterator, so no need to reinsert the old dabbrev,
;; just let helm exiting with "No expansion found".
(unless (or only-one cycling-disabled-p)
(setq dabbrev old-dabbrev
limits (helm-dabbrev-info-limits helm-dabbrev--data))
(setq helm-dabbrev--data nil)
(delete-region (car limits) (point))
(insert dabbrev))
(when (and (null cycling-disabled-p) only-one)
(setq helm-dabbrev--cache nil
helm-dabbrev--already-tried nil
helm-dabbrev--computing-cache nil)
(cl-return-from helm-dabbrev
(message "[Helm-dabbrev: No expansion found]")))
(with-helm-show-completion (car limits) (cdr limits)
(unwind-protect
(helm :sources
(helm-build-in-buffer-source "Dabbrev Expand"
:data
(append
(cl-loop with lst = helm-dabbrev--cache
for cand in helm-dabbrev--already-tried
do (setq lst (delete cand lst))
finally return lst)
helm-dabbrev--already-tried)
:persistent-action 'ignore
:persistent-help "DoNothing"
:keymap helm-dabbrev-map
:action 'helm-dabbrev-default-action
:group 'helm-dabbrev)
:buffer "*helm dabbrev*"
:input (concat "^" dabbrev " ")
:resume 'noresume
:allow-nest t)
(setq helm-dabbrev--computing-cache nil
helm-dabbrev--already-tried nil
helm-dabbrev--cache nil)))))))))
(provide 'helm-dabbrev)
;;; helm-dabbrev.el ends here
helm-4.0.3/helm-easymenu.el 0000664 0000000 0000000 00000005553 15011067617 0015552 0 ustar 00root root 0000000 0000000 ;;; helm-easymenu.el --- Helm easymenu definitions. -*- lexical-binding: t -*-
;; Copyright (C) 2015 ~ 2025 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 .
;;; Code:
(require 'easymenu)
(easy-menu-add-item
nil '("Tools")
'("Helm"
["Find any Files/Buffers" helm-multi-files t]
["Helm Everywhere (Toggle)" helm-mode t]
["Helm resume" helm-resume t]
"----"
("Files"
["Find files" helm-find-files t]
["Recent Files" helm-recentf t]
["Locate" helm-locate t]
["Search Files with find" helm-find t]
["Bookmarks" helm-filtered-bookmarks t]
["Locate library" helm-locate-library t])
("Buffers"
["Find buffers" helm-buffers-list t])
("Projects"
["Browse project" helm-browse-project]
["Projects history" helm-projects-history])
("Commands"
["Emacs Commands" helm-M-x t]
["Externals Commands" helm-run-external-command t])
("Help"
["Helm Apropos" helm-apropos t])
("Info"
["Info at point" helm-info-at-point t]
["Emacs Manual index" helm-info-emacs t]
["Gnus Manual index" helm-info-gnus t]
["Helm documentation" helm-documentation t])
("Packages"
["Elisp packages" helm-packages t]
["Finder" helm-finder t])
("Tools"
["Occur" helm-occur t]
["Grep current directory with AG" helm-do-grep-ag t]
["Gid" helm-gid t]
["Etags" helm-etags-select t]
["Lisp complete at point" helm-lisp-completion-at-point t]
["Browse Kill ring" helm-show-kill-ring t]
["Browse register" helm-register t]
["Mark Ring" helm-all-mark-rings t]
["Regexp handler" helm-regexp t]
["Colors & Faces" helm-colors t]
["Show xfonts" helm-select-xfont t]
["Ucs Symbols" helm-ucs t]
["Imenu" helm-imenu t]
["Imenu all" helm-imenu-in-all-buffers t]
["Semantic or Imenu" helm-semantic-or-imenu t]
["Google Suggest" helm-google-suggest t]
["Eval expression" helm-eval-expression-with-eldoc t]
["Calcul expression" helm-calcul-expression t]
["Man pages" helm-man-woman t]
["Top externals process" helm-top t]
["Emacs internals process" helm-list-emacs-process t])
"----"
["Preferred Options" helm-configuration t])
"Spell Checking")
(easy-menu-add-item nil '("Tools") '("----") "Spell Checking")
(provide 'helm-easymenu)
;;; helm-easymenu.el ends here
helm-4.0.3/helm-elisp.el 0000664 0000000 0000000 00000137405 15011067617 0015042 0 ustar 00root root 0000000 0000000 ;;; helm-elisp.el --- Elisp symbols completion for helm. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-lib)
(require 'helm-help)
(require 'helm-types)
(require 'helm-utils)
(require 'helm-info)
(require 'helm-eval)
(require 'helm-files)
(declare-function helm-describe-function "helm-lib")
(declare-function helm-describe-variable "helm-lib")
(declare-function helm-describe-face "helm-lib")
(declare-function helm-read-file-name "helm-mode")
(declare-function helm-comp-read "helm-mode")
(declare-function helm-M-x-transformer-no-sort-no-props "helm-command")
(defvar helm-M-x-show-short-doc)
(defvar completions-detailed)
(defvar helm-completions-detailed)
;;; Customizable values
(defgroup helm-elisp nil
"Elisp related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-turn-on-show-completion t
"Display candidate in `current-buffer' while moving selection when non--nil."
:group 'helm-elisp
:type 'boolean)
(defcustom helm-show-completion-min-window-height 7
"Minimum completion window height used in show completion.
This is used in macro `with-helm-show-completion'."
:group 'helm-elisp
:type 'integer)
(defcustom helm-lisp-quoted-function-list
'(funcall apply mapc cl-mapc mapcar cl-mapcar
callf callf2 cl-callf cl-callf2 fset
fboundp fmakunbound symbol-function)
"List of function where quoted function completion happen.
E.g. give only function names after (funcall \\='."
:group 'helm-elisp
:type '(repeat (choice symbol)))
(defcustom helm-lisp-unquoted-function-list
'(function defadvice)
"List of function where unquoted function completion happen.
E.g. give only function names after (function ."
:group 'helm-elisp
:type '(repeat (choice symbol)))
(defcustom helm-apropos-fuzzy-match nil
"Enable fuzzy matching for `helm-apropos' when non-nil."
:group 'helm-elisp
:type 'boolean)
(defcustom helm-lisp-fuzzy-completion nil
"Enable fuzzy matching in emacs-lisp completion when non-nil.
NOTE: This enables fuzzy matching in Helm native implementation of
elisp completion, but not on helmized elisp completion, i.e. fuzzy
completion is not available in `completion-at-point'."
:group 'helm-elisp
:type 'boolean)
(defcustom helm-apropos-function-list '(helm-def-source--emacs-commands
helm-def-source--emacs-functions
helm-def-source--eieio-classes
helm-def-source--eieio-generic
helm-def-source--emacs-variables
helm-def-source--emacs-faces)
"A list of functions that build helm sources to use in `helm-apropos'."
:group 'helm-elisp
:type '(repeat (choice symbol)))
(defcustom helm-apropos-defaut-info-lookup-sources '(helm-source-info-elisp
helm-source-info-cl
helm-source-info-eieio)
"A list of sources to look into when searching info page of a symbol."
:group 'helm-elisp
:type '(repeat (choice symbol)))
(defcustom helm-show-completion-display-function
(if (display-graphic-p)
#'helm-display-buffer-in-own-frame
#'helm-show-completion-default-display-function)
"The function used to display helm completion buffer.
This function is used by `with-helm-show-completion', when nil
fallback to `helm-default-display-buffer'.
Default is to use a separate frame on graphic display and
`helm-show-completion-default-display-function' on non graphic
display."
:group 'helm-elisp
:type 'function)
;;; Faces
;;
;;
(defgroup helm-elisp-faces nil
"Customize the appearance of helm-elisp."
:prefix "helm-"
:group 'helm-elisp
:group 'helm-faces)
(defface helm-lisp-show-completion
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:background "DarkSlateGray"))
"Face used for showing candidates in `helm-lisp-completion'."
:group 'helm-elisp-faces)
(defface helm-lisp-completion-info
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "red"))
"Face used for showing info in `helm-lisp-completion'."
:group 'helm-elisp-faces)
(defcustom helm-elisp-help-function
'helm-elisp-show-help
"Function for displaying help for Lisp symbols."
:group 'helm-elisp
:type '(choice (function :tag "Open help for the symbol."
helm-elisp-show-help)
(function :tag "Show one liner in modeline."
helm-elisp-show-doc-modeline)))
(defcustom helm-locate-library-fuzzy-match t
"Enable fuzzy-matching in `helm-locate-library' when non--nil."
:type 'boolean
:group 'helm-elisp)
;;; Show completion.
;;
;; Provide show completion with macro `with-helm-show-completion'.
(defvar helm-show-completion-overlay nil)
;; Called each time cursor move in helm-buffer.
(defun helm-show-completion ()
(with-helm-current-buffer
(helm-aif (helm-get-selection)
(overlay-put helm-show-completion-overlay
'display (substring-no-properties it)))))
(defun helm-show-completion-init-overlay (beg end)
(setq helm-show-completion-overlay (make-overlay beg end))
(overlay-put helm-show-completion-overlay
'face 'helm-lisp-show-completion))
(defun helm-show-completion-default-display-function (buffer &rest _args)
"A special resized Helm window is used depending on position in BUFFER."
(with-selected-window (selected-window)
(if (window-dedicated-p)
(helm-default-display-buffer buffer)
(let* ((screen-size (+ (count-screen-lines (window-start) (point) t)
1 ; mode-line
(if header-line-format 1 0))) ; header-line
(def-size (- (window-height)
helm-show-completion-min-window-height))
(upper-height (max window-min-height (min screen-size def-size)))
split-window-keep-point)
(recenter -1)
(set-window-buffer (if (active-minibuffer-window)
(minibuffer-selected-window)
(split-window nil upper-height
helm-split-window-default-side))
buffer)))))
(defmacro with-helm-show-completion (beg end &rest body)
"Show Helm candidate in an overlay at point.
BEG and END are the beginning and end position of the current
completion in `helm-current-buffer'.
BODY is an Helm call where we want to enable show completion.
If `helm-turn-on-show-completion' is nil do nothing."
(declare (indent 2) (debug t))
`(unwind-protect
(if helm-turn-on-show-completion
(let ((helm-move-selection-after-hook
(append (list 'helm-show-completion)
helm-move-selection-after-hook))
(helm-split-window-default-side
(if (eq helm-split-window-default-side 'same)
'below helm-split-window-default-side))
helm-split-window-inside-p
helm-reuse-last-window-split-state)
(helm-set-local-variable
'helm-display-function
(or helm-show-completion-display-function
'helm-default-display-buffer))
(with-helm-after-update-hook
;; Show immediately first candidate as soon as helm popup.
(helm-show-completion))
(helm-show-completion-init-overlay ,beg ,end)
,@body)
,@body)
(when (and helm-show-completion-overlay
(overlayp helm-show-completion-overlay))
(delete-overlay helm-show-completion-overlay))))
;;; Lisp symbol completion.
;;
;;
(defun helm-lisp-completion--predicate-at-point (beg)
;; Return a predicate for `all-completions'.
(let ((fn-sym-p (lambda ()
(or
(and (eq (char-before) ?\ )
(save-excursion
(skip-syntax-backward " " (pos-bol))
(memq (symbol-at-point)
helm-lisp-unquoted-function-list)))
(and (eq (char-before) ?\')
(save-excursion
(forward-char -1)
(eq (char-before) ?\#)))))))
(save-excursion
(goto-char beg)
(cond ((or
;; Complete on all symbols in non--lisp modes (logs mail etc..)
(not (memq major-mode '(emacs-lisp-mode
lisp-interaction-mode
inferior-emacs-lisp-mode)))
(not (or (funcall fn-sym-p)
(and (eq (char-before) ?\')
(save-excursion
(forward-char (if (funcall fn-sym-p) -2 -1))
(skip-syntax-backward " " (pos-bol))
(memq (symbol-at-point)
helm-lisp-quoted-function-list)))
(eq (char-before) ?\())) ; no paren before str.
;; Looks like we are in a let statement.
(condition-case nil
(progn (up-list -2) (forward-char 1)
(eq (char-after) ?\())
(error nil)))
(lambda (sym)
(or (boundp sym) (fboundp sym) (symbol-plist sym))))
(t #'fboundp)))))
(defun helm-thing-before-point (&optional limits regexp)
"Return symbol name before point.
If REGEXP is specified return what REGEXP find before point.
By default match the beginning of symbol before point.
With LIMITS arg specified return the beginning and end position
of symbol before point."
(save-excursion
(let (beg
(end (point))
(boundary (field-beginning nil nil (pos-bol))))
(if (re-search-backward (or regexp "\\_<") boundary t)
(setq beg (match-end 0))
(setq beg boundary))
(unless (= beg end)
(if limits
(cons beg end)
(buffer-substring-no-properties beg end))))))
(defun helm-bounds-of-thing-before-point (&optional regexp)
"Get the beginning and end position of `helm-thing-before-point'.
Return a cons (beg . end)."
(helm-thing-before-point 'limits regexp))
(defun helm-insert-completion-at-point (beg end str)
;; When there is no space after point
;; we are completing inside a symbol or
;; after a partial symbol with the next arg aside
;; without space, in this case mark the region.
;; deleting it would remove the
;; next arg which is unwanted.
(delete-region beg end)
(insert str)
(let ((pos (cdr (or (bounds-of-thing-at-point 'symbol)
;; needed for helm-dabbrev.
(bounds-of-thing-at-point 'filename)))))
(when (and pos (< (point) pos))
(push-mark pos t t))))
(defconst helm-lisp-completion-re-chars-classes
'(":xdigit:" ":word:" ":upper:"
":unibyte:" ":space:" ":punct:"
":print:" ":nonascii:" ":ascii:"
":multibyte:" ":lower:"
":graph:" ":digit:" ":cntrl:"
":blank:" ":alpha:" ":alnum:")
"Table of Char Classes for regexps.")
;;;###autoload
(defun helm-lisp-completion-at-point ()
"Preconfigured Helm for Lisp symbol completion at point."
(interactive)
(let* ((target (helm-thing-before-point))
(beg (car (helm-bounds-of-thing-before-point)))
(end (point))
(pred (and beg (helm-lisp-completion--predicate-at-point beg)))
(re-class-p (and (eq 'string (syntax-ppss-context (syntax-ppss (point))))
(save-excursion
(re-search-backward "\\[:[[:alpha:]]*" (pos-bol) t))))
(loc-vars (and (fboundp 'elisp--local-variables)
(ignore-errors
(mapcar #'symbol-name (elisp--local-variables)))))
(glob-syms (and target pred (not re-class-p) (all-completions target obarray pred)))
(candidates (if re-class-p
helm-lisp-completion-re-chars-classes
(append loc-vars glob-syms)))
(helm-quit-if-no-candidate t)
(helm-execute-action-at-once-if-one t)
(enable-recursive-minibuffers t))
(if candidates
(with-helm-show-completion beg end
;; Overlay is initialized now in helm-current-buffer.
(helm
:sources (helm-build-in-buffer-source "Lisp completion"
:data candidates
:persistent-action `(helm-lisp-completion-persistent-action .
,(and (eq helm-elisp-help-function
'helm-elisp-show-doc-modeline)
'never-split))
:nomark t
:match-part (lambda (c) (car (split-string c)))
:fuzzy-match helm-lisp-fuzzy-completion
:popup-info (lambda (c) (helm-get-first-line-documentation
(if (string-match "\\`:[[:alpha:]]+:\\'" c)
c (intern-soft c))))
:persistent-help (helm-lisp-completion-persistent-help)
:filtered-candidate-transformer
#'helm-lisp-completion-transformer
:action (lambda (candidate)
(with-helm-current-buffer
(run-with-timer
0.01 nil
#'helm-insert-completion-at-point
beg end candidate))))
:input target
:resume 'noresume
:truncate-lines t
:buffer "*helm lisp completion*"
:allow-nest t))
(message "[No Match]"))))
(defun helm-lisp-completion-persistent-action (candidate &optional name)
"Show documentation for the function.
Documentation is shown briefly in mode-line or completely in
other window according to the value of
`helm-elisp-help-function'."
(funcall helm-elisp-help-function candidate name))
(defun helm-lisp-completion-persistent-help ()
"Return persistent-help according to the value of `helm-elisp-help-function'"
(cl-ecase helm-elisp-help-function
(helm-elisp-show-doc-modeline "Show brief doc in mode-line")
(helm-elisp-show-help "Toggle show help for the symbol")))
(defun helm-elisp--show-help-1 (candidate &optional name)
(helm-acase (if (member candidate helm-lisp-completion-re-chars-classes)
candidate
(intern-soft candidate))
((guard* (stringp it))
(helm-describe-re-char-classes it))
((guard* (and (fboundp it) (boundp it)))
(if (member name `(,helm-describe-function-function
,helm-describe-variable-function))
(funcall (intern (format "helm-%s" name)) it)
;; When there is no way to know what to describe
;; prefer describe-function.
(helm-describe-function it)))
((guard* (fboundp it)) (helm-describe-function it))
((guard* (boundp it)) (helm-describe-variable it))
((guard* (facep it)) (helm-describe-face it))))
(defun helm-elisp-show-help (candidate &optional name)
"Show full help for the function CANDIDATE.
Arg NAME specifies the name of the top level function calling
Helm generic completion (e.g., \"describe-function\") which
allows calling the right function when CANDIDATE symbol refers at
the same time to variable and a function."
(helm-elisp--persistent-help
candidate 'helm-elisp--show-help-1 name))
(defun helm-elisp-show-doc-modeline (candidate &optional name)
"Show brief documentation for the function in the mode-line."
(let ((cursor-in-echo-area t)
mode-line-in-non-selected-windows)
(helm-show-info-in-mode-line
(propertize
(helm-get-first-line-documentation
(intern candidate) name)
'face 'helm-lisp-completion-info))))
(defun helm-lisp-completion-transformer (candidates _source)
"Helm candidates transformer for Lisp completion."
(cl-loop for c in candidates
for sym = (if (string-match "\\`:[[:alpha:]]+:\\'" c)
c (intern-soft c))
for annot = (helm-acase sym
((guard* (stringp it))
(propertize " " 'face 'font-lock-regexp-face))
((guard* (commandp it))
(propertize " " 'face 'font-lock-function-name-face))
((guard* (class-p it))
(propertize " " 'face 'font-lock-type-face))
((guard* (cl-generic-p it))
(propertize " " 'face 'font-lock-function-name-face))
((guard* (fboundp it))
(propertize " " 'face 'font-lock-function-name-face))
((guard* (keywordp it))
(propertize " " 'face 'font-lock-keyword-face))
((guard* (boundp it))
(propertize " " 'face 'font-lock-variable-name-face))
((guard* (facep it))
(propertize " " 'face 'font-lock-variable-name-face))
((guard* (helm-group-p it))
(propertize " " 'face 'font-lock-type-face))
(t " "))
collect (cons (concat (propertize " " 'display annot) c) c)
into lst
finally return (sort lst #'helm-generic-sort-fn)))
;;;###autoload
(cl-defun helm-get-first-line-documentation (sym &optional
(name "describe-function")
(end-column 72))
"Return first line documentation of symbol SYM truncated at END-COLUMN.
If SYM is not documented, return \"Not documented\".
Argument NAME allows specifiying what function to use to display
documentation when SYM name is the same for function and variable."
(let ((doc (condition-case _err
(helm-acase sym
((guard* (stringp it))
(cadr (split-string (helm-describe-re-char-classes-1 it) "\n")))
((guard* (class-p it))
(cl--class-docstring (cl--find-class it)))
((guard* (and (fboundp it) (boundp it)))
(if (string= name "describe-variable")
(documentation-property it 'variable-documentation t)
(documentation it t)))
((guard* (custom-theme-p it))
(documentation-property it 'theme-documentation t))
((guard* (and (helm-group-p it) (not (fboundp it))))
(documentation-property it 'group-documentation t))
((guard* (fboundp it))
(documentation it t))
((guard* (boundp it))
(documentation-property it 'variable-documentation t))
((guard* (facep it)) (face-documentation it)))
(void-function "Void function -- Not documented"))))
(if (and doc (not (string= doc ""))
;; `documentation' return "\n\n(args...)"
;; for CL-style functions.
(not (string-match-p "\\`\n\n" doc)))
;; Some commands specify key bindings or keymap in their first line,
;; e.g.: "\A mode for editing binary [...]. As a result
;; (substitute-command-keys doc) returns a string like "\nUses
;; keymap...\nFirst line docstring. See
;; .
(truncate-string-to-width
(helm-acase (split-string (substitute-command-keys doc) "\n")
((dst* (l &rest args))
(if (string= l "") (cadr args) l)))
end-column nil nil t)
(if (or (symbol-function sym) (boundp sym) (facep sym) (helm-group-p sym))
"Not documented"
;; Symbol exist but has no definition yet e.g.
;; (advice-add 'foo-test :override (lambda () (message "invalid
;; function"))) and foo-test is not already defined.
"Not already defined or loaded"))))
;;; File completion.
;;
;; Complete file name at point.
;;;###autoload
(defun helm-complete-file-name-at-point (&optional force)
"Preconfigured Helm to complete file name at point."
(interactive)
(require 'helm-mode)
(let* ((tap (or (thing-at-point 'filename t) ""))
beg
(init (and tap
(or force
(save-excursion
(end-of-line)
(search-backward tap (pos-bol) t)
(setq beg (point))
(looking-back "[^'`( ]" (1- (point)))))
(expand-file-name tap)))
(end (point))
(helm-quit-if-no-candidate t)
(helm-execute-action-at-once-if-one t)
completion)
(with-helm-show-completion beg end
(setq completion (helm-read-file-name "FileName: "
:initial-input init)))
(when (and completion (not (string= completion "")))
(delete-region beg end) (insert (if (string-match "^~" tap)
(abbreviate-file-name completion)
completion)))))
(make-obsolete 'helm-complete-file-name-at-point 'helm-find-files "3.9.6")
;;;###autoload
(defun helm-lisp-indent ()
;; It is meant to use with `helm-define-multi-key' which
;; does not support args for functions yet, so use `current-prefix-arg'
;; for now instead of (interactive "P").
(interactive)
(let ((tab-always-indent (or (eq tab-always-indent 'complete)
tab-always-indent)))
(indent-for-tab-command current-prefix-arg)))
;;; Apropos
;;
;;
(defvar helm-apropos-history nil)
(defcustom helm-apropos-show-short-doc nil
"Show short docstring of symbols when non nil.
NOTE: When displaying helm-apropos in a frame, i.e. when
`helm-apropos' is member of `helm-commands-using-frame' setting this
to non nil have no effect, you have first to remove `helm-apropos'
from `helm-commands-using-frame'."
:group 'helm-elisp
:type 'boolean)
(defvar helm-apropos-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-]") #'helm-apropos-toggle-details)
map))
(defun helm-apropos-init (test default &optional fn)
"Setup `helm-candidate-buffer' for `helm-apropos' sources.
A list of symbols fetched with FN is inserted in
`helm-candidate-buffer', if FN is not provided symbols are fetched
against obarray with predicate TEST. When FN is provided predicate TEST
is only used to test DEFAULT."
(require 'helm-help)
(helm-init-candidates-in-buffer 'global
(let ((default-symbol (and (stringp default)
(intern-soft default)))
(symbols (if fn (funcall fn) (all-completions "" obarray test))))
(if (and default-symbol (funcall test default-symbol))
(cons default-symbol symbols)
symbols))))
(defun helm-apropos-short-doc-transformer (candidates _source)
(if helm-apropos-show-short-doc
(cl-loop for cand in candidates
for doc = (helm-get-first-line-documentation (intern-soft cand))
collect (cons (format "%s%s%s"
cand
(if doc
(helm-make-separator cand)
"")
(if doc
(propertize
doc 'face 'helm-M-x-short-doc)
""))
cand))
candidates))
(defun helm-apropos-default-sort-fn (candidates _source)
(if (string= helm-pattern "")
candidates
(sort candidates #'helm-generic-sort-fn)))
(defun helm-apropos-clean-history-variable (candidate)
(with-helm-current-buffer ; var is maybe local
(let* ((sym (intern-soft candidate))
(cands (symbol-value sym))
(mkds (and (listp cands)
(helm-comp-read "Delete entry: "
cands :marked-candidates t))))
(cl-assert (listp mkds) nil "Variable value is not a list")
(cl-loop for elm in mkds do
(if (local-variable-p sym)
(set (make-local-variable sym)
(setq cands (delete elm cands)))
(set sym (setq cands (delete elm cands))))))))
(defun helm-apropos-clean-ring (candidate)
(with-helm-current-buffer ; var is maybe local
(let* ((sym (intern-soft candidate))
(val (symbol-value sym))
(cands (and (ring-p val) (ring-elements val)))
(mkds (and cands (helm-comp-read
"Delete entry: "
cands :marked-candidates t))))
(when mkds
(cl-loop for elm in mkds do
(ring-remove
val (helm-position
elm
(ring-elements val)
:test 'equal))
and do (if (local-variable-p sym)
(set (make-local-variable sym) val)
(set sym val)))))))
(defun helm-apropos-action-transformer (actions candidate)
(let* ((sym (helm-symbolify candidate))
(val (with-helm-current-buffer (symbol-value sym))))
(cond ((custom-variable-p sym)
(append
actions
(let ((standard-value (eval (car (get sym 'standard-value)) t)))
(unless (equal standard-value (symbol-value sym))
`(("Reset Variable to default value"
. ,(lambda (candidate)
(let ((sym (helm-symbolify candidate)))
(set sym standard-value)))))))
`(("Customize variable"
. ,(lambda (candidate)
(customize-option (helm-symbolify candidate)))))))
((and val (with-helm-current-buffer (ring-p (symbol-value sym))))
(append actions
'(("Clean ring" . helm-apropos-clean-ring))))
((and (string-match-p "history" candidate) (listp val))
(append actions
'(("Clean variable" .
helm-apropos-clean-history-variable))))
(t actions))))
(defun helm-def-source--emacs-variables (&optional default)
(helm-build-in-buffer-source "Variables"
:init (lambda ()
(helm-apropos-init
(lambda (x)
(and (boundp x) (not (keywordp x)) (not (class-p x))))
default))
:fuzzy-match helm-apropos-fuzzy-match
:filtered-candidate-transformer
(delq nil (list (and (null helm-apropos-fuzzy-match)
'helm-apropos-default-sort-fn)
(and (null (memq 'helm-apropos helm-commands-using-frame))
#'helm-apropos-short-doc-transformer)))
:nomark t
:persistent-action (lambda (candidate)
(helm-elisp--persistent-help
candidate 'helm-describe-variable))
:persistent-help "Toggle describe variable"
:keymap helm-apropos-map
:action '(("Describe variable" . helm-describe-variable)
("Find variable" . helm-find-variable)
("Info lookup" . helm-info-lookup-symbol)
("Set variable" . helm-set-variable))
:action-transformer 'helm-apropos-action-transformer))
(defun helm-def-source--emacs-faces (&optional default)
"Create `helm' source for faces to be displayed with
`helm-apropos'."
(helm-build-in-buffer-source "Faces"
:init (lambda () (helm-apropos-init 'facep default #'face-list))
:fuzzy-match helm-apropos-fuzzy-match
:filtered-candidate-transformer
(delq nil (list
(and (null helm-apropos-fuzzy-match)
#'helm-apropos-default-sort-fn)
(lambda (candidates _source)
(cl-loop for c in candidates
collect (propertize c 'face (intern c))))
(and (null (memq 'helm-apropos helm-commands-using-frame))
#'helm-apropos-short-doc-transformer)))
:persistent-action (lambda (candidate)
(helm-elisp--persistent-help
candidate 'helm-describe-face))
:persistent-help "Toggle describe face"
:keymap helm-apropos-map
:action '(("Describe face" . helm-describe-face)
("Find face" . helm-find-face-definition)
("Customize face" . (lambda (candidate)
(customize-face (helm-symbolify candidate)))))))
(defun helm-def-source--emacs-commands (&optional default)
(require 'helm-command)
(helm-build-in-buffer-source "Commands"
:init (lambda ()
(helm-apropos-init 'commandp default))
:fuzzy-match helm-apropos-fuzzy-match
:filtered-candidate-transformer
(append (list #'helm-M-x-transformer-no-sort-no-props)
(and (null helm-apropos-fuzzy-match)
'(helm-apropos-default-sort-fn)))
:display-to-real 'helm-symbolify
:nomark t
:persistent-action (lambda (candidate)
(helm-elisp--persistent-help
candidate 'helm-describe-function))
:persistent-help "Toggle describe command"
:keymap helm-apropos-map
:action 'helm-type-function-actions))
(defun helm-def-source--emacs-functions (&optional default)
(helm-build-in-buffer-source "Functions"
:init (lambda ()
(helm-apropos-init (lambda (x)
(and (fboundp x)
(not (commandp x))
(not (cl-generic-p x))
(not (class-p x))))
default))
:fuzzy-match helm-apropos-fuzzy-match
:filtered-candidate-transformer
(delq nil (list (and (null helm-apropos-fuzzy-match)
'helm-apropos-default-sort-fn)
(and (null (memq 'helm-apropos helm-commands-using-frame))
#'helm-apropos-short-doc-transformer)))
:display-to-real 'helm-symbolify
:persistent-action (lambda (candidate)
(helm-elisp--persistent-help
candidate 'helm-describe-function))
:persistent-help "Toggle describe function"
:keymap helm-apropos-map
:nomark t
:action 'helm-type-function-actions))
(defun helm-def-source--eieio-classes (&optional default)
(helm-build-in-buffer-source "Classes"
:init (lambda ()
(helm-apropos-init (lambda (x)
(class-p x))
default))
:fuzzy-match helm-apropos-fuzzy-match
:filtered-candidate-transformer
(delq nil (list (and (null helm-apropos-fuzzy-match)
'helm-apropos-default-sort-fn)
(and (null (memq 'helm-apropos helm-commands-using-frame))
#'helm-apropos-short-doc-transformer)))
:nomark t
:persistent-action (lambda (candidate)
(helm-elisp--persistent-help
candidate 'helm-describe-class))
:persistent-help "Toggle describe class"
:keymap helm-apropos-map
:action '(("Describe Class" . helm-describe-class)
("Find Class (C-u for source)" . helm-find-function)
("Info lookup" . helm-info-lookup-symbol))))
(defun helm-def-source--eieio-generic (&optional default)
(helm-build-in-buffer-source "Generic functions"
:init (lambda ()
(helm-apropos-init (lambda (x)
(cl-generic-p x))
default))
:fuzzy-match helm-apropos-fuzzy-match
:filtered-candidate-transformer
(delq nil (list (and (null helm-apropos-fuzzy-match)
'helm-apropos-default-sort-fn)
(and (null (memq 'helm-apropos helm-commands-using-frame))
#'helm-apropos-short-doc-transformer)))
:nomark t
:persistent-action (lambda (candidate)
(helm-elisp--persistent-help
candidate 'helm-describe-function))
:persistent-help "Toggle describe generic function"
:keymap helm-apropos-map
:action '(("Describe function" . helm-describe-function)
("Find function (C-u for source)" . helm-find-function)
("Info lookup" . helm-info-lookup-symbol))))
(defun helm-info-lookup-fallback-source (candidate)
(cl-multiple-value-bind (fn src-name)
(helm-acase (helm-symbolify candidate)
((guard* (class-p it))
(list #'helm-describe-function
"Describe class"))
((guard* (cl-generic-p it))
(list #'helm-describe-function
"Describe generic function"))
((guard* (fboundp it))
(list #'helm-describe-function
"Describe function"))
((guard* (facep it))
(list #'helm-describe-face
"Describe face"))
(t
(list #'helm-describe-variable
"Describe variable")))
(helm-build-sync-source src-name
:candidates (list candidate)
:persistent-action (lambda (candidate)
(helm-elisp--persistent-help
candidate fn))
:persistent-help src-name
:nomark t
:action fn)))
(defun helm-info-lookup-symbol-1 (c)
(let ((helm-execute-action-at-once-if-one 'current-source))
(helm :sources (append helm-apropos-defaut-info-lookup-sources
(list (helm-info-lookup-fallback-source c)))
:resume 'noresume
:buffer "*helm lookup*"
:input (helm-stringify c))))
(defun helm-info-lookup-symbol (candidate)
;; ???:Running an idle-timer allows not catching RET when exiting
;; with the fallback source.
;; (run-with-idle-timer 0.01 nil #'helm-info-lookup-symbol-1 candidate)
(helm-info-lookup-symbol-1 candidate))
(defun helm-apropos-toggle-details ()
"Toggle details in `helm-apropos'."
(interactive)
(with-helm-buffer
(unless (memq 'helm-apropos helm-commands-using-frame)
(setq helm-M-x-show-short-doc (not helm-M-x-show-short-doc)
helm-apropos-show-short-doc (not helm-apropos-show-short-doc))
(helm-force-update (concat "^" (helm-stringify (helm-get-selection)))
(helm-get-current-source)))))
(defun helm-apropos-get-default ()
(with-syntax-table emacs-lisp-mode-syntax-table
(symbol-name (intern-soft
(helm-aand (thing-at-point 'symbol t)
(replace-regexp-in-string "\\`[~=]" "" it)
(replace-regexp-in-string "[~=]\\'" "" it))))))
;;;###autoload
(defun helm-apropos (default)
"Preconfigured Helm to describe commands, functions, variables and faces.
In non interactives calls DEFAULT argument should be provided as
a string, i.e. the `symbol-name' of any existing symbol."
(interactive (list (helm-apropos-get-default)))
(let ((helm-M-x-show-short-doc
(and helm-apropos-show-short-doc
(null (memq 'helm-apropos helm-commands-using-frame)))))
(helm :sources
(mapcar (lambda (func)
(funcall func default))
helm-apropos-function-list)
:history 'helm-apropos-history
:buffer "*helm apropos*"
:preselect (and default (concat "^\\_<" (regexp-quote default) "\\_>"))
:truncate-lines t)))
;;; Locate elisp library
;;
;;
(defvar helm--locate-library-cache nil)
(defvar helm--locate-library-doc-cache (make-hash-table :test 'equal))
(defun helm-locate-library-scan-list ()
(cl-loop for dir in load-path
when (file-directory-p dir)
nconc (directory-files
dir nil (concat (regexp-opt (find-library-suffixes)) "\\'"))))
;;;###autoload
(defun helm-locate-library (&optional arg)
"Preconfigured helm to locate elisp libraries.
When `completions-detailed' or `helm-completions-detailed' is non
nil, a description of libraries is provided. The libraries are
partially cached in the variables
`helm--locate-library-doc-cache' and
`helm--locate-library-cache'. TIP: You can make these vars
persistent for faster start with the psession package, using M-x
psession-make-persistent-variable. NOTE: The caches affect as
well `find-libray' and `locate-library' when `helm-mode' is
enabled and `completions-detailed' is non nil. There is no need
to refresh the caches, they will be updated automatically if some
new libraries are found, however when a library update its
headers and the description change you can reset the caches with
a prefix arg."
(interactive "P")
(require 'helm-mode)
(let (done)
(when arg
(setq helm--locate-library-cache nil)
(clrhash helm--locate-library-doc-cache))
(helm :sources
(helm-build-in-buffer-source "Elisp libraries (Scan)"
:data #'helm-locate-library-scan-list
:fuzzy-match helm-locate-library-fuzzy-match
:keymap helm-generic-files-map
:candidate-transformer
(lambda (candidates)
(cl-loop with reporter = (unless done
(make-progress-reporter
"Scanning libraries..." 0 (length candidates)))
with lgst = (helm-in-buffer-get-longest-candidate)
for c in candidates
for count from 0
for bn = (helm-basename c 2)
for sep = (helm-make-separator bn lgst)
for path = (or (assoc-default bn helm--locate-library-cache)
;; A lock file in LOAD-PATH (bug#2626).
(unless (string-match "\\`\\.#" bn)
(let ((p (find-library-name bn)))
(push (cons bn p) helm--locate-library-cache)
p)))
for doc = (and path
(or completions-detailed helm-completions-detailed)
(or (gethash bn helm--locate-library-doc-cache)
(puthash bn (helm-locate-lib-get-summary path)
helm--locate-library-doc-cache)))
for disp = (and path
(if (and doc
(or completions-detailed helm-completions-detailed))
(helm-aand (propertize doc 'face 'helm-completions-detailed)
(propertize " " 'display (concat sep it))
(concat bn it))
bn))
when (and disp path)
collect (cons disp path)
when reporter do (progress-reporter-update reporter count)
finally do (setq done t)))
:action (helm-actions-from-type-file))
:buffer "*helm locate library*")))
;;; Modify variables from Helm
;;
;;
(defun helm-set-variable (var)
"Set VAR value interactively."
(let* ((sym (helm-symbolify var))
(val (default-value sym))
(strv (prin1-to-string val)))
(if (> (length strv) 25)
(helm-edit-variable var)
(set-default sym (eval-minibuffer
(format "Set `%s': " var)
(if (or (arrayp val)
(memq val '(nil t))
(numberp val))
strv
(format "'%s" strv)))))))
(defvar helm-edit-variable-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-c") 'helm-set-variable-from-pp-buffer)
(define-key map (kbd "C-c C-k") 'helm-edit-variable-quit)
(define-key map (kbd "C-c =") 'helm-edit-variable-toggle-diff)
map))
(define-derived-mode helm-edit-variable-mode
emacs-lisp-mode "helm-edit-variable"
"A mode to edit variables values.
Special commands:
\\{helm-edit-variable-mode-map}")
(defvar helm-pretty-print-temp-file-name
(expand-file-name "helm-edit-variable.el" temporary-file-directory))
(defvar helm-pretty-print-buffer-name "*pretty print output*")
(defvar helm-pretty-print-current-symbol nil)
(defun helm-edit-variable (var)
(let* ((sym (intern-soft var))
(val (symbol-value sym))
(pp (pp-to-string val))
start)
(with-current-buffer (get-buffer-create helm-pretty-print-buffer-name)
(erase-buffer)
(helm-edit-variable-mode)
(setq start (point))
;; Any number of lines starting with ";;;" + one empty line.
(insert (format ";;; Edit variable `%s' and hit C-c C-c when done\n" sym)
";;; Abort with C-c C-k\n\n")
(add-text-properties start (1- (point)) '(read-only t))
(add-text-properties (1- (point)) (point) '(read-only t rear-nonsticky t))
(set (make-local-variable 'helm-pretty-print-current-symbol) sym)
(add-hook 'kill-buffer-hook
(lambda ()
(when (file-exists-p helm-pretty-print-temp-file-name)
(delete-file helm-pretty-print-temp-file-name)))
nil t)
(save-excursion (insert pp))
(write-region
(point-min) (point-max) helm-pretty-print-temp-file-name nil 1)
(setq buffer-file-name helm-pretty-print-temp-file-name))
(display-buffer helm-pretty-print-buffer-name)))
(defun helm-edit-variable-toggle-diff ()
"Show diff in edit variable buffer."
(interactive)
(if (get-buffer-window "*Diff*" 'visible)
(kill-buffer "*Diff*")
(diff-buffer-with-file)))
(defun helm-set-variable-from-pp-buffer ()
"Set variable associated with buffer to buffer contents.
The associated variable is the local variable
`helm-pretty-print-current-symbol'."
(interactive)
(with-current-buffer helm-pretty-print-buffer-name
(goto-char (point-min))
(when (re-search-forward "^$" nil t)
(forward-line 1))
(let ((val (symbol-value helm-pretty-print-current-symbol)))
(save-excursion
(if (or (arrayp val)
(memq val '(nil t))
(numberp val)
(looking-at "[`']"))
(set-default helm-pretty-print-current-symbol
(read (current-buffer)))
(set-default helm-pretty-print-current-symbol
`(,@(read (current-buffer))))))
(if (equal val (symbol-value helm-pretty-print-current-symbol))
(message "No changes done")
(message "`%s' value modified" helm-pretty-print-current-symbol))
(helm-edit-variable-quit))))
(defun helm-edit-variable-quit ()
"Quit edit variable buffer."
(interactive)
(set-buffer-modified-p nil)
(quit-window t)
(helm-aif (get-buffer-window "*Diff*" 'visible)
(quit-window t it)))
;;; Elisp Timers.
;;
;;
(defclass helm-absolute-time-timers-class (helm-source-sync helm-type-timers)
((candidates :initform 'timer-list)
(allow-dups :initform t)
(candidate-transformer
:initform
(lambda (candidates)
(cl-loop for timer in candidates
collect (cons (helm-elisp--format-timer timer) timer))))))
(defvar helm-source-absolute-time-timers
(helm-make-source "Absolute Time Timers" 'helm-absolute-time-timers-class))
(defclass helm-idle-time-timers-class (helm-source-sync helm-type-timers)
((candidates :initform 'timer-idle-list)
(allow-dups :initform t)
(candidate-transformer
:initform
(lambda (candidates)
(cl-loop for timer in candidates
collect (cons (helm-elisp--format-timer timer) timer))))))
(defvar helm-source-idle-time-timers
(helm-make-source "Idle Time Timers" 'helm-idle-time-timers-class))
(defun helm-elisp--format-timer (timer)
(format "%s repeat=%s %s(%s)"
(let ((time (timer--time timer)))
(if (timer--idle-delay timer)
(format "idle-for=[%s]"
(format-seconds "%dd %hh %mmin %z%,3ss"
(time-to-seconds time)))
(format-time-string "%m/%d %T" time)))
(or (timer--repeat-delay timer) "nil")
(mapconcat #'identity (split-string
(prin1-to-string (timer--function timer))
"\n")
" ")
(mapconcat #'prin1-to-string (timer--args timer) " ")))
;;;###autoload
(defun helm-timers ()
"Preconfigured `helm' for timers."
(interactive)
(helm :sources '(helm-source-absolute-time-timers
helm-source-idle-time-timers)
:buffer "*helm timers*"))
;;; Complex command history
;;
;;
(defvar helm-sexp--last-sexp nil)
;; This wont work compiled.
(defun helm-sexp-eval-1 ()
(interactive)
(unwind-protect
(progn
;; Trick called-interactively-p into thinking that `cand' is
;; an interactive call, See `repeat-complex-command'.
(add-hook 'called-interactively-p-functions
#'helm-complex-command-history--called-interactively-skip)
(eval (read helm-sexp--last-sexp) t))
(remove-hook 'called-interactively-p-functions
#'helm-complex-command-history--called-interactively-skip)))
(defun helm-complex-command-history--called-interactively-skip (i _frame1 frame2)
(and (eq 'eval (cadr frame2))
(eq 'helm-sexp-eval-1
(cadr (backtrace-frame (+ i 2) #'called-interactively-p)))
1))
(defun helm-sexp-eval (_candidate)
(call-interactively #'helm-sexp-eval-1))
(defvar helm-source-complex-command-history
(helm-build-sync-source "Complex Command History"
:candidates (lambda ()
;; Use cdr to avoid adding
;; `helm-complex-command-history' here.
(cl-loop for i in command-history
unless (equal i '(helm-complex-command-history))
collect (prin1-to-string i)))
:action (helm-make-actions
"Eval" (lambda (candidate)
(and (boundp 'helm-sexp--last-sexp)
(setq helm-sexp--last-sexp candidate))
(let ((command (read candidate)))
(unless (equal command (car command-history))
(setq command-history (cons command command-history))))
(run-with-timer 0.1 nil #'helm-sexp-eval candidate))
"Edit and eval" (lambda (candidate)
(edit-and-eval-command "Eval: " (read candidate))))
:persistent-action #'helm-sexp-eval
:multiline t))
;;;###autoload
(defun helm-complex-command-history ()
"Preconfigured `helm' for complex command history."
(interactive)
(helm :sources 'helm-source-complex-command-history
:buffer "*helm complex commands*"))
(provide 'helm-elisp)
;;; helm-elisp.el ends here
helm-4.0.3/helm-epa.el 0000664 0000000 0000000 00000025264 15011067617 0014472 0 ustar 00root root 0000000 0000000 ;;; helm-epa.el --- helm interface for epa/epg -*- lexical-binding: t; -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'helm)
(eval-when-compile (require 'epg))
(defvar epa-protocol)
(defvar epa-last-coding-system-specified)
(defvar epg-key-validity-alist)
(defvar mail-header-separator)
(declare-function epg-list-keys "epg")
(declare-function epg-make-context "epg")
(declare-function epg-key-sub-key-list "epg")
(declare-function epg-sub-key-id "epg")
(declare-function epg-key-user-id-list "epg")
(declare-function epg-user-id-string "epg")
(declare-function epg-user-id-validity "epg")
(declare-function epa-sign-region "epa")
(declare-function epa--read-signature-type "epa")
(declare-function epa-display-error "epa")
(declare-function epg-export-keys-to-string "epg")
(declare-function epg-context-armor "epg")
(declare-function epg-context-set-armor "epg")
(declare-function epg-delete-keys "epg")
(declare-function helm-read-file-name "helm-mode")
(defvar helm-epa--list-only-secrets nil
"[INTERNAL] Used to pass MODE argument to `epg-list-keys'.")
(defcustom helm-epa-actions '(("Show key" . epa--show-key)
("encrypt file with key" . helm-epa-encrypt-file)
("Copy keys to kill ring" . helm-epa-kill-keys-armor)
("Delete keys" . helm-epa-delete-keys))
"Actions for `helm-epa-list-keys'."
:type '(alist :key-type string :value-type symbol)
:group 'helm-misc)
(defclass helm-epa (helm-source-sync)
((init :initform (lambda ()
(require 'epg)
(require 'epa)))
(candidates :initform 'helm-epa-get-key-list)
(keymap :initform 'helm-comp-read-map)
(mode-line :initform 'helm-comp-read-mode-line))
"Allow building helm sources for GPG keys.")
(defun helm-epa-get-key-list (&optional keys)
"Build candidate list for `helm-epa-list-keys'."
(cl-loop with all-keys = (or keys (epg-list-keys (epg-make-context epa-protocol)
nil helm-epa--list-only-secrets))
for key in all-keys
for sublist = (car (epg-key-sub-key-list key))
for subkey-id = (epg-sub-key-id sublist)
for uid-list = (epg-key-user-id-list key)
for uid = (epg-user-id-string (car uid-list))
for validity = (epg-user-id-validity (car uid-list))
collect (cons (format " %s %s %s"
(helm-aif (rassq validity epg-key-validity-alist)
(string (car it))
"?")
(propertize
subkey-id
'face (cl-case validity
(none 'epa-validity-medium)
((revoked expired)
'epa-validity-disabled)
(t 'epa-validity-high)))
(propertize
uid 'face 'font-lock-warning-face))
key)))
(cl-defun helm-epa--select-keys (prompt keys)
"A helm replacement for `epa--select-keys'."
(let ((result (helm :sources (helm-make-source "Epa select keys" 'helm-epa
:candidates (lambda ()
(helm-epa-get-key-list keys))
:action (lambda (_candidate)
(helm-marked-candidates)))
:prompt (and prompt (helm-epa--format-prompt prompt))
:buffer "*helm epa*")))
(if (or (equal result "") (null result))
(cl-return-from helm-epa--select-keys
(error "No keys selected, aborting"))
result)))
(defun helm-epa--format-prompt (prompt)
(let ((split (split-string prompt "\n")))
(if (cdr split)
(format "%s\n(%s): "
(replace-regexp-in-string "\\.[\t ]*\\'" "" (car split))
(replace-regexp-in-string "\\.[\t ]*\\'" "" (cadr split)))
(format "%s: " (replace-regexp-in-string "\\.[\t ]*\\'" "" (car split))))))
(defun helm-epa--read-signature-type-help ()
(with-temp-buffer
(save-excursion
(insert
"n: Create a normal signature)\n"
"c: Create a cleartext signature)\n"
"d: Create a detached signature)"))
(while (re-search-forward "^\\(.\\):" nil t)
(helm-add-face-text-properties (match-beginning 1) (match-end 1)
'font-lock-variable-name-face))
(buffer-string)))
(defun helm-epa--read-signature-type ()
"A helm replacement for `epa--read-signature-type'."
(let ((answer (helm-read-answer "Signature type? [n,c,d,h]"
'("n" "c" "d")
#'helm-epa--read-signature-type-help)))
(helm-acase answer
("n" 'normal)
("c" 'clear)
("d" 'detached))))
(defun helm-epa-collect-keys-from-candidates (candidates)
(cl-loop for c in candidates
collect (epg-sub-key-id
(car (epg-key-sub-key-list c)))))
(defun helm-epa-collect-id-from-candidates (candidates)
(cl-loop for c in candidates
collect (epg-user-id-string
(car (epg-key-user-id-list c)))))
(defun helm-epa-success-message (str keys ids)
(message str
(mapconcat (lambda (pair)
(concat (car pair) " " (cdr pair)))
(cl-loop for k in keys
for i in ids
collect (cons k i))
"\n")))
;;;###autoload
(define-minor-mode helm-epa-mode
"Enable helm completion on gpg keys in epa functions."
:group 'helm-misc
:global t
(require 'epa)
(if helm-epa-mode
(progn
(advice-add 'epa--select-keys :override #'helm-epa--select-keys)
(advice-add 'epa--read-signature-type :override #'helm-epa--read-signature-type))
(advice-remove 'epa--select-keys #'helm-epa--select-keys)
(advice-remove 'epa--read-signature-type #'helm-epa--read-signature-type)))
(defun helm-epa-action-transformer (actions _candidate)
"Helm epa action transformer function."
(cond ((with-helm-current-buffer
(derived-mode-p 'message-mode 'mail-mode))
(helm-append-at-nth
actions '(("Sign mail with key" . helm-epa-mail-sign)
("Encrypt mail with key" . helm-epa-mail-encrypt))
3))
(t actions)))
(defun helm-epa-delete-keys (_candidate)
"Delete gpg marked keys from helm-epa."
(let ((context (epg-make-context epa-protocol))
(keys (helm-marked-candidates)))
(message "Deleting gpg keys..")
(condition-case error
(epg-delete-keys context keys)
(error
(epa-display-error context)
(signal (car error) (cdr error))))
(message "Deleting gpg keys done")))
(defun helm-epa-encrypt-file (_candidate)
"Select a file to encrypt with key CANDIDATE."
(let* ((file (helm-read-file-name "Encrypt file: "))
(cands (helm-marked-candidates))
(keys (helm-epa-collect-keys-from-candidates cands))
(ids (helm-epa-collect-id-from-candidates cands)))
(epa-encrypt-file file cands)
(helm-epa-success-message "File encrypted with key(s):\n %s"
keys ids)))
(defun helm-epa-kill-keys-armor (_candidate)
"Copy marked keys to kill ring."
(let ((keys (helm-marked-candidates))
(context (epg-make-context epa-protocol)))
(with-no-warnings
(setf (epg-context-armor context) t))
(condition-case error
(kill-new (epg-export-keys-to-string context keys))
(error
(epa-display-error context)
(signal (car error) (cdr error))))))
(defun helm-epa-mail-sign (candidate)
"Sign email with key CANDIDATE."
(let ((key (epg-sub-key-id (car (epg-key-sub-key-list candidate))))
(id (epg-user-id-string (car (epg-key-user-id-list candidate))))
start end mode)
(save-excursion
(goto-char (point-min))
(if (search-forward mail-header-separator nil t)
(forward-line))
(setq epa-last-coding-system-specified
(or coding-system-for-write
(select-safe-coding-system (point) (point-max))))
(let ((verbose current-prefix-arg))
(setq start (point)
end (point-max)
mode (if verbose
(epa--read-signature-type)
'clear))))
;; TODO Make non-interactive functions to replace epa-sign-region
;; and epa-encrypt-region and inline them.
(with-no-warnings
(epa-sign-region start end candidate mode))
(message "Mail signed with key `%s %s'" key id)))
(defun helm-epa-mail-encrypt (_candidate)
"Encrypt email with key CANDIDATE."
(let ((cands (helm-marked-candidates))
start end)
(save-excursion
(goto-char (point-min))
(when (search-forward mail-header-separator nil t)
(forward-line))
(setq start (point)
end (point-max))
(setq epa-last-coding-system-specified
(or coding-system-for-write
(select-safe-coding-system start end))))
;; Don't let some read-only text stop us from encrypting.
(let ((inhibit-read-only t)
(keys (helm-epa-collect-keys-from-candidates cands))
(ids (helm-epa-collect-id-from-candidates cands)))
(with-no-warnings
(epa-encrypt-region start end cands nil nil))
(helm-epa-success-message "Mail encrypted with key(s):\n %s"
keys ids))))
;;;###autoload
(defun helm-epa-list-keys ()
"List all gpg keys.
This is the helm interface for `epa-list-keys'."
(interactive)
(helm :sources
(helm-make-source "Epg list keys" 'helm-epa
:action-transformer 'helm-epa-action-transformer
:action 'helm-epa-actions)
:buffer "*helm epg list keys*"))
(provide 'helm-epa)
;;; helm-epa.el ends here
helm-4.0.3/helm-eshell.el 0000664 0000000 0000000 00000047703 15011067617 0015203 0 ustar 00root root 0000000 0000000 ;;; helm-eshell.el --- pcomplete and eshell completion for helm. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Commentary:
;;
;; Enable like this in .emacs:
;; (add-hook 'eshell-mode-hook
;; (lambda ()
;; (eshell-cmpl-initialize)
;; (define-key eshell-mode-map [remap eshell-pcomplete] 'helm-esh-pcomplete)
;; (define-key eshell-mode-map (kbd "M-s f") 'helm-eshell-prompts-all)))
;; (define-key eshell-mode-map (kbd "M-r") 'helm-eshell-history)))
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-lib)
(require 'helm-help)
(require 'helm-elisp)
(declare-function eshell-read-aliases-list "em-alias")
(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
(declare-function eshell-bol "esh-mode")
(declare-function eshell-parse-arguments "esh-arg" (beg end))
(declare-function eshell-backward-argument "esh-mode" (&optional arg))
(declare-function helm-quote-whitespace "helm-lib")
(declare-function eshell-skip-prompt "em-prompt")
(defvar eshell-special-chars-outside-quoting)
(defgroup helm-eshell nil
"Helm completion and history for Eshell."
:group 'helm)
(defcustom helm-eshell-fuzzy-match nil
"Enable fuzzy matching in `helm-esh-pcomplete' when non-nil."
:type 'boolean)
(defvar helm-eshell-history-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-p") #'helm-next-line)
map)
"Keymap for `helm-eshell-history'.")
(defvar helm-esh-completion-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "TAB") #'helm-next-line)
map)
"Keymap for `helm-esh-pcomplete'.")
(defvar helm-eshell--quit-flag nil)
;; Internal.
(defvar helm-ec-target "")
(defun helm-ec-insert (_candidate)
"Replace text at point with CANDIDATE.
The function that call this should set `helm-ec-target' to thing
at point."
(set (make-local-variable 'comint-file-name-quote-list)
eshell-special-chars-outside-quoting)
(let ((pt (point)))
(when (and helm-ec-target
(search-backward helm-ec-target nil t)
(string= (buffer-substring (point) pt) helm-ec-target))
(delete-region (point) pt)))
(when (string-match "\\`\\*" helm-ec-target) (insert "*"))
(let ((marked (helm-marked-candidates)))
(prog1 t ;; Makes helm returns t on action.
(insert
(mapconcat
(lambda (x)
(cond ((string-match "\\`~/" helm-ec-target)
;; Strip out the first escape char added by
;; `comint-quote-filename' before "~" (Bug#1803).
(substring (comint-quote-filename (abbreviate-file-name x)) 1))
((string-match "\\`/" helm-ec-target)
(comint-quote-filename x))
(t
(concat (and (string-match "\\`[.]/" helm-ec-target) "./")
(comint-quote-filename
(file-relative-name x))))))
marked " ")
(or (helm-aand (car (last marked))
(string-match-p "/\\'" it)
"")
" ")))))
(defun helm-esh-transformer (candidates _sources)
(cl-loop
for i in candidates
collect
(cond ((string-match "\\`~/?" helm-ec-target)
(abbreviate-file-name i))
((string-match "\\`/" helm-ec-target) i)
(t
(file-relative-name i)))
into lst
finally return (sort lst #'helm-generic-sort-fn)))
(defclass helm-esh-source (helm-source-sync)
((init :initform (lambda ()
(setq pcomplete-current-completions nil
pcomplete-last-completion-raw nil)
;; Eshell-command add this hook in all minibuffers
;; Remove it for the helm one. (Fixed in Emacs24)
(remove-hook 'minibuffer-setup-hook 'eshell-mode)))
(candidates :initform 'helm-esh-get-candidates)
;(nomark :initform t)
(persistent-action :initform 'ignore)
(nohighlight :initform t)
(filtered-candidate-transformer :initform #'helm-esh-transformer)
(action :initform 'helm-ec-insert))
"Helm class to define source for Eshell completion.")
(defun helm-esh-get-candidates ()
"Get candidates for Eshell completion using `pcomplete'."
(catch 'pcompleted
(with-helm-current-buffer
(let* ((pcomplete-stub)
pcomplete-seen pcomplete-norm-func
pcomplete-args pcomplete-last pcomplete-index
(pcomplete-autolist pcomplete-autolist)
(pcomplete-suffix-list pcomplete-suffix-list)
(table (pcomplete-completions))
(entry (or (try-completion helm-pattern
(pcomplete-entries))
helm-pattern)))
(cl-loop ;; expand entry too to be able to compare it with file-cand.
with exp-entry = (and (stringp entry)
(not (string= entry ""))
(file-name-as-directory
(expand-file-name entry default-directory)))
with comps = (all-completions pcomplete-stub table)
unless comps return (prog1 nil
;; Don't add final space when
;; there is no completion (Bug#1990).
(setq helm-eshell--quit-flag t)
(message "No completions of %s" pcomplete-stub))
for i in comps
;; Transform the relative names to abs names.
for file-cand = (and exp-entry
(if (file-remote-p i) i
(expand-file-name
i (file-name-directory
(if (directory-name-p pcomplete-stub)
entry
(directory-file-name entry))))))
;; Compare them to avoid dups.
for file-entry-p = (and (stringp exp-entry)
(stringp file-cand)
;; Fix :/tmp/foo/ $ cd foo
(not (file-directory-p file-cand))
(file-equal-p exp-entry file-cand))
if (and file-cand (or (file-remote-p file-cand)
(file-exists-p file-cand))
(not file-entry-p))
collect file-cand into ls
else
;; Avoid adding entry here.
unless file-entry-p collect i into ls
finally return
(if (and exp-entry
(file-directory-p exp-entry)
;; If the car of completion list is
;; an executable, probably we are in
;; command completion, so don't add a
;; possible file related entry here.
(and ls (not (executable-find (car ls))))
;; Don't add entry if already in prompt.
(not (file-equal-p exp-entry pcomplete-stub)))
(append (list exp-entry)
;; Entry should not be here now but double check.
(remove entry ls))
ls))))))
;;; Eshell history.
;;
;;
(defclass helm-eshell-history-source (helm-source-sync)
((init :initform
(lambda ()
;; Same comment as in `helm-source-esh'.
(remove-hook 'minibuffer-setup-hook 'eshell-mode)))
(candidates
:initform
(lambda ()
(with-helm-current-buffer
(cl-loop for c from 0 to (ring-length eshell-history-ring)
for elm = (eshell-get-history c)
unless (and (member elm lst)
eshell-hist-ignoredups)
collect elm into lst
finally return lst))))
(nomark :initform t)
(multiline :initform t)
(keymap :initform 'helm-eshell-history-map)
(candidate-number-limit :initform 9999)
(action :initform (lambda (candidate)
(eshell-kill-input)
(insert candidate))))
"Helm class to define source for Eshell history.")
(defun helm-esh-pcomplete-input (target users-comp last)
(if (and (stringp last)
(not (string= last ""))
(not users-comp)
;; Fix completion on "../" see Bug#1832.
(or (file-exists-p last)
(helm-aand
(file-name-directory last)
(file-directory-p it))))
(if (and (file-directory-p last)
(string-match "\\`[~.]*.*/[.]\\'" target))
;; Fix completion on "~/.", "~/[...]/.", and "../."
(expand-file-name
(concat (helm-basedir (file-name-as-directory last))
(regexp-quote (helm-basename target))))
(expand-file-name last))
;; Don't add "~" to input to provide completion on all users instead of only
;; on current $HOME (#1832).
(unless users-comp last)))
(defun helm-esh-pcomplete-default-source ()
"Make and return the default source for Eshell completion."
(helm-make-source "Eshell completions" 'helm-esh-source
:fuzzy-match helm-eshell-fuzzy-match
:keymap helm-esh-completion-map))
(defvar helm-esh-pcomplete-build-source-fn #'helm-esh-pcomplete-default-source
"Function that builds a source or a list of sources.")
(defun helm-esh-pcomplete--make-helm (&optional input)
(helm :sources (funcall helm-esh-pcomplete-build-source-fn)
:buffer "*helm pcomplete*"
:resume 'noresume
:input input))
;;;###autoload
(defun helm-esh-pcomplete ()
"Preconfigured `helm' to provide Helm completion in Eshell."
(interactive)
(let* ((helm-quit-if-no-candidate t)
(helm-execute-action-at-once-if-one t)
(end (point-marker))
(beg (save-excursion (eshell-bol) (point)))
(args (catch 'eshell-incomplete
(eshell-parse-arguments beg end)))
(target
(or (and (looking-back " " (1- (point))) " ")
(buffer-substring-no-properties
(save-excursion
(eshell-backward-argument 1) (point))
end)))
(users-comp (string= target "~"))
(first (car args)) ; Maybe lisp delimiter "(".
last ; Will be the last but parsed by pcomplete.
del-space
del-dot)
(setq helm-ec-target (or target " ")
end (point)
;; Reset beg for `with-helm-show-completion'.
beg (or (and target (not (string= target " "))
(- end (length target)))
;; Nothing at point.
(progn (insert " ") (setq del-space t) (point))))
(when (string-match "\\`[~.]*.*/[.]\\'" target)
;; Fix completion on
;; "~/.", "~/[...]/.", and "../."
(delete-char -1) (setq del-dot t)
(setq helm-ec-target (substring helm-ec-target 0 (1- (length helm-ec-target)))))
(cond ((eq first ?\()
(helm-lisp-completion-at-point))
;; In eshell `pcomplete-parse-arguments' is called
;; with `pcomplete-parse-arguments-function'
;; locally bound to `eshell-complete-parse-arguments'
;; which is calling `lisp-complete-symbol',
;; calling it before would popup the
;; *completions* buffer.
(t (setq last (replace-regexp-in-string
"\\`\\*" ""
(car (last (ignore-errors
(pcomplete-parse-arguments))))))
;; Set helm-eshell--quit-flag to non-nil only on
;; quit, this tells to not add final suffix when quitting
;; helm.
(add-hook 'helm-quit-hook #'helm-eshell--quit-hook-fn)
(with-helm-show-completion beg end
(unwind-protect
(or (helm-esh-pcomplete--make-helm
(helm-esh-pcomplete-input target users-comp last))
;; Delete removed dot on quit
(and del-dot (prog1 t (insert ".")))
;; A space is needed to have completion, remove
;; it when nothing found.
(and del-space (looking-back "\\s-" (1- (point)))
(delete-char -1))
(if (and (null helm-eshell--quit-flag)
(and (stringp last) (file-directory-p last))
(looking-back "\\([.]\\{1,2\\}\\|[^/]\\)\\'"
(1- (point))))
(prog1 t (insert "/"))
;; We need another flag for space here, but
;; global to pass it to `helm-quit-hook', this
;; space is added when point is just after
;; previous completion and there is no
;; more completion, see Bug#1832.
(unless (or helm-eshell--quit-flag
(looking-back "/\\'" (1- (point))))
(prog1 t (insert " ")))
(when (and helm-eshell--quit-flag
(string-match-p "[.]\\{2\\}\\'" last))
(insert "/"))))
(remove-hook 'helm-quit-hook #'helm-eshell--quit-hook-fn)
(setq helm-eshell--quit-flag nil)))))))
(defun helm-eshell--quit-hook-fn ()
(setq helm-eshell--quit-flag t))
;;;###autoload
(defun helm-eshell-history ()
"Preconfigured Helm for Eshell history."
(interactive)
(let* ((end (point))
(beg (save-excursion (eshell-bol) (point)))
(input (buffer-substring beg end))
flag-empty)
(when (eq beg end)
(insert " ")
(setq flag-empty t)
(setq end (point)))
(unwind-protect
(with-helm-show-completion beg end
(helm :sources (helm-make-source "Eshell history"
'helm-eshell-history-source
:fuzzy-match helm-eshell-fuzzy-match)
:buffer "*helm eshell history*"
:resume 'noresume
:input input))
(when (and flag-empty
(looking-back " " (1- (point))))
(delete-char -1)))))
;;; Eshell prompts
;;
(defface helm-eshell-prompts-promptidx
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "cyan"))
"Face used to highlight Eshell prompt index.")
(defface helm-eshell-prompts-buffer-name
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "green"))
"Face used to highlight Eshell buffer name.")
(defcustom helm-eshell-prompts-promptidx-p t
"Show prompt number."
:type 'boolean)
(defvar helm-eshell-prompts-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-c o") #'helm-eshell-prompts-other-window)
(define-key map (kbd "C-c C-o") #'helm-eshell-prompts-other-frame)
map)
"Keymap for `helm-eshell-prompt-all'.")
(defvar eshell-prompt-regexp)
(defvar eshell-highlight-prompt)
(defun helm-eshell-prompts-list (&optional buffer)
"List the prompts in Eshell BUFFER.
Return a list of (\"prompt\" (point) (buffer-name) prompt-index))
E.g. (\"ls\" 162 \"*eshell*\" 3).
If BUFFER is nil, use current buffer."
(with-current-buffer (or buffer (current-buffer))
(when (eq major-mode 'eshell-mode)
(save-excursion
(goto-char (point-min))
(let (result (count 1))
(helm-awhile (re-search-forward eshell-prompt-regexp nil t)
(when (or (and eshell-highlight-prompt
(get-text-property (match-beginning 0) 'read-only))
(null eshell-highlight-prompt))
(push (list (buffer-substring-no-properties
it (pos-eol))
it (buffer-name) count)
result)
(setq count (1+ count))))
(nreverse result))))))
(defun helm-eshell-prompts-list-all ()
"List the prompts of all Eshell buffers.
See `helm-eshell-prompts-list'."
(cl-loop for b in (buffer-list)
append (helm-eshell-prompts-list b)))
(defun helm-eshell-prompts-transformer (candidates &optional all)
;; ("ls" 162 "*eshell*" 3) => ("*eshell*:3:ls" . ("ls" 162 "*eshell*" 3))
(cl-loop for (prt pos buf id) in candidates
collect `(,(concat
(when all
(concat (propertize
buf
'face 'helm-eshell-prompts-buffer-name)
":"))
(when helm-eshell-prompts-promptidx-p
(concat (propertize
(number-to-string id)
'face 'helm-eshell-prompts-promptidx)
":"))
prt)
. ,(list prt pos buf id))))
(defun helm-eshell-prompts-all-transformer (candidates)
(helm-eshell-prompts-transformer candidates t))
(cl-defun helm-eshell-prompts-goto (candidate &optional (action 'switch-to-buffer))
;; Candidate format: ("ls" 162 "*eshell*" 3)
(let ((buf (nth 2 candidate)))
(unless (and (string= (buffer-name) buf)
(eq action 'switch-to-buffer))
(funcall action buf))
(goto-char (nth 1 candidate))
(recenter)))
(defun helm-eshell-prompts-goto-other-window (candidate)
(helm-eshell-prompts-goto candidate 'switch-to-buffer-other-window))
(defun helm-eshell-prompts-goto-other-frame (candidate)
(helm-eshell-prompts-goto candidate 'switch-to-buffer-other-frame))
(helm-make-command-from-action helm-eshell-prompts-other-window
"Switch to eshell prompt in other window."
'helm-eshell-prompts-goto-other-window)
(helm-make-command-from-action helm-eshell-prompts-other-frame
"Switch to eshell prompt in other frame."
'helm-eshell-prompts-goto-other-frame)
;;;###autoload
(defun helm-eshell-prompts ()
"Pre-configured `helm' to browse the prompts of the current Eshell."
(interactive)
(if (eq major-mode 'eshell-mode)
(helm :sources
(helm-build-sync-source "Eshell prompts"
:candidates (helm-eshell-prompts-list)
:candidate-transformer 'helm-eshell-prompts-transformer
:action '(("Go to prompt" . helm-eshell-prompts-goto)))
:buffer "*helm Eshell prompts*")
(message "Current buffer is not an Eshell buffer")))
;;;###autoload
(defun helm-eshell-prompts-all ()
"Pre-configured `helm' to browse the prompts of all Eshell sessions."
(interactive)
(helm :sources
(helm-build-sync-source "All Eshell prompts"
:candidates (helm-eshell-prompts-list-all)
:candidate-transformer 'helm-eshell-prompts-all-transformer
:action '(("Go to prompt" . helm-eshell-prompts-goto)
("Go to prompt in other window `C-c o`" .
helm-eshell-prompts-goto-other-window)
("Go to prompt in other frame `C-c C-o`" .
helm-eshell-prompts-goto-other-frame))
:keymap helm-eshell-prompts-keymap)
:buffer "*helm Eshell all prompts*"))
(provide 'helm-eshell)
;;; helm-eshell ends here
helm-4.0.3/helm-eval.el 0000664 0000000 0000000 00000021607 15011067617 0014651 0 ustar 00root root 0000000 0000000 ;;; helm-eval.el --- eval expressions from helm. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
(require 'eldoc)
(require 'edebug)
(declare-function helm-lisp-completion-at-point "helm-elisp.el")
(declare-function helm-elisp-show-doc-modeline "helm-elisp.el")
(defvar helm-elisp-help-function)
(defgroup helm-eval nil
"Eval related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-eldoc-in-minibuffer-show-fn
'helm-show-info-in-mode-line
"A function to display eldoc info.
Should take one arg: the string to display."
:group 'helm-eval
:type 'symbol)
(defcustom helm-show-info-in-mode-line-delay 12
"Eldoc will show info in mode-line during this delay if user is idle."
:type 'integer
:group 'helm-eval)
;;; Eldoc compatibility between emacs-24 and emacs-25
;;
(if (require 'elisp-mode nil t) ; emacs-25
;; Maybe the eldoc functions have been
;; already aliased by eldoc-eval.
(cl-loop for (f . a) in '((eldoc-current-symbol .
elisp--current-symbol)
(eldoc-fnsym-in-current-sexp .
elisp--fnsym-in-current-sexp)
(eldoc-get-fnsym-args-string .
elisp-get-fnsym-args-string)
(eldoc-get-var-docstring .
elisp-get-var-docstring))
unless (fboundp f)
do (defalias f a))
;; Emacs-24.
(declare-function eldoc-current-symbol "eldoc")
(declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index))
(declare-function eldoc-get-var-docstring "eldoc" (sym))
(declare-function eldoc-fnsym-in-current-sexp "eldoc"))
;;; Evaluation Result
;;
;;
;; Internal
(defvar helm-eldoc-active-minibuffers-list nil)
(defvar helm-eval-expression-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "") #'helm-eval-new-line-and-indent)
(define-key map (kbd "") #'lisp-indent-line)
(define-key map (kbd "") #'helm-lisp-completion-at-point)
(define-key map (kbd "C-p") #'previous-line)
(define-key map (kbd "C-n") #'next-line)
(define-key map (kbd "") #'previous-line)
(define-key map (kbd "") #'next-line)
(define-key map (kbd "") #'forward-char)
(define-key map (kbd "") #'backward-char)
map))
(defclass helm-evaluation-result-class (helm-source-dummy)
((echo-input-in-header-line
:initarg :echo-input-in-header-line
:initform 'never)))
(defun helm-build-evaluation-result-source ()
(helm-make-source "Evaluation Result" 'helm-evaluation-result-class
:multiline t
:mode-line "C-RET: nl-and-indent, M-tab: reindent, C-tab:complete, C-p/n: next/prec-line."
:filtered-candidate-transformer
(lambda (_candidates _source)
(list
(condition-case nil
(with-helm-current-buffer
(pp-to-string
(if edebug-active
(edebug-eval-expression
(read helm-pattern))
(eval (read helm-pattern) t))))
(error "Error"))))
:nohighlight t
:keymap helm-eval-expression-map
:action `(("Copy result to kill-ring" . ,(lambda (candidate)
(kill-new
(replace-regexp-in-string
"\n" "" candidate))
(message "Result copied to kill-ring")))
("copy sexp to kill-ring" . ,(lambda (_candidate)
(kill-new helm-input)
(message "Sexp copied to kill-ring"))))))
(defun helm-eval-new-line-and-indent ()
(interactive)
(newline) (lisp-indent-line))
(defun helm-eldoc-store-minibuffer ()
"Store minibuffer buffer name in `helm-eldoc-active-minibuffers-list'."
(with-selected-window (minibuffer-window)
(push (current-buffer) helm-eldoc-active-minibuffers-list)))
;; From emacs-28.1: As the eldoc API is nowaday a pain to use, try to
;; provide some eldoc in mode-line the best as possible (may break at
;; some point).
(defun helm-eldoc-show-in-eval ()
"Return eldoc in mode-line for current minibuffer input."
(let ((buf (window-buffer (active-minibuffer-window))))
(condition-case err
(when (member buf helm-eldoc-active-minibuffers-list)
(with-current-buffer buf
(let* ((info-fn (eldoc-fnsym-in-current-sexp))
(vsym (eldoc-current-symbol))
(sym (car info-fn))
(vardoc (eldoc-get-var-docstring vsym))
(doc (or vardoc
(eldoc-get-fnsym-args-string
sym (cadr info-fn))))
(all (format "%s: %s"
(propertize
(symbol-name (if vardoc vsym sym))
'face (if vardoc
'font-lock-variable-name-face
'font-lock-function-name-face))
doc)))
(when doc (funcall helm-eldoc-in-minibuffer-show-fn all)))))
(error (message "Eldoc in minibuffer error: %S" err) nil))))
(defun helm-show-info-in-mode-line (str)
"Display string STR in mode-line."
(save-selected-window
(with-helm-window
(let ((mode-line-format (concat " " str)))
(force-mode-line-update)
(sit-for helm-show-info-in-mode-line-delay))
(force-mode-line-update))))
;;; Calculation Result
;;
;;
(defvar helm-source-calculation-result
(helm-build-dummy-source "Calculation Result"
:filtered-candidate-transformer (lambda (_candidates _source)
(list
(condition-case err
(let ((result (calc-eval helm-pattern)))
(if (listp result)
(error "At pos %s: %s"
(car result) (cadr result))
result))
(error (cdr err)))))
:nohighlight t
:action `(("Copy result to kill-ring" . ,(lambda (candidate)
(kill-new candidate)
(message "Result \"%s\" copied to kill-ring"
candidate)))
("Copy operation to kill-ring" . ,(lambda (_candidate)
(kill-new helm-input)
(message "Calculation copied to kill-ring"))))))
;;;###autoload
(defun helm-eval-expression (arg)
"Preconfigured `helm' for `helm-source-evaluation-result'."
(interactive "P")
(let ((helm-elisp-help-function #'helm-elisp-show-doc-modeline))
(helm :sources (helm-build-evaluation-result-source)
:input (when arg (thing-at-point 'sexp))
:buffer "*helm eval*"
:echo-input-in-header-line nil
:history 'read-expression-history)))
(defvar eldoc-idle-delay)
;;;###autoload
(defun helm-eval-expression-with-eldoc ()
"Preconfigured `helm' for `helm-source-evaluation-result' with `eldoc' support."
(interactive)
(let ((timer (run-with-idle-timer
eldoc-idle-delay 'repeat
#'helm-eldoc-show-in-eval)))
(unwind-protect
(minibuffer-with-setup-hook
#'helm-eldoc-store-minibuffer
(call-interactively 'helm-eval-expression))
(and timer (cancel-timer timer))
(setq helm-eldoc-active-minibuffers-list
(cdr helm-eldoc-active-minibuffers-list)))))
;;;###autoload
(defun helm-calcul-expression ()
"Preconfigured `helm' for `helm-source-calculation-result'."
(interactive)
(helm :sources 'helm-source-calculation-result
:buffer "*helm calcul*"))
(provide 'helm-eval)
;;; helm-eval.el ends here
helm-4.0.3/helm-external.el 0000664 0000000 0000000 00000027435 15011067617 0015551 0 ustar 00root root 0000000 0000000 ;;; helm-external.el --- Run Externals commands within Emacs with helm completion. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
(require 'helm-net)
(declare-function helm-comp-read "helm-mode")
(defgroup helm-external nil
"External related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-raise-command nil
"A shell command to jump to a window running specific program.
Need external program wmctrl.
This will be use with `format', so use something like \"wmctrl -xa %s\"."
:type 'string
:group 'helm-external)
(defcustom helm-external-programs-associations nil
"Alist to store externals programs associated with file extension.
This variable overhide setting in .mailcap file.
E.g.: \\='((\"jpg\" . \"gqview\") (\"pdf\" . \"xpdf\")) "
:type '(alist :key-type string :value-type string)
:group 'helm-external)
(defcustom helm-default-external-file-browser "nautilus"
"Default external file browser for your system.
Directories will be opened externally with it when opening file
externally in `helm-find-files'.
Set to nil if you do not have an external file browser or do not
want to use it.
Windows users should set that to \"explorer.exe\"."
:group 'helm-external
:type 'string)
(defvar helm-open-file-externally-after-hook nil
"Hook that run after opening a file with external program.")
(defvar helm-open-file-externally-after-finish-hook nil
"Hook that run after external program finish.")
;;; Internals
(defvar helm-external-command-history nil)
(defvar helm-external-commands-list nil
"A list of all external commands the user can execute.
If this variable is not set by the user, it will be calculated
automatically.")
(defun helm-external-commands-list-1 (&optional sort)
"Return a list of all external commands the user can execute.
If `helm-external-commands-list' is non-nil it will return its
contents. Else it calculates all external commands and sets
`helm-external-commands-list'."
(or helm-external-commands-list
(setq helm-external-commands-list
(cl-loop for dir in (split-string (getenv "PATH") path-separator)
when (and (file-exists-p dir)
(file-accessible-directory-p dir))
for lsdir = (cl-loop for i in (directory-files dir t)
for bn = (file-name-nondirectory i)
when (and (not (member bn completions))
(not (file-directory-p i))
(file-executable-p i))
collect bn)
append lsdir into completions
finally return
(if sort (sort completions 'string-lessp) completions)))))
(defun helm-run-or-raise (exe &optional files detached)
"Run asynchronously EXE or jump to the application window.
If EXE is already running just jump to his window if
`helm-raise-command' is non-nil.
When FILES argument is provided run EXE with FILES.
When argument DETACHED is non nil, detach process from Emacs."
(let* ((proc-name (replace-regexp-in-string
"(" "" (car (split-string exe))))
(fmt-file (lambda (file)
(shell-quote-argument
(if (eq system-type 'windows-nt)
(helm-w32-prepare-filename file)
(expand-file-name file)))))
(file-arg (and files (mapconcat fmt-file files " ")))
process-connection-type proc)
(when (and files detached (not (string-match "%s &)\\'" exe)))
(setq exe (format "(%s &)" exe)))
(when (member proc-name helm-external-commands-list)
;; Allow adding more files to the current process if it is
;; already running (i.e. Don't just raise it without sending
;; files) we assume program doesn't start a new
;; process (like firefox, transmission etc...).
(if files
(cond ((string-match "%s &)\\'" exe)
(message "Starting and detaching `%s' from Emacs" proc-name)
(call-process-shell-command (format exe file-arg)))
(t
(message "Starting %s..." proc-name)
(setq proc
(start-process-shell-command
proc-name nil (if (string-match "%s" exe)
(format exe file-arg)
(format "%s %s" exe file-arg))))))
;; Just jump to the already running program instance or start
;; a new process.
(if (get-process proc-name)
(if helm-raise-command
(run-at-time 0.1 nil #'shell-command
(format helm-raise-command proc-name))
(error "Error: %s is already running" proc-name))
(if (and detached (not (memq system-type '(windows-nt ms-dos))))
(progn
(message "Starting and detaching `%s' from Emacs" proc-name)
(call-process-shell-command (format "(%s &)" exe)))
(when detached
(user-error "Detaching programs not supported on `%s'" system-type))
(setq proc (start-process-shell-command proc-name nil exe)))))
(when proc
(set-process-sentinel
proc
(lambda (process event)
(when (and (string= event "finished\n")
helm-raise-command
(not (helm-get-pid-from-process-name proc-name)))
(run-hooks 'helm-open-file-externally-after-finish-hook)
(shell-command (format helm-raise-command "emacs")))
(message "%s process...Finished." process))))
;; Move command on top list.
(setq helm-external-commands-list
(cons proc-name
(delete proc-name helm-external-commands-list))))))
(defun helm-get-mailcap-for-file (filename)
"Get the command to use for FILENAME from mailcap files."
(mailcap-parse-mailcaps)
(let* ((ext (file-name-extension filename))
(mime (when ext (mailcap-extension-to-mime ext)))
(result (when mime (mailcap-mime-info mime))))
;; If elisp file have no associations in .mailcap
;; `mailcap-maybe-eval' is returned, in this case just return nil.
(when (stringp result) (helm-basename result))))
(defun helm-get-default-program-for-file (filename)
"Try to find a default program to open FILENAME.
Try first in `helm-external-programs-associations' and then in
mailcap file. If nothing found return nil."
(let* ((ext (file-name-extension filename))
(def-prog (assoc-default ext helm-external-programs-associations)))
(cond ((and def-prog (not (string= def-prog ""))) def-prog)
((and helm-default-external-file-browser (file-directory-p filename))
helm-default-external-file-browser)
(t (helm-get-mailcap-for-file filename)))))
(defun helm-open-file-externally (_file)
"Open FILE with an external program.
Try to guess which program to use with
`helm-get-default-program-for-file'.
If not found or a prefix arg is given query the user which tool
to use."
(let* ((files (helm-marked-candidates :with-wildcard t))
(fname (expand-file-name (car files)))
(collection (helm-external-commands-list-1 'sort))
(def-prog (helm-get-default-program-for-file fname))
(program (if (or helm-current-prefix-arg (not def-prog))
;; Prefix arg or no default program.
(prog1
(helm-comp-read
"Program: " collection
:must-match t
:name "Open file Externally"
:history 'helm-external-command-history)
;; Always prompt to set this program as default.
(setq def-prog nil))
;; No prefix arg or default program exists.
def-prog)))
(unless (or def-prog ; Association exists, no need to record it.
;; Don't try to record non--filenames associations (e.g urls).
(not (file-exists-p fname)))
(when
(y-or-n-p
(format
"Do you want to make `%s' the default program for this kind of files? "
program))
(helm-aif (assoc (file-name-extension fname)
helm-external-programs-associations)
(setq helm-external-programs-associations
(delete it helm-external-programs-associations)))
(push (cons (file-name-extension fname)
(helm-read-string
"Program (Add args maybe and confirm): " program))
helm-external-programs-associations)
(customize-save-variable 'helm-external-programs-associations
helm-external-programs-associations)))
(helm-run-or-raise program files)
(run-hooks 'helm-open-file-externally-after-hook)
(setq helm-external-command-history
(cl-loop for i in helm-external-command-history
when (executable-find i) collect i))))
(defun helm-run-external-command-action (candidate &optional detached)
(helm-run-or-raise candidate nil detached)
(setq helm-external-command-history
(cons candidate
(delete candidate
helm-external-command-history))))
(defclass helm-external-commands (helm-source-in-buffer)
((filtered-candidate-transformer
:initform (lambda (candidates _source)
(cl-loop for c in candidates
if (get-process c)
collect (propertize c 'face 'font-lock-type-face)
else collect c)))
(must-match :initform t)
(nomark :initform t)
(action :initform
(helm-make-actions
"Run program" 'helm-run-external-command-action
(lambda ()
(unless (memq system-type '(windows-nt ms-dos))
"Run program detached"))
(lambda (candidate)
(helm-run-external-command-action candidate 'detached))))))
;;;###autoload
(defun helm-run-external-command ()
"Preconfigured `helm' to run External PROGRAM asyncronously from Emacs.
If program is already running try to run `helm-raise-command' if
defined otherwise exit with error. You can set your own list of
commands with `helm-external-commands-list'."
(interactive)
(helm :sources `(,(helm-make-source "External Commands history" 'helm-external-commands
:data helm-external-command-history)
,(helm-make-source "External Commands" 'helm-external-commands
:data (helm-external-commands-list-1 'sort)))
:buffer "*helm externals commands*"
:prompt "RunProgram: ")
;; Remove from history no more valid executables.
(setq helm-external-command-history
(cl-loop for i in helm-external-command-history
when (executable-find i) collect i)))
(provide 'helm-external)
;;; helm-external.el ends here
helm-4.0.3/helm-fd.el 0000664 0000000 0000000 00000013547 15011067617 0014317 0 ustar 00root root 0000000 0000000 ;;; helm-fd.el --- helm interface for fd command line tool. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'helm)
(require 'helm-types)
(declare-function ansi-color-apply "ansi-color.el")
(declare-function split-string-shell-command "shell.el")
(defvar helm-fd-executable "fd"
"The fd shell command executable.")
(defcustom helm-fd-switches '("--no-ignore" "--hidden" "--type" "f" "--type" "d" "--color" "always")
"A list of options to pass to fd shell command."
:type '(repeat string)
:group 'helm-files)
(defcustom helm-fd-mode-line-function 'helm-fd-default-mode-line
"Function called when `fd' process is finished to format mode-line."
:type 'function
:group 'helm-files)
(defface helm-fd-finish
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Green"))
"Face used in mode line when fd process ends."
:group 'helm-grep-faces)
(defvar helm-fd-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-generic-files-map)
(define-key map (kbd "C-]") 'undefined)
(define-key map (kbd "DEL") 'helm-delete-backward-no-update)
(define-key map (kbd "M-") 'helm-fd-next-directory)
(define-key map (kbd "M-") 'helm-fd-previous-directory)
map))
(defun helm-fd-next-directory-1 (arg)
(with-helm-window
(let ((cur-dir (helm-basedir (helm-get-selection))))
(while (equal cur-dir (helm-basedir (helm-get-selection)))
(if (> arg 0)
(helm-next-line)
(helm-previous-line))))))
(defun helm-fd-next-directory ()
"Move to next directory in a helm-fd source."
(interactive)
(with-helm-alive-p
(helm-fd-next-directory-1 1)))
(defun helm-fd-previous-directory ()
"Move to previous directory in a helm-fd source."
(interactive)
(with-helm-alive-p
(helm-fd-next-directory-1 -1)))
(defclass helm-fd-class (helm-source-async)
((candidates-process :initform 'helm-fd-process)
(requires-pattern :initform 2)
(candidate-number-limit :initform 20000)
(nohighlight :initform t)
(help-message :initform 'helm-fd-help-message)
(filtered-candidate-transformer :initform 'helm-fd-fct)
(action :initform 'helm-type-file-actions)
(keymap :initform 'helm-fd-map)))
(defun helm-fd-process ()
"Initialize fd process in an helm async source."
(let* (process-connection-type
(cmd (append helm-fd-switches
(or (and (fboundp #'split-string-shell-command)
(split-string-shell-command helm-pattern))
(split-string helm-pattern))))
(proc (apply #'start-process "fd" nil helm-fd-executable cmd))
(start-time (float-time))
(fd-version (replace-regexp-in-string
"\n" ""
(shell-command-to-string
(concat helm-fd-executable " --version")))))
(helm-log "helm-fd-process" "Fd command:\nfd %s"
(mapconcat 'identity cmd " "))
(helm-log "helm-fd-process" "VERSION: %s" fd-version)
(prog1
proc
(set-process-sentinel
proc (lambda (_process event)
(if (string= event "finished\n")
(with-helm-window
(when helm-fd-mode-line-function
(funcall helm-fd-mode-line-function start-time fd-version)
(force-mode-line-update)))
(helm-log "helm-fd-process sentinel" "Error: Fd %s"
(replace-regexp-in-string "\n" "" event))))))))
(defun helm-fd-default-mode-line (start-time fd-version)
"Format mode-line with START-TIME and FD-VERSION, as well as `fd' results."
(setq mode-line-format
`(" " mode-line-buffer-identification " "
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
(:eval (propertize
(format
"[%s process finished in %.2fs - (%s results)] "
,fd-version
,(- (float-time) start-time)
(helm-get-candidate-number))
'face 'helm-fd-finish)))))
(defun helm-fd-fct (candidates _source)
"The filtered-candidate-transformer function for helm-fd."
(cl-loop for i in candidates
for fname = (ansi-color-apply i)
if helm-ff-icon-mode collect
(let* ((abs (expand-file-name fname default-directory))
(icon (if (file-directory-p abs)
(helm-x-icons-generic "file-directory")
(helm-x-icons-icon-for-file (helm-basename fname)))))
(cons (concat icon fname) fname))
else collect fname))
(defun helm-fd-1 (directory)
"Run fd shell command on DIRECTORY with helm interface."
(cl-assert (executable-find helm-fd-executable) nil "Could not find fd executable")
(cl-assert (not (file-remote-p directory)) nil "Fd not supported on remote directories")
(let ((default-directory directory))
(helm :sources (helm-make-source "Fd" 'helm-fd-class
:header-name
(lambda (name)
(format "%s (%s)"
name (abbreviate-file-name default-directory))))
:buffer "*helm fd*")))
(provide 'helm-fd)
;;; helm-fd.el ends here
helm-4.0.3/helm-files.el 0000664 0000000 0000000 00001213673 15011067617 0015033 0 ustar 00root root 0000000 0000000 ;;; helm-files.el --- helm file browser and related. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-types)
(require 'helm-utils)
(require 'helm-grep)
(require 'helm-help)
(require 'helm-locate)
(require 'helm-tags)
(require 'helm-buffers)
(require 'tramp)
(eval-when-compile
(require 'thingatpt)
(require 'ffap)
(require 'dired-aux)
(require 'dired-x))
(require 'filenotify)
(require 'image-mode)
(require 'image-dired)
(require 'helm-x-icons)
(declare-function find-library-name "find-func.el" (library))
(declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag))
(declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
(declare-function eshell-read-aliases-list "em-alias")
(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
(declare-function eshell-kill-input "esh-mode")
(declare-function eshell-bol "esh-mode")
(declare-function eshell-reset "esh-mode.el")
(declare-function eshell/cd "em-dirs.el")
(declare-function eshell-next-prompt "em-prompt.el")
(declare-function eshell-resume-eval "esh-cmd")
(declare-function helm-ls-git "ext:helm-ls-git")
(declare-function helm-hg-find-files-in-project "ext:helm-ls-hg")
(declare-function helm-gid "helm-id-utils.el")
(declare-function helm-find-1 "helm-find")
(declare-function helm-fd-1 "helm-fd")
(declare-function helm-get-default-program-for-file "helm-external")
(declare-function helm-open-file-externally "helm-external")
(declare-function helm-comp-read "helm-mode")
(declare-function helm-read-file-name "helm-mode")
(declare-function term-line-mode "term")
(declare-function term-char-mode "term")
(declare-function term-send-input "term")
(declare-function term-next-prompt "term")
(declare-function term-process-mark "term")
(declare-function bookmark-prop-get "bookmark")
(declare-function helm-bookmark-build-source "helm-bookmark")
(declare-function comint-next-prompt "comint")
(declare-function comint-delete-input "comint")
(declare-function comint-send-input "comint")
(declare-function comint-goto-process-mark "comint")
(declare-function tramp-dissect-file-name "tramp")
(declare-function tramp-get-completion-function "tramp")
(declare-function seconds-to-time "time-date")
(declare-function ffap-fixup-url "ffap")
(declare-function ffap-url-at-point "ffap")
(declare-function ffap-file-at-point "ffap")
(declare-function dired-create-files "dired-aux")
(declare-function dired-goto-file "dired")
(declare-function dired-move-to-filename "dired")
(declare-function dired-move-to-end-of-filename "dired")
(declare-function dired-get-filename "dired")
(declare-function dired-get-marked-files "dired")
(declare-function tramp-list-connections "tramp-cache")
(declare-function tramp-get-connection-process "tramp")
(declare-function tramp-buffer-name "tramp")
(declare-function tramp-make-tramp-file-name "tramp")
(declare-function tramp-cleanup-connection "tramp-cmds")
(declare-function dired-async-processes "ext:dired-async.el")
(declare-function dired-async-mode-line-message "ext:dired-async.el")
(declare-function dired-async--modeline-mode "ext:dired-async.el")
(declare-function helm-adaptive-sort "ext:helm-adaptive.el")
(declare-function wfnames-setup-buffer "ext:wfnames.el")
(declare-function svg-lib-progress-bar "ext:svg-lib")
(declare-function svg-lib-tag "ext:svg-lib")
(declare-function helm-epa-success-message "helm-epa")
(declare-function helm-epa-collect-id-from-candidates "helm-epa")
(declare-function helm-epa-collect-keys-from-candidates "helm-epa")
(declare-function async-byte-compile-file "async-bytecomp.el")
(declare-function async-byte-recompile-directory "async-bytecomp.el")
(declare-function dnd-begin-drag-files "dnd.el")
(defvar term-char-mode-point-at-process-mark)
(defvar term-char-mode-buffer-read-only)
(defvar recentf-list)
(defvar helm-mm-matching-method)
(defvar dired-async-mode)
(defvar org-directory)
(defvar eshell-current-command)
(defvar eshell-debug-command)
(defvar eshell-current-command)
(defvar tramp-archive-enabled)
(defvar tramp-tolerate-tilde)
(defvar password-cache)
(defvar helm-fd-executable)
(defvar wfnames-buffer)
(defvar Info-current-file)
(defvar generated-autoload-file)
;;; Internal vars
;;
(defvar helm-ff-last-expanded-candidate-regexp "^[[:multibyte:] \t]*%s"
"Regexp that retrieve previous candidate when going up one level.
The default value matching a multibyte char at bol allows
prefixing candidate with an icon. The format part will be
replaced by the display part of the candidate regexp quoted.
This should be used for all preselection code for helm-find-files
to handle icons.")
(defvar helm-find-files-doc-header " (\\\\[helm-find-files-up-one-level]: Go up one level)"
"*The doc that is inserted in the Name header of a find-files or dired source.")
(defvar helm-ff-auto-update-flag nil
"Internal, flag to turn on/off auto-update in `helm-find-files'.
Don't set it directly, use instead `helm-ff-auto-update-initial-value'.")
(defvar helm-ff-last-expanded nil
"Store last expanded directory or file.")
(defvar helm-ff-default-directory nil)
(defvar helm-ff-history nil)
(defvar helm-ff-url-regexp
"\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*"
"Same as `ffap-url-regexp' but match earlier possible url.")
;; helm-tramp-file-name-regexp is based on old version of
;; tramp-file-name-regexp i.e. "\\`/\\([^[/:]+\\|[^/]+]\\):" but it
;; seems it is wrong and a simpler regexp is enough, let's try it and
;; watch out!
(defvar helm-tramp-file-name-regexp "\\`/\\([^/:|]+\\):")
(defvar helm-ff-tramp-method-regexp "[/|]:\\([^:]*\\)")
(defvar helm-ff--auto-update-state nil)
(defvar helm-ff--deleting-char-backward nil)
(defvar helm-multi-files--toggle-locate nil)
(defvar helm-ff--move-to-first-real-candidate t)
(defvar helm-find-files--toggle-bookmark nil)
(defvar helm-ff--tramp-methods nil)
(defvar helm-ff--directory-files-length (make-hash-table :test 'equal)
"Used to count number of candidates in directory.
candidate-number-limit is set to this value if this value is bigger
than `helm-candidate-number-limit'.")
(defvar helm-ff--list-directory-cache (make-hash-table :test 'equal)
"Cache for `helm-find-files' candidates.")
(defvar helm-ff--file-notify-watchers (make-hash-table :test 'equal)
"File-notify watchers for `helm-find-files' are stored here.")
(defvar helm-ff-history-buffer-name "*helm-find-files history*")
(defvar helm-rsync-command-history nil)
(defvar helm-rsync--last-progress-bar-alist nil
"Used to store last valid rsync progress bar.")
(defvar helm-rsync-process-buffer "*helm-rsync*")
(defvar helm-rsync-progress-str-alist nil)
(defvar helm-ff--trash-directory-regexp "\\.?Trash[/0-9]+files/?\\'")
(defvar helm-ff--show-directories-only nil)
(defvar helm-ff--show-files-only nil)
(defvar helm-ff--trashed-files nil
"[INTERNAL] Files already trashed are stored here during file deletion.
This is used only as a let binding.")
(defvar helm-ff--show-thumbnails nil)
(defvar helm-ff--thumbnailed-directories nil)
(defvar helm-source-find-files nil
"The main source to browse files.
Should not be used among other sources.")
(defvar helm-ff-icon-mode nil)
;;; Helm-find-files - The helm file browser.
;;
;; Keymaps
(defvar helm-find-files-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "RET") 'helm-ff-RET)
(define-key map (kbd "C-]") 'helm-ff-run-toggle-basename)
(define-key map (kbd "C-x C-f") 'helm-ff-run-locate)
(define-key map (kbd "C-x C-d") 'helm-ff-run-browse-project)
(define-key map (kbd "C-x r m") 'helm-ff-bookmark-set)
(define-key map (kbd "C-x r b") 'helm-find-files-switch-to-bookmark)
(define-key map (kbd "C-x C-q") 'helm-ff-run-edit-marked-files)
(define-key map (kbd "C-s") 'helm-ff-run-grep)
(define-key map (kbd "M-g s") 'helm-ff-run-grep)
(define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep)
(define-key map (kbd "M-g z") 'helm-ff-run-zgrep)
(define-key map (kbd "M-g a") 'helm-ff-run-grep-ag)
(define-key map (kbd "M-g g") 'helm-ff-run-git-grep)
(define-key map (kbd "M-g i") 'helm-ff-run-gid)
(define-key map (kbd "M-.") 'helm-ff-run-etags)
(define-key map (kbd "M-R") 'helm-ff-run-rename-file)
(define-key map (kbd "M-C") 'helm-ff-run-copy-file)
(define-key map (kbd "M-k") 'helm-ff-run-kill-default-directory)
(when (executable-find "rsync")
(define-key map (kbd "M-V") 'helm-ff-run-rsync-file))
(define-key map (kbd "C-M-SPC") 'helm-ff-mark-similar-files)
(define-key map (kbd "C-M-@") 'helm-ff-mark-similar-files)
(define-key map (kbd "C-c C-SPC") 'helm-ff-mark-similar-files)
(define-key map (kbd "C-M-c") 'helm-ff-run-mcp)
(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)
(define-key map (kbd "M-T") 'helm-ff-run-touch-files)
(define-key map (kbd "M-M") 'helm-ff-run-chmod)
(define-key map (kbd "C-c z") 'helm-ff-persistent-compress)
(define-key map (kbd "M-Z") 'helm-ff-run-compress-marked-files)
(define-key map (kbd "M-c") 'helm-ff-run-compress-to)
(define-key map (kbd "C-c d") 'helm-ff-persistent-delete)
(define-key map (kbd "M-e") 'helm-ff-run-switch-to-shell)
(define-key map (kbd "C-c i") 'helm-ff-run-complete-fn-at-point)
(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 "C-c t") 'helm-ff-toggle-thumbnails)
(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)
(define-key map (kbd "M-%") 'helm-ff-run-query-replace)
(define-key map (kbd "C-M-%") 'helm-ff-run-query-replace-regexp)
(define-key map (kbd "C-c =") 'helm-ff-run-ediff-file)
(define-key map (kbd "M-=") 'helm-ff-run-ediff-merge-file)
(define-key map (kbd "M-p") 'helm-find-files-history)
(define-key map (kbd "C-c h") 'helm-ff-file-name-history)
(define-key map (kbd "M-i") 'helm-ff-properties-persistent)
(define-key map (kbd "C-}") 'helm-narrow-window)
(define-key map (kbd "C-{") 'helm-enlarge-window)
(define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update)
(define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update)
(define-key map (kbd "C-c C-a") 'helm-ff-run-mail-attach-files)
(define-key map (kbd "C-c p") 'helm-ff-run-print-file)
(define-key map (kbd "C-c /") 'helm-ff-run-find-sh-command)
(define-key map (kbd "C-/") 'helm-ff-run-fd)
;; Next 2 have no effect if candidate is not an image file.
(define-key map (kbd "M-l") 'helm-ff-rotate-left-persistent)
(define-key map (kbd "M-r") 'helm-ff-rotate-right-persistent)
(define-key map (kbd "M-+") 'helm-ff-increase-image-size-persistent)
(define-key map (kbd "M--") 'helm-ff-decrease-image-size-persistent)
(define-key map (kbd "C-l") 'helm-find-files-up-one-level)
(define-key map (kbd "C-:") 'helm-ff-complete-tramp-methods)
(define-key map (kbd "C-_") 'helm-ff-undo)
(define-key map (kbd "C-r") 'helm-find-files-down-last-level)
(define-key map (kbd "C-c r") 'helm-ff-run-find-file-as-root)
(define-key map (kbd "C-x C-v") 'helm-ff-run-find-alternate-file)
(define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link)
(define-key map (kbd "S-") 'helm-ff-sort-alpha)
(define-key map (kbd "S-") 'helm-ff-sort-by-newest)
(define-key map (kbd "S-") 'helm-ff-sort-by-size)
(define-key map (kbd "S-") 'helm-ff-toggle-dirs-only)
(define-key map (kbd "S-") 'helm-ff-toggle-files-only)
(define-key map (kbd "S-") 'helm-ff-sort-by-ext)
(helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward
'((C-backspace . helm-ff-run-toggle-auto-update)
([C-c DEL] . helm-ff-run-toggle-auto-update))
nil 'helm-ff-delete-char-backward--exit-fn)
(when (fboundp 'tab-bar-mode)
(define-key map (kbd "C-c C-t") 'helm-ff-run-find-file-other-tab))
map)
"Keymap for `helm-find-files'.")
(defvar helm-read-file-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "") 'helm-cr-empty-string)
(define-key map (kbd "M-RET") 'helm-cr-empty-string)
(define-key map (kbd "C-]") 'helm-ff-run-toggle-basename)
(define-key map (kbd "C-.") 'helm-find-files-up-one-level)
(define-key map (kbd "C-l") 'helm-find-files-up-one-level)
(define-key map (kbd "C-:") 'helm-ff-complete-tramp-methods)
(define-key map (kbd "C-_") 'helm-ff-undo)
(define-key map (kbd "C-r") 'helm-find-files-down-last-level)
(define-key map (kbd "C-c h") 'helm-ff-file-name-history)
(define-key map (kbd "C-x r b") 'helm-ff-bookmark-insert-location)
(define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update)
(define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update)
(define-key map (kbd "C-c t") 'helm-ff-toggle-thumbnails)
(define-key map (kbd "S-") 'helm-ff-sort-alpha)
(define-key map (kbd "S-") 'helm-ff-sort-by-newest)
(define-key map (kbd "S-") 'helm-ff-sort-by-size)
(define-key map (kbd "S-") 'helm-ff-sort-by-ext)
(define-key map (kbd "RET") 'helm-ff-RET)
(helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward
'((C-backspace . helm-ff-run-toggle-auto-update)
([C-c DEL] . helm-ff-run-toggle-auto-update))
nil 'helm-ff-delete-char-backward--exit-fn)
map)
"Keymap for `helm-read-file-name'.")
;;; User variables
;;
(defgroup helm-files nil
"Files applications and libraries for Helm."
:group 'helm)
(defcustom helm-tramp-verbose 0
"Just like `tramp-verbose' but specific to Helm.
When set to 0 don't show tramp messages in Helm.
If you want to have the default tramp messages set it to 3."
:type 'integer)
(defcustom helm-ff-auto-update-initial-value nil
"Auto update when only one candidate directory is matched.
Default value when starting `helm-find-files' is nil to not
confuse new users.
For a better experience with `helm-find-files' set this to
non-nil and use C- to toggle it."
:type 'boolean)
(defcustom helm-ff-history-max-length 100
"Number of elements shown in `helm-find-files' history."
:type 'integer)
(defcustom helm-ff-fuzzy-matching t
"Enable fuzzy matching for `helm-find-files' when non--nil.
See `helm-ff--transform-pattern-for-completion' for more info."
:type 'boolean)
(defcustom helm-ff-exif-data-program "exiftran"
"Program used to extract exif data of an image file."
:type 'string)
(defcustom helm-ff-exif-data-program-args "-d"
"Arguments used for `helm-ff-exif-data-program'."
:type 'string)
(defcustom helm-ff-newfile-prompt-p t
"Whether Prompt or not when creating new file.
This set `ffap-newfile-prompt'."
:type 'boolean)
(defcustom helm-ff-avfs-directory "~/.avfs"
"The default avfs directory, usually \\='~/.avfs'.
When this is set you will be able to expand archive filenames
with `C-j' inside an avfs directory mounted with mountavfs.
See ."
:type 'string)
(defcustom helm-ff-file-compressed-list '("gz" "bz2" "zip" "7z" "xz")
"Minimal list of compressed files extension."
:type '(repeat (choice string)))
(defcustom helm-ff-printer-list nil
"A list of available printers on your system.
When non-nil let you choose a printer to print file.
Otherwise when nil the variable `printer-name' will be used.
On Unix based systems (lpstat command needed) you don't need to
set this, `helm-ff-find-printers' will find a list of available
printers for you."
:type '(repeat (choice string)))
(defcustom helm-ff-transformer-show-only-basename t
"Show only basename of candidates in `helm-find-files'.
This can be toggled at anytime from `helm-find-files' with \
\\\\[helm-ff-run-toggle-basename]. Note
that even when non nil, the dotted directories on top i.e. \".\"
and \"..\" are still displayed as full path when
`helm-ff-show-dot-file-path' is non nil."
:type 'boolean)
(defcustom helm-ff-show-dot-file-path nil
"Show full path of dotted directories when non nil."
:type 'boolean
:set (lambda (var val)
(set-default var val)
(clrhash helm-ff--list-directory-cache)))
(defcustom helm-ff-signal-error-on-dot-files t
"Signal error when file is `.' or `..' on file deletion when non-nil.
Default is non-nil.
WARNING: Setting this to nil is unsafe and can cause deletion of
a whole tree."
:type 'boolean)
(defcustom helm-ff-search-library-in-sexp nil
"Search for library in `require' and `declare-function' sexp."
:type 'boolean)
(defcustom helm-tooltip-hide-delay 25
"Hide tooltips automatically after this many seconds."
:type 'integer)
(defcustom helm-ff-file-name-history-use-recentf nil
"Use `recentf-list' instead of `file-name-history' in `helm-find-files'."
:type 'boolean)
(defcustom helm-ff-skip-boring-files nil
"Non-nil to skip boring files.
I.e. the files matching regexps in `helm-boring-file-regexp-list'.
This takes effect in `helm-find-files' and file completion used by
`helm-mode' i.e. `helm-read-file-name'.
Note that when non-nil this will slow down slightly `helm-find-files'."
:type 'boolean)
(defcustom helm-ff-skip-git-ignored-files nil
"Non-nil to skip git ignored files.
This take effect only in `helm-find-files'.
Check is not done on remote files.
Note that when non-nil this will slow down slightly
`helm-find-files'."
:type 'boolean)
(defcustom helm-ff-candidate-number-limit 5000
"The `helm-candidate-number-limit' for `helm-find-files' and friends.
Note that when going one level up with
`\\\\[helm-find-files-up-one-level]' the
length of directory will be used instead if it is higher than
this value. This is to avoid failing to preselect the previous
directory/file if this one is situated lower than
`helm-ff-candidate-number-limit' num candidate."
:type 'integer)
(defcustom helm-ff-preselect-ignore-large-dirs nil
"Preselect directory belonging to current-buffer even if large."
:type 'boolean)
(defcustom helm-ff-up-one-level-preselect t
"Always preselect previous directory when going one level up.
When non-nil `candidate-number-limit' source value is modified
dynamically when going one level up if the position of previous
candidate in its directory is > to
`helm-ff-candidate-number-limit'.
It can be helpful to disable this and reduce
`helm-ff-candidate-number-limit' if you often navigate across
very large directories."
:type 'boolean)
(defcustom helm-files-save-history-extra-sources
'("Find" "Fd" "Locate" "Recentf"
"Files from Current Directory" "File Cache" "Etags")
"Extras source that save candidate to `file-name-history'."
:type '(repeat (choice string)))
(defcustom helm-find-files-before-init-hook nil
"Hook that run before initialization of `helm-find-files'."
:type 'hook)
(defcustom helm-find-files-after-init-hook nil
"Hook that run after initialization of `helm-find-files'."
:type 'hook)
(defcustom helm-find-files-bookmark-prefix nil
"bookmark name prefix of `helm-find-files' sessions."
:type 'string)
(defcustom helm-ff-guess-ffap-filenames nil
"Use ffap to guess local filenames at point in `helm-find-files'.
This doesn't disable url or mail at point, see
`helm-ff-guess-ffap-urls' for this."
:type 'boolean)
(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 also `ffap-url-unwrap-remote' that may override this
variable."
:type 'boolean)
(defcustom helm-ff-no-preselect nil
"When non-nil `helm-find-files' starts at root of current directory."
:type 'boolean)
(defcustom helm-ff-allow-non-existing-file-at-point nil
"Use non existing file-at-point as initial input in `helm-find-files'."
:type 'boolean)
(defcustom helm-find-files-ignore-thing-at-point nil
"Use only `default-directory' as default input in `helm-find-files'.
I.e. text under cursor in `current-buffer' is ignored.
Note that when non-nil you will be unable to complete filename at
point in `current-buffer'."
:type 'boolean)
(defcustom helm-substitute-in-filename-stay-on-remote nil
"Don't switch back to local filesystem when expanding pattern with / or ~/."
:type 'boolean)
(defcustom helm-ff-goto-first-real-dired-exceptions '(dired-goto-file)
"Dired commands that are allowed moving to first real candidate."
:type '(repeat (choice symbol)))
(defcustom helm-mounted-network-directories nil
"A list of directories used for mounting remotes filesystem.
When nil `helm-file-on-mounted-network-p' always return nil
otherwise check if a file is in one of these directories.
Remote filesystem are generally mounted with sshfs."
:type '(repeat string))
(defcustom helm-browse-project-default-find-files-fn
(cond ((or (executable-find "fd")
(executable-find "fdfind"))
#'helm-browse-project-fd-find-files)
((executable-find "rg")
#'helm-browse-project-rg-find-files)
((executable-find "ag")
#'helm-browse-project-ag-find-files)
(t #'helm-browse-project-walk-directory))
"The default function to retrieve files in a non-vc directory.
A function that takes a directory name as only arg."
:type 'function)
(defcustom helm-ff-kill-or-find-buffer-fname-fn
#'helm-ff-kill-or-find-buffer-fname
"Default function used to expand non-directory filenames in `helm-find-files'.
This variable will take effect only in `helm-find-files'. It
affects the behavior of persistent-action on filenames and
non-existing filenames.
The default is to expand filename on first hit on
\\\\[helm-execute-persistent-action], pop buffer in
other window on second hit and finally kill this buffer on third
hit. This is very handy to create several new buffers, or when
navigating, show quickly the buffer of file to see its contents
briefly before killing it and continue navigating.
However some users may not want this, so to disable this behaviour
just set this to `ignore' function.
Of course you can also write your own function to do something
else."
:type 'function)
(defcustom helm-modes-using-escaped-strings
'(eshell-mode shell-mode term-mode)
"Modes that requires string's insertion to be escaped."
:type '(repeat symbol))
(defcustom helm-ff-allow-recursive-deletes nil
"When \\='always don't prompt for recursive deletion of directories.
When nil, will ask for recursive deletion.
Note that when deleting multiple directories you can answer !
when prompted to avoid being asked for next directories, so it
is probably 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-ff-run-delete-file]' from
`helm-find-files'."
:type '(choice (function :tag "Delete files synchronously."
helm-delete-marked-files)
(function :tag "Delete files asynchronously."
helm-delete-marked-files-async)))
(defcustom helm-trash-remote-files nil
"Allow trashing remote files when non-nil.
Trashing remote files with tramp doesn't work out of the box
unless the \\='trash-cli' package is installed. This is why trashing
remote files from Helm is disabled by default.
Tramp is using external \\='trash' command in its `delete-file' and
`delete-directory' handlers when using
`delete-by-moving-to-trash', which is documented nowhere in
Emacs.
If you want to enable this you will have to install the \\='trash'
command on remote (and/or locally if you want to trash as root).
On Ubuntu-based distributions it is \\='trash-cli'."
:type 'boolean)
(defvaralias 'helm-list-directory-function 'helm-list-remote-directory-fn)
(make-obsolete-variable 'helm-list-directory-function 'helm-list-remote-directory-fn "4.0")
(defcustom helm-list-remote-directory-fn
(cl-case system-type
(gnu/linux #'helm-list-dir-external)
(berkeley-unix #'helm-list-dir-lisp)
(windows-nt #'helm-list-dir-lisp)
(t #'helm-list-dir-lisp))
"The function used in `helm-find-files' to list remote directories.
Currently Helm provides two functions to do this:
`helm-list-dir-lisp' and `helm-list-dir-external'.
Using `helm-list-dir-external' will provide a similar display to
what is provided with local files i.e. colorized symlinks,
executables files etc., whereas using `helm-list-dir-lisp' will
allow colorizing only directories but it is more portable.
NOTE: `helm-list-dir-external' needs ls and awk as dependencies.
Also the ls version installed on the remote side should support
the same arguments as the GNU/ls version, which are -A -1 -F -b
and -Q. So even if you are using a GNU/ls version locally and you
want to connect e.g. on a Freebsd server, you may have failures
due to the incompatible ls version installed on remote server. In
such case use `helm-list-dir-lisp' which works everywhere but is
slower and less featured (only directories colorized)."
:type 'function)
(defcustom helm-ff-initial-sort-method nil
"Sort method to use when initially listing a directory.
It is better to keep this nil globally and turn it on only when needed
otherwise it may be slightly slower specially with `ext' method which
BTW is not provided on remote files (helm will fallback on nil in such
case).
Note that this have no effect as soon as you start narrowing directory
i.e. filtering filenames inside directory."
:type '(choice
(const :tag "alphabetically" nil)
(const :tag "newest" newest)
(const :tag "size" size)
(const :tag "extensions" ext)))
(defcustom helm-ff-rotate-image-program "exiftran"
"External program used to rotate images.
When nil and `helm-ff-display-image-native' is enabled, fallback to
`image-rotate' without modification of exif data i.e. rotation is not
persistent otherwise an error is returned when not using
`helm-ff-display-image-native' i.e. using image-dired."
:type '(choice
(const :tag "Mogrify" "mogrify")
(const :tag "Exiftran" "exiftran")
(const :tag "Jpegtran" "jpegtran")))
(defcustom helm-ff-rotate-image-switch '("-i")
"Options used with `helm-ff-rotate-image-program'.
If you are using Mogrify or Jpegtran mandatory option is
\"-rotate\", with Exiftran mandatory option is \"-i\"."
:type '(repeat string))
(defcustom helm-ff-preferred-shell-mode 'eshell-mode
"Shell to use to switch to a shell buffer from `helm-find-files'.
Possible values are `shell-mode', `eshell-mode' and `term-mode'.
This affects `\\\\[helm-ff-run-switch-to-shell]' keybinding."
:type '(choice
(const :tag "Use Eshell" eshell-mode)
(const :tag "Use Shell" shell-mode)
(const :tag "Use Term" term-mode)))
(defcustom helm-rsync-no-mode-line-update nil
"When non nil don't update mode-line when rsync is running.
This is useful if you display the progress bar somewhere else,
e.g. with minibuffer-line in minibuffer, in this case updating
mode-line may create flickering in other frame's mode-line."
:type 'boolean)
(defcustom helm-rsync-switches '("-a" "-z" "-h" "-s" "--info=all2")
"Rsync options to use with HFF Rsync action.
Note: Using \"--info=all2\" allows having the name of the file
currently transfered in an help-echo in mode-line, if you use
\"--info=progress2\" you will not have this information."
:type '(repeat string))
(defcustom helm-rsync-percent-sign "%"
"Percentage unicode sign to use in Rsync reporter."
:type 'string)
(defcustom helm-ff-rsync-progress-bar-style (if (display-graphic-p) 'bar 'text)
"Style of progress-bar for rsync action.
Value can be either bar or text.
Progress bar is inaccurate on non graphic displays, use text instead."
:type '(choice
(const :tag "Progress bar as a bar" bar)
(const :tag "Progress bar with text" text)))
(defcustom helm-ff-rsync-progress-bar-info '(percent)
"Infos shown at end of Rsync progress bar.
Valid value is a list containing one or more elements from
percent, size, speed and remain. When set to nil show nothing at end of
progress bar.
This Has no effect when `helm-ff-rsync-progress-bar-style' is text."
:type '(set :tag "Check zero or more items to show at end of Rsync progress bar"
(const :tag "Show the amount of data copied" size)
(const :tag "Show the percentage of data copied" percent)
(const :tag "Show the current speed of transfer" speed)
(const :tag "Show the time remaining" remain)))
(defcustom helm-rsync-progress-bar-function #'helm-rsync-default-progress-bar
"Function used to draw a rsync progress bar in mode-line.
Function is called with three args: PROCESS, PERCENT, INFO.
PROCESS is the rsync process in use, it's name is displayed before the progress
bar, it is useful to display it to distinguish the different processes running
e.g. rsync1 rsync2 etc...
PERCENT is the current percentage of data sent to the progress bar.
INFO is what is displayed after the progress bar according to
`helm-ff-rsync-progress-bar-info'.
Currently Helm provides two functions to draw the progress bar:
- The default progress bar which use the whole height of mode-line and print
colored spaces to mimic a progress bar.
- The SVG based progress bar which use the external library svg-lib (you will
have to install it to use this function) and needs emacs to be compiled with svg
support."
:type '(choice
(function :tag "Default progress bar"
helm-rsync-default-progress-bar)
(function :tag "SVG progress bar"
helm-rsync-svg-progress-bar)))
(defcustom helm-trash-default-directory nil
"The default trash directory.
You probably don't need to set this when using a Linux system using
standard settings.
Should be the directory file name i.e. don't add final slash.
When nil helm will compute a default value according to freedesktop
specs.
It is generally \"~/.local/share/Trash\"."
:type 'string)
(defcustom helm-ff-lynx-style-map t
"Use arrow keys to navigate with `helm-find-files'.
Note that if you define this variable with `setq' your change
will have no effect, use customize instead."
:type 'boolean
:set (lambda (var val)
(set var val)
(if val
(progn
(define-key helm-find-files-map (kbd "") 'helm-execute-persistent-action)
(define-key helm-find-files-map (kbd "") 'helm-find-files-up-one-level)
(define-key helm-read-file-map (kbd "") 'helm-execute-persistent-action)
(define-key helm-read-file-map (kbd "") 'helm-find-files-up-one-level))
(define-key helm-find-files-map (kbd "") nil)
(define-key helm-find-files-map (kbd "") nil)
(define-key helm-read-file-map (kbd "") nil)
(define-key helm-read-file-map (kbd "") nil))))
(defcustom helm-ff-DEL-up-one-level-maybe nil
"Use DEL to maybe go up one level when non nil.
Going up one level works only when pattern is a directory endings
with \"/\", otherwise this command deletes char backward.
When nil always delete char backward."
:type 'boolean)
(defcustom helm-ff-display-image-native t
"Use native `image-mode' when non nil.
You should use this only with Emacs>= 27 and `image-auto-resize'
enabled to have images resized properly. When this is enabled,
you have new commands to zoom in/out images. See
`image-transform-resize' and `image-auto-resize'. Otherwise,
when nil `image-dired' is used, using imagemagick as backend.
NOTE: On Emacs-29 `image-dired' is no more using external program
image-magick to display image, so this is used inconditionally even
when value is nil."
:type 'boolean)
(defcustom helm-ff-reset-filters-on-update t
"Reset filter variables when changing directory.
When filtering directories/files only, switch back to a \"show all\" view
when moving out of directory when non nil."
:type 'boolean)
(defcustom helm-ff-eshell-unwanted-aliases nil
"A list of eshell aliases to not display."
:type '(repeat string))
(defcustom helm-eshell-on-file-reverse-history t
"History source in *eshell-command-on-file appears on top when non nil."
:type 'boolean)
(defcustom helm-ff-edit-marked-files-fn #'helm-ff-wfnames
"A function to edit filenames in a special buffer.
By default `wfnames' package is used to avoid wdired which
doesn't always work with all emacs versions and also is quite
clumsy about default-directory among other things. If you still
want to use it, helm is still providing
`helm-marked-files-in-dired'."
:type '(choice (function :tag "Use Wfnames package to edit filenames."
helm-ff-wfnames)
(function :tag "Use Wdired package to edit filenames."
helm-marked-files-in-dired)))
(defcustom helm-find-files-actions
(helm-make-actions
"Find File" 'helm-find-file-or-marked
"Find file in Dired" 'helm-point-file-in-dired
"View file" 'view-file
"Query replace fnames on marked `M-@'" 'helm-ff-query-replace-fnames-on-marked
(lambda ()
(helm-acase helm-ff-edit-marked-files-fn
(helm-marked-files-in-dired "Edit filenames in Wdired `C-x C-q'")
(helm-ff-wfnames "Edit filenames in Wfnames `C-x C-q'")))
'helm-ff-edit-marked-files
"Query replace contents on marked `M-%'" 'helm-ff-query-replace
"Query replace regexp contents on marked `C-M-%'" 'helm-ff-query-replace-regexp
"Attach file(s) to mail buffer `C-c C-a'" 'helm-ff-mail-attach-files
"Serial rename files" 'helm-ff-serial-rename
"Serial rename by symlinking files" 'helm-ff-serial-rename-by-symlink
"Serial rename by copying files" 'helm-ff-serial-rename-by-copying
"Open file with default tool" 'helm-open-file-with-default-tool
"Find file in hex dump" 'hexl-find-file
"Browse project `C-x C-d'" 'helm-ff-browse-project
"Complete at point `C-c i'" 'helm-insert-file-name-completion-at-point
"Insert as org link `C-c @'" 'helm-files-insert-as-org-link
"Find shell command `C-c /'" 'helm-ff-find-sh-command
"Fd shell command (C-/)" 'helm-ff-fd
"Find files in file" 'helm-find-files-in-file
"Add marked files to file-cache" 'helm-ff-cache-add-file
"Open file externally `C-c C-x, C-u to choose'" 'helm-open-file-externally
"Grep File(s) `C-s, C-u Recurse'" 'helm-find-files-grep
"Grep current directory with AG `M-g a, C-u select type'" 'helm-find-files-ag
"Git grep `M-g g, C-u from root'" 'helm-ff-git-grep
"Zgrep File(s) `M-g z, C-u Recurse'" 'helm-ff-zgrep
"Pdf Grep File(s)" 'helm-ff-pdfgrep
"Gid `M-g i'" 'helm-ff-gid
"Switch to Eshell `M-e'" 'helm-ff-switch-to-shell
"Etags `M-., C-u reload tag file'" 'helm-ff-etags-select
"Eshell command on file(s) `M-!, C-u take all marked as arguments.'"
'helm-find-files-eshell-command-on-file
"Find file as root `C-c r'" 'helm-find-file-as-root
"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
(lambda () (format "Delete File(s)%s `M-D' (C-u reverse trash)"
(if (eq helm-ff-delete-files-function
'helm-delete-marked-files-async)
" async" "")))
'helm-ff-delete-files
"Touch File(s) `M-T'" 'helm-ff-touch-files
"Encrypt file(s)" 'helm-ff-encrypt-files
"Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy
(lambda ()
(and (executable-find "rsync")
"Rsync file(s) `M-V' (C-u edit command)"))
'helm-find-files-rsync
"Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename
"Backup files" 'helm-find-files-backup
"Copy file to dir(s) `C-M-c'" 'helm-ff-mcp
"Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink
"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
"Compress file(s) to archive `M-c'" 'helm-find-files-compress-to
"Compress or uncompress file(s) `M-Z'" 'helm-ff-compress-marked-files
"Change mode on file(s) `M-M'" 'helm-ff-chmod
"Find file other window `C-c o'" 'helm-find-files-other-window
"Find file other frame `C-c C-o'" 'find-file-other-frame
(lambda () (and (fboundp 'tab-bar-mode)
"Find file other tab `C-c C-t'"))
'helm-ff-find-file-other-tab
"Print File `C-c p, C-u to refresh'" 'helm-ff-print
"Locate `C-x C-f, C-u to specify locate db'" 'helm-ff-locate)
"Actions for `helm-find-files'."
:type '(alist :key-type string :value-type function))
(defcustom helm-dwim-target nil
"Default target directory for file actions.
Define the directory where you want to start navigating for the
target directory when copying, renaming, etc.. You can use the
`default-directory' of `next-window', the visited directory, the
current `default-directory' or have completion on all the
directories belonging to each visible windows."
:type '(radio :tag "Define default target directory for file actions."
(const :tag "Directory belonging to next window"
next-window)
(const :tag "Completion on directories belonging to each window"
completion)
(const :tag "Use initial directory or `default-directory'"
default-directory)
(const :tag "Use visited directory"
nil)))
(defcustom helm-ff-use-notify t
"Watch directories visited with `helm-find-files' when non nil.
If your system have no file notification package available turn this
to nil to avoid error messages when using `helm-find-files'."
:type 'boolean
:set (lambda (var val)
(set-default var val)
(unless (symbol-value var)
(cl-loop for dir being the hash-keys of helm-ff--file-notify-watchers
do (remhash dir helm-ff--list-directory-cache)))))
(defcustom helm-ff-inotify-unsupported-methods '("adb")
"Tramp methods unsupported by file-notify."
:type '(repeat string))
(defcustom helm-ff-image-cache-max-len 5
"The last seen image number to keep in cache."
:type 'integer)
(defcustom helm-ff-image-cache-max-len 5
"The last seen image number to keep in cache."
:type 'integer)
(defcustom helm-ff-slideshow-default-delay 3
"Delay in seconds between each image in slideshow."
:type 'integer)
(defcustom helm-file-name-history-hide-deleted nil
"Hide deleted files in file-name-history when non nil.
This can be toggled at any time from `helm-ff-file-name-history' with \
\\\\[helm-file-name-history-show-or-hide-deleted]."
:type 'boolean)
(defcustom helm-file-name-history-max-length 72
"Max length of candidates in helm file name history before truncating."
:type 'integer)
(defcustom helm-ff-follow-blacklist-file-exts '("gpg" "doc" "docx" "mp3" "ogg")
"File extensions we don't want to follow when helm-follow-mode is enabled.
Note that image files are always followed even if their extensions is
present in this list."
:type '(repeat string))
(defcustom helm-ff-nohighlight-matches nil
"Highlight matches in `helm-find-files' when nil."
:type 'boolean
:initialize 'custom-initialize-changed
:set (lambda (var val)
(set var val)
;; Force rebuilding the source to remove the highlight match FCT.
(setq helm-source-find-files nil)))
(defcustom helm-ff-ignore-following-on-directory nil
"In follow mode ignore silently directories when non nil."
:type 'boolean)
(defcustom helm-ff-dim-prompt-on-update t
"When non nil dim prompt while updating."
:type 'boolean)
(defcustom helm-ff-drag-mouse-1-default-action 'copy
"Default action when dragging files.
Possible values are `copy', `move' or `link'.
Currently supported value is `copy' when dropping to a dired buffer, `move' is
working only when dropping on an external application (only thunar tested)."
:type '(choice
(const :tag "Copy" copy)
(const :tag "Move" move)
(const :tag "Link" link)))
;;; Faces
;;
;;
(defgroup helm-files-faces nil
"Customize the appearance of helm-files."
:prefix "helm-"
:group 'helm-files
:group 'helm-faces)
(defface helm-ff-prefix
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:background "yellow" :foreground "black"))
"Face used to prefix new file or url paths in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-executable
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "green"))
"Face used for executable files in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-suid
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:background "red" :foreground "white"))
"Face used for suid files in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-directory
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "DarkRed" :background "LightGray"))
"Face used for directories in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-dotted-directory
`((((class color) (min-colors 88) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "black" :background "DimGray")
(((class color) (min-colors 88) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "black" :background "LightGray")
(t :inherit default))
"Face used for dotted directories in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-dotted-symlink-directory
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "DarkOrange" :background "DimGray"))
"Face used for dotted symlinked directories in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-symlink
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit font-lock-comment-face))
"Face used for symlinks in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-invalid-symlink
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "black" :background "red"))
"Face used for invalid symlinks in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-denied
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "red" :background "black"))
"Face used for non accessible files in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-file
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit font-lock-builtin-face))
"Face used for file names in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-nofile
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit helm-ff-file))
"Face used for non-files file names in `helm-find-files'.
Used when showing tramp host completions."
:group 'helm-files-faces)
(defface helm-ff-truename
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit font-lock-string-face))
"Face used for symlink truenames in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-dirs
`((t ,@(and (>= emacs-major-version 27) '(:extend 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 ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "DeepPink"))
"Face used for socket files in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-pipe
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "yellow" :background "black"))
"Face used for named pipes and character device files in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-file-extension
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "magenta"))
"Face used for file extensions in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-ff-backup-file
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "DimGray"))
"Face used for backup files in `helm-find-files'."
:group 'helm-files-faces)
(defface helm-history-deleted
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit helm-ff-invalid-symlink))
"Face used for deleted files in `file-name-history'."
:group 'helm-files-faces)
(defface helm-history-remote
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Indianred1"))
"Face used for remote files in `file-name-history'."
:group 'helm-files-faces)
(defface helm-delete-async-message
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "yellow"))
"Face used for mode-line message."
:group 'helm-files-faces)
(defface helm-ff-rsync-progress
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit font-lock-warning-face))
"Face used for rsync mode-line indicator."
:group 'helm-files-faces)
(defface helm-ff-rsync-progress-1
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:background "CadetBlue" :foreground "black"))
"Face used for rsync progress bar percentage and proc name."
:group 'helm-files-faces)
(defface helm-ff-rsync-progress-2
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:background "orange"))
"Face used for rsync progress bar progress."
:group 'helm-files-faces)
(defface helm-ff-rsync-progress-3
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:background "white"))
"Face used for rsync progress bar background."
:group 'helm-files-faces)
(defface helm-ff-rsync-progress-svg
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:background "black" :foreground "white"))
"Face used for rsync svg progress bar."
:group 'helm-files-faces)
;;; Helm-find-files
;;
;;
(defclass helm-source-ffiles (helm-source-sync)
((header-name
:initform (lambda (name)
(concat name (substitute-command-keys
helm-find-files-doc-header))))
(init
:initform (lambda ()
(setq helm-ff-auto-update-flag
helm-ff-auto-update-initial-value)
(setq helm-ff--auto-update-state
helm-ff-auto-update-flag)
(helm-set-local-variable 'bookmark-make-record-function
#'helm-ff-make-bookmark-record)
(require 'helm-external)))
(candidates :initform 'helm-find-files-get-candidates)
(update :initform (lambda ()
(remhash helm-ff-default-directory
helm-ff--list-directory-cache)))
(match-on-real :initform t)
(filtered-candidate-transformer
:initform '(helm-ff-fct
helm-ff-maybe-show-thumbnails
;; These next two have to be called after
;; `helm-ff-fct' as they use only cons cell candidates.
helm-ff-directories-only
helm-ff-files-only
helm-ff-sort-candidates))
(popup-info :initform (lambda (candidate)
(unless (helm-ff-dot-file-p candidate)
(helm-file-attributes
candidate
:dired t :human-size t :octal nil))))
(persistent-action-if :initform 'helm-find-files-persistent-action-if)
(persistent-help :initform "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
(help-message :initform 'helm-ff-help-message)
(mode-line :initform (list "File(s)" helm-mode-line-string))
(volatile :initform t)
(cleanup :initform 'helm-find-files-cleanup)
(migemo :initform t)
(nohighlight :initform (progn helm-ff-nohighlight-matches))
(keymap :initform 'helm-find-files-map)
(candidate-number-limit :initform 'helm-ff-candidate-number-limit)
(suspend-follow-in-update
:initarg :suspend-follow-in-update
:initform t
:documentation "Prevent following candidate when updating.")
(completing-file-name
:initarg :completing-file-name :initform t
:documentation "Flag to notify `helm-resume' we are completing filenames.")
(action-transformer
:initform 'helm-find-files-action-transformer)
(action :initform 'helm-find-files-actions)
(before-init-hook :initform 'helm-find-files-before-init-hook)
(after-init-hook :initform 'helm-find-files-after-init-hook)
(all-marked :initform t)
(group :initform 'helm-files)))
;; Bookmark handlers.
;;
(defun helm-ff-make-bookmark-record ()
"The `bookmark-make-record-function' for `helm-find-files'."
(with-helm-buffer
`((filename . ,helm-ff-default-directory)
(presel . ,(helm-get-selection))
(handler . helm-ff-bookmark-jump))))
(defun helm-ff-bookmark-jump (bookmark)
"bookmark handler for `helm-find-files'."
(let ((fname (bookmark-prop-get bookmark 'filename))
(presel (bookmark-prop-get bookmark 'presel)))
;; Force tramp connection with `file-directory-p' before lauching
;; hff otherwise the directory name is inserted on top before
;; tramp starts and display candidates. FNAME is here always a
;; directory.
(when (file-directory-p fname)
(helm-find-files-1 fname
(format helm-ff-last-expanded-candidate-regexp
(if helm-ff-transformer-show-only-basename
(regexp-quote (helm-basename presel))
(regexp-quote presel)))))))
(defun helm-ff-bookmark-set ()
"Record `helm-find-files' session in bookmarks."
(interactive)
(with-helm-alive-p
(with-helm-buffer
(bookmark-set
(concat helm-find-files-bookmark-prefix
(abbreviate-file-name helm-ff-default-directory))))
(message "Helm find files session bookmarked! ")))
(put 'helm-ff-bookmark-set 'helm-only t)
(defun helm-dwim-target-directory ()
"Try to return a suitable directory according to `helm-dwim-target'."
(with-selected-window (or
;; Try next-window if current-buffer has been
;; killed during this session probably by C-d.
(get-buffer-window helm-current-buffer)
(next-window (helm-window) 1))
(let ((wins (remove (get-buffer-window helm-marked-buffer-name)
(window-list))))
(expand-file-name
(cond (;; Provide completion on all the directory belonging to
;; visible windows if some.
(and (cdr wins)
(eq helm-dwim-target 'completion))
(helm-comp-read "Browse target starting from: "
(append (list (or (car-safe helm-ff-history)
default-directory)
default-directory)
(cl-loop for w in wins collect
(with-selected-window w
default-directory)))))
;; Use default-directory of next-window.
((and (cdr wins)
(eq helm-dwim-target 'next-window))
(with-selected-window (next-window)
default-directory))
;; Always use default-directory when only one window.
((and (null (cdr wins))
(eq helm-dwim-target 'default-directory))
default-directory)
;; Use the visited directory.
((or (null (cdr wins))
(null helm-dwim-target))
;; Using the car of *ff-history allow
;; staying in the directory visited instead of
;; current.
(or (car-safe helm-ff-history) default-directory)))))))
(defsubst helm-ff--file-directory-p (file)
(if (file-remote-p file)
(get-text-property 1 'helm-ff-dir file)
(file-directory-p file)))
(defun helm-ff--count-and-collect-dups (files)
(cl-loop with dups = (make-hash-table :test 'equal)
for f in files
for file = (if (helm-ff--file-directory-p f)
(concat (helm-basename f) "/")
(helm-basename f))
for count = (gethash file dups)
if count do (puthash file (1+ count) dups)
else do (puthash file 1 dups)
finally return (cl-loop for k being the hash-keys in dups
using (hash-value v)
if (> v 1)
collect (format "%s(%s)" k v)
else
collect k)))
(defun helm-find-files-do-action (action &optional target)
"Generic function for creating actions from `helm-source-find-files'.
ACTION can be `rsync' or any action supported by `helm-dired-action'."
(require 'dired-async)
(when (eq action 'rsync)
(cl-assert (executable-find "rsync") nil "No command named rsync"))
(let* (dired-create-destination-dirs ; We handle dirs creation ourself.
(rsync-switches
(when (and (eq action 'rsync)
helm-current-prefix-arg)
(cdr (split-string
(read-string "Run rsync like this: "
(mapconcat
'identity
(cons "rsync" helm-rsync-switches) " ")
'helm-rsync-command-history)))))
(ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
;; Use :all-sources to allow actions on wildcards
;; marked in dummy source. FIXME: We should use
;; :all-sources when :all-marked is non nil only, it is
;; true by default but user may modify HFF source by defmethod.
(helm-marked-candidates :with-wildcard t :all-sources t)))
(cand (unless (cdr ifiles) (helm-get-selection))) ; preselection.
(prefarg helm-current-prefix-arg)
(prompt (format "%s %s file(s) %s: "
(if (and (and (fboundp 'dired-async-mode)
dired-async-mode)
(not (eq action 'rsync))
(null prefarg))
(concat "Async " (symbol-name action))
(capitalize (symbol-name action)))
(length ifiles)
(if (memq action '(symlink relsymlink hardlink))
"from" "to")))
(cdir (helm-aand
(eq action 'compress)
(helm-common-dir ifiles)
(if (stringp it)
(file-name-as-directory it)
(error "Try to compress files not belonging to same drive"))))
helm-ff--move-to-first-real-candidate
helm-display-source-at-screen-top ; prevent setting window-start.
helm-ff-auto-update-initial-value
;; It is not possible to rename a file to a boring name when
;; helm-ff-skip-boring-files is enabled
helm-ff-skip-boring-files
;; If HFF is using a frame use a frame as well.
(helm-actions-inherit-frame-settings t)
helm-use-frame-when-more-than-two-windows
(dest (or target
(with-helm-display-marked-candidates
helm-marked-buffer-name
(if cdir
(mapcar (lambda (f)
(file-relative-name f cdir))
ifiles)
(helm-ff--count-and-collect-dups ifiles))
(with-helm-current-buffer
(helm-read-file-name
prompt
:preselect
(when cand
(format helm-ff-last-expanded-candidate-regexp
(regexp-quote
(if helm-ff-transformer-show-only-basename
(helm-basename cand) cand))))
:default (and cdir
(expand-file-name
(format "%s.tar.gz" (if cand
(helm-basename cand)
"new_archive"))
cdir))
:must-match (and cdir (lambda (f) (not (file-directory-p f))))
:initial-input (or cdir (helm-dwim-target-directory))
:history (helm-find-files-history nil :comp-read nil))))))
(dest-dir-p (file-directory-p dest))
(dest-dir (if dest-dir-p dest (helm-basedir dest))))
;; Ignore `dired-create-destination-dirs' and handle directory creation from
;; here like we were doing before. Dired is failing to create directories
;; when e.g. symlinking some files to a not yet existing directory.
(unless (or dest-dir-p (file-directory-p dest-dir))
(when (y-or-n-p (format "Create directory `%s'? " dest-dir))
;; When saying No here with rsync, `helm-rsync-copy-files' will raise an
;; error about dest not existing.
(make-directory dest-dir t)))
(helm-acase action
(rsync (helm-rsync-copy-files ifiles dest rsync-switches))
(compress (helm-do-compress-to ifiles dest))
(t (helm-dired-action
dest :files ifiles :action action :follow prefarg)))))
;; Rsync
;;
(defun helm-rsync-remote2rsync (file)
(if (file-remote-p file)
(let ((localname (directory-file-name
(expand-file-name (file-remote-p file 'localname))))
(user (file-remote-p file 'user))
;; Tramp name may contain port e.g. /ssh:host#2222:/foo.
(host (replace-regexp-in-string
"#[0-9]+" "" (file-remote-p file 'host))))
(if user
(format "%s@%s:%s" user host (shell-quote-argument localname))
(format "%s:%s" host (shell-quote-argument localname))))
(shell-quote-argument
(directory-file-name
(expand-file-name file)))))
(defun helm-rsync-format-mode-line-str (proc)
(helm-aif (and (process-live-p proc)
(assoc-default proc helm-rsync-progress-str-alist))
(progn
;; When rsync progress bar stop for some reason (e.g. rsync
;; takes time to finalize writing file to disk), no output is
;; coming from filter process, as a result the progress bar
;; disapear for a while giving no information to user while
;; the rsync process continues, so keep printing the last valid
;; progress bar (stored in `helm-rsync--last-progress-bar-alist')
;; instead of sending empty string.
(unless (equal it "")
(push (cons proc it) helm-rsync--last-progress-bar-alist))
(if (eq helm-ff-rsync-progress-bar-style 'text)
(format " [%s]" (propertize
(or (assoc-default proc helm-rsync--last-progress-bar-alist)
;; Avoid (wrong-type-argument stringp
;; nil) when process is not ready.
"")
'face 'helm-ff-rsync-progress))
(format " %s" (or (assoc-default proc helm-rsync--last-progress-bar-alist)
;; Avoid (wrong-type-argument stringp
;; nil) when process is not ready.
""))))))
(defun helm-ff--rsync-progress-bar (progbar proc)
;; progbar == " 2,83G 92% 98,65MB/s 0:00:02 "
(let ((infos (split-string
(replace-regexp-in-string
"%" helm-rsync-percent-sign
progbar)
" " t))
percent info)
(if (eq helm-ff-rsync-progress-bar-style 'text)
(mapconcat 'identity infos " ")
(setq info
(mapconcat (lambda (x)
(helm-acase x
(size (nth 0 infos))
(percent (nth 1 infos))
(speed (nth 2 infos))
(remain (nth 3 infos))))
(helm-mklist helm-ff-rsync-progress-bar-info)
", "))
(when (string-match "\\([0-9]+\\)%" progbar)
(setq percent (string-to-number
(match-string 1 progbar))))
(if percent
(funcall helm-rsync-progress-bar-function proc percent info)
""))))
(defun helm-rsync-default-progress-bar (proc percent info)
(format "%s%s%s%s"
(propertize (capitalize (replace-regexp-in-string
"<\\([0-9]+\\)>" "(\\1)"
(process-name proc)))
'display '(height 0.9)
'face 'helm-ff-rsync-progress-1)
(propertize " " 'display `(space :width ,(list percent))
'face 'helm-ff-rsync-progress-2)
(propertize " " 'display `(space :width ,(list (- 100 percent)))
'face 'helm-ff-rsync-progress-3)
(propertize info
'display '(height 0.9)
'face 'helm-ff-rsync-progress-1)))
(defun helm-rsync-svg-progress-bar (proc percent info)
(cl-assert (image-type-available-p 'svg) nil
"svg-lib requires Emacs to be compiled with svg support")
(require 'svg-lib)
(format "%s%s%s"
(propertize " " 'display (svg-lib-tag
(process-name proc)
'helm-ff-rsync-progress-svg))
(propertize " " 'display (svg-lib-progress-bar
(/ (+ percent 7) 105.0)
'helm-ff-rsync-progress-svg
:width 10 :margin 1 :stroke 2 :padding 2))
(if (string= info "")
""
(propertize " " 'display (svg-lib-tag
info 'helm-ff-rsync-progress-svg)))))
(defun helm-rsync-mode-line (proc)
"Add Rsync progress to the mode line."
(or global-mode-string (setq global-mode-string '("")))
(unless (member `(:eval (helm-rsync-format-mode-line-str ,proc))
global-mode-string)
(setq global-mode-string
(append global-mode-string
`((:eval (helm-rsync-format-mode-line-str ,proc)))))))
(defun helm-rsync-restore-mode-line (proc)
"Restore the mode line when Rsync finishes."
(setq global-mode-string
(remove `(:eval (helm-rsync-format-mode-line-str ,proc))
global-mode-string))
(setq helm-rsync--last-progress-bar-alist nil)
(force-mode-line-update))
(defun helm-rsync-copy-files (files dest &optional switches)
"Send FILES to DEST using Rsync with SWITCHES as arguments.
DEST must be a directory. SWITCHES when unspecified default to
`helm-rsync-switches'."
(cl-assert (file-directory-p dest) t)
(setq files (cl-loop for f in files
collect (helm-rsync-remote2rsync f))
dest (helm-rsync-remote2rsync dest))
(let* ((buf (generate-new-buffer-name helm-rsync-process-buffer))
(host (file-remote-p dest 'host))
(port (when (and host (string-match "#\\([0-9]+\\)" host))
(match-string 1 host)))
(proc (start-process-shell-command
"rsync" buf
(format "rsync %s"
(mapconcat
'identity
(append (or switches helm-rsync-switches)
(and port
;; Add automatically port
;; specified in tramp name
;; unless user already specified
;; it himself with the -e option
;; by editing command.
switches
(cl-loop for arg in switches never
(string-match-p
"\\`-e" arg))
(list (format "-e 'ssh -p %s'"
port)))
files (list dest))
" ")))))
(helm-rsync-mode-line proc)
(set-process-sentinel
proc (lambda (process event)
(cond ((string= event "finished\n")
(message "%s copied %s files"
(capitalize (process-name process))
(length files)))
(t (error "Process %s %s with code %s"
(process-name process)
(process-status process)
(process-exit-status process))))
(setq helm-rsync-progress-str-alist
(delete (assoc process helm-rsync-progress-str-alist)
helm-rsync-progress-str-alist))
(helm-rsync-restore-mode-line process)
(force-mode-line-update)))
(set-process-filter proc #'helm-rsync-process-filter)))
(defun helm-rsync-process-filter (proc output)
"Filter process function used by `helm-rsync-copy-files'."
(let ((inhibit-read-only t)
fname progbar)
(with-current-buffer (process-buffer proc)
(when (string-match comint-password-prompt-regexp output)
;; FIXME: Fully not tested and
;; use an agent or auth-source
;; or whatever to get password if
;; available.
(process-send-string
proc (concat (read-passwd (match-string 0 output)) "\n")))
;; Extract the progress bar.
(with-temp-buffer
(insert output)
(when (re-search-backward "[[:cntrl:]]" nil t)
(setq progbar (buffer-substring-no-properties
(match-end 0) (point-max)))))
;; Insert the text, advancing the process marker.
(save-excursion
(goto-char (process-mark proc))
(insert output)
(set-marker (process-mark proc) (point)))
(goto-char (process-mark proc))
;; Extract the file name currently
;; copied (Imply --info=all2 or all1).
(save-excursion
(when (re-search-backward "^[^[:cntrl:]]" nil t)
(setq fname (helm-basename
(buffer-substring-no-properties
(point) (pos-eol))))))
;; Now format the string for the mode-line.
(let ((ml-str (helm-ff--rsync-progress-bar progbar proc)))
(setq ml-str (propertize ml-str 'help-echo
(format "%s->%s" (process-name proc) fname)))
;; Now associate the formatted
;; progress-bar string with process.
(helm-aif (assoc proc helm-rsync-progress-str-alist)
(setcdr it ml-str)
(setq helm-rsync-progress-str-alist
(push (cons proc ml-str) helm-rsync-progress-str-alist)))))
;; Finally update mode-line.
(unless helm-rsync-no-mode-line-update
(force-mode-line-update))))
(defun helm-ff-kill-rsync-process (process)
"Kill rsync process PROCESS.
When called interactively prompt user with completion when more than
one process."
(interactive (list (get-process
(helm-comp-read
"Kill rsync process: "
(mapcar (lambda (x)
(process-name (car x)))
helm-rsync-progress-str-alist)
:exec-when-only-one t))))
(with-current-buffer (process-buffer process)
(delete-process process)
(kill-buffer))
(setq helm-rsync-progress-str-alist
(delete (assoc process helm-rsync-progress-str-alist)
helm-rsync-progress-str-alist)))
(defun helm-find-files-rsync (_candidate)
"Rsync files from `helm-find-files'."
(helm-find-files-do-action 'rsync))
(defun helm-find-files-copy (_candidate)
"Copy files from `helm-find-files'."
(helm-find-files-do-action 'copy))
(defun helm-find-files-backup (_candidate)
"Backup files from `helm-find-files'.
This reproduce the behavior of \"cp --backup=numbered from to\"."
(cl-assert (and (fboundp 'dired-async-mode) dired-async-mode) nil
"Backup only available when `dired-async-mode' is enabled")
(helm-find-files-do-action 'backup))
(defun helm-find-files-rename (_candidate)
"Rename files from `helm-find-files'."
(helm-find-files-do-action 'rename))
(defun helm-find-files-symlink (_candidate)
"Symlink files from `helm-find-files'."
(helm-find-files-do-action 'symlink))
(defun helm-find-files-relsymlink (_candidate)
"Relsymlink files from `helm-find-files'."
(helm-find-files-do-action 'relsymlink))
(defun helm-find-files-hardlink (_candidate)
"Hardlink files from `helm-find-files'."
(helm-find-files-do-action 'hardlink))
(defun helm-find-files-compress-to (_candidate)
"Compress to archive from `helm-find-files'."
(helm-find-files-do-action 'compress))
(defun helm-ff-compress-marked-files (_candidate)
"Compress or uncompress marked files with `dired-compress-file'."
(require 'dired-async)
(let* ((files (helm-marked-candidates :with-wildcard t)))
(if (not (with-helm-display-marked-candidates
helm-marked-buffer-name
(mapcar #'abbreviate-file-name files)
(y-or-n-p (format "Compress or uncompress *%s File(s)" (length files)))))
(message "(No (un)compression performed)")
(process-put
(async-start
`(lambda ()
(require 'dired-aux)
(let ((len 0))
(dolist (i ',files)
(let ((default-directory (file-name-directory i)))
(when (dired-compress-file i)
(cl-incf len))))
len))
(lambda (result)
(unless (dired-async-processes 'helm-async-compress)
(helm-ff--compress-async-modeline-mode -1))
(message "%s File(s) (un)compressed" result)
(run-with-timer
0.1 nil
(lambda (len flist)
(dired-async-mode-line-message
"%s %d/%d file(s) done"
'helm-delete-async-message
"(Un)compressing"
len (length flist)))
result files)))
'helm-async-compress t)
(helm-ff--compress-async-modeline-mode 1))))
(helm-make-command-from-action helm-ff-run-compress-marked-files
"Compress or uncompress marked files."
'helm-ff-compress-marked-files)
(defun helm-ff-chmod (_candidate)
"Set file mode on marked files.
If no mode is specified in prompt, default mode will be the mode of
the car of marked files i.e. the first marked file."
(let* ((mkd (helm-marked-candidates :with-wildcard t))
(model (car mkd))
(default (helm-file-attributes model :octal t))
(mode (read-file-modes nil model))
(smode (file-modes-number-to-symbolic mode))
(candidates (if (string= default (format "%o" mode))
(cdr mkd) mkd)))
(with-helm-display-marked-candidates
helm-marked-buffer-name
(helm-ff--count-and-collect-dups candidates)
(when (y-or-n-p (format "Change file mode to `%s'? " smode))
(dolist (f candidates)
(unless (file-symlink-p f)
;; For now don't use the FLAG arg 'nofollow of `set-file-modes' for
;; Emacs-26 compatibility.
(set-file-modes f mode)))
(message "Changed file mode to `%s' on %s file(s)"
smode (length candidates))))))
(defun helm-find-files-other-window (_candidate)
"Keep current-buffer and open files in separate windows.
When a prefix arg is detected files are opened in a vertical
windows layout."
(let* ((files (helm-marked-candidates))
(buffers (mapcar 'find-file-noselect files)))
(helm-window-show-buffers buffers t)))
(defun helm-find-files-byte-compile (_candidate)
"Byte compile elisp files from `helm-find-files'."
(let ((files (helm-marked-candidates :with-wildcard t))
(parg helm-current-prefix-arg))
(cl-loop for fname in files
do (condition-case _err
(with-no-warnings
(byte-compile-file fname parg))
(wrong-number-of-arguments
;; Emacs-28 accepts only one arg.
(byte-compile-file fname)
(when parg (load fname)))))))
(defun helm-find-files-load-files (_candidate)
"Load elisp files from `helm-find-files'."
(let ((files (helm-marked-candidates :with-wildcard t)))
(cl-loop for fname in files
do (load fname))))
(defun helm-find-files-ediff-files-1 (candidate &optional merge)
"Generic function to ediff/merge files in `helm-find-files'."
(let* ((helm-dwim-target 'next-window)
(bname (helm-basename candidate))
(marked (helm-marked-candidates :with-wildcard t))
(prompt (if merge "Ediff Merge `%s' With File: "
"Ediff `%s' With File: "))
(fun (if merge 'ediff-merge-files 'ediff-files))
(input (helm-dwim-target-directory))
(presel (if helm-ff-transformer-show-only-basename
(helm-basename candidate)
(expand-file-name
(helm-basename candidate)
input))))
(if (= (length marked) 2)
(funcall fun (car marked) (cadr marked))
(funcall fun candidate (helm-read-file-name
(format prompt bname)
:initial-input input
:preselect presel)))))
(defun helm-find-files-ediff-files (candidate)
(helm-find-files-ediff-files-1 candidate))
(defun helm-find-files-ediff-merge-files (candidate)
(helm-find-files-ediff-files-1 candidate 'merge))
(defun helm-find-files-grep (_candidate)
"Default action to grep files from `helm-find-files'."
(helm-do-grep-1 (helm-marked-candidates :with-wildcard t)
helm-current-prefix-arg))
(defun helm-ff-git-grep (_candidate)
"Default action to git-grep `helm-ff-default-directory'."
(helm-grep-git-1 helm-ff-default-directory helm-current-prefix-arg))
(defun helm-find-files-ag (_candidate)
(helm-grep-ag helm-ff-default-directory
helm-current-prefix-arg))
(defun helm-ff-zgrep (_candidate)
"Default action to zgrep files from `helm-find-files'."
(helm-ff-zgrep-1 (helm-marked-candidates :with-wildcard t) helm-current-prefix-arg))
(defun helm-ff-pdfgrep (_candidate)
"Default action to pdfgrep files from `helm-find-files'."
(let* ((recurse nil)
(cands (cl-loop for file in (helm-marked-candidates :with-wildcard t)
for dir = (file-directory-p file)
when dir do (setq recurse t)
when (or dir
(string= (file-name-extension file) "pdf")
(string= (file-name-extension file) "PDF"))
collect file)))
(when cands
(helm-do-pdfgrep-1 cands recurse))))
(defun helm-ff-etags-select (candidate)
"Default action to jump to etags from `helm-find-files'."
(when (get-buffer helm-action-buffer)
(kill-buffer helm-action-buffer))
(let* ((source-name (assoc-default 'name (helm-get-current-source)))
(default-directory (if (string= source-name "Find Files")
helm-ff-default-directory
(file-name-directory candidate))))
(helm-etags-select helm-current-prefix-arg)))
;;; Eshell command on file
;;
(defvar eshell-command-aliases-list nil)
(defvar helm-eshell-command-on-file-input-history nil)
(defvar helm-eshell-command-on-file-history nil)
(cl-defun helm-find-files-eshell-command-on-file-1 (&optional map)
"Run `eshell-command' on CANDIDATE or marked candidates.
This is done possibly with an Eshell alias. If no alias found,
you can type in an Eshell command.
Only aliases accepting a file as argument at the end of command
line are collected, i.e. aliases ending with \"$1\" or \"$*\".
Basename of CANDIDATE can be a wild-card.
E.g. you can do \"eshell-command command *.el\"
Where \"*.el\" is the CANDIDATE.
It is possible to do eshell-command command like this: \"command %s some more args\".
If MAP is given run `eshell-command' on all marked files at once,
Otherwise, run `eshell-command' on each marked files.
In other terms, with a prefix arg do on the three marked files
\"foo\" \"bar\" \"baz\":
\"eshell-command command foo bar baz\"
otherwise do
\"eshell-command command foo\"
\"eshell-command command bar\"
\"eshell-command command baz\"
Note:
You have to setup some aliases in Eshell with the `alias' command
or by editing yourself the file `eshell-aliases-file' to make
this working."
(require 'helm-adaptive)
(require 'em-alias) (eshell-read-aliases-list)
(unless (> emacs-major-version 27)
;; This advice has been merged in emacs-28.
(advice-add 'eshell-eval-command :override #'helm--advice-eshell-eval-command))
(when (or eshell-command-aliases-list
(y-or-n-p "No eshell aliases found, run eshell-command without alias anyway? "))
(let* ((cand-list (helm-marked-candidates :with-wildcard t))
(default-directory (or helm-ff-default-directory
;; If candidate is an url *-ff-default-directory is nil
;; so keep value of default-directory.
default-directory))
helm-display-source-at-screen-top
(helm-actions-inherit-frame-settings t)
helm-use-frame-when-more-than-two-windows
(command
(with-helm-display-marked-candidates
helm-marked-buffer-name
(helm-ff--count-and-collect-dups
(mapcar 'helm-basename cand-list))
(with-helm-current-buffer
(helm-comp-read
"Command: "
(cl-loop with len = 0
with aliases =
(cl-loop for (a c) in (eshell-read-aliases-list)
for len-key = (length a)
when
(and (string-match
"\\(\\$1\\|\\$\\*\\)"
c)
(not (member a helm-ff-eshell-unwanted-aliases)))
do (when (> len-key len) (setq len len-key))
and collect (list a c))
for (a c) in aliases
collect (cons
(concat (propertize
a 'face 'font-lock-keyword-face)
(make-string (1+ (- len (length a))) ? )
c)
a))
:fc-transformer #'helm-adaptive-sort
:buffer "*helm eshell on file*"
:name "Eshell command"
:mode-line
'("Eshell alias"
"C-h m: Help, \\[universal-argument]: Insert output at point")
:help-message 'helm-esh-help-message
:history 'helm-eshell-command-on-file-history
:raw-history t
:reverse-history helm-eshell-on-file-reverse-history
:input-history
'helm-eshell-command-on-file-input-history
;; Allow quoting when writing in minibuffer i.e. allow usage of
;; \@ and \#.
:raw-candidate t))))
(alias-value (car (assoc-default command eshell-command-aliases-list)))
cmd-line)
(if (or (equal helm-current-prefix-arg '(16))
(equal map '(16)))
;; Two time C-u from `helm-comp-read' mean print to current-buffer.
;; i.e `eshell-command' will use this value.
(setq current-prefix-arg '(16))
;; Else reset the value of `current-prefix-arg'
;; to avoid printing in current-buffer.
(setq current-prefix-arg nil))
(if (and (or
;; One prefix-arg have been passed before `helm-comp-read'.
;; If map have been set with C-u C-u (value == '(16))
;; ignore it.
(and map (equal map '(4)))
;; One C-u from `helm-comp-read'.
(equal helm-current-prefix-arg '(4))
;; An alias that finish with $*
(and alias-value
;; If command is an alias be sure it accept
;; more than one arg i.e $*.
(string-match "\\$\\*" alias-value)))
(cdr cand-list)
(and alias-value
;; Command is an alias and accept only one arg.
(not (string-match "\\$1" alias-value))))
;; Run eshell-command with ALL marked files as argument.
;; This wont work on remote files, because tramp handlers depend
;; on `default-directory' (limitation).
(let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
(if (string-match "%s" command)
(setq cmd-line (format command mapfiles)) ; See [1]
(setq cmd-line (format "%s %s" command mapfiles)))
(eshell-command cmd-line))
;; Run eshell-command sequencially on EACH marked files.
;; To work with tramp handler we have to call
;; COMMAND on basename of each file, using
;; its basedir as `default-directory'.
(unwind-protect
(progn
(cl-loop for f in cand-list
for n from 1
for dir = (and (not (string-match helm--url-regexp f))
(helm-basedir f))
;; We can use basename here as the command will run
;; under default-directory.
;; This allows running e.g.
;; "tar czvf test.tar.gz %s/*" without creating
;; an archive expanding from /home.
for file = (shell-quote-argument
(if (string-match helm--url-regexp f)
f (helm-basename f)))
;; \@ => placeholder for file without extension.
;; \# => placeholder for incremental number.
for fcmd = (helm-aand command
(replace-regexp-in-string
"\\\\#" (format "%03d" n)
it t t)
(replace-regexp-in-string
"\\\\@"
(regexp-quote
(file-name-sans-extension file))
it t t))
for com = (if (string-match "%s" fcmd)
;; [1] This allows to enter other args AFTER filename
;; i.e
(format fcmd file)
(format "%s %s" fcmd file))
do (let ((default-directory (or dir default-directory)))
(eshell-command com))))
;; Async process continues running but doesn't need anymore
;; the advice at this point (see the `eshell-eval-command'
;; call in `eshell-command').
(unless (> emacs-major-version 27)
(advice-remove 'eshell-eval-command #'helm--advice-eshell-eval-command)))))))
(defun helm--advice-eshell-eval-command (command &optional input)
"Fix return value when command ends with \"&\"."
;; Fix this emacs commit which is plain wrong as it returns
;; either nil or an error (double because format spec doesn't
;; always match specifier) whereas it should return either a
;; single element (CAR DELIM) or DELIM itself if the car of
;; DELIM is a process.
;; This prevent running eshell-command async when needed i.e. when
;; command ends with "&".
;;
;; UPDATE: This have now been merged in Emacs-28.
;;
;; 6b6f91b357f6fe2f1e0d72f046a1b8d8a2d6d8c3
;; Author: John Wiegley
;; AuthorDate: Fri May 27 02:57:18 2005 +0000
;; Commit: John Wiegley
;; CommitDate: Fri May 27 02:57:18 2005 +0000
(if eshell-current-command
;; we can just stick the new command at the end of the current
;; one, and everything will happen as it should
(setcdr (last (cdr eshell-current-command))
(list `(let ((here (and (eobp) (point))))
,(and input
`(insert-and-inherit ,(concat input "\n")))
(if here
(eshell-update-markers here))
(eshell-do-eval ',command))))
(and eshell-debug-command
(with-current-buffer (get-buffer-create "*eshell last cmd*")
(erase-buffer)
(insert "command: \"" input "\"\n")))
(setq eshell-current-command command)
(let* ((delim (catch 'eshell-incomplete
(eshell-resume-eval)))
(val (car-safe delim)))
;; If the return value of `eshell-resume-eval' is wrapped in a
;; list, it indicates that the command was run asynchronously.
;; In that case, unwrap the value before checking the delimiter
;; value.
(if (and val
(not (processp val))
(not (eq val t)))
(error "Unmatched delimiter: %S" val)
;; Eshell-command expect a list like () to know if the
;; command should be async or not.
(or (and (processp val) delim) val)))))
(defun helm-find-files-eshell-command-on-file (_candidate)
"Run `eshell-command' on CANDIDATE or marked candidates.
See `helm-find-files-eshell-command-on-file-1' for more info."
(helm-find-files-eshell-command-on-file-1 helm-current-prefix-arg))
(defun helm-ff--shell-interactive-buffer-p (buffer &optional mode)
(with-current-buffer buffer
(when (eq major-mode (or mode 'eshell-mode))
(let ((next-prompt-fn (cl-case major-mode
(shell-mode #'comint-next-prompt)
(eshell-mode #'eshell-next-prompt)
(term-mode #'term-next-prompt))))
(save-excursion
(goto-char (point-min))
(funcall next-prompt-fn 1)
(null (eql (point) (point-min))))))))
(defun helm-ff-switch-to-shell (_candidate)
"Switch to a shell buffer and cd to `helm-ff-default-directory'.
Set your preferred shell mode in `helm-ff-preferred-shell-mode'.
With a numeric prefix arg switch to numbered shell buffer, if no
prefix arg provided and more than one shell buffer exists, provide
completions on those buffers. If only one shell buffer exists,
switch to this one, if no shell buffer exists or if the numeric
prefix arg shell buffer doesn't exists, create it and switch to it."
;; Reproduce the Emacs-25 behavior to be able to edit and send
;; command in term buffer.
(let (term-char-mode-buffer-read-only ; Emacs-25 behavior.
term-char-mode-point-at-process-mark ; Emacs-25 behavior.
(cd-eshell (lambda ()
(eshell/cd helm-ff-default-directory)
(eshell-reset)))
(cd-shell
(lambda ()
(goto-char (point-max))
(when (eq helm-ff-preferred-shell-mode 'shell-mode)
(comint-delete-input))
(insert (format "cd %s"
(shell-quote-argument
(or (file-remote-p
helm-ff-default-directory 'localname)
helm-ff-default-directory))))
(cl-case helm-ff-preferred-shell-mode
(shell-mode (comint-send-input))
(term-mode (progn (term-char-mode) (term-send-input))))))
(bufs (cl-loop for b in (mapcar 'buffer-name (buffer-list))
when (helm-ff--shell-interactive-buffer-p
b helm-ff-preferred-shell-mode)
collect b)))
;; Jump to a shell buffer or open a new session.
(helm-aif (and (not helm-current-prefix-arg)
(if (cdr bufs)
(helm-comp-read "Switch to shell buffer: " bufs
:must-match t)
(car bufs)))
;; Display in same window by default to preserve the
;; historical behaviour
(pop-to-buffer it '(display-buffer-same-window))
(cl-case helm-ff-preferred-shell-mode
(eshell-mode
(eshell helm-current-prefix-arg))
(shell-mode
(shell (helm-aif (and helm-current-prefix-arg
(prefix-numeric-value
helm-current-prefix-arg))
(format "*shell<%s>*" it))))
(term-mode
(progn
(ansi-term (getenv "SHELL")
(helm-aif (and helm-current-prefix-arg
(prefix-numeric-value
helm-current-prefix-arg))
(format "*ansi-term<%s>*" it)))
(term-line-mode)))))
;; Now cd into directory.
(helm-aif (and (memq major-mode '(shell-mode term-mode))
(get-buffer-process (current-buffer)))
(accept-process-output it 0.1))
(unless (helm-ff-shell-alive-p major-mode)
(funcall
(if (eq major-mode 'eshell-mode) cd-eshell cd-shell)))))
(defun helm-ff-shell-alive-p (mode)
"Returns non nil when a process is running inside `shell-mode' buffer."
(cl-ecase mode
(shell-mode
(save-excursion
(comint-goto-process-mark)
(or (null comint-last-prompt)
(not (eql (point)
(marker-position (cdr comint-last-prompt)))))))
(eshell-mode
(get-buffer-process (current-buffer)))
(term-mode
(save-excursion
(goto-char (term-process-mark))
(not (looking-back "\\$ " (- (point) 2)))))))
(defun helm-ff-touch-files (_candidate)
"The touch files action for helm-find-files."
(let* ((files (helm-marked-candidates))
(split (cl-loop for f in files
for spt = (unless helm-current-prefix-arg
(cons (helm-basedir f)
(split-string f ", ?")))
if spt
append (cl-loop with dir = (car spt)
for ff in (cdr spt)
collect (expand-file-name ff dir))
else collect f))
(timestamp (helm-comp-read
"Timestamp (default Now): "
(cl-loop for f in split
for time = (file-attributes f)
for date = (and time
(format-time-string
"%Y-%m-%d %H:%M:%S"
(nth 5 time)))
when date
collect (cons (format "%s: %s"
(helm-basename f) date)
date))
:default
(format-time-string "%Y-%m-%d %H:%M:%S"
(current-time))))
(failures
(cl-loop with default-directory = helm-ff-default-directory
for f in split
for file = (or (file-remote-p f 'localname) f)
when (> (process-file
"touch" nil nil nil "-d" timestamp file)
0)
collect f)))
(when failures
(message "Failed to touch *%s files:\n%s"
(length failures)
(mapconcat (lambda (f) (format "- %s\n" f)) failures "")))))
(defun helm-ff-encrypt-files (_candidate)
"Encrypt marked files."
(require 'epg) (require 'epa) (require 'helm-epa)
(let* ((mkds (helm-marked-candidates :with-wildcard t))
(recipients (helm :sources (helm-build-sync-source
"Select recipient for encryption: "
:persistent-action 'ignore
:candidates 'helm-epa-get-key-list
:action (lambda (_candidate)
(helm-marked-candidates))
:must-match t)
:buffer "*helm-ff epg keys*"))
(keys (and recipients (helm-epa-collect-keys-from-candidates recipients)))
(ids (and recipients (helm-epa-collect-id-from-candidates recipients))))
(when recipients ; may be aborted by quit.
(cl-loop for f in mkds
do (epa-encrypt-file f recipients))
(helm-epa-success-message (concat (format "%s File(s) encrypted" (length mkds))
" with key(s):\n %s")
keys ids))))
(helm-make-command-from-action helm-ff-run-touch-files
"Used to interactively run touch file action from keyboard."
'helm-ff-touch-files)
(defun helm-ff-sort-by-size ()
(interactive)
(let ((helm-ff-initial-sort-method 'size))
(helm-force-update
(concat (regexp-quote (helm-get-selection
nil helm-ff-transformer-show-only-basename))
"$"))
(message "Sorting by size")))
(put 'helm-ff-sort-by-size 'helm-only t)
(defun helm-ff-sort-by-newest ()
(interactive)
(let ((helm-ff-initial-sort-method 'newest))
(helm-force-update
(concat (regexp-quote (helm-get-selection
nil helm-ff-transformer-show-only-basename))
"$"))
(message "Sorting by newest")))
(put 'helm-ff-sort-by-newest 'helm-only t)
(defun helm-ff-sort-by-ext ()
(interactive)
(let ((helm-ff-initial-sort-method 'ext))
(helm-force-update
(concat (regexp-quote (helm-get-selection
nil helm-ff-transformer-show-only-basename))
"$"))
(message "Sorting by extensions")))
(put 'helm-ff-sort-by-ext 'no-helm-mx t)
(defun helm-ff-sort-alpha ()
(interactive)
(let ((helm-ff-initial-sort-method nil))
(helm-force-update
(concat (regexp-quote (helm-get-selection
nil helm-ff-transformer-show-only-basename))
"$"))
(message "Sorting alphabetically")))
(put 'helm-ff-sort-alpha 'helm-only t)
(defun helm-ff-directories-only (candidates _source)
(if helm-ff--show-directories-only
(cl-loop for (d . r) in candidates
when (file-directory-p r)
;; We can use this as long as this filtering function
;; is called after `helm-ff-fct' otherwise candidates
;; may not be cons cell at first call [1].
collect (cons d r))
candidates))
(defun helm-ff-files-only (candidates _source)
(if helm-ff--show-files-only
(cl-loop for (d . r) in candidates
unless (file-directory-p r)
;; Same comment as in [1] above.
collect (cons d r))
candidates))
(defun helm-ff-toggle-dirs-only ()
"Show only directories in helm-find-files."
(interactive)
(with-helm-alive-p
(setq helm-ff--show-directories-only (not helm-ff--show-directories-only))
(setq helm-ff--show-files-only nil)
(helm-update (helm-get-selection nil t))))
(put 'helm-ff-toggle-dirs-only 'helm-only t)
(defun helm-ff-toggle-files-only ()
"Show only files in helm-find-files."
(interactive)
(with-helm-alive-p
(setq helm-ff--show-files-only (not helm-ff--show-files-only))
(setq helm-ff--show-directories-only nil)
(helm-update (helm-get-selection nil t))))
(put 'helm-ff-toggle-files-only 'helm-only t)
(defun helm-ff-after-persistent-show-all ()
(when helm-ff-reset-filters-on-update
(setq helm-ff--show-directories-only nil
helm-ff--show-files-only nil)))
(defun helm-ff-serial-rename-action (method)
"Rename all marked files in `helm-ff-default-directory' with METHOD.
See `helm-ff-serial-rename-1'."
(let* ((helm--reading-passwd-or-string t)
(cands (helm-marked-candidates :with-wildcard t))
(def-name (car cands))
(name (helm-read-string "NewName: "
(replace-regexp-in-string
"[0-9]+$" ""
(helm-basename
def-name
(file-name-extension def-name)))))
(start (read-number "StartAtNumber: "))
(extension (helm-read-string "Extension: "
(file-name-extension (car cands))))
(dir (expand-file-name
(helm-read-file-name
"Serial Rename to directory: "
:initial-input
(expand-file-name helm-ff-default-directory)
:test 'file-directory-p
:must-match t)))
done)
(with-helm-display-marked-candidates
helm-marked-buffer-name (helm-ff--count-and-collect-dups cands)
(if (y-or-n-p
(format "Rename %s file(s) to <%s> like this ?\n%s "
(length cands) dir (format "%s <-> %s%s.%s"
(helm-basename (car cands))
name start extension)))
(progn
(helm-ff-serial-rename-1
dir cands name start extension :method method)
(setq done t)
(message nil))))
(if done
(with-helm-current-buffer (helm-find-files-1 dir))
(message "Operation aborted"))))
(defun helm-ff-member-directory-p (file directory)
(let ((dir-file (expand-file-name
(file-name-as-directory (file-name-directory file))))
(cur-dir (expand-file-name (file-name-as-directory directory))))
(string= dir-file cur-dir)))
(cl-defun helm-ff-serial-rename-1
(directory collection new-name start-at-num extension &key (method 'rename))
"Rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
EXTENSION is the file extension to use. In empty prompt, reuse
the original extension of file.
METHOD can be one of rename, copy or symlink.
Files will be renamed if they are files of current directory,
otherwise they will be treated with METHOD.
Default METHOD is rename."
;; Maybe remove directories selected by error in collection.
(setq collection (cl-remove-if 'file-directory-p collection))
(let* ((tmp-dir (file-name-as-directory
(concat (file-name-as-directory directory)
(symbol-name (cl-gensym "tmp")))))
(fn (cl-case method
(copy 'copy-file)
(symlink 'make-symbolic-link)
(rename 'rename-file)
(t (error "Error: Unknown method %s" method)))))
(make-directory tmp-dir)
(unwind-protect
(progn
;; Rename all files to tmp-dir with new-name.
;; If files are not from start directory, use method
;; to move files to tmp-dir.
(cl-loop for i in collection
for count from start-at-num
for fnum = (if (< count 10) "0%s" "%s")
for nname = (concat tmp-dir new-name (format fnum count)
(if (not (string= extension ""))
(format ".%s" (replace-regexp-in-string
"[.]" "" extension))
(file-name-extension i 'dot)))
do (if (helm-ff-member-directory-p i directory)
(rename-file i nname)
(funcall fn i nname)))
;; Now move all from tmp-dir to destination.
(cl-loop with dirlist = (directory-files
tmp-dir t directory-files-no-dot-files-regexp)
for f in dirlist do
(if (file-symlink-p f)
(make-symbolic-link (file-truename f)
(concat (file-name-as-directory directory)
(helm-basename f)))
(rename-file f directory))))
(delete-directory tmp-dir t))))
(defun helm-ff-serial-rename (_candidate)
"Serial rename all marked files to `helm-ff-default-directory'.
Rename only file of current directory, and symlink files coming from
other directories.
See `helm-ff-serial-rename-1'."
(helm-ff-serial-rename-action 'rename))
(defun helm-ff-serial-rename-by-symlink (_candidate)
"Serial rename all marked files to `helm-ff-default-directory'.
Rename only file of current directory, and symlink files coming
from other directories.
See `helm-ff-serial-rename-1'."
(helm-ff-serial-rename-action 'symlink))
(defun helm-ff-serial-rename-by-copying (_candidate)
"Serial rename all marked files to `helm-ff-default-directory'.
Rename only file of current directory, and copy files coming from
other directories.
See `helm-ff-serial-rename-1'."
(helm-ff-serial-rename-action 'copy))
(defvar helm-ff-query-replace-fnames-history-from nil)
(defvar helm-ff-query-replace-fnames-history-to nil)
(defun helm-ff-query-replace-on-filenames (candidates)
"Query replace on filenames of CANDIDATES.
This doesn't replace inside the files, only modify filenames."
(with-helm-display-marked-candidates
helm-marked-buffer-name
(mapcar 'helm-basename candidates)
(let* ((regexp (read-string "Replace regexp on filename(s): "
nil 'helm-ff-query-replace-history-from
(helm-basename (car candidates))))
(rep (read-string (format "Replace regexp `%s' with: " regexp)
nil 'helm-ff-query-replace-history-to)))
(cl-loop with query = "y"
with count = 0
for old in candidates
for new = (helm-ff--query-replace-in-fname-set-new-name
old regexp rep count)
;; If `regexp' is not matched in `old'
;; `replace-regexp-in-string' will
;; return `old' unmodified.
unless (string= old new)
do (progn
(when (file-exists-p new)
(setq new (concat (file-name-sans-extension new)
(format "(%s)" count)
(file-name-extension new t))))
(unless (string= query "!")
(setq query (helm-read-answer (format
"Replace `%s' by `%s' [!,y,n,q,h]"
(helm-basename old)
(helm-basename new))
'("y" "n" "!" "q")
#'helm-read-answer-default-help-fn)))
(when (string= query "q")
(cl-return (message "Operation aborted")))
(unless (string= query "n")
(rename-file old new)
(cl-incf count)))
finally (message "%d Files renamed" count))))
;; This fix the emacs bug where "Emacs-Lisp:" is sent
;; in minibuffer (not the echo area).
(sit-for 0.1)
(with-current-buffer (window-buffer (minibuffer-window))
(delete-minibuffer-contents)))
(defun helm-ff--query-replace-in-fname-set-new-name (old regexp rep count)
"Setup a new name for OLD replacing part matching REGEXP with REP.
COUNT is used for incrementing new name if needed."
(let (subexp target)
(concat (helm-basedir old)
(helm--replace-regexp-in-buffer-string
(save-match-data
(cond ((string= regexp "%.")
(setq subexp 1)
(helm-ff--prepare-str-with-regexp
(setq target (helm-basename old t))))
((string= regexp ".%")
(setq subexp 1)
(helm-ff--prepare-str-with-regexp
(setq target (file-name-extension old))))
((string= regexp "%")
(regexp-quote
(setq target (helm-basename old))))
((string-match "%:\\([0-9]+\\):\\([0-9]+\\)" regexp)
(setq subexp 1)
(let ((beg (match-string 1 regexp))
(end (match-string 2 regexp))
(str (helm-basename old)))
(setq target (substring str
(string-to-number beg)
(string-to-number end)))
(helm-ff--prepare-str-with-regexp str beg end)))
(t regexp)))
(save-match-data
(cond (;; Handle incremental
;; replacement with \# in
;; search and replace
;; feature in placeholder \@.
(string-match "\\\\@/\\(.*\\)/\\(.*\\)/" rep)
(helm-aand (save-match-data
(replace-regexp-in-string
"\\\\#" (format "%03d" (1+ count))
(match-string 2 rep)))
(replace-regexp-in-string
(match-string 1 rep) it target)))
;; Incremental replacement
;; before or after \@.
((or (string-match "\\`\\\\#\\\\@\\'" rep)
(string-match "\\`\\\\@\\\\#\\'" rep))
(replace-regexp-in-string
"\\\\#" (format "%03d" (1+ count))
(replace-match target t t rep)))
;; Simple incremental replacement.
((or (string-match "\\`\\\\#" rep)
(string-match "\\\\#\\'" rep))
(replace-match
(format "%03d" (1+ count)) t t rep))
;; Substring replacement in placeholder.
((string-match
"\\\\@:\\([0-9]*\\):\\([0-9]*\\)" rep)
(replace-match (substring
target
(string-to-number
(match-string 1 rep))
(helm-acase (match-string 2 rep)
((guard* (string= it ""))
(length target))
(t (string-to-number it))))
t t rep))
;; Simple replacement by placeholder.
((string-match "\\\\@" rep)
(replace-match target t t rep))
;; Replacement with
;; upcase, downcase or
;; capitalized text.
((string= rep "%u") #'upcase)
((string= rep "%d") #'downcase)
((string= rep "%c") #'capitalize)
;; Simple replacement with
;; whole replacement regexp.
(t rep)))
(helm-basename old) t nil subexp))))
(defun helm-ff--prepare-str-with-regexp (str &optional rep1 rep2)
;; This is used in `helm-ff-query-replace-on-filenames' to prepare
;; STR when REGEXP is specified as substring e.g %:1:3 in this case
;; substring from 1 to 3 in STR will be enclosed with parenthesis to
;; match this substring as a subexp e.g %:1:3 on string "emacs" will
;; be replaced by "e\\(ma\\)cs" using subexp 1 like this:
;; (helm--replace-regexp-in-buffer-string "e\\(ma\\)cs" "fo" "emacs" nil t 1)
;; => "efocs"
;; ^^
;; Where "1" and "3" will be strings extracted with match-string
;; from regexp and refered respectively in this function as REP1 and
;; REP2.
(let* ((from (or (and rep1 (string-to-number rep1)) 0))
(to (or (and rep2 (string-to-number rep2)) (length str)))
(subexp (concat "\\(" (regexp-quote (substring str from to)) "\\)"))
(before-str (unless (zerop from)
(regexp-quote (substring str 0 from))))
(after-str (unless (= to (length str))
(regexp-quote (substring str to (length str))))))
(concat before-str subexp after-str)))
;; The action.
(defun helm-ff-query-replace-fnames-on-marked (_candidate)
(let ((marked (helm-marked-candidates :with-wildcard t)))
(helm-ff-query-replace-on-filenames marked)))
;; The command for `helm-find-files-map'.
(helm-make-command-from-action helm-ff-run-query-replace-fnames-on-marked
"Run query-replace on filenames from HFF."
'helm-ff-query-replace-fnames-on-marked)
(defun helm-ff-query-replace (_candidate)
(let ((bufs (cl-loop for f in (helm-marked-candidates :with-wildcard t)
collect (buffer-name (find-file-noselect f)))))
(helm-buffer-query-replace-1 nil bufs)))
(helm-make-command-from-action helm-ff-run-query-replace
"Run query-replace from HFF."
'helm-ff-query-replace)
(defun helm-ff-query-replace-regexp (_candidate)
(let ((bufs (cl-loop for f in (helm-marked-candidates :with-wildcard t)
collect (buffer-name (find-file-noselect f)))))
(helm-buffer-query-replace-1 'regexp bufs)))
(helm-make-command-from-action helm-ff-run-query-replace-regexp
"Run query-replace regexp from HFF."
'helm-ff-query-replace-regexp)
(defun helm-ff-toggle-auto-update ()
(if helm-ff--deleting-char-backward
(progn
(message "[Auto expansion disabled]")
(sit-for 1) (message nil)
(setq helm-ff--auto-update-state nil))
(setq helm-ff-auto-update-flag (not helm-ff-auto-update-flag))
(setq helm-ff--auto-update-state helm-ff-auto-update-flag)
(message "[Auto expansion %s]"
(if helm-ff-auto-update-flag "enabled" "disabled"))))
(defun helm-ff-run-toggle-auto-update ()
(interactive)
(with-helm-alive-p
(helm-ff-toggle-auto-update)))
(put 'helm-ff-run-toggle-auto-update 'helm-only t)
(defun helm-ff-delete-char-backward ()
"Go up one level or disable HFF auto update and delete char backward.
Going up one level works only when pattern is a directory endings
with \"/\", otherwise this command deletes char backward.
Going up one level can be disabled if necessary by deleting \"/\"
at end of pattern using \\\\[backward-char] and
\\[helm-delete-minibuffer-contents]."
(interactive)
(with-helm-alive-p
(if (and helm-ff-DEL-up-one-level-maybe
(string-match "/\\'" helm-pattern)
(file-directory-p helm-pattern))
(call-interactively 'helm-find-files-up-one-level)
(setq helm-ff-auto-update-flag nil)
(setq helm-ff--deleting-char-backward t)
(call-interactively
(lookup-key (current-global-map)
(read-kbd-macro "DEL")))
(helm--update-header-line))))
(put 'helm-ff-delete-char-backward 'helm-only t)
(defun helm-ff-delete-char-backward--exit-fn ()
(setq helm-ff-auto-update-flag helm-ff--auto-update-state)
(setq helm-ff--deleting-char-backward nil))
(defvar helm-ff--RET-disabled nil)
(defun helm-ff-RET-1 (&optional must-match)
"Used for RET action in `helm-find-files'.
See `helm-ff-RET' for details.
If MUST-MATCH is specified exit with
`helm-confirm-and-exit-minibuffer' which handle must-match mechanism."
(let ((sel (helm-get-selection))
;; Ensure `file-directory-p' works on remote files.
non-essential)
(cl-assert sel nil "Trying to exit with no candidates")
(if (and (or (file-directory-p sel)
(helm-ff--invalid-tramp-name-p sel))
;; Allows exiting with default action when a prefix arg
;; is specified.
(null current-prefix-arg)
(null helm-ff--RET-disabled)
(or (and (file-remote-p sel)
(string= "." (helm-basename sel))
(string-match-p "\\`[/].*:.*:\\'"
helm-pattern))
(not (string= "." (helm-basename sel)))))
(helm-execute-persistent-action)
(if must-match
(helm-confirm-and-exit-minibuffer)
(helm-maybe-exit-minibuffer)))))
(defun helm-ff-RET ()
"Default action for RET in `helm-find-files'.
Behave differently depending on `helm-selection':
- candidate basename is \".\" => open it in dired.
- candidate is a directory => expand it.
- candidate is a file => open it."
(interactive)
(helm-ff-RET-1))
(put 'helm-ff-RET 'helm-only t)
(defun helm-ff-TAB-1 (&optional force-menu)
"Used for TAB action in `helm-find-files'."
(let ((sel (helm-get-selection)))
(if (and (null force-menu)
(file-directory-p sel)
(not (string= "." (helm-basename sel))))
(helm-execute-persistent-action)
(helm-select-action))))
(defun helm-ff-TAB (arg)
"Default action for TAB in `helm-find-files'.
Behave differently depending on `helm-selection':
- candidate basename is \".\" => open the action menu.
- candidate is a directory => expand it.
- candidate is a file => open action menu.
Called with a prefix arg open menu unconditionally."
(interactive "P")
(helm-ff-TAB-1 arg))
(put 'helm-ff-TAB 'helm-only t)
(defun helm-ff-RET-must-match ()
"Same as `helm-ff-RET' but used in must-match map."
(interactive)
(helm-ff-RET-1 t))
(helm-make-command-from-action helm-ff-run-grep
"Run Grep action from `helm-source-find-files'."
'helm-find-files-grep)
(helm-make-command-from-action helm-ff-run-git-grep
"Run git-grep action from `helm-source-find-files'."
'helm-ff-git-grep)
(helm-make-command-from-action helm-ff-run-grep-ag
"Run grep AG action from `helm-source-find-files'."
'helm-find-files-ag)
(helm-make-command-from-action helm-ff-run-pdfgrep
"Run Pdfgrep action from `helm-source-find-files'."
'helm-ff-pdfgrep)
(helm-make-command-from-action helm-ff-run-zgrep
"Run Grep action from `helm-source-find-files'."
'helm-ff-zgrep)
(helm-make-command-from-action helm-ff-run-copy-file
"Run Copy file action from `helm-source-find-files'."
'helm-find-files-copy)
(helm-make-command-from-action helm-ff-run-rsync-file
"Run Rsync file action from `helm-source-find-files'."
'helm-find-files-rsync)
(helm-make-command-from-action helm-ff-run-rename-file
"Run Rename file action from `helm-source-find-files'."
'helm-find-files-rename)
(helm-make-command-from-action helm-ff-run-byte-compile-file
"Run Byte compile file action from `helm-source-find-files'."
'helm-find-files-byte-compile)
(helm-make-command-from-action helm-ff-run-load-file
"Run Load file action from `helm-source-find-files'."
'helm-find-files-load-files)
(helm-make-command-from-action helm-ff-run-eshell-command-on-file
"Run eshell command on file action from `helm-source-find-files'."
'helm-find-files-eshell-command-on-file)
(helm-make-command-from-action helm-ff-run-ediff-file
"Run Ediff file action from `helm-source-find-files'."
'helm-find-files-ediff-files)
(helm-make-command-from-action helm-ff-run-ediff-merge-file
"Run Ediff merge file action from `helm-source-find-files'."
'helm-find-files-ediff-merge-files)
(helm-make-command-from-action helm-ff-run-symlink-file
"Run Symlink file action from `helm-source-find-files'."
'helm-find-files-symlink)
(helm-make-command-from-action helm-ff-run-relsymlink-file
"Run Symlink file action from `helm-source-find-files'."
'helm-find-files-relsymlink)
(helm-make-command-from-action helm-ff-run-hardlink-file
"Run Hardlink file action from `helm-source-find-files'."
'helm-find-files-hardlink)
(helm-make-command-from-action helm-ff-run-compress-to
"Run Compress to archive action from `helm-source-find-files'."
'helm-find-files-compress-to)
(helm-make-command-from-action helm-ff-run-chmod
"Run chmod action from `helm-source-find-files'."
'helm-ff-chmod)
(defun helm-ff-delete-files (candidate)
"Delete files default action."
(funcall helm-ff-delete-files-function candidate))
(helm-make-command-from-action helm-ff-run-delete-file
"Run Delete file action from `helm-source-find-files'."
'helm-ff-delete-files)
(helm-make-command-from-action helm-ff-run-complete-fn-at-point
"Run complete file name action from `helm-source-find-files'."
'helm-insert-file-name-completion-at-point)
(helm-make-command-from-action helm-ff-run-switch-to-shell
"Run switch to eshell action from `helm-source-find-files'."
'helm-ff-switch-to-shell)
(helm-make-command-from-action helm-ff-run-switch-other-window
"Run switch to other window action from `helm-source-find-files'.
When a prefix arg is provided, split is done vertically."
'helm-find-files-other-window)
(helm-make-command-from-action helm-ff-run-switch-other-frame
"Run switch to other frame action from `helm-source-find-files'."
'find-file-other-frame)
(helm-make-command-from-action helm-ff-run-open-file-externally
"Run open file externally command action from `helm-source-find-files'."
'helm-open-file-externally)
(helm-make-command-from-action helm-ff-run-open-file-with-default-tool
"Run open file externally command action from `helm-source-find-files'."
'helm-open-file-with-default-tool)
(defun helm-ff-locate (candidate)
"Locate action function for `helm-find-files'."
(helm-locate-set-command)
(let ((default (concat (helm-basename
(expand-file-name
candidate
helm-ff-default-directory))
(unless (or
;; "-b" is already added when fuzzy matching.
helm-locate-fuzzy-match
;; The locate '-b' option doesn't exists
;; in everything (es).
(and (eq system-type 'windows-nt)
(string-match "^es" helm-locate-command)))
" -b"))))
(helm-locate-1 helm-current-prefix-arg nil 'from-ff default)))
(helm-make-command-from-action helm-ff-run-locate
"Run locate action from `helm-source-find-files'."
'helm-ff-locate)
(defun helm-files-insert-as-org-link (candidate)
(insert (format "[[%s][]]" candidate))
(goto-char (- (point) 2)))
(helm-make-command-from-action helm-ff-run-insert-org-link
"Run insert org link from HFF."
'helm-files-insert-as-org-link)
(helm-make-command-from-action helm-ff-run-find-file-as-root
"Run find file as root from HFF."
'helm-find-file-as-root)
(helm-make-command-from-action helm-ff-run-find-alternate-file
"Run `find-alternate-file' from HFF."
'find-alternate-file)
(helm-make-command-from-action helm-ff-run-mail-attach-files
"Run mail attach files command action from `helm-source-find-files'."
'helm-ff-mail-attach-files)
(helm-make-command-from-action helm-ff-run-etags
"Run Etags command action from `helm-source-find-files'."
'helm-ff-etags-select)
(defvar lpr-printer-switch)
(defun helm-ff-print (_candidate)
"Print marked files.
You may to set in order variables `lpr-command',`lpr-switches'
and/or `printer-name', but with no settings Helm should detect
your printer(s) and print with the default `lpr' settings.
NOTE: DO NOT set the \"-P\" flag in `lpr-switches'. If you really
have to modify this, do it in `lpr-printer-switch'.
Same as `dired-do-print' but for Helm."
(require 'lpr)
(when (or helm-current-prefix-arg
(not helm-ff-printer-list))
(setq helm-ff-printer-list
(helm-ff-find-printers)))
(let* ((file-list (helm-marked-candidates :with-wildcard t))
(len (length file-list))
(printer-name (if helm-ff-printer-list
(helm-comp-read
"Printer: " helm-ff-printer-list)
printer-name))
(lpr-switches
(if (and (stringp printer-name)
(string< "" printer-name))
(cons (concat lpr-printer-switch " " printer-name)
lpr-switches)
lpr-switches))
(command (helm-read-string
(format "Print *%s File(s):\n%s with: "
len
(mapconcat
(lambda (f) (format "- %s\n" f))
file-list ""))
(when (and lpr-command lpr-switches)
(mapconcat 'identity
(cons lpr-command
(if (stringp lpr-switches)
(list lpr-switches)
lpr-switches))
" "))))
(file-args (mapconcat #'shell-quote-argument
file-list " "))
(cmd-line (concat command " " file-args)))
(if command
(start-process-shell-command "helm-print" nil cmd-line)
(error "Error: Please verify your printer settings in Emacs."))))
(helm-make-command-from-action helm-ff-run-print-file
"Run Print file action from `helm-source-find-files'."
'helm-ff-print)
(defun helm-ff-checksum (file)
"Calculate the checksum of FILE.
The checksum is copied to `kill-ring'.
Checksum is calculated with the md5sum, sha1sum, sha224sum,
sha256sum, sha384sum and sha512sum when available, otherwise the
Emacs function `secure-hash' is used but it is slow and may crash
Emacs and even the whole system as it eats all memory."
(cl-assert (file-regular-p file)
nil "`%s' is not a regular file" file)
(let* ((algo (intern (helm-comp-read
"Algorithm: "
'(md5 sha1 sha224 sha256 sha384 sha512))))
(cmd (concat (symbol-name algo) "sum"))
(bn (helm-basename file))
proc)
(message "Calculating %s checksum for %s..." algo bn)
(if (executable-find cmd)
(progn
(set-process-filter
(setq proc (start-file-process cmd nil cmd "-b" file))
(lambda (_process output)
(when output (kill-new output))))
(set-process-sentinel
proc
`(lambda (_process event)
(when (string= event "finished\n")
(message "Calculating %s checksum for `%s' done and copied to kill-ring"
,(symbol-name algo) ,bn)))))
(async-let ((sum (with-temp-buffer
(insert-file-contents-literally file)
(secure-hash algo (current-buffer)))))
(kill-new sum)
(message "Calculating %s checksum for `%s' done and copied to kill-ring"
algo bn)))))
(defun helm-ff-toggle-basename ()
(with-helm-buffer
(setq helm-ff-transformer-show-only-basename
(not helm-ff-transformer-show-only-basename))
(let* ((cand (helm-get-selection))
(target (if helm-ff-transformer-show-only-basename
(helm-basename cand) cand)))
(helm-force-update
(format helm-ff-last-expanded-candidate-regexp
(regexp-quote target))))))
(defun helm-ff-run-toggle-basename ()
(interactive)
(with-helm-alive-p
(unless (helm-empty-source-p)
(helm-ff-toggle-basename))))
(put 'helm-ff-run-toggle-basename 'helm-only t)
(defun helm-ff-mark-similar-files-1 ()
"Mark similar files.
Files are considered similar if they have the same face and same
extension."
(with-helm-window
(let* ((src (helm-get-current-source))
(file (helm-get-selection nil 'withprop src))
(face (get-text-property (min 2 (length file)) 'face file))
(ext (file-name-extension file)))
(helm-map-candidates-in-source src
(lambda (_cand) (helm-make-visible-mark))
(lambda (cand)
(and (not (helm-this-visible-mark))
(eq (get-text-property (min 2 (length cand)) 'face cand) face)
(equal ext (file-name-extension cand)))))
(helm-mark-current-line)
(helm-display-mode-line src t)
(when helm-marked-candidates
(message "%s candidates marked" (length helm-marked-candidates))
(set-window-margins (selected-window) 1)))))
(defun helm-ff-mark-similar-files ()
"Mark all files similar to selection."
(interactive)
(with-helm-alive-p
(let ((marked (helm-marked-candidates)))
(if (and (>= (length marked) 1)
(with-helm-window helm-visible-mark-overlays))
(helm-unmark-all)
(helm-ff-mark-similar-files-1)))))
(put 'helm-ff-mark-similar-files 'helm-only t)
(defun helm-reduce-file-name-1 (fname level)
;; This is the old version of helm-reduce-file-name, we still use it
;; with ftp fnames as expand-file-name is not working as expected
;; with ftp fnames (emacs bug).
(cl-loop with result
with iter = (helm-iter-reduce-fname (expand-file-name fname))
repeat level do (setq result (helm-iter-next iter))
finally return (or result (expand-file-name "/"))))
(defun helm-reduce-file-name-2 (fname level)
;; This version comes from Bug#2004 (UNC paths) and should fix
;; it. It works with local files and remote files as well but not
;; with ftp, see helm-reduce-file-name-1.
(while (> level 0)
(unless (or (string= fname "/")
(string= (file-remote-p fname 'localname) "/"))
(setq fname (expand-file-name
(concat (expand-file-name fname) "/../"))))
(setq level (1- level)))
fname)
(defun helm-reduce-file-name (fname level)
"Reduce FNAME by number LEVEL from end."
(if (helm-aand (file-remote-p fname 'method)
(string= it "ftp"))
(helm-reduce-file-name-1 fname level)
(helm-reduce-file-name-2 fname level)))
(defun helm-iter-reduce-fname (fname)
"Yield FNAME reduced by one level at each call."
(let ((split (split-string fname "/" t)))
(unless (or (null split)
(string-match "\\`\\(~\\|[[:alpha:]]:\\)" (car split)))
(setq split (cons "/" split)))
(lambda ()
(when (and split (cdr split))
(cl-loop for i in (setq split (butlast split))
concat (if (string= i "/") i (concat i "/")))))))
(defvar helm-find-files--level-tree nil)
(defvar helm-find-files--level-tree-iterator nil)
(defun helm-find-files-up-one-level (arg)
"Go up one level like unix command `cd ..'.
If prefix numeric arg is given go ARG level up."
(interactive "p")
(with-helm-alive-p
(helm-ff-after-persistent-show-all)
(let ((src (helm-get-current-source)))
(when (and (helm-file-completion-source-p src)
(not (helm-ff--invalid-tramp-name-p)))
(with-helm-window
(when (helm-follow-mode-p)
(helm-follow-mode -1) (message nil)))
;; When going up one level we want to be at the line
;; corresponding to actual directory, so store this info
;; in `helm-ff-last-expanded'.
(let ((cur-cand (helm-get-selection nil nil src))
(new-pattern (helm-reduce-file-name helm-pattern arg)))
;; Ensure visibility on all candidates for preselection.
(unless (helm-empty-source-p)
;; We may have an empty source in read-file-name when a
;; predicate is used e.g. images and the default is a non
;; file image.
(helm-set-attr 'candidate-number-limit
(if helm-ff-up-one-level-preselect
(max (gethash new-pattern
helm-ff--directory-files-length
helm-ff-candidate-number-limit)
helm-ff-candidate-number-limit)
helm-ff-candidate-number-limit)))
(cond ((file-directory-p helm-pattern)
(setq helm-ff-last-expanded helm-ff-default-directory))
((file-exists-p helm-pattern)
(setq helm-ff-last-expanded helm-pattern))
((and cur-cand (file-exists-p cur-cand))
(setq helm-ff-last-expanded cur-cand)))
(unless helm-find-files--level-tree
(setq helm-find-files--level-tree
(cons helm-ff-default-directory
helm-find-files--level-tree)))
(setq helm-find-files--level-tree-iterator nil)
(push new-pattern helm-find-files--level-tree)
(setq helm-ff--show-thumbnails
(member new-pattern helm-ff--thumbnailed-directories))
(helm-set-pattern new-pattern helm-suspend-update-flag)
(with-helm-after-update-hook (helm-ff-retrieve-last-expanded)))))))
(put 'helm-find-files-up-one-level 'helm-only t)
(defun helm-find-files-down-last-level ()
"Retrieve previous paths reached by `C-l' in helm-find-files."
(interactive)
(with-helm-alive-p
(when (and (helm-file-completion-source-p)
(not (helm-ff--invalid-tramp-name-p)))
(unless helm-find-files--level-tree-iterator
(setq helm-find-files--level-tree-iterator
(helm-iter-list (cdr helm-find-files--level-tree))))
(setq helm-find-files--level-tree nil)
(helm-aif (helm-iter-next helm-find-files--level-tree-iterator)
(progn
(setq helm-ff--show-thumbnails
(member it helm-ff--thumbnailed-directories))
(helm-set-pattern it))
(setq helm-find-files--level-tree-iterator nil)))))
(put 'helm-find-files-down-last-level 'helm-only t)
(defun helm-find-files--reset-level-tree ()
(setq helm-find-files--level-tree-iterator nil
helm-find-files--level-tree nil))
(add-hook 'helm-cleanup-hook 'helm-find-files--reset-level-tree)
(add-hook 'post-self-insert-hook 'helm-find-files--reset-level-tree)
(add-hook 'helm-after-persistent-action-hook 'helm-find-files--reset-level-tree)
(defun helm-ff-retrieve-last-expanded ()
"Move overlay to last visited directory `helm-ff-last-expanded'.
This happen after using `helm-find-files-up-one-level', or
hitting C-j on \"..\"."
(when helm-ff-last-expanded
(let ((presel (if helm-ff-transformer-show-only-basename
(helm-basename
(directory-file-name helm-ff-last-expanded))
(directory-file-name helm-ff-last-expanded))))
(with-helm-window
(when (re-search-forward
(format helm-ff-last-expanded-candidate-regexp
;; The space at eol may contain a display property
;; e.g. "-> symlink truename".
(concat (regexp-quote presel) " ?$"))
nil t)
(forward-line 0)
(helm-mark-current-line)))
(setq helm-ff-last-expanded nil))))
(defun helm-ff-undo ()
"Undo minibuffer in `helm-find-files'.
Ensure disabling `helm-ff-auto-update-flag' before undoing."
(interactive)
(let ((old--flag helm-ff-auto-update-flag))
(setq helm-ff-auto-update-flag nil)
(setq helm-ff--auto-update-state nil)
(unwind-protect
(progn
(undo)
(helm-check-minibuffer-input))
(setq helm-ff-auto-update-flag old--flag)
(setq helm-ff--auto-update-state helm-ff-auto-update-flag))))
(put 'helm-ff-undo 'helm-only t)
;;; Auto-update - helm-find-files auto expansion of directories.
;;
;;
(defun helm-ff-update-when-only-one-matched ()
"Expand to directory when sole completion.
When only one candidate is remaining and it is a directory,
expand to this directory.
This happen only when `helm-ff-auto-update-flag' is non-nil or
when `helm-pattern' is equal to \"~/\"."
(let ((src (helm-get-current-source)))
(when (and (helm-file-completion-source-p src)
(not (get-buffer-window helm-action-buffer 'visible))
(not (helm-ff--invalid-tramp-name-p))
(not (string-match-p "\\`[.]\\{2\\}[^/]+"
(helm-basename helm-pattern))))
(with-helm-buffer
(let* ((history-p (string= (assoc-default 'name src)
"Read File Name History"))
(pat (helm-ff-set-pattern helm-pattern))
;; Try to shut up persistent tramp error with adb method when
;; adding tilde to path.
(tramp-tolerate-tilde (equal (file-remote-p pat 'method)
tramp-adb-method))
(completed-p (helm-aand (expand-file-name
(substitute-in-file-name pat))
(string= (file-name-as-directory it)
helm-ff-default-directory)))
(candnum (helm-get-candidate-number))
(lt2-p (and (<= candnum 2)
(>= (string-width (helm-basename helm-pattern)) 2)))
(cur-cand (helm-get-selection nil nil src))
expand-to)
(when (and (or (and helm-ff-auto-update-flag
(null helm-ff--deleting-char-backward)
;; Bug#295
;; File predicates are returning t
;; with paths like //home/foo.
;; So check it is not the case by regexp
;; to allow user to do C-a / to start e.g
;; entering a tramp method e.g /sudo::.
(not (string-match "\\`//" helm-pattern))
(not (eq last-command 'helm-yank-text-at-point)))
;; Fix Bug#542.
(string= helm-pattern "~/")
;; Only one remaining directory, expand it.
(and (= candnum 1)
helm-ff--auto-update-state
(file-accessible-directory-p pat)
(null helm-ff--deleting-char-backward)))
(or
;; Only one candidate remaining
;; and at least 2 char in basename.
lt2-p
;; Already completed.
completed-p)
(not history-p) ; Don't try to auto complete in history.
(stringp cur-cand)
(file-accessible-directory-p cur-cand))
(if (and (not (helm-ff-dot-file-p cur-cand)) ; [1]
;; Maybe we are here because completed-p is true
;; but check this again to be sure. (Windows fix)
(<= candnum 2)) ; [2]
;; If after going to next line the candidate
;; is not one of "." or ".." [1]
;; and only one candidate is remaining [2],
;; assume candidate is a new directory to expand, and do it.
(progn
(setq expand-to (file-name-as-directory
(substring-no-properties cur-cand)))
(setq helm-ff--show-thumbnails
(member expand-to helm-ff--thumbnailed-directories))
(helm-set-pattern expand-to)
;; Reset flags to show all when changing dir.
(helm-ff-after-persistent-show-all))
;; The candidate is one of "." or ".."
;; that mean we have entered the last letter of the directory name
;; in prompt, so expansion is already done, just add the "/" at end
;; of name unless helm-pattern ends with "."
;; (i.e we are writing something starting with ".")
(unless (string-match "\\`.*[.]\\{1\\}\\'" helm-pattern)
;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt.
(setq expand-to (expand-file-name (file-name-as-directory helm-pattern)))
(setq helm-ff--show-thumbnails
(member expand-to helm-ff--thumbnailed-directories))
(helm-set-pattern expand-to)))
;; When typing pattern in minibuffer, helm
;; expand very fast to a directory matching pattern and
;; don't let undo the time to set a boundary, the result
;; is when e.g. going to root with "//" and undoing, undo
;; doesn't undo to previous input. One fix for this is to
;; advice `undo-auto--boundary-ensure-timer' so that it is
;; possible to modify its delay (use a value of 1s for
;; helm), a second fix is to run directly here `undo-boundary'
;; inside a timer.
(run-at-time helm-input-idle-delay nil #'undo-boundary)
(helm-check-minibuffer-input)))))))
(cl-defun helm-ff-auto-expand-to-home-or-root (&optional (pattern helm-pattern spattern))
"Allow expanding to $HOME or \"/\" or text yanked after pattern.
Argument PATTERN default to `helm-pattern' and should _not_ be used for
other purpose than debugging the second cond clause of this function.
When PATTERN is specified, specific helm functions are not called to
avoid errors when called outside helm for debugging purpose."
(when (or spattern
(and (helm-file-completion-source-p)
(with-current-buffer (window-buffer (minibuffer-window)) (eolp))
(not (string-match helm-ff-url-regexp pattern))))
(cond ((and (not (file-remote-p pattern))
(null (file-exists-p pattern))
(string-match-p
"\\`\\([.]\\)\\{2\\}[^/]+"
(helm-basename pattern))
(string-match-p "/\\'" pattern)
(null spattern))
(helm-ff-recursive-dirs pattern)
(helm-ff--maybe-set-pattern-and-update))
((string-match
"\\(?:\\`~/\\)\\|/?\\$.*/\\|/\\./\\|/\\.\\./\\|/~.*/\\|//\\|\\(/[[:alpha:]]:/\\)"
pattern)
(let* ((match (match-string 0 pattern))
(input (cond ((string= match "/./")
(expand-file-name default-directory))
((string= pattern "/../") "/")
((string-match-p "\\`/\\$" match)
(let ((sub (substitute-in-file-name match)))
(if (file-directory-p sub)
sub (replace-regexp-in-string "/\\'" "" sub))))
(t (helm-ff--expand-substitued-pattern pattern)))))
;; `file-directory-p' returns t on "/home/me/." (Bug#1844).
(if (and (file-directory-p input)
(not (string-match-p "[^.]\\.\\'" input)))
(progn
(setq helm-ff-default-directory
(setq input (file-name-as-directory input)))
;; When changing directory ensure to show all.
(helm-ff-after-persistent-show-all))
(setq helm-ff-default-directory (file-name-as-directory
(file-name-directory input))))
(if spattern input (helm-ff--maybe-set-pattern-and-update input))))
((and (string-match "\\`/\\(-\\):.*" pattern) (null spattern))
(helm-ff--maybe-set-pattern-and-update
(replace-match tramp-default-method t t pattern 1))))))
(defun helm-ff--maybe-set-pattern-and-update (&optional str)
(with-helm-window
(when str (helm-set-pattern str))
(helm-check-minibuffer-input)))
(defun helm-ff--expand-file-name-no-dot (name &optional directory)
"Prevent expanding \"/home/user/.\" to \"/home/user\"."
;; Bug#1844 - If user enter "~/." to type an hidden filename
;; don't expand to /home/him e.g.
;; (expand-file-name "~/.") =>"/home/thierry"
;; (helm-ff--expand-substitued-pattern "~/.") =>"/home/thierry/."
(concat (expand-file-name name directory)
(and (string-match "[^.]\\.\\'" name) "/.")))
(defun helm-ff--expand-substitued-pattern (pattern)
;; [Windows] On UNC paths "/" expand to current machine,
;; so use the root of current Drive. (i.e "C:/")
(let* ((directory (and (memq system-type '(windows-nt ms-dos))
(getenv "SystemDrive")))
(subst (helm-substitute-in-filename pattern))
;; On Windows use a simple call to `expand-file-name' to
;; avoid Bug#2004.
(expand-fn (if directory
#'expand-file-name
#'helm-ff--expand-file-name-no-dot)))
;; Fix Bug#2223 with tilde in directory names e.g. "~/tmp/~test/".
(funcall expand-fn (if (string-match-p "\\`~[^/]" subst)
pattern subst)
;; directory is nil on Nix.
directory)))
(defun helm-substitute-in-filename (fname)
"Substitute all parts of FNAME from start up to \"~/\" or \"/\".
On windows system substitute from start up to \"/[[:lower:]]:/\".
This function is needed for `helm-ff-auto-expand-to-home-or-root'
and should be used carefully elsewhere, or not at all, using
`substitute-in-file-name' instead."
(cond ((and helm--url-regexp
(string-match-p helm--url-regexp fname))
fname)
((and (file-remote-p fname)
helm-substitute-in-filename-stay-on-remote)
(let ((sub (substitute-in-file-name fname)))
(if (file-directory-p sub)
sub (replace-regexp-in-string "/\\'" "" sub))))
(t
(with-temp-buffer
(insert fname)
(goto-char (point-min))
(when (memq system-type '(windows-nt ms-dos))
(skip-chars-forward "/")) ;; Avoid infloop in UNC paths Bug#424
(if (re-search-forward "~.*/?\\|//\\|/[[:alpha:]]:/" nil t)
(let ((match (match-string 0)))
(goto-char (if (or (string= match "//")
(string-match-p "/[[:alpha:]]:/" match))
(1+ (match-beginning 0))
(match-beginning 0)))
(buffer-substring-no-properties (point) (pos-eol)))
fname)))))
(defun helm-point-file-in-dired (file)
"Put point on filename FILE in dired buffer."
(unless (and helm--url-regexp
(string-match-p helm--url-regexp file))
(let ((target (expand-file-name (helm-substitute-in-filename file))))
(dired (file-name-directory target))
(dired-goto-file target))))
(defun helm-marked-files-in-dired (_candidate)
"Open a dired buffer with only marked files.
With a prefix arg toggle dired buffer to wdired mode.
Note: This function works only in Emacs-29+ because Wdired doesn't support
editing absolute fnames in previous Emacs versions."
(let* ((marked (helm-marked-candidates :with-wildcard t))
(current (car marked)))
(unless (and helm--url-regexp
(string-match-p helm--url-regexp current))
(let ((target (expand-file-name (helm-substitute-in-filename current))))
(dired (cons helm-ff-default-directory marked))
(dired-goto-file target)
(when (or helm-current-prefix-arg current-prefix-arg)
(call-interactively 'wdired-change-to-wdired-mode))))))
(defun helm-ff-wfnames (_candidate)
"Edit marked fnames with `Wfnames' package."
(cl-assert (require 'wfnames nil t) nil "Wfnames package not found")
(let ((marked (helm-marked-candidates :with-wildcard t)))
(wfnames-setup-buffer
marked #'switch-to-buffer (buffer-live-p (get-buffer wfnames-buffer)))))
(defun helm-ff-edit-marked-files (candidate)
"Edit marked files with `helm-ff-edit-marked-files-fn' fn."
(funcall helm-ff-edit-marked-files-fn candidate))
(helm-make-command-from-action helm-ff-run-edit-marked-files
"Execute `helm-ff-edit-marked-files' interactively."
'helm-ff-edit-marked-files)
(defun helm-ff--create-tramp-name (fname)
"Build filename from `helm-pattern' like /su:: or /sudo::."
;; `tramp-make-tramp-file-name' takes 7 args on emacs-26 whereas it
;; takes only 5 args in emacs-24/25.
(apply #'tramp-make-tramp-file-name
;; `tramp-dissect-file-name' returns a list in emacs-26
;; whereas in 24.5 it returns a vector, thus the car is a
;; symbol (`tramp-file-name') which is not needed as argument
;; for `tramp-make-tramp-file-name' so transform the cdr in
;; vector, and for 24.5 use directly the returned value.
(cl-loop with v = (helm-ff--tramp-cons-or-vector
(tramp-dissect-file-name fname))
for i across v collect i)))
(defun helm-ff--tramp-cons-or-vector (vector-or-cons)
"Return VECTOR-OR-CONS as a vector."
(helm-acase vector-or-cons
((guard* (and (consp it) (cdr it))) (vconcat guard))
((guard* (vectorp it)) it)
(t (error "Wrong type argument: %s" it))))
(defun helm-ff--get-tramp-methods ()
"Return a list of the car of `tramp-methods'."
(or helm-ff--tramp-methods
(setq helm-ff--tramp-methods (mapcar 'car tramp-methods))))
(defun helm-ff--previous-mh-tramp-method (str)
(save-match-data
(with-temp-buffer
(insert str)
(when (re-search-backward
(concat "\\([|]\\)\\("
(mapconcat 'identity (helm-ff--get-tramp-methods) "\\|")
"\\):")
nil t)
(list
(buffer-substring-no-properties (pos-bol) (match-beginning 2))
(buffer-substring-no-properties (match-beginning 2) (match-end 2)))))))
(defun helm-ff--get-host-from-tramp-invalid-fname (fname)
"Extract hostname from an incomplete tramp file name.
Return nil on valid file name remote or not."
;; Check first if whole file is remote (file-remote-p is inefficient
;; in this case) otherwise we are matching e.g. /home/you/ssh:foo/
;; which is not a remote name.
;; FIXME this will not work with a directory or a file named like
;; "ssh:foo" and located at root (/) but it seems there is no real
;; solution apart disabling tramp-mode when a file/dir located at /
;; is matching helm-tramp-file-name-regexp; This would prevent usage
;; of tramp if one have such a directory at / (who would want to
;; have such a dir at / ???) See emacs-bug#31489.
(when (string-match-p helm-tramp-file-name-regexp fname)
(let* ((bn (helm-basename fname))
(bd (replace-regexp-in-string (regexp-quote bn) "" fname))
(split (split-string bn ":" t))
(meth (car (member (car split)
(helm-ff--get-tramp-methods)))))
(and meth (string= bd "/") (car (last split))))))
(cl-defun helm-ff--tramp-hostnames (&optional (pattern helm-pattern))
"Get a list of hosts for tramp method found in `helm-pattern'.
Argument PATTERN default to `helm-pattern'. It is here only for
debugging purpose."
(when (string-match helm-tramp-file-name-regexp pattern)
(let* ((mh-method (helm-ff--previous-mh-tramp-method pattern))
(method (or (cadr mh-method) (match-string 1 pattern))))
(cl-loop with all-methods = (helm-ff--get-tramp-methods)
for (f . h) in (tramp-get-completion-function method)
append (cl-loop for e in (funcall f (car h))
for host = (and (consp e) (cadr e))
;; On emacs-27 host may be
;; ("root" t) in sudo method.
when (and (stringp host)
(not (member host all-methods)))
collect (helm-ff-filter-candidate-one-by-one
(concat (or (car mh-method) "/")
method ":" host)))
into comps
finally return
(helm-fast-remove-dups comps :test 'equal)))))
(defun helm-ff-before-action-hook-fn ()
"Exit Helm when user try to execute action on an invalid tramp fname."
(let* ((src (helm-get-current-source))
(cand (helm-get-selection nil nil src)))
(when (and (helm-file-completion-source-p src)
(stringp cand)
(helm-ff--invalid-tramp-name-p cand) ; Check candidate.
(helm-ff--invalid-tramp-name-p)) ; check helm-pattern.
(error "Error: Unknown file or directory `%s'" cand))))
(add-hook 'helm-before-action-hook 'helm-ff-before-action-hook-fn)
(cl-defun helm-ff--invalid-tramp-name-p (&optional (pattern helm-pattern))
"Return non-nil when PATTERN is an invalid tramp filename."
(or (string= (helm-ff-set-pattern pattern)
"@@TRAMP@@")
;; Tramp methods completion.
(string-match helm-ff-tramp-method-regexp pattern)))
(defun helm-ff--tramp-multihops-p (name)
(cl-loop for m in (helm-ff--get-tramp-methods)
thereis (string-match (format "\\`\\(/%s:.*[|]\\).*" m) name)))
(defun helm-ff-complete-tramp-methods ()
"Completion on tramp methods in a nested helm session."
(interactive)
(with-helm-alive-p
(let* (initial-input
(str helm-pattern)
(pattern (with-temp-buffer
(insert str)
(let ((end (point)) beg)
(when (re-search-backward "[/|]" nil t)
(setq beg (1+ (point)))
(unless (= beg end)
(setq initial-input
(buffer-substring beg end))
(delete-region beg end))
(buffer-string)))))
(collection (helm-ff--get-tramp-methods))
(method (helm-comp-read
"Tramp methods: "
(sort collection #'string<)
:initial-input initial-input
:fc-transformer
(lambda (candidates _source)
(cl-loop for c in candidates
collect (propertize c 'face 'helm-ff-file)))
:allow-nest t
:must-match t)))
(helm-set-pattern (concat pattern method ":")))))
(put 'helm-ff-complete-tramp-methods 'no-helm-mx t)
(defun helm-ff-set-pattern (pattern)
"Handle tramp filenames in `helm-pattern'."
(let* ((methods (helm-ff--get-tramp-methods))
;; Returns the position of last ":" entered.
(postfixed (file-remote-p pattern))
(reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
cur-method tramp-name)
(when (string-match "\\`/\\(-\\):" pattern)
(setq pattern (replace-match tramp-default-method t t pattern 1)))
;; In some rare cases tramp can return a nil input,
;; so be sure pattern is a string for safety (Bug#476).
(unless pattern (setq pattern ""))
(cond ((string-match helm-ff-url-regexp pattern) pattern)
((string-match "\\`\\$" pattern)
(substitute-in-file-name pattern))
((string= pattern "") "")
((string-match "\\`[.]\\{1,2\\}/\\'" pattern)
(expand-file-name pattern))
;; Directories ending by a dot (Bug#1940)
((string-match "[^/][.]/\\'" pattern)
(expand-file-name pattern))
((string-match ".*\\(~?/?[.]\\{1\\}/\\)\\'" pattern)
(expand-file-name default-directory))
((string-match ".*\\(~//\\|//\\)\\'" pattern)
(expand-file-name "/")) ; Expand to "/" or "c:/"
((string-match "\\`\\(~/\\|.*/~/\\)\\'" pattern)
(expand-file-name "~/"))
((string-match "\\`~/" pattern)
(expand-file-name pattern))
((string-match helm-ff-tramp-method-regexp pattern)
pattern)
;; Match "/method:maybe_hostname:~"
((and (string-match (concat reg "~") pattern)
postfixed
(setq cur-method (match-string 1 pattern))
(member cur-method methods))
(setq tramp-name (expand-file-name
(helm-ff--create-tramp-name
(match-string 0 pattern))))
(replace-match tramp-name nil t pattern))
;; Match "/method:maybe_hostname:"
((and (string-match reg pattern)
postfixed
(setq cur-method (match-string 1 pattern))
(member cur-method methods))
(setq tramp-name (helm-ff--create-tramp-name
(match-string 0 pattern)))
(replace-match tramp-name nil t pattern))
;; Match "/hostname:"
((and (string-match helm-tramp-file-name-regexp pattern)
postfixed
(setq cur-method (match-string 1 pattern))
(and cur-method (not (member cur-method methods))))
(setq tramp-name (helm-ff--create-tramp-name
(match-string 0 pattern)))
(replace-match tramp-name nil t pattern))
;; Match "/method:" in this case don't try to connect.
((and (null postfixed)
(string-match helm-tramp-file-name-regexp pattern)
(member (match-string 1 pattern) methods))
;; A flag to notify tramp name is incomplete.
"@@TRAMP@@")
;; Return PATTERN unchanged.
(t pattern))))
(defun helm-find-files-get-candidates ()
"Create candidate list for `helm-source-find-files'."
(let* ((path (helm-ff-set-pattern helm-pattern))
(dir-p (file-accessible-directory-p path))
basedir
invalid-basedir
non-essential
(tramp-verbose helm-tramp-verbose)) ; No tramp message when 0.
;; Tramp check if path is valid without waiting a valid
;; connection and may send a file-error.
(setq helm--ignore-errors (file-remote-p path))
(set-text-properties 0 (length path) nil path)
;; Bug#118 allow creation of newdir+newfile.
(unless (or
;; A tramp file name not completed.
(string= path "@@TRAMP@@")
;; An empty pattern
(string= path "")
(file-remote-p path)
;; Check if base directory of PATH is valid.
(helm-aif (file-name-directory path)
;; If PATH is a valid directory IT=PATH,
;; else IT=basedir of PATH.
(file-directory-p it)))
;; BASEDIR is invalid, that's mean user is starting
;; to write a non--existing path in minibuffer
;; probably to create a 'new_dir' or a 'new_dir+new_file'.
(setq invalid-basedir t))
;; Don't set now `helm-pattern' if `path' == "@@TRAMP@@"
;; like that the actual value (e.g /ssh:) is passed to
;; `helm-ff--tramp-hostnames'.
(unless (or (string= path "@@TRAMP@@")
invalid-basedir) ; Leave helm-pattern unchanged.
(setq helm-ff-auto-update-flag ; [1]
;; Unless auto update is disabled start auto updating only
;; at third char.
(unless (or (null helm-ff--auto-update-state)
;; But don't enable auto update when
;; deleting backward.
helm-ff--deleting-char-backward
(and dir-p (not (string-match-p "/\\'" path))))
(or (>= (length (helm-basename path)) 3) dir-p)))
;; At this point the tramp connection is triggered.
(helm-log
"helm-find-files-get-candidates"
"Pattern=%S"
(setq helm-pattern (if (string-match helm-ff-tramp-method-regexp path)
;; A tramp method, don't modify pattern.
helm-pattern
(helm-ff--transform-pattern-for-completion path))))
;; This have to be set after [1] to allow deleting char backward.
(setq basedir (or (helm-aand
(if (and dir-p helm-ff-auto-update-flag)
;; Add the final "/" to path
;; when `helm-ff-auto-update-flag' is enabled.
(file-name-as-directory path)
(if (string= path "")
"/" (file-name-directory path)))
(expand-file-name it))
default-directory))
(setq helm-ff-default-directory
(if (string= helm-pattern "")
(expand-file-name "/") ; Expand to "/" or "c:/"
;; If path is an url *default-directory have to be nil.
(unless (or (string-match helm-ff-url-regexp path)
(and helm--url-regexp
(string-match helm--url-regexp path)))
basedir))))
(when (and (string-match ":\\'" path)
(file-remote-p basedir nil t))
(setq helm-pattern basedir))
(cond (invalid-basedir nil)
((string-match helm-ff-tramp-method-regexp path) ; Tramp methods
(mapcar (lambda (method)
(helm-ff-filter-candidate-one-by-one
(concat "/" ":" method)))
(helm-ff--get-tramp-methods)))
((string= path "@@TRAMP@@")
(helm-ff--tramp-hostnames)) ; Hostnames completion.
((or (and (file-regular-p path)
(eq last-repeatable-command 'helm-execute-persistent-action))
;; `ffap-url-regexp' don't match until url is complete.
(string-match helm-ff-url-regexp path)
(and helm--url-regexp (string-match helm--url-regexp path)))
;; Do NOT filter boring files here (Bug#2330).
(list (helm-ff-filter-candidate-one-by-one path nil t)))
((string= path "") (helm-ff-directory-files "/"))
;; Check here if directory is accessible (not working on Windows).
((and (file-directory-p path) (not (file-readable-p path)))
;; Prefix error message with @@@@ for safety
;; (some files may match file-error See bug#2400)
(list (cons (format "@@@@file-error: Opening directory permission denied `%s'" path)
path)))
;; A fast expansion of PATH is made only if `helm-ff-auto-update-flag'
;; is enabled.
((and dir-p helm-ff-auto-update-flag)
(helm-ff-directory-files path))
(t (helm-ff-directory-files basedir)))))
(defun helm-list-directory (directory &optional sel)
"List directory DIRECTORY.
If DIRECTORY is remote use `helm-list-remote-directory-fn',
otherwise use `directory-files'.
SEL argument is only here for debugging purpose, it default to
`helm-get-selection'."
(let* ((remote (file-remote-p directory 'method))
(helm-list-remote-directory-fn
(helm-acase remote
("ftp" #'helm-list-dir-lisp)
("adb" #'helm-list-dir-adb)
(t helm-list-remote-directory-fn)))
(use-ext-remote-fn
(and remote
(eq helm-list-remote-directory-fn 'helm-list-dir-external)))
(sort-method (helm-acase helm-ff-initial-sort-method
(newest (if use-ext-remote-fn
"-t" #'file-newer-than-file-p))
(size (if use-ext-remote-fn
"-S" #'helm-ff-file-larger-that-file-p))
(ext (if use-ext-remote-fn
#'identity
#'helm-group-candidates-by)))))
(if remote
(ignore-errors
(funcall helm-list-remote-directory-fn directory sort-method))
(helm-acase helm-ff-initial-sort-method
((newest size)
(sort (helm-local-directory-files
directory t directory-files-no-dot-files-regexp)
sort-method))
(ext (funcall sort-method
(helm-local-directory-files
directory t directory-files-no-dot-files-regexp)
#'file-name-extension
(or sel (helm-get-selection) "")))
(t (helm-local-directory-files
directory t directory-files-no-dot-files-regexp))))))
(defsubst helm-ff-file-larger-that-file-p (f1 f2)
(let ((attr1 (file-attributes f1))
(attr2 (file-attributes f2)))
(> (nth 7 attr1) (nth 7 attr2))))
(defun helm-list-dir-lisp (directory &optional sort-method)
"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)
(or sort-method 'string-lessp))
unless (or (string= f "")
(member f '("./" "../" "." "..")))
if (and (helm--dir-name-p f)
(helm--dir-file-name f directory))
collect (propertize it 'helm-ff-dir t)
else collect (propertize (expand-file-name f directory)
'helm-ff-file t)))
(defun helm-file-name-all-completions-internal (directory)
(let ((switches "-1F"))
(with-temp-buffer
(insert-directory (format "%s*"
(file-name-as-directory directory))
switches t)
(split-string
(buffer-substring-no-properties (point-min) (point-max))
"\n" t))))
(defun helm-list-dir-adb (directory &optional sort-method)
"List DIRECTORY with `helm-file-name-all-completions-internal' as backend.
This is used for tramp adb backend.
Add a `helm-ff-dir' property on each fname ending with \"/\"."
(let ((inhibit-message t))
(cl-loop with files = (helm-file-name-all-completions-internal directory)
for f in (sort files (or sort-method 'string-lessp))
for split = (split-string f "->" t)
for fname = (replace-regexp-in-string " $" "" (car split))
for truename = (cadr split)
collect (cond ((string-match "/\\'" fname)
(propertize (helm--dir-file-name fname directory)
'helm-ff-dir t))
(truename
(propertize (expand-file-name
(substring fname 0 (1- (length fname)))
directory)
'helm-ff-sym truename))
(t (propertize (expand-file-name fname directory)
'helm-ff-file t))))))
(defun helm-list-dir-external (dir &optional sort-method)
"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 %s | awk -v dir=%s '{print dir $0}'"
(or sort-method "")
(shell-quote-argument 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"@
(helm-acase (match-string 0)
("*" (replace-match "")
(put-text-property
(pos-bol) (pos-eol) 'helm-ff-exe t))
("@" (replace-match "")
(put-text-property
(pos-bol) (pos-eol) 'helm-ff-sym t))
("/" (replace-match "")
(put-text-property
(pos-bol) (pos-eol) 'helm-ff-dir t))
(("=" "|" ">") (replace-match "")))))
(while (re-search-forward "[\"]" nil t)
(replace-match ""))
(add-text-properties (point-min) (point-max) '(helm-ff-file t))
(split-string (buffer-string) "\n" t)))))
;; This is to fix issue with file-notify.el no more following symlinks
;; on emacs-29 (regression) with inotify backend at least. Also it
;; seems inotify is not configured to follow symlinks on other systems
;; (MacOS) so this should fix as well this issue on such systems see
;; bug#2542.
;; Store here associations of (truename . symlink) when opening a
;; symlinked directory, then add the watch to the truename; When the
;; watcher ring on the truename remove the symlinked directory from cache.
(defvar helm-ff--list-directory-links nil)
(defun helm-ff-directory-files (directory &optional force-update)
"List contents of DIRECTORY.
Argument FULL mean absolute path.
It is same as `directory-files' but always returns the dotted
filename \\='.' and \\='..' even on root directories in Windows
systems.
When FORCE-UPDATE is non nil recompute candidates even if DIRECTORY is
in cache."
(let* ((method (file-remote-p directory 'method))
(dfn (directory-file-name directory))
(truename (and (file-symlink-p dfn) (file-truename dfn))))
(setq directory (file-name-as-directory
(expand-file-name directory)))
(when truename
(cl-pushnew (cons truename directory)
helm-ff--list-directory-links :test 'equal))
(or (and (not force-update)
(not (member method helm-ff-inotify-unsupported-methods))
(gethash directory helm-ff--list-directory-cache))
(let* (file-error
(ls (condition-case err
(helm-list-directory directory)
;; Handle file-error from here for Windows
;; because predicates like `file-readable-p' and friends
;; seem broken on emacs for Windows systems (always returns t).
;; This should never be called on GNU/Linux/Unix
;; as the error is properly intercepted in
;; `helm-find-files-get-candidates' by `file-readable-p'.
(file-error
(prog1
;; Prefix error message with @@@@ for safety
;; (some files may match file-error See bug#2400)
(list (format "@@@@%s:%s"
(car err)
(mapconcat 'identity (cdr err) " ")))
(setq file-error t)))))
(dot (concat directory "."))
(dot2 (concat directory ".."))
(candidates (append (and (not file-error) (list dot dot2)) ls))
watcher)
(puthash directory (+ (length ls) 2) helm-ff--directory-files-length)
(prog1
(puthash directory
(cl-loop for f in candidates
when (helm-ff-filter-candidate-one-by-one f)
collect it)
helm-ff--list-directory-cache)
;; Put an inotify watcher to check directory modifications.
(unless (or (null helm-ff-use-notify)
(member method helm-ff-inotify-unsupported-methods)
(helm-aand (setq watcher (gethash
directory
helm-ff--file-notify-watchers))
;; [1] If watcher is invalid enter
;; next and delete it.
(file-notify-valid-p it)))
(condition-case-unless-debug err
(let ((to-watch (or truename directory)))
(when watcher
;; If watcher is still in cache and we are here,
;; that's mean test [1] above fails and watcher
;; is invalid, so delete it.
(file-notify-rm-watch watcher)
(remhash directory helm-ff--file-notify-watchers))
;; Keep adding DIRECTORY to
;; helm-ff--file-notify-watchers but watch on the
;; truename and not the symlink as before bug#2542.
(puthash directory
(file-notify-add-watch
to-watch
'(change attribute-change)
(helm-ff--inotify-make-callback to-watch))
helm-ff--file-notify-watchers))
(file-notify-error (user-error "Error: %S %S" (car err) (cdr err))))))))))
(defun helm-ff--inotify-make-callback (directory)
"Return a callback for `file-notify-add-watch'."
(lambda (event)
(let ((desc (cadr event))
(target directory)) ; Either truename or directory.
(helm-log "Inotify callback" "Event %S called on %S" event directory)
;; `attribute-changed' means permissions have changed, not
;; file modifications like file changes, visit
;; etc... AFAIU the desc for this is `changed' and for our
;; use case we don't care of this. Elemnts of
;; `helm-ff--list-directory-links' are of the form
;; (truename . visited-symlink-directory)
(when (memq desc '(created deleted renamed attribute-changed))
;; Watched directory is the truename which is not in the
;; cache, so remove its associated directory (the symlink)
;; from the cache bug#2542.
(helm-aif (assoc directory helm-ff--list-directory-links)
(progn
(setq target (cdr it))
(setq helm-ff--list-directory-links
(delete it helm-ff--list-directory-links))))
;; When TARGET is modified remove it from cache.
(helm-log "Inotify callback"
"Removing %S from `helm-ff--list-directory-cache'" target)
(remhash target helm-ff--list-directory-cache)))))
(defun helm-ff-tramp-cleanup-hook (vec)
"Remove remote directories related to VEC in helm-ff* caches.
Remove as well all related file-notify watchers.
This is meant to run in `tramp-cleanup-connection-hook'."
(cl-loop for key being the hash-keys in helm-ff--list-directory-cache
when (equal (file-remote-p key 'method) (cadr vec))
do (remhash key helm-ff--list-directory-cache))
(cl-loop for key being the hash-keys in helm-ff--file-notify-watchers
when (equal (file-remote-p key 'method) (cadr vec))
do (progn
(file-notify-rm-watch
(gethash key helm-ff--file-notify-watchers))
(remhash key helm-ff--file-notify-watchers))))
(add-hook 'tramp-cleanup-connection-hook #'helm-ff-tramp-cleanup-hook)
(defun helm-ff-handle-backslash (fname)
;; Allow creation of filenames containing a backslash.
(cl-loop with bad = '((92 . ""))
for i across fname
if (assq i bad) concat (cdr it)
else concat (string i)))
(defun helm-ff-fuzzy-matching-p ()
(and helm-ff-fuzzy-matching
(not (memq helm-mm-matching-method '(multi1 multi3p)))))
(defun helm-ff--transform-pattern-for-completion (pattern)
"Maybe return PATTERN with it's basename modified as a regexp.
This happens only when `helm-ff-fuzzy-matching' is enabled.
This provides a similar behavior as `ido-enable-flex-matching'.
See also `helm--mapconcat-pattern'.
If PATTERN is an url return it unmodified.
When PATTERN contains a space fallback to multi-match.
If basename contains one or more space fallback to multi-match.
If PATTERN is a valid directory name, return PATTERN unchanged."
;; handle bad filenames containing a backslash (no more needed in
;; emacs-26, also prevent regexp matching with e.g. "\|").
;; (setq pattern (helm-ff-handle-backslash pattern))
(let ((bn (helm-basename pattern))
(bd (or (helm-basedir pattern) ""))
;; Trigger tramp connection with file-directory-p.
(dir-p (file-directory-p pattern))
(tramp-p (cl-loop for (m . f) in tramp-methods
thereis (string-match m pattern))))
;; Always regexp-quote base directory name to handle
;; crap dirnames such e.g bookmark+
(cond
((or (and dir-p tramp-p (string-match ":\\'" pattern))
(string= pattern "")
(and dir-p (<= (length bn) 2))
;; Fix Bug#541 when BD have a subdir similar
;; to BN, don't switch to match plugin
;; which will match both.
(and dir-p (string-match (regexp-quote bn) bd)))
;; Use full PATTERN on e.g "/ssh:host:".
(regexp-quote pattern))
;; Prefixing BN with a space call multi-match completion.
;; This allow showing all files/dirs matching BN (Bug#518).
;; FIXME: some multi-match methods may not work here.
(dir-p (concat (regexp-quote bd) " " (regexp-quote bn)))
((or (not (helm-ff-fuzzy-matching-p))
(string-match "[ !]" bn)) ; Fall back to multi-match.
(concat (regexp-quote bd) " " bn))
((or (string-match "[*][.]?.*" bn) ; Allow entering wildcard.
(string-match "/\\'" pattern) ; Allow mkdir.
(string-match helm-ff-url-regexp pattern)
(and (string= helm-ff-default-directory "/") tramp-p))
;; Don't treat wildcards ("*") as regexp char.
;; (e.g ./foo/*.el => ./foo/\\*\\.el) or ./foo/*.[ch] =>
;; ./foo/\\*\\.\\[ch]
(concat (regexp-quote bd)
;; We were previously using
;; (replace-regexp-in-string "[*]" "[*]" bn) but this
;; doesn't handle wilcards like *.[ch], so regexp-quote
;; bn as well.
(regexp-quote bn)))
(t (concat (regexp-quote bd)
(if (>= (length bn) 2) ; wait 2nd char before concating.
(helm--mapconcat-pattern bn)
(concat ".*" (regexp-quote bn))))))))
(defalias 'helm-dir-is-dot 'helm-ff-dot-file-p)
(make-obsolete 'helm-dir-is-dot 'helm-ff-dot-file-p "3.8.8")
(defun helm-ff-save-history ()
"Store the last value of `helm-ff-default-directory' in `helm-ff-history'.
Note that only existing directories are saved here."
(when (and helm-ff-default-directory
(helm-file-completion-source-p)
(file-directory-p helm-ff-default-directory))
(set-text-properties 0 (length helm-ff-default-directory)
nil helm-ff-default-directory)
(push helm-ff-default-directory helm-ff-history)))
(add-hook 'helm-cleanup-hook 'helm-ff-save-history)
(defun helm-ff-valid-symlink-p (file &optional link)
"Returns the truename of FILE if it exists.
If we already know the truename of FILE we can pass it with LINK arg
to avoid an unnecessary call to `file-truename'."
(helm-aif (condition-case-unless-debug nil
;; `file-truename' send error
;; on cyclic symlinks (Bug#692).
(or link (file-truename file))
(error nil))
(and (file-exists-p it) it)))
(defun helm-get-default-mode-for-file (filename)
"Return the default mode to open FILENAME."
(let ((mode (cl-loop for (r . m) in auto-mode-alist
thereis (and (string-match r filename) m))))
(or (and (symbolp mode) mode) "Fundamental")))
(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'.
(helm-aif (helm-file-attributes candidate)
(let* ((dired-line (helm-file-attributes-dired-line it t t))
(type (cl-getf it :type))
(mode-type (cl-getf it :mode-type))
(owner (cl-getf it :uid))
(owner-right (cl-getf it :user t))
(group (cl-getf it :gid))
(group-right (cl-getf it :group))
(other-right (cl-getf it :other))
(octal (cl-getf it :octal))
(trash (and (helm-ff-trash-file-p candidate)
(helm-ff--get-dest-file-from-trash
(helm-ff-trash-list)
(replace-regexp-in-string
"\\.trashinfo\\'" "" candidate))))
(size (helm-file-human-size (cl-getf it :size)))
(modif (cl-getf it :modif-time))
(access (cl-getf it :access-time))
(ext (helm-get-default-program-for-file candidate))
(tooltip-hide-delay (or helm-tooltip-hide-delay tooltip-hide-delay))
(posn (with-helm-window
(posn-at-point (save-excursion (end-of-visual-line) (point)))))
(tooltip-frame-parameters (append tooltip-frame-parameters
`((left . ,(car (posn-x-y posn)))
(top . ,(cdr (posn-x-y posn)))))))
(if (and (display-graphic-p) 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))
(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 "NumMode: %s\n" octal)
(format "Size: %s\n" size)
(when (string= type "directory")
(format "Size used in directory: %s\n"
(helm-directory-size
candidate current-prefix-arg t)))
(format "Modified: %s\n" modif)
(format "Accessed: %s\n" access)
(and (stringp trash)
(format "Trash: %s\n"
(abbreviate-file-name trash)))))
(message dired-line) (sit-for 5)))
(message "Permission denied, file not readable")))
(helm-make-persistent-command-from-action helm-ff-properties-persistent
"Show properties without quitting helm."
'properties-action 'helm-ff-properties)
(helm-make-persistent-command-from-action helm-ff-persistent-delete
"Delete current candidate without quitting."
'quick-delete 'helm-ff-quick-delete)
(defun helm-ff-kill-default-directory (_candidate)
(with-helm-window
(kill-new helm-ff-default-directory)
(message "`%s' copied to kill-ring" helm-ff-default-directory)))
(helm-make-persistent-command-from-action helm-ff-run-kill-default-directory
"Kill `helm-ff-default-directory'."
'kill-default-directory
'helm-ff-kill-default-directory)
(defun helm-ff-dot-file-p (file)
"Check if FILE is `.' or `..'."
(member (helm-basename file) '("." "..")))
(defun helm-ff-kill-buffer-fname (candidate)
(let* ((buf (get-file-buffer candidate))
(buf-name (buffer-name buf)))
(cond ((and buf (eq buf (get-buffer helm-current-buffer)))
(user-error
"Can't kill `helm-current-buffer' without quitting session"))
(buf (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
(t (message "No buffer to kill")))))
(defun helm-ff-kill-or-find-buffer-fname (candidate)
"Find file CANDIDATE or kill its buffer if it is visible.
Never kill `helm-current-buffer'.
Never kill buffer modified.
This is called normally on third hit of \
\\\\[helm-execute-persistent-action]
in `helm-find-files-persistent-action-if'."
(let* ((buf (get-file-buffer candidate))
(buf-name (buffer-name buf))
(win (get-buffer-window buf))
(helm--reading-passwd-or-string t)
;; Prevent tramp from asking yes-or-no-p for
;; `tramp-allow-unsafe-temporary-files'.
auto-save-default)
(cond ((and buf win (eql buf (get-buffer helm-current-buffer)))
(user-error
"Can't kill `helm-current-buffer' without quitting session"))
((and buf win (buffer-modified-p buf))
(message "Can't kill modified buffer, please save it before"))
((and buf win)
(kill-buffer buf)
(if (and helm-persistent-action-display-window
(window-dedicated-p (next-window win 1)))
(delete-window helm-persistent-action-display-window)
(set-window-buffer win helm-current-buffer))
(message "Buffer `%s' killed" buf-name))
(t (find-file candidate)))))
(helm-make-persistent-command-from-action helm-ff-run-kill-buffer-persistent
"Execute `helm-ff-kill-buffer-fname' without quitting."
'kill-buffer-fname 'helm-ff-kill-buffer-fname)
;; 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))))
(helm-make-persistent-command-from-action helm-ff-run-preview-file-externally
"Run open file externally without quitting helm."
'open-file-externally 'helm-ff-persistent-open-file-externally)
(defun helm-ff-prefix-filename (disp fname &optional new-file)
"Return DISP maybe prefixed with a string or an icon.
Arg FNAME is the real filename whereas DISP is the display part of candidate.
Icons are used when `helm-ff-icon-mode' is enabled.
When NEW-FILE is non nil, returns a string prefixed with
[+] or [@] or a special icon, otherwise DISP is
returned prefixed with its icon or unchanged."
(let (prefix-new prefix-url)
(cond ((and new-file
(or (string-match helm-ff-url-regexp disp)
(and helm--url-regexp
(string-match helm--url-regexp disp))))
(setq prefix-url
(if helm-ff-icon-mode
(helm-acase (match-string 1 disp)
("mailto:"
(helm-x-icons-generic "mail"))
(t (helm-x-icons-generic "link-external")))
(propertize
" " 'display
(propertize "[@]" 'face 'helm-ff-prefix))))
(add-text-properties 0 1 '(helm-url t) prefix-url)
(concat prefix-url " " disp))
(new-file
(setq prefix-new
(if helm-ff-icon-mode
(if (string-match "/\\'" disp)
(helm-x-icons-generic "create_new_folder")
(helm-x-icons-generic "note_add"))
(propertize
" " 'display
(propertize "[+]" 'face 'helm-ff-prefix))))
(add-text-properties 0 1 '(helm-new-file t) prefix-new)
(concat prefix-new " " disp))
(t (concat (helm-ff-get-icon disp fname) disp)))))
(defun helm-ff-score-candidate-for-pattern (real disp pattern)
(cond ((member real '("." "..")) 900000)
((and (string-match-p "\\`\\s-\\{2\\}" disp)
(string= real (substring-no-properties disp 2)))
;; Incomplete filenames are prefixed with two spaces, the
;; first one beeing propertized with a 'display prop
;; i.e. "[+] foo".
900001)
(t (helm-score-candidate-for-pattern real pattern))))
(defun helm-ff-sort-candidates-1 (candidates input)
"Sort function for `helm-source-find-files'.
Return candidates prefixed with basename of INPUT first."
(if (or (and (file-directory-p input)
(string-match "/\\'" input))
(string-match "\\`\\$" input)
(null candidates))
candidates
(let* ((memo-src (make-hash-table :test 'equal))
(all (sort candidates
(lambda (s1 s2)
(let* ((score (lambda (disp real)
(helm-ff-score-candidate-for-pattern
disp real (helm-basename input))))
;; Reals
(r1 (helm-basename (if (consp s1) (cdr s1) s1)))
(r2 (helm-basename (if (consp s2) (cdr s2) s2)))
;; Displays
(d1 (helm-basename (if (consp s1) (car s1) s1)))
(d2 (helm-basename (if (consp s2) (car s2) s2)))
(sc1 (or (gethash r1 memo-src)
(puthash r1 (funcall score r1 d1) memo-src)))
(sc2 (or (gethash r2 memo-src)
(puthash r2 (funcall score r2 d2) memo-src))))
;; The score fn may return a string (happens with "/adb:").
(cond ((or (stringp sc1) (stringp sc2)))
((= sc1 sc2)
(< (string-width r1)
(string-width r2)))
((> sc1 sc2))))))))
all)))
(defun helm-ff-sort-candidates (candidates _source)
"Sort function for `helm-source-find-files'.
Return candidates prefixed with basename of `helm-input' first."
(helm-ff-sort-candidates-1 candidates helm-input))
(defun helm-ff-boring-file-p (file)
"Returns non nil when FILE is matching boring regexps."
;; Prevent user doing silly thing like
;; adding the dotted files to boring regexps (#924).
(and helm-ff-skip-boring-files
(not (string-match "\\.$" file))
(string-match helm-ff--boring-regexp file)))
(defvar helm-ff--git-found-p nil)
(defun helm-ff-git-ignored-p (file)
"Returns non nil when FILE is matched in \".gitignore\" file."
(and helm-ff-skip-git-ignored-files
(not (file-remote-p file))
(or helm-ff--git-found-p
(setq helm-ff--git-found-p (executable-find "git")))
(zerop (call-process "git" nil nil nil "check-ignore" "-q" file))))
(defun helm-ff-fct (candidates _source)
"Filter in charge of displaying basename or full path in HFF.
Because CANDIDATES are directly stored as (basename . full_path), when
`helm-ff-transformer-show-only-basename' is non nil do nothing and
return directly CANDIDATES."
(if (null helm-ff-transformer-show-only-basename)
(cl-loop for (_disp . real) in candidates
for fc = (helm-ff-filter-candidate-one-by-one real 'reverse)
when fc collect fc)
candidates))
(defun helm-ff-filter-candidate-one-by-one (file &optional reverse skip-boring-check)
"Transform file in a cons cell like (DISPLAY . REAL).
DISPLAY is shown as basename of FILE and REAL as full path of FILE.
If REVERSE is non nil DISPLAY is shown as full path.
If SKIP-BORING-CHECK is non nil don't filter boring files."
(let* ((basename (helm-basename file))
(dot (helm-ff-dot-file-p file))
(urlp (string-match-p helm-ff-url-regexp file))
(tramp-invalid-fname (helm-ff--get-host-from-tramp-invalid-fname file))
(disp (or tramp-invalid-fname
;; Filename with cntrl chars e.g. foo^J
(replace-regexp-in-string
"[[:cntrl:]]" "?"
(if (or reverse urlp (and dot helm-ff-show-dot-file-path))
file basename))))
(len (length disp))
(backup (backup-file-name-p disp)))
(when (string-match "/\\'" file)
(setq disp (concat disp "/")
len (1+ len)))
;; We want to filter boring files only on the files coming
;; from the output of helm-ff-directory-files not on single
;; candidate (Bug#2330).
(unless (and (not skip-boring-check)
(or (helm-ff-boring-file-p basename)
(helm-ff-git-ignored-p file)))
;; Highlight extensions.
(helm-aif (and (not backup)
(not urlp)
(helm-file-name-extension disp))
(when (condition-case _err
(string-match (format "\\.\\(%s\\)\\'" it) disp)
(invalid-regexp nil))
(add-face-text-property
(match-beginning 1) (match-end 1)
'helm-ff-file-extension t disp)))
;; 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-acond (;; Dot directories . and ..
dot
(cons (helm-ff-prefix-filename
(propertize disp 'face 'helm-ff-dotted-directory)
file)
file))
;; Directories.
((get-text-property 1 'helm-ff-dir file)
(cons (helm-ff-prefix-filename
(propertize disp 'face 'helm-ff-directory)
file)
file))
;; Backup files.
(backup
(cons (helm-ff-prefix-filename
(propertize disp 'face 'helm-ff-backup-file)
file)
file))
;; Executable files.
((get-text-property 1 'helm-ff-exe file)
(add-face-text-property 0 len 'helm-ff-executable t disp)
(cons (helm-ff-prefix-filename disp file) file))
;; Symlinks.
((get-text-property 1 'helm-ff-sym file)
(add-face-text-property 0 len 'helm-ff-symlink t disp)
(if (stringp it) ; adb method.
(progn
(add-face-text-property 0 (length it) 'helm-ff-truename nil it)
(cons (propertize disp 'display (concat disp " ->" it)) file))
(cons (helm-ff-prefix-filename disp file) file)))
;; Regular files.
((get-text-property 1 'helm-ff-file file)
(add-face-text-property 0 len 'helm-ff-file t disp)
(cons (helm-ff-prefix-filename disp file) file))
;; Tramp methods.
((string-match helm-ff-tramp-method-regexp file)
(let ((method (match-string 1 file))
(mh (helm-ff--tramp-multihops-p helm-pattern)))
(cons (propertize (concat (if mh "" "/") method) 'face 'helm-ff-file)
(if mh
(concat (match-string 1 helm-pattern) ":" method)
(concat "/:" method)))))
;; non existing files.
(t
(add-face-text-property 0 len 'helm-ff-file t disp)
(when tramp-invalid-fname
(add-text-properties 0 len `(host ,tramp-invalid-fname) disp))
(cons (helm-ff-prefix-filename
disp
file
(unless tramp-invalid-fname 'new-file))
file)))
;; Highlight local files showing everything, symlinks, exe,
;; dirs etc...
(let* ((attr (condition-case err
(file-attributes file)
(file-error
;; Possible error not happening during listing
;; but when calling file-attributes see error
;; with sshfs bug#2405
(message "%s:%s" (car err) (cdr err)) nil)))
(type (car attr))
x-bit)
(cond (;; Not a file but the message error printed in
;; helm-buffer. Such a message should not have a
;; subdir so matching on bol should suffice, but to
;; be sure use @@@@ as prefix in file-error message
;; to be safe bug#2400.
(string-match "\\`@@@@file-error:" file) file)
(;; A dead symlink.
(and (stringp type)
(not (helm-ff-valid-symlink-p file))
(not (string-match "^\\.#" basename)))
(add-face-text-property 0 len 'helm-ff-invalid-symlink t disp)
(cons (helm-ff-prefix-filename disp file) file))
;; A dotted directory symlinked.
((and dot (stringp type))
(cons (helm-ff-prefix-filename
(propertize disp 'face 'helm-ff-dotted-symlink-directory)
file)
file))
;; A dotted directory.
(dot
(cons (helm-ff-prefix-filename
(propertize disp 'face 'helm-ff-dotted-directory)
file)
file))
;; Backup files.
(backup
(cons (helm-ff-prefix-filename
(propertize disp 'face 'helm-ff-backup-file)
file)
file))
;; A symlink.
((stringp type)
(let* ((abbrev (abbreviate-file-name type))
(len-abbrev (length abbrev)))
(helm-aif (helm-file-name-extension abbrev)
(when (string-match (format "\\.\\(%s\\)\\'" it) abbrev)
(add-face-text-property
(match-beginning 1) (match-end 1)
'helm-ff-file-extension t abbrev)))
(add-face-text-property 0 len-abbrev 'helm-ff-truename t abbrev)
;; Colorize extension only on truename.
(add-face-text-property 0 len 'helm-ff-symlink nil disp)
(cons (concat (helm-ff-prefix-filename disp file)
;; Displaying this in a space with display prop
;; allows retrieving the candidate with
;; `helm-ff-retrieve-last-expanded'. If we put
;; the display prop on the whole candidate
;; `helm-fuzzy-highlight-matches' don't match
;; properly.
(propertize " " 'display (concat " -> " abbrev)))
file)))
;; A directory.
((eq t type)
(cons (helm-ff-prefix-filename
(propertize disp 'face 'helm-ff-directory)
file)
file))
;; A character device file.
((and attr (string-match
"\\`[cp]" (setq x-bit (substring (nth 8 attr) 0 4))))
(add-face-text-property 0 len 'helm-ff-pipe t disp)
(cons (helm-ff-prefix-filename disp file) file))
;; A socket file.
((and attr (string-match "\\`[s]" x-bit))
(add-face-text-property 0 len 'helm-ff-socket t disp)
(cons (helm-ff-prefix-filename disp file) file))
;; An executable file.
((and attr (string-match "x\\'" x-bit))
(add-face-text-property 0 len 'helm-ff-executable t disp)
(cons (helm-ff-prefix-filename disp file) file))
;; An executable file with suid
((and attr (string-match "s\\'" x-bit))
(add-face-text-property 0 len 'helm-ff-suid t disp)
(cons (helm-ff-prefix-filename disp file) file))
;; A file.
((and attr (null type))
(add-face-text-property 0 len 'helm-ff-file t disp)
(cons (helm-ff-prefix-filename disp file) file))
;; A tramp method
;; At this point no need to handle multi hops syntax
;; which is considered remote and handled in first
;; cond before.
((string-match helm-ff-tramp-method-regexp file)
(cons (propertize (concat "/" (match-string 1 file))
'face 'helm-ff-nofile)
(concat "/:" (match-string 1 file))))
;; A non--existing file.
(t
(add-face-text-property 0 len 'helm-ff-nofile t disp)
(cons (helm-ff-prefix-filename disp file 'new-file)
file))))))))
(defun helm-ff-get-icon (disp file)
"Get icon from `helm-x-icons-provider' for FILE.
Arg DISP is the display part of the candidate.
Arg FILE is the real part of candidate, a filename with no props."
(when helm-ff-icon-mode
(let ((icon (helm-acond (;; Non symlink directories.
(helm-ff--is-dir-from-disp disp)
(helm-aif (helm-x-icons-match-to-alist
(helm-basename file)
'dir)
(apply (car it) (cdr it))
(helm-x-icons-generic "file-directory")))
(;; All files, symlinks may be symlink directories.
(helm-ff--is-file-from-disp disp)
;; Detect symlink directories. We must call
;; `file-directory-p' here but it is
;; limited to symlinks, so it should not
;; degrade too much performances.
(if (and (memq it '(helm-ff-symlink
helm-ff-dotted-symlink-directory))
(file-directory-p file))
(helm-x-icons-generic "file-symlink-directory")
(helm-x-icons-icon-for-file (helm-basename file)))))))
(when icon (concat icon " ")))))
(defun helm-ff--is-dir-from-disp (disp)
"Return the face used for candidate when candidate is a directory."
(helm-aand (get-text-property 0 'face disp)
(memq it '(helm-ff-directory helm-ff-dotted-directory))
(car it)))
(defun helm-ff--is-file-from-disp (disp)
"Return the face used for file's candidate or dotted-symlink dirs."
(helm-aand (get-text-property 0 'face disp)
(memq it '(helm-ff-file
helm-ff-suid
helm-ff-executable
helm-ff-socket
helm-ff-pipe
helm-ff-symlink
helm-ff-dotted-symlink-directory
helm-ff-backup-file
helm-ls-git-untracked-face))
(car it)))
;;;###autoload
(define-minor-mode helm-ff-icon-mode
"Display icons from `helm-x-icons-provider' package in HFF when enabled."
:global t
:group 'helm-files
(when helm-ff-icon-mode
(unless (require helm-x-icons-provider nil t)
(setq helm-ff-icon-mode nil)
(message "No suitable Icons package found")))
(clrhash helm-ff--list-directory-cache))
;;; Action transformer
;;
(defun helm-ff--in-backup-directory ()
(when backup-directory-alist
(cl-loop for (_p . f) in backup-directory-alist
thereis (file-equal-p f helm-ff-default-directory))))
(defun helm-ff-restore-backups (_candidate)
(let ((mkd (helm-marked-candidates))
(copied 0)
ovw)
(cl-dolist (file mkd)
(let (dest)
(when (string-match "\\(?:\\`\\([!]\\)[^!]*\\1.*\\)\\|\\(?:~\\'\\)"
(helm-basename file))
(setq dest (helm-aand (replace-regexp-in-string
"\\.~[[:digit:]]*~?"
"" (helm-basename file))
(helm-ff--normalize-backup-name it)
(if (string-match "\\`/" it)
it
;; If basename doesn't contain now
;; "/", that's mean it was a backup file
;; stored in current directory, just
;; expand it to this directory.
(expand-file-name it helm-ff-default-directory))))
(if (and (file-exists-p dest) (null ovw))
(helm-acase (helm-read-answer
(format "Overwrite `%s' (answer [y,n,!,q])? " dest)
'("y" "n" "!" "q"))
("y" (cl-incf copied) (copy-file file dest t t t t))
("n" (ignore))
("!" (setq ovw t) (cl-incf copied) (copy-file file dest t t t t))
("q" (setq copied nil) (cl-return (message "Abort restoring files"))))
(cl-incf copied)
(copy-file file dest t t t t)))))
(when (numberp copied)
(message "(%s/%s) files copied" copied (length mkd)))))
(defun helm-ff--normalize-backup-name (fname)
"Normalize backup FNAME to its original name."
;; When Emacs build a backup filename for the backup directory it
;; replace "/" by "!" in the basedir of file and double the "!" in
;; the basename, this is done by `make-backup-file-name-1'. We want
;; to replace only the "!" in the basedir part of FNAME.
(with-temp-buffer
(insert fname)
(goto-char (point-min))
(save-excursion
(when (looking-at "!") (replace-match "/"))
(while (re-search-forward "[^!]\\([!]\\)[^!]" nil t)
(replace-match "/" nil nil nil 1)))
(let ((count 0) rep)
(while (re-search-forward "!" nil t)
(cl-incf count))
(setq rep (make-string (/ count 2) ?!))
(replace-regexp-in-string "[!]+" rep (buffer-string)))))
(defun helm-ff-update-directory-autoloads (_candidate)
"Action to update or create autoloads file in current directory."
(let ((default-directory helm-ff-default-directory)
(file
(read-file-name "Write autoload definitions to file: "
helm-ff-default-directory
nil nil nil
(lambda (f)
(string-match "autoloads\\|loaddefs" f)))))
(if (fboundp 'loaddefs-generate)
(loaddefs-generate default-directory file)
(let ((generated-autoload-file file))
(update-directory-autoloads default-directory)))))
(defun helm-find-files-action-transformer (actions candidate)
"Action transformer for `helm-source-find-files'."
(let ((str-at-point (with-helm-current-buffer
(buffer-substring-no-properties
(pos-bol) (pos-eol)))))
(when (file-regular-p candidate)
(setq actions (helm-append-at-nth
actions '(("Checksum File" . helm-ff-checksum)) 4)))
(when (file-exists-p (expand-file-name
(format "#%s#" (helm-basename candidate))
(helm-basedir candidate)))
(setq actions (helm-append-at-nth
actions '(("Recover file" . recover-file)) 4)))
(cond ((and (file-exists-p candidate)
(string-match helm-ff--trash-directory-regexp
(helm-basedir (expand-file-name candidate)))
(not (member (helm-basename candidate) '("." ".."))))
(helm-append-at-nth
actions
'(("Restore file(s) from trash" . helm-restore-file-from-trash)
("Delete file(s) from trash" . helm-ff-trash-rm))
1))
((and helm--url-regexp
(not (string-match-p helm--url-regexp str-at-point))
(not (with-helm-current-buffer (eq major-mode 'dired-mode)))
(string-match-p ":\\([0-9]+:?\\)" str-at-point))
(append '(("Find file to line number" . helm-ff-goto-linum))
actions))
((string-match (image-file-name-regexp) candidate)
(helm-append-at-nth
actions
(helm-make-actions
"Rotate image right `M-r'" 'helm-ff-rotate-image-right
"Rotate image left `M-l'" 'helm-ff-rotate-image-left
"Start slideshow with marked" 'helm-ff-start-slideshow-on-marked
(lambda ()
(and (fboundp 'image-dired-wallpaper-set)
(display-graphic-p)
"Change wall paper"))
'image-dired-wallpaper-set)
3))
((string-match "\\.el\\'" candidate)
(helm-append-at-nth
actions
`(("Byte compile lisp file(s) `M-B, C-u to load'"
. helm-find-files-byte-compile)
("Byte compile file(s) async"
. ,(lambda (_candidate)
(cl-loop for file in (helm-marked-candidates)
do (async-byte-compile-file file))))
("Byte recompile directory async"
. ,(lambda (_)
(async-byte-recompile-directory
helm-ff-default-directory)))
("Load File(s) `M-L'" . helm-find-files-load-files)
("Update directory autoloads" . helm-ff-update-directory-autoloads))
2))
((string-match (concat (regexp-opt load-suffixes) "\\'") candidate)
(helm-append-at-nth
actions
'(("Load File(s) `M-L'" . helm-find-files-load-files))
2))
((and (string-match "\\.html?$" candidate)
(file-exists-p candidate))
(helm-append-at-nth
actions '(("Browse url file" . browse-url-of-file)) 2))
((and (helm-ff--in-backup-directory)
(cl-loop for file in (helm-marked-candidates)
always (string-match "\\(?:\\`\\([!]\\)[^!]*\\1.*\\)\\|\\(?:~\\'\\)"
(helm-basename file))))
(helm-append-at-nth
actions '(("Restore backup file(s)" . helm-ff-restore-backups)) 1))
(t actions))))
;;; Trashing files
;;
(defun helm-ff-trash-action (fn names &rest args)
"Execute a trash action FN on marked files.
Arg NAMES is a list of strings to pass to messages.
E.g. \\='(\"delete\" \"deleting\")
ARGS are other arguments to be passed to FN."
(let ((mkd (helm-marked-candidates))
errors aborted)
(with-helm-display-marked-candidates
helm-marked-buffer-name
(if (and args (string= (car names) "restore"))
(cl-loop for f in mkd
for bd = (helm-basename f)
for assoc = (assoc bd (car args))
when assoc
collect (concat (truncate-string-to-width
(car assoc) 40 nil nil t)
" -> "
(truncate-string-to-width
(helm-basedir (cdr assoc)) 40 nil nil t)))
(helm-ff--count-and-collect-dups (mapcar 'helm-basename mkd)))
(if (y-or-n-p (format "%s %s files from trash? "
(capitalize (car names))
(length mkd)))
(progn
(message "%s files from trash..." (capitalize (cadr names)))
(cl-loop for f in mkd do
(condition-case err
(apply fn f args)
(error (push (format "%s" (cadr err)) errors)
nil))))
(message "%s files from trash aborted" (capitalize (cadr names)))
(setq aborted t)))
;; Handle errors from outside the
;; with-helm-display-marked-candidates block otherwise warning is
;; never displayed.
(if errors
(progn
(display-warning 'helm
(with-temp-buffer
(insert (format-time-string "%Y-%m-%d %H:%M:%S\n"
(current-time)))
(insert (format
"Failed to %s %s/%s files from trash\n"
(car names) (length errors) (length mkd)))
(insert (mapconcat 'identity errors "\n") "\n")
(buffer-string))
:error
"*helm restore warnings*")
(message "%s files from trash aborted" (capitalize (cadr names))))
(unless aborted
(message "%s %s files from trash done"
(capitalize (cadr names)) (length mkd))))))
(defun helm-ff-trash-rm (_candidate)
"Delete marked-files from a Trash directory.
The Trash directory should be a directory compliant with
and each
file should have its \\='*.trashinfo' correspondent file in
Trash/info directory."
(helm-ff-trash-action 'helm-ff-trash-rm-1 '("delete" "deleting")))
(defun helm-ff-trash-rm-1 (file)
(let ((info-file (concat (helm-reduce-file-name file 2)
"info/" (helm-basename file "trashinfo")
".trashinfo")))
(cl-assert (file-exists-p file)
nil (format "No such file or directory `%s'"
file))
(cl-assert (file-exists-p info-file)
nil (format "No such file or directory `%s'"
info-file))
(if (file-directory-p file)
(delete-directory file t)
(delete-file file))
(delete-file info-file)))
(defun helm-restore-file-from-trash (_candidate)
"Restore marked-files from a Trash directory.
The Trash directory should be a directory compliant with
and each
file should have its \\='*.trashinfo' corresponding file in
Trash/info directory."
(let* ((default-directory (file-name-as-directory
helm-ff-default-directory))
(trashed-files (helm-ff-trash-list)))
(helm-ff-trash-action 'helm-restore-file-from-trash-1
'("restore" "restoring")
trashed-files)))
(defun helm-restore-file-from-trash-1 (file trashed-files)
"Restore FILE from a trash directory.
Arg TRASHED-FILES is an alist of (fname_in_trash . dest) obtained
with `helm-ff-trash-list'."
;; Emacs trash duplicate files with a unique name + .trashinfo in
;; the filename which is wrong, only files in info directory should
;; end with .trashinfo, so fix the filename before looking for dest name.
(let* ((fname (replace-regexp-in-string "\\.trashinfo\\'" "" file))
(info-file (concat (helm-reduce-file-name fname 2)
"info/"
(helm-basename fname)
".trashinfo"))
(dest-file (helm-ff--get-dest-file-from-trash
trashed-files fname)))
(cl-assert (not (file-exists-p dest-file)) nil
(format "File `%s' already exists" dest-file))
(cl-assert dest-file nil "No such file in trash")
(message "Restoring %s to %s..." (helm-basename file) (helm-basedir dest-file))
(rename-file file dest-file)
(message "Restoring %s to %s done" (helm-basename file) (helm-basedir dest-file))
(delete-file info-file)))
(defun helm-ff-trash-file-p (file)
"Return t when FILE is a trashed file."
(and (file-exists-p file)
(string-match helm-ff--trash-directory-regexp (helm-basedir file))
(not (member (helm-basename file) '("." "..")))))
(defun helm-ff--get-dest-file-from-trash (trashed-files file)
(assoc-default (helm-basename file) trashed-files))
(cl-defun helm-ff-trash-list (&optional (trash-dir nil strash-dir))
"Return an alist of trashed files basename and dest name.
Assume the trash system in use is freedesktop compatible, see
This function is intended to be used from a trash directory i.e. it
use `helm-ff-default-directory', but it may be used elsewhere by
specifying the trash directory with TRASH-DIR arg."
(unless (or (fboundp 'system-move-file-to-trash)
(and strash-dir (null trash-dir)))
;; Files owned by root are trashed in /root/.local/share/Trash.
;; Files owned by user and trashed by root are trashed in
;; /home/.Trash.
;; Files owned by user and trashed by user are trashed in
;; ~/.local/share/Trash.
(cl-loop for f in (directory-files
(expand-file-name
;; helm-ff-default-directory is currently the
;; trash directory.
"info" (helm-basedir (directory-file-name
(or trash-dir helm-ff-default-directory))))
t directory-files-no-dot-files-regexp)
collect (cons (helm-basename (replace-regexp-in-string "\\.trashinfo\\'" "" f))
(with-temp-buffer
(save-excursion
(insert-file-contents f))
(when (re-search-forward "^path=" nil t)
(let ((path (helm-url-unhex-string
(buffer-substring-no-properties
(point) (pos-eol)))))
(if (string-match "\\`/" path)
;; path is absolute
path
;; When path is relative, assume the
;; trash directory is located at
;; /home/.Trash and path is the
;; relative name of file from /home.
(expand-file-name path "/home")))))))))
(defun helm-ff-goto-linum (candidate)
"Find file CANDIDATE and maybe jump to line number found in fname at point.
Line number should be added at end of fname preceded with \":\".
E.g. \"foo:12\"."
(let ((linum (with-helm-current-buffer
(let ((str (buffer-substring-no-properties
(pos-bol) (pos-eol))))
(when (string-match ":\\([0-9]+:?\\)" str)
(match-string 1 str))))))
(find-file candidate)
(and linum (not (string= linum ""))
(helm-goto-line (string-to-number linum) t))))
(defun helm-ff-mail-attach-files (_candidate)
"Run `mml-attach-file' on `helm-marked-candidates'."
(require 'mml)
(let ((flist (helm-marked-candidates :with-wildcard t))
(dest-buf (and (derived-mode-p 'message-mode 'mail-mode)
(current-buffer)))
bufs)
(unless dest-buf
(setq bufs (cl-loop for b in (buffer-list)
when (with-current-buffer b
(derived-mode-p 'message-mode 'mail-mode))
collect (buffer-name b)))
(if (and bufs (y-or-n-p "Attach files to existing mail composition buffer? "))
(setq dest-buf
(if (cdr bufs)
(helm-comp-read "Attach to buffer: " bufs :nomark t)
(car bufs)))
(compose-mail)
(setq dest-buf (current-buffer))))
(switch-to-buffer dest-buf)
(save-restriction
(widen)
(save-excursion
(goto-char (point-max))
(cl-loop for f in flist
do (mml-attach-file f (or (mm-default-file-encoding f)
"application/octet-stream")))))))
(defvar image-dired-display-image-buffer)
(defun helm-ff-rotate-current-image-1 (file angle)
"Rotate current image at ANGLE degrees."
(cl-assert (and (file-exists-p file)
(string-match (image-file-name-regexp) file))
nil "Can't rotate non image file")
(setq file (file-truename file)) ; For symlinked images.
(let ((default-directory (file-name-directory file))
(basename (helm-basename file))
;; convert ANGLE to a suitable value for exiftran.
(num-arg (if (string= helm-ff-rotate-image-program "exiftran")
(cl-case angle
(90 "-9") ; 90 clockwise
(270 "-2")) ; 270 clockwise == -90
(number-to-string angle)))
rotation-failed)
;; Try to rotate image with exiftran even with helm-ff-display-image-native.
(if (and helm-ff-rotate-image-program
(executable-find helm-ff-rotate-image-program))
(apply #'process-file helm-ff-rotate-image-program nil nil nil
(append helm-ff-rotate-image-switch
(list num-arg basename)))
(setq rotation-failed t))
;; Display image in image-mode.
(if (helm-ff-display-image-native-p)
(if rotation-failed
;; When rotation fails fallback to `image-rotate' with no
;; transformation of file.
(with-selected-window (helm-persistent-action-display-window)
(condition-case _err
(with-no-warnings (image-rotate angle))
(wrong-number-of-arguments (image-rotate))))
(helm-ff--display-image-native file))
;; Use image-dired to display image.
(when rotation-failed
(error "%s not found" (or helm-ff-rotate-image-program
"`helm-ff-rotate-image-program'")))
(when (buffer-live-p image-dired-display-image-buffer)
(kill-buffer image-dired-display-image-buffer))
(image-dired-display-image basename)
(message nil)
(display-buffer (get-buffer image-dired-display-image-buffer)))))
(defun helm-ff-rotate-image-left (candidate)
"Rotate image file CANDIDATE left.
This affects directly file CANDIDATE."
(helm-ff-rotate-current-image-1 candidate 270))
(defun helm-ff-rotate-image-right (candidate)
"Rotate image file CANDIDATE right.
This affects directly file CANDIDATE."
(helm-ff-rotate-current-image-1 candidate 90))
(defun helm-ff-rotate-left-persistent ()
"Rotate image left without quitting helm."
(interactive)
(with-helm-alive-p
(helm-set-attr 'image-action1 'helm-ff-rotate-image-left)
(helm-execute-persistent-action 'image-action1)))
(put 'helm-ff-rotate-left-persistent 'helm-only t)
(defun helm-ff-rotate-right-persistent ()
"Rotate image right without quitting helm."
(interactive)
(with-helm-alive-p
(helm-set-attr 'image-action2 'helm-ff-rotate-image-right)
(helm-execute-persistent-action 'image-action2)))
(put 'helm-ff-rotate-right-persistent 'helm-only t)
(defun helm-ff-resize-image-1 (arg)
;; `image-decrease-size' and `image-increase-size' are not usable
;; because they run directly `image--change-size' in a timer without
;; taking care of the selected-window.
(cl-assert (and (fboundp 'image--change-size)
(helm-ff-display-image-native-p))
nil "Resizing image not available")
(if (> arg 0)
(run-with-idle-timer
0.3 nil
(lambda ()
(with-selected-window (helm-persistent-action-display-window)
(image--change-size 1.2))))
(run-with-idle-timer
0.3 nil
(lambda ()
(with-selected-window (helm-persistent-action-display-window)
(image--change-size 0.8))))))
(defun helm-ff-increase-image-size (_candidate)
(helm-ff-resize-image-1 1))
(defun helm-ff-decrease-image-size (_candidate)
(helm-ff-resize-image-1 -1))
(defun helm-ff-increase-image-size-persistent ()
"Increase image size without quitting helm."
(interactive)
(with-helm-alive-p
(helm-set-attr 'image-action3 'helm-ff-increase-image-size)
(helm-execute-persistent-action 'image-action3)))
(put 'helm-ff-increase-image-size-persistent 'helm-only t)
(defun helm-ff-decrease-image-size-persistent ()
"Decrease image size without quitting helm."
(interactive)
(with-helm-alive-p
(helm-set-attr 'image-action4 'helm-ff-decrease-image-size)
(helm-execute-persistent-action 'image-action4)))
(put 'helm-ff-decrease-image-size-persistent 'helm-only t)
(defun helm-ff-exif-data (candidate)
"Extract exif data from file CANDIDATE using `helm-ff-exif-data-program'."
(if (and helm-ff-exif-data-program
(executable-find helm-ff-exif-data-program))
(shell-command-to-string (format "%s %s %s"
helm-ff-exif-data-program
helm-ff-exif-data-program-args
candidate))
(format "No program %s found to extract exif"
helm-ff-exif-data-program)))
(defvar helm-ff-image-native-buffer "*image-native-display*")
(defvar helm-ff-sound-file-extensions '("wav" "au"))
(defun helm-ff--maybe-follow (candidate)
(let ((file (if helm-ff-ignore-following-on-directory
(file-exists-p candidate)
(file-regular-p candidate)))
(image (string-match-p (image-file-name-regexp) candidate))
(ext (file-name-extension candidate)))
(and file
(or image (not (member ext helm-ff-follow-blacklist-file-exts))))))
(cl-defun helm-find-files-persistent-action-if (candidate)
"Open subtree CANDIDATE without quitting helm.
If CANDIDATE is not a directory expand CANDIDATE filename.
If CANDIDATE is alone, open file CANDIDATE filename.
That means:
First hit on C-j expands CANDIDATE, second hit opens file.
If a prefix arg is given or `helm-follow-mode' is on, then open
file."
(let* ((follow (or (helm-follow-mode-p)
helm--temp-follow-flag))
(image-cand (string-match-p (image-file-name-regexp) candidate))
(sound-cand (member (file-name-extension candidate)
helm-ff-sound-file-extensions))
(selection (helm-get-selection))
(insert-in-minibuffer (lambda (fname)
(with-selected-window (or (active-minibuffer-window)
(minibuffer-window))
(unless follow
(delete-minibuffer-contents)
(set-text-properties 0 (length fname)
nil fname)
(insert fname))))))
(helm-set-attr 'candidate-number-limit helm-ff-candidate-number-limit)
(unless (helm-ff--maybe-follow candidate)
(when follow
(helm-follow-mode -1) (message nil)
(cl-return-from helm-find-files-persistent-action-if
(prog1
#'ignore
(user-error "Can't follow this kind of file")))))
(cond (;; Tramp methods completion.
(string-match helm-ff-tramp-method-regexp candidate)
(let ((method (match-string 1 candidate)))
(cons (lambda (candidate)
(funcall insert-in-minibuffer
(if (helm-ff--tramp-multihops-p candidate)
(concat (match-string 1 candidate) method ":")
(concat "/" method ":"))))
'never-split)))
((and (helm-ff--invalid-tramp-name-p)
(string-match helm-tramp-file-name-regexp candidate))
(cons (lambda (_candidate)
;; First hit insert hostname and
;; second hit insert ":" and expand.
(if (string= candidate helm-pattern)
(funcall insert-in-minibuffer (concat candidate ":"))
(funcall insert-in-minibuffer candidate)))
'never-split))
(;; A symlink directory, expand it but not to its truename
;; unless a prefix arg is given.
(and (file-directory-p candidate) (file-symlink-p candidate))
(cons (lambda (_candidate)
(helm-ff-after-persistent-show-all)
(let ((new-dir (file-name-as-directory
(if current-prefix-arg
(file-truename (expand-file-name candidate))
(expand-file-name candidate)))))
(setq helm-ff--show-thumbnails
(member new-dir helm-ff--thumbnailed-directories))
(funcall insert-in-minibuffer new-dir)))
'never-split))
;; A directory, open it.
((file-directory-p candidate)
(cons (lambda (_candidate)
(helm-ff-after-persistent-show-all)
(when (string= (helm-basename candidate) "..")
(setq helm-ff-last-expanded helm-ff-default-directory))
(let ((new-dir (file-name-as-directory
(expand-file-name candidate))))
(setq helm-ff--show-thumbnails
(member new-dir helm-ff--thumbnailed-directories))
(funcall insert-in-minibuffer new-dir))
(with-helm-after-update-hook (helm-ff-retrieve-last-expanded)))
'never-split))
;; A symlink file, expand to it's true name. (first hit)
((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
(cons (lambda (_candidate)
(funcall insert-in-minibuffer (file-truename candidate))
(helm-check-minibuffer-input)) ; Force update.
'never-split))
;; A regular file, expand it, (first hit)
((and (not (file-equal-p selection helm-pattern))
(not current-prefix-arg) (not follow))
(cons (lambda (_candidate)
(funcall insert-in-minibuffer selection)
(helm-check-minibuffer-input)) ; Force update.
'never-split))
(sound-cand (lambda (candidate) (play-sound-file candidate)))
;; An image file and it is the second hit on C-j, display it.
(image-cand
(if (helm-ff-display-image-native-p)
#'helm-ff--display-or-kill-image-native
(lambda (_candidate)
(require 'image-dired)
(let* ((win (get-buffer-window
image-dired-display-image-buffer 'visible))
(fname (and win
(with-selected-window win
(get-text-property (point-min)
'original-file-name))))
(remove-buf-only (and win
fname
(with-helm-buffer
(file-equal-p candidate fname)))))
(when remove-buf-only
(with-helm-window
(if (and helm-persistent-action-display-window
(window-dedicated-p (next-window win 1)))
(delete-window helm-persistent-action-display-window)
(set-window-buffer win helm-current-buffer))))
(when (buffer-live-p (get-buffer image-dired-display-image-buffer))
(kill-buffer image-dired-display-image-buffer))
(unless remove-buf-only
;; Fix emacs bug never fixed upstream.
(unless (file-directory-p image-dired-dir)
(make-directory image-dired-dir))
(switch-to-buffer image-dired-display-image-buffer)
(message "Resizing image...")
(cl-letf (((symbol-function 'message) #'ignore))
(image-dired-display-image candidate))
(message "Resizing image done")
(with-current-buffer image-dired-display-image-buffer
(let ((exif-data (helm-ff-exif-data candidate)))
(setq default-directory helm-ff-default-directory)
(image-dired-update-property 'help-echo exif-data))))))))
;; Allow browsing archive on avfs fs.
;; Assume volume is already mounted with mountavfs.
((helm-aand helm-ff-avfs-directory
(file-name-directory candidate)
(string-match
(regexp-quote (expand-file-name helm-ff-avfs-directory))
it)
(helm-ff-file-compressed-p candidate))
(cons (lambda (_candidate)
(funcall insert-in-minibuffer (concat candidate "#/")))
'never-split))
;; File is not existing and have no basedir, typically when
;; user hit C-k (minibuffer is empty) and then write foo and
;; hit C-j. This make clear that when no basedir, helm will
;; create the file in default-directory.
((and (not (file-exists-p candidate))
(not (helm-basedir candidate)))
(cons (lambda (_candidate)
(funcall insert-in-minibuffer
(expand-file-name candidate default-directory)))
'never-split))
;; On second hit we open file.
;; On Third hit we kill it's buffer maybe.
(t
(lambda (candidate)
(funcall helm-ff-kill-or-find-buffer-fname-fn candidate))))))
;; Native image display (with image-mode).
;;
(defvar helm-ff--image-cache nil)
(defun helm-ff-display-image-native-p ()
"Use `helm-ff-display-image-native' when returns `t'."
(or helm-ff-display-image-native
;; Image-dired in emacs-29 uses image-mode but
;; display is no more working with our old
;; image-dired code, so force usage of
;; helm-ff-display-image-native.
(fboundp 'image-dired-display-image-mode)))
(defun helm-ff--display-or-kill-image-native (candidate)
;; Display images in same buffer
;; `helm-ff-image-native-buffer'.
(if (and (buffer-live-p (get-buffer helm-ff-image-native-buffer))
(file-equal-p (buffer-file-name
(get-buffer helm-ff-image-native-buffer))
candidate)
;; Allow redisplaying
;; `helm-ff-image-native-buffer' when it
;; already exists and display same image as candidate.
(get-buffer-window helm-ff-image-native-buffer 'visible))
(progn
(set-window-buffer
helm-persistent-action-display-window helm-current-buffer)
(kill-buffer helm-ff-image-native-buffer))
(helm-ff--display-image-native candidate)))
(defun helm-ff-clean-image-cache ()
(when helm-ff--image-cache
(cl-loop for img in helm-ff--image-cache
do (clear-image-cache img)
finally do (setq helm-ff--image-cache nil))))
(defun helm-ff--display-image-native (candidate)
(when (string-match-p (image-file-name-regexp) candidate)
(when (buffer-live-p (get-buffer helm-ff-image-native-buffer))
(kill-buffer helm-ff-image-native-buffer))
;; Avoid hight memory consumption see
;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-11/msg00879.html.
(when (> (length helm-ff--image-cache)
(* helm-ff-image-cache-max-len 2))
;; Only keep the last `helm-ff-image-cache-max-len' images in cache.
(cl-loop for img in (butlast helm-ff--image-cache
(1+ helm-ff-image-cache-max-len))
do (clear-image-cache img)
(setq helm-ff--image-cache
(delete img helm-ff--image-cache))))
(cl-letf* (((symbol-function 'message) #'ignore)
(buf (find-file-noselect candidate t)))
;; When going back reuse the cached images.
(unless (member candidate helm-ff--image-cache)
(setq helm-ff--image-cache
(append helm-ff--image-cache
(list (expand-file-name candidate)))))
(with-current-buffer buf
(rename-buffer helm-ff-image-native-buffer))
(display-buffer buf))))
;;; Slideshow action
;;
(defvar helm-ff--slideshow-iterator nil)
(defvar helm-ff--slideshow-sequence nil)
(defvar helm-ff--slideshow-in-pause nil)
(defvar helm-ff-slideshow-helper
"Type `\\[helm-ff-slideshow-pause-or-restart]' to %s, \
`\\[helm-ff-slideshow-next]' for next, `\\[helm-ff-slideshow-previous]' for previous, \
`\\[helm-ff-slideshow-quit]' to quit")
(defvar helm-slideshow-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map image-mode-map)
(define-key map (kbd "SPC") 'helm-ff-slideshow-pause-or-restart)
(define-key map (kbd "q") 'helm-ff-slideshow-quit)
(define-key map (kbd "n") 'helm-ff-slideshow-next)
(define-key map (kbd "p") 'helm-ff-slideshow-previous)
map))
(define-derived-mode helm-slideshow-mode
image-mode "helm-image-mode"
"Mode to display images from helm-find-files.
Special commands:
\\{helm-slideshow-mode-map}
")
(put 'helm-slideshow-mode 'no-helm-mx t)
(defun helm-ff-slideshow-help-string (counter-string state)
(concat counter-string
(substitute-command-keys
(format helm-ff-slideshow-helper state))))
(defun helm-ff-start-slideshow-on-marked (_candidate)
"Start a slideshow on marked files."
(let ((marked (helm-remove-if-not-match
(image-file-name-regexp)
(helm-marked-candidates :with-wildcard t))))
(cl-assert (cdr marked) nil "Can't start a slideshow on a single file")
(setq helm-ff--slideshow-sequence marked)
(setq helm-ff--slideshow-iterator (helm-iter-circular marked))
(helm-ff--display-image-native (helm-iter-next helm-ff--slideshow-iterator))
(delete-other-windows (get-buffer-window helm-ff-image-native-buffer))
(cl-letf (((symbol-function 'message) #'ignore))
(helm-slideshow-mode))
(setq mode-line-format (helm-ff-slideshow-help-string
(format "(1/%s) " (length marked)) "pause"))
(helm-ff-slideshow-loop helm-ff--slideshow-iterator)))
(defun helm-ff-slideshow-state ()
(format "(%s/%s) "
(1+ (helm-position
(buffer-file-name) helm-ff--slideshow-sequence
:test 'equal))
(length helm-ff--slideshow-sequence)))
(defun helm-ff-slideshow-sequence-from-current (&optional reverse)
(helm-reorganize-sequence-from-elm
helm-ff--slideshow-sequence (buffer-file-name) reverse))
(defun helm-ff-slideshow-loop (iterator &optional restart)
(while (sit-for helm-ff-slideshow-default-delay)
(helm-ff--display-image-native (helm-iter-next iterator))
(delete-other-windows (get-buffer-window helm-ff-image-native-buffer))
(cl-letf (((symbol-function 'message) #'ignore))
(helm-slideshow-mode))
(when restart
(message "Helm Slideshow started")
(sit-for 1)
(message nil)
(setq restart nil))
(setq mode-line-format
(helm-ff-slideshow-help-string
(helm-ff-slideshow-state) "pause"))))
(defun helm-ff-slideshow-pause-or-restart ()
(interactive)
(setq helm-ff--slideshow-in-pause (not helm-ff--slideshow-in-pause))
(if helm-ff--slideshow-in-pause
(setq mode-line-format (helm-ff-slideshow-help-string nil "restart"))
(message "Helm Slideshow restarting...")
(setq helm-ff--slideshow-iterator
(helm-iter-circular (helm-ff-slideshow-sequence-from-current)))
(helm-ff-slideshow-loop helm-ff--slideshow-iterator 'restart)))
(put 'helm-ff-slideshow-pause-or-restart 'no-helm-mx t)
(defun helm-ff-slideshow-next ()
(interactive)
(setq helm-ff--slideshow-in-pause t)
(setq helm-ff--slideshow-iterator nil)
(helm-ff--display-image-native
(car (helm-ff-slideshow-sequence-from-current)))
(delete-other-windows (get-buffer-window helm-ff-image-native-buffer))
(cl-letf (((symbol-function 'message) #'ignore))
(helm-slideshow-mode))
(message (concat (helm-ff-slideshow-state)
(substitute-command-keys
(format helm-ff-slideshow-helper "restart")))))
(put 'helm-ff-slideshow-next 'no-helm-mx t)
(defun helm-ff-slideshow-previous ()
(interactive)
(setq helm-ff--slideshow-in-pause t)
(setq helm-ff--slideshow-iterator nil)
(helm-ff--display-image-native
(car (helm-ff-slideshow-sequence-from-current 'reverse)))
(delete-other-windows (get-buffer-window helm-ff-image-native-buffer))
(cl-letf (((symbol-function 'message) #'ignore))
(helm-slideshow-mode))
(message (concat (helm-ff-slideshow-state)
(substitute-command-keys
(format helm-ff-slideshow-helper "restart")))))
(put 'helm-ff-slideshow-previous 'no-helm-mx t)
(defun helm-ff-slideshow-quit ()
(interactive)
(setq helm-ff--slideshow-iterator nil)
(setq helm-ff--slideshow-in-pause nil)
(helm-ff-clean-image-cache)
(quit-window))
(put 'helm-ff-slideshow-quit 'no-helm-mx t)
;;; Thumbnails view
;;
(defun helm-ff-maybe-show-thumbnails (candidates _source)
(require 'image-dired)
(if (and helm-ff--show-thumbnails
(null (file-remote-p helm-ff-default-directory)))
(prog1
(cl-loop with scale = (image-compute-scaling-factor nil)
for (disp . img) in candidates
for type = (helm-acase (file-name-extension img)
((guard* (and (member it '("png" "jpg" "jpeg"))
(memq image-dired-thumbnail-storage
'(standard standard-large))))
'png)
(("jpg" "jpeg") 'jpeg)
("png" 'png))
if type collect
(let ((thumbnail (plist-get
(cdr (helm-ff--image-dired-get-thumbnail-image
img type scale))
:file)))
;; When icons are displayed the leading space handling disp
;; prop is already here, just replace icon with the thumbnail.
(unless helm-ff-icon-mode (setq disp (concat " " disp)))
(add-text-properties 0 1 `(display (image
:type ,type
:margin 5
:file ,thumbnail)
rear-nonsticky '(display))
disp)
(cons disp img))
else collect (cons disp img))
;; Ensure this is done AFTER previous clause otherwise thumb files will
;; never be created if they don't already exist.
(cl-pushnew helm-ff-default-directory
helm-ff--thumbnailed-directories :test 'equal))
candidates))
;; Same as `image-dired-get-thumbnail-image' but use
;; `helm-ff--image-dired-thumb-name' which cache thumbnails for further use.
(defun helm-ff--image-dired-get-thumbnail-image (file &optional type scale)
"Return the image descriptor for a thumbnail of image file FILE."
(unless (string-match-p (image-file-name-regexp) file)
(error "%s is not a valid image file" file))
(let* ((thumb-file (helm-ff--image-dired-thumb-name file))
thumb-attr)
;; Don't check status of files with `file-attributes' if it has already been
;; done in this session.
(when (and (not (member helm-ff-default-directory
helm-ff--thumbnailed-directories))
(or (not (setq thumb-attr (file-attributes thumb-file)))
(time-less-p (file-attribute-modification-time thumb-attr)
(file-attribute-modification-time
(file-attributes file)))))
(image-dired-create-thumb file thumb-file))
(create-image thumb-file type nil :scale scale)))
(defvar helm-ff-image-dired-thumbnails-cache (make-hash-table :test 'equal)
"Store associations of image_file/thumbnail_file.")
(defun helm-ff--image-dired-thumb-name (file)
(or (gethash file helm-ff-image-dired-thumbnails-cache)
(let ((thumb-name (image-dired-thumb-name file)))
(puthash file thumb-name helm-ff-image-dired-thumbnails-cache)
thumb-name)))
(defun helm-ff-toggle-thumbnails ()
(interactive)
(cl-assert (null (file-remote-p helm-ff-default-directory))
nil "Thumbnails show not supported on remote files")
(setq helm-ff--show-thumbnails (not helm-ff--show-thumbnails))
(when helm-ff--show-thumbnails
(message "Loading thumbnails...")
(with-helm-after-update-hook
(message "Loading thumbnails done")))
(when (and (null helm-ff--show-thumbnails)
(member helm-ff-default-directory
helm-ff--thumbnailed-directories))
(setq helm-ff--thumbnailed-directories
(delete helm-ff-default-directory helm-ff--thumbnailed-directories)))
(helm-force-update (regexp-quote (replace-regexp-in-string
"\\`[[:multibyte:] ]*" ""
(helm-get-selection nil t)))))
(put 'helm-ff-toggle-thumbnails 'no-helm-mx t)
;;;###autoload
(defun helm-ff-clear-image-dired-thumbnails-cache ()
"Clear `helm-ff-image-dired-thumbnails-cache'.
You may want to do this after customizing
`image-dired-thumbnail-storage' which may change the place where
thumbnail files are stored."
(interactive)
(clrhash helm-ff-image-dired-thumbnails-cache))
;;;###autoload
(defun helm-ff-cleanup-image-dired-dir-and-cache ()
"Cleanup `image-dired-dir' directory.
Delete all thumb files that are no more associated with an existing
image file in `helm-ff-image-dired-thumbnails-cache'."
(interactive)
(cl-loop for key being the hash-keys in helm-ff-image-dired-thumbnails-cache
using (hash-value val)
unless (file-exists-p key) do
(progn
(message "Deleting %s" val)
(delete-file val)
(remhash key helm-ff-image-dired-thumbnails-cache))))
;;; Recursive dirs completion
;;
(defun helm-find-files-recursive-dirs (directory &optional input)
(when (string-match "\\([.]\\)\\{2\\}" input)
(setq input (replace-match "" nil t input)))
(message "Recursively searching %s from %s ..."
input (abbreviate-file-name directory))
;; Ensure to not create a new frame
(let (helm-actions-inherit-frame-settings)
(helm :sources
(helm-make-source
"Recursive directories" 'helm-locate-subdirs-source
:header-name
(lambda (name)
(format "%s from `%s'"
name
(abbreviate-file-name helm-ff-default-directory)))
:basedir (if (string-match-p
"\\`es" helm-locate-recursive-dirs-command)
directory
(shell-quote-argument directory))
:subdir (shell-quote-argument input)
:candidate-transformer
`(,(lambda (candidates)
(cl-loop for c in candidates
when (and (file-directory-p c)
(null (helm-boring-directory-p
c helm-boring-file-regexp-list))
(string-match-p (regexp-quote input)
(helm-basename c)))
collect (propertize c 'face 'helm-ff-dirs)))
helm-w32-pathname-transformer
,(lambda (candidates)
(helm-ff-sort-candidates-1 candidates input)))
:persistent-action 'ignore
:action (lambda (c)
(helm-set-pattern
(file-name-as-directory (expand-file-name c)))))
:candidate-number-limit 999999
:allow-nest t
:resume 'noresume
:ff-transformer-show-only-basename nil
:buffer "*helm recursive dirs*")))
(defun helm-ff-recursive-dirs (_candidate)
"Launch a recursive search in `helm-ff-default-directory'."
(with-helm-default-directory helm-ff-default-directory
(helm-find-files-recursive-dirs
default-directory
(helm-basename (helm-get-selection)))))
(defun helm-ff-file-compressed-p (candidate)
"Whether CANDIDATE is a compressed file or not."
(member (file-name-extension candidate)
helm-ff-file-compressed-list))
(defun helm-ff--fname-at-point ()
"Try to guess fname at point."
(let ((end (point))
(limit (helm-aif (bounds-of-thing-at-point 'filename)
(car it)
(point))))
(save-excursion
(while (re-search-backward "\\(~\\|/\\|[[:lower:][:upper:]]:/\\)"
limit t))
(buffer-substring-no-properties (point) end))))
(defun helm-insert-file-name-completion-at-point (_candidate)
"Insert file name completion at point.
When completing i.e. there is already something at point, insert
filename abbreviated, relative or full according to initial
input, whereas when inserting i.e. there is nothing at point,
insert filename full, abbreviated or relative according to prefix
arg, respectively no prefix arg, one prefix arg or two prefix
arg."
(with-helm-current-buffer
(if buffer-read-only
(error "Error: Buffer `%s' is read-only" (buffer-name))
(let* ((mkds (helm-marked-candidates :with-wildcard t))
(candidate (car mkds))
(end (point))
(tap (helm-ffap-guesser))
(guess (and (stringp tap)
(substring-no-properties tap)))
(beg (helm-aif (and guess
(save-excursion
(when (re-search-backward
(regexp-quote guess)
(pos-bol) t)
(point))))
it (point)))
(full-path-p (and (stringp guess)
(or (string-match-p
(concat "^" (getenv "HOME"))
guess)
(string-match-p
"\\`\\(/\\|[[:lower:][:upper:]]:/\\)"
guess))))
(escape-fn (if (memq major-mode
helm-modes-using-escaped-strings)
#'shell-quote-argument #'identity)))
(when (and beg end)
(delete-region beg end))
(insert
(funcall
escape-fn
(helm-ff--format-fname-to-insert
candidate beg end full-path-p guess
helm-current-prefix-arg))
(if (cdr mkds) " " "")
(mapconcat escape-fn
(cl-loop for f in (cdr mkds)
collect (helm-ff--format-fname-to-insert
f nil nil nil nil
helm-current-prefix-arg))
" "))))))
(defun helm-ff--format-fname-to-insert (candidate
&optional beg end full-path guess prefarg)
(set-text-properties 0 (length candidate) nil candidate)
(if (and beg end guess (not (string= guess ""))
(null prefarg)
(or (string-match
"^\\(~/\\|/\\|[[:lower:][:upper:]]:/\\)"
guess)
(file-exists-p candidate)))
(cond (full-path
(expand-file-name candidate))
((string= (match-string 1 guess) "~/")
(abbreviate-file-name candidate))
(t (file-relative-name candidate)))
(helm-acase prefarg
((4) (abbreviate-file-name candidate))
((16) (file-relative-name candidate))
((64) (helm-basename candidate))
(t candidate))))
(cl-defun helm-find-files-history (arg &key (comp-read t))
"The `helm-find-files' history.
Show the first `helm-ff-history-max-length' elements of
`helm-ff-history' in an `helm-comp-read'."
(interactive "p")
(let ((history (when helm-ff-history
(helm-fast-remove-dups helm-ff-history
:test 'equal))))
(when history
(setq helm-ff-history
(if (>= (length history) helm-ff-history-max-length)
(helm-take history helm-ff-history-max-length)
history))
(if comp-read
(let ((src (helm-build-sync-source "Helm Find Files History"
:candidates helm-ff-history
:fuzzy-match (helm-ff-fuzzy-matching-p)
:persistent-action 'ignore
:migemo t
:action (lambda (candidate)
(if arg
(helm-set-pattern
(expand-file-name candidate))
(identity candidate))))))
(helm :sources src
:resume 'noresume
:buffer helm-ff-history-buffer-name
:allow-nest t))
helm-ff-history))))
(put 'helm-find-files-history 'helm-only t)
;; The `helm-drag-mouse-1-fn' for helm-find-files, it is bound to
;; in `helm--bind-mouse-for-selection'.
;; See https://freedesktop.org/wiki/Specifications/XDND/
;; and (info "(elisp) Drag and Drop") for more infos.
(defun helm-ff-mouse-drag (event)
"Drag-and-drop marked files at EVENT.
It is the drag-an-drop function of dired adapted for helm-find-files."
(interactive "e")
(when mark-active (deactivate-mark))
(let ((action helm-ff-drag-mouse-1-default-action))
(save-excursion
(with-selected-window (posn-window (event-end event))
(goto-char (posn-point (event-end event))))
(track-mouse
(let ((beginning-position (mouse-pixel-position))
new-event)
(catch 'track-again
(setq new-event (read-event))
(if (not (eq (event-basic-type new-event) 'mouse-movement))
(when (eq (event-basic-type new-event) 'mouse-1)
(push new-event unread-command-events))
(let ((current-position (mouse-pixel-position)))
;; If the mouse didn't move far enough, don't
;; inadvertently trigger a drag.
(when (and (eq (car current-position) (car beginning-position))
(ignore-errors
(and (> 3 (abs (- (cadr beginning-position)
(cadr current-position))))
(> 3 (abs (- (caddr beginning-position)
(caddr current-position)))))))
(throw 'track-again nil)))
;; We can get an error if there's by some chance no file
;; name at point.
(condition-case error
(let ((files (with-helm-window (helm-marked-candidates))))
(dnd-begin-drag-files files nil action t))
(error (when (eq (event-basic-type new-event) 'mouse-1)
(push new-event unread-command-events))
;; Errors from `dnd-begin-drag-files' should be
;; treated as user errors, since they should
;; only occur when the user performs an invalid
;; action, such as trying to create a link to
;; a remote file.
(user-error (cadr error)))))))))))
(put 'helm-ff-mouse-drag 'helm-only t)
(defvar helm-dnd-protocol-alist
'(("^file:///" . helm-dnd-handle-local-file)
("^file://" . helm-dnd-handle-file)
("^file:" . helm-dnd-handle-local-file))
"The functions to call when dropping to helm-buffer.
Prevent dropping to helm buffer when user starts a drag-and-drop action
and release the mouse in this same buffer.")
(defun helm-dnd-handle-local-file (_uri _action)
"Prevent dropping files to helm buffer."
(user-error "Can't drop files in helm buffer"))
(defun helm-dnd-handle-file (_uri _action)
"Prevent dropping files to helm buffer."
(user-error "Can't drop files in helm buffer"))
;; This is used to advice `x-dnd-handle-drag-n-drop-event'.
(defun helm-ff--restore-frame (&rest _args)
(let ((hframe (window-frame (helm-window))))
(if (eql (selected-frame) hframe)
(select-window (active-minibuffer-window))
(select-frame hframe))))
(defun helm-find-files-1 (fname &optional preselect)
"Find FNAME filename with PRESELECT filename preselected.
Use it for non-interactive calls of `helm-find-files'."
(require 'tramp)
(require 'dnd)
;; Resolve FNAME now outside of helm.
;; [FIXME] When `helm-find-files-1' is used directly from lisp
;; and FNAME is an abbreviated path, for some reasons
;; `helm-update' is called many times before resolving
;; the abbreviated path (Bug#1939) so be sure to pass a
;; full path to helm-find-files-1.
(unless (string-match-p helm-ff-url-regexp fname)
(setq fname (expand-file-name (substitute-in-file-name fname))))
(when (get-buffer helm-action-buffer)
(kill-buffer helm-action-buffer))
(setq helm-find-files--toggle-bookmark nil)
(let* ( ;; Be sure we don't erase the precedent minibuffer if some.
(helm-ff-auto-update-initial-value
(and helm-ff-auto-update-initial-value
(not (minibuffer-window-active-p (minibuffer-window)))))
(tap (thing-at-point 'filename))
(def (and tap (or (file-remote-p tap)
(expand-file-name tap))))
;; Ensure not being prompted for password each time we
;; navigate to a directory.
(password-cache t))
(helm-set-local-variable 'helm-follow-mode-persistent nil)
(when (fboundp 'dnd-begin-drag-files)
(helm-set-local-variable 'helm-drag-mouse-1-fn 'helm-ff-mouse-drag
'dnd-protocol-alist
(append helm-dnd-protocol-alist dnd-protocol-alist))
(advice-add 'x-dnd-handle-drag-n-drop-event :after #'helm-ff--restore-frame))
(unless helm-source-find-files
(setq helm-source-find-files (helm-make-source
"Find Files" 'helm-source-ffiles)))
(when (helm-get-attr 'follow helm-source-find-files)
(helm-set-attr 'follow -1 helm-source-find-files))
;; If preselected candidate is further than `helm-ff-candidate-number-limit'
;; in the directory file list, we have to increase `candidate-number-limit'
;; attr to have this candidate visible for preselection. NOTE:
;; When HFF has yet not been launched in this directory the maximum length
;; of this directory is unknown and candidate will NOT be selected until
;; next time we call HFF on this same buffer.
(helm-aif (and preselect
(not helm-ff-preselect-ignore-large-dirs)
(gethash fname helm-ff--directory-files-length
helm-ff-candidate-number-limit))
(helm-set-attr 'candidate-number-limit
(max it helm-ff-candidate-number-limit)
helm-source-find-files))
(helm-ff-setup-update-hook)
(add-hook 'helm-resume-after-hook 'helm-ff--update-resume-after-hook)
(unwind-protect
(helm :sources '(helm-source-find-files helm-find-files-dummy-source)
:input fname
:case-fold-search helm-file-name-case-fold-search
:preselect preselect
:ff-transformer-show-only-basename
helm-ff-transformer-show-only-basename
:dim-prompt-on-update helm-ff-dim-prompt-on-update
:default def
:prompt "Find files or url: "
:buffer "*helm find files*")
(helm-ff--update-resume-after-hook nil t)
(setq helm-ff-default-directory nil)
(advice-remove 'x-dnd-handle-drag-n-drop-event 'helm-ff--restore-frame))))
(defvar helm-find-files-dummy-source
(helm-build-dummy-source "New file or directory"
:filtered-candidate-transformer
(lambda (_candidates _source)
(unless (file-exists-p helm-pattern)
(list (helm-ff-filter-candidate-one-by-one helm-pattern nil t))))
:all-marked t
:keymap 'helm-find-files-map
:action 'helm-find-files-actions
:action-transformer 'helm-find-files-dummy-action-transformer))
(defun helm-find-files-dummy-action-transformer (actions candidate)
"Action transformer for `helm-find-files-dummy-source'."
(let (cand-no-linum linum)
(cond ((and helm--url-regexp
(not (string-match-p helm--url-regexp candidate))
(string-match "\\(:[[:digit:]]+:?\\)\\'" candidate)
(file-exists-p
(setq cand-no-linum (replace-match "" t t candidate 1))))
(setq linum (replace-regexp-in-string
":" "" (match-string 1 candidate)))
(helm-append-at-nth
actions
`(("Find file to line number"
. ,(lambda (_candidate)
(find-file cand-no-linum)
(helm-goto-line (string-to-number linum) t))))
1))
(t actions))))
(defun helm-ff--update-resume-after-hook (sources &optional nohook)
"Meant to be used in `helm-resume-after-hook'.
When NOHOOK is non-nil run inconditionally, otherwise only when
source is `helm-source-find-files'."
;; When using the action `helm-find-files-load-files' on helm-files.el,
;; `helm-source-find-files' is reseted to nil hence error when calling
;; `helm-set-attr' outside helm => "no buffer named *helm*".
(unless helm-source-find-files
(setq helm-source-find-files (helm-make-source
"Find Files" 'helm-source-ffiles)))
(when (or nohook (string= "Find Files"
(assoc-default 'name (car sources))))
(helm-set-attr 'resume `(lambda ()
(helm-ff-setup-update-hook)
(setq helm-ff-default-directory
,helm-ff-default-directory
helm-ff-last-expanded
,helm-ff-last-expanded))
helm-source-find-files)))
(defun helm-ff-clean-initial-input ()
;; When using hff in an external frame initial input is printed in
;; the minibuffer of initial-frame, delete it.
(with-selected-frame helm-initial-frame
(helm-clean-up-minibuffer)))
(defun helm-ff-setup-update-hook ()
(dolist (hook '(helm-ff-clean-initial-input ; Add to be called first.
helm-ff-update-when-only-one-matched
helm-ff-auto-expand-to-home-or-root))
(add-hook 'helm-after-update-hook hook)))
(defun helm-find-files-cleanup ()
(mapc (lambda (hook)
(remove-hook 'helm-after-update-hook hook))
'(helm-ff-auto-expand-to-home-or-root
helm-ff-update-when-only-one-matched
helm-ff-clean-initial-input))
(maphash (lambda (k _v)
(when (member k helm-ff--thumbnailed-directories)
(remhash k helm-ff--list-directory-cache)))
helm-ff--list-directory-cache)
(setq helm-ff--show-directories-only nil
helm-ff--show-files-only nil
helm-ff--show-thumbnails nil
helm-ff--thumbnailed-directories nil)
(helm-ff-clean-image-cache))
(defun helm-ff-bookmark ()
(helm :sources 'helm-source-bookmark-helm-find-files
:buffer "*helm ff bookmarks*"))
(defun helm-find-files-switch-to-bookmark ()
"Switch to helm-bookmark for `helm-find-files' from `helm-find-files.'"
(interactive)
(require 'helm-bookmark)
(with-helm-alive-p
(helm-run-after-exit 'helm-ff-bookmark)))
(put 'helm-find-files-switch-to-bookmark 'helm-only t)
(defun helm-ff-bookmark-insert-location ()
"Insert helm-find-files bookmark in minibuffer."
(interactive)
(require 'helm-bookmark)
(with-helm-alive-p
(helm :sources (helm-bookmark-build-source
"bookmark insert location"
'helm-bookmark-helm-find-files-setup-alist
'helm-source-in-buffer
:filtered-candidate-transformer
'(helm-adaptive-sort
helm-highlight-bookmark)
:action (lambda (candidate)
(with-selected-window (minibuffer-window)
(delete-minibuffer-contents)
(bookmark-insert-location candidate))))
:buffer "*helm bookmark insert*"
:allow-nest t)))
(put 'helm-ff-bookmark-insert-location 'helm-only t)
(defun helm-find-files-initial-input (&optional input)
"Return INPUT if present, otherwise try to guess it."
(let ((guesser (helm-acase (helm-ffap-guesser)
("" nil)
(t it))))
(unless (eq major-mode 'image-mode)
(if input
(if (or (file-remote-p input)
(string-match helm-ff-url-regexp input))
input
(expand-file-name input))
(helm-find-files-input
(if (and helm-ff-allow-non-existing-file-at-point
guesser
(not (string-match ffap-url-regexp guesser)))
;; Keep the ability of jumping to numbered lines even
;; when allowing non existing filenames at point.
(helm-aand guesser
(thing-at-point 'filename)
(replace-regexp-in-string
":[0-9]+\\'" "" it))
guesser)
(thing-at-point 'filename))))))
(defun helm-ffap-guesser ()
"Same as `ffap-guesser' but without gopher and machine support."
(require 'ffap)
;; Avoid "Stack overflow in regexp matcher" error
;; in evil `ffap-guesser' by removing crap `ffap-gopher-at-point'
;; (bug fixed in emacs-26 http://debbugs.gnu.org/cgi/bugreport.cgi?bug=25391) .
;; `ffap-machine-at-point' have been removed too as it was anyway
;; 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'
;; 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)
(let ((beg (save-excursion (dired-move-to-filename)))
(end (save-excursion (dired-move-to-end-of-filename t))))
(helm-aif (and beg end (member (buffer-substring beg end)
'("." "..")))
(concat (file-name-as-directory
(expand-file-name dired-directory))
(car it))
(dired-get-filename 'no-dir t)))
(let* ((beg (and (use-region-p) (region-beginning)))
(end (and (use-region-p) (region-end)))
(str (and beg end (buffer-substring-no-properties beg end)))
(ffap (or (helm-aand helm-ff-guess-ffap-urls ffap-url-regexp
(ffap-url-at-point)
(ffap-fixup-url it)
(and (string-match ffap-url-regexp it) it))
(and helm-ff-guess-ffap-urls ffap-url-regexp
(fboundp 'ffap-fixup-email) ; Emacs-30
(ffap-fixup-email (thing-at-point 'email)))
(ffap-file-at-point))))
;; Workaround emacs bugs:
;; When the region is active and a file is detected
;; `ffap-string-at-point' returns the region prefixed with
;; "/", e.g. at a beginning of a patch (first bug) and make
;; `file-remote-p' returning an error (second bug), so in such
;; case returns the region itself instead of the region
;; corrupted by ffap.
(if (and str ffap) str ffap)))))
(defun helm-find-files-input (file-at-pt thing-at-pt)
"Try to guess a default input for `helm-find-files'."
(let* ((non-essential t)
(remp (or (and file-at-pt (file-remote-p file-at-pt))
(and thing-at-pt (file-remote-p thing-at-pt))))
(def-dir (helm-current-directory))
(urlp (and file-at-pt helm--url-regexp
(string-match helm--url-regexp file-at-pt)))
(lib (when helm-ff-search-library-in-sexp
(helm-find-library-at-point)))
(hlink (helm-ff-find-url-at-point))
(file-p (and file-at-pt
(not (string= file-at-pt ""))
(not remp)
(or (file-exists-p file-at-pt)
helm-ff-allow-non-existing-file-at-point)
(not urlp)
thing-at-pt
(not (string= thing-at-pt ""))
(file-exists-p
(file-name-directory
(expand-file-name thing-at-pt def-dir))))))
(cond (lib) ; e.g we are inside a require sexp.
(hlink) ; String at point is an hyperlink.
(file-p ; a regular file
(and file-at-pt (if (not (member (helm-basename file-at-pt)
'("." "..")))
(expand-file-name file-at-pt)
file-at-pt)))
(urlp (helm-html-decode-entities-string file-at-pt)) ; possibly an url or email.
((and file-at-pt
(not remp)
(or helm-ff-allow-non-existing-file-at-point
(file-exists-p file-at-pt)))
(expand-file-name file-at-pt)))))
(defun helm-ff-find-url-at-point ()
"Try to find link to an url in text-property at point."
(let* ((he (get-text-property (point) 'help-echo))
(ov (overlays-at (point)))
(ov-he (and ov (overlay-get
(car (overlays-at (point))) 'help-echo)))
(w3m-l (get-text-property (point) 'w3m-href-anchor))
(nt-prop (get-text-property (point) 'nt-link)))
;; Org link.
(when (and (stringp he) (string-match "^LINK: " he))
(setq he (replace-match "" t t he)))
(cl-loop for i in (list he ov-he w3m-l nt-prop)
thereis (and (stringp i) helm--url-regexp (string-match helm--url-regexp i) i))))
(defun helm-find-library-at-point ()
"Try to find library path at point.
Find inside `require' and `declare-function' sexp."
(require 'find-func)
(let* ((beg-sexp (save-excursion (search-backward "(" (pos-bol) t)))
(end-sexp (save-excursion (ignore-errors (end-of-defun)) (point)))
(sexp (and beg-sexp end-sexp
(buffer-substring-no-properties
(1+ beg-sexp) (1- end-sexp)))))
(ignore-errors
(cond (;; Should work only when point is on the use-package line
;; i.e. first line of sexp otherwise it prevents matching
;; urls with helm-find-files (bug #2469).
(and sexp (string-match "use-package +\\([^ )\n]+\\)" sexp))
(find-library-name (match-string 1 sexp)))
((and sexp (string-match "require +[']\\([^ )]+\\)" sexp))
;; If require use third arg, ignore it,
;; always use library path found in `load-path'.
(find-library-name (match-string 1 sexp)))
;; Assume declare-function sexps are on one line.
((and sexp (string-match "declare-function .+? \"\\(?:ext:\\)?\\([^ )]+\\)\"" sexp))
(find-library-name (match-string 1 sexp)))
(t nil)))))
;;; Handle copy, rename, symlink, relsymlink and hardlink from helm.
;;
;;
(defun helm-ff--valid-default-directory ()
(with-helm-current-buffer
(cl-loop for b in (buffer-list)
for cd = (with-current-buffer b default-directory)
when (eq (car (file-attributes cd)) t)
return cd)))
(cl-defun helm-dired-action (destination
&key action follow (files (dired-get-marked-files)))
"Execute ACTION on FILES to DESTINATION.
Where ACTION is a symbol that can be one of:
\\='copy', \\='rename', \\='symlink', \\='relsymlink', \\='hardlink' or \\='backup'.
Argument FOLLOW when non-nil specifies 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)
;; be sure to use a valid value to give to dired-create-file.
;; i.e start-process is creating a process buffer based on default-directory.
(let ((default-directory (helm-ff--valid-default-directory))
(fn (cl-case action
(copy 'dired-copy-file)
(rename 'dired-rename-file)
(symlink 'make-symbolic-link)
(relsymlink 'dired-make-relative-symlink)
(hardlink 'dired-hardlink)
(backup 'backup-file)))
(marker (cl-case action
((copy rename backup) dired-keep-marker-copy)
(symlink dired-keep-marker-symlink)
(relsymlink dired-keep-marker-relsymlink)
(hardlink dired-keep-marker-hardlink)))
(dirflag (and (= (length files) 1)
(file-directory-p (car files))
(not (file-directory-p destination))))
(dired-async-state (if (and (boundp 'dired-async-mode)
dired-async-mode)
1 -1)))
(and follow (fboundp 'dired-async-mode) (dired-async-mode -1))
;; When dired-create-destination-dirs is available (emacs-27.1+) such error
;; is handled later in dired-create-files.
(when (and (null (boundp 'dired-create-destination-dirs))
(cdr files) (not (file-directory-p destination)))
(error "%s: target `%s' is not a directory" action destination))
(unwind-protect
(dired-create-files
fn (symbol-name action) files
(if (file-directory-p destination)
;; When DESTINATION is a directory, build file-name in this directory.
;; Else we use DESTINATION.
(lambda (from)
(expand-file-name (file-name-nondirectory from) destination))
(lambda (_from) destination))
marker)
(and (fboundp 'dired-async-mode)
(dired-async-mode dired-async-state)))
(push (file-name-as-directory
(if (file-directory-p destination)
(expand-file-name destination)
(file-name-directory destination)))
helm-ff-history)
;; If follow is non--nil we should not be in async mode.
(when (and follow
(not (memq action '(symlink relsymlink hardlink)))
(not (get-buffer dired-log-buffer)))
(let ((target (directory-file-name destination))
(cands-to-mark (helm-get-dest-fnames-from-list files destination dirflag)))
(with-helm-after-update-hook (helm-ff-maybe-mark-candidates cands-to-mark))
;; Wait for the notify callback ends before calling HFF.
(run-at-time
0.1 nil
(lambda ()
(if (and dirflag (eq action 'rename))
(helm-find-files-1 (file-name-directory target)
(format helm-ff-last-expanded-candidate-regexp
(if helm-ff-transformer-show-only-basename
(helm-basename target) target)))
(helm-find-files-1 (if (file-directory-p destination)
(file-name-as-directory
(expand-file-name destination))
(expand-file-name (helm-basedir destination)))
(format helm-ff-last-expanded-candidate-regexp
(if helm-ff-transformer-show-only-basename
(helm-basename (car files))
(car files)))))))))))
(defun helm-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
"Transform filenames of FLIST to abs of DEST-CAND.
If RENAME-DIR-FLAG is non-nil collect the `directory-file-name'
of transformed members of FLIST."
;; At this point files have been renamed/copied at destination.
;; That's mean DEST-CAND exists.
(cl-loop
with dest = (expand-file-name dest-cand)
for src in flist
for basename-src = (helm-basename src)
for fname = (cond (rename-dir-flag (directory-file-name dest))
((file-directory-p dest)
(concat (file-name-as-directory dest) basename-src))
(t dest))
when (file-exists-p fname)
collect fname into tmp-list
finally return (sort tmp-list 'string<)))
(defun helm-ff-maybe-mark-candidates (seq)
"Add visible mark to all candidates in SEQ.
This is used when copying/renaming/symlinking etc. and following
files to destination."
(when (and (string= (assoc-default 'name (helm-get-current-source))
(assoc-default 'name helm-source-find-files))
seq)
(with-helm-window
(while seq
(if (string= (car seq) (helm-get-selection))
(progn
(helm-make-visible-mark)
(helm-next-line)
(setq seq (cdr seq)))
(helm-next-line)))
(unless (helm-this-visible-mark)
(helm-prev-visible-mark)))))
;;; Compress/uncompress files
;;
;;
(define-minor-mode helm-ff--compress-async-modeline-mode
"Notify mode-line that an async process run."
:group 'dired-async
:global t
:lighter (:eval (propertize (format " [%s async job (Un)compressing file(s)]"
(length (dired-async-processes
'helm-async-compress)))
'face 'helm-delete-async-message))
(unless helm-ff--compress-async-modeline-mode
(let ((visible-bell t)) (ding))))
(defun helm-do-compress-to (ifiles ofile)
"Compress IFILES files/directories to the OFILE archive.
Choose the archiving command based on the OFILE extension
and `dired-compress-files-alist'."
(let ((cmd (cl-loop for (r . c) in dired-compress-files-alist
when (string-match r ofile) return c))
(error-file (expand-file-name
"dired-shell-command-output" temporary-file-directory)))
(cl-assert
cmd nil
"No compression rule found for %s, see `dired-compress-files-alist'" ofile)
(when (and (file-exists-p ofile)
(not (y-or-n-p
(format "%s exists, overwrite?"
(abbreviate-file-name ofile)))))
(message "Compression aborted"))
(message "Compressing %d file(s) to `%s'..."
(length ifiles) (helm-basename ofile))
(process-put
(async-start
`(lambda ()
(require 'cl-lib)
(require 'dired-aux)
(let* ((default-directory
(cl-loop with base = (car ',ifiles)
for file in ',ifiles
do (setq base (fill-common-string-prefix base file))
finally return (file-name-directory base)))
(local-name (shell-quote-argument (file-local-name ,ofile)))
(input (mapconcat
(lambda (in-file)
(shell-quote-argument (file-relative-name in-file)))
',ifiles " "))
process-status)
(when (not (zerop
(setq process-status
(dired-shell-command
(format-spec ,cmd `((?o . ,local-name) (?i . ,input)))))))
(let ((error-output (with-current-buffer " *dired-check-process output*"
(buffer-string))))
(with-temp-file ,error-file
(insert error-output))))
process-status))
(lambda (result)
(unless (dired-async-processes 'helm-async-compress)
(helm-ff--compress-async-modeline-mode -1))
(if (zerop result) ; dired-shell-command succeed.
(progn
(message "Compressed %d file(s) to `%s' done"
(length ifiles)
(file-name-nondirectory ofile))
(run-with-timer
0.1 nil
(lambda (flist dest)
(dired-async-mode-line-message
"%s %d file(s) to %s done"
'helm-delete-async-message
"Compressing"
(length flist) (helm-basename dest)))
ifiles ofile))
(when (file-exists-p error-file)
(pop-to-buffer (find-file-noselect error-file))))))
'helm-async-compress t)
(helm-ff--compress-async-modeline-mode 1)))
(defun helm-ff--dired-compress-file (file)
;; `dired-compress-file' doesn't take care of binding `default-directory' when
;; uncompressing FILE, as a result FILE is uncompressed in the directory where
;; helm was started i.e. the current value of `default-directory'.
(with-helm-default-directory helm-ff-default-directory
(dired-compress-file file)))
(defun helm-ff-quick-compress (_candidate)
"Compress or uncompress marked files without quitting."
(with-helm-window
(let (cfile)
(unwind-protect
(helm-read-answer-dolist-with-action
"Compress or uncompress file `%s'? "
(helm-marked-candidates)
(lambda (c)
(setq cfile (save-selected-window
(helm-ff--dired-compress-file c)))
(message nil)
(helm--remove-marked-and-update-mode-line c))
#'abbreviate-file-name)
(setq helm-marked-candidates nil
helm-visible-mark-overlays nil)
(helm-force-update
(let ((presel (helm-get-selection)))
;; FIXME: Probably this would never happen, I see no cases here where
;; helm-get-selection doesn't exist.
(unless (file-exists-p presel)
(setq presel cfile))
(when presel
(format helm-ff-last-expanded-candidate-regexp
(regexp-quote
(if (and helm-ff-transformer-show-only-basename
(not (helm-ff-dot-file-p presel)))
(helm-basename presel) presel))))))))))
(helm-make-persistent-command-from-action helm-ff-persistent-compress
"Compress or uncompress marked candidates without quitting."
'quick-compress 'helm-ff-quick-compress)
;;; Delete and trash files
;;
;;
(defun helm-file-buffers (filename)
"Return a list of buffer names corresponding to FILENAME."
(cl-loop with name = (expand-file-name filename)
for buf in (buffer-list)
for bfn = (buffer-file-name buf)
when (and bfn (string= name bfn))
collect (buffer-name buf)))
(defun helm-ff--delete-by-moving-to-trash (file)
"Decide to trash or delete FILE.
Return non-nil when FILE needs to be trashed."
(let ((remote (file-remote-p file)))
(or
(and delete-by-moving-to-trash
(null helm-current-prefix-arg)
(null current-prefix-arg)
(or (and remote helm-trash-remote-files)
(null remote)))
(and (null delete-by-moving-to-trash)
(or helm-current-prefix-arg
current-prefix-arg)
(or (and remote helm-trash-remote-files)
(null remote))))))
(defun helm-trash-directory ()
"Try to find a trash directory.
Return the \"files\" subdirectory of trash directory.
When `helm-trash-default-directory' is set use it as trash directory."
(let* ((xdg-data-dir
(or helm-trash-default-directory
(directory-file-name
(expand-file-name "Trash"
(or (getenv "XDG_DATA_HOME")
"~/.local/share")))))
(trash-files-dir (expand-file-name "files" xdg-data-dir)))
;; Just return nil if the Trash directory is not yet created. It will be
;; created later by `delete-directory'.
(and (file-exists-p trash-files-dir) trash-files-dir)))
(cl-defun helm-ff-file-already-trashed (file &optional (trash-alist nil strash-alist))
"Return FILE when it is already in trash.
Optional arg TRASH-ALIST should be an alist as what
`helm-ff-trash-list' returns."
(unless (or (fboundp 'system-move-file-to-trash)
(and strash-alist (null trash-alist)))
(let ((trash-files-dir (helm-trash-directory)))
(cl-loop for (_bn . fn) in (or trash-alist
(helm-ff-trash-list trash-files-dir))
thereis (and (file-equal-p file fn) file)))))
(defun helm-ff-quick-delete (_candidate)
"Delete file CANDIDATE without quitting.
When a prefix arg is given, meaning of
`delete-by-moving-to-trash' is the opposite."
(with-helm-window
(let* ((marked (helm-marked-candidates))
(trash (helm-ff--delete-by-moving-to-trash (car marked)))
(helm-ff--trashed-files
(and trash (helm-ff-trash-list (helm-trash-directory))))
(old--allow-recursive-deletes helm-ff-allow-recursive-deletes)
(buffers (cl-loop for f in marked
append (helm-file-buffers f))))
(unwind-protect
(progn
(helm-read-answer-dolist-with-action
"Really %s file `%s'"
marked
(lambda (file) (helm-ff--quick-delete-action file trash))
(list (if trash "Trash" "Delete") #'abbreviate-file-name))
(when buffers
(helm-read-answer-dolist-with-action
"Kill buffer `%s', too? "
buffers #'kill-buffer)))
(setq helm-marked-candidates nil
helm-visible-mark-overlays nil)
(helm-force-update
(let ((presel (helm-get-selection)))
(when presel
(format helm-ff-last-expanded-candidate-regexp
(regexp-quote (if (and helm-ff-transformer-show-only-basename
(not (helm-ff-dot-file-p presel)))
(helm-basename presel) presel))))))
(setq helm-ff-allow-recursive-deletes old--allow-recursive-deletes)))))
(defun helm-ff--quick-delete-action (candidate trash)
"Delete or trash CANDIDATE and remove it from display."
(helm-preselect
(format helm-ff-last-expanded-candidate-regexp
(regexp-quote
(if (and helm-ff-transformer-show-only-basename
(not (helm-ff-dot-file-p candidate)))
(helm-basename candidate) candidate))))
(helm-acase (helm-delete-file
candidate helm-ff-signal-error-on-dot-files
trash)
(skip
;; This happens only when trying to
;; trash a file already trashed.
(helm-delete-visible-mark (helm-this-visible-mark))
(if (helm-end-of-source-p)
(helm-previous-line)
(helm-next-line)))
(t (helm-delete-current-selection)))
(message nil)
(helm--remove-marked-and-update-mode-line candidate))
(defun helm-delete-file (file &optional error-if-dot-file-p trash)
"Delete FILE after querying the user.
When a prefix arg is given, meaning of
`delete-by-moving-to-trash' is the opposite.
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.
When TRASH is non nil, trash FILE even if `delete-by-moving-to-trash'
is nil."
(require 'dired)
(cl-block nil
(when (and error-if-dot-file-p
(helm-ff-dot-file-p file))
(error "Error: Cannot operate on `.' or `..'"))
(let ((helm--reading-passwd-or-string t)
(file-attrs (file-attributes file))
(trash (or trash (helm-ff--delete-by-moving-to-trash file)))
(delete-by-moving-to-trash trash))
(cond ((and (eq (nth 0 file-attrs) t) ; a not empty directory.
(directory-files file t directory-files-no-dot-files-regexp))
(if (or helm-ff-allow-recursive-deletes trash)
(delete-directory file 'recursive trash)
(helm-acase (helm-read-answer
(format "Recursive delete of `%s'? [y,n,!,q,h]"
(abbreviate-file-name file))
'("y" "n" "!" "q")
#'helm-read-answer-default-help-fn)
("y" (delete-directory file 'recursive trash))
("!" (setq helm-ff-allow-recursive-deletes t)
(delete-directory file 'recursive trash))
("n" (cl-return 'skip))
("q" (throw 'helm-abort-delete-file
(progn
(message "Abort file deletion") (sleep-for 1)))))))
((eq (nth 0 file-attrs) t) ; a directory.
(delete-directory file nil trash))
(t (delete-file file trash))))))
(defun helm-delete-marked-files (_ignore)
"Delete marked files with `helm-delete-file'.
When a prefix arg is given, meaning of
`delete-by-moving-to-trash' is the opposite."
(let* ((files (helm-marked-candidates :with-wildcard t))
(len 0)
(trash (helm-ff--delete-by-moving-to-trash (car files)))
(helm-ff--trashed-files
(and trash (helm-ff-trash-list (helm-trash-directory))))
(prmt (if trash "Trash" "Delete"))
(old--allow-recursive-deletes helm-ff-allow-recursive-deletes)
(buffers (cl-loop for f in files
append (helm-file-buffers f))))
(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)")
(catch 'helm-abort-delete-file
(unwind-protect
(progn
(dolist (i files)
(set-text-properties 0 (length i) nil i)
(let ((res (helm-delete-file
i helm-ff-signal-error-on-dot-files trash)))
(if (eq res 'skip)
(progn (message "Directory is not empty, skipping")
(sleep-for 1))
(cl-incf len))))
(when buffers
(helm-read-answer-dolist-with-action
"Kill buffer `%s', too? "
buffers #'kill-buffer)))
(setq helm-ff-allow-recursive-deletes old--allow-recursive-deletes)))
(message "%s File(s) %s" len (if trash "trashed" "deleted"))))))
;;; Delete files async
;;
;;
(defvar helm-ff-delete-log-file
(locate-user-emacs-file "helm-delete-file.log")
"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
:lighter (:eval (propertize (format " %s file(s) async [%s job]..."
(if helm-ff--trash-flag
"Trashing" "Deleting")
(length (dired-async-processes
'helm-delete-async)))
'face 'helm-delete-async-message))
(unless helm-ff--delete-async-modeline-mode
(let ((visible-bell t)) (ding))
(setq helm-ff--trash-flag nil)))
(defalias 'helm-delete-async-mode-line-message 'dired-async-mode-line-message)
(make-obsolete 'helm-delete-async-mode-line-message
'dired-async-mode-line-message "3.9.8")
(defun helm-delete-async-kill-process ()
"Kill async process created by helm delete files async."
(interactive)
(let* ((processes (dired-async-processes))
(proc (car (last processes))))
(and proc (delete-process proc))
(unless (> (length processes) 1)
(helm-ff--delete-async-modeline-mode -1))))
(defun helm-delete-marked-files-async (_ignore)
"Same as `helm-delete-marked-files' but async.
When a prefix arg is given, meaning of
`delete-by-moving-to-trash' is the opposite.
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 (helm-ff--delete-by-moving-to-trash (car files)))
(prmt (if trash "Trash" "Delete"))
buffers callback
;; Workaround emacs-26 bug with tramp see
;; https://github.com/jwiegley/emacs-async/issues/80.
(async-quiet-switch "-q"))
(cl-loop for f in files
for buf = (helm-file-buffers f)
for dot-file-p = (helm-ff-dot-file-p f)
when (and helm-ff-signal-error-on-dot-files
dot-file-p)
do (cl-return (error "Error: Cannot operate on `.' or `..'"))
when buf
do (setq buffers (nconc buf buffers)))
(setq callback (lambda (result)
(unless (dired-async-processes 'helm-delete-async)
(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
(helm-read-answer-dolist-with-action
"Kill buffer `%s', too? "
buffers #'kill-buffer))
(run-with-timer
0.1 nil
(lambda ()
(dired-async-mode-line-message
"%s (%s/%s) file(s) async done"
'helm-delete-async-message
(if trash "Trashing" "Deleting")
result (length files))))))
(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)")
(process-put
(async-start
`(lambda ()
(require 'cl-lib)
;; `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 ,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\n" err))))))))
callback)
'helm-delete-async t)
(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.
Called with one prefix arg open files in separate windows in a
vertical split.
Called with two prefix arg open files in background without
selecting them."
(let ((marked (helm-marked-candidates :with-wildcard t))
(url-p (and helm--url-regexp ; we should have only one candidate.
(string-match helm--url-regexp candidate)))
(ffap-newfile-prompt helm-ff-newfile-prompt-p)
(find-file-wildcards nil)
(helm--reading-passwd-or-string t))
(if (cdr marked)
(if (equal helm-current-prefix-arg '(16))
(mapc 'find-file-noselect marked)
;; If helm-current-prefix-arg is detected split is done
;; vertically.
(helm-window-show-buffers (mapcar 'find-file-noselect marked)))
(let ((dir (and (not url-p) (helm-basedir candidate))))
(cond ((and dir (file-directory-p dir))
(find-file (substitute-in-file-name candidate)))
(url-p (find-file-at-point candidate))
;; A a non--existing filename ending with /
;; Create a directory and jump to it.
((and (not (file-exists-p candidate))
(string-match "/$" candidate))
(helm-ff--mkdir candidate 'helm-ff))
;; A non--existing filename NOT ending with / or
;; an existing filename, create or jump to it.
;; If the basedir of candidate doesn't exists,
;; ask for creating it.
(dir
(helm-ff--mkdir dir)
(find-file candidate))
;; Find file at `default-directory' when basedir is
;; unspecified e.g user hit C-k foo RET.
(t (find-file candidate)))))))
(defun helm-ff-find-file-other-tab (_candidate)
"Display marked files in a new tab.
See `helm-buffers-switch-buffers-in-tab-1' for more infos."
(helm-buffers-switch-buffers-in-tab-1
(mapcar 'find-file-noselect (helm-marked-candidates))))
(helm-make-command-from-action helm-ff-run-find-file-other-tab
"Run find file in other tab action from `helm-find-files'."
'helm-ff-find-file-other-tab
(cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available"))
(defun helm-ff--new-dirs-to-update (path)
"Collect directories to update when creating new directory PATH."
(let ((result (list path)))
(helm-awhile (helm-reduce-file-name path 1)
(if (not (file-directory-p it))
(progn (push it result) (setq path it))
(push it result)
(cl-return)))
result))
(defun helm-ff--mkdir (dir &optional helm-ff)
(when (or (not confirm-nonexistent-file-or-buffer)
(y-or-n-p (format "Create directory `%s'? "
(abbreviate-file-name
(expand-file-name dir)))))
(let ((dirfname (directory-file-name dir))
(to-update (and helm-ff (helm-ff--new-dirs-to-update dir))))
(if (file-exists-p dirfname)
(error
"Mkdir: Unable to create directory `%s': file exists."
(helm-basename dirfname))
(make-directory dir 'parent))
(when helm-ff
;; Refresh cache.
(mapc (lambda (x) (helm-ff-directory-files x t)) to-update)
;; Allow having this new dir in history
;; to be able to retrieve it immediately
;; if we want to e.g copy a file from somewhere in it.
(setq helm-ff-default-directory
(file-name-as-directory (expand-file-name dir)))
(push helm-ff-default-directory helm-ff-history))
(or (and helm-ff (helm-find-files-1 dir)) t))))
(defun helm-transform-file-load-el (actions candidate)
"Add action to load the file CANDIDATE if it is an Emacs Lisp
file. Else return ACTIONS unmodified."
(if (member (file-name-extension candidate) '("el" "elc"))
(append actions '(("Load Emacs Lisp File" . load-file)))
actions))
(defun helm-transform-file-browse-url (actions candidate)
"Add an action to browse the file CANDIDATE if it is a HTML file or URL.
Else return ACTIONS unmodified."
(let ((browse-action '("Browse with Browser" . browse-url)))
(cond ((string-match "^http\\|^ftp" candidate)
(cons browse-action actions))
((string-match "\\.html?$" candidate)
(append actions (list browse-action)))
(t actions))))
(defun helm-file-on-mounted-network-p (file)
"Return non-nil when FILE is part of a mounted remote directory.
This function is checking `helm-mounted-network-directories'
list."
(when helm-mounted-network-directories
(cl-loop for dir in helm-mounted-network-directories
thereis (file-in-directory-p file dir))))
;; helm-find-files bindings for filecache
(defvar file-cache-alist)
(defun helm-ff-cache-add-file (_candidate)
(require 'filecache)
(let ((mkd (helm-marked-candidates :with-wildcard t)))
(mapc 'file-cache-add-file mkd)))
(defun helm-ff-file-cache-remove-file-1 (file)
"Remove FILE from `file-cache-alist'."
(let ((entry (assoc (helm-basename file) file-cache-alist))
(dir (helm-basedir file))
new-entry)
(setq new-entry (remove dir entry))
(when (= (length entry) 1)
(setq new-entry nil))
(setq file-cache-alist
(cons new-entry (remove entry file-cache-alist)))))
(defun helm-ff-file-cache-remove-file (_file)
"Remove marked files from `file-cache-alist.'"
(let ((mkd (helm-marked-candidates)))
(mapc 'helm-ff-file-cache-remove-file-1 mkd)))
;;; Find files in file
;;
;;
(defclass helm-find-files-in-file-class (helm-source-in-file helm-type-file) ())
(cl-defmethod helm--setup-source ((source helm-find-files-in-file-class))
(helm-aif (slot-value source 'candidate-transformer)
(setf (slot-value source 'candidate-transformer)
(append (helm-mklist it)
`(,(lambda (candidates)
(cl-loop for c in candidates
when (and (not (string= c ""))
(file-exists-p c))
collect c)))))))
(defun helm-find-files-in-file-build-source (file)
(helm-make-source
(format "Find files in `%s'" (helm-basename file))
'helm-find-files-in-file-class
:candidates-file file))
(defun helm-find-files-in-file (_file)
"Helm action for listing filenames listed in marked files."
(require 'helm-for-files)
(let ((sources (cl-loop for f in (helm-marked-candidates)
collect (helm-find-files-in-file-build-source f))))
(helm :sources sources
:quit-if-no-candidate (lambda ()
(message "No files found in file(s)"))
:buffer "*helm find files in files*")))
(cl-defun helm-ff-mcp (_candidate)
"Copy the car of marked candidates to the remaining marked candidates.
The car of marked should be a regular file and the rest of marked (cdr) should
be existing directories."
(let* ((mkd (helm-marked-candidates))
(file (car mkd))
(targets (cdr mkd))
(skipped 0)
operations)
(cl-assert (file-regular-p file) nil (format "ERROR: Not a regular file `%s'" file))
(cl-assert targets nil (format "ERROR: No destination specified for file `%s'" file))
(cl-assert (cl-loop for f in targets always (file-directory-p f)) nil
"ERROR: Destinations must be existing directories")
(when targets
(cl-loop with yes-for-all
for dest in targets
for dest-file = (expand-file-name (helm-basename file) dest)
for dir-ok = (file-accessible-directory-p dest)
for exists = (and dir-ok
(file-exists-p
(expand-file-name
(helm-basename file) dest)))
for overwrite = (or (null exists)
yes-for-all
(helm-acase (helm-read-answer
(format
"File `%s' already-exists, overwrite (y,n,!,q) ? "
dest-file)
'("y" "n" "!" "q"))
("y" t)
("n" nil)
("!" (prog1 t
(setq yes-for-all t)))
("q" (cl-return-from helm-ff-mcp
(message "Operation aborted")))))
if dir-ok
do (if overwrite
(push (list file (file-name-as-directory dest) overwrite) operations)
(cl-incf skipped))
else do (cl-incf skipped))
(when operations
(with-helm-display-marked-candidates
helm-marked-buffer-name
(mapcar #'abbreviate-file-name targets)
(if (y-or-n-p (format "Copy `%s' to directories?" (helm-basename file)))
(progn
(process-put
(async-start
`(lambda ()
(require 'cl-lib)
(cl-loop with copies = 0
with skipped = ,skipped
for (file dest overwrite) in ',operations
do (condition-case _err
(progn
(copy-file file dest overwrite)
(cl-incf copies))
(file-error (cl-incf skipped)))
finally return (list file copies skipped)))
(lambda (result)
(let ((copied (nth 1 result)))
(unless (dired-async-processes)
(dired-async--modeline-mode -1))
(run-with-idle-timer
0.1 nil
(lambda ()
(dired-async-mode-line-message
"Mcp done, %s %s of %s done, %s files skipped"
'dired-async-message
copied
(if (> copied 1)
"copies" "copy")
(helm-basename (nth 0 result))
(nth 2 result)))))))
'dired-async-process t)
(dired-async--modeline-mode 1))
(message "Operation aborted")))))))
(helm-make-command-from-action helm-ff-run-mcp
"Copy the car of marked candidates to the remaining marked candidates."
'helm-ff-mcp)
;;; File name history
;;
;;
(defun helm-files-save-file-name-history (&optional force)
"Save marked files to `file-name-history'."
(let* ((src (helm-get-current-source))
(src-name (assoc-default 'name src)))
(when (or force (helm-file-completion-source-p src)
(member src-name helm-files-save-history-extra-sources))
(let ((mkd (helm-marked-candidates :with-wildcard t))
(history-delete-duplicates t))
(cl-loop for sel in mkd
when (and sel
(stringp sel)
;; If file was one of HFF candidates assume it
;; is an existing file, so no need to call
;; file-exists-p which is costly on remote candidates.
;; (file-exists-p sel)
(not (helm-ff--file-directory-p sel))
;; When creating a new directory previous test
;; check for file-directory-p BEFORE its
;; creation, so check for ending slash as
;; well to know if it is a future directory.
(not (string-match "/\\'" sel)))
do
;; we use `abbreviate-file-name' here because
;; other parts of Emacs seems to,
;; and we don't want to introduce duplicates.
(add-to-history 'file-name-history
(abbreviate-file-name
(expand-file-name
;; See comments in `helm-recentf-source'
;; about bug#2709.
(substring-no-properties sel)))))))))
(add-hook 'helm-exit-minibuffer-hook 'helm-files-save-file-name-history)
(defvar helm-source-file-name-history
(helm-build-sync-source "File Name History"
:candidates 'file-name-history
:persistent-action #'ignore
;; See comments in `helm-recentf-source' about bug#2709.
:coerce 'substring-no-properties
:filtered-candidate-transformer #'helm-file-name-history-transformer
:action 'helm-type-file-actions))
(defun helm-file-name-history-show-or-hide-deleted ()
(interactive)
(setq helm-file-name-history-hide-deleted
(not helm-file-name-history-hide-deleted))
(helm-update))
(put 'helm-file-name-history-show-or-hide-deleted 'helm-only t)
(defvar helm-file-name-history-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "C-c d") 'helm-file-name-history-show-or-hide-deleted)
(define-key map (kbd "C-x C-f") 'helm-ff-file-name-history-run-ff)
map))
(defun helm-file-name-history-transformer (candidates _source)
(cl-loop with lgst = helm-file-name-history-max-length
for elm in candidates
for c = (truncate-string-to-width
elm helm-file-name-history-max-length nil nil t)
for disp = (cond ((or (file-remote-p elm)
(and (fboundp 'tramp-archive-file-name-p)
(tramp-archive-file-name-p c)))
(propertize c 'face 'helm-history-remote))
((file-exists-p elm)
(let ((last-access (format-time-string "%d/%m/%Y %X"
(nth 4 (file-attributes elm)))))
(propertize
elm 'display
(concat (propertize c 'face 'helm-ff-file)
(make-string (1+ (- lgst (length c))) ? )
last-access))))
(t (unless helm-file-name-history-hide-deleted
(propertize c 'face 'helm-history-deleted))))
when disp
collect (cons (if helm-ff-icon-mode
(concat (helm-x-icons-icon-for-file
(helm-basename elm))
" " disp)
disp)
elm)))
(defun helm-ff-file-name-history-ff (candidate)
(helm-set-pattern
(expand-file-name candidate)))
(helm-make-command-from-action helm-ff-file-name-history-run-ff
"Switch back to current HFF session with selection as preselect."
'helm-ff-file-name-history-ff)
(defun helm-ff-file-name-history-delete-item (_candidate)
(let ((files (helm-marked-candidates)))
(with-helm-display-marked-candidates
helm-marked-buffer-name
(helm-ff--count-and-collect-dups files)
(when (y-or-n-p "Delete file(s) from history? ")
(cl-loop for f in files do
(setq file-name-history (delete f file-name-history))))
(message nil))))
(defun helm-ff-file-name-history ()
"Switch to `file-name-history' without quitting `helm-find-files'."
(interactive)
(let ((src (helm-build-sync-source "File name history"
:init (lambda ()
(with-helm-alive-p
(when helm-ff-file-name-history-use-recentf
(require 'recentf)
(or recentf-mode (recentf-mode 1)))))
:candidate-number-limit (helm-aand (or (get 'file-name-history 'history-length)
history-length)
(and (numberp it) it))
:candidates (lambda ()
(if helm-ff-file-name-history-use-recentf
recentf-list
file-name-history))
:help-message 'helm-file-name-history-help-message
:fuzzy-match t
:persistent-action 'ignore
:migemo t
:filtered-candidate-transformer 'helm-file-name-history-transformer
:action (helm-make-actions
"Find file" (lambda (candidate)
(helm-set-pattern
(expand-file-name candidate))
(with-helm-after-update-hook (helm-exit-minibuffer)))
"Find file in helm" 'helm-ff-file-name-history-ff
"Delete candidate(s)" 'helm-ff-file-name-history-delete-item)
:keymap helm-file-name-history-map)))
(with-helm-alive-p
(helm :sources src
:buffer "*helm-file-name-history*"
:allow-nest t
:resume 'noresume))))
(put 'helm-ff-file-name-history 'helm-only t)
;;; Browse project
;; Need dependencies:
;;
;;
;; Only hg and git are supported for now.
(defvar helm--browse-project-cache (make-hash-table :test 'equal))
(defvar helm-buffers-in-project-p)
(defvar helm-browse-project-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-generic-files-map)
(define-key map (kbd "M-g a") 'helm-browse-project-run-ag)
map))
(defun helm-browse-project-get-buffers (root-directory)
(cl-loop for b in (helm-buffer-list)
;; FIXME: Why default-directory is root-directory
;; for current-buffer when coming from helm-quit-and-find-file.
for cd = (with-current-buffer b default-directory)
for bn = (buffer-file-name (get-buffer b))
if (or (and bn (file-in-directory-p bn root-directory))
(and (null bn)
(not (file-remote-p cd))
(file-in-directory-p cd root-directory)))
collect b))
(defun helm-browse-project-build-buffers-source (directory)
(helm-make-source "Buffers in project" 'helm-source-buffers
:header-name (lambda (name)
(format
"%s (%s)"
name (abbreviate-file-name directory)))
:buffer-list (lambda () (helm-browse-project-get-buffers directory))))
(defun helm-browse-project-walk-directory (directory)
"Default function for `helm-browse-project-default-find-files-fn'."
(helm-walk-directory
directory
:directories nil :path 'full :skip-subdirs t))
(defun helm-browse-project-find-files-1 (directory program)
"List files in DIRECTORY recursively with external PROGRAM."
(require 'helm-fd)
(let* ((fd-exe (or helm-fd-executable
(executable-find "fdfind")
(executable-find "fd")))
(cmd (cl-ecase program
(ag "ag --hidden -g '.*' %s")
(rg "rg --files --hidden -g '*' %s")
(fd (concat fd-exe " --hidden --type f --glob '*' %s")))))
(with-temp-buffer
(call-process-shell-command
(format cmd directory)
nil t nil)
(mapcar (lambda (f) (expand-file-name f directory))
(split-string (buffer-string) "\n")))))
(defun helm-browse-project-ag-find-files (directory)
"A suitable function for `helm-browse-project-default-find-files-fn'.
Use AG as backend."
(helm-browse-project-find-files-1 directory 'ag))
(defun helm-browse-project-rg-find-files (directory)
"A suitable function for `helm-browse-project-default-find-files-fn'.
Use RG as backend."
(helm-browse-project-find-files-1 directory 'rg))
(defun helm-browse-project-fd-find-files (directory)
"A suitable function for `helm-browse-project-default-find-files-fn'.
Use FD as backend."
(helm-browse-project-find-files-1 directory 'fd))
(defun helm-browse-project-ag (_candidate)
"A `helm-grep' AG action for `helm-browse-project'."
(let ((dir (with-helm-buffer (helm-get-attr 'root-dir))))
(helm-grep-ag dir helm-current-prefix-arg)))
(helm-make-command-from-action helm-browse-project-run-ag
"Run `helm-grep' AG from `helm-browse-project'."
'helm-browse-project-ag)
(defclass helm-browse-project-source (helm-source-in-buffer helm-type-file)
((root-dir :initarg :root-dir
:initform nil
:custom 'file)
(match-part :initform
(lambda (c)
(if (with-helm-buffer
helm-ff-transformer-show-only-basename)
(helm-basename c) c)))
(filter-one-by-one :initform
(lambda (c)
(if (with-helm-buffer
helm-ff-transformer-show-only-basename)
(cons (propertize (helm-basename c)
'face 'helm-ff-file)
c)
(propertize c 'face 'helm-ff-file)))))
"Class to define a source in `helm-browse-project' handling non
VC handled directories.")
(cl-defmethod helm--setup-source :after ((source helm-browse-project-source))
(let ((actions (slot-value source 'action)))
(setf (slot-value source 'action)
(helm-append-at-nth
(symbol-value actions)
'(("Grep project with AG `M-g a, C-u select type'" . helm-browse-project-ag))
7))
(setf (slot-value source 'keymap) helm-browse-project-map)))
(defun helm-browse-project-find-files (directory &optional refresh)
"Browse non VC handled directory DIRECTORY."
(when refresh (remhash directory helm--browse-project-cache))
(unless (gethash directory helm--browse-project-cache)
(puthash directory (funcall helm-browse-project-default-find-files-fn
directory)
helm--browse-project-cache))
(helm :sources `(,(helm-browse-project-build-buffers-source directory)
,(helm-make-source "Browse project"
'helm-browse-project-source
:root-dir directory
:data (gethash directory helm--browse-project-cache)
:header-name
(lambda (name)
(format
"%s (%s)"
name (abbreviate-file-name directory)))))
:ff-transformer-show-only-basename nil
:buffer "*helm browse project*"))
(defvar helm-browse-project-history nil)
;;;###autoload
(defun helm-projects-history (&optional arg)
"Jump to project already visisted with `helm-browse-project'.
Prefix arg allows browsing files recursively under a project not handled
by git or hg, otherwise it has no effect."
(interactive "P")
(setq helm-browse-project-history
(cl-loop for p in helm-browse-project-history
when (file-directory-p p)
collect p))
(helm :sources
(helm-build-sync-source "Project history"
:candidates helm-browse-project-history
:action (helm-make-actions
"Browse project"
(lambda (candidate)
(with-helm-default-directory candidate
(helm-browse-project
(or arg helm-current-prefix-arg))))
"Remove project(s)"
(lambda (_candidate)
(let ((mkd (helm-marked-candidates)))
(cl-loop for c in mkd do
(setq helm-browse-project-history
(delete c helm-browse-project-history)))
(message "%s projects removed" (length mkd))))))
:buffer "*helm browse project history*"))
;;;###autoload
(defun helm-browse-project (arg)
"Preconfigured helm to browse projects.
Browse files and see status of project with its VCS.
Only HG and GIT are supported for now.
Fall back to `helm-browse-project-find-files' if current
directory is not under control of one of those VCS.
With a prefix ARG browse files recursively, with two prefix ARG
rebuild the cache.
If the current directory is found in the cache, start
`helm-browse-project-find-files' even with no prefix ARG.
NOTE: The prefix ARG have no effect on the VCS controlled
directories.
Needed dependencies for VCS:
and
."
(interactive "P")
(require 'helm-x-files)
(let ((helm-type-buffer-actions
(remove (assoc "Browse project from buffer"
helm-type-buffer-actions)
helm-type-buffer-actions))
(helm-buffers-in-project-p t))
(cl-flet ((push-to-hist (root)
(setq helm-browse-project-history
(cons root (delete root helm-browse-project-history)))))
(helm-acond ((and (require 'helm-ls-git nil t)
(fboundp 'helm-ls-git-root-dir)
(helm-ls-git-root-dir))
(push-to-hist it)
(helm-ls-git))
((and (require 'helm-ls-hg nil t)
(fboundp 'helm-hg-root)
(helm-hg-root))
(push-to-hist it)
(helm-hg-find-files-in-project))
((helm-browse-project-get--root-dir (helm-current-directory))
(if (or arg (gethash it helm--browse-project-cache))
(progn
(push-to-hist it)
(helm-browse-project-find-files it (equal arg '(16))))
(helm :sources (helm-browse-project-build-buffers-source it)
:buffer "*helm browse project*")))))))
(defun helm-browse-project-get--root-dir (directory)
(cl-loop with dname = (file-name-as-directory directory)
while (and dname (not (gethash dname helm--browse-project-cache)))
if (file-remote-p dname)
do (setq dname nil) else
do (setq dname (helm-basedir (substring dname 0 (1- (length dname)))))
finally return (or dname (file-name-as-directory directory))))
(defun helm-ff-browse-project (_candidate)
"Browse project in current directory.
See `helm-browse-project'."
(with-helm-default-directory helm-ff-default-directory
(helm-browse-project helm-current-prefix-arg)))
(helm-make-command-from-action helm-ff-run-browse-project
"Run browse project."
'helm-ff-browse-project)
;;; Actions calling helm and main interactive functions.
;;
;;
(defun helm-ff-gid (_candidate)
(with-helm-default-directory helm-ff-default-directory
(helm-gid)))
(helm-make-command-from-action helm-ff-run-gid
"Run gid from HFF."
'helm-ff-gid)
;; helm-find bindings for helm-find-files.
(defun helm-ff-find-sh-command (_candidate)
"Run `helm-find' from `helm-find-files'."
(require 'helm-find)
(helm-find-1 helm-ff-default-directory))
(helm-make-command-from-action helm-ff-run-find-sh-command
"Run find shell command action with key from `helm-find-files'."
'helm-ff-find-sh-command)
;; helm-hd bindings for hff
(defun helm-ff-fd (_candidate)
"Run fd shell command from `helm-find-files'."
(require 'helm-fd)
(helm-fd-1 helm-ff-default-directory))
(helm-make-command-from-action helm-ff-run-fd
"Run fd shell command action with key from `helm-find-files'."
'helm-ff-fd)
;;;###autoload
(defun helm-find-files (arg)
"Preconfigured `helm' for helm implementation of `find-file'.
Called with a prefix arg show history if some.
Don't call it from programs, use `helm-find-files-1' instead.
This is the starting point for nearly all actions you can do on
files."
(interactive "P")
(let* (tramp-archive-enabled ; Disable tramp-archive which is
; kicking in unexpectedly.
(hist (and arg helm-ff-history (helm-find-files-history nil)))
(smart-input (or hist (helm-find-files-initial-input)))
(default-input (expand-file-name (helm-current-directory)))
(input (cond ((and (null hist)
helm-find-files-ignore-thing-at-point)
default-input)
((and (eq major-mode 'org-agenda-mode)
org-directory
(not smart-input))
(file-name-as-directory
(expand-file-name org-directory)))
((and (eq major-mode 'dired-mode) smart-input)
(file-name-directory smart-input))
((and (not (string= smart-input ""))
smart-input))
(t default-input)))
(input-as-presel (null (file-directory-p input)))
(presel (helm-aif (or hist
(and input-as-presel input)
(buffer-file-name (current-buffer))
(and (eq major-mode 'dired-mode)
smart-input)
(and (eq major-mode 'Info-mode)
Info-current-file))
(if (and helm-ff-transformer-show-only-basename
(null hist)
(not (string-match-p "[.]\\{1,2\\}\\'" it)))
(helm-basename it)
it))))
;; Continue using the same display function as history which used
;; probably itself the same display function as inner HFF call,
;; i.e. if history was using frame use a frame otherwise use a window.
(when (and hist (buffer-live-p (get-buffer helm-ff-history-buffer-name)))
(helm-set-local-variable 'helm-display-function
(with-current-buffer helm-ff-history-buffer-name
helm-display-function)
'helm--last-frame-parameters
(with-current-buffer helm-ff-history-buffer-name
helm--last-frame-parameters)))
(set-text-properties 0 (length input) nil input)
(setq current-prefix-arg nil)
;; Allow next helm session to reuse helm--last-frame-parameters as
;; resume would do.
(let ((helm--executing-helm-action (not (null hist))))
(helm-find-files-1 input (and presel (null helm-ff-no-preselect)
(format helm-ff-last-expanded-candidate-regexp
(regexp-quote presel)))))))
(provide 'helm-files)
;;; helm-files.el ends here
helm-4.0.3/helm-find.el 0000664 0000000 0000000 00000016424 15011067617 0014643 0 ustar 00root root 0000000 0000000 ;;; helm-find.el --- helm interface for find command. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'helm-files)
(require 'helm-external)
(defcustom helm-findutils-skip-boring-files t
"Ignore boring files in find command results."
:group 'helm-files
:type 'boolean)
(defcustom helm-findutils-search-full-path nil
"Search in full path with shell command find when non-nil.
I.e. use the -path/ipath arguments of find instead of
-name/iname."
:group 'helm-files
:type 'boolean)
(defcustom helm-find-noerrors nil
"Prevent showing error messages in helm buffer when non nil."
:group 'helm-files
:type 'boolean)
(defcustom helm-find-show-full-path-fn #'identity
"Function used in transformer to show the full path of candidate.
You may want to show the relative path or the abbreviated path instead of the
full path. The basename is accessible with
\\\\[helm-ff-run-toggle-basename], so no need to use a function
that display the basename of candidate here."
:group 'helm-files
:type '(choice
(const :tag "Display absolute path" identity)
(const :tag "Display relative path" file-relative-name)
(const :tag "Display abbreviated path" abbreviate-file-name)))
(defvar helm-find-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-generic-files-map)
(define-key map (kbd "DEL") 'helm-delete-backward-no-update)
map))
(defvar helm-source-findutils
(helm-build-async-source "Find"
:header-name (lambda (name)
(concat name " in [" (helm-default-directory) "]"))
:candidates-process 'helm-find-shell-command-fn
:filtered-candidate-transformer 'helm-findutils-transformer
:action-transformer 'helm-transform-file-load-el
:persistent-action 'helm-ff-kill-or-find-buffer-fname
:action 'helm-type-file-actions
:help-message 'helm-generic-file-help-message
:keymap helm-find-map
:candidate-number-limit 9999
:requires-pattern 3))
(defun helm-findutils-transformer (candidates _source)
(let (non-essential
(default-directory (helm-default-directory)))
(cl-loop for i in candidates
for abs = (expand-file-name
(helm-aif (file-remote-p default-directory)
(concat it i) i))
for type = (car (file-attributes abs))
for fname = (if (and helm-ff-transformer-show-only-basename
(not (string-match "[.]\\{1,2\\}$" i)))
(helm-basename abs)
(funcall helm-find-show-full-path-fn abs))
for disp = (helm-acase type
('t (propertize fname 'face 'helm-ff-directory))
((guard* (stringp it))
(propertize fname 'face 'helm-ff-symlink))
(otherwise (propertize fname 'face 'helm-ff-file)))
collect (cons (helm-ff-prefix-filename disp abs) abs))))
(defun helm-find--build-cmd-line ()
(require 'find-cmd)
(let* ((default-directory (or (file-remote-p default-directory 'localname)
default-directory))
(patterns+options (split-string helm-pattern "\\(\\`\\| +\\)\\* +"))
(fold-case (helm-set-case-fold-search (car patterns+options)))
(patterns (split-string (car patterns+options)))
(additional-options (and (cdr patterns+options)
(list (concat (cadr patterns+options) " "))))
(ignored-dirs ())
(ignored-files (when helm-findutils-skip-boring-files
(cl-loop for f in completion-ignored-extensions
if (string-match "/$" f)
do (push (replace-match "" nil t f)
ignored-dirs)
else collect (concat "*" f))))
(path-or-name (if helm-findutils-search-full-path
'(ipath path) '(iname name)))
(name-or-iname (if fold-case
(car path-or-name) (cadr path-or-name))))
(find-cmd (and ignored-dirs
`(prune (name ,@ignored-dirs)))
(and ignored-files
`(not (name ,@ignored-files)))
`(and ,@(mapcar
(lambda (pattern)
`(,name-or-iname ,(concat "*" pattern "*")))
patterns)
,@additional-options))))
(defun helm-find-shell-command-fn ()
"Asynchronously fetch candidates for `helm-find'.
Additional find options can be specified after a \"*\"
separator."
(let* (process-connection-type
non-essential
(cmd (concat (helm-find--build-cmd-line)
(if helm-find-noerrors "2> /dev/null" "")))
(proc (start-file-process-shell-command "hfind" helm-buffer cmd)))
(helm-log "helm-find-shell-command-fn" "Find command:\n%s" cmd)
(prog1 proc
(set-process-sentinel
proc
(lambda (process event)
(helm-process-deferred-sentinel-hook
process event (helm-default-directory))
(if (string= event "finished\n")
(helm-locate-update-mode-line "Find")
(helm-log "helm-find-shell-command-fn sentinel" "Error: Find %s"
(replace-regexp-in-string "\n" "" event))))))))
(defun helm-find-1 (dir)
(let ((default-directory (file-name-as-directory dir)))
(helm :sources 'helm-source-findutils
:buffer "*helm find*"
:ff-transformer-show-only-basename nil
:case-fold-search helm-file-name-case-fold-search)))
;;; Preconfigured commands
;;
;;
;;;###autoload
(defun helm-find (arg)
"Preconfigured `helm' for the find shell command.
Recursively find files whose names are matched by all specified
globbing PATTERNs under the current directory using the external
program specified in `find-program' (usually \"find\"). Every
input PATTERN is silently wrapped into two stars: *PATTERN*.
With prefix argument, prompt for a directory to search.
When user option `helm-findutils-search-full-path' is non-nil,
match against complete paths, otherwise, against file names
without directory part.
The (possibly empty) list of globbing PATTERNs can be followed by
the separator \"*\" plus any number of additional arguments that
are passed to \"find\" literally."
(interactive "P")
(let ((directory
(if arg
(file-name-as-directory
(read-directory-name "DefaultDirectory: "))
default-directory)))
(helm-find-1 directory)))
(provide 'helm-find)
;;; helm-find.el ends here
helm-4.0.3/helm-font.el 0000664 0000000 0000000 00000027411 15011067617 0014667 0 ustar 00root root 0000000 0000000 ;;; helm-font --- Font and ucs selection for Helm -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'helm-help)
;; No warnings in Emacs built --without-x
(declare-function x-list-fonts "xfaces.c")
(declare-function helm-generic-sort-fn "helm-utils")
(defgroup helm-font nil
"Related applications to display fonts in Helm."
:group 'helm)
(defcustom helm-ucs-recent-size 10
"Number of recent chars to keep."
:type 'integer
:group 'helm-font)
(defcustom helm-ucs-actions
'(("Insert character" . helm-ucs-insert-char)
("Insert character name" . helm-ucs-insert-name)
("Insert character code in hex" . helm-ucs-insert-code)
("Kill marked characters" . helm-ucs-kill-char)
("Kill name" . helm-ucs-kill-name)
("Kill code" . helm-ucs-kill-code)
("Describe char" . helm-ucs-describe-char))
"Actions for `helm-source-ucs'."
:group 'helm-font
:type '(alist :key-type string :value-type function))
(defvar helm-ucs-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "") 'helm-ucs-persistent-delete)
(define-key map (kbd "") 'helm-ucs-persistent-backward)
(define-key map (kbd "") 'helm-ucs-persistent-forward)
(define-key map (kbd "C-c SPC") 'helm-ucs-persistent-insert-space)
map)
"Keymap for `helm-ucs'.")
(defface helm-ucs-char
`((((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Gold"))
"Face used to display ucs characters."
:group 'helm-font)
;;; Xfont selection
;;
;;
(defvar helm-xfonts-cache nil)
(defvar helm-previous-font nil)
(defvar helm-source-xfonts
(helm-build-sync-source "X Fonts"
:init (lambda ()
(unless helm-xfonts-cache
(setq helm-xfonts-cache
(x-list-fonts "*")))
;; Save current font so it can be restored in cleanup
(setq helm-previous-font (cdr (assq 'font (frame-parameters)))))
:candidates 'helm-xfonts-cache
:action `(("Copy font to kill ring" . ,(lambda (elm)
(kill-new elm)))
("Set font" . ,(lambda (elm)
(kill-new elm)
(set-frame-font elm 'keep-size)
(message "Font copied to kill ring"))))
:cleanup (lambda ()
;; Restore previous font
(set-frame-font helm-previous-font 'keep-size))
:persistent-action (lambda (new-font)
(set-frame-font new-font 'keep-size)
(kill-new new-font))
:persistent-help "Preview font and copy to kill-ring"))
;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟
;;
;;
(defvar helm-ucs--max-len nil)
(defvar helm-ucs--names nil)
(defvar helm-ucs-history nil)
(defvar helm-ucs-recent nil
"Ring of recent `helm-ucs' selections.")
(defun helm-calculate-ucs-alist-max-len (names)
"Calculate the length of the longest NAMES list candidate."
(cl-loop for (_n . v) in names
maximize (length (format "#x%x:" v)) into code
maximize (max 1 (string-width (format "%c" v))) into char
finally return (cons code char)))
(defun helm-calculate-ucs-hash-table-max-len (names)
"Calculate the length of the longest NAMES hash table candidate."
(cl-loop for _n being the hash-keys of names
using (hash-values v)
maximize (length (format "#x%x:" v)) into code
maximize (max 1 (string-width (format "%c" v))) into char
finally return (cons code char)))
(defun helm-calculate-ucs-max-len ()
"Calculate the length of the longest `ucs-names' candidate."
(let ((ucs-struct (ucs-names)))
(if (hash-table-p ucs-struct)
(helm-calculate-ucs-hash-table-max-len ucs-struct)
(helm-calculate-ucs-alist-max-len ucs-struct))))
(defun helm-ucs-collect-symbols-alist (names)
"Collect ucs symbols from the NAMES list."
(cl-loop with pr = (make-progress-reporter
"collecting ucs names"
0 (length names))
for (n . v) in names
for count from 1
for xcode = (format "#x%x:" v)
for len = (length xcode)
for diff = (- (car helm-ucs--max-len) len)
for code = (format "(#x%x): " v)
for char = (propertize (format "%c" v)
'face 'helm-ucs-char)
unless (or (string= "" n)
;; `char-displayable-p' return a font object or
;; t for some char that are displayable but have
;; no special font (e.g 10) so filter out char
;; with no font.
(not (fontp (char-displayable-p (read xcode)))))
collect
(concat code (make-string diff ? )
char " " n)
and do (progress-reporter-update pr count)))
(defun helm-ucs-collect-symbols-hash-table (names)
"Collect ucs symbols from the NAMES hash-table."
(cl-loop with pr = (make-progress-reporter
"collecting ucs names"
0 (hash-table-count names))
for n being the hash-keys of names
using (hash-values v)
for count from 1
for xcode = (format "#x%x:" v)
for len = (length xcode)
for diff = (- (car helm-ucs--max-len) len)
for code = (format "(#x%x): " v)
for char = (propertize (format "%c" v)
'face 'helm-ucs-char)
unless (or (string= "" n)
(not (fontp (char-displayable-p (read xcode)))))
collect
(concat code (make-string diff ? )
char " " n)
and do (progress-reporter-update pr count)))
(defun helm-ucs-collect-symbols (ucs-struct)
"Collect ucs symbols from UCS-STRUCT.
Depending on the Emacs version, the variable `ucs-names' can
either be an alist or a hash-table."
(if (hash-table-p ucs-struct)
(helm-ucs-collect-symbols-hash-table ucs-struct)
(helm-ucs-collect-symbols-alist ucs-struct)))
(defun helm-ucs-init ()
"Initialize a Helm buffer with ucs symbols.
Only math* symbols are collected."
(unless helm-ucs--max-len
(setq helm-ucs--max-len
(helm-calculate-ucs-max-len)))
(or helm-ucs--names
(setq helm-ucs--names
(helm-ucs-collect-symbols (ucs-names)))))
;; Actions (insertion)
(defun helm-ucs-match (candidate n)
"Return the N part of an ucs CANDIDATE.
Where N=1 is the ucs code, N=2 the ucs char and N=3 the ucs
name."
(when (string-match
"^(\\(#x[a-f0-9]+\\)): *\\(.\\) *\\([^:]+\\)+"
candidate)
(match-string n candidate)))
(defun helm-ucs-save-recentest (candidate)
(let ((lst (cons candidate (delete candidate helm-ucs-recent))))
(setq helm-ucs-recent
(if (> (length lst) helm-ucs-recent-size)
(nbutlast lst 1)
lst))))
(defun helm-ucs-insert (candidate n)
"Insert the N part of CANDIDATE."
(with-helm-current-buffer
(helm-ucs-save-recentest candidate)
(insert (helm-ucs-match candidate n))))
(defun helm-ucs-insert-char (candidate)
"Insert ucs char part of CANDIDATE at point."
(helm-ucs-insert candidate 2))
(defun helm-ucs-insert-code (candidate)
"Insert ucs code part of CANDIDATE at point."
(helm-ucs-insert candidate 1))
(defun helm-ucs-insert-name (candidate)
"Insert ucs name part of CANDIDATE at point."
(helm-ucs-insert candidate 3))
;; Kill actions
(defun helm-ucs-kill-char (_candidate)
"Action that concatenate ucs marked chars."
(let ((marked (helm-marked-candidates)))
(cl-loop for candidate in marked
do (helm-ucs-save-recentest candidate))
(kill-new (mapconcat (lambda (x)
(helm-ucs-match x 2))
marked ""))))
(defun helm-ucs-kill-code (candidate)
(helm-ucs-save-recentest candidate)
(kill-new (helm-ucs-match candidate 1)))
(defun helm-ucs-kill-name (candidate)
(helm-ucs-save-recentest candidate)
(kill-new (helm-ucs-match candidate 3)))
;; Describe char
(defun helm-ucs-describe-char (candidate)
"Describe char CANDIDATE."
(with-temp-buffer
(insert (helm-ucs-match candidate 2))
(describe-char (point-min))))
;; Navigation in current-buffer (persistent)
(defun helm-ucs-forward-char (_candidate)
(with-helm-current-buffer
(forward-char 1)))
(defun helm-ucs-backward-char (_candidate)
(with-helm-current-buffer
(forward-char -1)))
(defun helm-ucs-delete-backward (_candidate)
(with-helm-current-buffer
(delete-char -1)))
(defun helm-ucs-insert-space (_candidate)
(with-helm-current-buffer
(insert " ")))
(defun helm-ucs-persistent-forward ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'action-forward 'helm-ucs-forward-char)
(helm-execute-persistent-action 'action-forward)))
(put 'helm-ucs-persistent-forward 'helm-only t)
(defun helm-ucs-persistent-backward ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'action-back 'helm-ucs-backward-char)
(helm-execute-persistent-action 'action-back)))
(put 'helm-ucs-persistent-backward 'helm-only t)
(defun helm-ucs-persistent-delete ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'action-delete 'helm-ucs-delete-backward)
(helm-execute-persistent-action 'action-delete)))
(put 'helm-ucs-persistent-delete 'helm-only t)
(defun helm-ucs-persistent-insert-space ()
(interactive)
(with-helm-alive-p
(helm-set-attr 'action-insert-space 'helm-ucs-insert-space)
(helm-execute-persistent-action 'action-insert-space)))
(defvar helm-source-ucs-recent
(helm-build-sync-source "Recent UCS"
:action 'helm-ucs-actions
:candidates (lambda () helm-ucs-recent)
:help-message helm-ucs-help-message
:keymap helm-ucs-map
:volatile t))
(defvar helm-source-ucs
(helm-build-in-buffer-source "UCS names"
:data #'helm-ucs-init
:get-line #'buffer-substring
:help-message 'helm-ucs-help-message
:filtered-candidate-transformer
(lambda (candidates _source) (sort candidates #'helm-generic-sort-fn))
:action 'helm-ucs-actions
:persistent-action (lambda (candidate)
(helm-ucs-insert-char candidate)
(helm-force-update))
:keymap helm-ucs-map)
"Source for collecting `ucs-names' math symbols.")
;;;###autoload
(defun helm-select-xfont ()
"Preconfigured `helm' to select Xfont."
(interactive)
(helm :sources 'helm-source-xfonts
:buffer "*helm select xfont*"))
;;;###autoload
(defun helm-ucs (arg)
"Preconfigured `helm' for `ucs-names'.
Called with a prefix arg force reloading cache."
(interactive "P")
(when arg
(setq helm-ucs--names nil
helm-ucs--max-len nil
ucs-names nil))
(let ((char (helm-aif (char-after) (string it))))
(helm :sources (list helm-source-ucs-recent helm-source-ucs)
:history 'helm-ucs-history
:input (and char (multibyte-string-p char) char)
:buffer "*helm ucs*")))
(provide 'helm-font)
;;; helm-font.el ends here
helm-4.0.3/helm-for-files.el 0000664 0000000 0000000 00000036461 15011067617 0015614 0 ustar 00root root 0000000 0000000 ;;; helm-for-files.el --- helm-for-files and related. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'helm-files)
(require 'helm-external)
(require 'helm-bookmark)
(defvar recentf-list)
(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)
(defvar helm-recentf-cache 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))
;; Use a copy of not recentf-list itself but the of its
;; elements to not corrupt them with text props.
(setq helm-recentf-cache (helm-copy-sequence recentf-list))))
(candidates :initform 'helm-recentf-cache)
(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)))
;; When real candidate is equal to display it gets corrupted with the text
;; properties added by the transformer, so ensure to strip out properties
;; before passing the candidate to action otherwise recentf will save the
;; candidate passed to find-file with the properties and corrupt
;; recentf-list. This happen when abbreviate-file-name is passed to a
;; candidate with no leading "~" e.g. "/foo" bug#2709.
(coerce :initform 'substring-no-properties)
(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)))))
;;; Transformer for helm-type-file
;;
;;
(defvar helm-sources-for-files-no-basename '("Recentf" "File Cache"))
;; Function `helm-highlight-files' is used in type `helm-type-file'. Ensure that
;; the definition is available for clients, should they need it.
;; See https://github.com/bbatsov/helm-projectile/issues/184.
;;;###autoload
(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)
with sname = (helm-get-attr 'name source)
for i in files
for disp = (if (or (and (not helm-ff-show-dot-file-path)
(helm-ff-dot-file-p i))
(and helm-ff-transformer-show-only-basename
(not (member sname
helm-sources-for-files-no-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))
;; file-attributes is too slow on remote files,
;; so call it 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 (;; No fancy display on remote files with basic predicates.
(and (null type) isremote) (cons disp i))
(;; Symlinks
(stringp type)
(add-text-properties 0 (length disp) `(face helm-ff-symlink
match-part ,(funcall mp-fn disp)
help-echo ,(expand-file-name i))
disp)
(cons (helm-ff-prefix-filename disp i) i))
(;; Dotted dirs
(and (eq type t) (helm-ff-dot-file-p i))
(add-text-properties 0 (length disp) `(face helm-ff-dotted-directory
match-part ,(funcall mp-fn disp)
help-echo ,(expand-file-name i))
disp)
(cons (helm-ff-prefix-filename disp i) i))
(;; Dirs
(eq type t)
(add-text-properties 0 (length disp) `(face helm-ff-directory
match-part ,(funcall mp-fn disp)
help-echo ,(expand-file-name i))
disp)
(cons (helm-ff-prefix-filename disp i) i))
(t ;; Files.
(add-text-properties 0 (length disp) `(face helm-ff-file
match-part ,(funcall mp-fn disp)
help-echo ,(expand-file-name i))
disp)
(helm-aif (helm-file-name-extension disp)
(when (condition-case _err
(string-match (format "\\.\\(%s\\)\\'" it) disp)
(invalid-regexp nil))
(add-face-text-property
(match-beginning 1) (match-end 1)
'helm-ff-file-extension t disp)))
(cons (helm-ff-prefix-filename disp i) i)))))
;;; Files in current dir
;;
;;
(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)
(popup-info :initform (lambda (candidate)
(unless (helm-ff-dot-file-p candidate)
(helm-file-attributes
candidate
:dired t :human-size t :octal nil))))
(migemo :initform t)))
(cl-defmethod helm--setup-source :after ((source helm-files-in-current-dir-source))
(helm-aif (slot-value source 'filtered-candidate-transformer)
(setf (slot-value source 'filtered-candidate-transformer)
(append '(helm-ff-sort-candidates) (helm-mklist it)))))
(defvar helm-source-files-in-current-dir
(helm-make-source "Files from Current Directory"
'helm-files-in-current-dir-source
:header-name (lambda (_name)
(format "Files from `%s'"
(abbreviate-file-name (helm-default-directory))))))
;;;###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))))
'helm-ff-transformer-show-only-basename nil)
(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
: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
helm-4.0.3/helm-global-bindings.el 0000664 0000000 0000000 00000010354 15011067617 0016752 0 ustar 00root root 0000000 0000000 ;;; helm-global-bindings.el --- Bind global helm commands -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'helm-lib) ; For helm-aif (bug #2520).
;;; Command Keymap
;;
;;
(defgroup helm-global-bindings nil
"Global bindings for Helm."
:group 'helm)
(defcustom helm-command-prefix-key
(helm-aif (car (where-is-internal 'Control-X-prefix (list global-map)))
(concat it [?c]))
"The prefix key used to call Helm commands from the `global-map'.
Its default value is `C-x c'.
This key is bound to the function `helm-command-prefix' in the global map.
The definition of `helm-command-prefix' is the keymap `helm-command-map'.
Using `setq' to modify this variable will have no effect."
:type '(choice (string :tag "Key") (const :tag "no binding"))
:set
(lambda (var key)
(helm-aif (and (boundp var) (symbol-value var))
(global-unset-key (read-kbd-macro it)))
(when key
(global-set-key (read-kbd-macro key) 'helm-command-prefix))
(set var key)))
(defvar helm-command-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "a") 'helm-apropos)
(define-key map (kbd "e") 'helm-etags-select)
(define-key map (kbd "l") 'helm-locate)
(define-key map (kbd "L") 'helm-locate-library)
(define-key map (kbd "s") 'helm-surfraw)
(define-key map (kbd "r") 'helm-regexp)
(define-key map (kbd "m") 'helm-man-woman)
(define-key map (kbd "t") 'helm-top)
(define-key map (kbd "o") 'helm-outline)
(define-key map (kbd "/") 'helm-find)
(define-key map (kbd "i") 'helm-imenu)
(define-key map (kbd "I") 'helm-imenu-in-all-buffers)
(define-key map (kbd "") 'helm-lisp-completion-at-point)
(define-key map (kbd "p") 'helm-list-emacs-process)
(define-key map (kbd "C-x r b") 'helm-filtered-bookmarks)
(define-key map (kbd "M-y") 'helm-show-kill-ring)
(define-key map (kbd "C-c ") 'helm-all-mark-rings)
(define-key map (kbd "C-x C-f") 'helm-find-files)
(define-key map (kbd "f") 'helm-multi-files)
(define-key map (kbd "C-:") 'helm-eval-expression-with-eldoc)
(define-key map (kbd "C-,") 'helm-calcul-expression)
(define-key map (kbd "M-x") 'helm-M-x)
(define-key map (kbd "M-s o") 'helm-occur)
(define-key map (kbd "M-g a") 'helm-do-grep-ag)
(define-key map (kbd "c") 'helm-colors)
(define-key map (kbd "F") 'helm-select-xfont)
(define-key map (kbd "8") 'helm-ucs)
(define-key map (kbd "C-c f") 'helm-recentf)
(define-key map (kbd "C-c g") 'helm-google-suggest)
(define-key map (kbd "h i") 'helm-info-at-point)
(define-key map (kbd "h r") 'helm-info-emacs)
(define-key map (kbd "h g") 'helm-info-gnus)
(define-key map (kbd "h h") 'helm-documentation)
(define-key map (kbd "C-x C-b") 'helm-buffers-list)
(define-key map (kbd "C-x r i") 'helm-register)
(define-key map (kbd "C-c C-x") 'helm-run-external-command)
(define-key map (kbd "b") 'helm-resume)
(define-key map (kbd "M-g i") 'helm-gid)
(define-key map (kbd "@") 'helm-packages)
(define-key map (kbd "h p") 'helm-finder)
map)
"Default keymap for \\[helm-command-prefix] commands.
The normal global definition of the character \\[helm-command-prefix] indirects to this keymap.")
(fset 'helm-command-prefix helm-command-map)
;;; Menu
(require 'helm-easymenu)
;;; Provide
(provide 'helm-global-bindings)
;;; helm-global-bindings.el ends here
helm-4.0.3/helm-grep.el 0000664 0000000 0000000 00000236456 15011067617 0014671 0 ustar 00root root 0000000 0000000 ;;; helm-grep.el --- Helm Incremental Grep. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'ansi-color)
(require 'cl-lib)
(require 'format-spec)
(require 'helm)
(require 'helm-help)
(require 'helm-regexp)
;;; load wgrep proxy if it's available
(require 'wgrep-helm nil t)
(declare-function helm-buffer-list "helm-buffers")
(declare-function View-quit "view")
(declare-function doc-view-goto-page "doc-view" (page))
(declare-function pdf-view-goto-page "pdf-view" (page &optional window))
(declare-function helm-mm-split-pattern "helm-multi-match")
(declare-function helm-comp-read "helm-mode")
(declare-function helm-occur "helm-occur")
(defvar helm--ansi-color-regexp)
(defvar helm-ff-default-directory)
(defvar helm-tramp-verbose)
(defvar helm-grep-ack-types-cache)
(defvar helm-grep-git-grep-command)
(defvar helm-source-grep-git)
(defvar tramp-verbose)
(defvar helm-current-error)
;;; Internals vars
;;
;;
(defvar helm-rzgrep-cache (make-hash-table :test 'equal))
(defvar helm-grep-default-function 'helm-grep-init)
(defvar helm-zgrep-recurse-flag nil)
(defvar helm-grep-history nil)
(defvar helm-grep-ag-history nil)
(defvar helm-grep-last-targets nil)
(defvar helm-grep-include-files nil)
(defvar helm-grep-in-recurse nil)
(defvar helm-grep-use-zgrep nil)
(defvar helm-grep-default-directory-fn nil
"A function that should return a directory to expand candidate to.
It is intended to use as a let-bound variable, DON'T set this globaly.")
(defvar helm-pdfgrep-targets nil)
(defvar helm-grep-last-cmd-line nil)
(defvar helm-grep-split-line-regexp "^\\([[:lower:][:upper:]]?:?.*?\\):\\([0-9]+\\):\\(.*\\)")
;;; Keymaps
;;
;;
(defvar helm-grep-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-") 'helm-goto-next-file)
(define-key map (kbd "M-") 'helm-goto-precedent-file)
(define-key map (kbd "C-c o") 'helm-grep-run-other-window-action)
(define-key map (kbd "C-c C-o") 'helm-grep-run-other-frame-action)
(define-key map (kbd "C-x C-s") 'helm-grep-run-save-buffer)
(define-key map (kbd "DEL") 'helm-delete-backward-no-update)
map)
"Keymap used in Grep sources.")
(defvar helm-pdfgrep-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-") 'helm-goto-next-file)
(define-key map (kbd "M-") 'helm-goto-precedent-file)
(define-key map (kbd "DEL") 'helm-delete-backward-no-update)
map)
"Keymap used in pdfgrep.")
(defvar helm-grep-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'helm-grep-mode-jump)
(define-key map (kbd "C-o") 'helm-grep-mode-jump-other-window)
(define-key map (kbd "") 'helm-grep-mode-jump-other-window-forward)
(define-key map (kbd "") 'helm-grep-mode-jump-other-window-backward)
(define-key map (kbd "") 'helm-gm-next-file)
(define-key map (kbd "") 'helm-gm-precedent-file)
(define-key map (kbd "M-n") 'helm-grep-mode-jump-other-window-forward)
(define-key map (kbd "M-p") 'helm-grep-mode-jump-other-window-backward)
(define-key map (kbd "M-N") 'helm-gm-next-file)
(define-key map (kbd "M-P") 'helm-gm-precedent-file)
map))
(defgroup helm-grep nil
"Grep related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-grep-default-command
"grep --color=always -a -d skip %e -n%cH -e %p %f"
"Default grep format command for `helm-do-grep-1'.
Where:
'%e' format spec is for --exclude or --include grep options or
ack-grep --type option. (Not mandatory)
'%c' format spec is for case-fold-search,
whether to use the -i option of grep. (Not mandatory)
When you specify this spec, helm grep will use smartcase
that is when a upcase character is found in pattern case will
be respected and no \\='-i' option will be used, otherwise, when
no upcase character is found in pattern always use \\='-i'.
If you don't want this behavior, don't use this spec and
specify or not the \\='-i' option.
Note that with ack-grep this is not needed, just specify
the \\='--smart-case' option.
'%p' format spec is for pattern. (Mandatory)
'%f' format spec is for filenames. (Mandatory)
If your grep version doesn't support the --exclude/include args
don't specify the \\='%e' format spec.
Helm also support ack-grep and git-grep. The following is a
default command example for ack-grep:
\(setq helm-grep-default-command
\"ack-grep -Hn --color --smart-case --no-group %e -- %p %f\"
helm-grep-default-recurse-command
\"ack-grep -H --color --smart-case --no-group %e -- %p %f\")
You can ommit the %e spec if you don't want to be prompted for
types.
NOTE: Helm for ack-grep support ANSI sequences, so you can remove
the \"--no-color\" option safely (recommended).
However you should specify --color to enable multi matches highlighting
because ack disable it when output is piped.
Same for grep you can use safely the option \"--color=always\" (default).
You can customize the color of matches using GREP_COLORS env var.
e.g: (setenv \"GREP_COLORS\"
\"ms=30;43:mc=30;43:sl=01;37:cx=:fn=35:ln=32:bn=32:se=36\")
To enable ANSI color in git-grep just add \"--color=always\".
To customize the ANSI color in git-grep, GREP_COLORS have no effect,
you will have to setup this in your .gitconfig:
[color \"grep\"]
match = black yellow
Where \"black\" is the foreground and \"yellow\" the background.
See the git documentation for more infos.
`helm-grep-default-command' and
`helm-grep-default-recurse-command' are independent, so you can
enable `helm-grep-default-command' with ack-grep and
`helm-grep-default-recurse-command' with grep if you want to be
faster on recursive grep.
NOTE: Remote grepping is not available with ack-grep, and badly
supported with grep because tramp handles badly repeated
remote processes in a short delay (< to 5s)."
:type 'string)
(defcustom helm-grep-default-recurse-command
"grep --color=always -a -d recurse %e -n%cH -e %p %f"
"Default recursive grep format command for `helm-do-grep-1'.
See `helm-grep-default-command' for format specs and infos about
ack-grep."
:type 'string)
(defcustom helm-default-zgrep-command
"zgrep --color=always -a -n%cH -e %p %f"
"Default command for Zgrep.
See `helm-grep-default-command' for infos on format specs.
Option --color=always is supported and can be used safely to
replace the Helm internal match highlighting. See
`helm-grep-default-command' for more infos."
:type 'string)
(defcustom helm-pdfgrep-default-command
"pdfgrep --color always -niH %s %s"
"Default command for pdfgrep.
Option \"--color always\" is supported starting Helm version
1.7.8. When used matches will be highlighted according to
GREP_COLORS env var."
:type 'string)
(defcustom helm-pdfgrep-default-recurse-command
"pdfgrep --color always -rniH %s %s"
"Default recurse command for pdfgrep.
Option \"--color always\" is supported starting Helm version
1.7.8. When used matches will be highlighted according to
GREP_COLORS env var."
:type 'string)
(defcustom helm-pdfgrep-default-read-command nil
"Default command to read pdf files from pdfgrep.
Where \\='%f' format spec is filename and \\='%p' is page number.
E.g. In Ubuntu you can set it to:
\"evince --page-label=%p \\='%f'\"
If set to nil either `doc-view-mode' or `pdf-view-mode' will be
used instead of an external command."
:type 'string)
(defcustom helm-grep-max-length-history 100
"Max number of elements to save in `helm-grep-history'."
:type 'integer)
(defcustom helm-zgrep-file-extension-regexp
".*\\(\\.gz\\|\\.bz\\|\\.xz\\|\\.lzma\\)$"
"Default file extensions zgrep will search in."
:type 'string)
(defcustom helm-grep-preferred-ext nil
"This file extension will be preselected for grep."
:type 'string)
(defcustom helm-grep-save-buffer-name-no-confirm nil
"When *hgrep* already exists, auto append suffix."
:type 'boolean)
(defcustom helm-grep-ignored-files
(cons ".#*" (delq nil (mapcar (lambda (s)
(unless (string-match-p "/\\'" s)
(concat "*" s)))
completion-ignored-extensions)))
"List of file names which `helm-grep' shall exclude."
:type '(repeat string))
(defcustom helm-grep-ignored-directories
helm-walk-ignore-directories
"List of names of sub-directories which `helm-grep' shall not recurse into."
:type '(repeat string))
(defcustom helm-grep-truncate-lines t
"When nil the grep line that appears will not be truncated."
:type 'boolean)
(defcustom helm-grep-file-path-style 'basename
"File path display style when grep results are displayed.
Possible value are:
basename: displays only the filename, none of the directory path
absolute: displays absolute path
relative: displays relative path from root grep directory."
:type '(choice (const :tag "Basename" basename)
(const :tag "Absolute" absolute)
(const :tag "Relative" relative)))
(defcustom helm-grep-actions
(helm-make-actions
"Find File" 'helm-grep-action
"Find file other frame" 'helm-grep-other-frame
"Save results in grep buffer" 'helm-grep-save-results
"Find file other window (C-u vertically)" 'helm-grep-other-window)
"Actions for helm grep."
:type '(alist :key-type string :value-type function))
(defcustom helm-grep-pipe-cmd-switches nil
"A list of additional parameters to pass to grep pipe command.
This will be used to pipe command for multiple pattern matching
for grep, zgrep ack-grep and git-grep backends.
If you add extra args for ack-grep, use ack-grep options, for
others (grep, zgrep and git-grep) use grep options.
Here are the commands where you may want to add switches:
grep --color=always
ack-grep --smart-case --color
You probably don't need to use this unless you know what you are
doing."
:type '(repeat string))
(defcustom helm-grep-ag-pipe-cmd-switches nil
"A list of additional parameters to pass to grep-ag pipe command.
Use parameters compatibles with the backend you are using
\(i.e. AG for AG, PT for PT or RG for RG)
Here are the commands where you may want to add switches:
ag -S --color
rg -N -S --color=?
For RG the value of --color= is computed according to the --color=
value used in `helm-grep-ag-command'.
Note also that by default the \"--\" option is always used, you don't
need to add it here.
You probably don't need to use this unless you know what you are
doing."
:type '(repeat string))
(defcustom helm-grep-input-idle-delay 0.1
"Idle time before updating, specified in seconds.
A lower value (default) means Helm will display the results
faster. Increasing it to a higher value (e.g. 0.6) prevents the
buffer from flickering when updating."
:type 'float)
(defcustom helm-grep-use-ioccur-style-keys t
"Use Arrow keys to jump to occurences.
Note that if you define this variable with `setq' your change
will have no effect, use customize instead."
:type 'boolean
:set (lambda (var val)
(set var val)
(if val
(progn
(define-key helm-grep-map (kbd "") 'helm-execute-persistent-action)
(define-key helm-grep-map (kbd "") 'helm-grep-run-default-action))
(define-key helm-grep-map (kbd "") nil)
(define-key helm-grep-map (kbd "") nil))))
(defcustom helm-grep-ag-command
(cond ((executable-find "rg")
"rg --color=always --smart-case --search-zip --no-heading --line-number %s -- %s %s")
((executable-find "ag")
"ag --line-numbers -S --color --nogroup %s -- %s %s"))
"The default command for RG or AG.
Prefer RG by default if available.
Update: PT is still mentionned in this documentation but it seems it
doesn't exists anymore, or at least it is no more maintained.
Takes three format specs, the first for type(s), the second for
pattern and the third for directory.
You can use safely \"--color\" (used by default) with AG RG and
PT.
NOTE: Usage of \"--color=never\" is discouraged as it uses Elisp
to colorize matched items which is slower than using the native
colorization of backend, however it is still supported.
For ripgrep here is the command line to use:
rg --color=always --smart-case --no-heading --line-number %s -- %s %s
And to customize colors (always for ripgrep) use something like this:
rg --color=always --colors \\='match:bg:yellow' --colors \\='match:fg:black'
\--smart-case --no-heading --line-number %s -- %s %s
This will change color for matched items from foreground red (the
default) to a yellow background with a black foreground. Note
that your color settings for RG will not work properly with
multiples pattern if you have configured colors in rg config file
instead of command line. For more enhanced settings of ansi
colors see https://github.com/emacs-helm/helm/issues/2313
You must use an output format that fit with helm grep, that is:
\"filename:line-number:string\"
The option \"--nogroup\" allow this.
The option \"--line-numbers\" is also mandatory except with
PT (not supported).
For RG the options \"--no-heading\" and \"--line-number\" are the
ones to use.
When modifying the default colors of matches with e.g.
\"--color-match\" option of AG or \"--colors\" option of ripgrep
you may want to modify as well `helm-grep-ag-pipe-cmd-switches'
to have all matches colorized with the same color in multi
match.
Of course you can use several other options, see the man page of the
backend you are using."
:type 'string)
(defcustom helm-grep-git-grep-command
"git --no-pager grep -n%cH --color=always --full-name -e %p -- %f"
"The git grep default command line.
The option \"--color=always\" can be used safely.
The color of matched items can be customized in your .gitconfig
See `helm-grep-default-command' for more infos.
The \"--exclude-standard\" and \"--no-index\" switches allow
skipping unwanted files specified in ~/.gitignore_global and
searching files not already staged (not enabled by default).
You have also to enable this in global \".gitconfig\" with
\"git config --global core.excludesfile ~/.gitignore_global\"."
:type 'string)
;;; Faces
;;
;;
(defgroup helm-grep-faces nil
"Customize the appearance of helm-grep."
:prefix "helm-"
:group 'helm-grep
:group 'helm-faces)
(defface helm-grep-match
`((((background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "#b00000")
(((background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "gold1"))
"Face used to highlight grep matches.
Have no effect when grep backend use \"--color=\"."
:group 'helm-grep-faces)
(defface helm-grep-file
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "BlueViolet"
:underline t))
"Face used to highlight grep results filenames."
:group 'helm-grep-faces)
(defface helm-grep-lineno
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Darkorange1"))
"Face used to highlight grep number lines."
:group 'helm-grep-faces)
(defface helm-grep-finish
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "Green"))
"Face used in mode line when grep is finish."
:group 'helm-grep-faces)
(defface helm-grep-cmd-line
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit font-lock-type-face))
"Face used to highlight grep command line when no results."
:group 'helm-grep-faces)
;;; Init
;;
;;
(defun helm-grep-prepare-candidates (candidates in-directory)
"Prepare filenames and directories CANDIDATES for grep command line."
;; If one or more candidate is a directory, search in all files
;; of this candidate (e.g /home/user/directory/*).
;; If r option is enabled search also in subdidrectories.
;; We need here to expand wildcards to support crap windows filenames
;; as grep doesn't accept quoted wildcards (e.g "dir/*.el").
(if helm-zgrep-recurse-flag
(mapconcat 'shell-quote-argument candidates " ")
;; When candidate is a directory, search in all its files.
;; NOTE that `file-expand-wildcards' will return also
;; directories, they will be ignored by grep but not
;; by ack-grep that will grep all files of this directory
;; without recursing in their subdirs though, see that as a one
;; level recursion with ack-grep.
;; So I leave it as it is, considering it is a feature. [1]
(cl-loop for i in candidates append
(cond ((string-match "^git" helm-grep-default-command)
(list i))
;; Candidate is a directory and we use recursion or ack.
((and (file-directory-p i)
(or helm-grep-in-recurse
;; ack-grep accept directory [1].
(helm-grep-use-ack-p)))
(list (expand-file-name i)))
;; Grep doesn't support directory only when not in recurse.
((file-directory-p i)
(file-expand-wildcards
(concat (file-name-as-directory (expand-file-name i)) "*") t))
;; Candidate is a file or wildcard and we use recursion, use the
;; current directory instead of candidate.
((and (or (file-exists-p i) (string-match "[*]" i))
helm-grep-in-recurse)
(list (expand-file-name
(directory-file-name ; Needed for windoze.
(file-name-directory (directory-file-name i))))))
;; Else should be one or more file/directory
;; possibly marked.
;; When real is a normal filename without wildcard
;; file-expand-wildcards returns a list of one file.
;; wildcards should have been already handled by
;; helm-read-file-name or helm-find-files but do it from
;; here too in case we are called from elsewhere.
(t (file-expand-wildcards i t))) into all-files ; [1]
finally return
(let ((files (if (file-remote-p in-directory)
;; Grep don't understand tramp filenames
;; use the local name.
(mapcar (lambda (x)
(file-remote-p x 'localname))
all-files)
all-files)))
;; When user mark files and use recursion with grep
;; backend enabled, the loop collect on each marked
;; candidate its `file-name-directory' and we endup with
;; duplicates (Bug#1714). FIXME: For now as a quick fix
;; I just remove dups here but I should handle this inside
;; the cond above.
(setq files (helm-fast-remove-dups files :test 'equal))
(if (string-match "^git" helm-grep-default-command)
(mapconcat 'identity files " ")
(mapconcat 'shell-quote-argument files " "))))))
(defun helm-grep-command (&optional recursive grep)
(let* ((com (if recursive
helm-grep-default-recurse-command
helm-grep-default-command))
(exe (if grep
(symbol-name grep)
(and com (car (split-string com " "))))))
(if (and exe (string= exe "git")) "git-grep" exe)))
(cl-defun helm-grep-use-ack-p (&key where)
(let* ((rec-com (helm-grep-command t))
(norm-com (helm-grep-command))
(norm-com-ack-p (string-match "\\`ack" norm-com))
(rec-com-ack-p (and rec-com (string-match "\\`ack" rec-com))))
(cl-case where
(default (and norm-com norm-com-ack-p))
(recursive (and rec-com rec-com-ack-p))
(strict (and norm-com rec-com rec-com-ack-p norm-com-ack-p))
(t (and (not (and norm-com (string= norm-com "git-grep")))
(or (and norm-com norm-com-ack-p)
(and rec-com rec-com-ack-p)))))))
(defun helm-grep--pipe-command-for-grep-command (smartcase pipe-switches &optional grep-cmd)
(helm-acase (or grep-cmd (helm-grep-command))
;; Use grep for GNU regexp based tools.
(("grep" "zgrep" "git-grep")
(format "grep --color=always%s %s"
(if smartcase " -i" "")
pipe-switches))
;; Use ack-grep for PCRE based tools.
;; Sometimes ack-grep cmd is ack only so compare by matching ack.
((guard* (string-match-p "ack" it))
(format "%s --smart-case --color %s" it pipe-switches))))
(defun helm-grep--prepare-cmd-line (only-files &optional include zgrep)
(let* ((default-directory (or helm-ff-default-directory
(helm-default-directory)
default-directory))
(fnargs (helm-grep-prepare-candidates
only-files default-directory))
(ignored-files (unless (helm-grep-use-ack-p)
(mapconcat
(lambda (x)
(concat "--exclude="
(shell-quote-argument x)))
helm-grep-ignored-files " ")))
(ignored-dirs (unless (helm-grep-use-ack-p)
(mapconcat
;; Need grep version >=2.5.4
;; of Gnuwin32 on windoze.
(lambda (x)
(concat "--exclude-dir="
(shell-quote-argument x)))
helm-grep-ignored-directories " ")))
(exclude (unless (helm-grep-use-ack-p)
(let ((inc (and include
(concat include " ")))
(igfiles (and ignored-files
(concat ignored-files " ")))
(igdirs (and helm-grep-in-recurse
ignored-dirs)))
(concat inc igfiles igdirs))))
(types (and (helm-grep-use-ack-p)
;; When %e format spec is not specified
;; in `helm-grep-default-command'
;; we need to pass an empty string
;; to types to avoid error.
(or include "")))
(smartcase (if (helm-grep-use-ack-p)
""
(unless (let ((case-fold-search nil))
(string-match-p
"[[:upper:]]" helm-pattern))
"i")))
(helm-grep-default-command
(concat helm-grep-default-command " %m")) ; `%m' like multi.
(patterns (helm-mm-split-pattern helm-pattern t))
(pipe-switches (mapconcat 'identity helm-grep-pipe-cmd-switches " "))
(pipes
(helm-aif (cdr patterns)
(cl-loop with pipcom = (helm-grep--pipe-command-for-grep-command
smartcase pipe-switches)
for p in it concat
(format " | %s %s" pipcom (shell-quote-argument p)))
"")))
(format-spec
helm-grep-default-command
(delq nil
(list (unless zgrep
(if types
(cons ?e types)
(cons ?e exclude)))
(cons ?c (or smartcase ""))
(cons ?p (shell-quote-argument (car patterns)))
(cons ?f fnargs)
(cons ?m pipes))))))
(defun helm-grep-init (cmd-line)
"Start an asynchronous grep process with CMD-LINE using ZGREP if non-nil."
(let* ((default-directory (or helm-ff-default-directory
(helm-default-directory)
default-directory))
(zgrep (string-match "\\`zgrep" cmd-line))
;; Use pipe only with grep, zgrep or git-grep.
(process-connection-type (and (not zgrep) (helm-grep-use-ack-p)))
(tramp-verbose helm-tramp-verbose)
(start-time (float-time))
(proc-name (if helm-grep-use-zgrep
"Zgrep"
(capitalize
(if helm-grep-in-recurse
(helm-grep-command t)
(helm-grep-command)))))
non-essential)
;; Start grep process.
(helm-log "helm-grep-init" "Starting Grep process in directory `%s'" default-directory)
(helm-log "helm-grep-init" "Command line used was:\n\n%s"
(concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n"))
(prog1 ; This function should return the process first.
(start-file-process-shell-command
proc-name helm-buffer cmd-line)
;; Init sentinel.
(set-process-sentinel
(get-buffer-process helm-buffer)
(lambda (process event)
(let* ((err (process-exit-status process))
(noresult (= err 1)))
(unless (and err (> err 0))
(helm-process-deferred-sentinel-hook
process event (helm-default-directory)))
(cond ((and noresult
;; This is a workaround for zgrep
;; that exit with code 1
;; after a certain amount of results.
(with-helm-buffer (helm-empty-buffer-p)))
(with-helm-buffer
(insert (concat "* Exit with code 1, no result found,"
" command line was:\n\n "
(propertize helm-grep-last-cmd-line
'face 'helm-grep-cmd-line)))
(setq mode-line-format
`(" " mode-line-buffer-identification " "
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
(:eval (propertize
(format
"[%s process finished - (no results)] "
,proc-name)
'face 'helm-grep-finish))))))
((or (string= event "finished\n")
(and noresult
;; This is a workaround for zgrep
;; that exit with code 1
;; after a certain amount of results.
(with-helm-buffer (not (helm-empty-buffer-p)))))
(helm-log "helm-grep-init" "%s process finished with %s results in %fs"
proc-name
(helm-get-candidate-number)
(- (float-time) start-time))
(helm-maybe-show-help-echo)
(with-helm-window
(setq mode-line-format
`(" " mode-line-buffer-identification " "
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
(:eval (propertize
(format
"[%s process finished in %.2fs - (%s results)] "
,proc-name
,(- (float-time) start-time)
(helm-get-candidate-number))
'face 'helm-grep-finish))))
(force-mode-line-update)
(when (and helm-allow-mouse helm-selection-point)
(helm--bind-mouse-for-selection helm-selection-point))))
;; Catch error output in log.
(t (helm-log
"helm-grep-init"
"Error: %s %s"
proc-name
(replace-regexp-in-string "\n" "" event))))))))))
(defun helm-grep-collect-candidates ()
(let ((cmd-line (helm-grep--prepare-cmd-line
helm-grep-last-targets
helm-grep-include-files
helm-grep-use-zgrep)))
(set (make-local-variable 'helm-grep-last-cmd-line) cmd-line)
(funcall helm-grep-default-function cmd-line)))
;;; Actions
;;
;;
(defun helm-grep-action (candidate &optional where)
"Define a default action for `helm-do-grep-1' on CANDIDATE.
WHERE can be `other-window' or `other-frame'."
(let* ((split (helm-grep-split-line candidate))
(split-pat (helm-mm-split-pattern helm-input))
(lineno (string-to-number (nth 1 split)))
(loc-fname (or (with-current-buffer
(if (eq major-mode 'helm-grep-mode)
(current-buffer)
helm-buffer)
(get-text-property (pos-bol)
'helm-grep-fname))
(car split)))
(tramp-fname (file-remote-p (or helm-ff-default-directory
default-directory)))
(fname (if tramp-fname
(concat tramp-fname loc-fname)
loc-fname)))
(helm-log "helm-grep-action" "helm-grep-action fname: %s" fname )
(cl-case where
(other-window (helm-window-show-buffers
(list (find-file-noselect fname)) t))
(other-frame (find-file-other-frame fname))
(grep (helm-grep-save-results-1))
(pdf (if helm-pdfgrep-default-read-command
(helm-pdfgrep-action-1 split lineno (car split))
(find-file (car split))
(if (derived-mode-p 'pdf-view-mode)
(pdf-view-goto-page lineno)
(doc-view-goto-page lineno))))
(t (find-file fname)))
(unless (or (eq where 'grep) (eq where 'pdf))
(helm-goto-line lineno)
;; Move point to the nearest matching regexp from bol.
(cl-loop for reg in split-pat
when (save-excursion
(condition-case _err
(if helm-migemo-mode
(helm-mm-migemo-forward reg (pos-eol) t)
(re-search-forward reg (pos-eol) t))
(invalid-regexp nil)))
collect (match-beginning 0) into pos-ls
finally (when pos-ls (goto-char (apply #'min pos-ls))))
;; Save history
(unless (or helm-in-persistent-action
(eq major-mode 'helm-grep-mode)
(string= helm-pattern ""))
(setq helm-grep-history
(cons helm-pattern
(delete helm-pattern helm-grep-history)))
(when (> (length helm-grep-history)
helm-grep-max-length-history)
(setq helm-grep-history
(delete (car (last helm-grep-history))
helm-grep-history)))))))
(defun helm-grep-persistent-action (candidate)
"Persistent action for `helm-do-grep-1'.
With a prefix arg record CANDIDATE in `mark-ring'."
(helm-grep-action candidate)
(helm-highlight-current-line))
(defun helm-grep-other-window (candidate)
"Jump to result in other window from helm grep."
(helm-grep-action candidate 'other-window))
(defun helm-grep-other-frame (candidate)
"Jump to result in other frame from helm grep."
(helm-grep-action candidate 'other-frame))
(defun helm-goto-next-or-prec-file (n)
"Go to next or precedent candidate file in helm grep/etags buffers.
If N is positive go forward otherwise go backward."
(let* ((allow-mode (or (eq major-mode 'helm-grep-mode)
(eq major-mode 'helm-moccur-mode)
(eq major-mode 'helm-occur-mode)))
(sel (if allow-mode
(buffer-substring (pos-bol) (pos-eol))
(helm-get-selection nil t)))
(current-line-list (helm-grep-split-line sel))
(current-fname (nth 0 current-line-list))
(bob-or-eof (if (eq n 1) 'eobp 'bobp))
(mark-maybe (lambda ()
(if allow-mode
(ignore)
(helm-mark-current-line)))))
(catch 'break
(while (not (funcall bob-or-eof))
(forward-line n) ; Go forward or backward depending of n value.
;; Exit when current-fname is not matched or in `helm-grep-mode'
;; the line is not a grep line i.e 'fname:num:tag'.
(setq sel (buffer-substring (pos-bol) (pos-eol)))
(when helm-allow-mouse
(helm--mouse-reset-selection-help-echo))
(unless (or (string= current-fname
(car (helm-grep-split-line sel)))
(and (eq major-mode 'helm-grep-mode)
(not (get-text-property (pos-bol) 'helm-grep-fname))))
(funcall mark-maybe)
(throw 'break nil))))
(cond ((and (> n 0) (eobp))
(re-search-backward ".")
(forward-line 0)
(funcall mark-maybe))
((and (< n 0) (bobp))
(helm-aif (next-single-property-change (pos-bol) 'helm-grep-fname)
(goto-char it)
(forward-line 1))
(funcall mark-maybe)))
(unless allow-mode
(helm-follow-execute-persistent-action-maybe)
(helm-log-run-hook "helm-goto-next-or-prec-file" 'helm-move-selection-after-hook))))
;;;###autoload
(defun helm-goto-precedent-file ()
"Go to previous file in Helm grep/etags buffers."
(interactive)
(with-helm-alive-p
(with-helm-window
(helm-goto-next-or-prec-file -1))))
(put 'helm-goto-precedent-file 'helm-only t)
;;;###autoload
(defun helm-goto-next-file ()
"Go to previous file in Helm grep/etags buffers."
(interactive)
(with-helm-window
(helm-goto-next-or-prec-file 1)))
(put 'helm-goto-next-file 'helm-only t)
(helm-make-command-from-action helm-grep-run-default-action
"Run grep default action from `helm-do-grep-1'."
'helm-grep-action)
(helm-make-command-from-action helm-grep-run-other-window-action
"Run grep goto other window action from `helm-do-grep-1'."
'helm-grep-other-window)
(helm-make-command-from-action helm-grep-run-other-frame-action
"Run grep goto other frame action from `helm-do-grep-1'."
'helm-grep-other-frame)
(helm-make-command-from-action helm-grep-run-save-buffer
"Run grep save results action from `helm-do-grep-1'."
'helm-grep-save-results)
(defun helm-grep-quit-an-find-file-fn (source)
(let* ((sel (helm-get-selection nil nil source))
(grep-line (and (stringp sel)
(helm-grep-split-line sel))))
(if (and grep-line (file-exists-p (car grep-line)))
(expand-file-name (car grep-line))
default-directory)))
;;; helm-grep-mode
;;
;;
(defun helm-grep-save-results (candidate)
(helm-grep-action candidate 'grep))
(defvar helm-grep-mode-use-pcre nil)
(defun helm-grep-save-results-1 ()
"Save Helm grep result in a `helm-grep-mode' buffer."
(let* ((buf "*hgrep*")
new-buf
(pattern (with-helm-buffer helm-input-local))
(src (helm-get-current-source))
(src-name (assoc-default 'name src)))
(when (get-buffer buf)
(if helm-grep-save-buffer-name-no-confirm
(setq new-buf (format "*hgrep|%s|-%s" pattern
(format-time-string "%H-%M-%S*")))
(setq new-buf (helm-read-string "GrepBufferName: " buf))
(cl-loop for b in (helm-buffer-list)
when (and (string= new-buf b)
(not (y-or-n-p
(format "Buffer `%s' already exists overwrite? "
new-buf))))
do (setq new-buf (helm-read-string "GrepBufferName: " "*hgrep "))))
(setq buf new-buf))
(with-current-buffer (get-buffer-create buf)
(setq default-directory (or helm-ff-default-directory
(helm-default-directory)
default-directory))
(setq-local helm-grep-mode-use-pcre (helm-get-attr 'pcre src))
(setq buffer-read-only t)
(let ((inhibit-read-only t)
(map (make-sparse-keymap)))
(erase-buffer)
(insert "-*- mode: helm-grep -*-\n\n"
(format "%s Results for `%s':\n\n" src-name pattern))
(save-excursion
(insert (with-current-buffer helm-buffer
(goto-char (point-min)) (forward-line 1)
(buffer-substring (point) (point-max)))))
(save-excursion
(while (not (eobp))
(add-text-properties (pos-bol) (pos-eol)
`(keymap ,map
help-echo ,(concat
(get-text-property
(point) 'helm-grep-fname)
"\nmouse-1: set point\nmouse-2: jump to selection")
mouse-face highlight))
(define-key map [mouse-1] 'mouse-set-point)
(define-key map [mouse-2] 'helm-grep-mode-mouse-jump)
(define-key map [mouse-3] 'ignore)
(forward-line 1))))
(helm-grep-mode))
(pop-to-buffer buf)
(setq next-error-last-buffer (get-buffer buf))
(message "Helm %s Results saved in `%s' buffer" src-name buf)))
(defun helm-grep-mode-mouse-jump (event)
(interactive "e")
(let* ((window (posn-window (event-end event)))
(pos (posn-point (event-end event))))
(with-selected-window window
(when (eq major-mode 'helm-grep-mode)
(goto-char pos)
(helm-grep-mode-jump)))))
(put 'helm-grep-mode-mouse-jump 'helm-only t)
(defun helm-grep-next-error (&optional argp reset)
"Goto ARGP position from a `helm-grep-mode' buffer.
RESET non-nil means rewind to the first match.
This is the `next-error-function' for `helm-grep-mode'."
(interactive "p")
(goto-char (cond (reset (point-min))
((and (< argp 0) helm-current-error)
(line-beginning-position))
((and (> argp 0) helm-current-error)
(line-end-position))
((point))))
(let ((fun (if (> argp 0)
#'next-single-property-change
#'previous-single-property-change)))
(helm-aif (funcall fun (point) 'helm-grep-fname)
(progn
(goto-char it)
;; `helm-current-error' is set in
;; `helm-grep-mode-jump'.
(helm-grep-mode-jump))
(user-error "No more matches"))))
(put 'helm-grep-next-error 'helm-only t)
;;;###autoload
(defun helm-revert-next-error-last-buffer ()
"Revert last `next-error' buffer from `current-buffer'.
Accept to revert only `helm-grep-mode' or `helm-occur-mode' buffers.
Use this when you want to revert the `next-error' buffer after
modifications in `current-buffer'."
(interactive)
(let ((buffer (next-error-find-buffer))
(linum (line-number-at-pos))
(bufname (buffer-name)))
(if buffer
(with-current-buffer buffer
(helm-aif (memq major-mode '(helm-grep-mode helm-occur-mode))
(progn (revert-buffer)
;; helm-occur-mode revert fn is synchronous so
;; reajust from here (it is done with
;; helm-grep-mode in its sentinel).
(when (eq (car it) 'helm-occur-mode)
(helm-grep-goto-closest-from-linum linum bufname)))
(error "No suitable buffer to revert found")))
(error "No suitable buffer to revert found"))))
(define-derived-mode helm-grep-mode
special-mode "helm-grep"
"Major mode to provide actions in helm grep saved buffer.
Special commands:
\\{helm-grep-mode-map}"
(set (make-local-variable 'helm-grep-last-cmd-line)
(with-helm-buffer helm-grep-last-cmd-line))
(set (make-local-variable 'revert-buffer-function)
#'helm-grep-mode--revert-buffer-function)
(set (make-local-variable 'next-error-function)
#'helm-grep-next-error)
(set (make-local-variable 'helm-current-error) nil))
(put 'helm-grep-mode 'helm-only t)
(defun helm-grep-mode--revert-buffer-function (&optional _ignore-auto _noconfirm)
(goto-char (point-min))
(when (re-search-forward helm-grep-split-line-regexp nil t) (forward-line 0))
(let ((inhibit-read-only t))
(delete-region (point) (point-max)))
(message "Reverting buffer...")
(let ((process-connection-type
;; Git needs a nil value otherwise it tries to use a pager.
(null (string-match-p "\\`git" helm-grep-last-cmd-line))))
(set-process-sentinel
(start-file-process-shell-command
"hgrep" (generate-new-buffer "*hgrep revert*") helm-grep-last-cmd-line)
'helm-grep-mode--sentinel)))
(defun helm-grep-mode--sentinel (process event)
(when (string= event "finished\n")
(with-current-buffer (if (eq major-mode 'helm-grep-mode)
(current-buffer)
(next-error-find-buffer))
(let ((inhibit-read-only t))
(save-excursion
(cl-loop for l in (with-current-buffer (process-buffer process)
(prog1 (split-string (buffer-string) "\n")
(kill-buffer)))
for line = (if (string-match-p helm--ansi-color-regexp l)
(ansi-color-apply l) l)
when (string-match helm-grep-split-line-regexp line)
do (insert (propertize
(car (helm-grep-filter-one-by-one
line helm-grep-mode-use-pcre))
;; needed for wgrep.
'helm-realvalue line)
"\n"))))
(when (fboundp 'wgrep-cleanup-overlays)
(wgrep-cleanup-overlays (point-min) (point-max))))
(unless (eq major-mode 'helm-grep-mode)
(let ((bufname (buffer-name))
(linum (line-number-at-pos)))
(with-current-buffer (next-error-find-buffer)
(helm-grep-goto-closest-from-linum linum bufname))))
(message "Reverting buffer done")
(when executing-kbd-macro (sit-for 1))))
(defun helm-grep-goto-closest-from-linum (linum bufname)
(goto-char (point-min))
(catch 'break
(while (re-search-forward (format "^%s:\\([0-9]+\\):" (regexp-quote bufname)) nil t)
(let ((numline (string-to-number (match-string 1))))
(when (< (- linum numline) 0)
(forward-line -1)
(throw 'break nil))))))
(defun helm-gm-next-file ()
(interactive)
(helm-goto-next-or-prec-file 1))
(put 'helm-gm-next-file 'helm-only t)
(defun helm-gm-precedent-file ()
(interactive)
(helm-goto-next-or-prec-file -1))
(put 'helm-gm-precedent-file 'helm-only t)
(defun helm-grep-mode-jump ()
(interactive)
(setq next-error-last-buffer (current-buffer))
(setq-local helm-current-error (point-marker))
(helm-grep-action
(buffer-substring (pos-bol) (pos-eol)))
(helm-match-line-cleanup-pulse))
(defun helm-grep-mode-jump-other-window-1 (arg)
(condition-case nil
(progn
(when (or (eq last-command 'helm-grep-mode-jump-other-window-forward)
(eq last-command 'helm-grep-mode-jump-other-window-backward))
(forward-line arg))
(save-selected-window
(helm-grep-action (buffer-substring (pos-bol) (pos-eol))
'other-window)
(helm-match-line-cleanup-pulse)
(recenter)))
(error nil)))
(defun helm-grep-mode-jump-other-window-forward (arg)
(interactive "p")
(helm-grep-mode-jump-other-window-1 arg))
(defun helm-grep-mode-jump-other-window-backward (arg)
(interactive "p")
(helm-grep-mode-jump-other-window-1 (- arg)))
(defun helm-grep-mode-jump-other-window ()
(interactive)
(setq next-error-last-buffer (current-buffer))
(setq-local helm-current-error (point-marker))
(let ((candidate (buffer-substring (pos-bol) (pos-eol))))
(condition-case nil
(progn (helm-grep-action candidate 'other-window)
(helm-match-line-cleanup-pulse))
(error nil))))
;;; ack-grep types
;;
;;
(defun helm-grep-hack-types ()
"Return a list of known ack-grep types."
(with-temp-buffer
;; "--help-types" works with both 1.96 and 2.1+, while
;; "--help types" works only with 1.96 Bug#422.
;; `helm-grep-command' should return the ack executable
;; when this function is used in the right context
;; i.e After checking is we are using ack-grep with
;; `helm-grep-use-ack-p'.
(call-process (helm-grep-command t) nil t nil "--help-types")
(goto-char (point-min))
(cl-loop while (re-search-forward "^ +\\([^. ]+\\) +\\(.*\\)" nil t)
collect (cons (concat (match-string 1)
" [" (match-string 2) "]")
(match-string 1))
collect (cons (concat "no" (match-string 1)
" [" (match-string 2) "]")
(concat "no" (match-string 1))))))
(defun helm-grep-ack-types-transformer (candidates _source)
(cl-loop for i in candidates
if (stringp i)
collect (rassoc i helm-grep-ack-types-cache)
else
collect i))
(defvar helm-grep-ack-types-cache nil)
(defun helm-grep-read-ack-type ()
"Select types for the \\='--type' argument of ack-grep."
(require 'helm-mode)
(require 'helm-adaptive)
(setq helm-grep-ack-types-cache (helm-grep-hack-types))
(let ((types (helm-comp-read
"Types: " helm-grep-ack-types-cache
:name "*Ack-grep types*"
:marked-candidates t
:must-match t
:fc-transformer '(helm-adaptive-sort
helm-grep-ack-types-transformer)
:buffer "*helm ack-types*")))
(mapconcat (lambda (type) (concat "--type=" type)) types " ")))
;;; grep extensions
;;
;;
(defun helm-grep-guess-extensions (files)
"Try to guess file extensions in FILES list when using grep recurse.
These extensions will be added to command line with --include arg
of grep."
(cl-loop with ext-list = (list helm-grep-preferred-ext "*")
with lst = (if (file-directory-p (car files))
(directory-files
(car files) nil
directory-files-no-dot-files-regexp)
files)
for i in lst
for ext = (file-name-extension i 'dot)
for glob = (and ext (not (string= ext ""))
(concat "*" ext))
unless (or (not glob)
(and glob-list (member glob glob-list))
(and glob-list (member glob ext-list))
(and glob-list (member glob helm-grep-ignored-files)))
collect glob into glob-list
finally return (delq nil (append ext-list glob-list))))
(defun helm-grep-get-file-extensions (files)
"Try to return a list of file extensions to pass to \\='--include' arg of grep."
(require 'helm-adaptive)
(let* ((all-exts (helm-grep-guess-extensions
(mapcar 'expand-file-name files)))
(extensions (helm-comp-read "Search Only in: " all-exts
:marked-candidates t
:fc-transformer 'helm-adaptive-sort
:buffer "*helm grep exts*"
:name "*helm grep extensions*")))
(when (listp extensions) ; Otherwise it is empty string returned by C-RET.
;; If extensions is a list of one string containing spaces,
;; assume user entered more than one glob separated by space(s) and
;; split this string to pass it later to mapconcat.
;; e.g '("*.el *.py")
(cl-loop for i in extensions
append (split-string-and-unquote i " ")))))
;;; Set up source
;;
;;
(defvar helm-grep-before-init-hook nil
"Hook that runs before initialization of the Helm buffer.")
(defvar helm-grep-after-init-hook nil
"Hook that runs after initialization of the Helm buffer.")
(defclass helm-grep-class (helm-source-async)
((candidates-process :initform 'helm-grep-collect-candidates)
(filtered-candidate-transformer :initform #'helm-grep-fc-transformer)
(popup-info :initform #'helm-grep-popup-info-fn)
(keymap :initform 'helm-grep-map)
(pcre :initarg :pcre :initform nil
:documentation
" Backend is using pcre regexp engine when non-nil.")
(nohighlight :initform t)
(nomark :initform t)
(backend :initarg :backend
:initform nil
:documentation
" The grep backend that will be used.
It is currently used only as an internal flag
and doesn't set the backend by itself.
You probably don't want to modify this.")
(candidate-number-limit :initform 9999)
(help-message :initform 'helm-grep-help-message)
(history :initform 'helm-grep-history)
(action :initform 'helm-grep-actions)
(persistent-action :initform 'helm-grep-persistent-action)
(persistent-help :initform "Jump to line (`C-u' Record in mark ring)")
(requires-pattern :initform 2)
(before-init-hook :initform 'helm-grep-before-init-hook)
(after-init-hook :initform 'helm-grep-after-init-hook)
(find-file-target :initform #'helm-grep-quit-an-find-file-fn)
(group :initform 'helm-grep)))
(defvar helm-source-grep nil)
(cl-defmethod helm--setup-source ((source helm-grep-class))
(cl-call-next-method)
(helm-aif (and helm-follow-mode-persistent
(if (eq (slot-value source 'backend) 'git)
helm-source-grep-git
helm-source-grep))
(setf (slot-value source 'follow)
(assoc-default 'follow it))))
(cl-defun helm-do-grep-1 (targets &optional recurse backend exts
default-input input (source 'helm-source-grep))
"Launch helm using backend BACKEND on a list of TARGETS files.
When RECURSE is given and BACKEND is \\='grep' use -r option of
BACKEND and prompt user for EXTS to set the --include args of
BACKEND.
Interactively you can give more than one arg separated by space
at prompt.
E.g.:
$Pattern: *.el *.py *.tex
From Lisp use the EXTS argument as a list of extensions as above.
If you are using ack-grep, you will be prompted for --type
instead and EXTS will be ignored. If prompt is empty
`helm-grep-ignored-files' are added to --exclude.
Argument DEFAULT-INPUT is use as `default' arg of `helm' and
INPUT is used as `input' arg of `helm'. See `helm' docstring.
Arg BACKEND when non-nil specifies which backend to use.
It is used currently to specify \\='zgrep' or \\='git'.
When BACKEND \\='zgrep' is used don't prompt for a choice in
recurse, and ignore EXTS, search being made recursively on files
matching `helm-zgrep-file-extension-regexp' only."
(let* (non-essential
(ack-rec-p (helm-grep-use-ack-p :where 'recursive))
(exts (and recurse
;; [FIXME] I could handle this from helm-walk-directory.
(not (eq backend 'zgrep)) ; zgrep doesn't handle -r opt.
(not ack-rec-p)
(or exts (helm-grep-get-file-extensions targets))))
(include-files
(and exts
(mapconcat (lambda (x)
(concat "--include="
(shell-quote-argument x)))
(if (> (length exts) 1)
(remove "*" exts)
exts) " ")))
(types (and (not include-files)
(not (eq backend 'zgrep))
recurse
ack-rec-p
;; When %e format spec is not specified
;; ignore types and do not prompt for choice.
(string-match "%e" helm-grep-default-command)
(helm-grep-read-ack-type)))
(src-name (capitalize (helm-grep-command recurse backend)))
(com (cond ((eq backend 'zgrep) helm-default-zgrep-command)
((eq backend 'git) helm-grep-git-grep-command)
(recurse helm-grep-default-recurse-command)
;; When resuming, the local value of
;; `helm-grep-default-command' is used, only git-grep
;; should need this.
(t helm-grep-default-command))))
;; When called as action from an other source e.g *-find-files
;; we have to kill action buffer.
(when (get-buffer helm-action-buffer)
(kill-buffer helm-action-buffer))
;; If `helm-find-files' haven't already started,
;; give a default value to `helm-ff-default-directory'
;; and set locally `default-directory' to this value . See below [1].
(unless helm-ff-default-directory
(setq helm-ff-default-directory default-directory))
;; We need to store these vars locally
;; to pass infos later to `helm-resume'.
(helm-set-local-variable
'helm-zgrep-recurse-flag (and recurse (eq backend 'zgrep))
'helm-grep-last-targets targets
'helm-grep-include-files (or include-files types)
'helm-grep-in-recurse recurse
'helm-grep-use-zgrep (eq backend 'zgrep)
'helm-grep-default-command com
'helm-input-idle-delay helm-grep-input-idle-delay
'default-directory helm-ff-default-directory) ;; [1]
;; Setup the source.
(set source (helm-make-source src-name 'helm-grep-class
:backend backend
:pcre (string-match-p "\\`ack" com)))
(helm
:sources source
:buffer (format "*helm %s*" (helm-grep-command recurse backend))
:default default-input
:input input
:keymap helm-grep-map
:history 'helm-grep-history
:truncate-lines helm-grep-truncate-lines)))
;;; zgrep
;;
;;
(defun helm-ff-zgrep-1 (flist recursive)
(unwind-protect
(let* ((def-dir (or helm-ff-default-directory
default-directory))
(only (if recursive
(or (gethash def-dir helm-rzgrep-cache)
(puthash
def-dir
(helm-walk-directory
def-dir
:directories nil
:path 'full
:match helm-zgrep-file-extension-regexp)
helm-rzgrep-cache))
flist)))
(helm-do-grep-1 only recursive 'zgrep))
(setq helm-zgrep-recurse-flag nil)))
;;; transformers
;;
;;
(defun helm-grep-split-line (line)
"Split a grep output line."
;; The output of grep may send a truncated line in this chunk,
;; so don't split until grep line is valid, that is
;; once the second part of the line comes with next chunk
;; send by process.
(when (string-match helm-grep-split-line-regexp line)
;; Don't use split-string because buffer/file name or string
;; may contain a ":".
(cl-loop for n from 1 to 3 collect (match-string n line))))
(defun helm-grep--filter-candidate-1 (candidate &optional dir pcre)
(let* ((root (or dir (and helm-grep-default-directory-fn
(funcall helm-grep-default-directory-fn))))
(ansi-p (string-match-p helm--ansi-color-regexp candidate))
(line (if ansi-p (ansi-color-apply candidate) candidate))
(split (helm-grep-split-line line))
(fname (if (and root split)
;; Filename should always be provided as a local
;; path, if the root directory is remote, the
;; tramp prefix will be added before executing
;; action, see `helm-grep-action' and Bug#2032.
(expand-file-name (car split)
(or (file-remote-p root 'localname)
root))
(car-safe split)))
(lineno (nth 1 split))
(str (nth 2 split))
(display-fname (cl-ecase helm-grep-file-path-style
(basename (and fname (file-name-nondirectory fname)))
(absolute fname)
(relative (and fname root
(file-relative-name fname root))))))
(if (and display-fname lineno str)
(cons (concat (propertize display-fname
'face 'helm-grep-file
'help-echo (abbreviate-file-name fname)
'helm-grep-fname fname)
":"
(propertize lineno 'face 'helm-grep-lineno)
":"
(if ansi-p str (helm-grep-highlight-match str pcre)))
line)
"")))
(defun helm-grep-filter-one-by-one (candidate &optional pcre)
"`filter-one-by-one' transformer function for `helm-do-grep-1'."
(let ((helm-grep-default-directory-fn
(or helm-grep-default-directory-fn
(lambda () (or helm-ff-default-directory
(and helm-alive-p
(helm-default-directory))
default-directory)))))
(if (consp candidate)
;; Already computed do nothing (default as input).
candidate
(and (stringp candidate)
(helm-grep--filter-candidate-1 candidate nil pcre)))))
(defun helm-grep-popup-info-fn (_candidate)
(helm-aif (get-text-property (pos-bol) 'helm-grep-fname)
(abbreviate-file-name it)))
(defun helm-grep-fc-transformer (candidates source)
(let ((helm-grep-default-directory-fn
(or helm-grep-default-directory-fn
(lambda () (or helm-ff-default-directory
(and (null (eq major-mode 'helm-grep-mode))
(helm-default-directory))
default-directory))))
(pcre (helm-get-attr 'pcre source)))
(cl-loop for c in candidates
collect (helm-grep--filter-candidate-1 c nil pcre))))
(defun helm-grep-highlight-match (str &optional pcre)
"Highlight in string STR all occurences matching `helm-pattern'."
(let (beg end)
(condition-case-unless-debug nil
(with-temp-buffer
(insert (propertize str 'read-only nil)) ; Fix bug#1176
(goto-char (point-min))
(cl-loop for reg in
(cl-loop for r in (helm-mm-split-pattern
helm-input)
unless (string-match "\\`!" r)
collect
(helm-aif (and helm-migemo-mode
(assoc r helm-mm--previous-migemo-info))
(cdr it) r))
do
(while (and (re-search-forward
(if pcre
(helm--translate-pcre-to-elisp reg)
reg)
nil t)
(> (- (setq end (match-end 0))
(setq beg (match-beginning 0)))
0))
(helm-add-face-text-properties beg end 'helm-grep-match))
do (goto-char (point-min)))
(buffer-string))
(error nil))))
;;; Grep from buffer list
;;
;;
(defun helm-grep-buffers-1 (candidate &optional zgrep)
"Run grep on all file buffers or CANDIDATE if it is a file buffer.
If one of selected buffers is not a file buffer, it is ignored
and grep will run on all others file-buffers.
If only one candidate is selected and it is not a file buffer,
switch to this buffer and run `helm-occur'.
If a prefix arg is given run grep on all buffers ignoring
non-file buffers."
(let* ((prefarg (or current-prefix-arg helm-current-prefix-arg))
(helm-ff-default-directory
(if (and helm-ff-default-directory
(file-remote-p helm-ff-default-directory))
default-directory
helm-ff-default-directory))
(cands (if prefarg
(buffer-list)
(helm-marked-candidates)))
(win-conf (current-window-configuration))
;; Non--fname and remote buffers are ignored.
(bufs (cl-loop for buf in cands
for fname = (buffer-file-name (get-buffer buf))
when (and fname (not (file-remote-p fname)))
collect (expand-file-name fname))))
(if bufs
(if zgrep
(helm-do-grep-1 bufs nil 'zgrep)
(helm-do-grep-1 bufs))
;; bufs is empty, thats mean we have only CANDIDATE
;; and it is not a buffer-filename, fallback to occur.
(switch-to-buffer candidate)
(when (get-buffer helm-action-buffer)
(kill-buffer helm-action-buffer))
(helm-occur)
(when (eq helm-exit-status 1)
(set-window-configuration win-conf)))))
(defun helm-grep-buffers (candidate)
"Action to grep buffers."
(helm-grep-buffers-1 candidate))
(defun helm-zgrep-buffers (candidate)
"Action to zgrep buffers."
(helm-grep-buffers-1 candidate 'zgrep))
;;; Helm interface for pdfgrep
;; pdfgrep program
;; and a pdf-reader (e.g xpdf) are needed.
;;
(defvar helm-pdfgrep-default-function 'helm-pdfgrep-init)
(defun helm-pdfgrep-init (only-files &optional recurse)
"Start an asynchronous pdfgrep process in ONLY-FILES list."
(let* ((default-directory (or helm-ff-default-directory
default-directory))
(fnargs (helm-grep-prepare-candidates
(if (file-remote-p default-directory)
(mapcar (lambda (x)
(file-remote-p x 'localname))
only-files)
only-files)
default-directory))
(cmd-line (format (if recurse
helm-pdfgrep-default-recurse-command
helm-pdfgrep-default-command)
helm-pattern
fnargs))
process-connection-type)
;; Start pdf grep process.
(helm-log "helm-pdfgrep-init" "Starting Pdf Grep process in directory `%s'" default-directory)
(helm-log "helm-pdfgrep-init" "Command line used was:\n\n%s"
(concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n"))
(prog1
(start-file-process-shell-command
"pdfgrep" helm-buffer cmd-line)
(message nil)
(set-process-sentinel
(get-buffer-process helm-buffer)
(lambda (_process event)
(if (string= event "finished\n")
(with-helm-window
(setq mode-line-format
'(" " mode-line-buffer-identification " "
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
(:eval (propertize
(format "[Pdfgrep Process Finish - %s result(s)] "
(max (1- (count-lines
(point-min) (point-max))) 0))
'face 'helm-grep-finish))))
(force-mode-line-update)
(when helm-allow-mouse
(helm--bind-mouse-for-selection helm-selection-point)))
(helm-log "helm-pdfgrep-init" "Error: Pdf grep %s"
(replace-regexp-in-string "\n" "" event))))))))
(defun helm-do-pdfgrep-1 (only &optional recurse)
"Launch pdfgrep with a list of ONLY files."
(unless (executable-find "pdfgrep")
(error "Error: No such program `pdfgrep'."))
(let (helm-grep-in-recurse) ; recursion is implemented differently in *pdfgrep.
;; When called as action from an other source e.g *-find-files
;; we have to kill action buffer.
(when (get-buffer helm-action-buffer)
(kill-buffer helm-action-buffer))
(setq helm-pdfgrep-targets only)
(helm
:sources (helm-build-async-source "PdfGrep"
:init (lambda ()
;; If `helm-find-files' haven't already started,
;; give a default value to `helm-ff-default-directory'.
(setq helm-ff-default-directory (or helm-ff-default-directory
default-directory)))
:candidates-process (lambda ()
(funcall helm-pdfgrep-default-function
helm-pdfgrep-targets recurse))
:nohighlight t
:nomark t
:filter-one-by-one #'helm-grep-filter-one-by-one
:candidate-number-limit 9999
:history 'helm-grep-history
:keymap helm-pdfgrep-map
:help-message 'helm-pdfgrep-help-message
:action #'helm-pdfgrep-action
:persistent-help "Jump to PDF Page"
:requires-pattern 2)
:buffer "*helm pdfgrep*"
:history 'helm-grep-history)))
(defun helm-pdfgrep-action (candidate)
(helm-grep-action candidate 'pdf))
(defun helm-pdfgrep-action-1 (_split pageno fname)
(save-selected-window
(start-file-process-shell-command
"pdf-reader" nil
(format-spec helm-pdfgrep-default-read-command
(list (cons ?f fname) (cons ?p pageno))))))
;;; AG - PT - RG
;;
;; https://github.com/ggreer/the_silver_searcher
;; https://github.com/monochromegane/the_platinum_searcher
;; https://github.com/BurntSushi/ripgrep
(defun helm-grep--ag-command ()
(and helm-grep-ag-command
(car (helm-remove-if-match
"\\`[A-Z]*=" (split-string helm-grep-ag-command)))))
(defun helm-grep-ag-get-types ()
"Returns a list of AG types if available with AG version.
See AG option \"--list-file-types\"
Ripgrep (rg) types are also supported if this backend is used."
(with-temp-buffer
(let* ((com (helm-grep--ag-command))
(ripgrep (string= com "rg"))
(regex (if ripgrep "^\\(.*\\):" "^ *\\(--[a-z]*\\)"))
(prefix (if ripgrep "-t " "")))
(when (equal (call-process com
nil t nil
(if ripgrep
"--type-list" "--list-file-types")) 0)
(goto-char (point-min))
(cl-loop while (re-search-forward regex nil t)
for type = (match-string 1)
collect (cons type (concat prefix type)))))))
(defun helm-grep-ag-prepare-cmd-line (pattern directory &optional type)
"Prepare AG command line to search PATTERN in DIRECTORY.
When TYPE is specified it is one of what `helm-grep-ag-get-types'
returns if available with current AG version."
(let* ((patterns (helm-mm-split-pattern pattern t))
(pipe-switches (mapconcat 'identity helm-grep-ag-pipe-cmd-switches " "))
(pipe-cmd (helm-acase (helm-grep--ag-command)
(("ag" "pt")
(format "%s -S --color%s" it (concat " " pipe-switches)))
("rg" (format "rg -N -S --color=%s%s"
(when (string-match "--color=\\([a-z]+\\) "
helm-grep-ag-command)
(match-string 1 helm-grep-ag-command))
(concat " " pipe-switches)))))
(cmd (format helm-grep-ag-command
(mapconcat 'identity type " ")
(shell-quote-argument (car patterns))
(shell-quote-argument directory))))
(helm-aif (cdr patterns)
(concat cmd (cl-loop for p in it concat
(format " | %s -- %s"
pipe-cmd (shell-quote-argument p))))
cmd)))
(defun helm-grep-ag-init (directory &optional type)
"Start AG process in DIRECTORY maybe searching only files of type TYPE."
(let ((default-directory (or helm-ff-default-directory
(helm-default-directory)
default-directory))
(cmd-line (helm-grep-ag-prepare-cmd-line
;; NOTE Encode directory name and pattern,
;; or it may not work with Chinese and maybe other non-utf8
;; characters on MSWindows systems issue#2677 and issue#2678.
(encode-coding-string helm-pattern locale-coding-system)
(or (file-remote-p directory 'localname)
(encode-coding-string directory locale-coding-system))
type))
(start-time (float-time))
(proc-name (helm-grep--ag-command)))
(set (make-local-variable 'helm-grep-last-cmd-line) cmd-line)
(helm-log "helm-grep-ag-init" "Starting %s process in directory `%s'"
proc-name directory)
(helm-log "helm-grep-ag-init" "Command line used was:\n\n%s"
(concat ">>> " cmd-line "\n\n"))
(prog1
(start-file-process-shell-command
proc-name helm-buffer cmd-line)
(set-process-sentinel
(get-buffer-process helm-buffer)
(lambda (process event)
(let* ((err (process-exit-status process))
(noresult (= err 1)))
(cond (noresult
(with-helm-buffer
(insert (concat "* Exit with code 1, no result found,"
" command line was:\n\n "
(propertize helm-grep-last-cmd-line
'face 'helm-grep-cmd-line)))
(setq mode-line-format
`(" " mode-line-buffer-identification " "
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
(:eval (propertize
(format
"[%s process finished - (no results)] "
,(upcase proc-name))
'face 'helm-grep-finish))))))
((string= event "finished\n")
(helm-log "helm-grep-ag-init" "%s process finished with %s results in %fs"
proc-name
(helm-get-candidate-number)
(- (float-time) start-time))
(helm-maybe-show-help-echo)
(with-helm-window
(setq mode-line-format
`(" " mode-line-buffer-identification " "
(:eval (format "L%s" (helm-candidate-number-at-point))) " "
(:eval (propertize
(format
"[%s process finished in %.2fs - (%s results)] "
,(upcase proc-name)
,(- (float-time) start-time)
(helm-get-candidate-number))
'face 'helm-grep-finish))))
(force-mode-line-update)
(when helm-allow-mouse
(helm--bind-mouse-for-selection helm-selection-point))))
(t (helm-log
"helm-grep-ag-init"
"Error: %s %s"
proc-name
(replace-regexp-in-string "\n" "" event))))))))))
(defun helm-grep-ag-search-results (_candidate)
"Launch a new helm session on the current results.
Allow narrowing the grep ag results to a specific file or pattern without
continuing calling grep ag, i.e. once called, what you type in minibuffer will be
searched with helm match functions in all the candidates found previously by
grep ag."
(with-helm-buffer
(let* ((src (helm-get-current-source))
(candidates (nthcdr 1 (split-string
(buffer-substring-no-properties
(point-min) (point-max))
"\n")))
(transfo (helm-get-attr 'filtered-candidate-transformer src))
(actions (helm-get-attr 'action src))
(name (helm-get-attr 'name src))
(directory (helm-get-attr 'directory src)))
(helm :sources (helm-build-sync-source (format "Search in %s" name)
:candidates candidates
:keymap 'helm-grep-map
:candidate-transformer
(lambda (candidates)
(let ((helm-grep-default-directory-fn
(lambda () directory)))
(funcall transfo candidates nil)))
:action actions)
:buffer "*helm search ag*"))))
(helm-make-command-from-action helm-grep-ag-run-search-results
"Run `helm-grep-ag-search-results' action." 'helm-grep-ag-search-results)
(defvar helm-grep-ag-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-grep-map)
(define-key map (kbd "C-s") 'helm-grep-run-ag-grep-parent-directory)
(define-key map (kbd "C-c s") 'helm-grep-ag-run-search-results)
map))
(defclass helm-grep-ag-class (helm-source-async)
((nohighlight :initform t)
(pcre :initarg :pcre :initform t
:documentation
" Backend is using pcre regexp engine when non--nil.")
(keymap :initform 'helm-grep-ag-map)
(history :initform 'helm-grep-ag-history)
(help-message :initform 'helm-grep-help-message)
(filtered-candidate-transformer :initform #'helm-grep-fc-transformer)
(popup-info :initform #'helm-grep-popup-info-fn)
(persistent-action :initform 'helm-grep-persistent-action)
(persistent-help :initform "Jump to line (`C-u' Record in mark ring)")
(candidate-number-limit :initform 99999)
(directory :initarg :directory :initform nil
:documentation
" Directory currently searched.")
(requires-pattern :initform 2)
(nomark :initform t)
(action :initform 'helm-grep-actions)
(find-file-target :initform #'helm-grep-quit-an-find-file-fn)
(group :initform 'helm-grep)))
(defvar helm-source-grep-ag nil)
(cl-defmethod helm--setup-source ((source helm-grep-ag-class))
(cl-call-next-method)
(helm-aif (and helm-follow-mode-persistent
helm-source-grep-ag
(assoc-default 'follow helm-source-grep-ag))
(setf (slot-value source 'follow) it)))
(defun helm-grep-ag-1 (directory &optional type input)
"Start helm ag in DIRECTORY maybe searching in files of type TYPE.
If INPUT is provided, use it as the search string."
(setq helm-source-grep-ag
(helm-make-source (upcase (helm-grep--ag-command)) 'helm-grep-ag-class
:header-name (lambda (name)
(format "%s [%s]"
name (abbreviate-file-name directory)))
:directory directory
:action (append helm-grep-actions
`((,(format "%s grep parent directory"
(upcase (helm-grep--ag-command)))
. helm-grep-ag-grep-parent-directory)
(,(format "Search results in grep %s buffer"
(upcase (helm-grep--ag-command)))
. helm-grep-ag-search-results)))
:candidates-process
(lambda () (helm-grep-ag-init directory type))))
(helm-set-local-variable 'helm-input-idle-delay helm-grep-input-idle-delay)
(helm :sources 'helm-source-grep-ag
:history 'helm-grep-ag-history
:input input
:truncate-lines helm-grep-truncate-lines
:buffer (format "*helm %s*" (helm-grep--ag-command))))
(defun helm-grep-ag-grep-parent-directory (_candidate)
"Restart helm-grep-ag in the parent of the currently searched directory."
(let* ((src (with-helm-buffer (car helm-sources)))
(directory (helm-basedir (helm-get-attr 'directory src) t))
(input helm-pattern))
(helm-grep-ag-1 directory nil input)))
(helm-make-command-from-action helm-grep-run-ag-grep-parent-directory
"Ag grep parent directory." 'helm-grep-ag-grep-parent-directory)
(defun helm-grep-ag (directory with-types)
"Start grep AG in DIRECTORY.
When WITH-TYPES is non-nil provide completion on AG types."
(require 'helm-adaptive)
(let ((com (capitalize (helm-grep--ag-command))))
(helm-grep-ag-1 directory
(helm-aif (and with-types
(helm-grep-ag-get-types))
(helm-comp-read
(format "%s type: " com) it
:must-match t
:marked-candidates t
:fc-transformer 'helm-adaptive-sort
:buffer (format "*helm %s types*" com))))))
;;; Git grep
;;
;;
(defvar helm-source-grep-git nil)
(defun helm-grep-git-1 (directory &optional all default input)
"Run git-grep on DIRECTORY.
If DIRECTORY is not inside or part of a git repo exit with error.
If optional arg ALL is non-nil grep the whole repo otherwise
start at DIRECTORY.
Arg DEFAULT is what you will have with `next-history-element',
arg INPUT is what you will have by default at prompt on startup."
(require 'vc)
(let* (helm-grep-default-recurse-command
;; Expand filename of each candidate with the git root dir.
;; The filename will be in the helm-grep-fname prop.
(helm-grep-default-directory-fn (lambda ()
(vc-find-root directory ".git")))
(helm-ff-default-directory (funcall helm-grep-default-directory-fn)))
(cl-assert helm-ff-default-directory nil "Not inside a Git repository")
(helm-do-grep-1 (if all '("") `(,(expand-file-name directory)))
nil 'git nil default input 'helm-source-grep-git)))
;;;###autoload
(defun helm-do-grep-ag (arg)
"Preconfigured `helm' for grepping with AG in `default-directory'.
With prefix arg prompt for type if available with your AG
version."
(interactive "P")
(require 'helm-files)
(helm-grep-ag (expand-file-name default-directory) arg))
;;;###autoload
(defun helm-grep-do-git-grep (arg)
"Preconfigured `helm' for git-grepping `default-directory'.
With a prefix arg ARG git-grep the whole repository."
(interactive "P")
(require 'helm-files)
(helm-grep-git-1 default-directory arg))
(provide 'helm-grep)
;;; helm-grep.el ends here
helm-4.0.3/helm-help.el 0000664 0000000 0000000 00000307740 15011067617 0014657 0 ustar 00root root 0000000 0000000 ;;; helm-help.el --- Help messages for Helm. -*- lexical-binding: t -*-
;; Copyright (C) 2012 ~ 2025 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 .
;;; Code:
(require 'helm)
(defgroup helm-help nil
"Embedded help for `helm'."
:group 'helm)
(defface helm-helper
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
:inherit helm-header))
"Face for Helm help string in minibuffer."
:group 'helm-help)
(defvar helm-help--string-list '(helm-help-message
helm-buffer-help-message
helm-ff-help-message
helm-read-file-name-help-message
helm-generic-file-help-message
helm-fd-help-message
helm-grep-help-message
helm-pdfgrep-help-message
helm-etags-help-message
helm-ucs-help-message
helm-bookmark-help-message
helm-esh-help-message
helm-buffers-ido-virtual-help-message
helm-moccur-help-message
helm-top-help-message
helm-M-x-help-message
helm-imenu-help-message
helm-colors-help-message
helm-semantic-help-message
helm-kmacro-help-message
helm-kill-ring-help-message)
"A list of help messages (strings) used by `helm-documentation'.")
(defvar helm-documentation-buffer-name "*helm documentation*")
;;;###autoload
(defun helm-documentation ()
"Preconfigured `helm' for Helm documentation.
With a prefix arg refresh the documentation.
Find here the documentation of all documented sources."
(interactive)
(let ((buf (get-buffer-create helm-documentation-buffer-name)))
(switch-to-buffer buf)
(set-buffer buf)
(let ((inhibit-read-only t))
(erase-buffer)
(save-excursion
(cl-loop for elm in helm-help--string-list
for str = (helm-interpret-value elm)
do (insert (substitute-command-keys str) "\n\n")))
(org-mode))
(setq buffer-read-only t)
(view-mode)))
;;; Local help messages.
;;; `helm-buffer-list' help
;;
;;
(defvar helm-buffer-help-message
"* Helm Buffer
** Tips
*** Completion
**** Major-mode
You can enter a partial major-mode name (e.g. lisp, sh) to narrow down buffers.
To specify the major-mode, prefix it with \"*\" e.g. \"*lisp\".
If you want to match all buffers but the ones with a specific major-mode
\(negation), prefix the major-mode with \"!\" e.g. \"*!lisp\".
If you want to specify more than one major-mode, separate them with \",\",
e.g. \"*!lisp,!sh,!fun\" lists all buffers but the ones in lisp-mode, sh-mode
and fundamental-mode.
Then enter a space followed by a pattern to narrow down to buffers matching this
pattern.
**** Search inside buffers
If you enter a space and a pattern prefixed by \"@\", Helm searches for text
matching this pattern *inside* the buffer (i.e. not in the name of the buffer).
Negation are supported i.e. \"!\".
When you specify more than one of such patterns, it will match
buffers with contents matching each of these patterns i.e. AND,
not OR. That means that if you specify \"@foo @bar\" the contents
of buffer will have to be matched by foo AND bar. If you specify
\"@foo @!bar\" it means the contents of the buffer have to be
matched by foo but NOT bar.
If you enter a pattern prefixed with an escaped \"@\", Helm searches for a
buffer matching \"@pattern\" but does not search inside the buffer.
**** Search by directory name
If you prefix the pattern with \"/\", Helm matches over the directory names
of the buffers.
This feature can be used to narrow down the search to one directory while
subsequent strings entered after a space match over the buffer name only.
Note that negation is not supported for matching on buffer filename.
Starting from Helm v1.6.8, you can specify more than one directory.
**** Fuzzy matching
`helm-buffers-fuzzy-matching' turns on fuzzy matching on buffer
names, but not on directory names or major modes. A pattern
starting with \"^\" disables fuzzy matching and matching is done
litteraly IOW do not use regexps (\"^\" or whatever special
regexp character) when you want to fuzzy match.
**** Examples
With the following pattern
\"*lisp ^helm @moc\"
Helm narrows down the list by selecting only the buffers that are in lisp mode,
start with \"helm\" and which content matches \"moc\".
Without the \"@\"
\"*lisp ^helm moc\"
Helm looks for lisp mode buffers starting with \"helm\" and containing \"moc\"
in their name.
With this other pattern
\"*!lisp !helm\"
Helm narrows down to buffers that are not in \"lisp\" mode and that do not match
\"helm\".
With this last pattern
/helm/ w3
Helm narrows down to buffers that are in any \"helm\" subdirectory and
matching \"w3\".
*** Creating buffers
When creating a new buffer, use `\\[universal-argument]' to choose a mode from a
list. This list is customizable, see `helm-buffers-favorite-modes'.
*** Killing buffers
You can kill buffers either one by one or all the marked buffers at once.
One kill-buffer command leaves Helm while the other is persistent. Run the
persistent kill-buffer command either with the regular
`helm-execute-persistent-action' called with a prefix argument (`\\[universal-argument] \\\\[helm-execute-persistent-action]')
or with its specific command `helm-buffer-run-kill-persistent'. See the
bindings below.
*** Switching to buffers
To switch to a buffer, press RET, to switch to a buffer in another window, select this buffer
and press \\\\[helm-buffer-switch-other-window], when called with a prefix arg
the buffer will be displayed vertically in other window.
If you mark more than one buffer, the marked buffers will be displayed in different windows.
*** Saving buffers
If buffer is associated to a file and is modified, it is by default colorized in orange,
see [[Meaning of colors and prefixes for buffers][Meaning of colors and prefixes for buffers]].
You can save these buffers with \\\\[helm-buffer-save-persistent].
If you want to save all these buffers, you can mark them with \\[helm-buffers-mark-similar-buffers]
and save them with \\[helm-buffer-save-persistent]. You can also do this in one step with
\\[helm-buffer-run-save-some-buffers]. Note that you will not be asked for confirmation.
*** Meaning of colors and prefixes for buffers
Remote buffers are prefixed with '@'.
Red => Buffer's file was modified on disk by an external process.
Indianred2 => Buffer exists but its file has been deleted.
Orange => Buffer is modified and not saved to disk.
Italic => A non-file buffer.
Yellow => Tramp archive buffer.
DimGray => Indirect buffer.
** Commands
\\
|Keys|Description|
|-------------+----------|
|\\[helm-buffer-run-zgrep]|Grep Buffer(s) works as zgrep too (`\\[universal-argument]' to grep all buffers but non-file buffers).
|\\[helm-buffers-run-occur]|Multi-Occur buffer or marked buffers (`\\[universal-argument]' to toggle force-searching current-buffer).
|\\[helm-buffer-switch-other-window]|Switch to other window.
|\\[helm-buffer-switch-other-frame]|Switch to other frame.
|\\[helm-buffers-run-browse-project]|Browse project from buffer.
|\\[helm-buffer-run-query-replace-regexp]|Query-replace-regexp in marked buffers.
|\\[helm-buffer-run-query-replace]|Query-replace in marked buffers.
|\\[helm-buffer-run-ediff]|Ediff current buffer with candidate. With two marked buffers, ediff those buffers.
|\\[helm-buffer-run-ediff-merge]|Ediff-merge current buffer with candidate. With two marked buffers, ediff-merge those buffers.
|\\[helm-buffer-diff-persistent]|Toggle Diff-buffer with saved file without leaving Helm.
|\\[helm-buffer-revert-persistent]|Revert buffer without leaving Helm.
|\\[helm-buffer-save-persistent]|Save buffer without leaving Helm.
|\\[helm-buffer-run-save-some-buffers]|Save all unsaved buffers.
|\\[helm-buffer-run-kill-buffers]|Delete marked buffers and leave Helm.
|\\[helm-buffer-run-kill-persistent]|Delete buffer without leaving Helm.
|\\[helm-buffer-run-rename-buffer]|Rename buffer.
|\\[helm-toggle-all-marks]|Toggle all marks.
|\\[helm-mark-all]|Mark all.
|\\[helm-toggle-buffers-details]|Toggle details.
|\\[helm-buffers-toggle-show-hidden-buffers]|Show hidden buffers.
|\\[helm-buffers-mark-similar-buffers]|Mark all buffers of the same type (color) as current buffer.")
;;; Find files help (`helm-find-files')
;;
;;
(defvar helm-ff-help-message
"* Helm Find Files
** Tips
*** Navigation summary
For a better experience you can enable auto completion by setting
`helm-ff-auto-update-initial-value' to non-nil in your init file. It is not
enabled by default to not confuse new users.
**** Navigate with arrow keys
You can use and arrows to go down or up one level, to disable
this customize `helm-ff-lynx-style-map'.
Note that using `setq' will NOT work.
**** Use `\\\\[helm-execute-persistent-action]' (persistent action) on a directory to go down one level
On a symlinked directory a prefix argument expands to its true name.
**** Use `\\\\[helm-find-files-up-one-level]' or `DEL' on a directory to go up one level
***** `DEL' behavior
`DEL' by default deletes char backward.
But when `helm-ff-DEL-up-one-level-maybe' is non nil `DEL' behaves
differently depending on the contents of helm-pattern. It goes up one
level if the pattern is a directory ending with \"/\" or disables HFF
auto update and delete char backward if the pattern is a filename or
refers to a non existing path. Going up one level can be disabled
if necessary by deleting \"/\" at the end of the pattern using
\\\\[backward-char] and \\[helm-delete-minibuffer-contents].
Note that when deleting char backward, Helm takes care of
disabling update giving you the opportunity to edit your pattern for
e.g. renaming a file or creating a new file or directory.
When `helm-ff-auto-update-initial-value' is non nil you may want to
disable it temporarily, see [[Toggle auto-completion][Toggle auto-completion]] for this.
**** Use `\\\\[helm-find-files-down-last-level]' to walk back the resulting tree of all the `\\\\[helm-find-files-up-one-level]' or DEL you did
The tree is reinitialized each time you browse a new tree with
`\\\\[helm-execute-persistent-action]' or by entering some pattern in the prompt.
**** `RET' behavior
It behaves differently depending on `helm-selection' (current candidate in helm-buffer):
- candidate basename is \".\" => Open it in dired.
- candidate is a directory => Expand it.
- candidate is a file => Open it.
If you have marked candidates and you press RET on a directory,
Helm will navigate to this directory. If you want to exit with
RET with default action with these marked candidates, press RET a
second time while you are on the root of this directory e.g.
\"/home/you/dir/.\" or press RET on any file which is not a
directory. You can also exit with default action at any moment
with `f1'.
Note that when copying, renaming, etc. from `helm-find-files' the
destination file is selected with `helm-read-file-name'.
**** `TAB' behavior
Normally `TAB' is bound to `helm-select-action' in helm-map which
display the action menu.
You can change this behavior by setting in `helm-find-files-map'
a new command for `TAB':
(define-key helm-find-files-map (kbd \"C-i\") 'helm-ff-TAB)
It will then behave slighly differently depending of
`helm-selection':
- candidate basename is \".\" => open the action menu.
- candidate is a directory => expand it (behave as \\\\[helm-execute-persistent-action]).
- candidate is a file => open action menu.
Called with a prefix arg open menu unconditionally.
*** Show information on files (permissions etc...)
Turn on `helm-popup-tip-mode'.
*** Filter out files or directories
You can show files or directories only with respectively
\\\\[helm-ff-toggle-dirs-only] and \\\\[helm-ff-toggle-files-only].
These are toggle commands i.e. filter/show_all.
Changing directory disable filtering.
*** Sort directory contents
When listing a directory without narrowing its contents, i.e. when pattern ends with \"/\",
you can sort alphabetically, by newest or by size by using respectively
\\\\[helm-ff-sort-alpha], \\[helm-ff-sort-by-newest] or \\[helm-ff-sort-by-size].
NOTE:
When starting back narrowing i.e. entering something in minibuffer after \"/\" sorting is done
again with fuzzy sorting and no more with sorting methods previously selected.
You can use these sort functions only on files or directory,
see [[Filter out files or directories][Filter out files or directories]].
*** Find file at point
Helm uses `ffap' partially or completely to find file at point depending on the
value of `helm-ff-guess-ffap-filenames': if non-nil, support is complete
\(annoying), if nil, support is partial.
Note that when the variable
`helm-ff-allow-non-existing-file-at-point' is non nil Helm will
insert the filename at point even if file with this name doesn't
exists. If non existing file at point ends with numbers prefixed
with \":\" the \":\" and numbers are stripped.
**** Find file at line number
When text at point is in the form of
~/elisp/helm/helm.el:1234
Helm finds this file at the indicated line number, here 1234.
**** Find URL at point
When a URL is found at point, Helm expands to that URL only.
Pressing `RET' opens that URL using `browse-url-browser-function'.
**** Find e-mail address at point
When an e-mail address is found at point, Helm expands to this e-mail address
prefixed with \"mailto:\". Pressing `RET' opens a message buffer with that
e-mail address.
*** Quick pattern expansion
**** Enter `~/' at end of pattern to quickly reach home directory
**** Enter `/' at end of pattern to quickly reach the file system root
**** Enter `./' at end of pattern to quickly reach `default-directory'
\(As per its value at the beginning of the session.)
If you already are in the `default-directory' this will move the cursor to the top.
**** Enter `../' at end of pattern will reach upper directory, moving cursor to the top
This is different from using `\\\\[helm-find-files-up-one-level]' in that it moves
the cursor to the top instead of remaining on the previous subdir name.
**** Enter `..name/' at end of pattern to start a recursive search
It searches directories matching \"name\" under the current directory,
see the [[Recursive completion on subdirectories][Recursive completion on subdirectories]] section below for more details.
**** Any environment variable (e.g. `$HOME') at end of pattern gets expanded
**** Any valid filename yanked after pattern gets expanded
**** Special case: URL at point
The quick expansions do not take effect after end a URL, you must kill the
pattern first (`\\[helm-delete-minibuffer-contents]').
*** Helm-find-files supports fuzzy matching
It starts from the third character of the pattern.
For instance \"fob\" or \"fbr\" will complete \"foobar\" but \"fb\" needs a
third character in order to complete it.
*** Watch briefly files contents while navigating
You can use `\\[helm-execute-persistent-action]' on a filename for this, then:
- First hit expands to that filename in the Helm buffer.
- Second hit displays the buffer filename.
- Third hit kills the buffer filename.
Note: `\\[universal-argument] \\[helm-execute-persistent-action]' displays the buffer directly.
*** Browse images directories with `helm-follow-mode' and navigate up/down
Before Emacs-27 Helm was using image-dired that works with
external ImageMagick tools. From Emacs-27 Helm use native
display of images with image-mode by default for Emacs-27 (see `helm-ff-display-image-native'),
this allows automatic resize when changing window size, zooming with `\\[helm-ff-increase-image-size-persistent]' and `\\[helm-ff-decrease-image-size-persistent]'
and rotate images as before.
You can also use `helm-follow-action-forward' and `helm-follow-action-backward' with
`\\[helm-follow-action-forward]' and `\\[helm-follow-action-backward]' respectively.
Note that these commands have different behavior when `helm-follow-mode'
is enabled (go to next/previous line only).
Use `\\[universal-argument] \\[helm-execute-persistent-action]' to display an image or kill its buffer.
TIP: Use `\\\\[helm-toggle-resplit-and-swap-windows]' and `\\[helm-enlarge-window]' to display Helm window vertically
and to enlarge it while viewing images.
Note this may not work with exotic Helm windows settings such as the ones in Spacemacs.
**** Show thumbnails
Helm use image-dired to show thumbnails on image files, you can
toggle the thumbnail view with \\`\\[helm-ff-toggle-thumbnails]'.
**** Launch a slideshow from marked files
Helm provides an action from `helm-find-files' that allows
running a slideshow on marked files. Just mark image files and
launch slideshow from action menu, bindings are self documented
in mode-line. NOTE: When hitting any other keys than the ones
mentionned in mode-line, slideshow will come in pause, to restart
it you will have to press twice SPACE.
*** Open files externally
- Open file with external program (`\\\\[helm-ff-run-open-file-externally]',`C-u' to choose).
Helm is looking what is used by default to open file
externally (mailcap files) but have its own variable
`helm-external-programs-associations' to store external
applications. If you call the action or its binding without
prefix arg Helm will see if there is an application suitable in
`helm-external-programs-associations', otherwise it will look in
mailcap files. If you want to specify which external application
to use (and its options) use a prefix arg.
If you have to pass arguments after filename use `%s' in your command e.g. \"foo %s -a -b\"
If you want to detach your program from Emacs, you can use e.g. \"(foo %s &)\" (only supported on Linux/Unix).
When using `%s' do not quote it (i.e. \"%s\"), helm is already quoting filename argument.
Note: What you configure for Helm in `helm-external-programs-associations'
will take precedence on mailcap files.
- Preview file with external program (`\\[helm-ff-run-preview-file-externally]').
Same as above but doesn't quit Helm session, it is apersistent action.
- Open file externally with default tool (`\\[helm-ff-run-open-file-with-default-tool]').
Use `xdg-open' to open files.
*** Toggle auto-completion
Normally auto-completion in helm-find-files is disabled by
default but you can toggle it with `\\[helm-ff-run-toggle-auto-update]'. To enable it on startup by
default, customize `helm-ff-auto-update-initial-value'.
It is useful when trying to create a new file or directory and you don't want
Helm to complete what you are writing.
Note: On a terminal, the default binding `C-' may not work.
In this case use `C-c '.
*** Show infos of files
To have infos on files like size, permissions etc... hit `\\[helm-ff-properties-persistent]'.
To have automatically brief infos on selected file, turn on `helm-popup-tip-mode'.
*** You can create a new directory and a new file at the same time
Simply write the path in the prompt and press `RET', e.g.
\"~/new/newnew/newnewnew/my_newfile.txt\".
*** To create a new directory, append a \"/\" to the new name and press `RET'
*** To create a new file, enter a filename not ending with \"/\"
Note that when you enter a new name, this one is prefixed with [+].
*** Recursive search from Helm-find-files
**** You can use Helm-browse-project (see binding below)
- With no prefix argument:
If the current directory is under version control with either git or hg and
helm-ls-git and/or helm-ls-hg are installed, it lists all the files under
version control. Otherwise it falls back to Helm-find-files. See
https://github.com/emacs-helm/helm-ls-git and
https://github.com/emacs-helm/helm-ls-hg.
- With one prefix argument:
List all the files under this directory and other subdirectories
\(recursion) and this list of files will be cached.
- With two prefix arguments:
Same but the cache is refreshed.
**** You can start a recursive search with \"locate\", \"find\" or [[https://github.com/sharkdp/fd][Fd]]
See \"NOTE\" in the [[Recursive completion on subdirectories][section on subdirectories]].
Using \"locate\", you can enable the local database with a prefix argument. If the
local database doesn't already exists, you will be prompted for its creation.
If it exists and you want to refresh it, give it two prefix args.
When using locate the Helm buffer remains empty until you type something.
Regardless Helm uses the basename of the pattern entered in the helm-find-files
session by default. Hitting `\\[next-history-element]' should just kick in the
locate search with this pattern. If you want Helm to automatically do this, add
`helm-source-locate' to `helm-sources-using-default-as-input'.
NOTE: On Windows use Everything with its command line ~es~ as a replacement of locate.
See [[https://github.com/emacs-helm/helm/wiki/Locate#windows][Locate on Windows]]
If your system use plocate as backend and you have no results when searching,
see [[Recursive completion on subdirectories][section on subdirectories]].
**** Recursive completion on subdirectories
Starting from the directory you are currently browsing, it is
possible to have completion of all directories underneath. Say
you are at \"/home/you/foo/\" and you want to go to
\"/home/you/foo/bar/baz/somewhere/else\", simply type
\"/home/you/foo/..else\" and enter the final \"/\". Helm will
then list all possible directories under \"foo\" matching
\"else\".
You can use either find, locate or fdfind as backend, see the variable
`helm-locate-recursive-dirs-command', the default is to use find as backend.
NOTE: When using `locate' as backend which uses an index, the
directory tree displayed may be out-of-date and not reflect the
latest change until you update the index (using \"updatedb\" for
\"locate\").
On recent systems plocate is used instead of mlocate and the
corresponding updatedb command doesn't index anymore user
directories, see the option PRUNE_BIND_MOUNTS in the updatedb man
page.
If a locale db file is found under current directory it will be
used instead of the global updatedb index.
To create a locale db file under current directory, use `C-u C-u
C-x C-f' from helm-find-files.
*** Insert filename at point or complete filename at point
On insertion (i.e. there is nothing at point):
- `\\[helm-ff-run-complete-fn-at-point]': insert absolute file name.
- `\\[universal-argument] \\[helm-ff-run-complete-fn-at-point]': insert abbreviated file name.
- `\\[universal-argument] \\[universal-argument] \\[helm-ff-run-complete-fn-at-point]': insert relative file name.
- `\\[universal-argument] \\[universal-argument] \\[universal-argument] \\[helm-ff-run-complete-fn-at-point]': insert basename.
On completion (\\[helm-ff-run-complete-fn-at-point]):
- Target starts with \"~/\": insert abbreviate file name.
- target starts with \"/\" or \"[a-z]:/\": insert full path.
- Otherwise: insert relative file name.
*** Use the wildcard to select multiple files
Use of wildcard is supported to run an action over a set of files.
Example: You can copy all the files with \".el\" extension by using \"*.el\" and
then run copy action.
Similarly, \"**.el\" (note the two stars) will recursively select all \".el\"
files under the current directory.
Note that when recursively copying files, you may have files with same name
dispatched across different subdirectories, so when copying them in the same
directory they will get overwritten. To avoid this Helm has a special action
called \"backup files\" that has the same behavior as the command line \"cp -f
--backup=numbered\": it allows you to copy many files with the same name from
different subdirectories into one directory. Files with same name are renamed
as follows: \"foo.txt.~1~\". Like with the --force option of cp, it is possible
to backup files in current directory.
This command is available only when `dired-async-mode' is active.
When using an action that involves an external backend (e.g. grep), using \"**\"
is not recommended (even though it works fine) because it will be slower to
select all the files. You are better off leaving the backend to do it, it will
be faster. However, if you know you have not many files it is reasonable to use
this, also using not recursive wildcard (e.g. \"*.el\") is perfectly fine for
this.
The \"**\" feature is active by default in the option `helm-file-globstar'. It
is different from the Bash \"shopt globstar\" feature in that to list files with
a named extension recursively you would write \"**.el\" whereas in Bash it would
be \"**/*.el\". Directory selection with \"**/\" like Bash \"shopt globstar\"
option is not supported yet.
Helm supports different styles of wildcards:
- `sh' style, the ones supported by `file-expand-wildcards'.
e.g. \"*.el\", \"*.[ch]\" which match respectively all \".el\"
files or all \".c\" and \".h\" files.
- `bash' style (partially) In addition to what allowed in `sh'
style you can specify file extensions that have more than one
character like this: \"*.{sh,py}\" which match \".sh\" and
\".py\" files.
Of course in both styles you can specify one or two \"*\".
*** Query replace regexp on filenames
Replace different parts of a file basename with something else.
When calling this action you will be prompted twice as with
`query-replace', first for the matching expression of the text to
replace and second for the replacement text. Several facilities,
however, are provided to make the two prompts more powerfull.
**** Syntax of the first prompt
In addition to simple regexps, these shortcuts are available:
- Basename without extension => \"%.\"
- Only extension => \".%\"
- Substring => \"%::\"
- Whole basename => \"%\"
**** Syntax of the second prompt
In addition to a simple string to use as replacement, here is what you can use:
- A placeholder refering to what you have selected in the first prompt: \"\\@\".
After this placeholder you can use a search-and-replace syntax à-la sed:
\"\\@///
You can select a substring from the string represented by the placeholder:
\"\\@::\"
- A special character representing a number which is incremented: \"\\#\".
- Shortcuts for `upcase', `downcase' and `capitalize'
are available as`%u', `%d' and `%c' respectively.
**** Examples
***** Recursively rename all files with \".JPG\" extension to \".jpg\"
Use the `helm-file-globstar' feature described in [[Use the wildcard to select multiple files][recursive globbing]]
by entering \"**.JPG\" at the end of the Helm-find-files pattern, then hit
\\\\[helm-ff-run-query-replace-fnames-on-marked] and enter \"JPG\" on first prompt, then \"jpg\" on second prompt and hit `RET'.
Alternatively you can enter \".%\" at the first prompt, then \"jpg\" and hit
`RET'. Note that when using this instead of using \"JPG\" at the first prompt,
all extensions will be renamed to \"jpg\" even if the extension of one of the
files is, say, \"png\". If you want to keep the original extension you can use
\"%d\" at the second prompt (downcase).
***** Batch-rename files from number 001 to 00x
Use \"\\#\" inside the second prompt.
Example 1: To rename the files
foo.jpg
bar.jpg
baz.jpg
to
foo-001.jpg
foo-002.jpg
foo-003.jpg
use \"%.\" as matching regexp and \"foo-\\#\" as replacement string.
Example 2: To rename the files
foo.jpg
bar.jpg
baz.jpg
to
foo-001.jpg
bar-002.jpg
baz-003.jpg
use as matching regexp \"%.\" and as replacement string \"\\@-\\#\".
***** Replace a substring
Use \"%::\".
Example: To rename files
foo.jpg
bar.jpg
baz.jpg
to
fOo.jpg
bAr.jpg
bAz.jpg
use as matching regexp \"%:1:2\" and as replacement string \"%u\" (upcase).
Note that you \*cannot* use \"%.\" and \".%\" along with substring replacement.
***** Modify the string from the placeholder (\\@)
- By substring, i.e. only using the substring of the placeholder: \"\\@::\".
The length of placeholder is used for when unspecified.
Example 1: \"\\@:0:2\" replaces from the beginning to the second char of the placeholder.
Example 2: \\@:2: replaces from the second char of the placeholder to the end.
- By search-and-replace: \"\\@///\".
Incremental replacement is also handled in .
Example 3: \"\\@/foo/bar/\" replaces \"foo\" by \"bar\" in the placeholder.
Example 4: \"\\@/foo/-\\#/\" replaces \"foo\" in the placeholder by 001, 002, etc.
***** Clash in replacements (avoid overwriting files)
When performing any of these replacement operations you may end up with same
names as replacement. In such cases Helm numbers the file that would otherwise
overwritten. For instance, should you remove the \"-m\" part from the files
\"emacs-m1.txt\", \"emacs-m2.txt\" and \"emacs-m3.txt\" you would end up with
three files named \"emacs.txt\", the second renaming overwriting first file, and
the third renaming overwriting second file and so on. Instead Helm will
automatically rename the second and third files as \"emacs(1).txt\" and
\"emacs(2).txt\" respectively.
***** Query-replace on filenames vs. serial-rename action
Unlike the [[Serial renaming][serial rename]] actions, the files renamed with
the query-replace action stay in their initial directory and are not moved to
the current directory. As such, using \"\\#\" to serial-rename files only makes
sense for files inside the same directory. It even keeps renaming files
with an incremental number in the next directories.
*** Serial renaming
You can use the serial-rename actions to rename, copy or symlink marked files to
a specific directory or in the current directory with all the files numbered
incrementally.
- Serial-rename by renaming:
Rename all marked files with incremental numbering to a specific directory.
- Serial-rename by copying:
Copy all marked files with incremental numbering to a specific directory.
- Serial-rename by symlinking:
Symlink all marked files with incremental numbering to a specific directory.
*** Edit marked files in a dired buffer
You can open a dired buffer containing only marked files with `\\\\[helm-ff-run-marked-files-in-dired]'.
With a prefix argument you can open this same dired buffer in wdired mode for
editing. Note that wildcards are supported as well, so you can use e.g.
\"*.txt\" to select all \".txt\" files in the current directory or \"**.txt\" to
select all files recursively from the current directory.
See [[Use the wildcard to select multiple files]] section above.
*** Defining default target directory for copying, renaming, etc
You can customize `helm-dwim-target' to behave differently depending on the
windows open in the current frame. Default is to provide completion on all
directories associated to each window.
*** Copying/Renaming from or to remote directories
Never use ssh tramp method to copy/rename large files, use
instead its scp method if you want to avoid out of memory
problems and crash Emacs or the whole system. Moreover when using
scp method, you will hit a bug when copying more than 3 files at
the time, see [[https://github.com/emacs-helm/helm/issues/1945][bug#1945]].
The best way currently is using Rsync to copy files from or to
remote, see [[Use Rsync to copy files][Use Rsync to copy files]].
Also if you often work on remote you may consider using SSHFS
instead of relying on tramp.
*** Copying and renaming asynchronously
If you have the async library installed (if you got Helm from MELPA you do), you
can use it for copying/renaming files by enabling `dired-async-mode'.
Note that even when async is enabled, running a copy/rename action with a prefix
argument will execute action synchronously. Moreover it will follow the first
file of the marked files in its destination directory.
When `dired-async-mode' is enabled, an additional action named \"Backup files\"
will be available. (Such command is not natively available in Emacs).
See [[Use the wildcard to select multiple files]] for details.
*** Multiple copies of a file
The command \\\\[helm-ff-run-mcp] allows
copying a single file to multiple directories. To use it, mark
the file you want to copy first and then mark the directories
where you want to copy file. For example if you run
\\[helm-ff-run-mcp] on the marked candidates '(\"foo.txt\" \"bar/\" \"baz\"),
\"foo.txt\" will be copied to directories \"bar/\" and \"baz/\".
*** Use Rsync to copy files
If Rsync is available, you can use it to copy/sync files or directories
with some restrictions though:
- Copying from/to tramp sudo method may not work (permissions).
- Copying from remote to remote is not supported (rsync restriction)
however you can mount a remote with sshfs and copy to it (best), otherwise you have to modify
the command line with a prefix arg, see [[https://unix.stackexchange.com/questions/183504/how-to-rsync-files-between-two-remotes][how-to-rsync-files-between-two-remotes]]
for the command line to use.
This command is mostly useful when copying large files as it is
fast, asynchronous and provide a progress bar in mode-line. Each
rsync process have its own progress bar, so you can run several
rsync jobs, they are independents. If rsync fails you can
consult the \"*helm-rsync*\" buffer to see rsync errors. An
help-echo (move mouse over progress bar) is provided to see which
file is in transfer. Note that when copying directories, no
trailing slashes are added to directory names, which mean that
directory is created on destination if it doesn't already exists,
see rsync documentation for more infos on rsync behavior. To
synchronize a directory, mark all in the directory and rsync all
marked to the destination directory or rsync the directory itself
to its parent, e.g. remote:/home/you/music => /home/you.
The options are configurable through `helm-rsync-switches', but
you can modify them on the fly when needed by using a prefix arg,
in this case you will be prompted for modifications.
NOTE: When selecting a remote file, if you use the tramp syntax
for specifying a port, i.e. host#2222, helm will add
automatically \"-e 'ssh -p 2222'\" to the rsync command line
unless you have specified yourself the \"-e\" option by editing
rsync command line with a prefix arg (see above).
*** Drag and drop files from Helm
When mouse support is enabled in Helm (which is the default, see
`helm-allow-mouse') you can drag and drop files to `default-directory'
of the buffer you drag-and-drop in or in an external application.
By default Helm copy files when using drag-and-drop, you can customize
`helm-ff-drag-mouse-1-default-action' to modify this, however note that
other actions than `copy' are not supported when dropping in dired buffers
as of now, it works when dropping in external apps like Thunar though.
Also drag-and-drop is not working when trying to drop in a window that
is in another desktop, in this case use the following solution.
To drag-and-drop to external applications you can also use the
external application [[https://github.com/mwh/dragon][Dragon]] and use it as follow:
#+begin_src elisp
(defun helm-ff-dragon (files)
\"Create a small window with FILES ready to drag and drop.
Use this to drop files on externals applications or desktop.
Dropping on emacs buffers with this is not supported.
Needs `dragon' executable: https://github.com/mwh/dragon.\"
(interactive (list (helm-marked-candidates)))
(cl-assert (executable-find \"dragon\") nil \"Dragon executable not found\")
(apply #'call-process \"dragon\" nil nil nil \"--all\" \"--and-exit\" files))
(define-key helm-find-files-map (kbd \"C-c m\") 'helm-ff-dragon)
#+end_src
Tip: From the Dragon window, you can move your mouse to an other desktop
where the external application you want to drag-and-drop is.
NOTE: Drag-and-dropping from elsewhere to Helm is forbidden.
*** Access files on Android phones from Helm
Since Android doesn't provide anymore mass storage for USB, it is
not simple to access files on Android, the best way to do this
currently seems to use Adb, here some hints to set this up, read
in addition the Tramp documentation.
1) Install Adb, most distribution provide it.
2) Enable on your phone USB debug in System/dvlpmnt settings.
3) From helm-find-files use adb tramp method:
/adb::/
From there you can navigate as usual, mark and copy files etc...
*** Bookmark the `helm-find-files' session
You can bookmark the `helm-find-files' session with `\\[helm-ff-bookmark-set]'.
You can later retrieve these bookmarks by calling `helm-filtered-bookmarks'
or, from the current `helm-find-files' session, by hitting `\\[helm-find-files-switch-to-bookmark]'.
*** Grep files from `helm-find-files'
You can grep individual files from `helm-find-files' by using
\`\\\\[helm-ff-run-grep]'. This same command can also
recursively grep files from the current directory when called with a prefix
argument. In this case you will be prompted for the file extensions to use
\(grep backend) or the types of files to use (ack-grep backend). See the
`helm-grep-default-command' documentation to set this up. For compressed files
or archives, use zgrep with \`\\\\[helm-ff-run-zgrep]'.
Otherwise you can use recursive commands like \`\\\\[helm-ff-run-grep-ag]' or `\\\\[helm-ff-run-git-grep]'
that are much faster than using `\\\\[helm-ff-run-grep]' with a prefix argument.
See `helm-grep-ag-command' and `helm-grep-git-grep-command' to set this up.
You can also use \"id-utils\"' GID with \`\\\\[helm-ff-run-gid]'
by creating an ID index file with the \"mkid\" shell command.
All those grep commands use the symbol at point as the default pattern.
Note that default is different from input (nothing is added to the prompt until
you hit `\\[next-history-element]').
**** Grepping on remote files
On remote files grep is not well supported by TRAMP unless you suspend updates before
entering the pattern and re-enable it once your pattern is ready.
To toggle suspend-update, use `\\\\[helm-toggle-suspend-update]'.
*** Compressing or uncompressing files from helm-find-files
**** Compressing/uncompressing using Helm commands
Helm provide commands like dired (reusing dired code)
to (un)compress files from `helm-find-files', however these
commands are asynchronous.
You can use `\\\\[helm-ff-run-compress-marked-files]' to compress marked files.
To compress file(s) to an archive use `\\\\[helm-ff-run-compress-to]'.
To quickly compress/uncompress small files without quitting Helm use `\\\\[helm-ff-persistent-compress]'.
NOTE: This persistent action is NOT asynchronous, IOW it will block Helm
for a while until compression/uncompression finish.
**** Compressing/uncompressing using external commands in Eshell
You can use Eshell aliases to uncompress files,
see [[Execute Eshell commands on files][Execute Eshell commands on files]] for more infos.
Here some aliases using commands from the excellent =atools= package:
alias pack2zip apack -e -F .zip $* &
alias pack2gz apack -e -F .tar.gz $* &
alias pack2bz apack -e -F .tar.bz $* &
alias pack2xz apack -e -F .tar.xz $* &
alias unpack aunpack $1 &
Note the \"&\" at end of commands that make eshell aliases asynchronous.
NOTE: Using the ampersand at end of command to make it asynchronous is broken
in all emacs versions before emacs-28 (see emacs bug#50209).
Of course you can use any other commands of your choice as aliases.
*** Execute Eshell commands on files
Setting up aliases in Eshell allows you to set up powerful customized commands.
Your aliases for using eshell command on file should allow
specifying one or more files, use e.g. \"alias foo $1\" or
\"alias foo $*\", if you want your command to be asynchronous add
at end \"&\", e.g. \"alias foo $* &\".
Adding Eshell aliases to your `eshell-aliases-file' or using the
`alias' command from Eshell allows you to create personalized
commands not available in `helm-find-files' actions and use them
from `\\\\[helm-ff-run-eshell-command-on-file]'.
Example: You want a command to uncompress some \"*.tar.gz\" files from `helm-find-files':
1) Create an Eshell alias named, say, \"untargz\" with the command
\"alias untargz tar zxvf $*\".
2) Now from `helm-find-files' select the \"*.tar.gz\" file (you can also
mark files if needed) and hit `\\\\[helm-ff-run-eshell-command-on-file]'.
Note: When using marked files with this, the meaning of the prefix argument is
quite subtle. Say you have \"foo\", \"bar\" and \"baz\" marked; when you run
the alias command `example' on these files with no prefix argument it will run
`example' sequentially on each file:
$ example foo
$ example bar
$ example baz
With a prefix argument however it will apply `example' on all files at once:
$ example foo bar baz
Of course the alias command should support this.
NOTE: Helm assume that any alias command ending with '$*' or
'$*&' supports many files as arguments, so no need to give a
prefix arg for such alias, however if your command is not an
alias you have to specify a prefix arg if you want your command
to apply all files at once.
If you add %s to the command line %s will be replaced with the candidate, this mean you can
add extra argument to your command e.g. command -extra-arg %s or command %s -extra-arg.
If you want to pass many files inside %s, don't forget to use a prefix arg.
You can also use special placeholders in extra-args,
see the specific info page once you hit `\\\\[helm-ff-run-eshell-command-on-file]'.
*** Using TRAMP with `helm-find-files' to read remote directories
`helm-find-files' works fine with TRAMP despite some limitations.
- Grepping files is not very well supported when used incrementally.
See [[Grepping on remote files]].
- Locate does not work on remote directories.
**** A TRAMP syntax crash course
Please refer to TRAMP's documentation for more details.
- Connect to host 192.168.0.4 as user \"foo\":
/scp:192.168.0.4@foo:
- Connect to host 192.168.0.4 as user \"foo\" on port 2222:
/scp:192.168.0.4@foo#2222:
- Connect to host 192.168.0.4 as root using multihops syntax:
/ssh:192.168.0.4@foo|sudo:192.168.0.4:
Note: You can also use `tramp-default-proxies-alist' when connecting often to
the same hosts.
As a rule of thumb, prefer the scp method unless using multihops (which only
works with the ssh method), especially when copying large files.
IMPORTANT:
You need to hit `C-j' once on top of a directory on the first connection
to complete the pattern in the minibuffer.
**** Display color for directories, symlinks etc... with tramp
Starting at helm version 2.9.7 it is somewhat possible to
colorize fnames by listing files without loosing performances with
external commands (ls and awk) if your system is compatible.
For this you can use `helm-list-dir-external' as value
for `helm-list-remote-directory-fn'.
See `helm-list-remote-directory-fn' documentation for more infos.
**** Completing host
As soon as you enter the first \":\" after method e.g =/scp:= you will
have some completion about previously used hosts or from your =~/.ssh/config=
file, hitting `\\[helm-execute-persistent-action]' or `right' on a candidate will insert this host in minibuffer
without addind the ending \":\", second hit insert the last \":\".
As soon the last \":\" is entered TRAMP will kick in and you should see the list
of candidates soon after.
**** Completion on tramp methods
If you enter \":\" directly after \"/\" or \"|\" you will have completion on tramp methods,
hitting `\\[helm-execute-persistent-action]' or `right' on a method will insert it in minibuffer.
When connection fails, be sure to delete your TRAMP connection with M-x
`helm-delete-tramp-connection' before retrying.
**** Editing local files as root
Use the sudo method:
\"/sudo:host:\" or simply \"/sudo::\".
*** Attach files to a mail buffer (message-mode)
If you are in a `message-mode' or `mail-mode' buffer, that action will appear
in action menu, otherwise it is available at any time with \\\\[helm-ff-run-mail-attach-files].
It behaves as follows:
- If you are in a (mail or message) buffer, files are attached there.
- If you are not in a mail buffer but one or more mail buffers exist, you are
prompted to attach files to one of these mail buffers.
- If you are not in a mail buffer and no mail buffer exists,
a new mail buffer is created with the attached files in it.
*** Open files in separate windows
When [[Marked candidates][marking]] multiple files or using [[Use the wildcard to select multiple files][wildcard]], helm allow opening all
this files in separate windows using an horizontal layout or a
vertical layout if you used a prefix arg, when no more windows can be
displayed in frame, next files are opened in background without being
displayed. When using \\\\[helm-ff-run-switch-other-window] the current
buffer is kept and files are displayed next to it with same behavior as above.
When using two prefix args, files are opened in background without beeing displayed.
*** Expand archives as directories in a avfs directory
If you have mounted your filesystem with 'mountavfs' command,
you can expand archives in the \"~/.avfs\" directory with \\\\[helm-execute-persistent-action].
To umount Avfs, use ~fusermount -u ~/.avfs~
NOTE: You need the package 'avfs', on debian like distros use ~apt-get install avfs~.
*** Tramp archive support (emacs-27+ only)
As Tramp archive often crash Helm and Emacs, Helm does its best
to disable it, however it is hard to do so as Tramp Archive is
enabled inconditionally in Emacs. Here I build my Emacs
without-dbus to ensure Tramp archive wont kickin unexpectedly.
If you want to browse archives please use [[Expand archives as
directories in a avfs directory][Avfs]] which is much better and
stable.
*** Touch files
In the completion buffer, you can choose the default which is the current-time, it is
the first candidate or the timestamp of one of the selected files.
If you need to use something else, use \\\\[next-history-element] and edit
the date in minibuffer.
It is also a way to quickly create a new file without opening a buffer, saving it
and killing it.
To touch more than one new file, separate you filenames with a comma (\",\").
If one wants to create (touch) a new file with comma inside the name use a prefix arg,
this will prevent splitting the name and create multiple files.
*** Change mode on files (chmod)
When running `\\\\[helm-ff-run-chmod]' on marked
files, you can enter the new mode in prompt but you can also use the
first marked file as model to use it as default. For example you can
mark a file with mode 777 and mark other files with mode 664, press
'RET' and answer 'y', all marked files will be changed to 777. To see
the default mode and eventually edit it use 'M-n'. You can use numeric
mode or letters, see 'chmod' man page for more infos.
NOTE: Another way to change modes on files in helm-find-files is
running `\\\\[helm-ff-run-switch-to-shell]' and use 'chmod' directly.
*** Delete files
You can delete files without quitting helm with
`\\\\[helm-ff-persistent-delete]' or delete files and quit helm with `\\[helm-ff-run-delete-file]'.
In the second method you can choose to
make this command asynchronous by customizing
\`helm-ff-delete-files-function'.
_WARNING_: When deleting files asynchronously you will NOT be
WARNED if directories are not empty, that's mean non empty directories will
be deleted recursively in background without asking.
A good compromise is to trash your files
when using asynchronous method (see [[Trashing files][Trashing files]]).
When choosing synchronous delete, you can allow recursive
deletion of directories with `helm-ff-allow-recursive-deletes'.
Note that when trashing (synchronous) you are not asked for recursive deletion.
Note that `helm-ff-allow-recursive-deletes' have no effect when
deleting asynchronously.
First method (persistent delete) is always synchronous.
Note that when a prefix arg is given, trashing behavior is inversed.
See [[Trashing files][Trashing files]].
**** Trashing files
If you want to trash your files instead of deleting them you can
set `delete-by-moving-to-trash' to non nil, like this your files
will be moved to trash instead of beeing deleted.
You can reverse at any time the behavior of `delete-by-moving-to-trash' by using
a prefix arg with any of the delete files command.
On GNULinux distributions, when navigating to a Trash directory you
can restore any file in ..Trash/files directory with the 'Restore
from trash' action you will find in action menu (needs the
trash-cli package installed for remote files, see [[Trashing remote files with tramp][Here]]).
You can as well delete files from Trash directories with the 'delete files from trash'
action.
If you want to know where a file will be restored, hit `M-i', you will find a trash info.
Tip: Navigate to your Trash/files directories with `helm-find-files' and set a bookmark
there with \\\\[helm-ff-bookmark-set] for fast access to Trash.
NOTE: Restoring files from trash is working only on system using
the
[[http://freedesktop.org/wiki/Specifications/trash-spec][freedesktop trash specifications]].
***** Trashing remote files with tramp
Trashing remote files (or local files with sudo method) is disabled by default
because tramp is requiring the 'trash' command to be installed, if you want to
trash your remote files, customize `helm-trash-remote-files'.
The package on most GNU/Linux based distributions is trash-cli, it is available [[https://github.com/andreafrancia/trash-cli][here]].
NOTE:
When deleting your files with sudo method, your trashed files will not be listed
with trash-list command line until you log in as root.
*** Checksum file
Checksum is calculated with the md5sum, sha1sum, sha224sum,
sha256sum, sha384sum and sha512sum commands when available, otherwise the
Emacs function `secure-hash' is used but it is slow and may crash
Emacs and even the whole system as it eats all memory. So if
your system doesn't have the md5sum and sha*sum command line tools be
careful when checking sum of larges files e.g. isos.
*** Ignored or boring files
Helm-find-files can ignore files matching
`helm-boring-file-regexp-list' or files that are git ignored, you
can set this with `helm-ff-skip-boring-files' or
`helm-ff-skip-git-ignored-files'.
NOTE: This will slow down helm, be warned.
*** Helm-find-files is using a cache
Helm is caching each directory files list in a hash table for
faster search, when a directory is modified it is removed from cache
so that further visit in this directory refresh cache.
You may have in some rare cases to refresh directory manually with `\\\\[helm-refresh]'
for example when helm-find-files session is running and a file is modified/deleted
in current visited directory by an external command from outside Emacs.
NOTE: Helm is using file-notify to watch visited directories,
nowaday most systems come with a notify package but if your
system doesn't support this, you can turn off file notifications
by customizing the variable `helm-ff-use-notify'. In this case
you will have to refresh manually directories when needed with `\\\\[helm-refresh]'.
*** Prefix file candidates with icons
If `all-the-icons' package is installed, turning on
`helm-ff-icon-mode' will show icons before files and directories.
** Commands
\\
|Keys|Description
|-----------+----------|
|\\[helm-ff-run-locate]|Run `locate' (`\\[universal-argument]' to specify locate database, `M-n' to insert basename of candidate).
|\\[helm-ff-run-browse-project]|Browse project (`\\[universal-argument]' to recurse, `\\[universal-argument] \\[universal-argument]' to recurse and refresh database).
|\\[helm-ff-run-find-sh-command]|Run `find' shell command from this directory.
|\\[helm-ff-run-grep]|Run Grep (`\\[universal-argument]' to recurse).
|\\[helm-ff-run-pdfgrep]|Run Pdfgrep on marked files.
|\\[helm-ff-run-zgrep]|Run zgrep (`\\[universal-argument]' to recurse).
|\\[helm-ff-run-grep-ag]|Run AG grep on current directory.
|\\[helm-ff-run-git-grep]|Run git-grep on current directory.
|\\[helm-ff-run-gid]|Run gid (id-utils).
|\\[helm-ff-run-etags]|Run Etags (`\\[universal-argument]' to use thing-at-point, `\\[universal-argument] \\[universal-argument]' to reload cache).
|\\[helm-ff-run-rename-file]|Rename Files (`\\[universal-argument]' to follow).
|\\[helm-ff-run-query-replace-fnames-on-marked]|Query replace on marked files.
|\\[helm-ff-run-copy-file]|Copy Files (`\\[universal-argument]' to follow).
|\\[helm-ff-run-mcp]|Copy car of marked to remaining directories.
|\\[helm-ff-run-rsync-file]|Rsync Files (`\\[universal-argument]' to edit command).
|\\[helm-ff-run-byte-compile-file]|Byte Compile Files (`\\[universal-argument]' to load).
|\\[helm-ff-run-load-file]|Load Files.
|\\[helm-ff-run-symlink-file]|Symlink Files.
|\\[helm-ff-run-hardlink-file]|Hardlink files.
|\\[helm-ff-run-relsymlink-file]|Relative symlink Files.
|\\[helm-ff-run-chmod]|Change mode on Files.
|\\[helm-ff-run-delete-file]|Delete Files.
|\\[helm-ff-run-touch-files]|Touch files.
|\\[helm-ff-run-kill-buffer-persistent]|Kill buffer candidate without leaving Helm.
|\\[helm-ff-persistent-delete]|Delete file without leaving Helm.
|\\[helm-ff-run-switch-to-shell]|Switch to prefered shell.
|\\[helm-ff-run-eshell-command-on-file]|Eshell command on file (`\\[universal-argument]' to apply on marked files, otherwise treat them sequentially).
|\\[helm-ff-run-ediff-file]|Ediff file.
|\\[helm-ff-run-ediff-merge-file]|Ediff merge file.
|\\[helm-ff-run-complete-fn-at-point]|Complete file name at point.
|\\[helm-ff-run-switch-other-window]|Switch to other window.
|\\[helm-ff-run-switch-other-frame]|Switch to other frame.
|\\[helm-ff-run-open-file-externally]|Open file with external program (`\\[universal-argument]' to choose).
|\\[helm-ff-run-preview-file-externally]|Preview file with external program.
|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool.
|\\[helm-ff-rotate-left-persistent]|Rotate image left.
|\\[helm-ff-rotate-right-persistent]|Rotate image right.
|\\[helm-ff-increase-image-size-persistent]|Zoom in image.
|\\[helm-ff-decrease-image-size-persistent]|Zoom out image.
|\\[helm-ff-toggle-thumbnails]|Show thumbnails on image files.
|\\[helm-find-files-up-one-level]|Go to parent directory.
|\\[helm-find-files-history]|Switch to the visited-directory history.
|\\[helm-ff-file-name-history]|Switch to file name history.
|\\[helm-ff-properties-persistent]|Show file properties in a tooltip.
|\\[helm-mark-all]|Mark all visible candidates.
|\\[helm-ff-run-toggle-auto-update]|Toggle auto-expansion of directories.
|\\[helm-unmark-all]|Unmark all candidates, visible and invisible ones.
|\\[helm-ff-run-mail-attach-files]|Attach files to message buffer.
|\\[helm-ff-run-print-file]|Print file, (`\\[universal-argument]' to refresh printer list).
|\\[helm-enlarge-window]|Enlarge Helm window.
|\\[helm-narrow-window]|Narrow Helm window.
|\\[helm-ff-run-toggle-basename]|Toggle basename/fullpath.
|\\[helm-ff-run-find-file-as-root]|Find file as root.
|\\[helm-ff-run-find-alternate-file]|Find alternate file.
|\\[helm-ff-run-insert-org-link]|Insert org link.
|\\[helm-ff-bookmark-set]|Set bookmark to current directory.
|\\[helm-find-files-switch-to-bookmark]|Jump to bookmark list.
|\\[helm-ff-sort-alpha]|Sort alphabetically.
|\\[helm-ff-sort-by-newest]|Sort by newest.
|\\[helm-ff-sort-by-size]|Sort by size.
|\\[helm-ff-toggle-dirs-only]|Show only directories.
|\\[helm-ff-toggle-files-only]|Show only files.
|\\[helm-ff-sort-by-ext]|Sort by extensions.
|\\[helm-ff-run-compress-to]|Compress file(s) to archive.
|\\[helm-ff-run-compress-marked-files]|Compress file(s).
|\\[helm-ff-persistent-compress]|Compress file(s) without quitting.")
;;; Help for file-name-history
;;
;;
(defvar helm-file-name-history-help-message
"* Helm file name history
** Tips
You can open directly the selected file and exit helm or preselect the file in helm-find-files,
see actions in action menu.
You can toggle the view of deleted files, see commands below.
** Commands
\\
\\[helm-file-name-history-show-or-hide-deleted]|Toggle deleted files view.")
;;; Help for `helm-read-file-name'
;;
;;
(defun helm-read-file-name-help-message ()
(let ((name (if helm-alive-p
(assoc-default 'name (helm-get-current-source))
"generic")))
(format
"* Helm `%s' read file name completion
This is `%s' read file name completion that have been \"helmized\"
because you have enabled [[Helm mode][helm-mode]].
Don't confuse this with `helm-find-files' which is a native helm command,
see [[Helm functions vs helmized Emacs functions]].
** Tips
*** Navigation
**** Enter `~/' at end of pattern to quickly reach home directory
**** Enter `/' at end of pattern to quickly reach the file system root
**** Enter `./' at end of pattern to quickly reach `default-directory'
\(As per its value at the beginning of the session.)
If you already are in the `default-directory' this will move the cursor to the top.
**** Enter `../' at end of pattern will reach upper directory, moving cursor on top
This is different from using `\\[helm-find-files-up-one-level]' in that it moves
the cursor to the top instead of remaining on the previous subdir name.
**** You can complete with partial basename
It starts from the third character of the pattern.
For instance \"fob\" or \"fbr\" will complete \"foobar\" but \"fb\" needs a
third character in order to complete it.
*** Persistent actions
By default `helm-read-file-name' uses the persistent actions of `helm-find-files'.
**** Use `\\[universal-argument] \\\\[helm-execute-persistent-action]' to display an image
**** `\\\\[helm-execute-persistent-action]' on a filename will expand to this filename in Helm-buffer
Second hit displays the buffer filename.
Third hit kills the buffer filename.
Note: `\\[universal-argument] \\\\[helm-execute-persistent-action]' displays the buffer directly.
**** Browse images directories with `helm-follow-mode' and navigate up/down
*** Delete characters backward
When you want to delete characters backward, e.g. to create a new file or directory,
auto-update may come in the way when it keeps updating to an existent directory.
In that case, type `C-' and then `'.
This should not be needed when copying/renaming files because autoupdate is disabled
by default in that case.
Note: On a terminal, the default binding `C-' may not work.
In this case use `C-c '.
*** Create new directories and files
**** You can create a new directory and a new file at the same time
Simply write the path in prompt and press `RET', e.g.
\"~/new/newnew/newnewnew/my_newfile.txt\".
**** To create a new directory, append a \"/\" at to the new name and press `RET'
**** To create a new file, enter a filename not ending with \"/\"
File and directory creation works only with some commands (e.g. `find-file')
and it will not work with others where it is not intended to return a file or
a directory \(e.g `list-directory').
*** Exiting minibuffer with empty string
You can exit minibuffer with empty string with \\\\[helm-cr-empty-string].
It is useful when some commands are prompting continuously until you enter an empty prompt.
** Commands
\\
|Keys|Description
|-----------+----------|
|\\[helm-find-files-up-one-level]|Go to parent directory.
|\\[helm-ff-run-toggle-auto-update]|Toggle auto-expansion of directories.
|\\[helm-ff-run-toggle-basename]|Toggle basename.
|\\[helm-ff-file-name-history]|File name history.
|C/\\[helm-cr-empty-string]|Return empty string unless `must-match' is non-nil.
|\\[helm-next-source]|Go to next source.
|\\[helm-previous-source]|Go to previous source."
name name)))
;;; FD help
;;
;;
(defvar helm-fd-help-message
"* Helm fd
** Tips
\[[https://github.com/sharkdp/fd][The Fd command line tool]] is very fast to search files recursively.
You may have to wait several seconds at first usage when your
hard drive cache is \"cold\", then once the cache is initialized
searchs are very fast. You can pass any [[https://github.com/sharkdp/fd#command-line-options][Fd options]] before pattern, e.g. \"-e py foo\".
The [[https://github.com/sharkdp/fd][Fd]] command line can be customized with `helm-fd-switches' user variable.
Always use =--color always= as option otherwise you will have no colors.
To customize colors see [[https://github.com/sharkdp/fd#colorized-output][Fd colorized output]].
NOTE:
Starting from fd version 8.2.1, you have to provide the env var
LS_COLORS to Emacs to have a colorized output, the easiest way is
to add to your =~/.profile= file =eval $(dircolors)=.
Another way is using =setenv= in your init file.
This is not needed when running Emacs from a terminal either with =emacs -nw=
or =emacs= because emacs inherit the env vars of this terminal.
See [[https://github.com/sharkdp/fd/issues/725][fd bugref#725]]
Search is (pcre) regexp based (see [[https://docs.rs/regex/1.0.0/regex/#syntax][Regexp syntax]]), multi patterns are _not_ supported.
** Man page
NAME
fd - find entries in the filesystem
SYNOPSIS
fd [-HIEsiaLp0hV] [-d depth] [-t filetype] [-e ext] [-E exclude] [-c
when] [-j num] [-x cmd] [pattern] [path...]
DESCRIPTION
fd is a simple, fast and user-friendly alternative to find(1).
OPTIONS
-H, --hidden
Include hidden files and directories in the search results
(default: hidden files and directories are skipped).
-I, --no-ignore
Show search results from files and directories that would other‐
wise be ignored by .gitignore, .ignore, .fdignore, or the global
ignore file.
-u, --unrestricted
Alias for '--no-ignore'. Can be repeated; '-uu' is an alias for
'--no-ignore --hidden'.
--no-ignore-vcs
Show search results from files and directories that would other‐
wise be ignored by .gitignore files.
-s, --case-sensitive
Perform a case-sensitive search. By default, fd uses case-insen‐
sitive searches, unless the pattern contains an uppercase char‐
acter (smart case).
-i, --ignore-case
Perform a case-insensitive search. By default, fd uses case-
insensitive searches, unless the pattern contains an uppercase
character (smart case).
-g, --glob
Perform a glob-based search instead of a regular expression
search.
--regex
Perform a regular-expression based seach (default). This can be
used to override --glob.
-F, --fixed-strings
Treat the pattern as a literal string instead of a regular
expression.
-a, --absolute-path
Shows the full path starting from the root as opposed to rela‐
tive paths.
-l, --list-details
Use a detailed listing format like 'ls -l'. This is basically an
alias for '--exec-batch ls -l' with some additional 'ls'
options. This can be used to see more metadata, to show symlink
targets and to achieve a deterministic sort order.
-L, --follow
By default, fd does not descend into symlinked directories.
Using this flag, symbolic links are also traversed.
-p, --full-path
By default, the search pattern is only matched against the file‐
name (or directory name). Using this flag, the pattern is
matched against the full path.
-0, --print0
Separate search results by the null character (instead of new‐
lines). Useful for piping results to xargs.
--max-results count
Limit the number of search results to 'count' and quit immedi‐
ately.
-1 Limit the search to a single result and quit immediately. This
is an alias for '--max-results=1'.
--show-errors
Enable the display of filesystem errors for situations such as
insufficient permissions or dead symlinks.
--one-file-system, --mount, --xdev
By default, fd will traverse the file system tree as far as
other options dictate. With this flag, fd ensures that it does
not descend into a different file system than the one it started
in. Comparable to the -mount or -xdev filters of find(1).
-h, --help
Print help information.
-V, --version
Print version information.
-d, --max-depth d
Limit directory traversal to at most d levels of depth. By
default, there is no limit on the search depth.
--min-depth d
Only show search results starting at the given depth. See also:
'--max-depth' and '--exact-depth'.
--exact-depth d
Only show search results at the exact given depth. This is an
alias for '--min-depth --max-depth '.
-t, --type filetype
Filter search by type:
f, file
regular files
d, directory
directories
l, symlink
symbolic links
x, executable
executable (files)
e, empty
empty files or directories
s, socket
sockets
p, pipe
named pipes (FIFOs)
This option can be used repeatedly to allow for multiple file
types.
-e, --extension ext
Filter search results by file extension ext. This option can be
used repeatedly to allow for multiple possible file extensions.
-E, --exclude pattern
Exclude files/directories that match the given glob pattern.
This overrides any other ignore logic. Multiple exclude pat‐
terns can be specified.
--ignore-file path
Add a custom ignore-file in '.gitignore' format. These files
have a low precedence.
-c, --color when
Declare when to colorize search results:
auto Colorize output when standard output is connected to terminal (default).
never Do not colorize output.
always Always colorize output.
-j, --threads num
Set number of threads to use for searching & executing (default:
number of available CPU cores).
-S, --size size
Limit results based on the size of files using the format
<+->
'+' file size must be greater than or equal to this
'-' file size must be less than or equal to this
'NUM' The numeric size (e.g. 500)
'UNIT' The units for NUM. They are not case-sensitive. Allowed
unit values:
'b' bytes
'k' kilobytes (base ten, 10^3 = 1000 bytes)
'm' megabytes
'g' gigabytes
't' terabytes
'ki' kibibytes (base two, 2^10 = 1024 bytes)
'mi' mebibytes
'gi' gibibytes
'ti' tebibytes
--changed-within date|duration
Filter results based on the file modification time. The argument
can be provided as a specific point in time (YYYY-MM-DD
HH:MM:SS) or as a duration (10h, 1d, 35min). --change-newer-
than can be used as an alias.
Examples:
--changed-within 2weeks
--change-newer-than \"2018-10-27 10:00:00\"
--changed-before date|duration
Filter results based on the file modification time. The argument
can be provided as a specific point in time (YYYY-MM-DD
HH:MM:SS) or as a duration (10h, 1d, 35min). --change-older-
than can be used as an alias.
Examples:
--changed-before \"2018-10-27 10:00:00\"
--change-older-than 2weeks
-o, --owner [user][:group]
Filter files by their user and/or group. Format:
[(user|uid)][:(group|gid)]. Either side is optional. Precede
either side with a '!' to exclude files instead.
Examples:
--owner john
--owner :students
--owner \"!john:students\"
-x, --exec command
Execute command for each search result. The following placehold‐
ers are substituted by a path derived from the current search
result:
{} path
{/} basename
{//} parent directory
{.} path without file extension
{/.} basename without file extension
-X, --exec-batch command
Execute command with all search results at once. A single
occurence of the following placeholders is authorized and
sub stituted by the paths derived from the search results before the
command is executed:
{} path
{/} basename
{//} parent directory
{.} path without file extension
{/.} basename without file extension
** Commands
\\
|Keys|Description
|-----------+----------|
|\\[helm-ff-run-grep]|Run grep (`\\[universal-argument]' to recurse).
|\\[helm-ff-run-zgrep]|Run zgrep.
|\\[helm-ff-run-pdfgrep]|Run PDFgrep on marked files.
|\\[helm-ff-run-copy-file]|Copy file(s)
|\\[helm-ff-run-rename-file]|Rename file(s).
|\\[helm-ff-run-symlink-file]|Symlink file(s).
|\\[helm-ff-run-hardlink-file]|Hardlink file(s).
|\\[helm-ff-run-delete-file]|Delete file(s).
|\\[helm-ff-run-byte-compile-file]|Byte compile Elisp file(s) (`\\[universal-argument]' to load).
|\\[helm-ff-run-load-file]|Load Elisp file(s).
|\\[helm-ff-run-ediff-file]|Ediff file.
|\\[helm-ff-run-ediff-merge-file]|Ediff-merge file.
|\\[helm-ff-run-switch-other-window]|Switch to other window.
|\\[helm-ff-properties-persistent]|Show file properties.
|\\[helm-ff-run-open-file-externally]|Open file with external program (`\\[universal-argument]' to choose).
|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool.
|\\[helm-ff-run-insert-org-link]|Insert org link.
|\\[helm-fd-previous-directory]|Move to previous directory.
|\\[helm-fd-next-directory]|Move to next directory.")
;;; Generic file help - Used by locate.
;;
;;
(defvar helm-generic-file-help-message
"* Helm Generic files
** Tips
*** Locate
You can append to the search pattern any of the locate command line options,
e.g. -b, -e, -n , etc. See the locate(1) man page for more details.
Some other sources (at the moment \"recentf\" and \"file in current directory\")
support the -b flag for compatibility with locate when they are used with it.
When you enable fuzzy matching on locate with `helm-locate-fuzzy-match', the
search will be performed on basename only for efficiency (so don't add \"-b\" at
prompt). As soon as you separate the patterns with spaces, fuzzy matching will
be disabled and search will be done on the full filename. Note that in
multi-match, fuzzy is completely disabled, which means that each pattern is a
match regexp (i.e. \"helm\" will match \"helm\" but \"hlm\" will *not* match
\"helm\").
NOTE: On Windows use Everything with its command line ~es~ as a replacement of locate.
See [[https://github.com/emacs-helm/helm/wiki/Locate#windows][Locate on Windows]]
On recent systems, the updatedb command doesn't
index anymore user directories, see the option PRUNE_BIND_MOUNTS
in the updatedb man page.
*** Browse project
When the current directory is not under version control, don't forget to refresh
the cache when files have been added/removed in the directory.
*** Find command
Recursively search files using the \"find\" shell command.
Candidates are all filenames that match all given globbing patterns. This
respects the options `helm-case-fold-search' and
`helm-findutils-search-full-path'.
You can pass arbitrary \"find\" options directly after a \"*\" separator.
For example, this would find all files matching \"book\" that are larger
than 1 megabyte:
book * -size +1M
** Commands
\\
|Keys|Description
|-----------+----------|
|\\[helm-ff-run-toggle-basename]|Toggle basename.
|\\[helm-ff-run-grep]|Run grep (`\\[universal-argument]' to recurse).
|\\[helm-ff-run-zgrep]|Run zgrep.
|\\[helm-ff-run-pdfgrep]|Run PDFgrep on marked files.
|\\[helm-ff-run-copy-file]|Copy file(s)
|\\[helm-ff-run-rename-file]|Rename file(s).
|\\[helm-ff-run-symlink-file]|Symlink file(s).
|\\[helm-ff-run-hardlink-file]|Hardlink file(s).
|\\[helm-ff-run-delete-file]|Delete file(s).
|\\[helm-ff-run-byte-compile-file]|Byte compile Elisp file(s) (`\\[universal-argument]' to load).
|\\[helm-ff-run-load-file]|Load Elisp file(s).
|\\[helm-ff-run-ediff-file]|Ediff file.
|\\[helm-ff-run-ediff-merge-file]|Ediff-merge file.
|\\[helm-ff-run-switch-other-window]|Switch to other window.
|\\[helm-ff-properties-persistent]|Show file properties.
|\\[helm-ff-run-open-file-externally]|Open file with external program (`\\[universal-argument]' to choose).
|\\[helm-ff-run-open-file-with-default-tool]|Open file externally with default tool.
|\\[helm-ff-run-insert-org-link]|Insert org link.")
;;; Grep help
;;
;;
(defvar helm-grep-help-message
"* Helm Grep
** Tips
With Helm supporting Git-grep and AG/RG, you are better off using
one of them for recursive searches, keeping grep or ack-grep to
grep individual or marked files. See [[Helm AG][Helm AG]].
*** Meaning of the prefix argument
**** With grep or ack-grep
Grep recursively, in this case you are
prompted for types (ack-grep) or for wild cards (grep).
**** With AG or RG
the prefix arg allows you to specify a type of file to search in.
*** You can use wild cards when selecting files (e.g. \"*.el\")
Note that a way to grep specific files recursively is to use
e.g. \"**.el\" to select files, the variable `helm-file-globstar'
controls this (it is non nil by default), however it is much
slower than using grep recusively (see helm-find-files
documentation about this feature).
*** Grep hidden files
You may want to customize your command line for grepping hidden
files, for AG/RG use \"--hidden\", see man page
of your backend for more infos.
*** You can grep in different directories by marking files or using wild cards
*** You can save the result in a `helm-grep-mode' buffer
See [[Commands][commands]] below.
Once in that buffer you can use [[https://github.com/mhayashi1120/Emacs-wgrep][emacs-wgrep]] (external package not bundled with Helm)
to edit your changes, for Helm the package name is `wgrep-helm', it is hightly recommended.
Type `g' to update (revert) the buffer (after saving your buffer's changes to file).
NOTE: `next-error' is available from this `helm-grep-mode' buffer.
When you are running `next-error' from elsewhere, you can update
the buffer with `helm-revert-next-error-last-buffer' (up to you
to bind it to a convenient key).
*** Helm-grep supports multi-matching
\(Starting from version 1.9.4.)
Simply add a space between each pattern as for most Helm commands.
NOTE: Depending the regexp you use it may match as well the
filename, this because we pipe the first grep command which send
the filename in output.
*** See full path of selected candidate
Add (helm-popup-tip-mode 1) in your init file or enable it
interactively with M-x helm-popup-tip-mode, however it is
generally enough to just put your mouse cursor over candidate.
*** Stop grepping with AG or RG and search in the current results
Once you have found your results with helm grep ag you can search
in these results (helm search, no grep). This allows narrowing
the results to a specific file for example or to a specific
pattern without launching grep ag/rg. The command is \\\\[helm-grep-ag-run-search-results].
If you want to continue grepping, switch to the previous helm session
which is helm-grep-ag session with \\\\[helm-resume-previous-session-after-quit].
_NOTE_: This is available only in AG/RG, not grep.
*** Grep AG/RG on parent directory
The command
\\\\[helm-grep-run-ag-grep-parent-directory] allow to grep the parent directory
of the currently searched directory.
*** Open file in other window
The command \\\\[helm-grep-run-other-window-action] allow you to open file
in other window horizontally or vertically if a prefix arg is supplied.
*** Performance over TRAMP
Grepping works but it is badly supported as TRAMP doesn't support multiple
processes running in a short delay (less than 5s) among other things.
Helm uses a special hook to suspend the process automatically while you are
typing. Even if Helm handles this automatically by delaying each process by 5s,
you are adviced to this manually by hitting `\\\\[helm-toggle-suspend-update]' (suspend process) before
typing, and hit again `\\\\[helm-toggle-suspend-update]' when the regexp is ready to send to the remote
process. For simple regexps, there should be no need for this.
Another solution is to not use TRAMP at all and mount your remote file system via
SSHFS.
* Helm GID
Still supported, but mostly deprecated, using AG/RG or Git-grep
is much more efficient, also `id-utils' seems no more maintained.
** Tips
Helm-GID reads the database created with the `mkid' command from id-utils.
The name of the database file can be customized with `helm-gid-db-file-name', it
is usually \"ID\".
Helm-GID use the symbol at point as default-input. This command is also
accessible from `helm-find-files' which allow you to navigate to another
directory to consult its database.
Note: Helm-GID supports multi-matches but only the last pattern entered will be
highlighted since there is no ~--color~-like option in GID itself.
* Helm AG
** Tips
Helm-AG is different from grep or ack-grep in that it works on a
directory recursively and not on a list of files. It is called
helm-AG but it support several backend, namely AG, RG and PT.
Nowaday the best backend is Ripgrep aka RG, it is the fastest and
is actively maintained, see `helm-grep-ag-command' and
`helm-grep-ag-pipe-cmd-switches' to configure it.
You can ignore files and directories with a \".agignore\" or
\".rgignore\" file, local to a directory or global when placed in
the home directory. (See the AG/RG man pages for more details.)
Note that `helm-grep-ignored-files'and
`helm-grep-ignored-directories' have no effect in helm-AG/RG.
As always you can access Helm AG from `helm-find-files'.
Starting with version 0.30, AG accepts one or more TYPE arguments on its command
line. Helm provides completion on these TYPE arguments when available with your
AG version. Use a prefix argument when starting a Helm-AG session to enable this
completion. See RG and AG man pages on how to add new types.
Note: You can mark several types to match in the AG query. The first AG
versions providing this feature allowed only one type, so in this case only the
last mark will be used.
* Helm git-grep
Helm-git-grep searches the current directory, i.e. the default directory or the
directory in Helm-find-files. If this current directory is a subdirectory of a
project and you want to also match parent directories (i.e the whole project),
use a prefix argument.
** Commands
\\
|Keys|Description
|-----------+----------|
|\\[helm-goto-next-file]|Next File.
|\\[helm-goto-precedent-file]|Previous File.
|\\[helm-yank-text-at-point]|Yank text at point in minibuffer.
|\\[helm-grep-run-other-window-action]|Jump to other window.
|\\[helm-grep-run-other-frame-action]|Jump to other frame.
|\\[helm-grep-run-default-action]|Run default action (same as `RET').
|\\[helm-grep-run-save-buffer]|Save to a `helm-grep-mode' enabled buffer.")
;;; PDF grep help
;;
;;
(defvar helm-pdfgrep-help-message
"* Helm PDFgrep Map
** Commands
\\
|Keys|Description
|-----------+----------|
|\\[helm-goto-next-file]|Next file.
|\\[helm-goto-precedent-file]|Previous file.
|\\[helm-yank-text-at-point]|Yank text at point in minibuffer.")
;;; Etags help
;;
;;
(defvar helm-etags-help-message
"* Helm Etags Map
** Commands
\\
|Keys|Description
|-----------+----------|
|\\[helm-goto-next-file]|Next file.
|\\[helm-goto-precedent-file]|Previous file.
|\\[helm-yank-text-at-point]|Yank text at point in minibuffer.")
;;; UCS help
;;
;;
(defvar helm-ucs-help-message
"* Helm UCS
** Tips
Use commands below to insert unicode characters in current buffer without
leaving Helm.
** Commands
\\
|Keys|Description
|-----------+----------|
|\\[helm-ucs-persistent-insert]|Insert character.
|\\[helm-ucs-persistent-forward]|Forward character.
|\\[helm-ucs-persistent-backward]|Backward character.
|\\[helm-ucs-persistent-delete]|Delete character backward.
|\\[helm-ucs-persistent-insert-space]|Insert space.")
;;; Bookmark help
;;
;;
(defvar helm-bookmark-help-message
"* Helm bookmark name
** Tips
*** Display bookmarks with Icons
When `helm-bookmark-use-icon' is non nil and you have a
`helm-x-icons-provider' either `all-the-icons' or `nerd-icons' package
is installed icons before candidates will be displayed.
*** Reset bookmark position
When using `helm-filtered-bookmarks' you can modify your bookmark
position by resetting it, to do this, jump to your bookmark, move point
to the new location, then call again `helm-filtered-bookmarks' and find
your current bookmark, yank its name in minibuffer with `\\\\[helm-yank-selection]'
switch to the \"Set bookmark\" source and hit RET.
** Commands
\\
|Keys|Description
|-----------+----------|
|\\[helm-bookmark-run-jump-other-window]|Jump other window.
|\\[helm-bookmark-run-delete]|Delete bookmark.
|\\[helm-bookmark-run-edit]|Edit bookmark.
|\\[helm-bookmark-toggle-filename]|Toggle bookmark location visibility.")
;;; Eshell command on file help
;;
;;
(defvar helm-esh-help-message
"* Helm Eshell on file
** Tips
*** Pass extra arguments after filename
Normally the command or alias will be called with file as argument. For instance
candidate_file
But you can also pass an argument or more after \"candidate_file\" like this: