From d56ed1a5a4f1f876d9db220000496a38107cf08c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 8 Oct 2016 18:45:05 -0700 Subject: Import helm_2.2.1-1.debian.tar.xz [dgit import tarball helm 2.2.1-1 helm_2.2.1-1.debian.tar.xz] --- changelog | 83 +++++++++++++ compat | 1 + control | 41 +++++++ copyright | 34 ++++++ elpa-helm-core.elpa | 5 + elpa-helm.docs | 2 + elpa-helm.elpa | 36 ++++++ elpa-helm.examples | 1 + gbp.conf | 10 ++ patches/0001-dummy-upstream-changelog.patch | 19 +++ patches/0003-decruft-README.patch | 182 ++++++++++++++++++++++++++++ patches/0004-patch-emacs-helm-sh.patch | 55 +++++++++ patches/0005-remove-async-dependency.patch | 33 +++++ patches/series | 4 + rules | 7 ++ source/format | 1 + source/lintian-overrides | 1 + source/options | 1 + watch | 3 + 19 files changed, 519 insertions(+) create mode 100644 changelog create mode 100644 compat create mode 100644 control create mode 100644 copyright create mode 100644 elpa-helm-core.elpa create mode 100644 elpa-helm.docs create mode 100644 elpa-helm.elpa create mode 100644 elpa-helm.examples create mode 100644 gbp.conf create mode 100644 patches/0001-dummy-upstream-changelog.patch create mode 100644 patches/0003-decruft-README.patch create mode 100644 patches/0004-patch-emacs-helm-sh.patch create mode 100644 patches/0005-remove-async-dependency.patch create mode 100644 patches/series create mode 100755 rules create mode 100644 source/format create mode 100644 source/lintian-overrides create mode 100644 source/options create mode 100644 watch diff --git a/changelog b/changelog new file mode 100644 index 00000000..07464c28 --- /dev/null +++ b/changelog @@ -0,0 +1,83 @@ +helm (2.2.1-1) unstable; urgency=medium + + * New upstream release. + * Refresh 0005-remove-async-dependency.patch. + + -- Sean Whitton Sat, 08 Oct 2016 18:45:05 -0700 + +helm (2.2.0-1) unstable; urgency=medium + + * New upstream release. + * Refresh patches. + + -- Sean Whitton Sat, 01 Oct 2016 08:34:04 -0700 + +helm (2.1.0-1) unstable; urgency=medium + + * New upstream release. + * Fix path to emacs-helm.sh in patch to README.md. + * Refresh patches. + + -- Sean Whitton Thu, 08 Sep 2016 20:34:53 -0700 + +helm (2.0-1) unstable; urgency=medium + + * New upstream release. + * Refresh patch. + + -- Sean Whitton Mon, 22 Aug 2016 11:00:54 -0700 + +helm (1.9.9-1) unstable; urgency=medium + + * New upstream release. + * Drop obsolete helm-plugin.el from elpa-helm.elpa. + * Refresh patch. + + -- Sean Whitton Fri, 22 Jul 2016 06:44:38 -0700 + +helm (1.9.8-1) unstable; urgency=medium + + * New upstream release. + * Patch refresh. + + -- Sean Whitton Fri, 01 Jul 2016 08:15:09 -0400 + +helm (1.9.7-1) unstable; urgency=medium + + * Package new upstream release. + * Refresh patch. + + -- Sean Whitton Fri, 10 Jun 2016 15:00:39 +0900 + +helm (1.9.6-1) unstable; urgency=medium + + * Package new upstream release. + * Refresh patch. + + -- Sean Whitton Thu, 02 Jun 2016 15:21:33 +0900 + +helm (1.9.5-1) unstable; urgency=medium + + * Package new upstream version. + * Refresh patch to README.md. + * Update d/copyright for 2016. + * Bump standards version to 3.9.8 (no changes required). + * Dependency on elpa-async is now a suggestion. + - Patch helm{-core,}-pkg.el to remove dependency from ${elpa:Depends}. + + -- Sean Whitton Sun, 08 May 2016 08:17:49 -0700 + +helm (1.9.2-1) unstable; urgency=medium + + * New upstream release. + New dependency on elpa-popup. + * Refresh patch to emacs-helm.sh. + * Bump standards version to 3.9.7 (no changes required). + + -- Sean Whitton Mon, 29 Feb 2016 17:54:58 -0700 + +helm (1.9.1-1) unstable; urgency=medium + + * Initial release. (Closes: #810289) + + -- Sean Whitton Fri, 29 Jan 2016 20:35:56 -0700 diff --git a/compat b/compat new file mode 100644 index 00000000..ec635144 --- /dev/null +++ b/compat @@ -0,0 +1 @@ +9 diff --git a/control b/control new file mode 100644 index 00000000..c94444e3 --- /dev/null +++ b/control @@ -0,0 +1,41 @@ +Source: helm +Section: lisp +Priority: optional +Maintainer: Debian Emacs addons team +Uploaders: Sean Whitton +Build-Depends: debhelper (>= 9), dh-elpa (>= 0.0.18) +Standards-Version: 3.9.8 +Homepage: https://emacs-helm.github.io/helm/ +Vcs-Git: https://anonscm.debian.org/git/pkg-emacsen/pkg/helm.git +Vcs-Browser: https://anonscm.debian.org/cgit/pkg-emacsen/pkg/helm.git/ + +Package: elpa-helm-core +Architecture: all +Depends: ${misc:Depends}, emacs, ${elpa:Depends} +Built-Using: ${misc:Built-Using} +Recommends: emacs (>= 46.0) +Suggests: elpa-async +Enhances: emacs, emacs24 +Description: Emacs Helm library files + This package provides library Emacs Lisp files used by the elpa-helm + package, and by Emacs Lisp addons that depend on Helm. + . + Please see the description & documentation for the elpa-helm package + for more information. + +Package: elpa-helm +Architecture: all +Depends: ${misc:Depends}, emacs, ${elpa:Depends} +Built-Using: ${misc:Built-Using} +Recommends: emacs (>= 46.0) +Suggests: elpa-async +Enhances: emacs, emacs24 +Description: Emacs incremental completion and selection narrowing framework + Helm is incremental completion and selection narrowing framework for + Emacs. It will help steer you in the right direction when you're + looking for stuff in Emacs (like buffers, files, etc). + . + Helm is a fork of anything.el originally written by Tamas Patrovic and + can be considered to be its successor. Helm sets out to clean up the + legacy code in anything.el and provide a cleaner, leaner and more + modular tool, that's not tied in the trap of backward compatibility. diff --git a/copyright b/copyright new file mode 100644 index 00000000..1b621e33 --- /dev/null +++ b/copyright @@ -0,0 +1,34 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: helm +Source: https://emacs-helm.github.io/helm/ + +Files: * +Copyright: (C) 2011-2016 Thierry Volpiatto + (C) 2008-2011 rubikitch + (C) 2007 Tamas Patrovics +License: GPL-3+ + +Files: Makefile +Copyright: (C) 2011-2012, Michael Markert +License: GPL-3+ + +Files: debian/* +Copyright: (C) 2016 Sean Whitton +License: GPL-3+ + +License: GPL-3+ + 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 . + . + On Debian systems, the complete text of the GNU General + Public License version 3 can be found in "/usr/share/common-licenses/GPL-3 diff --git a/elpa-helm-core.elpa b/elpa-helm-core.elpa new file mode 100644 index 00000000..03e56a34 --- /dev/null +++ b/elpa-helm-core.elpa @@ -0,0 +1,5 @@ +helm-core-pkg.el +helm.el +helm-lib.el +helm-source.el +helm-multi-match.el diff --git a/elpa-helm.docs b/elpa-helm.docs new file mode 100644 index 00000000..3c7a3a3d --- /dev/null +++ b/elpa-helm.docs @@ -0,0 +1,2 @@ +README.md +doc/helm-buffers-list.gif diff --git a/elpa-helm.elpa b/elpa-helm.elpa new file mode 100644 index 00000000..65083d73 --- /dev/null +++ b/elpa-helm.elpa @@ -0,0 +1,36 @@ +helm-adaptive.el +helm-apt.el +helm-bookmark.el +helm-buffers.el +helm-color.el +helm-command.el +helm-config.el +helm-dabbrev.el +helm-easymenu.el +helm-elisp.el +helm-elisp-package.el +helm-elscreen.el +helm-eshell.el +helm-eval.el +helm-external.el +helm-files.el +helm-font.el +helm-grep.el +helm-help.el +helm-id-utils.el +helm-imenu.el +helm-info.el +helm-locate.el +helm-man.el +helm-misc.el +helm-mode.el +helm-net.el +helm-org.el +helm-pkg.el +helm-regexp.el +helm-ring.el +helm-semantic.el +helm-sys.el +helm-tags.el +helm-types.el +helm-utils.el diff --git a/elpa-helm.examples b/elpa-helm.examples new file mode 100644 index 00000000..ec8248d7 --- /dev/null +++ b/elpa-helm.examples @@ -0,0 +1 @@ +emacs-helm.sh diff --git a/gbp.conf b/gbp.conf new file mode 100644 index 00000000..32252db5 --- /dev/null +++ b/gbp.conf @@ -0,0 +1,10 @@ +[DEFAULT] +upstream-branch = upstream +debian-branch = master +upstream-tag = v%(version)s +debian-tag = debian/%(version)s + +#postbuild = lintian $GBP_CHANGES_FILE +color = on +compression = xz +compression-level = 9 diff --git a/patches/0001-dummy-upstream-changelog.patch b/patches/0001-dummy-upstream-changelog.patch new file mode 100644 index 00000000..7e7b14d6 --- /dev/null +++ b/patches/0001-dummy-upstream-changelog.patch @@ -0,0 +1,19 @@ +From: Sean Whitton +Date: Fri, 8 Jan 2016 14:44:50 -0700 +Subject: dummy-upstream-changelog + +Point the user to GitHub releases page which serves as upstream's +changelog. +--- + CHANGELOG | 2 ++ + 1 file changed, 2 insertions(+) + create mode 100644 CHANGELOG + +diff --git a/CHANGELOG b/CHANGELOG +new file mode 100644 +index 0000000..bc8133c +--- /dev/null ++++ b/CHANGELOG +@@ -0,0 +1,2 @@ ++Please see for details of ++the changes between upstream releases. diff --git a/patches/0003-decruft-README.patch b/patches/0003-decruft-README.patch new file mode 100644 index 00000000..c8f77397 --- /dev/null +++ b/patches/0003-decruft-README.patch @@ -0,0 +1,182 @@ +From: Sean Whitton +Date: Fri, 8 Jan 2016 14:48:08 -0700 +Subject: decruft-README + +--- + README.md | 103 +++++--------------------------------------------------------- + 1 file changed, 7 insertions(+), 96 deletions(-) + +--- a/README.md ++++ b/README.md +@@ -1,17 +1,8 @@ +-

License GPL 3 +-MELPA +-MELPA Stable

++Maintainance of Helm is a lot of work that I do freely on my sparse ++time, please consider donating: ++ ++or or + +-

Emacs-helm

+- +-

Emacs-helm

+- +-

Maintainance of Helm is a lot of work that I do freely on my sparse time,

+-

please Donate to help this project,

+-or [![Support via Gratipay](https://cdn.rawgit.com/gratipay/gratipay-badge/2.3.0/dist/gratipay.png)](https://gratipay.com/emacs-helm/) +- +- +- + **Table of Contents** + + - [Introduction](#introduction) +@@ -34,8 +25,6 @@ or [![Support via Gratipay](https://cdn. + - [Bugs & Improvements](#bugs--improvements) + - [Getting help](#getting-help) + +- +- + # Introduction + + `Helm` is an Emacs framework for incremental completions and narrowing +@@ -61,98 +50,11 @@ and dired operations in Helm. + + # Getting Started + +-## Quick install from git +- +- 1. Clone the `helm` repository to some directory: +- +- ```elisp +- $ git clone https://github.com/emacs-helm/helm.git /path/to/helm/directory +- ``` +- +- 2. Clone the `async` repository to some directory (facultative) +- +- ```elisp +- $ git clone https://github.com/jwiegley/emacs-async.git /path/to/async/directory +- ``` +- 3. Run `make` from the `helm` directory. +- +- 3. Add to `.emacs.el` (or equivalent): +- +- ```elisp +- ;; If async is installed +- (add-to-list 'load-path "/path/to/async/directory") +- +- (add-to-list 'load-path "/path/to/helm/directory") +- (require 'helm-config) +- ``` +- +-_NOTE:_ Installing helm using git and make is the safest way. +- +-To quickly run `helm`, launch this script from helm directory: +- +-`./emacs-helm.sh` +- +-Also use the same script above for bug reporting. +- +-_NOTE:_ This script does not work on Windows systems. +- +-## Install from Emacs packaging system +- +-Helm can also be installed from MELPA repository at http://melpa.org/. +-You will find the instructions to install packages from MELPA [here](https://github.com/melpa/melpa#usage). +- +-No further configuration is necessary to run helm other than perhaps a +-one-line entry in the Emacs init file: +- +-```elisp +-(require 'helm-config) +-``` +- +-_WARNING:_ Helm upgrades from MELPA repository encountered errors +-because of the way package.el fetched and compiled updates for +-existing packages. To get around these errors, Helm adds +-[Async](https://github.com/jwiegley/emacs-async) as a dependency +-package install. Async forces compilation in a clean environment, +-which solves those compilation errors. Since async has other benefits +-as well, both for Helm and other packages, we recommend installing +-async even for Helm installs using git. See +-[FAQ](https://github.com/emacs-helm/helm/wiki#faq) for details. +- +-_Note:_ Restart Emacs for Helm updates from MELPA repositories to take +-effect. +- +-**Note to Linux Distributions Maintainers** +- +-`Only the extensions in the github emacs-helm repository are supported.` +- +-## Debian and Ubuntu +- +-Users of Debian 9 or later or Ubuntu 16.04 or later may simply +-`apt-get install elpa-helm` (or `apt-get install elpa-helm-core`; see +-below). +- +-## Installing just the helm-core package +- +-`helm-core` package is available on [MELPA](http://melpa.org/) for +-third party packages that depend on helm libraries. These packages +-should require helm as follows: +- +- (require 'helm) +- +-Requiring helm builds and runs helm code necessary for multiple regexp +-and fuzzy matching. See +-[helm wiki](https://github.com/emacs-helm/helm/wiki#developpingusinghelmframework) +-for details. +- +-## Warning about alternate installation methods +- +-Installation methods that circumvent `helm-config` are known to fail +-if the careful safeguards are not implemented in the hacks. +- + ## Configuration + +-For minimal helm configuration, run the start-up script `./emacs-helm.sh` +-and then see the file `/tmp/helm-cfg.el`. ++For minimal helm configuration, run the start-up script ++`/usr/share/doc/elpa-helm/emacs-helm.sh` and then see the file ++`/tmp/helm-cfg.el`. + + The full configuration I (the helm maintainer) use is + [here](https://github.com/thierryvolpiatto/emacs-tv-config/blob/master/init-helm-thierry.el). +@@ -200,9 +102,9 @@ To make helm-mode start with Emacs init + To discover helm commands, look at helm menu item in Emacs menu. + + Another way to discover helm commands: run the shell script: +-`./emacs-helm.sh` and then look in the scratch buffer. `emacs-helm.sh` +-accepts emacs command line options. `emacs-helm.sh -h` opens an Info +-screen with more details. ++`/usr/share/doc/elpa-helm/examples/emacs-helm.sh` and then look in the ++scratch buffer. `emacs-helm.sh` accepts emacs command line ++options. `emacs-helm.sh -h` opens an Info screen with more details. + + ## Advanced usage + +@@ -210,7 +112,7 @@ Helm contains many features, some of whi + visually. Here is a demo of `helm-buffers-list` used with + `helm-moccur`. Demo starts with `Eval: START` in the minibuffer. + +-![helm-buffers-list](doc/helm-buffers-list.gif) ++![helm-buffers-list](helm-buffers-list.gif) + + - Regexp `*C` selects the C buffers. `*Tcl` in the demo selects TCL + buffers, then with `*C` switches back to C buffers. +@@ -350,8 +252,8 @@ interacts with many Emacs features, bugs + itself. + + One way to ascertain that the bugs are helm-related, recreate the +-error either by using `Emacs -Q` or by running the included package +-script `./emacs-helm.sh` located in the helm directory. ++error either by using `Emacs -Q` or by running the included script ++`/usr/share/doc/elpa-helm/examples/emacs-helm.sh`. + + # Getting help + +@@ -361,5 +263,3 @@ are two readily available locations. + + Cheers,
+ The Helm Team +- +-[badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg diff --git a/patches/0004-patch-emacs-helm-sh.patch b/patches/0004-patch-emacs-helm-sh.patch new file mode 100644 index 00000000..9ee7bb14 --- /dev/null +++ b/patches/0004-patch-emacs-helm-sh.patch @@ -0,0 +1,55 @@ +From: Sean Whitton +Date: Sat, 6 Feb 2016 11:17:39 -0700 +Subject: patch-emacs-helm-sh + +--- + emacs-helm.sh | 29 +++++------------------------ + 1 file changed, 5 insertions(+), 24 deletions(-) + +diff --git a/emacs-helm.sh b/emacs-helm.sh +index e71cc10..d73901c 100755 +--- a/emacs-helm.sh ++++ b/emacs-helm.sh +@@ -40,23 +40,6 @@ case $1 in + ;; + esac + +-cd $(dirname "$0") +- +-# Check if autoload file exists. +-# It is maybe in a different directory if +-# emacs-helm.sh is a symlink. +-LS=$(ls -l $0 | awk '{print $11}') +-if [ ! -z $LS ]; then +- AUTO_FILE="$(dirname $LS)/helm-autoloads.el" +-else +- AUTO_FILE="helm-autoloads.el" +-fi +-if [ ! -e "$AUTO_FILE" ]; then +- echo No autoloads found, please run make first to generate autoload file +- exit 2 +-fi +- +- + cat > $CONF_FILE < $CONF_FILE < +Forwarded: not-needed + +Upstream specifies a dependency on async.el in order to fix +installation from MELPA. The Debian installation process avoids the +issue. We remove the dependency from ${elpa:Depends} and provide a +Recommends: elpa-async in debian/control. + +--- +This patch header follows DEP-3: http://dep.debian.net/deps/dep3/ +--- a/helm-pkg.el ++++ b/helm-pkg.el +@@ -3,7 +3,6 @@ + (define-package "helm" "2.2.1" + "Helm is an Emacs incremental and narrowing framework" + '((emacs "24.4") +- (async "1.9") + (popup "0.5.3") + (helm-core "2.2.1")) + :url "https://emacs-helm.github.io/helm/") +--- a/helm-core-pkg.el ++++ b/helm-core-pkg.el +@@ -2,8 +2,7 @@ + + (define-package "helm-core" "2.2.1" + "Development files for Helm" +- '((emacs "24.4") +- (async "1.9")) ++ '((emacs "24.4")) + :url "https://emacs-helm.github.io/helm/") + + ;; Local Variables: diff --git a/patches/series b/patches/series new file mode 100644 index 00000000..29032f66 --- /dev/null +++ b/patches/series @@ -0,0 +1,4 @@ +0001-dummy-upstream-changelog.patch +0003-decruft-README.patch +0004-patch-emacs-helm-sh.patch +0005-remove-async-dependency.patch diff --git a/rules b/rules new file mode 100755 index 00000000..2d7ab517 --- /dev/null +++ b/rules @@ -0,0 +1,7 @@ +#!/usr/bin/make -f + +%: + dh $@ --parallel --with elpa + +override_dh_auto_build: + /bin/true diff --git a/source/format b/source/format new file mode 100644 index 00000000..163aaf8d --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/source/lintian-overrides b/source/lintian-overrides new file mode 100644 index 00000000..8b06cb13 --- /dev/null +++ b/source/lintian-overrides @@ -0,0 +1 @@ +debian-watch-may-check-gpg-signature diff --git a/source/options b/source/options new file mode 100644 index 00000000..96df8b1b --- /dev/null +++ b/source/options @@ -0,0 +1 @@ +extend-diff-ignore = "(^|/)(helm-autoloads.el)$" diff --git a/watch b/watch new file mode 100644 index 00000000..ca8c9d51 --- /dev/null +++ b/watch @@ -0,0 +1,3 @@ +version=3 +opts=filenamemangle=s/.+\/v?(\d\S*)\.tar\.gz/helm-$1\.tar\.gz/ \ + https://github.com/emacs-helm/helm/tags .*/v?(\d\S*)\.tar\.gz -- cgit v1.2.3 From 34952d1b13694757f2323255004e553bc4f8d100 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 8 Oct 2016 18:45:05 -0700 Subject: Import helm_2.2.1.orig.tar.xz [dgit import orig helm_2.2.1.orig.tar.xz] --- .github/issue_template.md | 13 + .gitignore | 8 + COPYING | 674 ++++++ Makefile | 65 + README.md | 365 +++ doc/helm-buffers-list.gif | Bin 0 -> 812264 bytes emacs-helm.sh | 106 + helm-adaptive.el | 234 ++ helm-apt.el | 298 +++ helm-bookmark.el | 790 +++++++ helm-buffers.el | 924 ++++++++ helm-color.el | 170 ++ helm-command.el | 294 +++ helm-config.el | 170 ++ helm-core-pkg.el | 11 + helm-dabbrev.el | 327 +++ helm-easymenu.el | 90 + helm-elisp-package.el | 440 ++++ helm-elisp.el | 948 ++++++++ helm-elscreen.el | 102 + helm-eshell.el | 272 +++ helm-eval.el | 204 ++ helm-external.el | 213 ++ helm-files.el | 3778 +++++++++++++++++++++++++++++++ helm-font.el | 201 ++ helm-grep.el | 1471 ++++++++++++ helm-help.el | 1124 ++++++++++ helm-id-utils.el | 133 ++ helm-imenu.el | 287 +++ helm-info.el | 247 +++ helm-lib.el | 886 ++++++++ helm-locate.el | 411 ++++ helm-man.el | 115 + helm-misc.el | 344 +++ helm-mode.el | 1205 ++++++++++ helm-multi-match.el | 373 ++++ helm-net.el | 521 +++++ helm-org.el | 339 +++ helm-pkg.el | 13 + helm-regexp.el | 645 ++++++ helm-ring.el | 469 ++++ helm-semantic.el | 223 ++ helm-source.el | 1003 +++++++++ helm-sys.el | 448 ++++ helm-tags.el | 342 +++ helm-types.el | 283 +++ helm-utils.el | 803 +++++++ helm.el | 5432 +++++++++++++++++++++++++++++++++++++++++++++ 48 files changed, 27814 insertions(+) create mode 100644 .github/issue_template.md create mode 100644 .gitignore create mode 100644 COPYING create mode 100644 Makefile create mode 100644 README.md create mode 100644 doc/helm-buffers-list.gif create mode 100755 emacs-helm.sh create mode 100644 helm-adaptive.el create mode 100644 helm-apt.el create mode 100644 helm-bookmark.el create mode 100644 helm-buffers.el create mode 100644 helm-color.el create mode 100644 helm-command.el create mode 100644 helm-config.el create mode 100644 helm-core-pkg.el create mode 100644 helm-dabbrev.el create mode 100644 helm-easymenu.el create mode 100644 helm-elisp-package.el create mode 100644 helm-elisp.el create mode 100644 helm-elscreen.el create mode 100644 helm-eshell.el create mode 100644 helm-eval.el create mode 100644 helm-external.el create mode 100644 helm-files.el create mode 100644 helm-font.el create mode 100644 helm-grep.el create mode 100644 helm-help.el create mode 100644 helm-id-utils.el create mode 100644 helm-imenu.el create mode 100644 helm-info.el create mode 100644 helm-lib.el create mode 100644 helm-locate.el create mode 100644 helm-man.el create mode 100644 helm-misc.el create mode 100644 helm-mode.el create mode 100644 helm-multi-match.el create mode 100644 helm-net.el create mode 100644 helm-org.el create mode 100644 helm-pkg.el create mode 100644 helm-regexp.el create mode 100644 helm-ring.el create mode 100644 helm-semantic.el create mode 100644 helm-source.el create mode 100644 helm-sys.el create mode 100644 helm-tags.el create mode 100644 helm-types.el create mode 100644 helm-utils.el create mode 100644 helm.el diff --git a/.github/issue_template.md b/.github/issue_template.md new file mode 100644 index 00000000..97e7e7bc --- /dev/null +++ b/.github/issue_template.md @@ -0,0 +1,13 @@ +## Expected behavior + + +## Actual behavior from emacs-helm.sh if possible + + +## Steps to reproduce (recipe) + + +## Backtraces if some (M-x toggle-debug-on-error) + + +## Describe versions of helm, emacs, operating system etc. diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..9860044b --- /dev/null +++ b/.gitignore @@ -0,0 +1,8 @@ +*.elc +patch* +*.patch +*.diff +Home.md +TAGS +helm-autoloads.el +ID diff --git a/COPYING b/COPYING new file mode 100644 index 00000000..94a9ed02 --- /dev/null +++ b/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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 . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/Makefile b/Makefile new file mode 100644 index 00000000..997c9103 --- /dev/null +++ b/Makefile @@ -0,0 +1,65 @@ +# 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 + +EMACS := $(EMACS_COMMAND) -Q -batch + +EVAL := $(EMACS) --eval + +PKGDIR := . + +# Additional emacs loadpath +LOADPATH := -L . + +# 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: + $(EMACS) $(LOADPATH) -f batch-byte-compile $(EL) + +# Remove all generated files +clean: + rm -f $(ELC) + +# Make autoloads file +autoloads: + $(EVAL) "(let ((generated-autoload-file (expand-file-name \"helm-autoloads.el\" \"$(PKGDIR)\")) \ +(backup-inhibited t)) (update-directory-autoloads \"$(PKGDIR)\"))" diff --git a/README.md b/README.md new file mode 100644 index 00000000..a2c96dc2 --- /dev/null +++ b/README.md @@ -0,0 +1,365 @@ +

License GPL 3 +MELPA +MELPA Stable

+ +

Emacs-helm

+ +

Emacs-helm

+ +

Maintainance of Helm is a lot of work that I do freely on my sparse time,

+

please Donate to help this project,

+or [![Support via Gratipay](https://cdn.rawgit.com/gratipay/gratipay-badge/2.3.0/dist/gratipay.png)](https://gratipay.com/emacs-helm/) + + + +**Table of Contents** + +- [Introduction](#introduction) +- [Requirements](#requirements) +- [Getting Started](#getting-started) + - [Quick install from git](#quick-install-from-git) + - [Install from Emacs packaging system](#install-from-emacs-packaging-system) + - [Debian and Ubuntu](#debian-and-ubuntu) + - [Installing just the helm-core package](#installing-just-the-helm-core-package) + - [Warning about alternate installation methods](#warning-about-alternate-installation-methods) + - [Configuration](#configuration) + - [Basic usage](#basic-usage) + - [Advanced usage](#advanced-usage) + - [Matching methods](#matching-methods) + - [Creating custom helm sources](#creating-custom-helm-sources) +- [Helm Applications](#helm-applications) +- [Recommended Helm extensions](#recommended-helm-extensions) +- [Known issues](#known-issues) +- [Contributors](#contributors) +- [Bugs & Improvements](#bugs--improvements) +- [Getting help](#getting-help) + + + +# Introduction + +`Helm` is an Emacs framework for incremental completions and narrowing +selections. It helps to rapidly complete file names, buffer names, or +any other Emacs interactions requiring selecting an item from a list of +possible choices. + +Helm is a fork of `anything.el`, which was originally written by Tamas +Patrovic and can be considered to be its successor. `Helm` cleans the +legacy code that is leaner, modular, and unchained from constraints of +backward compatibility. + +# Requirements + +Helm requires Emacs-24.4 or later versions. + +Helm installs [async](https://github.com/jwiegley/emacs-async) package as a dependency +when Helm is installed using MELPA. + +Helm installation from the git source repository does not include +async. The async package is recommended for smooth asynchronous file +and dired operations in Helm. + +# Getting Started + +## Quick install from git + + 1. Clone the `helm` repository to some directory: + + ```elisp + $ git clone https://github.com/emacs-helm/helm.git /path/to/helm/directory + ``` + + 2. Clone the `async` repository to some directory (facultative) + + ```elisp + $ git clone https://github.com/jwiegley/emacs-async.git /path/to/async/directory + ``` + 3. Run `make` from the `helm` directory. + + 3. Add to `.emacs.el` (or equivalent): + + ```elisp + ;; If async is installed + (add-to-list 'load-path "/path/to/async/directory") + + (add-to-list 'load-path "/path/to/helm/directory") + (require 'helm-config) + ``` + +_NOTE:_ Installing helm using git and make is the safest way. + +To quickly run `helm`, launch this script from helm directory: + +`./emacs-helm.sh` + +Also use the same script above for bug reporting. + +_NOTE:_ This script does not work on Windows systems. + +## Install from Emacs packaging system + +Helm can also be installed from MELPA repository at http://melpa.org/. +You will find the instructions to install packages from MELPA [here](https://github.com/melpa/melpa#usage). + +No further configuration is necessary to run helm other than perhaps a +one-line entry in the Emacs init file: + +```elisp +(require 'helm-config) +``` + +_WARNING:_ Helm upgrades from MELPA repository encountered errors +because of the way package.el fetched and compiled updates for +existing packages. To get around these errors, Helm adds +[Async](https://github.com/jwiegley/emacs-async) as a dependency +package install. Async forces compilation in a clean environment, +which solves those compilation errors. Since async has other benefits +as well, both for Helm and other packages, we recommend installing +async even for Helm installs using git. See +[FAQ](https://github.com/emacs-helm/helm/wiki#faq) for details. + +_Note:_ Restart Emacs for Helm updates from MELPA repositories to take +effect. + +**Note to Linux Distributions Maintainers** + +`Only the extensions in the github emacs-helm repository are supported.` + +## Debian and Ubuntu + +Users of Debian 9 or later or Ubuntu 16.04 or later may simply +`apt-get install elpa-helm` (or `apt-get install elpa-helm-core`; see +below). + +## Installing just the helm-core package + +`helm-core` package is available on [MELPA](http://melpa.org/) for +third party packages that depend on helm libraries. These packages +should require helm as follows: + + (require 'helm) + +Requiring helm builds and runs helm code necessary for multiple regexp +and fuzzy matching. See +[helm wiki](https://github.com/emacs-helm/helm/wiki#developpingusinghelmframework) +for details. + +## Warning about alternate installation methods + +Installation methods that circumvent `helm-config` are known to fail +if the careful safeguards are not implemented in the hacks. + +## Configuration + +For minimal helm configuration, run the start-up script `./emacs-helm.sh` +and then see the file `/tmp/helm-cfg.el`. + +The full configuration I (the helm maintainer) use is +[here](https://github.com/thierryvolpiatto/emacs-tv-config/blob/master/init-helm-thierry.el). + +Also see helm customizable variables with the customize interface. + +Enabling `helm-mode` will enable helm for many features of emacs +requiring completions, see below how to enable `helm-mode`. + +## Basic usage + +`M-x helm-M-x RET helm-` lists helm commands ready for narrowing and selecting. + +To bind to `M-x`: + +`(global-set-key (kbd "M-x") 'helm-M-x)` + +- _IMPORTANT:_ + +In any helm session (after `helm-M-x` or `helm-` command) + +`C-h m` pops a general info buffer about helm + +`C-c ?` pops a special info buffer of the current helm command + +Not all helm commands have specialized info buffers. Look for `C-c ?` +in the mode-line. `C-h m` is shown for any command that does not have +a specialized info buffer. + +Use these embedded Info screens first before reporting bugs. + +`M-x helm-mode` to enable helm completion for common Emacs commands +(e.g `M-x`, `C-x C-f`, etc...). Note that the helm functionality +enabled through helm-mode comes from a generic implementation and does +not include all helm features available through equivalent +helm-specific commands. For example, `helm-M-x` has more features than +helm completion through `M-x`. + +To make helm-mode start with Emacs init file: + +```elisp +(helm-mode 1) +``` + +To discover helm commands, look at helm menu item in Emacs menu. + +Another way to discover helm commands: run the shell script: +`./emacs-helm.sh` and then look in the scratch buffer. `emacs-helm.sh` +accepts emacs command line options. `emacs-helm.sh -h` opens an Info +screen with more details. + +## Advanced usage + +Helm contains many features, some of which are easier to follow +visually. Here is a demo of `helm-buffers-list` used with +`helm-moccur`. Demo starts with `Eval: START` in the minibuffer. + +![helm-buffers-list](doc/helm-buffers-list.gif) + +- Regexp `*C` selects the C buffers. `*Tcl` in the demo selects TCL + buffers, then with `*C` switches back to C buffers. +- For buffers containing the string "crash", the demo adds a space, + then the pattern `@crash`. +- Matching buffers are then handed over to `helm-moccur` - `moccur` + with its own Helm interface. The demo shows switching to a + single file, `kexec.c`. Multiple selections can be made with + `C-SPC`. `M-a` selects all. +- Adding characters to the pattern gradually filters (narrows) the + available candidates. By adding `memory`, the buffers shown now + include those buffers with "crash" and "memory". + +With more pattern matching, candidates are narrowed down from the +initial 253 buffers to 12 as shown in the modeline. + +Helm [guide](http://tuhdo.github.io/helm-intro.html) and +[Helm Wiki](https://github.com/emacs-helm/helm/wiki) provide +additional details. + +### Matching methods + +Helm support by default multi pattern matching, it is the standard way +of matching in helm. +E.g You can use a pattern like "foo bar" to match a line containing "foo" and "bar" +or "bar" and "foo". +Each pattern can be a regexp. + +In addition helm support [fuzzy matching](https://github.com/emacs-helm/helm/wiki/Fuzzy-matching). + +### Creating custom helm sources + +An example: + +```elisp + +(helm :sources (helm-build-sync-source "test" + :candidates '(foo foa fob bar baz) + :fuzzy-match t) + :buffer "*helm test*") +``` + +The candidates list may be replaced by a function that produces a list. +See ([helm wiki](https://github.com/emacs-helm/helm/wiki#25-developing-using-helm-framework)) +for details. + +# Helm Applications + +These are popular applications developed using helm completion and +narrowing framework. They are available for individual installs +through the Emacs package manager. This list is not exhaustive. + +- `helm-mode`: turns on helm completions for most standard emacs + completions. Helm provides even more optimized helm completions for + some commands in helm-mode. Prefer these natively optimized versions + over the ones in helm-mode. + +- `helm-find-files`: one command that handles all the files related + commands (bind to `C-x C-f`). + +- `helm-buffers-list`: provides enhanced buffers listing. + +- `helm-browse-project`: handles project files and buffers; defaults + to current directory; works with `helm-find-files`; recommended + with [helm-ls-git](https://github.com/emacs-helm/helm-ls-git), + [helm-ls-hg](https://github.com/emacs-helm/helm-ls-hg) and + `helm-ls-svn` for a better handling of version control files. + Each time a project under version control is visited it is added + to `helm-browse-project-history` and can be visted with `helm-projects-history`. + +- `helm-dabbrev`: enhanced dabbrev implementation with helm + completion; does not use emacs code. + +- `helm-moccur`: enhanced occur for one or more buffers; launch from + `helm-buffers-list` or `current-buffer`. + +- `helm-M-x`: enhanced `execute-extended-command` (bind it to `M-x`). + +- `helm-imenu` and `helm-imenu-in-all-buffers`: provide imenus for + current or all buffers. + +- `helm-etags-select`: enhanced etags with helm-completion; usable + everywhere with `helm-find-files`. + +- `helm-apropos`: enhanced apropos for functions and variables that + `C-h` commands provide. + +- `Grep`: launch from any helm file commands; supports back-ends + `grep`, `ack-grep`, `git-grep`, `ag` and custom implementation of + `pt`. + +- `helm-gid`: Helm interface for `gid` from + [id-utils](https://www.gnu.org/software/idutils/). + +- `helm-show-kill-ring`: A helm browser for kill ring. + +- `helm-all-mark-rings`: A helm browser for mark ring; retrieves last positions in buffers. + +- `helm-filtered-bookmarks`: enhanced browser for bookmarks. + +- `helm-list-elisp-packages`: enhanced browser for elisp package management. + +# Recommended Helm extensions + +- [helm-ls-git](https://github.com/emacs-helm/helm-ls-git) +- [helm-ls-hg](https://github.com/emacs-helm/helm-ls-hg) +- [helm-descbinds](https://github.com/emacs-helm/helm-descbinds) +- [helm-firefox](https://github.com/emacs-helm/helm-firefox) + +**Warning** Helm development has sparked quite a few extensions, many +of which duplicate features already included in helm. Some of these +packages (about 20 at last count in the MELPA repository) are either +deprecated or unmaintained. Moreover, many remain out-of-sync with +`helm` core development cycles causing incompatibilities. To avoid +helm problems or unstable emacs, please look for comparable features +within [helm](https://github.com/emacs-helm/helm) and +[emacs-helm](https://github.com/emacs-helm) before installing such +extensions. + +# Known issues + +The Helm project has a current unresolved +[issue list](https://github.com/emacs-helm/helm/issues?sort=created&direction=desc&state=open). +Please feel free to fix any of them; send a pull request. + +# Contributors + +The Helm project maintains a +[list](https://github.com/emacs-helm/helm/contributors) of +contributors. + +# Bugs & Improvements + +The Helm Team welcomes bug reports and suggestions. Note that not all +bugs when using Helm are due to Helm. Because of the way Helm +interacts with many Emacs features, bugs may be related to Emacs +itself. + +One way to ascertain that the bugs are helm-related, recreate the +error either by using `Emacs -Q` or by running the included package +script `./emacs-helm.sh` located in the helm directory. + +# Getting help + +[Helm Wiki](https://github.com/emacs-helm/helm/wiki) and +[emacs-helm Google group](https://groups.google.com/group/emacs-helm?hl=en) +are two readily available locations. + +Cheers,
+The Helm Team + +[badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg diff --git a/doc/helm-buffers-list.gif b/doc/helm-buffers-list.gif new file mode 100644 index 00000000..8cf30895 Binary files /dev/null and b/doc/helm-buffers-list.gif differ diff --git a/emacs-helm.sh b/emacs-helm.sh new file mode 100755 index 00000000..1213a867 --- /dev/null +++ b/emacs-helm.sh @@ -0,0 +1,106 @@ +#!/usr/bin/env bash + + +## Copyright (C) 2012 ~ 2016 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 with a basic helm configuration. +# Useful to start quickly an emacs -Q with helm. +# Run it from this directory or symlink it somewhere in your PATH. + +# If TEMP env var exists use it otherwise declare it. +[ -z $TEMP ] && declare TEMP="/tmp" + +CONF_FILE="$TEMP/helm-cfg.el" +EMACS=emacs + +case $1 in + -P) + shift 1 + declare EMACS=$1 + shift 1 + ;; + -h) + echo "Usage: ${0##*/} [-P} Emacs path [-h} help [--] EMACS ARGS" + exit 2 + ;; +esac + +cd $(dirname "$0") + +# Check if autoload file exists. +# It is maybe in a different directory if +# emacs-helm.sh is a symlink. +LS=$(ls -l $0 | awk '{print $11}') +if [ ! -z $LS ]; then + AUTO_FILE="$(dirname $LS)/helm-autoloads.el" +else + AUTO_FILE="helm-autoloads.el" +fi +if [ ! -e "$AUTO_FILE" ]; then + echo No autoloads found, please run make first to generate autoload file + exit 2 +fi + + +cat > $CONF_FILE <\`helm-find-files'\n\ +;; - \`occur'(M-s o) =>\`helm-occur'\n\ +;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\n\ +;; - \`completion-at-point'(M-tab) =>\`helm-lisp-completion-at-point'[1]\n\ +;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\n\n\ +;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\n\n +;; Some others native emacs commands are \"helmized\" by \`helm-mode'.\n\ +;; [1] Coming with emacs-24.4 \`completion-at-point' is \"helmized\" by \`helm-mode'\n\ +;; which provide helm completion in many other places like \`shell-mode'.\n\ +;; You will find embeded help for most helm commands with \`C-h m'.\n\ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")) + +(setq package-user-dir (directory-file-name + (file-name-directory + (directory-file-name default-directory)))) +(unless (member "helm.el" (directory-files default-directory)) + (setq package-load-list '((helm-core t) (helm t) (async t) (popup t))) + (package-initialize)) +(add-to-list 'load-path (file-name-directory (file-truename "$0"))) +(setq default-frame-alist '((vertical-scroll-bars . nil) + (tool-bar-lines . 0) + (menu-bar-lines . 0) + (fullscreen . nil))) +(blink-cursor-mode -1) +(require 'helm-config) +(helm-mode 1) +(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) +(global-set-key (kbd "M-x") 'helm-M-x) +(unless (boundp 'completion-in-region-function) + (define-key lisp-interaction-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point) + (define-key emacs-lisp-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point)) +(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$CONF_FILE") (delete-file "$CONF_FILE")))) +EOF + +$EMACS -Q -l $CONF_FILE $@ + diff --git a/helm-adaptive.el b/helm-adaptive.el new file mode 100644 index 00000000..e76a61d7 --- /dev/null +++ b/helm-adaptive.el @@ -0,0 +1,234 @@ +;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*- + +;; Original Author: Tamas Patrovics + +;; Copyright (C) 2007 Tamas Patrovics +;; Copyright (C) 2012 ~ 2016 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 + "~/.emacs.d/helm-adaptive-history" + "Path of file where history information is stored." + :type 'string + :group 'helm-adapt) + +(defcustom helm-adaptive-history-length 50 + "Maximum number of candidates stored for a source." + :type 'number + :group 'helm-adapt) + + +;; 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) ...) ...) ...)") + +(defun helm-adaptive-done-reset () + (setq helm-adaptive-done nil)) + +;;;###autoload +(define-minor-mode helm-adaptive-mode + "Toggle adaptive sorting in all sources." + :group 'helm-adapt + :require 'helm-adaptive + :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 (member '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 (or (assoc-default 'type source) + (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)))) + + ;; increase usage count + (setcdr pattern-info (1+ (cdr pattern-info))) + + ;; truncate history if needed + (if (> (length (cdr selection-info)) helm-adaptive-history-length) + (setcdr selection-info + (cl-subseq (cdr selection-info) 0 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 (file-readable-p helm-adaptive-history-file) + (load-file helm-adaptive-history-file))) + +(defun helm-adaptive-save-history (&optional arg) + "Save history information to file given by `helm-adaptive-history-file'." + (interactive "p") + (with-temp-buffer + (insert + ";; -*- mode: emacs-lisp -*-\n" + ";; History entries used for helm adaptive display.\n") + (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 (or (assoc-default 'type source) + (assoc-default 'name source))) + (source-info (assoc source-name helm-adaptive-history))) + (if source-info + (let ((usage + ;; Assemble a list containing the (CANDIDATE . USAGE-COUNT) pairs. + (cl-loop with count = 0 + for (sn . infos) in (cdr source-info) + do (cl-loop for (pattern . score) in infos + if (not (equal pattern helm-pattern)) + do (cl-incf count score) + else return + ;; If current pattern is equal to the previously + ;; used one then this candidate has priority + ;; (that's why its count is boosted by 10000) and + ;; it only has to compete with other candidates + ;; which were also selected with the same pattern. + (setq count (+ 10000 score))) + and collect (cons sn count) 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 (info . _freq) in usage + for mlinfo = (and (assq 'multiline source) + (replace-regexp-in-string "\n\\'" "" info)) + for member = (cl-member (or mlinfo info) candidates + :test 'helm-adaptive-compare) + when member collect (car member) into sorted + and do + (setq candidates (cl-remove (or mlinfo 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) + (delete-file helm-adaptive-history-file))) + +(defun helm-adaptive-compare (x y) + "Compare candidates X and Y taking into account that the +candidate can be in (DISPLAY . REAL) format." + (equal (if (listp x) (cdr x) x) + (if (listp y) (cdr y) y))) + + +(provide 'helm-adaptive) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-adaptive.el ends here diff --git a/helm-apt.el b/helm-apt.el new file mode 100644 index 00000000..d65a1158 --- /dev/null +++ b/helm-apt.el @@ -0,0 +1,298 @@ +;;; helm-apt.el --- Helm interface for Debian/Ubuntu packages (apt-*) -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-utils) +(require 'helm-external) +(require 'helm-help) + +(declare-function term-line-mode "term") +(declare-function term-char-mode "term") +(declare-function term-send-input "term") +(declare-function term-send-eof "term") + + +(defgroup helm-apt nil + "Apt related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-apt-cache-show-function 'helm-apt-cache-show-1 + "Function of one argument used to show apt package. +Default is `helm-apt-cache-show-1' but you can use `apt-utils-show-package-1' +from `apt-utils.el' to have something more enhanced. +If nil default `helm-apt-cache-show-1' will be used." + :type 'function + :group 'helm-apt) + +(defcustom helm-apt-actions + '(("Show package description" . helm-apt-cache-show) + ("Install package(s)" . helm-apt-install) + ("Reinstall package(s)" . helm-apt-reinstall) + ("Remove package(s)" . helm-apt-uninstall) + ("Purge package(s)" . helm-apt-purge)) + "Actions for helm apt." + :group 'helm-apt + :type '(alist :key-type string :value-type function)) + +(defface helm-apt-installed + '((t (:foreground "green"))) + "Face used for apt installed candidates." + :group 'helm-apt) + +(defface helm-apt-deinstalled + '((t (:foreground "DimGray"))) + "Face used for apt deinstalled candidates." + :group 'helm-apt) + + +(defvar helm-apt-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-I") 'helm-apt-show-only-installed) + (define-key map (kbd "M-U") 'helm-apt-show-only-not-installed) + (define-key map (kbd "M-D") 'helm-apt-show-only-deinstalled) + (define-key map (kbd "M-A") 'helm-apt-show-all) + map)) + + +(defvar helm-source-apt + (helm-build-in-buffer-source "APT" + :init #'helm-apt-init + :candidate-transformer #'helm-apt-candidate-transformer + :display-to-real #'helm-apt-display-to-real + :update #'helm-apt-refresh + :keymap helm-apt-map + :help-message 'helm-apt-help-message + :action 'helm-apt-actions + :persistent-action #'helm-apt-persistent-action + :persistent-help "Show package description")) + +;;; Internals vars +(defvar helm-apt-search-command "apt-cache search '%s'") +(defvar helm-apt-show-command "apt-cache show '%s'") +(defvar helm-apt-installed-packages nil) +(defvar helm-apt-all-packages nil) +(defvar helm-apt-input-history nil) +(defvar helm-apt-show-only 'all) +(defvar helm-apt-term-buffer nil) +(defvar helm-apt-default-archs nil) + +(defun helm-apt-refresh () + "Refresh installed candidates list." + (setq helm-apt-installed-packages nil) + (setq helm-apt-all-packages nil)) + +(defun helm-apt-persistent-action (candidate) + "Persistent action for APT source." + (helm-apt-cache-show candidate)) + +(defun helm-apt--installed-package-name (name) + (cl-loop for arch in helm-apt-default-archs + thereis (or (assoc-default + name helm-apt-installed-packages) + (assoc-default + (format "%s:%s" name arch) + helm-apt-installed-packages)))) + +(defun helm-apt-candidate-transformer (candidates) + "Show installed CANDIDATES and the ones to deinstall in a different color." + (cl-loop for cand in candidates + for name = (helm-apt-display-to-real cand) + for deinstall = (string= + (helm-apt--installed-package-name name) + "deinstall") + for install = (string= + (helm-apt--installed-package-name name) + "install") + for show = (cond ((and deinstall + (memq helm-apt-show-only '(all deinstalled))) + (propertize cand 'face 'helm-apt-deinstalled)) + ((and install + (memq helm-apt-show-only '(all installed))) + (propertize cand 'face 'helm-apt-installed)) + ((and (eq helm-apt-show-only 'noinstalled) + (not install)) cand) + ((eq helm-apt-show-only 'all) cand)) + when show collect show)) + +(defun helm-apt-show-only-installed () + (interactive) + (with-helm-alive-p + (setq helm-apt-show-only 'installed) + (helm-update))) +(put 'helm-apt-show-only-installed 'helm-only t) + +(defun helm-apt-show-only-not-installed () + (interactive) + (with-helm-alive-p + (setq helm-apt-show-only 'noinstalled) + (helm-update))) +(put 'helm-apt-show-only-not-installed 'helm-only t) + +(defun helm-apt-show-only-deinstalled () + (interactive) + (with-helm-alive-p + (setq helm-apt-show-only 'deinstalled) + (helm-update))) +(put 'helm-apt-show-only-deinstalled 'helm-only t) + +(defun helm-apt-show-all () + (interactive) + (with-helm-alive-p + (setq helm-apt-show-only 'all) + (helm-update))) +(put 'helm-apt-show-all 'helm-only t) + +(defun helm-apt-init () + "Initialize list of debian packages." + (let ((query "")) + (unless (and helm-apt-installed-packages + helm-apt-all-packages) + (message "Loading package list...") + (setq helm-apt-installed-packages + (with-temp-buffer + (call-process-shell-command "dpkg --get-selections" + nil (current-buffer)) + (cl-loop for i in (split-string (buffer-string) "\n" t) + for p = (split-string i) + collect (cons (car p) (cadr p))))) + (helm-init-candidates-in-buffer + 'global + (setq helm-apt-all-packages + (with-temp-buffer + (call-process-shell-command + (format helm-apt-search-command query) + nil (current-buffer)) + (buffer-string)))) + (message "Loading package list done") + (sit-for 0.5)))) + +(defun helm-apt-display-to-real (line) + "Return only name of a debian package. +LINE is displayed like: +package name - description." + (car (split-string line " - "))) + +(defvar helm-apt-show-current-package nil) +(define-derived-mode helm-apt-show-mode + special-mode "helm-apt-show" + "Mode to display infos on apt packages.") + +(defun helm-apt-cache-show (package) + "Show information on apt package PACKAGE." + (if (and (functionp helm-apt-cache-show-function) + (not (eq helm-apt-cache-show-function + 'helm-apt-cache-show))) + ;; A function, call it. + (funcall helm-apt-cache-show-function package) + ;; nil or whatever use default. + (helm-apt-cache-show-1 package))) + +(defun helm-apt-cache-show-1 (package) + (let* ((command (format helm-apt-show-command package)) + (buf (get-buffer-create "*helm apt show*"))) + (switch-to-buffer buf) + (unless (string= package helm-apt-show-current-package) + (let ((inhibit-read-only t)) + (erase-buffer) + (save-excursion + (call-process-shell-command + command nil (current-buffer) t)))) + (helm-apt-show-mode) + (set (make-local-variable 'helm-apt-show-current-package) + package))) + +(defun helm-apt-install (_package) + "Run 'apt-get install' shell command on PACKAGE." + (helm-apt-generic-action :action 'install)) + +(defun helm-apt-reinstall (_package) + "Run 'apt-get install --reinstall' shell command on PACKAGE." + (helm-apt-generic-action :action 'reinstall)) + +(defun helm-apt-uninstall (_package) + "Run 'apt-get remove' shell command on PACKAGE." + (helm-apt-generic-action :action 'uninstall)) + +(defun helm-apt-purge (_package) + "Run 'apt-get purge' shell command on PACKAGE." + (helm-apt-generic-action :action 'purge)) + +(cl-defun helm-apt-generic-action (&key action) + "Run 'apt-get ACTION'. +Support install, remove and purge actions." + (if (and helm-apt-term-buffer + (buffer-live-p (get-buffer helm-apt-term-buffer))) + (switch-to-buffer helm-apt-term-buffer) + (ansi-term (getenv "SHELL") "term apt") + (setq helm-apt-term-buffer (buffer-name))) + (term-line-mode) + (let* ((command (cl-case action + (install "sudo apt-get install ") + (reinstall "sudo apt-get install --reinstall ") + (uninstall "sudo apt-get remove ") + (purge "sudo apt-get purge ") + (t (error "Unknown action")))) + (cands (helm-marked-candidates)) + (cand-list (mapconcat (lambda (x) (format "'%s'" x)) cands " "))) + (with-helm-display-marked-candidates "*apt candidates*" + cands + (when (y-or-n-p (format "%s package(s)" (symbol-name action))) + (with-current-buffer helm-apt-term-buffer + (goto-char (point-max)) + (insert (concat command cand-list)) + (setq helm-external-commands-list nil) + (setq helm-apt-installed-packages nil) + (term-char-mode) (term-send-input)))))) + +;;;###autoload +(defun helm-apt (arg) + "Preconfigured `helm' : frontend of APT package manager. +With a prefix arg reload cache." + (interactive "P") + (setq helm-apt-show-only 'all) + (unless helm-apt-default-archs + (setq helm-apt-default-archs + (append (split-string + (shell-command-to-string + "dpkg --print-architecture") + "\n" t) + (split-string + (shell-command-to-string + "dpkg --print-foreign-architectures") + "\n" t)))) + (let ((query (read-string "Search Package: " nil 'helm-apt-input-history))) + (when arg (helm-apt-refresh)) + (helm :sources 'helm-source-apt + :prompt "Search Package: " + :input query + :buffer "*helm apt*" + :history 'helm-apt-input-history))) + + +(provide 'helm-apt) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-apt.el ends here diff --git a/helm-bookmark.el b/helm-bookmark.el new file mode 100644 index 00000000..ebb3010b --- /dev/null +++ b/helm-bookmark.el @@ -0,0 +1,790 @@ +;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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) + +(declare-function addressbook-bookmark-edit "ext:addressbook-bookmark.el" (bookmark)) +(declare-function message-buffers "message.el") +(declare-function addressbook-set-mail-buffer-1 "ext:addressbook-bookmark.el" + (&optional bookmark-name append cc)) +(declare-function helm-browse-project "helm-files" (arg)) + + +(defgroup helm-bookmark nil + "Predefined configurations for `helm.el'." + :group 'helm) + +(defcustom helm-bookmark-show-location nil + "Show location of bookmark on display." + :group 'helm-bookmark + :type 'boolean) + +(defcustom helm-bookmark-default-filtered-sources + (append '(helm-source-bookmark-files&dirs + helm-source-bookmark-helm-find-files + helm-source-bookmark-info + helm-source-bookmark-gnus + helm-source-bookmark-man + helm-source-bookmark-images + helm-source-bookmark-w3m) + (and (locate-library "addressbook-bookmark") + (list 'helm-source-bookmark-addressbook)) + (list 'helm-source-bookmark-uncategorized + 'helm-source-bookmark-set)) + "List of sources to use in `helm-filtered-bookmarks'." + :group 'helm-bookmark + :type '(repeat (choice symbol))) + +(defcustom helm-bookmark-addressbook-actions + '(("Show Contact(s)" + . (lambda (candidate) + (let* ((contacts (helm-marked-candidates)) + (current-prefix-arg helm-current-prefix-arg)) + (bookmark-jump + (helm-bookmark-get-bookmark-from-name (car contacts))) + (helm-aif (cdr contacts) + (let ((current-prefix-arg '(4))) + (cl-loop for bmk in it do + (bookmark-jump + (helm-bookmark-get-bookmark-from-name bmk)))))))) + ("Mail To" . helm-bookmark-addressbook-send-mail-1) + ("Mail Cc" . (lambda (_candidate) + (helm-bookmark-addressbook-send-mail-1 nil 'cc))) + ("Mail Bcc" . (lambda (_candidate) + (helm-bookmark-addressbook-send-mail-1 nil 'bcc))) + ("Edit Bookmark" + . (lambda (candidate) + (let ((bmk (helm-bookmark-get-bookmark-from-name + candidate))) + (addressbook-bookmark-edit + (assoc bmk bookmark-alist))))) + ("Delete bookmark(s)" . helm-delete-marked-bookmarks) + ("Insert Email at point" + . (lambda (candidate) + (let* ((bmk (helm-bookmark-get-bookmark-from-name + candidate)) + (mlist (split-string + (assoc-default + 'email (assoc bmk bookmark-alist)) + ", "))) + (insert + (if (> (length mlist) 1) + (helm-comp-read + "Insert Mail Address: " mlist :must-match t) + (car mlist)))))) + ("Show annotation" + . (lambda (candidate) + (let ((bmk (helm-bookmark-get-bookmark-from-name + candidate))) + (bookmark-show-annotation bmk)))) + ("Edit annotation" + . (lambda (candidate) + (let ((bmk (helm-bookmark-get-bookmark-from-name + candidate))) + (bookmark-edit-annotation bmk)))) + ("Show Google map" + . (lambda (candidate) + (let* ((bmk (helm-bookmark-get-bookmark-from-name + candidate)) + (full-bmk (assoc bmk bookmark-alist))) + (addressbook-google-map full-bmk))))) + "Actions for addressbook bookmarks." + :group 'helm-bookmark + :type '(alist :key-type string :value-type function)) + + +(defface helm-bookmark-info + '((t (:foreground "green"))) + "Face used for W3m Emacs bookmarks (not w3m bookmarks)." + :group 'helm-bookmark) + +(defface helm-bookmark-w3m + '((t (:foreground "yellow"))) + "Face used for W3m Emacs bookmarks (not w3m bookmarks)." + :group 'helm-bookmark) + +(defface helm-bookmark-gnus + '((t (:foreground "magenta"))) + "Face used for Gnus bookmarks." + :group 'helm-bookmark) + +(defface helm-bookmark-man + '((t (:foreground "Orange4"))) + "Face used for Woman/man bookmarks." + :group 'helm-bookmark) + +(defface helm-bookmark-file + '((t (:foreground "Deepskyblue2"))) + "Face used for file bookmarks." + :group 'helm-bookmark) + +(defface helm-bookmark-directory + '((t (:inherit helm-ff-directory))) + "Face used for file bookmarks." + :group 'helm-bookmark) + +(defface helm-bookmark-addressbook + '((t (:foreground "tomato"))) + "Face used for addressbook bookmarks." + :group 'helm-bookmark) + + +(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-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 + (bookmark-all-names)))) + (filtered-candidate-transformer :initform 'helm-bookmark-transformer))) + +(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)) + (loc (bookmark-location real))) + (setq helm-bookmark-show-location (not helm-bookmark-show-location)) + (helm-update (if helm-bookmark-show-location + (concat (regexp-quote trunc) + " +" + (regexp-quote + (if (listp loc) (car loc) loc))) + (regexp-quote real))))) + +(defun helm-bookmark-toggle-filename () + "Toggle bookmark location visibility." + (interactive) + (with-helm-alive-p + (helm-attrset 'toggle-filename + '(helm-bookmark-toggle-filename-1 . never-split)) + (helm-execute-persistent-action 'toggle-filename))) +(put 'helm-bookmark-toggle-filename 'helm-only t) + +(defun helm-bookmark-jump (candidate) + "Jump to bookmark from keyboard." + (let ((current-prefix-arg helm-current-prefix-arg) + non-essential) + (bookmark-jump candidate))) + +(defun helm-bookmark-jump-other-window (candidate) + (let (non-essential) + (bookmark-jump-other-window candidate))) + + +;;; 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))) + +(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))) + +(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))) + +(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))) + +(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) + (assoc 'image-type (assoc bookmark bookmark-alist)) + (assoc '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 (bookmark-get-handler bookmark))))) + +(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-addressbook-p + helm-bookmark-gnus-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) + never (funcall pred bookmark))) + +(defun helm-bookmark-filter-setup-alist (fn) + "Return a filtered `bookmark-alist' sorted alphabetically." + (cl-loop for b in 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) + (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) + + +;;;; Filtered bookmark sources +;; +;; +(defclass helm-source-filtered-bookmarks (helm-source-in-buffer helm-type-bookmark) + ((filtered-candidate-transformer + :initform '(helm-adaptive-sort + helm-highlight-bookmark)))) + +;;; W3m bookmarks. +;; +(defun helm-bookmark-w3m-setup-alist () + "Specialized filter function for bookmarks w3m." + (helm-bookmark-filter-setup-alist 'helm-bookmark-w3m-bookmark-p)) + +(defvar helm-source-bookmark-w3m + (helm-make-source "Bookmark W3m" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-w3m-setup-alist))))) + +;;; Images +;; +(defun helm-bookmark-images-setup-alist () + "Specialized filter function for images bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-image-bookmark-p)) + +(defvar helm-source-bookmark-images + (helm-make-source "Bookmark Images" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-images-setup-alist))))) + +;;; Woman Man +;; +(defun helm-bookmark-man-setup-alist () + "Specialized filter function for bookmarks w3m." + (helm-bookmark-filter-setup-alist 'helm-bookmark-woman-man-bookmark-p)) + +(defvar helm-source-bookmark-man + (helm-make-source "Bookmark Woman&Man" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-man-setup-alist))))) + +;;; Gnus +;; +(defun helm-bookmark-gnus-setup-alist () + "Specialized filter function for bookmarks gnus." + (helm-bookmark-filter-setup-alist 'helm-bookmark-gnus-bookmark-p)) + +(defvar helm-source-bookmark-gnus + (helm-make-source "Bookmark Gnus" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-gnus-setup-alist))))) + +;;; Info +;; +(defun helm-bookmark-info-setup-alist () + "Specialized filter function for bookmarks info." + (helm-bookmark-filter-setup-alist 'helm-bookmark-info-bookmark-p)) + +(defvar helm-source-bookmark-info + (helm-make-source "Bookmark Info" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-info-setup-alist))))) + +;;; 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)) + +(defvar helm-source-bookmark-files&dirs + (helm-make-source "Bookmark Files&Directories" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-local-files-setup-alist))))) + +;;; 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))) + +(defun helm-bookmark-run-browse-project () + "Run `helm-bookmark-browse-project' from keyboard." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-bookmark-browse-project))) +(put 'helm-bookmark-run-browse-project 'helm-only t) + +(defvar helm-bookmark-find-files-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-bookmark-map) + (define-key map (kbd "C-c o") 'ignore) + (define-key map (kbd "C-x C-d") 'helm-bookmark-run-browse-project) + map)) + +(defclass helm-bookmark-override-inheritor (helm-source) ()) + +(defmethod helm--setup-source ((source helm-bookmark-override-inheritor)) + ;; Ensure `helm-source-in-buffer' method is called. + (call-next-method) + (setf (slot-value source 'action) + (helm-append-at-nth + (remove '("Jump to BM other window" . helm-bookmark-jump-other-window) + helm-type-bookmark-actions) + '(("Browse project" . helm-bookmark-browse-project)) 1)) + (setf (slot-value source 'keymap) helm-bookmark-find-files-map)) + +(defclass helm-bookmark-find-files-class (helm-source-filtered-bookmarks + helm-bookmark-override-inheritor) + ()) + +(defvar helm-source-bookmark-helm-find-files + (helm-make-source "Bookmark helm-find-files sessions" 'helm-bookmark-find-files-class + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-helm-find-files-setup-alist))) + :persistent-action (lambda (_candidate) (ignore)) + :persistent-help "Do nothing")) + +;;; Uncategorized bookmarks +;; +(defun helm-bookmark-uncategorized-setup-alist () + "Specialized filter function for uncategorized bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-uncategorized-bookmark-p)) + +(defvar helm-source-bookmark-uncategorized + (helm-make-source "Bookmark uncategorized" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-uncategorized-setup-alist))))) + +;;; Addressbook. +;; +;; +(defun helm-bookmark-addressbook-search-fn (pattern) + (helm-awhile (next-single-property-change (point) 'email) + (goto-char it) + (end-of-line) + (when (string-match pattern + (get-text-property + 0 'email (buffer-substring + (point-at-bol) (point-at-eol)))) + (cl-return + (+ (point) (match-end 0)))))) + +(defclass helm-bookmark-addressbook-class (helm-source-in-buffer) + ((init :initform (lambda () + (require 'addressbook-bookmark nil t) + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global + (cl-loop for b in (helm-bookmark-addressbook-setup-alist) + collect (propertize + b 'email (bookmark-prop-get + b 'email)))))) + (search :initform 'helm-bookmark-addressbook-search-fn) + (persistent-action :initform + (lambda (candidate) + (let ((bmk (helm-bookmark-get-bookmark-from-name + candidate))) + (bookmark--jump-via bmk 'switch-to-buffer)))) + (persistent-help :initform "Show contact - Prefix with C-u to append") + (mode-line :initform (list "Contact(s)" helm-mode-line-string)) + (filtered-candidate-transformer :initform + '(helm-adaptive-sort + helm-highlight-bookmark)) + (action :initform 'helm-bookmark-addressbook-actions))) + +(defun helm-bookmark-addressbook-send-mail-1 (_candidate &optional cc) + (let* ((contacts (helm-marked-candidates)) + (bookmark (helm-bookmark-get-bookmark-from-name + (car contacts))) + (append (message-buffers))) + (addressbook-set-mail-buffer-1 bookmark append cc) + (helm-aif (cdr contacts) + (cl-loop for bmk in it do + (addressbook-set-mail-buffer-1 + (helm-bookmark-get-bookmark-from-name bmk) 'append cc))))) + +(defun helm-bookmark-addressbook-setup-alist () + "Specialized filter function for addressbook bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-addressbook-p)) + +(defvar helm-source-bookmark-addressbook + (helm-make-source "Bookmark Addressbook" 'helm-bookmark-addressbook-class)) + +;;; 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 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 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) + ;; Add a * if bookmark have annotation + if (and isannotation (not (string-equal isannotation ""))) + do (setq trunc (concat "*" (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)) + ( ;; 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 + (and isfile + (or hff + ;; 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)) + ( ;; regular files + t + (propertize trunc 'face 'helm-bookmark-file + 'help-echo isfile))) + collect (if helm-bookmark-show-location + (cons (concat bmk sep (if (listp loc) (car loc) loc)) + i) + (cons 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)) + (new-name (read-from-minibuffer "Name: " bookmark-name)) + (new-loc (read-from-minibuffer "FileName or Location: " + (or bookmark-fname + (if (consp bookmark-loc) + (car bookmark-loc) + bookmark-loc)))) + (docid (and (eq handler 'mu4e-bookmark-jump) + (read-number "Docid: " (cdr bookmark-loc))))) + (when docid + (setq new-loc (cons new-loc docid))) + (when (and (not (equal new-name "")) (not (equal new-loc "")) + (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) 'location new-loc) + (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. +Interactively: + If called from the keyboard, then prompt for OLD. + If called from the menubar, select OLD from a menu. +If NEW is nil, then prompt for its string value. + +If BATCH is non-nil, then do not rebuild the menu list. + +While the user enters the new name, repeated `C-w' inserts consecutive +words from the buffer into the new bookmark name." + (interactive (list (bookmark-completing-read "Old 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)) + (let ((newname (or new (read-from-minibuffer + "New name: " nil + (let ((now-map (copy-keymap minibuffer-local-map))) + (define-key now-map "\C-w" 'bookmark-yank-word) + now-map) + nil 'bookmark-history)))) + (bookmark-set-name old newname) + (setq bookmark-current-bookmark newname) + (unless batch (bookmark-bmenu-surreptitiously-rebuild-list)) + (helm-bookmark-maybe-save-bookmark) newname)) + +(defun helm-bookmark-run-edit () + "Run `helm-bookmark-edit-bookmark' from keyboard." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-bookmark-edit-bookmark))) +(put 'helm-bookmark-run-edit 'helm-only t) + + +(defun helm-bookmark-run-jump-other-window () + "Jump to bookmark from keyboard." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-bookmark-jump-other-window))) +(put 'helm-bookmark-run-jump-other-window 'helm-only t) + +(defun helm-bookmark-run-delete () + "Delete bookmark from keyboard." + (interactive) + (with-helm-alive-p + (when (y-or-n-p "Delete bookmark(s)?") + (helm-exit-and-execute-action 'helm-delete-marked-bookmarks)))) +(put 'helm-bookmark-run-delete 'helm-only t) + +(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." + (cl-dolist (i (helm-marked-candidates)) + (bookmark-delete (helm-bookmark-get-bookmark-from-name i) + 'batch))) + + +;;;###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 library addressbook-bookmark.el is available." + (interactive) + (helm :sources helm-bookmark-default-filtered-sources + :prompt "Search Bookmark: " + :buffer "*helm filtered bookmarks*" + :default (list (thing-at-point 'symbol) + (buffer-name helm-current-buffer)))) + +(provide 'helm-bookmark) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-bookmark.el ends here diff --git a/helm-buffers.el b/helm-buffers.el new file mode 100644 index 00000000..8f62e1d5 --- /dev/null +++ b/helm-buffers.el @@ -0,0 +1,924 @@ +;;; helm-buffers.el --- helm support for buffers. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-elscreen) +(require 'helm-grep) +(require 'helm-regexp) +(require 'helm-help) + +(declare-function ido-make-buffer-list "ido" (default)) +(declare-function ido-add-virtual-buffers-to-list "ido") +(declare-function helm-comp-read "helm-mode") +(declare-function helm-browse-project "helm-files") + + +(defgroup helm-buffers nil + "Buffers related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-boring-buffer-regexp-list + '("\\` " "\\*helm" "\\*helm-mode" "\\*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)) + :group 'helm-buffers) + +(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)) + :group 'helm-buffers) + +(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)) + :group 'helm-buffers) + +(defcustom helm-buffer-max-length 20 + "Max length of buffer names before truncate. +When disabled (nil) use the longest buffer-name length found." + :group 'helm-buffers + :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." + :group 'helm-buffers + :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." + :group 'helm-buffers + :type 'boolean) + +(defcustom helm-buffer-skip-remote-checking nil + "Ignore checking for `file-exists-p' on remote files." + :group 'helm-buffers + :type 'boolean) + +(defcustom helm-buffers-truncate-lines t + "Truncate lines in `helm-buffers-list' when non--nil." + :group 'helm-buffers + :type 'boolean) + +(defcustom helm-mini-default-sources '(helm-source-buffers-list + helm-source-recentf + helm-source-buffer-not-found) + "Default sources list used in `helm-mini'." + :group 'helm-buffers + :type '(repeat (choice symbol))) + +(defcustom helm-buffers-end-truncated-string "..." + "The string to display at end of truncated buffer names." + :type 'string + :group 'helm-buffers) + + +;;; 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 (:foreground "red" :background "black"))) + "Face used for buffer files modified outside of emacs." + :group 'helm-buffers-faces) + +(defface helm-buffer-not-saved + '((t (:foreground "Indianred2"))) + "Face used for buffer files not already saved on disk." + :group 'helm-buffers-faces) + +(defface helm-buffer-size + '((((background dark)) :foreground "RosyBrown") + (((background light)) :foreground "SlateGray")) + "Face used for buffer size." + :group 'helm-buffers-faces) + +(defface helm-buffer-process + '((t (:foreground "Sienna3"))) + "Face used for process status in buffer." + :group 'helm-buffers-faces) + +(defface helm-buffer-directory + '((t (:foreground "DarkRed" :background "LightGray"))) + "Face used for directories in `helm-buffers-list'." + :group 'helm-buffers-faces) + +(defface helm-buffer-file + '((t :inherit font-lock-builtin-face)) + "Face for buffer file names in `helm-buffers-list'." + :group 'helm-buffers-faces) + + +;;; 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-multi-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 "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-U") '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-M-%") 'helm-buffer-run-query-replace-regexp) + (define-key map (kbd "M-%") 'helm-buffer-run-query-replace) + (define-key map (kbd "M-m") 'helm-toggle-all-marks) + (define-key map (kbd "M-a") 'helm-mark-all) + (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 "") 'helm-buffers-mark-similar-buffers) + map) + "Keymap for buffer sources in helm.") + +(defvar helm-buffers-ido-virtual-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (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 "M-g s") 'helm-ff-run-grep) + (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) + (define-key map (kbd "M-D") 'helm-ff-run-delete-file) + (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) + map)) + + +(defvar helm-buffers-list-cache nil) +(defvar helm-buffer-max-len-mode nil) +(defvar helm-buffers-in-project-p nil) + +(defun helm-buffers-list--init () + ;; Issue #51 Create the list before `helm-buffer' creation. + (setq helm-buffers-list-cache (funcall (helm-attr 'buffer-list))) + (let ((result (cl-loop for b in helm-buffers-list-cache + maximize (length b) into len-buf + maximize (length (with-current-buffer b + (format-mode-line mode-name))) + 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) + (candidates :initform helm-buffers-list-cache) + (multimatch :initform nil) + (match :initform 'helm-buffers-match-function) + (persistent-action :initform 'helm-buffers-list-persistent-action) + (resume :initform (lambda () + (run-with-idle-timer + 0.1 nil (lambda () + (with-helm-buffer + (helm-force-update)))))) + (keymap :initform helm-buffer-map) + (migemo :initform 'nomultimatch) + (volatile :initform t) + (resume :initform (lambda () (setq helm-buffers-in-project-p nil))) + (help-message :initform 'helm-buffer-help-message) + (persistent-help + :initform + "Show this buffer / C-u \\[helm-execute-persistent-action]: Kill this buffer"))) + +(defvar helm-source-buffers-list nil) + +(defvar helm-source-buffer-not-found + (helm-build-dummy-source + "Create buffer" + :action (helm-make-actions + "Create buffer (C-u choose mode)" + (lambda (candidate) + (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))) + (if mjm + (with-current-buffer buffer (funcall mjm)) + (set-buffer-major-mode buffer)) + (switch-to-buffer buffer)))))) + +(defvar ido-temp-list) +(defvar ido-ignored-list) +(defvar ido-process-ignore-lists) +(defvar ido-use-virtual-buffers) +(defvar ido-virtual-buffers) + +(defvar helm-source-ido-virtual-buffers + (helm-build-sync-source "Ido virtual buffers" + :candidates (lambda () + (let (ido-temp-list + ido-ignored-list + (ido-process-ignore-lists t)) + (when ido-use-virtual-buffers + (ido-add-virtual-buffers-to-list) + ido-virtual-buffers))) + :fuzzy-match helm-buffers-fuzzy-matching + :keymap helm-buffers-ido-virtual-map + :help-message 'helm-buffers-ido-virtual-help-message + :action '(("Find file" . helm-find-many-files) + ("Find file other window" . find-file-other-window) + ("Find file other frame" . find-file-other-frame) + ("Find file as root" . helm-find-file-as-root) + ("Grep File(s) `C-u recurse'" . helm-find-files-grep) + ("Zgrep File(s) `C-u Recurse'" . helm-ff-zgrep) + ("View file" . view-file) + ("Delete file(s)" . helm-delete-marked-files) + ("Open file externally (C-u to choose)" + . helm-open-file-externally)))) + + +(defvar ido-use-virtual-buffers) +(defvar ido-ignore-buffers) +(defun helm-buffer-list () + "Return the current list of buffers. +Currently visible buffers are put at the end of the list. +See `ido-make-buffer-list' for more infos." + (require 'ido) + (let ((ido-process-ignore-lists t) + ido-ignored-list + ido-ignore-buffers + ido-use-virtual-buffers) + (ido-make-buffer-list nil))) + +(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 + (concat prefix + (propertize buf-name 'face face1 + 'help-echo help-echo + 'type type))) + (and details + (list size mode + (propertize + (if proc + (format "(%s %s in `%s')" + (process-name proc) + (process-status proc) dir) + (format "(in `%s')" dir)) + 'face face2))))) + +(defun helm-buffer--details (buffer &optional details) + (let* ((mode (with-current-buffer buffer (format-mode-line mode-name))) + (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)))) + ;; 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) + (cond + ( ;; 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-ff-symlink '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)) + ;; Any non--file buffer.=>grey italic + (t + (helm-buffer--show-details + name (and proc name-prefix) dir size mode dir + 'italic '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-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 (cons (if helm-buffer-details-flag + (concat truncbuf "\t" formatted-size + " " fmode " " meta) + name) + (get-buffer i)))) + +(defun helm-buffer--get-preselection (buffer) + (let ((bufname (buffer-name buffer))) + (concat "^" + (if (and (null helm-buffer-details-flag) + (numberp helm-buffer-max-length) + (> (string-width bufname) + helm-buffer-max-length)) + (regexp-quote + (helm-substring-by-width + bufname helm-buffer-max-length + 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 ((preselect (helm-buffer--get-preselection + (helm-get-selection)))) + (setq helm-buffer-details-flag (not helm-buffer-details-flag)) + (helm-update preselect)))) +(put 'helm-toggle-buffers-details 'helm-only t) + +(defun helm-buffers-sort-transformer (candidates _source) + (if (string= helm-pattern "") + candidates + (sort candidates + (lambda (s1 s2) + (< (string-width s1) (string-width s2)))))) + +(defun helm-buffers-mark-similar-buffers-1 () + (with-helm-window + (let* ((src (helm-get-current-source)) + (type (get-text-property + 0 'type (helm-get-selection nil 'withprop src)))) + (save-excursion + (goto-char (helm-get-previous-header-pos)) + (helm-next-line) + (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 ((cand (helm-get-selection nil 'withprop src))) + (when (and (not (helm-this-visible-mark)) + (eq (get-text-property 0 'type cand) type)) + (helm-make-visible-mark))) + (forward-line 1) (end-of-line)))) + (helm-mark-current-line) + (helm-display-mode-line src t) + (message "%s candidates marked" (length helm-marked-candidates))))) + +(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))))))) + +(defun helm-buffer--match-pattern (pattern candidate) + (let ((bfn (if (and helm-buffers-fuzzy-matching + (not helm-migemo-mode) + (not (string-match "\\`\\^" pattern))) + #'helm--mapconcat-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 (split-string pattern) + when (string-match "\\`\\*" p) + return p))) + (if regexp + (when buf + (with-current-buffer buf + (let ((mjm (format-mode-line mode-name))) + (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 (split-string pattern) + unless (string-match + "\\`\\(\\*\\|/\\|@\\)" p) + collect p))) + (if regexp-list + (cl-loop for re in regexp-list + always (helm-buffer--match-pattern re candidate)) + t))) + +(defun helm-buffers--match-from-inside (candidate) + (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) + (buf (get-buffer cand)) + (regexp (cl-loop with pattern = helm-pattern + for p in (split-string pattern) + when (string-match "\\`@\\(.*\\)" p) + return (match-string 1 p)))) + (if (and buf regexp) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (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 (buffer-file-name buf)) + (regexps (cl-loop with pattern = helm-pattern + for p in (split-string 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*") + (progn (kill-buffer "*Diff*") + (set-window-buffer it helm-current-buffer)) + (diff-buffer-with-file (get-buffer candidate)))) + +(defun helm-buffer-diff-persistent () + "Toggle diff buffer without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'diff-action 'helm-buffer-toggle-diff) + (helm-execute-persistent-action 'diff-action))) +(put 'helm-buffer-diff-persistent 'helm-only t) + +(defun helm-revert-buffer (candidate) + (with-current-buffer candidate + (helm-aif (buffer-file-name) + (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) + (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 (> (length marked) 1) (helm-unmark-all)) + (helm-force-update preselect))) + +(defun helm-buffer-revert-persistent () + "Revert buffer without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'revert-action '(helm-buffer-revert-and-update . never-split)) + (helm-execute-persistent-action 'revert-action))) +(put 'helm-buffer-revert-persistent 'helm-only t) + +(defun helm-buffer-save-and-update (_candidate) + (let ((marked (helm-marked-candidates)) + (preselect (helm-get-selection nil t)) + (enable-recursive-minibuffers t)) + (cl-loop for buf in marked do + (with-current-buffer (get-buffer buf) + (when (buffer-file-name) (save-buffer)))) + (when (> (length marked) 1) (helm-unmark-all)) + (helm-force-update (regexp-quote preselect)))) + +(defun helm-buffer-save-persistent () + "Save buffer without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'save-action '(helm-buffer-save-and-update . never-split)) + (helm-execute-persistent-action 'save-action))) +(put 'helm-buffer-save-persistent 'helm-only t) + +(defun helm-buffer-run-kill-persistent () + "Kill buffer without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'kill-action '(helm-buffers-persistent-kill . never-split)) + (helm-execute-persistent-action 'kill-action))) +(put 'helm-buffer-run-kill-persistent 'helm-only t) + +(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))) + +(defun helm-buffer-run-kill-buffers () + "Run kill buffer action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-kill-marked-buffers))) +(put 'helm-buffer-run-kill-buffers 'helm-only t) + +(defun helm-buffer-run-grep () + "Run Grep action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-grep-buffers))) +(put 'helm-buffer-run-grep 'helm-only t) + +(defun helm-buffer-run-zgrep () + "Run Grep action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-zgrep-buffers))) +(put 'helm-buffer-run-zgrep 'helm-only t) + +(defun helm-buffer-run-query-replace-regexp () + "Run Query replace regexp action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-buffer-query-replace-regexp))) +(put 'helm-buffer-run-query-replace-regexp 'helm-only t) + +(defun helm-buffer-run-query-replace () + "Run Query replace action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-buffer-query-replace))) +(put 'helm-buffer-run-query-replace 'helm-only t) + +(defun helm-buffer-switch-other-window () + "Run switch to other window action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-switch-to-buffers-other-window))) +(put 'helm-buffer-switch-other-window 'helm-only t) + +(defun helm-buffer-switch-other-frame () + "Run switch to other frame action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'switch-to-buffer-other-frame))) +(put 'helm-buffer-switch-other-frame 'helm-only t) + +(defun helm-buffer-switch-to-elscreen () + "Run switch to elscreen action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-buffer-on-elscreen))) +(put 'helm-buffer-switch-to-elscreen 'helm-only t) + +(defun helm-buffer-run-ediff () + "Run ediff action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ediff-marked-buffers))) +(put 'helm-buffer-run-ediff 'helm-only t) + +(defun helm-buffer-run-ediff-merge () + "Run ediff action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ediff-marked-buffers-merge))) +(put 'helm-buffer-run-ediff-merge 'helm-only t) + +(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)) + (with-current-buffer buf + (kill-buffer buffer-or-name)) + (helm-delete-current-selection) + (with-helm-temp-hook 'helm-after-persistent-action-hook + (helm-force-update (regexp-quote (helm-get-selection nil t))))))) + +(defun helm-buffers--quote-truncated-buffer (buffer) + (let ((bufname (and (bufferp buffer) + (buffer-name buffer)))) + (when bufname + (regexp-quote + (if helm-buffer-max-length + (helm-substring-by-width + bufname helm-buffer-max-length + "") + bufname))))) + +(defun helm-buffers-persistent-kill (_buffer) + (let ((marked (helm-marked-candidates))) + (unwind-protect + (cl-loop for b in marked + do (progn (helm-preselect + (format "^%s" + (helm-buffers--quote-truncated-buffer b))) + (save-selected-window + (when (y-or-n-p (format "kill buffer (%s)? " b)) + (helm-buffers-persistent-kill-1 b))) + (message nil) + (helm--remove-marked-and-update-mode-line b))) + (with-helm-buffer + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil)) + (helm-force-update (helm-buffers--quote-truncated-buffer + (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)))) + (switch-to-buffer candidate) + (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 ((lg-lst (length (helm-marked-candidates))) + 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 (helm-marked-candidates)))) + (2 + (setq buf1 (cl-first (helm-marked-candidates)) + buf2 (cl-second (helm-marked-candidates)))) + (t + (error "Error:To much 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-moccur-always-search-in-current + (if helm-current-prefix-arg + (not helm-moccur-always-search-in-current) + helm-moccur-always-search-in-current)) + (buffers (helm-marked-candidates)) + (input (cl-loop for i in (split-string helm-pattern " " t) + thereis (and (string-match "\\`@\\(.*\\)" i) + (match-string 1 i))))) + (helm-multi-occur-1 buffers input))) + +(defun helm-buffers-run-multi-occur () + "Run `helm-multi-occur-as-action' by key." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-multi-occur-as-action))) +(put 'helm-buffers-run-multi-occur 'helm-only t) + +(defun helm-buffers-toggle-show-hidden-buffers () + (interactive) + (with-helm-alive-p + (let ((filter-attrs (helm-attr 'filtered-candidate-transformer + helm-source-buffers-list))) + (if (memq 'helm-shadow-boring-buffers filter-attrs) + (helm-attrset 'filtered-candidate-transformer + (cons 'helm-skip-boring-buffers + (remove 'helm-shadow-boring-buffers + filter-attrs)) + helm-source-buffers-list) + (helm-attrset 'filtered-candidate-transformer + (cons 'helm-shadow-boring-buffers + (remove 'helm-skip-boring-buffers + filter-attrs)) + helm-source-buffers-list)) + (helm-force-update)))) +(put 'helm-buffers-toggle-show-hidden-buffers 'helm-only t) + +(defun helm-buffers-browse-project (buf) + "Browse project from buffer." + (with-current-buffer buf + (helm-browse-project helm-current-prefix-arg))) + +(defun helm-buffers-run-browse-project () + "Run `helm-buffers-browse-project' from key." + (interactive) + (with-helm-alive-p + (if helm-buffers-in-project-p + (user-error "You are already browsing this project") + (helm-exit-and-execute-action 'helm-buffers-browse-project)))) + +;;; Candidate Transformers +;; +;; +(defun helm-skip-boring-buffers (buffers _source) + (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-ido-virtual-buffers + helm-source-buffer-not-found) + :buffer "*helm buffers*" + :keymap helm-buffer-map + :truncate-lines helm-buffers-truncate-lines)) + +;;;###autoload +(defun helm-mini () + "Preconfigured `helm' lightweight version \(buffer -> recentf\)." + (interactive) + (require 'helm-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)) + +(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) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-buffers.el ends here diff --git a/helm-color.el b/helm-color.el new file mode 100644 index 00000000..73f6e3d0 --- /dev/null +++ b/helm-color.el @@ -0,0 +1,170 @@ +;;; helm-color.el --- colors and faces -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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) + +;;; 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) 'face) + (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 () + (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))) + +(defun helm-color-run-insert-name () + "Insert name of color from `helm-source-colors'" + (interactive) + (with-helm-alive-p (helm-exit-and-execute-action 'helm-color-insert-name))) +(put 'helm-color-run-insert-name 'helm-only t) + +(defun helm-color-run-kill-name () + "Kill name of color from `helm-source-colors'" + (interactive) + (with-helm-alive-p (helm-exit-and-execute-action 'helm-color-kill-name))) +(put 'helm-color-run-kill-name 'helm-only t) + +(defun helm-color-run-insert-rgb () + "Insert RGB of color from `helm-source-colors'" + (interactive) + (with-helm-alive-p (helm-exit-and-execute-action 'helm-color-insert-rgb))) +(put 'helm-color-run-insert-rgb 'helm-only t) + +(defun helm-color-run-kill-rgb () + "Kill RGB of color from `helm-source-colors'" + (interactive) + (with-helm-alive-p (helm-exit-and-execute-action 'helm-color-kill-rgb))) +(put 'helm-color-run-kill-rgb 'helm-only t) + +(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) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-color.el ends here diff --git a/helm-command.el b/helm-command.el new file mode 100644 index 00000000..3b2fe051 --- /dev/null +++ b/helm-command.el @@ -0,0 +1,294 @@ +;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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) + + +(defgroup helm-command nil + "Emacs command related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-M-x-requires-pattern 0 + "Value of requires-pattern for `helm-M-x'. +Show all candidates on startup when 0 (default)." + :group 'helm-command + :type 'boolean) + +(defcustom helm-M-x-always-save-history nil + "`helm-M-x' Save command in `extended-command-history' even when it fail." + :group 'helm-command + :type 'boolean) + +(defcustom helm-M-x-reverse-history nil + "The history source of `helm-M-x' appear in second position when non--nil." + :group 'helm-command + :type 'boolean) + +(defcustom helm-M-x-fuzzy-match nil + "Enable fuzzy matching in `helm-M-x' when non--nil." + :group 'helm-command + :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 (:foreground "orange" :underline t))) + "Face used in helm-M-x to show keybinding." + :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'.") + + +(cl-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-transformer-1 (candidates &optional sort) + "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)) + unless (get (intern (if (consp cand) (car cand) cand)) 'helm-only) + collect + (cons (cond ((and (string-match "^M-x" key) local-key) + (format "%s (%s)" + cand (propertize + local-key + 'face 'helm-M-x-key))) + ((string-match "^M-x" key) cand) + (t (format "%s (%s)" + cand (propertize + key + 'face 'helm-M-x-key)))) + 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." + (helm-M-x-transformer-1 candidates (null helm--in-fuzzy))) + +(defun helm-M-x-transformer-hist (candidates _source) + "Transformer function for `helm-M-x' candidates." + (helm-M-x-transformer-1 candidates)) + +(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 + (point-at-bol) (point-at-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)) + +(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) + map)) + +(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-read-extended-command (&optional collection history) + "Read command name to invoke in `helm-M-x'. +Helm completion is not provided when executing or defining +kbd macros. +Optional arg COLLECTION is to allow using another COLLECTION +than the default which is OBARRAY." + (if (or defining-kbd-macro executing-kbd-macro) + (if helm-mode + (unwind-protect + (progn + (helm-mode -1) + (read-extended-command)) + (helm-mode 1)) + (read-extended-command)) + (let* ((orig-fuzzy-sort-fn helm-fuzzy-sort-fn) + (helm-fuzzy-sort-fn (lambda (candidates source) + (funcall orig-fuzzy-sort-fn + candidates source 'real))) + (helm--mode-line-display-prefarg t) + (tm (run-at-time 1 0.1 'helm-M-x--notify-prefix-arg)) + (helm-move-selection-after-hook + (cons (lambda () (setq current-prefix-arg nil)) + helm-move-selection-after-hook))) + (setq extended-command-history + (cl-loop for c in extended-command-history + when (and c (commandp (intern c))) + do (set-text-properties 0 (length c) nil c) + and collect c)) + (unwind-protect + (progn + (setq current-prefix-arg nil) + (helm-comp-read + (concat (cond + ((eq helm-M-x-prefix-argument '-) "- ") + ((and (consp helm-M-x-prefix-argument) + (eq (car helm-M-x-prefix-argument) 4)) "C-u ") + ((and (consp helm-M-x-prefix-argument) + (integerp (car helm-M-x-prefix-argument))) + (format "%d " (car helm-M-x-prefix-argument))) + ((integerp helm-M-x-prefix-argument) + (format "%d " helm-M-x-prefix-argument))) + "M-x ") + (or collection obarray) + :test 'commandp + :requires-pattern helm-M-x-requires-pattern + :name "Emacs Commands" + :buffer "*helm M-x*" + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-function)) + :persistent-help "Describe this command" + :history (or history extended-command-history) + :reverse-history helm-M-x-reverse-history + :input-history 'helm-M-x-input-history + :del-input nil + :help-message 'helm-M-x-help-message + :keymap helm-M-x-map + :must-match t + :match-part (lambda (c) (car (split-string c))) + :fuzzy helm-M-x-fuzzy-match + :nomark t + :candidates-in-buffer t + :fc-transformer 'helm-M-x-transformer + :hist-fc-transformer 'helm-M-x-transformer-hist)) + (cancel-timer tm) + (setq helm--mode-line-display-prefarg nil))))) + +;;;###autoload +(defun helm-M-x (_arg &optional command-name) + "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 (helm-M-x-read-extended-command)))) + (let ((sym-com (and (stringp command-name) (intern-soft command-name)))) + (when sym-com + ;; Avoid having `this-command' set to *exit-minibuffer. + (setq this-command sym-com + ;; Handle C-x z (repeat) Issue #322 + real-this-command sym-com) + ;; 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))) + ;; This ugly construct is to save history even on error. + (unless helm-M-x-always-save-history + (command-execute sym-com 'record)) + (setq extended-command-history + (cons command-name + (delete command-name extended-command-history))) + (when helm-M-x-always-save-history + (command-execute sym-com 'record)))))) +(put 'helm-M-x 'interactive-only 'command-execute) + +(provide 'helm-command) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-command.el ends here diff --git a/helm-config.el b/helm-config.el new file mode 100644 index 00000000..89632094 --- /dev/null +++ b/helm-config.el @@ -0,0 +1,170 @@ +;;; helm-config.el --- Applications library for `helm.el' -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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 +;; +;; +(declare-function async-bytecomp-package-mode "ext:async-bytecomp.el") +(when (require 'async-bytecomp nil t) + (and (fboundp 'async-bytecomp-package-mode) + (async-bytecomp-package-mode 1))) + + +(defgroup helm-config nil + "Various configurations for Helm." + :group 'helm) + +(defcustom helm-command-prefix-key "C-x c" + "The key `helm-command-prefix' is bound to in the global map." + :type '(choice (string :tag "Key") (const :tag "no binding")) + :group 'helm-config + :set + (lambda (var key) + (when (and (boundp var) (symbol-value var)) + (define-key (current-global-map) + (read-kbd-macro (symbol-value var)) nil)) + (when key + (define-key (current-global-map) + (read-kbd-macro key) 'helm-command-prefix)) + (set var key))) + +(defcustom helm-minibuffer-history-key "C-r" + "The key `helm-minibuffer-history' is bound to in minibuffer local maps." + :type '(choice (string :tag "Key") (const :tag "no binding")) + :group 'helm-config + :set + (lambda (var key) + (cl-dolist (map '(minibuffer-local-completion-map + minibuffer-local-filename-completion-map + minibuffer-local-filename-must-match-map ; Emacs 23.1.+ + minibuffer-local-isearch-map + minibuffer-local-map + minibuffer-local-must-match-filename-map ; Older Emacsen + minibuffer-local-must-match-map + minibuffer-local-ns-map)) + (when (and (boundp map) (keymapp (symbol-value map))) + (when (and (boundp var) (symbol-value var)) + (define-key (symbol-value map) + (read-kbd-macro (symbol-value var)) nil)) + (when key + (define-key (symbol-value map) + (read-kbd-macro key) 'helm-minibuffer-history)))) + (set var key))) + +;;; Command Keymap +;; +;; +(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 "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 "/") 'helm-find) + (define-key map (kbd "i") 'helm-semantic-or-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-list-elisp-packages) + map)) + +;; Don't override the keymap we just defined with an empty +;; keymap. This also protect bindings changed by the user. +(defvar helm-command-prefix) +(define-prefix-command 'helm-command-prefix) +(fset 'helm-command-prefix helm-command-map) +(setq helm-command-prefix helm-command-map) + + +;;; Menu + +(require 'helm-easymenu) + + +;;;###autoload +(defun helm-configuration () + "Customize `helm'." + (interactive) + (customize-group "helm")) + + +;;; Fontlock +(cl-dolist (mode '(emacs-lisp-mode lisp-interaction-mode)) + (font-lock-add-keywords + mode + '(("(\\<\\(with-helm-after-update-hook\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-temp-hook\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-window\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-quittable\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-current-buffer\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-buffer\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-show-completion\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-default-directory\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-restore-variables\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(helm-multi-key-defun\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(helm-while-no-input\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(helm-aif\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(helm-awhile\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(helm-acond\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(helm-with-gensyms\\)\\>" 1 font-lock-keyword-face)))) + + +;;; Load the autoload file +;; It should have been generated either by +;; package.el or the make file. + +(load "helm-autoloads" nil t) + +(provide 'helm-config) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-config.el ends here diff --git a/helm-core-pkg.el b/helm-core-pkg.el new file mode 100644 index 00000000..a9d6fd01 --- /dev/null +++ b/helm-core-pkg.el @@ -0,0 +1,11 @@ +;;; helm-core-pkg.el --- define helm-core for package.el + +(define-package "helm-core" "2.2.1" + "Development files for Helm" + '((emacs "24.4") + (async "1.9")) + :url "https://emacs-helm.github.io/helm/") + +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/helm-dabbrev.el b/helm-dabbrev.el new file mode 100644 index 00000000..21d54f7d --- /dev/null +++ b/helm-dabbrev.el @@ -0,0 +1,327 @@ +;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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'." + :group 'helm-dabbrev + :type 'boolean) + +(defcustom helm-dabbrev-max-length-result 20 + "Max length of candidates before searching in all buffers. +If number of candidates found in current-buffer is <= to this, +search in all buffers. +Have no effect when `helm-dabbrev-always-search-all' is non--nil." + :group 'helm-dabbrev + :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." + :group 'helm-dabbrev + :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 is related to `current-buffer'. +This is actually 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 example. + +When nil all buffers are considered related to `current-buffer'." + :group 'helm-dabbrev + :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 have same `major-mode' +than the `current-buffer'. +This have 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) + :group 'helm-dabbrev) + +(defcustom helm-dabbrev-lineno-around 30 + "Search first in this number of lines before an after point." + :group 'helm-dabbrev + :type 'integer) + +(defcustom helm-dabbrev-cycle-threshold nil + "Number of time helm-dabbrev cycle before displaying helm completion. +When nil or 0 disable cycling." + :group 'helm-dabbrev + :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)." + :group 'helm-dabbrev + :type '(choice (const :tag "Ignore case" t) + (const :tag "Respect case" nil) + (other :tag "Smart" 'smart))) + + +(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--exclude-current-buffer-flag nil) +(defvar helm-dabbrev--cache nil) +(defvar helm-dabbrev--data nil) +(defvar helm-dabbrev--regexp "\\s-\\|\t\\|[(\[\{\"'`=<$;.]\\|\\s\\\\|^") +(cl-defstruct helm-dabbrev-info dabbrev limits iterator) + + +(defun helm-dabbrev--buffer-list () + (cl-loop with lst = (buffer-list) + for buf in (if helm-dabbrev--exclude-current-buffer-flag + (cdr lst) lst) + 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)) + result pos-before pos-after + (search-and-store + (lambda (pattern direction) + (while (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 pos-after pos) + (search-forward pattern pos t))) + (-2 (let ((pos + (save-excursion + (forward-line + (- helm-dabbrev-lineno-around)) + (point)))) + (setq pos-before pos) + (search-backward pattern pos t)))) + (let* ((replace-regexp (concat "\\(" helm-dabbrev--regexp "\\)\\'")) + (match-1 (helm-aif (thing-at-point 'symbol) + ;; `thing-at-point' returns + ;; the quote outside of e-lisp mode, + ;; e.g in message mode, + ;; `foo' => foo' + ;; but in e-lisp like modes: + ;; `foo' => foo + ;; so remove it [1]. + (replace-regexp-in-string + replace-regexp + "" (substring-no-properties it)))) + (match-2 (helm-aif (thing-at-point 'filename) + ;; Same as in [1]. + (replace-regexp-in-string + replace-regexp + "" (substring-no-properties it)))) + (lst (if (string= match-1 match-2) + (list match-1) + (list match-1 match-2)))) + (cl-loop for match in lst + unless (or (string= str match) + (member match result)) + do (push match result))))))) + (cl-loop for buf in (if all (helm-dabbrev--buffer-list) + (list (current-buffer))) + + do (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. + (funcall search-and-store str -2)) ; store pos [1] + (save-excursion + ;; Search the next 30 lines after point. + (funcall search-and-store str 2)) ; store pos [2] + (save-excursion + ;; Search all before point. + (goto-char pos-before) ; start from [1] + (funcall search-and-store str -1)) + (save-excursion + ;; Search all after point. + (goto-char pos-after) ; start from [2] + (funcall search-and-store str 1)))) + when (> (length result) limit) return (nreverse result) + finally return (nreverse result)))) + +(defun helm-dabbrev--get-candidates (abbrev) + (cl-assert abbrev nil "[No Match]") + (with-current-buffer (current-buffer) + (let* ((dabbrev-get (lambda (str all-bufs) + (helm-dabbrev--collect + str helm-candidate-number-limit + (cl-case helm-dabbrev-case-fold-search + (smart (helm-set-case-fold-search-1 abbrev)) + (t helm-dabbrev-case-fold-search)) + all-bufs))) + (lst (funcall dabbrev-get abbrev helm-dabbrev-always-search-all))) + (if (and (not helm-dabbrev-always-search-all) + (<= (length lst) helm-dabbrev-max-length-result)) + ;; Search all but don't recompute current-buffer. + (let ((helm-dabbrev--exclude-current-buffer-flag t)) + (append lst (funcall dabbrev-get abbrev 'all-bufs))) + lst)))) + +(defun helm-dabbrev-default-action (candidate) + (with-helm-current-buffer + (let* ((limits (helm-bounds-of-thing-before-point + helm-dabbrev--regexp)) + (beg (car limits)) + (end (point))) + (run-with-timer + 0.01 nil + 'helm-insert-completion-at-point + beg end candidate)))) + +;;;###autoload +(defun helm-dabbrev () + "Preconfigured helm for dynamic abbreviations." + (interactive) + (let ((dabbrev (helm-thing-before-point nil helm-dabbrev--regexp)) + (limits (helm-bounds-of-thing-before-point helm-dabbrev--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 cycling-disabled-p + (setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev))) + (unless (or cycling-disabled-p + (helm-dabbrev-info-p helm-dabbrev--data)) + (setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev)) + (setq helm-dabbrev--data + (make-helm-dabbrev-info + :dabbrev dabbrev + :limits limits + :iterator + (helm-iter-list + (cl-loop for i in helm-dabbrev--cache when + (and i (string-match + (concat "^" (regexp-quote dabbrev)) i)) + collect i into selection + when (and selection + (= (length selection) + helm-dabbrev-cycle-threshold)) + ;; When selection len reach + ;; `helm-dabbrev-cycle-threshold' + ;; return selection. + return selection + ;; selection len never reach + ;; `helm-dabbrev-cycle-threshold' + ;; return selection. + finally return selection))))) + (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)) + (cdr limits) it) + ;; Move already tried candidates to end of list. + (setq helm-dabbrev--cache (append (remove it helm-dabbrev--cache) + (list it)))) + ;; 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". + (let ((old-dabbrev (if (helm-dabbrev-info-p helm-dabbrev--data) + (helm-dabbrev-info-dabbrev helm-dabbrev--data) + dabbrev))) + (unless (cdr (all-completions old-dabbrev helm-dabbrev--cache)) + (setq cycling-disabled-p t)) + ;; Iterator is now empty, reset dabbrev to initial value + ;; and start helm completion. + (unless 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)) + (with-helm-show-completion (car limits) (cdr limits) + (helm :sources (helm-build-in-buffer-source "Dabbrev Expand" + :data helm-dabbrev--cache + :persistent-action 'ignore + :persistent-help "DoNothing" + :keymap helm-dabbrev-map + :action 'helm-dabbrev-default-action) + :buffer "*helm dabbrev*" + :input (concat "^" dabbrev " ") + :resume 'noresume + :allow-nest t))))))) + +(provide 'helm-dabbrev) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-dabbrev.el ends here diff --git a/helm-easymenu.el b/helm-easymenu.el new file mode 100644 index 00000000..9ab3580c --- /dev/null +++ b/helm-easymenu.el @@ -0,0 +1,90 @@ +;;; helm-easymenu.el --- Helm easymenu definitions. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2016 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]) + ("Buffers" + ["Find buffers" helm-buffers-list t]) + ("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]) + ("Org" + ["Org headlines in org agenda files" helm-org-agenda-files-headings t] + ["Org headlines in buffer" helm-org-in-buffer-headings t]) + ("Elpa" + ["Elisp packages" helm-list-elisp-packages t] + ["Elisp packages no fetch" helm-list-elisp-packages-no-fetch 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) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-easymenu.el ends here diff --git a/helm-elisp-package.el b/helm-elisp-package.el new file mode 100644 index 00000000..a639133b --- /dev/null +++ b/helm-elisp-package.el @@ -0,0 +1,440 @@ +;;; helm-elisp-package.el --- helm interface for package.el -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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 'package) + +(defgroup helm-el-package nil + "helm elisp packages." + :group 'helm) + +(defcustom helm-el-package-initial-filter 'all + "Show only installed, upgraded or all packages at startup." + :group 'helm-el-package + :type '(radio :tag "Initial filter for elisp packages" + (const :tag "Show all packages" all) + (const :tag "Show installed packages" installed) + (const :tag "Show not installed packages" uninstalled) + (const :tag "Show upgradable packages" upgrade))) + +;; internals vars +(defvar helm-el-package--show-only 'all) +(defvar helm-el-package--initialized-p nil) +(defvar helm-el-package--tabulated-list nil) +(defvar helm-el-package--upgrades nil) +(defvar helm-el-package--removable-packages nil) + +;; Shutup bytecompiler for emacs-24* +(defvar package-menu-async) ; Only available on emacs-25. +(declare-function async-byte-recompile-directory "ext:async-bytecomp.el") + +(defun helm-el-package--init () + (let (package-menu-async) + (when (null package-alist) + (setq helm-el-package--show-only 'all)) + (when (fboundp 'package--removable-packages) + (setq helm-el-package--removable-packages + (package--removable-packages))) + (save-selected-window + (if (and helm-el-package--initialized-p + (fboundp 'package-show-package-list)) + ;; Use this as `list-packages' doesn't work + ;; properly (empty buffer) when called from lisp + ;; with 'no-fetch (emacs-25 WA). + (package-show-package-list) + (when helm--force-updating-p (message "Refreshing packages list...")) + (list-packages helm-el-package--initialized-p)) + (setq helm-el-package--initialized-p t) + (message nil)) + (helm-init-candidates-in-buffer + 'global + (with-current-buffer (get-buffer "*Packages*") + (setq helm-el-package--tabulated-list tabulated-list-entries) + (buffer-string))) + (setq helm-el-package--upgrades (helm-el-package-menu--find-upgrades)) + (if helm--force-updating-p + (if helm-el-package--upgrades + (message "Refreshing packages list done, [%d] package(s) to upgrade" + (length helm-el-package--upgrades)) + (message "Refreshing packages list done, no upgrades available")) + (setq helm-el-package--show-only (if helm-el-package--upgrades + 'upgrade + helm-el-package-initial-filter))) + (kill-buffer "*Packages*"))) + +(defun helm-el-package-describe (candidate) + (let ((id (get-text-property 0 'tabulated-list-id candidate))) + (describe-package (if (fboundp 'package-desc-name) + (package-desc-name id) + (car id))))) + +(defun helm-el-package-visit-homepage (candidate) + (let* ((id (get-text-property 0 'tabulated-list-id candidate)) + (pkg (if (fboundp 'package-desc-name) (package-desc-name id) + (car id))) + (desc (cadr (assoc pkg package-archive-contents))) + (extras (package-desc-extras desc)) + (url (and (listp extras) (cdr-safe (assoc :url extras))))) + (if (stringp url) + (browse-url url) + (message "Package %s has no homepage" + (propertize (symbol-name pkg) + 'face 'font-lock-keyword-face))))) + +(defun helm-el-run-visit-homepage () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-el-package-visit-homepage))) +(put 'helm-el-run-visit-homepage 'helm-only t) + +(defun helm-el-package-install-1 (pkg-list) + (cl-loop with mkd = pkg-list + for p in mkd + for id = (get-text-property 0 'tabulated-list-id p) + do (package-install + (if (fboundp 'package-desc-name) id (car id))) + collect (if (fboundp 'package-desc-full-name) id (car id)) + into installed-list + finally do (if (fboundp 'package-desc-full-name) + (message (format "%d packages installed:\n(%s)" + (length installed-list) + (mapconcat #'package-desc-full-name + installed-list ", "))) + (message (format "%d packages installed:\n(%s)" + (length installed-list) + (mapconcat 'symbol-name installed-list ", ")))))) + +(defun helm-el-package-install (_candidate) + (helm-el-package-install-1 (helm-marked-candidates))) + +(defun helm-el-run-package-install () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-el-package-install))) +(put 'helm-el-run-package-install 'helm-only t) + +(defun helm-el-package-uninstall-1 (pkg-list &optional force) + (cl-loop with mkd = pkg-list + for p in mkd + for id = (get-text-property 0 'tabulated-list-id p) + do + (condition-case-unless-debug err + (with-no-warnings + (if (fboundp 'package-desc-full-name) + ;; emacs 24.4 + (condition-case nil + (package-delete id force) + (wrong-number-of-arguments + (package-delete id))) + ;; emacs 24.3 + (package-delete (symbol-name (car id)) + (package-version-join (cdr id))))) + (error (message (cadr err)))) + unless (assoc (elt id 1) package-alist) + collect (if (fboundp 'package-desc-full-name) + id + (cons (symbol-name (car id)) + (package-version-join (cdr id)))) + into delete-list + finally do (if delete-list + (if (fboundp 'package-desc-full-name) + ;; emacs 24.4 + (message (format "%d packages deleted:\n(%s)" + (length delete-list) + (mapconcat #'package-desc-full-name + delete-list ", "))) + ;; emacs 24.3 + (message (format "%d packages deleted:\n(%s)" + (length delete-list) + (mapconcat (lambda (x) + (concat (car x) "-" (cdr x))) + delete-list ", "))) + ;; emacs 24.3 doesn't update + ;; its `package-alist' after deleting. + (cl-loop for p in package-alist + when (assq (symbol-name (car p)) delete-list) + do (setq package-alist (delete p package-alist)))) + "No package deleted"))) + +(defun helm-el-package-uninstall (_candidate) + (helm-el-package-uninstall-1 (helm-marked-candidates) helm-current-prefix-arg)) + +(defun helm-el-run-package-uninstall () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-el-package-uninstall))) +(put 'helm-el-run-package-uninstall 'helm-only t) + +(defun helm-el-package-menu--find-upgrades () + (cl-loop for entry in helm-el-package--tabulated-list + for pkg-desc = (car entry) + for status = (package-desc-status pkg-desc) + when (member status '("installed" "unsigned" "dependency")) + collect pkg-desc + into installed + when (member status '("available" "new")) + collect (cons (package-desc-name pkg-desc) pkg-desc) + into available + finally return + (cl-loop for pkg in installed + for avail-pkg = (assq (package-desc-name pkg) available) + when (and avail-pkg + (version-list-< (package-desc-version pkg) + (package-desc-version + (cdr avail-pkg)))) + collect avail-pkg))) + +(defun helm-el-package-upgrade-1 (pkg-list) + (cl-loop for p in pkg-list + for pkg-desc = (car p) + for upgrade = (cdr (assq (package-desc-name pkg-desc) + helm-el-package--upgrades)) + do + (cond ((null upgrade) + (ignore)) + ((equal pkg-desc upgrade) + ;;Install. + (with-no-warnings + (if (boundp 'package-selected-packages) + (package-install pkg-desc t) + (package-install pkg-desc)))) + (t + ;; Delete. + (if (boundp 'package-selected-packages) + (with-no-warnings + (package-delete pkg-desc t t)) + (package-delete pkg-desc)))))) + +(defun helm-el-package-upgrade (_candidate) + (helm-el-package-upgrade-1 + (cl-loop with pkgs = (helm-marked-candidates) + for p in helm-el-package--tabulated-list + for pkg = (car p) + if (member (symbol-name (package-desc-name pkg)) pkgs) + collect p))) + +(defun helm-el-run-package-upgrade () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-el-package-upgrade))) +(put 'helm-el-run-package-upgrade 'helm-only t) + +(defun helm-el-package-upgrade-all () + (if helm-el-package--upgrades + (with-helm-display-marked-candidates + helm-marked-buffer-name (mapcar (lambda (x) (symbol-name (car x))) + helm-el-package--upgrades) + (when (y-or-n-p "Upgrade all packages? ") + (helm-el-package-upgrade-1 helm-el-package--tabulated-list))) + (message "No packages to upgrade actually!"))) + +(defun helm-el-package-upgrade-all-action (_candidate) + (helm-el-package-upgrade-all)) + +(defun helm-el-run-package-upgrade-all () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-el-package-upgrade-all-action))) +(put 'helm-el-run-package-upgrade-all 'helm-only t) + +(defun helm-el-package--transformer (candidates _source) + (cl-loop for c in candidates + for id = (get-text-property 0 'tabulated-list-id c) + for name = (if (fboundp 'package-desc-name) + (and id (package-desc-name id)) + (car id)) + for desc = (package-desc-status id) + for built-in-p = (and (package-built-in-p name) + (not (member desc '("available" "new" + "installed" "dependency")))) + for installed-p = (member desc '("installed" "dependency")) + for upgrade-p = (assq name helm-el-package--upgrades) + for user-installed-p = (and (boundp 'package-selected-packages) + (memq name package-selected-packages)) + do (when user-installed-p (put-text-property 0 2 'display "S " c)) + do (when (memq name helm-el-package--removable-packages) + (put-text-property 0 2 'display "U " c) + (put-text-property + 2 (+ (length (symbol-name name)) 2) + 'face 'font-lock-variable-name-face c)) + for cand = (cons c (car (split-string c))) + when (or (and built-in-p + (eq helm-el-package--show-only 'built-in)) + (and upgrade-p + (eq helm-el-package--show-only 'upgrade)) + (and installed-p + (eq helm-el-package--show-only 'installed)) + (and (not installed-p) + (not built-in-p) + (eq helm-el-package--show-only 'uninstalled)) + (eq helm-el-package--show-only 'all)) + collect cand)) + +(defun helm-el-package-show-built-in () + (interactive) + (with-helm-alive-p + (setq helm-el-package--show-only 'built-in) + (helm-update))) +(put 'helm-el-package-show-built-in 'helm-only t) + +(defun helm-el-package-show-upgrade () + (interactive) + (with-helm-alive-p + (setq helm-el-package--show-only 'upgrade) + (helm-update))) +(put 'helm-el-package-show-upgrade 'helm-only t) + +(defun helm-el-package-show-installed () + (interactive) + (with-helm-alive-p + (setq helm-el-package--show-only 'installed) + (helm-update))) +(put 'helm-el-package-show-installed 'helm-only t) + +(defun helm-el-package-show-all () + (interactive) + (with-helm-alive-p + (setq helm-el-package--show-only 'all) + (helm-update))) +(put 'helm-el-package-show-all 'helm-only t) + +(defun helm-el-package-show-uninstalled () + (interactive) + (with-helm-alive-p + (setq helm-el-package--show-only 'uninstalled) + (helm-update))) +(put 'helm-el-package-show-uninstalled 'helm-only t) + +(defvar helm-el-package-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-I") 'helm-el-package-show-installed) + (define-key map (kbd "M-O") 'helm-el-package-show-uninstalled) + (define-key map (kbd "M-U") 'helm-el-package-show-upgrade) + (define-key map (kbd "M-B") 'helm-el-package-show-built-in) + (define-key map (kbd "M-A") 'helm-el-package-show-all) + (define-key map (kbd "C-c i") 'helm-el-run-package-install) + (define-key map (kbd "C-c r") 'helm-el-run-package-reinstall) + (define-key map (kbd "C-c d") 'helm-el-run-package-uninstall) + (define-key map (kbd "C-c u") 'helm-el-run-package-upgrade) + (define-key map (kbd "C-c U") 'helm-el-run-package-upgrade-all) + (define-key map (kbd "C-c @") 'helm-el-run-visit-homepage) + map)) + +(defvar helm-source-list-el-package nil) +(defclass helm-list-el-package-source (helm-source-in-buffer) + ((init :initform 'helm-el-package--init) + (get-line :initform 'buffer-substring) + (filtered-candidate-transformer :initform 'helm-el-package--transformer) + (action-transformer :initform 'helm-el-package--action-transformer) + (help-message :initform 'helm-el-package-help-message) + (keymap :initform helm-el-package-map) + (update :initform 'helm-el-package--update) + (candidate-number-limit :initform 9999) + (action :initform '(("Describe package" . helm-el-package-describe) + ("Visit homepage" . helm-el-package-visit-homepage))))) + +(defun helm-el-package--action-transformer (actions candidate) + (let* ((pkg-desc (get-text-property 0 'tabulated-list-id candidate)) + (status (package-desc-status pkg-desc)) + (pkg-name (package-desc-name pkg-desc)) + (built-in (and (package-built-in-p pkg-name) + (not (member status '("available" "new" + "installed" "dependency"))))) + (acts (if helm-el-package--upgrades + (append actions '(("Upgrade all packages" + . helm-el-package-upgrade-all-action))) + actions))) + (cond (built-in '(("Describe package" . helm-el-package-describe))) + ((and (package-installed-p pkg-name) + (cdr (assq pkg-name helm-el-package--upgrades))) + (append '(("Upgrade package(s)" . helm-el-package-upgrade) + ("Uninstall package(s)" . helm-el-package-uninstall)) acts)) + ((and (package-installed-p pkg-name) + (or (null (package-built-in-p pkg-name)) + (and (package-built-in-p pkg-name) + (assq pkg-name package-alist)))) + (append acts '(("Reinstall package(s)" . helm-el-package-reinstall) + ("Recompile package(s)" . helm-el-package-recompile) + ("Uninstall package(s)" . helm-el-package-uninstall)))) + (t (append acts '(("Install packages(s)" . helm-el-package-install))))))) + +(defun helm-el-package--update () + (setq helm-el-package--initialized-p nil)) + +(defun helm-el-package-recompile (_pkg) + (cl-loop for p in (helm-marked-candidates) + for pkg-desc = (get-text-property 0 'tabulated-list-id p) + for name = (package-desc-name pkg-desc) + for dir = (package-desc-dir pkg-desc) + do (if (fboundp 'async-byte-recompile-directory) + (async-byte-recompile-directory dir) + (when (y-or-n-p (format "Really recompile `%s' while already loaded ?" name)) + (byte-recompile-directory dir 0 t))))) + +(defun helm-el-package-reinstall (_pkg) + (cl-loop for p in (helm-marked-candidates) + for pkg-desc = (get-text-property 0 'tabulated-list-id p) + for name = (package-desc-name pkg-desc) + do (if (boundp 'package-selected-packages) + (with-no-warnings + (package-delete pkg-desc 'force 'nosave) + ;; pkg-desc contain the description + ;; of the installed package just removed + ;; and is BTW no more valid. + ;; Use the entry in package-archive-content + ;; which is the non--installed package entry. + ;; For some reason `package-install' + ;; need a pkg-desc (package-desc-p) for the build-in + ;; packages already installed, the name (as symbol) + ;; fails with such packages. + (package-install + (cadr (assq name package-archive-contents)) t)) + (package-delete pkg-desc) + (package-install name)))) + +(defun helm-el-run-package-reinstall () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-el-package-reinstall))) +(put 'helm-el-run-package-reinstall 'helm-only t) + +;;;###autoload +(defun helm-list-elisp-packages (arg) + "Preconfigured helm for listing and handling emacs packages." + (interactive "P") + (when arg (setq helm-el-package--initialized-p nil)) + (unless helm-source-list-el-package + (setq helm-source-list-el-package + (helm-make-source "list packages" 'helm-list-el-package-source))) + (helm :sources 'helm-source-list-el-package + :buffer "*helm list packages*")) + +;;;###autoload +(defun helm-list-elisp-packages-no-fetch () + "Preconfigured helm for emacs packages. +Same as `helm-list-elisp-packages' but don't fetch packages on remote." + (interactive) + (let ((helm-el-package--initialized-p t)) + (helm-list-elisp-packages nil))) + +(provide 'helm-elisp-package) + +;;; helm-elisp-package.el ends here diff --git a/helm-elisp.el b/helm-elisp.el new file mode 100644 index 00000000..ddefa630 --- /dev/null +++ b/helm-elisp.el @@ -0,0 +1,948 @@ +;;; helm-elisp.el --- Elisp symbols completion for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-types) +(require 'helm-utils) +(require 'helm-info) +(require 'helm-eval) +(require 'helm-files) +(require 'advice) + +(declare-function 'helm-describe-function "helm-lib") +(declare-function 'helm-describe-variable "helm-lib") +(declare-function 'helm-describe-face "helm-lib") + + +;;; 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 buffer while moving selection when non--nil." + :group 'helm-elisp + :type 'boolean) + +(defcustom helm-show-completion-use-special-display t + "A special display will be used in Lisp completion if non--nil. +All functions that are wrapped in macro `with-helm-show-completion' +will be affected." + :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 enable 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))) + + +;;; 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 (:background "DarkSlateGray"))) + "Face used for showing candidates in `helm-lisp-completion'." + :group 'helm-elisp-faces) + +(defface helm-lisp-completion-info + '((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 + (overlay-put helm-show-completion-overlay + 'display (substring-no-properties + (helm-get-selection))))) + +(defun helm-show-completion-init-overlay (beg end) + (when (and helm-turn-on-show-completion 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-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 just do nothing." + (declare (indent 2) (debug t)) + `(let ((helm-move-selection-after-hook + (and helm-turn-on-show-completion + (append (list 'helm-show-completion) + helm-move-selection-after-hook))) + (helm-always-two-windows t) + (helm-split-window-default-side + (if (eq helm-split-window-default-side 'same) + 'below helm-split-window-default-side)) + helm-split-window-in-side-p + helm-reuse-last-window-split-state) + (helm-set-local-variable + 'helm-display-function + (if helm-show-completion-use-special-display + 'helm-show-completion-display-function + 'helm-default-display-buffer)) + (unwind-protect + (progn + (helm-show-completion-init-overlay ,beg ,end) + ,@body) + (when (and helm-turn-on-show-completion + 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 " " (point-at-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) + (if (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 " " (point-at-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))) + #'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 (point-at-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)))) + +(defvar helm-lisp-completion--cache nil) +(defvar helm-lgst-len nil) +;;;###autoload +(defun helm-lisp-completion-at-point () + "Preconfigured helm for lisp symbol completion at point." + (interactive) + (setq helm-lgst-len 0) + (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))) + (loc-vars (and (fboundp 'elisp--local-variables) + (ignore-errors + (mapcar #'symbol-name (elisp--local-variables))))) + (glob-syms (and target pred (all-completions target obarray pred))) + (candidates (append loc-vars glob-syms)) + (helm-quit-if-no-candidate t) + (helm-execute-action-at-once-if-one t) + (enable-recursive-minibuffers t)) + (setq helm-lisp-completion--cache (cl-loop for sym in candidates + for len = (length sym) + when (> len helm-lgst-len) + do (setq helm-lgst-len len) + collect sym)) + (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 helm-lisp-completion--cache + :persistent-action 'helm-lisp-completion-persistent-action + :nomark t + :match-part (lambda (c) (car (split-string c))) + :fuzzy-match helm-lisp-fuzzy-completion + :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 (if helm-lisp-fuzzy-completion + target (concat target " ")) + :resume 'noresume + :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) + (let ((sym (intern-soft candidate))) + (cl-typecase sym + ((and fboundp boundp) + (if (member name '("describe-function" "describe-variable")) + (funcall (intern (format "helm-%s" name)) sym) + ;; When there is no way to know what to describe + ;; prefer describe-function. + (helm-describe-function sym))) + (fbound (helm-describe-function sym)) + (bound (helm-describe-variable sym)) + (face (helm-describe-face sym))))) + +(defun helm-elisp-show-help (candidate &optional name) + "Show full help for the function CANDIDATE. +Arg NAME specify the name of the top level function +calling helm generic completion (e.g \"describe-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 modeline." + (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 = (intern c) + for annot = (cl-typecase sym + (command " (Com)") + (class " (Class)") + (generic " (Gen)") + (fbound " (Fun)") + (bound " (Var)") + (face " (Face)")) + for spaces = (make-string (- helm-lgst-len (length c)) ? ) + collect (cons (concat c spaces annot) c) into lst + finally return (sort lst #'helm-generic-sort-fn))) + +(defun helm-get-first-line-documentation (sym &optional name) + "Return first line documentation of symbol SYM. +If SYM is not documented, return \"Not documented\"." + (let ((doc (cl-typecase sym + ((and fboundp boundp) + (cond ((string= name "describe-function") + (documentation sym t)) + ((string= name "describe-variable") + (documentation-property sym 'variable-documentation t)) + (t (documentation sym t)))) + (fbound (documentation sym t)) + (bound (documentation-property sym 'variable-documentation t)) + (face (face-documentation sym))))) + (if (and doc (not (string= doc "")) + ;; `documentation' return "\n\n(args...)" + ;; for CL-style functions. + (not (string-match-p "^\n\n" doc))) + (car (split-string doc "\n")) + "Not documented"))) + +;;; 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 (thing-at-point 'filename)) + beg + (init (and tap + (or force + (save-excursion + (end-of-line) + (search-backward tap (point-at-bol) t) + (setq beg (point)) + (looking-back "[^'`( ]" (1- (point))))) + (expand-file-name + (substring-no-properties 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))))) + +;;;###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))) + +;;;###autoload +(defun helm-lisp-completion-or-file-name-at-point () + "Preconfigured helm to complete lisp symbol or filename at point. +Filename completion happen if string start after or between a double quote." + (interactive) + (let* ((tap (thing-at-point 'filename))) + (if (and tap (save-excursion + (end-of-line) + (search-backward tap (point-at-bol) t) + (looking-back "[^'`( ]" (1- (point))))) + (helm-complete-file-name-at-point) + (helm-lisp-completion-at-point)))) + + +;;; Apropos +;; +;; +(defvar helm-apropos-history nil) + +(defun helm-apropos-init (test default) + "Init candidates buffer for `helm-apropos' sources." + (require 'helm-help) + (helm-init-candidates-in-buffer 'global + (let ((default-symbol (and (stringp default) + (intern-soft default))) + (symbols (all-completions "" obarray test))) + (if (and default-symbol (funcall test default-symbol)) + (cons default-symbol symbols) + symbols)))) + +(defun helm-apropos-init-faces (default) + "Init candidates buffer for faces for `helm-apropos'." + (require 'helm-help) + (with-current-buffer (helm-candidate-buffer 'global) + (goto-char (point-min)) + (let ((default-symbol (and (stringp default) + (intern-soft default))) + (faces (face-list))) + (when (and default-symbol (facep default-symbol)) + (insert (concat default "\n"))) + (insert + (mapconcat #'prin1-to-string + (if default + (cl-remove-if (lambda (sym) (string= sym default)) faces) + faces) + "\n"))))) + +(defun helm-apropos-default-sort-fn (candidates _source) + (if (string= helm-pattern "") + candidates + (sort candidates #'helm-generic-sort-fn))) + +(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)))) default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :nomark t + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-variable)) + :persistent-help "Describe variable" + :action '(("Describe variable" . helm-describe-variable) + ("Find variable" . helm-find-variable) + ("Info lookup" . helm-info-lookup-symbol) + ("Set variable" . helm-set-variable)) + :action-transformer + (lambda (actions candidate) + (let ((sym (helm-symbolify candidate))) + (if (custom-variable-p sym) + (append + actions + (let ((standard-value (eval (car (get sym 'standard-value))))) + (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)))))) + actions))))) + +(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-faces default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer + (append (and (null helm-apropos-fuzzy-match) + '(helm-apropos-default-sort-fn)) + (list + (lambda (candidates _source) + (cl-loop for c in candidates + collect (propertize c 'face (intern c)))))) + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-face)) + :persistent-help "Describe face" + :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) + (helm-build-in-buffer-source "Commands" + :init (lambda () + (helm-apropos-init 'commandp default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :nomark t + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-function)) + :persistent-help "Describe command" + :action '(("Describe function" . helm-describe-function) + ("Find function" . helm-find-function) + ("Info lookup" . helm-info-lookup-symbol)))) + +(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 (generic-p x)) + (not (class-p x)))) + default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-function)) + :persistent-help "Describe function" + :nomark t + :action '(("Describe function" . helm-describe-function) + ("Find function" . helm-find-function) + ("Info lookup" . helm-info-lookup-symbol)))) + +(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 (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :nomark t + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-function)) + :persistent-help "Describe class" + :action '(("Describe function" . helm-describe-function) + ("Find function" . 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) + (generic-p x)) + default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :nomark t + :persistent-action (lambda (candidate) + (helm-elisp--persistent-help + candidate 'helm-describe-function)) + :persistent-help "Describe generic function" + :action '(("Describe function" . helm-describe-function) + ("Find function" . helm-find-function) + ("Info lookup" . helm-info-lookup-symbol)))) + +(defun helm-info-lookup-fallback-source (candidate) + (let ((sym (helm-symbolify candidate)) + src-name fn) + (cond ((class-p sym) + (setq fn #'helm-describe-function + src-name "Describe class")) + ((generic-p sym) + (setq fn #'helm-describe-function + src-name "Describe generic function")) + ((fboundp sym) + (setq fn #'helm-describe-function + src-name "Describe function")) + ((facep sym) + (setq fn #'helm-describe-face + src-name "Describe face")) + (t + (setq fn #'helm-describe-variable + src-name "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 c))) + +(defun helm-info-lookup-symbol (candidate) + ;; Running an idle-timer allow not catching RET + ;; when exiting with the fallback source. + (run-with-idle-timer 0.01 nil #'helm-info-lookup-symbol-1 candidate)) + +(defun helm-elisp--persistent-help (candidate fun &optional name) + (let ((hbuf (get-buffer (help-buffer)))) + (cond ((helm-follow-mode-p) + (if name + (funcall fun candidate name) + (funcall fun candidate))) + ((or (and (helm-attr 'help-running-p) + (string= candidate (helm-attr 'help-current-symbol)))) + (progn + ;; When started from a help buffer, + ;; Don't kill this buffer as it is helm-current-buffer. + (unless (equal hbuf helm-current-buffer) + (kill-buffer hbuf) + (set-window-buffer (get-buffer-window hbuf) + helm-current-buffer)) + (helm-attrset 'help-running-p nil))) + (t + (if name + (funcall fun candidate name) + (funcall fun candidate)) + (helm-attrset 'help-running-p t))) + (helm-attrset 'help-current-symbol candidate))) + +;;;###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 (thing-at-point 'symbol))) + (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) "\\_>")))) + + +;;; Advices +;; +;; +(defvar helm-source-advice + (helm-build-sync-source "Function Advice" + :candidates 'helm-advice-candidates + :action (helm-make-actions "Toggle Enable/Disable" 'helm-advice-toggle) + :persistent-action 'helm-advice-persistent-action + :nomark t + :multiline t + :persistent-help "Describe function / C-u C-j: Toggle advice")) + +(defun helm-advice-candidates () + (cl-loop for (fname) in ad-advised-functions + for function = (intern fname) + append + (cl-loop for class in ad-advice-classes append + (cl-loop for advice in (ad-get-advice-info-field function class) + for enabled = (ad-advice-enabled advice) + collect + (cons (format + "%s %s %s" + (if enabled "Enabled " "Disabled") + (propertize fname 'face 'font-lock-function-name-face) + (ad-make-single-advice-docstring advice class nil)) + (list function class advice)))))) + +(defun helm-advice-persistent-action (func-class-advice) + (if current-prefix-arg + (helm-advice-toggle func-class-advice) + (describe-function (car func-class-advice)))) + +(defun helm-advice-toggle (func-class-advice) + (cl-destructuring-bind (function _class advice) func-class-advice + (cond ((ad-advice-enabled advice) + (ad-advice-set-enabled advice nil) + (message "Disabled")) + (t + (ad-advice-set-enabled advice t) + (message "Enabled"))) + (ad-activate function) + (and helm-in-persistent-action + (helm-advice-update-current-display-string)))) + +(defun helm-advice-update-current-display-string () + (helm-edit-current-selection + (let ((newword (cond ((looking-at "Disabled") "Enabled") + ((looking-at "Enabled") "Disabled")))) + (when newword + (delete-region (point) (progn (forward-word 1) (point))) + (insert newword))))) + +;;;###autoload +(defun helm-manage-advice () + "Preconfigured `helm' to disable/enable function advices." + (interactive) + (helm-other-buffer 'helm-source-advice "*helm advice*")) + + +;;; Locate elisp library +;; +;; +(defun helm-locate-library-scan-list () + (cl-loop for dir in load-path + with load-suffixes = '(".el") + when (file-directory-p dir) + append (directory-files + dir t (concat (regexp-opt (get-load-suffixes)) + "\\'")))) + +;;;###autoload +(defun helm-locate-library () + "Preconfigured helm to locate elisp libraries." + (interactive) + (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 + :search (unless helm-locate-library-fuzzy-match + (lambda (regexp) + (re-search-forward + (if helm-ff-transformer-show-only-basename + (replace-regexp-in-string + "\\`\\^" "" regexp) + regexp) + nil t))) + :match-part (lambda (candidate) + (if helm-ff-transformer-show-only-basename + (helm-basename candidate) candidate)) + :filter-one-by-one (lambda (c) + (if helm-ff-transformer-show-only-basename + (cons (helm-basename c) c) c)) + :action (helm-actions-from-type-file)) + :buffer "*helm locate library*")) + +(defun helm-set-variable (var) + "Set value to VAR interactively." + (let* ((sym (helm-symbolify var)) + (val (default-value sym))) + (set-default sym (eval-minibuffer (format "Set `%s': " var) + (if (or (stringp val) (memq val '(nil t))) + (prin1-to-string val) + (format "'%s" (prin1-to-string val))))))) + + +;;; 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-time-string "idle-for=%5s" 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 +;; +;; +(defun helm-btf--usable-p () + "Return t if current version of `backtrace-frame' accept 2 arguments." + (condition-case nil + (progn (backtrace-frame 1 'condition-case) t) + (wrong-number-of-arguments nil))) + +(if (helm-btf--usable-p) ; Check if BTF accept more than one arg. + ;; Emacs 24.4. + (dont-compile + (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))) + (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))) + ;; Emacs 24.3 + (defun helm-sexp-eval (cand) + (let ((sexp (read cand))) + (condition-case err + (if (> (length (remove nil sexp)) 1) + (eval sexp) + (apply 'call-interactively sexp)) + (error (message "Evaluating gave an error: %S" err) + nil))))) + +(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) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-elisp.el ends here diff --git a/helm-elscreen.el b/helm-elscreen.el new file mode 100644 index 00000000..44ac52cd --- /dev/null +++ b/helm-elscreen.el @@ -0,0 +1,102 @@ +;;; helm-elscreen.el -- Elscreen support -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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) + +(declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create)) +(declare-function elscreen-find-file "ext:elscreen.el" (filename)) +(declare-function elscreen-goto "ext:elscreen.el" (screen)) +(declare-function elscreen-get-conf-list "ext:elscreen.el" (type)) + +(defun helm-find-buffer-on-elscreen (candidate) + "Open buffer in new screen, if marked buffers open all in elscreens." + (helm-require-or-error 'elscreen 'helm-find-buffer-on-elscreen) + (helm-aif (helm-marked-candidates) + (cl-dolist (i it) + (let ((target-screen (elscreen-find-screen-by-buffer + (get-buffer i) 'create))) + (elscreen-goto target-screen))) + (let ((target-screen (elscreen-find-screen-by-buffer + (get-buffer candidate) 'create))) + (elscreen-goto target-screen)))) + +(defun helm-elscreen-find-file (file) + (helm-require-or-error 'elscreen 'helm-elscreen-find-file) + (elscreen-find-file file)) + +(defclass helm-source-elscreen (helm-source-sync) + ((candidates + :initform + (lambda () + (when (cdr (elscreen-get-screen-to-name-alist)) + (cl-sort (cl-loop for (screen . name) in (elscreen-get-screen-to-name-alist) + collect (cons (format "[%d] %s" screen name) screen)) + #'< :key #'cdr)))) + (action :initform + '(("Change Screen" . + (lambda (candidate) + (elscreen-goto candidate))) + ("Kill Screen(s)" . + (lambda (_) + (cl-dolist (i (helm-marked-candidates)) + (elscreen-goto i) + (elscreen-kill)))) + ("Only Screen" . + (lambda (candidate) + (elscreen-goto candidate) + (elscreen-kill-others))))) + (migemo :initform t))) + +(defclass helm-source-elscreen-history (helm-source-elscreen) + ((candidates + :initform + (lambda () + (let ((sname (elscreen-get-screen-to-name-alist))) + (when (cdr sname) + (cl-loop for screen in (cdr (elscreen-get-conf-list 'screen-history)) + collect (cons (format "[%d] %s" screen (cdr (assq screen sname))) + screen)))))))) + +(defvar helm-source-elscreen-list + (helm-make-source "ElScreen" 'helm-source-elscreen)) + +(defvar helm-source-elscreen-history-list + (helm-make-source "ElScreen History" 'helm-source-elscreen-history)) + +;;;###autoload +(defun helm-elscreen () + "Preconfigured helm to list elscreen." + (interactive) + (helm-other-buffer 'helm-source-elscreen-list "*Helm ElScreen*")) + +;;;###autoload +(defun helm-elscreen-history () + "Preconfigured helm to list elscreen in history order." + (interactive) + (helm-other-buffer 'helm-source-elscreen-history-list "*Helm ElScreen*")) + +(provide 'helm-elscreen) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-elscreen.el ends here diff --git a/helm-eshell.el b/helm-eshell.el new file mode 100644 index 00000000..5dc0788b --- /dev/null +++ b/helm-eshell.el @@ -0,0 +1,272 @@ +;;; helm-eshell.el --- pcomplete and eshell completion for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-p") '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") + + +(defgroup helm-eshell nil + "Helm eshell completion and history." + :group 'helm) + + +(defcustom helm-eshell-fuzzy-match nil + "Enable fuzzy matching in `helm-esh-pcomplete' when non--nil." + :group 'helm-eshell + :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'.") + + +(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 + (lambda (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)))) + (action :initform 'helm-ec-insert)) + "Helm class to define source for Eshell completion.") + +;; 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." + (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 "*")) + (cond ((string-match "\\`~/?" helm-ec-target) + (insert (helm-quote-whitespace (abbreviate-file-name candidate)))) + ((string-match "\\`/" helm-ec-target) + (insert (helm-quote-whitespace candidate))) + (t + (insert (concat (and (string-match "\\`[.]/" helm-ec-target) "./") + (helm-quote-whitespace + (file-relative-name candidate))))))) + +(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))) + for i in (all-completions pcomplete-stub table) + ;; Transform the related names to abs names. + for file-cand = (and exp-entry + (if (file-remote-p i) i + (expand-file-name + i (file-name-directory 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) + collect (eshell-get-history c))))) + (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.") + + +;;;###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))) + (first (car args)) ; Maybe lisp delimiter "(". + last ; Will be the last but parsed by pcomplete. + del-space) + (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)))) + (cond ((eq first ?\() + (helm-lisp-completion-or-file-name-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)))))) + (with-helm-show-completion beg end + (or (helm :sources (helm-make-source "Eshell completions" 'helm-esh-source + :fuzzy-match helm-eshell-fuzzy-match) + :buffer "*helm pcomplete*" + :keymap helm-esh-completion-map + :resume 'noresume + :input (and (stringp last) + (helm-ff-set-pattern last))) + (and del-space (looking-back "\\s-" (1- (point))) + (delete-char -1)))))))) + +;;;###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) + :buffer "*helm eshell history*" + :resume 'noresume + :input input)) + (when (and flag-empty + (looking-back " " (1- (point)))) + (delete-char -1))))) + +(provide 'helm-eshell) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-eshell ends here diff --git a/helm-eval.el b/helm-eval.el new file mode 100644 index 00000000..21594390 --- /dev/null +++ b/helm-eval.el @@ -0,0 +1,204 @@ +;;; helm-eval.el --- eval expressions from helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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) + + +(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)) + +(defun helm-build-evaluation-result-source () + (helm-build-dummy-source "Evaluation Result" + :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))))) + (error "Error")))) + :nohighlight t + :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))) + +(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* ((sym (save-excursion + (unless (looking-back ")\\|\"" (1- (point))) + (forward-char -1)) + (eldoc-current-symbol))) + (info-fn (eldoc-fnsym-in-current-sexp)) + (doc (or (eldoc-get-var-docstring sym) + (eldoc-get-fnsym-args-string + (car info-fn) (cadr info-fn))))) + (when doc (funcall helm-eldoc-in-minibuffer-show-fn doc))))) + (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-current-buffer helm-buffer + (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 nil + (calc-eval helm-pattern) + (error "error")))) + :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") + (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 + :keymap helm-eval-expression-map)) + +(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) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-eval.el ends here diff --git a/helm-external.el b/helm-external.el new file mode 100644 index 00000000..899b2d4b --- /dev/null +++ b/helm-external.el @@ -0,0 +1,213 @@ +;;; helm-external.el --- Run Externals commands within Emacs with helm completion. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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) + + +(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 external file browser +or do not want to use it. +Windows users should set that to \"explorer.exe\"." + :group 'helm-external + :type 'string) + + +;;; 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) + "Returns 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'." + (helm-aif helm-external-commands-list + it + (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 file) + "Generic command that run asynchronously EXE. +If EXE is already running just jump to his window if `helm-raise-command' +is non--nil. +When FILE argument is provided run EXE with FILE." + (let* ((real-com (car (split-string exe))) + (proc (if file (concat real-com " " file) real-com)) + process-connection-type) + (if (get-process proc) + (if helm-raise-command + (shell-command (format helm-raise-command real-com)) + (error "Error: %s is already running" real-com)) + (when (member real-com helm-external-commands-list) + (message "Starting %s..." real-com) + (if file + (start-process-shell-command + proc nil (format "%s %s" + real-com + (shell-quote-argument + (if (eq system-type 'windows-nt) + (helm-w32-prepare-filename file) + file)))) + (start-process-shell-command proc nil real-com)) + (set-process-sentinel + (get-process proc) + (lambda (process event) + (when (and (string= event "finished\n") + helm-raise-command + (not (helm-get-pid-from-process-name real-com))) + (shell-command (format helm-raise-command "emacs"))) + (message "%s process...Finished." process)))) + (setq helm-external-commands-list + (cons real-com + (delete real-com 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* ((fname (expand-file-name file)) + (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" + :del-input nil + :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 file) + (setq helm-external-command-history + (cons program + (delete program + (cl-loop for i in helm-external-command-history + when (executable-find i) collect i)))))) + +;;;###autoload +(defun helm-run-external-command (program) + "Preconfigured `helm' to run External PROGRAM asyncronously from Emacs. +If program is already running exit with error. +You can set your own list of commands with +`helm-external-commands-list'." + (interactive (list + (helm-comp-read + "RunProgram: " + (helm-external-commands-list-1 'sort) + :must-match t + :del-input nil + :name "External Commands" + :history helm-external-command-history))) + (helm-run-or-raise program) + (setq helm-external-command-history + (cons program (delete program + (cl-loop for i in helm-external-command-history + when (executable-find i) collect i))))) + + +(provide 'helm-external) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-external ends here diff --git a/helm-files.el b/helm-files.el new file mode 100644 index 00000000..61d65ce9 --- /dev/null +++ b/helm-files.el @@ -0,0 +1,3778 @@ +;;; helm-files.el --- helm file browser and related. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-external) +(require 'helm-grep) +(require 'helm-help) +(require 'helm-locate) +(require 'helm-bookmark) +(require 'helm-tags) +(require 'helm-buffers) +(require 'thingatpt) +(require 'ffap) +(require 'dired-aux) +(require 'dired-x) +(require 'tramp) +(require 'image-dired) + +(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 image-dired-display-image "image-dired.el" (file &optional original-size)) +(declare-function image-dired-update-property "image-dired.el" (prop value)) +(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-quote-argument "esh-arg.el") +(declare-function helm-ls-git-ls "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-ls-svn-ls "ext:helm-ls-svn") + +(defvar recentf-list) +(defvar helm-mm-matching-method) +(defvar dired-async-mode) + + +(defgroup helm-files nil + "Files applications and libraries for Helm." + :group 'helm) + +(defcustom helm-boring-file-regexp-list + (mapcar (lambda (f) + (concat + (rx-to-string + (replace-regexp-in-string + "/$" "" f) t) "$")) + completion-ignored-extensions) + "The regexp list matching boring files." + :group 'helm-files + :type '(repeat (choice regexp))) + +(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 to find files." + :type '(repeat (choice symbol)) + :group 'helm-files) + +(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 + :group 'helm-files) + +(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 because +it prevent using to delete char backward and by the way +confuse beginners. +For a better experience with `helm-find-files' set this to non--nil +and use C- to toggle it." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-lynx-style-map t + "Use arrow keys to navigate with `helm-find-files'. +You will have to restart Emacs or reeval `helm-find-files-map' +and `helm-read-file-map' for this take effect." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-history-max-length 100 + "Number of elements shown in `helm-find-files' history." + :group 'helm-files + :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." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-tramp-not-fancy t + "No colors when listing remote files when set to non--nil. +This make listing much faster, specially on slow machines." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-exif-data-program "exiftran" + "Program used to extract exif data of an image file." + :group 'helm-files + :type 'string) + +(defcustom helm-ff-exif-data-program-args "-d" + "Arguments used for `helm-ff-exif-data-program'." + :group 'helm-files + :type 'string) + +(defcustom helm-ff-newfile-prompt-p t + "Whether Prompt or not when creating new file. +This set `ffap-newfile-prompt'." + :type 'boolean + :group 'helm-files) + +(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 + :group 'helm-files) + +(defcustom helm-ff-file-compressed-list '("gz" "bz2" "zip" "7z") + "Minimal list of compressed files extension." + :type '(repeat (choice string)) + :group 'helm-files) + +(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)) + :group 'helm-files) + +(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]." + :type 'boolean + :group 'helm-files) + +(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." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-search-library-in-sexp nil + "Search for library in `require' and `declare-function' sexp." + :group 'helm-files + :type 'boolean) + +(defcustom helm-tooltip-hide-delay 25 + "Hide tooltips automatically after this many seconds." + :group 'helm-files + :type 'integer) + +(defcustom helm-ff-file-name-history-use-recentf nil + "Use `recentf-list' instead of `file-name-history' in `helm-find-files'." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-skip-boring-files nil + "Non--nil to skip files matching regexps in `helm-boring-file-regexp-list'. +This take effect in `helm-find-files' and file completion used by `helm-mode' +i.e `helm-read-file-name'." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-candidate-number-limit 5000 + "The `helm-candidate-number-limit' for `helm-find-files', `read-file-name' and friends." + :group 'helm-files + :type 'integer) + +(defcustom helm-findutils-skip-boring-files t + "Ignore files matching regexps in `completion-ignored-extensions'." + :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-files-save-history-extra-sources + '("Find" "Locate" "Recentf" + "Files from Current Directory" "File Cache") + "Extras source that save candidate to `file-name-history'." + :group 'helm-files + :type '(repeat (choice string))) + +(defcustom helm-find-files-before-init-hook nil + "Hook that run before initialization of `helm-find-files'." + :group 'helm-files + :type 'hook) + +(defcustom helm-find-files-after-init-hook nil + "Hook that run after initialization of `helm-find-files'." + :group 'helm-files + :type 'hook) + +(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-find-files-bookmark-prefix "Helm-find-files: " + "bookmark name prefix of `helm-find-files' sessions." + :group 'helm-files + :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." + :group 'helm-files + :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." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-no-preselect nil + "When non--nil `helm-find-files' starts at root of current directory." + :group 'helm-files + :type 'boolean) + +(defcustom helm-find-file-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'." + :group 'helm-files + :type 'boolean) + +(defcustom helm-substitute-in-filename-stay-on-remote nil + "Don't switch back to local filesystem when expanding pattern with / or ~/." + :group 'helm-files + :type 'boolean) + + +;;; 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 (: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 (:foreground "green"))) + "Face used for executable files in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-directory + '((t (:foreground "DarkRed" :background "LightGray"))) + "Face used for directories in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-dotted-directory + '((t (:foreground "black" :background "DimGray"))) + "Face used for dotted directories in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-dotted-symlink-directory + '((t (:foreground "DarkOrange" :background "DimGray"))) + "Face used for dotted symlinked directories in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-symlink + '((t (:foreground "DarkOrange"))) + "Face used for symlinks in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-invalid-symlink + '((t (:foreground "black" :background "red"))) + "Face used for invalid symlinks in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-file + '((t (:inherit font-lock-builtin-face))) + "Face used for file names in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-dirs + '((t (:inherit font-lock-function-name-face))) + "Face used for file names in recursive dirs completion in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-history-deleted + '((t (:inherit helm-ff-invalid-symlink))) + "Face used for deleted files in `file-name-history'." + :group 'helm-files-faces) + +(defface helm-history-remote + '((t (:foreground "Indianred1"))) + "Face used for remote files in `file-name-history'." + :group 'helm-files-faces) + + +;;; 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 "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-toggle-to-bookmark) + (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-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-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 "C-c d") 'helm-ff-persistent-delete) + (define-key map (kbd "M-e") 'helm-ff-run-switch-to-eshell) + (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 X") 'helm-ff-run-open-file-with-default-tool) + (define-key map (kbd "M-!") 'helm-ff-run-eshell-command-on-file) + (define-key map (kbd "M-%") 'helm-ff-run-query-replace-on-marked) + (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-ff-run-switch-to-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-gnus-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) + ;; 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 "C-l") 'helm-find-files-up-one-level) + (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) + (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward + nil nil 'helm-ff-delete-char-backward--exit-fn) + (when helm-ff-lynx-style-map + (define-key map (kbd "") 'helm-find-files-up-one-level) + (define-key map (kbd "") 'helm-execute-persistent-action)) + (delq nil 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 "") '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-r") 'helm-find-files-down-last-level) + (define-key map (kbd "C-c h") 'helm-ff-file-name-history) + (define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update) + (define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update) + (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward + nil nil 'helm-ff-delete-char-backward--exit-fn) + (when helm-ff-lynx-style-map + (define-key map (kbd "") 'helm-find-files-up-one-level) + (define-key map (kbd "") 'helm-execute-persistent-action) + (define-key map (kbd "") 'helm-previous-source) + (define-key map (kbd "") 'helm-next-source)) + (delq nil map)) + "Keymap for `helm-read-file-name'.") + + +;; Internal. +(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-cand-to-mark 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.") +(defvar helm-tramp-file-name-regexp "\\`/\\([^[/:]+\\|[^/]+]\\):") +(defvar helm-marked-buffer-name "*helm marked*") +(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) + + +;;; Helm-find-files +;; +;; +(defcustom helm-find-files-actions + (helm-make-actions + "Find File" 'helm-find-file-or-marked + "Find file in Dired" 'helm-point-file-in-dired + (lambda () (and (locate-library "elscreen") "Find file in Elscreen")) + 'helm-elscreen-find-file + "View file" 'view-file + "Checksum File" 'helm-ff-checksum + "Query replace fnames on marked" 'helm-ff-query-replace-on-marked + "Query replace contents on marked" 'helm-ff-query-replace + "Query replace regexp contents on marked" 'helm-ff-query-replace-regexp + "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" '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 + "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" 'helm-find-files-ag + "Git grep" 'helm-ff-git-grep + "Zgrep File(s) `M-g z, C-u Recurse'" 'helm-ff-zgrep + "Gid" 'helm-ff-gid + "Switch to Eshell `M-e'" 'helm-ff-switch-to-eshell + "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" 'find-alternate-file + "Ediff File `C-c ='" 'helm-find-files-ediff-files + "Ediff Merge File `M-='" 'helm-find-files-ediff-merge-files + "Delete File(s) `M-D'" 'helm-delete-marked-files + "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy + "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename + "Backup files" 'helm-find-files-backup + "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink + "Relsymlink file(s) `C-u to follow'" 'helm-find-files-relsymlink + "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink + "Find file other window `C-c o'" 'helm-find-files-other-window + "Switch to history `M-p'" 'helm-find-files-switch-to-hist + "Find file other frame `C-c C-o'" 'find-file-other-frame + "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'." + :group 'helm-files + :type '(alist :key-type string :value-type function)) + +(defvar helm-source-find-files nil + "The main source to browse files. +Should not be used among other sources.") + +(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))) + (candidates :initform 'helm-find-files-get-candidates) + (filtered-candidate-transformer :initform 'helm-ff-sort-candidates) + (filter-one-by-one :initform 'helm-ff-filter-candidate-one-by-one) + (persistent-action :initform 'helm-find-files-persistent-action) + (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 t) + (keymap :initform helm-find-files-map) + (candidate-number-limit :initform 'helm-ff-candidate-number-limit) + (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))) + +;; 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))) + (helm-find-files-1 fname (if helm-ff-transformer-show-only-basename + (helm-basename presel) + 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 () + "Return value of `default-directory' of buffer in other window. +If there is only one window return the value of currently visited directory +if found in `helm-ff-history' or fallback to `default-directory' +of current buffer." + (with-helm-current-buffer + (let ((num-windows (length (remove (get-buffer-window helm-marked-buffer-name) + (window-list))))) + (expand-file-name + (if (> num-windows 1) + (save-selected-window + (other-window 1) + default-directory) + ;; Using the car of *ff-history allow + ;; staying in the directory visited instead of current. + (or (car-safe helm-ff-history) default-directory)))))) + +(defun helm-ff--count-and-collect-dups (files) + (cl-loop with dups = (make-hash-table :test 'equal) + for f in files + for file = (if (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) + "Generic function for creating actions from `helm-source-find-files'. +ACTION must be an action supported by `helm-dired-action'." + (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo' + (helm-marked-candidates :with-wildcard t))) + (cand (helm-get-selection)) ; Target + (prompt (format "%s %s file(s) to: " + (capitalize (symbol-name action)) + (length ifiles))) + helm-ff--move-to-first-real-candidate + (parg helm-current-prefix-arg) + helm-display-source-at-screen-top ; prevent setting window-start. + helm-ff-auto-update-initial-value + (dest (with-helm-display-marked-candidates + helm-marked-buffer-name + (helm-ff--count-and-collect-dups ifiles) + (with-helm-current-buffer + (helm-read-file-name + prompt + :preselect (unless (cdr ifiles) + (if helm-ff-transformer-show-only-basename + (helm-basename cand) cand)) + :initial-input (helm-dwim-target-directory) + :history (helm-find-files-history :comp-read nil)))))) + (helm-dired-action + dest :files ifiles :action action :follow parg))) + +(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-other-window (_candidate) + "Keep current-buffer and open files in separate windows." + (let* ((files (helm-marked-candidates)) + (buffers (mapcar 'find-file-noselect files))) + (switch-to-buffer-other-window (car buffers)) + (helm-aif (cdr buffers) + (save-selected-window + (cl-loop for buffer in it + do (progn + (select-window (split-window)) + (switch-to-buffer buffer))))))) + +(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 (byte-compile-file fname parg)))) + +(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* ((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 ((cands (cl-loop for file in (helm-marked-candidates :with-wildcard t) + if (or (string= (file-name-extension file) "pdf") + (string= (file-name-extension file) "PDF")) + collect file)) + (helm-pdfgrep-default-function 'helm-pdfgrep-init)) + (when cands + (helm-do-pdfgrep-1 cands)))) + +(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))) + +(defun helm-find-files-switch-to-hist (_candidate) + "Switch to helm-find-files history." + (helm-find-files t)) + +(defvar eshell-command-aliases-list nil) +(defvar helm-eshell-command-on-file-input-history nil) +(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. + +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: +If `eshell' or `eshell-command' have not been run once, +or if you have no eshell aliases `eshell-command-aliases-list' +will not be loaded first time you use this." + (when (or eshell-command-aliases-list + (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? ")) + (and eshell-command-aliases-list (eshell-read-aliases-list)) + (let* ((cand-list (helm-marked-candidates)) + (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)) + (command (helm-comp-read + "Command: " + (cl-loop for (a . c) in eshell-command-aliases-list + when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c)) + collect (propertize a 'help-echo (car c)) into ls + finally return (sort ls 'string<)) + :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 + :input-history + 'helm-eshell-command-on-file-input-history)) + (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)) + + ;; Run eshell-command with ALL marked files as arguments. + ;; This wont work on remote files, because tramp handlers depends + ;; on `default-directory' (limitation). + (let ((mapfiles (mapconcat 'eshell-quote-argument cand-list " "))) + (if (string-match "'%s'\\|\"%s\"\\|%s" command) + (setq cmd-line (format command mapfiles)) ; See [1] + (setq cmd-line (format "%s %s" command mapfiles))) + (helm-log "%S" cmd-line) + (eshell-command cmd-line)) + + ;; Run eshell-command 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'. + (cl-loop for f in cand-list + for dir = (and (not (string-match ffap-url-regexp f)) + (helm-basedir f)) + for file = (eshell-quote-argument + (format "%s" (if (and dir (file-remote-p dir)) + (helm-basename f) f))) + for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command) + ;; [1] This allow to enter other args AFTER filename + ;; i.e + (format command file) + (format "%s %s" command file)) + do (let ((default-directory (or dir default-directory))) + (eshell-command com))))))) + +(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-switch-to-eshell (_candidate) + "Switch to eshell and cd to `helm-ff-default-directory'." + (let ((cd-eshell (lambda () + (eshell/cd helm-ff-default-directory) + (eshell-reset)))) + (if (get-buffer "*eshell*") + (switch-to-buffer "*eshell*") + (call-interactively 'eshell)) + (unless (get-buffer-process (current-buffer)) + (funcall cd-eshell)))) + +(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)))) + (str (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 = (concat (helm-basedir old) + (replace-regexp-in-string + (cond ((string= regexp "%.") + (helm-basename old t)) + ((string= regexp ".%") + (file-name-extension old)) + ((string= regexp "%") + (helm-basename old)) + (t regexp)) + (save-match-data + (cond ((string-match "\\\\#" str) + (replace-match + (format "%03d" (1+ count)) t t str)) + ((string= str "%u") #'upcase) + ((string= str "%d") #'downcase) + ((string= str "%c") #'capitalize) + (t str))) + (helm-basename old) t)) + ;; 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 "!") + (while (not (member + (setq query + (string + (read-key + (propertize + (format + "Replace `%s' by `%s' [!,y,n,q]" + old new) + 'face 'minibuffer-prompt)))) + '("y" "!" "n" "q"))) + (message "Please answer by y,n,! or q") (sit-for 1))) + (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))) + +;; The action. +(defun helm-ff-query-replace-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'. +(defun helm-ff-run-query-replace-on-marked () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-query-replace-on-marked))) +(put 'helm-ff-run-query-replace-on-marked 'helm-only t) + +(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))) + +(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))) + +(defun helm-ff-run-query-replace () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-query-replace))) +(put 'helm-ff-run-query-replace 'helm-only t) + +(defun helm-ff-run-query-replace-regexp () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-query-replace-regexp))) +(put 'helm-ff-run-query-replace-regexp 'helm-only t) + +(defun helm-ff-toggle-auto-update (_candidate) + (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-attrset 'toggle-auto-update '(helm-ff-toggle-auto-update . never-split)) + (helm-execute-persistent-action 'toggle-auto-update))) +(put 'helm-ff-run-toggle-auto-update 'helm-only t) + +(defun helm-ff-delete-char-backward () + "Disable helm find files auto update and delete char backward." + (interactive) + (with-helm-alive-p + (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"))))) +(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)) + +(defun helm-ff-run-switch-to-history () + "Run Switch to history action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (when (helm-file-completion-source-p) + (helm-exit-and-execute-action 'helm-find-files-switch-to-hist)))) +(put 'helm-ff-run-switch-to-history 'helm-only t) + +(defun helm-ff-run-grep () + "Run Grep action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-grep))) +(put 'helm-ff-run-grep 'helm-only t) + +(defun helm-ff-run-git-grep () + "Run git-grep action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-git-grep))) +(put 'helm-ff-run-git-grep 'helm-only t) + +(defun helm-ff-run-grep-ag () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-ag))) +(put 'helm-ff-run-grep-ag 'helm-only t) + +(defun helm-ff-run-pdfgrep () + "Run Pdfgrep action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-pdfgrep))) +(put 'helm-ff-run-pdfgrep 'helm-only t) + +(defun helm-ff-run-zgrep () + "Run Grep action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-zgrep))) +(put 'helm-ff-run-zgrep 'helm-only t) + +(defun helm-ff-run-copy-file () + "Run Copy file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-copy))) +(put 'helm-ff-run-copy-file 'helm-only t) + +(defun helm-ff-run-rename-file () + "Run Rename file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-rename))) +(put 'helm-ff-run-rename-file 'helm-only t) + +(defun helm-ff-run-byte-compile-file () + "Run Byte compile file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-byte-compile))) +(put 'helm-ff-run-byte-compile-file 'helm-only t) + +(defun helm-ff-run-load-file () + "Run Load file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-load-files))) +(put 'helm-ff-run-load-file 'helm-only t) + +(defun helm-ff-run-eshell-command-on-file () + "Run eshell command on file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action + 'helm-find-files-eshell-command-on-file))) +(put 'helm-ff-run-eshell-command-on-file 'helm-only t) + +(defun helm-ff-run-ediff-file () + "Run Ediff file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-ediff-files))) +(put 'helm-ff-run-ediff-file 'helm-only t) + +(defun helm-ff-run-ediff-merge-file () + "Run Ediff merge file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action + 'helm-find-files-ediff-merge-files))) +(put 'helm-ff-run-ediff-merge-file 'helm-only t) + +(defun helm-ff-run-symlink-file () + "Run Symlink file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-symlink))) +(put 'helm-ff-run-symlink-file 'helm-only t) + +(defun helm-ff-run-hardlink-file () + "Run Hardlink file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-hardlink))) +(put 'helm-ff-run-hardlink-file 'helm-only t) + +(defun helm-ff-run-delete-file () + "Run Delete file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-delete-marked-files))) +(put 'helm-ff-run-delete-file 'helm-only t) + +(defun helm-ff-run-complete-fn-at-point () + "Run complete file name action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action + 'helm-insert-file-name-completion-at-point))) +(put 'helm-ff-run-complete-fn-at-point 'helm-only t) + +(defun helm-ff-run-switch-to-eshell () + "Run switch to eshell action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-switch-to-eshell))) +(put 'helm-ff-run-switch-to-eshell 'helm-only t) + +(defun helm-ff-run-switch-other-window () + "Run switch to other window action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-files-other-window))) +(put 'helm-ff-run-switch-other-window 'helm-only t) + +(defun helm-ff-run-switch-other-frame () + "Run switch to other frame action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'find-file-other-frame))) +(put 'helm-ff-run-switch-other-frame 'helm-only t) + +(defun helm-ff-run-open-file-externally () + "Run open file externally command action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-open-file-externally))) +(put 'helm-ff-run-open-file-externally 'helm-only t) + +(defun helm-ff-run-open-file-with-default-tool () + "Run open file externally command action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-open-file-with-default-tool))) +(put 'helm-ff-run-open-file-with-default-tool 'helm-only t) + +(defun helm-ff-locate (candidate) + "Locate action function for `helm-find-files'." + (helm-locate-set-command) + (let ((input (concat (helm-basename + (expand-file-name + candidate + helm-ff-default-directory)) + ;; The locate '-b' option doesn't exists + ;; in everything (es). + (unless (and (eq system-type 'windows-nt) + (string-match "^es" helm-locate-command)) + " -b")))) + (helm-locate-1 helm-current-prefix-arg nil 'from-ff input))) + +(defun helm-ff-run-locate () + "Run locate action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-locate))) +(put 'helm-ff-run-locate 'helm-only t) + +(defun helm-files-insert-as-org-link (candidate) + (insert (format "[[%s][]]" candidate)) + (goto-char (- (point) 2))) + +(defun helm-ff-run-insert-org-link () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-files-insert-as-org-link))) +(put 'helm-ff-run-insert-org-link 'helm-only t) + +(defun helm-ff-run-find-file-as-root () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-find-file-as-root))) +(put 'helm-ff-run-find-file-as-root 'helm-only t) + +(defun helm-ff-run-find-alternate-file () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'find-alternate-file))) +(put 'helm-ff-run-find-alternate-file 'helm-only t) + +(defun helm-ff-run-gnus-attach-files () + "Run gnus attach files command action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-gnus-attach-files))) +(put 'helm-ff-run-gnus-attach-files 'helm-only t) + +(defun helm-ff-run-etags () + "Run Etags command action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-etags-select))) +(put 'helm-ff-run-etags 'helm-only t) + +(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 (lambda (x) + (format "'%s'" x)) + 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.")))) + +(defun helm-ff-run-print-file () + "Run Print file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-print))) +(put 'helm-ff-run-print-file 'helm-only t) + +(defun helm-ff-checksum (file) + "Calculate the checksum of FILE. +The checksum is copied to kill-ring." + (let ((algo (intern (helm-comp-read + "Algorithm: " + '(md5 sha1 sha224 sha256 sha384 sha512))))) + (kill-new (with-temp-buffer + (insert-file-contents-literally file) + (secure-hash algo (current-buffer)))) + (message "Checksum copied to kill-ring."))) + +(defun helm-ff-toggle-basename (_candidate) + (with-helm-buffer + (setq helm-ff-transformer-show-only-basename + (not helm-ff-transformer-show-only-basename)) + (let* ((cand (helm-get-selection nil t)) + (target (if helm-ff-transformer-show-only-basename + (helm-basename cand) cand))) + (helm-force-update (regexp-quote target))))) + +(defun helm-ff-run-toggle-basename () + (interactive) + (with-helm-alive-p + (unless (helm-empty-source-p) + (helm-ff-toggle-basename nil)))) +(put 'helm-ff-run-toggle-basename 'helm-only t) + +(defun helm-reduce-file-name (fname level) + "Reduce FNAME by number LEVEL from end." + (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-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 + (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))) + (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) + (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) + (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 (concat "^" (regexp-quote presel) "$") nil t) + (forward-line 0) + (helm-mark-current-line))) + (setq helm-ff-last-expanded nil)))) + +(defun helm-ff-move-to-first-real-candidate () + "When candidate is an incomplete file name move to first real candidate." + (let ((src (helm-get-current-source))) + (helm-aif (and (helm-file-completion-source-p src) + (not (helm-empty-source-p)) + (not (string-match + "\\`[Dd]ired-" + (assoc-default 'name (helm-get-current-source)))) + helm-ff--move-to-first-real-candidate + (helm-get-selection nil nil src)) + (unless (or (not (stringp it)) + (and (string-match helm-tramp-file-name-regexp it) + (not (file-remote-p it nil t))) + (file-exists-p it)) + (helm-next-line))))) + +;;; 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 (helm-ff-invalid-tramp-name-p))) + (with-helm-window + (let* ((history-p (string= (assoc-default 'name src) + "Read File Name History")) + (pat (if (string-match helm-tramp-file-name-regexp + helm-pattern) + (helm-create-tramp-name helm-pattern) + helm-pattern)) + (completed-p (string= (file-name-as-directory + (expand-file-name + (substitute-in-file-name pat))) + helm-ff-default-directory)) + (candnum (helm-get-candidate-number)) + (lt2-p (and (<= candnum 2) + (>= (string-width (helm-basename helm-pattern)) 2))) + (cur-cand (prog2 + (unless (or completed-p + (file-exists-p pat) + history-p (null lt2-p)) + ;; Only one non--existing candidate + ;; and one directory candidate, move to it, + ;; but not when renaming, copying etc..., + ;; so for this use + ;; `helm-ff-move-to-first-real-candidate' + ;; instead of `helm-next-line' (Issue #910). + (helm-ff-move-to-first-real-candidate)) + (helm-get-selection nil nil src)))) + (when (and (or (and helm-ff-auto-update-flag + (null helm-ff--deleting-char-backward) + (not (get-buffer-window helm-action-buffer 'visible)) + ;; Issue #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 issue #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-dir-is-dot 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. + (helm-set-pattern (file-name-as-directory cur-cand)) + ;; 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) + (helm-set-pattern + ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt. + (expand-file-name (file-name-as-directory helm-pattern))))) + (helm-check-minibuffer-input))))))) + +(defun helm-ff-auto-expand-to-home-or-root () + "Allow expanding to home/user directory or root or text yanked after pattern." + (when (and (helm-file-completion-source-p) + (with-current-buffer (window-buffer (minibuffer-window)) (eolp)) + (not (string-match helm-ff-url-regexp helm-pattern))) + (cond ((and (not (file-remote-p helm-pattern)) + (null (file-exists-p helm-pattern)) + (string-match-p + "\\`\\([.]\\|\\s-\\)\\{2\\}[^/]+" + (helm-basename helm-pattern)) + (string-match-p "/\\'" helm-pattern)) + (helm-ff-recursive-dirs helm-pattern) + (with-helm-window (helm-check-minibuffer-input))) + ((and (string-match + "/?\\$.*/\\|/\\./\\|/\\.\\./\\|/~.*/\\|//\\|\\(/[[:alpha:]]:/\\|\\s\\+\\)" + helm-pattern)) + (let* ((match (match-string 0 helm-pattern)) + (input (cond ((string= match "/./") + (expand-file-name default-directory)) + ((string= helm-pattern "/../") "/") + ((string-match-p "\\`/\\$" match) + (let ((sub (substitute-in-file-name match))) + (if (file-directory-p sub) + sub (replace-regexp-in-string "/\\'" "" sub)))) + (t (expand-file-name + (helm-substitute-in-filename helm-pattern) + ;; [Windows] On UNC paths "/" expand to current machine, + ;; so use the root of current Drive. (i.e "C:/") + (and (memq system-type '(windows-nt ms-dos)) + (getenv "SystemDrive")) ; nil on Unix. + ))))) + (if (file-directory-p input) + (setq helm-ff-default-directory + (setq input (file-name-as-directory input))) + (setq helm-ff-default-directory (file-name-as-directory + (file-name-directory input)))) + (with-helm-window + (helm-set-pattern input) + (helm-check-minibuffer-input))))))) + +(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 ffap-url-regexp + (string-match-p ffap-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)) + (skip-chars-forward "/") ;; Avoid infloop in UNC paths Issue #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) (point-at-eol))) + fname))))) + +(defun helm-point-file-in-dired (file) + "Put point on filename FILE in dired buffer." + (unless (and ffap-url-regexp + (string-match-p ffap-url-regexp file)) + (let ((target (expand-file-name (helm-substitute-in-filename file)))) + (dired (file-name-directory target)) + (dired-goto-file target)))) + +(defun helm-create-tramp-name (fname) + "Build filename for `helm-pattern' like /su:: or /sudo::." + (apply #'tramp-make-tramp-file-name + (cl-loop with v = (tramp-dissect-file-name fname) + for i across v collect i))) + +(defun helm-ff-get-tramp-methods () + "Returns 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 (point-at-bol) (match-beginning 2)) + (buffer-substring-no-properties (match-beginning 2) (match-end 2))))))) + +(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))) + (current-mh-host (helm-aif (and mh-method + (helm-ff-get-host-from-tramp-invalid-fname pattern)) + (concat (car mh-method) method ":" + (car (split-string it "|" t))))) + (all-methods (helm-ff-get-tramp-methods))) + (helm-fast-remove-dups + (cons current-mh-host + (cl-loop 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)) + when (and host (not (member host all-methods))) + collect (concat (or (car mh-method) "/") + method ":" host)))) + :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." + (string= (helm-ff-set-pattern pattern) + "Invalid tramp file name")) + +(defun helm-ff-tramp-postfixed-p (str) + (let (result) + (save-match-data + (with-temp-buffer + (save-excursion (insert str)) + (helm-awhile (search-forward ":" nil t) + (if (save-excursion + (forward-char -1) + (looking-back + (mapconcat 'identity (helm-ff-get-tramp-methods) "\\|") + (point-at-bol))) + (setq result nil) + (setq result it))))) + result)) + +(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 (helm-ff-tramp-postfixed-p pattern)) + (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:") + cur-method tramp-name) + ;; In some rare cases tramp can return a nil input, + ;; so be sure pattern is a string for safety (Issue #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)) + ((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 "~/")) + ;; 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-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-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-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)) + "Invalid tramp file name") ; Write in helm-buffer. + ;; Return PATTERN unchanged. + (t pattern)))) + +(defun helm-find-files-get-candidates (&optional require-match) + "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) + ;; Issue #118 allow creation of newdir+newfile. + (unless (or + ;; A tramp file name not completed. + (string= path "Invalid tramp file name") + ;; An empty pattern + (string= path "") + (and (string-match-p ":\\'" path) + (helm-ff-tramp-postfixed-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' == "Invalid tramp file name" + ;; like that the actual value (e.g /ssh:) is passed to + ;; `helm-ff-tramp-hostnames'. + (unless (or (string= path "Invalid tramp file name") + invalid-basedir) ; Leave helm-pattern unchanged. + (setq helm-ff-auto-update-flag ; [1] + ;; Unless auto update is disabled at startup or + ;; interactively, start auto updating only at third char. + (unless (or (null helm-ff-auto-update-initial-value) + (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. + (setq helm-pattern (helm-ff--transform-pattern-for-completion path)) + ;; This have to be set after [1] to allow deleting char backward. + (setq basedir (expand-file-name + (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))))) + (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 ffap-url-regexp + (string-match ffap-url-regexp path))) + basedir)))) + (when (and (string-match ":\\'" path) + (file-remote-p basedir nil t)) + (setq helm-pattern basedir)) + (cond ((string= path "Invalid tramp file name") + (or (helm-ff-tramp-hostnames) ; Hostnames completion. + (prog2 + ;; `helm-pattern' have not been modified yet. + ;; Set it here to the value of `path' that should be now + ;; "Invalid tramp file name" and set the candidates list + ;; to ("Invalid tramp file name") to make `helm-pattern' + ;; match single candidate "Invalid tramp file name". + (setq helm-pattern path) + ;; "Invalid tramp file name" is now printed + ;; in `helm-buffer'. + (list path)))) + ((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) + invalid-basedir + (and (not (file-exists-p path)) (string-match "/$" path)) + (and ffap-url-regexp (string-match ffap-url-regexp path))) + (list path)) + ((string= path "") (helm-ff-directory-files "/" t)) + ;; Check here if directory is accessible (not working on Windows). + ((and (file-directory-p path) (not (file-readable-p path))) + (list (format "file-error: Opening directory permission denied `%s'" 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)) + (t (append (unless (or require-match + ;; When `helm-ff-auto-update-flag' has been + ;; disabled, whe don't want PATH to be added on top + ;; if it is a directory. + dir-p) + (list path)) + (helm-ff-directory-files basedir t)))))) + +(defun helm-ff-directory-files (directory &optional full) + "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." + (setq directory (file-name-as-directory + (expand-file-name directory))) + (let* (file-error + (ls (condition-case err + (directory-files + directory full directory-files-no-dot-files-regexp) + ;; 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 + (list (format "%s:%s" + (car err) + (mapconcat 'identity (cdr err) " "))) + (setq file-error t))))) + (dot (concat directory ".")) + (dot2 (concat directory ".."))) + (append (and (not file-error) (list dot dot2)) ls))) + +(defun helm-ff-handle-backslash (fname) + ;; Allow creation of filenames containing a backslash. + (cl-loop with bad = '((92 . "")) + for i across fname + for isbad = (assq i bad) + if isbad concat (cdr isbad) + 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 happen only when `helm-ff-fuzzy-matching' is enabled. +This provide a similar behavior as `ido-enable-flex-matching'. +See also `helm--mapconcat-pattern'. +If PATTERN is an url returns it unmodified. +When PATTERN contain a space fallback to multi-match. +If basename contain one or more space fallback to multi-match. +If PATTERN is a valid directory name,return PATTERN unchanged." + ;; handle bad filenames containing a backslash. + (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 Issue #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 (Issue #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 "\\s-" bn)) ; Fall back to multi-match. + (concat (regexp-quote bd) bn)) + ((or (string-match "[*][.]?.*" bn) ; Allow entering wilcard. + (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) + (concat (regexp-quote bd) + (replace-regexp-in-string "[*]" "[*]" bn))) + (t (concat (regexp-quote bd) + (if (>= (length bn) 2) ; wait 2nd char before concating. + (helm--mapconcat-pattern bn) + (concat ".*" (regexp-quote bn)))))))) + +(defun helm-dir-is-dot (dir) + (string-match "\\(?:/\\|\\`\\)\\.\\{1,2\\}\\'" dir)) + +(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-files-save-file-name-history (&optional force) + "Save selected file 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)) + (history-delete-duplicates t)) + (cl-loop for sel in mkd + when (and sel + (stringp sel) + (file-exists-p sel) + (not (file-directory-p 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 sel))))))) +(add-hook 'helm-exit-minibuffer-hook 'helm-files-save-file-name-history) + +(defun helm-ff-valid-symlink-p (file) + (helm-aif (condition-case-unless-debug nil + ;; `file-truename' send error + ;; on cyclic symlinks (Issue #692). + (file-truename file) + (error nil)) + (file-exists-p 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." + (let* ((all (helm-file-attributes candidate)) + (dired-line (helm-file-attributes + candidate :dired t :human-size t)) + (type (cl-getf all :type)) + (mode-type (cl-getf all :mode-type)) + (owner (cl-getf all :uid)) + (owner-right (cl-getf all :user t)) + (group (cl-getf all :gid)) + (group-right (cl-getf all :group)) + (other-right (cl-getf all :other)) + (size (helm-file-human-size (cl-getf all :size))) + (modif (cl-getf all :modif-time)) + (access (cl-getf all :access-time)) + (ext (helm-get-default-program-for-file candidate)) + (tooltip-hide-delay (or helm-tooltip-hide-delay tooltip-hide-delay))) + (if (and (window-system) tooltip-mode) + (tooltip-show + (concat + (helm-basename candidate) "\n" + dired-line "\n" + (format "Mode: %s\n" (helm-get-default-mode-for-file candidate)) + (format "Ext prog: %s\n" (or (and ext (replace-regexp-in-string + " %s" "" ext)) + "Not defined")) + (format "Type: %s: %s\n" type mode-type) + (when (string= type "symlink") + (format "True name: '%s'\n" + (cond ((string-match "^\.#" (helm-basename candidate)) + "Autosave symlink") + ((helm-ff-valid-symlink-p candidate) + (file-truename candidate)) + (t "Invalid Symlink")))) + (format "Owner: %s: %s\n" owner owner-right) + (format "Group: %s: %s\n" group group-right) + (format "Others: %s\n" other-right) + (format "Size: %s\n" size) + (format "Modified: %s\n" modif) + (format "Accessed: %s\n" access))) + (message dired-line) (sit-for 5)))) + +(defun helm-ff-properties-persistent () + "Show properties without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'properties-action '(helm-ff-properties . never-split)) + (helm-execute-persistent-action 'properties-action))) +(put 'helm-ff-properties-persistent 'helm-only t) + +(defun helm-ff-persistent-delete () + "Delete current candidate without quitting." + (interactive) + (with-helm-alive-p + (helm-attrset 'quick-delete '(helm-ff-quick-delete . never-split)) + (helm-execute-persistent-action 'quick-delete))) +(put 'helm-ff-persistent-delete 'helm-only t) + +(defun helm-ff-dot-file-p (file) + "Check if FILE is `.' or `..'." + (member (helm-basename file) '("." ".."))) + +(defun helm-ff-quick-delete (_candidate) + "Delete file CANDIDATE without quitting." + (let ((marked (helm-marked-candidates))) + (unwind-protect + (save-selected-window + (cl-loop for c in marked do + (progn (helm-preselect + (if (and helm-ff-transformer-show-only-basename + (not (helm-ff-dot-file-p c))) + (helm-basename c) c)) + (when (y-or-n-p + (format "Really Delete file `%s'? " c)) + (helm-delete-file + c helm-ff-signal-error-on-dot-files 'synchro) + (helm-delete-current-selection) + (message nil) + (helm--remove-marked-and-update-mode-line c))))) + (with-helm-buffer + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil)) + (helm-force-update + (let ((presel (helm-get-selection))) + (regexp-quote (if (and helm-ff-transformer-show-only-basename + (not (helm-ff-dot-file-p presel))) + (helm-basename presel) presel))))))) + +(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 it's 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'." + (let* ((buf (get-file-buffer candidate)) + (buf-name (buffer-name buf)) + (win (get-buffer-window buf)) + (helm--reading-passwd-or-string t)) + (cond ((and buf win (eq 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) + (set-window-buffer win helm-current-buffer) + (message "Buffer `%s' killed" buf-name)) + (t (find-file candidate))))) + +(defun helm-ff-run-kill-buffer-persistent () + "Execute `helm-ff-kill-buffer-fname' without quitting." + (interactive) + (with-helm-alive-p + (helm-attrset 'kill-buffer-fname 'helm-ff-kill-buffer-fname) + (helm-execute-persistent-action 'kill-buffer-fname))) +(put 'helm-ff-run-kill-buffer-persistent 'helm-only t) + +(defun helm-ff-prefix-filename (fname &optional file-or-symlinkp new-file) + "Return filename FNAME maybe prefixed with [?] or [@]. +If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an +existing filename or valid symlink and there is no need to test it. +NEW-FILE when non--nil mean FNAME is a non existing file and +return FNAME prefixed with [?]." + (let* ((prefix-new (propertize + " " 'display + (propertize "[?]" 'face 'helm-ff-prefix))) + (prefix-url (propertize + " " 'display + (propertize "[@]" 'face 'helm-ff-prefix)))) + (cond (file-or-symlinkp fname) + ((or (string-match helm-ff-url-regexp fname) + (and ffap-url-regexp (string-match ffap-url-regexp fname))) + (concat prefix-url " " fname)) + (new-file (concat prefix-new " " fname))))) + +(defun helm-ff-score-candidate-for-pattern (str pattern) + (if (member str '("." "..")) + 200 + (helm-score-candidate-for-pattern str pattern))) + +(defun helm-ff-sort-candidates (candidates _source) + "Sort function for `helm-source-find-files'. +Return candidates prefixed with basename of `helm-input' first." + (if (or (and (file-directory-p helm-input) + (string-match "/\\'" helm-input)) + (string-match "\\`\\$" helm-input) + (null candidates)) + candidates + (let* ((c1 (car candidates)) + (cand1real (if (consp c1) (cdr c1) c1)) + (cand1 (unless (file-exists-p cand1real) c1)) + (rest-cand (if cand1 (cdr candidates) candidates)) + (memo-src (make-hash-table :test 'equal)) + (all (sort rest-cand + (lambda (s1 s2) + (let* ((score (lambda (str) + (helm-ff-score-candidate-for-pattern + str (helm-basename helm-input)))) + (bn1 (helm-basename (if (consp s1) (cdr s1) s1))) + (bn2 (helm-basename (if (consp s2) (cdr s2) s2))) + (sc1 (or (gethash bn1 memo-src) + (puthash bn1 (funcall score bn1) memo-src))) + (sc2 (or (gethash bn2 memo-src) + (puthash bn2 (funcall score bn2) memo-src)))) + (cond ((= sc1 sc2) + (< (string-width bn1) + (string-width bn2))) + ((> sc1 sc2)))))))) + (if cand1 (cons cand1 all) all)))) + +(defun helm-ff-filter-candidate-one-by-one (file) + "`filter-one-by-one' Transformer function for `helm-source-find-files'." + ;; Handle boring files + (unless (and helm-ff-skip-boring-files + (cl-loop for r in helm-boring-file-regexp-list + ;; Prevent user doing silly thing like + ;; adding the dotted files to boring regexps (#924). + thereis (and (not (string-match "\\.$" file)) + (string-match r file)))) + ;; Handle tramp files. + (if (and (string-match helm-tramp-file-name-regexp helm-pattern) + helm-ff-tramp-not-fancy) + (if helm-ff-transformer-show-only-basename + (if (helm-dir-is-dot file) + file + (cons (or (helm-ff-get-host-from-tramp-invalid-fname file) + (helm-basename file)) + file)) + file) + ;; Now highlight. + (let* ((disp (if (and helm-ff-transformer-show-only-basename + (not (helm-dir-is-dot file)) + (not (and ffap-url-regexp + (string-match ffap-url-regexp file))) + (not (string-match helm-ff-url-regexp file))) + (or (helm-ff-get-host-from-tramp-invalid-fname file) + (helm-basename file)) file)) + (attr (file-attributes file)) + (type (car attr))) + + (cond ((string-match "file-error" file) file) + ( ;; A not already saved file. + (and (stringp type) + (not (helm-ff-valid-symlink-p file)) + (not (string-match "^\.#" (helm-basename file)))) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-invalid-symlink) t) + file)) + ;; A dotted directory symlinked. + ((and (helm-ff-dot-file-p file) (stringp type)) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-dotted-symlink-directory) t) + file)) + ;; A dotted directory. + ((helm-ff-dot-file-p file) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-dotted-directory) t) + file)) + ;; A symlink. + ((stringp type) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-symlink) t) + file)) + ;; A directory. + ((eq t type) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-directory) t) + file)) + ;; An executable file. + ((and attr (string-match "x" (nth 8 attr))) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-executable) t) + file)) + ;; A file. + ((and attr (null type)) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-file) t) + file)) + ;; A non--existing file. + (t + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-file) nil 'new-file) + file))))))) + +(defun helm-find-files-action-transformer (actions candidate) + "Action transformer for `helm-source-find-files'." + (let ((str-at-point (with-helm-current-buffer + (buffer-substring-no-properties + (point-at-bol) (point-at-eol))))) + (cond ((with-helm-current-buffer + (eq major-mode 'message-mode)) + (append actions + '(("Gnus attach file(s)" . helm-ff-gnus-attach-files)))) + ((and ffap-url-regexp + (not (string-match-p ffap-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) + (append actions + '(("Rotate image right `M-r'" . helm-ff-rotate-image-right) + ("Rotate image left `M-l'" . helm-ff-rotate-image-left)))) + ((string-match "\.el$" (helm-aif (helm-marked-candidates) + (car it) candidate)) + (append actions + '(("Byte compile lisp file(s) `M-B, C-u to load'" + . helm-find-files-byte-compile) + ("Load File(s) `M-L'" . helm-find-files-load-files)))) + ((and (string-match "\.html?$" candidate) + (file-exists-p candidate)) + (append actions + '(("Browse url file" . browse-url-of-file)))) + ((or (string= (file-name-extension candidate) "pdf") + (string= (file-name-extension candidate) "PDF")) + (append actions + '(("Pdfgrep File(s)" . helm-ff-pdfgrep)))) + (t actions)))) + +(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 + (point-at-bol) (point-at-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-gnus-attach-files (_candidate) + "Run `gnus-dired-attach' on `helm-marked-candidates' or CANDIDATE." + (require 'gnus-dired) + (let ((flist (helm-marked-candidates :with-wildcard t))) + (gnus-dired-attach flist))) + +(defvar image-dired-display-image-buffer) +(defun helm-ff-rotate-current-image-1 (file &optional num-arg) + "Rotate current image at NUM-ARG degrees. +This is a destructive operation on FILE made by external tool mogrify." + (setq file (file-truename file)) ; For symlinked images. + ;; When FILE is not an image-file, do nothing. + (when (string-match (image-file-name-regexp) file) + (if (executable-find "mogrify") + (progn + (shell-command (format "mogrify -rotate %s %s" + (or num-arg 90) + (shell-quote-argument file))) + (when (buffer-live-p image-dired-display-image-buffer) + (kill-buffer image-dired-display-image-buffer)) + (image-dired-display-image file) + (message nil) + (display-buffer (get-buffer image-dired-display-image-buffer))) + (error "mogrify not found")))) + +(defun helm-ff-rotate-image-left (candidate) + "Rotate image file CANDIDATE left. +This affect directly file CANDIDATE." + (helm-ff-rotate-current-image-1 candidate -90)) + +(defun helm-ff-rotate-image-right (candidate) + "Rotate image file CANDIDATE right. +This affect directly file CANDIDATE." + (helm-ff-rotate-current-image-1 candidate)) + +(defun helm-ff-rotate-left-persistent () + "Rotate image left without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset '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-attrset '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-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))) + +(cl-defun helm-find-files-persistent-action (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's mean: +First hit on C-j expand CANDIDATE second hit open file. +If a prefix arg is given or `helm-follow-mode' is on open file." + (let* ((follow (or (helm-follow-mode-p) + helm--temp-follow-flag)) + (image-cand (string-match-p (image-file-name-regexp) candidate)) + (new-pattern (helm-get-selection)) + (num-lines-buf (with-current-buffer helm-buffer + (count-lines (point-min) (point-max)))) + (insert-in-minibuffer (lambda (fname) + (with-selected-window (minibuffer-window) + (unless follow + (delete-minibuffer-contents) + (set-text-properties 0 (length fname) + nil fname) + (insert fname)))))) + (unless image-cand + (when follow + (helm-follow-mode -1) + (cl-return-from helm-find-files-persistent-action + (message "Helm-follow-mode allowed only on images, disabling")))) + (cond ((and (helm-ff-invalid-tramp-name-p) + (string-match helm-tramp-file-name-regexp 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))) + (;; 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)) + (funcall insert-in-minibuffer + (file-name-as-directory + (if current-prefix-arg + (file-truename (expand-file-name candidate)) + (expand-file-name candidate))))) + ;; A directory, open it. + ((file-directory-p candidate) + (when (string= (helm-basename candidate) "..") + (setq helm-ff-last-expanded helm-ff-default-directory)) + (funcall insert-in-minibuffer (file-name-as-directory + (expand-file-name candidate)))) + ;; A symlink file, expand to it's true name. (first hit) + ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow)) + (funcall insert-in-minibuffer (file-truename candidate))) + ;; A regular file, expand it, (first hit) + ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow)) + (setq helm-pattern "") ; Force update. + (funcall insert-in-minibuffer new-pattern)) + ;; An image file and it is the second hit on C-j, + ;; show the file in `image-dired'. + (image-cand + (when (buffer-live-p (get-buffer image-dired-display-image-buffer)) + (kill-buffer image-dired-display-image-buffer)) + ;; Fix emacs bug never fixed upstream. + (unless (file-directory-p image-dired-dir) + (make-directory image-dired-dir)) + (image-dired-display-image candidate) + (message nil) + (switch-to-buffer image-dired-display-image-buffer) + (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. + ((and helm-ff-avfs-directory + (string-match + (regexp-quote (expand-file-name helm-ff-avfs-directory)) + (file-name-directory candidate)) + (helm-ff-file-compressed-p candidate)) + (funcall insert-in-minibuffer (concat candidate "#"))) + ;; File doesn't exists and basename starts with ".." or " ", + ;; Start a recursive search for directories. + ((and (not (file-exists-p candidate)) + (not (file-remote-p candidate)) + (string-match-p "\\`\\([.]\\|\\s-\\)\\{2\\}[^/]+" + (helm-basename candidate))) + ;; As soon as the final "/" is added the job is passed + ;; to `helm-ff-auto-expand-to-home-or-root'. + (funcall insert-in-minibuffer (concat candidate "/"))) + ;; On second hit we open file. + ;; On Third hit we kill it's buffer maybe. + (t + (helm-ff-kill-or-find-buffer-fname candidate))))) + + +;;; Recursive dirs completion +;; +(defun helm-find-files-recursive-dirs (directory &optional input) + (when (string-match "\\(\\s-+\\|[.]\\)\\{2\\}" input) + (setq input (replace-match "" nil t input))) + (message "Recursively searching %s from %s ..." + input (abbreviate-file-name directory)) + (helm :sources + (helm-make-source + "Recursive directories" 'helm-locate-subdirs-source + :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) + :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 + (helm-current-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-insert-file-name-completion-at-point (candidate) + "Insert file name completion at point." + (with-helm-current-buffer + (if buffer-read-only + (error "Error: Buffer `%s' is read-only" (buffer-name)) + (let* ((end (point)) + (tap (thing-at-point 'filename)) + (guess (and (stringp tap) (substring-no-properties tap))) + (beg (- (point) (length guess))) + (full-path-p (and (stringp guess) + (or (string-match-p + (concat "^" (getenv "HOME")) + guess) + (string-match-p + "\\`\\(/\\|[[:lower:][:upper:]]:/\\)" + guess))))) + (set-text-properties 0 (length candidate) nil candidate) + (if (and guess (not (string= guess "")) + (or (string-match "^\\(~/\\|/\\|[[:lower:][:upper:]]:/\\)" + guess) + (file-exists-p candidate))) + (progn + (delete-region beg end) + (insert (cond (full-path-p + (expand-file-name candidate)) + ((string= (match-string 1 guess) "~/") + (abbreviate-file-name candidate)) + (t (file-relative-name candidate))))) + (insert (cond ((equal helm-current-prefix-arg '(4)) + (abbreviate-file-name candidate)) + ((equal helm-current-prefix-arg '(16)) + (file-relative-name candidate)) + (t candidate)))))))) + +(cl-defun helm-find-files-history (&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'." + (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) + (cl-subseq history 0 helm-ff-history-max-length) + history)) + (if comp-read + (helm-comp-read + "Switch to Directory: " + helm-ff-history + :name "Helm Find Files History" + :must-match t) + helm-ff-history)))) + +(defun helm-find-files-1 (fname &optional preselect) + "Find FNAME with `helm' completion. +Like `find-file' but with `helm' support. +Use it for non--interactive calls of `helm-find-files'." + (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)))) + helm-follow-mode-persistent) + (unless helm-source-find-files + (setq helm-source-find-files (helm-make-source + "Find Files" 'helm-source-ffiles))) + (mapc (lambda (hook) + (add-hook 'helm-after-update-hook hook)) + '(helm-ff-move-to-first-real-candidate + helm-ff-update-when-only-one-matched + helm-ff-auto-expand-to-home-or-root)) + (unwind-protect + (helm :sources 'helm-source-find-files + :input fname + :case-fold-search helm-file-name-case-fold-search + :preselect preselect + :ff-transformer-show-only-basename + helm-ff-transformer-show-only-basename + :default def + :prompt "Find files or url: " + :buffer "*helm find files*") + (helm-attrset 'resume (lambda () + (setq helm-ff-default-directory + helm-ff-default-directory + helm-ff-last-expanded + helm-ff-last-expanded)) + helm-source-find-files) + (setq helm-ff-default-directory nil)))) + +(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-move-to-first-real-candidate))) + +(defun helm-find-files-toggle-to-bookmark () + "Toggle helm-bookmark for `helm-find-files' and `helm-find-files.'" + (interactive) + (with-helm-alive-p + (with-helm-buffer + (if (setq helm-find-files--toggle-bookmark + (not helm-find-files--toggle-bookmark)) + (progn + (helm-set-pattern "" t) + (helm-set-sources '(helm-source-bookmark-helm-find-files))) + ;; Switch back to helm-find-files. + (helm-set-pattern "./" t) ; Back to initial directory of hff session. + (helm-set-sources '(helm-source-find-files)) + (helm--maybe-update-keymap))))) +(put 'helm-find-files-toggle-to-bookmark 'helm-only t) + +(defun helm-find-files-initial-input (&optional input) + "Return INPUT if present, otherwise try to guess it." + (let ((ffap-machine-p-known 'reject) + (ffap-alist (and helm-ff-guess-ffap-filenames ffap-alist)) + (ffap-url-regexp (and helm-ff-guess-ffap-urls ffap-url-regexp))) + (unless (eq major-mode 'image-mode) + (or (and input (or (and (file-remote-p input) input) + (expand-file-name input))) + (helm-find-files-input + (ffap-guesser) + (thing-at-point 'filename)))))) + +(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 ffap-url-regexp + (string-match ffap-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) + (file-exists-p file-at-pt) + 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 + (helm-aif (ffap-file-at-point) (expand-file-name it))) + (urlp file-at-pt) ; possibly an url or email. + ((and file-at-pt + (not remp) + (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) ffap-url-regexp (string-match ffap-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 "(" (point-at-bol) t))) + (end-sexp (save-excursion (search-forward ")" (point-at-eol) t))) + (sexp (and beg-sexp end-sexp + (buffer-substring-no-properties + (1+ beg-sexp) (1- end-sexp))))) + (ignore-errors + (cond ((and sexp (string-match "require \'.+[^)]" sexp)) + (find-library-name + (replace-regexp-in-string + "'\\|\)\\|\(" "" + ;; If require use third arg, ignore it, + ;; always use library path found in `load-path'. + (cl-second (split-string (match-string 0 sexp)))))) + ((and sexp (string-match-p "^declare-function" sexp)) + (find-library-name + (replace-regexp-in-string + "\"\\|ext:" "" + (cl-third (split-string 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 (candidate + &key action follow (files (dired-get-marked-files))) + "Execute ACTION on FILES to CANDIDATE. +Where ACTION is a symbol that can be one of: +'copy, 'rename, 'symlink,'relsymlink, 'hardlink or 'backup. +Argument FOLLOW when non--nil specify to follow FILES to destination for the actions +copy and rename." + (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 candidate)))) + (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 (and (cdr files) (not (file-directory-p candidate))) + (error "%s: target `%s' is not a directory" action candidate)) + (unwind-protect + (dired-create-files + fn (symbol-name action) files + ;; CANDIDATE is the destination. + (if (file-directory-p candidate) + ;; When CANDIDATE is a directory, build file-name in this directory. + ;; Else we use CANDIDATE. + (lambda (from) + (expand-file-name (file-name-nondirectory from) candidate)) + (lambda (_from) candidate)) + marker) + (and (fboundp 'dired-async-mode) + (dired-async-mode dired-async-state))) + (push (file-name-as-directory + (if (file-directory-p candidate) + (expand-file-name candidate) + (file-name-directory candidate))) + 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 candidate))) + (unwind-protect + (progn + (setq helm-ff-cand-to-mark + (helm-get-dest-fnames-from-list files candidate dirflag)) + (with-helm-after-update-hook (helm-ff-maybe-mark-candidates)) + (if (and dirflag (eq action 'rename)) + (helm-find-files-1 (file-name-directory target) + (if helm-ff-transformer-show-only-basename + (helm-basename target) target)) + (helm-find-files-1 (file-name-as-directory + (expand-file-name candidate))))) + (setq helm-ff-cand-to-mark nil)))))) + +(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 () + "Mark all candidates of list `helm-ff-cand-to-mark'. +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)) + helm-ff-cand-to-mark) + (with-helm-window + (while helm-ff-cand-to-mark + (if (string= (car helm-ff-cand-to-mark) (helm-get-selection)) + (progn + (helm-make-visible-mark) + (helm-next-line) + (setq helm-ff-cand-to-mark (cdr helm-ff-cand-to-mark))) + (helm-next-line))) + (unless (helm-this-visible-mark) + (helm-prev-visible-mark))))) + + +;;; Routines for files +;; +;; +(defun helm-file-buffers (filename) + "Returns 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-delete-file (file &optional error-if-dot-file-p synchro) + "Delete the given file after querying the user. +Ask to kill buffers associated with that file, too." + (when (and error-if-dot-file-p + (helm-ff-dot-file-p file)) + (error "Error: Cannot operate on `.' or `..'")) + (let ((buffers (helm-file-buffers file)) + (helm--reading-passwd-or-string t)) + (if (or (< emacs-major-version 24) synchro) + ;; `dired-delete-file' in Emacs versions < 24 + ;; doesn't support delete-by-moving-to-trash + ;; so use `delete-directory' and `delete-file' + ;; that handle it. + (cond ((and (not (file-symlink-p file)) + (file-directory-p file) + (directory-files file t dired-re-no-dot)) + (when (y-or-n-p (format "Recursive delete of `%s'? " file)) + (delete-directory file 'recursive))) + ((and (not (file-symlink-p file)) + (file-directory-p file)) + (delete-directory file)) + (t (delete-file file))) + (dired-delete-file + file dired-recursive-deletes delete-by-moving-to-trash)) + (when buffers + (cl-dolist (buf buffers) + (when (y-or-n-p (format "Kill buffer %s, too? " buf)) + (kill-buffer buf)))))) + +(defun helm-delete-marked-files (_ignore) + (let* ((files (helm-marked-candidates :with-wildcard t)) + (len (length files))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (helm-ff--count-and-collect-dups files) + (if (not (y-or-n-p (format "Delete *%s File(s)" len))) + (message "(No deletions performed)") + (cl-dolist (i files) + (set-text-properties 0 (length i) nil i) + (helm-delete-file i helm-ff-signal-error-on-dot-files)) + (message "%s File(s) deleted" len))))) + +(defun helm-find-file-or-marked (candidate) + "Open file CANDIDATE or open helm marked files in separate windows. +Called with a prefix arg open files in background without selecting them." + (let ((marked (helm-marked-candidates :with-wildcard t)) + (url-p (and ffap-url-regexp ; we should have only one candidate. + (string-match ffap-url-regexp candidate))) + (ffap-newfile-prompt helm-ff-newfile-prompt-p) + (find-file-wildcards nil) + (make-dir-fn + (lambda (dir &optional helm-ff) + (when (or (not confirm-nonexistent-file-or-buffer) + (y-or-n-p (format "Create directory `%s'? " dir))) + (let ((dirfname (directory-file-name 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 + ;; 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 dir)) + (push helm-ff-default-directory helm-ff-history)) + (or (and helm-ff (helm-find-files-1 dir)) t)))) + (helm--reading-passwd-or-string t)) + (if (cdr marked) + (if helm-current-prefix-arg + (dired-simultaneous-find-file marked nil) + (mapc 'find-file-noselect (cdr marked)) + (find-file (car marked))) + (if (and (not (file-exists-p candidate)) + (not url-p) + (string-match "/$" candidate)) + ;; A a non--existing filename ending with / + ;; Create a directory and jump to it. + (funcall make-dir-fn 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. + (let ((dir (and (not url-p) (helm-basedir candidate)))) + (find-file-at-point + (cond ((and dir (file-directory-p dir)) + (substitute-in-file-name candidate)) + (url-p candidate) + ((funcall make-dir-fn dir) candidate)))))))) + +(defun helm-shadow-boring-files (files) + "Files matching `helm-boring-file-regexp' will be +displayed with the `file-name-shadow' face if available." + (helm-shadow-entries files helm-boring-file-regexp-list)) + +(defun helm-skip-boring-files (files) + "Files matching `helm-boring-file-regexp' will be skipped." + (helm-skip-entries files helm-boring-file-regexp-list)) + +(defun helm-skip-current-file (files) + "Current file will be skipped." + (remove (buffer-file-name helm-current-buffer) files)) + +(defun helm-w32-pathname-transformer (args) + "Change undesirable features of windows pathnames to ones more acceptable to +other candidate transformers." + (if (eq system-type 'windows-nt) + (helm-transform-mapcar + (lambda (x) + (replace-regexp-in-string + "/cygdrive/\\(.\\)" "\\1:" + (replace-regexp-in-string "\\\\" "/" x))) + args) + args)) + +(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-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) + + +;;; List of files gleaned from every dired buffer +;; +;; +(defun helm-files-in-all-dired-candidates () + (save-excursion + (cl-loop for (f . b) in dired-buffers + when (buffer-live-p b) + append (let ((dir (with-current-buffer b dired-directory))) + (if (listp dir) (cdr dir) + (directory-files f t dired-re-no-dot)))))) + +;; (dired '("~/" "~/.emacs.d/.emacs-custom.el" "~/.emacs.d/.emacs.bmk")) + +(defclass helm-files-dired-source (helm-source-sync helm-type-file) + ((candidates :initform #'helm-files-in-all-dired-candidates))) + +(defvar helm-source-files-in-all-dired + (helm-make-source "Files in all dired buffer." 'helm-files-dired-source)) + + +;;; 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-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))) + +(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))) + + +;;; File name history +;; +;; +(defvar helm-source-file-name-history + (helm-build-sync-source "File Name History" + :candidates 'file-name-history + :persistent-action #'ignore + :filtered-candidate-transformer #'helm-file-name-history-transformer + :action 'helm-type-file-actions)) + +(defvar helm-source--ff-file-name-history nil + "[Internal] This source is build to be used with `helm-find-files'. +Don't use it in your own code unless you know what you are doing.") + +(defun helm-file-name-history-transformer (candidates _source) + (cl-loop for c in candidates collect + (cond ((file-remote-p c) + (cons (propertize c 'face 'helm-history-remote) c)) + ((file-exists-p c) + (cons (propertize c 'face 'helm-ff-file) c)) + (t (cons (propertize c 'face 'helm-history-deleted) c))))) + +(defun helm-ff-file-name-history () + "Switch to `file-name-history' without quitting `helm-find-files'." + (interactive) + (unless helm-source--ff-file-name-history + (setq helm-source--ff-file-name-history + (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))))) + :candidates (lambda () + (if helm-ff-file-name-history-use-recentf + recentf-list + file-name-history)) + :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" (lambda (candidate) + (helm-set-pattern + (expand-file-name candidate))))))) + (with-helm-alive-p + (helm :sources 'helm-source--ff-file-name-history + :buffer "*helm-file-name-history*" + :allow-nest t + :resume 'noresume))) +(put 'helm-ff-file-name-history 'helm-only t) + +;;; Recentf files +;; +;; +(defvar helm-recentf--basename-flag nil) + +(defun helm-recentf-pattern-transformer (pattern) + (let ((pattern-no-flag (replace-regexp-in-string " -b" "" pattern))) + (cond ((and (string-match " " pattern-no-flag) + (string-match " -b\\'" pattern)) + (setq helm-recentf--basename-flag t) + pattern-no-flag) + ((string-match "\\([^ ]*\\) -b\\'" pattern) + (prog1 (match-string 1 pattern) + (setq helm-recentf--basename-flag t))) + (t (setq helm-recentf--basename-flag nil) + pattern)))) + +(defcustom helm-turn-on-recentf t + "Automatically turn on `recentf-mode' when non-nil." + :group 'helm-files + :type 'boolean) + +(defclass helm-recentf-source (helm-source-sync helm-type-file) + ((init :initform (lambda () + (require 'recentf) + (when helm-turn-on-recentf (recentf-mode 1)))) + (candidates :initform (lambda () recentf-list)) + (pattern-transformer :initform 'helm-recentf-pattern-transformer) + (match-part :initform (lambda (candidate) + (if (or helm-ff-transformer-show-only-basename + helm-recentf--basename-flag) + (helm-basename candidate) candidate))) + (migemo :initform t) + (persistent-action :initform 'helm-ff-kill-or-find-buffer-fname))) + +(defmethod helm--setup-source :after ((source helm-recentf-source)) + (setf (slot-value source 'action) + (append (symbol-value (helm-actions-from-type-file)) + '(("Delete file(s) from recentf" . + (lambda (_candidate) + (cl-loop for file in (helm-marked-candidates) + do (setq recentf-list (delq 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) + (setq helm-source-recentf + (helm-make-source "Recentf" 'helm-recentf-source + :fuzzy-match helm-recentf-fuzzy-match)))) + +;;; 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) + +(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-find-files (directory &optional refresh) + (when refresh (remhash directory helm--browse-project-cache)) + (unless (gethash directory helm--browse-project-cache) + (puthash directory (helm-walk-directory + directory + :directories nil :path 'full :skip-subdirs t) + helm--browse-project-cache)) + (helm :sources `(,(helm-browse-project-build-buffers-source directory) + ,(helm-build-in-buffer-source "Browse project" + :data (gethash directory helm--browse-project-cache) + :header-name (lambda (name) + (format + "%s (%s)" + name (abbreviate-file-name directory))) + :match-part (lambda (c) + (if (with-helm-buffer + helm-ff-transformer-show-only-basename) + (helm-basename c) c)) + :filter-one-by-one + (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))) + :keymap helm-generic-files-map + :action 'helm-type-file-actions)) + :ff-transformer-show-only-basename nil + :buffer "*helm browse project*")) + +(defvar helm-browse-project-history nil) + +;;;###autoload +(defun helm-projects-history () + (interactive) + (helm :sources + (helm-build-sync-source "Project history" + :candidates helm-browse-project-history + :action (lambda (candidate) + (with-helm-default-directory candidate + (helm-browse-project nil)))) + :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 + +and +." + (interactive "P") + (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-ls)) + ((and (require 'helm-ls-hg nil t) + (fboundp 'helm-hg-root) + (helm-hg-root)) + (push-to-hist it) + (helm-hg-find-files-in-project)) + ((and (require 'helm-ls-svn nil t) + (fboundp 'helm-ls-svn-root-dir) + (helm-ls-svn-root-dir)) + (push-to-hist it) + (helm-ls-svn-ls)) + ((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))) + +(defun helm-ff-run-browse-project () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-browse-project))) +(put 'helm-ff-run-browse-project 'helm-only t) + +(defun helm-ff-gid (_candidate) + (with-helm-default-directory helm-ff-default-directory + (helm-gid))) + +(defun helm-ff-run-gid () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-gid))) +(put 'helm-ff-run-gid 'helm-only t) + +;;; session.el files +;; +;; session (http://emacs-session.sourceforge.net/) is an alternative to +;; recentf that saves recent file history and much more. +(defvar session-file-alist) +(defvar helm-source-session + (helm-build-sync-source "Session" + :candidates (lambda () + (cl-delete-if-not (lambda (f) + (or (string-match helm-tramp-file-name-regexp f) + (file-exists-p f))) + (mapcar 'car session-file-alist))) + :keymap helm-generic-files-map + :help-message helm-generic-file-help-message + :action 'helm-type-file-actions) + "File list from emacs-session.") + + +;;; Files in current dir +;; +;; +(defun helm-highlight-files (files) + "A basic transformer for helm files sources. +Colorize only symlinks, directories and files." + (cl-loop for i in files + for disp = (if (and helm-ff-transformer-show-only-basename + (not (helm-dir-is-dot i)) + (not (and ffap-url-regexp + (string-match ffap-url-regexp i))) + (not (string-match helm-ff-url-regexp i))) + (helm-basename i) i) + for type = (and (null helm-ff-tramp-not-fancy) + (car (file-attributes i))) + collect + (cond ((and helm-ff-tramp-not-fancy + (string-match helm-tramp-file-name-regexp i)) + (cons disp i)) + ((stringp type) + (cons (propertize disp + 'face 'helm-ff-symlink + 'help-echo (expand-file-name i)) + i)) + ((eq type t) + (cons (propertize disp + 'face 'helm-ff-directory + 'help-echo (expand-file-name i)) + i)) + (t (cons (propertize disp + 'face 'helm-ff-file + 'help-echo (expand-file-name i)) + i))))) + +(defclass helm-files-in-current-dir-source (helm-source-sync helm-type-file) + ((candidates :initform (lambda () + (with-helm-current-buffer + (let ((dir (helm-current-directory))) + (when (file-accessible-directory-p dir) + (directory-files dir t)))))) + (pattern-transformer :initform 'helm-recentf-pattern-transformer) + (match-part :initform (lambda (candidate) + (if (or helm-ff-transformer-show-only-basename + helm-recentf--basename-flag) + (helm-basename candidate) candidate))) + (fuzzy-match :initform t) + (migemo :initform t))) + +(defvar helm-source-files-in-current-dir + (helm-make-source "Files from Current Directory" + helm-files-in-current-dir-source)) + + +;;; External searching file tools. +;; +;; Tracker desktop search +(defvar helm-source-tracker-cand-incomplete nil "Contains incomplete candidate") +(defun helm-source-tracker-transformer (candidates _source) + (helm-log "received: %S" candidates) + (cl-loop for cand in candidates + for path = (when (stringp helm-source-tracker-cand-incomplete) + (caar (helm-highlight-files + (list helm-source-tracker-cand-incomplete)))) + for built = (if (not (stringp cand)) cand + (let ((snippet cand)) + (unless (or (null path) + (string= "" path) + (not (string-match-p + "\\`[[:space:]]*\\.\\.\\." + snippet))) + (let ((complete-candidate + (cons (concat path "\n" snippet) path))) + (setq helm-source-tracker-cand-incomplete nil) + (helm-log "built: %S" complete-candidate) + complete-candidate)))) + when (and (stringp cand) + (string-match "\\`[[:space:]]*file://" cand)) + do (setq helm-source-tracker-cand-incomplete ; save path + (replace-match "" t t cand)) end + collect built)) + +(defvar helm-source-tracker-search + (helm-build-async-source "Tracker Search" + :candidates-process + (lambda () + (start-process "tracker-search-process" nil + "tracker-search" + "--disable-color" + "--limit=512" + helm-pattern)) + :filtered-candidate-transformer #'helm-source-tracker-transformer + ;;(multiline) ; https://github.com/emacs-helm/helm/issues/529 + :keymap helm-generic-files-map + :action 'helm-type-file-actions + :action-transformer '(helm-transform-file-load-el + helm-transform-file-browse-url) + :requires-pattern 3) + "Source for retrieving files matching the current input pattern +with the tracker desktop search.") + +;; Spotlight (MacOS X desktop search) +(defclass helm-mac-spotlight-source (helm-source-async helm-type-file) + ((candidates-process :initform + (lambda () + (start-process + "mdfind-process" nil "mdfind" helm-pattern))) + (requires-pattern :initform 3))) + +(defvar helm-source-mac-spotlight + (helm-make-source "mdfind" helm-mac-spotlight-source) + "Source for retrieving files via Spotlight's command line +utility mdfind.") + + +;;; Findutils +;; +;; +(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 + :keymap helm-generic-files-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 disp = (if (and helm-ff-transformer-show-only-basename + (not (string-match "[.]\\{1,2\\}$" i))) + (helm-basename abs) abs) + collect (cond ((eq t type) + (cons (propertize disp 'face 'helm-ff-directory) + abs)) + ((stringp type) + (cons (propertize disp 'face 'helm-ff-symlink) + abs)) + (t (cons (propertize disp 'face 'helm-ff-file) + 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 (helm-find--build-cmd-line)) + (proc (start-file-process-shell-command "hfind" helm-buffer cmd))) + (helm-log "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") + (with-helm-window + (setq mode-line-format + '(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format "[Find process finished - (%s results)]" + (max (1- (count-lines + (point-min) (point-max))) + 0)) + 'face 'helm-locate-finish)))) + (force-mode-line-update)) + (helm-log "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))) + +;; helm-find-files integration. +(defun helm-ff-find-sh-command (_candidate) + "Run `helm-find' from `helm-find-files'." + (helm-find-1 helm-ff-default-directory)) + +(defun helm-ff-run-find-sh-command () + "Run find shell command action with key from `helm-find-files'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-ff-find-sh-command))) +(put 'helm-ff-run-find-sh-command 'helm-only t) + + +;;; 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))) + +(defvar org-directory) +;;;###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* ((hist (and arg helm-ff-history (helm-find-files-history))) + (smart-input (or hist (helm-find-files-initial-input))) + (default-input (expand-file-name (helm-current-directory))) + (input (cond (helm-find-file-ignore-thing-at-point + default-input) + ((and (eq major-mode 'org-agenda-mode) + org-directory + (not smart-input)) + (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 (nth 0 (file-attributes input)))) + (presel (helm-aif (or hist + (and input-as-presel input) + (buffer-file-name (current-buffer)) + (and (eq major-mode 'dired-mode) + smart-input)) + (if helm-ff-transformer-show-only-basename + (helm-basename it) it)))) + (set-text-properties 0 (length input) nil input) + (helm-find-files-1 input (and presel (null helm-ff-no-preselect) + (concat "^" (regexp-quote presel)))))) + +;;;###autoload +(defun helm-for-files () + "Preconfigured `helm' for opening files. +Run all sources defined in `helm-for-files-preferred-list'." + (interactive) + (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*")) + +;;;###autoload +(defun helm-multi-files () + "Preconfigured helm similar to `helm-for-files' but that don't run locate. +Allow toggling from locate to others sources. +This allow seeing first if what you search is in other sources before launching +locate." + (interactive) + (unless helm-source-buffers-list + (setq helm-source-buffers-list + (helm-make-source "Buffers" 'helm-source-buffers))) + (setq helm-multi-files--toggle-locate nil) + (let ((sources (remove 'helm-source-locate helm-for-files-preferred-list)) + (old-key (lookup-key + helm-map + (read-kbd-macro helm-multi-files-toggle-locate-binding)))) + (with-helm-temp-hook 'helm-after-initialize-hook + (define-key helm-map (kbd helm-multi-files-toggle-locate-binding) + 'helm-multi-files-toggle-to-locate)) + (unwind-protect + (helm :sources sources + :ff-transformer-show-only-basename nil + :buffer "*helm multi files*") + (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*")) + +;;;###autoload +(defun helm-delete-tramp-connection () + "Allow deleting tramp connection or marked tramp connections at once. + +This replace `tramp-cleanup-connection' which is partially broken in +emacs < to 25.1.50.1 (See Emacs Bug#24432). + +It allows additionally to delete more than one connection at once." + (interactive) + (let ((helm-quit-if-no-candidate + (lambda () + (message "No Tramp connection found")))) + (helm :sources (helm-build-sync-source "Tramp connections" + :candidates (tramp-list-connections) + :candidate-transformer (lambda (candidates) + (cl-loop for v in candidates + for name = (apply #'tramp-make-tramp-file-name + (cl-loop for i across v collect i)) + when (or (processp (tramp-get-connection-process v)) + (buffer-live-p (get-buffer (tramp-buffer-name v)))) + collect (cons name v))) + :action (lambda (_vec) + (let ((vecs (helm-marked-candidates))) + (cl-loop for v in vecs + do (progn + (tramp-cleanup-connection v) + (remhash v tramp-cache-data)))))) + :buffer "*helm tramp connections*"))) + + +(provide 'helm-files) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-files.el ends here diff --git a/helm-font.el b/helm-font.el new file mode 100644 index 00000000..c88e3ba9 --- /dev/null +++ b/helm-font.el @@ -0,0 +1,201 @@ +;;; helm-font --- Font and ucs selection for Helm -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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) + +(defgroup helm-font nil + "Related applications to display fonts in helm." + :group 'helm) + +(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 "") 'helm-ucs-persistent-insert) + map) + "Keymap for `helm-ucs'.") + +(defface helm-ucs-char + '((((class color) (background dark)) (: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 (assoc '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) + +(defun helm-calculate-ucs-max-len () + "Calculate the length of longest `ucs-names' candidate." + (cl-loop for (_n . v) in (ucs-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-ucs-init () + "Initialize an 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 + (cl-loop for (n . v) in (ucs-names) + for len = (length (format "#x%x:" v)) + 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 (string= "" n) collect + (concat code (make-string diff ? ) + char " " n))))) + +(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 (candidate n) + (when (string-match + "^(\\(#x[a-f0-9]+\\)): *\\(.\\) *\\([^:]+\\)+" + candidate) + (with-helm-current-buffer + (insert (match-string n candidate))))) + +(defun helm-ucs-insert-char (candidate) + (helm-ucs-insert candidate 2)) + +(defun helm-ucs-insert-code (candidate) + (helm-ucs-insert candidate 1)) + +(defun helm-ucs-insert-name (candidate) + (helm-ucs-insert candidate 3)) + +(defun helm-ucs-persistent-insert () + (interactive) + (with-helm-alive-p + (helm-attrset 'action-insert 'helm-ucs-insert-char) + (helm-execute-persistent-action 'action-insert))) +(put 'helm-ucs-persistent-insert 'helm-only t) + +(defun helm-ucs-persistent-forward () + (interactive) + (with-helm-alive-p + (helm-attrset '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-attrset '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-attrset 'action-delete 'helm-ucs-delete-backward) + (helm-execute-persistent-action 'action-delete))) +(put 'helm-ucs-persistent-delete 'helm-only 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 + :match-part (lambda (candidate) (cadr (split-string candidate ":"))) + :filtered-candidate-transformer + (lambda (candidates _source) (sort candidates #'helm-generic-sort-fn)) + :action '(("Insert character" . helm-ucs-insert-char) + ("Insert character name" . helm-ucs-insert-name) + ("Insert character code in hex" . helm-ucs-insert-code) + ("Forward char" . helm-ucs-forward-char) + ("Backward char" . helm-ucs-backward-char) + ("Delete char backward" . helm-ucs-delete-backward))) + "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 () + "Preconfigured helm for `ucs-names' math symbols." + (interactive) + (let ((char (helm-aif (char-after) (string it)))) + (helm :sources 'helm-source-ucs + :keymap helm-ucs-map + :history 'helm-ucs-history + :input (and char (multibyte-string-p char) char) + :buffer "*helm ucs*"))) + +(provide 'helm-font) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-font.el ends here diff --git a/helm-grep.el b/helm-grep.el new file mode 100644 index 00000000..1bba7523 --- /dev/null +++ b/helm-grep.el @@ -0,0 +1,1471 @@ +;;; helm-grep.el --- Helm Incremental Grep. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-regexp) + +;;; load wgrep proxy if it's available +(require 'wgrep-helm nil t) + +(declare-function helm-buffer-list "helm-buffers") +(declare-function helm-elscreen-find-file "helm-elscreen" (file)) +(declare-function View-quit "view") +(declare-function doc-view-goto-page "doc-view" (page)) +(declare-function helm-mm-split-pattern "helm-multi-match") +(declare-function helm--ansi-color-apply "helm-lib") +(defvar helm--ansi-color-regexp) + + +(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 , +here 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 +independents, 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 handle badly + repeated remote processes in a short delay (< to 5s)." + :group 'helm-grep + :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." + :group 'helm-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." + :group 'helm-grep + :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 matchs will be highlighted according to GREP_COLORS env var." + :group 'helm-grep + :type 'string) + +(defcustom helm-grep-use-ioccur-style-keys t + "Use Arrow keys to jump to occurences." + :group 'helm-grep + :type 'boolean) + +(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 `doc-view-mode' will be used instead of an external command." + :group 'helm-grep + :type 'string) + +(defcustom helm-grep-max-length-history 100 + "Max number of elements to save in `helm-grep-history'." + :group 'helm-grep + :type 'integer) + +(defcustom helm-zgrep-file-extension-regexp + ".*\\(\\.gz\\|\\.bz\\|\\.xz\\|\\.lzma\\)$" + "Default file extensions zgrep will search in." + :group 'helm-grep + :type 'string) + +(defcustom helm-grep-preferred-ext nil + "This file extension will be preselected for grep." + :group 'helm-grep + :type 'string) + +(defcustom helm-grep-save-buffer-name-no-confirm nil + "when *hgrep* already exists,auto append suffix." + :group 'helm-grep + :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." + :group 'helm-grep + :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." + :group 'helm-grep + :type '(repeat string)) + +(defcustom helm-grep-truncate-lines t + "When nil the grep line that appears will not be truncated." + :group 'helm-grep + :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." + :group 'helm-grep + :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 + (lambda () (and (locate-library "elscreen") + "Find file in Elscreen")) + 'helm-grep-jump-elscreen + "Save results in grep buffer" 'helm-grep-save-results + "Find file other window" 'helm-grep-other-window) + "Actions for helm grep." + :group 'helm-grep + :type '(alist :key-type string :value-type function)) + + +;;; 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)) :foreground "#b00000") + (((background dark)) :foreground "gold1")) + "Face used to highlight grep matches." + :group 'helm-grep-faces) + +(defface helm-grep-file + '((t (:foreground "BlueViolet" + :underline t))) + "Face used to highlight grep results filenames." + :group 'helm-grep-faces) + +(defface helm-grep-lineno + '((t (:foreground "Darkorange1"))) + "Face used to highlight grep number lines." + :group 'helm-grep-faces) + +(defface helm-grep-finish + '((t (:foreground "Green"))) + "Face used in mode line when grep is finish." + :group 'helm-grep-faces) + +(defface helm-grep-cmd-line + '((t (:inherit diff-added))) + "Face used to highlight grep command line when no results." + :group 'helm-grep-faces) + + +;;; 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-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-x C-s") 'helm-grep-run-save-buffer) + (when helm-grep-use-ioccur-style-keys + (define-key map (kbd "") 'helm-execute-persistent-action) + (define-key map (kbd "") 'helm-grep-run-default-action)) + (delq nil 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 "C-w") 'helm-yank-text-at-point) + 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)) + + +;;; 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-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]+\\):\\(.*\\)") + + +;;; 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))) + (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--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) + (if helm-grep-in-recurse + (concat (or include ignored-files) + " " ignored-dirs) + ignored-files))) + (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 (split-string helm-pattern)) + (pipes + (helm-aif (cdr patterns) + (cl-loop with pipcom = (pcase (helm-grep-command) + ((or "grep" "zgrep" "git-grep") + "grep --color=always") + ;; Sometimes ack-grep cmd is ack only. + ((and (pred (string-match-p "ack")) ack) + (format "%s --color" ack))) + 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) + non-essential) + ;; Start grep process. + (helm-log "Starting Grep process in directory `%s'" default-directory) + (helm-log "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 + "grep" 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 + ;; [FIXME] This is a workaround for zgrep + ;; that exit with code 1 + ;; after a certain amount of results. + (not (with-helm-buffer helm-grep-use-zgrep))) + (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)] " + (if helm-grep-use-zgrep + "Zgrep" + (capitalize + (if helm-grep-in-recurse + (helm-grep-command t) + (helm-grep-command))))) + 'face 'helm-grep-finish)))))) + ((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 + "[%s process finished - (%s results)] " + (if helm-grep-use-zgrep + "Zgrep" + (capitalize + (if helm-grep-in-recurse + (helm-grep-command t) + (helm-grep-command)))) + (helm-get-candidate-number)) + 'face 'helm-grep-finish)))) + (force-mode-line-update))) + ;; Catch error output in log. + (t (helm-log + "Error: %s %s" + (if helm-grep-use-zgrep "Zgrep" "Grep") + (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 mark) + "Define a default action for `helm-do-grep-1' on CANDIDATE. +WHERE can be one of other-window, elscreen, other-frame." + (let* ((split (helm-grep-split-line candidate)) + (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 (point-at-bol) 'help-echo)) + (car split))) + (tramp-method (file-remote-p (or helm-ff-default-directory + default-directory) 'method)) + (tramp-host (file-remote-p (or helm-ff-default-directory + default-directory) 'host)) + (tramp-prefix (concat "/" tramp-method ":" tramp-host ":")) + (fname (if tramp-host + (concat tramp-prefix loc-fname) loc-fname))) + (cl-case where + (other-window (find-file-other-window fname)) + (elscreen (helm-elscreen-find-file fname)) + (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)) (doc-view-goto-page lineno))) + (t (find-file fname))) + (unless (or (eq where 'grep) (eq where 'pdf)) + (helm-goto-line lineno)) + (when mark + (set-marker (mark-marker) (point)) + (push-mark (point) 'nomsg)) + ;; 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'." + (if current-prefix-arg + (helm-grep-action candidate nil 'mark) + (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-grep-jump-elscreen (candidate) + "Jump to result in elscreen from helm grep." + (helm-grep-action candidate 'elscreen)) + +(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))) + (sel (if allow-mode + (buffer-substring (point-at-bol) (point-at-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 (point-at-bol) (point-at-eol))) + (unless (or (string= current-fname + (car (helm-grep-split-line sel))) + (and (eq major-mode 'helm-grep-mode) + (not (get-text-property (point-at-bol) 'help-echo)))) + (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 (point-at-bol) 'help-echo) + (goto-char it) + (forward-line 1)) + (funcall mark-maybe))) + (helm-follow-execute-persistent-action-maybe) + (helm-log-run-hook 'helm-move-selection-after-hook))) + +;;;###autoload +(defun helm-goto-precedent-file () + "Go to precedent 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 precedent file in helm grep/etags buffers." + (interactive) + (with-helm-window + (helm-goto-next-or-prec-file 1))) + +(defun helm-grep-run-default-action () + "Run grep default action from `helm-do-grep-1'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-grep-action))) +(put 'helm-grep-run-default-action 'helm-only t) + +(defun helm-grep-run-other-window-action () + "Run grep goto other window action from `helm-do-grep-1'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-grep-other-window))) +(put 'helm-grep-run-other-window-action 'helm-only t) + +(defun helm-grep-run-other-frame-action () + "Run grep goto other frame action from `helm-do-grep-1'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-grep-other-frame))) +(put 'helm-grep-run-other-frame-action 'helm-only t) + +(defun helm-grep-run-save-buffer () + "Run grep save results action from `helm-do-grep-1'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-grep-save-results))) +(put 'helm-grep-run-save-buffer 'helm-only t) + + +;;; helm-grep-mode +;; +;; +(defun helm-grep-save-results (candidate) + (helm-grep-action candidate 'grep)) + +(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-name (assoc-default 'name (helm-get-current-source)))) + (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 buffer-read-only t) + (let ((inhibit-read-only t)) + (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)))))) + (helm-grep-mode)) + (pop-to-buffer buf) + (message "Helm %s Results saved in `%s' buffer" src-name buf))) + +(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)) +(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 (current-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) + (helm--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)) + ;; needed for wgrep. + 'helm-realvalue line) + "\n")))) + (message "Reverting buffer done")))) + +(defun helm-gm-next-file () + (interactive) + (helm-goto-next-or-prec-file 1)) + +(defun helm-gm-precedent-file () + (interactive) + (helm-goto-next-or-prec-file -1)) + +(defun helm-grep-mode-jump () + (interactive) + (helm-grep-action + (buffer-substring (point-at-bol) (point-at-eol)))) + +(defun helm-grep-mode-jump-other-window-1 (arg) + (let ((candidate (buffer-substring (point-at-bol) (point-at-eol)))) + (condition-case nil + (progn + (save-selected-window + (helm-grep-action candidate 'other-window) + (recenter)) + (forward-line arg)) + (error nil)))) + +(defun helm-grep-mode-jump-other-window-forward () + (interactive) + (helm-grep-mode-jump-other-window-1 1)) + +(defun helm-grep-mode-jump-other-window-backward () + (interactive) + (helm-grep-mode-jump-other-window-1 -1)) + +(defun helm-grep-mode-jump-other-window () + (interactive) + (let ((candidate (buffer-substring (point-at-bol) (point-at-eol)))) + (condition-case nil + (helm-grep-action candidate 'other-window) + (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 Issue #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 + "^ *--\\(\\[no\\]\\)\\([^. ]+\\) *\\(.*\\)" nil t) + collect (cons (concat (match-string 2) + " [" (match-string 3) "]") + (match-string 2)) + collect (cons (concat "no" (match-string 2) + " [" (match-string 3) "]") + (concat "no" (match-string 2)))))) + +(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." + (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 +;; +;; +(defclass helm-grep-class (helm-source-async) + ((candidates-process :initform 'helm-grep-collect-candidates) + (filter-one-by-one :initform 'helm-grep-filter-one-by-one) + (keymap :initform helm-grep-map) + (nohighlight :initform t) + (nomark :initform t) + (backend :initarg :backend + :initform nil + :documentation + " The grep backend that will be used. + It is actually used only as an internal flag + and don'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))) + +(defvar helm-source-grep nil) + +(defmethod helm--setup-source ((source helm-grep-class)) + (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 specify which backend to use +It is used actually 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." + (when (and (helm-grep-use-ack-p) + helm-ff-default-directory + (file-remote-p helm-ff-default-directory)) + (error "Error: Remote operation not supported with ack-grep.")) + (let* (non-essential + (exts (and recurse + ;; [FIXME] I could handle this from helm-walk-directory. + (not (eq backend 'zgrep)) ; zgrep doesn't handle -r opt. + (not (helm-grep-use-ack-p :where 'recursive)) + (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 + (helm-grep-use-ack-p :where 'recursive) + ;; 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)))) + ;; 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 + (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)) + 'default-directory helm-ff-default-directory) ;; [1] + ;; Setup the source. + (set source (helm-make-source src-name 'helm-grep-class + :backend backend)) + (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) + (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 (helm--ansi-color-apply candidate) candidate)) + (split (helm-grep-split-line line)) + (fname (if (and root split) + (expand-file-name (car split) 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 fname) + ":" + (propertize lineno 'face 'helm-grep-lineno) + ":" + (if ansi-p str (helm-grep-highlight-match str t))) + line) + ""))) + +(defun helm-grep-filter-one-by-one (candidate) + "`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 (null (eq major-mode 'helm-grep-mode)) + (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))))) + +(defun helm-grep-highlight-match (str &optional multi-match) + "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 (#1176) + (goto-char (point-min)) + (cl-loop for reg in + (if multi-match + ;; (m)occur. + (cl-loop for r in (helm-mm-split-pattern + helm-pattern) + unless (string-match "\\`!" r) + collect + (helm-aif (and helm-migemo-mode + (assoc r helm-mm--previous-migemo-info)) + (cdr it) r)) + ;; async sources (grep, gid etc...) + (list helm-input)) + do + (while (and (re-search-forward 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) + "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 helm-pdfgrep-default-command + helm-pattern + fnargs)) + process-connection-type) + ;; Start pdf grep process. + (helm-log "Starting Pdf Grep process in directory `%s'" default-directory) + (helm-log "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)) + (helm-log "Error: Pdf grep %s" + (replace-regexp-in-string "\n" "" event)))))))) + +(defun helm-do-pdfgrep-1 (only) + "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 never used 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)) + :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 +;; +;; https://github.com/ggreer/the_silver_searcher +;; https://github.com/monochromegane/the_platinum_searcher + +(defcustom helm-grep-ag-command + "ag --line-numbers -S --hidden --color --nogroup %s %s %s" + "The default command for AG or PT. +Takes three format specs, the first for type(s), the second for pattern +and the third for directory. + +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). + +You can use safely \"--color\" (default)." + :group 'helm-grep + :type 'string) + +(defun helm-grep--ag-command () + (car (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\"." + (with-temp-buffer + (when (equal (call-process (helm-grep--ag-command) + nil t nil "--list-file-types") 0) + (goto-char (point-min)) + (cl-loop while (re-search-forward "^ *\\(--[a-z]*\\)" nil t) + collect (match-string 1))))) + +(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 returns `helm-grep-ag-get-types' +if available with current AG version." + (let* ((patterns (split-string pattern)) + (pipe-cmd (cond ((executable-find "ack") "ack --color") + ((executable-find "ack-grep") "ack-grep --color") + (t "grep --perl-regexp --color=always"))) + (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 ((cmd-line (helm-grep-ag-prepare-cmd-line + helm-pattern directory type))) + (set (make-local-variable 'helm-grep-last-cmd-line) cmd-line) + (helm-log "Starting %s process in directory `%s'" + (helm-grep--ag-command) directory) + (helm-log "Command line used was:\n\n%s" + (concat ">>> " cmd-line "\n\n")) + (prog1 + (start-process-shell-command + "ag" 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 (helm-grep--ag-command))) + 'face 'helm-grep-finish)))))) + ((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 + "[%s process finished - (%s results)] " + (upcase (helm-grep--ag-command)) + (helm-get-candidate-number)) + 'face 'helm-grep-finish)))) + (force-mode-line-update))) + (t (helm-log + "Error: %s %s" + (helm-grep--ag-command) + (replace-regexp-in-string "\n" "" event)))))))))) + +(defclass helm-grep-ag-class (helm-source-async) + ((nohighlight :initform t) + (keymap :initform helm-grep-map) + (help-message :initform 'helm-grep-help-message) + (filter-one-by-one :initform 'helm-grep-filter-one-by-one) + (persistent-action :initform 'helm-grep-persistent-action) + (candidate-number-limit :initform 99999) + (requires-pattern :initform 2) + (nomark :initform t) + (action :initform 'helm-grep-actions))) + +(defvar helm-source-grep-ag nil) + +(defmethod helm--setup-source ((source helm-grep-ag-class)) + (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) + "Start helm ag in DIRECTORY maybe searching in files of type TYPE." + (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))) + :candidates-process + (lambda () (helm-grep-ag-init directory type)))) + (helm :sources 'helm-source-grep-ag + :keymap helm-grep-map + :truncate-lines helm-grep-truncate-lines + :buffer (format "*helm %s*" (helm-grep--ag-command)))) + +(defun helm-grep-ag (directory with-types) + "Start grep AG in DIRECTORY. +When WITH-TYPES is non-nil provide completion on AG types." + (helm-grep-ag-1 directory + (helm-aif (and with-types + (helm-grep-ag-get-types)) + (helm-comp-read + "Ag type: " it + :must-match t + :marked-candidates t + :fc-transformer 'helm-adaptive-sort + :buffer "*helm ag types*")))) + +;;; Git grep +;; +;; +(defvar helm-source-grep-git nil) + +(defcustom helm-grep-git-grep-command + "git --no-pager grep -n%cH --color=always --exclude-standard --no-index --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. +You have also to enable this in global \".gitconfig\" with + \"git config --global core.excludesfile ~/.gitignore_global\"." + :group 'helm-grep + :type 'string) + +(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 help-echo 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) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-grep.el ends here diff --git a/helm-help.el b/helm-help.el new file mode 100644 index 00000000..e39e502e --- /dev/null +++ b/helm-help.el @@ -0,0 +1,1124 @@ +;;; helm-help.el --- Help messages for Helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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) + +(defvar helm-org-headings--nofilename) +(declare-function helm-source-org-headings-for-files "helm-org.el") + + +(defgroup helm-help nil + "Embedded help for `helm'." + :group 'helm) + +(defface helm-helper + '((t :inherit helm-header)) + "Face for helm help string in minibuffer." + :group 'helm-help) + +(defcustom helm-documentation-file "~/.emacs.d/helm-doc.org" + "The file where you want to save helm documentation." + :group 'helm-help + :type 'string) + +(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-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-apt-help-message + helm-el-package-help-message + helm-M-x-help-message + helm-imenu-help-message + helm-colors-help-message + helm-semantic-help-message + helm-kmacro-help-message)) + + +;;;###autoload +(defun helm-documentation (arg) + "Preconfigured helm for helm documentation. +With a prefix arg refresh the documentation. + +Find here the documentation of all sources actually documented." + (interactive "P") + (require 'helm-org) + (when arg (delete-file helm-documentation-file) + (helm-aif (get-file-buffer helm-documentation-file) + (kill-buffer it))) + (unless (file-exists-p helm-documentation-file) + (with-temp-file helm-documentation-file + (erase-buffer) + (cl-loop for elm in helm-help--string-list + for str = (symbol-value elm) + do (insert (substitute-command-keys + (if (functionp str) (funcall str) str)) + "\n\n")))) + (let ((helm-org-headings--nofilename t)) + (helm :sources (helm-source-org-headings-for-files + (list helm-documentation-file)) + :candidate-number-limit 99999 + :buffer "*helm documentation*"))) + +;;; Local help messages. + +;;; `helm-buffer-list' help +;; +;; +(defvar helm-buffer-help-message + "* Helm Buffer + +** Tips + +*** Completion + +**** Major-mode + +You can enter a partial name of major-mode (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\" will list all buffers but the ones in lisp-mode, sh-mode and +fundamental-mode. + +Enter then a space and a pattern to narrow down to buffers matching this pattern. + +**** Search inside buffers + +If you enter a space and a pattern prefixed by \"@\" helm will search for text matching +this pattern INSIDE the buffer (i.e not in the name of buffer). +NOTE that if you enter your pattern prefixed with \"@\" but escaped, helm will search a buffer +matching \"@pattern\" but will not search inside. + +**** Search by directory name + +If you prefix the beginning of pattern with \"/\" the match will occur on directory name +of buffer, it is interesting to narrow down to one directory for example, subsequent string +entered after a space will match on buffer-name only. +Note that negation is not supported for matching on buffer-file-name. +You can specify more than one directory starting from helm v1.6.8 + +**** Fuzzy matching + +Note that if `helm-buffers-fuzzy-matching' is non--nil you will have +fuzzy matching on buffer names (not on directory name matching and major-mode though). +A pattern starting with \"^\" will disable fuzzy matching and will match by exact regexp. + +**** Examples + +if I enter in pattern prompt: + + \"*lisp ^helm @moc\" + +helm will narrow down the list by selecting only buffers that are in lisp mode, start by helm +and match \"moc\" in their contents. + +if I enter in pattern prompt: + + \"*lisp ^helm moc\" + +Notice there is no \"@\" this time +helm will look for lisp mode buffers starting by \"helm\" and have \"moc\" in their name. + +if I enter in pattern prompt: + + \"*!lisp !helm\" + +helm will narrow down to buffers that are not in \"lisp\" mode and that do not match \"helm\" + +if I enter in pattern prompt: + + /helm/ w3 + +helm will narrow 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 for your buffer in a list. +This list is customizable, see `helm-buffers-favorite-modes'. + +*** Killing buffers + +You have a command to kill buffer(s) and quit emacs and a command to kill buffers one by one +\(no marked\) without quitting helm. + +You can run this persistent kill buffer command either with the regular +`helm-execute-persistent-action' called with a prefix arg (C-u C-j) or with its specific command +`helm-buffer-run-kill-persistent' see binding below. + +*** Meaning of colors and prefixes for buffers + +Remote buffers are prefixed with '@'. +Red => Buffer have its file modified on disk by an external process. +Indianred2 => Buffer exists but its file have been deleted. +Orange => Buffer is modified and its file not saved to disk. +Italic => A non--file buffer. + +** Commands +\\ +\\[helm-buffer-run-zgrep]\t\tGrep Buffer(s) works as zgrep too (C-u grep all buffers but non--file buffers). +\\[helm-buffers-run-multi-occur]\t\tMulti Occur buffer or marked buffers. (C-u toggle force searching current-buffer). +\\[helm-buffer-switch-other-window]\t\tSwitch other window. +\\[helm-buffer-switch-other-frame]\t\tSwitch other frame. +\\[helm-buffers-run-browse-project]\t\tBrowse Project from buffer. +\\[helm-buffer-run-query-replace-regexp]\t\tQuery replace regexp in marked buffers. +\\[helm-buffer-run-query-replace]\t\tQuery replace in marked buffers. +\\[helm-buffer-run-ediff]\t\tEdiff current buffer with candidate. If two marked buffers ediff those buffers. +\\[helm-buffer-run-ediff-merge]\t\tEdiff merge current buffer with candidate. If two marked buffers ediff merge those buffers. +\\[helm-buffer-diff-persistent]\t\tToggle Diff buffer with saved file without quitting. +\\[helm-buffer-revert-persistent]\t\tRevert buffer without quitting. +\\[helm-buffer-save-persistent]\t\tSave buffer without quitting. +\\[helm-buffer-run-kill-buffers]\t\tDelete marked buffers and quit. +\\[helm-buffer-run-kill-persistent]\t\tDelete buffer without quitting helm. +\\[helm-toggle-all-marks]\t\tToggle all marks. +\\[helm-mark-all]\t\tMark all. +\\[helm-toggle-buffers-details]\t\tToggle details. +\\[helm-buffers-toggle-show-hidden-buffers]\t\tShow hidden buffers. +\\[helm-buffers-mark-similar-buffers]\t\tMark all buffers with same type (color) than current.") + +;;; 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. + +**** Use `C-j' (persistent action) on a directory to go down one level + +On a symlinked directory a prefix arg will allow expanding to its true name. + +**** Use `C-l' on a directory to go up one level + +**** Use `C-r' to walk back the resulting tree of all the `C-l' you did + +Note: The tree is reinitialized each time you enter a new tree with `C-j' +or by entering some pattern in prompt. + +*** Find file at point + +Helm is using `ffap' partially or completely to find file at point +depending on value of `helm-ff-guess-ffap-filenames'. +You can use full `ffap' by setting this to non-nil (annoying). +Default value is nil which make `ffap' working partially. + +**** Find file at number line + +With something like this at point: + + ~/elisp/helm/helm.el:1234 + +Helm will find this file at line number 1234. + +**** Find url at point + +When an url is found at point, helm expand to that url only. +Pressing RET jump to that url using `browse-url-browser-function'. + +**** Find mail at point + +When a mail address is found at point helm expand to this email address +prefixed by \"mailto:\". Pressing RET open a message buffer with this mail +address. + +*** Quick pattern expansion + +**** Enter `~/' at end of pattern to quickly reach home directory + +**** Enter `/' at end of pattern to quickly reach root of your file system + +**** Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session) + +If you are already in `default-directory' this will move cursor on top. + +**** Enter `../' at end of pattern will reach upper directory, moving cursor on top + +NOTE: This is different from using `C-l' in that `C-l' doesn't move cursor on top but stays on previous +subdir name. + +**** Enter `..name/' at end of pattern start a recursive search of directories matching name under +your current directory, see below the \"Recursive completion on subdirectories\" section for more infos. + +**** Enter any environment var (e.g. `$HOME') at end of pattern, it will be expanded + +**** You can yank any valid filename after pattern, it will be expanded + +**** Special case with url's at point + +This have no effect at end of an url, you have first to kill pattern (`C-k') +before entering one of these quick expansions patterns. + +*** Helm find files is fuzzy matching (start on third char entered) + +e.g. \"fob\" or \"fbr\" will complete \"foobar\" +but \"fb\" will wait for a third char for completing. + +*** Use `C-u C-j' to watch an image or `C-' + +*** `C-j' on a filename will expand in helm-buffer to this filename + +Second hit on `C-j' will display buffer filename. +Third hit on `C-j' will kill buffer filename. +NOTE: `C-u C-j' will display buffer directly. + +*** To browse images directories turn on `helm-follow-mode' and navigate with arrow keys + +You can also use `helm-follow-action-forward' and `helm-follow-action-backward' +\(`C-'). + +*** You can turn off/on (toggle) autoupdate completion at any moment with `C-DEL' + +It is useful when auto completion is enabled and when trying to create a new file +or directory you want to prevent helm trying to complete what you are writing. +NOTE: On a terminal C- may not work, use in this case C-c . + +*** You can create a new directory and a new file at the same time + +Just write the path in prompt and press `'. +e.g. You can create \"~/new/newnew/newnewnew/my_newfile.txt\". + +*** To create a new directory, add a \"/\" at end of new name and press + +*** To create a new file just write the filename not ending with \"/\" + +*** Recursive search from helm find files + +**** You can use helm browse project (see binding below) + +- With no prefix arg + If your current directory is under version control + with one of git or hg and you have installed helm-ls-git and/or helm-ls-hg + https://github.com/emacs-helm/helm-ls-git.git + https://github.com/emacs-helm/helm-ls-hg + you will see all your files under version control, otherwise + you will be back to helm-find-files. +- With one prefix arg + You will see all the files under this directory + and other subdirectories (recursion) and this list of files will be cached. +- With two prefix args + same but the cache will be refreshed. + +**** You can start a recursive search with Locate or Find (See commands below) + +With Locate you can use a local db with a prefix arg. If the localdb doesn't already +exists, you will be prompted for its creation, if it exists and you want to refresh it, +give two prefix args. + +Note that when using locate the helm-buffer is empty until you type something, +but helm use by default the basename of pattern entered in your helm-find-files session, +hitting M-n should just kick in the locate search with this pattern. +If you want to automatically do this add the `helm-source-locate' +to `helm-sources-using-default-as-input'. + +**** Recursive completion on subdirectories + +Starting from the current directory you are browsing, it is possible +to have completion of all directories under here. +So if you are at \"/home/you/foo/\" and you want to go to \"/home/you/foo/bar/baz/somewhere/else\" +just type \"/home/you/foo/..else\" and hit `C-j' or enter the final \"/\", helm will show you all +possibles directories under \"foo\" matching \"else\". +\(Note that entering two spaces before \"else\" instead of two dots works also). + +NOTE: Completion on subdirectories use locate as backend, you can configure +the command with `helm-locate-recursive-dirs-command'. +Because this completion use an index, you may not have all the recent additions +of directories until you update your index (with `updatedb' for locate). + +*** Insert filename at point or complete filename at point + +On insertion (no completion, i.e nothing at point): + +- `C-c i' => insert absolute file name. +- `C-u C-c i' => insert abbreviate file name. +- `C-u C-u C-c i' => insert relative file name. + +On completion: + +- target starts by ~/ => insert abbreviate file name. +- target starts by / or [a-z]:/ => insert full path. +- otherwise => insert relative file name. + +*** Using wildcard to select multiple files + +Use of wilcard is supported to give a set of files to an action: + +e.g. You can copy all the files with \".el\" extension by using \"*.el\" +and then run your copy action. + +You can do the same but with \"**.el\" (note the two stars), +this will select recursively all \".el\" files under current directory. + +Note that when copying recursively files, you may have files with same name +dispatched in the different subdirectories, so when copying them in the same directory +they would be overwrited. To avoid this helm have a special action called \"backup files\" +that have the same behavior as the command line \"cp --backup=numbered\", it allows you +copying for example many *.jpg files with the same name from different +subdirectories in one directory. +Files with same name are renamed like this: \"foo.txt.~1~\". +NOTE: This command is available only when `dired-async-mode' is used. + +NOTE: When using an action that involve an external backend (e.g. grep), using \"**\" +is not advised (even if it works fine) because it will be slower to select all your files, +you have better time letting the backend doing it, it will be faster. +However, if you know you have not many files it is reasonable to use this, +also using not recursive wilcard (e.g. \"*.el\") is perfectly fine for this. + +This feature (\"**\") is activated by default with the option `helm-file-globstar'. +It is different than the bash shopt globstar feature in that to list files with a named extension +recursively you just have to specify e.g \"**.el\" whereas in bash you have to specify \"**/*.el\" +which is not convenient as \"**.el\". +The directory selection with \"**/\" like bash shopt globstar option is not supported yet. + +*** Query replace regexp on filenames + +You can rename your files by replacing only part of filenames matching +a regexp. + +e.g Rename recursively all files with \".JPG\" extension to \".jpg\": +Use the helm-file-globstar feature described in previous section by +entering at end of helm-find-files pattern \"**.JPG\", then hit `M-%`, +at first prompt enter \"JPG\", at second \"jpg\" and hit `RET`. + +Shortcut for basename without extension, only extension or all are available: + +- Basename without extension => \"%.\" +- Only extension => \".%\" +- All => \"%\" + +So in the example above you could do instead: +At first prompt enter \".%\", at second \"jpg\" and hit `RET`. +Note that when using this instead of using \"JPG\" at first prompt, all extensions +will be renamed to \"jpg\" even if the extension of one of the files is e.g \"png\". + +If you want to rename a serie of files from number 001 to 00x use \\# inside the replacement +string when you will be prompted for it. + +e.g To rename the files \"foo.jpg\" \"bar.jpg\" and \"baz.jpg\" + to \"foo-001.jpg\" \"foo-002.jpg\" \"foo-003.jpg\" + +Use as replace regexp \"%.\" and as replacement string \"foo-\\#\". +Where \"%.\" is same as regexp \".*\\.jpg\". + +Note: You can do this with the serial renames actions you will find in the action menu + for more sophisticated renaming, but using query replace regexp on filenames + is a fast way for most common serial replacements. + +Note also that unlike the serial rename actions the renamed files stay in their initial directory +and are not renamed to current directory, IOW use this (\\#) to rename files inside current directory. + +In the second prompt (replace regexp with) shortcut for `upcase', `downcase' and `capitalize' +are available, respectively `%u', `%d' and `%c'. + +*** Copying renaming asynchronously + +If you use async library (if you have installed helm from MELPA you do) you can enable +async for copying/renaming etc... your files by enabling `dired-async-mode'. + +Note that even when async is enabled, running a copy/rename action with a prefix arg +will execute action synchronously, it will follow also the first file of the marked files +in its destination directory. + +*** Bookmark your `helm-find-files' session + +You can bookmark your `helm-find-files' session with `C-x r m'. +You can retrieve later these bookmarks easily by using M-x helm-filtered-bookmarks +or from the current `helm-find-files' session just hitting `C-x r b'. + +*** Run Gid from `helm-find-files' + +You can navigate to a project containing an ID file created with the `mkid' +command from id-utils, and run the `gid' command which will use the symbol at point +in `helm-current-buffer' as default. + +** Commands +\\ +\\[helm-ff-run-locate]\t\tRun Locate (C-u to specify locate db, M-n insert basename of candidate) +\\[helm-ff-run-browse-project]\t\tBrowse project (`C-u' recurse, `C-u C-u' recurse and refresh db) +\\[helm-ff-run-find-sh-command]\t\tRun Find shell command from this directory. +\\[helm-ff-run-grep]\t\tRun Grep (C-u Recursive). +\\[helm-ff-run-pdfgrep]\t\tRun Pdfgrep on marked files. +\\[helm-ff-run-zgrep]\t\tRun zgrep (C-u Recursive). +\\[helm-ff-run-grep-ag]\t\tRun AG grep on current directory. +\\[helm-ff-run-git-grep]\t\tRun git-grep on current directory. +\\[helm-ff-run-gid]\t\tRun gid (id-utils). +\\[helm-ff-run-etags]\t\tRun Etags (C-u use thing-at-point `C-u C-u' reload cache) +\\[helm-ff-run-rename-file]\t\tRename File (C-u Follow). +\\[helm-ff-run-query-replace-on-marked]\t\tQuery replace on marked files. +\\[helm-ff-run-copy-file]\t\tCopy File (C-u Follow). +\\[helm-ff-run-byte-compile-file]\t\tByte Compile File (C-u Load). +\\[helm-ff-run-load-file]\t\tLoad File. +\\[helm-ff-run-symlink-file]\t\tSymlink File. +\\[helm-ff-run-hardlink-file]\t\tHardlink file. +\\[helm-ff-run-delete-file]\t\tDelete File. +\\[helm-ff-run-kill-buffer-persistent]\t\tKill buffer candidate without quitting. +\\[helm-ff-persistent-delete]\t\tDelete file without quitting. +\\[helm-ff-run-switch-to-eshell]\t\tSwitch to Eshell. +\\[helm-ff-run-eshell-command-on-file]\t\tEshell command on file (C-u Apply on marked files, otherwise treat them sequentially). +\\[helm-ff-run-ediff-file]\t\tEdiff file. +\\[helm-ff-run-ediff-merge-file]\t\tEdiff merge file. +\\[helm-ff-run-complete-fn-at-point]\t\tComplete file name at point. +\\[helm-ff-run-switch-other-window]\t\tSwitch other window. +\\[helm-ff-run-switch-other-frame]\t\tSwitch other frame. +\\[helm-ff-run-open-file-externally]\t\tOpen file with external program (C-u to choose). +\\[helm-ff-run-open-file-with-default-tool]\t\tOpen file externally with default tool. +\\[helm-ff-rotate-left-persistent]\t\tRotate Image Left. +\\[helm-ff-rotate-right-persistent]\t\tRotate Image Right. +\\[helm-find-files-up-one-level]\t\tGo down precedent directory. +\\[helm-ff-run-switch-to-history]\t\tSwitch to last visited directories history. +\\[helm-ff-file-name-history]\t\tSwitch to file name history. +\\[helm-ff-properties-persistent]\t\tShow file properties in a tooltip. +\\[helm-mark-all]\t\tMark all visibles candidates. +\\[helm-ff-run-toggle-auto-update]\t\tToggle auto expansion of directories. +\\[helm-unmark-all]\t\tUnmark all candidates, visibles and invisibles. +\\[helm-ff-run-gnus-attach-files]\t\tGnus attach files to message buffer. +\\[helm-ff-run-print-file]\t\tPrint file, (C-u to refresh printers list). +\\[helm-enlarge-window]\t\tEnlarge helm window. +\\[helm-narrow-window]\t\tNarrow helm window. +\\[helm-ff-run-toggle-basename]\t\tToggle basename/fullpath. +\\[helm-ff-run-find-file-as-root]\t\tFind file as root. +\\[helm-ff-run-find-alternate-file]\t\tFind alternate file. +\\[helm-ff-run-insert-org-link]\t\tInsert org link.") + +;;; Help for `helm-read-file-name' +;; +;; +(defvar helm-read-file-name-help-message + "* Helm read file name + +** Tips + +If you are here, you are probably using a vanilla command like `find-file' +helmized by `helm-mode', this is cool, but it is even better for your file +navigation to use `helm-find-files' which is fully featured. + +*** Navigation + +**** Enter `~/' at end of pattern to quickly reach home directory + +**** Enter `/' at end of pattern to quickly reach root of your file system + +**** Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session) + +If you are in `default-directory' move cursor on top. + +**** Enter `../' at end of pattern will reach upper directory, moving cursor on top + +NOTE: This different to using `C-l' in that `C-l' don't move cursor on top but stay on previous +subdir name. + +**** You can complete with partial basename (start on third char entered) + +E.g. \"fob\" or \"fbr\" will complete \"foobar\" +but \"fb\" will wait for a third char for completing. + +*** Persistent actions + +By default `helm-read-file-name' use the persistent actions of `helm-find-files' + +**** Use `C-u C-j' to watch an image + +**** `C-j' on a filename will expand in helm-buffer to this filename + +Second hit on `C-j' will display buffer filename. +Third hit on `C-j' will kill buffer filename. +NOTE: `C-u C-j' will display buffer directly. + +**** To browse images directories turn on `helm-follow-mode' and navigate with arrow keys + +*** Delete characters backward + +When you want to delete backward characters, e.g. to create a new file or directory, +autoupdate may keep updating to an existent directory preventing you from doing so. +In this 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 C- may not work, use in this case C-c . + +*** Create new directory and files + +**** Create a new directory and a new file at the same time + +You can create a new directory and a new file at the same time, +just write the path in prompt and press . +E.g. You can create \"~/new/newnew/newnewnew/my_newfile.txt\". + +**** To create a new directory, add a \"/\" at end of new name and press + +**** To create a new file just write the filename not ending with \"/\" + +_NOTE_: File and directory creation work only in some commands (e.g `find-file') +and will not work in other commands where it is not intended to return a file or a directory +\(e.g `list-directory'). + +** Commands +\\ +\\[helm-find-files-up-one-level]\t\tGo down precedent directory. +\\[helm-ff-run-toggle-auto-update]\t\tToggle auto expansion of directories. +\\[helm-ff-run-toggle-basename]\t\tToggle basename. +\\[helm-ff-file-name-history]\t\tFile name history. +C/\\[helm-cr-empty-string]\t\tMaybe return empty string (unless `must-match'). +\\[helm-next-source]\t\tGoto next source. +\\[helm-previous-source]\t\tGoto previous source.") + +;;; Generic file help - Used by locate. +;; +;; +(defvar helm-generic-file-help-message + "* Helm Generic files + +** Tips + +*** Locate + +You can add after writing search pattern any of the locate command line options. +e.g. -b, -e, -n ...etc. +See Man locate for more infos. + +Some other sources (at the moment recentf and file in current directory sources) +support the -b flag for compatibility with locate when they are used with it. + +*** Browse project + +When your directory is not under version control, +don't forget to refresh your cache when files have been added/removed in your directory. + +*** Find command + +Recursively search files using \"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 options directly to find after a \"*\" separator. +For example, this would find all files matching \"book\" that are larger +than 1 megabyte: + + book * -size +1M + +** Commands +\\ +\\[helm-ff-run-toggle-basename]\t\tToggle basename. +\\[helm-ff-run-grep]\t\tRun grep (C-u recurse). +\\[helm-ff-run-zgrep]\t\tRun zgrep. +\\[helm-ff-run-gid]\t\tRun gid (id-utils). +\\[helm-ff-run-pdfgrep]\t\tRun Pdfgrep on marked files. +\\[helm-ff-run-copy-file]\t\tCopy file(s) +\\[helm-ff-run-rename-file]\t\tRename file(s). +\\[helm-ff-run-symlink-file]\t\tSymlink file(s). +\\[helm-ff-run-hardlink-file]\t\tHardlink file(s). +\\[helm-ff-run-delete-file]\t\tDelete file(s). +\\[helm-ff-run-byte-compile-file]\t\tByte compile file(s) (C-u load) (elisp). +\\[helm-ff-run-load-file]\t\tLoad file(s) (elisp). +\\[helm-ff-run-ediff-file]\t\tEdiff file. +\\[helm-ff-run-ediff-merge-file]\t\tEdiff merge file. +\\[helm-ff-run-switch-other-window]\t\tSwitch other window. +\\[helm-ff-properties-persistent]\t\tShow file properties. +\\[helm-ff-run-etags]\t\tRun etags (C-u use tap, C-u C-u reload DB). +\\[helm-yank-text-at-point]\t\tYank text at point. +\\[helm-ff-run-open-file-externally]\t\tOpen file with external program (C-u to choose). +\\[helm-ff-run-open-file-with-default-tool]\t\tOpen file externally with default tool. +\\[helm-ff-run-insert-org-link]\t\tInsert org link.") + +;;; Grep help +;; +;; +(defvar helm-grep-help-message + "* Helm Grep + +** Tips + +*** You can start grep with a prefix arg to recurse in subdirectories +However now that helm support git-grep and AG, you have better time +using one of those for your recursives search. + +*** You can use wild card when selecting files (e.g. *.el) + +*** You can grep in many differents directories by marking files or wild cards + +*** You can save your results in a `helm-grep-mode' buffer, see commands below + +Once in this buffer you can use emacs-wgrep (external package not bundled with helm) +to edit your changes. + +*** Helm grep is supporting multi matching starting from version 1.9.4. +Just add a space between each pattern like in most helm commands. + +*** Important + +Grepping on remote file will work only with grep, not ack-grep, but it is +anyway bad supported as tramp doesn't support multiple process running in a +short delay (less than 5s actually) among other things, +so I strongly advice hitting `C-!' (i.e suspend process) +before entering anything in pattern, and hit again `C-!' when +your regexp is ready to send to remote process, even if helm is handling +this by delaying each process at 5s. +Or even better don't use tramp at all and mount your remote file system on SSHFS. + +* Helm Gid + +** Tips + +Helm gid read 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. +You have access to this command also from `helm-find-files' which allow you to +navigate to another directory to consult its database. + +NOTE: Helm gid support multi matches but only the last pattern entered will be +highlighted due to the lack of ~--color~ support in GID itself. + +* Helm AG + +** Tips + +Helm AG is different from grep or ack-grep in that it works on a directory and not +a list of files. +You can ignore files and directories by using a \".agignore\" file, local to directory +or global when placed in home directory (See AG man page for more infos). +This file supports same entries as what you will find in `helm-grep-ignored-files' and +`helm-grep-ignored-directories'. +As always you can access helm AG from `helm-find-files'. + +Starting at version 0.30 AG allow providing one or more TYPE argument on its command line. +Helm provide completion on these TYPES arguments when available with your AG version, +Use a prefix argument when starting helm ag session to get this completion. +NOTE: You can mark several types to match in your ag query, however on the first versions of +AG providing this, only one type was allowed, so in this case the last marked will take effect. + +* Helm git-grep + +Helm git-grep is searching from current directory +(i.e default-directory or the directory currently browsed by helm-find-files). +If this current directory is a subdirectory of project and you want to match +also upper directories (i.e the whole project) use a prefix arg. + +** Commands +\\ +\\[helm-goto-next-file]\t\tNext File. +\\[helm-goto-precedent-file]\t\tPrecedent File. +\\[helm-yank-text-at-point]\t\tYank Text at point in minibuffer. +\\[helm-grep-run-other-window-action]\t\tJump other window. +\\[helm-grep-run-other-frame-action]\t\tJump other frame. +\\[helm-grep-run-default-action]\t\tRun default action (Same as RET). +\\[helm-grep-run-save-buffer]\t\tSave to a `helm-grep-mode' enabled buffer.") + +;;; Pdf grep help +;; +;; +(defvar helm-pdfgrep-help-message + "* Helm PdfGrep Map + +** Commands +\\ +\\[helm-goto-next-file]\t\tNext File. +\\[helm-goto-precedent-file]\t\tPrecedent File. +\\[helm-yank-text-at-point]\t\tYank Text at point in minibuffer.") + +;;; Etags help +;; +;; +(defvar helm-etags-help-message + "* Helm Etags Map + +** Commands +\\ +\\[helm-goto-next-file]\t\tNext File. +\\[helm-goto-precedent-file]\t\tPrecedent File. +\\[helm-yank-text-at-point]\t\tYank 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 quitting helm. + +** Commands +\\ +\\[helm-ucs-persistent-insert]\t\tInsert char. +\\[helm-ucs-persistent-forward]\t\tForward char. +\\[helm-ucs-persistent-backward]\t\tBackward char. +\\[helm-ucs-persistent-delete]\t\tDelete char backward.") + +;;; Bookmark help +;; +;; +(defvar helm-bookmark-help-message + "* Helm bookmark name + +** Commands +\\ +\\[helm-bookmark-run-jump-other-window]\t\tJump other window. +\\[helm-bookmark-run-delete]\t\tDelete bookmark. +\\[helm-bookmark-run-edit]\t\tEdit bookmark. +\\[helm-bookmark-toggle-filename]\t\tToggle bookmark location visibility.") + +;;; Eshell command on file help +;; +;; +(defvar helm-esh-help-message + "* Helm eshell on file + +** Tips + +*** Passing extra args after filename + +Normally your command or alias will be called with file as argument. E.g., + + 'candidate_file' + +But you can also pass an argument or more after 'candidate_file' like this: + + %s [extra_args] + +'candidate_file' will be added at '%s' and your command will look at this: + + 'candidate_file' [extra_args] + +*** Specify many files as args (marked files) + +E.g. file1 file2 ... + +Call `helm-find-files-eshell-command-on-file' with one prefix-arg +Otherwise you can pass one prefix-arg from the command selection buffer. +NOTE: This is not working on remote files. + +With two prefix-arg before starting or from the command selection buffer +the output is printed to your `current-buffer'. + +Note that with no prefix-arg or a prefix-arg value of '(16) (C-u C-u) +the command is called once for each file like this: + + file1 file2 etc... + +** Commands +\\") + +;;; Ido virtual buffer help +;; +;; +(defvar helm-buffers-ido-virtual-help-message + "* Helm ido virtual buffers + +** Commands +\\ +\\[helm-ff-run-switch-other-window]\t\tSwitch other window. +\\[helm-ff-run-switch-other-frame]\t\tSwitch other frame. +\\[helm-ff-run-grep]\t\tGrep file. +\\[helm-ff-run-zgrep]\t\tZgrep file. +\\[helm-ff-run-delete-file]\t\tDelete file. +\\[helm-ff-run-open-file-externally]\t\tOpen file externally.") + +;;; Moccur help +;; +;; +(defvar helm-moccur-help-message + "* Helm Moccur + +** Tips + +*** Matching + +Multiple regexp matching is allowed, just enter a space to separate your regexps. + +Matching empty lines is supported with the regexp \"^$\", you will get the results +with only the buffer-name and the line number, you can of course save and edit these +results (i.e add text to the empty line) . + +*** Automatically matching symbol at point + +You can match automatically the symbol at point, but keeping +the minibuffer empty ready to write into. +This is disabled by default, to enable this you have to add `helm-source-occur' +and `helm-source-moccur' to `helm-sources-using-default-as-input'. + +*** Jump to the corresponding line in the searched buffer + +You can do this with `C-j' (persistent-action), to do it repetitively +you can use `C-' and `C-' or enable `helm-follow-mode' with `C-c C-f'. + +*** Saving results + +Same as with helm-grep, you can save the results with `C-x C-s'. +Of course if you don't save your results, you can get back your session +with `helm-resume'. + +*** Refreshing the resumed session. + +When the buffer(s) where you ran helm-(m)occur have been modified, you will be +warned of this with the buffer flashing to red, you can refresh the buffer by running +`C-c C-u'. +This can be done automatically by customizing `helm-moccur-auto-update-on-resume'. + +*** Refreshing a saved buffer + +Type `g' to update your buffer. + +*** Edit a saved buffer + +First, install wgrep https://github.com/mhayashi1120/Emacs-wgrep +and then: + +1) C-c C-p to edit the buffer(s). +2) C-x C-s to save your changes. + +Tip: Use the excellent iedit https://github.com/tsdh/iedit +to modify occurences in your buffer. + +** Commands +\\ +\\[helm-goto-next-file]\t\tNext Buffer. +\\[helm-goto-precedent-file]\t\tPrecedent Buffer. +\\[helm-yank-text-at-point]\t\tYank Text at point in minibuffer. +\\[helm-moccur-run-goto-line-ow]\t\tGoto line in other window. +\\[helm-moccur-run-goto-line-of]\t\tGoto line in new frame.") + +;;; Helm Top +;; +;; +(defvar helm-top-help-message + "* Helm Top + +** Tips + +** Commands +\\ +\\[helm-top-run-sort-by-com]\t\tSort by commands. +\\[helm-top-run-sort-by-cpu]\t\tSort by cpu usage. +\\[helm-top-run-sort-by-user]\t\tSort alphabetically by user. +\\[helm-top-run-sort-by-mem]\t\tSort by memory.") + +;;; Helm Apt +;; +;; +(defvar helm-apt-help-message + "* Helm Apt + +** Tips + +** Commands +\\ +\\[helm-apt-show-all]\t\tShow all packages. +\\[helm-apt-show-only-installed]\t\tShow installed packages only. +\\[helm-apt-show-only-not-installed]\t\tShow not installed packages only. +\\[helm-apt-show-only-deinstalled]\t\tShow deinstalled (not purged yet) packages only.>") + +;;; Helm elisp package +;; +;; +(defvar helm-el-package-help-message + "* Helm elisp package + +** Tips + +*** Compile all your packages asynchronously + +When using async (if you have installed from MELPA you do), only helm, helm-core, +and magit are compiled asynchronously, if you want all your packages compiled async, +add to your init file: + + (setq async-bytecomp-allowed-packages '(all)) + +*** Upgrade elisp packages + +On initial start (when emacs is fetching packages on remote), if helm find +package to upgrade it will start in the upgradables packages view showing the packages +availables to upgrade. +On further starts, you will have to refresh the list with `C-c C-u', if helm find upgrades +you will have a message telling you some packages are available for upgrade, you can switch to +upgrade view (see below) to see what packages are available for upgrade or just hit `C-c U'. +to upgrade all. + +To see upgradables packages hit . + +Then you can install all upgradables packages with the upgrade all action (`C-c C-u'), +or upgrade only the specific packages by marking them (the new ones) and running +the upgrade action (visible only when there is upgradables packages). +Of course you can upgrade a single package by just running the upgrade action +without marking it (`C-c u' or RET) . + +\*WARNING* You are strongly advised to RESTART emacs after UPGRADING packages. + +*** Meaning of flags prefixing packages (Emacs-25) + +- The flag \"S\" that prefix package names mean that this package is one of `package-selected-packages'. +This feature is only available with emacs-25. + +- The flag \"U\" that prefix package names mean that this package is no more needed. +This feature is only available with emacs-25. + +** Commands +\\ +\\[helm-el-package-show-all]\t\tShow all packages. +\\[helm-el-package-show-installed]\t\tShow installed packages only. +\\[helm-el-package-show-uninstalled]\t\tShow not installed packages only. +\\[helm-el-package-show-upgrade]\t\tShow upgradable packages only. +\\[helm-el-package-show-built-in]\t\tShow built-in packages only. +\\[helm-el-run-package-install]\t\tInstall package(s). +\\[helm-el-run-package-reinstall]\t\tReinstall package(s). +\\[helm-el-run-package-uninstall]\t\tUninstall package(s). +\\[helm-el-run-package-upgrade]\t\tUpgrade package(s). +\\[helm-el-run-package-upgrade-all]\t\tUpgrade all packages upgradables. +\\[helm-el-run-visit-homepage]\t\tVisit package homepage.") + +;;; Helm M-x +;; +;; +(defvar helm-M-x-help-message + "* Helm M-x + +** Tips + +*** You can get help on any command with persistent action (C-j) + +*** Prefix Args + +When you want pass prefix args, you should pass prefix args AFTER starting `helm-M-x', +you will see a prefix arg counter appearing in mode-line notifying you +the number of prefix args entered. + +If you pass prefix args before running `helm-M-x', it will be displayed in prompt, +then the first C-u after `helm-M-x' will be used to clear that prefix args.") + +;;; helm-imenu +;; +;; +(defvar helm-imenu-help-message + "* Helm imenu + +** Tips + +** Commands +\\ +\\[helm-imenu-next-section]\t\tGo to next section. +\\[helm-imenu-previous-section]\t\tGo to previous section.") + +;;; helm-colors +;; +;; +(defvar helm-colors-help-message + "* Helm colors + +** Commands +\\ +\\[helm-color-run-insert-name]\t\tInsert the entry'name. +\\[helm-color-run-kill-name]\t\tKill the entry's name. +\\[helm-color-run-insert-rgb]\t\tInsert entry in RGB format. +\\[helm-color-run-kill-rgb]\t\tKill entry in RGB format.") + +;;; helm semantic +;; +;; +(defvar helm-semantic-help-message + "* Helm semantic + +** Tips + +** Commands +\\") + +;;; helm kmacro +;; +;; +(defvar helm-kmacro-help-message + "* Helm kmacro + +** Tips + +- Start recording some keys with `f3' +- Record new kmacro with `f4' +- Start `helm-execute-kmacro' to list all your macros. + +Use persistent action to run your kmacro as many time as needed, +you can change of kmacro with `helm-next-line' `helm-previous-line'. + +NOTE: You can't record keys running helm commands except `helm-M-x' unless +you don't choose from there a command using helm completion. + +** Commands +\\") + + +;;; Mode line strings +;; +;; +;;;###autoload +(defvar helm-comp-read-mode-line "\ +\\\ +C/\\[helm-cr-empty-string]:Empty \ +\\\ +\\[helm-help]:Help \ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + +;;;###autoload +(defvar helm-read-file-name-mode-line-string "\ +\\\ +\\[helm-help]:Help \ +C/\\[helm-cr-empty-string]:Empty \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend" + "String displayed in mode-line in `helm-source-find-files'.") + +;;;###autoload +(defvar helm-top-mode-line "\ +\\\ +\\[helm-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + + +(provide 'helm-help) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-help.el ends here diff --git a/helm-id-utils.el b/helm-id-utils.el new file mode 100644 index 00000000..ee51cb3a --- /dev/null +++ b/helm-id-utils.el @@ -0,0 +1,133 @@ +;;; helm-id-utils.el --- Helm interface for id-utils. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2016 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-grep) +(require 'helm-help) + +(defgroup helm-id-utils nil + "ID-Utils related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-gid-program "gid" + "Name of gid command (usually `gid'). +For Mac OS X users, if you install GNU coreutils, the name `gid' +might be occupied by `id' from GNU coreutils, and you should set +it to correct name (or absolute path), for example, if using +MacPorts to install id-utils, it should be `gid32'." + :group 'helm-id-utils + :type 'file) + +(defcustom helm-gid-db-file-name "ID" + "Name of a database file created by `mkid' command from `ID-utils'." + :group 'helm-id-utils + :type 'string) + +(defun helm-gid-candidates-process () + (let* ((patterns (split-string helm-pattern)) + (default-com (format "%s -r %s" helm-gid-program + (shell-quote-argument (car patterns)))) + (cmd (helm-aif (cdr patterns) + (concat default-com + (cl-loop for p in it + concat (format " | grep --color=always %s" + (shell-quote-argument p)))) + default-com)) + (proc (start-process-shell-command + "gid" helm-buffer cmd))) + (set (make-local-variable 'helm-grep-last-cmd-line) cmd) + (prog1 proc + (set-process-sentinel + proc (lambda (_process event) + (when (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 "[Helm Gid process finished - (%s results)]" + (max (1- (count-lines + (point-min) (point-max))) + 0)) + 'face 'helm-locate-finish)))) + (force-mode-line-update)) + (helm-log "Error: Gid %s" + (replace-regexp-in-string "\n" "" event)))))))) + +(defun helm-gid-filtered-candidate-transformer (candidates _source) + ;; "gid -r" may add dups in some rare cases. + (cl-loop for c in (helm-fast-remove-dups candidates :test 'equal) + collect (helm-grep--filter-candidate-1 c))) + +(defclass helm-gid-source (helm-source-async) + ((header-name + :initform + (lambda (name) + (concat name " [" (helm-attr 'db-dir) "]"))) + (db-dir :initarg :db-dir + :initform nil + :custom string + :documentation " Location of ID file.") + (candidates-process :initform #'helm-gid-candidates-process) + (filtered-candidate-transformer + :initform #'helm-gid-filtered-candidate-transformer) + (candidate-number-limit :initform 99999) + (action :initform (helm-make-actions + "Find File" 'helm-grep-action + "Find file other frame" 'helm-grep-other-frame + (lambda () (and (locate-library "elscreen") + "Find file in Elscreen")) + 'helm-grep-jump-elscreen + "Save results in grep buffer" 'helm-grep-save-results + "Find file other window" 'helm-grep-other-window)) + (persistent-action :initform 'helm-grep-persistent-action) + (history :initform 'helm-grep-history) + (nohighlight :initform t) + (help-message :initform 'helm-grep-help-message) + (requires-pattern :initform 2))) + +;;;###autoload +(defun helm-gid () + "Preconfigured helm for `gid' command line of `ID-Utils'. +Need A database created with the command `mkid' +above `default-directory'. +Need id-utils as dependency which provide `mkid', `gid' etc... +See ." + (interactive) + (let* ((db (locate-dominating-file + default-directory + helm-gid-db-file-name)) + (helm-grep-default-directory-fn + (lambda () default-directory)) + (helm--maybe-use-default-as-input t)) + (cl-assert db nil "No DataBase found, create one with `mkid'") + (helm :sources (helm-make-source "Gid" 'helm-gid-source + :db-dir db) + :buffer "*helm gid*" + :keymap helm-grep-map + :truncate-lines helm-grep-truncate-lines))) + +(provide 'helm-id-utils) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-id-utils ends here diff --git a/helm-imenu.el b/helm-imenu.el new file mode 100644 index 00000000..d12cf70b --- /dev/null +++ b/helm-imenu.el @@ -0,0 +1,287 @@ +;;; helm-imenu.el --- Helm interface for Imenu -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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 'imenu) +(require 'helm-utils) +(require 'helm-help) + + +(defgroup helm-imenu nil + "Imenu related libraries and applications for helm." + :group 'helm) + +(defcustom helm-imenu-delimiter " / " + "Delimit types of candidates and his value in `helm-buffer'." + :group 'helm-imenu + :type 'string) + +(defcustom helm-imenu-execute-action-at-once-if-one + #'helm-imenu--execute-action-at-once-p + "Goto the candidate when only one is remaining." + :group 'helm-imenu + :type 'function) + +(defcustom helm-imenu-lynx-style-map t + "Use Arrow keys to jump to occurences." + :group 'helm-imenu + :type 'boolean) + +(defcustom helm-imenu-all-buffer-assoc nil + "Major mode association alist for `helm-imenu-in-all-buffers'. +Allow `helm-imenu-in-all-buffers' searching in these associated buffers +even if they are not derived from each other. +The alist is bidirectional, i.e no need to add '((foo . bar) (bar . foo)) +only '((foo . bar)) is needed." + :type '(alist :key-type symbol :value-type symbol) + :group 'helm-imenu) + +;;; keymap +(defvar helm-imenu-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-") 'helm-imenu-next-section) + (define-key map (kbd "M-") 'helm-imenu-previous-section) + (when helm-imenu-lynx-style-map + (define-key map (kbd "") 'helm-maybe-exit-minibuffer) + (define-key map (kbd "") 'helm-execute-persistent-action)) + (delq nil map))) + +(defun helm-imenu-next-or-previous-section (n) + (with-helm-buffer + (let* ((fn (lambda () + (car (split-string (helm-get-selection nil t) + helm-imenu-delimiter)))) + (curtype (funcall fn)) + (move-fn (if (> n 0) #'helm-next-line #'helm-previous-line)) + (stop-fn (if (> n 0) + #'helm-end-of-source-p + #'helm-beginning-of-source-p))) + (catch 'break + (while (not (funcall stop-fn)) + (funcall move-fn) + (unless (string= curtype (funcall fn)) + (throw 'break nil))))))) + +(defun helm-imenu-next-section () + (interactive) + (helm-imenu-next-or-previous-section 1)) + +(defun helm-imenu-previous-section () + (interactive) + (helm-imenu-next-or-previous-section -1)) + + +;;; Internals +(defvar helm-cached-imenu-alist nil) +(make-variable-buffer-local 'helm-cached-imenu-alist) + +(defvar helm-cached-imenu-candidates nil) +(make-variable-buffer-local 'helm-cached-imenu-candidates) + +(defvar helm-cached-imenu-tick nil) +(make-variable-buffer-local 'helm-cached-imenu-tick) + + +(defvar helm-source-imenu nil "See (info \"(emacs)Imenu\")") +(defvar helm-source-imenu-all nil) + +(defclass helm-imenu-source (helm-source-sync) + ((candidates :initform 'helm-imenu-candidates) + (candidate-transformer :initform 'helm-imenu-transformer) + (persistent-action :initform 'helm-imenu-persistent-action) + (persistent-help :initform "Show this entry") + (keymap :initform helm-imenu-map) + (help-message :initform 'helm-imenu-help-message) + (action :initform 'helm-imenu-action))) + +(defcustom helm-imenu-fuzzy-match nil + "Enable fuzzy matching in `helm-source-imenu'." + :group 'helm-imenu + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-imenu + (helm-make-source "Imenu" 'helm-imenu-source + :fuzzy-match helm-imenu-fuzzy-match)))) + +(defun helm-imenu--maybe-switch-to-buffer (candidate) + (helm-aif (marker-buffer (cdr candidate)) + (switch-to-buffer it))) + +(defun helm-imenu--execute-action-at-once-p () + (let ((cur (helm-get-selection)) + (mb (with-helm-current-buffer + (save-excursion + (goto-char (point-at-bol)) + (point-marker))))) + (if (equal (cdr cur) mb) + (prog1 nil + (helm-set-pattern "") + (helm-force-update)) + t))) + +(defun helm-imenu-action (candidate) + "Default action for `helm-source-imenu'." + (helm-log-run-hook 'helm-goto-line-before-hook) + (helm-imenu--maybe-switch-to-buffer candidate) + (imenu candidate) + ;; If semantic is supported in this buffer + ;; imenu used `semantic-imenu-goto-function' + ;; and position have been highlighted, + ;; no need to highlight again. + (unless (eq imenu-default-goto-function + 'semantic-imenu-goto-function) + (helm-highlight-current-line))) + +(defun helm-imenu-persistent-action (candidate) + "Default persistent action for `helm-source-imenu'." + (helm-imenu--maybe-switch-to-buffer candidate) + (imenu candidate) + (helm-highlight-current-line)) + +(defun helm-imenu-candidates (&optional buffer) + (with-current-buffer (or buffer helm-current-buffer) + (let ((tick (buffer-modified-tick))) + (if (eq helm-cached-imenu-tick tick) + helm-cached-imenu-candidates + (setq imenu--index-alist nil) + (prog1 (setq helm-cached-imenu-candidates + (let ((index (imenu--make-index-alist t))) + (helm-imenu--candidates-1 + (delete (assoc "*Rescan*" index) index)))) + (setq helm-cached-imenu-tick tick)))))) + +(defun helm-imenu-candidates-in-all-buffers () + (let* ((lst (buffer-list)) + (progress-reporter (make-progress-reporter + "Imenu indexing buffers..." 1 (length lst)))) + (prog1 + (cl-loop for b in lst + for count from 1 + when + (and (with-current-buffer b + (derived-mode-p 'prog-mode)) + (with-current-buffer b + (helm-same-major-mode-p helm-current-buffer + helm-imenu-all-buffer-assoc))) + do (progress-reporter-update progress-reporter count) + and + append (with-current-buffer b + (helm-imenu-candidates b))) + (progress-reporter-done progress-reporter)))) + +(defun helm-imenu--candidates-1 (alist) + (cl-loop for elm in alist + nconc (if (imenu--subalist-p elm) + (helm-imenu--candidates-1 + (cl-loop for (e . v) in (cdr elm) collect + (cons (propertize + e 'helm-imenu-type (car elm)) + ;; If value is an integer, convert it + ;; to a marker, otherwise it is a cons cell + ;; and it will be converted on next recursions. + ;; (Issue #1060) [1]. + (if (integerp v) (copy-marker v) v)))) + (and (cdr elm) ; bug in imenu, should not be needed. + (setcdr elm (copy-marker (cdr elm))) ; Same as [1]. + (list elm))))) + +(defun helm-imenu--get-prop (item) + ;; property value of ITEM can have itself + ;; a property value which have itself a property value + ;; ...and so on; Return a list of all these + ;; properties values starting at ITEM. + (let* ((prop (get-text-property 0 'helm-imenu-type item)) + (lst (list prop item))) + (when prop + (while prop + (setq prop (get-text-property 0 'helm-imenu-type prop)) + (and prop (push prop lst))) + lst))) + +(defun helm-imenu-transformer (candidates) + (cl-loop for (k . v) in candidates + for types = (or (helm-imenu--get-prop k) + (list "Function" k)) + for bufname = (buffer-name (marker-buffer v)) + for disp1 = (mapconcat + (lambda (x) + (propertize + x 'face (cond ((string= x "Variables") + 'font-lock-variable-name-face) + ((string= x "Function") + 'font-lock-function-name-face) + ((string= x "Types") + 'font-lock-type-face)))) + types helm-imenu-delimiter) + for disp = (propertize disp1 'help-echo bufname) + collect + (cons disp (cons k v)))) + +;;;###autoload +(defun helm-imenu () + "Preconfigured `helm' for `imenu'." + (interactive) + (unless helm-source-imenu + (setq helm-source-imenu + (helm-make-source "Imenu" 'helm-imenu-source + :fuzzy-match helm-imenu-fuzzy-match))) + (let ((imenu-auto-rescan t) + (str (thing-at-point 'symbol)) + (helm-execute-action-at-once-if-one + helm-imenu-execute-action-at-once-if-one)) + (helm :sources 'helm-source-imenu + :default (list (concat "\\_<" str "\\_>") str) + :preselect str + :buffer "*helm imenu*"))) + +;;;###autoload +(defun helm-imenu-in-all-buffers () + "Preconfigured helm for fetching imenu entries in all buffers with similar mode as current. +A mode is similar as current if it is the same, it is derived i.e `derived-mode-p' +or it have an association in `helm-imenu-all-buffer-assoc'." + (interactive) + (unless helm-source-imenu-all + (setq helm-source-imenu-all + (helm-make-source "Imenu in all buffers" 'helm-imenu-source + :candidates 'helm-imenu-candidates-in-all-buffers + :fuzzy-match helm-imenu-fuzzy-match))) + (let ((imenu-auto-rescan t) + (str (thing-at-point 'symbol)) + (helm-execute-action-at-once-if-one + helm-imenu-execute-action-at-once-if-one)) + (helm :sources 'helm-source-imenu-all + :default (list (concat "\\_<" str "\\_>") str) + :preselect (unless (memq 'helm-source-imenu-all + helm-sources-using-default-as-input) + str) + :buffer "*helm imenu all*"))) + +(provide 'helm-imenu) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-imenu.el ends here diff --git a/helm-info.el b/helm-info.el new file mode 100644 index 00000000..e63b3f1c --- /dev/null +++ b/helm-info.el @@ -0,0 +1,247 @@ +;;; helm-info.el --- Browse info index with helm -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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 'info) + +(declare-function Info-index-nodes "info" (&optional file)) +(declare-function Info-goto-node "info" (&optional fork)) +(declare-function Info-find-node "info.el" (filename nodename &optional no-going-back)) +(defvar Info-history) +(defvar Info-directory-list) + +;;; Customize + +(defgroup helm-info nil + "Info-related applications and libraries for Helm." + :group 'helm) + +(defcustom helm-info-default-sources + '(helm-source-info-elisp + helm-source-info-cl + helm-source-info-eieio + helm-source-info-pages) + "Default sources to use for looking up symbols at point in Info +files with `helm-info-at-point'." + :group 'helm-info + :type '(repeat (choice symbol))) + +;;; Build info-index sources with `helm-info-source' class. + +(cl-defun helm-info-init (&optional (file (helm-attr 'info-file))) + ;; Allow reinit candidate buffer when using edebug. + (helm-aif (and debug-on-error + (helm-candidate-buffer)) + (kill-buffer it)) + (unless (helm-candidate-buffer) + (save-window-excursion + (info file) + (let ((tobuf (helm-candidate-buffer 'global)) + Info-history + start end line) + (cl-dolist (node (Info-index-nodes)) + (Info-goto-node node) + (goto-char (point-min)) + (while (search-forward "\n* " nil t) + (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t) + (setq start (point-at-bol) + ;; Fix issue #1503 by getting the invisible + ;; info displayed on next line in long strings. + ;; e.g "* Foo.\n (line 12)" instead of + ;; "* Foo.(line 12)" + end (or (save-excursion + (goto-char (point-at-bol)) + (re-search-forward "(line +[0-9]+)" nil t)) + (point-at-eol)) + ;; Long string have a new line inserted before the + ;; invisible spec, remove it. + line (replace-regexp-in-string + "\n" "" (buffer-substring start end))) + (with-current-buffer tobuf + (insert line) + (insert "\n"))))))))) + +(defun helm-info-goto (node-line) + (Info-goto-node (car node-line)) + (helm-goto-line (cdr node-line))) + +(defun helm-info-display-to-real (line) + (and (string-match + ;; This regexp is stolen from Info-apropos-matches + "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line) + (cons (format "(%s)%s" (helm-attr 'info-file) (match-string 2 line)) + (string-to-number (or (match-string 3 line) "1"))))) + +(defclass helm-info-source (helm-source-in-buffer) + ((info-file :initarg :info-file + :initform nil + :custom 'string) + (init :initform #'helm-info-init) + (display-to-real :initform #'helm-info-display-to-real) + (get-line :initform #'buffer-substring) + (action :initform '(("Goto node" . helm-info-goto))))) + +(defmacro helm-build-info-source (fname &rest args) + `(helm-make-source (concat "Info Index: " ,fname) 'helm-info-source + :info-file ,fname ,@args)) + +(defun helm-build-info-index-command (name doc source buffer) + "Define a helm command NAME with documentation DOC. +Arg SOURCE will be an existing helm source named +`helm-source-info-' and BUFFER a string buffer name." + (defalias (intern (concat "helm-info-" name)) + (lambda () + (interactive) + (helm :sources source + :buffer buffer + :candidate-number-limit 1000)) + doc)) + +(defun helm-define-info-index-sources (var-value &optional commands) + "Define helm sources named helm-source-info-. +Sources are generated for all entries of `helm-default-info-index-list'. +If COMMANDS arg is non-nil, also build commands named `helm-info-'. +Where NAME is an element of `helm-default-info-index-list'." + (cl-loop for str in var-value + for sym = (intern (concat "helm-source-info-" str)) + do (set sym (helm-build-info-source str)) + when commands + do (helm-build-info-index-command + str (format "Predefined helm for %s info." str) + sym (format "*helm info %s*" str)))) + +(defun helm-info-index-set (var value) + (set var value) + (helm-define-info-index-sources value t)) + +;;; Search Info files + +;; `helm-info' is the main entry point here. It prompts the user for an Info +;; file, then a term in the file's index to jump to. + +(defvar helm-info-searched (make-ring 32) + "Ring of previously searched Info files.") + +(defun helm-get-info-files () + "Return list of Info files to use for `helm-info'. + +Elements of the list are strings of Info file names without +extensions (e.g. \"emacs\" for file \"emacs.info.gz\"). Info +files are found by searching directories in +`Info-directory-list'." + (let ((files (cl-loop for d in (or Info-directory-list + Info-default-directory-list) + when (file-directory-p d) + append (directory-files d nil "\\.info")))) + (helm-fast-remove-dups + (cl-loop for f in files collect + (helm-file-name-sans-extension f)) + :test 'equal))) + +(defcustom helm-default-info-index-list + (helm-get-info-files) + "Info files to search in with `helm-info'." + :group 'helm-info + :type '(repeat (choice string)) + :set 'helm-info-index-set) + +(defun helm-info-search-index (candidate) + "Search the index of CANDIDATE's Info file using the function +helm-info-." + (let ((helm-info-function + (intern-soft (concat "helm-info-" candidate)))) + (when (fboundp helm-info-function) + (funcall helm-info-function) + (ring-insert helm-info-searched candidate)))) + +(defun helm-def-source--info-files () + "Return a `helm' source for Info files." + (helm-build-sync-source "Helm Info" + :candidates + (lambda () (copy-sequence helm-default-info-index-list)) + :candidate-number-limit 999 + :candidate-transformer + (lambda (candidates) + (sort candidates #'string-lessp)) + :nomark t + :action '(("Search index" . helm-info-search-index)))) + +;;;###autoload +(defun helm-info () + "Preconfigured `helm' for searching Info files' indices." + (interactive) + (let ((default (unless (ring-empty-p helm-info-searched) + (ring-ref helm-info-searched 0)))) + (helm :sources (helm-def-source--info-files) + :buffer "*helm Info*" + :preselect (and default + (concat "\\_<" (regexp-quote default) "\\_>"))))) + +;;;; Info at point + +;; `helm-info-at-point' is the main entry point here. It searches for the +;; symbol at point through the Info sources defined in +;; `helm-info-default-sources' and jumps to it. + +(defvar helm-info--pages-cache nil + "Cache for all Info pages on the system.") + +(defvar helm-source-info-pages + (helm-build-sync-source "Info Pages" + :init #'helm-info-pages-init + :candidates (lambda () helm-info--pages-cache) + :action '(("Show with Info" .(lambda (node-str) + (info (replace-regexp-in-string + "^[^:]+: " "" node-str))))) + :requires-pattern 2) + "Helm source for Info pages.") + +(defun helm-info-pages-init () + "Collect candidates for initial Info node Top." + (if helm-info--pages-cache + helm-info--pages-cache + (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.") + topics) + (with-temp-buffer + (Info-find-node "dir" "top") + (goto-char (point-min)) + (while (re-search-forward info-topic-regexp nil t) + (push (match-string-no-properties 1) topics)) + (kill-buffer)) + (setq helm-info--pages-cache topics)))) + +;;;###autoload +(defun helm-info-at-point () + "Preconfigured `helm' for searching info at point. +With a prefix-arg insert symbol at point." + (interactive) + (helm :sources helm-info-default-sources + :buffer "*helm info*")) + +(provide 'helm-info) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-info.el ends here diff --git a/helm-lib.el b/helm-lib.el new file mode 100644 index 00000000..fb89b826 --- /dev/null +++ b/helm-lib.el @@ -0,0 +1,886 @@ +;;; helm-lib.el --- Helm routines. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2016 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; 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: +;; All helm functions that don't require specific helm code should go here. + +;;; Code: + +(require 'cl-lib) +(require 'dired) + + +;;; User vars. +;; +(defcustom helm-file-globstar t + "Same as globstar bash shopt option. +When non--nil a pattern beginning with two stars will expand recursively. +Directories expansion is not supported yet." + :group 'helm + :type 'boolean) + +(defcustom helm-yank-text-at-point-function nil + "The function used to forward point with `helm-yank-text-at-point'. +With a nil value, fallback to default `forward-word'. +The function should take one arg, an integer like `forward-word'. +NOTE: Using `forward-symbol' here is not very useful as it is already +provided by \\\\[next-history-element]." + :type 'function + :group 'helm) + +(defcustom helm-scroll-amount nil + "Scroll amount when scrolling other window in a helm session. +It is used by `helm-scroll-other-window' +and `helm-scroll-other-window-down'. + +If you prefer scrolling line by line, set this value to 1." + :group 'helm + :type 'integer) + +(defcustom helm-help-full-frame t + "Display help window in full frame when non nil. + +Even when `nil' probably the same result (full frame) +can be reach by tweaking `display-buffer-alist' but it is +much more convenient to use a simple boolean value here." + :type 'boolean + :group 'helm-help) + + +;;; Internal vars +;; +(defvar helm-yank-point nil) +(defvar helm-pattern "" + "The input pattern used to update the helm buffer.") +(defvar helm-buffer "*helm*" + "Buffer showing completions.") +(defvar helm-current-buffer nil + "Current buffer when `helm' is invoked.") +(defvar helm-suspend-update-flag nil) +(defvar helm-action-buffer "*helm action*" + "Buffer showing actions.") + + +;;; Compatibility +;; +(defun helm-add-face-text-properties (beg end face &optional append object) + "Add the face property to the text from START to END. +It is a compatibility function which behave exactly like +`add-face-text-property' if available otherwise like `add-text-properties'. +When only `add-text-properties' is available APPEND is ignored." + (if (fboundp 'add-face-text-property) + (add-face-text-property beg end face append object) + (add-text-properties beg end `(face ,face) object))) + +;;; Macros helper. +;; +(defmacro helm-with-gensyms (symbols &rest body) + "Bind the SYMBOLS to fresh uninterned symbols and eval BODY." + (declare (indent 1)) + `(let ,(mapcar (lambda (s) + ;; Use cl-gensym here instead of make-symbol + ;; to ensure a symbol that have a live that go + ;; beyond the live of its macro have different name. + ;; i.e symbols created with `with-helm-temp-hook' + ;; should have random names. + `(,s (cl-gensym (symbol-name ',s)))) + symbols) + ,@body)) + +;;; Command loop helper +;; +(defun helm-this-command () + "Returns the actual command in action. +Like `this-command' but return the real command, +and not `exit-minibuffer' or other unwanted functions." + (cl-loop with bl = '(helm-maybe-exit-minibuffer + helm-confirm-and-exit-minibuffer + helm-exit-minibuffer + exit-minibuffer) + for count from 1 to 50 + for btf = (backtrace-frame count) + for fn = (cl-second btf) + if (and + ;; In some case we may have in the way an + ;; advice compiled resulting in byte-code, + ;; ignore it (Issue #691). + (symbolp fn) + (commandp fn) + (not (memq fn bl))) + return fn + else + if (and (eq fn 'call-interactively) + (> (length btf) 2)) + return (cadr (cdr btf)))) + + +;;; Iterators +;; +(defun helm-iter-list (seq) + "Return an iterator object from SEQ." + (let ((lis seq)) + (lambda () + (let ((elm (car lis))) + (setq lis (cdr lis)) + elm)))) + +(defun helm-iter-next (iterator) + "Return next elm of ITERATOR." + (funcall iterator)) + +(defun helm-make-actions (&rest args) + "Build an alist with (NAME . ACTION) elements with each pairs in ARGS. +Where NAME is a string or a function returning a string or nil and ACTION +a function. +If NAME returns nil the pair is skipped. + +\(fn NAME ACTION ...)" + (cl-loop for i on args by #'cddr + for name = (car i) + when (functionp name) + do (setq name (funcall name)) + when name + collect (cons name (cadr i)))) + +;;; Anaphoric macros. +;; +(defmacro helm-aif (test-form then-form &rest else-forms) + "Anaphoric version of `if'. +Like `if' but set the result of TEST-FORM in a temporary variable called `it'. +THEN-FORM and ELSE-FORMS are then excuted just like in `if'." + (declare (indent 2) (debug t)) + `(let ((it ,test-form)) + (if it ,then-form ,@else-forms))) + +(defmacro helm-awhile (sexp &rest body) + "Anaphoric version of `while'. +Same usage as `while' except that SEXP is bound to +a temporary variable called `it' at each turn. +An implicit nil block is bound to the loop so usage +of `cl-return' is possible to exit the loop." + (declare (indent 1) (debug t)) + (helm-with-gensyms (flag) + `(let ((,flag t)) + (cl-block nil + (while ,flag + (helm-aif ,sexp + (progn ,@body) + (setq ,flag nil))))))) + +(defmacro helm-acond (&rest clauses) + "Anaphoric version of `cond'." + (unless (null clauses) + (helm-with-gensyms (sym) + (let ((clause1 (car clauses))) + `(let ((,sym ,(car clause1))) + (helm-aif ,sym + (progn ,@(cdr clause1)) + (helm-acond ,@(cdr clauses)))))))) + + +;;; Fuzzy matching routines +;; +(defsubst helm--mapconcat-pattern (pattern) + "Transform string PATTERN in regexp for further fuzzy matching. +e.g helm.el$ + => \"[^h]*h[^e]*e[^l]*l[^m]*m[^.]*[.][^e]*e[^l]*l$\" + ^helm.el$ + => \"helm[.]el$\"." + (let ((ls (split-string-and-unquote pattern ""))) + (if (string= "^" (car ls)) + ;; Exact match. + (mapconcat (lambda (c) + (if (and (string= c "$") + (string-match "$\\'" pattern)) + c (regexp-quote c))) + (cdr ls) "") + ;; Fuzzy match. + (mapconcat (lambda (c) + (if (and (string= c "$") + (string-match "$\\'" pattern)) + c (format "[^%s]*%s" c (regexp-quote c)))) + ls "")))) + +(defsubst helm--collect-pairs-in-string (string) + (cl-loop for str on (split-string string "" t) by 'cdr + when (cdr str) + collect (list (car str) (cadr str)))) + +;;; Help routines. +;; +(defun helm-help-internal (bufname insert-content-fn) + "Show long message during `helm' session in BUFNAME. +INSERT-CONTENT-FN is the function that insert +text to be displayed in BUFNAME." + (let ((winconf (current-frame-configuration))) + (unwind-protect + (progn + (setq helm-suspend-update-flag t) + (set-buffer (get-buffer-create bufname)) + (switch-to-buffer bufname) + (when helm-help-full-frame (delete-other-windows)) + (delete-region (point-min) (point-max)) + (org-mode) + (save-excursion + (funcall insert-content-fn)) + (buffer-disable-undo) + (helm-help-event-loop)) + (setq helm-suspend-update-flag nil) + (set-frame-configuration winconf)))) + +(defun helm-help-scroll-up (amount) + (condition-case _err + (scroll-up-command amount) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(defun helm-help-scroll-down (amount) + (condition-case _err + (scroll-down-command amount) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(defun helm-help-next-line () + (condition-case _err + (call-interactively #'next-line) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(defun helm-help-previous-line () + (condition-case _err + (call-interactively #'previous-line) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(defun helm-help-toggle-mark () + (if (region-active-p) + (deactivate-mark) + (push-mark nil nil t))) + +;; For movement of cursor in help buffer we need to call interactively +;; commands for impaired people using a synthetizer (#1347). +(defun helm-help-event-loop () + (let ((prompt (propertize + "[SPC,C-v,down,next:NextPage b,M-v,up,prior:PrevPage C-s/r:Isearch q:Quit]" + 'face 'helm-helper)) + scroll-error-top-bottom) + (helm-awhile (read-key prompt) + (cl-case it + ((?\C-v ? down next) (helm-help-scroll-up helm-scroll-amount)) + ((?\M-v ?b up prior) (helm-help-scroll-down helm-scroll-amount)) + (?\C-s (isearch-forward)) + (?\C-r (isearch-backward)) + (?\C-a (call-interactively #'move-beginning-of-line)) + (?\C-e (call-interactively #'move-end-of-line)) + (?\C-f (call-interactively #'forward-char)) + (?\C-b (call-interactively #'backward-char)) + (?\C-n (helm-help-next-line)) + (?\C-p (helm-help-previous-line)) + (?\M-a (call-interactively #'backward-sentence)) + (?\M-e (call-interactively #'forward-sentence)) + (?\M-f (call-interactively #'forward-word)) + (?\M-b (call-interactively #'backward-word)) + (?\C- (helm-help-toggle-mark)) + (?\M-w (copy-region-as-kill + (region-beginning) (region-end)) + (deactivate-mark)) + (?q (cl-return)) + (t (ignore)))))) + + +;;; List processing +;; +(defun helm-flatten-list (seq &optional omit-nulls) + "Return a list of all single elements of sublists in SEQ." + (let (result) + (cl-labels ((flatten (seq) + (cl-loop + for elm in seq + if (and (or elm + (null omit-nulls)) + (or (atom elm) + (functionp elm) + (and (consp elm) + (cdr elm) + (atom (cdr elm))))) + do (push elm result) + else do (flatten elm)))) + (flatten seq)) + (nreverse result))) + +(defun helm-mklist (obj) + "If OBJ is a list \(but not lambda\), return itself. +Otherwise make a list with one element." + (if (and (listp obj) (not (functionp obj))) + obj + (list obj))) + +(cl-defmacro helm-position (item seq &key (test 'eq) all) + "A simple and faster replacement of CL `position'. +Return position of first occurence of ITEM found in SEQ. +Argument SEQ can be a string, in this case ITEM have to be a char. +Argument ALL, if non--nil specify to return a list of positions of +all ITEM found in SEQ." + (let ((key (if (stringp seq) 'across 'in))) + `(cl-loop for c ,key ,seq + for index from 0 + when (funcall ,test c ,item) + if ,all collect index into ls + else return index + finally return ls))) + +(cl-defun helm-fast-remove-dups (seq &key (test 'eq)) + "Remove duplicates elements in list SEQ. +This is same as `remove-duplicates' but with memoisation. +It is much faster, especially in large lists. +A test function can be provided with TEST argument key. +Default is `eq'." + (cl-loop with cont = (make-hash-table :test test) + for elm in seq + unless (gethash elm cont) + collect (puthash elm elm cont))) + +(defun helm-skip-entries (seq black-regexp-list &optional white-regexp-list) + "Remove entries which matches one of REGEXP-LIST from SEQ." + (cl-loop for i in seq + unless (and (cl-loop for re in black-regexp-list + thereis (and (stringp i) + (string-match-p re i))) + (null + (cl-loop for re in white-regexp-list + thereis (and (stringp i) + (string-match-p re i))))) + collect i)) + +(defun helm-boring-directory-p (directory black-list) + "Check if one regexp in BLACK-LIST match DIRECTORY." + (helm-awhile (helm-basedir (directory-file-name + (expand-file-name directory))) + (when (string= it "/") (cl-return nil)) + (when (cl-loop for r in black-list + thereis (string-match-p + r (directory-file-name directory))) + (cl-return t)) + (setq directory it))) + +(defun helm-shadow-entries (seq regexp-list) + "Put shadow property on entries in SEQ matching a regexp in REGEXP-LIST." + (let ((face 'italic)) + (cl-loop for i in seq + if (cl-loop for regexp in regexp-list + thereis (and (stringp i) + (string-match regexp i))) + collect (propertize i 'face face) + else collect i))) + +(defun helm-remove-if-not-match (regexp seq) + "Remove all elements of SEQ that don't match REGEXP." + (cl-loop for s in seq + for str = (cond ((symbolp s) + (symbol-name s)) + ((consp s) + (car s)) + (t s)) + when (string-match-p regexp str) + collect s)) + +(defun helm-remove-if-match (regexp seq) + "Remove all elements of SEQ that match REGEXP." + (cl-loop for s in seq + for str = (cond ((symbolp s) + (symbol-name s)) + ((consp s) + (car s)) + (t s)) + unless (string-match-p regexp str) + collect s)) + +(defun helm-transform-mapcar (function args) + "`mapcar' for candidate-transformer. + +ARGS is (cand1 cand2 ...) or ((disp1 . real1) (disp2 . real2) ...) + +\(helm-transform-mapcar 'upcase '(\"foo\" \"bar\")) +=> (\"FOO\" \"BAR\") +\(helm-transform-mapcar 'upcase '((\"1st\" . \"foo\") (\"2nd\" . \"bar\"))) +=> ((\"1st\" . \"FOO\") (\"2nd\" . \"BAR\")) +" + (cl-loop for arg in args + if (consp arg) + collect (cons (car arg) (funcall function (cdr arg))) + else + collect (funcall function arg))) + +(defun helm-append-at-nth (seq elm index) + "Append ELM at INDEX in SEQ." + (let ((len (length seq))) + (cond ((> index len) (setq index len)) + ((< index 0) (setq index 0))) + (if (zerop index) + (append elm seq) + (cl-loop for i in seq + for count from 1 collect i + when (= count index) + if (listp elm) append elm + else collect elm)))) + +(defun helm-source-by-name (name &optional sources) + "Get a Helm source in SOURCES by NAME. + +Optional argument SOURCES is a list of Helm sources. The default +value is computed with `helm-get-sources' which is faster +than specifying SOURCES because sources are cached." + (cl-loop with src-list = (if sources + (cl-loop for src in sources + collect (if (listp src) + src + (symbol-value src))) + (helm-get-sources)) + for source in src-list + thereis (and (string= name (assoc-default 'name source)) source))) + + +;;; Strings processing. +;; +(defun helm-stringify (elm) + "Return the representation of ELM as a string. +ELM can be a string, a number or a symbol." + (cl-typecase elm + (string elm) + (number (number-to-string elm)) + (symbol (symbol-name elm)))) + +(defun helm-substring (str width) + "Return the substring of string STR from 0 to WIDTH. +Handle multibyte characters by moving by columns." + (with-temp-buffer + (save-excursion + (insert str)) + (move-to-column width) + (buffer-substring (point-at-bol) (point)))) + +(defun helm-substring-by-width (str width &optional endstr) + "Truncate string STR to end at column WIDTH. +Similar to `truncate-string-to-width'. +Add ENDSTR at end of truncated STR. +Add spaces at end if needed to reach WIDTH when STR is shorter than WIDTH." + (cl-loop for ini-str = str + then (substring ini-str 0 (1- (length ini-str))) + for sw = (string-width ini-str) + when (<= sw width) return + (concat ini-str endstr (make-string (- width sw) ? )))) + +(defun helm-string-multibyte-p (str) + "Check if string STR contains multibyte characters." + (cl-loop for c across str + thereis (> (char-width c) 1))) + +(defun helm-get-pid-from-process-name (process-name) + "Get pid from running process PROCESS-NAME." + (cl-loop with process-list = (list-system-processes) + for pid in process-list + for process = (assoc-default 'comm (process-attributes pid)) + when (and process (string-match process-name process)) + return pid)) + +(defun helm-ff-find-printers () + "Return a list of available printers on Unix systems." + (when (executable-find "lpstat") + (let ((printer-list (with-temp-buffer + (call-process "lpstat" nil t nil "-a") + (split-string (buffer-string) "\n")))) + (cl-loop for p in printer-list + for printer = (car (split-string p)) + when printer + collect printer)))) + +(defun helm-region-active-p () + (and transient-mark-mode mark-active (/= (mark) (point)))) + +(defun helm-quote-whitespace (candidate) + "Quote whitespace, if some, in string CANDIDATE." + (replace-regexp-in-string " " "\\\\ " candidate)) + +(defun helm-current-line-contents () + "Current line string without properties." + (buffer-substring-no-properties (point-at-bol) (point-at-eol))) + + +;;; Symbols routines +;; +(defun helm-symbolify (str-or-sym) + "Get symbol of STR-OR-SYM." + (if (symbolp str-or-sym) + str-or-sym + (intern str-or-sym))) + +(defun helm-symbol-name (obj) + (if (or (and (consp obj) (functionp obj)) + (byte-code-function-p obj)) + "Anonymous" + (symbol-name obj))) + +(defun helm-describe-function (func) + "FUNC is symbol or string." + (cl-letf (((symbol-function 'message) #'ignore)) + (describe-function (helm-symbolify func)))) + +(defun helm-describe-variable (var) + "VAR is symbol or string." + (cl-letf (((symbol-function 'message) #'ignore)) + (describe-variable (helm-symbolify var)))) + +(defun helm-describe-face (face) + "FACE is symbol or string." + (let ((faces (helm-marked-candidates))) + (cl-letf (((symbol-function 'message) #'ignore)) + (describe-face (if (cdr faces) + (mapcar 'helm-symbolify faces) + (helm-symbolify face)))))) + +(defun helm-find-function (func) + "FUNC is symbol or string." + (find-function (helm-symbolify func))) + +(defun helm-find-variable (var) + "VAR is symbol or string." + (find-variable (helm-symbolify var))) + +(defun helm-find-face-definition (face) + "FACE is symbol or string." + (find-face-definition (helm-symbolify face))) + +(defun helm-kill-new (candidate &optional replace) + "CANDIDATE is symbol or string. +See `kill-new' for argument REPLACE." + (kill-new (helm-stringify candidate) replace)) + + +;;; Modes +;; +(defun helm-same-major-mode-p (start-buffer alist) + "Decide if current-buffer is related to START-BUFFER. +Argument ALIST is an alist of associated major modes." + ;; START-BUFFER is the current-buffer where we start searching. + ;; Determine the major-mode of START-BUFFER as `cur-maj-mode'. + ;; Each time the loop go in another buffer we try from this buffer + ;; to determine if its `major-mode' is: + ;; - same as the `cur-maj-mode' + ;; - derived from `cur-maj-mode' and from + ;; START-BUFFER if its mode is derived from the one in START-BUFFER. + ;; - have an assoc entry (major-mode . cur-maj-mode) + ;; - have an rassoc entry (cur-maj-mode . major-mode) + ;; - check if one of these entries inherit from another one in + ;; `alist'. + (let* ((cur-maj-mode (with-current-buffer start-buffer major-mode)) + (maj-mode major-mode) + (c-assoc-mode (assq cur-maj-mode alist)) + (c-rassoc-mode (rassq cur-maj-mode alist)) + (o-assoc-mode (assq major-mode alist)) + (o-rassoc-mode (rassq major-mode alist)) + (cdr-c-assoc-mode (cdr c-assoc-mode)) + (cdr-o-assoc-mode (cdr o-assoc-mode))) + (or (eq major-mode cur-maj-mode) + (derived-mode-p cur-maj-mode) + (with-current-buffer start-buffer + (derived-mode-p maj-mode)) + (or (eq cdr-c-assoc-mode major-mode) + (eq (car c-rassoc-mode) major-mode) + (eq (cdr (assq cdr-c-assoc-mode alist)) + major-mode) + (eq (car (rassq cdr-c-assoc-mode alist)) + major-mode)) + (or (eq cdr-o-assoc-mode cur-maj-mode) + (eq (car o-rassoc-mode) cur-maj-mode) + (eq (cdr (assq cdr-o-assoc-mode alist)) + cur-maj-mode) + (eq (car (rassq cdr-o-assoc-mode alist)) + cur-maj-mode))))) + +;;; Files routines +;; +(defun helm-file-name-sans-extension (filename) + "Same as `file-name-sans-extension' but remove all extensions." + (helm-aif (file-name-sans-extension filename) + ;; Start searching at index 1 for files beginning with a dot (#1335). + (if (string-match "\\." (helm-basename it) 1) + (helm-file-name-sans-extension it) + it))) + +(defun helm-basename (fname &optional ext) + "Print FNAME with any leading directory components removed. +If specified, also remove filename extension EXT. +Arg EXT can be specified as a string with or without dot, +in this case it should match file-name-extension. +It can also be non-nil (`t') in this case no checking +of file-name-extension is done and the extension is removed +unconditionally." + (let ((non-essential t)) + (if (and ext (or (string= (file-name-extension fname) ext) + (string= (file-name-extension fname t) ext) + (eq ext t)) + (not (file-directory-p fname))) + (file-name-sans-extension (file-name-nondirectory fname)) + (file-name-nondirectory (directory-file-name fname))))) + +(defun helm-basedir (fname) + "Return the base directory of filename ending by a slash." + (helm-aif (and fname + (or (and (string= fname "~") "~") + (file-name-directory fname))) + (file-name-as-directory it))) + +(defun helm-current-directory () + "Return current-directory name at point. +Useful in dired buffers when there is inserted subdirs." + (expand-file-name + (if (eq major-mode 'dired-mode) + (dired-current-directory) + default-directory))) + +(defun helm-w32-prepare-filename (file) + "Convert filename FILE to something usable by external w32 executables." + (replace-regexp-in-string ; For UNC paths + "/" "\\" + (replace-regexp-in-string ; Strip cygdrive paths + "/cygdrive/\\(.\\)" "\\1:" + file nil nil) nil t)) + +(defun helm-w32-shell-execute-open-file (file) + (with-no-warnings + (w32-shell-execute "open" (helm-w32-prepare-filename file)))) + +;; Same as `vc-directory-exclusion-list'. +(defvar helm-walk-ignore-directories + '("SCCS/" "RCS/" "CVS/" "MCVS/" ".svn/" ".git/" ".hg/" ".bzr/" + "_MTN/" "_darcs/" "{arch}/" ".gvfs/")) + +(defsubst helm--dir-file-name (file dir) + (expand-file-name + (substring file 0 (1- (length file))) dir)) + +(defsubst helm--dir-name-p (str) + (char-equal (aref str (1- (length str))) ?/)) + +(cl-defun helm-walk-directory (directory &key (path 'basename) + directories + match skip-subdirs) + "Walk through DIRECTORY tree. + +Argument PATH can be one of basename, relative, full, or a function +called on file name, default to basename. + +Argument DIRECTORIES when non--nil (default) return also directories names, +otherwise skip directories names, with a value of 'only returns +only subdirectories, i.e files are skipped. + +Argument MATCH is a regexp matching files or directories. + +Argument SKIP-SUBDIRS when `t' will skip `helm-walk-ignore-directories' +otherwise if it is given as a list of directories, this list will be used +instead of `helm-walk-ignore-directories'." + (let ((fn (cl-case path + (basename 'file-name-nondirectory) + (relative 'file-relative-name) + (full 'identity) + (t path)))) ; A function. + (setq skip-subdirs (if (listp skip-subdirs) + skip-subdirs + helm-walk-ignore-directories)) + (cl-labels ((ls-rec (dir) + (unless (file-symlink-p dir) + (cl-loop for f in (sort (file-name-all-completions "" dir) + 'string-lessp) + unless (member f '("./" "../")) + ;; A directory. + ;; Use `helm--dir-file-name' to remove the final slash. + ;; Needed to avoid infloop on directory symlinks. + if (and (helm--dir-name-p f) + (helm--dir-file-name f dir)) + nconc + (unless (member f skip-subdirs) + (if (and directories + (or (null match) + (string-match match f))) + (nconc (list (concat (funcall fn it) "/")) + (ls-rec it)) + (ls-rec it))) + ;; A regular file. + else nconc + (when (and (null (eq directories 'only)) + (or (null match) (string-match match f))) + (list (funcall fn (expand-file-name f dir)))))))) + (ls-rec directory)))) + +(defun helm-file-expand-wildcards (pattern &optional full) + "Same as `file-expand-wildcards' but allow recursion. +Recursion happen when PATTERN starts with two stars. +Directories expansion is not supported." + (let ((bn (helm-basename pattern)) + (case-fold-search nil)) + (if (and helm-file-globstar + (string-match "\\`\\*\\{2\\}\\(.*\\)" bn)) + (helm-walk-directory (helm-basedir pattern) + :path (cl-case full + (full 'full) + (relative 'relative) + ((basename nil) 'basename) + (t 'full)) + :directories nil + :match (wildcard-to-regexp bn) + :skip-subdirs t) + (file-expand-wildcards pattern full)))) + +;;; helm internals +;; +(defun helm-set-pattern (pattern &optional noupdate) + "Set minibuffer contents to PATTERN. +if optional NOUPDATE is non-nil, helm buffer is not changed." + (with-selected-window (or (active-minibuffer-window) (minibuffer-window)) + (delete-minibuffer-contents) + (insert pattern)) + (when noupdate + (setq helm-pattern pattern))) + +(defun helm-minibuffer-completion-contents () + "Return the user input in a minibuffer before point as a string. +That is what completion commands operate on." + (buffer-substring (field-beginning) (point))) + +(defmacro with-helm-buffer (&rest body) + "Eval BODY inside `helm-buffer'." + (declare (indent 0) (debug t)) + `(with-current-buffer (helm-buffer-get) + ,@body)) + +(defmacro with-helm-current-buffer (&rest body) + "Eval BODY inside `helm-current-buffer'." + (declare (indent 0) (debug t)) + `(with-current-buffer (or (and (buffer-live-p helm-current-buffer) + helm-current-buffer) + (setq helm-current-buffer + (current-buffer))) + ,@body)) + +(defun helm-buffer-get () + "Return `helm-action-buffer' if shown otherwise `helm-buffer'." + (if (helm-action-window) + helm-action-buffer + helm-buffer)) + +(defun helm-window () + "Window of `helm-buffer'." + (get-buffer-window (helm-buffer-get) 0)) + +(defun helm-action-window () + "Window of `helm-action-buffer'." + (get-buffer-window helm-action-buffer 'visible)) + +(defmacro with-helm-window (&rest body) + "Be sure BODY is excuted in the helm window." + (declare (indent 0) (debug t)) + `(with-selected-window (helm-window) + ,@body)) + + +;; Yank text at point. +;; +;; +(defun helm-yank-text-at-point () + "Yank text at point in `helm-current-buffer' into minibuffer." + (interactive) + (with-helm-current-buffer + (let ((fwd-fn (or helm-yank-text-at-point-function #'forward-word))) + ;; Start to initial point if C-w have never been hit. + (unless helm-yank-point (setq helm-yank-point (point))) + (save-excursion + (goto-char helm-yank-point) + (funcall fwd-fn 1) + (helm-set-pattern + (concat + helm-pattern (replace-regexp-in-string + "\\`\n" "" + (buffer-substring-no-properties + helm-yank-point (point))))) + (setq helm-yank-point (point)))))) + +(defun helm-reset-yank-point () + (setq helm-yank-point nil)) + +(add-hook 'helm-cleanup-hook 'helm-reset-yank-point) +(add-hook 'helm-after-initialize-hook 'helm-reset-yank-point) + +;;; Ansi +;; +;; +(defvar helm--ansi-color-regexp + "\033\\[\\(K\\|[0-9;]*m\\)") +(defvar helm--ansi-color-drop-regexp + "\033\\[\\([ABCDsuK]\\|[12][JK]\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\)") +(defun helm--ansi-color-apply (string) + "A version of `ansi-color-apply' immune to upstream changes. + +Similar to the emacs-24.5 version without support to `ansi-color-context' +which is buggy in emacs. + +Modify also `ansi-color-regexp' by using own variable `helm--ansi-color-regexp' +that match whole STRING. + +This is needed to provide compatibility for both emacs-25 and emacs-24.5 +as emacs-25 version of `ansi-color-apply' is partially broken." + (let ((start 0) + codes end escape-sequence + result colorized-substring) + ;; Find the next escape sequence. + (while (setq end (string-match helm--ansi-color-regexp string start)) + (setq escape-sequence (match-string 1 string)) + ;; Colorize the old block from start to end using old face. + (when codes + (put-text-property + start end 'font-lock-face (ansi-color--find-face codes) string)) + (setq colorized-substring (substring string start end) + start (match-end 0)) + ;; Eliminate unrecognized ANSI sequences. + (while (string-match helm--ansi-color-drop-regexp colorized-substring) + (setq colorized-substring + (replace-match "" nil nil colorized-substring))) + (push colorized-substring result) + ;; Create new face, by applying escape sequence parameters. + (setq codes (ansi-color-apply-sequence escape-sequence codes))) + ;; If the rest of the string should have a face, put it there. + (when codes + (put-text-property + start (length string) + 'font-lock-face (ansi-color--find-face codes) string)) + ;; Save the remainder of the string to the result. + (if (string-match "\033" string start) + (push (substring string start (match-beginning 0)) result) + (push (substring string start) result)) + (apply 'concat (nreverse result)))) + +(provide 'helm-lib) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-lib ends here diff --git a/helm-locate.el b/helm-locate.el new file mode 100644 index 00000000..ac12a6b5 --- /dev/null +++ b/helm-locate.el @@ -0,0 +1,411 @@ +;;; helm-locate.el --- helm interface for locate. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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 . + +;; NOTE for WINDOZE users: +;; You have to install Everything with his command line interface here: +;; http://www.voidtools.com/download.php + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-types) +(require 'helm-help) + + +(defgroup helm-locate nil + "Locate related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-locate-db-file-regexp "m?locate\.db$" + "Default regexp to match locate database. +If nil Search in all files." + :type 'string + :group 'helm-locate) + +(defcustom helm-ff-locate-db-filename "locate.db" + "The basename of the locatedb file you use locally in your directories. +When this is set and `helm' find such a file in the directory from +where you launch locate, it will use this file and will not prompt you +for a db file. +Note that this happen only when locate is launched with a prefix arg." + :group 'helm-locate + :type 'string) + +(defcustom helm-locate-command nil + "A list of arguments for locate program. +Normally the default value should work on any system. + +If nil it will be calculated when `helm-locate' startup +with these default values for different systems: + +Gnu/linux: \"locate %s -e --regex %s\" +berkeley-unix: \"locate %s %s\" +windows-nt: \"es %s %s\" +Others: \"locate %s %s\" + +This string will be passed to format so it should end with `%s'. +The first format spec is used for the \"-i\" value of locate/es, +So don't set it directly but use `helm-locate-case-fold-search' +for this. +The \"-r\" option must be the last option, however if not specified you will +be able to specify it during helm invocation by prefixing the pattern +you enter with \"-r\"." + :type 'string + :group 'helm-locate) + +(defcustom helm-locate-create-db-command + "updatedb -l 0 -o %s -U %s" + "Command used to create a locale locate db file." + :type 'string + :group 'helm-locate) + +(defcustom helm-locate-case-fold-search helm-case-fold-search + "It have the same meaning as `helm-case-fold-search'. +The -i option of locate will be used depending of value of +`helm-pattern' when this is set to 'smart. +When nil \"-i\" will not be used at all. +and when non--nil it will always be used. +NOTE: the -i option of the \"es\" command used on windows does +the opposite of \"locate\" command." + :group 'helm-locate + :type 'symbol) + +(defcustom helm-locate-fuzzy-match nil + "Enable fuzzy matching in `helm-locate'." + :group 'helm-locate + :type 'boolean) + +(defcustom helm-locate-project-list nil + "A list of directories, your projects. +When set, allow browsing recursively files in all +directories of this list with `helm-projects-find-files'." + :group 'helm-locate + :type '(repeat string)) + +(defcustom helm-locate-recursive-dirs-command "locate -i -e -A --regex ^%s %s.*$" + "Command used in recursive directories completion in `helm-find-files'. +For Windows and `es' use something like \"es -r ^%s.*%s.*$\"." + :type 'string + :group 'helm-files) + + +(defvar helm-generic-files-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) + (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 z") 'helm-ff-run-zgrep) + (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) + (define-key map (kbd "C-c g") 'helm-ff-run-gid) + (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-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-H") 'helm-ff-run-hardlink-file) + (define-key map (kbd "M-D") 'helm-ff-run-delete-file) + (define-key map (kbd "C-=") 'helm-ff-run-ediff-file) + (define-key map (kbd "C-c =") 'helm-ff-run-ediff-merge-file) + (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 "M-i") 'helm-ff-properties-persistent) + (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) + (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) + (define-key map (kbd "M-.") 'helm-ff-run-etags) + (define-key map (kbd "C-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) + map) + "Generic Keymap for files.") + + +(defface helm-locate-finish + '((t (:foreground "Green"))) + "Face used in mode line when locate process is finish." + :group 'helm-locate) + + +(defun helm-ff-find-locatedb (&optional from-ff) + "Try to find if a local locatedb file is available. +The search is done in `helm-ff-default-directory' or +fall back to `default-directory' if FROM-FF is nil." + (helm-aif (and helm-ff-locate-db-filename + (locate-dominating-file + (or (and from-ff + helm-ff-default-directory) + default-directory) + helm-ff-locate-db-filename)) + (expand-file-name helm-ff-locate-db-filename it))) + +(defun helm-locate-create-db-default-function (db-name directory) + "Default function used to create a locale locate db file. +Argument DB-NAME name of the db file. +Argument DIRECTORY root of file system subtree to scan." + (format helm-locate-create-db-command db-name directory)) + +(defvar helm-locate-create-db-function + #'helm-locate-create-db-default-function + "Function used to create a locale locate db file. +It should receive the same arguments as +`helm-locate-create-db-default-function'.") + +(defun helm-locate-1 (&optional localdb init from-ff default) + "Generic function to run Locate. +Prefix arg LOCALDB when (4) search and use a local locate db file when it +exists or create it, when (16) force update of existing db file +even if exists. +It have no effect when locate command is 'es'. +INIT is a string to use as initial input in prompt. +See `helm-locate-with-db' and `helm-locate'." + (require 'helm-mode) + (helm-locate-set-command) + (let ((pfn (lambda (candidate) + (if (file-directory-p candidate) + (message "Error: The locate Db should be a file") + (if (= (shell-command + (funcall helm-locate-create-db-function + candidate + helm-ff-default-directory)) + 0) + (message "New locatedb file `%s' created" candidate) + (error "Failed to create locatedb file `%s'" candidate))))) + (locdb (and localdb + (not (string-match "^es" helm-locate-command)) + (or (and (equal '(4) localdb) + (helm-ff-find-locatedb from-ff)) + (helm-read-file-name + "Create Locate Db file: " + :initial-input (expand-file-name "locate.db" + (or helm-ff-default-directory + default-directory)) + :preselect helm-locate-db-file-regexp + :test (lambda (x) + (if helm-locate-db-file-regexp + ;; Select only locate db files and directories + ;; to allow navigation. + (or (string-match + helm-locate-db-file-regexp x) + (file-directory-p x)) + x))))))) + (when (and locdb (or (equal localdb '(16)) + (not (file-exists-p locdb)))) + (funcall pfn locdb)) + (helm-locate-with-db (and localdb locdb) init default))) + +(defun helm-locate-set-command () + "Setup `helm-locate-command' if not already defined." + (unless helm-locate-command + (setq helm-locate-command + (cl-case system-type + (gnu/linux "locate %s -e --regex %s") + (berkeley-unix "locate %s %s") + (windows-nt "es %s %s") + (t "locate %s %s"))))) + +(defvar helm-file-name-history nil) +(defun helm-locate-with-db (&optional db initial-input default) + "Run locate -d DB. +If DB is not given or nil use locate without -d option. +Argument DB can be given as a string or list of db files. +Argument INITIAL-INPUT is a string to use as initial-input. +See also `helm-locate'." + (require 'helm-files) + (when (and db (stringp db)) (setq db (list db))) + (helm-locate-set-command) + (let ((helm-locate-command + (if db + (replace-regexp-in-string + "locate" + (format "locate -d %s" + (mapconcat 'identity + ;; Remove eventually + ;; marked directories by error. + (cl-loop for i in db + unless (file-directory-p i) + collect i) ":")) + helm-locate-command) + helm-locate-command))) + (setq helm-file-name-history (mapcar 'helm-basename file-name-history)) + (helm :sources 'helm-source-locate + :buffer "*helm locate*" + :ff-transformer-show-only-basename nil + :input initial-input + :default default + :history 'helm-file-name-history))) + +(defun helm-locate-init () + "Initialize async locate process for `helm-source-locate'." + (let* ((locate-is-es (string-match "\\`es" helm-locate-command)) + (real-locate (string-match "\\`locate" helm-locate-command)) + (case-sensitive-flag (if locate-is-es "-i" "")) + (ignore-case-flag (if (or locate-is-es + (not real-locate)) "" "-i")) + (args (split-string helm-pattern " ")) + (cmd (format helm-locate-command + (cl-case helm-locate-case-fold-search + (smart (let ((case-fold-search nil)) + (if (string-match "[[:upper:]]" helm-pattern) + case-sensitive-flag + ignore-case-flag))) + (t (if helm-locate-case-fold-search + ignore-case-flag + case-sensitive-flag))) + (concat + ;; The pattern itself. + (shell-quote-argument (car args)) " " + ;; Possible locate args added + ;; after pattern, don't quote them. + (mapconcat 'identity (cdr args) " "))))) + (helm-log "Starting helm-locate process") + (helm-log "Command line used was:\n\n%s" + (concat ">>> " (propertize cmd 'face 'font-lock-comment-face) "\n\n")) + (prog1 + (start-process-shell-command + "locate-process" helm-buffer + cmd) + (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 + (unless (cdr helm-sources) + (insert (concat "* Exit with code 1, no result found," + " command line was:\n\n " + cmd))))) + ((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 "[Locate process finished - (%s results)]" + (max (1- (count-lines + (point-min) (point-max))) + 0)) + 'face 'helm-locate-finish)))) + (force-mode-line-update))) + (t + (helm-log "Error: Locate %s" + (replace-regexp-in-string "\n" "" event)))))))))) + +(defclass helm-locate-source (helm-source-async helm-type-file) + ((init :initform 'helm-locate-set-command) + (candidates-process :initform 'helm-locate-init) + (requires-pattern :initform 3) + (history :initform 'helm-file-name-history) + (persistent-action :initform 'helm-ff-kill-or-find-buffer-fname) + (candidate-number-limit :initform 9999))) + +(defvar helm-source-locate + (helm-make-source "Locate" 'helm-locate-source + :pattern-transformer 'helm-locate-pattern-transformer)) + +(defun helm-locate-pattern-transformer (pattern) + (if helm-locate-fuzzy-match + (cond ((string-match + " " (replace-regexp-in-string " -b" "" pattern)) pattern) + ((string-match "\\([^ ]*\\) -b" pattern) + (concat (helm--mapconcat-pattern + (match-string 1 pattern)) " -b")) + (t (helm--mapconcat-pattern pattern))) + pattern)) + +(defun helm-locate-find-dbs-in-projects (&optional update) + (let* ((pfn (lambda (candidate directory) + (unless (= (shell-command + (funcall helm-locate-create-db-function + candidate + directory)) + 0) + (error "Failed to create locatedb file `%s'" candidate))))) + (cl-loop for p in helm-locate-project-list + for db = (expand-file-name + helm-ff-locate-db-filename + (file-name-as-directory p)) + if (and (null update) (file-exists-p db)) + collect db + else do (funcall pfn db p) + and collect db))) + +;;; Directory completion for hff. +;; +(defclass helm-locate-subdirs-source (helm-source-in-buffer) + ((basedir :initarg :basedir + :initform nil + :custom string) + (subdir :initarg :subdir + :initform nil + :custom 'string) + (data :initform #'helm-locate-init-subdirs))) + +(defun helm-locate-init-subdirs () + (with-temp-buffer + (call-process-shell-command + (format helm-locate-recursive-dirs-command + (if (string-match-p "\\`es" helm-locate-recursive-dirs-command) + ;; Fix W32 paths. + (replace-regexp-in-string + "/" "\\\\\\\\" (helm-attr 'basedir)) + (helm-attr 'basedir)) + (helm-attr 'subdir)) + nil t nil) + (buffer-string))) + +;;;###autoload +(defun helm-projects-find-files (update) + "Find files with locate in `helm-locate-project-list'. +With a prefix arg refresh the database in each project." + (interactive "P") + (helm-locate-set-command) + (cl-assert (and (string-match-p "\\`locate" helm-locate-command) + (executable-find "updatedb")) + nil "Unsupported locate version") + (let ((dbs (helm-locate-find-dbs-in-projects update))) + (if dbs + (helm-locate-with-db dbs) + (user-error "No projects found, please setup `helm-locate-project-list'")))) + +;;;###autoload +(defun helm-locate (arg) + "Preconfigured `helm' for Locate. +Note: you can add locate options after entering pattern. +See 'man locate' for valid options and also `helm-locate-command'. + +You can specify a local database with prefix argument ARG. +With two prefix arg, refresh the current local db or create it +if it doesn't exists. + +To create a user specific db, use +\"updatedb -l 0 -o db_path -U directory\". +Where db_path is a filename matched by +`helm-locate-db-file-regexp'." + (interactive "P") + (setq helm-ff-default-directory default-directory) + (helm-locate-1 arg nil nil (thing-at-point 'filename))) + +(provide 'helm-locate) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-locate.el ends here diff --git a/helm-man.el b/helm-man.el new file mode 100644 index 00000000..987624f6 --- /dev/null +++ b/helm-man.el @@ -0,0 +1,115 @@ +;;; helm-man.el --- Man and woman UI -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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) + +(defvar woman-topic-all-completions) +(defvar woman-manpath) +(defvar woman-path) +(defvar woman-expanded-directory-path) +(declare-function woman-file-name "woman.el" (topic &optional re-cache)) +(declare-function woman-file-name-all-completions "woman.el" (topic)) +(declare-function Man-getpage-in-background "man.el" (topic)) +(declare-function woman-expand-directory-path "woman.el" (path-dirs path-regexps)) +(declare-function woman-topic-all-completions "woman.el" (path)) +(declare-function helm-generic-sort-fn "helm-utils.el" (S1 S2)) + +(defgroup helm-man nil + "Man and Woman applications for helm." + :group 'helm) + +(defcustom helm-man-or-woman-function 'Man-getpage-in-background + "Default command to display a man page." + :group 'helm-man + :type '(radio :tag "Preferred command to display a man page" + (const :tag "Man" Man-getpage-in-background) + (const :tag "Woman" woman))) + +(defcustom helm-man-format-switches "-l %s" + "Arguments to pass to the `manual-entry' function. +Arguments are passed to `manual-entry' with `format.' +Default use \"-l\" which may not be supported on old man versions, +in this case use \"%s\" as value to pass only the filename as argument. +See Issue #1035" + :group 'helm-man + :type 'string) + +;; Internal +(defvar helm-man--pages nil + "All man pages on system. +Will be calculated the first time you invoke helm with this +source.") + +(defun helm-man-default-action (candidate) + "Default action for jumping to a woman or man page from helm." + (let ((wfiles (mapcar + 'car (woman-file-name-all-completions candidate)))) + (condition-case nil + (if (> (length wfiles) 1) + (let ((file (helm-comp-read + "ManFile: " wfiles :must-match t))) + (if (eq helm-man-or-woman-function 'Man-getpage-in-background) + (manual-entry (format helm-man-format-switches file)) + (woman-find-file file))) + (funcall helm-man-or-woman-function candidate)) + ;; If woman is unable to format correctly + ;; use man instead. + (error (kill-buffer) ; Kill woman buffer. + (Man-getpage-in-background candidate))))) + +(defun helm-man--init () + (require 'woman) + (require 'helm-utils) + (unless helm-man--pages + (setq woman-expanded-directory-path + (woman-expand-directory-path woman-manpath woman-path)) + (setq woman-topic-all-completions + (woman-topic-all-completions woman-expanded-directory-path)) + (setq helm-man--pages (mapcar 'car woman-topic-all-completions))) + (helm-init-candidates-in-buffer 'global helm-man--pages)) + +(defvar helm-source-man-pages + (helm-build-in-buffer-source "Manual Pages" + :init #'helm-man--init + :persistent-action #'ignore + :filtered-candidate-transformer + (lambda (candidates _source) + (sort candidates #'helm-generic-sort-fn)) + :action '(("Display Man page" . helm-man-default-action)))) + +;;;###autoload +(defun helm-man-woman (arg) + "Preconfigured `helm' for Man and Woman pages. +With a prefix arg reinitialize the cache." + (interactive "P") + (when arg (setq helm-man--pages nil)) + (helm :sources 'helm-source-man-pages + :buffer "*helm man woman*")) + +(provide 'helm-man) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-man.el ends here diff --git a/helm-misc.el b/helm-misc.el new file mode 100644 index 00000000..07911709 --- /dev/null +++ b/helm-misc.el @@ -0,0 +1,344 @@ +;;; helm-misc.el --- Various functions for helm -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-types) + +(declare-function display-time-world-display "time.el") +(defvar display-time-world-list) +(declare-function LaTeX-math-mode "ext:latex.el") +(declare-function jabber-chat-with "ext:jabber.el") +(declare-function jabber-read-account "ext:jabber.el") + + +(defgroup helm-misc nil + "Various Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-time-zone-home-location "Paris" + "The time zone of your home" + :group 'helm-misc + :type 'string) + +(defcustom helm-timezone-actions + '(("Set timezone env (TZ)" . (lambda (candidate) + (setenv "TZ" candidate)))) + "Actions for helm-timezone." + :group 'helm-misc + :type '(alist :key-type string :value-type function)) + +(defcustom helm-mini-default-sources '(helm-source-buffers-list + helm-source-recentf + helm-source-buffer-not-found) + "Default sources list used in `helm-mini'." + :group 'helm-misc + :type '(repeat (choice symbol))) + +(defface helm-time-zone-current + '((t (:foreground "green"))) + "Face used to colorize current time in `helm-world-time'." + :group 'helm-misc) + +(defface helm-time-zone-home + '((t (:foreground "red"))) + "Face used to colorize home time in `helm-world-time'." + :group 'helm-misc) + + + +;;; Latex completion +(defvar LaTeX-math-menu) +(defun helm-latex-math-candidates () + "Collect candidates for latex math completion." + (cl-loop for i in (cddr LaTeX-math-menu) + for elm = (cl-loop for s in i when (vectorp s) + collect (cons (aref s 0) (aref s 1))) + append elm)) + +(defvar helm-source-latex-math + (helm-build-sync-source "Latex Math Menu" + :init (lambda () + (with-helm-current-buffer + (LaTeX-math-mode 1))) + :candidate-number-limit 9999 + :candidates 'helm-latex-math-candidates + :action (lambda (candidate) + (call-interactively candidate)))) + + +;;; Jabber Contacts (jabber.el) +(defun helm-jabber-online-contacts () + "List online Jabber contacts." + (with-no-warnings + (cl-loop for item in (jabber-concat-rosters) + when (get item 'connected) + collect + (if (get item 'name) + (cons (get item 'name) item) + (cons (symbol-name item) item))))) + +(defvar helm-source-jabber-contacts + (helm-build-sync-source "Jabber Contacts" + :init (lambda () (require 'jabber)) + :candidates (lambda () (mapcar 'car (helm-jabber-online-contacts))) + :action (lambda (x) + (jabber-chat-with + (jabber-read-account) + (symbol-name + (cdr (assoc x (helm-jabber-online-contacts)))))))) + +;;; World time +;; +(defun helm-time-zone-transformer (candidates _source) + (cl-loop for i in candidates + for (z . p) in display-time-world-list + collect + (cons + (cond ((string-match (format-time-string "%H:%M" (current-time)) i) + (propertize i 'face 'helm-time-zone-current)) + ((string-match helm-time-zone-home-location i) + (propertize i 'face 'helm-time-zone-home)) + (t i)) + z))) + +(defvar helm-source-time-world + (helm-build-in-buffer-source "Time World List" + :data (lambda () + (with-temp-buffer + (display-time-world-display display-time-world-list) + (buffer-string))) + :action 'helm-timezone-actions + :filtered-candidate-transformer 'helm-time-zone-transformer)) + +;;; LaCarte +;; +;; +(declare-function lacarte-get-overall-menu-item-alist "ext:lacarte.el" (&optional MAPS)) + +(defun helm-lacarte-candidate-transformer (cands) + (mapcar (lambda (cand) + (let* ((item (car cand)) + (match (string-match "[^>] \\((.*)\\)$" item))) + (when match + (put-text-property (match-beginning 1) (match-end 1) + 'face 'helm-M-x-key item)) + cand)) + cands)) + +(defclass helm-lacarte (helm-source-sync helm-type-command) + ((init :initform (lambda () (require 'lacarte))) + (candidates :initform 'helm-lacarte-get-candidates) + (candidate-transformer :initform 'helm-lacarte-candidate-transformer) + (candidate-number-limit :initform 9999))) + +(defun helm-lacarte-get-candidates (&optional maps) + "Extract candidates for menubar using lacarte.el. +See http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el. +Optional argument MAPS is a list specifying which keymaps to use: it +can contain the symbols `local', `global', and `minor', mean the +current local map, current global map, and all current minor maps." + (with-helm-current-buffer + ;; When a keymap doesn't have a [menu-bar] entry + ;; the filtered map returned and passed to + ;; `lacarte-get-a-menu-item-alist-22+' is nil, which + ;; fails because this code is not protected for such case. + (condition-case nil + (lacarte-get-overall-menu-item-alist maps) + (error nil)))) + +;;;###autoload +(defun helm-browse-menubar () + "Preconfigured helm to the menubar using lacarte.el." + (interactive) + (require 'lacarte) + (helm :sources (mapcar + (lambda (spec) (helm-make-source (car spec) 'helm-lacarte + :candidates + (lambda () + (helm-lacarte-get-candidates (cdr spec))))) + '(("Major Mode" . (local)) + ("Minor Modes" . (minor)) + ("Global Map" . (global)))) + :buffer "*helm lacarte*")) + +(defun helm-call-interactively (cmd-or-name) + "Execute CMD-OR-NAME as Emacs command. +It is added to `extended-command-history'. +`helm-current-prefix-arg' is used as the command's prefix argument." + (setq extended-command-history + (cons (helm-stringify cmd-or-name) + (delete (helm-stringify cmd-or-name) extended-command-history))) + (let ((current-prefix-arg helm-current-prefix-arg) + (cmd (helm-symbolify cmd-or-name))) + (if (stringp (symbol-function cmd)) + (execute-kbd-macro (symbol-function cmd)) + (setq this-command cmd) + (call-interactively cmd)))) + +;;; Minibuffer History +;; +;; +(defvar helm-source-minibuffer-history + (helm-build-sync-source "Minibuffer History" + :header-name (lambda (name) + (format "%s (%s)" name minibuffer-history-variable)) + :candidates + (lambda () + (let ((history (cl-loop for i in + (symbol-value minibuffer-history-variable) + unless (string= "" i) collect i))) + (if (consp (car history)) + (mapcar 'prin1-to-string history) + history))) + :migemo t + :multiline t + :action (lambda (candidate) + (delete-minibuffer-contents) + (insert candidate)))) + +;;; Shell history +;; +;; +(defun helm-comint-input-ring-action (candidate) + "Default action for comint history." + (with-helm-current-buffer + (delete-region (comint-line-beginning-position) (point-max)) + (insert candidate))) + +(defvar helm-source-comint-input-ring + (helm-build-sync-source "Comint history" + :candidates (lambda () + (with-helm-current-buffer + (ring-elements comint-input-ring))) + :action 'helm-comint-input-ring-action) + "Source that provide helm completion against `comint-input-ring'.") + + +;;; Helm ratpoison UI +;; +;; +(defvar helm-source-ratpoison-commands + (helm-build-in-buffer-source "Ratpoison Commands" + :init 'helm-ratpoison-commands-init + :action (helm-make-actions + "Execute the command" 'helm-ratpoison-commands-execute) + :display-to-real 'helm-ratpoison-commands-display-to-real + :candidate-number-limit 999999)) + +(defun helm-ratpoison-commands-init () + (unless (helm-candidate-buffer) + (with-current-buffer (helm-candidate-buffer 'global) + ;; with ratpoison prefix key + (save-excursion + (call-process "ratpoison" nil (current-buffer) nil "-c" "help")) + (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) + (replace-match " \\1: \\2")) + (goto-char (point-max)) + ;; direct binding + (save-excursion + (call-process "ratpoison" nil (current-buffer) nil "-c" "help top")) + (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) + (replace-match "\\1: \\2"))))) + +(defun helm-ratpoison-commands-display-to-real (display) + (and (string-match ": " display) + (substring display (match-end 0)))) + +(defun helm-ratpoison-commands-execute (candidate) + (call-process "ratpoison" nil nil nil "-ic" candidate)) + +;;; Helm stumpwm UI +;; +;; +(defvar helm-source-stumpwm-commands + (helm-build-in-buffer-source "Stumpwm Commands" + :init 'helm-stumpwm-commands-init + :action (helm-make-actions + "Execute the command" 'helm-stumpwm-commands-execute) + :candidate-number-limit 999999)) + +(defun helm-stumpwm-commands-init () + (with-current-buffer (helm-candidate-buffer 'global) + (save-excursion + (call-process "stumpish" nil (current-buffer) nil "commands")) + (while (re-search-forward "[ ]*\\([^ ]+\\)[ ]*\n?" nil t) + (replace-match "\n\\1\n")) + (delete-blank-lines) + (sort-lines nil (point-min) (point-max)) + (goto-char (point-max)))) + +(defun helm-stumpwm-commands-execute (candidate) + (call-process "stumpish" nil nil nil candidate)) + +;;;###autoload +(defun helm-world-time () + "Preconfigured `helm' to show world time. +Default action change TZ environment variable locally to emacs." + (interactive) + (helm-other-buffer 'helm-source-time-world "*helm world time*")) + +;;;###autoload +(defun helm-insert-latex-math () + "Preconfigured helm for latex math symbols completion." + (interactive) + (helm-other-buffer 'helm-source-latex-math "*helm latex*")) + +;;;###autoload +(defun helm-ratpoison-commands () + "Preconfigured `helm' to execute ratpoison commands." + (interactive) + (helm-other-buffer 'helm-source-ratpoison-commands + "*helm ratpoison commands*")) + +;;;###autoload +(defun helm-stumpwm-commands() + "Preconfigured helm for stumpwm commands." + (interactive) + (helm-other-buffer 'helm-source-stumpwm-commands + "*helm stumpwm commands*")) + +;;;###autoload +(defun helm-minibuffer-history () + "Preconfigured `helm' for `minibuffer-history'." + (interactive) + (let ((enable-recursive-minibuffers t)) + (helm :sources 'helm-source-minibuffer-history + :buffer "*helm minibuffer-history*"))) + +;;;###autoload +(defun helm-comint-input-ring () + "Preconfigured `helm' that provide completion of `comint' history." + (interactive) + (when (derived-mode-p 'comint-mode) + (helm :sources 'helm-source-comint-input-ring + :input (buffer-substring-no-properties (comint-line-beginning-position) + (point-at-eol)) + :buffer "*helm comint history*"))) + + +(provide 'helm-misc) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-misc.el ends here diff --git a/helm-mode.el b/helm-mode.el new file mode 100644 index 00000000..003141fa --- /dev/null +++ b/helm-mode.el @@ -0,0 +1,1205 @@ +;;; helm-mode.el --- Enable helm completion everywhere. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-files) + + +(defgroup helm-mode nil + "Enable helm completion." + :group 'helm) + +(defcustom helm-completing-read-handlers-alist + '((describe-function . helm-completing-read-symbols) + (describe-variable . helm-completing-read-symbols) + (describe-symbol . helm-completing-read-symbols) + (debug-on-entry . helm-completing-read-symbols) + (find-function . helm-completing-read-symbols) + (disassemble . helm-completing-read-symbols) + (trace-function . helm-completing-read-symbols) + (trace-function-foreground . helm-completing-read-symbols) + (trace-function-background . helm-completing-read-symbols) + (find-tag . helm-completing-read-with-cands-in-buffer) + (org-capture . helm-org-completing-read-tags) + (org-set-tags . helm-org-completing-read-tags) + (ffap-alternate-file . nil) + (tmm-menubar . nil) + (find-file . nil) + (execute-extended-command . nil)) + "Alist of handlers to replace `completing-read', `read-file-name' in `helm-mode'. +Each entry is a cons cell like \(emacs_command . completing-read_handler\) +where key and value are symbols. + +Each key is an Emacs command that use originaly `completing-read'. + +Each value maybe an helm function that take same arguments as +`completing-read' plus NAME and BUFFER, where NAME is the name of the new +helm source and BUFFER the name of the buffer we will use. +This function prefix name must start by \"helm\". + +See `helm-completing-read-symbols' for example. + +Note that this function will be reused for ALL the `completing-read' +of this command, so it should handle all cases, e.g +If first `completing-read' complete against symbols and +second `completing-read' should handle only buffer, +your specialized function should handle the both. + +If the value of an entry is nil completion will fall back to +emacs vanilla behavior. +e.g If you want to disable helm completion for `describe-function': +\(describe-function . nil\). + +Ido is also supported, you can use `ido-completing-read' and +`ido-read-file-name' as value of an entry or just 'ido. +e.g ido completion for `find-file': +\(find-file . ido\) +same as +\(find-file . ido-read-file-name\) +Note that you don't need to enable `ido-mode' for this to work." + :group 'helm-mode + :type '(alist :key-type symbol :value-type symbol)) + +(defcustom helm-comp-read-case-fold-search helm-case-fold-search + "Default Local setting of `helm-case-fold-search' for `helm-comp-read'. +See `helm-case-fold-search' for more info." + :group 'helm-mode + :type 'symbol) + +(defcustom helm-mode-handle-completion-in-region t + "Whether to replace or not `completion-in-region-function'. +This enable support for `completing-read-multiple' and `completion-at-point' +when non--nil." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-mode-reverse-history t + "Display history source after current source in `helm-mode' handled commands." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-mode-no-completion-in-region-in-modes nil + "A list of modes that do not want helm for `completion-in-region'." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-completion-in-region-fuzzy-match nil + "Whether `helm-completion-in-region' use fuzzy matching or not. +Affect among others `completion-at-point', `completing-read-multiple'." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-mode-fuzzy-match nil + "Enable fuzzy matching in `helm-mode' globally. +Note that this will slow down completion and modify sorting +which is unwanted in many places. +This affect only the functions with completing-read helmized by helm-mode. +To fuzzy match `completion-at-point' and friends see +`helm-completion-in-region-fuzzy-match'." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-mode-minibuffer-setup-hook-black-list '(minibuffer-completion-help) + "Incompatible `minibuffer-setup-hook' functions go here. +A list of symbols. +Helm-mode is rejecting all lambda's, byte-code fns +and all functions belonging in this list from `minibuffer-setup-hook'." + :group 'helm-mode + :type '(repeat (choice symbol))) + + +(defvar helm-comp-read-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") 'helm-cr-empty-string) + (define-key map (kbd "") 'helm-cr-empty-string) + map) + "Keymap for `helm-comp-read'.") + +(defvar helm-comp-read-must-match-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") + 'helm-confirm-and-exit-minibuffer) + map) + "Keymap use as must-match-map in `helm-comp-read' and `helm-read-file-name'.") + + +;;; Internal +;; +;; +;; Flag to know if `helm-pattern' have been added +;; to candidate list in `helm-comp-read'. +(defvar helm-cr-unknown-pattern-flag nil) + + +;;; Helm `completing-read' replacement +;; +;; +(defun helm-cr-empty-string () + "Return empty string." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action + (lambda (_candidate) + (identity ""))))) +(put 'helm-cr-empty-string 'helm-only t) + +(defun helm-mode--keyboard-quit () + ;; Use this instead of `keyboard-quit' + ;; to avoid deactivating mark in current-buffer. + (let ((debug-on-quit nil)) + (signal 'quit nil))) + +(cl-defun helm-comp-read-get-candidates (collection &optional test sort-fn alistp (input "")) + "Convert COLLECTION to list removing elements that don't match TEST. +See `helm-comp-read' about supported COLLECTION arguments. + +SORT-FN is a predicate to sort COLLECTION. + +ALISTP when non--nil will not use `all-completions' to collect +candidates because it doesn't handle alists correctly for helm. +i.e In `all-completions' the car of each pair is used as value. +In helm we want to use the cdr instead like \(display . real\), +so we return the alist as it is with no transformation by all-completions. + +e.g + +\(setq A '((a . 1) (b . 2) (c . 3))) +==>((a . 1) (b . 2) (c . 3)) +\(helm-comp-read \"test: \" A :alistp nil + :exec-when-only-one t + :initial-input \"a\") +==>\"a\" Which is not what we expect. + +\(helm-comp-read \"test: \" A :alistp t + :exec-when-only-one t + :initial-input \"1\") +==>\"1\" + +See docstring of `all-completions' for more info. + +If COLLECTION is an `obarray', a TEST should be needed. See `obarray'." + ;; Ensure COLLECTION is computed from `helm-current-buffer' + ;; because some functions used as COLLECTION work + ;; only in the context of current-buffer (Issue #1030) . + (with-helm-current-buffer + (let ((cands + (cond ((vectorp collection) + (all-completions input collection test)) + ((and (symbolp collection) (boundp collection) + ;; Issue #324 history is let-bounded and given + ;; quoted as hist argument of completing-read. + ;; See example in `rcirc-browse-url'. + (symbolp (symbol-value collection))) + nil) + ;; When collection is a symbol, most of the time + ;; it should be a symbol used as a minibuffer-history. + ;; The value of this symbol in this case return a list + ;; of string which maybe are converted later as symbol + ;; in special cases. + ;; we treat here commandp as a special case as it return t + ;; also with a string unless its last arg is provided. + ;; Also, the history collections generally collect their + ;; elements as string, so intern them to call predicate. + ((and (symbolp collection) (boundp collection) test) + (let ((predicate (lambda (elm) + (condition-case _err + (if (eq test 'commandp) + (funcall test (intern elm)) + (funcall test elm)) + (wrong-type-argument + (funcall test (intern elm))))))) + (all-completions input (symbol-value collection) predicate))) + ((and (symbolp collection) (boundp collection)) + (all-completions input (symbol-value collection))) + ;; Normally file completion should not be handled here, + ;; but special cases like `find-file-at-point' do it. + ;; Handle here specially such cases. + ((and (functionp collection) minibuffer-completing-file-name) + (cl-loop for f in (funcall collection helm-pattern test t) + unless (member f '("./" "../")) + if (string-match ffap-url-regexp helm-pattern) + collect f + else + collect (concat (file-name-as-directory + (helm-basedir helm-pattern)) f))) + ((functionp collection) + (funcall collection input test t)) + ((and alistp (null test)) collection) + ;; Next test ensure circular objects are removed + ;; with `all-completions' (Issue #1530). + (t (all-completions input collection test))))) + (if sort-fn (sort cands sort-fn) cands)))) + +(defun helm-cr-default-transformer (candidates _source) + "Default filter candidate function for `helm-comp-read'." + (cl-loop for c in candidates + for cand = (if (stringp c) (replace-regexp-in-string "\\s\\" "" c) c) + for pat = (replace-regexp-in-string "\\s\\" "" helm-pattern) + if (and (equal cand pat) helm-cr-unknown-pattern-flag) + collect + (cons (concat (propertize + " " 'display + (propertize "[?]" 'face 'helm-ff-prefix)) + c) + c) + into lst + else collect (if (and (stringp c) + (string-match "\n" c)) + (cons (replace-regexp-in-string "\n" "->" c) c) + c) + into lst + finally return (helm-fast-remove-dups lst :test 'equal))) + +(defun helm-comp-read--move-to-first-real-candidate () + (helm-aif (helm-get-selection nil 'withprop) + (when (string= (get-text-property 0 'display it) "[?]") + (helm-next-line)))) + +(defun helm-cr-default (default cands) + (delq nil + (cond ((and (stringp default) (not (string= default ""))) + (cons default (delete default cands))) + ((consp default) + (append (cl-loop for d in default + ;; Don't convert + ;; nil to "nil" (i.e the string) + ;; it will be delq'ed on top. + collect (if (null d) d (helm-stringify d))) + cands)) + (t cands)))) + +;;;###autoload +(cl-defun helm-comp-read (prompt collection + &key + test + initial-input + default + preselect + (buffer "*Helm Completions*") + must-match + fuzzy + reverse-history + (requires-pattern 0) + history + input-history + (case-fold helm-comp-read-case-fold-search) + (del-input t) + (persistent-action nil) + (persistent-help "DoNothing") + (mode-line helm-comp-read-mode-line) + help-message + (keymap helm-comp-read-map) + (name "Helm Completions") + candidates-in-buffer + match-part + exec-when-only-one + quit-when-no-cand + (volatile t) + sort + (fc-transformer 'helm-cr-default-transformer) + hist-fc-transformer + marked-candidates + nomark + (alistp t) + (candidate-number-limit helm-candidate-number-limit)) + "Read a string in the minibuffer, with helm completion. + +It is helm `completing-read' equivalent. + +- PROMPT is the prompt name to use. + +- COLLECTION can be a list, vector, obarray or hash-table. + It can be also a function that receives three arguments: + the values string, predicate and t. See `all-completions' for more details. + +Keys description: + +- TEST: A predicate called with one arg i.e candidate. + +- INITIAL-INPUT: Same as input arg in `helm'. + +- PRESELECT: See preselect arg of `helm'. + +- DEFAULT: This option is used only for compatibility with regular + Emacs `completing-read' (Same as DEFAULT arg of `completing-read'). + +- BUFFER: Name of helm-buffer. + +- MUST-MATCH: Candidate selected must be one of COLLECTION. + +- FUZZY: Enable fuzzy matching. + +- REVERSE-HISTORY: When non--nil display history source after current + source completion. + +- REQUIRES-PATTERN: Same as helm attribute, default is 0. + +- HISTORY: A list containing specific history, default is nil. + When it is non--nil, all elements of HISTORY are displayed in + a special source before COLLECTION. + +- INPUT-HISTORY: A symbol. the minibuffer input history will be + stored there, if nil or not provided, `minibuffer-history' + will be used instead. + +- CASE-FOLD: Same as `helm-case-fold-search'. + +- DEL-INPUT: Boolean, when non--nil (default) remove the partial + minibuffer input from HISTORY is present. + +- PERSISTENT-ACTION: A function called with one arg i.e candidate. + +- PERSISTENT-HELP: A string to document PERSISTENT-ACTION. + +- MODE-LINE: A string or list to display in mode line. + Default is `helm-comp-read-mode-line'. + +- KEYMAP: A keymap to use in this `helm-comp-read'. + (the keymap will be shared with history source) + +- NAME: The name related to this local source. + +- EXEC-WHEN-ONLY-ONE: Bound `helm-execute-action-at-once-if-one' + to non--nil. (possibles values are t or nil). + +- VOLATILE: Use volatile attribute. + +- SORT: A predicate to give to `sort' e.g `string-lessp' + Use this only on small data as it is ineficient. + If you want to sort faster add a sort function to + FC-TRANSFORMER. + Note that FUZZY when enabled is already providing a sort function. + +- FC-TRANSFORMER: A `filtered-candidate-transformer' function + or a list of functions. + +- HIST-FC-TRANSFORMER: A `filtered-candidate-transformer' + function for the history source. + +- MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list. + +- NOMARK: When non--nil don't allow marking candidates. + +- ALISTP: \(default is non--nil\) See `helm-comp-read-get-candidates'. + +- CANDIDATES-IN-BUFFER: when non--nil use a source build with + `helm-source-in-buffer' which is much faster. + Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil. + +- MATCH-PART: Allow matching only one part of candidate. + See match-part documentation in `helm-source'. + +Any prefix args passed during `helm-comp-read' invocation will be recorded +in `helm-current-prefix-arg', otherwise if prefix args were given before +`helm-comp-read' invocation, the value of `current-prefix-arg' will be used. +That's mean you can pass prefix args before or after calling a command +that use `helm-comp-read' See `helm-M-x' for example." + + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (let ((action-fn `(("Sole action (Identity)" + . (lambda (candidate) + (if ,marked-candidates + (helm-marked-candidates) + (identity candidate))))))) + ;; Assume completion have been already required, + ;; so always use 'confirm. + (when (eq must-match 'confirm-after-completion) + (setq must-match 'confirm)) + (let* ((minibuffer-completion-confirm must-match) + (must-match-map (when must-match helm-comp-read-must-match-map)) + (loc-map (if must-match-map + (make-composed-keymap + must-match-map (or keymap helm-map)) + (or keymap helm-map))) + (minibuffer-completion-predicate test) + (minibuffer-completion-table collection) + (helm-read-file-name-mode-line-string + (replace-regexp-in-string "helm-maybe-exit-minibuffer" + "helm-confirm-and-exit-minibuffer" + helm-read-file-name-mode-line-string)) + (get-candidates + (lambda () + (let ((cands (helm-comp-read-get-candidates + collection test sort alistp))) + (setq helm-cr-unknown-pattern-flag nil) + (unless (or (eq must-match t) + (string= helm-pattern "") + (assoc helm-pattern cands) + (assoc (intern helm-pattern) cands) + (member helm-pattern cands) + (member (downcase helm-pattern) cands) + (member (upcase helm-pattern) cands)) + (setq cands (append (list + ;; Unquote helm-pattern + ;; when it is added + ;; as candidate. + (replace-regexp-in-string + "\\s\\" "" helm-pattern)) + cands)) + (setq helm-cr-unknown-pattern-flag t)) + (helm-cr-default default cands)))) + (history-get-candidates + (lambda () + (let ((cands (helm-comp-read-get-candidates + history test nil alistp))) + (when cands + (delete "" (helm-cr-default default cands)))))) + (src-hist (helm-build-sync-source (format "%s History" name) + :candidates history-get-candidates + :fuzzy-match fuzzy + :match-part match-part + :filtered-candidate-transformer + (append '((lambda (candidates sources) + (cl-loop for i in candidates + ;; Input is added to history in completing-read's + ;; and may be regexp-quoted, so unquote it + ;; but check if cand is a string (it may be at this stage + ;; a symbol or nil) Issue #1553. + when (stringp i) + collect (replace-regexp-in-string "\\s\\" "" i)))) + (and hist-fc-transformer (helm-mklist hist-fc-transformer))) + :persistent-action persistent-action + :persistent-help persistent-help + :mode-line mode-line + :help-message help-message + :action action-fn)) + (src (helm-build-sync-source name + :candidates get-candidates + :match-part match-part + :filtered-candidate-transformer fc-transformer + :requires-pattern requires-pattern + :persistent-action persistent-action + :persistent-help persistent-help + :fuzzy-match fuzzy + :mode-line mode-line + :help-message help-message + :action action-fn + :volatile volatile)) + (src-1 (helm-build-in-buffer-source name + :data get-candidates + :match-part match-part + :filtered-candidate-transformer fc-transformer + :requires-pattern requires-pattern + :persistent-action persistent-action + :fuzzy-match fuzzy + :persistent-help persistent-help + :mode-line mode-line + :help-message help-message + :action action-fn)) + (src-list (list src-hist + (if candidates-in-buffer + src-1 src))) + (helm-execute-action-at-once-if-one exec-when-only-one) + (helm-quit-if-no-candidate quit-when-no-cand) + result) + (when nomark + (setq src-list (cl-loop for src in src-list + collect (cons '(nomark) src)))) + (when reverse-history (setq src-list (nreverse src-list))) + (add-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate) + (unwind-protect + (setq result (helm + :sources src-list + :input initial-input + :default default + :preselect preselect + :prompt prompt + :resume 'noresume + :candidate-number-limit candidate-number-limit + :case-fold-search case-fold + :keymap loc-map + :history (and (symbolp input-history) input-history) + :buffer buffer)) + (remove-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate)) + ;; Avoid adding an incomplete input to history. + (when (and result history del-input) + (cond ((and (symbolp history) ; History is a symbol. + (not (symbolp (symbol-value history)))) ; Fix Issue #324. + ;; Be sure history is not a symbol with a nil value. + (helm-aif (symbol-value history) (setcar it result))) + ((consp history) ; A list with a non--nil value. + (setcar history result)) + (t ; Possibly a symbol with a nil value. + (set history (list result))))) + (or result (helm-mode--keyboard-quit))))) + +;; Generic completing-read +;; +;; Support also function as collection. +;; e.g M-x man is supported. +;; Support hash-table and vectors as collection. +;; NOTE: +;; Some crap emacs functions may not be supported +;; like ffap-alternate-file (bad use of completing-read) +;; and maybe others. +;; Provide a mode `helm-mode' which turn on +;; helm in all `completing-read' and `read-file-name' in Emacs. +;; +(defvar helm-completion-mode-string " Helm") + +(defvar helm-completion-mode-quit-message + "Helm completion disabled") + +(defvar helm-completion-mode-start-message + "Helm completion enabled") + +;;; Specialized handlers +;; +;; +(defun helm-completing-read-symbols + (prompt _collection test _require-match init + hist default _inherit-input-method name buffer) + "Specialized function for fast symbols completion in `helm-mode'." + (require 'helm-elisp) + (or + (helm + :sources (helm-build-in-buffer-source name + :init (lambda () + (helm-apropos-init (lambda (x) + (and (funcall test x) + (not (keywordp x)))) + (or (car-safe default) default))) + :filtered-candidate-transformer 'helm-apropos-default-sort-fn + :fuzzy-match helm-mode-fuzzy-match + :persistent-action + (lambda (candidate) + (helm-lisp-completion-persistent-action + candidate name)) + :persistent-help (helm-lisp-completion-persistent-help)) + :prompt prompt + :buffer buffer + :input init + :history hist + :resume 'noresume + :default (or default "")) + (helm-mode--keyboard-quit))) + + +;;; Generic completing read +;; +;; +(defun helm-completing-read-default-1 + (prompt collection test require-match + init hist default _inherit-input-method + name buffer &optional cands-in-buffer exec-when-only-one) + "Call `helm-comp-read' with same args as `completing-read'. +Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer' +method which is faster. +It should be used when candidate list don't need to rebuild dynamically." + (let ((history (or (car-safe hist) hist)) + (alistp cands-in-buffer) + (initial-input (helm-aif (pcase init + ((pred (stringp)) init) + ;; INIT is a cons cell. + (`(,l . ,_ll) l)) + (if minibuffer-completing-file-name it + (regexp-quote it))))) + (helm-comp-read + prompt collection + :test test + :history history + :reverse-history helm-mode-reverse-history + :input-history history + :must-match require-match + :alistp alistp + :name name + :requires-pattern (if (and (stringp default) + (string= default "") + (or (eq require-match 'confirm) + (eq require-match + 'confirm-after-completion))) + 1 0) + :candidates-in-buffer cands-in-buffer + :exec-when-only-one exec-when-only-one + :fuzzy helm-mode-fuzzy-match + :buffer buffer + ;; If DEF is not provided, fallback to empty string + ;; to avoid `thing-at-point' to be appended on top of list + :default (or default "") + ;; Fail with special characters (e.g in gnus "nnimap+gmail:") + ;; if regexp-quote is not used. + ;; when init is added to history, it will be unquoted by + ;; helm-comp-read. + :initial-input initial-input))) + +(defun helm-completing-read-with-cands-in-buffer + (prompt collection test require-match + init hist default inherit-input-method + name buffer) + "Same as `helm-completing-read-default-1' but use candidates-in-buffer." + ;; Some commands like find-tag may use `read-file-name' from inside + ;; the calculation of collection. in this case it clash with + ;; candidates-in-buffer that reuse precedent data (files) which is wrong. + ;; So (re)calculate collection outside of main helm-session. + (let ((cands (all-completions (or init "") collection))) + (helm-completing-read-default-1 prompt cands test require-match + init hist default inherit-input-method + name buffer t))) + +(cl-defun helm--completing-read-default + (prompt collection &optional + predicate require-match + initial-input hist def + inherit-input-method) + "An helm replacement of `completing-read'. +This function should be used only as a `completing-read-function'. + +Don't use it directly, use instead `helm-comp-read' in your programs. + +See documentation of `completing-read' and `all-completions' for details." + (let* ((current-command (or (helm-this-command) this-command)) + (str-command (helm-symbol-name current-command)) + (buf-name (format "*helm-mode-%s*" str-command)) + (entry (assq current-command + helm-completing-read-handlers-alist)) + (def-com (cdr-safe entry)) + (str-defcom (and def-com (helm-symbol-name def-com))) + (def-args (list prompt collection predicate require-match + initial-input hist def inherit-input-method)) + ;; Append the two extra args needed to set the buffer and source name + ;; in helm specialized functions. + (any-args (append def-args (list str-command buf-name))) + helm-completion-mode-start-message ; Be quiet + helm-completion-mode-quit-message + ;; Be sure this pesty *completion* buffer doesn't popup. + ;; Note: `minibuffer-with-setup-hook' may setup a lambda + ;; calling `minibuffer-completion-help' or other minibuffer + ;; functions we DONT WANT here, in these cases removing the hook + ;; (a symbol) have no effect. Issue #448. + ;; Because `minibuffer-completion-table' and + ;; `minibuffer-completion-predicate' are not bound + ;; anymore here, these functions should have no effect now, + ;; except in some rare cases like in `woman-file-name', + ;; so remove all incompatible functions + ;; from `minibuffer-setup-hook' (Issue #1205, #1240). + ;; otherwise helm have not the time to close its initial session. + (minibuffer-setup-hook + (cl-loop for h in minibuffer-setup-hook + unless (or (consp h) ; a lambda. + (byte-code-function-p h) + (memq h helm-mode-minibuffer-setup-hook-black-list)) + collect h)) + ;; Disable hack that could be used before `completing-read'. + ;; i.e (push ?\t unread-command-events). + unread-command-events) + (when (eq def-com 'ido) (setq def-com 'ido-completing-read)) + (unless (or (not entry) def-com) + ;; An entry in *read-handlers-alist exists but have + ;; a nil value, so we exit from here, disable `helm-mode' + ;; and run the command again with it original behavior. + ;; `helm-mode' will be restored on exit. + (cl-return-from helm--completing-read-default + (unwind-protect + (progn + (helm-mode -1) + (apply completing-read-function def-args)) + (helm-mode 1)))) + ;; If we use now `completing-read' we MUST turn off `helm-mode' + ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. + (when (or (eq def-com 'completing-read) + ;; All specialized functions are prefixed by "helm" + (and (stringp str-defcom) + (not (string-match "^helm" str-defcom)))) + (helm-mode -1)) + (unwind-protect + (cond (;; An helm specialized function exists, run it. + (and def-com helm-mode) + (apply def-com any-args)) + (;; Try to handle `ido-completing-read' everywhere. + (and def-com (eq def-com 'ido-completing-read)) + (setcar (memq collection def-args) + (all-completions "" collection predicate)) + (apply def-com def-args)) + (;; User set explicitely `completing-read' or something similar + ;; in *read-handlers-alist, use this with exactly the same + ;; args as in `completing-read'. + ;; If we are here `helm-mode' is now disabled. + def-com + (apply def-com def-args)) + (t ; Fall back to classic `helm-comp-read'. + (helm-completing-read-default-1 + prompt collection predicate require-match + initial-input hist def inherit-input-method + str-command buf-name))) + (helm-mode 1) + ;; When exiting minibuffer, `this-command' is set to + ;; `helm-exit-minibuffer', which is unwanted when starting + ;; on another `completing-read', so restore `this-command' to + ;; initial value when exiting. + (setq this-command current-command)))) + +;;; Generic read-file-name +;; +;; +;;;###autoload +(cl-defun helm-read-file-name + (prompt + &key + (name "Read File Name") + (initial-input default-directory) + (buffer "*Helm file completions*") + test + (case-fold helm-file-name-case-fold-search) + preselect + history + must-match + default + marked-candidates + (candidate-number-limit helm-ff-candidate-number-limit) + nomark + (alistp t) + (persistent-action 'helm-find-files-persistent-action) + (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file") + (mode-line helm-read-file-name-mode-line-string)) + "Read a file name with helm completion. +It is helm `read-file-name' emulation. + +Argument PROMPT is the default prompt to use. + +Keys description: + +- NAME: Source name, default to \"Read File Name\". + +- INITIAL-INPUT: Where to start read file name, default to `default-directory'. + +- BUFFER: `helm-buffer' name default to \"*Helm Completions*\". + +- TEST: A predicate called with one arg 'candidate'. + +- CASE-FOLD: Same as `helm-case-fold-search'. + +- PRESELECT: helm preselection. + +- HISTORY: Display HISTORY in a special source. + +- MUST-MATCH: Can be 'confirm, nil, or t. + +- MARKED-CANDIDATES: When non--nil return a list of marked candidates. + +- NOMARK: When non--nil don't allow marking candidates. + +- ALISTP: Don't use `all-completions' in history (take effect only on history). + +- PERSISTENT-ACTION: a persistent action function. + +- PERSISTENT-HELP: persistent help message. + +- MODE-LINE: A mode line message, default is `helm-read-file-name-mode-line-string'." + + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + ;; Assume completion have been already required, + ;; so always use 'confirm. + (when (eq must-match 'confirm-after-completion) + (setq must-match 'confirm)) + (mapc (lambda (hook) + (add-hook 'helm-after-update-hook hook)) + '(helm-ff-move-to-first-real-candidate + helm-ff-update-when-only-one-matched + helm-ff-auto-expand-to-home-or-root)) + (let* ((action-fn `(("Sole action (Identity)" + . (lambda (candidate) + (if ,marked-candidates + (helm-marked-candidates :with-wildcard t) + (identity candidate)))))) + ;; Be sure we don't erase the underlying minibuffer if some. + (helm-ff-auto-update-initial-value + (and helm-ff-auto-update-initial-value + (not (minibuffer-window-active-p (minibuffer-window))))) + helm-full-frame + helm-follow-mode-persistent + (hist (and history (helm-comp-read-get-candidates + history nil nil alistp))) + (minibuffer-completion-confirm must-match) + (must-match-map (when must-match helm-comp-read-must-match-map)) + (cmap (if must-match-map + (make-composed-keymap + must-match-map helm-read-file-map) + helm-read-file-map)) + (minibuffer-completion-predicate test) + (minibuffer-completing-file-name t) + (helm-read-file-name-mode-line-string + (replace-regexp-in-string "helm-maybe-exit-minibuffer" + "helm-confirm-and-exit-minibuffer" + helm-read-file-name-mode-line-string)) + (src-list + (list + ;; History source. + (helm-build-sync-source (format "%s History" name) + :header-name (lambda (name) + (concat name (substitute-command-keys + helm-find-files-doc-header))) + :mode-line mode-line + :candidates hist + :nohighlight t + :persistent-action persistent-action + :persistent-help persistent-help + :nomark nomark + :action action-fn) + ;; Other source. + (helm-build-sync-source name + :header-name (lambda (name) + (concat name (substitute-command-keys + helm-find-files-doc-header))) + :init (lambda () + (setq helm-ff-auto-update-flag + helm-ff-auto-update-initial-value) + (setq helm-ff--auto-update-state + helm-ff-auto-update-flag)) + :mode-line mode-line + :help-message 'helm-read-file-name-help-message + :nohighlight t + :candidates + (lambda () + (append (and (not (file-exists-p helm-pattern)) + (list helm-pattern)) + (if test + (cl-loop with hn = (helm-ff-tramp-hostnames) + for i in (helm-find-files-get-candidates + must-match) + when (or (member i hn) ; A tramp host + (funcall test i)) ; Test ok + collect i) + (helm-find-files-get-candidates must-match)))) + :filtered-candidate-transformer 'helm-ff-sort-candidates + :filter-one-by-one 'helm-ff-filter-candidate-one-by-one + :persistent-action persistent-action + :persistent-help persistent-help + :volatile t + :cleanup 'helm-find-files-cleanup + :nomark nomark + :action action-fn))) + ;; Helm result. + (result (helm + :sources src-list + :input (expand-file-name initial-input) + :prompt prompt + :keymap cmap + :candidate-number-limit candidate-number-limit + :resume 'noresume + :case-fold-search case-fold + :default default + :buffer buffer + :preselect preselect))) + (or + (cond ((and result (stringp result) + (string= result "") "")) + ((and result + (stringp result) + (file-equal-p result initial-input) + default) + (if (listp default) (car default) default)) + ((and result (stringp result)) + (expand-file-name result)) + ((and result (listp result)) + (mapcar #'expand-file-name result)) + (t result)) + (helm-mode--keyboard-quit)))) + +(defun helm-mode--default-filename (fname dir initial) + (unless dir (setq dir default-directory)) + (unless (file-name-absolute-p dir) + (setq dir (expand-file-name dir))) + (unless (or fname (consp fname)) + (setq fname (expand-file-name + (or initial buffer-file-name dir) + dir))) + (if (and fname (consp fname)) + (setq fname (cl-loop for f in fname + collect (expand-file-name f dir))) + (if (file-name-absolute-p fname) + fname (expand-file-name fname dir)))) + +(cl-defun helm--generic-read-file-name + (prompt &optional dir default-filename mustmatch initial predicate) + "Generic helm replacement of `read-file-name'. +Don't use it directly, use instead `helm-read-file-name' in your programs." + (let* ((init (or initial dir default-directory)) + (current-command (or (helm-this-command) this-command)) + (str-command (helm-symbol-name current-command)) + (helm--file-completion-sources + (cons str-command + (remove str-command helm--file-completion-sources))) + (buf-name (format "*helm-mode-%s*" str-command)) + (entry (assq current-command + helm-completing-read-handlers-alist)) + (def-com (cdr-safe entry)) + (str-defcom (and def-com (helm-symbol-name def-com))) + (def-args (list prompt dir default-filename mustmatch initial predicate)) + ;; Append the two extra args needed to set the buffer and source name + ;; in helm specialized functions. + (any-args (append def-args (list str-command buf-name))) + (ido-state ido-mode) + helm-completion-mode-start-message ; Be quiet + helm-completion-mode-quit-message ; Same here + fname) + (setq default-filename (helm-mode--default-filename + default-filename dir initial)) + ;; Some functions that normally call `completing-read' can switch + ;; brutally to `read-file-name' (e.g find-tag), in this case + ;; the helm specialized function will fail because it is build + ;; for `completing-read', so set it to 'incompatible to be sure + ;; we switch to `helm-read-file-name' and don't try to call it + ;; with wrong number of args. + (when (eq def-com 'ido) + (setq def-com 'ido-read-file-name) (ido-mode 1)) + (when (and def-com (> (length (help-function-arglist def-com)) 8)) + (setq def-com 'incompatible)) + (unless (or (not entry) def-com) + (cl-return-from helm--generic-read-file-name + (unwind-protect + (progn + (helm-mode -1) + (apply read-file-name-function def-args)) + (helm-mode 1)))) + ;; If we use now `read-file-name' we MUST turn off `helm-mode' + ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. + (when (or (eq def-com 'read-file-name) + (eq def-com 'ido-read-file-name) + (and (stringp str-defcom) + (not (string-match "^helm" str-defcom)))) + (helm-mode -1)) + (unwind-protect + (setq fname + (cond (;; A specialized function exists, run it + ;; with the two extra args specific to helm.. + (and def-com helm-mode + (not (eq def-com 'ido-read-file-name)) + (not (eq def-com 'incompatible))) + (apply def-com any-args)) + (;; Def-com value is `ido-read-file-name' + ;; run it with default args. + (and def-com (eq def-com 'ido-read-file-name)) + (ido-mode 1) + (apply def-com def-args)) + (;; Def-com value is `read-file-name' + ;; run it with default args. + (eq def-com 'read-file-name) + (apply def-com def-args)) + (t ; Fall back to classic `helm-read-file-name'. + (helm-read-file-name + prompt + :name str-command + :buffer buf-name + :default default-filename + :initial-input (expand-file-name init dir) + :alistp nil + :must-match mustmatch + :test predicate)))) + (helm-mode 1) + (ido-mode (if ido-state 1 -1)) + ;; Same comment as in `helm--completing-read-default'. + (setq this-command current-command)) + (if (eq predicate 'file-directory-p) ; Using `read-directory-name'. + (file-name-as-directory fname) fname))) + +(defun helm-mode--advice-lisp--local-variables (old--fn &rest args) + (ignore-errors + (apply old--fn args))) + +(defun helm--completion-in-region (start end collection &optional predicate) + "Helm replacement of `completion--in-region'. +Can be used as value for `completion-in-region-function'." + (cl-declare (special require-match prompt)) + (if (memq major-mode helm-mode-no-completion-in-region-in-modes) + (funcall helm--old-completion-in-region-function + start end collection predicate) + (advice-add + 'lisp--local-variables + :around #'helm-mode--advice-lisp--local-variables) + (unwind-protect + (let* ((enable-recursive-minibuffers t) + (input (buffer-substring-no-properties start end)) + (current-command (or (helm-this-command) this-command)) + (str-command (helm-symbol-name current-command)) + (buf-name (format "*helm-mode-%s*" str-command)) + (require-match (or (and (boundp 'require-match) require-match) + minibuffer-completion-confirm + ;; If prompt have not been propagated here, that's + ;; probably mean we have no prompt and we are in + ;; completion-at-point or friend, so use a non--nil + ;; value for require-match. + (not (boundp 'prompt)))) + ;; `completion-extra-properties' is let-bounded in `completion-at-point'. + ;; `afun' is a closure to call against each string in `data'. + ;; it provide the annotation info for each string. + ;; e.g "foo" => "foo " where foo is a function. + ;; See Issue #407. + (afun (plist-get completion-extra-properties :annotation-function)) + (metadata (completion-metadata + (buffer-substring-no-properties start (point)) + collection predicate)) + (data (completion-all-completions + (buffer-substring start end) + collection + predicate + (- (point) start) + metadata)) + ;; `completion-all-completions' store the base-size in the last `cdr', + ;; so data looks like this: '(a b c d . 0) and (last data) == (d . 0). + (last-data (last data)) + (base-size (helm-aif (cdr (last data)) + (prog1 it + (setcdr last-data nil)) + 0)) + (init-space-suffix (unless (or helm-completion-in-region-fuzzy-match + (string-suffix-p " " input) + (string= input "")) + " ")) + (file-comp-p (or (eq (completion-metadata-get metadata 'category) 'file) + (helm-mode--in-file-completion-p) + ;; Assume that when `afun' and `predicate' are null + ;; we are in filename completion. + (and (null afun) (null predicate)))) + ;; Completion-at-point and friends have no prompt. + (result (if (stringp data) + data + (helm-comp-read + (or (and (boundp 'prompt) prompt) "Pattern: ") + (if file-comp-p + (cl-loop for f in data unless + (string-match "\\`\\.\\{1,2\\}/\\'" f) + collect f) + (if afun + (mapcar (lambda (s) + (let ((ann (funcall afun s))) + (if ann + (cons + (concat + s + (propertize + " " 'display + (propertize + ann + 'face 'completions-annotations))) + s) + s))) + data) + data)) + :name str-command + :fuzzy helm-completion-in-region-fuzzy-match + :nomark t + :initial-input + (cond ((and file-comp-p + (not (string-match "/\\'" input))) + (concat (helm-basename input) + init-space-suffix)) + ((string-match "/\\'" input) nil) + ((or (null require-match) + (stringp require-match)) + input) + (t (concat input init-space-suffix))) + :buffer buf-name + :fc-transformer (append (list 'helm-cr-default-transformer) + (unless helm-completion-in-region-fuzzy-match + (list (lambda (candidates _source) + (sort candidates 'helm-generic-sort-fn))))) + :exec-when-only-one t + :quit-when-no-cand + (lambda () + ;; Delay message to overwrite "Quit". + (run-with-timer + 0.01 nil + (lambda () + (message "[No matches]"))) + t) ; exit minibuffer immediately. + :must-match require-match)))) + (when result + (choose-completion-string + result (current-buffer) + (list (+ start base-size) end) + completion-list-insert-choice-function))) + (advice-remove 'lisp--local-variables + #'helm-mode--advice-lisp--local-variables)))) + +(defun helm-mode--in-file-completion-p () + (with-helm-current-buffer + (run-hook-with-args-until-success 'file-name-at-point-functions))) + +(when (boundp 'completion-in-region-function) + (defconst helm--old-completion-in-region-function completion-in-region-function)) + +;;;###autoload +(define-minor-mode helm-mode + "Toggle generic helm completion. + +All functions in Emacs that use `completing-read' +or `read-file-name' and friends will use helm interface +when this mode is turned on. +However you can modify this behavior for functions of your choice +with `helm-completing-read-handlers-alist'. + +Called with a positive arg, turn on unconditionally, with a +negative arg turn off. +You can turn it on with `helm-mode'. + +Some crap emacs functions may not be supported, +e.g `ffap-alternate-file' and maybe others +You can add such functions to `helm-completing-read-handlers-alist' +with a nil value. + +Note: This mode is incompatible with Emacs23." + :group 'helm-mode + :global t + :lighter helm-completion-mode-string + (cl-assert (boundp 'completing-read-function) nil + "`helm-mode' not available, upgrade to Emacs-24") + (if helm-mode + (if (fboundp 'add-function) + (progn + (add-function :override completing-read-function + #'helm--completing-read-default) + (add-function :override read-file-name-function + #'helm--generic-read-file-name) + (when helm-mode-handle-completion-in-region + (add-function :override completion-in-region-function + #'helm--completion-in-region))) + (setq completing-read-function 'helm--completing-read-default + read-file-name-function 'helm--generic-read-file-name) + (when (and (boundp 'completion-in-region-function) + helm-mode-handle-completion-in-region) + (setq completion-in-region-function #'helm--completion-in-region)) + (message helm-completion-mode-start-message)) + (if (fboundp 'remove-function) + (progn + (remove-function completing-read-function #'helm--completing-read-default) + (remove-function read-file-name-function #'helm--generic-read-file-name) + (remove-function completion-in-region-function #'helm--completion-in-region)) + (setq completing-read-function (and (fboundp 'completing-read-default) + 'completing-read-default) + read-file-name-function (and (fboundp 'read-file-name-default) + 'read-file-name-default)) + (when (and (boundp 'completion-in-region-function) + (boundp 'helm--old-completion-in-region-function)) + (setq completion-in-region-function helm--old-completion-in-region-function)) + (message helm-completion-mode-quit-message)))) + +(provide 'helm-mode) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-mode.el ends here diff --git a/helm-multi-match.el b/helm-multi-match.el new file mode 100644 index 00000000..ce6ed005 --- /dev/null +++ b/helm-multi-match.el @@ -0,0 +1,373 @@ +;;; helm-multi-match.el --- Multiple regexp matching methods for helm -*- lexical-binding: t -*- + +;; Original Author: rubikitch + +;; Copyright (C) 2008 ~ 2011 rubikitch +;; Copyright (C) 2011 ~ 2016 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; 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-lib) + + +(defgroup helm-multi-match nil + "Helm multi match." + :group 'helm) + +(defcustom helm-mm-matching-method 'multi3 + "Matching method for helm match plugin. +You can set here different methods to match candidates in helm. +Here are the possible value of this symbol and their meaning: +- multi1: Respect order, prefix of pattern must match. +- multi2: Same but with partial match. +- multi3: The best, multiple regexp match, allow negation. +- multi3p: Same but prefix must match. + +Default is multi3, you should keep this for a better experience. + +Note that multi1 and multi3p are incompatible with fuzzy matching +in file completion and by the way fuzzy matching will be disabled there +when these options are used." + :type '(radio :tag "Matching methods for helm" + (const :tag "Multiple regexp 1 ordered with prefix match" multi1) + (const :tag "Multiple regexp 2 ordered with partial match" multi2) + (const :tag "Multiple regexp 3 matching no order, partial, best." multi3) + (const :tag "Multiple regexp 3p matching with prefix match" multi3p)) + :group 'helm-multi-match) + + +;; Internal +(defvar helm-mm-default-match-functions + '(helm-mm-exact-match helm-mm-match)) +(defvar helm-mm-default-search-functions + '(helm-mm-exact-search helm-mm-search)) + + +;;; Build regexps +;; +;; +(defvar helm-mm-space-regexp "[\\ ] " + "Regexp to represent space itself in multiple regexp match.") + +(defun helm-mm-split-pattern (pattern) + "Split PATTERN if it contain spaces and return resulting list. +If spaces in PATTERN are escaped, don't split at this place. +i.e \"foo bar\"=> (\"foo\" \"bar\") +but \"foo\ bar\"=> (\"foobar\")." + (if (string= pattern "") + '("") + (cl-loop for s in (split-string + (replace-regexp-in-string helm-mm-space-regexp + "\000\000" pattern) + " " t) + collect (replace-regexp-in-string "\000\000" " " s)))) + +(defun helm-mm-1-make-regexp (pattern) + "Replace spaces in PATTERN with \"\.*\"." + (mapconcat 'identity (helm-mm-split-pattern pattern) ".*")) + + +;;; Exact match. +;; +;; +;; Internal. +(defvar helm-mm-exact-pattern-str nil) +(defvar helm-mm-exact-pattern-real nil) + +(defun helm-mm-exact-get-pattern (pattern) + (unless (equal pattern helm-mm-exact-pattern-str) + (setq helm-mm-exact-pattern-str pattern + helm-mm-exact-pattern-real (concat "\n" pattern "\n"))) + helm-mm-exact-pattern-real) + + +(cl-defun helm-mm-exact-match (str &optional (pattern helm-pattern)) + (if case-fold-search + (progn + (setq str (downcase str) + pattern (downcase pattern)) + (string= str pattern)) + (string= str pattern))) + +(defun helm-mm-exact-search (pattern &rest _ignore) + (and (search-forward (helm-mm-exact-get-pattern pattern) nil t) + (forward-line -1))) + + +;;; Prefix match +;; +;; +;; Internal +(defvar helm-mm-prefix-pattern-str nil) +(defvar helm-mm-prefix-pattern-real nil) + +(defun helm-mm-prefix-get-pattern (pattern) + (unless (equal pattern helm-mm-prefix-pattern-str) + (setq helm-mm-prefix-pattern-str pattern + helm-mm-prefix-pattern-real (concat "\n" pattern))) + helm-mm-prefix-pattern-real) + +(defun helm-mm-prefix-match (str &optional pattern) + ;; In filename completion basename and basedir may be + ;; quoted, unquote them for string comparison (Issue #1283). + (setq pattern (replace-regexp-in-string + "\\\\" "" (or pattern helm-pattern))) + (let ((len (length pattern))) + (and (<= len (length str)) + (string= (substring str 0 len) pattern )))) + +(defun helm-mm-prefix-search (pattern &rest _ignore) + (search-forward (helm-mm-prefix-get-pattern pattern) nil t)) + + +;;; Multiple regexp patterns 1 (order is preserved / prefix). +;; +;; +;; Internal +(defvar helm-mm-1-pattern-str nil) +(defvar helm-mm-1-pattern-real nil) + +(defun helm-mm-1-get-pattern (pattern) + (unless (equal pattern helm-mm-1-pattern-str) + (setq helm-mm-1-pattern-str pattern + helm-mm-1-pattern-real + (concat "^" (helm-mm-1-make-regexp pattern)))) + helm-mm-1-pattern-real) + +(cl-defun helm-mm-1-match (str &optional (pattern helm-pattern)) + (string-match (helm-mm-1-get-pattern pattern) str)) + +(defun helm-mm-1-search (pattern &rest _ignore) + (re-search-forward (helm-mm-1-get-pattern pattern) nil t)) + + +;;; Multiple regexp patterns 2 (order is preserved / partial). +;; +;; +;; Internal +(defvar helm-mm-2-pattern-str nil) +(defvar helm-mm-2-pattern-real nil) + +(defun helm-mm-2-get-pattern (pattern) + (unless (equal pattern helm-mm-2-pattern-str) + (setq helm-mm-2-pattern-str pattern + helm-mm-2-pattern-real + (concat "^.*" (helm-mm-1-make-regexp pattern)))) + helm-mm-2-pattern-real) + +(cl-defun helm-mm-2-match (str &optional (pattern helm-pattern)) + (string-match (helm-mm-2-get-pattern pattern) str)) + +(defun helm-mm-2-search (pattern &rest _ignore) + (re-search-forward (helm-mm-2-get-pattern pattern) nil t)) + + +;;; Multiple regexp patterns 3 (permutation). +;; +;; +;; Internal +(defvar helm-mm-3-pattern-str nil) +(defvar helm-mm-3-pattern-list nil) + +(defun helm-mm-3-get-patterns (pattern) + "Return `helm-mm-3-pattern-list', a list of predicate/regexp cons cells. +e.g ((identity . \"foo\") (identity . \"bar\")). +This is done only if `helm-mm-3-pattern-str' is same as PATTERN." + (unless (equal pattern helm-mm-3-pattern-str) + (setq helm-mm-3-pattern-str pattern + helm-mm-3-pattern-list + (helm-mm-3-get-patterns-internal pattern))) + helm-mm-3-pattern-list) + +(defun helm-mm-3-get-patterns-internal (pattern) + "Return a list of predicate/regexp cons cells. +e.g ((identity . \"foo\") (identity . \"bar\"))." + (unless (string= pattern "") + (cl-loop for pat in (helm-mm-split-pattern pattern) + collect (if (string= "!" (substring pat 0 1)) + (cons 'not (substring pat 1)) + (cons 'identity pat))))) + +(cl-defun helm-mm-3-match (str &optional (pattern helm-pattern)) + "Check if PATTERN match STR. +When PATTERN contain a space, it is splitted and matching is done +with the several resulting regexps against STR. +e.g \"bar foo\" will match \"foobar\" and \"barfoo\". +Argument PATTERN, a string, is transformed in a list of +cons cell with `helm-mm-3-get-patterns' if it contain a space. +e.g \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")). +Then each predicate of cons cell(s) is called with regexp of same +cons cell against STR (a candidate). +i.e (identity (string-match \"foo\" \"foo bar\")) => t." + (let ((pat (helm-mm-3-get-patterns pattern))) + (cl-loop for (predicate . regexp) in pat + always (funcall predicate + (condition-case _err + ;; FIXME: Probably do nothing when + ;; using fuzzy leaving the job + ;; to the fuzzy fn. + (string-match regexp str) + (invalid-regexp nil)))))) + +(defun helm-mm-3-search-base (pattern searchfn1 searchfn2) + "Try to find PATTERN in `helm-buffer' with SEARCHFN1 and SEARCHFN2. +This is the search function for `candidates-in-buffer' enabled sources. +Use the same method as `helm-mm-3-match' except it search in buffer +instead of matching on a string. +i.e (identity (re-search-forward \"foo\" (point-at-eol) t)) => t." + (cl-loop with pat = (if (stringp pattern) + (helm-mm-3-get-patterns pattern) + pattern) + when (eq (caar pat) 'not) return + ;; Pass the job to `helm-search-match-part'. + (prog1 (list (point-at-bol) (point-at-eol)) + (forward-line 1)) + while (condition-case _err + (funcall searchfn1 (or (cdar pat) "") nil t) + (invalid-regexp nil)) + for bol = (point-at-bol) + for eol = (point-at-eol) + if (cl-loop for (pred . str) in (cdr pat) always + (progn (goto-char bol) + (funcall pred (condition-case _err + (funcall searchfn2 str eol t) + (invalid-regexp nil))))) + do (goto-char eol) and return t + else do (goto-char eol) + finally return nil)) + +(defun helm-mm-3-search (pattern &rest _ignore) + (when (stringp pattern) + (setq pattern (helm-mm-3-get-patterns pattern))) + (helm-mm-3-search-base + pattern 're-search-forward 're-search-forward)) + +;;; mp-3 with migemo +;; +;; +(defvar helm-mm--previous-migemo-info nil + "[Internal] Cache previous migemo query.") +(make-local-variable 'helm-mm--previous-migemo-info) + +(declare-function migemo-get-pattern "ext:migemo.el") +(declare-function migemo-search-pattern-get "ext:migemo.el") + +(define-minor-mode helm-migemo-mode + "Enable migemo in helm. +It will be available in the sources handling it, +i.e the sources which have the slot :migemo with non--nil value." + :lighter " Hmio" + :group 'helm + :global t + (cl-assert (featurep 'migemo) + nil "No feature called migemo found, install migemo.el.")) + +(defun helm-mm-migemo-get-pattern (pattern) + (let ((regex (migemo-get-pattern pattern))) + (if (ignore-errors (string-match regex "") t) + (concat regex "\\|" pattern) pattern))) + +(defun helm-mm-migemo-search-pattern-get (pattern) + (let ((regex (migemo-search-pattern-get pattern))) + (if (ignore-errors (string-match regex "") t) + (concat regex "\\|" pattern) pattern))) + +(defun helm-mm-migemo-string-match (pattern str) + "Migemo version of `string-match'." + (unless (assoc pattern helm-mm--previous-migemo-info) + (with-helm-buffer + (setq helm-mm--previous-migemo-info + (push (cons pattern (helm-mm-migemo-get-pattern pattern)) + helm-mm--previous-migemo-info)))) + (string-match (assoc-default pattern helm-mm--previous-migemo-info) str)) + +(cl-defun helm-mm-3-migemo-match (str &optional (pattern helm-pattern)) + (and helm-migemo-mode + (cl-loop for (pred . re) in (helm-mm-3-get-patterns pattern) + always (funcall pred (helm-mm-migemo-string-match re str))))) + +(defun helm-mm-migemo-forward (word &optional bound noerror count) + (with-helm-buffer + (unless (assoc word helm-mm--previous-migemo-info) + (setq helm-mm--previous-migemo-info + (push (cons word (if (delq 'ascii (find-charset-string word)) + word + (helm-mm-migemo-search-pattern-get word))) + helm-mm--previous-migemo-info)))) + (re-search-forward + (assoc-default word helm-mm--previous-migemo-info) bound noerror count)) + +(defun helm-mm-3-migemo-search (pattern &rest _ignore) + (and helm-migemo-mode + (helm-mm-3-search-base + pattern 'helm-mm-migemo-forward 'helm-mm-migemo-forward))) + + +;;; mp-3p- (multiple regexp pattern 3 with prefix search) +;; +;; +(defun helm-mm-3p-match (str &optional pattern) + "Check if PATTERN match STR. +Same as `helm-mm-3-match' but more strict, matching against prefix also. +e.g \"bar foo\" will match \"barfoo\" but not \"foobar\" contrarily to +`helm-mm-3-match'." + (let* ((pat (helm-mm-3-get-patterns (or pattern helm-pattern))) + (first (car pat))) + (and (funcall (car first) (helm-mm-prefix-match str (cdr first))) + (cl-loop for (predicate . regexp) in (cdr pat) + always (funcall predicate (string-match regexp str)))))) + +(defun helm-mm-3p-search (pattern &rest _ignore) + (when (stringp pattern) + (setq pattern (helm-mm-3-get-patterns pattern))) + (helm-mm-3-search-base + pattern 'helm-mm-prefix-search 're-search-forward)) + + +;;; Generic multi-match/search functions +;; +;; +(cl-defun helm-mm-match (str &optional (pattern helm-pattern)) + (let ((fun (cl-ecase helm-mm-matching-method + (multi1 #'helm-mm-1-match) + (multi2 #'helm-mm-2-match) + (multi3 #'helm-mm-3-match) + (multi3p #'helm-mm-3p-match)))) + (funcall fun str pattern))) + +(defun helm-mm-search (pattern &rest _ignore) + (let ((fun (cl-ecase helm-mm-matching-method + (multi1 #'helm-mm-1-search) + (multi2 #'helm-mm-2-search) + (multi3 #'helm-mm-3-search) + (multi3p #'helm-mm-3p-search)))) + (funcall fun pattern))) + + +(provide 'helm-multi-match) + + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-multi-match.el ends here diff --git a/helm-net.el b/helm-net.el new file mode 100644 index 00000000..fd8464ab --- /dev/null +++ b/helm-net.el @@ -0,0 +1,521 @@ +;;; helm-net.el --- helm browse url and search web. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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 'url) +(require 'xml) +(require 'browse-url) + + +(defgroup helm-net nil + "Net related applications and libraries for Helm." + :group 'helm) + +(defcustom helm-google-suggest-default-browser-function nil + "The browse url function you prefer to use with google suggest. +When nil, use the first browser function available +See `helm-browse-url-default-browser-alist'." + :group 'helm-net + :type 'symbol) + +(defcustom helm-home-url "http://www.google.fr" + "Default url to use as home url." + :group 'helm-net + :type 'string) + +(defcustom helm-surfraw-default-browser-function nil + "The browse url function you prefer to use with surfraw. +When nil, fallback to `browse-url-browser-function'." + :group 'helm-net + :type 'symbol) + +(defcustom helm-google-suggest-url + "http://google.com/complete/search?output=toolbar&q=" + "URL used for looking up Google suggestions." + :type 'string + :group 'helm-net) + +(defcustom helm-google-suggest-search-url + "http://www.google.com/search?ie=utf-8&oe=utf-8&q=%s" + "URL used for Google searching." + :type 'string + :group 'helm-net) + +(defcustom helm-net-prefer-curl nil + "When non--nil use CURL external program to fetch data. +Otherwise `url-retrieve-synchronously' is used." + :type 'boolean + :group 'helm-net) + +(defvaralias 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl) +(make-obsolete-variable 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl "1.7.7") + +(defcustom helm-surfraw-duckduckgo-url + "https://duckduckgo.com/lite/?q=%s&kp=1" + "The duckduckgo url. +This is a format string, don't forget the `%s'. +If you have personal settings saved on duckduckgo you should have +a personal url, see your settings on duckduckgo." + :type 'string + :group 'helm-net) + +(defcustom helm-wikipedia-suggest-url + "https://en.wikipedia.org/w/api.php?action=opensearch&search=" + "Url used for looking up Wikipedia suggestions." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-wikipedia-url + "https://en.wikipedia.org/wiki/Special:Search?search=%s" + "The Wikipedia search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-wikipedia-summary-url + "http://en.wikipedia.org/w/api.php?action=parse&format=json&prop=text§ion=0&page=" + "URL for getting the summary of a Wikipedia topic." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-youtube-url + "http://www.youtube.com/results?aq=f&search_query=%s" + "The Youtube search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-imdb-url + "http://www.imdb.com/find?s=all&q=%s" + "The IMDb search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-google-maps-url + "http://maps.google.com/maps?f=q&source=s_q&q=%s" + "The Google Maps search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-google-news-url + "http://www.google.com/search?safe=off&prmd=nvlifd&source=lnms&tbs=nws:1&q=%s" + "The Google News search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-google-suggest-actions + '(("Google Search" . helm-google-suggest-action) + ("Wikipedia" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-wikipedia-url + candidate))) + ("Youtube" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-youtube-url + candidate))) + ("IMDb" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-imdb-url + candidate))) + ("Google Maps" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-google-maps-url + candidate))) + ("Google News" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-google-news-url + candidate)))) + "List of actions for google suggest sources." + :group 'helm-net + :type '(alist :key-type string :value-type function)) + +(defcustom helm-browse-url-firefox-new-window "-new-tab" + "Allow choosing to browse url in new window or new tab. +Can be \"-new-tab\" (default) or \"-new-window\"." + :group 'helm-net + :type '(radio + (const :tag "New tab" "-new-tab") + (const :tag "New window" "-new-window"))) + + +;;; Additional actions for search suggestions +;; +;; +;; Internal + +(defun helm-search-suggest-perform-additional-action (url query) + "Perform the search via URL using QUERY as input." + (browse-url (format url (url-hexify-string query)))) + +(defun helm-net--url-retrieve-sync (request parser) + (if helm-net-prefer-curl + (with-temp-buffer + (call-process "curl" nil t nil request) + (funcall parser)) + (with-current-buffer (url-retrieve-synchronously request) + (funcall parser)))) + + +;;; Google Suggestions +;; +;; +(defun helm-google-suggest-parser () + (cl-loop + with result-alist = (xml-get-children + (car (xml-parse-region + (point-min) (point-max))) + 'CompleteSuggestion) + for i in result-alist collect + (cdr (cl-caadr (assoc 'suggestion i))))) + +(defun helm-google-suggest-fetch (input) + "Fetch suggestions for INPUT from XML buffer." + (let ((request (concat helm-google-suggest-url + (url-hexify-string input)))) + (helm-net--url-retrieve-sync + request #'helm-google-suggest-parser))) + +(defun helm-google-suggest-set-candidates (&optional request-prefix) + "Set candidates with result and number of google results found." + (let ((suggestions (helm-google-suggest-fetch + (or (and request-prefix + (concat request-prefix + " " helm-pattern)) + helm-pattern)))) + (if (member helm-pattern suggestions) + suggestions + ;; if there is no suggestion exactly matching the input then + ;; prepend a Search on Google item to the list + (append + suggestions + (list (cons (format "Search for '%s' on Google" helm-input) + helm-input)))))) + +(defun helm-ggs-set-number-result (num) + (if num + (progn + (and (numberp num) (setq num (number-to-string num))) + (cl-loop for i in (reverse (split-string num "" t)) + for count from 1 + append (list i) into C + when (= count 3) + append (list ",") into C + and do (setq count 0) + finally return + (replace-regexp-in-string + "^," "" (mapconcat 'identity (reverse C) "")))) + "?")) + +(defun helm-google-suggest-action (candidate) + "Default action to jump to a google suggested candidate." + (let ((arg (format helm-google-suggest-search-url + (url-hexify-string candidate)))) + (helm-aif helm-google-suggest-default-browser-function + (funcall it arg) + (helm-browse-url arg)))) + +(defvar helm-google-suggest-default-function + 'helm-google-suggest-set-candidates + "Default function to use in helm google suggest.") + +(defvar helm-source-google-suggest + (helm-build-sync-source "Google Suggest" + :candidates (lambda () + (funcall helm-google-suggest-default-function)) + :action 'helm-google-suggest-actions + :volatile t + :keymap helm-map + :requires-pattern 3)) + +(defun helm-google-suggest-emacs-lisp () + "Try to emacs lisp complete with google suggestions." + (helm-google-suggest-set-candidates "emacs lisp")) + +;;; Wikipedia suggestions +;; +;; +(declare-function json-read-from-string "json" (string)) +(defun helm-wikipedia-suggest-fetch () + "Fetch Wikipedia suggestions and return them as a list." + (require 'json) + (let ((request (concat helm-wikipedia-suggest-url + (url-hexify-string helm-pattern)))) + (helm-net--url-retrieve-sync + request #'helm-wikipedia--parse-buffer))) + +(defun helm-wikipedia--parse-buffer () + (goto-char (point-min)) + (when (re-search-forward "^\\[.+\\[\\(.*\\)\\]\\]" nil t) + (cl-loop for i across (aref (json-read-from-string (match-string 0)) 1) + collect i into result + finally return (or result + (append + result + (list (cons (format "Search for '%s' on wikipedia" + helm-pattern) + helm-pattern))))))) + +(defvar helm-wikipedia--summary-cache (make-hash-table :test 'equal)) +(defun helm-wikipedia-persistent-action (candidate) + (unless (string= (format "Search for '%s' on wikipedia" + helm-pattern) + (helm-get-selection nil t)) + (message "Fetching summary from Wikipedia...") + (let ((buf (get-buffer-create "*helm wikipedia summary*")) + result mess) + (while (progn + (setq result (or (gethash candidate helm-wikipedia--summary-cache) + (puthash candidate + (prog1 + (helm-wikipedia-fetch-summary candidate) + (setq mess "Done")) + helm-wikipedia--summary-cache))) + (when (and result + (listp result)) + (setq candidate (cdr result)) + (message "Redirected to %s" candidate) + t))) + (if (not result) + (message "Error when getting summary.") + (with-current-buffer buf + (erase-buffer) + (setq cursor-type nil) + (insert result) + (fill-region (point-min) (point-max)) + (goto-char (point-min))) + (display-buffer buf) + (message mess))))) + +(defun helm-wikipedia-fetch-summary (input) + (let* ((request (concat helm-wikipedia-summary-url + (url-hexify-string input)))) + (helm-net--url-retrieve-sync + request #'helm-wikipedia--parse-summary))) + +(defun helm-wikipedia--parse-summary () + (goto-char (point-min)) + (when (search-forward "{" nil t) + (let ((result (cdr (assoc '* + (assoc 'text + (assoc 'parse + (json-read-from-string + (buffer-substring-no-properties + (1- (point)) (point-max))))))))) + (when result + (if (string-match "]+>\\([^<]+\\)" result) + (cons 'redirect (match-string 1 result)) + + ;; find the beginning of the summary text in the result + + ;; check if there is a table before the summary and skip that + (when (or (string-match "\\(\n\\)?\n

" result) + ;; otherwise just find the first paragraph + (string-match "

" result)) + ;; remove cruft and do a simple formatting + (replace-regexp-in-string + "Cite error: .*" "" + (replace-regexp-in-string + " " "" + (replace-regexp-in-string + "\\[[^\]]+\\]" "" + (replace-regexp-in-string + "<[^>]*>" "" + (replace-regexp-in-string + "

\n

" "\n\n" + (substring result (match-end 0))))))))))))) + + +(defvar helm-source-wikipedia-suggest + (helm-build-sync-source "Wikipedia Suggest" + :candidates #'helm-wikipedia-suggest-fetch + :action '(("Wikipedia" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-wikipedia-url + candidate)))) + :persistent-action #'helm-wikipedia-persistent-action + :persistent-help "show summary" + :volatile t + :keymap helm-map + :requires-pattern 3)) + + +;;; Web browser functions. +;; +;; +;; If default setting of `w3m-command' is not +;; what you want and you modify it, you will have to reeval +;; also `helm-browse-url-default-browser-alist'. + +(defvar helm-browse-url-chromium-program "chromium-browser") +(defvar helm-browse-url-uzbl-program "uzbl-browser") +(defvar helm-browse-url-conkeror-program "conkeror") +(defvar helm-browse-url-default-browser-alist + `((,(or (and (boundp 'w3m-command) w3m-command) + "/usr/bin/w3m") . w3m-browse-url) + (,browse-url-firefox-program . browse-url-firefox) + (,helm-browse-url-chromium-program . helm-browse-url-chromium) + (,helm-browse-url-conkeror-program . helm-browse-url-conkeror) + (,helm-browse-url-uzbl-program . helm-browse-url-uzbl) + (,browse-url-kde-program . browse-url-kde) + (,browse-url-gnome-moz-program . browse-url-gnome-moz) + (,browse-url-mozilla-program . browse-url-mozilla) + (,browse-url-galeon-program . browse-url-galeon) + (,browse-url-netscape-program . browse-url-netscape) + (,browse-url-mosaic-program . browse-url-mosaic) + (,browse-url-xterm-program . browse-url-text-xterm) + ("emacs" . eww-browse-url)) + "*Alist of \(executable . function\) to try to find a suitable url browser.") + +(cl-defun helm-generic-browser (url cmd-name &rest args) + "Browse URL with NAME browser." + (let ((proc (concat cmd-name " " url))) + (message "Starting %s..." cmd-name) + (apply 'start-process proc nil cmd-name + (append args (list url))) + (set-process-sentinel + (get-process proc) + (lambda (process event) + (when (string= event "finished\n") + (message "%s process %s" process event)))))) + +(defun helm-browse-url-firefox (url &optional _ignore) + "Same as `browse-url-firefox' but detach from emacs. +So when you quit emacs you can keep your firefox open +and not be prompted to kill firefox process. + +NOTE: Probably not supported on some systems (e.g Windows)." + (interactive (list (read-string "URL: " (browse-url-url-at-point)) + nil)) + (setq url (browse-url-encode-url url)) + (let ((process-environment (browse-url-process-environment))) + (call-process-shell-command + (format "(%s %s %s &)" + browse-url-firefox-program + helm-browse-url-firefox-new-window + (shell-quote-argument url))))) + +(defun helm-browse-url-chromium (url &optional _ignore) + "Browse URL with google chrome browser." + (interactive "sURL: ") + (helm-generic-browser + url helm-browse-url-chromium-program)) + +(defun helm-browse-url-uzbl (url &optional _ignore) + "Browse URL with uzbl browser." + (interactive "sURL: ") + (helm-generic-browser url helm-browse-url-uzbl-program "-u")) + +(defun helm-browse-url-conkeror (url &optional _ignore) + "Browse URL with conkeror browser." + (interactive "sURL: ") + (helm-generic-browser url helm-browse-url-conkeror-program)) + +(defun helm-browse-url-default-browser (url &rest args) + "Find the first available browser and ask it to load URL." + (let ((default-browser-fn + (cl-loop for (exe . fn) in helm-browse-url-default-browser-alist + thereis (and exe (executable-find exe) (fboundp fn) fn)))) + (if default-browser-fn + (apply default-browser-fn url args) + (error "No usable browser found")))) + +(defun helm-browse-url (url &rest args) + "Default command to browse URL." + (if browse-url-browser-function + (browse-url url args) + (helm-browse-url-default-browser url args))) + + +;;; Surfraw +;; +;; Need external program surfraw. +;; + +;; Internal +(defvar helm-surfraw-engines-history nil) +(defvar helm-surfraw-input-history nil) +(defvar helm-surfraw--elvi-cache nil) + +(defun helm-build-elvi-list () + "Return list of all engines and descriptions handled by surfraw." + (or helm-surfraw--elvi-cache + (setq helm-surfraw--elvi-cache + (cdr (with-temp-buffer + (call-process "surfraw" nil t nil "-elvi") + (split-string (buffer-string) "\n")))))) + +;;;###autoload +(defun helm-surfraw (pattern engine) + "Preconfigured `helm' to search PATTERN with search ENGINE." + (interactive (list (read-string "SearchFor: " + nil 'helm-surfraw-input-history + (thing-at-point 'symbol)) + (helm-comp-read + "Engine: " + (helm-build-elvi-list) + :must-match t + :name "Surfraw Search Engines" + :del-input nil + :history helm-surfraw-engines-history))) + (let* ((engine-nodesc (car (split-string engine))) + (url (if (string= engine-nodesc "duckduckgo") + ;; "sr duckduckgo -p foo" is broken, workaround. + (format helm-surfraw-duckduckgo-url + (url-hexify-string pattern)) + (with-temp-buffer + (apply 'call-process "surfraw" nil t nil + (append (list engine-nodesc "-p") (split-string pattern))) + (replace-regexp-in-string + "\n" "" (buffer-string))))) + (browse-url-browser-function (or helm-surfraw-default-browser-function + browse-url-browser-function))) + (if (string= engine-nodesc "W") + (helm-browse-url helm-home-url) + (helm-browse-url url) + (setq helm-surfraw-engines-history + (cons engine (delete engine helm-surfraw-engines-history)))))) + +;;;###autoload +(defun helm-google-suggest () + "Preconfigured `helm' for google search with google suggest." + (interactive) + (helm-other-buffer 'helm-source-google-suggest "*helm google*")) + +;;;###autoload +(defun helm-wikipedia-suggest () + "Preconfigured `helm' for Wikipedia lookup with Wikipedia suggest." + (interactive) + (helm :sources 'helm-source-wikipedia-suggest + :buffer "*helm wikipedia*")) + + +(provide 'helm-net) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-net.el ends here diff --git a/helm-org.el b/helm-org.el new file mode 100644 index 00000000..6f501785 --- /dev/null +++ b/helm-org.el @@ -0,0 +1,339 @@ +;;; helm-org.el --- Helm for org headlines and keywords completion -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-utils) +(require 'org) + +(declare-function org-agenda-switch-to "org-agenda.el") + +(defgroup helm-org nil + "Org related functions for helm." + :group 'helm) + +(defcustom helm-org-headings-fontify nil + "Fontify org buffers before parsing them. +This reflect fontification in helm-buffer when non--nil. +NOTE: This will be slow on large org buffers." + :group 'helm-org + :type 'boolean) + +(defcustom helm-org-format-outline-path nil + "Show all org level as path." + :group 'helm-org + :type 'boolean) + +(defcustom helm-org-show-filename nil + "Show org filenames in `helm-org-agenda-files-headings' when non--nil. +Note this have no effect in `helm-org-in-buffer-headings'." + :group 'helm-org + :type 'boolean) + +(defcustom helm-org-headings-min-depth 1 + "Minimum depth of org headings to start with." + :group 'helm-org + :type 'integer) + +(defcustom helm-org-headings-max-depth 8 + "Go down to this maximum depth of org headings." + :group 'helm-org + :type 'integer) + +(defcustom helm-org-headings-actions + '(("Go to heading" . helm-org-goto-marker) + ("Open in indirect buffer `C-c i'" . helm-org--open-heading-in-indirect-buffer) + ("Refile to this heading `C-c w`" . helm-org-heading-refile) + ("Insert link to this heading `C-c l`" . helm-org-insert-link-to-heading-at-marker)) + "Default actions alist for + `helm-source-org-headings-for-files'." + :group 'helm-org + :type '(alist :key-type string :value-type function)) + +(defcustom helm-org-truncate-lines t + "Truncate org-header-lines when non-nil" + :type 'boolean + :group 'helm-org) + +;;; Org capture templates +;; +;; +(defvar org-capture-templates) +(defun helm-source-org-capture-templates () + (helm-build-sync-source "Org Capture Templates:" + :candidates (cl-loop for template in org-capture-templates + collect (cons (nth 1 template) (nth 0 template))) + :action '(("Do capture" . (lambda (template-shortcut) + (org-capture nil template-shortcut)))))) + +;;; Org headings +;; +;; +(defun helm-org-goto-marker (marker) + (switch-to-buffer (marker-buffer marker)) + (goto-char (marker-position marker)) + (org-show-context) + (re-search-backward "^\\*+ " nil t) + (org-show-entry)) + +(defun helm-org--open-heading-in-indirect-buffer (marker) + (helm-org-goto-marker marker) + (org-tree-to-indirect-buffer) + + ;; Put the non-indirect buffer at the bottom of the prev-buffers + ;; list so it won't be selected when the indirect buffer is killed + (set-window-prev-buffers nil (append (cdr (window-prev-buffers)) + (car (window-prev-buffers))))) + +(defun helm-org-run-open-heading-in-indirect-buffer () + "Open selected Org heading in an indirect buffer." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action #'helm-org--open-heading-in-indirect-buffer))) +(put 'helm-org-run-open-heading-in-indirect-buffer 'helm-only t) + +(defvar helm-org-headings-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") 'helm-org-run-open-heading-in-indirect-buffer) + (define-key map (kbd "C-c w") 'helm-org-run-heading-refile) + (define-key map (kbd "C-c l") 'helm-org-run-insert-link-to-heading-at-marker) + map) + "Keymap for `helm-source-org-headings-for-files'.") + +(defclass helm-org-headings-class (helm-source-sync) + ((parents + :initarg :parents + :initform nil + :custom boolean) + (match :initform + (lambda (candidate) + (string-match + helm-pattern + (helm-aif (get-text-property 0 'helm-real-display candidate) + it + candidate)))) + (action :initform 'helm-org-headings-actions) + (keymap :initform 'helm-org-headings-map))) + +(defmethod helm--setup-source :after ((source helm-org-headings-class)) + (let ((parents (slot-value source 'parents))) + (setf (slot-value source 'candidate-transformer) + (lambda (candidates) + (let ((cands (helm-org-get-candidates candidates parents))) + (if parents (nreverse cands) cands)))))) + +(defun helm-source-org-headings-for-files (filenames &optional parents) + (helm-make-source "Org Headings" 'helm-org-headings-class + :parents parents + :candidates filenames)) + +(defun helm-org-get-candidates (filenames &optional parents) + (apply #'append + (mapcar (lambda (filename) + (helm-org--get-candidates-in-file + filename + helm-org-headings-fontify + (or parents (null helm-org-show-filename)) + parents)) + filenames))) + +(defun helm-org--get-candidates-in-file (filename &optional fontify nofname parents) + (with-current-buffer (pcase filename + ((pred bufferp) filename) + ((pred stringp) (find-file-noselect filename))) + (let ((match-fn (if fontify + #'match-string + #'match-string-no-properties)) + (search-fn (lambda () + (re-search-forward + org-complex-heading-regexp nil t))) + (file (unless nofname + (concat (helm-basename filename) ":")))) + (when parents + (add-function :around (var search-fn) + (lambda (old-fn &rest args) + (when (org-up-heading-safe) + (apply old-fn args))))) + (save-excursion + (save-restriction + (widen) + (unless parents (goto-char (point-min))) + ;; clear cache for new version of org-get-outline-path + (and (boundp 'org-outline-path-cache) + (setq org-outline-path-cache nil)) + (cl-loop with width = (window-width (helm-window)) + while (funcall search-fn) + for beg = (point-at-bol) + for end = (point-at-eol) + when (and fontify + (null (text-property-any + beg end 'fontified t))) + do (jit-lock-fontify-now beg end) + for level = (length (match-string-no-properties 1)) + for heading = (funcall match-fn 4) + if (and (>= level helm-org-headings-min-depth) + (<= level helm-org-headings-max-depth)) + collect `(,(propertize + (if helm-org-format-outline-path + (org-format-outline-path + ;; org-get-outline-path changed in signature and behaviour since org's + ;; commit 105a4466971. Let's fall-back to the new version in case + ;; of wrong-number-of-arguments error. + (condition-case nil + (append (apply #'org-get-outline-path + (unless parents + (list t level heading))) + (list heading)) + (wrong-number-of-arguments + (org-get-outline-path t t))) + width file) + (if file + (concat file (funcall match-fn 0)) + (funcall match-fn 0))) + 'helm-real-display heading) + . ,(point-marker)))))))) + +(defun helm-org-insert-link-to-heading-at-marker (marker) + (with-current-buffer (marker-buffer marker) + (let ((heading-name (save-excursion (goto-char (marker-position marker)) + (nth 4 (org-heading-components)))) + (file-name (buffer-file-name))) + (with-helm-current-buffer + (org-insert-link + file-name (concat "file:" file-name "::*" heading-name)))))) + +(defun helm-org-run-insert-link-to-heading-at-marker () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action + 'helm-org-insert-link-to-heading-at-marker))) + +(defun helm-org-heading-refile (marker) + (save-selected-window + (when (eq major-mode 'org-agenda-mode) + (org-agenda-switch-to)) + (org-cut-subtree) + (let ((target-level (with-current-buffer (marker-buffer marker) + (goto-char (marker-position marker)) + (org-current-level)))) + (helm-org-goto-marker marker) + (org-end-of-subtree t t) + (org-paste-subtree (+ target-level 1))))) + +(defun helm-org-in-buffer-preselect () + (if (org-on-heading-p) + (buffer-substring-no-properties (point-at-bol) (point-at-eol)) + (save-excursion + (outline-previous-visible-heading 1) + (buffer-substring-no-properties (point-at-bol) (point-at-eol))))) + +(defun helm-org-run-heading-refile () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-org-heading-refile))) +(put 'helm-org-run-heading-refile 'helm-only t) + +;;;###autoload +(defun helm-org-agenda-files-headings () + "Preconfigured helm for org files headings." + (interactive) + (helm :sources (helm-source-org-headings-for-files (org-agenda-files)) + :candidate-number-limit 99999 + :truncate-lines helm-org-truncate-lines + :buffer "*helm org headings*")) + +;;;###autoload +(defun helm-org-in-buffer-headings () + "Preconfigured helm for org buffer headings." + (interactive) + (let (helm-org-show-filename helm-org-format-outline-path) + (helm :sources (helm-source-org-headings-for-files + (list (current-buffer))) + :candidate-number-limit 99999 + :preselect (helm-org-in-buffer-preselect) + :truncate-lines helm-org-truncate-lines + :buffer "*helm org inbuffer*"))) + +;;;###autoload +(defun helm-org-parent-headings () + "Preconfigured helm for org headings that are parents of the +current heading." + (interactive) + ;; Use a large max-depth to ensure all parents are displayed. + (let ((helm-org-headings-min-depth 1) + (helm-org-headings-max-depth 50)) + (helm :sources (helm-source-org-headings-for-files + (list (current-buffer)) t) + :candidate-number-limit 99999 + :truncate-lines helm-org-truncate-lines + :buffer "*helm org parent headings*"))) + +;;;###autoload +(defun helm-org-capture-templates () + "Preconfigured helm for org templates." + (interactive) + (helm :sources (helm-source-org-capture-templates) + :candidate-number-limit 99999 + :truncate-lines helm-org-truncate-lines + :buffer "*helm org capture templates*")) + +;;; Org tag completion + +;; Based on code from Anders Johansson posted on 3 Mar 2016 at +;; + +(defvar crm-separator) + +;;;###autoload +(defun helm-org-completing-read-tags (prompt collection pred req initial + hist def inherit-input-method _name _buffer) + (if (not (string= "Tags: " prompt)) + ;; Not a tags prompt. Use normal completion by calling + ;; `org-icompleting-read' again without this function in + ;; `helm-completing-read-handlers-alist' + (let ((helm-completing-read-handlers-alist + (rassq-delete-all + 'helm-org-completing-read-tags + helm-completing-read-handlers-alist))) + (org-icompleting-read + prompt collection pred req initial hist def inherit-input-method)) + ;; Tags prompt + (let* ((curr (and (stringp initial) + (not (string= initial "")) + (org-split-string initial ":"))) + (table (delete curr + (org-uniquify + (mapcar 'car org-last-tags-completion-table)))) + (crm-separator ":\\|,\\|\\s-")) + (cl-letf (((symbol-function 'crm-complete-word) + 'self-insert-command)) + (mapconcat 'identity + (completing-read-multiple + prompt table pred nil initial hist def) + ":"))))) + +(provide 'helm-org) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-org.el ends here diff --git a/helm-pkg.el b/helm-pkg.el new file mode 100644 index 00000000..0253ca55 --- /dev/null +++ b/helm-pkg.el @@ -0,0 +1,13 @@ +;;; helm-pkg.el --- define helm for package.el + +(define-package "helm" "2.2.1" + "Helm is an Emacs incremental and narrowing framework" + '((emacs "24.4") + (async "1.9") + (popup "0.5.3") + (helm-core "2.2.1")) + :url "https://emacs-helm.github.io/helm/") + +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/helm-regexp.el b/helm-regexp.el new file mode 100644 index 00000000..b67a145c --- /dev/null +++ b/helm-regexp.el @@ -0,0 +1,645 @@ +;;; helm-regexp.el --- In buffer regexp searching and replacement for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-utils) + +(declare-function helm-mm-split-pattern "helm-multi-match") + + +(defgroup helm-regexp nil + "Regexp related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-moccur-always-search-in-current nil + "Helm multi occur always search in current buffer when non--nil." + :group 'helm-regexp + :type 'boolean) + +(defcustom helm-moccur-use-ioccur-style-keys t + "Similar to `helm-grep-use-ioccur-style-keys' but for multi occur." + :group 'helm-regexp + :type 'boolean) + +(defcustom helm-moccur-auto-update-on-resume nil + "Allow auto updating helm-(m)occur buffer when outdated. +noask => Always update without asking +nil => Don't update but signal buffer needs update +never => Never update and do not signal buffer needs update +Any other non--nil value update after confirmation." + :group 'helm-regexp + :type '(radio :tag "Allow auto updating helm-(m)occur buffer when outdated." + (const :tag "Always update without asking" noask) + (const :tag "Never update and do not signal buffer needs update" never) + (const :tag "Don't update but signal buffer needs update" nil) + (const :tag "Update after confirmation" t))) + +(defcustom helm-source-multi-occur-actions + '(("Go to Line" . helm-moccur-goto-line) + ("Goto line other window" . helm-moccur-goto-line-ow) + ("Goto line new frame" . helm-moccur-goto-line-of)) + "Actions for helm-occur and helm-moccur." + :group 'helm-regexp + :type '(alist :key-type string :value-type function)) + +(defcustom helm-moccur-truncate-lines t + "When nil the (m)occur line that appears will not be truncated." + :group 'helm-regexp + :type 'boolean) + + +(defface helm-moccur-buffer + '((t (:foreground "DarkTurquoise" :underline t))) + "Face used to highlight moccur buffer names." + :group 'helm-regexp) + +(defface helm-resume-need-update + '((t (:background "red"))) + "Face used to flash moccur buffer when it needs update." + :group 'helm-regexp) + + +(defvar helm-moccur-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-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-c o") 'helm-moccur-run-goto-line-ow) + (define-key map (kbd "C-c C-o") 'helm-moccur-run-goto-line-of) + (define-key map (kbd "C-x C-s") 'helm-moccur-run-save-buffer) + (when helm-moccur-use-ioccur-style-keys + (define-key map (kbd "") 'helm-execute-persistent-action) + (define-key map (kbd "") 'helm-moccur-run-default-action)) + (delq nil map)) + "Keymap used in Moccur source.") + + +;; History vars +(defvar helm-build-regexp-history nil) +(defvar helm-occur-history nil) + +(defun helm-query-replace-regexp (_candidate) + "Query replace regexp from `helm-regexp'. +With a prefix arg replace only matches surrounded by word boundaries, +i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b." + (let ((regexp helm-input)) + (apply 'query-replace-regexp + (helm-query-replace-args regexp)))) + +(defun helm-kill-regexp-as-sexp (_candidate) + "Kill regexp in a format usable in lisp code." + (helm-regexp-kill-new + (prin1-to-string helm-input))) + +(defun helm-kill-regexp (_candidate) + "Kill regexp as it is in `helm-pattern'." + (helm-regexp-kill-new helm-input)) + +(defun helm-query-replace-args (regexp) + "create arguments of `query-replace-regexp' action in `helm-regexp'." + (let ((region-only (helm-region-active-p))) + (list + regexp + (query-replace-read-to regexp + (format "Query replace %sregexp %s" + (if helm-current-prefix-arg "word " "") + (if region-only "in region " "")) + t) + helm-current-prefix-arg + (when region-only (region-beginning)) + (when region-only (region-end))))) + +(defvar helm-source-regexp + (helm-build-in-buffer-source "Regexp Builder" + :init (lambda () + (helm-init-candidates-in-buffer + 'global (with-temp-buffer + (insert-buffer-substring helm-current-buffer) + (buffer-string)))) + :get-line #'helm-regexp-get-line + :persistent-action #'helm-regexp-persistent-action + :persistent-help "Show this line" + :multiline t + :multimatch nil + :requires-pattern 2 + :mode-line "Press TAB to select action." + :action '(("Kill Regexp as sexp" . helm-kill-regexp-as-sexp) + ("Query Replace Regexp (C-u Not inside word.)" + . helm-query-replace-regexp) + ("Kill Regexp" . helm-kill-regexp)))) + +(defun helm-regexp-get-line (s e) + (let ((matches (match-data)) + (line (buffer-substring s e))) + (propertize + (cl-loop with ln = (format "%5d: %s" (1- (line-number-at-pos s)) line) + for i from 0 to (1- (/ (length matches) 2)) + concat (format "\n %s'%s'" (format "Group %d: " i) + (match-string i)) + into ln1 + finally return (concat ln ln1)) + 'helm-realvalue s))) + +(defun helm-regexp-persistent-action (pt) + (helm-goto-char pt) + (helm-highlight-current-line)) + +(defun helm-regexp-kill-new (input) + (kill-new (substring-no-properties input)) + (message "Killed: %s" input)) + + +;;; Occur +;; +;; +(defvar helm-source-occur nil) +(defun helm-occur-init-source () + (unless helm-source-occur + (setq helm-source-occur + (helm-make-source "Occur" 'helm-source-multi-occur)))) + + +;;; Multi occur +;; +;; + +;; Internal +(defvar helm-multi-occur-buffer-list nil) +(defvar helm-multi-occur-buffer-tick nil) +(defun helm-moccur-init () + "Create the initial helm multi occur buffer." + (helm-init-candidates-in-buffer + 'global + (cl-loop with buffers = (helm-attr 'moccur-buffers) + for buf in buffers + for bufstr = (with-current-buffer buf (buffer-string)) + do (add-text-properties + 0 (length bufstr) + `(buffer-name ,(buffer-name (get-buffer buf))) + bufstr) + concat bufstr))) + +(defun helm-moccur--next-or-previous-char () + (save-excursion + (or (re-search-forward "^." nil t) + (re-search-backward "^." nil t)))) + +(defun helm-moccur-get-line (beg end) + "Format line for `helm-source-moccur'." + (prog1 + (format "%s:%d:%s" + (get-text-property (if (= beg end) + (helm-moccur--next-or-previous-char) + beg) + 'buffer-name) + (save-restriction + (narrow-to-region (or (previous-single-property-change + (point) 'buffer-name) 1) + (or (next-single-property-change + (if (= beg end) + (helm-moccur--next-or-previous-char) + (point)) + 'buffer-name) + (point-max))) + (line-number-at-pos beg)) + ;; When matching empty line, use empty string + ;; to allow saving and modifying with wgrep. + (if (= beg end) "" (buffer-substring beg end))) + ;; When matching empty line, forward char ("\n") + ;; to not be blocked forever here. + (when (= beg end) (forward-char 1)))) + +(cl-defun helm-moccur-action (candidate + &optional (method (quote buffer)) mark) + "Jump to CANDIDATE with METHOD. +arg METHOD can be one of buffer, buffer-other-window, buffer-other-frame." + (require 'helm-grep) + (let* ((split (helm-grep-split-line candidate)) + (buf (car split)) + (lineno (string-to-number (nth 1 split))) + (split-pat (helm-mm-split-pattern helm-input))) + (cl-case method + (buffer (switch-to-buffer buf)) + (buffer-other-window (switch-to-buffer-other-window buf)) + (buffer-other-frame (switch-to-buffer-other-frame buf))) + (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 (point-at-eol) t) + (re-search-forward reg (point-at-eol) t)) + (invalid-regexp nil))) + collect (match-beginning 0) into pos-ls + finally (when pos-ls (goto-char (apply #'min pos-ls)))) + (when mark + (set-marker (mark-marker) (point)) + (push-mark (point) 'nomsg)))) + +(defun helm-moccur-persistent-action (candidate) + (helm-moccur-goto-line candidate) + (helm-highlight-current-line)) + +(defun helm-moccur-goto-line (candidate) + "From multi occur, switch to buffer and go to nth 1 CANDIDATE line." + (helm-moccur-action + candidate 'buffer (or current-prefix-arg ; persistent. + helm-current-prefix-arg))) ; exit. + +(defun helm-moccur-goto-line-ow (candidate) + "Go to CANDIDATE line in other window. +Same as `helm-moccur-goto-line' but go in other window." + (helm-moccur-action + candidate 'buffer-other-window + (or current-prefix-arg ; persistent. + helm-current-prefix-arg))) ; exit. + +(defun helm-moccur-goto-line-of (candidate) + "Go to CANDIDATE line in new frame. +Same as `helm-moccur-goto-line' but go in new frame." + (helm-moccur-action + candidate 'buffer-other-frame + (or current-prefix-arg ; persistent. + helm-current-prefix-arg))) ; exit. + +(defun helm-moccur-run-goto-line-ow () + "Run goto line other window action from `helm-source-moccur'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-moccur-goto-line-ow))) +(put 'helm-moccur-run-goto-line-ow 'helm-only t) + +(defun helm-moccur-run-goto-line-of () + "Run goto line new frame action from `helm-source-moccur'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-moccur-goto-line-of))) +(put 'helm-moccur-run-goto-line-of 'helm-only t) + +(defun helm-moccur-run-default-action () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-moccur-goto-line))) +(put 'helm-moccur-run-default-action 'helm-only t) + +(defvar helm-source-moccur nil) +(defclass helm-source-multi-occur (helm-source-in-buffer) + ((init :initform (lambda () + (require 'helm-grep) + (helm-moccur-init))) + (filter-one-by-one :initform 'helm-moccur-filter-one-by-one) + (get-line :initform helm-moccur-get-line) + (nohighlight :initform t) + (nomark :initform t) + (migemo :initform t) + (action :initform 'helm-source-multi-occur-actions) + (persistent-action :initform 'helm-moccur-persistent-action) + (persistent-help :initform "Go to line") + (resume :initform 'helm-moccur-resume-fn) + (candidate-number-limit :initform 9999) + (help-message :initform 'helm-moccur-help-message) + (keymap :initform helm-moccur-map) + (history :initform 'helm-occur-history) + (requires-pattern :initform 2))) + +(defun helm-moccur-resume-fn () + (with-helm-buffer + (let (new-tick-ls buffer-is-modified) + (set (make-local-variable 'helm-multi-occur-buffer-list) + (cl-loop for b in helm-multi-occur-buffer-list + when (buffer-live-p (get-buffer b)) + collect b)) + (setq buffer-is-modified (/= (length helm-multi-occur-buffer-list) + (length (helm-attr 'moccur-buffers)))) + (helm-attrset 'moccur-buffers helm-multi-occur-buffer-list) + (setq new-tick-ls (cl-loop for b in helm-multi-occur-buffer-list + collect (buffer-chars-modified-tick (get-buffer b)))) + (when buffer-is-modified + (setq helm-multi-occur-buffer-tick new-tick-ls)) + (cl-assert (> (length helm-multi-occur-buffer-list) 0) nil + "helm-resume error: helm-(m)occur buffer list is empty") + (unless (eq helm-moccur-auto-update-on-resume 'never) + (when (or buffer-is-modified + (cl-loop for b in helm-multi-occur-buffer-list + for new-tick = (buffer-chars-modified-tick (get-buffer b)) + for tick in helm-multi-occur-buffer-tick + thereis (/= tick new-tick))) + (helm-aif helm-moccur-auto-update-on-resume + (when (or (eq it 'noask) + (y-or-n-p "Helm (m)occur Buffer outdated, update? ")) + (run-with-idle-timer 0.1 nil (lambda () + (with-helm-buffer + (helm-force-update) + (message "Helm (m)occur Buffer have been udated") + (sit-for 1) (message nil)))) + (unless buffer-is-modified (setq helm-multi-occur-buffer-tick new-tick-ls))) + (run-with-idle-timer 0.1 nil (lambda () + (with-helm-buffer + (let ((ov (make-overlay (save-excursion + (goto-char (point-min)) + (forward-line 1) + (point)) + (point-max)))) + (overlay-put ov 'face 'helm-resume-need-update) + (sit-for 0.3) (delete-overlay ov) + (message "[Helm occur Buffer outdated (C-c C-u to update)]"))))) + (unless buffer-is-modified + (with-helm-after-update-hook + (setq helm-multi-occur-buffer-tick new-tick-ls) + (message "Helm (m)occur Buffer have been udated"))))))))) + +(defun helm-moccur-filter-one-by-one (candidate) + "`filter-one-by-one' function for `helm-source-moccur'." + (require 'helm-grep) + (let* ((split (helm-grep-split-line candidate)) + (buf (car split)) + (lineno (nth 1 split)) + (str (nth 2 split))) + (cons (concat (propertize + buf + 'face 'helm-moccur-buffer + 'help-echo (buffer-file-name + (get-buffer buf)) + 'buffer-name buf) + ":" + (propertize lineno 'face 'helm-grep-lineno) + ":" + (helm-grep-highlight-match str t)) + candidate))) + +(defun helm-multi-occur-1 (buffers &optional input) + "Main function to call `helm-source-moccur' with BUFFERS list." + (let ((bufs (if helm-moccur-always-search-in-current + (cons + ;; will become helm-current-buffer later. + (buffer-name (current-buffer)) + (remove helm-current-buffer buffers)) + buffers))) + (unless helm-source-moccur + (setq helm-source-moccur + (helm-make-source "Moccur" 'helm-source-multi-occur))) + (helm-attrset 'moccur-buffers bufs helm-source-moccur) + (helm-set-local-variable 'helm-multi-occur-buffer-list bufs) + (helm-set-local-variable + 'helm-multi-occur-buffer-tick + (cl-loop for b in bufs + collect (buffer-chars-modified-tick (get-buffer b))))) + (helm :sources 'helm-source-moccur + :buffer "*helm multi occur*" + :history 'helm-occur-history + :keymap helm-moccur-map + :input input + :truncate-lines helm-moccur-truncate-lines)) + +(defun helm-moccur-run-save-buffer () + "Run moccur save results action from `helm-moccur'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action 'helm-moccur-save-results))) +(put 'helm-moccur-run-save-buffer 'helm-only t) + + +;;; helm-moccur-mode +;; +;; +(defvar helm-moccur-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'helm-moccur-mode-goto-line) + (define-key map (kbd "C-o") 'helm-moccur-mode-goto-line-ow) + (define-key map (kbd "") 'helm-moccur-mode-goto-line-ow-forward) + (define-key map (kbd "") 'helm-moccur-mode-goto-line-ow-backward) + (define-key map (kbd "") 'helm-gm-next-file) + (define-key map (kbd "") 'helm-gm-precedent-file) + (define-key map (kbd "M-n") 'helm-moccur-mode-goto-line-ow-forward) + (define-key map (kbd "M-p") 'helm-moccur-mode-goto-line-ow-backward) + (define-key map (kbd "M-N") 'helm-gm-next-file) + (define-key map (kbd "M-P") 'helm-gm-precedent-file) + map)) + +(defun helm-moccur-mode-goto-line () + (interactive) + (helm-aif (get-text-property (point) 'helm-realvalue) + (helm-moccur-goto-line it))) + +(defun helm-moccur-mode-goto-line-ow () + (interactive) + (helm-aif (get-text-property (point) 'helm-realvalue) + (helm-moccur-goto-line-ow it))) + +(defun helm-moccur-mode-goto-line-ow-forward-1 (arg) + (condition-case nil + (progn + (save-selected-window + (helm-moccur-mode-goto-line-ow) + (recenter)) + (forward-line arg)) + (error nil))) + +(defun helm-moccur-mode-goto-line-ow-forward () + (interactive) + (helm-moccur-mode-goto-line-ow-forward-1 1)) + +(defun helm-moccur-mode-goto-line-ow-backward () + (interactive) + (helm-moccur-mode-goto-line-ow-forward-1 -1)) + +(defun helm-moccur-save-results (_candidate) + "Save helm moccur results in a `helm-moccur-mode' buffer." + (let ((buf "*hmoccur*") + new-buf) + (when (get-buffer buf) + (setq new-buf (helm-read-string "OccurBufferName: " 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 "OccurBufferName: " "*hmoccur "))) + (setq buf new-buf)) + (with-current-buffer (get-buffer-create buf) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert "-*- mode: helm-moccur -*-\n\n" + (format "Moccur Results for `%s':\n\n" helm-input)) + (save-excursion + (insert (with-current-buffer helm-buffer + (goto-char (point-min)) (forward-line 1) + (buffer-substring (point) (point-max)))))) + (helm-moccur-mode)) + (pop-to-buffer buf) + (message "Helm Moccur Results saved in `%s' buffer" buf))) + +;;;###autoload +(define-derived-mode helm-moccur-mode + special-mode "helm-moccur" + "Major mode to provide actions in helm moccur saved buffer. + +Special commands: +\\{helm-moccur-mode-map}" + (set (make-local-variable 'helm-multi-occur-buffer-list) + (with-helm-buffer helm-multi-occur-buffer-list)) + (set (make-local-variable 'revert-buffer-function) + #'helm-moccur-mode--revert-buffer-function)) +(put 'helm-moccur-mode 'helm-only t) + +(defun helm-moccur-mode--revert-buffer-function (&optional _ignore-auto _noconfirm) + (goto-char (point-min)) + (let (pattern) + (when (re-search-forward "^Moccur Results for `\\(.*\\)'" nil t) + (setq pattern (match-string 1)) + (forward-line 0) + (when (re-search-forward "^$" nil t) + (forward-line 1)) + (let ((inhibit-read-only t) + (buffer (current-buffer)) + (buflst helm-multi-occur-buffer-list)) + (delete-region (point) (point-max)) + (message "Reverting buffer...") + (save-excursion + (with-temp-buffer + (insert + "\n" + (cl-loop for buf in buflst + for bufstr = (or (and (buffer-live-p (get-buffer buf)) + (with-current-buffer buf + (buffer-string))) + "") + unless (string= bufstr "") + do (add-text-properties + 0 (length bufstr) + `(buffer-name ,(buffer-name (get-buffer buf))) + bufstr) + concat bufstr) + "\n") + (goto-char (point-min)) + (cl-loop with helm-pattern = pattern + while (helm-mm-search pattern) + for line = (helm-moccur-get-line (point-at-bol) (point-at-eol)) + when line + do (with-current-buffer buffer + (insert + (propertize + (car (helm-moccur-filter-one-by-one line)) + 'helm-realvalue line) + "\n"))))) + (message "Reverting buffer done"))))) + + +;;; Predefined commands +;; +;; + +;;;###autoload +(defun helm-regexp () + "Preconfigured helm to build regexps. +`query-replace-regexp' can be run from there against found regexp." + (interactive) + (save-restriction + (when (and (helm-region-active-p) + ;; Don't narrow to region if buffer is already narrowed. + (not (helm-current-buffer-narrowed-p (current-buffer)))) + (narrow-to-region (region-beginning) (region-end))) + (helm :sources helm-source-regexp + :buffer "*helm regexp*" + :prompt "Regexp: " + :history 'helm-build-regexp-history))) + +;;;###autoload +(defun helm-occur () + "Preconfigured helm for Occur." + (interactive) + (helm-occur-init-source) + (let ((bufs (list (buffer-name (current-buffer))))) + (helm-attrset 'moccur-buffers bufs helm-source-occur) + (helm-set-local-variable 'helm-multi-occur-buffer-list bufs) + (helm-set-local-variable + 'helm-multi-occur-buffer-tick + (cl-loop for b in bufs + collect (buffer-chars-modified-tick (get-buffer b))))) + (helm :sources 'helm-source-occur + :buffer "*helm occur*" + :history 'helm-occur-history + :preselect (and (memq 'helm-source-occur helm-sources-using-default-as-input) + (format "%s:%d:" (regexp-quote (buffer-name)) + (line-number-at-pos (point)))) + :truncate-lines helm-moccur-truncate-lines)) + +;;;###autoload +(defun helm-occur-from-isearch () + "Invoke `helm-occur' from isearch." + (interactive) + (let ((input (if isearch-regexp + isearch-string + (regexp-quote isearch-string))) + (bufs (list (buffer-name (current-buffer))))) + (isearch-exit) + (helm-occur-init-source) + (helm-attrset 'moccur-buffers bufs helm-source-occur) + (helm-set-local-variable 'helm-multi-occur-buffer-list bufs) + (helm-set-local-variable + 'helm-multi-occur-buffer-tick + (cl-loop for b in bufs + collect (buffer-chars-modified-tick (get-buffer b)))) + (helm :sources 'helm-source-occur + :buffer "*helm occur*" + :history 'helm-occur-history + :input input + :truncate-lines helm-moccur-truncate-lines))) + +;;;###autoload +(defun helm-multi-occur-from-isearch (&optional _arg) + "Invoke `helm-multi-occur' from isearch. + +With a prefix arg, reverse the behavior of +`helm-moccur-always-search-in-current'. +The prefix arg can be set before calling +`helm-multi-occur-from-isearch' or during the buffer selection." + (interactive "p") + (let (buf-list + helm-moccur-always-search-in-current + (input (if isearch-regexp + isearch-string + (regexp-quote isearch-string)))) + (isearch-exit) + (setq buf-list (helm-comp-read "Buffers: " + (helm-buffer-list) + :name "Occur in buffer(s)" + :marked-candidates t)) + (setq helm-moccur-always-search-in-current + (if (or current-prefix-arg + helm-current-prefix-arg) + (not helm-moccur-always-search-in-current) + helm-moccur-always-search-in-current)) + (helm-multi-occur-1 buf-list input))) + + +(provide 'helm-regexp) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-regexp.el ends here diff --git a/helm-ring.el b/helm-ring.el new file mode 100644 index 00000000..65af573e --- /dev/null +++ b/helm-ring.el @@ -0,0 +1,469 @@ +;;; helm-ring.el --- kill-ring, mark-ring, and register browsers for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-utils) +(require 'helm-help) +(require 'helm-elisp) + +(declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register)) + + +(defgroup helm-ring nil + "Ring related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-kill-ring-threshold 3 + "Minimum length of a candidate to be listed by `helm-source-kill-ring'." + :type 'integer + :group 'helm-ring) + +(defcustom helm-kill-ring-max-lines-number 5 + "Max number of lines displayed per candidate in kill-ring browser. +If nil or zero (disabled), don't truncate candidate, show all." + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Max number of lines")) + :group 'helm-ring) + +(defcustom helm-register-max-offset 160 + "Max size of string register entries before truncating." + :group 'helm-ring + :type 'integer) + +(defcustom helm-kill-ring-actions + '(("Yank" . helm-kill-ring-action) + ("Delete" . (lambda (_candidate) + (cl-loop for cand in (helm-marked-candidates) + do (setq kill-ring + (delete cand kill-ring)))))) + "List of actions for kill ring source." + :group 'helm-ring + :type '(alist :key-type string :value-type function)) + + +;;; Kill ring +;; +;; +(defvar helm-kill-ring-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-y") 'helm-next-line) + (define-key map (kbd "M-u") 'helm-previous-line) + map) + "Keymap for `helm-show-kill-ring'.") + +(defvar helm-source-kill-ring + (helm-build-sync-source "Kill Ring" + :init (lambda () (helm-attrset 'last-command last-command)) + :candidates #'helm-kill-ring-candidates + :filtered-candidate-transformer #'helm-kill-ring-transformer + :action 'helm-kill-ring-actions + :persistent-action (lambda (_candidate) (ignore)) + :persistent-help "DoNothing" + :keymap helm-kill-ring-map + :migemo t + :multiline t) + "Source for browse and insert contents of kill-ring.") + +(defun helm-kill-ring-candidates () + (cl-loop for kill in (helm-fast-remove-dups kill-ring :test 'equal) + unless (or (< (length kill) helm-kill-ring-threshold) + (string-match "\\`[\n[:blank:]]+\\'" kill)) + collect kill)) + +(defun helm-kill-ring-transformer (candidates _source) + "Display only the `helm-kill-ring-max-lines-number' lines of candidate." + (cl-loop for i in candidates + when (get-text-property 0 'read-only i) + do (set-text-properties 0 (length i) '(read-only nil) i) + for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max))) + if (and helm-kill-ring-max-lines-number + (> nlines helm-kill-ring-max-lines-number)) + collect (cons + (with-temp-buffer + (insert i) + (goto-char (point-min)) + (concat + (buffer-substring + (point-min) + (save-excursion + (forward-line helm-kill-ring-max-lines-number) + (point))) + "[...]")) i) + else collect i)) + +(defun helm-kill-ring-action (str) + "Insert STR in `kill-ring' and set STR to the head. +If this action is executed just after `yank', +replace with STR as yanked string." + (with-helm-current-buffer + (setq kill-ring (delete str kill-ring)) + ;; Adding a `delete-selection' property + ;; to `helm-kill-ring-action' is not working + ;; because `this-command' will be `helm-maybe-exit-minibuffer', + ;; so use this workaround (Issue #1520). + (when (and (region-active-p) delete-selection-mode) + (delete-region (region-beginning) (region-end))) + (if (not (eq (helm-attr 'last-command helm-source-kill-ring) 'yank)) + (insert-for-yank str) + ;; from `yank-pop' + (let ((inhibit-read-only t) + (before (< (point) (mark t)))) + (if before + (funcall (or yank-undo-function 'delete-region) (point) (mark t)) + (funcall (or yank-undo-function 'delete-region) (mark t) (point))) + (setq yank-undo-function nil) + (set-marker (mark-marker) (point) helm-current-buffer) + (insert-for-yank str) + ;; Set the window start back where it was in the yank command, + ;; if possible. + (set-window-start (selected-window) yank-window-start t) + (when before + ;; This is like exchange-point-and-mark, but doesn't activate the mark. + ;; It is cleaner to avoid activation, even though the command + ;; loop would deactivate the mark because we inserted text. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) helm-current-buffer)))))) + (kill-new str))) + + +;;;; +;; DO NOT use these sources with other sources use +;; the commands `helm-mark-ring', `helm-global-mark-ring' or +;; `helm-all-mark-rings' instead. + +(defun helm-mark-ring-line-string-at-pos (pos) + "Return line string at position POS." + (save-excursion + (goto-char pos) + (forward-line 0) + (let ((line (car (split-string (thing-at-point 'line) "[\n\r]")))) + (if (string= "" line) + "" + line)))) + +(defun helm-mark-ring-get-candidates () + (with-helm-current-buffer + (cl-loop with marks = (if (mark t) (cons (mark-marker) mark-ring) mark-ring) + for i in marks + with max-line-number = (line-number-at-pos (point-max)) + with width = (length (number-to-string max-line-number)) + for m = (format (concat "%" (number-to-string width) "d: %s") + (line-number-at-pos i) + (helm-mark-ring-line-string-at-pos i)) + unless (and recip (member m recip)) + collect m into recip + finally return recip))) + +(defvar helm-source-mark-ring + (helm-build-sync-source "mark-ring" + :candidates #'helm-mark-ring-get-candidates + :action '(("Goto line" + . (lambda (candidate) + (helm-goto-line (string-to-number candidate))))) + :persistent-action (lambda (candidate) + (helm-goto-line (string-to-number candidate)) + (helm-highlight-current-line)) + :persistent-help "Show this line")) + +;;; Global-mark-ring +(defvar helm-source-global-mark-ring + (helm-build-sync-source "global-mark-ring" + :candidates #'helm-global-mark-ring-get-candidates + :action '(("Goto line" + . (lambda (candidate) + (let ((items (split-string candidate ":"))) + (switch-to-buffer (cl-second items)) + (helm-goto-line (string-to-number (car items))))))) + :persistent-action (lambda (candidate) + (let ((items (split-string candidate ":"))) + (switch-to-buffer (cl-second items)) + (helm-goto-line (string-to-number (car items))) + (helm-highlight-current-line))) + :persistent-help "Show this line")) + +(defun helm-global-mark-ring-format-buffer (marker) + (with-current-buffer (marker-buffer marker) + (goto-char marker) + (forward-line 0) + (let ((line (pcase (thing-at-point 'line) + ((and line (pred stringp) + (guard (not (string-match-p "\\`\n?\\'" line)))) + (car (split-string line "[\n\r]"))) + (_ "")))) + (format "%7d:%s: %s" + (line-number-at-pos) (marker-buffer marker) line)))) + +(defun helm-global-mark-ring-get-candidates () + (let ((marks global-mark-ring)) + (when marks + (cl-loop for i in marks + for mb = (marker-buffer i) + for gm = (unless (or (string-match "^ " (format "%s" mb)) + (null mb)) + (helm-global-mark-ring-format-buffer i)) + when (and gm (not (member gm recip))) + collect gm into recip + finally return recip)))) + +(defun helm--push-mark (&optional location nomsg activate) + "[Internal] Don't use directly, use instead `helm-push-mark-mode'." + (unless (null (mark t)) + (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) + (when (> (length mark-ring) mark-ring-max) + (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) + (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))) + (set-marker (mark-marker) (or location (point)) (current-buffer)) + ;; Now push the mark on the global mark ring. + (setq global-mark-ring (cons (copy-marker (mark-marker)) + ;; Avoid having multiple entries + ;; for same buffer in `global-mark-ring'. + (cl-loop with mb = (current-buffer) + for m in global-mark-ring + for nmb = (marker-buffer m) + unless (eq mb nmb) + collect m))) + (when (> (length global-mark-ring) global-mark-ring-max) + (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil) + (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)) + (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) + (message "Mark set")) + (when (or activate (not transient-mark-mode)) + (set-mark (mark t))) + nil) + +;;;###autoload +(define-minor-mode helm-push-mark-mode + "Provide an improved version of `push-mark'. +Modify the behavior of `push-mark' to update +the `global-mark-ring' after each new visit." + :group 'helm-ring + :global t + (if helm-push-mark-mode + (advice-add 'push-mark :override #'helm--push-mark) + (advice-remove 'push-mark #'helm--push-mark))) + +;;;; +;;; Insert from register +(defvar helm-source-register + (helm-build-sync-source "Registers" + :candidates #'helm-register-candidates + :action-transformer #'helm-register-action-transformer + :persistent-help "" + :multiline t + :action '(("Delete Register(s)" . + (lambda (_candidate) + (cl-loop for candidate in (helm-marked-candidates) + for register = (car candidate) + do (setq register-alist + (delq (assoc register register-alist) + register-alist))))))) + "See (info \"(emacs)Registers\")") + +(defun helm-register-candidates () + "Collecting register contents and appropriate commands." + (cl-loop for (char . val) in register-alist + for key = (single-key-description char) + for string-actions = + (cond + ((numberp val) + (list (int-to-string val) + 'insert-register + 'increment-register)) + ((markerp val) + (let ((buf (marker-buffer val))) + (if (null buf) + (list "a marker in no buffer") + (list (concat + "a buffer position:" + (buffer-name buf) + ", position " + (int-to-string (marker-position val))) + 'jump-to-register + 'insert-register)))) + ((and (consp val) (window-configuration-p (car val))) + (list "window configuration." + 'jump-to-register)) + ((and (vectorp val) + (fboundp 'undo-tree-register-data-p) + (undo-tree-register-data-p (elt val 1))) + (list + "Undo-tree entry." + 'undo-tree-restore-state-from-register)) + ((or (and (vectorp val) (eq 'registerv (aref val 0))) + (and (consp val) (frame-configuration-p (car val)))) + (list "frame configuration." + 'jump-to-register)) + ((and (consp val) (eq (car val) 'file)) + (list (concat "file:" + (prin1-to-string (cdr val)) + ".") + 'jump-to-register)) + ((and (consp val) (eq (car val) 'file-query)) + (list (concat "file:a file-query reference: file " + (car (cdr val)) + ", position " + (int-to-string (car (cdr (cdr val)))) + ".") + 'jump-to-register)) + ((consp val) + (let ((lines (format "%4d" (length val)))) + (list (format "%s: %s\n" lines + (truncate-string-to-width + (mapconcat 'identity (list (car val)) + "^J") (- (window-width) 15))) + 'insert-register))) + ((stringp val) + (list + ;; without properties + (concat (substring-no-properties + val 0 (min (length val) helm-register-max-offset)) + (if (> (length val) helm-register-max-offset) + "[...]" "")) + 'insert-register + 'append-to-register + 'prepend-to-register))) + unless (null string-actions) ; Fix Issue #1107. + collect (cons (format "Register %3s:\n %s" key (car string-actions)) + (cons char (cdr string-actions))))) + +(defun helm-register-action-transformer (actions register-and-functions) + "Decide actions by the contents of register." + (cl-loop with transformer-actions = nil + with func-actions = + '((insert-register + "Insert Register" . + (lambda (c) (insert-register (car c)))) + (jump-to-register + "Jump to Register" . + (lambda (c) (jump-to-register (car c)))) + (append-to-register + "Append Region to Register" . + (lambda (c) (append-to-register + (car c) (region-beginning) (region-end)))) + (prepend-to-register + "Prepend Region to Register" . + (lambda (c) (prepend-to-register + (car c) (region-beginning) (region-end)))) + (increment-register + "Increment Prefix Arg to Register" . + (lambda (c) (increment-register + helm-current-prefix-arg (car c)))) + (undo-tree-restore-state-from-register + "Restore Undo-tree register" . + (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register) + (undo-tree-restore-state-from-register (car c)))))) + for func in (cdr register-and-functions) + for cell = (assq func func-actions) + when cell + do (push (cdr cell) transformer-actions) + finally return (append (nreverse transformer-actions) actions))) + +;;;###autoload +(defun helm-mark-ring () + "Preconfigured `helm' for `helm-source-mark-ring'." + (interactive) + (helm :sources 'helm-source-mark-ring + :resume 'noresume + :buffer "*helm mark*")) + +;;;###autoload +(defun helm-global-mark-ring () + "Preconfigured `helm' for `helm-source-global-mark-ring'." + (interactive) + (helm :sources 'helm-source-global-mark-ring + :resume 'noresume + :buffer "*helm global mark*")) + +;;;###autoload +(defun helm-all-mark-rings () + "Preconfigured `helm' for `helm-source-global-mark-ring' and \ +`helm-source-mark-ring'." + (interactive) + (helm :sources '(helm-source-mark-ring + helm-source-global-mark-ring) + :resume 'noresume + :buffer "*helm mark ring*")) + +;;;###autoload +(defun helm-register () + "Preconfigured `helm' for Emacs registers." + (interactive) + (helm :sources 'helm-source-register + :resume 'noresume + :buffer "*helm register*")) + +;;;###autoload +(defun helm-show-kill-ring () + "Preconfigured `helm' for `kill-ring'. +It is drop-in replacement of `yank-pop'. + +First call open the kill-ring browser, next calls move to next line." + (interactive) + (let ((enable-recursive-minibuffers t)) + (helm :sources helm-source-kill-ring + :buffer "*helm kill ring*" + :resume 'noresume + :allow-nest t))) + +;;;###autoload +(defun helm-execute-kmacro () + "Preconfigured helm for keyboard macros. +Define your macros with `f3' and `f4'. +See (info \"(emacs) Keyboard Macros\") for detailed infos. +This command is useful when used with persistent action." + (interactive) + (helm :sources + (helm-build-sync-source "Kmacro" + :candidates (lambda () + (helm-fast-remove-dups + (cons (kmacro-ring-head) + kmacro-ring) + :test 'equal)) + :multiline t + :candidate-transformer + (lambda (candidates) + (cl-loop for c in candidates collect + (propertize (help-key-description (car c) nil) + 'helm-realvalue c))) + :persistent-help "Execute kmacro" + :help-message 'helm-kmacro-help-message + :action + (helm-make-actions + "Execute kmacro (`C-u ' to execute times)" + (lambda (candidate) + (interactive) + ;; Move candidate on top of list for next use. + (setq kmacro-ring (delete candidate kmacro-ring)) + (kmacro-push-ring) + (kmacro-split-ring-element candidate) + (kmacro-exec-ring-item + candidate helm-current-prefix-arg)))) + :buffer "*helm kmacro*")) + +(provide 'helm-ring) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-ring.el ends here diff --git a/helm-semantic.el b/helm-semantic.el new file mode 100644 index 00000000..5baa00ae --- /dev/null +++ b/helm-semantic.el @@ -0,0 +1,223 @@ +;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 Daniel Hackney +;; Author: Daniel Hackney + +;; 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: + +;; Uses `candidates-in-buffer' for speed. + +;;; Code: + +(require 'cl-lib) +(require 'semantic) +(require 'helm-help) +(require 'helm-imenu) + +(declare-function pulse-momentary-highlight-one-line "pulse.el" (point &optional face)) + +(defgroup helm-semantic nil + "Semantic tags related libraries and applications for helm." + :group 'helm) + +(defcustom helm-semantic-lynx-style-map t + "Use Arrow keys to jump to occurences." + :group 'helm-semantic + :type 'boolean) + +(defcustom helm-semantic-display-style + '((python-mode . semantic-format-tag-summarize) + (c-mode . semantic-format-tag-concise-prototype-c-mode) + (emacs-lisp-mode . semantic-format-tag-abbreviate-emacs-lisp-mode)) + "Function to present a semantic tag according to `major-mode'. + +It is an alist where the `car' of each element is a `major-mode' and +the `cdr' a `semantic-format-tag-*' function. + +If no function is found for current `major-mode', fall back to +`semantic-format-tag-summarize' default function. + +You can have more or less informations depending of the `semantic-format-tag-*' +function you choose. + +All the supported functions are prefixed with \"semantic-format-tag-\", +you have completion on these functions with `C-M i' in the customize interface." + :group 'helm-semantic + :type '(alist :key-type symbol :value-type symbol)) + +;;; keymap +(defvar helm-semantic-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (when helm-semantic-lynx-style-map + (define-key map (kbd "") 'helm-maybe-exit-minibuffer) + (define-key map (kbd "") 'helm-execute-persistent-action)) + (delq nil map))) + +;; Internals vars +(defvar helm-semantic--tags-cache nil) + +(defun helm-semantic--fetch-candidates (tags depth &optional class) + "Write the contents of TAGS to the current buffer." + (let ((class class) cur-type + (stylefn (or (with-helm-current-buffer + (assoc-default major-mode helm-semantic-display-style)) + #'semantic-format-tag-summarize))) + (cl-dolist (tag tags) + (when (listp tag) + (cl-case (setq cur-type (semantic-tag-class tag)) + ((function variable type) + (let ((spaces (make-string (* depth 2) ?\s)) + (type-p (eq cur-type 'type))) + (unless (and (> depth 0) (not type-p)) + (setq class nil)) + (insert + (if (and class (not type-p)) + (format "%s%s(%s) " + spaces (if (< depth 2) "" "├►") class) + spaces) + ;; Save the tag for later + (propertize (funcall stylefn tag nil t) + 'semantic-tag tag) + "\n") + (and type-p (setq class (car tag))) + ;; Recurse to children + (unless (eq cur-type 'function) + (helm-semantic--fetch-candidates + (semantic-tag-components tag) (1+ depth) class)))) + + ;; Don't do anything with packages or includes for now + ((package include) + (insert + (propertize (funcall stylefn tag nil t) + 'semantic-tag tag) + "\n") + ) + ;; Catch-all + (t)))))) + +(defun helm-semantic-default-action (_candidate &optional persistent) + ;; By default, helm doesn't pass on the text properties of the selection. + ;; Fix this. + (helm-log-run-hook 'helm-goto-line-before-hook) + (with-current-buffer helm-buffer + (when (looking-at " ") + (goto-char (next-single-property-change + (point-at-bol) 'semantic-tag nil (point-at-eol)))) + (let ((tag (get-text-property (point) 'semantic-tag))) + (semantic-go-to-tag tag) + (unless persistent + (pulse-momentary-highlight-one-line (point)))))) + +(defun helm-semantic--maybe-set-needs-update () + (with-helm-current-buffer + (when (semantic-parse-tree-needs-update-p) + (semantic-parse-tree-set-needs-update)))) + +(defvar helm-source-semantic nil) + +(defclass helm-semantic-source (helm-source-in-buffer) + ((init :initform (lambda () + (helm-semantic--maybe-set-needs-update) + (setq helm-semantic--tags-cache (semantic-fetch-tags)) + (with-current-buffer (helm-candidate-buffer 'global) + (let ((major-mode (with-helm-current-buffer major-mode))) + (helm-semantic--fetch-candidates helm-semantic--tags-cache 0))))) + (get-line :initform 'buffer-substring) + (persistent-help :initform "Show this entry") + (keymap :initform 'helm-semantic-map) + (help-message :initform 'helm-semantic-help-message) + (persistent-action :initform (lambda (elm) + (helm-semantic-default-action elm t) + (helm-highlight-current-line))) + (action :initform 'helm-semantic-default-action))) + +(defcustom helm-semantic-fuzzy-match nil + "Enable fuzzy matching in `helm-source-semantic'." + :group 'helm-semantic + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-semantic + (helm-make-source "Semantic Tags" 'helm-semantic-source + :fuzzy-match helm-semantic-fuzzy-match)))) + +;;;###autoload +(defun helm-semantic (arg) + "Preconfigured `helm' for `semantic'. +If ARG is supplied, pre-select symbol at point instead of current" + (interactive "P") + (let ((tag (helm-aif (semantic-current-tag-parent) + (cons (format "\\_<%s\\_>" (car it)) + (format "\\_<%s\\_>" (car (semantic-current-tag)))) + (format "\\_<%s\\_>" (car (semantic-current-tag)))))) + (unless helm-source-semantic + (setq helm-source-semantic + (helm-make-source "Semantic Tags" 'helm-semantic-source + :fuzzy-match helm-semantic-fuzzy-match))) + (helm :sources 'helm-source-semantic + :candidate-number-limit 9999 + :preselect (if arg + (thing-at-point 'symbol) + tag) + :buffer "*helm semantic*"))) + +;;;###autoload +(defun helm-semantic-or-imenu (arg) + "Preconfigured helm for `semantic' or `imenu'. +If ARG is supplied, pre-select symbol at point instead of current +semantic tag in scope. + +If `semantic-mode' is active in the current buffer, then use +semantic for generating tags, otherwise fall back to `imenu'. +Fill in the symbol at point by default." + (interactive "P") + (unless helm-source-semantic + (setq helm-source-semantic + (helm-make-source "Semantic Tags" 'helm-semantic-source + :fuzzy-match helm-semantic-fuzzy-match))) + (unless helm-source-imenu + (setq helm-source-imenu + (helm-make-source "Imenu" 'helm-imenu-source + :fuzzy-match helm-imenu-fuzzy-match))) + (let* ((source (if (semantic-active-p) + 'helm-source-semantic + 'helm-source-imenu)) + (imenu-p (eq source 'helm-source-imenu)) + (imenu-auto-rescan imenu-p) + (str (thing-at-point 'symbol)) + (helm-execute-action-at-once-if-one + (and imenu-p + helm-imenu-execute-action-at-once-if-one)) + (tag (helm-aif (semantic-current-tag-parent) + (cons (format "\\_<%s\\_>" (car it)) + (format "\\_<%s\\_>" (car (semantic-current-tag)))) + (format "\\_<%s\\_>" (car (semantic-current-tag)))))) + (helm :sources source + :candidate-number-limit 9999 + :default (and imenu-p (list (concat "\\_<" str "\\_>") str)) + :preselect (if (or arg imenu-p) str tag) + :buffer "*helm semantic/imenu*"))) + +(provide 'helm-semantic) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-semantic.el ends here diff --git a/helm-source.el b/helm-source.el new file mode 100644 index 00000000..facc342e --- /dev/null +++ b/helm-source.el @@ -0,0 +1,1003 @@ +;;; helm-source.el --- Helm source creation. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2016 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; 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: + +;; Interface to create helm sources easily. +;; Actually the eieo objects are transformed in alist for compatibility. +;; In the future this package should allow creating source as eieo objects +;; without conversion to alist, teaching helm to read such a structure. +;; The compatibility with alists would be kept. + +;;; Code: + +(require 'cl-lib) +(require 'eieio) +(require 'helm-lib) + +(defvar helm-fuzzy-sort-fn) +(defvar helm-fuzzy-match-fn) +(defvar helm-fuzzy-search-fn) + +(declare-function helm-init-candidates-in-buffer "helm.el") +(declare-function helm-interpret-value "helm.el") +(declare-function helm-fuzzy-highlight-matches "helm.el") + + +(defgeneric helm--setup-source (source) + "Prepare slots and handle slot errors before creating a helm source.") + +(defgeneric helm-setup-user-source (source) + "Allow users modifying slots in SOURCE just before creation.") + + +;;; Classes for sources +;; +;; +(defclass helm-source () + ((name + :initarg :name + :initform nil + :custom string + :documentation + " The name of the source. + A string which is also the heading which appears + above the list of matches from the source. Must be unique.") + + (header-name + :initarg :header-name + :initform nil + :custom function + :documentation + " A function returning the display string of the header. + Its argument is the name of the source. This attribute is useful to + add an additional information with the source name. + It doesn't modify the name of the source.") + + (init + :initarg :init + :initform nil + :custom function + :documentation + " Function called with no parameters when helm is started. + It is useful for collecting current state information which can be + used to create the list of candidates later. + Initialization of `candidates-in-buffer' is done here + with `helm-init-candidates-in-buffer'.") + + (candidates + :initarg :candidates + :initform nil + :custom (choice function list) + :documentation + " Specifies how to retrieve candidates from the source. + It can either be a variable name, a function called with no parameters + or the actual list of candidates. + + The list must be a list whose members are strings, symbols + or (DISPLAY . REAL) pairs. + + In case of (DISPLAY . REAL) pairs, the DISPLAY string is shown + in the Helm buffer, but the REAL one is used as action + argument when the candidate is selected. This allows a more + readable presentation for candidates which would otherwise be, + for example, too long or have a common part shared with other + candidates which can be safely replaced with an abbreviated + string for display purposes. + + Note that if the (DISPLAY . REAL) form is used then pattern + matching is done on the displayed string, not on the real + value.") + + (update + :initarg :update + :initform nil + :custom function + :documentation + " Function called with no parameters at before \"init\" function + when `helm-force-update' is called.") + + (cleanup + :initarg :cleanup + :initform nil + :custom function + :documentation + " Function called with no parameters when *helm* buffer is + closed. It is useful for killing unneeded candidates buffer. + + Note that the function is executed BEFORE performing action.") + + (keymap + :initarg :keymap + :initform nil + :custom sexp + :documentation + " Specific keymap for this source. + It is useful to have a keymap per source when using more than + one source. Otherwise, a keymap can be set per command with + `helm' argument KEYMAP. NOTE: when a source have `helm-map' as + keymap attr, the global value of `helm-map' will override the + actual local one.") + + (action + :initarg :action + :initform 'identity + :custom (alist :key-type string + :value-type function) + :documentation + " An alist of (DISPLAY . FUNCTION) pairs, a variable name or a function. + FUNCTION is called with one parameter: the selected candidate. + + An action other than the default can be chosen from this list + of actions for the currently selected candidate (by default + with TAB). The DISPLAY string is shown in the completions + buffer and the FUNCTION is invoked when an action is + selected. The first action of the list is the default. + + You should use `helm-make-actions' to build this alist easily.") + + (persistent-action + :initarg :persistent-action + :initform nil + :custom function + :documentation + " Can be a either a Function called with one parameter (the + selected candidate) or a cons cell where first element is this + same function and second element a symbol (e.g never-split) + that inform `helm-execute-persistent-action'to not split his + window to execute this persistent action.") + + (persistent-help + :initarg :persistent-help + :initform nil + :custom string + :documentation + " A string to explain persistent-action of this source. It also + accepts a function or a variable name. + It will be displayed in `header-line'. + Have no effect when `helm-echo-input-in-header-line' is non--nil.") + + (help-message + :initarg :help-message + :initform nil + :custom (choice string function) + :documentation + " Help message for this source. + If not present, `helm-help-message' value will be used.") + + (multiline + :initarg :multiline + :initform nil + :custom boolean + :documentation + " Enable to selection multiline candidates.") + + (requires-pattern + :initarg :requires-pattern + :initform nil + :custom integer + :documentation + " If present matches from the source are shown only if the + pattern is not empty. Optionally, it can have an integer + parameter specifying the required length of input which is + useful in case of sources with lots of candidates.") + + (candidate-transformer + :initarg :candidate-transformer + :initform nil + :custom (choice function list) + :documentation + " It's a function or a list of functions called with one argument + when the completion list from the source is built. The argument + is the list of candidates retrieved from the source. The + function should return a transformed list of candidates which + will be used for the actual completion. If it is a list of + functions, it calls each function sequentially. + + This can be used to transform or remove items from the list of + candidates. + + Note that `candidates' is run already, so the given transformer + function should also be able to handle candidates with (DISPLAY + . REAL) format.") + + (filtered-candidate-transformer + :initarg :filtered-candidate-transformer + :initform nil + :custom (choice function list) + :documentation + " It has the same format as `candidate-transformer', except the + function is called with two parameters: the candidate list and + the source. + + This transformer is run on the candidate list which is already + filtered by the current pattern. While `candidate-transformer' + is run only once, it is run every time the input pattern is + changed. + + It can be used to transform the candidate list dynamically, for + example, based on the current pattern. + + In some cases it may also be more efficent to perform candidate + transformation here, instead of with `candidate-transformer' + even if this transformation is done every time the pattern is + changed. For example, if a candidate set is very large then + `candidate-transformer' transforms every candidate while only + some of them will actually be displayed due to the limit + imposed by `helm-candidate-number-limit'. + + Note that `candidates' and `candidate-transformer' is run + already, so the given transformer function should also be able + to handle candidates with (DISPLAY . REAL) format.") + + (filter-one-by-one + :initarg :filter-one-by-one + :initform nil + :custom (choice function list) + :documentation + " A transformer function that treat candidates one by one. + It is called with one arg the candidate. + It is faster than `filtered-candidate-transformer' or + `candidates-transformer', but should be used only in sources + that recompute constantly their candidates, e.g `helm-source-find-files'. + Filtering happen early and candidates are treated + one by one instead of re-looping on the whole list. + If used with `filtered-candidate-transformer' or `candidates-transformer' + these functions should treat the candidates transformed by the + `filter-one-by-one' function in consequence.") + + (display-to-real + :initarg :display-to-real + :initform nil + :custom function + :documentation + " Transform the selected candidate when passing it to action. + + Function called with one parameter, the selected candidate. + + Avoid recomputing all candidates with candidate-transformer + or filtered-candidate-transformer to give a new value to REAL, + instead the selected candidate is transformed only when passing it + to action. + + Note that this is NOT a transformer, + so the display will not be modified by this function.") + + (real-to-display + :initarg :real-to-display + :initform nil + :custom function + :documentation + " Recompute all candidates computed previously with other transformers. + + Function called with one parameter, the selected candidate. + + The real value of candidates will be shown in display. + Note: This have nothing to do with display-to-real. + It is unuseful as the same can be performed by using more than + one function in transformers, it is kept only for backward compatibility.") + + (action-transformer + :initarg :action-transformer + :initform nil + :custom (choice function list) + :documentation + " It's a function or a list of functions called with two + arguments when the action list from the source is + assembled. The first argument is the list of actions, the + second is the current selection. If it is a list of functions, + it calls each function sequentially. + + The function should return a transformed action list. + + This can be used to customize the list of actions based on the + currently selected candidate.") + + (pattern-transformer + :initarg :pattern-transformer + :initform nil + :custom (choice function list) + :documentation + " It's a function or a list of functions called with one argument + before computing matches. Its argument is `helm-pattern'. + Functions should return transformed `helm-pattern'. + + It is useful to change interpretation of `helm-pattern'.") + + (candidate-number-limit + :initarg :candidate-number-limit + :initform nil + :custom integer + :documentation + " Override `helm-candidate-number-limit' only for this source.") + + (volatile + :initarg :volatile + :initform nil + :custom boolean + :documentation + " Indicates the source assembles the candidate list dynamically, + so it shouldn't be cached within a single Helm + invocation. It is only applicable to synchronous sources, + because asynchronous sources are not cached.") + + (match + :initarg :match + :initform nil + :custom (choice function list) + :documentation + " List of functions called with one parameter: a candidate. The + function should return non-nil if the candidate matches the + current pattern (see variable `helm-pattern'). + + When using `candidates-in-buffer' its default value is `identity' and + don't have to be changed, use the `search' slot instead. + + This attribute allows the source to override the default + pattern matching based on `string-match'. It can be used, for + example, to implement a source for file names and do the + pattern matching on the basename of files, since it's more + likely one is typing part of the basename when searching for a + file, instead of some string anywhere else in its path. + + If the list contains more than one function then the list of + matching candidates from the source is constructed by appending + the results after invoking the first function on all the + potential candidates, then the next function, and so on. The + matching candidates supplied by the first function appear first + in the list of results and then results from the other + functions, respectively. + + This attribute has no effect for asynchronous sources (see + attribute `candidates'), since they perform pattern matching + themselves. + + Note that FUZZY-MATCH slot will overhide value of this slot.") + + (fuzzy-match + :initarg :fuzzy-match + :initform nil + :custom boolean + :documentation + " Enable fuzzy matching in this source. + This will overwrite settings in MATCH slot, and for + sources built with child class `helm-source-in-buffer' the SEARCH slot. + This is an easy way of enabling fuzzy matching, but you can use the MATCH + or SEARCH slots yourself if you want something more elaborated, mixing + different type of match (See `helm-source-buffers' class for example).") + + (nomark + :initarg :nomark + :initform nil + :custom boolean + :documentation + " Don't allow marking candidates when this attribute is present.") + + (nohighlight + :initarg :nohighlight + :initform nil + :custom boolean + :documentation + " Disable highlighting matches in this source. + This will disable generic highlighting of matches, + but some specialized highlighting can be done from elsewhere, + i.e from `filtered-candidate-transformer' or `filter-one-by-one' slots. + So use this to either disable completely highlighting in your source, + or to disable highlighting and use a specialized highlighting matches + function for this source. + Remember that this function should run AFTER all filter functions if those + filter functions are modifying face properties, though it is possible to + avoid this by using new `add-face-text-property' in your filter functions.") + + (allow-dups + :initarg :allow-dups + :initform nil + :custom boolean + :documentation + " Allow helm collecting duplicates candidates.") + + (history + :initarg :history + :initform nil + :custom symbol + :documentation + " Allow passing history variable to helm from source. + It should be a quoted symbol.") + + (coerce + :initarg :coerce + :initform nil + :custom function + :documentation + " It's a function called with one argument: the selected candidate. + This function is intended for type convertion. In normal case, + the selected candidate (string) is passed to action + function. If coerce function is specified, it is called just + before action function. + + Example: converting string to symbol + (coerce . intern)") + + (mode-line + :initarg :mode-line + :initform nil + :custom (choice string sexp) + :documentation + " Source local `helm-mode-line-string' (included in + `mode-line-format'). It accepts also variable/function name.") + + (header-line + :initarg :header-line + :initform nil + :custom (choice string function) + :documentation + " Source local `header-line-format'. + Have no effect when `helm-echo-input-in-header-line' is non--nil. + It accepts also variable/function name.") + + (resume + :initarg :resume + :initform nil + :custom function + :documentation + " Function called with no parameters at end of initialization + when `helm-resume' is started. + If this function try to do something against `helm-buffer', \(e.g updating, + searching etc...\) probably you should run it in a timer to ensure + `helm-buffer' is ready.") + + (follow + :initarg :follow + :initform nil + :custom integer + :documentation + " Enable `helm-follow-mode' for this source only. +With a value of 1 enable, a value of -1 or nil disable the mode. + See `helm-follow-mode' for more infos.") + + (follow-delay + :initarg :follow-delay + :initform nil + :custom integer + :documentation + " `helm-follow-mode' will execute persistent-action after this delay. + Otherwise value of `helm-follow-input-idle-delay' is used if non--nil, + If none of these are found fallback to `helm-input-idle-delay'.") + + (multimatch + :initarg :multimatch + :initform t + :custom boolean + :documentation + " Use the multi-match algorithm when non-nil. + I.e Allow specifying multiple patterns separated by spaces. + When a pattern is prefixed by \"!\" the negation of this pattern is used, + i.e match anything but this pattern. + It is the standard way of matching in helm and is enabled by default. + It can be used with fuzzy-matching enabled, but as soon helm detect a space, + each pattern will match by regexp and will not be fuzzy.") + + (match-part + :initarg :match-part + :initform nil + :custom function + :documentation + " Allow matching only one part of candidate. + If source contain 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.") + + (before-init-hook + :initarg :before-init-hook + :initform nil + :custom symbol + :documentation + " A local hook that run at beginning of initilization of this source. + i.e Before the creation of `helm-buffer'. + + Should be a variable (defined with defvar). + Can be also an anonymous function or a list of functions + directly added to slot, this is not recommended though.") + + (after-init-hook + :initarg :after-init-hook + :initform nil + :custom symbol + :documentation + " A local hook that run at end of initilization of this source. + i.e After the creation of `helm-buffer'. + + Should be a variable. + Can be also an anonymous function or a list of functions + directly added to slot, this is not recommended though.") + + (delayed + :initarg :delayed + :initform nil + :custom (choice null integer) + :documentation + " This slot have no more effect and is just kept for backward compatibility. + Please don't use it.")) + + "Main interface to define helm sources." + :abstract t) + +(defclass helm-source-sync (helm-source) + ((candidates + :initform '("ERROR: You must specify the `candidates' slot, either with a list or a function")) + + (migemo + :initarg :migemo + :initform nil + :custom boolean + :documentation + " Enable migemo. + When multimatch is disabled, you can give the symbol 'nomultimatch as value + to force not using generic migemo matching function. + In this case you have to provide your own migemo matching funtion + that kick in when `helm-migemo-mode' is enabled. + Otherwise it will be available for this source once `helm-migemo-mode' + is enabled when non-nil.") + + (match-strict + :initarg :match-strict + :initform nil + :custom function + :documentation + " When specifying a match function within a source and + helm-multi-match is enabled, the result of all matching + functions will be concatened, which in some cases is not what + is wanted. When using `match-strict' only this or these + functions will be used. You can specify those functions as a + list of functions or a single symbol function. + + NOTE: This have the same effect as using :MULTIMATCH nil.")) + + "Use this class to make helm sources using a list of candidates. +This list should be given as a normal list, a variable handling a list +or a function returning a list. +Matching is done basically with `string-match' against each candidate.") + +(defclass helm-source-async (helm-source) + ((candidates-process + :initarg :candidates-process + :initform nil + :custom function + :documentation + " This attribute is used to define a process as candidate. + The value must be a process. + + NOTE: + When building the source at runtime you can give directly a process + as value, otherwise wrap the process call into a function. + The process buffer should be nil, otherwise, if you use + `helm-buffer' give to the process a sentinel.") + + (multimatch :initform nil)) + + "Use this class to define a helm source calling an external process. +The :candidates slot is not allowed even if described because this class +inherit from `helm-source'.") + +(defclass helm-source-in-buffer (helm-source) + ((init + :initform 'helm-default-init-source-in-buffer-function) + + (data + :initarg :data + :initform nil + :custom (choice list string) + :documentation + " A string or a list that will be used to feed the `helm-candidates-buffer'. + This data will be passed in a function added to the init slot and + the buffer will be build with `helm-init-candidates-in-buffer'. + This is an easy and fast method to build a `candidates-in-buffer' source.") + + (migemo + :initarg :migemo + :initform nil + :custom boolean + :documentation + " Enable migemo. + When multimatch is disabled, you can give the symbol 'nomultimatch as value + to force not using generic migemo matching function. + In this case you have to provide your own migemo matching funtion + that kick in when `helm-migemo-mode' is enabled. + Otherwise it will be available for this source once `helm-migemo-mode' + is enabled when non-nil.") + + (candidates + :initform 'helm-candidates-in-buffer) + + (volatile + :initform t) + + (match + :initform '(identity)) + + (get-line + :initarg :get-line + :initform 'buffer-substring-no-properties + :custom function + :documentation + " A function like `buffer-substring-no-properties' or `buffer-substring'. + This function converts point of line-beginning and point of line-end, + which represents a candidate computed by `helm-candidates-in-buffer'. + By default, `helm-candidates-in-buffer' uses + `buffer-substring-no-properties'.") + + (search + :initarg :search + :initform '(helm-candidates-in-buffer-search-default-fn) + :custom (choice function list) + :documentation + " List of functions like `re-search-forward' or `search-forward'. + Buffer search function used by `helm-candidates-in-buffer'. + By default, `helm-candidates-in-buffer' uses `re-search-forward'. + The function should take one arg PATTERN. + If your search function needs to handle negation like multimatch, + this function should returns in such case a cons cell of two integers defining + the beg and end positions to match in the line previously matched by + `re-search-forward' or similar, and move point to next line + (See how the `helm-mm-3-search-base' and `helm-fuzzy-search' functions are working). + + NOTE: FUZZY-MATCH slot will overhide value of this slot.") + + (search-strict + :initarg :search-strict + :initform nil + :custom function + :documentation + " When specifying a search function within a source and + helm-multi-match is enabled, the result of all searching + functions will be concatened, which in some cases is not what + is wanted. When using `search-strict' only this or these + functions will be used. You can specify those functions as a + list of functions or a single symbol function. + + NOTE: This have the same effect as using a nil value for + :MULTIMATCH slot.")) + + "Use this source to make helm sources storing candidates inside a buffer. +Contrarily to `helm-source-sync' candidates are matched using a function +like `re-search-forward', see below documentation of :search slot. +See `helm-candidates-in-buffer' for more infos.") + +(defclass helm-source-dummy (helm-source) + ((candidates + :initform '("dummy")) + + (filtered-candidate-transformer + :initform (lambda (_candidates _source) (list helm-pattern))) + + (multimatch + :initform nil) + + (accept-empty + :initarg :accept-empty + :initform t + :custom boolean + :documentation + " Allow exiting with an empty string. + You should keep the default value.") + + (match + :initform 'identity) + + (volatile + :initform t))) + +(defclass helm-source-in-file (helm-source-in-buffer) + ((init :initform (lambda () + (let ((file (helm-attr 'candidates-file))) + (with-current-buffer (helm-candidate-buffer 'global) + (insert-file-contents file))))) + (candidates-file + :initarg :candidates-file + :initform nil + :custom string + :documentation "A filename.")) + + "The contents of the file will be used as candidates in buffer.") + + +;;; Error functions +;; +;; +(defun helm-default-init-source-in-buffer-function () + (helm-init-candidates-in-buffer 'global + '("ERROR: No buffer handling your data, use either the `init' slot or the `data' slot."))) + + +;;; Internal Builder functions. +;; +;; +(defun helm--create-source (object) + "[INTERNAL] Build a helm source from OBJECT. +Where OBJECT is an instance of an eieio class." + (cl-loop for s in (object-slots object) + for slot-val = (slot-value object s) + when slot-val + collect (cons s (unless (eq t slot-val) slot-val)))) + +(defun helm-make-source (name class &rest args) + "Build a `helm' source named NAME with ARGS for CLASS. +Argument NAME is a string which define the source name, so no need to use +the keyword :name in your source, NAME will be used instead. +Argument CLASS is an eieio class object. +Arguments ARGS are keyword value pairs as defined in CLASS." + (declare (indent 2)) + (let ((source (apply #'make-instance class name args))) + (setf (slot-value source 'name) name) + (helm--setup-source source) + (helm-setup-user-source source) + (helm--create-source source))) + +(defun helm-make-type (class &rest args) + (let ((source (apply #'make-instance class args))) + (setf (slot-value source 'name) nil) + (helm--setup-source source) + (helm--create-source source))) + +(defvar helm-mm-default-search-functions) +(defvar helm-mm-default-match-functions) + +(defun helm-source-mm-get-search-or-match-fns (source method) + (let ((defmatch (helm-aif (slot-value source 'match) + (helm-mklist it))) + (defmatch-strict (helm-aif (and (eq method 'match) + (slot-value source 'match-strict)) + (helm-mklist it))) + (defsearch (helm-aif (and (eq method 'search) + (slot-value source 'search)) + (helm-mklist it))) + (defsearch-strict (helm-aif (and (eq method 'search-strict) + (slot-value source 'search-strict)) + (helm-mklist it))) + (migemo (slot-value source 'migemo))) + (cl-case method + (match (cond (defmatch-strict) + (migemo + (append helm-mm-default-match-functions + defmatch '(helm-mm-3-migemo-match))) + (defmatch + (append helm-mm-default-match-functions defmatch)) + (t helm-mm-default-match-functions))) + (search (cond (defsearch-strict) + (migemo + (append helm-mm-default-search-functions + defsearch '(helm-mm-3-migemo-search))) + (defsearch + (append helm-mm-default-search-functions defsearch)) + (t helm-mm-default-search-functions)))))) + + +;;; Modifiers +;; +(cl-defun helm-source-add-action-to-source-if (name fn source predicate + &optional (index 4)) + "Same as `helm-add-action-to-source-if' but for SOURCE defined as eieio object. +You can use this inside a `helm--setup-source' method for a SOURCE defined as +an eieio class." + (let* ((actions (slot-value source 'action)) + (action-transformers (slot-value source 'action-transformer)) + (new-action (list (cons name fn))) + (transformer (lambda (actions candidate) + (cond ((funcall predicate candidate) + (helm-append-at-nth + actions new-action index)) + (t actions))))) + (if (functionp actions) + (setf (slot-value source 'action) (list (cons "Default action" actions))) + (setf (slot-value source 'action) (helm-interpret-value actions source))) + (when (or (symbolp action-transformers) (functionp action-transformers)) + (setq action-transformers (list action-transformers))) + (setf (slot-value source 'action-transformer) + (delq nil (append (list transformer) action-transformers))))) + + +;;; Methods to build sources. +;; +;; +(defun helm-source--persistent-help-string (string source) + (substitute-command-keys + (concat "\\\\[helm-execute-persistent-action]: " + (or (format "%s (keeping session)" string) + (slot-value source 'header-line))))) + +(defun helm-source--header-line (source) + (substitute-command-keys + (concat "\\\\[helm-execute-persistent-action]: " + (helm-aif (or (slot-value source 'persistent-action) + (slot-value source 'action)) + (cond ((and (symbolp it) + (functionp it) + (eq it 'identity)) + "Do Nothing") + ((and (symbolp it) + (boundp it) + (listp (symbol-value it)) + (stringp (caar (symbol-value it)))) + (caar (symbol-value it))) + ((or (symbolp it) (functionp it)) + (helm-symbol-name it)) + ((listp it) + (let ((action (car it))) + ;; It comes from :action ("foo" . function). + (if (stringp (car action)) + (car action) + ;; It comes from :persistent-action + ;; (function . 'nosplit) Fix Issue #788. + (if (or (symbolp action) + (functionp action)) + (helm-symbol-name action))))) + (t "")) + "") + " (keeping session)"))) + +(defmethod helm--setup-source :primary ((_source helm-source))) + +(defmethod helm--setup-source :before ((source helm-source)) + (when (slot-value source 'delayed) + (warn "Deprecated usage of helm `delayed' slot in `%s'" + (slot-value source 'name))) + (helm-aif (slot-value source 'keymap) + (and (symbolp it) (setf (slot-value source 'keymap) (symbol-value it)))) + (helm-aif (slot-value source 'persistent-help) + (setf (slot-value source 'header-line) + (helm-source--persistent-help-string it source)) + (setf (slot-value source 'header-line) (helm-source--header-line source))) + (helm-aif (slot-value source 'candidate-number-limit) + (and (symbolp it) (setf (slot-value source 'candidate-number-limit) + (symbol-value it)))) + (when (and (slot-value source 'fuzzy-match) helm-fuzzy-sort-fn) + (setf (slot-value source 'filtered-candidate-transformer) + (helm-aif (slot-value source 'filtered-candidate-transformer) + (append (helm-mklist it) + (list helm-fuzzy-sort-fn)) + (list helm-fuzzy-sort-fn)))) + (unless (slot-value source 'nohighlight) + (setf (slot-value source 'filtered-candidate-transformer) + (helm-aif (slot-value source 'filtered-candidate-transformer) + (append (helm-mklist it) + (list #'helm-fuzzy-highlight-matches)) + (list #'helm-fuzzy-highlight-matches))))) + +(defmethod helm-setup-user-source ((_source helm-source))) + +(defmethod helm--setup-source ((source helm-source-sync)) + (when (slot-value source 'fuzzy-match) + (helm-aif (slot-value source 'match) + (setf (slot-value source 'match) + (append (helm-mklist it) + (list helm-fuzzy-match-fn))) + (setf (slot-value source 'match) helm-fuzzy-match-fn))) + (when (slot-value source 'multimatch) + (setf (slot-value source 'match) + (helm-source-mm-get-search-or-match-fns source 'match))) + (helm-aif (and (null (slot-value source 'multimatch)) + (slot-value source 'migemo)) + (unless (eq it 'nomultimatch) ; Use own migemo fn. + (setf (slot-value source 'match) + (append (helm-mklist (slot-value source 'match)) + '(helm-mm-3-migemo-match)))))) + +(defmethod helm--setup-source ((source helm-source-in-buffer)) + (let ((cur-init (slot-value source 'init))) + (helm-aif (slot-value source 'data) + (setf (slot-value source 'init) + (delq + nil + (list + (and (null (eq 'helm-default-init-source-in-buffer-function + cur-init)) + cur-init) + (lambda () + (helm-init-candidates-in-buffer + 'global + (if (functionp it) (funcall it) it)))))))) + (when (slot-value source 'fuzzy-match) + (helm-aif (slot-value source 'search) + (setf (slot-value source 'search) + (append (helm-mklist it) + (list helm-fuzzy-search-fn))) + (setf (slot-value source 'search) (list helm-fuzzy-search-fn)))) + (when (slot-value source 'multimatch) + (setf (slot-value source 'search) + (helm-source-mm-get-search-or-match-fns source 'search))) + (helm-aif (and (null (slot-value source 'multimatch)) + (slot-value source 'migemo)) + (unless (eq it 'nomultimatch) + (setf (slot-value source 'search) + (append (helm-mklist (slot-value source 'search)) + '(helm-mm-3-migemo-search))))) + (let ((mtc (slot-value source 'match))) + (cl-assert (or (equal '(identity) mtc) + (eq 'identity mtc)) + nil "Invalid slot value for `match'") + (cl-assert (eq (slot-value source 'volatile) t) + nil "Invalid slot value for `volatile'"))) + +(defmethod helm--setup-source ((source helm-source-async)) + (cl-assert (null (slot-value source 'candidates)) + nil "Incorrect use of `candidates' use `candidates-process' instead") + (cl-assert (null (slot-value source 'multimatch)) + nil "`multimatch' not allowed in async sources.")) + +(defmethod helm--setup-source ((source helm-source-dummy)) + (let ((mtc (slot-value source 'match))) + (cl-assert (or (equal '(identity) mtc) + (eq 'identity mtc)) + nil "Invalid slot value for `match'") + (cl-assert (eq (slot-value source 'volatile) t) + nil "Invalid slot value for `volatile'") + (cl-assert (equal (slot-value source 'candidates) '("dummy")) + nil "Invalid slot value for `candidates'") + (cl-assert (eq (slot-value source 'accept-empty) t) + nil "Invalid slot value for `accept-empty'"))) + + +;;; User functions +;; +;; Sources +(defmacro helm-build-sync-source (name &rest args) + "Build a synchronous helm source with name NAME. +Args ARGS are keywords provided by `helm-source-sync'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-sync ,@args)) + +(defmacro helm-build-async-source (name &rest args) + "Build a asynchronous helm source with name NAME. +Args ARGS are keywords provided by `helm-source-async'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-async ,@args)) + +(defmacro helm-build-in-buffer-source (name &rest args) + "Build a helm source with name NAME using `candidates-in-buffer' method. +Args ARGS are keywords provided by `helm-source-in-buffer'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-in-buffer ,@args)) + +(defmacro helm-build-dummy-source (name &rest args) + "Build a helm source with name NAME using `dummy' method. +Args ARGS are keywords provided by `helm-source-dummy'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-dummy ,@args)) + +(defmacro helm-build-in-file-source (name file &rest args) + "Build a helm source with NAME name using `candidates-in-files' method. +Arg FILE is a filename, the contents of this file will be +used as candidates in buffer. +Args ARGS are keywords provided by `helm-source-in-file'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-in-file + :candidates-file ,file ,@args)) + + +(provide 'helm-source) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-source ends here diff --git a/helm-sys.el b/helm-sys.el new file mode 100644 index 00000000..3230a0ca --- /dev/null +++ b/helm-sys.el @@ -0,0 +1,448 @@ +;;; helm-sys.el --- System related functions for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-utils) + + +(defgroup helm-sys nil + "System related helm library." + :group 'helm) + +(defface helm-top-columns + '((t :inherit helm-header)) + "Face for helm help string in minibuffer." + :group 'helm-sys) + + +(defcustom helm-top-command + (cl-case system-type + (darwin "env COLUMNS=%s ps -axo pid,user,pri,nice,ucomm,tty,start_time,vsz,%%cpu,%%mem,etime,command") + (t "env COLUMNS=%s top -b -n 1")) + "Top command used to display output of top. +A format string where %s will be replaced with `frame-width'. + +To use 'top' command, a version supporting batch mode (-b option) is needed. +On Mac OSX 'top' command doesn't support this, so ps command +is used instead by default. +Normally 'top' command output have 12 columns, but in some versions you may +have less than this, so you can either customize top to use 12 columns with the +interactives 'f' and 'W' commands of top, or modify +`helm-top-sort-colums-alist' to fit with the number of columns +your 'top' command is using. + +If you modify 'ps' command be sure that 'pid' comes in first +and \"env COLUMNS=%s\" is specified at beginning of command. +Ensure also that no elements contain spaces (e.g use start_time and not start). +Same as for 'top' you can customize `helm-top-sort-colums-alist' to make sort commands +working properly according to your settings." + :group 'helm-sys + :type 'string) + +(defcustom helm-top-sort-colums-alist '((com . 11) + (mem . 9) + (cpu . 8) + (user . 1)) + "Allow defining which column to use when sorting output of top/ps command. +Only com, mem, cpu and user are sorted, so no need to put something else there, +it will have no effect. +Note that column numbers are counted from zero, i.e column 1 is the nth 0 column." + :group 'helm-sys + :type '(alist :key-type symbol :value-type (integer :tag "Column number"))) + +(defcustom helm-top-poll-delay 1.5 + "Helm top poll after this delay when `helm-top-poll-mode' is enabled. +The minimal delay allowed is 1.5, if less than this helm-top will use 1.5." + :group 'helm-sys + :type 'float) + +(defcustom helm-top-poll-delay-post-command 1.0 + "Helm top stop polling during this delay. +This delay is additioned to `helm-top-poll-delay' after emacs stop +being idle." + :group 'helm-sys + :type 'float) + +(defcustom helm-top-poll-preselection 'linum + "Stay on same line or follow candidate when `helm-top-poll' update display. +Possible values are 'candidate or 'linum. +This affect also sorting functions in the same way." + :group'helm-sys + :type '(radio :tag "Preferred preselection action for helm-top" + (const :tag "Follow candidate" candidate) + (const :tag "Stay on same line" linum))) + +;;; Top (process) +;; +;; +(defvar helm-top-sort-fn nil) +(defvar helm-top-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-P") 'helm-top-run-sort-by-cpu) + (define-key map (kbd "M-C") 'helm-top-run-sort-by-com) + (define-key map (kbd "M-M") 'helm-top-run-sort-by-mem) + (define-key map (kbd "M-U") 'helm-top-run-sort-by-user) + map)) + +(defvar helm-top-after-init-hook nil + "Local hook for helm-top.") + +(defvar helm-top--poll-timer nil) + +(defun helm-top-poll (&optional no-update delay) + (when helm-top--poll-timer + (cancel-timer helm-top--poll-timer)) + (condition-case nil + (progn + (when (and (helm-alive-p) (null no-update)) + ;; Fix quitting while process is running + ;; by binding `with-local-quit' in init function + ;; Issue #1521. + (helm-force-update + (cl-ecase helm-top-poll-preselection + (candidate (replace-regexp-in-string + "[0-9]+" "[0-9]+" + (regexp-quote (helm-get-selection nil t)))) + (linum `(lambda () + (goto-char (point-min)) + (forward-line ,(helm-candidate-number-at-point))))))) + (setq helm-top--poll-timer + (run-with-idle-timer + (helm-aif (current-idle-time) + (time-add it (seconds-to-time + (or delay (helm-top--poll-delay)))) + (or delay (helm-top--poll-delay))) + nil + 'helm-top-poll))) + (quit (cancel-timer helm-top--poll-timer)))) + +(defun helm-top--poll-delay () + (max 1.5 helm-top-poll-delay)) + +(defun helm-top-poll-no-update () + (helm-top-poll t (+ (helm-top--poll-delay) + helm-top-poll-delay-post-command))) + +(defun helm-top-initialize-poll-hooks () + ;; When emacs is idle during say 20s + ;; the idle timer will run in 20+1.5 s. + ;; This is fine when emacs stays idle, because the next timer + ;; will run at 21.5+1.5 etc... so the display will be updated + ;; at every 1.5 seconds. + ;; But as soon as emacs looses its idleness, the next update + ;; will occur at say 21+1.5 s, so we have to reinitialize + ;; the timer at 0+1.5. + (add-hook 'post-command-hook 'helm-top-poll-no-update) + (add-hook 'focus-in-hook 'helm-top-poll-no-update)) + +;;;###autoload +(define-minor-mode helm-top-poll-mode + "Refresh automatically helm top buffer once enabled." + :group 'helm-top + :global t + (if helm-top-poll-mode + (progn + (add-hook 'helm-top-after-init-hook 'helm-top-poll-no-update) + (add-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks)) + (remove-hook 'helm-top-after-init-hook 'helm-top-poll-no-update) + (remove-hook 'helm-top-after-init-hook 'helm-top-initialize-poll-hooks))) + +(defvar helm-source-top + (helm-build-in-buffer-source "Top" + :header-name (lambda (name) + (concat name (if helm-top-poll-mode + " (auto updating)" + " (Press C-c C-u to refresh)"))) + :init #'helm-top-init + :after-init-hook 'helm-top-after-init-hook + :cleanup (lambda () + (when helm-top--poll-timer + (cancel-timer helm-top--poll-timer)) + (remove-hook 'post-command-hook 'helm-top-poll-no-update) + (remove-hook 'focus-in-hook 'helm-top-poll-no-update)) + :nomark t + :display-to-real #'helm-top-display-to-real + :persistent-action #'helm-top-sh-persistent-action + :persistent-help "SIGTERM" + :help-message 'helm-top-help-message + :mode-line 'helm-top-mode-line + :follow 'never + :keymap helm-top-map + :filtered-candidate-transformer #'helm-top-sort-transformer + :action-transformer #'helm-top-action-transformer)) + +(defvar helm-top--line nil) +(defun helm-top-transformer (candidates _source) + "Transformer for `helm-top'. +Return empty string for non--valid candidates." + (cl-loop for disp in candidates collect + (cond ((string-match "^ *[0-9]+" disp) disp) + ((string-match "^ *PID" disp) + (setq helm-top--line (cons (propertize disp 'face 'helm-top-columns) ""))) + (t (cons disp ""))) + into lst + finally return (or (member helm-top--line lst) + (cons helm-top--line lst)))) + +(defun helm-top--skip-top-line () + (let* ((src (helm-get-current-source)) + (src-name (assoc-default 'name src))) + (helm-aif (and (stringp src-name) + (string= src-name "Top") + (helm-get-selection nil t src)) + (when (string-match-p "^ *PID" it) + (helm-next-line))))) + +(defun helm-top-action-transformer (actions _candidate) + "Action transformer for `top'. +Show actions only on line starting by a PID." + (let ((disp (helm-get-selection nil t))) + (cond ((string-match "^ *[0-9]+" disp) + (list '("kill (SIGTERM)" . (lambda (pid) (helm-top-sh "TERM" pid))) + '("kill (SIGKILL)" . (lambda (pid) (helm-top-sh "KILL" pid))) + '("kill (SIGINT)" . (lambda (pid) (helm-top-sh "INT" pid))) + '("kill (Choose signal)" + . (lambda (pid) + (helm-top-sh + (helm-comp-read (format "Kill [%s] with signal: " pid) + '("ALRM" "HUP" "INT" "KILL" "PIPE" "POLL" + "PROF" "TERM" "USR1" "USR2" "VTALRM" + "STKFLT" "PWR" "WINCH" "CHLD" "URG" + "TSTP" "TTIN" "TTOU" "STOP" "CONT" + "ABRT" "FPE" "ILL" "QUIT" "SEGV" + "TRAP" "SYS" "EMT" "BUS" "XCPU" "XFSZ") + :must-match t) + pid))))) + (t actions)))) + +(defun helm-top-sh (sig pid) + "Run kill shell command with signal SIG on PID for `helm-top'." + (let ((cmd (format "kill -%s %s" sig pid))) + (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))) + +(defun helm-top-sh-persistent-action (pid) + (delete-other-windows) + (helm-top-sh "TERM" pid) + (helm-force-update)) + +(defun helm-top-init () + "Insert output of top command in candidate buffer." + (with-local-quit + (unless helm-top-sort-fn (helm-top-set-mode-line "CPU")) + (with-current-buffer (helm-candidate-buffer 'global) + (call-process-shell-command + (format helm-top-command (frame-width)) + nil (current-buffer))))) + +(defun helm-top-display-to-real (line) + "Return pid only from LINE." + (car (split-string line))) + +;; Sort top command + +(defun helm-top-set-mode-line (str) + (if (string-match "Sort:\\[\\(.*\\)\\] " helm-top-mode-line) + (setq helm-top-mode-line (replace-match str nil nil helm-top-mode-line 1)) + (setq helm-top-mode-line (concat (format "Sort:[%s] " str) helm-top-mode-line)))) + +(defun helm-top-sort-transformer (candidates source) + (helm-top-transformer + (if helm-top-sort-fn + (cl-loop for c in candidates + if (string-match "^ *[0-9]+" c) + collect c into pid-cands + else collect c into header-cands + finally return (append + header-cands + (sort pid-cands helm-top-sort-fn))) + candidates) + source)) + +(defun helm-top-sort-by-com (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (col (cdr (assq 'com helm-top-sort-colums-alist))) + (com-1 (nth col split-1)) + (com-2 (nth col split-2))) + (string< com-1 com-2))) + +(defun helm-top-sort-by-mem (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (col (cdr (assq 'mem helm-top-sort-colums-alist))) + (mem-1 (string-to-number (nth col split-1))) + (mem-2 (string-to-number (nth col split-2)))) + (> mem-1 mem-2))) + +(defun helm-top-sort-by-cpu (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (col (cdr (assq 'cpu helm-top-sort-colums-alist))) + (cpu-1 (string-to-number (nth col split-1))) + (cpu-2 (string-to-number (nth col split-2)))) + (> cpu-1 cpu-2))) + +(defun helm-top-sort-by-user (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (col (cdr (assq 'user helm-top-sort-colums-alist))) + (user-1 (nth col split-1)) + (user-2 (nth col split-2))) + (string< user-1 user-2))) + +(defun helm-top--preselect-fn () + (if (eq helm-top-poll-preselection 'linum) + `(lambda () + (goto-char (point-min)) + (forward-line ,(helm-candidate-number-at-point))) + (replace-regexp-in-string + "[0-9]+" "[0-9]+" + (regexp-quote (helm-get-selection nil t))))) + +(defun helm-top-run-sort-by-com () + (interactive) + (helm-top-set-mode-line "COM") + (setq helm-top-sort-fn 'helm-top-sort-by-com) + (helm-update (helm-top--preselect-fn))) + +(defun helm-top-run-sort-by-cpu () + (interactive) + (let ((com (nth 2 (split-string helm-top-command)))) + (helm-top-set-mode-line "CPU") + (setq helm-top-sort-fn (and (null (string= com "top")) + 'helm-top-sort-by-cpu)) + (helm-update (helm-top--preselect-fn)))) + +(defun helm-top-run-sort-by-mem () + (interactive) + (helm-top-set-mode-line "MEM") + (setq helm-top-sort-fn 'helm-top-sort-by-mem) + (helm-update (helm-top--preselect-fn))) + +(defun helm-top-run-sort-by-user () + (interactive) + (helm-top-set-mode-line "USER") + (setq helm-top-sort-fn 'helm-top-sort-by-user) + (helm-update (helm-top--preselect-fn))) + + +;;; X RandR resolution change +;; +;; +;;; FIXME I do not care multi-display. + +(defun helm-xrandr-info () + "Return a pair with current X screen number and current X display name." + (with-temp-buffer + (call-process "xrandr" nil (current-buffer) nil + "--current") + (let (screen output) + (goto-char (point-min)) + (save-excursion + (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t) + (setq screen (match-string 2)))) + (when (re-search-forward "^\\(.*\\) connected" nil t) + (setq output (match-string 1))) + (list screen output)))) + +(defun helm-xrandr-screen () + "Return current X screen number." + (car (helm-xrandr-info))) + +(defun helm-xrandr-output () + "Return current X display name." + (cadr (helm-xrandr-info))) + +(defvar helm-source-xrandr-change-resolution + (helm-build-sync-source "Change Resolution" + :candidates + (lambda () + (with-temp-buffer + (call-process "xrandr" nil (current-buffer) nil + "--screen" (helm-xrandr-screen) "-q") + (goto-char 1) + (cl-loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t) + for mode = (match-string 1) + unless (member mode modes) + collect mode into modes + finally return modes))) + :action + (helm-make-actions "Change Resolution" + (lambda (mode) + (call-process "xrandr" nil nil nil + "--screen" (helm-xrandr-screen) + "--output" (helm-xrandr-output) + "--mode" mode))))) + + +;;; Emacs process +;; +;; +(defvar helm-source-emacs-process + (helm-build-sync-source "Emacs Process" + :init (lambda () (list-processes--refresh)) + :candidates (lambda () (mapcar #'process-name (process-list))) + :persistent-action (lambda (elm) + (delete-process (get-process elm)) + (helm-delete-current-selection)) + :persistent-help "Kill Process" + :action (helm-make-actions "Kill Process" + (lambda (elm) + (delete-process (get-process elm)))))) + + +;;;###autoload +(defun helm-top () + "Preconfigured `helm' for top command." + (interactive) + (add-hook 'helm-after-update-hook 'helm-top--skip-top-line) + (save-window-excursion + (unless helm-alive-p (delete-other-windows)) + (unwind-protect + (helm :sources 'helm-source-top + :buffer "*helm top*" :full-frame t + :candidate-number-limit 9999 + :preselect "^\\s-*[0-9]+") + (remove-hook 'helm-after-update-hook 'helm-top--skip-top-line)))) + +;;;###autoload +(defun helm-list-emacs-process () + "Preconfigured `helm' for emacs process." + (interactive) + (helm-other-buffer 'helm-source-emacs-process "*helm process*")) + +;;;###autoload +(defun helm-xrandr-set () + "Preconfigured helm for xrandr." + (interactive) + (helm :sources 'helm-source-xrandr-change-resolution + :buffer "*helm xrandr*")) + +(provide 'helm-sys) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-sys.el ends here diff --git a/helm-tags.el b/helm-tags.el new file mode 100644 index 00000000..079c2b4d --- /dev/null +++ b/helm-tags.el @@ -0,0 +1,342 @@ +;;; helm-tags.el --- Helm for Etags. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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-utils) +(require 'helm-grep) + + +(defgroup helm-tags nil + "Tags related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-etags-tag-file-name "TAGS" + "Etags tag file name." + :type 'string + :group 'helm-tags) + +(defcustom helm-etags-tag-file-search-limit 10 + "The limit level of directory to search tag file. +Don't search tag file deeply if outside this value." + :type 'number + :group 'helm-tags) + +(defcustom helm-etags-match-part-only 'tag + "Allow choosing the tag part of CANDIDATE in `helm-source-etags-select'. +A tag looks like this: + filename: \(defun foo +You can choose matching against the tag part (i.e \"(defun foo\"), +or against the whole candidate (i.e \"(filename:5:(defun foo\")." + :type '(choice + (const :tag "Match only tag" tag) + (const :tag "Match all file+tag" all)) + :group 'helm-tags) + +(defcustom helm-etags-execute-action-at-once-if-one t + "Whether to jump straight to the selected tag if there's only +one match." + :type 'boolean + :group 'helm-tags) + + +(defgroup helm-tags-faces nil + "Customize the appearance of helm-tags faces." + :prefix "helm-" + :group 'helm-tags + :group 'helm-faces) + +(defface helm-etags-file + '((t (:foreground "Lightgoldenrod4" + :underline t))) + "Face used to highlight etags filenames." + :group 'helm-tags-faces) + + +;;; Etags +;; +;; +(defun helm-etags-run-switch-other-window () + "Run switch to other window action from `helm-source-etags-select'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action + (lambda (c) + (helm-etags-action-goto 'find-file-other-window c))))) +(put 'helm-etags-run-switch-other-window 'helm-only t) + +(defun helm-etags-run-switch-other-frame () + "Run switch to other frame action from `helm-source-etags-select'." + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action + (lambda (c) + (helm-etags-action-goto 'find-file-other-frame c))))) +(put 'helm-etags-run-switch-other-frame 'helm-only t) + +(defvar helm-etags-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-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-c o") 'helm-etags-run-switch-other-window) + (define-key map (kbd "C-c C-o") 'helm-etags-run-switch-other-frame) + map) + "Keymap used in Etags.") + +(defvar helm-etags-mtime-alist nil + "Store the last modification time of etags files here.") +(defvar helm-etags-cache (make-hash-table :test 'equal) + "Cache content of etags files used here for faster access.") + +(defun helm-etags-get-tag-file (&optional directory) + "Return the path of etags file if found. +Lookes recursively in parents directorys for a +`helm-etags-tag-file-name' file." + ;; Get tag file from `default-directory' or upper directory. + (let ((current-dir (helm-etags-find-tag-file-directory + (or directory default-directory)))) + ;; Return nil if not find tag file. + (when current-dir + (expand-file-name helm-etags-tag-file-name current-dir)))) + +(defun helm-etags-all-tag-files () + "Return files from the following sources; + 1) An automatically located file in the parent directories, by `helm-etags-get-tag-file'. + 2) `tags-file-name', which is commonly set by `find-tag' command. + 3) `tags-table-list' which is commonly set by `visit-tags-table' command." + (helm-fast-remove-dups + (delq nil + (append (list (helm-etags-get-tag-file) + tags-file-name) + tags-table-list)) + :test 'equal)) + +(defun helm-etags-find-tag-file-directory (current-dir) + "Try to find the directory containing tag file. +If not found in CURRENT-DIR search in upper directory." + (let ((file-exists? (lambda (dir) + (let ((tag-path (expand-file-name + helm-etags-tag-file-name dir))) + (and (stringp tag-path) + (file-regular-p tag-path) + (file-readable-p tag-path)))))) + (cl-loop with count = 0 + until (funcall file-exists? current-dir) + ;; Return nil if outside the value of + ;; `helm-etags-tag-file-search-limit'. + if (= count helm-etags-tag-file-search-limit) + do (cl-return nil) + ;; Or search upper directories. + else + do (cl-incf count) + (setq current-dir (expand-file-name (concat current-dir "../"))) + finally return current-dir))) + +(defun helm-etags-get-header-name (_x) + "Create header name for this helm etags session." + (concat "Etags in " + (with-helm-current-buffer + (helm-etags-get-tag-file)))) + +(defun helm-etags-create-buffer (file) + "Create the `helm-buffer' based on contents of etags tag FILE." + (let* (max + (split (with-temp-buffer + (insert-file-contents file) + (prog1 + (split-string (buffer-string) "\n" 'omit-nulls) + (setq max (line-number-at-pos (point-max)))))) + (progress-reporter (make-progress-reporter "Loading tag file..." 0 max))) + (cl-loop + with fname + with cand + for i in split for count from 0 + for elm = (unless (string-match "^\x0c" i) ;; "^L" + (helm-aif (string-match "\177" i) ;; "^?" + (substring i 0 it) + i)) + for linum = (when (string-match "[0-9]+,?[0-9]*$" i) + (car (split-string (match-string 0 i) ","))) + do (cond ((and elm (string-match "^\\([^,]+\\),[0-9]+$" elm)) + (setq fname (propertize (match-string 1 elm) + 'face 'helm-etags-file))) + (elm (setq cand (format "%s:%s:%s" fname linum elm))) + (t (setq cand nil))) + when cand do (progn + (insert (propertize (concat cand "\n") 'linum linum)) + (progress-reporter-update progress-reporter count))))) + +(defun helm-etags-init () + "Feed `helm-buffer' using `helm-etags-cache' or tag file. +If no entry in cache, create one." + (let ((tagfiles (helm-etags-all-tag-files))) + (when tagfiles + (with-current-buffer (helm-candidate-buffer 'global) + (dolist (f tagfiles) + (helm-aif (gethash f helm-etags-cache) + ;; An entry is present in cache, insert it. + (insert it) + ;; No entry, create a new buffer using content of tag file (slower). + (helm-etags-create-buffer f) + ;; Store content of buffer in cache. + (puthash f (buffer-string) helm-etags-cache) + ;; Store or set the last modification of tag file. + (helm-aif (assoc f helm-etags-mtime-alist) + ;; If an entry exists modify it. + (setcdr it (helm-etags-mtime f)) + ;; No entry create a new one. + (cl-pushnew (cons f (helm-etags-mtime f)) + helm-etags-mtime-alist + :test 'equal)))))))) + +(defvar helm-source-etags-select nil + "Helm source for Etags.") + +(defun helm-etags-build-source () + (helm-build-in-buffer-source "Etags" + :header-name 'helm-etags-get-header-name + :init 'helm-etags-init + :get-line 'buffer-substring + :match-part (lambda (candidate) + ;; Match only the tag part of CANDIDATE + ;; and not the filename. + (cl-case helm-etags-match-part-only + (tag (cl-caddr (helm-grep-split-line candidate))) + (t candidate))) + :fuzzy-match helm-etags-fuzzy-match + :help-message 'helm-etags-help-message + :keymap helm-etags-map + :action '(("Go to tag" . (lambda (c) + (helm-etags-action-goto 'find-file c))) + ("Go to tag in other window" . (lambda (c) + (helm-etags-action-goto + 'find-file-other-window + c))) + ("Go to tag in other frame" . (lambda (c) + (helm-etags-action-goto + 'find-file-other-frame + c)))) + :persistent-help "Go to line" + :persistent-action (lambda (candidate) + (helm-etags-action-goto 'find-file candidate) + (helm-highlight-current-line)))) + +(defcustom helm-etags-fuzzy-match nil + "Use fuzzy matching in `helm-etags-select'." + :group 'helm-tags + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-etags-select + (helm-etags-build-source)))) + +(defvar find-tag-marker-ring) + +(defun helm-etags-action-goto (switcher candidate) + "Helm default action to jump to an etags entry in other window." + (require 'etags) + (helm-log-run-hook 'helm-goto-line-before-hook) + (let* ((split (helm-grep-split-line candidate)) + (fname (cl-loop for tagf being the hash-keys of helm-etags-cache + for f = (expand-file-name + (car split) (file-name-directory tagf)) + when (file-exists-p f) + return f)) + (elm (cl-caddr split)) + (linum (string-to-number (cadr split)))) + (if (null fname) + (error "file %s not found" fname) + (ring-insert find-tag-marker-ring (point-marker)) + (funcall switcher fname) + (helm-goto-line linum t) + (when (search-forward elm nil t) + (goto-char (match-beginning 0)))))) + +(defun helm-etags-mtime (file) + "Last modification time of etags tag FILE." + (cadr (nth 5 (file-attributes file)))) + +(defun helm-etags-file-modified-p (file) + "Check if tag FILE have been modified in this session. +If FILE is nil return nil." + (let ((last-modif (and file + (assoc-default file helm-etags-mtime-alist)))) + (and last-modif + (/= last-modif (helm-etags-mtime file))))) + +;;;###autoload +(defun helm-etags-select (reinit) + "Preconfigured helm for etags. +If called with a prefix argument REINIT +or if any of the tag files have been modified, reinitialize cache. + +This function aggregates three sources of tag files: + + 1) An automatically located file in the parent directories, + by `helm-etags-get-tag-file'. + 2) `tags-file-name', which is commonly set by `find-tag' command. + 3) `tags-table-list' which is commonly set by `visit-tags-table' command." + (interactive "P") + (let ((tag-files (helm-etags-all-tag-files)) + (helm-execute-action-at-once-if-one + helm-etags-execute-action-at-once-if-one) + (str (if (region-active-p) + (buffer-substring-no-properties + (region-beginning) (region-end)) + ;; Use a raw syntax-table to determine tap. + ;; This may be wrong when calling etags + ;; with hff from a buffer that use + ;; a different syntax, but most of the time it + ;; should be better. + (with-syntax-table (standard-syntax-table) + (thing-at-point 'symbol))))) + (if (cl-notany 'file-exists-p tag-files) + (message "Error: No tag file found.\ +Create with etags shell command, or visit with `find-tag' or `visit-tags-table'.") + (cl-loop for k being the hash-keys of helm-etags-cache + unless (member k tag-files) + do (remhash k helm-etags-cache)) + (mapc (lambda (f) + (when (or (equal reinit '(4)) + (and helm-etags-mtime-alist + (helm-etags-file-modified-p f))) + (remhash f helm-etags-cache))) + tag-files) + (unless helm-source-etags-select + (setq helm-source-etags-select + (helm-etags-build-source))) + (helm :sources 'helm-source-etags-select + :keymap helm-etags-map + :default (if helm-etags-fuzzy-match + str + (list (concat "\\_<" str "\\_>") str)) + :buffer "*helm etags*")))) + +(provide 'helm-tags) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-tags.el ends here diff --git a/helm-types.el b/helm-types.el new file mode 100644 index 00000000..03146719 --- /dev/null +++ b/helm-types.el @@ -0,0 +1,283 @@ +;;; helm-types.el --- Helm types classes and methods. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 ~ 2016 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; 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 'eieio) + + +;; Files +(defclass helm-type-file (helm-source) () + "A class to define helm type file.") + +(defmethod helm-source-get-action-from-type ((object helm-type-file)) + (slot-value object 'action)) + +(defun helm-actions-from-type-file () + (let ((source (make-instance 'helm-type-file))) + (helm--setup-source source) + (helm-source-get-action-from-type source))) + +(defcustom helm-type-file-actions + (helm-make-actions + "Find file" 'helm-find-many-files + "Find file as root" 'helm-find-file-as-root + "Find file other window" 'helm-find-files-other-window + "Find file other frame" 'find-file-other-frame + "Open dired in file's directory" 'helm-open-dired + "Grep File(s) `C-u recurse'" 'helm-find-files-grep + "Zgrep File(s) `C-u Recurse'" 'helm-ff-zgrep + "Pdfgrep File(s)" 'helm-ff-pdfgrep + "Insert as org link" 'helm-files-insert-as-org-link + "Checksum File" 'helm-ff-checksum + "Ediff File" 'helm-find-files-ediff-files + "Ediff Merge File" 'helm-find-files-ediff-merge-files + "Etags `M-., C-u reload tag file'" 'helm-ff-etags-select + "View file" 'view-file + "Insert file" 'insert-file + "Add marked files to file-cache" 'helm-ff-cache-add-file + "Delete file(s)" 'helm-delete-marked-files + "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy + "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename + "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink + "Relsymlink file(s) `C-u to follow'" 'helm-find-files-relsymlink + "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink + "Open file externally (C-u to choose)" 'helm-open-file-externally + "Open file with default tool" 'helm-open-file-with-default-tool + "Find file in hex dump" 'hexl-find-file) + "Default actions for type files." + :group 'helm-files + :type '(alist :key-type string :value-type function)) + +(defmethod helm--setup-source :primary ((_source helm-type-file))) + +(defmethod helm--setup-source :before ((source helm-type-file)) + (setf (slot-value source 'action) 'helm-type-file-actions) + (setf (slot-value source 'persistent-help) "Show this file") + (setf (slot-value source 'action-transformer) + '(helm-transform-file-load-el + helm-transform-file-browse-url + helm-transform-file-cache)) + (setf (slot-value source 'candidate-transformer) + '(helm-skip-boring-files + helm-highlight-files + helm-w32-pathname-transformer)) + (setf (slot-value source 'help-message) 'helm-generic-file-help-message) + (setf (slot-value source 'mode-line) (list "File(s)" helm-mode-line-string)) + (setf (slot-value source 'keymap) helm-generic-files-map)) + + +;; Bookmarks +(defclass helm-type-bookmark (helm-source) () + "A class to define type bookmarks.") + +(defcustom helm-type-bookmark-actions + (helm-make-actions + "Jump to bookmark" 'helm-bookmark-jump + "Jump to BM other window" 'helm-bookmark-jump-other-window + "Bookmark edit annotation" 'bookmark-edit-annotation + "Bookmark show annotation" 'bookmark-show-annotation + "Delete bookmark(s)" 'helm-delete-marked-bookmarks + "Edit Bookmark" 'helm-bookmark-edit-bookmark + "Rename bookmark" 'helm-bookmark-rename + "Relocate bookmark" 'bookmark-relocate) + "Default actions for type bookmarks." + :group 'helm-bookmark + :type '(alist :key-type string + :value-type function)) + +(defmethod helm-source-get-action-from-type ((object helm-type-bookmark)) + (slot-value object 'action)) + +(defmethod helm--setup-source :primary ((_source helm-type-bookmark))) + +(defmethod helm--setup-source :before ((source helm-type-bookmark)) + (setf (slot-value source 'action) 'helm-type-bookmark-actions) + (setf (slot-value source 'keymap) helm-bookmark-map) + (setf (slot-value source 'mode-line) (list "Bookmark(s)" helm-mode-line-string)) + (setf (slot-value source 'help-message) 'helm-bookmark-help-message) + (setf (slot-value source 'migemo) t) + (setf (slot-value source 'follow) 'never)) + + +;; Buffers +(defclass helm-type-buffer (helm-source) () + "A class to define type buffer.") + +(defcustom helm-type-buffer-actions + (helm-make-actions + "Switch to buffer(s)" 'helm-switch-to-buffers + (lambda () (and (locate-library "popwin") + "Switch to buffer in popup window")) + 'popwin:popup-buffer + "Switch to buffer(s) other window `C-c o'" + 'helm-switch-to-buffers-other-window + "Switch to buffer other frame `C-c C-o'" + 'switch-to-buffer-other-frame + (lambda () (and (locate-library "elscreen") + "Display buffer in Elscreen")) + 'helm-find-buffer-on-elscreen + "Browse project from buffer" + 'helm-buffers-browse-project + "Query replace regexp `C-M-%'" + 'helm-buffer-query-replace-regexp + "Query replace `M-%'" 'helm-buffer-query-replace + "View buffer" 'view-buffer + "Display buffer" 'display-buffer + "Grep buffers `M-g s' (C-u grep all buffers)" + 'helm-zgrep-buffers + "Multi occur buffer(s) `C-s'" 'helm-multi-occur-as-action + "Revert buffer(s) `M-U'" 'helm-revert-marked-buffers + "Insert buffer" 'insert-buffer + "Kill buffer(s) `M-D'" 'helm-kill-marked-buffers + "Diff with file `C-='" 'diff-buffer-with-file + "Ediff Marked buffers `C-c ='" 'helm-ediff-marked-buffers + "Ediff Merge marked buffers `M-='" + (lambda (candidate) + (helm-ediff-marked-buffers candidate t))) + "Default actions for type buffers." + :group 'helm-buffers + :type '(alist :key-type string :value-type function)) + +(defmethod helm-source-get-action-from-type ((object helm-type-buffer)) + (slot-value object 'action)) + +(defmethod helm--setup-source :primary ((_source helm-type-buffer))) + +(defmethod helm--setup-source :before ((source helm-type-buffer)) + (setf (slot-value source 'action) 'helm-type-buffer-actions) + (setf (slot-value source 'persistent-help) "Show this buffer") + (setf (slot-value source 'mode-line) (list "Buffer(s)" helm-mode-line-string)) + (setf (slot-value source 'filtered-candidate-transformer) + '(helm-skip-boring-buffers + helm-buffers-sort-transformer + helm-highlight-buffers))) + +;; Functions +(defclass helm-type-function (helm-source) () + "A class to define helm type function.") + +(defcustom helm-type-function-actions + (helm-make-actions + "Describe command" 'describe-function + "Add command to kill ring" 'helm-kill-new + "Go to command's definition" 'find-function + "Debug on entry" 'debug-on-entry + "Cancel debug on entry" 'cancel-debug-on-entry + "Trace function" 'trace-function + "Trace function (background)" 'trace-function-background + "Untrace function" 'untrace-function) + "Default actions for type functions." + :group 'helm-elisp + :type '(alist :key-type string :value-type function)) + +(defmethod helm-source-get-action-from-type ((object helm-type-function)) + (slot-value object 'action)) + +(defun helm-actions-from-type-function () + (let ((source (make-instance 'helm-type-function))) + (helm--setup-source source) + (helm-source-get-action-from-type source))) + +(defmethod helm--setup-source :primary ((_source helm-type-function))) + +(defmethod helm--setup-source :before ((source helm-type-function)) + (setf (slot-value source 'action) 'helm-type-function-actions) + (setf (slot-value source 'action-transformer) + 'helm-transform-function-call-interactively) + (setf (slot-value source 'candidate-transformer) + 'helm-mark-interactive-functions) + (setf (slot-value source 'coerce) 'helm-symbolify)) + + +;; Commands +(defclass helm-type-command (helm-source) () + "A class to define helm type command.") + +(defun helm-actions-from-type-command () + (let ((source (make-instance 'helm-type-command))) + (helm--setup-source source) + (helm-source-get-action-from-type source))) + +(defcustom helm-type-command-actions + (append (helm-make-actions + "Call interactively" 'helm-call-interactively) + (helm-actions-from-type-function)) + "Default actions for type command." + :group 'helm-command + :type '(alist :key-type string :value-type function)) + +(defmethod helm--setup-source :primary ((_source helm-type-command))) + +(defmethod helm--setup-source :before ((source helm-type-command)) + (setf (slot-value source 'action) 'helm-type-command-actions) + (setf (slot-value source 'coerce) 'helm-symbolify) + (setf (slot-value source 'persistent-action) 'describe-function)) + +;; Timers +(defclass helm-type-timers (helm-source) () + "A class to define helm type timers.") + +(defcustom helm-type-timers-actions + '(("Cancel Timer" . (lambda (_timer) + (let ((mkd (helm-marked-candidates))) + (cl-loop for timer in mkd + do (cancel-timer timer))))) + ("Describe Function" . (lambda (tm) + (describe-function (timer--function tm)))) + ("Find Function" . (lambda (tm) + (helm-aif (timer--function tm) + (if (byte-code-function-p it) + (message "Can't find anonymous function `%s'" it) + (find-function it)))))) + "Default actions for type timers." + :group 'helm-elisp + :type '(alist :key-type string :value-type function)) + +(defmethod helm--setup-source :primary ((_source helm-type-timers))) + +(defmethod helm--setup-source :before ((source helm-type-timers)) + (setf (slot-value source 'action) 'helm-type-timers-actions) + (setf (slot-value source 'persistent-action) + (lambda (tm) + (describe-function (timer--function tm)))) + (setf (slot-value source 'persistent-help) "Describe Function")) + +;; Builders. +(defun helm-build-type-file () + (helm-make-type 'helm-type-file)) + +(defun helm-build-type-function () + (helm-make-type 'helm-type-function)) + +(defun helm-build-type-command () + (helm-make-type 'helm-type-command)) + +(provide 'helm-types) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-types.el ends here diff --git a/helm-utils.el b/helm-utils.el new file mode 100644 index 00000000..63bcdb8f --- /dev/null +++ b/helm-utils.el @@ -0,0 +1,803 @@ +;;; helm-utils.el --- Utilities Functions for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2016 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 'compile) ; Fixme: Is this needed? +(require 'dired) + +(declare-function helm-find-files-1 "helm-files.el" (fname &optional preselect)) +(declare-function popup-tip "ext:popup") +(defvar winner-boring-buffers) + + +(defgroup helm-utils nil + "Utilities routines for Helm." + :group 'helm) + +(defcustom helm-su-or-sudo "sudo" + "What command to use for root access." + :type 'string + :group 'helm-utils) + +(defcustom helm-default-kbsize 1024.0 + "Default Kbsize to use for showing files size. +It is a float, usually 1024.0 but could be 1000.0 on some systems." + :group 'helm-utils + :type 'float) + +(define-obsolete-variable-alias + 'helm-highlight-number-lines-around-point + 'helm-highlight-matches-around-point-max-lines + "20160119") + +(defcustom helm-highlight-matches-around-point-max-lines 15 + "Number of lines around point where matched items are highlighted." + :group 'helm-utils + :type 'integer) + +(defcustom helm-buffers-to-resize-on-pa nil + "A list of helm buffers where the helm-window should be reduced on persistent actions." + :group 'helm-utils + :type '(repeat (choice string))) + +(defcustom helm-resize-on-pa-text-height 12 + "The size of the helm-window when resizing on persistent action." + :group 'helm-utils + :type 'integer) + +(defcustom helm-sources-using-help-echo-popup '("Moccur" "Imenu in all buffers" + "Ack-Grep" "AG" "Gid" "Git-Grep") + "Show the buffer name or the filename in a popup at selection." + :group 'helm-utils + :type '(repeat (choice string))) + +(defcustom helm-html-decode-entities-function #'helm-html-decode-entities-string + "Function used to decode html entities in html bookmarks. +Helm comes by default with `helm-html-decode-entities-string', if you need something +more sophisticated you can use `w3m-decode-entities-string' if available. + +In emacs itself org-entities seems broken and `xml-substitute-numeric-entities' +supports only numeric entities." + :group 'helm-utils + :type 'function) + + +(defvar helm-goto-line-before-hook '(helm-save-current-pos-to-mark-ring) + "Run before jumping to line. +This hook run when jumping from `helm-goto-line', `helm-etags-default-action', +and `helm-imenu-default-action'. +This allow you to retrieve a previous position after using the different helm +tools for searching (etags, grep, gid, (m)occur etc...). +By default positions are added to `mark-ring' you can also add to register +by using instead (or adding) `helm-save-pos-to-register-before-jump'. +In this case last position is added to the register +`helm-save-pos-before-jump-register'.") + +(defvar helm-save-pos-before-jump-register ?_ + "The register where `helm-save-pos-to-register-before-jump' save position.") + +(defconst helm-html-entities-alist + '((""" . 34) ;; " + (">" . 62) ;; > + ("<" . 60) ;; < + ("&" . 38) ;; & + ("€" . 8364) ;; € + ("Ÿ" . 89) ;; Y + ("¡" . 161) ;; ¡ + ("¢" . 162) ;; ¢ + ("£" . 163) ;; £ + ("¤" . 164) ;; ¤ + ("¥" . 165) ;; ¥ + ("¦" . 166) ;; ¦ + ("§" . 167) ;; § + ("¨" . 32) ;; SPC + ("©" . 169) ;; © + ("ª" . 97) ;; a + ("«" . 171) ;; « + ("¬" . 172) ;; ¬ + ("&masr;" . 174) ;; ® + ("°" . 176) ;; ° + ("±" . 177) ;; ± + ("²" . 50) ;; 2 + ("³" . 51) ;; 3 + ("´" . 39) ;; ' + ("µ" . 956) ;; μ + ("¶" . 182) ;; ¶ + ("·" . 183) ;; · + ("¸" . 32) ;; SPC + ("¹" . 49) ;; 1 + ("º" . 111) ;; o + ("»" . 187) ;; » + ("¼" . 49) ;; 1 + ("½" . 49) ;; 1 + ("¾" . 51) ;; 3 + ("¿" . 191) ;; ¿ + ("À" . 192) ;; À + ("Á" . 193) ;; Á + ("Â" . 194) ;; Â + ("Ã" . 195) ;; Ã + ("Ä" . 196) ;; Ä + ("Å" . 197) ;; Å + ("&Aelig" . 198) ;; Æ + ("Ç" . 199) ;; Ç + ("È" . 200) ;; È + ("É" . 201) ;; É + ("Ê" . 202) ;; Ê + ("Ë" . 203) ;; Ë + ("Ì" . 204) ;; Ì + ("Í" . 205) ;; Í + ("Î" . 206) ;; Î + ("Ï" . 207) ;; Ï + ("ð" . 208) ;; Ð + ("Ñ" . 209) ;; Ñ + ("Ò" . 210) ;; Ò + ("Ó" . 211) ;; Ó + ("Ô" . 212) ;; Ô + ("Õ" . 213) ;; Õ + ("Ö" . 214) ;; Ö + ("×" . 215) ;; × + ("Ø" . 216) ;; Ø + ("Ù" . 217) ;; Ù + ("Ú" . 218) ;; Ú + ("Û" . 219) ;; Û + ("Ü" . 220) ;; Ü + ("Ý" . 221) ;; Ý + ("þ" . 222) ;; Þ + ("ß" . 223) ;; ß + ("à" . 224) ;; à + ("á" . 225) ;; á + ("â" . 226) ;; â + ("ã" . 227) ;; ã + ("ä" . 228) ;; ä + ("å" . 229) ;; å + ("æ" . 230) ;; æ + ("ç" . 231) ;; ç + ("è" . 232) ;; è + ("é" . 233) ;; é + ("ê" . 234) ;; ê + ("ë" . 235) ;; ë + ("ì" . 236) ;; ì + ("í" . 237) ;; í + ("î" . 238) ;; î + ("ï" . 239) ;; ï + ("ð" . 240) ;; ð + ("ñ" . 241) ;; ñ + ("ò" . 242) ;; ò + ("ó" . 243) ;; ó + ("ô" . 244) ;; ô + ("õ" . 245) ;; õ + ("ö" . 246) ;; ö + ("÷" . 247) ;; ÷ + ("ø" . 248) ;; ø + ("ù" . 249) ;; ù + ("ú" . 250) ;; ú + ("û" . 251) ;; û + ("ü" . 252) ;; ü + ("ý" . 253) ;; ý + ("þ" . 254) ;; þ + ("ÿ" . 255) ;; ÿ + ("®" . 174) ;; ® + ("­" . 173)) ;; ­ + + "Table of html character entities and values.") + +;;; Faces. +;; +(defface helm-selection-line + '((t (:inherit highlight :distant-foreground "black"))) + "Face used in the `helm-current-buffer' when jumping to candidate." + :group 'helm-faces) + +(defface helm-match-item + '((t (:inherit isearch))) + "Face used to highlight item matched in a selected line." + :group 'helm-faces) + + +;;; Utils functions +;; +;; +(defun helm-switch-to-buffers (buffer-or-name &optional other-window) + "Switch to buffer BUFFER-OR-NAME. +If more than one buffer marked switch to these buffers in separate windows. +If OTHER-WINDOW is specified keep current-buffer and switch to others buffers +in separate windows." + (let* ((mkds (helm-marked-candidates)) + (size (/ (window-height) (length mkds)))) + (or (<= window-min-height size) + (error "Too many buffers to visit simultaneously.")) + (helm-aif (cdr mkds) + (progn + (if other-window + (switch-to-buffer-other-window (car mkds)) + (switch-to-buffer (car mkds))) + (save-selected-window + (cl-loop for b in it + do (progn + (select-window (split-window)) + (switch-to-buffer b))))) + (if other-window + (switch-to-buffer-other-window buffer-or-name) + (switch-to-buffer buffer-or-name))))) + +(defun helm-switch-to-buffers-other-window (buffer-or-name) + "switch to buffer BUFFER-OR-NAME in other window. +See `helm-switch-to-buffers' for switching to marked buffers." + (helm-switch-to-buffers buffer-or-name t)) + +(cl-defun helm-current-buffer-narrowed-p (&optional + (buffer helm-current-buffer)) + "Check if BUFFER is narrowed. +Default is `helm-current-buffer'." + (with-current-buffer buffer + (let ((beg (point-min)) + (end (point-max)) + (total (buffer-size))) + (or (/= beg 1) (/= end (1+ total)))))) + +(defun helm-goto-char (loc) + "Go to char, revealing if necessary." + (goto-char loc) + (when (or (eq major-mode 'org-mode) + (and (boundp 'outline-minor-mode) + outline-minor-mode)) + (require 'org) ; On some old Emacs versions org may not be loaded. + (org-reveal))) + +(defun helm-goto-line (lineno &optional noanim) + "Goto LINENO opening only outline headline if needed. +Animation is used unless NOANIM is non--nil." + (helm-log-run-hook 'helm-goto-line-before-hook) + (helm-match-line-cleanup) + (goto-char (point-min)) + (helm-goto-char (point-at-bol lineno)) + (unless noanim + (helm-highlight-current-line))) + +(defun helm-save-pos-to-register-before-jump () + "Save current buffer position to `helm-save-pos-before-jump-register'. +To use this add it to `helm-goto-line-before-hook'." + (with-helm-current-buffer + (unless helm-in-persistent-action + (point-to-register helm-save-pos-before-jump-register)))) + +(defun helm-save-current-pos-to-mark-ring () + "Save current buffer position to mark ring. +To use this add it to `helm-goto-line-before-hook'." + (with-helm-current-buffer + (unless helm-in-persistent-action + (set-marker (mark-marker) (point)) + (push-mark (point) 'nomsg)))) + +(defun helm-show-all-in-this-source-only (arg) + "Show only current source of this helm session with all its candidates. +With a numeric prefix arg show only the ARG number of candidates." + (interactive "p") + (with-helm-alive-p + (with-helm-window + (with-helm-default-directory (helm-default-directory) + (let ((helm-candidate-number-limit (and (> arg 1) arg))) + (helm-set-source-filter + (list (assoc-default 'name (helm-get-current-source))))))))) +(put 'helm-show-all-in-this-source-only '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-displaying-source-names () + "Return the list of sources name for this helm session." + (with-current-buffer helm-buffer + (goto-char (point-min)) + (cl-loop with pos + while (setq pos (next-single-property-change (point) 'helm-header)) + do (goto-char pos) + collect (buffer-substring-no-properties (point-at-bol)(point-at-eol)) + do (forward-line 1)))) + +(defun helm-handle-winner-boring-buffers () + "Add `helm-buffer' to `winner-boring-buffers' when quitting/exiting helm. +Add this function to `helm-cleanup-hook' when you don't want to see helm buffers +after running winner-undo/redo." + (require 'winner) + (cl-pushnew helm-buffer winner-boring-buffers :test 'equal)) +(add-hook 'helm-cleanup-hook #'helm-handle-winner-boring-buffers) + +(defun helm-quit-and-find-file () + "Drop into `helm-find-files' from `helm'. +If current selection is a buffer or a file, `helm-find-files' +from its directory." + (interactive) + (with-helm-alive-p + (require 'helm-grep) + (helm-run-after-exit + (lambda (f) + ;; Ensure specifics `helm-execute-action-at-once-if-one' + ;; fns don't run here. + (let (helm-execute-action-at-once-if-one) + (if (file-exists-p f) + (helm-find-files-1 (file-name-directory f) + (concat + "^" + (regexp-quote + (if helm-ff-transformer-show-only-basename + (helm-basename f) f)))) + (helm-find-files-1 f)))) + (let* ((sel (helm-get-selection)) + (marker (if (consp sel) (markerp (cdr sel)))) + (grep-line (and (stringp sel) + (helm-grep-split-line sel))) + (bmk-name (and (stringp sel) + (not grep-line) + (replace-regexp-in-string "\\`\\*" "" sel))) + (bmk (and bmk-name (assoc bmk-name bookmark-alist))) + (buf (helm-aif (and (bufferp sel) (get-buffer sel)) + (buffer-name it))) + (default-preselection (or (buffer-file-name helm-current-buffer) + default-directory))) + (cond + ;; Buffer. + (buf (or (buffer-file-name sel) + (car (rassoc buf dired-buffers)) + (and (with-current-buffer buf + (eq major-mode 'org-agenda-mode)) + org-directory + (expand-file-name org-directory)) + (with-current-buffer buf default-directory))) + ;; imenu (marker). + (marker + (or (buffer-file-name (marker-buffer (cdr sel))) + default-preselection)) + ;; Bookmark. + (bmk (helm-aif (bookmark-get-filename bmk) + (if (and ffap-url-regexp + (string-match ffap-url-regexp it)) + it (expand-file-name it)) + default-directory)) + ((and (stringp sel) (or (file-remote-p sel) + (file-exists-p sel))) + (expand-file-name sel)) + ;; Grep. + ((and grep-line (file-exists-p (car grep-line))) + (expand-file-name (car grep-line))) + ;; Occur. + (grep-line + (with-current-buffer (get-buffer (car grep-line)) + (or (buffer-file-name) default-directory))) + ;; Url. + ((and (stringp sel) ffap-url-regexp (string-match ffap-url-regexp sel)) sel) + ;; Default. + (t default-preselection)))))) +(put 'helm-quit-and-find-file 'helm-only t) + +(defun helm-generic-sort-fn (s1 s2) + "Sort predicate function for helm candidates. +Args S1 and S2 can be single or \(display . real\) candidates, +that is sorting is done against real value of candidate." + (let* ((qpattern (regexp-quote helm-pattern)) + (reg1 (concat "\\_<" qpattern "\\_>")) + (reg2 (concat "\\_<" qpattern)) + (reg3 helm-pattern) + (split (split-string helm-pattern)) + (str1 (if (consp s1) (cdr s1) s1)) + (str2 (if (consp s2) (cdr s2) s2)) + (score (lambda (str r1 r2 r3 lst) + (+ (if (string-match (concat "\\`" qpattern) str) 1 0) + (cond ((string-match r1 str) 5) + ((and (string-match " " qpattern) + (string-match + (concat "\\_<" (regexp-quote (car lst))) str) + (cl-loop for r in (cdr lst) + always (string-match r str))) 4) + ((and (string-match " " qpattern) + (cl-loop for r in lst + always (string-match r str))) 3) + ((string-match r2 str) 2) + ((string-match r3 str) 1) + (t 0))))) + (sc1 (funcall score str1 reg1 reg2 reg3 split)) + (sc2 (funcall score str2 reg1 reg2 reg3 split))) + (cond ((or (zerop (string-width qpattern)) + (and (zerop sc1) (zerop sc2))) + (string-lessp str1 str2)) + ((= sc1 sc2) + (< (length str1) (length str2))) + (t (> sc1 sc2))))) + +(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." + (let* ((str (helm-basename fname)) + (split (split-string str ":" t)) + (meth (car (member (car split) + (helm-ff-get-tramp-methods))))) + (when meth (car (last split))))) + +(cl-defun helm-file-human-size (size &optional (kbsize helm-default-kbsize)) + "Return a string showing SIZE of a file in human readable form. +SIZE can be an integer or a float depending it's value. +`file-attributes' will take care of that to avoid overflow error. +KBSIZE is a floating point number, defaulting to `helm-default-kbsize'." + (cl-loop with result = (cons "B" size) + for i in '("k" "M" "G" "T" "P" "E" "Z" "Y") + while (>= (cdr result) kbsize) + do (setq result (cons i (/ (cdr result) kbsize))) + finally return + (pcase (car result) + (`"B" (format "%s" size)) + (suffix (format "%.1f%s" (cdr result) suffix))))) + +(cl-defun helm-file-attributes + (file &key type links uid gid access-time modif-time + status size mode gid-change inode device-num dired human-size + mode-type mode-owner mode-group mode-other (string t)) + "Return `file-attributes' elements of FILE separately according to key value. +Availables keys are: +- TYPE: Same as nth 0 `files-attributes' if STRING is nil + otherwise return either symlink, directory or file (default). +- LINKS: See nth 1 `files-attributes'. +- UID: See nth 2 `files-attributes'. +- GID: See nth 3 `files-attributes'. +- ACCESS-TIME: See nth 4 `files-attributes', however format time + when STRING is non--nil (the default). +- MODIF-TIME: See nth 5 `files-attributes', same as above. +- STATUS: See nth 6 `files-attributes', same as above. +- SIZE: See nth 7 `files-attributes'. +- MODE: See nth 8 `files-attributes'. +- GID-CHANGE: See nth 9 `files-attributes'. +- INODE: See nth 10 `files-attributes'. +- DEVICE-NUM: See nth 11 `files-attributes'. +- DIRED: A line similar to what 'ls -l' return. +- HUMAN-SIZE: The size in human form, see `helm-file-human-size'. +- MODE-TYPE, mode-owner,mode-group, mode-other: Split what + nth 7 `files-attributes' return in four categories. +- STRING: When non--nil (default) `helm-file-attributes' return + more friendly values. +If you want the same behavior as `files-attributes' , +\(but with return values in proplist\) use a nil value for STRING. +However when STRING is non--nil, time and type value are different from what +you have in `file-attributes'." + (let* ((all (cl-destructuring-bind + (type links uid gid access-time modif-time + status size mode gid-change inode device-num) + (file-attributes file string) + (list :type (if string + (cond ((stringp type) "symlink") ; fname + (type "directory") ; t + (t "file")) ; nil + type) + :links links + :uid uid + :gid gid + :access-time (if string + (format-time-string + "%Y-%m-%d %R" access-time) + access-time) + :modif-time (if string + (format-time-string + "%Y-%m-%d %R" modif-time) + modif-time) + :status (if string + (format-time-string + "%Y-%m-%d %R" status) + status) + :size size + :mode mode + :gid-change gid-change + :inode inode + :device-num device-num))) + (modes (helm-split-mode-file-attributes (cl-getf all :mode)))) + (cond (type (cl-getf all :type)) + (links (cl-getf all :links)) + (uid (cl-getf all :uid)) + (gid (cl-getf all :gid)) + (access-time (cl-getf all :access-time)) + (modif-time (cl-getf all :modif-time)) + (status (cl-getf all :status)) + (size (cl-getf all :size)) + (mode (cl-getf all :mode)) + (gid-change (cl-getf all :gid-change)) + (inode (cl-getf all :inode)) + (device-num (cl-getf all :device-num)) + (dired (concat + (helm-split-mode-file-attributes + (cl-getf all :mode) t) " " + (number-to-string (cl-getf all :links)) " " + (cl-getf all :uid) ":" + (cl-getf all :gid) " " + (if human-size + (helm-file-human-size (cl-getf all :size)) + (int-to-string (cl-getf all :size))) " " + (cl-getf all :modif-time))) + (human-size (helm-file-human-size (cl-getf all :size))) + (mode-type (cl-getf modes :mode-type)) + (mode-owner (cl-getf modes :user)) + (mode-group (cl-getf modes :group)) + (mode-other (cl-getf modes :other)) + (t (append all modes))))) + +(defun helm-split-mode-file-attributes (str &optional string) + "Split mode file attributes STR into a proplist. +If STRING is non--nil return instead a space separated string." + (cl-loop with type = (substring str 0 1) + with cdr = (substring str 1) + for i across cdr + for count from 1 + if (<= count 3) + concat (string i) into user + if (and (> count 3) (<= count 6)) + concat (string i) into group + if (and (> count 6) (<= count 9)) + concat (string i) into other + finally return + (if string + (mapconcat 'identity (list type user group other) " ") + (list :mode-type type :user user :group group :other other)))) + +(defmacro with-helm-display-marked-candidates (buffer-or-name candidates &rest body) + (declare (indent 0) (debug t)) + (helm-with-gensyms (buffer window) + `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name)) + (helm-always-two-windows t) + (helm-split-window-default-side + (if (eq helm-split-window-default-side 'same) + 'below helm-split-window-default-side)) + helm-split-window-in-side-p + helm-reuse-last-window-split-state + ,window) + (with-current-buffer ,buffer + (dired-format-columns-of-files ,candidates)) + (unwind-protect + (with-selected-window + (setq ,window (temp-buffer-window-show + ,buffer + '(display-buffer-below-selected + (window-height . fit-window-to-buffer)))) + (progn ,@body)) + (quit-window 'kill ,window))))) + +;;; Persistent Action Helpers +;; +;; +;; Internal +(defvar helm-match-line-overlay nil) +(defvar helm--match-item-overlays nil) + +(defun helm-highlight-current-line (&optional start end buf face) + "Highlight and underline current position" + (let* ((start (or start (line-beginning-position))) + (end (or end (1+ (line-end-position)))) + (start-match (if (or (null helm-highlight-matches-around-point-max-lines) + (zerop helm-highlight-matches-around-point-max-lines)) + start + (save-excursion + (forward-line + (- helm-highlight-matches-around-point-max-lines)) + (point-at-bol)))) + (end-match (if (or (null helm-highlight-matches-around-point-max-lines) + (zerop helm-highlight-matches-around-point-max-lines)) + end + (save-excursion + (forward-line + helm-highlight-matches-around-point-max-lines) + (point-at-eol)))) + (args (list start end buf))) + (if (not helm-match-line-overlay) + (setq helm-match-line-overlay (apply 'make-overlay args)) + (apply 'move-overlay helm-match-line-overlay args)) + (overlay-put helm-match-line-overlay + 'face (or face 'helm-selection-line)) + (catch 'empty-line + (cl-loop with ov + for r in (helm-remove-if-match + "\\`!" (split-string helm-input)) + do (save-excursion + (goto-char start-match) + (while (condition-case _err + (if helm-migemo-mode + (helm-mm-migemo-forward r end-match t) + (re-search-forward r end-match t)) + (invalid-regexp nil)) + (let ((s (match-beginning 0)) + (e (match-end 0))) + (if (= s e) + (throw 'empty-line nil) + (push (setq ov (make-overlay s e)) + helm--match-item-overlays) + (overlay-put ov 'face 'helm-match-item) + (overlay-put ov 'priority 1))))))) + (recenter))) + +(defun helm-match-line-cleanup () + (when helm-match-line-overlay + (delete-overlay helm-match-line-overlay) + (setq helm-match-line-overlay nil)) + (when helm--match-item-overlays + (mapc 'delete-overlay helm--match-item-overlays))) + +(defun helm-match-line-update () + (when helm-match-line-overlay + (delete-overlay helm-match-line-overlay) + (helm-highlight-current-line))) + +(defun helm-persistent-autoresize-hook () + (when (and helm-buffers-to-resize-on-pa + (member helm-buffer helm-buffers-to-resize-on-pa) + (eq helm-split-window-state 'vertical)) + (set-window-text-height (helm-window) helm-resize-on-pa-text-height))) + +(defun helm-match-line-cleanup-pulse () + (run-with-idle-timer 0.3 nil #'helm-match-line-cleanup)) + +(add-hook 'helm-after-persistent-action-hook 'helm-persistent-autoresize-hook) +(add-hook 'helm-cleanup-hook 'helm-match-line-cleanup) +(add-hook 'helm-after-action-hook 'helm-match-line-cleanup-pulse) +(add-hook 'helm-after-persistent-action-hook 'helm-match-line-update) + +;;; Popup buffer-name or filename in grep/moccur/imenu-all. +;; +(defvar helm--show-help-echo-timer nil) + +(defun helm-cancel-help-echo-timer () + (when helm--show-help-echo-timer + (cancel-timer helm--show-help-echo-timer) + (setq helm--show-help-echo-timer nil))) + +(defun helm-show-help-echo () + (when helm--show-help-echo-timer + (cancel-timer helm--show-help-echo-timer) + (setq helm--show-help-echo-timer nil)) + (when (and helm-alive-p + (member (assoc-default 'name (helm-get-current-source)) + helm-sources-using-help-echo-popup)) + (setq helm--show-help-echo-timer + (run-with-timer + 1 nil + (lambda () + (save-selected-window + (with-helm-window + (helm-aif (get-text-property (point-at-bol) 'help-echo) + (popup-tip (concat " " (abbreviate-file-name it)) + :around nil + :point (save-excursion + (end-of-visual-line) (point))))))))))) + +;;;###autoload +(define-minor-mode helm-popup-tip-mode + "Show help-echo informations in a popup tip at end of line." + :global t + (require 'popup) + (if helm-popup-tip-mode + (progn + (add-hook 'helm-after-update-hook 'helm-show-help-echo) ; Needed for async sources. + (add-hook 'helm-move-selection-after-hook 'helm-show-help-echo) + (add-hook 'helm-cleanup-hook 'helm-cancel-help-echo-timer)) + (remove-hook 'helm-after-update-hook 'helm-show-help-echo) + (remove-hook 'helm-move-selection-after-hook 'helm-show-help-echo) + (remove-hook 'helm-cleanup-hook 'helm-cancel-help-echo-timer))) + +(defun helm-open-file-with-default-tool (file) + "Open FILE with the default tool on this platform." + (let (process-connection-type) + (if (eq system-type 'windows-nt) + (helm-w32-shell-execute-open-file file) + (start-process "helm-open-file-with-default-tool" + nil + (cond ((eq system-type 'gnu/linux) + "xdg-open") + ((or (eq system-type 'darwin) ;; Mac OS X + (eq system-type 'macos)) ;; Mac OS 9 + "open")) + file)))) + +(defun helm-open-dired (file) + "Opens a dired buffer in FILE's directory. If FILE is a +directory, open this directory." + (if (file-directory-p file) + (dired file) + (dired (file-name-directory file)) + (dired-goto-file file))) + +(defun helm-require-or-error (feature function) + (or (require feature nil t) + (error "Need %s to use `%s'." feature function))) + +(defun helm-find-file-as-root (candidate) + (let* ((buf (helm-basename candidate)) + (host (file-remote-p candidate 'host)) + (remote-path (format "/%s:%s:%s" + helm-su-or-sudo + (or host "") + (expand-file-name + (if host + (file-remote-p candidate 'localname) + candidate)))) + non-essential) + (if (buffer-live-p (get-buffer buf)) + (progn + (set-buffer buf) + (find-alternate-file remote-path)) + (find-file remote-path)))) + +(defun helm-find-many-files (_ignore) + (let ((helm--reading-passwd-or-string t)) + (mapc 'find-file (helm-marked-candidates)))) + +(defun helm-read-repeat-string (prompt &optional count) + "Prompt as many time PROMPT is not empty. +If COUNT is non--nil add a number after each prompt." + (cl-loop with elm + while (not (string= elm "")) + for n from 1 + do (when count + (setq prompt (concat prompt (int-to-string n) ": "))) + collect (setq elm (helm-read-string prompt)) into lis + finally return (remove "" lis))) + +(defun helm-html-bookmarks-to-alist (file url-regexp bmk-regexp) + "Parse html bookmark FILE and return an alist with (title . url) as elements." + (let (bookmarks-alist url title) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward "href=\\|^ *

+;; 2011 ~ 2016 Thierry Volpiatto + +;; This is a fork of anything.el wrote by Tamas Patrovics. + +;; Authors of anything.el: Tamas Patrovics +;; rubikitch +;; Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; 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 'advice) ; Shutup byte compiler about ad-deactivate. +(require 'helm-lib) +(require 'helm-multi-match) +(require 'helm-source) + + +;;; 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 () + (message \"Run foo\")) + \(defun bar () + (message \"Run bar\")) + \(defun baz () + (message \"Run baz\")) + +\(helm-define-multi-key global-map \" 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)) + (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 (cl-gensym "helm-iter-key")) + (timeout delay)) + (eval (list 'defvar iter nil)) + (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) + (unless (and (symbol-value iterator) + ;; Reset iterator when another key is pressed. + (eq this-command real-last-command)) + (set iterator (helm-iter-list (funcall fn)))) + (setq next (helm-iter-next (symbol-value iterator))) + (unless next + (set iterator (helm-iter-list (funcall fn))) + (setq next (helm-iter-next (symbol-value iterator)))) + (and next (symbol-value iterator) (call-interactively (nth (1- next) functions))) + (when delay (run-with-idle-timer delay nil (lambda () + (setq 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 0.5s runs `helm-swap-windows'." + '(helm-toggle-resplit-window helm-swap-windows) 1) +(put 'helm-toggle-resplit-and-swap-windows 'helm-only t) + +;;;###autoload +(defun helm-define-key-with-subkeys (map key subkey command + &optional other-subkeys menu exit-fn) + "Defines 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\"'s run this command again +and subsequent \"p\"'s run `git-gutter:previous-hunk'. + +Arg MENU is a string displayed in minibuffer that +describes SUBKEY and OTHER-SUBKEYS. +Arg EXIT-FN specifies a function to run on exit. + +For any other keys pressed, run their assigned command as defined +in MAP and then exit the loop running EXIT-FN, if specified. + +NOTE: SUBKEY and OTHER-SUBKEYS bindings support char syntax only +\(e.g ?n), so don't use strings or vectors to define them." + (declare (indent 1)) + (define-key map key + (lambda () + (interactive) + (unwind-protect + (progn + (call-interactively command) + (while (let ((input (read-key menu)) other kb com) + (setq last-command-event input) + (cond + ((eq input subkey) + (call-interactively command) + t) + ((setq other (assoc input other-subkeys)) + (call-interactively (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))))) + (and exit-fn (funcall exit-fn)))))) + +;;; 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-previous-page) + (define-key map (kbd "C-v") 'helm-next-page) + (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-next-source) + (define-key map (kbd "") 'helm-previous-source) + (define-key map (kbd "") 'helm-maybe-exit-minibuffer) + (define-key map (kbd "C-i") 'helm-select-action) + (define-key map (kbd "C-z") 'helm-execute-persistent-action) + (define-key map (kbd "C-j") 'helm-execute-persistent-action) + (define-key map (kbd "C-o") 'helm-next-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) + (define-key map (kbd "M-SPC") 'helm-toggle-visible-mark) + (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 "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-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-M-a") 'helm-show-all-in-this-source-only) + (define-key map (kbd "C-M-e") 'helm-display-all-sources) + (define-key map (kbd "C-r") 'undefined) + (define-key map (kbd "C-s") 'undefined) + (define-key map (kbd "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 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-copy-to-buffer) + (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 "M-p") 'previous-history-element) + (define-key map (kbd "M-n") 'next-history-element) + (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) + ;; 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") 'undefined) + (define-key map (kbd "C-h C-d") 'helm-enable-or-switch-to-debug) + ;; 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) + ;; Use `describe-mode' key in `global-map'. + (cl-dolist (k (where-is-internal 'describe-mode global-map)) + (define-key map k 'helm-help)) + (define-key map (kbd "C-c ?") 'helm-help) + ;; Bind all actions from 1 to 12 to their corresponding nth index+1. + (cl-loop for n from 0 to 12 do + (define-key map (kbd (format "" (1+ n))) + `(lambda () + (interactive) + (helm-select-nth-action ,n)))) + ;; Bind keys to allow executing default action + ;; on first 9 candidates before and after selection. + (cl-loop for n from 1 to 9 + for key = (format "C-c %d" n) + for key- = (format "C-x %d" n) + for fn = `(lambda () + (interactive) + (helm-execute-selection-action-at-nth ,n)) + for fn- = `(lambda () + (interactive) + (helm-execute-selection-action-at-nth ,(- n))) + do (progn + (define-key map (kbd key) fn) + (define-key map (kbd key-) fn-))) + map) + "Keymap for helm.") + + +(defgroup helm nil + "Open helm." + :prefix "helm-" :group 'convenience) + +(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-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 100 + "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) + +(defcustom helm-full-frame nil + "Use current window for showing candidates. +If t, then Helm does not pop-up new window." + :group 'helm + :type 'boolean) + +(defvaralias 'helm-samewindow 'helm-full-frame) +(make-obsolete-variable 'helm-samewindow 'helm-full-frame "1.4.8.1") + +(defcustom helm-candidate-separator + "--------------------" + "Candidates separator of `multiline' source." + :group 'helm + :type 'string) + +(defcustom helm-save-configuration-functions + '(set-window-configuration . 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 . 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 to display *helm* buffer. +By default, it is `helm-default-display-buffer', which affects +`helm-full-frame'." + :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 rely 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-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 display +`helm-buffer' in current window and `other' that display +`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-in-side-p' and `helm-always-two-windows' that +take precedence over this. + +NOTE: this have 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 the responsibility for +re-sizing the window; function's return value is ignored. +Note that this have 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 the responsibility 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)) + +(defcustom helm-split-window-in-side-p nil + "Forces 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 nil + "When non-`nil' helm uses two windows in this frame. +To display `helm-buffer' in one window and `helm-current-buffer' +in the other. + +Note: this has no effect when `helm-split-window-in-side-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-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' delete region from `point'. +Otherwise delete `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 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 escape from minibuffer during the helm session." + :group 'helm + :type 'boolean) + +(defcustom helm-move-to-line-cycle-in-source nil + "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. +When nil, sorting is not done." + :group 'helm + :type 'function) + +(defcustom helm-fuzzy-matching-highlight-fn 'helm-fuzzy-default-highlight-match + "The function to highlight fuzzy matches. +When nil, no highlighting is done." + :group 'helm + :type 'function) + +(defcustom helm-autoresize-max-height 40 + "Specifies 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 + "Specifies 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." + :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 in header-line." + :group 'helm + :type 'boolean) + +(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-debug-root-directory nil + "When non-`nil', saves helm log messages to a file in this directory. +When `nil' log messages are saved to a buffer instead. +Log message are saved only when `helm-debug' is non-nil, so setting this +doesn't enable debugging by itself. + +See `helm-log-save-maybe' for more info." + :type 'string + :group 'helm) + + +;;; Faces +;; +;; +(defgroup helm-faces nil + "Customize the appearance of helm." + :prefix "helm-" + :group 'faces + :group 'helm) + +(defface helm-source-header + '((((background dark)) + :background "#22083397778B" + :foreground "white" + :weight bold :height 1.3 :family "Sans Serif") + (((background light)) + :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)) + (:background "green1" :foreground "black")) + (((background dark)) + (:background "green" :foreground "black")) + (((background light)) :background "#d1f5ea") + (((min-colors 88)) + (:background "green1")) + (t (:background "green"))) + "Face for visible mark." + :group 'helm-faces) + +(defface helm-header + '((t (:inherit header-line))) + "Face for header lines in the helm buffer." + :group 'helm-faces) + +(defface helm-candidate-number + '((((background dark)) :background "Yellow" :foreground "black") + (((background light)) :background "#faffb5" :foreground "black")) + "Face for candidate number in mode-line." :group 'helm-faces) + +(defface helm-selection + '((((background dark)) :background "ForestGreen" + :distant-foreground "black") + (((background light)) :background "#b5ffd1" + :distant-foreground "black")) + "Face for currently selected item in the helm buffer." + :group 'helm-faces) + +(defface helm-separator + '((((background dark)) :foreground "red") + (((background light)) :foreground "#ffbfb5")) + "Face for multiline source separator." + :group 'helm-faces) + +(defface helm-action + '((t (:underline t))) + "Face for action lines in the helm action buffer." + :group 'helm-faces) + +(defface helm-prefarg + '((((background dark)) :foreground "green") + (((background light)) :foreground "red")) + "Face for showing prefix arg in mode-line." + :group 'helm-faces) + +(defface helm-match + '((((background light)) :foreground "#b00000") + (((background dark)) :foreground "gold1")) + "Face used to highlight matches." + :group 'helm-faces) + +(defface helm-header-line-left-margin + '((t (:foreground "black" :background "yellow"))) + "Face used to highlight helm-header sign in left-margin." + :group 'helm-faces) + + +;;; 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. +See also `helm-set-source-filter'.") + +(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. +This is very similar to `helm-update-hook' except the selection +is not moved. Hook is useful for selecting a particular object +instead of the first one.") + +(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.") + +(defconst helm-restored-variables + '(helm-candidate-number-limit + helm-source-filter + helm-map + helm-sources) + "Variables restored after an `helm' invocation.") + +(defvar helm-execute-action-at-once-if-one nil + "When non--nil executes the default action and then exits 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', quits if there are no candidates. +This variable accepts a function.") + +(defvar helm-debug-variables nil + "A list of helm variables that `helm-debug-output' displays. +If `nil', `helm-debug-output' includes only variables with +`helm-' prefixes.") + +(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/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend" + "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', uses default `mode-line-format'.") + +(defvar helm-minibuffer-set-up-hook nil + "Hook that runs at minibuffer initialization. +A hook useful for modifying minibuffer settings in helm. + +An example that hides the minibuffer when using +`helm-echo-input-in-header-line': + + (add-hook 'helm-minibuffer-set-up-hook #'helm-hide-minibuffer-maybe) + +Note that we check `helm-echo-input-in-header-line' value +from `helm-buffer' which allow detecting possible local +value of this var.") + +(defvar helm-help-message + "* Helm Generic Help + +\\`helm' is an Emacs framework for incremental +completions and narrowing selections. + +Helm narrows the list of candidates as the pattern is typed and +updates the list in a live feedback. Helm accepts multiple +patterns (entered with a space between patterns). Helm uses +familiar Emacs navigation keys to move up and down the list. +`RET' selects the candidate from the list. + +** Helm Help + +C-h m\t\tShows this generic Helm help. + +** Helm's Basic Operations and Default Key Bindings + +| Key | Alternative Keys | Command | +|---------+------------------+-----------------------------------------------------------| +| C-p | Up | Previous Line | +| C-n | Down | Next Line | +| M-v | PageUp | Previous Page | +| C-v | PageDown | Next Page | +| Enter | | Execute first (default) action / Select | +| M-< | | First Line | +| M-> | | Last Line | +| C-M-S-v | M-PageUp, C-M-y | Previous Page (other-window) | +| C-M-v | M-PageDown | Next Page (other-window) | +| Tab | C-i | Show action list | +| Left | | Previous Source | +| Right | C-o | Next Source | +| C-k | | Delete pattern (with prefix arg delete from point to end) | +| C-j | C-z | Persistent Action (Execute and keep helm session) | + +** Shortcuts For nth Action + +f1-12: Execute nth Action where n is 1 to 12. + +** Shortcuts for executing Default Action on the nth candidate + +C-x => executes default action on number candidate before currently selected candidate. + +C-c => executes default action on number candidate after current selected candidate. + +n is limited only to 1 through 9. For larger jumps use other +navigation keys. Also note that Helm candidates list by default +do not display line numbers. Line numbers can be enabled with the +linum-relative package. + +** Marked candidates + +You can mark candidates to execute an action on them instead +of the current selected candidate only (See binding below). +Most Helm actions operate on marked candidates unless marking candidates +is prevented explicitely for a specific source. + +** Follow candidates + +You can execute automatically an action specified in the source as persistent-action +while moving up and down in helm-window or while updating the list of candidates by +turning on `helm-follow-mode' while in helm. +The follow behavior will be saved and used in next emacs sessions when `helm-follow-mode-persistent' +is non-nil. + +** Frequently Used Commands + +\\[helm-toggle-resplit-and-swap-windows]\t\tToggle vertical/horizontal split on first hit and swap helm window on second hit. +\\[helm-quit-and-find-file]\t\tDrop into `helm-find-files'. +\\[helm-kill-selection-and-quit]\t\tKill display value of candidate and quit (with prefix arg, kill the real value). +\\[helm-yank-selection]\t\tYank current selection into pattern. +\\[helm-follow-mode]\t\tToggle automatic execution of persistent action. +\\[helm-follow-action-forward]\tRun persistent action and then select next line. +\\[helm-follow-action-backward]\t\tRun persistent action and then select previous line. +\\[helm-refresh]\t\tRecalculate and redisplay candidates. +\\[helm-toggle-suspend-update]\t\tSuspend/reenable updates to candidates list. + +** Global Commands + +\\\\[helm-resume] revives the last `helm' session. +Very useful for resuming previous Helm. Binding a key to this +command will greatly improve `helm' interactivity especially +after an accidental exit. + +** Debugging helm + +helm have a special variable called `helm-debug', setting it to non-nil +will allow helm logging in a special outline-mode buffer. +Helm is resetting the variable to nil at end of each session. + +A convenient command is bound to \\\\[helm-enable-or-switch-to-debug] +and allow turning debugging to this session only. +To avoid accumulating log while you are typing your pattern, you can use +\\\\[helm-toggle-suspend-update] to turn off updating, then when you +are ready turn it on again to start updating. + +Once you exit your helm session you can access the debug buffer with `helm-debug-open-last-log'. +It is possible to save logs to dated files when `helm-debug-root-directory' +is set to a valid directory. + +NOTE: Be aware that helm log buffers grow really fast, so use `helm-debug' only when needed. + +** 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'. + + +;;; Internal Variables +;; +;; +(defvar helm-current-prefix-arg nil + "Record `current-prefix-arg' when exiting minibuffer.") +(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-compiled-sources nil + "Compiled version of `helm-sources'.") +(defvar helm-in-persistent-action nil + "Flag whether in persistent-action or not.") +(defvar helm-last-buffer nil + "`helm-buffer' of previously `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.") +(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-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-tick-hash (make-hash-table :test 'equal)) +(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) +(defvar helm-alive-p nil) +(defvar helm-visible-mark-overlays nil) +(defvar helm-update-blacklist-regexps '("^" "^ *" "$" "!" " " "\\b" + "\\<" "\\>" "\\_<" "\\_>" ".*")) +(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 candadates. 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-truncate-lines nil + "[Internal] Don't set this globally, it is used as a local var.") +(defvar helm--prompt nil) +(defvar helm--file-completion-sources + '("Find Files" "Read File Name" "Read File Name History") + "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.") +;; 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, will be restored +at end of session.") + +;; Utility: logging +(defun helm-log (format-string &rest args) + "Log message `helm-debug' is non-`nil'. +Messages are written to the `helm-debug-buffer' buffer. + +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) + (set (make-local-variable '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) + (helm-log-get-current-function) + (apply #'format (cons format-string args)))))))) + +(defun helm-log-run-hook (hook) + "Run HOOK like `run-hooks' but write these actions to helm log buffer." + (helm-log "Executing %s with value = %S" hook (symbol-value hook)) + (helm-log "Executing %s with global value = %S" hook (default-value hook)) + (run-hooks hook) + (helm-log "executed %s" hook)) + +(defun helm-log-get-current-function () + "Get name of function that is calling `helm-log'. +The original idea is from `tramp-debug-message'." + (cl-loop with exclude-func-re = "^helm-\\(?:interpret\\|log\\|.*funcall\\)" + for btn from 1 to 40 + for btf = (cl-second (backtrace-frame btn)) + for fn = (if (symbolp btf) (symbol-name btf) "") + if (and (string-match "^helm" fn) + (not (string-match exclude-func-re fn))) + return fn)) + +(defun helm-log-error (&rest args) + "Accumulate error messages into `helm-issued-errors'. +ARGS are args given to `format'. +e.g (helm-log-error \"Error %s: %s\" (car err) (cdr err))." + (apply 'helm-log (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)))) + +(defun helm-log-save-maybe () + "Save log buffer if `helm-debug-root-directory' is set to a valid directory. +Messages are logged to a file named with todays date and time in this directory." + (when (and (stringp helm-debug-root-directory) + (file-directory-p helm-debug-root-directory) + helm-debug) + (let ((logdir (expand-file-name (concat "helm-debug-" + (format-time-string "%Y%m%d")) + helm-debug-root-directory))) + (make-directory logdir t) + (with-current-buffer (get-buffer-create helm-debug-buffer) + (write-region (point-min) (point-max) + (setq helm--last-log-file + (expand-file-name + (format-time-string "%Y%m%d-%H%M%S") + logdir)) + nil 'silent) + (kill-buffer)))) + (setq helm-debug nil)) + +;;;###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-restore-variables (&rest body) + "Restore `helm-restored-variables' after executing BODY." + (declare (indent 0) (debug t)) + (helm-with-gensyms (orig-vars) + `(let ((,orig-vars (mapcar (lambda (v) + (cons v (symbol-value v))) + helm-restored-variables))) + (unwind-protect (progn ,@body) + (cl-loop for (var . value) in ,orig-vars + do (set var value)) + (helm-log "restore variables"))))) + +(defmacro with-helm-default-directory (directory &rest body) + (declare (indent 2) (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)) + (helm-with-gensyms (helm--hook) + `(progn + (defun ,helm--hook () + (unwind-protect + (progn ,@body) + (remove-hook ,hook (quote ,helm--hook)) + (fmakunbound (quote ,helm--hook)))) + (push (cons ',helm--hook ,hook) helm--temp-hooks) + (add-hook ,hook (quote ,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")))) + + +;;; helm-attributes +;; +(defun helm-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." + (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))))) + +(cl-defun helm-attr-defined (attribute-name + &optional (src (helm-get-current-source))) + "Return non-`nil' if ATTRIBUTE-NAME of SRC is defined. +if SRC is omitted, use current source." + (and (helm-attr attribute-name src) t)) + +(cl-defun helm-attrset (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." + (let (done) + (helm-aif (assq attribute-name src) + (prog1 (setcdr it value) (setq done t)) + (setcdr src (cons (cons attribute-name value) (cdr src))) + (setq done t)) + (and done value))) + +(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-attr 'action source 'ignorefn)) + (new-action (list (cons name fn)))) + (when (functionp actions) + (setq actions (list (cons "Default action" actions)))) + (helm-attrset '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-attr 'action source 'ignorefn)) + (del-action (if (symbolp action-or-name) + (rassoc action-or-name actions) + (assoc action-or-name actions)))) + (helm-attrset '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 allow 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 return 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-attr 'action source 'ignorefn)) + (action-transformers (helm-attr 'action-transformer source)) + (new-action (list (cons name fn))) + (transformer (lambda (actions candidate) + (cond ((funcall predicate candidate) + (helm-append-at-nth + actions new-action index)) + (t actions))))) + (when (functionp actions) + (helm-attrset '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-attrset '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." + (let ((cur-disp-sel (with-current-buffer helm-buffer + (helm-get-selection nil t)))) + (setq helm-source-filter (helm--normalize-filter-sources sources)) + (helm-log "helm-source-filter = %S" helm-source-filter) + ;; Use force-update to run init/update functions. + (helm-force-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-compiled-sources nil + helm-sources sources) + (helm-log "helm-compiled-sources = %S" helm-compiled-sources) + (helm-log "helm-sources = %S" helm-sources)) + (unless no-init (helm-funcall-foreach 'init)) + (unless no-update (helm-update))) + +(defun helm-get-sources () + "Return compiled `helm-sources', which is memoized." + (cond + ;; action + ((helm-action-window) helm-sources) + ;; memoized + (helm-compiled-sources) + ;; first time + (t + (prog1 + (setq helm-compiled-sources + (mapcar (lambda (source) + (if (listp source) source (symbol-value source))) + helm-sources)) + (helm-log "helm-compiled-sources = %S" helm-compiled-sources))))) + +(defun helm-get-selection (&optional buffer force-display-part source) + "Return the currently selected item or nil. +if BUFFER is nil or unspecified, use helm-buffer as default value. +If FORCE-DISPLAY-PART is non-`nil', return the display string. +If FORCE-DISPLAY-PART value is 'withprop the display string is returned +with its properties." + (setq buffer (or buffer helm-buffer)) + (unless (helm-empty-buffer-p buffer) + (with-current-buffer buffer + (let* ((disp-fn (if (eq force-display-part 'withprop) + 'buffer-substring + 'buffer-substring-no-properties)) + (selection + (or (and (not force-display-part) + (get-text-property (overlay-start + helm-selection-overlay) + 'helm-realvalue)) + ;; It is needed to return properties of DISP in some case, + ;; e.g for `helm-confirm-and-exit-minibuffer', + ;; so use `buffer-substring' here when 'withprop is specified. + (let ((disp (funcall + disp-fn + (overlay-start helm-selection-overlay) + (1- (overlay-end helm-selection-overlay)))) + (src (or source (helm-get-current-source)))) + (helm-aif (and (not force-display-part) + (assoc-default 'display-to-real src)) + (helm-funcall-with-source source it disp) + disp))))) + (unless (equal selection "") + (helm-log "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 (helm-get-current-source))) + (helm-aif (helm-attr 'action-transformer) + (helm-funcall-with-source + (or source src) it + (helm-attr 'action nil 'ignorefn) + ;; Check if the first given transformer + ;; returns the same set of actions for each + ;; candidate in marked candidates. + ;; If so use the car of marked to determine + ;; the set of actions, otherwise use the selection. + (if (cl-loop with marked = (helm-marked-candidates) + with act = (car (helm-mklist it)) + with acts = (funcall act nil (car marked)) + for c in marked + always (equal (funcall act nil c) acts)) + (car (helm-marked-candidates)) + (helm-get-selection nil nil src))) + (helm-attr 'action nil 'ignorefn))))) + +(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 + ;; 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-get-sources) thereis + (and (equal (assoc-default 'name source) source-name) + source))))))) + +(defun helm-buffer-is-modified (buffer) + "Return non-`nil' when BUFFER is modified since `helm' was invoked." + (let* ((buf (get-buffer buffer)) + (key (concat (buffer-name buf) "/" (helm-attr 'name))) + (source-tick (or (gethash key helm-tick-hash) 0)) + (buffer-tick (buffer-chars-modified-tick buf)) + (modifiedp (/= source-tick buffer-tick))) + (puthash key buffer-tick helm-tick-hash) + (helm-log "buffer = %S" buffer) + (helm-log "modifiedp = %S" modifiedp) + modifiedp)) + +(defun helm-current-buffer-is-modified () + "Check if `helm-current-buffer' is modified since `helm' was invoked." + (helm-buffer-is-modified helm-current-buffer)) + +(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 "function = %S" function) + (helm-log "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." + (setq helm-saved-action action) + (setq helm-saved-selection (or (helm-get-selection) "")) + (helm-exit-minibuffer)) + +(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-funcall-with-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)))) + + +;; Core: 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 (point-at-bol) (point-at-eol)) + (or + (save-excursion + (forward-line -1) + (helm-pos-header-line-p)) + (bobp))))))) + + +;; Core: tools +;; +(defun helm-funcall-with-source (source functions &rest args) + "Call from SOURCE FUNCTIONS list or single function FUNCTIONS with ARGS. +FUNCTIONS is either a symbol or a list of functions. +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))) + (helm-log "helm-source-name = %S" helm-source-name) + (helm-log "functions = %S" functions) + (helm-log "args = %S" args) + (cl-loop with result + for fn in funs + do (setq result (apply fn args)) + when (and args (cdr 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. + ;; 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))) + +(defun helm-funcall-foreach (sym &optional sources) + "Call the associated function(s) to SYM for each source if any." + (let ((sources (or sources (helm-get-sources)))) + (cl-dolist (source sources) + (helm-aif (assoc-default sym source) + (helm-funcall-with-source source it))))) + +(defun helm-normalize-sources (sources) + "If SOURCES is only one source, make a list of one element." + (cond ((or (and sources (symbolp sources)) + (and (listp sources) (assq 'name sources))) + (list sources)) + (sources) + (t helm-sources))) + +(defun helm-get-candidate-number (&optional in-current-source) + "Return candidates number in `helm-buffer'. +If IN-CURRENT-SOURCE is provided return number of candidates of current source +only." + (with-helm-buffer + (if (or (helm-empty-buffer-p) + (helm-empty-source-p)) + 0 + (save-excursion + (if in-current-source + (goto-char (helm-get-previous-header-pos)) + (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 (#1370). + unless (or (eq (point-at-bol) (point-at-eol)) + (helm-pos-header-line-p)) + do (cl-incf ln) + do (forward-line 1) finally return ln)))))) + +(defmacro with-helm-quittable (&rest body) + "If an error occurs in execution of BODY, safely quit helm." + (declare (indent 0) (debug t)) + `(condition-case _v + (let (inhibit-quit) + ,@body) + (quit (setq quit-flag t) + (setq helm-quit t) + (exit-minibuffer) + (keyboard-quit) + ;; See comment about this in `with-local-quit'. + (eval '(ignore nil))))) + +;; Core: entry point +;; `:allow-nest' is not in this list because it is treated before. +(defconst helm-argument-keys + '(:sources :input :prompt :resume + :preselect :buffer :keymap :default :history)) + +;;;###autoload +(defun helm (&rest plist) + "Main function to execute helm sources. + +Keywords supported: +:sources :input :prompt :resume :preselect +:buffer :keymap :default :history :allow-nest + +Extra LOCAL-VARS keywords are supported, see below. + +PLIST is a list like \(:key1 val1 :key2 val2 ...\) or +\(&optional sources input prompt resume + preselect buffer keymap default history\). + +Basic keywords are the following: + +\:sources + +A list of sources used for this session. It also accepts a +symbol, interpreted as a variable of a helm source +i.e (a symbol can be passed instead of a list of sources). +It also accepts an alist representing a helm source, which is +detected by \(assq 'name ANY-SOURCES\). +NOTE: In this case the source is embedded in the helm command and +have no symbol name, so it is not reachable from outside. +It will be referenced in `helm-sources' as a whole alist. + +\:input + +Temporary value of `helm-pattern', ie. initial input of minibuffer. + +\:prompt + +Prompt other than \"pattern: \". + +\:resume + +If t, Resurrect previously instance of `helm'. Skip the initialization. +If 'noresume, this instance of `helm' cannot be resumed. + +\:preselect + +Initially selected candidate. Specified by exact candidate or a regexp. + +\:buffer + +`helm-buffer' instead of *helm*. + +\:keymap + +`helm-map' for current `helm' session. + +\:default + +A default argument that will be inserted in minibuffer \ with +\\\\[next-history-element]. When nil or not +present `thing-at-point' will be used instead. If +`helm--maybe-use-default-as-input' is non-`nil' display will be +updated using :default arg as input unless :input is specified, +which in this case will take precedence over :default. This is a +string or a list. If list, car of the list becomes initial +default input. \\\\[next-history-element] +cycles through the list items. + +\:history + +Minibuffer input, by default, is pushed to `minibuffer-history'. +When an argument HISTORY is provided, input is pushed to +HISTORY. The HISTORY element should be a valid symbol. + +\:allow-nest + +Allow running this helm command in a running helm session. + +Standard arguments are supported. These two are the same: + +\(helm :sources sources :input input :prompt prompt :resume resume + :preselect preselect :buffer buffer :keymap keymap :default default + :history history\) + +and + +\(helm sources input prompt resume preselect buffer keymap default history\) + +are the same for now. However, the use of non-keyword args is +deprecated and should not be used. + +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 helm session with `helm-source-buffers' source in +*helm buffers* buffer and sets variable `helm-candidate-number-limit' +to 10 as a session local variable. + +\(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 () + "Check if `helm' is alive. +An `helm' session is considered alive if `helm-alive-p' returns +non-`nil', the `helm-buffer' is visible, and cursor is in the +minibuffer." + (and helm-alive-p + (get-buffer-window helm-buffer '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))) + +;;; Core: entry point helper +(defun helm-internal (&optional + any-sources any-input + any-prompt any-resume + any-preselect any-buffer + any-keymap any-default any-history) + "The internal helm function called by `helm'. +For ANY-SOURCES ANY-INPUT ANY-PROMPT ANY-RESUME ANY-PRESELECT ANY-BUFFER and +ANY-KEYMAP ANY-DEFAULT ANY-HISTORY See `helm'." + ;; Activate the advice for `tramp-read-passwd' and cua. + ;; 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--advice-tramp-read-passwd) + (advice-add 'ange-ftp-get-passwd :around #'helm--advice-ange-ftp-get-passwd) + (advice-add 'cua-delete-region :around #'cua-delete-region--advice) + (advice-add 'copy-region-as-kill :around #'copy-region-as-kill--advice)) + (helm-log (concat "[Start session] " (make-string 41 ?+))) + (helm-log "any-prompt = %S" any-prompt) + (helm-log "any-preselect = %S" any-preselect) + (helm-log "any-buffer = %S" any-buffer) + (helm-log "any-keymap = %S" any-keymap) + (helm-log "any-default = %S" any-default) + (helm-log "any-history = %S" any-history) + (setq helm--prompt (or any-prompt "pattern: ")) + (let ((non-essential t) + ;; Prevent mouse jumping to the upper-right + ;; hand corner of the frame (#1538). + mouse-autoselect-window + focus-follows-mouse + (input-method-verbose-flag helm-input-method-verbose-flag) + (old--cua cua-mode) + (helm--maybe-use-default-as-input + (and (null any-input) + (or helm--maybe-use-default-as-input ; it is let-bounded so use it. + (cl-loop for s in (helm-normalize-sources any-sources) + thereis (memq s helm-sources-using-default-as-input)))))) + ;; cua-mode override local helm bindings. + ;; disable this stupid thing if enabled. + (and cua-mode (cua-mode -1)) + (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 any-buffer helm-buffer))) + (with-helm-restore-variables + (helm-initialize + any-resume any-input any-default any-sources) + (helm-display-buffer helm-buffer) + (select-window (helm-window)) + ;; We are now in helm-buffer. + (when helm-prevent-escaping-from-minibuffer + (helm--remap-mouse-mode 1)) ; Disable mouse bindings. + (add-hook 'post-command-hook 'helm--maybe-update-keymap) + (add-hook 'post-command-hook 'helm--update-header-line) + (helm-log "show prompt") + (unwind-protect + (helm-read-pattern-maybe + any-prompt any-input any-preselect + any-resume any-keymap any-default any-history) + (helm-cleanup))) + (prog1 + (unless helm-quit (helm-execute-selection-action)) + (helm-log (concat "[End session] " (make-string 41 ?-))))) + (quit + (helm-restore-position-on-quit) + (helm-log (concat "[End session (quit)] " (make-string 34 ?-))) + nil)) + (when (fboundp 'advice-remove) + (advice-remove 'tramp-read-passwd #'helm--advice-tramp-read-passwd) + (advice-remove 'ange-ftp-get-passwd #'helm--advice-ange-ftp-get-passwd) + (advice-remove 'cua-delete-region #'cua-delete-region--advice) + (advice-remove 'copy-region-as-kill #'copy-region-as-kill--advice)) + (helm-log "helm-alive-p = %S" (setq helm-alive-p nil)) + (helm--remap-mouse-mode -1) ; Reenable mouse bindings. + (setq helm-alive-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) + (and old--cua (cua-mode 1)) + (helm-log-save-maybe)))) + + +;;; 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 (any-buffer + cur-dir + (helm-full-frame (default-value 'helm-full-frame))) + (if arg + (if (and (stringp arg) (bufferp (get-buffer arg))) + (setq any-buffer arg) + (setq any-buffer (helm-resume-select-buffer))) + (setq any-buffer helm-last-buffer)) + (cl-assert any-buffer nil + "helm-resume: No helm buffers found to resume") + ;; Reset `cursor-type' to nil as it have been set to t + ;; when quitting previous session. + (with-current-buffer any-buffer (setq cursor-type nil)) + (setq helm-full-frame (buffer-local-value + 'helm-full-frame (get-buffer any-buffer))) + (setq helm-compiled-sources nil) + (setq cur-dir (buffer-local-value + 'default-directory (get-buffer any-buffer))) + (setq helm-saved-selection nil + helm-saved-action nil) + (unless (buffer-live-p helm-current-buffer) + ;; `helm-current-buffer' may have been killed. + (setq helm-current-buffer (current-buffer))) + ;; Restart with same `default-directory' value this session + ;; was initially started with. + (with-helm-default-directory cur-dir + (helm + :sources (buffer-local-value + 'helm-sources (get-buffer any-buffer)) + :input (buffer-local-value 'helm-input-local (get-buffer any-buffer)) + :prompt (buffer-local-value 'helm--prompt (get-buffer any-buffer)) + :resume t + :buffer any-buffer)))) + +(defun helm-resume-previous-session-after-quit (arg) + "Resume previous helm session within a running helm." + (interactive "p") + (with-helm-alive-p + (if (> (length helm-buffers) arg) + (helm-run-after-exit (lambda () (helm-resume (nth arg helm-buffers)))) + (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 resumable helm buffers within running helm." + (interactive) + (with-helm-alive-p + (if (> (length helm-buffers) 0) + (helm-run-after-exit (lambda () (helm-resume t))) + (message "No previous helm sessions available for resuming!")))) +(put 'helm-resume-list-buffers-after-quit 'helm-only t) + +(defun helm-resume-p (any-resume) + "Whether current helm session is resumed or not." + (eq any-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-other-buffer (any-sources any-buffer) + "Simplified `helm' interface with other `helm-buffer'. +Call `helm' only with ANY-SOURCES and ANY-BUFFER as args." + (helm :sources any-sources :buffer any-buffer)) + +(defun helm-nest (&rest same-as-helm) + "Allows calling `helm' within a running helm session. +Arguments SAME-AS-HELM are the same as `helm'" + (with-helm-window + (let ((orig-helm-current-buffer helm-current-buffer) + (orig-helm-buffer helm-buffer) + (orig-helm--prompt helm--prompt) + (orig-helm--in-fuzzy helm--in-fuzzy) + (orig-helm-last-frame-or-window-configuration + helm-last-frame-or-window-configuration) + (orig-one-window-p helm-onewindow-p)) + (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*")) + helm-sources + helm-compiled-sources + (helm-full-frame t) + (enable-recursive-minibuffers t)) + (apply #'helm same-as-helm)) + (with-current-buffer orig-helm-buffer + (setq helm-alive-p t) ; Nested session set this to nil on exit. + (setq helm-buffer orig-helm-buffer) + (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. + (if (fboundp 'advice-add) + (progn + (advice-add 'tramp-read-passwd + :around #'helm--advice-tramp-read-passwd) + (advice-add 'ange-ftp-get-passwd + :around #'helm--advice-ange-ftp-get-passwd)) + (ad-activate 'tramp-read-passwd) + (ad-activate 'ange-ftp-get-passwd)) + (when helm-prevent-escaping-from-minibuffer + (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))))))) + + +;;; Core: Accessors +;; +(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 "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 "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-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-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 frame focus. + ;; This is needed for minibuffer own-frame config + ;; when recursive minibuffers are in use. + ;; e.g M-: + helm-minibuffer-history. + (let ((frame (if (minibufferp helm-current-buffer) + (selected-frame) + (last-nonminibuffer-frame)))) + (select-frame-set-input-focus frame)))))) + +(defun helm-split-window-default-fn (window) + (let (split-width-threshold) + (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))) + (if (or (one-window-p t) + helm-split-window-in-side-p) + (split-window + (selected-window) nil (if (eq helm-split-window-default-side 'other) + 'below 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 (other-window-for-scrolling)) + (t (or (window-next-sibling) (selected-window))))) + (split-window-sensibly window)))) + +(defun helm-window-in-direction (direction) + "Same as `window-in-direction' but check if window is dedicated." + (helm-aif (window-in-direction direction) + (and (not (window-dedicated-p it)) it))) + + +;;; Display helm buffer +;; +;; +(defun helm-display-buffer (buffer) + "Display BUFFER. +The function to display `helm-buffer'." + (let (pop-up-frames + (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) + (cond ((eq helm-split-window-default-side 'same) 'same) + ((eq helm-split-window-default-side 'other) 'other) + (helm--window-side-state) + (t helm-split-window-default-side)) + helm-split-window-default-side))) + (prog1 + (funcall (with-current-buffer buffer helm-display-function) buffer) + (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) + "Default function to display `helm-buffer' BUFFER. +It uses `switch-to-buffer' or `display-buffer' depending on the +value of `helm-full-frame' or `helm-split-window-default-side'." + (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)) + (delete-other-windows)) + (switch-to-buffer buffer)) + (when (and (or helm-always-two-windows helm-autoresize-mode + (and (not helm-split-window-in-side-p) + (eq (save-selected-window + (funcall helm-split-window-preferred-function + (selected-window))) + (get-buffer-window helm-current-buffer)))) + (not (eq helm-split-window-default-side 'same)) + (not (minibufferp helm-current-buffer)) + (not helm-split-window-in-side-p)) + (delete-other-windows)) + (display-buffer + buffer `(nil . ((window-height . ,helm-display-buffer-default-height) + (window-width . ,helm-display-buffer-default-width)))) + (helm-log-run-hook 'helm-window-configuration-hook))) + + +;;; Core: initialize +;; +(defun helm-initialize (any-resume any-input any-default any-sources) + "Start initialization of `helm' session. +For ANY-RESUME ANY-INPUT ANY-DEFAULT and ANY-SOURCES See `helm'." + (helm-log "start initialization: any-resume=%S any-input=%S" + any-resume any-input) + (helm-frame-or-window-configuration 'save) + (setq helm-sources (helm-normalize-sources any-sources)) + (setq helm--in-fuzzy + (cl-loop for s in helm-sources + for matchfns = (helm-match-functions + (if (symbolp s) (symbol-value s) s)) + for searchfns = (helm-search-functions + (if (symbolp s) (symbol-value s) s)) + when (or (member 'helm-fuzzy-match matchfns) + (member 'helm-fuzzy-search searchfns)) + return t)) + (helm-log "sources = %S" helm-sources) + (helm-current-position 'save) + (if (helm-resume-p any-resume) + (helm-initialize-overlays (helm-buffer-get)) + (helm-initial-setup any-default)) + (setq helm-alive-p t) + (unless (eq any-resume 'noresume) + (helm--recent-push helm-buffer 'helm-buffers) + (setq helm-last-buffer helm-buffer)) + (when any-input + (setq helm-input any-input + helm-pattern any-input) + (helm--fuzzy-match-maybe-set-pattern)) + ;; If a `resume' attribute is present `helm-funcall-foreach' + ;; will run its function. + (when (helm-resume-p any-resume) + (helm-funcall-foreach 'resume)) + (helm-log "end initialization")) + +(defun helm-initialize-overlays (buffer) + "Initialize helm overlays in BUFFER." + (helm-log "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-restore-position-on-quit () + "Restore position in `helm-current-buffer' when quitting." + (helm-current-position 'restore)) + +(defun helm--recent-push (elm sym) + "Move ELM of SYM value on top and set SYM to this new value." + (pcase (symbol-value sym) + ((and (pred (member elm)) l) + (set sym (delete elm l)))) + (push 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 Issue #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))))) + +(defun helm--run-init-hooks (hook) + "Run after and before init hooks local to source. +See :after-init-hook and :before-init-hook in `helm-source'." + (cl-loop with sname = (cl-ecase hook + (before-init-hook "h-before-init-hook") + (after-init-hook "h-after-init-hook")) + with h = (cl-gensym sname) + for s in (helm-get-sources) + for hv = (assoc-default hook s) + if (and hv (not (symbolp hv))) + do (set h hv) + and do (helm-log-run-hook h) + else do (helm-log-run-hook hv))) + +(defun helm-initial-setup (any-default) + "Initialize helm settings and set up the helm buffer." + ;; Run global hook. + (helm-log-run-hook 'helm-before-initialize-hook) + ;; Run local source hook. + (helm--run-init-hooks 'before-init-hook) + ;; 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 + helm-current-buffer (helm--current-buffer) + helm-buffer-file-name buffer-file-name + helm-issued-errors nil + helm-compiled-sources nil + helm-saved-current-source nil) + (unless (and (or helm-split-window-state + helm--window-side-state) + helm-reuse-last-window-split-state) + (setq helm-split-window-state + (if (or (null split-width-threshold) + (and (integerp split-width-threshold) + (>= split-width-threshold (+ (frame-width) 4)))) + 'vertical 'horizontal)) + (setq helm--window-side-state + (or helm-split-window-default-side 'below))) + ;; Call the init function for sources where appropriate + (helm-funcall-foreach + 'init (and helm-source-filter + (cl-remove-if-not (lambda (s) + (member (assoc-default 'name s) + helm-source-filter)) + (helm-get-sources)))) + (setq helm-pattern (or (and helm--maybe-use-default-as-input + (or (if (listp any-default) + (car any-default) any-default) + (with-helm-current-buffer + (thing-at-point 'symbol)))) + "")) + (setq helm-input "") + (clrhash helm-candidate-cache) + (helm-create-helm-buffer) + (helm-clear-visible-mark) + ;; Run global hook. + (helm-log-run-hook 'helm-after-initialize-hook) + ;; Run local source hook. + (helm--run-init-hooks 'after-init-hook)) + +(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)) + (with-current-buffer (get-buffer-create helm-buffer) + (helm-log "Enabling major-mode %S" major-mode) + (helm-log "kill local variables: %S" (buffer-local-variables)) + (kill-all-local-variables) + (helm-major-mode) + (set (make-local-variable 'inhibit-read-only) t) + (buffer-disable-undo) + (erase-buffer) + (set (make-local-variable 'helm-map) helm-map) + (make-local-variable 'helm-sources) + (set (make-local-variable 'helm-display-function) helm-display-function) + (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-display-function = %S" helm-display-function) + (helm-log "helm--local-variables = %S" helm--local-variables) + (cl-loop for (var . val) in helm--local-variables + do (set (make-local-variable var) val) + finally (setq helm--local-variables nil)) + (setq truncate-lines helm-truncate-lines) ; already local. + (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 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-pattern-maybe (any-prompt any-input + any-preselect any-resume any-keymap + any-default any-history) + "Read pattern with prompt ANY-PROMPT and initial input ANY-INPUT. +For ANY-PRESELECT ANY-RESUME ANY-KEYMAP ANY-DEFAULT ANY-HISTORY, See `helm'." + (if (and (helm-resume-p any-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 any-preselect)) + (with-current-buffer (helm-buffer-get) + (let* ((src (helm-get-current-source)) + (src-keymap (assoc-default 'keymap src)) + (hist (or (and any-history (symbolp any-history) any-history) + ;; Needed for resuming. + (assoc-default 'history src))) + (timer nil) + blink-matching-paren + (resize-mini-windows (and (null helm-echo-input-in-header-line) + resize-mini-windows)) + (first-src (car helm-sources)) + (first-src-val (if (symbolp first-src) + (symbol-value first-src) + first-src)) + (source-process-p (or (assq 'candidates-process src) + (assq 'candidates-process first-src-val)))) + (helm-log "helm-get-candidate-number => %S" + (helm-get-candidate-number)) + (helm-log "helm-execute-action-at-once-if-one = %S" + helm-execute-action-at-once-if-one) + (helm-log "helm-quit-if-no-candidate = %S" helm-quit-if-no-candidate) + (when (and src (helm-resume-p any-resume)) + (helm-display-mode-line src)) + ;; 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))) + ;; 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 any-default + (with-helm-current-buffer + (thing-at-point 'symbol))))) + (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 ANY-KEYMAP + ;; which will become buffer local. + ;; - Or fallback to the global value of helm-map. + (helm--maybe-update-keymap + (or src-keymap any-keymap helm-map)) + (helm-log-run-hook '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)))))) + (helm--update-header-line)) ; minibuffer has already been filled here + (read-from-minibuffer (or any-prompt "pattern: ") + any-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 update of display in helm. +This can be useful for example for quietly writing a complex regexp." + (interactive) + (with-helm-alive-p + (when (setq helm-suspend-update-flag (not helm-suspend-update-flag)) + (helm-kill-async-processes) + (setq helm-pattern "")) + (message (if helm-suspend-update-flag + "Helm update suspended!" + "Helm update re-enabled!")))) +(put 'helm-toggle-suspend-update 'helm-only t) + +(defun helm--advice-tramp-read-passwd (old--fn &rest args) + ;; 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--advice-ange-ftp-get-passwd (old--fn &rest args) + ;; Suspend update when prompting for a ange password. + (setq helm-suspend-update-flag t) + (setq overriding-terminal-local-map nil) + (setq helm--reading-passwd-or-string t) + (unwind-protect + (apply old--fn args) + (setq helm--reading-passwd-or-string nil) + (setq helm-suspend-update-flag nil))) + +;; CUA workaround +(defun cua-delete-region--advice (old--fn &rest args) + (ignore-errors + (apply old--fn args))) + +(defun copy-region-as-kill--advice (old--fn &rest args) + (if cua-mode + (ignore-errors (apply old--fn args)) + (apply old--fn args))) + +(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 issue #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) + +;; Core: clean up + +(defun helm-cleanup () + "Clean up the mess when helm exit or quit." + (helm-log "start cleanup") + (with-current-buffer helm-buffer + (setq cursor-type t) + ;; bury-buffer from this window. + (bury-buffer) ;[1] + (remove-hook 'post-command-hook 'helm--maybe-update-keymap) + (remove-hook 'post-command-hook 'helm--update-header-line) + ;; Be sure we call this from helm-buffer. + (helm-funcall-foreach 'cleanup)) + (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 (set hook (delete fn (symbol-value hook))))) + ;; 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-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) + ;; 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))))) + + +;;; Core: input handling +;; +;; +(defun helm-check-minibuffer-input () + "Check minibuffer content." + (with-helm-quittable + (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-pattern = %S" helm-pattern) + (helm-log "helm-input = %S" helm-input) + (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) + + +;; Core: all candidates + +(defun helm-get-candidates (source) + "Retrieve and return the list of candidates from SOURCE." + (let* (inhibit-quit + (candidate-fn (assoc-default 'candidates source)) + (candidate-proc (assoc-default 'candidates-process source)) + 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-funcall-with-source'. + (helm-interpret-value candidate-proc) + (helm-interpret-value candidate-fn source)) + (error (helm-log "Error: %S" (setq cfn-error err)) nil)))) + (when (and (processp candidates) (not candidate-proc)) + (warn "Candidates function `%s' should be called in a `candidates-process' attribute" + candidate-fn)) + (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 (Issue #938). + ;; e.g (completing-read "test: " '("")) + (equal candidates '(""))) + nil) + ((listp candidates) + ;; Transform candidates with `candidate-transformer' functions if + ;; some, otherwise return candidates. + (helm-transform-candidates candidates source)) + (t (funcall notify-error))))) + +(defmacro helm-while-no-input (&rest body) + "Same as `while-no-input' but without the `input-pending-p' test." + (declare (debug t) (indent 0)) + (let ((catch-sym (make-symbol "input"))) + `(with-local-quit + (catch ',catch-sym + (let ((throw-on-input ',catch-sym)) + ,@body))))) + +(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))) + (helm-aif candidate-cache + (prog1 it (helm-log "Use cached candidates")) + (helm-log "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 (assoc 'volatile source)) + (puthash name candidates helm-candidate-cache))) + candidates)))) + + +;;; Core: 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-funcall-with-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-funcall-with-source source it candidates source) + candidates)) + +(defmacro helm--maybe-process-filter-one-by-one-candidate (candidate source) + "Execute `filter-one-by-one' function(s) on real value of CANDIDATE in SOURCE." + `(helm-aif (assoc-default 'filter-one-by-one ,source) + (let ((real (if (consp ,candidate) + (cdr ,candidate) + ,candidate))) + (if (and (listp it) + (not (functionp it))) ;; Don't treat lambda's as list. + (cl-loop for f in it + do (setq ,candidate (funcall f real)) + finally return ,candidate) + (setq ,candidate (funcall it real)))) + ,candidate)) + +(defun helm--initialize-one-by-one-candidates (candidates source) + "Process the CANDIDATES with the `filter-one-by-one' function in SOURCE. +Return CANDIDATES when pattern is 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-funcall-with-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. When `real-to-display' +attribute is present, execute its function on all maybe filtered +CANDIDATES." + (helm-process-real-to-display + (helm-process-filtered-candidate-transformer-maybe + (helm-process-candidate-transformer + (helm--initialize-one-by-one-candidates candidates source) source) + source process-p) + source)) + + +;; Core: 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) + (or (cdr 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." + (cond ((car-safe candidate)) + ((symbolp candidate) + (symbol-name candidate)) + ((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-funcall-with-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 (funcall fun (substring helm-pattern 1 2)) + (funcall fun (substring helm-pattern 1))) + '("" "")) + helm--fuzzy-regexp-cache) + (puthash 'helm-pattern + (if (> (length helm-pattern) 0) + (list (funcall fun (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 (point-at-bol) (point-at-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]*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 = (point-at-bol) + for eol = (point-at-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))))) + +(defun helm-score-candidate-for-pattern (candidate pattern) + "Assign 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)) + (bonus (if (equal (car pat-lookup) (car str-lookup)) 1 0)) + (bonus1 (and (string-match (concat "\\<" (regexp-quote pattern) "\\>") + cand) + 100))) + (+ bonus (or bonus1 + ;; 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 (cl-nintersection + pat-lookup str-lookup :test 'equal)) + 2))))) + +(defun helm-fuzzy-matching-default-sort-fn (candidates _source &optional use-real) + "The transformer for sorting candidates in fuzzy matching. +It sorts on the display part by default. + +Sorts CANDIDATES by their scores as calculated by +`helm-score-candidate-for-pattern'. Ties in scores are sorted by +length of the candidates. Set USE-REAL to non-`nil' to sort on the +real part." + (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 (if (consp s1) + (funcall real-or-disp-fn s1) + s1)) + (cand2 (if (consp s2) + (funcall real-or-disp-fn s2) + 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) + (< len1 len2)) + ((> scr1 scr2))))))))) + +(defun helm--maybe-get-migemo-pattern (pattern) + (or (and helm-migemo-mode + (assoc-default pattern helm-mm--previous-migemo-info)) + pattern)) + +(defun helm-fuzzy-default-highlight-match (candidate) + "The default function to highlight matches in fuzzy matching. +Highlight elements in CANDIDATE matching `helm-pattern' according +to the matching method in use." + (if (string= helm-pattern "") + ;; Empty pattern, do nothing. + candidate + ;; Else start highlighting. + (let* ((pair (and (consp candidate) candidate)) + (display (helm-stringify (if pair (car pair) candidate))) + (real (cdr pair)) + (regex (helm--maybe-get-migemo-pattern helm-pattern)) + (mp (pcase (get-text-property 0 'match-part display) + ((pred (string= display)) nil) + (str str))) + (count 0) + beg-str end-str) + ;; Extract all parts of display keeping original properties. + (when (and mp (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 (#1176) + (goto-char (point-min)) + (condition-case nil + (progn + ;; Try first matching against whole pattern. + (while (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 " " helm-pattern) + with patterns = (if multi-match + (mapcar #'helm--maybe-get-migemo-pattern + (split-string helm-pattern)) + (split-string helm-pattern "" t)) + for p in patterns + ;; Multi matches (regexps patterns). + if multi-match do + (progn + (while (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)))) + +(defun helm-fuzzy-highlight-matches (candidates _source) + "The filtered-candidate-transformer function to highlight fuzzy matches. +See `helm-fuzzy-default-highlight-match'." + (cl-loop for c in candidates + collect (funcall helm-fuzzy-matching-highlight-fn c))) + +(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-take-first-elements (seq n) + "Return the first N elements of SEQ if SEQ is longer than N. +It is used for narrowing list of candidates to the +`helm-candidate-number-limit'." + (if (> (length seq) n) (cl-subseq seq 0 n) seq)) + +(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'." + (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))) + +(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))) + +(defun helm-match-from-candidates (cands matchfns match-part-fn limit source) + (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) + while (< count limit) + for target = (helm-candidate-get-display c) + 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) + (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 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. + (helm-process-filtered-candidate-transformer + ;; ; Using in-buffer method or helm-pattern is empty + ;; in this case compute all candidates. + (if (or (equal helm-pattern "") + (helm--candidates-in-buffer-p matchfns)) + ;; Compute all candidates up to LIMIT. + (helm-take-first-elements + (helm-get-cached-candidates source) limit) + ;; Compute candidates according to pattern with their match fns. + (helm-match-from-candidates + (helm-get-cached-candidates source) matchfns matchpartfn limit source)) + source)))) + +(defun helm--candidates-in-buffer-p (matchfns) + (equal matchfns '(identity))) + +(defun helm-render-source (source matches) + "Display MATCHES from SOURCE according to its settings." + (helm-log "Source name = %S" (assoc-default 'name source)) + (when matches + (helm-insert-header-from-source source) + (if (not (assq 'multiline source)) + (cl-loop for m in matches + for count from 1 + do (helm-insert-match m 'insert count)) + (let ((start (point)) + (count 0) + separate) + (cl-dolist (match matches) + (cl-incf count) + (if separate + (helm-insert-candidate-separator) + (setq separate t)) + (helm-insert-match match 'insert count)) + (put-text-property start (point) 'helm-multiline t))))) + +(defmacro helm--maybe-use-while-no-input (&rest body) + "Wrap BODY in `helm-while-no-input' unless initializing a remote connection." + `(progn + (if (and (file-remote-p helm-pattern) + (not (file-remote-p helm-pattern nil t))) + ;; Tramp will ask for passwd, don't use `helm-while-no-input'. + ,@body + (helm-log "Using here `helm-while-no-input'") + (helm-while-no-input ,@body)))) + +(defun helm--collect-matches (src-list) + (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))) + + +;;; Core: helm-update +;; +(defun helm-update (&optional preselect source) + "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." + (helm-log "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'. + (with-helm-window + (when helm-onewindow-p (delete-other-windows))) + (with-current-buffer (helm-buffer-get) + (set (make-local-variable 'helm-input-local) helm-pattern) + (unwind-protect + (let (sources matches) + ;; Collect sources ready to be updated. + (setq sources + (cl-loop for src in (helm-get-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. + (unless sources (erase-buffer)) + ;; Compute matches without rendering the sources. + (helm-log "Matches: %S" + (setq matches (helm--collect-matches sources))) + ;; If computing matches finished and is not interrupted + ;; erase the helm-buffer and render results (Fix #1157). + (when matches + (erase-buffer) ; [1] + (cl-loop for src in sources + for mtc in matches + do (helm-render-source src mtc)))) + (helm--update-move-first-line) + (let ((src (or source (helm-get-current-source)))) + (unless (assoc 'candidates-process src) + (helm-display-mode-line src) + (helm-log-run-hook 'helm-after-update-hook))) + (when preselect + (helm-log "Update preselect candidate %s" preselect) + (helm-preselect preselect source)) + (setq helm--force-updating-p nil)) + (helm-log "end update"))) + +(defun helm-update-source-p (source) + "Whether SOURCE need updating or not." + (let ((len (string-width + (if (assoc '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 (assoc 'requires-pattern source) (or (cdr it) 1) 0)) + ;; These incomplete regexps hang helm forever + ;; so defer update. Maybe replace spaces quoted when using + ;; multi-match. + (not (member (replace-regexp-in-string "\\s\\ " " " helm-pattern) + helm-update-blacklist-regexps))))) + +(defun helm--update-move-first-line () + "Goto first line of `helm-buffer'." + (goto-char (point-min)) + (helm-move-selection-common :where 'line + :direction 'next + :follow t)) + +(defun helm-force-update (&optional preselect) + "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 or moved to +PRESELECT, if specified." + (let* ((source (helm-get-current-source)) + (selection (helm-aif (helm-get-selection nil t source) + (regexp-quote it) + it))) + (setq helm--force-updating-p t) + (when source + (mapc 'helm-force-update--reinit + (helm-get-sources))) + (helm-update (or preselect selection) source) + (with-helm-window (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." + (helm-aif (helm-funcall-with-source + source 'helm-candidate-buffer) + (kill-buffer it)) + (cl-dolist (attr '(update init)) + (helm-aif (assoc-default attr source) + (helm-funcall-with-source source it))) + (helm-remove-candidate-cache source)) + +(defun helm-remove-candidate-cache (source) + "Remove SOURCE from `helm-candidate-cache'." + (remhash (assoc-default 'name source) helm-candidate-cache)) + +(defun helm-insert-match (match insert-function &optional num) + "Insert MATCH into `helm-buffer' with INSERT-FUNCTION for SOURCE. +If MATCH is a list then insert the string to display and store +the real value in a text property." + (let ((start (point-at-bol (point))) + (dispvalue (helm-candidate-get-display match)) + (realvalue (cdr-safe match))) + (when (and (stringp dispvalue) + (not (zerop (length dispvalue)))) + (funcall insert-function dispvalue) + ;; 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 (point-at-eol) + 'helm-realvalue realvalue))) + (when num + (put-text-property start (point-at-eol) 'helm-cand-num num)) + (funcall insert-function "\n")))) + +(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-funcall-with-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 "\n") + (put-text-property start (point) 'helm-header-separator t))) + (let ((start (point))) + (insert name) + (put-text-property (point-at-bol) + (point-at-eol) 'helm-header t) + (when display-string + (overlay-put (make-overlay (point-at-bol) (point-at-eol)) + 'display display-string)) + (insert "\n") + (put-text-property start (point) 'face 'helm-source-header))) + +(defun helm-insert-candidate-separator () + "Insert separator of candidates into the helm buffer." + (insert (propertize helm-candidate-separator 'face 'helm-separator)) + (put-text-property (point-at-bol) + (point-at-eol) 'helm-candidate-separator t) + (insert "\n")) + + +;;; Core: async process +;; +(defun helm-output-filter (process output-string) + "The `process-filter' function for helm async sources." + (with-helm-quittable + (helm-output-filter-1 (assoc process helm-async-processes) output-string))) + +(defun helm-output-filter-1 (process-assoc output-string) + (helm-log "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 "\n") + (assoc '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 (assoc 'item-count source)))) + (put-text-property start (point) 'helm-multiline t)) + (helm-insert-match candidate 'insert-before-markers + (1+ (cdr (assoc 'item-count source))))) + (cl-incf (cdr (assoc 'item-count source))) + (when (>= (assoc-default 'item-count source) limit) + (helm-kill-async-process process) + (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 "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 (Issue #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) + ;; 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-after-update-hook)))) + +(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)) + + +;;; Core: action +;; +(defun helm-execute-selection-action () + "Execute current action." + (helm-log-run-hook '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) + (prog1 (helm-execute-selection-action-1) + (helm-log-run-hook 'helm-after-action-hook))) + +(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 "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 (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 (assoc '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-funcall-with-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-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-hook) + (setq helm-saved-selection (helm-get-selection nil nil src)) + (with-selected-frame (with-helm-window (selected-frame)) + (prog1 + (cond ((get-buffer-window helm-action-buffer 'visible) + (set-window-buffer (get-buffer-window helm-action-buffer) + helm-buffer) + (kill-buffer helm-action-buffer) + (setq helm-saved-selection nil) + (helm-set-pattern helm-input 'noupdate)) + (helm-saved-selection + (setq helm-saved-current-source src) + (let ((actions (helm-get-actions-from-current-source src))) + (if (functionp actions) + (message "Sole action: %s" + (if (or (consp actions) + (byte-code-function-p actions)) + "Anonymous" actions)) + (helm-show-action-buffer actions) + ;; Be sure the minibuffer is entirely deleted (#907). + (helm--delete-minibuffer-contents-from "") + ;; Make `helm-pattern' differs from the previous value. + (setq helm-pattern 'dummy) + (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-show-action-buffer (actions) + (with-current-buffer (get-buffer-create helm-action-buffer) + (erase-buffer) + (buffer-disable-undo) + (set-window-buffer (get-buffer-window helm-buffer) helm-action-buffer) + (set (make-local-variable 'helm-sources) + (list + (helm-build-sync-source "Actions" + :volatile t + :nomark t + :keymap 'helm-map + :candidates actions + :mode-line '("Action(s)" "TAB: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))) + + +;; Core: selection + +(defun helm-display-source-at-screen-top-maybe (unit) + "Display source at the top of screen when UNIT value is 'source. +Returns 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 bop 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 (point-at-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 ((follow (and (or (helm-follow-mode-p source) + (and helm-follow-mode-persistent + (member (assoc-default 'name source) + helm-source-names-using-follow))) + " (HF)")) + (marked (and helm-marked-candidates + (cl-loop with cur-name = (assoc-default 'name source) + for c in helm-marked-candidates + for name = (assoc-default 'name (car c)) + when (string= name cur-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 (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) + (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-quote helm--prompt) cont) + '(space :width left-fringe) + (propertize + "->" + 'face 'helm-header-line-left-margin)))) + (pos (- (point) beg))) + (with-helm-buffer + (setq header-line-format (concat pref cont " ")) + (put-text-property + ;; Increment pos to handle the space before prompt (i.e `pref'). + (1+ pos) (+ 2 pos) + 'face ;don't just use 'cursor; this can hide the current character + (list :inverse-video t + :foreground (face-background 'cursor) + :background (face-background 'default)) + header-line-format) + (when update (force-mode-line-update)))))) + +(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))) + +(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)) + (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 '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)))))))) + (unless (or (helm-empty-buffer-p (helm-buffer-get)) + (not (helm-window))) + (with-helm-window + (helm-log-run-hook '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 (helm-get-current-source)) + (helm-log-run-hook 'helm-move-selection-after-hook))))) + +(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))) + +(defun helm-move--previous-page-fn () + (condition-case nil + (scroll-down) + (beginning-of-buffer (goto-char (point-min))))) + +(defun helm-move--next-page-fn () + (condition-case nil + (scroll-up) + (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 () + (goto-char (or (helm-get-next-header-pos) (point-max))) + (when (helm-pos-header-line-p) (forward-line -2))) + +(defun helm-move--beginning-of-source () + (goto-char (helm-get-previous-header-pos)) + (forward-line 1)) + +(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. + ;; Issue #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 (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 "%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-previous-page () + "Move selection back with a pageful." + (interactive) + (with-helm-alive-p + (helm-move-selection-common :where 'page :direction 'previous))) +(put 'helm-previous-page 'helm-only t) + +(defun helm-next-page () + "Move selection forward with a pageful." + (interactive) + (with-helm-alive-p + (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 (source-or-name) + "Move the selection to the source SOURCE-OR-NAME." + (helm-move-selection-common :where 'source :direction source-or-name)) + +(defun helm--follow-action (arg) + (let ((helm--temp-follow-flag t)) + (when (or (eq last-command 'helm-follow-action-forward) + (eq last-command 'helm-follow-action-backward) + (eq last-command 'helm-execute-persistent-action)) + (if (> arg 0) + (helm-move-selection-common :where 'line + :direction 'next + :follow nil) + (helm-move-selection-common :where 'line + :direction 'previous + :follow nil))) + (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) + "Move `helm-selection-overlay' to current line. +Note that this is unrelated to visible marks used for marking +candidates." + (with-helm-window + (when resumep + (goto-char helm-selection-point)) + (move-overlay + helm-selection-overlay (point-at-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+ (point-at-eol)))) + (setq helm-selection-point (overlay-start helm-selection-overlay)))) + +(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)) + (let* ((src (helm-get-current-source)) + (empty-buffer-p (with-current-buffer helm-buffer + (eq (point-min) (point-max)))) + (sel (helm-get-selection nil nil src)) + (unknown (and (not empty-buffer-p) + (string= (get-text-property + 0 'display + (helm-get-selection nil 'withprop src)) + "[?]")))) + (cond ((and (or empty-buffer-p unknown) + (eq minibuffer-completion-confirm 'confirm)) + (setq helm-minibuffer-confirm-state + 'confirm) + (setq minibuffer-completion-confirm nil) + (minibuffer-message " [confirm]")) + ((and (or empty-buffer-p + (unless (if minibuffer-completing-file-name + (and minibuffer-completion-predicate + (funcall minibuffer-completion-predicate sel)) + (and (stringp sel) + ;; SEL may be a cons cell when helm-comp-read + ;; is called directly with a collection composed + ;; of (display . real) and real is a cons cell. + (try-completion sel minibuffer-completion-table + minibuffer-completion-predicate))) + unknown)) + (eq minibuffer-completion-confirm t)) + (minibuffer-message " [No match]")) + (t + (setq helm-minibuffer-confirm-state nil) + (helm-exit-minibuffer))))))) +(put 'helm-confirm-and-exit-minibuffer 'helm-only t) + +(add-hook 'helm-after-update-hook 'helm-confirm-and-exit-hook) + +(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))) + +(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-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-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 (point-at-bol) 'helm-header) + (get-text-property (point-at-bol) 'helm-header-separator))) + +(defun helm-pos-candidate-separator-p () + "Return t if the current line is a candidate separator." + (get-text-property (point-at-bol) 'helm-candidate-separator)) + + +;;; Debugging +;; +;; +(defun helm-debug-output () + "Show all helm-related variables at this time." + (interactive) + (with-helm-alive-p + (helm-help-internal " *Helm Debug*" 'helm-debug-output-function))) +(put 'helm-debug-output 'helm-only t) + +(defun helm-debug-output-function (&optional vars) + (message "Calculating all helm-related values...") + (insert "If you debug some variables or forms, set `helm-debug-variables' +to a list of forms.\n\n") + (cl-dolist (v (or vars + helm-debug-variables + (apropos-internal "^helm-" 'boundp))) + (insert "** " + (pp-to-string v) "\n" + (pp-to-string (with-current-buffer helm-buffer (eval v))) "\n")) + (message "Calculating all helm-related values...Done")) + +;;;###autoload +(defun helm-debug-toggle () + "Enable/disable helm debugging from outside of helm session." + (interactive) + (setq helm-debug (not helm-debug)) + (message "Helm Debug is now %s" + (if helm-debug "Enabled" "Disabled"))) + +(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) + + +;; Core: misc +(defun helm-kill-buffer-hook () + "Remove tick entry from `helm-tick-hash' and remove buffer from +`helm-buffers' when killing a buffer." + (cl-loop for key being the hash-keys in helm-tick-hash + if (string-match (format "^%s/" (regexp-quote (buffer-name))) key) + do (remhash key helm-tick-hash)) + (setq helm-buffers (remove (buffer-name) helm-buffers))) +(add-hook 'kill-buffer-hook 'helm-kill-buffer-hook) + +(defun helm-preselect (candidate-or-regexp &optional source) + "Move selection to CANDIDATE-OR-REGEXP on Helm start. + +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. + +Optional argument SOURCE is a Helm source object." + (with-helm-window + (when candidate-or-regexp + (if source + (helm-goto-source source) + (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 (Issue #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)) + (helm-mark-current-line) + (helm-display-mode-line (or source (helm-get-current-source))) + (helm-log-run-hook '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 (point-at-bol) + (1+ (progn (goto-char it) (point-at-eol)))) + ;; last candidate + (goto-char (helm-get-previous-candidate-separator-pos)) + (delete-region (point-at-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 (point-at-bol) (1+ (point-at-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-p (&optional at-point) + "Return non-`nil' if we are at eob or end of source." + (save-excursion + (if (and (helm-pos-multiline-p) (null at-point)) + (null (helm-get-next-candidate-separator-pos)) + (forward-line (if at-point 0 1)) + (or (eq (point-at-bol) (point-at-eol)) + (helm-pos-header-line-p) + (eobp))))) + +(defun helm-beginning-of-source-p (&optional at-point) + "Return non-`nil' if we are at bob or beginning of source." + (save-excursion + (if (and (helm-pos-multiline-p) (null at-point)) + (null (helm-get-previous-candidate-separator-pos)) + (forward-line (if at-point 0 -1)) + (or (eq (point-at-bol) (point-at-eol)) + (helm-pos-header-line-p) + (bobp))))) + +(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) (point-at-eol) + 'helm-realvalue realvalue)) + (and multiline + (put-text-property (point) (point-at-eol) + '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) + ;; Giving an empty string value to FROM-STR delete all. + (let ((input (minibuffer-contents))) + (helm-reset-yank-point) + (if (> (length input) 0) + ;; minibuffer is not empty, delete contents from end + ;; of FROM-STR and update. + (helm-set-pattern from-str) + ;; minibuffer is already empty, force update. + (helm-force-update)))) + +(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. +Giving a prefix arg reverses this behavior. +When at the end of minibuffer, deletes all." + (interactive "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) "")))) + (helm--delete-minibuffer-contents-from str))) + + +;;; 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' behavior, +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)) + (helm-candidate-number-limit src) + (helm-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 + (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." + ;; 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 limit) + (helm-search-from-candidate-buffer + pattern get-line-fn search-fns 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 (buffer-read-only) + (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 + while (and (setq pos-lst (funcall searcher pattern)) + (not (eobp)) + (< count limit)) + for cand = (apply get-line-fn + (if (and pos-lst (listp pos-lst)) + pos-lst + (list (point-at-bol) (point-at-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)) + (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))) + do (progn + (puthash cand iter hash) + (helm--maybe-process-filter-one-by-one-candidate cand source) + (cl-incf count)) + and collect cand)))))) + +(defun helm-search-match-part (candidate pattern) + "Match PATTERN only on part of CANDIDATE returned by MATCH-PART-FN. +Because `helm-search-match-part' maybe called even if unspecified +in source (negation), MATCH-PART-FN default to `identity' +to match whole candidate. +When using fuzzy matching and negation (i.e \"!\"), +this function is always called." + (let ((part (get-text-property 0 'match-part candidate)) + (fuzzy-regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache))) + (matchfn (if helm-migemo-mode + 'helm-mm-migemo-string-match 'string-match))) + (if (string-match " " pattern) + (cl-loop for i in (split-string 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))))) + +(defun helm-initial-candidates-from-candidate-buffer (get-line-fn limit) + (delq nil (cl-loop for i from 1 to limit + until (eobp) + collect (funcall get-line-fn + (point-at-bol) (point-at-eol)) + 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 create-or-buffer) + "Register and return a buffer containing candidates of current source. +`helm-candidate-buffer' searches buffer-local candidates buffer first, +then global candidates buffer. + +Acceptable values of CREATE-OR-BUFFER: + +- nil (omit) + Only return the candidates buffer. +- a buffer + Register a buffer as a candidates buffer. +- 'global + Create a new global candidates buffer, + named \" *helm candidates:SOURCE*\". +- other non-`nil' value + Create a new local candidates buffer, + named \" *helm candidates:SOURCE*HELM-CURRENT-BUFFER\"." + (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))) + helm-candidate-buffer-alist + (register-func + (lambda () + (setq helm-candidate-buffer-alist + (cons (cons helm-source-name create-or-buffer) + (delete (assoc helm-source-name + helm-candidate-buffer-alist) + helm-candidate-buffer-alist))))) + (kill-buffers-func + (lambda () + (cl-loop for b in (buffer-list) + if (string-match (format "^%s" (regexp-quote global-bname)) + (buffer-name b)) + do (kill-buffer b)))) + (create-func + (lambda () + (with-current-buffer + (get-buffer-create (if (eq create-or-buffer 'global) + global-bname + local-bname)) + (set (make-local-variable 'inhibit-read-only) t) ; Fix (#1176) + (buffer-disable-undo) + (erase-buffer) + (font-lock-mode -1)))) + (return-func + (lambda () + (or (get-buffer local-bname) + (get-buffer global-bname) + (helm-aif (assoc-default helm-source-name + helm-candidate-buffer-alist) + (and (buffer-live-p it) it)))))) + (when create-or-buffer + (funcall register-func) + (unless (bufferp create-or-buffer) + (and (eq create-or-buffer 'global) (funcall kill-buffers-func)) + (funcall create-func))) + (funcall return-func))) + +(defun helm-init-candidates-in-buffer (buffer data) + "Register BUFFER with DATA for a helm candidates-in-buffer session. +Arg BUFFER can be a string, a buffer object (bufferp), or a symbol, +either 'local or 'global which is passed to `helm-candidate-buffer'. +Arg DATA can be either a list or a plain string. +Returns the resulting buffer." + (declare (indent 1)) + (let ((buf (helm-candidate-buffer + (if (or (stringp buffer) + (bufferp buffer)) + (get-buffer-create buffer) + buffer)))) ; a symbol. + (with-current-buffer buf + (erase-buffer) + (if (listp data) + (insert (mapconcat (lambda (i) + (cond ((symbolp i) (symbol-name i)) + ((numberp i) (number-to-string i)) + (t i))) + data "\n")) + (and (stringp data) (insert data)))) + buf)) + + +;;; Resplit helm window +;; +;; +(defun helm-toggle-resplit-window () + "Toggle resplit helm window, vertically or horizontally." + (interactive) + (with-helm-alive-p + (when helm-prevent-escaping-from-minibuffer + (helm-prevent-switching-other-window :enabled nil)) + (unwind-protect + (with-helm-window + (if (or helm-full-frame (one-window-p t)) + (message "Error: Attempt to resplit a single window") + (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))))) +(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-swap-windows () + "Swap window holding `helm-buffer' with other window." + (interactive) + (with-helm-alive-p + (if (and helm-full-frame (one-window-p t)) + (error "Error: Can't swap windows in a single window") + (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)))))) +(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) + (cond ((and (zerop n) (functionp action)) + action) + ((listp action) + (or (cdr (elt action n)) + (error "No such action"))) + ((and (functionp action) (< 0 n)) + (error "Sole action")) + (t + (error "Error in `helm-select-nth-action'")))) + +(defun helm-execute-selection-action-at-nth (linum) + "Allow to execute default action on candidate at LINUM." + (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 'persistent-action) split-onewindow) + "Perform the associated action ATTR without quitting helm. +ATTR default is 'persistent-action', but it can be anything else. +In this case you have to add this new attribute to your source. + +When `helm-full-frame' or SPLIT-ONEWINDOW are 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." + (interactive) + (with-helm-alive-p + (helm-log "executing persistent-action") + (let* ((source (helm-get-current-source)) + (selection (and source (helm-get-selection nil nil source))) + (attr-val (assoc-default attr source)) + ;; If attr value is a cons, use its car as persistent function + ;; and its car to decide if helm window should be splitted. + (fn (if (and (consp attr-val) + ;; maybe a lambda. + (not (functionp attr-val))) + (car attr-val) attr-val)) + (no-split (and (consp attr-val) + (not (functionp attr-val)) + (cdr attr-val))) + (cursor-in-echo-area t) + mode-line-in-non-selected-windows) + (when source + (with-helm-window + (save-selected-window + (if no-split + (helm-select-persistent-action-window) + (helm-select-persistent-action-window + (or split-onewindow helm-onewindow-p))) + (helm-log "current-buffer = %S" (current-buffer)) + (let ((helm-in-persistent-action t) + (same-window-regexps '(".")) + 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) + (helm-log-run-hook '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) + +(defun helm-persistent-action-display-window (&optional split-onewindow) + "Return the window that will be used for persistent action. +If SPLIT-ONEWINDOW is non-`nil' window is split in persistent action." + (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) + (split-onewindow (split-window)) + ((get-buffer-window helm-current-buffer)) + (t (next-window (selected-window) 1)))))) + +(defun helm-select-persistent-action-window (&optional split-onewindow) + "Select the window that will be used for persistent action. +See `helm-persistent-action-display-window' for how to use SPLIT-ONEWINDOW." + (select-window (get-buffer-window (helm-buffer-get))) + (select-window + (setq minibuffer-scroll-window + (helm-persistent-action-display-window split-onewindow)))) + +;; scroll-other-window(-down)? for persistent-action +(defun helm-other-window-base (command &optional scroll-amount) + (setq scroll-amount (unless (eq scroll-amount 'noscroll) + helm-scroll-amount)) + (with-selected-window (helm-persistent-action-display-window) + (funcall command scroll-amount))) + +(defun helm-scroll-other-window () + "Scroll other window (not *Helm* window) upward." + (interactive) + (with-helm-alive-p (helm-other-window-base 'scroll-up))) +(put 'helm-scroll-other-window 'helm-only t) + +(defun helm-scroll-other-window-down () + "Scroll other window (not *Helm* window) downward." + (interactive) + (with-helm-alive-p (helm-other-window-base 'scroll-down))) +(put 'helm-scroll-other-window-down 'helm-only t) + +(defun helm-recenter-top-bottom-other-window () + "`recenter-top-bottom' in other window (not *Helm* window)." + (interactive) + (with-helm-alive-p (helm-other-window-base 'recenter-top-bottom 'noscroll))) +(put 'helm-recenter-top-bottom-other-window 'helm-only t) + +(defun helm-reposition-window-other-window () + "`helm-reposition-window' in other window (not *Helm* window)." + (interactive) + (with-helm-alive-p (helm-other-window-base 'reposition-window 'noscroll))) +(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 nil src))) + (o (make-overlay (point-at-bol) + (if (helm-pos-multiline-p) + (or (helm-get-next-candidate-separator-pos) + (point-max)) + (1+ (point-at-eol)))))) + (overlay-put o 'priority 0) + (overlay-put o 'face 'helm-visible-mark) + (overlay-put o 'source (assoc-default 'name source)) + (overlay-put o 'string (buffer-substring (overlay-start o) (overlay-end o))) + (overlay-put o 'real sel) + (overlay-put o 'visible-mark t) + (cl-pushnew o helm-visible-mark-overlays) + (push (cons source sel) helm-marked-candidates))) + +(defun helm-toggle-visible-mark () + "Toggle helm visible mark at point." + (interactive) + (with-helm-alive-p + (with-helm-window + (let ((nomark (assq 'nomark (helm-get-current-source)))) + (if nomark + (message "Marking not allowed in this source") + (helm-aif (helm-this-visible-mark) + (helm-delete-visible-mark it) + (helm-make-visible-mark)) + (if (helm-end-of-source-p) + (helm-display-mode-line (helm-get-current-source)) + (helm-next-line))))))) +(put 'helm-toggle-visible-mark 'helm-only t) + +(defun helm-file-completion-source-p (&optional source) + "Return non-`nil' if current source is a file completion source." + (or minibuffer-completing-file-name + (let ((cur-source (cdr (assoc '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 () + "Mark all visible unmarked candidates in current source." + (interactive) + (with-helm-alive-p + (with-helm-window + (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"))) + (remote-p (and filecomp-p (file-remote-p helm-pattern)))) + (cl-letf (((symbol-function 'message) #'ignore)) + (helm-follow-mode -1) + (unwind-protect + (if nomark + (message "Marking not allowed in this source") + (save-excursion + (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 (get-text-property (point-at-bol) 'display)) + (cand (helm-get-selection nil nil src)) + (bn (and filecomp-p (helm-basename cand)))) + ;; Don't mark possibles directories ending with . or .. + ;; autosave files/links and non--existent file. + (unless + (or (helm-this-visible-mark) + (string= prefix "[?]") ; doesn't match + (and filecomp-p + (or (string-match-p ; autosave or dot files + "^[.]?#.*#?$\\|[^#]*[.]\\{1,2\\}$" bn) + ;; We need to test here when not using + ;; a transformer that put a prefix tag + ;; before candidate. + ;; (i.e no [?] prefix on tramp). + (and remote-p (not (file-exists-p cand)))))) + (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))))))) +(put 'helm-mark-all 'helm-only t) + +(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))))) +(put 'helm-unmark-all 'helm-only t) + +(defun helm-toggle-all-marks () + "Toggle all marks. +Mark all visible candidates of current source or unmark all candidates +visible or invisible in all sources of current helm session" + (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-mark-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 wilcard 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) + "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." + (with-current-buffer helm-buffer + (let ((candidates + (cl-loop with current-src = (helm-get-current-source) + for (source . real) in (reverse helm-marked-candidates) + for use-wc = (and with-wildcard (string-match-p "\\*" real)) + when (equal (assq 'name source) (assq 'name current-src)) + append (helm--compute-marked real source use-wc) + into cands + finally return (or cands + (append + (helm--compute-marked + (helm-get-selection nil nil current-src) + current-src + with-wildcard) + cands))))) + (helm-log "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 + (cl-dolist (o helm-visible-mark-overlays) + (let ((o-src-str (overlay-get o 'source)) + (o-str (overlay-get o 'string)) + beg end) + ;; Move point to end of source header line. + (goto-char (point-min)) + (search-forward o-src-str nil t) + (while (and (search-forward o-str nil t) + (not (overlays-at (point-at-bol 0))) + (helm-current-source-name= o-src-str)) + (setq beg (match-beginning 0) + end (match-end 0)) + ;; Calculate real value of candidate. + ;; It can be nil if candidate have only a display value. + (let ((real (get-text-property (point-at-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. + ;; Issue (#706). + (and (equal (overlay-get o 'real) real) + (move-overlay o beg end)) + (and (equal o-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) + +;;; Utility: Selection Paste +;; +(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-copy-to-buffer () + "Copy selection or marked candidates to `helm-current-buffer'. +Note that the real values of candidates are copied and not the +display values." + (interactive) + (with-helm-alive-p + (helm-run-after-exit + (lambda (cands) + (with-helm-current-buffer + (insert (mapconcat (lambda (c) + (format "%s" c)) + cands "\n")))) + (helm-marked-candidates)))) +(put 'helm-copy-to-buffer '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 apply 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 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)) + (sym (cl-loop for s in helm-sources + for sname = (and (symbolp s) + (assoc-default + 'name (symbol-value s))) + thereis (and sname (string= sname name) s))) + (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))))) + (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 arg is nil assume the call is interactive. + ;; However if user call helm-follow-mode with a prefix arg, + ;; the call will be considered non--interactive and + ;; src-name will NOT be saved to helm-source-names-using-follow. + ;; When called from lisp (non--interactive) src-name + ;; will never be saved. + (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)) + (unless helm-follow-mode-persistent + (and sym (set sym (remove (assq 'follow src) src))))) + (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)))) + (when (and (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-window) + (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-attr 'follow (or source (helm-get-current-source))) 1))) + +(defun helm-follow-mode-set-source (value &optional source) + (with-helm-buffer + (helm-attrset 'follow value (or source (helm-get-current-source))))) + +;;; Auto-resize mode +;; +(defun helm--autoresize-hook (&optional max-height min-height) + (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 () + "Help of `helm'." + (interactive) + (with-helm-alive-p + (save-selected-window + (helm-help-internal + "*Helm Help*" + (lambda () + (helm-aif (assoc-default 'help-message (helm-get-current-source)) + (insert (substitute-command-keys + (helm-interpret-value it))) + (insert "* No specific help for this source at this time.\n +It may appear after first results popup in helm buffer.")) + (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)) + (helm-update (regexp-quote (helm-get-selection nil t)))))) +(put 'helm-toggle-truncate-line 'helm-only t) + +(provide 'helm) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm.el ends here -- cgit v1.2.3 From 211eeb1dac5920e6c1185c628fca7a9e0a1b2521 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 8 Jan 2016 14:44:50 -0700 Subject: dummy-upstream-changelog Point the user to GitHub releases page which serves as upstream's changelog. Gbp-Pq: Name 0001-dummy-upstream-changelog.patch --- CHANGELOG | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 CHANGELOG diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 index 00000000..bc8133c1 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,2 @@ +Please see for details of +the changes between upstream releases. -- cgit v1.2.3 From be89b2ef8134f33fd7e7c90b3d15e4da852aa948 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 8 Jan 2016 14:48:08 -0700 Subject: decruft-README Gbp-Pq: Name 0003-decruft-README.patch --- README.md | 126 +++++++------------------------------------------------------- 1 file changed, 13 insertions(+), 113 deletions(-) diff --git a/README.md b/README.md index a2c96dc2..223b5495 100644 --- a/README.md +++ b/README.md @@ -1,17 +1,8 @@ -

License GPL 3 -MELPA -MELPA Stable

+Maintainance of Helm is a lot of work that I do freely on my sparse +time, please consider donating: + +or or -

Emacs-helm

- -

Emacs-helm

- -

Maintainance of Helm is a lot of work that I do freely on my sparse time,

-

please Donate to help this project,

-or [![Support via Gratipay](https://cdn.rawgit.com/gratipay/gratipay-badge/2.3.0/dist/gratipay.png)](https://gratipay.com/emacs-helm/) - - - **Table of Contents** - [Introduction](#introduction) @@ -34,8 +25,6 @@ or [![Support via Gratipay](https://cdn.rawgit.com/gratipay/gratipay-badge/2.3.0 - [Bugs & Improvements](#bugs--improvements) - [Getting help](#getting-help) - - # Introduction `Helm` is an Emacs framework for incremental completions and narrowing @@ -61,98 +50,11 @@ and dired operations in Helm. # Getting Started -## Quick install from git - - 1. Clone the `helm` repository to some directory: - - ```elisp - $ git clone https://github.com/emacs-helm/helm.git /path/to/helm/directory - ``` - - 2. Clone the `async` repository to some directory (facultative) - - ```elisp - $ git clone https://github.com/jwiegley/emacs-async.git /path/to/async/directory - ``` - 3. Run `make` from the `helm` directory. - - 3. Add to `.emacs.el` (or equivalent): - - ```elisp - ;; If async is installed - (add-to-list 'load-path "/path/to/async/directory") - - (add-to-list 'load-path "/path/to/helm/directory") - (require 'helm-config) - ``` - -_NOTE:_ Installing helm using git and make is the safest way. - -To quickly run `helm`, launch this script from helm directory: - -`./emacs-helm.sh` - -Also use the same script above for bug reporting. - -_NOTE:_ This script does not work on Windows systems. - -## Install from Emacs packaging system - -Helm can also be installed from MELPA repository at http://melpa.org/. -You will find the instructions to install packages from MELPA [here](https://github.com/melpa/melpa#usage). - -No further configuration is necessary to run helm other than perhaps a -one-line entry in the Emacs init file: - -```elisp -(require 'helm-config) -``` - -_WARNING:_ Helm upgrades from MELPA repository encountered errors -because of the way package.el fetched and compiled updates for -existing packages. To get around these errors, Helm adds -[Async](https://github.com/jwiegley/emacs-async) as a dependency -package install. Async forces compilation in a clean environment, -which solves those compilation errors. Since async has other benefits -as well, both for Helm and other packages, we recommend installing -async even for Helm installs using git. See -[FAQ](https://github.com/emacs-helm/helm/wiki#faq) for details. - -_Note:_ Restart Emacs for Helm updates from MELPA repositories to take -effect. - -**Note to Linux Distributions Maintainers** - -`Only the extensions in the github emacs-helm repository are supported.` - -## Debian and Ubuntu - -Users of Debian 9 or later or Ubuntu 16.04 or later may simply -`apt-get install elpa-helm` (or `apt-get install elpa-helm-core`; see -below). - -## Installing just the helm-core package - -`helm-core` package is available on [MELPA](http://melpa.org/) for -third party packages that depend on helm libraries. These packages -should require helm as follows: - - (require 'helm) - -Requiring helm builds and runs helm code necessary for multiple regexp -and fuzzy matching. See -[helm wiki](https://github.com/emacs-helm/helm/wiki#developpingusinghelmframework) -for details. - -## Warning about alternate installation methods - -Installation methods that circumvent `helm-config` are known to fail -if the careful safeguards are not implemented in the hacks. - ## Configuration -For minimal helm configuration, run the start-up script `./emacs-helm.sh` -and then see the file `/tmp/helm-cfg.el`. +For minimal helm configuration, run the start-up script +`/usr/share/doc/elpa-helm/emacs-helm.sh` and then see the file +`/tmp/helm-cfg.el`. The full configuration I (the helm maintainer) use is [here](https://github.com/thierryvolpiatto/emacs-tv-config/blob/master/init-helm-thierry.el). @@ -200,9 +102,9 @@ To make helm-mode start with Emacs init file: To discover helm commands, look at helm menu item in Emacs menu. Another way to discover helm commands: run the shell script: -`./emacs-helm.sh` and then look in the scratch buffer. `emacs-helm.sh` -accepts emacs command line options. `emacs-helm.sh -h` opens an Info -screen with more details. +`/usr/share/doc/elpa-helm/examples/emacs-helm.sh` and then look in the +scratch buffer. `emacs-helm.sh` accepts emacs command line +options. `emacs-helm.sh -h` opens an Info screen with more details. ## Advanced usage @@ -210,7 +112,7 @@ Helm contains many features, some of which are easier to follow visually. Here is a demo of `helm-buffers-list` used with `helm-moccur`. Demo starts with `Eval: START` in the minibuffer. -![helm-buffers-list](doc/helm-buffers-list.gif) +![helm-buffers-list](helm-buffers-list.gif) - Regexp `*C` selects the C buffers. `*Tcl` in the demo selects TCL buffers, then with `*C` switches back to C buffers. @@ -350,8 +252,8 @@ interacts with many Emacs features, bugs may be related to Emacs itself. One way to ascertain that the bugs are helm-related, recreate the -error either by using `Emacs -Q` or by running the included package -script `./emacs-helm.sh` located in the helm directory. +error either by using `Emacs -Q` or by running the included script +`/usr/share/doc/elpa-helm/examples/emacs-helm.sh`. # Getting help @@ -361,5 +263,3 @@ are two readily available locations. Cheers,
The Helm Team - -[badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg -- cgit v1.2.3 From ecbbdfe94dda505f5a10ba3cc950a7b87f1a1056 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 6 Feb 2016 11:17:39 -0700 Subject: patch-emacs-helm-sh Gbp-Pq: Name 0004-patch-emacs-helm-sh.patch --- emacs-helm.sh | 29 +++++------------------------ 1 file changed, 5 insertions(+), 24 deletions(-) diff --git a/emacs-helm.sh b/emacs-helm.sh index 1213a867..13d47613 100755 --- a/emacs-helm.sh +++ b/emacs-helm.sh @@ -40,23 +40,6 @@ case $1 in ;; esac -cd $(dirname "$0") - -# Check if autoload file exists. -# It is maybe in a different directory if -# emacs-helm.sh is a symlink. -LS=$(ls -l $0 | awk '{print $11}') -if [ ! -z $LS ]; then - AUTO_FILE="$(dirname $LS)/helm-autoloads.el" -else - AUTO_FILE="helm-autoloads.el" -fi -if [ ! -e "$AUTO_FILE" ]; then - echo No autoloads found, please run make first to generate autoload file - exit 2 -fi - - cat > $CONF_FILE < $CONF_FILE < Date: Sat, 8 Oct 2016 18:45:05 -0700 Subject: remove-async-dependency Upstream specifies a dependency on async.el in order to fix installation from MELPA. The Debian installation process avoids the issue. We remove the dependency from ${elpa:Depends} and provide a Recommends: elpa-async in debian/control. Gbp-Pq: Name 0005-remove-async-dependency.patch --- helm-core-pkg.el | 3 +-- helm-pkg.el | 1 - 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/helm-core-pkg.el b/helm-core-pkg.el index a9d6fd01..cf967ff6 100644 --- a/helm-core-pkg.el +++ b/helm-core-pkg.el @@ -2,8 +2,7 @@ (define-package "helm-core" "2.2.1" "Development files for Helm" - '((emacs "24.4") - (async "1.9")) + '((emacs "24.4")) :url "https://emacs-helm.github.io/helm/") ;; Local Variables: diff --git a/helm-pkg.el b/helm-pkg.el index 0253ca55..f9e3d3c7 100644 --- a/helm-pkg.el +++ b/helm-pkg.el @@ -3,7 +3,6 @@ (define-package "helm" "2.2.1" "Helm is an Emacs incremental and narrowing framework" '((emacs "24.4") - (async "1.9") (popup "0.5.3") (helm-core "2.2.1")) :url "https://emacs-helm.github.io/helm/") -- cgit v1.2.3 From b6d35ab88c9f67f9792c31549035fc75e246f001 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 8 Jan 2016 14:44:50 -0700 Subject: dummy-upstream-changelog Point the user to GitHub releases page which serves as upstream's changelog. Gbp-Pq: Name 0001-dummy-upstream-changelog.patch --- CHANGELOG | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 CHANGELOG diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 index 00000000..bc8133c1 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,2 @@ +Please see for details of +the changes between upstream releases. -- cgit v1.2.3 From 067a22a529132d84c68e67d80a23f9abddae4e78 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 8 Jan 2016 14:48:08 -0700 Subject: decruft-README Gbp-Pq: Name 0003-decruft-README.patch --- README.md | 126 +++++++------------------------------------------------------- 1 file changed, 13 insertions(+), 113 deletions(-) diff --git a/README.md b/README.md index a2c96dc2..223b5495 100644 --- a/README.md +++ b/README.md @@ -1,17 +1,8 @@ -

License GPL 3 -MELPA -MELPA Stable

+Maintainance of Helm is a lot of work that I do freely on my sparse +time, please consider donating: + +or or -

Emacs-helm

- -

Emacs-helm

- -

Maintainance of Helm is a lot of work that I do freely on my sparse time,

-

please Donate to help this project,

-or [![Support via Gratipay](https://cdn.rawgit.com/gratipay/gratipay-badge/2.3.0/dist/gratipay.png)](https://gratipay.com/emacs-helm/) - - - **Table of Contents** - [Introduction](#introduction) @@ -34,8 +25,6 @@ or [![Support via Gratipay](https://cdn.rawgit.com/gratipay/gratipay-badge/2.3.0 - [Bugs & Improvements](#bugs--improvements) - [Getting help](#getting-help) - - # Introduction `Helm` is an Emacs framework for incremental completions and narrowing @@ -61,98 +50,11 @@ and dired operations in Helm. # Getting Started -## Quick install from git - - 1. Clone the `helm` repository to some directory: - - ```elisp - $ git clone https://github.com/emacs-helm/helm.git /path/to/helm/directory - ``` - - 2. Clone the `async` repository to some directory (facultative) - - ```elisp - $ git clone https://github.com/jwiegley/emacs-async.git /path/to/async/directory - ``` - 3. Run `make` from the `helm` directory. - - 3. Add to `.emacs.el` (or equivalent): - - ```elisp - ;; If async is installed - (add-to-list 'load-path "/path/to/async/directory") - - (add-to-list 'load-path "/path/to/helm/directory") - (require 'helm-config) - ``` - -_NOTE:_ Installing helm using git and make is the safest way. - -To quickly run `helm`, launch this script from helm directory: - -`./emacs-helm.sh` - -Also use the same script above for bug reporting. - -_NOTE:_ This script does not work on Windows systems. - -## Install from Emacs packaging system - -Helm can also be installed from MELPA repository at http://melpa.org/. -You will find the instructions to install packages from MELPA [here](https://github.com/melpa/melpa#usage). - -No further configuration is necessary to run helm other than perhaps a -one-line entry in the Emacs init file: - -```elisp -(require 'helm-config) -``` - -_WARNING:_ Helm upgrades from MELPA repository encountered errors -because of the way package.el fetched and compiled updates for -existing packages. To get around these errors, Helm adds -[Async](https://github.com/jwiegley/emacs-async) as a dependency -package install. Async forces compilation in a clean environment, -which solves those compilation errors. Since async has other benefits -as well, both for Helm and other packages, we recommend installing -async even for Helm installs using git. See -[FAQ](https://github.com/emacs-helm/helm/wiki#faq) for details. - -_Note:_ Restart Emacs for Helm updates from MELPA repositories to take -effect. - -**Note to Linux Distributions Maintainers** - -`Only the extensions in the github emacs-helm repository are supported.` - -## Debian and Ubuntu - -Users of Debian 9 or later or Ubuntu 16.04 or later may simply -`apt-get install elpa-helm` (or `apt-get install elpa-helm-core`; see -below). - -## Installing just the helm-core package - -`helm-core` package is available on [MELPA](http://melpa.org/) for -third party packages that depend on helm libraries. These packages -should require helm as follows: - - (require 'helm) - -Requiring helm builds and runs helm code necessary for multiple regexp -and fuzzy matching. See -[helm wiki](https://github.com/emacs-helm/helm/wiki#developpingusinghelmframework) -for details. - -## Warning about alternate installation methods - -Installation methods that circumvent `helm-config` are known to fail -if the careful safeguards are not implemented in the hacks. - ## Configuration -For minimal helm configuration, run the start-up script `./emacs-helm.sh` -and then see the file `/tmp/helm-cfg.el`. +For minimal helm configuration, run the start-up script +`/usr/share/doc/elpa-helm/emacs-helm.sh` and then see the file +`/tmp/helm-cfg.el`. The full configuration I (the helm maintainer) use is [here](https://github.com/thierryvolpiatto/emacs-tv-config/blob/master/init-helm-thierry.el). @@ -200,9 +102,9 @@ To make helm-mode start with Emacs init file: To discover helm commands, look at helm menu item in Emacs menu. Another way to discover helm commands: run the shell script: -`./emacs-helm.sh` and then look in the scratch buffer. `emacs-helm.sh` -accepts emacs command line options. `emacs-helm.sh -h` opens an Info -screen with more details. +`/usr/share/doc/elpa-helm/examples/emacs-helm.sh` and then look in the +scratch buffer. `emacs-helm.sh` accepts emacs command line +options. `emacs-helm.sh -h` opens an Info screen with more details. ## Advanced usage @@ -210,7 +112,7 @@ Helm contains many features, some of which are easier to follow visually. Here is a demo of `helm-buffers-list` used with `helm-moccur`. Demo starts with `Eval: START` in the minibuffer. -![helm-buffers-list](doc/helm-buffers-list.gif) +![helm-buffers-list](helm-buffers-list.gif) - Regexp `*C` selects the C buffers. `*Tcl` in the demo selects TCL buffers, then with `*C` switches back to C buffers. @@ -350,8 +252,8 @@ interacts with many Emacs features, bugs may be related to Emacs itself. One way to ascertain that the bugs are helm-related, recreate the -error either by using `Emacs -Q` or by running the included package -script `./emacs-helm.sh` located in the helm directory. +error either by using `Emacs -Q` or by running the included script +`/usr/share/doc/elpa-helm/examples/emacs-helm.sh`. # Getting help @@ -361,5 +263,3 @@ are two readily available locations. Cheers,
The Helm Team - -[badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg -- cgit v1.2.3 From 8d27b0e4d072531fbb94307126095910703c2732 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 6 Feb 2016 11:17:39 -0700 Subject: patch-emacs-helm-sh Gbp-Pq: Name 0004-patch-emacs-helm-sh.patch --- emacs-helm.sh | 29 +++++------------------------ 1 file changed, 5 insertions(+), 24 deletions(-) diff --git a/emacs-helm.sh b/emacs-helm.sh index 1213a867..13d47613 100755 --- a/emacs-helm.sh +++ b/emacs-helm.sh @@ -40,23 +40,6 @@ case $1 in ;; esac -cd $(dirname "$0") - -# Check if autoload file exists. -# It is maybe in a different directory if -# emacs-helm.sh is a symlink. -LS=$(ls -l $0 | awk '{print $11}') -if [ ! -z $LS ]; then - AUTO_FILE="$(dirname $LS)/helm-autoloads.el" -else - AUTO_FILE="helm-autoloads.el" -fi -if [ ! -e "$AUTO_FILE" ]; then - echo No autoloads found, please run make first to generate autoload file - exit 2 -fi - - cat > $CONF_FILE < $CONF_FILE < Date: Mon, 17 Oct 2016 09:48:48 -0700 Subject: remove async dependency Upstream specifies a dependency on async.el in order to fix installation from MELPA. The Debian installation process avoids the issue. We remove the dependency from ${elpa:Depends} and provide a Recommends: elpa-async in debian/control. Gbp-Pq: Name 0005-remove-async-dependency.patch --- helm-core-pkg.el | 3 +-- helm-pkg.el | 1 - 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/helm-core-pkg.el b/helm-core-pkg.el index 91690563..532359e0 100644 --- a/helm-core-pkg.el +++ b/helm-core-pkg.el @@ -2,8 +2,7 @@ (define-package "helm-core" "2.3.0" "Development files for Helm" - '((emacs "24.4") - (async "1.9")) + '((emacs "24.4")) :url "https://emacs-helm.github.io/helm/") ;; Local Variables: diff --git a/helm-pkg.el b/helm-pkg.el index e4f231a9..05cee828 100644 --- a/helm-pkg.el +++ b/helm-pkg.el @@ -3,7 +3,6 @@ (define-package "helm" "2.3.0" "Helm is an Emacs incremental and narrowing framework" '((emacs "24.4") - (async "1.9") (popup "0.5.3") (helm-core "2.3.0")) :url "https://emacs-helm.github.io/helm/") -- cgit v1.2.3 From 89c53ca8c465fed45f69fcf6d987a22eadf65cda Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 8 Jan 2016 14:44:50 -0700 Subject: dummy-upstream-changelog Point the user to GitHub releases page which serves as upstream's changelog. Gbp-Pq: Name 0001-dummy-upstream-changelog.patch --- CHANGELOG | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 CHANGELOG diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 index 00000000..bc8133c1 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,2 @@ +Please see for details of +the changes between upstream releases. -- cgit v1.2.3 From 6fa7ba76a208d4b5b48556af92bc5f0329853830 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 8 Jan 2016 14:48:08 -0700 Subject: decruft-README Gbp-Pq: Name 0003-decruft-README.patch --- README.md | 126 +++++++------------------------------------------------------- 1 file changed, 13 insertions(+), 113 deletions(-) diff --git a/README.md b/README.md index a2c96dc2..223b5495 100644 --- a/README.md +++ b/README.md @@ -1,17 +1,8 @@ -

License GPL 3 -MELPA -MELPA Stable

+Maintainance of Helm is a lot of work that I do freely on my sparse +time, please consider donating: + +or or -

Emacs-helm

- -

Emacs-helm

- -

Maintainance of Helm is a lot of work that I do freely on my sparse time,

-

please Donate to help this project,

-or [![Support via Gratipay](https://cdn.rawgit.com/gratipay/gratipay-badge/2.3.0/dist/gratipay.png)](https://gratipay.com/emacs-helm/) - - - **Table of Contents** - [Introduction](#introduction) @@ -34,8 +25,6 @@ or [![Support via Gratipay](https://cdn.rawgit.com/gratipay/gratipay-badge/2.3.0 - [Bugs & Improvements](#bugs--improvements) - [Getting help](#getting-help) - - # Introduction `Helm` is an Emacs framework for incremental completions and narrowing @@ -61,98 +50,11 @@ and dired operations in Helm. # Getting Started -## Quick install from git - - 1. Clone the `helm` repository to some directory: - - ```elisp - $ git clone https://github.com/emacs-helm/helm.git /path/to/helm/directory - ``` - - 2. Clone the `async` repository to some directory (facultative) - - ```elisp - $ git clone https://github.com/jwiegley/emacs-async.git /path/to/async/directory - ``` - 3. Run `make` from the `helm` directory. - - 3. Add to `.emacs.el` (or equivalent): - - ```elisp - ;; If async is installed - (add-to-list 'load-path "/path/to/async/directory") - - (add-to-list 'load-path "/path/to/helm/directory") - (require 'helm-config) - ``` - -_NOTE:_ Installing helm using git and make is the safest way. - -To quickly run `helm`, launch this script from helm directory: - -`./emacs-helm.sh` - -Also use the same script above for bug reporting. - -_NOTE:_ This script does not work on Windows systems. - -## Install from Emacs packaging system - -Helm can also be installed from MELPA repository at http://melpa.org/. -You will find the instructions to install packages from MELPA [here](https://github.com/melpa/melpa#usage). - -No further configuration is necessary to run helm other than perhaps a -one-line entry in the Emacs init file: - -```elisp -(require 'helm-config) -``` - -_WARNING:_ Helm upgrades from MELPA repository encountered errors -because of the way package.el fetched and compiled updates for -existing packages. To get around these errors, Helm adds -[Async](https://github.com/jwiegley/emacs-async) as a dependency -package install. Async forces compilation in a clean environment, -which solves those compilation errors. Since async has other benefits -as well, both for Helm and other packages, we recommend installing -async even for Helm installs using git. See -[FAQ](https://github.com/emacs-helm/helm/wiki#faq) for details. - -_Note:_ Restart Emacs for Helm updates from MELPA repositories to take -effect. - -**Note to Linux Distributions Maintainers** - -`Only the extensions in the github emacs-helm repository are supported.` - -## Debian and Ubuntu - -Users of Debian 9 or later or Ubuntu 16.04 or later may simply -`apt-get install elpa-helm` (or `apt-get install elpa-helm-core`; see -below). - -## Installing just the helm-core package - -`helm-core` package is available on [MELPA](http://melpa.org/) for -third party packages that depend on helm libraries. These packages -should require helm as follows: - - (require 'helm) - -Requiring helm builds and runs helm code necessary for multiple regexp -and fuzzy matching. See -[helm wiki](https://github.com/emacs-helm/helm/wiki#developpingusinghelmframework) -for details. - -## Warning about alternate installation methods - -Installation methods that circumvent `helm-config` are known to fail -if the careful safeguards are not implemented in the hacks. - ## Configuration -For minimal helm configuration, run the start-up script `./emacs-helm.sh` -and then see the file `/tmp/helm-cfg.el`. +For minimal helm configuration, run the start-up script +`/usr/share/doc/elpa-helm/emacs-helm.sh` and then see the file +`/tmp/helm-cfg.el`. The full configuration I (the helm maintainer) use is [here](https://github.com/thierryvolpiatto/emacs-tv-config/blob/master/init-helm-thierry.el). @@ -200,9 +102,9 @@ To make helm-mode start with Emacs init file: To discover helm commands, look at helm menu item in Emacs menu. Another way to discover helm commands: run the shell script: -`./emacs-helm.sh` and then look in the scratch buffer. `emacs-helm.sh` -accepts emacs command line options. `emacs-helm.sh -h` opens an Info -screen with more details. +`/usr/share/doc/elpa-helm/examples/emacs-helm.sh` and then look in the +scratch buffer. `emacs-helm.sh` accepts emacs command line +options. `emacs-helm.sh -h` opens an Info screen with more details. ## Advanced usage @@ -210,7 +112,7 @@ Helm contains many features, some of which are easier to follow visually. Here is a demo of `helm-buffers-list` used with `helm-moccur`. Demo starts with `Eval: START` in the minibuffer. -![helm-buffers-list](doc/helm-buffers-list.gif) +![helm-buffers-list](helm-buffers-list.gif) - Regexp `*C` selects the C buffers. `*Tcl` in the demo selects TCL buffers, then with `*C` switches back to C buffers. @@ -350,8 +252,8 @@ interacts with many Emacs features, bugs may be related to Emacs itself. One way to ascertain that the bugs are helm-related, recreate the -error either by using `Emacs -Q` or by running the included package -script `./emacs-helm.sh` located in the helm directory. +error either by using `Emacs -Q` or by running the included script +`/usr/share/doc/elpa-helm/examples/emacs-helm.sh`. # Getting help @@ -361,5 +263,3 @@ are two readily available locations. Cheers,
The Helm Team - -[badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg -- cgit v1.2.3 From 34703b6c4b83a487d68c978d6236cd2b7342a410 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 6 Feb 2016 11:17:39 -0700 Subject: patch-emacs-helm-sh Gbp-Pq: Name 0004-patch-emacs-helm-sh.patch --- emacs-helm.sh | 29 +++++------------------------ 1 file changed, 5 insertions(+), 24 deletions(-) diff --git a/emacs-helm.sh b/emacs-helm.sh index 1213a867..13d47613 100755 --- a/emacs-helm.sh +++ b/emacs-helm.sh @@ -40,23 +40,6 @@ case $1 in ;; esac -cd $(dirname "$0") - -# Check if autoload file exists. -# It is maybe in a different directory if -# emacs-helm.sh is a symlink. -LS=$(ls -l $0 | awk '{print $11}') -if [ ! -z $LS ]; then - AUTO_FILE="$(dirname $LS)/helm-autoloads.el" -else - AUTO_FILE="helm-autoloads.el" -fi -if [ ! -e "$AUTO_FILE" ]; then - echo No autoloads found, please run make first to generate autoload file - exit 2 -fi - - cat > $CONF_FILE < $CONF_FILE < Date: Wed, 26 Oct 2016 15:31:31 -0700 Subject: remove async dependency Upstream specifies a dependency on async.el in order to fix installation from MELPA. The Debian installation process avoids the issue. We remove the dependency from ${elpa:Depends} and provide a Recommends: elpa-async in debian/control. Gbp-Pq: Name 0005-remove-async-dependency.patch --- helm-core-pkg.el | 3 +-- helm-pkg.el | 1 - 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/helm-core-pkg.el b/helm-core-pkg.el index b4e95697..f172cd49 100644 --- a/helm-core-pkg.el +++ b/helm-core-pkg.el @@ -2,8 +2,7 @@ (define-package "helm-core" "2.3.1" "Development files for Helm" - '((emacs "24.4") - (async "1.9")) + '((emacs "24.4")) :url "https://emacs-helm.github.io/helm/") ;; Local Variables: diff --git a/helm-pkg.el b/helm-pkg.el index 624fb342..cf527d84 100644 --- a/helm-pkg.el +++ b/helm-pkg.el @@ -3,7 +3,6 @@ (define-package "helm" "2.3.1" "Helm is an Emacs incremental and narrowing framework" '((emacs "24.4") - (async "1.9") (popup "0.5.3") (helm-core "2.3.1")) :url "https://emacs-helm.github.io/helm/") -- cgit v1.2.3